Expandir Problema de colegiala de Kirkman

22

Para aquellos de ustedes que no están familiarizados, el problema de la colegiala de Kirkman es el siguiente:

Quince señoritas en una escuela salen tres juntas por siete días seguidos: es necesario organizarlas diariamente para que no dos caminen dos veces juntas.

Podríamos ver esto como una lista anidada de 3 por 5 (o matriz):

[[a,b,c]
 [d,e,f]
 [g,h,i]
 [j,k,l]
 [m,n,o]]

Esencialmente, el objetivo del problema original es descubrir 7 formas diferentes de organizar la matriz anterior para que dos letras nunca compartan una fila más de una vez . De MathWorld (vinculado anteriormente), encontramos esta solución:

[[a,b,c]   [[a,d,h]   [[a,e,m]   [[a,f,i]   [[a,g,l]   [[a,j,n]   [[a,k,o]
 [d,e,f]    [b,e,k]    [b,h,n]    [b,l,o]    [b,d,j]    [b,i,m]    [b,f,g]
 [g,h,i]    [c,i,o]    [c,g,k]    [c,h,j]    [c,f,m]    [c,e,l]    [c,d,n]
 [j,k,l]    [f,l,n]    [d,i,l]    [d,k,m]    [e,h,o]    [d,o,g]    [e,i,j]
 [m,n,o]]   [g,j,m]]   [f,j,o]]   [e,g,n]]   [i,k,n]]   [f,h,k]]   [h,l,m]]

Ahora, ¿y si hubiera un número diferente de colegialas? ¿Podría haber un octavo día? Este es nuestro desafío.

En este caso, no †† , pero no necesariamente para otras dimensiones de matriz
†† Podemos mostrar esto fácilmente, ya que aaparece en una fila con todas las demás letras.


El reto:

Dada una entrada de dimensiones (filas, de columnas) de una matriz de colegialas (es decir 3 x 5, 4 x 4, o [7,6], [10,10], etc.), de salida de la mayor cantidad posible de 'día' que se ajustan a los requisitos especificados anteriormente.

Entrada: las
dimensiones de la matriz de colegiala (cualquier forma de entrada razonable que desee).

Salida: la
serie más grande posible de matrices que se ajustan a los requisitos anteriores (cualquier forma razonable).

Casos de prueba:

Input:  [1,1]
Output: [[a]]

Input:  [1,2]
Output: [[a,b]]

Input:* [2,1]
Output: [[a]
         [b]]

Input:  [2,2]
Output: [[a,b]  [[a,c]  [[a,d]
         [c,d]]  [b,d]]  [b,c]]

Input:  [3,3]
Output: [[a,b,c]  [[a,d,g]  [[a,e,i]  [[a,f,h]
         [d,e,f]   [b,e,h]   [b,f,g]   [b,d,i]
         [g,h,i]]  [c,f,i]]  [c,d,h]]  [c,e,g]]

Input:  [5,3]
Output: [[a,b,c]   [[a,d,h]   [[a,e,m]   [[a,f,i]   [[a,g,l]   [[a,j,n]   [[a,k,o]
         [d,e,f]    [b,e,k]    [b,h,n]    [b,l,o]    [b,d,j]    [b,i,m]    [b,f,g]
         [g,h,i]    [c,i,o]    [c,g,k]    [c,h,j]    [c,f,m]    [c,e,l]    [c,d,n]
         [j,k,l]    [f,l,n]    [d,i,l]    [d,k,m]    [e,h,o]    [d,o,g]    [e,i,j]
         [m,n,o]]   [g,j,m]]   [f,j,o]]   [e,g,n]]   [i,k,n]]   [f,h,k]]   [h,l,m]]

There may be more than one correct answer. 

* Gracias a @Frozenfrank por corregir el caso de prueba 3 : si solo hay una columna, solo puede haber un día, ya que el orden de las filas no importa.

Esta es competencia de : gana la respuesta más corta.

