系統解析に使えそうな Perl script をつくっています．簡単な参考書やこちらのサイトを参照しながら使ってください．

perl -v

私はアップグレードしたかったのですが，やり方がわからず (アップグレードは無いのかもしれません)，結局インストールしました．こちらから最新版をダウンロードしてください (The latest releases in each branch という表です)．ただし，5.13 などのように奇数は安定していないようなので，偶数を選んだ方が無難です．私は 5.12.2 をダウンロードしました．解凍して得られたフォルダに入り，以下の順番でコマンドをうちます．全体で 10 分位かかったでしょうか．

$ sh Configure -de
$ make
$ sudo make install
$ make clean

以下を test.pl として保存します．ターミナルから，「perl test.pl」と入力してください．

#!/usr/bin/perl
use strict;
use warnings;

print "Hello World.\n";

塩基配列以外の文字を取り除く

$line =~ s/[^a-z]//g;

ギャップを取り除く

$sequence =~ s/-//g;

perl -i.bak -p -e 's/#ffffdd/#aaaacc/ig;' *.html

perl PerlController.pl PerlScript.pl

アウトプットディレクトリを作成する．
my $OutFolder = "Out_fol";

# Output folder is made.
if (-d "$OutFolder") {
system ("rm -r $OutFolder");
}
if (!-d "$OutFolder") {
mkdir("$OutFolder", 0755);
}

ディレクトリに入っているファイル名を配列に格納する
opendir (DIR,".") || die "cannot open :$!\n";
@dirfile = readdir(DIR);
close(DIR);

System 関数によって他のプログラムを操作する.
system("perl PERLSCRIPT.pl INFILE > OUTFILE");

#!/usr/bin/perl
use strict;
use warnings;
use Cwd;
my $cur_dir = getcwd();
print "Current directory:\n$cur_dir\n";

@array = ("apple", "application","pineapple","wine","windows");
$count = grep(/^app/, @array);
@items = grep(/^app/, @array);
print "件数は $count、内容は@items．\n";

実行結果は以下の通り.
件数は2、内容はapple application.

* 完全一致．

if(grep($_ eq "apple", @array))

* メタ文字を文字そのものとして判断させるには m|\Q〜\E| を使う．

