Discussion :

[kaukau]

Salut!
J'essaye d'écrire un solveur pour le jeu du solitaire en Haskell.
Vous savez, ce jeu ou des billes sont disposées en croix sur un plateau, le but étant de manger toutes les billes pour n'en avoir plus qu'une à la fin, si possible au milieu du plateau...
Je rencontre quelques problèmes de design, j'aimerais que vous me donniez votre avis!

Il me faut décrire le plateau, les coups possibles et l'arbre des jeux:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
--les emplacements: bille, trou ou interdit
data Emplacement = B | T | I  deriving Eq
 
--le plateau 
data Plateau = Plateau { deconsPlat :: [[Emplacement]]}
 
--les coups possibles
newtype Coup = Coup { coup :: ([[Emplacement]], [[Emplacement]])}
newtype ListeCoups = ListeCoups { coups :: [Coup]}
 
--l'arbre des jeux
data Tree = Null | Node Plateau [Tree]
	deriving Eq
 
-- list of legal moves
coupsLegaux = ListeCoups [ Coup ([[B, B, T]], [[T, T, B]]),
			   Coup ([[T, B, B]], [[B, T, T]]),
                           Coup ([[B], [B], [T]], [[T], [T], [B]]),
                           Coup ([[T], [B], [B]], [[B], [T], [T]])]
 
--the initial board
initial = Plateau [[I, I, B, B, B, I, I],
                      [I, I, B, B, B, I, I],
                      [B, B, B, B, B, B, B],
                      [B, B, B, T, B, B, B],
                      [B, B, B, B, B, B, B],
                      [I, I, B, B, B, I, I],
                      [I, I, B, B, B, I, I]]

Ensuite, j'essaye de trouver tous les coups jouables à partir d'une position donnée.
Je souhaite écrire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

listePlat :: Plateau -> Coup -> [Plateau]

qui me donne tous les plateaux possibles à partir d'un plateau et d'un coup donné.

Cette recherche ressemble au problème classique du rechercher/remplacer d'une sous-chaine dans une chaine...
J'ai donc écrit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
--recherche la première occurence de "find" dans "s" et la remplace par "repl"
--si trouvé, retourne le résultat et le reste (pour application itérative)
replReste :: Eq a => [a] -> [a] -> [a] -> Maybe ([a], [a])
replReste _ _ [] = Nothing
replReste [] _ s = Just (s, [])
replReste find repl s =
    if take (length find) s == find
	 --si on trouve, on effectue le remplacement et on renvoie le reste
        then Just (repl ++ (drop (length find) s), drop (length find) s) 
	 --sinon on appelle récursivement en accumulant les caractères
        else case replReste find repl (tail s) of 
		Nothing -> Nothing
		Just (a, b) -> Just ([head s] ++ a, b)
 
--recherche les occurences de "find" dans "s" et les remplaces par "repl"
--retourne la liste des chaines résultats (un remplacement à chaque fois).
repls :: Eq a => [a] -> [a] -> [a] -> [[a]]
repls rech rempl s = unfoldr (compl . (replReste rech rempl))  s
   where compl Nothing = Nothing 
       -- on est obligé de compléter le début des chaines car sinon elles commencent par les caractères remplacés
      compl (Just (a,b)) = Just (take ((length s) - ((length a) + (length rech) -(length rempl))) s ++ a, b)

Ces deux fonctions me parraissent bien compliquées pour le résultat... Mais je n'ai pas trouvé plus simple après beaucoup beaucoup de grattage de tête!! D'autres idées?



Ensuite je voudrais écrire la fonction:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

listePlat :: Plateau -> Coup -> [Plateau]

Mais je bloque!
Il faudrais appliquer "repls" à chaque lignes du plateau et tout reconstituer... Je ne trouve pas de solution élégante.

[Jedai]

Je crains que le problème ne réside dans la représentation du plateau (et des coups)... Tu as dû t'en apercevoir lorsque le problème d'appliquer simplement un coup à un plateau s'est démontré si difficile.
A mon avis, une bien meilleure solution serait d'utiliser soit une matrice soit une Map pour représenter le plateau et un couple de coordonnées pour un coup, il serait bien plus aisé de manipuler cette représentation, plus compacte de plus... Je conseille une Map puisqu'une bonne partie des plateaux similaires peuvent ainsi être partagés.

