Come Solo.

El juego de come solo (en inglés Triangular peg solitaire) tradicional consiste de un trablero triangular con 15 orificios como el mostrado en la siguiente figura: 

El tablero no necesita necesariamente ser triangular pero el diseño comunmente usado corresponde a un triángulo equilatero. De los 15 orificios en todos menos uno (posición abierta inicial) se coloca una pequeña canica o pin. Los pines pueden pasar a una posición abierta saltando a un pin adyancente (vecino), removiendo el pin sobre el cual se salta. La meta es terminar con un tablero que al final contenga un sólo pin.  Los saltos se permiten en las tres direcciones  de los ejes paralelos al tablero. Cada pin tiene un máximo de 6 vecinos en el caso de un tablero triangular y cuatro para el caso de un tablero cuadrado.

Como resolver utilizando búsqueda Ciega?

1. Obtener una representación para  el tablero. 
2. Basados en la representación definir una función para a partir de un estado generar los siguientes posibles estados
3. Definir la fucnión que  identifique cuando se  encontro una solución 
4. A diferencia del problema de las N reinas es este caso se necesita recordar toda la rama de búsqueda que nos llevo a la solución.

1. Representación

En este caso se puede representar el tablero como una lista de listas. En la que cada posición corresponde a un orificio, si en el orificio hay aún un pin la posisción de la lista tendrá un 1 y un 0 en caso contrario.  Por ejemplo  con la siguiente instrucción pordríamos generar un estado para un tablero de 15 orificios tringular en la que todos los orificios contienen un pin (esto no ocurre ya siempre se debe inciar con una posición abierta)

Table[1, {i, 5}, {j, i}]

{{1}, {1, 1}, {1, 1, 1}, {1, 1, 1, 1}, {1, 1, 1, 1, 1}}

si impirmimos su matriz form

MatrixForm[Table[1, {i, 5}, {j, i}]]

(({{{1}}, {{1,1}}, {{1,1,1}}, {{1,1,1,1}}, {{1,1,1,1,1}}}))

como convención podriamos asumir que el último elemento de la ultima lista siempre sea la posisición abierta.  Para el caso del ejemplo, se puede conseguir como sigue:

MatrixForm[Table[If[i == j && j == 5, 0, 1], {i, 5}, {j, i}]]

(({{{1}}, {{1,1}}, {{1,1,1}}, {{1,1,1,1}}, {{1,1,1,1,0}}}))

Ejercicio 1.  Implemente una función que genere tableros trianguales de tamaño n (TrianglePuzzleState[n]) que regrese un tablero de tamaño 3xn (dado que es un triángulo equilatero)

TrianglePuzzleState[6] debe regresar

(({{{1}}, {{1,1}}, {{1,1,1}}, {{1,1,1,1}}, {{1,1,1,1,1}}, {{1,1,1,1,1,0}}}))

{{1}, {1, 1}, {1, 1, 1}, {1, 1, 1, 1}, {1, 1, 1, 1, 1}, {1, 1, 1, 1, 1, 0}}

y TrianglePuzzleState[7] debe regresar

(({{{1}}, {{1,1}}, {{1,1,1}}, {{1,1,1,1}}, {{1,1,1,1,1}}, {{1,1,1,1,1,1}}, {{1,1,1,1,1,1,0}}}))

etc

Solución

TrianglePuzzleState[n_]:=Module[{i,j},Table[If[i==n && i==j,0,1],{i,n},{j,i}]]

Ejercicio 2 Implementar un función que pase al representación de lista a una representación gráfica (como en le caso de las n reinas).  Generar un tablero con la estructura   de la siguiente figura:

GraphicsGrid[Table[Graphics[Disk[]], {i, 8}, {j, i}]]

Solución:

SetFrame[t_]:=Module[{i,j, n=Length[t]},
      Flatten[ Table[ {i,j}->True, {i, n}, {j,i}]]
]

TrianglePuzzleBoard[t_]:=GraphicsGrid[t/.{0-> Graphics[],1->Graphics[Disk[]]}, Frame->{ None,None, SetFrame[t]}]

