어떻게 확인할 수 있는 가장 긴 비슷한 부분의 여러 가지 문자열?
https://stackoverflow.com/questions/499967
-
20-08-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian문제
따라 제목,나는 방법을 찾기 위해 노력하고 프로그래밍 방식으로 결정하는 가장 긴 부분의 유사성이 여러 가지 문자열입니다.
예제:
file:///home/gms8994/Music/t.A.T.u./file:///home/gms8994/Music/nina%20sky/file:///home/gms8994/Music/A%20Perfect%20Circle/
이상적으로 난 돌아 file:///home/gms8994/Music/, 기 때문에,그것은 긴 일부는 일반적인 모든 3 문자열입니다.
특히,내가 찾는 Perl 솔루션,하지만 솔루션에는 모든 언어(또는 의사-언어)에는 것으로 충분합니다.
의견:네,만에 처음;그러나의 가능성이 있습니다 몇 가지 다른 항목 목록에서,어떤 것은 무시에 대한 이 질문입니다.
해결책
편집하다: 실수에 대해 죄송합니다. 내가 그 사용을 감독하는 나의 동정 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% 더 빠릅니다 로이의 해결책 테스트 사례와 하나의 접두사 찾기에는 약 50US가 걸립니다. 데이터 나 성능 기대치가 크지 않으면 XS를 사용해야 할 필요가 없습니다.
다른 팁
Wikipedia 항목에 대한 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에서. Tree :: 접미사는 아마도 당신과 내가 아는 한, 최고의 알고리즘 인 당신을위한 최고의 일반적인 솔루션 일 것입니다. 불행히도 최근의 빌드가 깨졌습니다. 그러나,이 서브 루틴은 이것에서 Perlmonks에 대해 언급 된 토론 내에 존재합니다. 변연 ~ 지역에 의해 게시됩니다 (데이터와 함께 여기서 재생산).
#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/
당신이 원하는 것 같습니다 K-Common 서브 스트링 알고리즘. 프로그램은 매우 간단하고 동적 프로그래밍의 좋은 예입니다.
내 첫 번째 본능은 캐릭터가 동일하지 않을 때까지 각 문자열에서 다음 문자를 취하는 루프를 실행하는 것입니다. 문자열에서 어떤 위치를 세는 다음 캐릭터가 동일하지 않기 전에 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 (참고 그들은 의미 연속 서브,ie,substring 는 당신이 원하는 것입니다.)
는 경우에만 관심을 가장 긴 공통 접두사 그것은 훨씬 더 빨리해야만 반복해 나가서 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";
위보다 빠르면 PerlMongers 솔루션 ($+[0]가 작동하지 않음)에서 적용된 Perl의 기본 바이너리 XOR 함수를 사용합니다.
sub common_suffix {
my $comm = shift @_;
while ($_ = shift @_) {
$_ = substr($_,-length($comm)) if (length($_) > length($comm));
$comm = substr($comm,-length($_)) if (length($_) < length($comm));
if (( $_ ^ $comm ) =~ /(\0*)$/) {
$comm = substr($comm, -length($1));
} else {
return undef;
}
}
return $comm;
}
sub common_prefix {
my $comm = shift @_;
while ($_ = shift @_) {
$_ = substr($_,0,length($comm)) if (length($_) > length($comm));
$comm = substr($comm,0,length($_)) if (length($_) < length($comm));
if (( $_ ^ $comm ) =~ /^(\0*)/) {
$comm = substr($comm,0,length($1));
} else {
return undef;
}
}
return $comm;
}