Quelque chose comme :

Code Haskell :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
module Solitaire () where
import Data.Set as S
import qualified Data.List as L
import Control.Monad
import Data.Maybe
 
type Board = Set Pos
data Pos = P !Int !Int deriving (Eq, Ord, Show)
type Move = (Pos,Pos)
 
validPos :: Pos -> Bool
validPos (P x y) = 
    0 < x && x < 8 && 0 < y && y < 8
          && (x `elem` [3,4,5] || y `elem` [3,4,5]) 
 
initBoard = delete (P 4 4) . fromList $ [ pos | x <- [1..7], y <- [1..7], let pos = P x y, validPos pos ]
 
(P x y) <+> (P x' y') = P (x+x') (y+y')
n <*> (P x y) = P (n*x) (n*y)
 
moveDirs = [P 0 (-1), P (-1) 0, P 1 0, P 0 1]
 
applyMove :: Board -> Move -> Maybe Board
applyMove b (pos,dir) = do 
    guard validMove >> 
              return (delete bridge . delete pos . insert newPos $ b)
    where validMove = 
              pos `member` b && bridge `member` b && dir `elem` moveDirs
                      && newPos `notMember` b && validPos newPos
          newPos = pos <+> (2 <*> dir)
          bridge = pos <+> dir
 
oneMove :: Board -> [Board]
oneMove b = catMaybes . L.map (applyMove b) 
            $ [(pos,dir) | pos <- elems b, dir <- moveDirs]

Encore que oneMove soit un peu lent en début de partie, une variante travaillerait sur les trous plutôt que sur les billes.

--
Jedaï

[kaukau]

Joli!
Je ne comprend pas la partie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
applyMove b (pos,dir) = do 
    guard validMove >> 
              return (delete bridge . delete pos . insert newPos $ b)

Mais je n'ai jamais compris cette histoire de monade.
Que signifie guard? ">>"?
Quelle différence avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
applyMove :: Board -> Move -> Maybe Board
applyMove b (pos,dir) = if validMove 
                          then Just (delete bridge . delete pos . insert newPos $ b)
                          else Nothing

Je ne comprend pas non plus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

data Pos = P !Int !Int deriving (Eq, Ord, Show)

Les "!" c'est pour les rendre parresseux? Pour quoi faire?

[Jedai]

Il n'y a pas de différence entre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

guard a >> return b

et :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if a then Just b else Nothing

Utilise la forme qui t'est le plus agréable/familière.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

data Pos = P !Int !Int

Les ! indiquent que ces champs sont stricts, c'est à dire que une position ne peut avoir que deux formes : soit bottom, soit P x y avec x et y des entiers bien définis. Il y a donc une différence avec (Int,Int) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
fst (x,y) = x
pFst (P x y) = x

