String 简单字符串压缩和比较

我试图比较两个字符串，作为输出，我想要连续相同字符的计数，如果字符不同，只需要第二个字符串中的字符。我有一个有效的递归实现，但我不知道如何将连续计数相加

代码：

期望输出：

['a',4,'c']
[5,'c']
[31,'x','x','x','x','x','x','x',2,'x','x',11]

当然，我可以使用

unpack

将字符分割成一个数组，然后相当容易地计算连续的匹配数，但我想尝试一种分而治之的方法，以便比较性能

谢谢

Edit——在递归情况下，通过返回一个嵌套数组，然后进行缩减，来解决这个问题。令人惊讶的是，它没有那么慢：

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;
}

---

编辑：哦，对不起。刚才看到您对希望使用递归和拆分字符串的评论。所以我的回答不太合适，很抱歉。不管怎样，我还是会离开的

我认为你不需要递归。以下作品

use Data::Dumper;

sub find_diff($$)
{
    my( $a, $b ) = @_;
    my @res;
    my @a = split( '', $a );
    my @b = split( '', $b );
    # Assume a and b are the same length
    my $mcount = 0;
    for( my $i = 0; $i < scalar(@a); $i++ )
    {
        if( $a[$i] eq $b[$i] )
        {
            $mcount++;
        }
        else
        {
            if( $mcount )
            {
                push( @res, $mcount );
            }
            $mcount = 0;
            push( @res, $b[$i] );
        }
    }
    if( $mcount )
    {
        push( @res, $mcount );
    }
    return @res;
} # END find_diff

print Data::Dumper::Dumper( [ find_diff('xaabbb', 'aaabbc' ) ] ) . "\n";
print Data::Dumper::Dumper( [ find_diff('aaabbb', 'aaabbc' ) ] ) . "\n";

使用数据：：转储程序；
子查找差异（$$）
{
我的（$a$b）=；
我的@res；
我的@a=分割（“”，$a）；
我的@b=分割（“”，$b）；
#假设a和b的长度相同
我的$mcount=0；
对于（my$i=0；$i<标量（@a）；$i++）
{
如果（$a[$i]eq$b[$i]）
{
$mcount++；
}
其他的
{
如果（$mcount）
{
推送（@res，$mcount）；
}
$mcount=0；
推送（@res，$b[$i]）；
}
}
如果（$mcount）
{
推送（@res，$mcount）；
}
返回@res；
}#结束查找_diff
打印数据：：转储程序：：转储程序（[find_diff（'xaabb'，'aaabbc'）]）。“\n”；
打印数据：：转储程序：：转储程序（[find_diff（'aaabb'，'aaabbc'）]）。“\n”；

尽管我有所保留，但我已经更新了我的解决方案，以显示递归方法。基准测试取决于您！请公布你的结果

递归或分而治之的方法不适合这个问题。最后，必须比较每对字符，并计算连续匹配字符的数量。无论是一次性完成，还是将字符串一分为二，分别处理每一半，然后重新组合结果，都没有区别。事实上，由于拆分和组合中间结果所需的代码，递归解决方案的速度必然较慢

这个问题应该通过将两个字符串拆分为单个字符并比较两个序列中的每对字符来解决

这个解决方案似乎做了需要做的事情，并且还考虑了两个字符串长度不同的情况

use strict;
use warnings;

use Data::Dump;

my $str1 = "aaaaaaaaaaaabbbbbbbbbbbccccccccdddddddddddeeeefffffff";
my $str2 = "aaaaaaaaaaaabbbbbbbbbbbccccccccxxxxxxxddxxeeeefffffff";

dd [ find_diff( 'xaabbb', 'aaabbc' ) ];
dd [ find_diff( 'aaabbb', 'aaabbc' ) ];
dd [ find_diff( $str1, $str2 ) ];
dd [ find_diff( 'xxx', 'xx' ) ];

sub find_diff {

  my @str1 = unpack '(A1)*', shift;
  my @str2 = unpack '(A1)*', shift;
  my @return;
  my $nmatch;

  while (@str1 or @str2) {
    my @pair = map $_ // '', ( shift(@str1), shift(@str2) );
    if ($pair[0] eq $pair[1]) {
      $nmatch++;
    }
    else {
      push @return, $nmatch if $nmatch;
      undef $nmatch;
      push @return, $pair[1];
    }
  }
  push @return, $nmatch if $nmatch;

  return @return;
}

