2010-01-11 39 views
0
 
List-1 List-2 
one  one 
two  three 
three  three 
four  four 
five  six 
six  seven 
eight  eighttt 
nine  nine 

比較兩個列表時展望輸出在Perl

 
one  | one  PASS 
two  | *    FAIL MISSING 
three  | three  PASS 
*   | three   FAIL EXTRA 
four  | four  PASS 
five  | *    FAIL MISSING 
six  | six  PASS 
*   | seven   FAIL EXTRA 
eight  | eighttt   FAIL INVALID 
nine  | nine  PASS 

其實從我目前的解決方案回報是兩個修改單的參考和參照「找到額外的,丟失的,無效的字符串失敗「列表描述失敗的索引爲」無失敗「,」失蹤「,」額外「或」無效「,這也是(明顯)良好的輸出。

我目前的解決辦法是:

sub compare { 
    local $thisfound = shift; 
    local $thatfound = shift; 
    local @thisorig = @{ $thisfound }; 
    local @thatorig = @{ $thatfound }; 
    local $best = 9999; 

    foreach $n (1..6) { 
     local $diff = 0; 
     local @thisfound = @thisorig; 
     local @thatfound = @thatorig; 
     local @fail =(); 
     for (local $i=0;$i<scalar(@thisfound) || $i<scalar(@thatfound);$i++) { 
      if($thisfound[$i] eq $thatfound[$i]) { 
       $fail[$i] = 'NO_FAIL'; 
       next; 
      } 
      if($n == 1) {  # 1 2 3 
       next unless __compare_missing__(); 
       next unless __compare_extra__(); 
       next unless __compare_invalid__(); 
      } elsif($n == 2) { # 1 3 2 
       next unless __compare_missing__(); 
       next unless __compare_invalid__(); 
       next unless __compare_extra__(); 
      } elsif($n == 3) { # 2 1 3 
       next unless __compare_extra__(); 
       next unless __compare_missing__(); 
       next unless __compare_invalid__(); 
      } elsif($n == 4) { # 2 3 1 
       next unless __compare_extra__(); 
       next unless __compare_invalid__(); 
       next unless __compare_missing__(); 
      } elsif($n == 5) { # 3 1 2 
       next unless __compare_invalid__(); 
       next unless __compare_missing__(); 
       next unless __compare_extra__(); 
      } elsif($n == 6) { # 3 2 1 
       next unless __compare_invalid__(); 
       next unless __compare_extra__(); 
       next unless __compare_missing__(); 
      } 
      push @fail,'INVALID'; 
      $diff += 1; 
     } 
     if ($diff<$best) { 
      $best = $diff; 
      @thisbest = @thisfound; 
      @thatbest = @thatfound; 
      @failbest = @fail; 
     } 
    } 
    return (\@thisbest,\@thatbest,\@failbest) 
} 