TrianglePuzzleBoard[TrianglePuzzleState[5]]

s=TrianglePuzzleState[5]

SetFrame[s]

GraphicsGrid[s/.{0-> Graphics[],1->Graphics[Disk[]]}, Frame->{None,None, {{5,5}->True,{1,1}->True}}]

Generar los siguientes estados:

En éste caso los posibles siguientes estados consisten, en todas las posibles opciones de saltar un elemento para un tablero dado. Por ejemplo en el tablero de la figura previa, la única posición libre es la  {5,5}  a esta posición solo se puede llegar saltando sobre {4,4} o bien sobre {5,4}.  Realizar las poperaciones mencionadas nos llevaría a:

Si se elige saltar sobre {4,4} desde {3,3}, se elimina  el pin en la posición {4,4} y se pasa el de la posición {3,3} a {5,5} y se obtiene el siguiente estado

Meintras que, si se elige saltar sobre {5,4} utilizando {5,3}, de igual forma se elimina en la posición {5,4} y se pasa el de la posición {5,3} a {5,5} y se obtiene la siguiente configuracion

Con lo anterior puede observarce al  realizar un movimiento se cumple lo siguiente: 
1. Existen dos pines adyancente ({i,j},{i±1,j}), ({i,j},{i,j±1}) o ({i,j},{i±1,j±1}). 
2. La posición de destino del pin que salta siempre sera la posción ±2 de la dirección elegida y ésta debe estar vacia 
En niguno de los casos los indices deben caer fuera del tablero

de la siguiente figura

s=TrianglePuzzleState[5]

TrianglePuzzleBoard[s]

TrianglePuzzleStateSigs[state_]:=Block[
{fill=Position[state,1], void=Position[state,0],psigs,jumps, n=Length[state], childs,pjumps,i,j,k,origen,destino, jump},
jumps=Select[Flatten[Table[{i,j}, {i,{-2,0,2}},{j,{-2,0,2}}],1],#=!={0,0}&];
jumps=Map[Map[ Function[{x},#+x  ],jumps ]&,fill];
jumps=Map[Function[{x},
Select[x,(#[[1]]>0 && #[[1]]<=n && #[[2]]>0 && #[[2]]<=n &&  #[[1]]≥ #[[2]]) &]], jumps];
jumps=Map[Function[{x},Map[Intersection[x,{#}]&,void]],jumps];
pjumps=Position[jumps,{{_Integer,_Integer}}];
childs={};
pjumps=Position[jumps,{{_Integer,_Integer}}];
For[k=1,k<=Length[pjumps],k++ ,
i=pjumps[[k]][[1]];
j=pjumps[[k]][[2]];
origen=fill[[i]];
destino=jumps[[i,j]][[1]];
jump=(origen+destino)/2;
If[MemberQ[fill,jump],
childs=Insert[childs,ReplacePart[state,{origen->0,destino->1,jump->0}],1]];
];
childs
]

s1=ReplacePart[s,{{5,4}->0,{3,2}->0,{4,1}->0}]

TrianglePuzzleBoard[s1]

Map[MakeNode[#,s1], TrianglePuzzleStateSigs[s1]]

Map[TrianglePuzzleBoard, Join[{s1},TrianglePuzzleStateSigs[s1]]]

¿Cuáles son los indices de los elementos que pueden moverse (comer)?
¿Cuántas posibles configuracione hay para el siguiente tablero?
 Sugerir una formula o condición calcular el número posibles estados siguientes

Ejercicio 3: Implementar una función que genere todas las posibles configuraciones dadas para un estado dado.

r=MakeNode[State->s1,NDepth->0]

r=Map[MakeNode [State->#1,Parent->r]&,TrianglePuzzleStateSigs[State[r]]]

TSUCCN[node_]:=Map[MakeNode [State->#1,Parent->node]&,TrianglePuzzleStateSigs[State[node]]]

TSUCCN[r[[1]]]

TPNGoal[node_]:=Apply[Plus, Flatten[State[node]]]==1

TPNGoal[r[[1]]]

z=DefineProblem[InitialState->s, GoalPredicate->TPNGoal,Successors->TSUCCN]