質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.85%

  • Perl

    425questions

    Perlは多目的に使用される実用性が高い動的プログラミング言語のひとつです。

perlスクリプトの不具合

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 61

y-fk

score 7

いつも大変お世話になっております。
自身で作成したperlスクリプトが思うように動かずに困っております。
改善すべき点を御教授頂けたら幸いです。

入力ファイル1:amino_1
>ARGLB_001_00010 hypothetical protein OS=Gordonia rhizosphera NBRC 16068 GN= PE=3
PRHPSSPAPPPQRARARGMTGPGPLSSSCRPGCGSRPPKPAAASSLADAVLPRTGFGGQP
LPPRYEELAAAVSAARIGSRAGTTITLALDRARHLTTADLTAAMEHALTQTAVESDGDFL
TRVTKHWAEAIDQDGTEPSEPALRQIQGAFIRRPKHGLQHLEIFATTEQFETLTTAMNTA
TNP
>ARGLB_002_00010 hypothetical protein OS=Gordonia rhizosphera NBRC 16068 GN= PE=3
APRHPAPLPAPTQPGPAVTGRTVTGPGNRAARPAGTPRTSRKSRWTTGPRARRDSTDSSA
PAKPPSPPTPCPPTADTGPRSWSPSTTATSSPNSTNGTTHSGPH



「>}に続く1行がIDに相当し、次行からの各文字列(数百~数千)に対応する。これがファイル中に数千程度存在する。

入力ファイル2:cds_1
>ARGLB_001_00010 hypothetical protein
GGGGTTGGTGGCGGTGTTCATGGCGGTGGTGAGGGTTTCGAATTGTTCGGTGGTGGCGAA
GATTTCCAGGTGCTGCAGGCCGTGTTTGGGGCGGCGGATGAAGGCGCCCTGGATCTGGCG
GAGGGCcGGTTCGGAGGGTTCGGTCCCGTCCTGGTCGATGGCCTCGGCCCAGTGTTTGGT
GACCCGGGTGAGGAAGTCGCCGTCGCTTTCGACGGCGGTTTGGGTCAGGGCGTGTTCCAT
CGCGGCGGTGAGGTCCGCGGTGGTGAGGTGCCGGGCCCGGTCCAGGGCCAGGGTGATGGT
GGTCCCGGCGCGGGAGCCGATCCGGGCGGCGCTGACCGCGGCGGCGAGTTCTTCGTAGCG
GGGCGGGAGCGGCTGCCCGCCGAACCCGGTCCGGGGCAGGACGGCGTCGGCCAGGGacGA
GGCGGCGGCGGGCTTCGGCGGCCGGGATCCGCAGCCTGGCCTGCAGGAACTCGACAGTGG
TCCGGGACCCGTCATCCCCCGGGCCCGGGCGCGCTGCGGCGGCGGGGCCGGGGACGAGGG
GTGCCGCGG
>ARGLB_002_00010 hypothetical protein
GTGCGGCCCACTGTGCGTTGTGCCGTTGGTGGAGTTCGGCGAGGAGGTCGCGGTAGTTGA
TGGTGACCAGGATCTGGGGCCGGTGTCCGCCGTTGGCGGGCAGGGTGTCGGTGGTGAGGG
CGGTTTGGCAGGCGCCGACGAGTCCGTCGAGTCTCTTCTGGCCCTGGGACCGGTGGTCCA
GCGGGATTTCCGGGAGGTCCGGGGTGTCCCAGCCGGCCGGGCCGCCCTGTTCCCCGGCCC
CGTCACCGTTCGTCCCGTCACTGCCGGTCCCGGTTGCGTCGGTGCCGGTAGGGGTGCCGG
GTGTCGGGGTGC


入力ファイル1とほぼ同じ内容

これらにつきまして、いくつかの作業をすべく、まずは両入力ファイルが続けて出力されるように以下のスクリプトを作成した。
(コメントアウト行は、次なる作業に繋げる所であり、今は気にしない。入力ファイルは両者とも作業ディレクトリに存在)

$aminofile = "amino_1";
$cdsfile = "cds_1";

