Mensajes

Ahora estoy un poco dormido, pero creo que la solución es esta:

Código (perl) [Seleccionar] Expandir

my $visto;

for my $a1 (1 .. 20) {
   for my $a2 (1 .. 20) {
       for my $a3 (1 .. 20) {
           for my $a4 (1 .. 20) {

               my @ordenados = sort { $a <=> $b } $a1, $a2, $a3, $a4;

               # salimos si hay coincidencia
               next if $ordenados[0] == $ordenados[1]
                    or $ordenados[0] == $ordenados[2]
                    or $ordenados[0] == $ordenados[3]
                    or $ordenados[1] == $ordenados[2]
                    or $ordenados[1] == $ordenados[3]
                    or $ordenados[2] == $ordenados[3]
               ;

               # salimos si hay coincidencia por pares
               next if $visto{"$ordenados[0]-$ordenados[1]"}
                    or $visto{"$ordenados[0]-$ordenados[2]"}
                    or $visto{"$ordenados[0]-$ordenados[3]"}
                    or $visto{"$ordenados[1]-$ordenados[2]"}
                    or $visto{"$ordenados[1]-$ordenados[3]"}
                    or $visto{"$ordenados[2]-$ordenados[3]"}
               ;

               # recordamos todos los pares nuevos
               $visto{"$ordenados[0]-$ordenados[1]"} =
               $visto{"$ordenados[0]-$ordenados[2]"} =
               $visto{"$ordenados[0]-$ordenados[3]"} =
               $visto{"$ordenados[1]-$ordenados[2]"} =
               $visto{"$ordenados[1]-$ordenados[3]"} =
               $visto{"$ordenados[2]-$ordenados[3]"} = 1;

               # Impresión
               print "[", join('-', @ordenados), "]\n";
           }
       }
   }
}
La salida es algo corta:
[1-2-3-4]
[1-5-6-7]
[1-8-9-10]
[1-11-12-13]
[1-14-15-16]
[1-17-18-19]
[2-5-8-11]
[2-6-9-12]
[2-7-10-13]
[2-14-17-20]
[3-5-9-13]
[3-6-8-14]
[3-7-11-15]
[3-10-12-16]
[4-5-10-14]
[4-6-11-16]
[4-7-8-12]
[4-9-15-17]
[4-13-18-20]
[5-12-15-18]
[5-16-19-20]
[6-10-15-19]
[7-9-14-18]
[8-13-16-17]

Curiosamente, el alumno 1 nunca estará con el número 20. ¿Por qué?
Supongamos que queremos la combinación [1-a-b-20]. ¿Qué valores serían a o b?. Pues cualquiera entre 2 y 19... pero eso no es posible, porque todos los números entre 2 y 19 ya han salido con el 1 antes (mirar las 6 primeras combinaciones). Y se cumpliría la condición de que el 1 ya se ha visto con cualquiera de esos números.

Me temo que esto no es lo que quieres...

Según las condiciones que has puesto, la segunda es la que limita la salida de todas las combinaciones: «tampoco me valdría otra donde volvieran a coincidir dos variables o más...». Como los grupos son de 4, eso quiere decir que habrá alumnos que estarán en más combinaciones (el 1, seis veces), pero otras, menos (el 20, tres veces) por la razón explicada antes.

Ya que lo vas a ejecutar en Codepad, prueba esta versión:

Código (perl) [Seleccionar] Expandir

#!/usr/bin/perl
use strict;
use warnings;

my $alumnos = 20;                    # Número de alumnos
my $grupos  = 4;                     # Tamaño de los grupos

my @alumnos = 1 .. $alumnos;
my $n_grupo = 1;

while (@alumnos >= $grupos) {

   # Creamos un @nuevo_grupo compuesto de tantos alumnos como de grande
   # sean los $grupos, elegidos al azar de los @alumnos restantes
   my @nuevo_grupo = map { splice @alumnos, rand(@alumnos), 1 } 1 .. $grupos;

   print "Grupo $n_grupo: [@nuevo_grupo]\n";

   $n_grupo++;
}

# Resto que ha quedado sin asignar
if (@alumnos) {
   print "Grupo $n_grupo: [@alumnos]\n";
}


Ya está cambiado para los Perl antiguos.

Esta es mi versión:

Código (perl) [Seleccionar] Expandir

#!/usr/bin/perl
use strict;
use warnings;

print "Número de alumnos: ";
my $alumnos = <>;

print "Tamaño de los grupos: ";
my $grupos  = <>;

my @alumnos = 1 .. $alumnos;
my $n_grupo = 1;

while (@alumnos >= $grupos) {

   # Creamos un @nuevo_grupo compuesto de tantos alumnos como de grande
   # sean los $grupos, elegidos al azar de los @alumnos restantes
   my @nuevo_grupo = map { splice @alumnos, rand(@alumnos), 1 } 1 .. $grupos;

   print "Grupo $n_grupo: [@nuevo_grupo]\n";

   $n_grupo++;
}

# Resto que ha quedado sin asignar
if (@alumnos) {
   print "Grupo $n_grupo: [@alumnos]\n";
}

__END__
Número de alumnos: 23
Tamaño de los grupos: 4
Grupo 1: [23 1 3 7]
Grupo 2: [14 20 13 22]
Grupo 3: [15 8 10 6]
Grupo 4: [4 12 18 11]
Grupo 5: [21 17 5 2]
Grupo 6: [9 16 19]

Para que LWP pueda acceder con el protocolo HTTPS, debe estar instalado el módulo LWP::Protocol::https .

La mejor forma de evitar este tipo de ataques es programar bien la prueba de entrada de datos.
De hecho, la primera regla de lectura de datos desde el exterior del programa es no confiar nunca en los datos que llegan desde el usuario.

Con Perl, se puede usar el par prepare/execute:

Código (perl) [Seleccionar] Expandir


my $sth = $dbh->prepare('SELECT * FROM usuarios WHERE nombre=? AND clave=?');

$sth->execute($nombre, $clave);


Además, si el nombre y/o clave cumplen alguna regla de escritura, podemos poner un filtrado previo a $nombre y $clave, y así reducir aún más la posibilidad de ataque. Por ejemplo: las claves no deben contener espacios en blanco.

Sería algo así:

Código (perl) [Seleccionar] Expandir

#!/usr/bin/perl
use 5.010;
use utf8;
use strict;

print "Ingrese nombre de usuario: ";
my $nombre = <>;
chomp $nombre ;

if ($nombre =~ /^[ab]+$/i) {
   say 'Sí pertenece';
}
else {
   say 'No pertenece';
}