code_perl/Maasha/Solid.pm

   1 package Maasha::Solid;
   2
   3
   4 # Copyright (C) 2007-2008 Martin A. Hansen.
   5
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License
   8 # as published by the Free Software Foundation; either version 2
   9 # of the License, or (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  19
  20 # http://www.gnu.org/copyleft/gpl.html
  21
  22
  23 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  24
  25
  26 # Routines for manipulation Solid sequence files with di-base encoding.
  27
  28
  29 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  30
  31
  32 use vars qw( @ISA @EXPORT_OK );
  33
  34 require Exporter;
  35
  36 @ISA = qw( Exporter );
  37
  38
  39 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CONSTANTS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  40
  41
  42 my %CONVERT_HASH = (
  43     'A0' => 'A',   'AA' => 0,
  44     'A1' => 'C',   'AC' => 1,
  45     'A2' => 'G',   'AG' => 2,
  46     'A3' => 'T',   'AT' => 3,
  47     'C0' => 'C',   'CA' => 1,
  48     'C1' => 'A',   'CC' => 0,
  49     'C2' => 'T',   'CG' => 3,
  50     'C3' => 'G',   'CT' => 2,
  51     'G0' => 'G',   'GA' => 2,
  52     'G1' => 'T',   'GC' => 3,
  53     'G2' => 'A',   'GG' => 0,
  54     'G3' => 'C',   'GT' => 1,
  55     'T0' => 'T',   'TA' => 3,
  56     'T1' => 'G',   'TC' => 2,
  57     'T2' => 'C',   'TG' => 1,
  58     'T3' => 'A',   'TT' => 0,
  59                    'AN' => 4,
  60                    'CN' => 4,
  61                    'GN' => 4,
  62                    'TN' => 4,
  63                    'NA' => 5,
  64                    'NC' => 5,
  65                    'NG' => 5,
  66                    'NT' => 5,
  67                    'NN' => 6,
  68 );
  69
  70
  71 # from Solid - ABI
  72
  73 sub define_color_code {
  74
  75     my %color = ();
  76
  77     $color{AA} = 0;
  78     $color{CC} = 0;
  79     $color{GG} = 0;
  80     $color{TT} = 0;
  81     $color{AC} = 1;
  82     $color{CA} = 1;
  83     $color{GT} = 1;
  84     $color{TG} = 1;
  85     $color{AG} = 2;
  86     $color{CT} = 2;
  87     $color{GA} = 2;
  88     $color{TC} = 2;
  89     $color{AT} = 3;
  90     $color{CG} = 3;
  91     $color{GC} = 3;
  92     $color{TA} = 3;
  93     $color{AN} = 4;
  94     $color{CN} = 4;
  95     $color{GN} = 4;
  96     $color{TN} = 4;
  97     $color{NA} = 5;
  98     $color{NC} = 5;
  99     $color{NG} = 5;
 100     $color{NT} = 5;
 101     $color{NN} = 6;
 102
 103     return(%color);
 104 }
 105
 106
 107 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 108
 109
 110 sub color_space2seq
 111 {
 112     # Martin A. Hansen, April 2008.
 113
 114     # Converts a di-base encoded Solid sequence to
 115     # regular sequence.
 116
 117     my ( $seq_cs,   # di-base encode sequence
 118        ) = @_;
 119
 120     # Returns a string.
 121
 122     my ( @codes, $base, $i, $seq );
 123
 124     @codes = split //, $seq_cs;
 125     $base  = shift @codes;
 126     $seq   = $base;
 127
 128     for ( $i = 0; $i < @codes; $i++ )
 129     {
 130         $base = $CONVERT_HASH{ $base . $codes[ $i ] };
 131         $seq .= $base;
 132     }
 133
 134     return $seq;
 135 }
 136
 137
 138 sub seq2color_space
 139 {
 140     # Martin A. Hansen, April 2008.
 141
 142     # Converts a sequence to di-base encoded Solid sequence.
 143
 144     my ( $seq,   # sequence
 145        ) = @_;
 146
 147     # Returns a string.
 148
 149     my ( $i, $seq_cs );
 150
 151     $seq_cs = substr $seq, 0, 1;
 152
 153     for ( $i = 0; $i < length( $seq ) - 1; $i++ ) {
 154         $seq_cs .= $CONVERT_HASH{ substr( $seq, $i, 2 ) };
 155     }
 156
 157     return $seq_cs;
 158 }
 159
 160
 161 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 162
 163
 164 1;