Scott Milner
fuente
¿Se relaciona esto con planos proyectivos finitos de alguna manera o estoy pensando en un problema diferente?
Neil
@Neil no tengo idea. Me temo que no estoy calificado para responder eso. ;-)
Scott Milner
¿Hay un límite de tiempo?
Artyer
@Artyer No, pero me gustaría poder probar el código ...
Scott Milner
2
@Neil que fue una lectura divertida de Wikipedia.
Urna mágica de pulpo

Respuestas:

12

Mathematica, 935 bytes

Inp={5,4};L=Length;T=Table;ST[t_,k_,n_]:=Binomial[n-1,t-1]/Binomial[k-1,t-1];H=ToExpression@Alphabet[];Lo=Inp[[1]]*Inp[[2]];H=H[[;;Lo]];Final={};ST[2,3,12]=4;ST[2,4,20]=5;If[Inp[[2]]==1,Column[Partition[H,{1}]],CA=Lo*Floor@ST[2,Inp[[2]],Lo];While[L@Flatten@Final!=CA,Final={};uu=0;S=Normal[Association[T[ToRules[H[[Z]]==Prime[Z]],{Z,L@H}]]];PA=Union[Sort/@Permutations[H,{Inp[[2]]}]];PT=Partition[H,Inp[[2]]];While[L@PA!=0,AppendTo[Final,PT];Test=Flatten@T[Times@@@Subsets[PT[[X]],{2}]/.S,{X, L@PT}];POK=T[Times@@@Subsets[PA[[Y]],{2}]/.S,{Y,L@PA}];Fin=Select[POK,L@Intersection[Test,#]==0&];Facfin=T[FactorInteger[Fin[[V]]],{V,L@Fin}];end=T[Union@Flatten@T[First/@#[[W]],{W,L@#}]&[Facfin[[F]]],{F,L@Facfin}]/.Map[Reverse,S];PA=end;PT=DeleteDuplicates[RandomSample@end,Intersection@##=!={}&];If[L@Flatten@PT<L@H,While[uu<1000,PT=DeleteDuplicates[RandomSample@end,Intersection@##=!={}&];If[L@Flatten@PT==L@H,Break[],uu++]]]]];Grid@Final]


esto es para 26 damas max

EDITAR
Hice algunos cambios y creo que funciona! El código ahora está configurado para resolver [5,4] (que es el "problema de los golfistas sociales") y obtiene el resultado en unos segundos. Sin embargo, el problema [5,3] es más difícil y tendrá que esperar entre 10 y 20 minutos, pero obtendrá la combinación correcta para todos los días. Para casos más fáciles es muy rápido.

de todos modos, puede probarlo y ver los resultados
Pruébelo en línea aquí,
copie y pegue usando ctrl-v
presione shift + enter para ejecutar el código
, puede cambiar la entrada al comienzo del código -> Inp = {5,4}
ejecute codificar varias veces para obtener diferentes permutaciones

J42161217
fuente
Si bien esto es impresionante y progresa mucho hacia la solución del problema, aún está incompleto. Si bien funciona para casos de prueba más pequeños, no pudo resolver ninguno más grande, incluido el [5,3]caso de prueba en el que se basa todo este problema. Además, esto se puede jugar más al golf; hay varios nombres de variables que son más grandes de lo que deben ser, y algunas funciones pueden acortarse con @notación infija o infijada. ¡Pero espero que sigas trabajando!
Scott Milner
Gracias por revisarlo. Intentaré hacer que esto funcione primero y luego
jugarlo
1
Usted debe ser capaz de guardar un montón de bytes haciendo sus nombres de variables de una sola letra, y la asignación de algunas funciones que utiliza más de una vez a las variables y la sustitución de las funciones con las variables :)
numbermaniac
2
@numbermaniac Simplemente reemplazando los nombres de las variables, pude hacerlo 914. Debería ser golfable a alrededor de 850.
Scott Milner
3
Arreglé el caso de prueba. En primer lugar, quiero que esto funcione. Es por eso que no lo he jugado todavía. Gracias por todos sus comentarios. Creo que ahora está listo.
J42161217