G

Prelude

Summary Included libraries Package variables Synopsis Description General documentation Methods
Summary
G::Prelude
Package variables top
Globals (from use vars definitions)
$AUTOLOAD
@INC
$VERSION = '1.0'
Included modulestop
G::Messenger
G::Seq::Primitive
strict
Inherit top
Unavailable
Synopsistop
 use G::Prelude;
 @ISA = (G::Prelude);
Descriptiontop
 Intended for internal use only. Super class for the core. Provides 
 the native methods.


Methodstop
after_startcodonNo descriptionCode
after_stopcodonNo descriptionCode
before_startcodonNo descriptionCode
before_stopcodonNo descriptionCode
cdsNo descriptionCode
del_keyNo descriptionCode
featureNo descriptionCode
gene2idNo descriptionCode
get_cdsseqNo descriptionCode
get_exonNo descriptionCode
get_gbkseqNo descriptionCode
get_geneseqNo descriptionCode
get_intronNo descriptionCode
getseqNo descriptionCode
hairpin_cutNo descriptionCode
intergenicNo descriptionCode
pos2featureNo descriptionCode
pos2geneNo descriptionCode
seq_infoNo descriptionCode
set_intergenicNo descriptionCode
startcodonNo descriptionCode
stopcodonNo descriptionCode

Methods description

Methods code

