Result:
found more than 661 distributions - search limited to the first 2001 files matching your query
( run in 0.660 )
Bio-NEXUS
view release on metacpan or search on metacpan
README_admin view on Meta::CPAN
2. Once you are sure that the package works, change the master version number
in lib/Bio/NEXUS.pm (grep on VERSION). This will change the dist name when
the package is built (but the cvs version has to be changed separately-- see #4).
The initial version was based on the percent completion of NEXUS commands,
starting with 0.66 on 8/22/06. Subsequently we just incremented the minor number
by 1 each time. If you don't change this, you won't get a new version number to
upload to CPAN.
3. Check everything into CVS so that you can tag the current versions. If you
Bio-Phylo
view release on metacpan or search on metacpan
lib/Bio/Phylo/Matrices/MatrixRole.pm view on Meta::CPAN
sub no_sequences {
my $self = shift;
return scalar @{ $self->get_entities };
}
sub percentage_identity { $logger->warn }
# from simplealign
sub average_percentage_identity{
my ($self,@args) = @_;
my @alphabet = ('A','B','C','D','E','F','G','H','I','J','K','L','M',
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
lib/Bio/Phylo/Matrices/MatrixRole.pm view on Meta::CPAN
}
return $divisor > 0 ? ($total / $divisor )*100.0 : 0;
}
# from simplealign
sub overall_percentage_identity{
my ($self, $length_measure) = @_;
my @alphabet = ('A','B','C','D','E','F','G','H','I','J','K','L','M',
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
Bio-Pipeline-Comparison
view release on metacpan or search on metacpan
lib/Bio/Pipeline/Comparison/Report/ParseVCFCompare.pm view on Meta::CPAN
{
my ($self,$filename) = @_;
my $number_of_variants = 0;
for my $row_results (@{$self->_raw_venn_diagram_results})
{
my $number_of_files_with_overlap = @{$row_results->{files_to_percentage}};
if($number_of_files_with_overlap > 0)
{
for(my $i = 0; $i < $number_of_files_with_overlap; $i++ )
{
if(defined($row_results->{files_to_percentage}->[$1]->{file_name})
&& $row_results->{files_to_percentage}->[$1]->{file_name} eq $filename)
{
$number_of_variants +=$row_results->{number_of_sites};
last;
}
}
lib/Bio/Pipeline/Comparison/Report/ParseVCFCompare.pm view on Meta::CPAN
sub _number_of_uniques_for_filename
{
my ($self, $filename) = @_;
for my $row_results (@{$self->_raw_venn_diagram_results})
{
if(@{$row_results->{files_to_percentage}} == 1
&& defined($row_results->{files_to_percentage}->[0]->{file_name})
&& $row_results->{files_to_percentage}->[0]->{file_name} eq $filename)
{
return $row_results->{number_of_sites};
}
}
return 0;
lib/Bio/Pipeline/Comparison/Report/ParseVCFCompare.pm view on Meta::CPAN
my $line = $_;
if( $line =~ m/$vd_regex/)
{
my %vd_results;
$vd_results{number_of_sites} = $1;
$vd_results{files_to_percentage} = [ {file_name => $2, percentage => $3} ];
if(defined($4) && defined($5) && defined($6))
{
push(@{$vd_results{files_to_percentage}}, {file_name => $5, percentage => $6} );
}
push(@vd_rows,\%vd_results);
}
}
return \@vd_rows;
Bio-Polloc
view release on metacpan or search on metacpan
lib/Bio/Polloc/GroupCriteria.pm view on Meta::CPAN
Minimum score for either algorithms B<blast> and B<hmmer>. 20 by default.
=item -consensusperc I<float>
Minimum percentage a residue must appear in order to include it in the
consensus used as query. 60 by default. Only if -algorithm blast.
=item -e I<float>
If C<-algorithm> B<blast>, maximum e-value. 0.1 by default.
Bio-Prospect
view release on metacpan or search on metacpan
exercising rights under, and complying with all of the terms of, this
License. For legal entities, "You" includes any entity that controls, is
controlled by, or is under common control with you. For purposes of this
definition, "control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or otherwise,
or (ii) ownership of fifty percent (50%) or more of the outstanding shares,
or (iii) beneficial ownership of such entity.
15) Right to Use. You may use the Original Work in all ways not otherwise
restricted or conditioned by this License or by law, and Licensor promises
not to interfere with or be responsible for such uses by You.
Bio-Roary
view release on metacpan or search on metacpan
lib/Bio/Roary/AccessoryBinaryFasta.pm view on Meta::CPAN
has 'input_files' => ( is => 'ro', isa => 'ArrayRef', required => 1 );
has 'annotate_groups_obj' => ( is => 'ro', isa => 'Bio::Roary::AnnotateGroups', required => 1 );
has 'analyse_groups_obj' => ( is => 'ro', isa => 'Bio::Roary::AnalyseGroups', required => 1 );
has 'output_filename' => ( is => 'ro', isa => 'Str', default => 'accessory_binary_genes.fa' );
has 'lower_bound_percentage' => ( is => 'ro', isa => 'Int', default => 5 );
has 'upper_bound_percentage' => ( is => 'ro', isa => 'Int', default => 5 );
has 'max_accessory_to_include' => ( is => 'ro', isa => 'Int', default => 4000 );
has 'groups_to_files' => ( is => 'ro', isa => 'HashRef', lazy => 1, builder => '_build__groups_to_files' );
has '_lower_bound_value' => ( is => 'ro', isa => 'Int', lazy => 1, builder => '_build__lower_bound_value' );
has '_upper_bound_value' => ( is => 'ro', isa => 'Int', lazy => 1, builder => '_build__upper_bound_value' );
lib/Bio/Roary/AccessoryBinaryFasta.pm view on Meta::CPAN
}
sub _build__lower_bound_value {
my ($self) = @_;
my $num_files = @{ $self->input_files };
return ceil( $num_files * ( $self->lower_bound_percentage / 100 ) );
}
sub _build__upper_bound_value {
my ($self) = @_;
my $num_files = @{ $self->input_files };
return $num_files - ceil( $num_files * ( $self->upper_bound_percentage / 100 ) );
}
sub create_accessory_binary_fasta {
my ($self) = @_;
my $out_seq_io = Bio::SeqIO->new( -file => ">" . $self->output_filename, -format => 'Fasta' );
Bio-SamTools
view release on metacpan or search on metacpan
"Legal Entity" shall mean the union of the acting entity and all other
entities that control, are controlled by, or are under common control
with that entity. For the purposes of this definition, "control" means
(i) the power, direct or indirect, to cause the direction or
management of such entity, whether by contract or otherwise, or (ii)
ownership of fifty percent (50%) or more of the outstanding shares, or
(iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity exercising
permissions granted by this License.
Bio-SearchIO-blastxml
view release on metacpan or search on metacpan
t/SearchIO/blastxml.t view on Meta::CPAN
is($hsp->query->end,815);
is($hsp->hit->start, 3);
is($hsp->hit->end, 310);
is($hsp->query->frame,0);
is($hsp->hit->frame,0);
is(sprintf("%.2f", $hsp->percent_identity), 37.73);
is(sprintf("%.4f", $hsp->frac_identical('hit')), 0.3994);
is(sprintf("%.4f", $hsp->frac_identical('query')), 0.3868);
is(sprintf("%.4f",$hsp->query->frac_identical), 0.3868);
is(sprintf("%.4f",$hsp->frac_conserved('total')),0.5245);
t/SearchIO/blastxml.t view on Meta::CPAN
is($hsp->end('query'), $hsp->query->end);
is($hsp->strand('sbjct'), $hsp->subject->strand);# alias for hit
float_is($hsp->evalue, 0.000286309);
is($hsp->score, 86);
is($hsp->bits, 37.7354);
is(sprintf("%.1f",$hsp->percent_identity), 20.9);
is(sprintf("%.4f",$hsp->frac_identical('query')), 0.2105);
is(sprintf("%.3f",$hsp->frac_identical('hit')), 0.224);
is($hsp->gaps('total'), 11);
$hsps_left--;
}
t/SearchIO/blastxml.t view on Meta::CPAN
is($hsp->end('query'), $hsp->query->end);
is($hsp->strand('sbjct'), $hsp->subject->strand);# alias for hit
float_is($hsp->evalue, 0.0242028);
is($hsp->score, 73);
is($hsp->bits, 32.7278);
is(sprintf("%.1f",$hsp->percent_identity), '24.0');
is(sprintf("%.4f",$hsp->frac_identical('query')), '0.2605');
is(sprintf("%.3f",$hsp->frac_identical('hit')), '0.240');
is($hsp->gaps, 10);
$hsps_left--;
}
Bio-SearchIO-hmmer
view release on metacpan or search on metacpan
lib/Bio/Search/HSP/HMMERHSP.pm view on Meta::CPAN
default = 'total'
arg 2: [optional] integer length value to set for specific type
=cut
=head2 percent_identity
Title : percent_identity
Usage : my $percentid = $hsp->percent_identity()
Function: Returns the calculated percent identity for an HSP
Returns : floating point between 0 and 100
Args : none
=cut
Bio-ToolBox
view release on metacpan or search on metacpan
lib/Bio/ToolBox/Data.pm view on Meta::CPAN
# add column
my $i = $summed_data->add_column($data_name);
$summed_data->metadata( $i, 'dataset', $datasets[$d] );
# tag for remembering we're working with percentile bins
my $do_percentile = 0;
# remember the row
my $row = 1;
# Collect summarized data
lib/Bio/ToolBox/Data.pm view on Meta::CPAN
);
# convert midpoint to fraction of 1000 for plotting if necessary
if ( substr( $self->name($column), -1 ) eq '%' ) {
$midpoint *= 10; # midpoint * 0.01 * 1000 bp
$do_percentile++;
}
if ( $do_percentile and substr( $self->name($column), -2 ) eq 'bp' ) {
# working on the extension after the percentile bins
$midpoint += 1000;
}
# collect the values in the column
my @values;
lib/Bio/ToolBox/Data.pm view on Meta::CPAN
header becomes a row identifier (i.e. the table is transposed). The
best use of this is to summarize the mean profile of windowed data
collected across a feature. See the Bio::ToolBox scripts
L<get_relative_data.pl> and L<get_binned_data.pl> as examples.
For data from L<get_binned_data.pl> where the columns are expressed
as percentile bins, the reported midpoint column is automatically
converted based on a length of 1000 bp.
You may pass these options. They are optional.
=over 4
Bio-Tools-CodonOptTable
view release on metacpan or search on metacpan
lib/Bio/Tools/CodonOptTable.pm view on Meta::CPAN
. "|%{color:red}G%|"
. $monomers->{G} . "|\n"
. "|%{color:red}C%|"
. $monomers->{C} . "|\n";
my $gc_percentage =
( ( $monomers->{G} + $monomers->{C} ) /
( $monomers->{A} + $monomers->{T} + $monomers->{G} + $monomers->{C} )
) * 100;
$gc_percentage = sprintf( "%.2f", $gc_percentage );
my $REPORT = <<EOT;
h1. Bio::Tools::CodonOptTable
%{color:green}Report for $sequence_id%
%{color:red}Codon Adaptation Index (CAI) for sequence% : $cai
%{color:red}GC percentage for sequence% : $gc_percentage%
%{color:red}GENETIC CODE USED% : $genetic_code "--more about genetic code--":http://www.ncbi.nlm.nih.gov/Taxonomy/Utils/wprintgc.cgi
%{background:#336699;color:white;padding:5px}++**CODON USAGE**++%
Bio-Tools-Phylo-PAML
view release on metacpan or search on metacpan
lib/Bio/Tools/Phylo/PAML.pm view on Meta::CPAN
(\d+)\s+ # constant sites
\(\s*([\d\.]+)\s*\%\s*\)/x
)
{
$self->{'_summary'}->{'stats'}->{'constant_sites'} = $1;
$self->{'_summary'}->{'stats'}->{'constant_sites_percentage'} = $2;
}
elsif (/^ln\s+Lmax\s+\(unconstrained\)\s+\=\s+(\S+)/x) {
$self->{'_summary'}->{'stats'}->{'loglikelihood'} = $1;
$done = 1; # done for sure
}
lib/Bio/Tools/Phylo/PAML.pm view on Meta::CPAN
(\d+)\s+ # constant sites
\(\s*([\d\.]+)\s*\%\s*\)/ox
)
{
$self->{'_summary'}->{'stats'}->{'constant_sites'} = $1;
$self->{'_summary'}->{'stats'}->{'constant_sites_percentage'} = $2;
}
elsif (/^ln\s+Lmax\s+\(unconstrained\)\s+\=\s+(\S+)/ox) {
$self->{'_summary'}->{'stats'}->{'loglikelihood'} = $1;
$done = 1; # done for sure
}
Bio-Tools-Primer3Redux
view release on metacpan or search on metacpan
lib/Bio/Tools/Primer3Redux/Primer.pm view on Meta::CPAN
sub gc_content {
my ($self, $gc) = @_;
if (defined $gc) {
$self->remove_tag('gc_percent') if $self->has_tag('gc_percent');
$self->add_tag_value('gc_percent', $gc);
}
$self->has_tag('gc_percent') ? return ($self->get_tag_values('gc_percent'))[0] : return;
}
sub run_description {
my ($self, $desc) = @_;
lib/Bio/Tools/Primer3Redux/Primer.pm view on Meta::CPAN
=head2 gc_content
Title : gc
Usage : $obj->gc
Function : returns the GC content calculated for the primer via Primer3
Returns : float (percent)
Args : optional GC content (possibly calculated via other means)
=head2 run_description
Title : run_description
Bio-Tools-Run-Alignment-TCoffee
view release on metacpan or search on metacpan
t/TCoffee.t view on Meta::CPAN
my $seq_array_ref = \@seq_array;
$aln = $factory->align($seq_array_ref);
is $aln->num_sequences, 7;
my $s1_perid = $aln->average_percentage_identity;
my $profile1 = test_input_file("cysprot1a.msf");
my $profile2 = test_input_file("cysprot1b.msf");
# convert any warnings about program to an actual exception
t/TCoffee.t view on Meta::CPAN
$aln1 = $str1->next_aln();
$str2 = Bio::SeqIO->new(-file=> test_input_file("cysprot1b.fa"));
my $seq = $str2->next_seq();
is $aln1->num_sequences, 3;
is( int($aln1->average_percentage_identity), 39);
$aln = $factory->profile_align($aln1,$seq);
is( $aln->num_sequences, 4);
if( $version <= 1.22 ) {
cmp_ok( $aln->overall_percentage_identity, '>', 18);
is( int($aln->average_percentage_identity), 44);
} else {
my $overall = int($aln->overall_percentage_identity);
ok( $overall >=21 && $overall <= 23, 'expect 21 >= val >= 23');
my $avg = int($aln->average_percentage_identity);
ok( $avg == 47 || $avg ==48, 'expect 47 or 48');
}
# test new 'run' generic running of factory
$aln = $factory->run('-type' => 'align',
'-seq' => test_input_file("cysprot.fa"));
is ($aln->num_sequences, 7, 'simple generic run');
is ($aln->percentage_identity,$s1_perid); #calculated before
lives_ok{ $aln = $factory->run('-type' => 'profile',
'-profile' => $aln1,
'-seq' => test_input_file("cysprot1b.fa"))} ;
ok(! $@, "no T-COFFEE errors");
is( $aln->num_sequences, 7);
if( $version <= 1.22 ) {
cmp_ok( $aln->overall_percentage_identity, '>', 18);
is( int($aln->average_percentage_identity), 44);
} else {
my $overall = int $aln->overall_percentage_identity;
ok($overall == 14 || $overall == 13, 'expect 13 or 14');
my $avg = int($aln->average_percentage_identity);
ok($avg == 41 || $avg == 42, 'expect 41 or 42');
}
done_testing();
BioPerl-DB
view release on metacpan or search on metacpan
sql/markerdb-mysql.sql view on Meta::CPAN
CREATE TABLE marker_microsatellite (
marker_id integer(11) not null PRIMARY KEY,
oligo1_id integer(11) not null,
oligo2_id integer(11) not null,
flanking_gc_percent float(8,4),
length_low integer(6),
length_high integer(6),
motif varchar(128) not null
);
BioPerl-Run
view release on metacpan or search on metacpan
lib/Bio/Tools/Run/MCS.pm view on Meta::CPAN
for the latter stages (the stages involving align2binomial.pl,
generate_phyloMAX_score.pl and generate_mcs_beta.pl).
You can try supplying normal MCS command-line arguments to new(), eg.
$factory->new(-percentile => 95)
or calling arg-named methods (excluding the initial
hyphens, eg.
$factory->percentile(95)
to set the --percentile arg).
You will need to enable this MCS wrapper to find the MCS scripts.
This can be done in (at least) three ways:
lib/Bio/Tools/Run/MCS.pm view on Meta::CPAN
our $PROGRAM_NAME = 'align2binomial.pl';
our $PROGRAM_DIR;
# methods for the mcs args we support
our @PARAMS = qw(neutral percentile mcs specificity sensitivity name);
our @SWITCHES = qw(neg-score);
# just to be explicit, args we don't support (yet) or we handle ourselves
our @UNSUPPORTED = qw(ucsc gtf neutral-only fourd-align align-only ar);
BioPerl
view release on metacpan or search on metacpan
Bio/Align/AlignI.pm view on Meta::CPAN
# some descriptors
print $aln->length, "\n";
print $aln->num_residues, "\n";
print $aln->is_flush, "\n";
print $aln->num_sequences, "\n";
print $aln->percentage_identity, "\n";
print $aln->consensus_string(50), "\n";
# find the position in the alignment for a sequence location
$pos = $aln->column_from_residue_number('1433_LYCES', 14); # = 6;
Bio/Align/AlignI.pm view on Meta::CPAN
=head2 consensus_string
Title : consensus_string
Usage : $str = $ali->consensus_string($threshold_percent)
Function : Makes a strict consensus
Returns : consensus string
Argument : Optional threshold ranging from 0 to 100.
The consensus residue has to appear at least threshold %
of the sequences at a given location, otherwise a '?'
Bio/Align/AlignI.pm view on Meta::CPAN
sub num_sequences {
my ($self) = @_;
$self->throw_not_implemented();
}
=head2 percentage_identity
Title : percentage_identity
Usage : $id = $align->percentage_identity
Function: The function calculates the percentage identity of the alignment
Returns : The percentage identity of the alignment (as defined by the
implementation)
Argument: None
=cut
sub percentage_identity{
my ($self) = @_;
$self->throw_not_implemented();
}
=head2 overall_percentage_identity
Title : overall_percentage_identity
Usage : $id = $align->overall_percentage_identity
Function: The function calculates the percentage identity of
the conserved columns
Returns : The percentage identity of the conserved columns
Args : None
=cut
sub overall_percentage_identity{
my ($self) = @_;
$self->throw_not_implemented();
}
=head2 average_percentage_identity
Title : average_percentage_identity
Usage : $id = $align->average_percentage_identity
Function: The function uses a fast method to calculate the average
percentage identity of the alignment
Returns : The average percentage identity of the alignment
Args : None
=cut
sub average_percentage_identity{
my ($self) = @_;
$self->throw_not_implemented();
}
=head1 Alignment positions
Bio_AssemblyImprovement
view release on metacpan or search on metacpan
bin/abacas.pl view on Meta::CPAN
-d use default nucmer/promer parameters
-s int minimum length of exact matching word (nucmer default = 12, promer default = 4)
-m print ordered contigs to file in multifasta format
-b print contigs in bin to file
-N print a pseudomolecule without "N"s
-i int mimimum percent identity [default 40]
-v int mimimum contig coverage [default 40]
-V int minimum contig coverage difference [default 1]
-l int minimum contig length [default 1]
-t run tblastx on contigs that are not mapped
-g string (file name) print uncovered regions (gaps) on reference to file name
Bioinf
view release on metacpan or search on metacpan
# Category :
# Version : 2.2
#-----------------------------------------------------------------------------
sub get_isearch_result_stat{
my (@keys, $num_enq_seq, @pdbg_seqs_ori, $c, $d, $i, %correct_pairs,
$sum_correct, $sum_false, $match_seq, $percent_correct, $correct, @correct,
$av_correct, $av_false, $actual_e_value, $correct_matched,
%correcting_pairs, @correcting_pairs, %correct);
my %seqs=%{$_[0]};
my @pdbg_seqs=@{$_[1]};
$correct_group{$base} .="Nomolog: $sorted $base $msp_0{$sorted}\n";
}
$correct{$sorted} = "Nomolog: $base $msp_0{$sorted}";
}
}
if(@match_seqs == 0){ @match_seqs=1; $percent_correct=0; }
$sum_correct += $correct;
$sum_false += $false_positive;
}
$av_correct = $sum_correct/$num_enq_seq;
$av_false = $sum_false /($num_enq_seq);
my($i,$j,$c,$d,$e,$f,$g,$h,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u,$v,$w,$x,$y,$z);
if($debug==1){print "\n\t\@hash=\"@hash\"
\@raw_string=\"@raw_string\"\n\t\@array=\"@array\"\n\t\@num_opt=\"@num_opt\"
\@char_opt=\"@char_opt\"\n\t\@file=\"@file\"\n\t\@string=\"@string\"\n" }
#""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
my($merge, $verbose, $sat_file, $length_thresh, $factor, $indup, $indup_percent,
$score, @temp_show_sub, $optimize, $file, $evalue, $over_write, $din_dom,
$sum_seq_num, $base_1, $output_clu_file, $short_region, $large_region,
$average_region, $dynamic_factor, @sub_clustering_clu_files);
$factor=7; # default factor is 7 for 70%
}if($vars{'s'}=~/\d+/){ $score = $vars{'s'};
}if($vars{'e'}=~/\d+/){ $evalue= $vars{'e'};
}if($vars{'E'}=~/\d+/){ $evalue= $vars{'E'}; # synonym of e
}
$percent_fac=$factor*10;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# (0) When one file input was given (yes, divclus can handle multiple files, Sarah!)
#________________________________________________________________________________
if(@file == 1){ #<=== @file has xxxx.msp, yyyy.msp zzzz.msp ....,
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# (5) This is showing the result in clu file format
#________________________________________________________________________________
@temp_show_sub=&show_subclusterings(\@out, $file, $sat_file, $dindom, $indup,
"e=$evalue", "p=$percent_fac", "f=$factor" );
$good_bad = $temp_show_sub[0];
$indup_c = $temp_show_sub[1];
$sum_seq_num += $temp_show_sub[2];
push(@sub_clustering_out_files, @{$temp_show_sub[3]});
@out=@{&cluster_merged_seqlet_sets(\@grouped_seq_names, "f=$factor", $optimize, $dynamic_factor,
$short_region, $large_region, $average_region)};
@temp_show_sub=&show_subclusterings(\@out, $big_msp_file, $sat_file, $dindom, $indup,
"e=$evalue", "p=$percent_fac", "f=$factor");
$good_bad = $temp_show_sub[0];
$indup_c = $temp_show_sub[1];
$sum_seq_num += $temp_show_sub[2];
push(@sub_clustering_out_files, @{$temp_show_sub[3]});
if($debug==1){print "\n\t\@hash=\"@hash\"
\@raw_string=\"@raw_string\"\n\t\@array=\"@array\"\n\t\@num_opt=\"@num_opt\"
\@char_opt=\"@char_opt\"\n\t\@file=\"@file\"\n\t\@string=\"@string\"\n" }
#""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
my ($max_size, $sat_file_name, $clu_file_name,
$ori_cluster_size, $ori_cluster_num, $good_bad, @keys, $percentage_fac,
$indup, @sizes, $sum_seq_num, $indup_percent, $indup_count, %tem4,
@sub_clustering_out_files); # clusall_1e-5_clu_14-324_ss.sat
my @out=@{$array[0]};
$indup_count=0;
if($char_opt=~/d/){ $dindom=1; }
if($char_opt=~/i/){ $indup=1; }
if($vars{'f'}=~/\S+/){ $factor= $vars{'f'}; }
if($vars{'p'}=~/\d+/){ $percentage_fac= int($vars{'p'}); }
if($vars{'s'}=~/\d+/){ $score = $vars{'s'}; }
if($vars{'e'}=~/\d+/){ $evalue= $vars{'e'}; }
#print "\n# (1) show_subclusterings : \@file has : @file\n";
if( $file[0]=~/([\S+_]*?(\d+)\-(\d+)[_\w]*)\.msp/ or
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Local subroutine
#_______________________________________________________________
sub print_summary_for_divclus{ #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my(@keys, $indup_count, $x, $m, $percentage_fac);
my $count=$_[0]; # count of cluster
my %tem2=%{$_[1]}; my $num_seq=@keys=sort keys %tem2;
my %tem=%{$_[2]}; my $ori_cluster_num=$_[3];
my $new_clus_NAME=$ori_cluster_num.'0'.$count.'0'.$num_seq;
my $ori_cluster_size=$_[4];
}
#~~~~~~~~~~ Summary ~~~~~~~~~~~~~~~~~~~~~~~~~~~
print CLU "Cluster size $num_seq\n";
printf CLU ("Cluster number %-12s # E:%-5s Factor:%-2s P:%-2s, Ori size:%-4s Sub:%-4s From:%-12s\n",
$new_clus_NAME, $evalue, $factor, $percentage_fac,
$ori_cluster_size, $num_seq, $ori_cluster_num);
print "Cluster size $num_seq\n";
printf ("Cluster number %-12s # E:%-5s Factor:%-2s P:%-2s, Ori size:%-4s Sub:%-4s From:%-12s\n",
$new_clus_NAME, $evalue, $factor, $percentage_fac,
$ori_cluster_size, $num_seq, $ori_cluster_num);
for($x=0; $x <@keys; $x++){
printf CLU (" %-4s %-5s %-17s %-10s %-3s leng: %-s\n",
$num_seq, $ori_cluster_num, $keys[$x], $tem3{$keys[$x]}, $tem{$keys[$x]}, $tem4{$keys[$x]});
printf (" %-4s %-5s %-17s %-10s %-3s leng: %-s\n",
# 1cdg_6taa 67%
# 1cdg_2aaa 67%
#
# Warning :
# Keywords :
# Options : 'p' or 'P' for percentage term(default)
# 'r' or 'R' for ratio term (0.0 - 1.0), where 1 means all the
# segments were wrongly aligned.
# 's' or 'S' for Shift rate (it actually caculates the position shift
# rate for the secondary structure segment.
# 'h' or 'H' for position Shift rate (it actually caculates the position
# shift rate for helical segments). If this is the only option, it
# will show the default percentage term rate for helical segments.
# If used with 'r', it will give you ratio (0.0 - 1.0) for helical
# segment. If used with 's' option, it will give you position shift
# rate for only helical segments.
# 'e' or 'E' for position Shift rate (it actually caculates the position
# shift rate for beta segments). If this is the only option, it will
# show the default percentage term rate for beta segments. If used
# with 'r', it will give you ratio (0.0 - 1.0) for beta. If used
# with 's' option, it will give you position shift rate for only
# beta segments.
# Returns :
# Argument : Two references of hashes. One for error rate the other for sec.
# 2aaa_6taa -------00000---------00000000----0000-------00000-
# 1cdg_6taa -------442---------------2222-----------------000-
# 1cdg_2aaa -------222---------------2222-----------------000-
#
# In the above there are two segments wrong in 3 segment blocks = 2/3
# <output example> hash of 3 percentage rates.
#
# 2aaa_6taa 0 %
# 1cdg_6taa 66.6666666666667 %
# 1cdg_2aaa 66.6666666666667 %
#
# seq1 00111110000, The 'a' value of 0 and 1 as in the seq2
# seq2 33000040000 is 0-> 6/6, 1-> 4/5, while the 'n'
# calc would be, 0-> 6 (60%), 1-> 4(40%)
#
# Argument : (\%hash1, \%hash2) or optionally (\%hash1, \%hash2, ['n', 'i', 'p', 'a'])
# 'n' => normalizing, 'p' => percentage out, 'i' => make int out, 'a'=> averaged
# Category :
# Version : 1.2
#--------------------------------------------------------------------
sub tally_2_hashes{
#"""""""""""""""""< handle_arguments{ head Ver 4.1 >"""""""""""""""""""
for ($t=0; $t< @input; $t++){ $length=length($input[$t]) if(length($input[$t])>$length);}
if ($length < $window_size){ $window_size = $length; }
#___________ getting ratio for the whole sequence ___________
$compos_whole_seq=${&main::compos_id_percent_array(\@input)}; ## for whole composition rate
$seq_id_whole_seq=${&main::seq_id_percent_array(\@input)};
print "\nComposition ID of the alignment: $compos_whole_seq\%\n";
print "Sequence ID of the alignment: $seq_id_whole_seq\%\n";
if ($seq_id_whole_seq == 0){ $ratio_whole_seq =0; }
else{ $ratio_whole_seq = $compos_whole_seq/$seq_id_whole_seq; }
print "Composition and Sequ. ID Ratio: $ratio_whole_seq\n";
}
#####################################################################
## Getting Compos and Seq ids ##
#####################################################################
$compos_id=${&main::compos_id_percent_array(\@array_of_2_seq)};
$seq_id =${&main::seq_id_percent_array(\@array_of_2_seq)};
#####################################################################
#### Go back if the Seq id is bigger than Compos id #######
#####################################################################
$length=length($input[$t]) if (length($input[$t])>$length); }
if ($length < $window_size){ $window_size = $length; }
#___________ getting ratio for the whole sequence ___________
$compos_whole_seq=${&compos_id_percent_array(\@input)};
$seq_id_whole_seq=${&seq_id_percent_array(\@input)};
if ($seq_id_whole_seq == 0){ $ratio_whole_seq =$compos_whole_seq/10; }
else{ $ratio_whole_seq =$compos_whole_seq/$seq_id_whole_seq; }
#___________ getting ratio for each window sequence ___________
for ($w=0; $w < $length; $w++){
$offset = $w - int($window_size/2); # $offset starts from -5 when window_size is 10.
$offset=0 if ($offset < 0);
$window_1=substr($input[0], $offset, $window_size); # window_1 is one segment
$window_2=substr($input[1], $offset, $window_size); # of defined length(size)
@array_of_2_seq=($window_1, $window_2); # making an array like this = ('ABCDE', 'BDESA')
$compos_id=${&compos_id_percent_array(\@array_of_2_seq)};
$seq_id =${&seq_id_percent_array(\@array_of_2_seq)};
#print "\n offset = $offset Wind1 = $window_1 Wind2 = $window_2 ";
#print " Compos1 = $compos_id Seqid = $seq_id \n";
#______ Handle special case when $seqid is zero > the rate becomes $compos_id/10 ______
if (($seq_id == 0) && ($compos_id != 0)){ $ratio_compos_vs_seqid = $compos_id/10; }
# Example :
# Warning :
# Keywords : composition of chars, composition table making,
# make_composition, make composition table
# occurances_of_char, get_char_occurances, occurances
# get_percentage_occurances_of_char, percentage_occurances_of_char
# Options : 'p' for percentage output of the char among others
# 'n' for NO name option when HASH input is given
# Returns : one ref. of hash (a =>5, b=>6, c=>4,,,,,)
# Argument : one ref. of hash (seq1 alsdfjlsj
# seq2 asldfjsld
# seq3 owiurouou);
# Category :
# Version : 1.4
#--------------------------------------------------------------------
sub get_occurances_of_char{
my ($i, %H, $no_name, %out, $N,@splited, $val,$percentage_out,
$split, $sum);
for($i=0; $i< @_; $i++){
if($_[$i]=~/^[\-]?p$/i){
$percentage_out=1; splice(@_, $i, 1); $i--;
}elsif($_[$i]=~/^[\-]?n$/i){
$no_name=1; splice(@_, $i, 1); $i--;
}
}
}elsif( !(ref($_[$i])) ){
@splited = split(//, $_[$i]);
for $split (@splited){ $out{$split}++; $sum++ }
}
}
if($percentage_out==1){
my @keys=keys %out;
my %percent;
for($i=0; $i< @keys; $i++){
$percent{$keys[$i]} = $out{$keys[$i]}/$sum*100;
}
return(\%percent);
}else{
return(\%out);
}
}
}
#________________________________________________________________________
# Title : amino_acid_compos_id_percent
# Usage : $percent = &amino_acid_compos_id_percent (%any_hash_with_sequences);
# The way identity(composition) is derived is;
#
# Function : gets amino acid composition identity of any given
# number of sequences(at least 2).
# Example :
# Options :
# Argument : hash of at least 2 sequences.
# Category :
# Version : 1.1
#--------------------------------------------------------------------
sub amino_acid_compos_id_percent{
my(%input)= %{$_[0]};
my(@names)=keys (%input);
my(@temp, $i, $j, $iden, @all_pairs_id, $iden_sum);
my(%compos_table1, %compos_table2, $final_iden, $larger);
for ($i=0; $i < @names; $i ++){ # putting seqs in arrays.
$final_iden=$iden_sum/@all_pairs_id;
\$final_iden;
}
#________________________________________________________________________
# Title : seq_id_percent_array (more than 2 elements array)
# Usage : $percent = &seq_id_percent_array(@any_array_sequences);
# The way identity(pairwise) is derived is;
#
# Function : produces amino acid composition identity of any given number of sequences.
# Example :
# Warning : This can handle 'common gaps' in the sequences
# Keywords : get_percent_composition_identity, seq_composition_identity,
# percent_sequence_composition_id
#
# Options :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub seq_id_percent_array{
my(@input, $denominator,@all_pairs_id, $percent_id);
my($largest,$p,$i,$j,$k,$iden_residue_num,$iden,@temp,$iden_sum,$gap_num,$final_iden);
for($d=0; $d<@_; $d++){
if(ref($_[$d]) eq 'ARRAY'){ @input=@{$_[$d]}; }
elsif( (ref($_[$d]) eq 'SCALAR') &&( ${$_[$d]}=~/^[aA]/) ){ $average_len_opt =1 }
elsif( !(ref($_[$d])) && ( $_[$d] =~/^[aA]/) ){ $average_len_opt =1 } }
if ((@input== 1)||( @input== 0)){
print "\n\n \" $0 \" requires at least 2 sequences\n\n";
print "\n Abnormally dying at seq_id_percent_array in $0 \n\n";
print chr(7); exit;}
$shortest=length($input[0]);
my($sans_gap_seq, $length_sum, $average_seq_len);
for($p=0; $p < @input; $p++){
$input[$p]=~ tr/a-z/A-Z/;
$iden_residue_num++; }
elsif((${"string$i"}[$k] =~ /\W/)&&(${"string$i"}[$k]=~ /\W/)){ $gap_num++; }}
if( $average_len_opt == 1){ $denominator = $average_seq_len; }
else{ $denominator = $shortest; }
if($denominator == 0){ $denominator=1; } # in the above it is 50% rather than 0.07%
$percent_id=($iden_residue_num/($denominator))*100;
push(@all_pairs_id, $percent_id);
undef ($iden_residue_num, $gap_num);
}
}
for (@all_pairs_id){ $iden_sum+=$_; }
$final_iden=$iden_sum/($#all_pairs_id+1);
return( \$final_iden );
}
#________________________________________________________________________
# Title : compos_id_percent_array (more than 2 elements array)
# Usage : $percent = &compos_id_percent_array(@any_array_sequences);
# The way identity(composition) is derived is;
# Function : produces amino acid composition identity of any given number of sequences.
# Example :
# Warning :
# Keywords :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub compos_id_percent_array{
my(@input)=@{$_[0]};
my($largest,$iden,@temp,$iden_sum,$final_iden, @all_pairs_id);
for($i=0; $i<=$#input; $i++){ $input[$i]=~ tr/a-z/A-Z/; $input[$i]=~ s/[\.\-\s]//g;
@temp = split('', $input[$i]); (@{"string$i"})= @temp;
$largest = @{"string$i"} if @{"string$i"} > $largest; }
#-----------------------------------------------------
return ( \$final_iden ); # final identity for any given set of strings(seq).
}
#________________________________________________________________________________
# Title : compos_id_percent_hash (synonym of amino_acid_compos_id_percent)
# Usage : $percent = &compos_id_percent_hash(%any_hash_with_sequences);
# The way identity(composition) is derived is;
#
# Function : gets amino acid composition identity of any given number of sequences.
# Example :
# Warning :
# Returns :
# Argument :
# Category :
# Version : 1.0
#------------------------------------------------------------------------------
sub compos_id_percent_hash{ my(%input, @names);
if(ref($_[0]) eq 'HASH'){ %input= %{$_[0]}; @names= keys %input; }
else{ print "\n hash ref was not passed to compos_id_percent_hash\n"; exit; }
my(@temp, $iden, @all_pairs_id, $i, $j, $k,$iden_sum);
my(%compos_table1, %compos_table2, $final_iden, $larger);
for ($i=0; $i < @names; $i ++){ $input{$names[$i]}=~ tr/a-z/A-Z/;
$input{$names[$i]}=~ s/\W//g; @temp = split('', $input{$names[$i]});
(@{"string$i"})=@temp; $larger = @{"string$i"} if @{"string$i"}>$larger;}
# ('A', 290, 'C', 199, D, 100)
# uses only two sequences.
# Warning :
# Keywords :
# Options :
# Returns : ref. of a scaler (in percent) eg) 95
# Argument : two references of hash of seqeunces.
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub common_compos_id_hash{
# ('A', 290, 'C', 199, D, 100)
# uses only two sequences.
# Warning :
# Keywords :
# Options :
# Returns : ref. of a scaler (in percent) eg) 95
# Argument : two references of hash of seqeunces.
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub calc_compos_id_hash{ my(%hash1)=%{$_[0]}; my(%hash2)=%{$_[1]}; my(%common_of_the_2)=();
$sum_of_the_common_residue_no += $common; }
$compos_id = $sum_of_the_common_residue_no/($sum_residues/2)*100; }
\$compos_id;
}
#________________________________________________________________________
# Title : get_percentage
# Usage : %out= %{&get_percentage(\%result, '1')};
# Function : calculates the percentage content of any single char over the whole
# length of strings in it.
# Example : if the string is 'seq ABCDEEEEEFFEFE' given in a hash
# if you put 'A' as one argument, it counts the occurances of 'A'
# and gets the percentage of it.
# Warning : This converts array and string input as ref. into arbitrary hash and
# returns hash
# programmed by A Biomatic
# Keywords : get_percentage_of_char
# Options : None yet.
# Returns : Numerical Percentage
# Argument : ref. for Scalar string or Array of chars or Hash AND 'the target char'
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub get_percentage{
my(@in, $k, $sort, $numerator, $residue, @out_hash_ref, %hash_out );
for($k=0; $k< @_ ;$k++){
if( !ref($_[$k])&& (length($_[$k]) == 1 )){
$numerator = $_[$k];
}
for $name(@keys){
my($numerator_count);
my($seq_len) = length($H{$name}); print "\n $name Sequence length: ", $seq_len, "\n";
my(@string) = split(//, $H{$name});
for $residue (@string){ if($residue =~/^$numerator$/){ $numerator_count ++; }}
my($percent) = $numerator_count/$seq_len *100;
$hash_out{$name}=$percent; }
push(@out_hash_ref, \%hash_out); }
if(@out_hash_ref ==1){ return($out_hash_ref[0]); }
elsif( @out_hash_ref > 1){ return(@out_hash_ref); }
}
#________________________________________________________________________
# Title : pairwise_percent_id (pairwise sequence identity in percentage)
# Usage : $identity = ${&pairwise_percent_id(%arrayinput)};
#
# Function : takes a ref. of a hash of names and sequences, returns
# percent identity.
# Example :
# Warning :
# Keywords :
# Options :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub pairwise_percent_id{
my($i,$j,$k, @iden_array_ref);
for($i=0; $i< @_; $i++){ my %input= %{$_[$i]}; my @names= sort keys %input;
my(@temp, $iden, @all_pairs_id, $whole_seq_len, $residue_sum1,$residue_sum2);
my($final_av_iden, $larger, $percent_for_pair,@percent_for_pair, $iden_sum);
for ($i=0; $i < @names; $i ++){ $input{$names[$i]}=~ tr/a-z/A-Z/;
@temp = split('', $input{$names[$i]}); (@{"string$i"})=@temp;
$larger = @{"string$i"} if @{"string$i"} > $larger; }
for ($i=0; $i < @names; $i++){ # to make permutated pairs.
for ($j=$i+1; $j < @names; $j ++){
for ($k=0; $k < $larger; $k ++){ # getting composition tables for two seqs.
$iden+=2 if ((${"string$i"}[$k] eq ${"string$j"}[$k])&&(${"string$i"}[$k] =~ /\w/));
$residue_sum1++ if (${"string$i"}[$k] =~ /\w/);
$residue_sum2++ if (${"string$j"}[$k] =~ /\w/); }
$whole_seq_len =($residue_sum1+$residue_sum2);
$percent_for_pair = $iden/$whole_seq_len*100;
push(@percent_for_pair,$percent_for_pair);
$residue_sum1=0; $residue_sum2=0; $iden=0; } }
for $iden (@percent_for_pair){ $iden_sum+=$iden;}
$final_av_iden=$iden_sum/( @percent_for_pair );
push(@iden_array_ref, \$final_av_iden); }
if(@iden_array_ref ==1){ return($iden_array_ref[0]);}else{ return(@iden_array_ref);}
}
#________________________________________________________________________
# Title : get_seq_identity
# Usage : $identity = ${&get_seq_identity(%arrayinput)};
#
# Function : takes a ref. of a hash of names and sequences, returns
# percent identity. NOT composition identity.
# Example :
# Warning :
# Keywords : get_sequence_identity
# Options :
my($i,$j,$k, $c, @iden_array_ref);
for($c=0; $c< @_; $c++){
my %input= %{$_[$c]};
my @names= sort keys %input;
my(@temp, $iden, @all_pairs_id, $whole_seq_len, $residue_sum1,$residue_sum2);
my($final_av_iden, $larger, $percent_for_pair,@percent_for_pair, $iden_sum);
for ($i=0; $i < @names; $i ++){
$input{$names[$i]}=~ tr/a-z/A-Z/;
@temp = split(//, $input{$names[$i]});
@{"string$i"}=@temp;
$larger = @{"string$i"} if @{"string$i"} > $larger; }
}
$residue_sum1++ if (${"string$i"}[$k] =~ /\w/);
$residue_sum2++ if (${"string$j"}[$k] =~ /\w/);
}
$whole_seq_len =($residue_sum1+$residue_sum2);
$percent_for_pair = $iden/$whole_seq_len*100;
push(@percent_for_pair,$percent_for_pair);
$residue_sum1=0;
$residue_sum2=0;
$iden=0;
}
}
for $iden (@percent_for_pair){
$iden_sum+=$iden;
}
if(@percent_for_pair <1){ @percent_for_pair=(1); }
$final_av_iden=$iden_sum/( @percent_for_pair );
push(@iden_array_ref, \$final_av_iden);
}
if(@iden_array_ref ==1){
return($iden_array_ref[0]);
}else{
#________________________________________________________________________
# Title : get_correct_percent_alignment_rate (made for Bissan)
# Usage : &get_correct_percent_alignment_rate(\$file1, \$file2);
# Function : accepts two files and prints out the sequence identities of the alignment.
# Example :
# Warning : Alpha version, A Biomatic , made for Bissan
# Keywords :
# Options : h # for help
# v # for verbose printouts(prints actual sequences)
# Returns : reference of Scalar for percentage correct alignment(for already
# aligned sequences)
# Argument : two sequence files which have identical sequence names.
# Category :
# Version :
#--------------------------------------------------------------------
sub get_correct_percent_alignment_rate{
my($i, $j, $k, $verbose, @string1, @string2, $larger, $seq_pair_id, @seq_pair_ids );
my(%inputhash1) = %{&read_any_seq_files($_[0])};
my(%inputhash2) = %{&read_any_seq_files($_[1])};
my(@names)= sort keys %inputhash1;
######################################
elsif(@seq_pair_ids > 1){ return( \@seq_pair_ids ); }
}
#________________________________________________________________________
# Title : amino_acid_compos_id_percent_trend
# Usage :
# Function :
# Example :
# Warning :
# Keywords :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub amino_acid_compos_id_percent_trend{
my(%input) = %{$_[0]};
my(@common, @string,@accumu_percent_iden)=(); my(%common_so_far, %compos_table);
my($percent_id_so_far, $length_of_one_seq,$length_of_all_seq, $seq_no)=0;
for $key(keys %input){
$input{$key}=~s/[. \d-]//g;
@string= split(//, $input{$key});
print @string; print "\n";
$length_of_one_seq = $#string+1;
%compos_table = &composition_table(@string);
@check = keys (%common_so_far);
if ($#check < 0){ %common_so_far = %compos_table; }
else{ %common_so_far= %{&common_compos_2_hash(\%common_so_far,\%compos_table)};}
for $value(values %common_so_far){ $common_residue_sum +=$value; }
$final_percent_id = $common_residue_sum/($length_of_all_seq/$seq_no)*100;
$common_residue_sum =0; }
for $value(values %common_so_far){ $common_residue_sum +=$value; }
$final_percent_id = $common_residue_sum/($length_of_all_seq/$seq_no)*100;
return(\$final_percent_id);
}
#________________________________________________________________________
# Title : composition_table (can handle both nucleic and protein seq)
# Usage : %output = %{&compos_table(@input_array1, @input_array2,,,,)};
\%common_of_the_2;
}
#________________________________________________________________________
# Title : pair_percent_id_trend
# Usage : @array = &pair_percent_id_trend (%arrayinput);
# Function :
# Example : common gaps means only '.' (dots, not alphabets!!)
# AAA....BBCB
# AAAB..B.BCC --> A.A.....BC. (as in an array)
# A.AAA...BCA
# Returns :
# Argument :
# Category :
# Version :
#--------------------------------------------------------------------
sub pair_percent_id_trend{
my(%input) = %{$_[0]};
my(@common, @string,@accumu_percent_iden)=();
my($percent_id_so_far)=0;
for $key(keys %input){
my($len) = &smaller_one($#common, $#string) unless $#common < 0;
$input{$key}=~s/ //g;
@string= split(//, $input{$key});
$length_of_one_seq = $#string+1;
$common[$k]='.';
}
}
$num_of_iden_char = &count_num_of_char(\@common);
$av_seq_no = $length_of_all_seq/$seq_no;
$percent_id_so_far = $num_of_iden_char/$av_seq_no*100;
print "\n percent_id so far = $percent_id_so_far \n";
push(@accumu_percent_iden,$percent_id_so_far);
} # end of for (after all sequences have been run).
$num_of_iden_char = &count_num_of_char(@common);
$av_seq_no = $length_of_all_seq/$seq_no;
$percent_id_so_far = $num_of_iden_char/$av_seq_no*100;
print "\n percent_id so far = $percent_id_so_far \n";
\@accumu_percent_iden; # final ids array.
}
#________________________________________________________________________
# Title : smaller_one
# Usage : $smaller = & smaller_one($var, $var2);
#
# Version :
#--------------------------------------------------------------------
sub count_num_of_char{
my(@input)={$_[0]};
my($num_of_char)=0;
for $elem(@input){ # this is for the percentage of TWO seqs.
if ($elem =~ /\w/){
$num_of_char +=1;
}
}
$num_of_char;
#
# Warning :
# Keywords : open_prd_files, open_pred_files, predator, open_prdl_files
# open_pre_files, secondary structure prediction file
# Options : 's' for sequence output as well (\%sec_str, \%seq)
# 'p' for percentage of the sec. str.
# 'a' for accumulated percentage. This will
# set 'p' automatically
# 'n' for NO name when outputing Percentage of chars with
# HASH input to get_occurances_of_char sub.
# $reverse_residue_order=r by r
# Returns :
my($i,$j,$c,$d,$e,$f,$g,$h,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u,$v,$w,$x,$y,$z);
if($debug==1){print "\n\t\@hash=\"@hash\"
\@raw_string=\"@raw_string\"\n\t\@array=\"@array\"\n\t\@num_opt=\"@num_opt\"
\@char_opt=\"@char_opt\"\n\t\@file=\"@file\"\n\t\@string=\"@string\"\n" }
#""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
my( @out_ref, $seq_out, %sec_str, %seq, $percent_out, $NO_name_out,
$short_form_out_detected, $long_form_out_detected, $accumulate,
$reverse_residue_order, %rev_sec_str);
if($char_opt=~/s/i){ $seq_out=1 }
if($char_opt=~/a/i){ $accumulate=1 }
if($char_opt=~/p/i){ $percent_out=1 }
if($char_opt=~/n/i){ $NO_name_out='n' }
if($char_opt=~/r/){ $reverse_residue_order='r' }
for($i=0; $i< @file; $i++){
my (%sec_str, %seq) if($accumulate !=1);
}
}
close (PREDATOR_FILE);
print "\n \%sec_str is: ", %sec_str, "\n" if ($debug == 1);
if($seq_out==1){ push(@out_ref, \%sec_str, \%seq);
}elsif($percent_out==1 ){
push(@out_ref, [%{&get_occurances_of_char(\%sec_str, $NO_name_out, 'p')}] );
}elsif($percent_out !=1){ push(@out_ref, \%sec_str) }
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`
# If -r option is set (for long form, this does not affect
#____________________________________________________________
if($short_form_out_detected and $reverse_residue_order){
# TTTTTTTTTTTFFFFFFFFFFFFFFTTTTTTTTTTTTTTTTTFTT-TTTTFFFFFTFFTTTFTTTFFTTFTFTFF
# >P1;1cdg
# DSSP
# CCCCCCCCCCCCCCCCEEECCHHHHCCCCGGGCCCGGGCCCCCCC-CCCCCCCCHHHHHHHHHCCHHHHHCCCEE
# >P1;1cdg
# percentage accessibility
# 67523272360000000000000002213792129b722248085-14110000030015105660028040200
# 2ltn ----TETTSFLITKFSPDQQNLIFQGDGYTT-KEKLTLTK------AVKNTVGRALYSSP
# 1loe ----TETTSFSITKFGPDQQNLIFQGDGYTT-KERLTLTK------AVRNTVGRALYSSP
#
# 2ltn ----CEEEEEEECCCCCCCCCEEEEPCCEEP-PPCEEEEC------CCCPCEEEEEECCC
%hash, @keys, @array, @hash, $option_string, $string, @in, $line,
$name, %out, $gap_chr, @str1, @str2, $num_opt, @file, @dir,
$char_opt, $char_opt_given, $num_opt_given,
@char_options, @file, $original_dir, @read_files, %array_msf, %array_jp,
$jp_file, $error_rate, $id_compos, @dir, @names, $name, $name_found,
@outref, %sequence, %secondary,%solvent_access, %DSSP, %percent_accessibility,
$name_found,$type_seq, $type_secon, $type_sol, $type_DSSP, $type_acc
);
##################################################
##### Start of general argument handling ######
##################################################
}elsif(($type_sol ==1)&&(/^([\w\-]+)[\*]*$/)){
$solvent_access{$name}.=$1; #from below========= DSSP
}elsif(/^DSSP/){ $type_DSSP = 1;
}elsif(($type_DSSP ==1)&&(/^([\w\-]+)[\*]*$/)){
$DSSP{$name}.=$1; #from below=================== PERCENTAGE ACCESSIBILITY
}elsif(/^percentage accessibility/){ $type_acc = 1;
}elsif(($type_acc ==1)&&(/^([\w\-]+)[\*]*$/)){
$percent_accessibility{$name}.=$1; } }
push(@outref,\%sequence,\%secondary,\%solvent_access,\%DSSP,\%percent_accessibility);
} }
if( ($char_opt =~ /s/i) || ( @outref == 1 ) ){
return(\%sequence); }
elsif( @outref > 1){ return(@outref); } # <-- contains (\%sequence,\%secondary,....)
}
# %array_msf =&open_msf_files($realfile1);
# %array_jp =&open_jp_files ($jp_file);
# $array_ref_msf = \%array_msf;
# $array_ref_jp = \%array_jp;
# $error_rate =&get_posi_shift_hash($array_ref_msf, $array_ref_jp);
# $id_compos =&amino_acid_compos_id_percent($array_ref_jp);
# push(@rates_accumu,$error_rate);
# push(@compos_id,$id_compos);
}
}
else
&caller_info;
}
\$id_counter; # $id_counter is the homology counter;
}
#________________________________________________________________________
# Title : get_percent_homol_arr
# Usage : $homology_out = ${&get_pair_homol(\@any_array_of_2_elem)};= @ar=(ABCDE..., CDEGA..)
# Function : get pair wise seq. identity of any two strings, outputs a scalar (%)
# Example :
# Warning : reliable, but input seq. strings shouldn't contain spaces.
# Keywords :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub get_percent_homol_arr{
my(@input)=@{$_[0]};
$input[0] =~ tr/a-z/A-Z/; # capitalizing.
$input[1] =~ tr/a-z/A-Z/; # capitalizing.
my(@string1)= split(//,$input[0]);
my(@string2)= split(//,$input[1]);
if (($#string1 == -1) || ($#string2 == -1)){
print "\n One of the string is empty O.K. ? \n";
}
my($larger)= &max($#string1, $#string2);
my($id_counter, $gap_counter, $non_equal_counter, $sum,$percent_homol)=0;
for ($i = 0; $i<=$larger; $i++){
if (($string1[$i] eq '.')|| ($string2[$i] eq '.')){
$gap_counter+=1;
}elsif ($string1[$i] eq $string2[$i]){
$id_counter +=1;
$sum = ($id_counter + $gap_counter + $non_equal_counter);
if ($sum != ($larger+1)){
print "\n There is something wrong in getting homology in get_pair_homol \n";
&caller_info;
}else{
$percent_homol=($id_counter/$sum)*100;
}
return(\$percent_homol); # $id_counter is the homology counter;
}
#________________________________________________________________________
# Title : get_pair_homol_hash
# Usage : $homology_out = & get_pair_homol (%any_hash); , eg) %hash = (name1, ABCDE..., name2, CDEGA..)
&caller_info;
}
return ($id_counter); # $id_counter is the homology counter;
}
#________________________________________________________________________
# Title : get_percent_homo_hash
# Usage : $homology_out = &get_pair_homol_hash(%any_hash); , eg) %hash = (name1, ABCDE..., name2, CDEGA..)
# Function : get pair wise seq. identity(%) of any two strings put in as a hash
# Example :
# Warning : reliable, but input seq. strings shouldn't contain spaces.
# Keywords :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub get_percent_homo_hash{
my(%input)=@_;
&hash_chk(\%input);
my(@keys_input)= keys (%input);
my(@values_input) = values (%input);
$values_input[0] =~ tr/a-z/A-Z/; # capitalizing.
my(@string2)= split(//,$values_input[1]);
if (($#string1 == -1) || ($#string2 == -1)){
print "\n One of the string is empty O.K. ? \n";
}
my($larger)= &max($#string1, $#string2);
my($id_counter, $gap_counter, $non_equal_counter,$percent_homol,)=0;
for ($i = 0; $i<=$larger; $i++){
if (($string1[$i] eq '.')|| ($string2[$i] eq '.')){
$gap_counter+=1;
}elsif ($string1[$i] eq $string2[$i]){
$id_counter +=1;
my($sum) = ($id_counter + $gap_counter + $non_equal_counter);
if ($sum != ($larger+1)){
print "\n There is something wrong in getting homology in get_pair_homol \n";
&caller_info;
}else{
$percent_homol=($id_counter/$sum)*100;
}
return ($percent_homol);
}
#________________________________________________________________________
# Title : file_size
sub file_size { my($infile)=$_[0];
if ( $size=(-s "$infile")){ return $size; }
}
#________________________________________________________________________
# Title : seq_comp_percent2
# Usage : @outarray = &seq_comp_percent2(@any_input_string_array);
# Function : get string seq COMPOSITION identities(a to z). gets array
# of strings and outs array of % numbers
# Example :
# Warning :
# Keywords :
# Returns :
# Argument :
# Category :
# Version : 1.0
#--------------------------------------------------------------------
sub seq_comp_percent2{ # simple and basic seq. id. eg. ABC on ABCABC is 50 % identical.
my(@input)=@_;
my(@array_of_ids2, $id2, @char1, @char2);
&array_chk(sort @input);
my($longest_str_size) = &get_long_str_size (@input), "\n";
my($shortest_str_size) = &get_short_str_size(@input), "\n";
print $cls;
}
#________________________________________________________________________
# Title : seq_comp_percent1
# Usage : @outarray = &seq_comp_percent1(@any_input_string_array);
# Function : get string seq identities(a to z). gets array of strings and outs array of % numbers
# Example :
# Warning :
# Keywords :
# Options :
# Returns : one ref. of an array
# Argument : one ref. of an array
# Category :
# Version :
#--------------------------------------------------------------------
sub seq_comp_percent1{ # this is affected by seq. length
my(@input)=@{$_[0]};
my(@array_of_ids1, $id1, @char1, @char2);
&array_chk(\@input);
@input = sort (@input);
$longest_str_size = &get_long_str_size (@input), "\n";
last;
}
}
}
$identity = $sum_of_same*2/(&sum_array(@num_char1,@num_char2))*100;
# print "percent iden = ", $identity, "\n";
}
#________________________________________________________________________
# Title : get_id_among_2_2
# Usage : $id = &get_id_among_2(*charcount1, *charcount2) <- hashes
# Function : gets the % id of any two sequences, returns in 100.0% format.
}
$seq1=&sum_array(@num_char1);
$seq2=&sum_array(@num_char2);
$longer_seq = &max($seq1, $seq2);
$identity = $sum_of_same/$longer_seq*100;
#print "percent iden = ", $identity, "\n";
}
#________________________________________________________________________
# Title : array_average
# Usage : $output = &array_average(\@any_array);
$range_stop, @files_NOT_processed);
my $source_db_fasta=$ENV{'NRDB_FASTA'}; ## general default
my $evalue_thresh=0.001; # default
my $score_thresh=70; # default
my $range_thresh=10;
my $percent_id_thresh=0.95;
print "\n# (i) Running sub of: make_intermediate_sequence_library\n";
if($vars{'FASTA_DB'}=~/\S+/){ $source_db_fasta=$vars{'FASTA_DB'} }
if($vars{'MSP_DIR'}=~/\S+/){ $msp_seq_file_dir=$vars{'MSP_DIR'} }
if($vars{'p'}=~/\S+/){ $pdbg_file=$vars{'p'}; print "\n# (i) $vars{'p'} is given \n"; } ## PDBG file input
for($j=0; $j< @pdbd_seqs; $j++){
$pdbd_seq=$pdbd_seqs[$j];
$pdbd_seq_long="pdb\_$pdbd_seqs[$j]";
my (@msp_content, $evalue, $sub_dir, $percentage_id, $range_length);
if($pdbd_seq=~/^ *$/){ next; }
$msp_file="$pdbd_seq\.msp";
$msp_file_gz="$pdbd_seq\.msp\.gz";
$msp_file_long="pdb\_$pdbd_seq\.msp"; ## this is to handle Sarah's pdb_ prefixed pdbd files
#_______________________________________________________________________________________
my ($identical_one_added, $interm_seq);
for($k=0; $k< @msp_content; $k++){ ## NEW MSP format
if($msp_content[$k]=~/^ *(\S+) +(\S+) +(\S+) +\d+ +\d+ +[pdb_]*$pdbd_seq[_\d+\-\d+]* +(\d+) +(\d+) +(\S+)/){ # [pdb_]* is for Sarah's pdb_ prefix
#if($pdbd_seq eq $6){ next } ## this is to exclude the same seq match
$evalue=$2; $percentage_id=$3;
$range_length=$5-$4; $score =$1; $interm_seq=$6; $range_start=$4, $range_stop=$5;
if($interm_seq=~/(\S+)_\d+\-\d+/){ $interm_seq=$1; }
if($evalue < $evalue_thresh and $range_length > $range_thresh and $score > $score_thresh){
if($percentage_id <= $percent_id_thresh){ ## to keep one pdb seq ($percentage_id=1)
unless($interm_seq=~/^d\d\S/){ # to remove entries like: d1abc_10-20_d2acb__ (two pdb seqs)
$interm_hash{$superfamily} .=" $interm_seq\_$range_start\-$range_stop\_$pdbd_seq";
}
}elsif($percentage_id ==1 and $identical_one_added < 1){ ## this is to prevent more than 1 100% id seq
$interm_hash{$superfamily} .=" $interm_seq\_$range_start\-$range_stop\_$pdbd_seq";
$identical_one_added++;
}
}
}elsif($msp_content[$k]=~/^ *(\d+) +(\S+) +\d+ +\d+ +$pdbd_seq +(\d+) +(\d+) +(\S+)/){
Bitcoin-RPC-Client
view release on metacpan or search on metacpan
ex/example.pl view on Meta::CPAN
print $timeframe;
print "\n";
# 86400
# JSON arrays
# Let's say we want the feerate_percentiles from getblockstats
# https://developer.bitcoin.org/reference/rpc/getblockstats.html
#{
# "avgfee": 8967,
# "avgfeerate": 28,
# "feerate_percentiles": [1,1,3,62,65],
# "height": 584240,
# "maxfee": 850011
#}
$bstats = $btc->getblockstats(584240);
@fps = @{ $bstats->{feerate_percentiles} };
foreach $fr (@fps) {
print $fr;
print "\n";
}
# 1
BlueCoat-SGOS
view release on metacpan or search on metacpan
t/sysinfos/ProxySG-4006060000--20090307-165730UTC.sysinfo view on Meta::CPAN
Stat: CPU Utilization
Current State : OK
Last Transition : Fri, 06 Mar 2009 19:23:14 UTC
Current Value : 1
Unit of Measurement : percent
Warning Threshold : 80
Warning Interval : 120
Critical Threshold : 95
Critical Interval : 120
Notification Method : log
Stat: Memory Utilization
Current State : OK
Last Transition : Fri, 06 Mar 2009 19:23:14 UTC
Current Value : 31
Unit of Measurement : percent
Warning Threshold : 90
Warning Interval : 120
Critical Threshold : 95
Critical Interval : 120
Notification Method : log
Stat: Interface 0:0 Utilization
Current State : OK
Last Transition : Fri, 06 Mar 2009 19:23:14 UTC
Current Value : 0
Unit of Measurement : percent
Warning Threshold : 60
Warning Interval : 120
Critical Threshold : 90
Critical Interval : 120
Notification Method : log
Stat: Interface 0:1 Utilization
Current State : OK
Last Transition : Fri, 06 Mar 2009 19:23:14 UTC
Current Value : 0
Unit of Measurement : percent
Warning Threshold : 60
Warning Interval : 120
Critical Threshold : 90
Critical Interval : 120
Notification Method : log
t/sysinfos/ProxySG-4006060000--20090307-165730UTC.sysinfo view on Meta::CPAN
syslogMask: 243
nextClientId: 1
activeStreams: 0
logIp: 0.0.0.0
cache blocks: 45001
memory usage: 0 percent
cpu 0 usage: 82 percent
Worker counts:
MMS client: 0
MMS server: 0
HTTP client: 0
Book-Collate
view release on metacpan or search on metacpan
lib/Book/Collate/Report.pm view on Meta::CPAN
}
=head2 _generate_fry_stats
Gives a percentage of Fry list words used against the total unique words used.
=cut
sub _generate_fry_stats {
my $self = shift;
Boost-Geometry-Utils
view release on metacpan or search on metacpan
src/boost/test/floating_point_comparison.hpp view on Meta::CPAN
// ************************************************************************** //
// ************** tolerance presentation types ************** //
// ************************************************************************** //
template<typename FPT>
struct percent_tolerance_t {
explicit percent_tolerance_t( FPT v ) : m_value( v ) {}
FPT m_value;
};
//____________________________________________________________________________//
template<typename Out,typename FPT>
Out& operator<<( Out& out, percent_tolerance_t<FPT> t )
{
return out << t.m_value;
}
//____________________________________________________________________________//
template<typename FPT>
inline percent_tolerance_t<FPT>
percent_tolerance( FPT v )
{
return percent_tolerance_t<FPT>( v );
}
//____________________________________________________________________________//
template<typename FPT>
src/boost/test/floating_point_comparison.hpp view on Meta::CPAN
// Public typedefs
typedef bool result_type;
// Constructor
template<typename ToleranceBaseType>
explicit close_at_tolerance( percent_tolerance_t<ToleranceBaseType> tolerance,
floating_point_comparison_type fpc_type = FPC_STRONG )
: p_fraction_tolerance( tt_detail::fpt_abs( static_cast<FPT>(0.01)*tolerance.m_value ) )
, p_strong_or_weak( fpc_type == FPC_STRONG )
, m_report_modifier( 100. )
{}
src/boost/test/floating_point_comparison.hpp view on Meta::CPAN
// Public typedefs
typedef bool result_type;
template<typename FPT1, typename FPT2, typename ToleranceBaseType>
predicate_result
operator()( FPT1 left, FPT2 right, percent_tolerance_t<ToleranceBaseType> tolerance,
floating_point_comparison_type fpc_type = FPC_STRONG ) const
{
// deduce "better" type from types of arguments being compared
// if one type is floating and the second integral we use floating type and
// value of integral type is promoted to the floating. The same for float and double
Boost-Graph
view release on metacpan or search on metacpan
include/boost/test/floating_point_comparison.hpp view on Meta::CPAN
public:
// Public typedefs
typedef bool result_type;
// Constructor
explicit close_at_tolerance( PersentType percentage_tolerance, floating_point_comparison_type fpc_type = FPC_STRONG )
: p_fraction_tolerance( static_cast<FPT>(0.01)*percentage_tolerance ), p_strong_or_weak( fpc_type == FPC_STRONG ) {}
bool operator()( FPT left, FPT right ) const
{
FPT diff = tt_detail::fpt_abs( left - right );
FPT d1 = tt_detail::safe_fpt_division( diff, tt_detail::fpt_abs( right ) );
include/boost/test/floating_point_comparison.hpp view on Meta::CPAN
// Public typedefs
typedef bool result_type;
template<typename FPT, typename PersentType>
bool
operator()( FPT left, FPT right, PersentType percentage_tolerance, floating_point_comparison_type fpc_type = FPC_STRONG )
{
close_at_tolerance<FPT,PersentType> pred( percentage_tolerance, fpc_type );
return pred( left, right );
}
};
Bot-Backbone-Service-Fact
view release on metacpan or search on metacpan
lib/Bot/Backbone/Service/Fact/Keyword.pm view on Meta::CPAN
alice> !forget_keyword bot
=head1 DESCRIPTION
Allows members of the chat to establish a set of keywords that the bot can
respond to a configurable percentage of the time. Each keyword can have more
than one response associated with it, in which case, a response is chosen at random.
=head1 DISPATCHER
=head2 !keyword
Bot-BasicBot-Pluggable-Module-Fun
view release on metacpan or search on metacpan
lib/Bot/BasicBot/Pluggable/Module/Nickometer.pm view on Meta::CPAN
return unless $body =~ /^\s*(?:lame|nick)-?o-?meter(?: for)? (\S+)/i;
my $term = $1; $term = $who if (lc($term) eq 'me');
my $percentage = percentage($term);
if ($percentage =~ /NaN/) {
$percentage = "off the scale";
} else {
# $percentage = sprintf("%0.4f", $percentage);
$percentage =~ s/\.0+$//;
$percentage .= '%';
}
return "'$term' is $percentage lame, $who";
}
sub help {
return "Commands: 'nickometer <nick>'";
}
sub percentage {
local $_ = shift;
my $score = 0;
# Deal with special cases (precede with \ to prevent de-k3wlt0k)
lib/Bot/BasicBot/Pluggable/Module/Nickometer.pm view on Meta::CPAN
my $remains_length = length($remains);
$score += (50 * $remains_length + slow_pow(9, $remains_length)) if $remains;
# Use an appropriate function to map [0, +inf) to [0, 100)
my $percentage = 100 *
(1 + tanh(($score-400)/400)) *
(1 - 1/(1+$score/5)) / 2;
my $digits = 2 * (2 - &round_up(log(100 - $percentage) / log(10)));
return sprintf "%.${digits}f", $percentage;
}
sub case_shifts ($) {
# This is a neat trick suggested by freeside. Thanks freeside!
Bot-BasicBot-Pluggable-Module-Notes
view release on metacpan or search on metacpan
root/js/jquery-ui-1.7.2.custom.min.js view on Meta::CPAN
* http://docs.jquery.com/UI/Effects/Scale
*
* Depends:
* effects.core.js
*/
(function(a){a.effects.puff=function(b){return this.queue(function(){var f=a(this);var c=a.extend(true,{},b.options);var h=a.effects.setMode(f,b.options.mode||"hide");var g=parseInt(b.options.percent,10)||150;c.fade=true;var e={height:f.height(),widt...
* jQuery UI Effects Slide 1.7.2
*
* Copyright (c) 2009 AUTHORS.txt (http://jqueryui.com/about)
* Dual licensed under the MIT (MIT-LICENSE.txt)
* and GPL (GPL-LICENSE.txt) licenses.
Bot-BasicBot-Pluggable-Module-ReviewBoard
view release on metacpan or search on metacpan
lib/Bot/BasicBot/Pluggable/Module/ReviewBoard.pm view on Meta::CPAN
* user_rb_url - Review Board URL
* user_field_not_set - This will replace the value when a field doesn't have a value in RB
* user_input_regexp - The regexp that messages will be tested against, must include at least one named closure called "rb" that match the RB number.
%RB_URL% will be replaced by the value from user_rb_url.
Default: rb (?:\#|\s)? (?<rb>\d+) | %RB_URL%/r/(?<rb>\d+)
* user_output_message - The formatted output message. Words between two percent signs (e.g. %BRANCH%) will replaced with the data from RB. The following fields are available:
RB_URL ID SUBMITTER GROUPS BRANCH BUGS_CLOSED SUMMARY TIME_ADDED LAST_UPDATED REPOSITORY DESCRIPTION PUBLIC PEOPLE TESTING_DONE.};
}
sub _get_rb_data {
my ($self, $rb) = @_;
lib/Bot/BasicBot/Pluggable/Module/ReviewBoard.pm view on Meta::CPAN
This will replace the value when a field doesn't have a value in RB.
=item user_output_message
The formatted output message.
Tags between two percent signs (e.g. %BRANCH%) will replaced with
the data from RB. The following tags are available:
=over
=item RB_URL
Bot-BasicBot-Pluggable-Module-Tools
view release on metacpan or search on metacpan
lib/Bot/BasicBot/Pluggable/Module/Maths.pm view on Meta::CPAN
$loc =~ s/\bdiv(ided by)? /\/ /g;
$loc =~ s/\bover /\/ /g;
$loc =~ s/\bsquared/\*\*2 /g;
$loc =~ s/\bcubed/\*\*3 /g;
$loc =~ s/\bto\s+(\d+)(r?st|nd|rd|th)?( power)?/\*\*$1 /ig;
$loc =~ s/\bpercent of/*0.01*/ig;
$loc =~ s/\bpercent/*0.01/ig;
$loc =~ s/\% of\b/*0.01*/g;
$loc =~ s/\%/*0.01/g;
$loc =~ s/\bsquare root of (\d+)/$1 ** 0.5 /ig;
$loc =~ s/\bcubed? root of (\d+)/$1 **(1.0\/3.0) /ig;
$loc =~ s/ of / * /;
( run in 0.660 second using v1.01-cache-2.11-cpan-05162d3a2b1 )