in reply to Measuring Substrings Problem

I haven't tested the code below very much; you should if you think you many want to use it.

#!/usr/bin/perl -wl use strict; use List::Util qw( min max sum ); sub score { my ($str, @array) = @_; my @pos = sort { $a->[ 0 ] <=> $b->[ 0 ] } map [ $_->[ 0 ], $_->[ 0 ] + length $_->[ 1 ] ], grep $_->[ 0 ] > -1, map [ index( $str, $_ ), $_ ], @array; for my $i ( reverse 0 .. $#pos - 1 ) { my $lefts = [ sort { $a <=> $b } map $_->[ 0 ], @pos[ $i, $i + 1 +] ]; my $rights = [ sort { $b <=> $a } map $_->[ 1 ], @pos[ $i, $i + 1 +] ]; if ( $rights->[ 1 ] - $lefts->[ 1 ] > 0 ) { splice @pos, $i, 2, [ map $_->[ 0 ], $lefts, $rights ] } } return sum map $_->[ 1 ] - $_->[ 0 ], @pos; } my $s1 = 'GATTACGAGTGGCGCTCGTGTAACGGCA'; my @ar = ('GATTACG','GCGCTCG','AACGGCA'); #21 (0,11,21) my @ar2 = ('GATTACG','TTACGAG','CGTGTAA'); #16 my @ar3 = ('TACGAGT','GTGGCGC','GCTCGTG'); #17 print score( $s1, @$_ ) for \@ar, \@ar2, \@ar3; __END__ % perl score.pl 21 16 17

the lowliest monk