Muchísimas gracias de nuevo a EleKtro H@cker y Runex, sé que no es facil lo que quiero, pero me habéis ayudado bastante y bien.
Gracias.
Gracias.
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes MenúCita de: explorer en 22 Marzo 2012, 00:21 AM
Ahora estoy un poco dormido, pero creo que la solución es esta: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.
Cita de: explorer en 20 Marzo 2012, 18:47 PM
Ya que lo vas a ejecutar en Codepad, prueba esta versión:#!/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";
}