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

时间:2010-04-23 15:05:47

标签: perl

我从一个人那里继承了一些代码,他们最喜欢的时间是将每一行缩短到绝对最小值(有时只是为了让它看起来很酷)。他的代码很难理解,但我设法理解(并重写)其中的大部分内容。

现在我偶然发现了一段代码,无论我怎么努力,我都无法理解。

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个随机文件并复制它们。

===注意===

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

5 个答案:

答案 0 :(得分:12)

这看起来像是一些带有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;
    }

但是,您对此问题有一个特殊限制。由于您知道只有两个元素,因此您只需检查要添加的元素是否为先前元素。在第一种情况下它不会是undef,所以第一次添加总是有效。在第二种情况下,它不能是数组中的最后一个元素:

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,所有这些解决方案都存在导致无限循环的问题。我会添加一个更高的保护条件,以便通过错误添加no和single文件也许这两个文件案例并不打算订购它们。

你可能会这样做的另一种方法是将原始文件的整个列表改组(例如,使用List::Util),然后取下前两个文件:

use List::Util qw(shuffle);

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

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

print "selected: @two\n";

答案 1 :(得分:2)

从@heads中选择一个随机元素。

然后它添加来自@heads的另一个随机但不同的元素(如果它是之前选择的元素,则滚动@heads直到找到之前未选择的元素)。

总之,它在@heads数组中选择N(在你的情况下为N = 2)不同的随机索引,然后复制与这些索引相对应的文件。

就我个人而言,我的写法有点不同:

# ...
%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.

答案 2 :(得分:1)

您标记为“WTF”的部分并不那么麻烦,只需确保$selected_heads[$i]仍然是@head的有效下标。真正令人不安的是,这是一种非常低效的方法,可以确保他没有选择相同的文件。

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

但基本上它会随机复制两个文件(为什么?)作为'.txt'文件和'.cache'文件。

答案 3 :(得分:1)

如何

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

答案 4 :(得分:0)

这是选择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];
}
相关问题