输出

["a", 4, "c"]
[5, "c"]
[31, "x", "x", "x", "x", "x", "x", "x", 2, "x", "x", 11]
[2, ""]

["a", "+4", "c"]
["+5", "c"]
["+31", "x", "x", "x", "x", "x", "x", "x", "+2", "x", "x", "+11"]
["+6", 3, 3, "+3", "x"]

更新

为了满足您对类似递归解决方案的请求，此子例程使用递归方法执行相同的操作。它产生相同的结果，只是如果提供一对长度不同的字符串进行比较，它就会消失

请注意，它依赖于原始字符串中的数据是完全非数字的。如果不是这样的话，问题就变得更复杂了

更新2

我修改了

recursive\u find\u diff

以正确处理包含数字字符的字符串。它依赖于结果列表的所有成员都是单个字符，除非它们是匹配字符的计数。因此，我在所有匹配计数之前添加了一个

+

，以使它们始终长于一个字符，并且易于区分

我相信所有这些复杂的问题都会比简单的解决方案慢得多

use strict;
use warnings;

use Data::Dump;

my $str1 = "aaaaaaaaaaaabbbbbbbbbbbccccccccdddddddddddeeeefffffff";
my $str2 = "aaaaaaaaaaaabbbbbbbbbbbccccccccxxxxxxxddxxeeeefffffff";

dd [ recursive_find_diff( 'xaabbb', 'aaabbc' ) ];
dd [ recursive_find_diff( 'aaabbb', 'aaabbc' ) ];
dd [ recursive_find_diff( $str1, $str2 ) ];
dd [ recursive_find_diff( '111222444888', '11122233488x' ) ];

sub recursive_find_diff {

  my ($str1, $str2) = @_;
  my $len = length $str1;

  die "Strings for comparison must be of equal lengths" unless length $str2 == $len;

  if ($str1 eq $str2) {
    return ( '+'.$len );
  }
  elsif ($len == 1) {
    return $str1 eq $str2 ? ( '+1' ) : ( $str2 );
  }
  else {
    my $half = int($len / 2);
    my @part1 = recursive_find_diff(substr($str1, 0, $half), substr($str2, 0, $half));
    my @part2 = recursive_find_diff(substr($str1, $half), substr($str2, $half));
    if (length $part1[-1] >1 and length $part2[0] > 1) {
      $part2[0] = '+'.($part2[0] + pop @part1);
    }
    return ( @part1, @part2 );
  }
}

输出

["a", 4, "c"]
[5, "c"]
[31, "x", "x", "x", "x", "x", "x", "x", 2, "x", "x", 11]
[2, ""]

["a", "+4", "c"]
["+5", "c"]
["+31", "x", "x", "x", "x", "x", "x", "x", "+2", "x", "x", "+11"]
["+6", 3, 3, "+3", "x"]

---

多亏了Borodin和Sodved，我改进了我的解决方案，速度非常快。由于我比较的字符串是日志消息，除了更改值之外几乎相同，因此使用递归解决方案可以消除大量工作

正如索德维德提到的，在C语言中不会有类似的增益，因为我仍然需要逐个字符进行比较

它现在要做的是检查字符串的长度是否低于某个阈值，如果是，则返回数组比较

性能如下所示：

                        Rate          long_recurse long_recurse_fallback
long_recurse          1613/s                    --                  -18%
long_recurse_fallback 1961/s                   22%                    --

这是我的最终代码（删除测试字符串后，它们是真实的日志消息）：

