Как этот код 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 случайных файла и скопируйте их.

=== ПРИМЕЧАНИЯ ===

ОРД Framework является Framework нашей собственной. Они названы в честь их UNIX-аналогов и проводят базовое тестирование, чтобы приложение не нуждалось в этом.

Answer 1

Это похоже на код C с синтаксисом Perl. Иногда знание языка, о котором человек думает, помогает вам понять, что происходит. В этом случае мозг человека заражено внутренней работы управления памятью, арифметики указателей и других проблем низкого уровня, поэтому он хочет, чтобы ежеминутно контролировать все:

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

Huh. Я не могу вспомнить последний раз, когда я использовал 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, пока не найдет элемент, который ранее не был выбран).

Таким образом, он выбирает N (в вашем случае N = 2) различные случайные индексы в массиве @heads и затем копирует файлы, соответствующие этим индексам.

Лично я бы написал ее немного по-другому:

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

Часть вас с надписью «WTF» не так беспокоит, это просто убедившись, что $selected_heads[$i] остается действительным индексом в @head. Очень тревожная часть заключается в том, что это довольно неэффективный способ убедиться, что он не выбирает один и тот же файл.

С другой стороны, если размер @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 используются позже.