se comportent différemment si on leur donne une paire dont le second élément est "bottom" (c'est à dire undefined ou un calcul qui ne finit pas ou avec une exception), fst marche, mais pFst ne marche pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
print (fst (1, last [1..])) -- affiche 1
print (pFst (P 1 (last [1..]))) -- BOUM

Utiliser des champs stricts permet d'obtenir de meilleures performances lorsqu'on n'a pas besoin de la paresse comme ici, cela peut également faire sens d'un point de vue sémantique.

Lorsque tu compiles ce genre de code, utilise -funbox-strict-fields pour des performances maximales.

Par ailleurs que comptes-tu faire avec ce code ?

--
Jedaï

[kaukau]

Merci pour les réponses!

J'essaie de trouver la solution, bien sur...
Mon programme tourne, mais ne finit pas à cause de l'explosion combinatoire, on s'en doute!

Comme deux plateaux symétriques sont équivalents, je supprime toutes les symétries (8 symétries et rotations):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
--symetries
symId :: Plateau -> Plateau
symId p = p
symH ::  Plateau -> Plateau
symH p = Plateau $ reverse $ deconsPlat p
symV ::  Plateau -> Plateau
symV p = Plateau $ map reverse $ deconsPlat p
symD ::  Plateau -> Plateau
symD p = Plateau $ transpose $ deconsPlat p
 
--list of symetries and rotations
transList = [ h . v . d | h <- [symId,  symH], v <- [symId,  symV], d <- [symId, symD] ]
 
--new egality with symetries added
instance Eq(Plateau) where
	(==) p1 p2 = elem (deconsPlat p1) $ map (deconsPlat . ($ p2)) transList

Je définit une nouvelle égalité, ce qui me permet d'utiliser la fonction "nub" lors du calcul de l'arbre...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
--get the entiere tree from a board
arbre :: Plateau -> Tree
arbre monPlat = Node monPlat (map arbre (nub $ listePlatTot monPlat))

"listePlatTot" correspond à ton "oneMove"

Je me suis apperçu que grâce à la paresse, je pouvais supprimer les symétries ici ou plus tard, le temps d'éxécution est le même!!

Mais ce n'est pas suffisant, il faudrait supprimer les symétries pour tous les plateaux d'un même niveau (qui contiennent le même nombre de billes), plutôt que seulement sur les fils d'un tableau. Comment faire?


Ensuite j'essaye de noter les plateaux, afin d'implémenter une sorte d'algo Alpha-Béta, mais ça c'est pas gagné.
Mes critères sont:
a. essayer de centrer le jeu
b. ne pas avoir de billes ou de groupes de billes trop isolées du reste.
c. pas trop de billes dans les coins.

Le a. est facile a coder.
Pour le b. j'essaye d'implémenter un petit algo récursif, afin de distinguer des groupes de billes jointives. Ensuite je calculerais une distance entre les groupes...

[kaukau]

J'essaye de regrouper les billes par groupes sur le plateau.


J'ai écrit la fonction suivante, qui prend un plateau, une position et est sensée me retourner la liste de toutes les billes qui se touchent à partir de celle donnée...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
group :: Board -> Pos -> [Pos]
group board pos = if S.member pos board 
			then pos : concatMap ((group (S.delete pos board)).(pos <+>)) moveDirs 
			else []

Malheureusement elle boucle indéfiniement!!

[Jedai]

Malheureusement elle boucle indéfiniement!!

Non, elle ne boucle pas indéfiniment, par contre j'imagine que si tu l'as essayé sur un plateau un peu plein tu peux avoir cette impression.
Essaye la donc avec ces paramètres :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

shell (fromList [P 2 4, P 2 3, P 3 3, P 3 4, P 4 5, P 4 4]) (P 3 4)

(j'ai renommé "group" en "shell" parce que group est une fonction du Prelude et c'est toujours source de confusion d'utiliser un nom de fonction standard pour désigner une autre fonction)
Le résultat devrait t'éclairer un peu sur ton problème.

--
Jedaï

[kaukau]

J'ai une version qui fonctionne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
shell :: [Pos] -> Pos -> [Pos]
shell board pos = if elem pos board 
		then pos : g1 ++ g2 ++ g3 ++ g4   --recherche ds les 4 directions
		else []
	where	g1 = shell reste (pos <+> (moveDirs !! 0))
		g2 = shell (reste L.\\ g1) (pos <+> (moveDirs !! 1))
		g3 = shell ((reste L.\\ g1) L.\\ g2) (pos <+> (moveDirs !! 2))
		g4 = shell (((reste L.\\ g1) L.\\ g2) L.\\ g3) (pos <+> (moveDirs !! 3))
		reste = L.delete pos board

Mais j'ai du mal à le factoriser!!

[Jedai]

Je ne sais pas trop ce que tu veux dire par "factoriser", simplifier ?

J'ai une autre solution, un peu plus performante, mais à vrai dire sur un plateau de cette taille, ça ne fait pas grande différence :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
neighbours :: Board -> Pos -> Set Pos
neighbours b pos = fromList . L.filter (`member` b) . L.map (pos <+>) $ moveDirs
 
shellByN :: Board -> Pos -> [Set Pos]
shellByN b pos = tail shells
    where 
      shells =
          empty : (singleton pos) `intersection` b :
                zipWith shellN shells (tail shells)
      shellN s2 s1 = 
          (\\s2) . (\\ s1) . unions . L.map (neighbours b) . elems $ s1
 
shell :: Board -> Pos -> Set Pos
shell b = unions . takeWhile (not . S.null) . shellByN b

--
Jedaï

[kaukau]

J'ai trouvé une solution, mais oh! malheur! Elle provoque un beau plantage de ghci.exe, qui ferme avec pertes et fracas!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
import Data.List
 
data Pos = P !Int !Int deriving (Eq, Ord, Show)
moveDirs = [P 0 (-1), P (-1) 0, P 1 0, P 0 1]
(P x y) <+> (P x' y') = P (x+x') (y+y')
 
shell :: Pos -> [Pos] -> [Pos]
shell pos board = if elem pos board 
		then pos : (concat balls)
		else []
	where	left = delete pos board
                 -- gs is an array of functions that iterate on neigthboors in 4 directions given a stripped off board
		gs = map (shell . (pos <+>)) moveDirs 
                 --apply gs on stripped off boards (the return of precedent calls to gs are substracted), return gathered balls in each 4 directions
		balls = zipWith ($) (gs) (map ((left \\) . concat) (inits balls))

Ce code compile tel-quel (j'ai inclus les préliminaires nécessaires).
Mais plantage sur la commande:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

length $ shell (P 1 1) [P 1 1, P 1 2]

[kaukau]

On obtient le même plantage (stack overflow sous Linux) avec le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

f = map ((+)1.sum) (inits f)

Qui devrait pourtant fonctionner, puisque la première valeur de 'inits' est toujours '[]'...
Malheureusement, 'inits' n'est pas paresseuse!!
Ce qui explique tout!

On peut définir une version paresseuse comme ça (merci le chan IRC #haskell !):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
let inits' x = [] : case x of 
       [] -> [] 
       (y:ys) -> map (y:) inits' ys

Et ma fonction f fonctionne.

On peut même l'écrire comme ça, pour éviter la définition récursive (encore d'après l'IRC):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

f = fix (map ((+)1 . sum) . inits')

Mais j'avoue que cette définition me laisse un peu plus perplexe! Je devais dormir lors du cours sur la récursivité!!

[SpiceGuid]

Mon programme tourne, mais ne finit pas à cause de l'explosion combinatoire, on s'en doute!

• tu devrais utiliser une table de transposition, va voir mes sources OCaml dans le fil Page code source, tu devrais pouvoir facilement les convertir en Haskell
• mes higher-order modules sont assez simples, ça accrédite l'idée de Jedai selon laquelle les choix de conception les plus difficiles sont principalement dans la représentation du plateau et des coups
• ma source peut aussi utiliser une recherche bidirectionnelle, c'est plus ou moins adapté à ce problème puisque (au moins dans le défi C) on te donne la position finale. dans un sens tu fais disparaître les billes, dans l'autre sens tu les fais apparaître, ça divise par 2 la profondeur de l'espace de recherche. c'est tout de même nettement plus profitable que de simplement jouer sur les symétries ou sur le multi-coeur (ce sont des optimisations naïves)

À mon avis la meilleur représentation des coups c'est un point plus une direction :

Code OCaml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
type point = int * int

type move =
  | Left  of point
  | Right of point
  | Up    of point
  | Down  of point

Dans le sens direct le point est le point de départ de la bille, dans le sens rétrograde (recherche bi-directionnelle) ce serait au contraire le point d'arrivée.

Vu qu'il n'y a en fait que 33 trous on peut imaginer une représentation encore plus compacte des positions :

Code OCaml :

Sélectionner tout - Visualiser dans une fenêtre à part

type point = int

Par contre pour la réprésentation du plateau, là tout de suite, je n'ai pas d'idée sur la nature du meilleur compromis entre vitesse (de génération des coups) et espace mémoire.
La représentation la plus compacte en mémoire c'est un bit à 0 pour un trou et un bit à 1 pour une bille. Le plateau tient alors dans un entier 64bits (ou deux entiers 32bits) mais ça ralenti probablement trop la génération des coups.

[SpiceGuid]

Vu les performances des programmeurs C/C++ sur le deuxième défi C ça m'a donné envie de "participer" au troisième défi qui est d'ailleurs un peu plus facile à mon avis. Pour l'instant OCaml fait merveille, ma performance n'est pas du tout plombée par les 'foncteurs' et j'ai encore des opportunités d'optimisation.