if(grep m|\Qhttp://www.geocities.jp\E|, @array)

補足. メタ文字を文字そのものとして判断させる手法は，かなり便利．

$genomesHtmlLine =~ s|\QLoss(0)<br>= XXX</td>\E||g;

my $count = $line =~ tr/,//;
print "$count\n";

「out_ENSG00000000003_ENST00000373020」
-> 「ENSG00000000003_ENST00000373020」

NameChange_fol.tar.gz

#!/usr/bin/perl -w
# perl fasHash.pl db.fas > out.fas

use strict;
use warnings;

my $infile = "db.fas";

open(INFILE,"$infile") or die "$!";
my @inFileCont = ;
close INFILE;

my ($ref_fasHash,$ref_nameArray, $sequenceLength) 
     = &fastaReadHash(\@inFileCont);

foreach my $name (@$ref_nameArray){
  print "$name\n";
  print "$$ref_fasHash{$name}\n";
}

exit;

sub fastaReadHash
{
  my $name = "";
  my $sequence = "";
  my $sequenceLength = "";
  my $flag = 0;
  my @nameArraySR = ( );
  my %fasHashSR = ( );

  my ($inFileContSR) = @_;

  foreach my $inFileLine (@$inFileContSR) {
    chomp($inFileLine);
    if($inFileLine =~ /^>/){  
      if($flag == 0){$name = $inFileLine;
        $flag = 1;  
      } else {
        $fasHashSR{$name} = $sequence;  
        push(@nameArraySR,$name);
        $name = "$inFileLine";
        $sequence = "";
      }
    } else {
      $sequence .= $inFileLine; 
    }
  }
  $fasHashSR{$name} = $sequence;
  $sequenceLength = length($sequence);
  push(@nameArraySR,$name);

  return (\%fasHashSR,\@nameArraySR,\$sequenceLength);
}

#!/usr/bin/perl -w 
use strict; 
use warnings; 

my $inFile = "infile.txt"; 
open(IN,"$inFile") or die "Cannot find $inFile\n"; 
my @inFileCont = <IN>; close IN; 

my ($refRec, $totalLength) = &fasReader2d(\@inFileCont); 
my @recs = @$refRec; 

foreach my $ele (@recs) { 
  print "$ele->[0]\n"; 
  my @tempSeq = @{$ele->[1]}; 
  foreach my $ch (@tempSeq){ 
    print "$ch"; } print "\n"; 
  }

exit; 

sub fasReader2d{ 
  my $uniqNameSR = ""; 
  my $seqLength = "";
  my $flag = 0; 
  my @recs2D = (); 
  my @tempSeq = (); 
  my $tempSeq = ""; 
  
  my ($inFileContSR) = @_; 

  foreach my $inFileLine (@$inFileContSR) {
   chomp($inFileLine); 
    if($inFileLine =~ /^>/){
      if($flag == 0){ 
        $uniqNameSR = $inFileLine; 
        $flag = 1;  
      } 
      else { 
        my @tempSeqArray = split(//, $tempSeq); 
        print "tempSeq $tempSeq\n"; 
        push(@recs2D, [$uniqNameSR, \@tempSeqArray]); 
        $uniqNameSR = $inFileLine; $tempSeq = "";
      } 
    } 
    else {
      $tempSeq .= $inFileLine; 
    }
  }
  my @tempSeqArray = split(//, $tempSeq);
  push(@recs2D, [$uniqNameSR, \@tempSeqArray]);
  $seqLength = scalar(@tempSeq);
    
  return (\@recs2D, $seqLength);
}

キーワードが name line に含まれるレコードをデータベースから抽出します．
retRecords.tar.gz　(2016 年 7 月)

% perl SeqSlicer.pl seqFile.txt scaffold_66 10 20
aggtgtgctt

SeqSlicer_fol.tar.gz

infile 内部にある OTU 名の変換を行い，outfile に書き出します．

「AB005035」-> 「Lancelet_AB005035」

motifFinder.tar.gz

$match に入力したモチーフを探します．

my $match = "TCACA[CG]";

TCACACG か TCACACC を表します．

my $match = "T..CACCT";

.. に任意の 2 文字が入っていることを意味します．

(2016 年 3 月)

my @nameArrays = (Xenopus8, Cod4, Fugu5)
my $longestName = &logestNamePicker(\@nameArrays);

sub logestNamePicker {
  my ($refNames) = @_;
  my @nameArrays = @$refNames;

  my @nameArrays2D = ( );
  foreach my $nameSR (@nameArrays){
    push(@nameArrays2D,[length($nameSR), $nameSR]);
  }

  my @name2dSorted = sort{$b->[0] <=> $a->[0]}@nameArrays2D;
  my $longestName = $name2dSorted[0][1];
  return($longestName);
}

[inouejun:tBlastNResPicker]$ perl 010_autoQueryMaker.pl
1.ENSP00000375041
2.ENSP00000374824
3.ENSP00000374825

[inouejun:tBlastNResPicker]$ cd 020_transcripts/
[inouejun:020_transcripts]$ sh command.sh
Building a new DB, current time: 01/23/2015 19:12:29
New DB name: transcripts.fas
New DB title: transcripts.fas
....
[inouejun:020_transcripts]$ cd ../

[inouejun:tBlastNResPicker]$ perl 030_autoTblastn.pl
1.ENSP00000374824.txt
2.ENSP00000374825.txt
3.ENSP00000375041.txt

[inouejun:tBlastNResPicker]$ perl 040_autoSixWayTranslation.pl
#### 1.ENSP00000374824.txt ####
#### 2.ENSP00000374825.txt ####
#### 3.ENSP00000375041.txt ####
[inouejun:tBlastNResPicker]$

# reverse the DNA sequence
my $revcomp = reverse($dna);

# complement the reversed DNA sequence
$revcomp =~ tr/ABCDGHMNRSTUVWXYabcdghmnrstuvwxy
　　　　　　　　 /TVGHCDKNYSAABWXRtvghcdknysaabwxr/;

revCom.pl.tar.gz

sub uniqArrayOneslf{
  my $refArray = shift@_;
  my @uniqArray;
  foreach my $name (@$refArray) {
    if(grep($_ eq "$name", @uniqArray) == 0){
      push(@uniqArray,$name);
    }
  }
  return \@uniqArray;
}

sub printSequence {
  my($seqSR, $lengthSR) = @_;
  for (my $pos = 0 ; $pos < length($seqSR) ; $pos += $lengthSR ) {
      print substr($seqSR, $pos, $lengthSR), "\n";
  }
}

				  

perl TreePhyNex.pl infile.PHYLIP > outfile.nex

TreePhyNex.pl.txt

NexToFas_fol.tar.gz [2010 年 12 月]

サブルーチンの抜粋は以下

my($ref_seqHash,$ref_nameArray) = &nexReader(\@inFileCont);
my %seqHash2 = %$ref_seqHash;
my @nameArray2 = @$ref_nameArray;

# プリントアウト
open(OUT,">$outFile");
foreach (@nameArray2) {
  print OUT ">$_\n$seqHash2{$_}\n";
}

###### サブルーチン
sub nexReader
{
  my $stone = 0;
  my @nameArray = ( );
  my %seqHash = ( );
  my ($ref_inFileCont) = @_; 
  my @inFileCont = @$ref_inFileCont;

  foreach my $line (@inFileCont) {
    chomp($line);

    if($line =~ /^END;/){             # 解析終了．
      $stone = 0;
    }	     

    if($stone == 1) {                   # MATRIX〜END; 間の解析
      if($line =~ /^[a-zA-Z0-1]/) {     # sequence のある行を認識
        $line =~ s/ +\[\d+\]//g;        # スペース[数字]　を除去
        my($name,$seq) = split(/ +/,$line);

        # @nameArray に OTU 名があれば
        #ハッシュだけ作って OTU 名を新たに格納しない．
        if(grep($_ eq "$name", @nameArray)){ 
          $seqHash{$name} .= $seq;
          next;

        # @nameArray に OTU 名があれば，OTU 名を格納し，
        # ハッシュを作成する．これは最初の段だけ．
        } else { 
          push(@nameArray,$name);
          $seqHash{$name} .= $seq;
        }
      }
    }

    if($line =~ /^MATRIX/){             # 解析開始．
      $stone = 1;
    }

  }
  return(\%seqHash,\@nameArray);
}

Pdistance.pl
E001 vs E001 Seq Lenght: 789; Dif sites: 0; P dist: 0.000
E001 vs E002 Seq Lenght: 789; Dif sites: 50; P dist: 0.063
E001 vs E004 Seq Lenght: 789; Dif sites: 58; P dist: 0.074

E002 vs E001 Seq Lenght: 789; Dif sites: 50; P dist: 0.063
E002 vs E002 Seq Lenght: 789; Dif sites: 0; P dist: 0.000
E002 vs E004 Seq Lenght: 789; Dif sites: 45; P dist: 0.057

E004 vs E001 Seq Lenght: 789; Dif sites: 58; P dist: 0.074
E004 vs E002 Seq Lenght: 789; Dif sites: 45; P dist: 0.057
E004 vs E004 Seq Lenght: 789; Dif sites: 0; P dist: 0.000

PAUP
E002 Dolphin E001 Human 0.06802721
E004 Megabat E001 Human 0.07900394
E004 Megabat E002 Dolphin 0.06131519

PdistAdv_fol.tar.gz

* 小数点以下 3 桁まで表示します．
$formated = sprintf( "%.3f", $pdist);

jason2seqnece.tar.gz
解析に際し，FigTree などを使って，newick format を Jason format に書き換える必要があります (2018 年 12 月)．

newick 形式を読んで，クレードに含まれる leaf をクレードの大きい順に書き出す．

cladePicker.pl.tar.gz

二つの系統樹に含まれる OTU 構成は同じにしてください．遺伝子の系統樹 (比べる対象) の OTU 名の最初は，種の系統樹で用いた OTU 名にして，「_」(アンダーバー) を挟んで遺伝子名などを書くようにしてください [2012 年 3 月]．
treeComparison.tar.gz