Clinical PK/PD

OUTPUTからの情報抽出

最終更新:

匿名ユーザー

- view
だれでも歓迎! 編集

OUTPUT ファイルからの情報抽出


複数の OUTPUT ファイルから情報を抽出

  • あるフォルダ内にある OUTPUT ファイルすべてから必要な情報を抽出する.
    • フォルダ内に OUTPUT ファイル以外のファイルが保存されていても構わない.OUTPUT ファイルのみを認識して,以下の作業が自動的に行われる.
  • 使い方
    • 1. 下のプログラム (ReadNMoutMulti.pl および NMoutAnal.pl) をひとつのフォルダに保存する
    • 2. Perl をインストールしておく.(Perl 参照)
    • 3. 以下のように実行する.結果は CSV ファイルに出力される.Summary.csv は使用者が任意につける名前.何でもよい.

### カレントフォルダの OUTPUT をすべて対象とする場合 ###
C:\nmv\run>perl ReadNMoutMulti.pl . > Summary.csv

### カレントフォルダの下の OUT フォルダの中のファイルを対象とする場合 ###
C:\nmv\run>perl ReadNMoutMulti.pl out > Summary.csv

注意

  • COV ステップのエラー検出には未対応です.==> 対応しました.
  • 結果の保証はいたしかねます.

ReadNMoutMulti.pl


use strict;
require 'NMoutAnal.pl';
my $ThisScriptName = "ReadNMoutMulti.pl";

if (@ARGV != 1) {
  print "Usage: perl $ThisScriptName FOLDER_name\n\n";
  die;
}

my $dirname = shift @ARGV;

my @result_all;

opendir(DIR, $dirname) or die "$dirname: $!";
while (defined(my $fname = readdir(DIR))) {
  next if ($fname =~ /pl$/);
  next unless (-f "$dirname\\$fname");
  open(FILE, "$dirname\\$fname") or die "$dirname\\$fname: $!";
  my $isOutputFile = 0;
  while (defined(my $line = <FILE>)) {
    if ($line =~
      "DEVELOPED AND PROGRAMMED BY STUART BEAL AND LEWIS SHEINER"
    ) {
      $isOutputFile = 1;
    }
  }
  close(FILE);
  if ($isOutputFile) {
    my %result1 = &NMoutAnal("$dirname\\$fname");
    $result1{'FNAME'} = $fname;
    push(@result_all, \%result1);
  }
}
closedir(DIR);

my $max_ntheta = 0;
my $max_nomega = 0;
my $max_nsigma = 0;

foreach my $res1 (@result_all) {
  if ($res1->{'NTHETA'} > $max_ntheta) {
    $max_ntheta = ${$res1}{'NTHETA'};
  }
  if ($res1->{'NOMEGA'} > $max_nomega) {
    $max_nomega = ${$res1}{'NOMEGA'};
  }
  if ($res1->{'NSIGMA'} > $max_nsigma) {
    $max_nsigma = ${$res1}{'NSIGMA'};
  }
}

print "Output,EST Status,COV Status,NIndiv,Nobs,OBJ";
for (1..$max_ntheta) {
  print ",TH$_";
}
for (1..$max_nomega) {
  print ",OM$_";
}
for (1..$max_nsigma) {
  print ",SG$_";
}
for (1..$max_ntheta) {
  print ",SETH$_";
}
for (1..$max_nomega) {
  print ",SEOM$_";
}
for (1..$max_nsigma) {
  print ",SESG$_";
}
print "\n";

my @values;
my $COV_status;

