2 つの文字列を比較しようとしていますが、出力として、連続する同一文字の数が必要です。文字が異なる場合は、2 番目の文字列の char だけです。再帰的な実装が機能していますが、連続したカウントを加算する方法がわかりません
コード：
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;
my $str1 = "aaaaaaaaaaaabbbbbbbbbbbccccccccdddddddddddeeeefffffff";
my $str2 = "aaaaaaaaaaaabbbbbbbbbbbccccccccxxxxxxxddxxeeeefffffff";
sub find_diff {
my ( $a, $b ) = @_;
my @rtn = ();
my $len = length $a;
my $div = $len / 2;
if ( $div < 1 ) {
return $b;
}
my $a_1 = substr $a, 0, $div;
my $b_1 = substr $b, 0, $div;
if ($a_1 eq $b_1) {
push @rtn, length $a_1;
}
else {
push @rtn, find_diff( $a_1, $b_1 );
}
my $a_2 = substr $a, $div;
my $b_2 = substr $b, $div;
if ($a_2 eq $b_2) {
push @rtn, length $a_2;
}
else {
push @rtn, find_diff( $a_2, $b_2 );
}
return @rtn;
}
print Data::Dumper::Dumper( [ find_diff('xaabbb', 'aaabbc' ) ] ) . "\n";
print Data::Dumper::Dumper( [ find_diff('aaabbb', 'aaabbc' ) ] ) . "\n";
print Data::Dumper::Dumper( [ find_diff( $str1, $str2 ) ] ) . "\n";
出力：
['a',2,1,1,'c']
[3,1,1,'c']
[26,3,1,1,'x','x','x','x','x','x','x',1,1,'x','x',4,7]
望ましい出力:
['a',4,'c']
[5,'c']
[31,'x','x','x','x','x','x','x',2,'x','x',11]
もちろん、文字を配列に分割して、unpack連続した一致をかなり簡単にカウントできますが、パフォーマンスを比較できるように分割統治法を試してみたいと思います。
ありがとう！
編集 - ネストされた配列を返してから減らすことで、再帰的なケースでそれを解決することができました。驚くほど遅くはありません。
sub find_diff {
my ( $a, $b ) = @_;
my @rtn = ();
my $len = length $a;
if ( $len < 2 ) {
return [$b, 0];
}
my $div = $len / 2;
my $a_1 = substr $a, 0, $div;
my $b_1 = substr $b, 0, $div;
if ($a_1 eq $b_1) {
push @rtn, [length $a_1, 1];
}
else {
push @rtn, find_diff( $a_1, $b_1 );
}
my $a_2 = substr $a, $div;
my $b_2 = substr $b, $div;
if ($a_2 eq $b_2) {
push @rtn, [length $a_2, 1];
}
else {
push @rtn, find_diff( $a_2, $b_2 );
}
return @rtn;
}
sub compress_string {
my ($a, $b) = @_;
my @list = find_diff($a, $b);
my $acc = 0;
my @result = ();
foreach my $item (@list) {
if ( $item->[1] ) {
$acc += $item->[0];
} else {
push @result, if $acc;
push @result, $item->[0];
$acc = 0;
}
}
push @result, $acc if $acc;
return @result;
}
結果は私が望むものと一致します。
更新 - パフォーマンス統計
これは本当に興味深いです。使用unpack( 'C*', $string)は非常に高速であり、それが私の反復バージョンが非常に高速である理由だと思います。再帰の速度の利点は、より長い文字列 (434 文字) で出てきます。
Rate short_recurse_borodin short_recurse short_array_borodin short_array_sodved short_array
short_recurse_borodin 6944/s -- -31% -36% -73% -84%
short_recurse 10091/s 45% -- -8% -61% -76%
short_array_borodin 10929/s 57% 8% -- -57% -74%
short_array_sodved 25707/s 270% 155% 135% -- -40%
short_array 42553/s 513% 322% 289% 66% --
Rate mid_array_borodin mid_recurse_borodin mid_string mid_array_sodved mid_array
mid_array_borodin 1418/s -- -28% -56% -65% -82%
mid_recurse_borodin 1972/s 39% -- -39% -52% -76%
mid_recurse 3226/s 127% 64% -- -21% -60%
mid_array_sodved 4082/s 188% 107% 27% -- -49%
mid_array 8065/s 469% 309% 150% 98% --
Rate long_array_borodin long_array_sodved long_recurse_borodin long_array long_string
long_array_borodin 172/s -- -67% -80% -85% -89%
long_array_sodved 513/s 199% -- -40% -55% -67%
long_recurse_borodin 854/s 397% 66% -- -25% -45%
long_array 1142/s 564% 122% 34% -- -26%
long_recurse 1546/s 800% 201% 81% 35% --