Un mago te ha ordenado, como maestro arquitecto, que construyas torres apilando bloques de piedra.
Tienes a tu disposición cinco canteros de intelecto limitado. Cada albañil es capaz de fabricar un solo tipo de bloque cilíndrico, cuya altura debe ser un número entero positivo y cuyo diámetro es irrelevante. Los albañiles tienen tiempo suficiente para construir tantas copias de su tipo de bloque como sean necesarias.
El mago, siendo caprichoso, exigirá una torre con una altura entera entre 1 y 300 unidades. No hay forma de saber de antemano qué altura se exigirá; se seleccionará de una distribución uniforme. El mago también ha decidido que cada torre esté formada por no más de cinco bloques. Se acepta el uso de varias copias del mismo tamaño de bloque. Los bloques no pueden apilarse lateralmente.
¿Qué cinco números enteros asignas a tus albañiles para maximizar la probabilidad de que puedas construir una torre de la altura especificada, usando no más de cinco bloques en total? ¿Cuál es esa probabilidad (es decir, la probabilidad de que puedas cumplir las exigencias del mago y escapar de una muerte prematura)? ¿Existen múltiples soluciones con una probabilidad igualmente buena? ¿Cuál es la mejor manera de obtener buenas soluciones rápidamente?
Para decirlo de manera más formal:
Seleccione el conjunto de cinco enteros positivos {a, b, c, d, e} que maximizan la probabilidad de que
n1*a + n2*b + n3*c + n4*d + n5*e == RandomInteger[{1,300}]
n1 + n2 + n3 + n4 + n5 <= 5
tiene al menos una solución, donde n1 a n5 son enteros >= 0.
La única estrategia que se me ocurrió fue modificar al azar una solución existente y comprobar si era mejor que la solución actual. Esto no es muy eficiente, y es probable que se quede atascado en algún máximo local. Quizás haya algo más elegante. Aquí está el código de Mathematica:
score[{a_, b_, c_, d_, e_}] := Length[Flatten[FindInstance[{
n1*a + n2*b + n3*c + n4*d + n5*e == #,
n1 >= 0, n2 >= 0, n3 >= 0, n4 >= 0, n5 >= 0,
n1 + n2 + n3 + n4 + n5 <= 5
}, {n1, n2, n3, n4, n5}, Integers, 1] & /@ Range[300], 1]]
best = {5, 10, 15, 20, 25};
bestScore = score[best];
nRounds = 1000;
Do[
new = best + RandomInteger[{-2, 3}, 5];
newScore = score[new];
If[newScore > bestScore, bestScore = newScore; best = Sort[new]];
If[Mod[r, 10] == 0, Print[r, " ", best, " ", bestScore]],
{r, 1, nRounds}
]