[Bio] / FigKernelPackages / Tracer.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Tracer.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.120, Thu Jun 4 18:27:33 2009 UTC revision 1.121, Thu Jun 18 01:29:19 2009 UTC
# Line 3696  Line 3696 
3696      my $cmp = Tracer::Cmp($a, $b);      my $cmp = Tracer::Cmp($a, $b);
3697    
3698  This method performs a universal sort comparison. Each value coming in is  This method performs a universal sort comparison. Each value coming in is
3699  separated into a leading text part and a trailing number part. The text  separated into a text parts and number parts. The text
3700  part is string compared, and if both parts are equal, then the number  part is string compared, and if both parts are equal, then the number
3701  parts are compared numerically. A stream of just numbers or a stream of  parts are compared numerically. A stream of just numbers or a stream of
3702  just strings will sort correctly, and a mixed stream will sort with the  just strings will sort correctly, and a mixed stream will sort with the
3703  numbers first. Strings with a label and a number will sort in the  numbers first. Strings with a label and a number will sort in the
3704  expected manner instead of lexically.  expected manner instead of lexically. Undefined values sort last.
3705    
3706  =over 4  =over 4
3707    
# Line 3735  Line 3735 
3735          $retVal = 1;          $retVal = 1;
3736      } else {      } else {
3737          # Here we have two real values. Parse the two strings.          # Here we have two real values. Parse the two strings.
3738          my $aParsed = _Parse($a);          my @aParsed = _Parse($a);
3739          my $bParsed = _Parse($b);          my @bParsed = _Parse($b);
3740            # Loop through the first string.
3741            while (! $retVal && @aParsed) {
3742                # Extract the string parts.
3743                my $aPiece = shift(@aParsed);
3744                my $bPiece = shift(@bParsed) || '';
3745                # Extract the number parts.
3746                my $aNum = shift(@aParsed);
3747                my $bNum = shift(@bParsed) || 0;
3748          # Compare the string parts insensitively.          # Compare the string parts insensitively.
3749          $retVal = (lc $aParsed->[0] cmp lc $bParsed->[0]);              $retVal = (lc($aPiece) cmp lc($bPiece));
3750          # If they're equal, compare them sensitively.          # If they're equal, compare them sensitively.
3751          if (! $retVal) {          if (! $retVal) {
3752              $retVal = ($aParsed->[0] cmp $bParsed->[0]);                  $retVal = ($aPiece cmp $bPiece);
         }  
3753          # If they're STILL equal, compare the number parts.          # If they're STILL equal, compare the number parts.
3754          if (! $retVal) {          if (! $retVal) {
3755              $retVal = $aParsed->[1] <=> $bParsed->[1];                      $retVal = $aNum <=> $bNum;
3756                    }
3757                }
3758          }          }
3759      }      }
3760      # Return the result.      # Return the result.
3761      return $retVal;      return $retVal;
3762  }  }
3763    
3764  # This method parses an input string into a string part and a number part.  # This method parses an input string into a string parts alternating with
3765    # number parts.
3766  sub _Parse {  sub _Parse {
3767        # Get the incoming string.
3768      my ($string) = @_;      my ($string) = @_;
3769      my ($alpha, $num);      # The pieces will be put in here.
3770      if ($string =~ /^(.*?)(\d+(?:\.\d+)?)$/) {      my @retVal;
3771          $alpha = $1;      # Loop through as many alpha/num sets as we can.
3772          $num = $2;      while ($string =~ /^(\D*)(\d+)(.*)/) {
3773      } else {          # Push the alpha and number parts into the return string.
3774          $alpha = $string;          push @retVal, $1, $2;
3775          $num = 0;          # Save the residual.
3776            $string = $3;
3777        }
3778        # If there's still stuff left, add it to the end with a trailing
3779        # zero.
3780        if ($string) {
3781            push @retVal, $string, 0;
3782      }      }
3783      return [$alpha, $num];      # Return the list.
3784        return @retVal;
3785  }  }
3786    
3787  =head3 ListEQ  =head3 ListEQ

Legend:
Removed from v.1.120  
changed lines
  Added in v.1.121

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3