Bio::LiveSeq
Chain
Summary
Bio::LiveSeq::Chain - DoubleChain DataStructure for Perl
Package variables
No package variables defined.
Included modules
Carp qw ( croak cluck carp )
integer
strict
Synopsis
Description
This is a general purpose module (that's why it's not in object-oriented
form) that introduces a novel datastructure in PERL. It implements
the "double linked chain". The elements of the chain can contain basically
everything. From chars to strings, from object references to arrays or hashes.
It is used in the LiveSequence project to create a dynamical DNA sequence,
easier to manipulate and change. It's use is mainly for sequence variation
analysis but it could be used - for example - in e-cell projects.
The Chain module in itself doesn't have any biological bias, so can be
used for any programming purpose.
Each element of the chain (with the exclusion of the first and the last of the
chain) is connected to other two elements (the PREVious and the NEXT one).
There is no absolute position (like in an array), hence if positions are
important, they need to be computed (methods are provided).
Otherwise it's easy to keep track of the elements with their "LABELs".
There is one LABEL (think of it as a pointer) to each ELEMENT. The labels
won't change after insertions or deletions of the chain. So it's
always possible to retrieve an element even if the chain has been
modified by successive insertions or deletions.
From this the high potential profit for bioinformatics: dealing with
sequences in a way that doesn't have to rely on positions, without
the need of constantly updating them if the sequence changes, even
dramatically.
Methods
Methods description
Title : chain2string
Usage : $string = Bio::LiveSeq::Chain::chain2string("down",$chain,6,9)
Function: reads the contents of the chain, outputting a string
Returns : a string
Examples:
: down_chain2string($chain) -> all the chain from begin to end
: down_chain2string($chain,6) -> from 6 to the end
: down_chain2string($chain,6,4) -> from 6, going on 4 elements
: down_chain2string($chain,6,"",10) -> from 6 to 10
: up_chain2string($chain,10,"",6) -> from 10 to 6 upstream
Defaults: start=first element; if len undef, goes to last
if last undef, goes to end
if last defined, it overrides len (undefining it)
Error code: -1
Args : "up"||"down" as first argument to specify the reading direction
reference (to the chain)
[first] [len] [last] optional integer arguments to specify how
much and from (and to) where to read |
Title : labels
Usage : @labels = Bio::LiveSeq::Chain::_updown_labels("down",$chain,4,16)
Function: returns all the labels in a chain or those between two
specified ones (termed "first" and "last")
Returns : a reference to an array containing the labels
Args : "up"||"down" as first argument to specify the reading direction
reference (to the chain)
[first] [last] (integer for the starting and eneding labels) |
Title : start
Usage : $start = Bio::LiveSeq::Chain::start()
Returns : the label marking the start of the chain
Errorcode: -1
Args : none |
Title : end
Usage : $end = Bio::LiveSeq::Chain::end()
Returns : the label marking the end of the chain
Errorcode: -1
Args : none |
Title : label_exists
Usage : $check = Bio::LiveSeq::Chain::label_exists($chain,$label)
Function: It checks if a label is defined, i.e. if an element is there or
is not there anymore
Returns : 1 if the label exists, 0 if it is not there, -1 error
Errorcode: -1
Args : reference to the chain, integer |
Title : down_get_pos_of_label
Usage : $position = Bio::LiveSeq::Chain::down_get_pos_of_label($chain,$label,$first)
Function: returns the position of $label counting from $first, i.e. taking
$first as 1 of coordinate system. If $first is not specified it will
count from the start of the chain.
Returns :
Errorcode: 0
Args : reference to the chain, integer (the label of interest)
optional: integer (a different label that will be taken as the
first one, i.e. the one to count from)
Note: It counts "downstream". To proceed backward use up_get_pos_of_label |
Title : down_subchain_length
Usage : $length = Bio::LiveSeq::Chain::down_subchain_length($chain,$first,$last)
Function: returns the length of the chain between the labels "first" and "last", included
Returns : integer
Errorcode: 0
Args : reference to the chain, integer, integer
Note: It counts "downstream". To proceed backward use up_subchain_length |
Title : invert_chain
Usage : $errorcode=Bio::LiveSeq::Chain::invert_chain($chain)
Function: completely inverts the order of the chain elements; begin is swapped with end and all links updated (PREV&NEXT fields swapped)
Returns : 1 if all OK, 0 if errors
Errorcode: 0
Args : reference to the chain |
Title : down_get_value_at_pos
Usage : $value = Bio::LiveSeq::Chain::down_get_value_at_pos($chain,$position,$first)
Function: used to access the value of the chain at a particular position instead than directly with a label pointer. It will count the position from the start of the chain or from the label $first, if $first is specified
Returns : whatever is stored in the element of the chain
Errorcode: 0
Args : reference to the chain, integer, [integer]
Note: It works "downstream". To proceed backward use up_get_value_at_pos |
Title : down_set_value_at_pos
Usage : $errorcode = Bio::LiveSeq::Chain::down_set_value_at_pos($chain,$newvalue,$position,$first)
Function: used to store a new value inside an element of the chain at a particular position instead than directly with a label pointer. It will count the position from the start of the chain or from the label $first, if $first is specified
Returns : 1
Errorcode: 0
Args : reference to the chain, newvalue, integer, [integer]
(newvalue can be: integer, string, object reference, hash ref)
Note: It works "downstream". To proceed backward use up_set_value_at_pos
Note2: If the $newvalue is undef, it will delete the contents of the
element but it won't remove the element from the chain. |
Title : down_get_label_at_pos
Usage : $label = Bio::LiveSeq::Chain::down_get_label_at_pos($chain,$position,$first)
Function: used to retrieve the label of an an element of the chain at a particular position. It will count the position from the start of the chain or from the label $first, if $first is specified
Returns : integer
Errorcode: 0
Args : reference to the chain, integer, [integer]
Note: It works "downstream". To proceed backward use up_get_label_at_pos |
Title : _praepostinsert_array
Usage : ($insbegin,$insend) = Bio::LiveSeq::Chain::_praepostinsert_array($chainref,"post",$arrayref,$position)
Function: the elements of the array specified by $arrayref are inserted (creating a new subchain) in the chain specified by $chainref, before or after (depending on the "prae"||"post" keyword passed as second argument) the specified position.
Returns : two labels: the first and the last of the inserted subchain
Defaults: if no position is specified, the new chain will be inserted after
(post) the first element of the chain
Errorcode: 0
Args : chainref, "prae"||"post", arrayref, integer (position) |
Title : is_downstream
Usage : Bio::LiveSeq::Chain::is_downstream($chainref,$firstlabel,$secondlabel)
Function: checks if SECONDlabel follows FIRSTlabel
It runs downstream the elements of the chain from FIRST searching
for SECOND.
Returns : 1 if SECOND is found /after/ FIRST; 0 otherwise (i.e. if it
reaches the end of the chain without having found it)
Errorcode -1
Args : two labels (integer) |
Title : is_upstream
Usage : Bio::LiveSeq::Chain::is_upstream($chainref,$firstlabel,$secondlabel)
Function: checks if SECONDlabel follows FIRSTlabel
It runs upstream the elements of the chain from FIRST searching
for SECOND.
Returns : 1 if SECOND is found /after/ FIRST; 0 otherwise (i.e. if it
reaches the end of the chain without having found it)
Errorcode -1
Args : two labels (integer) |
Title : check_chain
Usage : @errorcodes = Bio::LiveSeq::Chain::check_chain()
Function: a wraparound to a series of check for consistency of the chain
It will check for boundaries, size, backlinking and forwardlinking
Returns : array of 4 warn codes, each can be 1 (all ok) or 0 (something wrong)
Errorcode: 0
Args : none
Note : this is slow and through. It is not really needed. It is mostly
a code-developer tool. |
Title : splice_chain
Usage : @errorcodes = Bio::LiveSeq::Chain::splice_chain($chainref,$first,$length,$last)
Function: removes the elements designated by FIRST and LENGTH from a chain.
The chain shrinks accordingly. If LENGTH is omitted, removes
everything from FIRST onward.
If END is specified, LENGTH is ignored and instead the removal
occurs from FIRST to LAST.
Returns : the elements removed as a string
Errorcode: -1
Args : chainref, integer, integer, integer |
Title : array2chain
Usage : $chainref = Bio::LiveSeq::Chain::array2chain($arrayref,$offset)
Function: creation of a double linked chain from an array
Returns : reference to a hash containing the chain
Defaults: OFFSET defaults to 1 if undef
Error code: 0
Args : a reference to an array containing the elements to be chainlinked
an optional integer > 0 (this will be the starting count for
the chain labels instead than having them begin from "1") |
Methods code
| up_chain2string | description | prev | next | Top |
sub up_chain2string
{ _updown_chain2string("up",@_);} | sub down_chain2string
{ _updown_chain2string("down",@_);} | sub _updown_chain2string
{ my ($direction,$chain,$first,$len,$last)=@_;
unless($chain) { cluck "no chain input"; return (-1); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $flow;
if ($direction eq "up") {
$flow=2;
unless ($first) { $first=$end; }
} else {
$flow=1;
unless ($first) { $first=$begin; }
}
unless($chain->{$first}) {
cluck "label for first not defined"; return (-1); }
if ($last) {
unless($chain->{$last}) {
cluck "label for last not defined"; return (-1); }
if ($len) {
warn "Warning chain2string: argument LAST:$last overriding LEN:$len!";
undef $len;
}
} else {
if ($direction eq "up") {
$last=$begin;
} else {
$last=$end;
}
}
my ($string,@array);
my $label=$first; my $i=1;
my $afterlast=$chain->{$last}[$flow];
unless (defined $afterlast) { $afterlast=0; }
while (($label) && ($label != $afterlast) && ($i <= ($len || $i + 1))) {
@array=@{$chain->{$label}};
$string .= $array[0];
$label = $array[$flow];
$i++;
}
return ($string);
} | sub down_labels
{ my ($chain,$first,$last)=@_;
_updown_labels("down",$chain,$first,$last);} | sub up_labels
{ my ($chain,$first,$last)=@_;
_updown_labels("up",$chain,$first,$last);} | sub _updown_labels
{ my ($direction,$chain,$first,$last)=@_;
unless($chain) { cluck "no chain input"; return (0); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $flow;
if ($direction eq "up") { $flow=2;
unless ($first) { $first=$end; }
unless ($last) { $last=$begin; }
} else { $flow=1;
unless ($last) { $last=$end; }
unless ($first) { $first=$begin; }
}
unless($chain->{$first}) { warn "not existing label $first"; return (0); }
unless($chain->{$last}) { warn "not existing label $last"; return (0); }
my $label=$first; my @labels;
my $afterlast=$chain->{$last}[$flow];
unless (defined $afterlast) { $afterlast=0; }
while (($label)&&($label != $afterlast)) {
push(@labels,$label);
$label=$chain->{$label}[$flow];
}
return (\@labels);
} | sub start
{ my $chain=$_[0];
unless($chain) { cluck "no chain input"; return (-1); }
return ($chain->{'begin'});} | sub end
{ my $chain=$_[0];
unless($chain) { cluck "no chain input"; return (-1); }
return ($chain->{'end'});} | sub label_exists
{ my ($chain,$label)=@_;
unless($chain) { cluck "no chain input"; return (-1); }
if ($label && $chain->{$label}) { return (1); } else { return (0) };} | sub down_get_pos_of_label
{
my ($chain,$label,$first)=@_;
_updown_count("down",$chain,$first,$label); } | sub up_get_pos_of_label
{
my ($chain,$label,$first)=@_;
_updown_count("up",$chain,$first,$label); } | sub down_subchain_length
{
my ($chain,$first,$last)=@_;
_updown_count("down",$chain,$first,$last); } | sub up_subchain_length
{
my ($chain,$first,$last)=@_;
_updown_count("up",$chain,$first,$last); } | sub _updown_count
{ my ($direction,$chain,$first,$last)=@_;
unless($chain) { cluck "no chain input"; return (0); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $flow;
if ($direction eq "up") { $flow=2;
unless ($first) { $first=$end; }
unless ($last) { $last=$begin; }
} else { $flow=1;
unless ($last) { $last=$end; }
unless ($first) { $first=$begin; }
}
unless($chain->{$first}) { warn "not existing label $first"; return (0); }
unless($chain->{$last}) { warn "not existing label $last"; return (0); }
my $label=$first; my $count;
my $afterlast=$chain->{$last}[$flow];
unless (defined $afterlast) { $afterlast=0; }
while (($label)&&($label != $afterlast)) {
$count++;
$label=$chain->{$label}[$flow];
}
return ($count);
} | sub invert_chain
{ my $chain=$_[0];
unless($chain) { cluck "no chain input"; return (0); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my ($label,@array);
$label=$begin;
while ($label) {
@array=@{$chain->{$label}};
($chain->{$label}[1],$chain->{$label}[2])=($array[2],$array[1]);
$label = $array[1];
}
($chain->{'begin'},$chain->{'end'})=($end,$begin);
return (1);
} | sub down_get_value_at_pos
{ my ($chain,$position,$first)=@_;
my $label=down_get_label_at_pos($chain,$position,$first);
if (($label eq -1)||($label eq 0)) {
warn "not existing element $label"; return (0); }
return _get_value($chain,$label); } | sub up_get_value_at_pos
{ my ($chain,$position,$first)=@_;
my $label=up_get_label_at_pos($chain,$position,$first);
if (($label eq -1)||($label eq 0)) {
warn "not existing element $label"; return (0); }
return _get_value($chain,$label); } | sub down_set_value_at_pos
{ my ($chain,$value,$position,$first)=@_;
my $label=down_get_label_at_pos($chain,$position,$first);
if (($label eq -1)||($label eq 0)) {
warn "not existing element $label"; return (0); }
_set_value($chain,$label,$value);
return (1); } | sub up_set_value_at_pos
{ my ($chain,$value,$position,$first)=@_;
my $label=up_get_label_at_pos($chain,$position,$first);
if (($label eq -1)||($label eq 0)) {
warn "not existing element $label"; return (0); }
_set_value($chain,$label,$value);
return (1); } | sub set_value_at_label
{ my ($chain,$value,$label)=@_;
unless($chain) { cluck "no chain input"; return (0); }
unless($chain->{$label}) {
warn "not existing element $label"; return (0); }
_set_value($chain,$label,$value);
return (1);} | sub get_value_at_label
{ my $chain=$_[0];
unless($chain) { cluck "no chain input"; return (0); }
my $label = $_[1];
unless($chain->{$label}) {
warn "not existing label $label"; return (0); }
return _get_value($chain,$label);} | sub _set_value
{ my ($chain,$label,$value)=@_;
$chain->{$label}[0]=$value;} | sub _get_value
{ my ($chain,$label)=@_;
return $chain->{$label}[0];} | sub down_get_label_at_pos
{ _updown_get_label_at_pos("down",@_);} | sub up_get_label_at_pos
{ _updown_get_label_at_pos("up",@_);} | sub _updown_get_label_at_pos
{ my ($direction,$chain,$position,$first)=@_;
unless($chain) { cluck "no chain input"; return (0); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $flow;
if ($direction eq "up") { $flow=2; unless ($first) { $first=$end; }
} else { $flow=1; unless ($first) { $first=$begin; } }
unless($chain->{$first}) { warn "not existing label $first"; return (0); }
my $label=$first;
my $i=1;
while ($i < $position) {
$label=$chain->{$label}[$flow];
$i++;
unless ($label) { return (0); }
}
return ($label);} | sub preinsert_string
{ &praeinsert_string } | sub preinsert_array
{ &praeinsert_array } | sub praeinsert_string
{ my @string=split(//,$_[1]);
praeinsert_array($_[0],\@string,$_[2]); } | sub postinsert_string
{ my @string=split(//,$_[1]);
postinsert_array($_[0],\@string,$_[2]); } | sub praeinsert_array
{ _praepostinsert_array($_[0],"prae",$_[1],$_[2]); } | sub postinsert_array
{ _praepostinsert_array($_[0],"post",$_[1],$_[2]); } | sub _praepostinsert_array
{ my $chain=$_[0];
unless($chain) { cluck "no chain input"; return (0); }
my $praepost=$_[1] || "post";
my ($prae,$post);
my $position=$_[3];
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
if ($praepost eq "prae") {
$prae=1;
unless (($position eq 0)||($position)) { $position=$begin; }
} else {
$post=1;
unless (($position eq 0)||($position)) { $position=$end; }
}
unless($chain->{$position}) {
warn ("Warning _praepostinsert_array: not existing element $position");
return (0);
}
my $elements=$_[2];
my $elements_count=scalar(@{$elements});
unless ($elements_count) {
warn ("Warning _praepostinsert_array: no elements input"); return (0); }
my ($insertbegin,$insertend)=_create_chain_elements($chain,$elements);
my $noerror=1;
if ($prae) {
if ($position==$begin) {
$noerror=_join_chain_elements($chain,$insertend,$begin);
$chain->{'begin'}=$insertbegin;
} else {
$noerror=_join_chain_elements($chain,up_element($chain,$position),$insertbegin);
$noerror=_join_chain_elements($chain,$insertend,$position);
}
} elsif ($post) {
if ($position==$end) {
$noerror=_join_chain_elements($chain,$end,$insertbegin);
$chain->{'end'}=$insertend;
} else {
$noerror=_join_chain_elements($chain,$insertend,down_element($chain,$position));
$noerror=_join_chain_elements($chain,$position,$insertbegin);
}
} else {
die "_praepostinsert_array: Something went very wrong";
}
if ($noerror) {
return ($insertbegin,$insertend);
} else {
warn "Warning _praepostinsert_array: Joining of insertion failed";
return (0);
}} | sub _create_chain_elements
{ my $chain=$_[0];
unless($chain) {
warn ("Warning _create_chain_elements: no chain input"); return (0); }
my $arrayref=$_[1];
my $array_count=scalar(@{$arrayref});
unless ($array_count) {
warn ("Warning _create_chain_elements: no elements input"); return (0); }
my $begin=$chain->{'firstfree'};
my $i=$begin-1;
my $element;
foreach $element (@{$arrayref}) {
$i++;
$chain->{$i}=[$element,$i+1,$i-1];
}
my $end=$i;
$chain->{'firstfree'}=$i+1;
$chain->{'size'} += $end-$begin+1;
$chain->{$begin}[2]=undef;
$chain->{$end}[1]=undef;
return ($begin,$end);
} | sub down_element
{ _updown_element("down",@_);} | sub up_element
{ _updown_element("up",@_);} | sub _updown_element
{ my $direction=$_[0] || "down";
my $flow;
if ($direction eq "up") {
$flow=2;
} else {
$flow=1;
}
my $chain=$_[1];
unless($chain) {
warn ("Warning ${direction}_element: no chain input"); return (-1); }
my $me = $_[2];
my $it = $chain->{$me}[$flow];
if ($it) {
return ($it);
} else {
return (0);
} } | sub _is_updownstream
{ my $direction=$_[0] || "down";
my $flow;
if ($direction eq "up") {
$flow=2;
} else {
$flow=1;
}
my $chain=$_[1];
unless($chain) {
warn ("Warning is_${direction}stream: no chain input"); return (-1); }
my $first=$_[2];
my $second=$_[3];
if ($first==$second) {
warn ("Warning is_${direction}stream: first==second!!"); return (0); }
unless($chain->{$first}) {
warn ("Warning is_${direction}stream: first element not defined"); return (-1); }
unless($chain->{$second}) {
warn ("Warning is_${direction}stream: second element not defined"); return (-1); }
my ($label,@array);
$label=$first;
my $found=0;
while (($label)&&(!($found))) {
if ($label==$second) {
$found=1;
}
@array=@{$chain->{$label}};
$label = $array[$flow];
}
return $found; } | sub is_downstream
{ _is_updownstream("down",@_);} | sub is_upstream
{ _is_updownstream("up",@_);} | sub check_chain
{ my $chain=$_[0];
unless($chain) {
warn ("Warning check_chain: no chain input"); return (-1); }
my ($warnbound,$warnsize,$warnbacklink,$warnforlink);
$warnbound=&_boundcheck;
$warnsize=&_sizecheck;
$warnbacklink=&_downlinkcheck;
$warnforlink=&_uplinkcheck;
return ($warnbound,$warnsize,$warnbacklink,$warnforlink);} | sub _uplinkcheck
{ _updownlinkcheck("up",@_);} | sub _downlinkcheck
{ _updownlinkcheck("down",@_);} | sub _updownlinkcheck
{ my $direction=$_[0] || "down";
my ($flow,$wolf);
my $chain=$_[1];
unless($chain) {
warn ("Warning _${direction}linkcheck: no chain input"); return (0); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my ($label,@array,$me,$it,$itpoints);
if ($direction eq "up") {
$flow=2;
$wolf=1;
$label=$end;
} else {
$flow=1;
$wolf=2;
$label=$begin;
}
my $warncode=1;
while ($label) {
$me=$label;
@array=@{$chain->{$label}};
$label = $array[$flow];
$it=$label;
if ($it) {
@array=@{$chain->{$label}};
$itpoints=$array[$wolf];
unless ($me==$itpoints) {
warn "Warning: ${direction}LinkCheck: LINK wrong in $it, that doesn't point back to me ($me). It points to $itpoints\n";
$warncode=0;
}
}
}
return $warncode; } | sub _sizecheck
{ my $chain=$_[0];
unless($chain) {
warn ("Warning _sizecheck: no chain input"); return (0); }
my $begin=$chain->{'begin'};
my $warncode=1;
my ($label,@array);
my $size=$chain->{'size'};
my $count=0;
$label=$begin;
while ($label) {
@array=@{$chain->{$label}};
$label = $array[1];
$count++;
}
if ($size != $count) {
warn "Size check reports error: assumed size: $size, real size: $count ";
$warncode=0;
}
return $warncode;} | sub _boundcheck
{ my $chain=$_[0];
unless($chain) {
warn ("Warning _boundcheck: no chain input"); return (0); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $warncode=1;
if (($begin)&&($chain->{$begin})) {
if ($chain->{$begin}[2]) {
warn "Warning: BEGIN element has PREV field defined\n ";
warn "\tWDEBUG begin: $begin\t";
warn "\tWDEBUG begin's PREV: $chain->{$begin}[2]\n ";
$warncode=0;
}
} else {
warn "Warning: BEGIN key of chain does not point to existing element!\n";
warn "\tWDEBUG begin: $begin\n";
$warncode=0;
}
if (($end)&&($chain->{$end})) {
if ($chain->{$end}[1]) {
warn "Warning: END element has NEXT field defined\n ";
warn "\tWDEBUG end: $end\t";
warn "\tWDEBUG end's NEXT: $chain->{$end}[1]\n ";
$warncode=0;
}
} else {
warn "Warning: END key of chain does not point to existing element!\n";
warn "\tWDEBUG end: $end\n";
$warncode=0;
}
return $warncode;} | sub chain_length
{ my $chain=$_[0];
unless($chain) {
warn ("Warning chain_length: no chain input"); return (-1); }
my $size=$chain->{'size'};
if ($size) {
return ($size);
} else {
return (-1);
}} | sub _join_chain_elements
{ my $chain=$_[0];
unless($chain) {
warn ("Warning _join_chain_elements: no chain input"); return (0); }
my $leftelem=$_[1];
my $rightelem=$_[2];
unless(($leftelem)&&($rightelem)) {
warn ("Warning _join_chain_elements: element arguments??"); return (0); }
if (($chain->{$leftelem})&&($chain->{$rightelem})) {
$chain->{$leftelem}[1]=$rightelem;
$chain->{$rightelem}[2]=$leftelem;
return 1;
} else {
warn ("Warning _join_chain_elements: elements not defined");
return 0;
}} | sub splice_chain
{ my $chain=$_[0];
unless($chain) {
warn ("Warning splice_chain: no chain input"); return (-1); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $first=$_[1];
unless (($first eq 0)||($first)) { $first=$begin; }
my $len=$_[2];
my $last=$_[3];
my (@array, $string);
my ($beforecut,$aftercut);
unless($chain->{$first}) {
warn ("Warning splice_chain: first element not defined"); return (-1); }
if ($last) {
unless($chain->{$last}) {
warn ("Warning splice_chain: last element not defined"); return (-1); }
if ($len) {
warn ("Warning splice_chain: argument LAST:$last overriding LEN:$len!");
undef $len;
}
} else {
$last=$end;
}
$beforecut=$chain->{$first}[2];
my $i=1;
my $label=$first;
my $afterlast=$chain->{$last}[1];
unless (defined $afterlast) { $afterlast=0; }
while (($label)&&($label != $afterlast) && ($i <= ($len || $i + 1))) {
@array=@{$chain->{$label}};
$string .= $array[0];
$aftercut = $array[1];
delete $chain->{$label};
$label=$aftercut;
$i++;
}
if ($beforecut) {
if ($aftercut) {
_join_chain_elements($chain,$beforecut,$aftercut);
} else {
$chain->{'end'}=$beforecut;
$chain->{$beforecut}[1]=undef;
}
} else {
if ($aftercut) {
$chain->{'begin'}=$aftercut;
$chain->{$aftercut}[2]=undef;
} else {
$chain->{'begin'}=undef;
$chain->{'end'}=undef;
}
}
$chain->{'size'}=($chain->{'size'}) - $i + 1;
return $string;} | sub chain2string_verbose
{ carp "Warning: method no more supported.\n";
&old_down_chain2string_verbose; } | sub up_chain2string_verbose
{ carp "Warning: method no more supported.\n";
old_up_chain2string($_[0],$_[1],$_[2],$_[3],"verbose"); } | sub down_chain2string_verbose
{ carp "Warning: method no more supported.\n";
old_down_chain2string($_[0],$_[1],$_[2],$_[3],"verbose"); } | sub old_up_chain2string
{ old_updown_chain2string("up",@_);} | sub old_down_chain2string
{ old_updown_chain2string("down",@_);} | sub old_updown_chain2string
{ my ($direction,$chain,$first,$len,$last,$option)=@_;
unless($chain) {
warn ("Warning chain2string: no chain input"); return (-1); }
my $begin=$chain->{'begin'};
my $end=$chain->{'end'};
my $flow;
if ($direction eq "up") {
$flow=2;
unless ($first) { $first=$end; }
} else {
$flow=1;
unless ($first) { $first=$begin; }
}
unless($chain->{$first}) {
warn ("Warning chain2string: first element not defined"); return (-1); }
if ($last) {
unless($chain->{$last}) {
warn ("Warning chain2string: last element not defined"); return (-1); }
if ($len) {
warn ("Warning chain2string: argument LAST:$last overriding LEN:$len!");
undef $len;
}
} else {
if ($direction eq "up") {
$last=$begin;
} else {
$last=$end;
}
}
my (@array, $string, $count);
my $verbose=0; my $elements=0; my @elements; my $counting=0;
if ($option) {
if ($option eq "verbose") { $verbose=1; }
if ($option eq "elements") { $elements=1; }
if ($option eq "counting") { $counting=1; }
}
if ($verbose) {
print "BEGIN=$begin"; print " END=$end"; print " SIZE=$chain->{'size'}";
print " FIRSTFREE=$chain->{'firstfree'}\n ";
}
my $i=1;
my $label=$first;
my $afterlast=$chain->{$last}[$flow];
unless (defined $afterlast) { $afterlast=0; }
while (($label)&&($label != $afterlast) && ($i <= ($len || $i + 1))) {
@array=@{$chain->{$label}};
if ($verbose) {
$string .= "$array[2]_${label}_$array[1]=$array[0] ";
$count++;
} elsif ($elements) {
push (@elements,$label);
} elsif ($counting) {
$count++;
} else {
$string .= $array[0];
}
$label = $array[$flow];
$i++;
}
if ($verbose) { print "TOTALprinted: $count\n"; }
if ($counting) {
return $count;
} elsif ($elements) {
return @elements;
} else {
return $string;
}} | sub string2chain
{ my @string=split(//,$_[0]);
array2chain(\@string,$_[1]); } | sub array2chain
{ my $arrayref=$_[0];
my $array_count=scalar(@{$arrayref});
unless ($array_count) {
warn ("Warning array2chain: no elements input"); return (0); }
my $begin=$_[1];
if (defined $begin) {
if ($begin < 1) {
warn "Warning array2chain: Zero or Negative offsets not allowed"; return (0); }
} else {
$begin=1;
}
my ($element,%hash);
$hash{'begin'}=$begin;
my $i=$begin-1;
foreach $element (@{$arrayref}) {
$i++;
$hash{$i}=[$element,$i+1,$i-1];
}
my $end=$i;
$hash{'end'}=$end;
$hash{firstfree}=$i+1;
$hash{size}=$end-$begin+1;
$hash{$begin}[2]=undef;
$hash{$end}[1]=undef;
return (\%hash);} | General documentation
| AUTHOR - Joseph A.L. Insana | Top |
Email:
Insana@ebi.ac.uk,
jinsana@gmx.netAddress:
EMBL Outstation, European Bioinformatics Institute
Wellcome Trust Genome Campus, Hinxton
Cambs. CB10 1SD, United KingdomThe rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _
| down_set_value_at_label | Top |
Title : down_set_value_at_label
Usage : $errorcode = Bio::LiveSeq::Chain::down_set_value_at_label($chain,$newvalue,$label)
Function: used to store a new value inside an element of the chain defined by its label.
Returns : 1
Errorcode: 0
Args : reference to the chain, newvalue, integer
(newvalue can be: integer, string, object reference, hash ref)
Note: It works "downstream". To proceed backward use up_set_value_at_label
Note2: If the $newvalue is undef, it will delete the contents of the
element but it won't remove the element from the chain.| down_get_value_at_label | Top |
Title : down_get_value_at_label
Usage : $value = Bio::LiveSeq::Chain::down_get_value_at_label($chain,$label)
Function: used to access the value of the chain from one element defined by its label.
Returns : whatever is stored in the element of the chain
Errorcode: 0
Args : reference to the chain, integer
Note: It works "downstream". To proceed backward use up_get_value_at_label