view release on metacpan or search on metacpan
lib/Binary/Heap/Search.pm view on Meta::CPAN
{my $z = 'BinaryHeapSearch.zip';
print for qx(zip $z $0 && aws s3 cp $z s3://AppaAppsSourceVersions/$z && rm $z);
}
#1 Methods
sub new($) # Create a new Binary Search-able Heap
{my ($compare) = @_; # Sub to perform <=> on two elements of the heap
return bless {compare=>$compare};
}
sub arrays {$_[0]{arrays} //= []} ## Each array in the heap is in the order created by compare
sub compare {$_[0]{compare}} ## A sub that performs <=>/cmp on any two elements on the heap
sub size {scalar @{$_[0]->heaps}} ## Number of arrays in the heap
sub mergeArrays($$$) ## Merge two ordered arrays to make a new ordered array
{my ($compare, $b, $c) = @_; # Sub to order elements, first array of elements to be merged, second array of elements to be merged
my @a;
while(@$b and @$c) # Sequentially merge the two arrays
{my $k = $compare->($$b[0], $$c[0]); # Compare the smallest elements in each array
if ($k < 0) {push @a, shift @$b} # Save smallest element
lib/Binary/Heap/Search.pm view on Meta::CPAN
else {confess "Duplicate entry ", dump($$b[0])}
}
@a, @$b, @$c # Add remaining un-merged elements, the order does not matter because one of the arrays will be emptied by the preceding merge
}
sub mergeAdjacentArrays($$$) ## Merge adjacent arrays
{my ($arrays, $compare, $start) = @_; # Index of first array to be merged
for my $small(reverse 1..$start) # Each array that might be merge-able
{my $b = $arrays->[$small-1]; # Larger array
my $c = $arrays->[$small-0]; # Smaller array
lib/Binary/Heap/Search.pm view on Meta::CPAN
}
}
$#$arrays = 0; # All the arrays have been merged into just one array
}
sub add($$) # Add an element to the heap of ordered arrays
{my ($heap, $element) = @_; # Heap, element (that can be ordered by compare)
my $compare = $heap->compare;
my $arrays = $heap->arrays;
for my $arrayIndex(0..$#$arrays) # Try to put the element on top of one of the existing arrays starting at the largest one. We could of course just add the new element as a single array at the end and t...
lib/Binary/Heap/Search.pm view on Meta::CPAN
}
push @$arrays, [$element]; # Cannot put element on top of any array in the heap so create a new array
mergeAdjacentArrays($arrays, $compare, $#$arrays) if $#$arrays; # Try to merge the newest array if there is an existing array into which to merge it
}
sub binarySearch($$$) ## Find an element in an array using binary search
{my ($array, $compare, $element) = @_; # Array, element
my $m = 0; # Check the lower bound of the array
my $e = $array->[$m]; # Lowest element in the array
my $c = $compare->($element, $e); # Compare with lowest element in the array
return $e if $c == 0; # Equal to the lowest element
lib/Binary/Heap/Search.pm view on Meta::CPAN
($c == 1 ? $m : $M) = $i;
} # Continue to narrow the range
undef # Not found
}
sub find($$) # Find an element in the heap
{my ($heap, $element) = @_; # Heap, element (that can be ordered by compare)
my $compare = $heap->compare;
my $arrays = $heap->arrays;
for my $array(@$arrays) # Use a binary search on each array in the heap
lib/Binary/Heap/Search.pm view on Meta::CPAN
{my ($a, $b) = @_;
defined($a) && defined($b) or confess;
$a cmp $b
};
sub newHeap($$)
{my ($string, $result) = @_;
my $h = Binary::Heap::Search::new($compare);
$h->add($_) for split //, $string;
my $dump = dumpHeap($h);
# say STDERR "newHeap(\'$string\', \'$dump\');";
ok $dump eq $result;
$h
}
sub dumpHeap($)
{my ($h) = @_;
join ',', map {join '', @$_} @{$h->arrays}
}
newHeap('0', '0') ; # Ascending
view release on metacpan or search on metacpan
lib/Bio/BPWrapper.pm view on Meta::CPAN
Show program name and version and exit
=cut
sub print_version($)
{
my $program = shift;
say "${program}, version $Bio::BPWrapper::VERSION";
exit;
}
lib/Bio/BPWrapper.pm view on Meta::CPAN
=back
=cut
sub common_opts($)
{
my $opts = shift;
pod2usage(1) if $opts->{"help"};
pod2usage(-exitstatus => 0, -verbose => 2) if $opts->{"man"};
}
view release on metacpan or search on metacpan
t/Phylogeny/phylonode.t view on Meta::CPAN
use Test::More;
use Bio::Chado::Schema::Test;
# shorthand for writing left and right indices
sub lr($$) { left_idx => shift, right_idx => shift }
my $schema = Bio::Chado::Schema::Test->init_schema();
my $phylotree_rs = $schema->resultset('Phylogeny::Phylotree');
my $phylonodes_rs = $schema->resultset('Phylogeny::Phylonode');
$phylonodes_rs->delete;
view release on metacpan or search on metacpan
lib/Bio/ConnectDots/DotTable.pm view on Meta::CPAN
print OUT "</DotTable>\n";
close(OUT);
}
sub _encode() {
my ($string) = @_;
$string = encode_entities($string);
$string =~ s/\'/'/g;
return $string;
}
view release on metacpan or search on metacpan
lib/Bio/DB/Das/Chado/Segment.pm view on Meta::CPAN
level prefetch, we will need to refactor features and _features2level
to avoid code duplication
=cut
sub _features2level(){
my $self = shift;
warn "Segment->_features2level() args:@_\n" if DEBUG;
my ($types,$type_placeholder,$attributes,$rangetype,$iterator,$callback,$base_start,$stop,$feature_id,$factory);
view release on metacpan or search on metacpan
lib/Bio/DB/NextProt.pm view on Meta::CPAN
$self->{_format} = "json";
bless($self, $class);
return $self;
}
sub search_protein() {
my $self = shift;
my %param = @_;
my $path = "/rest/protein/list";
lib/Bio/DB/NextProt.pm view on Meta::CPAN
return $self->{_client}->responseContent();
}
sub search_cv() {
my $self = shift;
my %param = @_;
my $path = "/rest/cv/list";
lib/Bio/DB/NextProt.pm view on Meta::CPAN
return $self->{_client}->responseContent();
}
sub get_protein_info() {
my $self = shift;
my %param = @_;
my $path = "/rest/entry/";
lib/Bio/DB/NextProt.pm view on Meta::CPAN
return $self->{_client}->responseContent();
}
sub get_isoform_info() {
my $self = shift;
my %param = @_;
my $path = "/rest/isoform/";
lib/Bio/DB/NextProt.pm view on Meta::CPAN
return $self->{_client}->responseContent();
}
sub get_protein_cv_info() {
my $self = shift;
my %param = @_;
my $path = "/rest/cv/";
lib/Bio/DB/NextProt.pm view on Meta::CPAN
return $self->{_client}->responseContent();
}
sub get_accession_list() {
my $self = shift;
my %param = @_;
my $path = "ftp://ftp.nextprot.org/pub/current_release/ac_lists";
my @file = ();
lib/Bio/DB/NextProt.pm view on Meta::CPAN
&reset_params();
return @file;
}
sub get_hpp_report() {
my $self = shift;
my %param = @_;
my $path = "ftp://ftp.nextprot.org/pub/current_release/custom/hpp";
my @file = ();
lib/Bio/DB/NextProt.pm view on Meta::CPAN
return @file;
}
sub get_mapping() {
my $self = shift;
my %param = @_;
my $path = "ftp://ftp.nextprot.org/pub/current_release/mapping";
my @file = ();
lib/Bio/DB/NextProt.pm view on Meta::CPAN
&reset_params();
return @file;
}
sub get_chromosome() {
my $self = shift;
my %param = @_;
my @data = ();
my %table = ();
lib/Bio/DB/NextProt.pm view on Meta::CPAN
}
return %map;
}
sub reset_params() {
my $self = shift;
$self->{_query} = undef;
$self->{_filter} = undef;
}
view release on metacpan or search on metacpan
# I assume if you've called autheniticate, it's because you've gotten a 401 error.
# Otherwise this does not make sense.
# There is also no caching of authentication done. I suggest the callback do this, so
# the user isn't asked 20 times for the same name and password.
sub authenticate($$$){
my ($self, $fetcher) = @_;
my $callback = $self->auth_callback;
return undef unless defined $callback;
view release on metacpan or search on metacpan
lib/Bio/EnsEMBL/IdMapping/Cache.pm view on Meta::CPAN
return $self->{'_dba'}->{$prefix};
} ## end sub get_DBAdaptor
sub get_production_DBAdaptor() {
my ($self) = @_;
my $dba = new Bio::EnsEMBL::DBSQL::DBAdaptor(
-host => $self->conf->param("productionhost"),
-port => $self->conf->param("productionport"),
-user => $self->conf->param("productionuser"),
view release on metacpan or search on metacpan
lib/Bio/FeatureIO/gff.pm view on Meta::CPAN
access the FASTA section (if any) at the end of the GFF stream. note that this method
will return undef if not all features in the stream have been handled
=cut
sub next_seq() {
my $self = shift;
return unless $self->fasta_mode();
#first time next_seq has been called. initialize Bio::SeqIO instance
if(!$self->seqio){
view release on metacpan or search on metacpan
cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
=cut
sub cmp_ok($$$;$) {
$Test->cmp_ok(@_);
}
=item B<can_ok>
view release on metacpan or search on metacpan
bin/self_dot_plot.pl view on Meta::CPAN
our $VERSION = '1.0';
use Getopt::Long;
sub usage();
sub main();
sub print_dots ($$$$$$$$);
sub print_png ($$);
main();
sub usage() {
print qq/
USAGE: $0 -w <word size> -s <step length>
-i <in file> -o <out file> -d <dot file>
-t <title>
[ -h ]
bin/self_dot_plot.pl view on Meta::CPAN
(Version $VERSION)
/;
}
sub main() {
my ($seqfile, $word, $step, $outfile, $title, $dotfile, $help);
if (!GetOptions('infile=s' => \$seqfile,
'wordlen=i' => \$word,
view release on metacpan or search on metacpan
xt/stream_gff3.t view on Meta::CPAN
use Bio::GFF3::LowLevel::Parser;
use Bio::JBrowse::FeatureStream::GFF3;
use Bio::JBrowse::Store::NCList;
sub open_gff3(@) {
return map Bio::GFF3::LowLevel::Parser->open( $_ ), @_;
}
my @f = snarf_stream( Bio::JBrowse::FeatureStream::GFF3->new( open_gff3( 'xt/data/AU9/scaffold_subset_sync.gff3' )) );
view release on metacpan or search on metacpan
lib/Bio/Lite.pm view on Meta::CPAN
return $seq;
}
my %conversion_hash = ( '+' => 1, '-' => '-1', '1' => '+', '-1' => '-');
sub convertStrand($) {
my $strand = shift;
return $conversion_hash{$strand};
}
view release on metacpan or search on metacpan
MAGE/XML/Writer.pm view on Meta::CPAN
$num++;
$self->external_data($num);
return "external-data-$num.txt";
}
sub write_bio_data_tuples() {
my ($self,$obj) = @_;
# has no attributes
# the tag name is the name of the class
view release on metacpan or search on metacpan
lib/Bio/MedChunker.pm view on Meta::CPAN
use Exporter::Lite;
our @EXPORT = qw(medchunker);
our $YamChaModel = '';
sub extract_NPchunks($) {
my $l = shift;
my @buf;
my @np;
while(my $a = shift @$l){
if( ($a->[2] eq 'O' && @buf) || ($a->[2] eq 'I' && !@$l && @buf)) {
view release on metacpan or search on metacpan
exec/nexplot.pl view on Meta::CPAN
}
}
# print "\%END LABEL\n";
}
sub __print_sequence() {
my $sequence = shift;
my $color = shift;
$color = ( defined($color) ? $color : "0 0 0" );
$sequence = uc(&__seqForDisplay($sequence));
# Print character table
exec/nexplot.pl view on Meta::CPAN
# print "(", substr($sequence, $i*10, 10), ") show\n";
# }
print "(", uc $sequence, ") show\n";
}
sub __seqForDisplay() {
my $string = shift;
$string =~ tr/01/.+/;
my @tmp = split (//, $string);
my $tmp_string = "";
for (my $i = 0; $i <= $#tmp; $i++) {
exec/nexplot.pl view on Meta::CPAN
}
print "\t\t0 setgray stroke\n";
print "\tgrestore\n";
}
sub __print_boot_strap()
{
print "\tgsave\n";
printf "\t\tdefaultfont setfont 0.4 0.2 0 setrgbcolor\n"; # brown
print "\t\t/numwidth (99.99) stringwidth pop def\n";
foreach my $node (@nodes) {
exec/nexplot.pl view on Meta::CPAN
printf "(%.2f) show\n", $node->get_support_value();
}
print "\tgrestore\n";
}
sub __end_post_script()
{
# PRINT SCALE
if ( (! $runtimeOptions{'m'}) && $dataPresent{trees} && (!($tree->is_cladogram())) ) {
print "\tgsave\n";
print "\t\tdefaultfont setfont\n";
view release on metacpan or search on metacpan
lib/Bio/Phylo/Util/CONSTANT.pm view on Meta::CPAN
else {
$looks_like_number = \&Scalar::Util::looks_like_number;
}
undef($@);
}
sub looks_like_number($) { return $looks_like_number->(shift) }
sub looks_like_object($$) {
my ( $object, $constant ) = @_;
my $type;
eval { $type = $object->_type };
if ( $@ or $type != $constant ) {
throw 'ObjectMismatch' => 'Invalid object!';
lib/Bio/Phylo/Util/CONSTANT.pm view on Meta::CPAN
else {
return 1;
}
}
sub looks_like_implementor($$) {
return UNIVERSAL::can( $_[0], $_[1] );
}
sub looks_like_instance($$) {
my ( $object, $class ) = @_;
if ( ref $object ) {
if ( blessed $object ) {
return $object->isa($class);
}
lib/Bio/Phylo/Util/CONSTANT.pm view on Meta::CPAN
else {
return;
}
}
sub looks_like_hash(@) {
if ( scalar(@_) % 2 ) {
throw 'OddHash' => 'Odd number of elements in hash assignment';
}
else {
return @_;
}
}
sub looks_like_class($) {
my $class = shift;
my $path = $class;
$path =~ s|::|/|g;
$path .= '.pm';
if ( not exists $INC{$path} ) {
view release on metacpan or search on metacpan
scripts/polloc_vntrs.pl view on Meta::CPAN
use Pod::Usage;
# ------------------------------------------------- METHODS
# Output methods
sub csv_header();
sub csv_line($$);
# Advance methods
sub _advance_proto($$); # file, msg
sub advance_detection($$$$); #Â loci, genomes, Ngenomes, rule
sub advance_group($$$); #Â locus1, locus2, Nloci
sub advance_extension($$); # group, Ngroups
# ------------------------------------------------- FILES
my $cnf = shift @ARGV;
our $out = shift @ARGV;
my $buildgroups = shift @ARGV;
scripts/polloc_vntrs.pl view on Meta::CPAN
&_advance_proto("$csv.done","done");
# ------------------------------------------------- SUB-ROUTINES
sub advance_detection($$$$){
my($loci, $gF, $gN, $rk) = @_;
our $out;
&_advance_proto("$out.nfeats", $loci);
&_advance_proto("$out.nseqs", "$gF/$gN");
}
sub advance_group($$$){
my($i,$j,$n) = @_;
our $out;
&_advance_proto("$out.ngroups", $i+1);
}
sub advance_extension($$){
my($i, $n) = @_;
our $out;
&_advance_proto("$out.next", "$i/$n");
}
sub _advance_proto($$) {
my($file, $msg) = @_;
open ADV, ">", $file or die "I can not open the '$file' file: $!\n";
print ADV $msg;
close ADV;
}
sub csv_header() {
return "ID\tGenome\tSeq\tFrom\tTo\tUnit length\tCopy number\tMismatch percent\tScore\t".
"Left 500bp\tRight 500bp (rc)\tRepeats\tConsensus/Notes\n";
}
sub csv_line($$) {
my $f = shift;
my $n = shift;
$n||= '';
my $left = $f->seq->subseq(max(1, $f->from-500), $f->from);
my $right = Bio::Seq->new(-seq=>$f->seq->subseq($f->to, min($f->seq->length, $f->to+500)));
view release on metacpan or search on metacpan
Bio/Prospect/CBT/Exception.pm view on Meta::CPAN
}
## INTERNAL FUNCTIONS
sub stringify($)
{
my $self = shift;
my $r = "! " . (ref($self)||$self) . " occurred: " . $self->error() . "\n";
if ( $self->detail() )
{ $r .= "Detail:" . wrap("\t", "\t", $self->detail()) . "\n" }
Bio/Prospect/CBT/Exception.pm view on Meta::CPAN
{ $r .= "Advice:" . wrap("\t", "\t", $self->advice()) . "\n" }
if ( $show_stacktrace )
{ $r .= "Trace:\t" . $self->stacktrace() . "\n"; }
return $r;
}
sub error($) { $_[0]->{error}; }
sub detail($) { $_[0]->{detail}; }
sub advice($) { $_[0]->{advice}; }
# backward compatibility
sub text($) { $_[0]->error(); }
1;
view release on metacpan or search on metacpan
sub set_mt { $_[0]->{mt} = (ref($_[1]) ? $_[1] : [@_[1..$#_]]) || undef }
sub set_prefix { $_[0]->{prefix} = $_[1] || join (q//, subseq) }
sub set_len { $_[0]->{len} = $_[1] || 10 }
sub genseq($) {
$_[0]->{_seqcnt} = 0;
$_[0]->{_result} = undef;
die "Prefix's length is greater than sequence's length\n" if length($_[0]->{prefix}) > $_[0]->{len};
_genseq($_[0], $_[0]->{prefix});
grep{$_}split /\n/, $_[0]->{_result};
view release on metacpan or search on metacpan
lib/Bio/Trace/ABIF.pm view on Meta::CPAN
This data item is from SeqScape(R) v2.5 and Sequencing Analysis v5.2 Software.
=cut
sub avg_peak_spacing() {
my $self = shift;
unless (defined $self->{'_SPAC1'}) {
my $s = undef;
($s) = $self->get_data_item('SPAC', 1, 'B32');
$self->{'_SPAC1'} = $self->_ieee2decimal($s) if (defined $s);
lib/Bio/Trace/ABIF.pm view on Meta::CPAN
This data item is from SeqScape(R) v2.5 and Sequencing Analysis v5.2 Software.
=cut
sub base_spacing() {
my $self = shift;
unless (defined $self->{'_SPAC3'}) {
my $s = undef;
($s) = $self->get_data_item('SPAC', 3, 'B32');
$self->{'_SPAC3'} = $self->_ieee2decimal($s) if (defined $s);
lib/Bio/Trace/ABIF.pm view on Meta::CPAN
0 if the sequence is not in the file.
File Type : ab1
=cut
sub edited_sequence_length() {
my $self = shift;
my $seq = $self->edited_sequence();
return 0 unless defined $seq;
return length($seq);
}
lib/Bio/Trace/ABIF.pm view on Meta::CPAN
0 if the sequence is not in the file.
File Type : ab1
=cut
sub sequence_length() {
my $self = shift;
my $seq = $self->sequence();
return 0 unless defined $seq;
return length($seq);
}
view release on metacpan or search on metacpan
t/lib/Test/Builder/Tester.pm view on Meta::CPAN
until you call C<test_test> (well, unless you manually meddle with the
output filehandles)
=cut
sub test_out(@)
{
# do we need to do any setup?
_start_testing() unless $testing;
$out->expect(@_)
}
sub test_err(@)
{
# do we need to do any setup?
_start_testing() unless $testing;
$err->expect(@_)
view release on metacpan or search on metacpan
t/lib/Test/Builder/Tester.pm view on Meta::CPAN
until you call C<test_test> (well, unless you manually meddle with the
output filehandles)
=cut
sub test_out(@)
{
# do we need to do any setup?
_start_testing() unless $testing;
$out->expect(@_)
}
sub test_err(@)
{
# do we need to do any setup?
_start_testing() unless $testing;
$err->expect(@_)
view release on metacpan or search on metacpan
lib/Bio/Tools/Run/Alignment/Blat.pm view on Meta::CPAN
# Returns :
# Args :
#
#=cut
sub _input() {
my ($self,$infile1) = @_;
if (defined $infile1) {
$self->{'input'} = $infile1;
}
return $self->{'input'};
lib/Bio/Tools/Run/Alignment/Blat.pm view on Meta::CPAN
# Returns :
# Args :
#
#=cut
sub _database() {
my ($self,$infile1) = @_;
$self->{'db'} = $infile1 if(defined $infile1);
return $self->{'db'};
}
view release on metacpan or search on metacpan
Bio/FeatureHolderI.pm view on Meta::CPAN
&_add_flattened_SeqFeatures($arrayref,$sub);
}
}
sub set_ParentIDs_from_hierarchy(){
# DEPRECATED - use IDHandler
my $self = shift;
require "Bio/SeqFeature/Tools/IDHandler.pm";
Bio::SeqFeature::Tools::IDHandler->new->set_ParentIDs_from_hierarchy($self);
}
sub create_hierarchy_from_ParentIDs(){
# DEPRECATED - use IDHandler
my $self = shift;
require "Bio/SeqFeature/Tools/IDHandler.pm";
Bio::SeqFeature::Tools::IDHandler->new->create_hierarchy_from_ParentIDs($self);
}
view release on metacpan or search on metacpan
lib/BioUtil/Util.pm view on Meta::CPAN
Example:
my @list = qq/1 2 3/;
mean_and_stdev(\@list);
=cut
sub mean_and_stdev($) {
my ($list) = @_;
return ( 0, 0 ) if @$list == 0;
my $sum = 0;
$sum += $_ for @$list;
my $sum_square = 0;
view release on metacpan or search on metacpan
examples/benchmarks.pl view on Meta::CPAN
}
EOC
*csb_c = *count_set_bits;
sub csb_perl_loop($n) {
my $count = 0;
while ($n) {
$count++ if $n & 1;
$n >>= 1;
}
return $count;
}
sub csb_perl_c($n) {
my $count = 0;
for ( ; $n; $count++ ) {
$n &= $n - 1;
}
return $count;
}
sub csb_perl_str($n) {
my $str = sprintf "%b", $n;
return $str =~ tr/1//d;
}
sub csb_perl_int($n) {
my $count = 0;
while ($n) {
$count++ if $n & 1;
$n >>= 1;
view release on metacpan or search on metacpan
lib/Bit/Vector/Array.pm view on Meta::CPAN
bva
);
our $VERSION = '0.02';
sub bva(\@)
{
tie @{$_[0]},'Bit::Vector::Array::Tie';
}
view release on metacpan or search on metacpan
t/17_________gcd.t view on Meta::CPAN
my $v = Bit::Vector->new(128);
my $w = Bit::Vector->new(128);
my($uu,$vv,$ww,$xx,$yy,$zz);
sub gcd($$$$$)
{
my($a,$b,$c,$d,$e) = @_;
my($q,$r,$i);
my(@t);
view release on metacpan or search on metacpan
lib/BitTorrent.pm view on Meta::CPAN
our $VERSION = '0.10';
our $TorrentScrape = "/var/lib/perl/torrent-checker.php";
sub new(){
my $self = bless {}, shift;
return $self;
}; # new()
sub getTrackerInfo(){
my $self = shift;
my $file = shift;
my $content;
lib/BitTorrent.pm view on Meta::CPAN
return \%result;
}; # sub getTrackerInfo(){
sub getHealth(){
my $self = shift;
my $torrent = shift;
# init
lib/BitTorrent.pm view on Meta::CPAN
return $Hash;
}; # sub sub getHealth(){
sub bin2hex() {
my ($d) = @_;
$d =~ s/(.)/sprintf("%02x",ord($1))/egs;
$d = lc($d);