foreach my $res1 (@result_all) {
  $COV_status = "Success";
  if ($res1->{'COV_STATUS'} == 0) {
    $COV_status = "Failure";
  } elsif ($res1->{'COV_STATUS'} == -1) {
    $COV_status = "Not Implemented";
  }

  print  "$res1->{'FNAME'}";
  print ",$res1->{'STATUS'}";
  print ",$COV_status"; #COV status
  print ",$res1->{'NINDIV'}";
  print ",$res1->{'NOBS'}";
  print ",$res1->{'OBJ'}";

  @values = &ConvEStrToNum($res1->{'THETA'});
  print ",", join(",", @values);
  if ($res1->{'NTHETA'} < $max_ntheta) {
    foreach my $i (($res1->{'NTHETA'} + 1)..$max_ntheta) {
      print ",.";
    }
  }

  @values = &ConvEStrToNum($res1->{'OMEGA'});
  print ",", join(",", @values);
  if ($res1->{'NOMEGA'} < $max_nomega) {
    foreach my $i (($res1->{'NOMEGA'} + 1)..$max_nomega) {
      print ",.";
    }
  }

  @values = &ConvEStrToNum($res1->{'SIGMA'});
  print ",", join(",", @values);
  if ($res1->{'NSIGMA'} < $max_nsigma) {
    foreach my $i (($res1->{'NSIGMA'} + 1)..$max_nsigma) {
      print ",.";
    }
  }

  @values = &ConvEStrToNum($res1->{'SE_THETA'});
  print ",", join(",", @values);
  if ($res1->{'NTHETA'} < $max_ntheta) {
    foreach my $i (($res1->{'NTHETA'} + 1)..$max_ntheta) {
      print ",.";
    }
  }

  @values = &ConvEStrToNum($res1->{'SE_OMEGA'});
  print ",", join(",", @values);
  if ($res1->{'NOMEGA'} < $max_nomega) {
    foreach my $i (($res1->{'NOMEGA'} + 1)..$max_nomega) {
      print ",.";
    }
  }

  @values = &ConvEStrToNum($res1->{'SE_SIGMA'});
  print ",", join(",", @values);
  if ($res1->{'NSIGMA'} < $max_nsigma) {
    foreach my $i (($res1->{'NSIGMA'} + 1)..$max_nsigma) {
      print ",.";
    }
  }

  print "\n";
}

NMoutAnal.pl


use strict;