open (AMINOFILE, $aminofile) or die "cannot open aminofile\n";
while (($amino_name, $amino_seq) = amino_fasta_get($aminofile)) {
        @amino_con = ($amino_seq);
        $amino_name =~ /^(\S+)/;
        $amino_name = $1;

open (CDSFILE, $cdsfile) or die "cannot open cdsfile\n";
while (($cds_name, $cds_seq) = cds_fasta_get($cdsfile)) {
        @cds_con = ($cds_seq);
        $cds_name =~ /^(\S+)/;
        $cds_name = $1;

        for (0..$#amino_con) {
        for (0..$#cds_con)   {
                 print ">$amino_name\n";
                 $con_amino_name = $amino_name;
                 print_amino_seq($amino_con[$_], 80);

                 print ">$cds_name\n";
                 $con_cds_name = $cds_name;
                 print_cds_seq($cds_con[$_], 80);


#print << "SQL";
#BEGIN;
#update mifup.cds set sequence = '{"header":"$amino_name","pep":"$amino_seq","nuc":"$cds_seq"}' where cds_no = '$amino_name';
#COMMIT;
#SQL
            }
         }
      }
 }

sub print_amino_seq
{
          my $amino_seq = shift;
          my $amino_line_len = shift;
          my $amino_seq_len = length $amino_seq;

          unless ($amino_line_len) {
                 ($amino_line_len) = 80;
          }

          for (my $amino_i = 0; $amino_i < $amino_seq_len; $amino_i += $amino_line_len) {
                  print(substr($amino_seq, $amino_i, $amino_line_len) . "\n");
          }
}

sub print_cds_seq
{
          my $cds_seq = shift;
          my $amino_line_len = shift;
          my $cds_seq_len = length $cds_seq;

          unless ($cds_line_len) {
                 ($cds_line_len) = 80;
          }

          for (my $cds_i = 0; $cds_i < $cds_seq_len; $cds_i += $cds_line_len) {
                  print(substr($cds_seq, $cds_i, $cds_line_len) . "\n");
          }
}


sub amino_fasta_get
{
        my $amino_in = shift;
        my($amino_l, $amino_name, $amino_seq);

        while ($amino_l = <$amino_in>) {
                if (substr($amino_l, 0, 1) eq '>') {
                        chomp $amino_l;
                        last;
                }
        }
        if ($amino_l eq '') {
                return ();
        }

        $amino_name = substr($amino_l, 1);

        while ($amino_l = <$amino_in>) {
                if (substr($amino_l, 0, 1) eq '>') {
                        seek($amino_in, -length($amino_l), 1);
                        return ($amino_name, $amino_seq);
                }
                chomp $amino_l;
                $amino_seq .= $amino_l
        }
        return ($amino_name, $amino_seq);
}

sub cds_fasta_get
{
        my $cds_in = shift;
        my($cds_l, $cds_name, $cds_seq);

        while ($cds_l = <$cds_in>) {
                if (substr($cds_l, 0, 1) eq '>') {
                        chomp $cds_l;
                        last;
                }
        }
        if ($cds_l eq '') {
                return ();
        }

        $cds_name = substr($cds_l, 1);

        while ($cds_l = <$cds_in>) {
                if (substr($cds_l, 0, 1) eq '>') {
                        seek($cds_in, -length($cds_l), 1);
                        return ($cds_name, $cds_seq);
                }
                chomp $cds_l;
                $cds_seq .= $cds_l
        }
        return ($cds_name, $cds_seq);
}

動かしてみたところ、エラーも含めて全く何も出力されない。
以前別の作業で、同じような入力ファイルについて、条件つきで出力させるようなスクリプトを作成した際は、
思い通りに動いた。そのスクリプトは以下の通り。

(@ARGV == 2) or die "usage: $0 file.fa min_bp_length\n";

$file = $ARGV[0];
$min_len = $ARGV[1];

($min_len =~ /[^0-9+]/) and die "please input correctly integer\n";
open ($fh, $file) or die "cannot open flie!\n";
while (($name, $seq) = fasta_get($fh)) {
        @con = ($seq);
        $name =~ /^(\S+)/;
        $name = $1;
        for (0..$#con) {
                if (length($con[$_]) >= $min_len) {
                      print ">$name\n";
                      $con_name = $name;
                      print_seq($con[$_], 80);
                }
        }
}

sub print_seq
{
        my $seq = shift;
        my $line_len = shift;
        my $seq_len = length $seq;

        unless ($line_len) {
                $line_len = 80;
        }

        for (my $i = 0; $i < $seq_len; $i += $line_len) {
                print(substr($seq, $i, $line_len) . "\n");
        }
}

sub fasta_get
{
        my $in = shift;
        my($l, $name, $seq);

        while ($l = <$in>) {
                if (substr($l, 0, 1) eq '>') {
                        chomp $l;
                        last;
                }
        }
        if ($l eq '') {
                return ();
        }

        $name = substr($l, 1);

        while ($l = <$in>) {
                if (substr($l, 0, 1) eq '>') {
                        seek($in, -length($l), 1);
                        return ($name, $seq);
                }
                chomp $l;
                $seq .= $l
        }
        return ($name, $seq);
}


