Как я определяю самую долгую подобную часть нескольких строк?

Это кажется на желание k-common алгоритма подстроки. Это исключительно просто к программе и хорошему примеру динамического программирования.

Ссылка, данная уже Brett Daniel для статьи в Википедии о "Самой долгой общей проблеме подстроки", является очень хорошей общей информацией (с псевдокодом) для Вашего вопроса, как указано. Однако алгоритм может быть экспоненциальным. И похоже, что Вы могли бы на самом деле хотеть алгоритм для самого длинного общего префикса, который является намного более простым алгоритмом.

Вот тот, касательно которого я использую для самого длинного общего префикса (и к исходному URL):

use strict; use warnings;
sub longest_common_prefix {
    # longest_common_prefix( $|@ ): returns $
    # URLref: http://linux.seindal.dk/2005/09/09/longest-common-prefix-in-perl
    # find longest common prefix of scalar list
    my $prefix = shift;
    for (@_) {
        chop $prefix while (! /^\Q$prefix\E/);
        }
    return $prefix;
}

my @str = map {chomp; $_} <DATA>;
print longest_common_prefix(@ARGV), "\n";
__DATA__
file:///home/gms8994/Music/t.A.T.u./
file:///home/gms8994/Music/nina%20sky/
file:///home/gms8994/Music/A%20Perfect%20Circle/

Если Вы действительно хотите реализацию LCSS, обратитесь к этим обсуждениям (Самая длинная Общая Подстрока и Самая Длинная Общая Подпоследовательность) по PerlMonks.org. Дерево:: Суффикс, вероятно, был бы лучшим общим решением для Вас и реализаций, к моему знанию, лучшему алгоритму. К сожалению, недавние сборки повреждаются. Но, рабочая подпрограмма действительно существует в рамках обсуждений, на которые ссылается на PerlMonks в этом сообщении Limbic~Region (воспроизведенный здесь с Вашими данными).

#URLref: http://www.perlmonks.org/?node_id=549876
#by Limbic~Region
use Algorithm::Loops 'NestedLoops';
use List::Util 'reduce';

use strict; use warnings;

sub LCS{
    my @str = @_;
    my @pos;
    for my $i (0 .. $#str) {
        my $line = $str[$i];
        for (0 .. length($line) - 1) {
            my $char= substr($line, $_, 1);
            push @{$pos[$i]{$char}}, $_;
        }
    }
    my $sh_str = reduce {length($a) < length($b) ? $a : $b} @str;
    my %map;
    CHAR:
    for my $char (split //, $sh_str) {
        my @loop;
        for (0 .. $#pos) {
            next CHAR if ! $pos[$_]{$char};
            push @loop, $pos[$_]{$char};
        }
        my $next = NestedLoops([@loop]);
        while (my @char_map = $next->()) {
            my $key = join '-', @char_map;
            $map{$key} = $char;
        }
    }
    my @pile;
    for my $seq (keys %map) {
        push @pile, $map{$seq};
        for (1 .. 2) {
            my $dir = $_ % 2 ? 1 : -1;
            my @offset = split /-/, $seq;
            $_ += $dir for @offset;
            my $next = join '-', @offset;
            while (exists $map{$next}) {
                $pile[-1] = $dir > 0 ?
                    $pile[-1] . $map{$next} : $map{$next} . $pile[-1];
                $_ += $dir for @offset;
                $next = join '-', @offset;
            }
        }
    }
    return reduce {length($a) > length($b) ? $a : $b} @pile;
}

my @str = map {chomp; $_} <DATA>;
print LCS(@str), "\n";
__DATA__
file:///home/gms8994/Music/t.A.T.u./
file:///home/gms8994/Music/nina%20sky/
file:///home/gms8994/Music/A%20Perfect%20Circle/

Мой первый инстинкт должен выполнить цикл, беря следующий символ от каждой строки, пока символы не равны. Проведите подсчет того, какое положение в строке Вы в и затем берете подстроку (от любой из трех строк) от 0 до положения, прежде чем символы не будут равны.

В Perl необходимо будет разделить строку сначала на символы с помощью чего-то как

@array = split(//, $string);

(разделяющий на пустые наборы символов каждый символ в его собственный элемент массива)

Затем сделайте цикл, возможно, в целом:

$n =0;
@array1 = split(//, $string1);
@array2 = split(//, $string2);
@array3 = split(//, $string3);

while($array1[$n] == $array2[$n] && $array2[$n] == $array3[$n]){
 $n++; 
}

$sameString = substr($string1, 0, $n); #n might have to be n-1

Или по крайней мере что-то вдоль тех строк. Простите мне, если это не работает, мой Perl немного ржав.

Если Вы погуглите для "самой длинной общей подстроки то", Вы получите некоторые хорошие указатели для общего случая, где последовательности не должны запускаться в начале строк. Например, http://en.wikipedia.org/wiki/Longest_common_substring_problem.

Mathematica, оказывается, имеет функцию для этого, встроил: http://reference.wolfram.com/mathematica/ref/LongestCommonSubsequence.html (Отмечают, что они имеют в виду непрерывную подпоследовательность, т.е., подстрока, которая является тем, что Вы хотите.)

Если Вы только заботитесь о самом длинном общем префиксе затем, это должно быть намного быстрее только к циклу, поскольку я от 0 до ith символов все не соответствую и возвращаю substr (s, 0, i-1).

Из http://forums.macosxhints.com/showthread.php?t=33780

my @strings =
    (
      'file:///home/gms8994/Music/t.A.T.u./',
      'file:///home/gms8994/Music/nina%20sky/',
      'file:///home/gms8994/Music/A%20Perfect%20Circle/',
    );

my $common_part = undef;
my $sep = chr(0);  # assuming it's not used legitimately
foreach my $str ( @strings ) {

    # First time through loop -- set common
    # to whole
    if ( !defined $common_part ) {
        $common_part = $str;
        next;
    }

    if ("$common_part$sep$str" =~ /^(.*).*$sep\1.*$/)
    {
        $common_part = $1;
    }
}

print "Common part = $common_part\n";