sub NMoutAnal {
  if (@_ != 1) {
    print "Irregular arguments.\n\n";
    die;
  }

  my $output_file = shift @_;

  if (not -e $output_file) {
    print "File not found: $output_file\n\n";
    die;
  }

  open(OUTPUT, $output_file) or die "$!";
  my @lines = <OUTPUT>;
  my $nlines = @lines; 
  close(OUTPUT);

  my %result;

  my $problem;
  my $tmp;
  my $nobs;
  my $nindiv;
  my $del;
  my $status;
  my $obj;
  my @theta;
  my $ntheta;
  my $str;
  my @omega;
  my $nomega;
  my @sigma;
  my $nsigma;
  my @se_theta;
  my @se_omega;
  my @se_sigma;

  foreach my $i (0..($nlines - 1)) {
    if ($lines[$i] =~ /PROBLEM NO./) {
      $i++;
      chomp($lines[$i]);
      $problem = $lines[$i];
      $problem =~ s/^ +//;
      $problem =~ s/ +$//;
      $result{'PROBLEM'} = $problem;
    } elsif ($lines[$i] =~ /OBS RECS/) {
      chomp($lines[$i]);
      ($tmp, $nobs) = split(/: +/, $lines[$i]);
      $result{'NOBS'} = $nobs;
    } elsif ($lines[$i] =~ /OF INDIVIDUALS/) {
      chomp($lines[$i]);
      ($tmp, $nindiv) = split(/: +/, $lines[$i]);
      $result{'NINDIV'} = $nindiv;
    } elsif ($lines[$i] =~ /MINIMIZATION/) {
      chomp($lines[$i]);
      $del = 0;
      if (substr($lines[$i], 0, 1) eq '0') {
        $del = 1;
      }
      $status = substr($lines[$i], $del);
      $result{'STATUS'} = $status;
    } elsif ($lines[$i] =~ /MINIMUM VALUE OF OBJ/) {
      do {
        $i++;
      } until ($lines[$i] =~ /[\-\d\.]+/);
      $obj = $&;
      $result{'OBJ'} = $obj;
    } elsif ($lines[$i] =~ /FINAL PARAMETER ESTIMATE/) {
      do {
        $i++;
      } until ($lines[$i] =~ /TH 1/);
      $i += 2;
      chomp($lines[$i]);
      @theta = split(' ', $lines[$i]);
      $ntheta = @theta;
      $result{'NTHETA'} = $ntheta;
      $result{'THETA'} = "@theta";

      if ($lines[$i + 4] =~ /OMEGA/) {
        do {
          $i++;
        } until ($lines[$i] =~ /^ ?ETA1/);
        $i++;
        chomp($lines[$i]);
        $del = 0;
        if (substr($lines[$i], 0, 1) eq '+') {
          $del = 1;
        }
        $str = substr($lines[$i], $del);
        @omega = split(' ', $str);

        $i += 2;
        while ($lines[$i] =~ /^ ?ETA/) {
          $i++;
          chomp($lines[$i]);
          $del = 0;
          if (substr($lines[$i], 0, 1) eq '+') {
            $del = 1;
          }
          $str = substr($lines[$i], $del);
          @omega = (@omega, split(' ', $str));
          $i += 2;
        };
        $nomega = @omega;

        $result{'NOMEGA'} = $nomega;
        $result{'OMEGA'} = "@omega";
      }

      if ($lines[$i + 2] =~ /SIGMA/) {
        do {
          $i++;
        } until ($lines[$i] =~ /^ ?EPS1/);
        $i++;
        chomp($lines[$i]);
        $del = 0;
        if (substr($lines[$i], 0, 1) eq '+') {
          $del = 1;
        }
        $str = substr($lines[$i], $del);
        @sigma = split(' ', $str);
        $i += 2;
        while ($lines[$i] =~ /^ ?EPS/) {
          $i++;
          chomp($lines[$i]);
          $del = 0;
          if (substr($lines[$i], 0, 1) eq '+') {
            $del = 1;
          }
          $str = substr($lines[$i], $del);
          @sigma = (@sigma, split(' ', $str));
          $i += 2;
        };
        $nsigma = @sigma;

        $result{'NSIGMA'} = $nsigma;
        $result{'SIGMA'} = "@sigma";
      }
    } elsif ($lines[$i] =~ /STANDARD ERROR/) {
      do {
        $i++;
      } until ($lines[$i] =~ /TH 1/);
      $i += 2; 
      chomp($lines[$i]);
      @se_theta = split(' ', $lines[$i]);

      $result{'SE_THETA'} = "@se_theta";

      
      if ($lines[$i + 4] =~ /OMEGA/) {
        do {
          $i++; 
        } until ($lines[$i] =~ /^ ?ETA1/);
        $i++; 
        chomp($lines[$i]);
        
        $del = 0;
        if (substr($lines[$i], 0, 1) eq '+') {
          $del = 1;
        }
        $str = substr($lines[$i], $del);
        @se_omega = split(' ', $str);
        $i += 2; 
        while ($lines[$i] =~ /^ ?ETA/) {
          $i++;
          chomp($lines[$i]);
          
          $del = 0;
          if (substr($lines[$i], 0, 1) eq '+') {
            $del = 1;
          }
          $str = substr($lines[$i], $del);
          @se_omega = (@se_omega, split(' ', $str));
          $i += 2;
        };
        $result{'SE_OMEGA'} = "@se_omega";
      }

      if ($lines[$i + 2] =~ /SIGMA/) {
        do {
          $i++; 
        } until ($lines[$i] =~ /^ ?EPS1/);
        $i++; 
        chomp($lines[$i]);
        
        $del = 0;
        if (substr($lines[$i], 0, 1) eq '+') {
          $del = 1;
        }
        $str = substr($lines[$i], $del);
        @se_sigma = split(' ', $str);
        $i += 2; 
        while ($lines[$i] =~ /^ ?EPS/) {
          $i++;
          chomp($lines[$i]);
          
          $del = 0;
          if (substr($lines[$i], 0, 1) eq '+') {
            $del = 1;
          }
          $str = substr($lines[$i], $del);
          @se_sigma = (@se_sigma, split(' ', $str));
          $i += 2;
        };
        $result{'SE_SIGMA'} = "@se_sigma";
      }
    }
  }

  # COV ステップエラーの検出
  my $COV_status = -1; # NOT IMPLEMENTED
  foreach my $line (@lines) {
    if ($line =~ /COVARIANCE STEP OMITTED.*$/) {
      my ($tmp, $COV_exec) = split(/:/, $&);
      if ($COV_exec =~ /NO/) {
        $COV_status = 1; # IMPLEMENTED
      }
    }
  }
  if ($COV_status == 1) {
    # COV ステップが実行されている
    if (!($se_theta[0] > 0)) {
      $COV_status = 0;
    }
  }
  $result{'COV_STATUS'} = $COV_status;

  return %result;
}



sub ConvEStrToNum {
  my $str = shift @_;
  my @value = split(/ /, $str);
  foreach (@value) {
    $_ += 0;
  }
  return (@value);
}

1;

タグ:

+ タグ編集
  • タグ:

このサイトはreCAPTCHAによって保護されており、Googleの プライバシーポリシー利用規約 が適用されます。

目安箱バナー