サブルーチンの部分は、同じような形式の入力ファイルを扱う際に、ID部とそれに対応する配列部を読み込むアルゴリズムとしてよく使い回している。今回は入力ファイルが複数なので、自身ではそれに対応した形に修正したつもりであるが、そこがうまくいっていないと考えられる。
因みに、perl -wcで確認したところ「syntax OK」であり、perl -dでも自身では問題がある箇所は確認できなかった。

以上におきまして、お取り計らい頂けたら幸いです。
加えて、今回のスクリプトは入力ファイルの数分サブルーチンを増やしましたが、その必要がないような書き方等、追加で御教授頂けることがあれば嬉しい限りです。

どうぞ宜しくお願い致します。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

0

open (AMINOFILE, $aminofile) or die "cannot open aminofile\n";としているのに amino_fasta_get($aminofile)) となっており、amino_fasta_get関数の中ではファイルハンドルが使われていません。

デバッガを使い、 while ($amino_l = <$amino_in>) {の次の行あたりにブレイクポイントを置いて実行してみれば、すぐにも問題に気付けると思います。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/13 14:37

    いつも御回答誠に有難う御座います。大変恥ずかしながら、私は未だ間違いに気づいていないようです。
    amino_fasta_get($aminofile)及びcds_fasta_get($cdsfile)の箇所をそれぞれamino_fasta_get(AMINOFILE), cds_fasta_get(CDSFILE)としただけでは、無限ループになってしまうようです。サブルーチン中の<$amino_in>や<$cds_in>をファイルハンドルや$aminofile, $cdsfileに置換しても結果は変わりません。何か別の箇所に問題があるとは思いますが・・・

    キャンセル

  • 2018/06/13 15:07

    「うまくいったスクリプト」と同じように書けばいいのに、わざわざ違う書き方をして悩んでいるのはなぜでしょうか。AMINOFILEは関数の引数としては使えません。もちろんファイル名はファイルハンドルの代用にはなりません。

    キャンセル

  • 2018/06/13 15:11

    あと、こういう基本的な処理に関してそのつどスクリプトをゼロから書き下ろすのは時間の無駄です。既存のライブラリをうまく活用しましょう。配列情報の処理なら定番のライブラリがあります。
    https://bi.biopapyrus.jp/perl/bioperl/seqio.html

    キャンセル

  • 2018/06/13 16:00

    御多忙のところを大変申し訳御座いませんでした。結果的に、態々サブルーチンをファイル毎に分ける必要性は全くなく、それによってファイル名や変数名をごちゃごちゃ変えることでバグとなってしまったようでした。思うように動いたスクリプトを解決方法の欄に記載させて頂きます。

    キャンセル

0

最終的にうまく動いたスクリプトは以下の通り。ほぼ以前のものをコピペ

$aminofile = "amino_1";
$cdsfile = "cds_1";

open (AMINOFILE, $aminofile) or die "cannot open aminofile\n";
while (($name, $seq) = fasta_get(AMINOFILE)) {
        @con = ($seq);
        $name =~ /^(\S+)/;
        $name = $1;

        for (0..$#con) {
             print ">$name\n";
             $con_name = $name;
             print_seq($con[$_], 80);
   }
}

open (CDSFILE, $cdsfile) or die "cannot open cdsfile\n";
while (($name, $seq) = fasta_get(CDSFILE)) {
        @con = ($seq);
        $name =~ /^(\S+)/;
        $name = $1;

        for (0..$#con) {
             print ">$name\n";
             $con_name = $name;
             print_seq($con[$_], 80);
    }
}

sub print_seq
{
        my $seq = shift;
        my $line_len = shift;
        my $seq_len = length $seq;

        unless ($line_len) {
                $line_len = 80;
        }

        for (my $i = 0; $i < $seq_len; $i += $line_len) {
                print(substr($seq, $i, $line_len) . "\n");
        }
}

sub fasta_get
{
        my $in = shift;
        my($l, $name, $seq);

        while ($l = <$in>) {
                if (substr($l, 0, 1) eq '>') {
                        chomp $l;
                        last;
                }
        }
        if ($l eq '') {
                return ();
        }

        $name = substr($l, 1);

        while ($l = <$in>) {
                if (substr($l, 0, 1) eq '>') {
                        seek($in, -length($l), 1);
                        return ($name, $seq);
                }
                chomp $l;
                $seq .= $l
        }
        return ($name, $seq);
}

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.85%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • Perl

    425questions

    Perlは多目的に使用される実用性が高い動的プログラミング言語のひとつです。