<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl

if (scalar(@ARGV) &lt;= 0) {
    print "perl analyze.pl &lt;cmd&gt; &lt;args&gt;\n";
    exit(1);
}

my $cmd = shift(@ARGV);
if ($cmd eq "select") {
  &amp;globalSelect(@ARGV);
}
if ($cmd eq "idlist") {
  &amp;analyzeIDlist(@ARGV);
}

sub getHash {
  my ($file, $index, $spstr, $spindex, $rest) = @_;
  if (!defined $index) {
    $index = 0;
  }
  my $hash = {};
  my $fh;
  if ($file eq "-") {
    $fh = \*STDIN;
  }
  else {
    open($fh, "&lt;$file") || die "Can't open $file\n";
  }
  while (my $in = &lt;$fh&gt;) {
    $in =~ s/[\r\n]//g;
    my @list = split("\t", $in, -1);
    my $id = $list[$index];
    if (defined $spstr) {
      $spindex = 0 if (!defined $spindex);
      my @l = split($spstr, $list[$index]);
      $id = $l[$spindex];
      $id =~ s/\s//g;
    }
    $hash-&gt;{$id} = [@list];
  }
  if ($file ne "-") {
    close($fh);
  }
  return $hash;
}

sub mse {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $result = 0.0;
  if ($start &gt; $end) {
    return $result;
  }
  my $m = &amp;mean($arrayref, $start, $end);
  my $result = 0.0;
  for (my $i = $start; $i &lt;= $end; $i++) {
    $result += ($arrayref-&gt;[$i] - $m) * ($arrayref-&gt;[$i] - $m);
  }
  return $result;
}

sub max {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $result = $arrayref-&gt;[$start];
  if ($start &gt; $end) {
    return $result;
  }
  for (my $i = $start; $i &lt;= $end; $i++) {
    if ($result &lt; $arrayref-&gt;[$i]) {
      $result = $arrayref-&gt;[$i];
    }
  }
  return $result;
}

sub min {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $result = $arrayref-&gt;[$start];
  if ($start &gt; $end) {
    return $result;
  }
  for (my $i = $start; $i &lt;= $end; $i++) {
    if ($result &gt; $arrayref-&gt;[$i]) {
      $result = $arrayref-&gt;[$i];
    }
  }
  return $result;
}

sub median {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $result = 0.0;
  if ($start &gt; $end) {
    return $result;
  }
  $result = $arrayref-&gt;[int(($start+$end)/2)];
  return $result;
}

sub mean {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $result = 0.0;
  if ($start &gt; $end) {
    return $result;
  }
  for (my $i = $start; $i &lt;= $end; $i++) {
    $result += $arrayref-&gt;[$i];
  }
  return $result / ($end - $start + 1);
}

sub stddev {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $sum = 0.0;
  if ($start &gt;= $end) {
    return $sum;
  }
  my $sumsq = 0;
  for (my $i = $start; $i &lt;= $end; $i++) {
    $sum += $arrayref-&gt;[$i];
    $sumsq += $arrayref-&gt;[$i] * $arrayref-&gt;[$i];
  }
  my $m = $sum / ($end - $start + 1);
  my $msq = $sumsq / ($end - $start + 1);
  my $factor = ($end - $start + 1) / ($end - $start);
  my $res = $factor * ($msq - $m * $m);
  if ($res &lt; 0) { $res = 0; }
  return sqrt($res);
}

sub variance {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $sum = 0.0;
  if ($start &gt;= $end) {
    return $sum;
  }
  my $sumsq = 0;
  for (my $i = $start; $i &lt;= $end; $i++) {
    $sum += $arrayref-&gt;[$i];
    $sumsq += $arrayref-&gt;[$i] * $arrayref-&gt;[$i];
  }
  my $m = $sum / ($end - $start + 1);
  my $msq = $sumsq / ($end - $start + 1);
  my $factor = ($end - $start + 1) / ($end - $start);
  return ($msq - $m * $m);
}

sub sum {
  my ($arrayref, $start, $end) = @_;
  if (!defined $start) {
    $start = 0;
  }
  if (!defined $end) {
    $end = scalar(@$arrayref) - 1;
  }
  my $result = 0.0;
  for (my $i = $start; $i &lt;= $end; $i++) {
    $result += $arrayref-&gt;[$i];
  }
  return $result;
}

