¿Cómo es que este código Perl selecciona dos elementos diferentes de una matriz?

Question

Heredé un código de un chico cuyo tiempo pasado favorito era acortar cada línea a su mínimo absoluto (y algunas veces solo para que se vea bien). Su código es difícil de entender pero logré entender (y reescribir) la mayor parte.

Ahora he tropezado con un código que, sin importar cuánto lo intente, no lo entiendo.

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

De lo que puedo entender, esto se supone que es algún tipo de aleatoriedad, pero nunca vi una forma más compleja para lograr la aleatoriedad. ¿O son erróneas mis suposiciones? Al menos, eso es lo que se supone que debe hacer este código. Seleccione 2 archivos aleatorios y cópielos.

NOTAS === ===

El Marco OSA es un marco de nuestra propia. Se nombran por sus contrapartes de UNIX y hacen algunas pruebas básicas para que la aplicación no tenga que preocuparse por eso.

Answer 1

Parece un código C con sintaxis Perl. A veces, saber el idioma en el que la persona está pensando te ayuda a descubrir qué está pasando. En este caso, el cerebro de la persona está infectada con el funcionamiento interno de la gestión de memoria, la aritmética de punteros, y otras preocupaciones de bajo nivel, por lo que quiere controlar minuciosamente todo:

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

... 
} 

Esto es mucho trabajo porque el original el programador no entiende hashes o no le gusta.

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; 

Si todavía odias hashes y tienes Perl 5.10 o posterior, puede utilizar Smart-juego para comprobar si un valor está en una matriz:

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

Sin embargo, usted tiene una restricción especial sobre este problema. Como sabes que solo hay dos elementos, solo tienes que verificar si el elemento que deseas agregar es el elemento anterior. En el primer caso, no será undef, entonces la primera adición siempre funciona. En el segundo caso, simplemente no puede ser el último elemento en la matriz:

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

Huh. No puedo recordar la última vez que usé until cuando realmente se ajustaba al problema. :)

Tenga en cuenta que todas estas soluciones tienen el problema de que pueden causar un bucle infinito si el número de archivos originales es menor que 2. Añadiría una condición de guardia más arriba para que los casos de archivo único y no un error y tal vez el caso de archivo dos no se molesta en ordenarlos.

Otra forma es posible hacer esto es a barajar (digamos, con List::Util) la lista completa de los archivos originales y apenas despegar los primeros dos archivos:

use List::Util qw(shuffle); 

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

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

print "selected: @two\n"; 

Answer 2

Aquí hay otra manera de seleccionar 2 índices aleatorios únicos:

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

Selecciona un elemento aleatorio de @heads.

Luego agrega otro elemento aleatorio pero diferente elemento de @heads (si es el elemento previamente seleccionado, se desplaza por @heads hasta que encuentre un elemento no seleccionado previamente).

En resumen, selecciona N (en su caso N = 2) diferentes índices aleatorios en @heads array y luego copia los archivos correspondientes a esos índices.

Personalmente me gustaría escribir un poco diferente:

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

La parte que se denomina "WTF" no es tan preocupante, que es simplemente asegurarse de que $selected_heads[$i] sigue siendo válida como subíndice de @head. La parte realmente preocupante es que es una forma bastante ineficiente de asegurarse de que no está seleccionando el mismo archivo.

Por otra parte, si el tamaño de @heads es pequeño, pasar de 0..$#heads es probablemente más eficiente que simplemente generar int rand(2) y probar si son iguales.

Pero básicamente copia dos archivos al azar (¿por qué?) Como un archivo '.txt' y un archivo '.cache'.

Answer 5

¿Qué tal

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

a menos que @heads o @selected_heads se usen más adelante.