sub __compare_missing__ { 
    my $j; 
    ### Does that command match a later this command? ### 
    ### If so most likely a MISSING command   ### 
    for($j=$i+1;$j<scalar(@thisfound);$j++) { 
     if($thisfound[$j] eq $thatfound[$i]) { 
      $diff += $j-$i; 
      for ($i..$j-1) { push(@fail,'MISSING'); } 
      @end = @thatfound[$i..$#thatfound]; 
      @thatfound = @thatfound[0..$i-1]; 
      for ($i..$j-1) { push(@thatfound,'*'); } 
      push(@thatfound,@end); 
      $i=$j-1; 
      last; 
     } 
    } 
    $j == scalar(@thisfound); 
} 

sub __compare_extra__ { 
    my $j; 
    ### Does this command match a later that command? ### 
    ### If so, most likely an EXTRA command   ### 
    for($j=$i+1;$j<scalar(@thatfound);$j++) { 
     if($thatfound[$j] eq $thisfound[$i]) { 
      $diff += $j-$i; 
      for ($i..$j-1) { push(@fail,'EXTRA'); } 
      @end = @thisfound[$i..$#thisfound]; 
      @thisfound = @thisfound[0..$i-1]; 
      for ($i..$j-1) { push (@thisfound,'*'); } 
      push(@thisfound,@end); 
      $i=$j-1; 
      last; 
     } 
    } 
    $j == scalar(@thatfound); 
} 

sub __compare_invalid__ { 
    my $j; 
    ### Do later commands match?      ### 
    ### If so most likely an INVALID command   ### 
    for($j=$i+1;$j<scalar(@thisfound);$j++) { 
     if($thisfound[$j] eq $thatfound[$j]) { 
      $diff += $j-$i; 
      for ($i..$j-1) { push(@fail,'INVALID'); } 
      $i=$j-1; 
      last; 
     } 
    } 
    $j == scalar(@thisfound); 
} 

但是,這並不完美......誰願意簡化和改進?具體而言...在單個數據集內,一個搜索順序對於一個子集更好,另一個順序對於不同子集更好。

+2

根據你的意見,我認爲你有一些你還沒有解釋的其他要求。也許你可以告訴我們你在做什麼。 – 2010-01-11 19:59:51

+0

這是一個有趣的問題,但在我嘗試其他答案之前,我想確保我正在處理正確的問題。在List1中,您有一系列的項目。在List2中,您希望看到相同的順序(相同順序的相同項目)。 你想知道什麼時候該序列搞砸了。除了不應該存在的意外項目外,您還想知道什麼時候應該存在的項目缺失,何時重複預期項目,*和*,您沒有指定,當任何預期項目出現順序錯亂時。 這是手頭的問題嗎? – 2010-01-11 21:15:33

+0

對不起,昨晚走了......但我最終實現了levenshtein的距離,然後回到桌子......我會發布最終的解決方案 我可能會調查換位,因爲我已經找到了我會喜歡識別這些場景...... – 2010-01-12 15:09:26

回答

4

如果數組包含重複的值,那麼答案會比這個複雜得多。

參見例如Algorithm::Diff或閱讀約Levenshtein distance

+0

感謝您的鏈接!是的假設是會有重複的值... – 2010-01-11 19:42:18

+0

我不認爲你需要求助於算法::比較這個。也許你可以解釋爲什麼你認爲Levenshtein距離是相關的。我沒有看到它。 – 2010-01-11 19:58:07

+0

我意識到我的輸出場景是「MISSING」或刪除,「EXTRA」或插入,「INVALID」或替換,以及「NO_FAIL」或傳遞......這些直接對應於差異操作...... levenshtein算法準確地獲得最少對值列表進行修改以使它們匹配的次數...通過識別修改必須是什麼,我能夠識別什麼是缺失,無效和額外的。現在我實際上是通過一個簡單的管道文件描述符將我的列表傳遞給sdiff,因爲我無法在目標機器上安裝額外的模塊。 – 2010-01-11 20:25:17

0

Perl(和類似語言)中的訣竅是哈希,它不關心順序。

假設第一個數組是保存有效元素的數組。使用這些值構造一個散列作爲鍵:

my @valid = qw(one two ...); 
    my %valid = map { $_, 1 } @valid; 

現在,找到了無效的元素,你只需要找到那些沒有在該%valid哈希:

my @invalid = grep { ! exists $valid{$_} } @array; 

如果你想知道無效元素的數組索引:

my @invalid_indices = grep { ! exists $valid{$_} } 0 .. $#array; 

現在,您可以展開以查找重複的元素。你不僅檢查%valid哈希值,但也保持你已經看到的軌跡:

my %Seen; 
my @invalid_indices = grep { ! exists $valid{$_} && ! $Seen{$_}++ } 0 .. $#array; 

重複的有效元素與%Seen的值大於1的那些:

my @repeated_valid = grep { $Seen{$_} > 1 } @valid; 

要查找缺失的元素,請查看%Seen以檢查不存在的元素。

my @missing = grep { ! $Seen{$_ } } @valid; 
+0

列表2中列表1中不存在的元素如何?我想我可以做一個哈希%這個和%,並交叉引用使用grep(我不知道有一個Perl中的grep ... whoopsie),所以我可能看*更簡單*雖然可能不是實際的功能我需要...... – 2010-01-11 19:29:33

+0

恩,這就是@示例。也許我們的編輯交叉在電線上。 – 2010-01-11 19:31:15

0

perlfaq4的回答到How can I tell whether a certain element is contained in a list or array?


聽力 「在」 字(此答案​​貢獻的紀元西格爾和Brian d FOY的部分)是指示你可能應該使用散列,而不是列表或數組來存儲數據。哈希函數旨在快速高效地回答這個問題。陣列不是。

這就是說,有幾種方法可以解決這個問題。在Perl 5.10或更高版本,可以使用智能匹配運算符來檢查的項目包含在一個數組或哈希:

use 5.010; 

if($item ~~ @array) 
    { 
    say "The array contains $item" 
    } 

if($item ~~ %hash) 
    { 
    say "The hash contains $item" 
    } 

與早期版本的Perl,你必須做一些更多的工作。如果你打算讓這個查詢過任意字符串值多次,以最快的方式可能是反轉原數組和維護一個哈希的鍵是第一個數組的值:

@blues = qw/azure cerulean teal turquoise lapis-lazuli/; 
%is_blue =(); 
for (@blues) { $is_blue{$_} = 1 } 

現在可以檢查是否$ is_blue {$ some_color}。將藍調全部放在首位可能是一個好主意。

如果這些值都是小整數,則可以使用簡單的索引數組。這類型的數組,將佔用較少的空間:

@primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31); 
@is_tiny_prime =(); 
for (@primes) { $is_tiny_prime[$_] = 1 } 
# or simply @istiny_prime[@primes] = (1) x @primes; 

現在你檢查是否$ is_tiny_prime [$ some_number。

如果有問題的值是整數,而不是字符串,則可以使用的比特串,而不是節省了不少的空間:

@articles = (1..10, 150..2000, 2017); 
undef $read; 
for (@articles) { vec($read,$_,1) = 1 } 

現在檢查VEC是否($讀取,$ N,1)對於某些$ n爲真。

這些方法保證快速的單個測試,但需要重新組織原始列表或數組。如果您必須針對同一陣列測試多個值,它們只會得到回報。

如果您只測試一次,則標準模塊List :: Util將爲此首先導出該函數。它一旦找到元素就停止工作。它是用C寫的速度,它的Perl的等效看起來是這樣的子程序:

sub first (&@) { 
    my $code = shift; 
    foreach (@_) { 
     return $_ if &{$code}(); 
    } 
    undef; 
} 

如果速度是很少關注的,常見的成語使用在標量上下文的grep(它返回通過其條件的項目數)遍歷整個列表。不過,這確實有告訴你找到了多少匹配的好處。

my $is_there = grep $_ eq $whatever, @array; 

如果你想實際提取匹配元素,只需在列表上下文中使用grep。

my @matches = grep $_ eq $whatever, @array; 
+0

我看到的唯一問題是順序是重要的...有效地,我比較發送到系統的命令,這些命令以十六進制序列表示,比較兩個控制系統的兩個輸出不僅需要了解發送的內容,但也知道爲什麼我選擇數組的順序是什麼,也許可以設置一個哈希值,使得映射的值等於發送$ values {$ _} = $ n而不是1的位置將提供靈活性使用一些提到的搜索工具。 – 2010-01-11 19:36:38

+0

您可以維護訂單。在我的具體答案中,我向你展示瞭如何使用指數。一旦你知道了無效指數等,你的工作就是弄清楚如何處理它們。常見問題回答只是告訴你什麼是可能的。你必須適應你的需求。 – 2010-01-11 19:54:31

-1

perlfaq4的答案How do I compute the difference of two arrays? How do I compute the intersection of two arrays?


使用哈希。這裏有兩個以上的代碼。它假定每個元素是一個給定的陣列中的獨特:

@union = @intersection = @difference =(); 
%count =(); 
foreach $element (@array1, @array2) { $count{$element}++ } 
foreach $element (keys %count) { 
    push @union, $element; 
    push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element; 
    } 

注意,這是對稱差,即,在A或B中,但不是在兩者的所有元素。把它想象成一個xor操作。

+0

我們在這裏近乎實時地溝通,我真的很感謝您願意提供儘可能多的建議!然而,我仍然不相信這些解決方案將列表的順序考慮在內......如果我錯了,請糾正我。 – 2010-01-11 19:39:56

+0

FAQ只是告訴你你可以在Perl中做什麼。您可以調整這些以適應特定的順序。我的具體示例向您展示瞭如何使用各種指標。 – 2010-01-11 19:56:15

0
sub compare { 
    local @d =(); 

    my $this = shift; 
    my $that = shift; 
    my $distance = _levenshteindistance($this, $that); 

    my @thisorig = @{ $this }; 
    my @thatorig = @{ $that }; 

    my $s = $#thisorig; 
    my $t = $#thatorig; 

    @this =(); 
    @that =(); 
    @fail =(); 

    while($s>0 || $t>0) { 
     #     deletion, insertion, substitution 
     my $min = _minimum($d[$s-1][$t],$d[$s][$t-1],$d[$s-1][$t-1]); 
     if($min == $d[$s-1][$t-1]) { 
      unshift(@this,$thisorig[$s]); 
      unshift(@that,$thatorig[$t]); 
      if($d[$s][$t] > $d[$s-1][$t-1]) { 
       unshift(@fail,'INVALID'); 
      } else { 
       unshift(@fail,'NO_FAIL'); 
      } 
      $s -= 1; 
      $t -= 1; 
     } elsif($min == $d[$s][$t-1]) { 
      unshift(@this,'*'); 
      unshift(@that,$thatorig[$t]); 
      unshift(@fail,'EXTRA'); 
      $t -= 1; 
     } elsif($min == $d[$s-1][$t]) { 
      unshift(@this,$thisorig[$s]); 
      unshift(@that,'*'); 
      unshift(@fail,'MISSING'); 
      $s -= 1; 
     } else { 
      die("Error! $!"); 
     } 
    } 

    return(\@this, \@that, \@fail); 

} 

sub _minimum { 
    my $ret = 2**53; 
    foreach $in (@_) { 
     $ret = $ret < $in ? $ret : $in; 
    } 
    $ret; 
} 

sub _levenshteindistance { 
    my $s = shift; 
    my $t = shift; 
    my @s = @{ $s }; 
    my @t = @{ $t }; 

    for(my $i=0;$i<scalar(@s);$i++) { 
     $d[$i] =(); 
    } 

    for(my $i=0;$i<scalar(@s);$i++) { 
     $d[$i][0] = $i # deletion 
    } 
    for(my $j=0;$j<scalar(@t);$j++) { 
     $d[0][$j] = $j # insertion 
    } 

    for(my $j=1;$j<scalar(@t);$j++) { 
     for(my $i=1;$i<scalar(@s);$i++) { 
      if ($s[$i] eq $t[$j]) { 
       $d[$i][$j] = $d[$i-1][$j-1]; 
      } else { 
       #     deletion,  insertion,  substitution 
       $d[$i][$j] = _minimum($d[$i-1][$j]+1,$d[$i][$j-1]+1,$d[$i-1][$j-1]+1); 
      } 
     } 
    } 

    foreach $a (@d) { 
     @a = @{ $a }; 
     foreach $b (@a) { 
      printf STDERR "%2d ",$b; 
     } 
     print STDERR "\n"; 
    } 

    return $d[$#s][$#t]; 
}