sub fitStep {
  my ($data, $start, $end, $times) = @_;
  my $count = $end - $start + 1;
  if ($count &lt;= 0) {
    return [0, 0, 0, 0, 0, 0, 0, 0];
  }
  if (!defined $times) {
    $times = [0 .. $end];
  }
  else {
    my @sk = sort { $times-&gt;[$a] &lt;=&gt; $times-&gt;[$b] } $start .. $end;
    $data = [map { $data-&gt;[$_] } @sk];
    $times = [map { $times-&gt;[$_] } @sk];
    $start = 0;
    $end = $count - 1;
  }
  my @sseArray = map { 0.0 } 0 .. ($count - 1);
  my $sum = &amp;sum($data, $start, $end);
  my $mean = &amp;mean($data, $start, $end);
  my $sstot = &amp;mse($data, $start, $end);
  my $sum1 = 0.0;
  my $count1 = 0;
  my $m1 = 0.0;
  my $sum2 = $sum;
  my $count2 = $count;
  my $m2 = ($sum/$count);
  my $sum1sq = 0.0;
  my $sum2sq = $sstot;
  my $sse = $sum1sq + $sum2sq;
  for (my $i = 0; $i &lt; $count; $i++) {
    my $entry = $data-&gt;[$i + $start];
    if (!defined $entry || $entry eq "") {
      $sseArray[$i] = $sse;
      next;
    }
    $count1 ++;
    $count2 --;
    if ($count2 == 0) {
      $sseArray[$i] = $sstot;
      next;
    }
    my $tmp = ($mean - ($entry + $sum1)/$count1);
    $sum1sq = $sum1sq + ($entry - $mean) * ($entry - $mean) - 
      $tmp * $tmp * $count1 + ($count1 - 1) * ($mean - $m1) * ($mean - $m1);
    $tmp = ($mean - ($sum2 - $entry)/$count2);
    $sum2sq = $sum2sq - ($entry - $mean) * ($entry - $mean) - 
      $tmp * $tmp * $count2 + ($count2 + 1) * ($mean - $m2) * ($mean - $m2);
    $sum1 += $entry;
    $sum2 -= $entry;
    $m1 = $sum1/$count1;
    $m2 = $sum2/$count2;
    $sse = $sum1sq + $sum2sq;
    $sseArray[$i] = $sse;
  }
  #print join(",", map { sprintf("%.2f", $_) } @sseArray), "\n-----------\n";
  my $bestSse;
  my $bestIndex = 0;
  my $dof = 0;
  for (my $i = 0; $i &lt; $count ; $i++) {
    if ($i &lt; ($count - 1)) {
       next if ($times-&gt;[$i+$start] eq $times-&gt;[$i+$start+1]);
    }
    $dof++;
    my $index = $i + $start;
    if (!defined $bestSse) {
      $bestSse = $sseArray[$i];
      $bestIndex = $index;
    }
    if ($sseArray[$i] &lt; $bestSse) {
      $bestSse = $sseArray[$i];
      $bestIndex = $index;
    }
    #{# Debug code start
    #  $entry = $data-&gt;[$index];
    #  $sum1sq = &amp;mse($data, $start, $index);
    #  $sum2sq = &amp;mse($data, $index + 1, $end);
    #  $sse = $sum1sq + $sum2sq;
    #  printf "%.2f\t%.2f\t%.2f\t%.2f\n", $sseArray[$i], $entry, $sse, $sum1sq;
    #}# Debug code end
  }
  #printf "bestSse = %.2f\t bestIndex=%d\n", $bestSse, $bestIndex;
  $m1 = &amp;mean($data, $start, $bestIndex);
  $m2 = &amp;mean($data, $bestIndex + 1, $end);
  my $thr = ($m1 + $m2)/2.0;
  #{# Debug code start
  #  $sum1sq = &amp;mse($data, $start, $bestIndex);
  #  $sum2sq = &amp;mse($data, $bestIndex + 1, $end);
  #  $sse = $sum1sq + $sum2sq;
  #  if ($sse != $bestSse) {
  #    print STDERR "SSE calculation is wrong :", $sse, ":", $bestSse, "\n";
  #  }
  #}# Debug code end
  my $label = 0;
  if ($m1 &lt; $m2) {
    $label = 1;
  }
  else {
    $label = 2;
  }
  my $statistic = 0;
  if ($bestSse &gt; 0) {
    if ($dof &gt; 4) {
      $statistic = ($sstot - $bestSse)/3/($bestSse/($dof - 4));
    }
    else {
      $statistic = ($sstot - $bestSse)/2/$bestSse;
    }
  }
  return [$bestIndex, $bestSse, $sstot, $statistic, $m1, $m2, $thr, $label];
}

sub globalSelect {
  my ($file, $rest) = @_;
  my $hash = &amp;getHash($file, 2);
  my $ids = [keys %{$hash}];
  my @data = sort { $a &lt;=&gt; $b } map {$hash-&gt;{$_}-&gt;[0]} @$ids;
  my $res = &amp;fitStep(\@data, 0, $#data);
  my $thr = $res-&gt;[6];
  print STDERR $thr, "\n";
  $ids = [sort { $hash-&gt;{$b}-&gt;[1] &lt;=&gt; $hash-&gt;{$a}-&gt;[1]} grep {$hash-&gt;{$_}-&gt;[0] &gt; $thr} @$ids];
  foreach my $id (@$ids) {
    print join("\t", @{$hash-&gt;{$id}}), "\n";
  }
}

sub analyzeIDlist {
  my ($pclfile, $listfile, $rest) = @_;
  open(FL, "&lt;$listfile") || die "Can't open $listfile\n";
  my $hash = {};
  while (&lt;FL&gt;) {
    s/[\r\n]//g;
    my ($id, $rest) = split("\t");
    $id =~ s/\s//g;
    $hash-&gt;{$id} = 1;
  }
  close(FL);
  open(FL, "&lt;$pclfile") || die "Can't open $pclfile\n";
  while (&lt;FL&gt;) {
    s/[\r\n]//g;
    my $line = $_;
    my ($id, $rest) = split("\t");
    $id =~ s/\s//g;
    if (defined $hash-&gt;{$id}) {
      print "$line\n";
    }
  }
  close(FL);
}

</pre></body></html>