这个Perl代码如何从数组中选择两个不同的元素？

Question

我继承了一些人的代码，他们最喜欢的过去时间是将每一行缩短到绝对最小值（有时只是为了让它看起来很酷）。他的代码很难理解，但我设法理解（并重写）了大部分代码。

现在我偶然发现了一段代码，无论我多么努力地尝试，我都无法理解。

my @heads = grep {s/\.txt$//} OSA::Fast::IO::Ls->ls($SysKey,'fo','osr/tiparlo',qr{^\d+\.txt$}) ||(); 
my @selected_heads =(); 
for my $i (0..1) { 
    $selected_heads[$i] = int rand scalar @heads; 
    for my $j (0..@heads-1) { 
     last if (!grep $j eq $_, @selected_heads[0..$i-1]); 
     $selected_heads[$i] = ($selected_heads[$i] + 1) % @heads; #WTF? 
    } 
    my $head_nr = sprintf "%04d", $i; 
    OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$heads[$selected_heads[$i]].txt","$recdir/heads/$head_nr.txt"); 
    OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$heads[$selected_heads[$i]].cache","$recdir/heads/$head_nr.cache"); 
} 

从我能理解，这应该是某种随机的，但我从来没有见过一个更复杂的方式来实现随机性。或者我的假设错了？至少，这是代码应该做的。选择2个随机文件并复制它们。

=== NOTES ===

OSA框架是我们自己的框架。它们是以UNIX的对应名称命名的，并进行一些基本的测试，以便应用程序无需为此而烦恼。

Answer 1

这看起来像一些Perl语法的C代码。有时候知道这个人想要的语言可以帮助你弄清楚发生了什么。在这种情况下，人的大脑感染了内存管理，指针运算，和其他低级别的关注内部的工作，所以他要精细地控制一切：

my @selected_heads =(); 

# a tricky way to make a two element array 
for my $i (0..1) { 

    # choose a random file 
    $selected_heads[$i] = int rand @heads; 

    # for all the files (could use $#heads instead) 
    for my $j (0..@heads-1) { 
     # stop if the chosen file is not already in @selected_heads 
     # it's that damned ! in front of the grep that's mind-warping 
     last if (!grep $j eq $_, @selected_heads[0..$i-1]); 

     # if we are this far, the two files we selected are the same 
     # choose a different file if we're this far 
     $selected_heads[$i] = ($selected_heads[$i] + 1) % @heads; #WTF? 
    } 

... 
} 

这是很多，因为原来的工作程序员要么不理解哈希，要么不喜欢它们。

my %selected_heads; 
until(keys %selected_heads == 2) 
    { 
    my $try = int rand @heads; 
    redo if exists $selected_heads{$try}; 
    $selected_heads{$try}++; 
    } 

my @selected_heads = keys %selected_heads; 

如果你仍然讨厌哈希和Perl 5。10或更高版本，您可以使用智能匹配来检查值是否在数组中：

my @selected_heads; 
until(@selected_heads == 2) 
    { 
    my $try = int rand @heads; 
    redo if $try ~~ @selected_heads; 
    push @selected_heads, $try; 
    } 

但是，您对此问题有特殊限制。既然你知道只有两个元素，你只需要检查你想添加的元素是否是先前的元素。在第一种情况下，它不会被取消，所以第一个添加总是有效的。在第二种情况下，它不能是阵列中的最后一个元素：

my @selected_heads; 
until(@selected_heads == 2) 
    { 
    my $try = int rand @heads; 
    redo if $try eq $selected_heads[-1]; 
    push @selected_heads, $try; 
    } 

呵呵。我不记得上一次我使用until时，它实际上适合问题。 :)

注意，所有这些解决方案都存在，他们可能会导致一个无限循环，如果原始文件的数量问题小于2。我想通过添加一个保护条件更高了，因此没有和单个文件的情况下一个错误，也许这两个文件的情况下不打扰他们。

，你可以这样做的另一个方法是重新洗牌（比如说，与List::Util）原始文件的完整列表，只是起飞前两个文件：

use List::Util qw(shuffle); 

my @input = 'a' .. 'z'; 

my @two = (shuffle(@input))[0,1]; 

print "selected: @two\n"; 

Answer 2

这里是另一种方式来选择2个独特的随机指数：

my @selected_heads =(); 
my @indices = 0..$#heads; 
for my $i (0..1) { 
    my $j = int rand (@heads - $i); 
    push @selected_heads, $indices[$j]; 
    $indices[$j] = $indices[@heads - $i - 1]; 
} 

Answer 3

它选择从@heads随机元素。

然后，它会添加另一个随机，但不同于@heads的元素（如果它是先前选择的元素，它将滚动浏览@heads直到找到之前未选中的元素）。

总之，它在@heads数组中选择N个（在你的情况下N = 2）不同的随机索引，然后复制对应于这些索引的文件。

我个人不同的看法写了一下：你打成“WTF”不是那么令人不安的是，它只是简单地确保$selected_heads[$i]仍然作为@head有效标

# ... 
%selected_previously =(); 
foreach my $i (0..$N) { # Generalize for N random files instead of 2 
    my $random_head_index = int rand scalar @heads; 
    while ($selected_previously[$random_head_index]++) { 
     $random_head_index = $random_head_index + 1) % @heads; # Cache me!!! 
    } 
    # NOTE: "++" in the while() might be considered a bit of a hack 
    # More readable version: $selected_previously[$random_head_index]=1; here. 

Answer 4

的一部分。真正令人不安的部分是，确保他不选择相同的文件是一种非常低效的方式。

再次，如果@heads的大小很小，从0..$#heads步进可能比仅生成int rand(2)更有效，并测试它们是否相同。

但基本上它是随机拷贝两个文件（为什么？）作为'.txt'文件和'.cache'文件。

Answer 5

如何只

for my $i (0..1) { 
    my $selected = splice(@heads, rand @heads, 1); 
    my $head_nr = sprintf "%04d", $i; 
    OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$selected.txt","$recdir/heads/$head_nr.txt"); 
    OSA::Fast::IO::Cp->cp($SysKey,'',"osr/tiparlo/$selected.cache","$recdir/heads/$head_nr.cache"); 
} 

，除非以后使用@heads或@selected_heads。