Я думаю, вы пытаетесь сделать Игры модулем фракции:
<?xml version="1.0" encoding="UTF-8"?>
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>com.yourdomain</groupId>
<artifactId>faction</artifactId>
<version>0.0.1-SNAPSHOT</version>
<packaging>pom</packaging>
<modules>
<module>games</module>
</modules>
</project>
, где у игр есть собственный pom.xml / project, и они могут находиться в подкаталоге в каталоге Faction.
<?xml version="1.0" encoding="UTF-8"?>
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>com.yourdomain</groupId>
<artifactId>games</artifactId>
<version>0.0.1-SNAPSHOT</version>
<packaging>pom</packaging>
<dependencies.../>
</project>
Править: Я сожалею об ошибке. Моя жалость, что я наблюдаемый то использование my
переменная внутри countit(x, q{})
большая ошибка. Эта строка оценена в модуле Сравнительного теста, и @str был пуст там. Это решение не состоит в том с такой скоростью, как я представил. Посмотрите исправление ниже. Я сожалею снова.
Perl может быть быстрым:
use strict;
use warnings;
package LCP;
sub LCP {
return '' unless @_;
return $_[0] if @_ == 1;
my $i = 0;
my $first = shift;
my $min_length = length($first);
foreach (@_) {
$min_length = length($_) if length($_) < $min_length;
}
INDEX: foreach my $ch ( split //, $first ) {
last INDEX unless $i < $min_length;
foreach my $string (@_) {
last INDEX if substr($string, $i, 1) ne $ch;
}
}
continue { $i++ }
return substr $first, 0, $i;
}
# Roy's implementation
sub LCP2 {
return '' unless @_;
my $prefix = shift;
for (@_) {
chop $prefix while (! /^\Q$prefix\E/);
}
return $prefix;
}
1;
Набор тестов:
#!/usr/bin/env perl
use strict;
use warnings;
Test::LCP->runtests;
package Test::LCP;
use base 'Test::Class';
use Test::More;
use Benchmark qw(:all :hireswallclock);
sub test_use : Test(startup => 1) {
use_ok('LCP');
}
sub test_lcp : Test(6) {
is( LCP::LCP(), '', 'Without parameters' );
is( LCP::LCP('abc'), 'abc', 'One parameter' );
is( LCP::LCP( 'abc', 'xyz' ), '', 'None of common prefix' );
is( LCP::LCP( 'abcdefgh', ('abcdefgh') x 15, 'abcdxyz' ),
'abcd', 'Some common prefix' );
my @str = map { chomp; $_ } <DATA>;
is( LCP::LCP(@str),
'file:///home/gms8994/Music/', 'Test data prefix' );
is( LCP::LCP2(@str),
'file:///home/gms8994/Music/', 'Test data prefix by LCP2' );
my $t = countit( 1, sub{LCP::LCP(@str)} );
diag("LCP: ${\($t->iters)} iterations took ${\(timestr($t))}");
$t = countit( 1, sub{LCP::LCP2(@str)} );
diag("LCP2: ${\($t->iters)} iterations took ${\(timestr($t))}");
}
__DATA__
file:///home/gms8994/Music/t.A.T.u./
file:///home/gms8994/Music/nina%20sky/
file:///home/gms8994/Music/A%20Perfect%20Circle/
Результат набора тестов:
1..7
ok 1 - use LCP;
ok 2 - Without parameters
ok 3 - One parameter
ok 4 - None of common prefix
ok 5 - Some common prefix
ok 6 - Test data prefix
ok 7 - Test data prefix by LCP2
# LCP: 22635 iterations took 1.09948 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU) @ 20766.06/s (n=22635)
# LCP2: 17919 iterations took 1.06787 wallclock secs ( 1.07 usr + 0.00 sys = 1.07 CPU) @ 16746.73/s (n=17919)
Это означает что чистое использование решения для Perl substr
приблизительно на 20% быстрее, чем решение Roy в Вашем тестовом сценарии и одном открытии префикса сопровождает 50us. Нет необходимого использования XS, если Ваши данные или ожидания производительности не больше.
Это кажется на желание 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";