使用严格；
使用警告；
使用数据：：转储程序；
使用基准qw（CMP准则）；
$Data:：Dumper:：Indent=0；
$Data:：Dumper:：Terse=1；
my$str1=“aaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbccccccccccccccddddddddddeefffffff”；
我的$str2=“aaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb；
子查找差异{
我的（$a，$b，$minlen）=@；
my$len=长度$a；
如果（$len<$minlen）{
返回压缩/解包文件（$a，$b）；
}
如果（$len<2）{
返回[ord（$b），0]；
}
我的@rtn=（）；
my$div=$len/2；
my$a_1=substr$a，0，$div；
my$b_1=substr$b，0，$div；
如果（$a_1 eq$b_1）{
推送@rtn，[length$a_1,1]；
}
否则{
推送@rtn，查找差异（$a_1，$b_1，$minlen）；
}
my$a_2=substr$a$div；
my$b_2=substr$b$div；
如果（$a_2 eq$b_2）{
推送@rtn，[length$a_2,1]；
}
否则{
推送@rtn，查找差异（$a_2，$b_2，$minlen）；
}
返回@rtn；
}
子字符串{
我的（$a，$b，$minlen）=@；
my@list=find_diff（$a，$b，$minlen）；
我的$acc=0；
我的@result=（）；
foreach my$项目（@list）{
如果（$item->[1]）{
$acc+=$item->[0]；
}否则{
而（$acc>127）{
按@result，255；
$acc-=127；
}
推送@result，$acc+128如果$acc；
推送@result，$item->[0]；
$acc=0；
}
}
而（$acc>127）{
按@result，255；
$acc-=127；
}
推送@result，$acc+128如果$acc；
返回包（'C*'，@result）；
}
子压缩解包{
我的（$a$b）=；
my@orig=拆包（'C*'，$a）；
我的@new=unpack（'C*
                        Rate          long_recurse long_recurse_fallback
long_recurse          1613/s                    --                  -18%
long_recurse_fallback 1961/s                   22%                    --

use strict;
use warnings;
use Data::Dumper;
use Benchmark qw(cmpthese);
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse  = 1;

my $str1 = "aaaaaaaaaaaabbbbbbbbbbbccccccccdddddddddddeeeefffffff";
my $str2 = "aaaaaaaaaaaabbbbbbbbbbbccccccccxxxxxxxddxxeeeefffffff";

sub find_diff {
    my ( $a, $b, $minlen ) = @_;
    my $len = length $a;
    if ($len < $minlen) {
        return compress_unpack_ary( $a, $b );
    }
    if ( $len < 2 ) {
        return [ord($b), 0];
    }
    my @rtn = ();
    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, $minlen );
    }
    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, $minlen );
    }
    return @rtn;
}

sub compress_string {
    my ($a, $b, $minlen) = @_;
    my @list = find_diff($a, $b, $minlen);
    my $acc = 0;
    my @result = ();
    foreach my $item (@list) {
        if ( $item->[1] ) {
            $acc += $item->[0];
        } else {
            while ( $acc > 127 ) {
                push @result, 255;
                $acc -= 127;
            }
            push @result, $acc + 128 if $acc;
            push @result, $item->[0];
            $acc = 0;
        }
    }
    while ( $acc > 127 ) {
        push @result, 255;
        $acc -= 127;
    }
    push @result, $acc + 128 if $acc;
    return pack('C*', @result);
}
sub compress_unpack_ary {
    my ( $a, $b ) = @_;
    my @orig       = unpack('C*', $a);
    my @new        = unpack('C*', $b);
    my @nonmatches = ();
    my $count      = 0;
    my $repeats    = 0;
    while ( $count < scalar @new ) {
        if ( $orig[$count] and $new[$count] == $orig[$count] ) {
            $repeats++;
        }
        elsif ( $repeats == 1 ) {
            push @nonmatches, [ $new[$count - 1], 0], [$new[$count], 0];
            $repeats = 0;
        }
        elsif ( $repeats > 1 ) {
            push @nonmatches, [$repeats, 1];
            $repeats = 0;    # reset counter
            push @nonmatches, [$new[$count], 0];
        }
        else {
            push @nonmatches, [$new[$count], 0];
        }
        $count++;
    }
    if ( $repeats > 0 ) {
        push @nonmatches, [$repeats, 1];
    }
    return @nonmatches;
}
print Data::Dumper::Dumper( [ compress_string( $str1, $str2, 20 ) ] ) . "\n";
print Data::Dumper::Dumper( [ compress_string( $str1, $str2, 0 ) ] ) . "\n";
print Data::Dumper::Dumper( [ compress_string( $long_a, $long_b, 20 ) ] ) . "\n";
print Data::Dumper::Dumper( [ compress_string( $long_a, $long_b, 0 ) ] ) . "\n";

cmpthese(1000, {
        'long_recurse' => sub { compress_string($long_a, $long_b, 0 ) },
        'long_recurse_fallback' => sub { compress_string($long_a, $long_b, 20 ) },
        });