after_startcodondescriptiontopprevnext
sub after_startcodon {
    my $this = shift;
    my $object = shift;
    my $length = shift;

    if ($this->{$object}->{direction} eq 'complement'){
	return 
	    complement(substr($this->{SEQ}, 
			      $this->{$object}->{end} - 1 - 3 - $length + 1, 
			      $length));
    }else{
	return 
	    substr($this->{SEQ}, 
		   $this->{$object}->{start} + 3 - 1, 
		   $length);
    }
}
after_stopcodondescriptiontopprevnext
sub after_stopcodon {
    my $this = shift;
    my $object = shift;
    my $length = shift;

    if ($this->{$object}->{direction} eq 'complement'){
	return 
	    complement(substr($this->{SEQ}, 
			      $this->{$object}->{start} - 1 - $length, 
			      $length));
    }else{
	return 
	    substr($this->{SEQ}, 
		   $this->{$object}->{end} +1 - 1, 
		   $length);
    }
}
before_startcodondescriptiontopprevnext
sub before_startcodon {
    my $this = shift;
    my $object = shift;
    my $length = shift;

    if ($this->{$object}->{direction} eq 'complement'){
	return 
	    complement(substr($this->{SEQ}, 
			      $this->{$object}->{end}, 
			      $length));
    }else{
	return 
	    substr($this->{SEQ}, 
		   $this->{$object}->{start} - 1 - $length, 
		   $length);
    }
}
before_stopcodondescriptiontopprevnext
sub before_stopcodon {
    my $this = shift;
    my $object = shift;
    my $length = shift;

    if ($this->{$object}->{direction} eq 'complement'){
	return 
	    complement(substr($this->{SEQ}, 
			      $this->{$object}->{start} + 3 - 1, 
			      $length));
    }else{
	return 
	    substr($this->{SEQ}, 
		   $this->{$object}->{end} - 3 - 1 - $length + 1, 
		   $length);
    }
}
cdsdescriptiontopprevnext
sub cds {
    my $this = shift;
    my $opt = shift || '';
    my $i = 0;
    my @cds;

    while(defined(%{$this->{"FEATURE" . ($i + 1)}})){
	$i ++;
	next if ($this->{"FEATURE$i"}->{type} ne 'CDS');

	if ($opt ne 'all'){
	    next if ($this->{"FEATURE$i"}->{on} == 0);
	    my $id = $this->{"FEATURE$i"}->{cds};
	    next if ($this->{"CDS$id"}->{on} == 0);
	}

	push (@cds, "FEATURE$i");
    }

    return @cds;
}
del_keydescriptiontopprevnext
sub del_key {
    my $this = shift;
    my $key = shift;

    $this->{$key}->{on} = 0;

    return 1;
}
featuredescriptiontopprevnext
sub feature {
    my $this = shift;
    my $opt = shift || '';
    my $i = 0;
    my @feature;

    while(defined(%{$this->{"FEATURE" . ($i + 1)}})){
	if ($opt ne 'all' && defined $this->{"FEATURE$i"}->{on}){
	    next if ($this->{"FEATURE$i"}->{on} == 0);
	}
	push (@feature, "FEATURE$i");
	$i ++;
    }

    return @feature;
}
gene2iddescriptiontopprevnext
sub gene2id {
    my $this = shift;
    my $gene = shift;

    foreach my $feat ($this->cds()){
	return $feat if ($this->{$feat}->{gene} eq $gene);
    }
}
get_cdsseqdescriptiontopprevnext
sub get_cdsseq {
    my $this = shift;
    my $object = shift;

    my $cdsseq = $this->get_gbkseq($this->{$object}->{start}, 
				   $this->{$object}->{end});
    $cdsseq = &complement($cdsseq) 
	if ($this->{$object}->{direction} eq 'complement');

    return $cdsseq;
}
get_exondescriptiontopprevnext
sub get_exon {
    my $this = shift;
    my $cds = shift;

    unless ($this->{$cds}->{join}){
	return -1;
	last;
    }
    my @join = split(/,/, $this->{$cds}->{join});
    my $seq = '';
    my $line;

    foreach $line (@join){
	my $complement = $line =~ tr/c//d;
	my ($start, $end) = split(/\.\./, $line, 2);
	my $tmp = $this->get_gbkseq($start, $end);
	$tmp = complement($tmp) if ($complement);
	$seq .= $tmp;
    }

    $seq = complement($seq) if ($this->{$cds}->{direction} eq 'complement');
    return $seq;
}
get_gbkseqdescriptiontopprevnext
sub get_gbkseq {
    my $this = shift;
    my $start = shift;
    my $end = shift;

    my $seq = substr($this->{SEQ}, $start -1, $end-$start+1);

    return $seq;
}
get_geneseqdescriptiontopprevnext
sub get_geneseq {
    my $this = shift;
    my $object = shift;

    my $geneseq = $this->get_gbkseq($this->{$object}->{start}, 
				   $this->{$object}->{end});
    if ($this->{$object}->{join}){
	$geneseq = $this->get_exon($object);
    }elsif ($this->{$object}->{direction} eq 'complement'){
	$geneseq = &complement($geneseq);
    }

    return $geneseq;
}
get_introndescriptiontopprevnext
sub get_intron {
    my $this = shift;
    my $cds = shift;

    unless ($this->{$cds}->{join}){
	return -1;
	last;
    }
    my @join = split(/\.\./, $this->{$cds}->{join});
    shift @join;
    pop @join;
    my @seq;
    my $line;

    foreach $line (@join){
	$line =~ s/c//g;
	my ($start, $end) = split(/,/, $line, 2);
	my $tmp = $this->get_gbkseq($start + 1, $end - 1);
	push (@seq, $tmp);
    }

    return @seq;
}
getseqdescriptiontopprevnext
sub getseq {
    my $this = shift;
    my $start = shift;
    my $end = shift;

    my $seq = substr($this->{SEQ}, $start, $end-$start+1);
    
    return $seq;
}
hairpin_cutdescriptiontopprevnext
sub hairpin_cut {
    my $nuc = shift;
    my $val = "\n==============\n!!!Afro Man!!!===============\n\n";

    system('netscape http://www2.osk.3web.ne.jp/~e916/');

    return $val;
}
intergenicdescriptiontopprevnext
sub intergenic {
    my $this = shift;
    my $opt = shift || '';
    my $i = 0;
    my @cds;

    while(defined(%{$this->{"INTER" . ($i + 1)}})){
	$i ++;

	if ($opt ne 'all'){
	    next if ($this->{"INTER$i"}->{on} == 0);
	}

	push (@cds, "INTER$i");
    }

    return @cds;
}
pos2featuredescriptiontopprevnext
sub pos2feature {
    my $this = shift;
    my $pos = shift;

    foreach my $feat ($this->feature()){
	next if ($feat eq 'FEATURE0');

	if ($pos >= $this->{$feat}->{start} && $pos <= $this->{$feat}->{end}){
	    return $feat;
	}elsif ($pos < $this->{$feat}->{start}){
	    return '';
	}
    }
}
pos2genedescriptiontopprevnext
sub pos2gene {
    my $this = shift;
    my $pos = shift;

    foreach my $feat ($this->cds()){
	if ($pos >= $this->{$feat}->{start} && $pos <= $this->{$feat}->{end}){
	    return $feat;
	}elsif ($pos < $this->{$feat}->{start}){
	    return '';
	}
    }
}
seq_infodescriptiontopprevnext
sub seq_info {
    my $this = shift;
    my $length = length($this->{SEQ});

    my $a = $this->{SEQ} =~ tr/a/a/;
    my $t = $this->{SEQ} =~ tr/t/t/;
    my $g = $this->{SEQ} =~ tr/g/g/;
    my $c = $this->{SEQ} =~ tr/c/c/;
    my $others = $length - $a - $t - $g - $c;
    my $msg;

    $msg .= sprintf "\n\nAccession Number: %s\n", $this->{LOCUS}->{id};
    $msg .= sprintf "\n  Length of Sequence : %9d\n" , $length;
    $msg .= sprintf "           A Content : %9d (%.2f", 
    $a , $a / $length * 100;
    $msg .= "\%)\n";
    $msg .= sprintf "           T Content : %9d (%.2f", 
    $t , $t / $length * 100;
    $msg .= "\%)\n";
    $msg .= sprintf "           G Content : %9d (%.2f", 
    $g , $g / $length * 100;
    $msg .= "\%)\n";
    $msg .= sprintf "           C Content : %9d (%.2f", 
    $c , $c / $length * 100;
    $msg .= "\%)\n";
    $msg .= sprintf "              Others : %9d (%.2f", 
    $others,  $others / $length * 100;
    $msg .= "\%)\n";
    $msg .= sprintf "          AT Content :    %.2f",
    ($a + $t) / $length * 100;
    $msg .= "\%\n";
    $msg .= sprintf "          GC Content :    %.2f", 
    ($g + $c) / $length * 100;
    $msg .= "\%\n\n";

    &msg_send($msg);

    return ($a, $t, $g, $c);
}
set_intergenicdescriptiontopprevnext
sub set_intergenic {
	my $gb = shift;
	my $num = 1;
	my $i = 0;
	my $length = length $gb->{SEQ};
	my $cds = scalar($gb->cds());
	my $so = $gb->{"CDS$cds"}->{end} + 1;

	while(defined(%{$gb->{"CDS$i"}})){
		if($i == 0){
			my $sta = $gb->{CDS1}->{start} - 1;
			$gb->{"INTER$num"}->{start} = 1;
			$gb->{"INTER$num"}->{end} = $sta;
			$gb->{"INTER$num"}->{direction} = "direct";
			$gb->{"INTER$num"}->{on} = 1;
			$num++;
		}elsif($i == $cds){
				$gb->{"INTER$num"}->{start} = $so;
				$gb->{"INTER$num"}->{end} = $length;
				$gb->{"INTER$num"}->{direction} = "direct";
				$gb->{"INTER$num"}->{on} = 1;
				$num++;
		}elsif($i > 0){
			my $it = $i + 1; 
			my $start = $gb->{"CDS$i"}->{end};
			my $end = $gb->{"CDS$it"}->{start};
			if($start < $end){
				$start ++;
				$end --;
				$gb->{"INTER$num"}->{start} = $start;
				$gb->{"INTER$num"}->{end} = $end;
				$gb->{"INTER$num"}->{direction} = "direct";
				$gb->{"INTER$num"}->{on} = 1;
				$num++;
			}
		}
		$i++;
	}
}
startcodondescriptiontopprevnext
sub startcodon {
    my $this = shift;
    my $object = shift;

    return substr($this->get_geneseq($object), 0, 3);
}
stopcodondescriptiontopprevnext
sub stopcodon {
    my $this = shift;
    my $object = shift;

    return substr($this->get_geneseq($object), -3, 3);
}

General documentation

AUTHOR top
Kazuharu Gaou Arakawa, gaou@g-language.org
SEE ALSO top
perl(1).