Discussion :

[Jedai]

Oui et non. Ton ton est assez sec et on dirait que tripoter dans son garage, c'est sale. Je ne suis pas vraiment d'accord et j'ai regardé ça parce que ça m'amusait d'expérimenter sur un petit truc, et je trouve que la phase de bidouillage/recherche_perso apporte des choses que "hoho on va regarder ce que disent les bons sur google" n'a pas.

Désolé pour le ton. Je suis tout à fait en faveur de l'expérimentation mais ce qui me gène c'est l'impression que vous tournez un peu en rond et que les solutions que vous sortez sont relativement illisibles et superficiellement compliquées alors qu'un peu de reformulation et d'abstraction permettent d'y voir nettement plus clair. Les exemples que j'avais fournis étaient destinés à illustrer cela plus qu'autre chose : tu remarqueras qu'aucune ne contient de fonction aussi longues que les vôtres, les tâches sont clairement séparées en fonctions autonomes utiles par elles-même et même ainsi, la totalité de la solution en elle-même est plus courte que vos propositions bien qu'optimisée.
Bon, c'est peut-être plus une question de style, mais j'aime bien m'en tenir à "une fonction ne devrait pas faire plus de 5 lignes". Ce n'est pas toujours possible, mais découper ainsi un programme a tendance à le rendre plus lisible.

(disclaimer : ceci n'est pas un argument pro-Haskell, je suis certains que les mêmes exemples peuvent être trouvés en OCaml, j'avais juste ceux-ci en mémoire)

--
Jedaï

[elishac]

Bon, revenons à nos moutons :-).
Je ne cherche pas à trop optimiser, juste à faire un programme qui marche en temps humain et à apprendre quelques trucs au passage ; quelque chose de personnel quoi. On reste sur l'algorithme du backtracking que j'ai présenté au début, avec optimisation par recherche de la case ayant le moins de voisins.
Il y a quelques questions de mon dernier post qui sont restées sans réponse.

[gasche]

Jedai : j'étais presque vexé donc voici la version implémentant l'heuristique :

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
30
31
32
33
34
35
36
37
38
39
40
41
let tour_cavalier_5 (n, p) =
  let echiquier = make_matrix n p None in
  let case (x, y) = echiquier.(x).(y) in
  let modifie (x, y) v = echiquier.(x).(y) <- v in
  let voisins (x,y) =
    let position_valide (x,y) = 0<=x && x<n && 0<=y && y<p in
    it_list (fun li (dx, dy) ->
               let pos' = (x+dx, y+dy) in
               if position_valide pos' && case pos' = None
               then pos' :: li else li) [] 
      [(2,1);(1,2);(-1,2);(-2,1);(-2,-1);(-1,-2);(1,-2);(2,-1)] in
  let accessibilite =
    let mat = make_matrix n p 0 in
    for i = 0 to n - 1 do
      for j = 0 to p - 1 do
        do_list (fun _ -> mat.(i).(j) <- mat.(i).(j) + 1) (voisins (i, j))
      done
    done;
    mat in
  let access (x, y) = accessibilite.(x).(y) in
  let change_access d (x, y) = accessibilite.(x).(y) <- accessibilite.(x).(y) + d in
  let rec explore nb_mouv pos_pere pos =
    if case pos = None then
      let voisins = voisins pos in
      modifie pos (Some pos_pere);
      do_list (change_access (-1)) voisins;
      if nb_mouv = n * p then raise (Solution pos);
      let voisins_tries = sort__sort (fun a b -> access a < access b) voisins in
      do_list (explore (nb_mouv + 1) pos) voisins_tries;        
      do_list (change_access 1) voisins;
      modifie pos None;
  in
  let depart = (0, 0) in
  try explore 1 depart depart; failwith "pas de solution"
  with Solution pos_finale ->
    let rec chemin acc pos =
      if pos = depart then acc
      else
        let (Some pos) = case pos in
        chemin (pos :: acc) pos in
    chemin [] pos_finale

C'est pas trop long et pas trop difficile à lire. On pourrait faire plus concis avec une lib standard plus fourni (entre caml light et Haskell on peut difficilement comparer), mais c'est le même ordre d'idée.

Traduite en OCaml (ou plutôt en ajoutant le petit header de compatibilité suivant :

Code :

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

1
2
3
4
5
let make_matrix = Array.make_matrix
let it_list = List.fold_left
let do_list = List.iter
let printf__printf = Printf.printf
let sort__sort cmp = List.sort (fun a b -> if cmp a b then -1 else 1)

), elle met effectivement 0.042s sur (40, 40) sur ma machine.


elishac >

ps: je n'ai toujours pas bien compris pourquoi l'utilisation de listes est plus couteuse, alors qu'elles sont en theorie plus adaptées aux fonctions recursives.

Ce n'est en gros pas vrai. Une liste est une structure de donnée récursive donc elle est élégante à Parcourir naturellement. C'est aussi une structure persistante donc elle est facile à conserver sans tenir compte des effets de bords. Mais dans de nombreux cas, les tableaux sont aussi adaptés.

Dans le cas qui nous occupe ici, toute la différence vient du fait que quand je veux tester "est-ce que la case est libre ?", c'est en O(1), alors que toi c'est linéaire en le nombre de cases déjà parcourues. Ça fait une grosse différence.
Pareil, pour l'optimisation en question, tu as beau penser que c'est "plus facile avec des listes", tu utiliseras un list_length linéaire en le nombre de cases restant à parcourir, alors que mon test est en O(1).

Ici ce n'est pas la récursivité ou la persistance qui joue, mais tout simplement les performances de l'accès aléatoire.

[elishac]

comment corriger :

Code :

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

solution [(0,0)] (copy_vect matrice_cases_voisines_initiale);;

Je croyais que, si on réinitialisait de proche en proche toutes les cases de degré 2, on aurait réinitialisé toutes les cases. Pourquoi serait-ce faux ?

[gasche]

Quel est le problème avec cette ligne ? Le fond du truc c'est que "copy_vect" ne permet pas de copier des matrices. Fait un petit test dans ton coin, tu verras qu'il reste des problèmes de partage des modifications. La question est de savoir comment les éviter.


Pour ta deuxième question, tu veux réinitialiser, quand tu as épuisé toutes les possibilités d'une case C, toutes les possibilités de ses voisines. Mais dans ces voisines il y a aussi la case parente P dont tu viens, et donc quand tu reviendras en arrière sur P, tu vas recommencer à tout tester, C compris, et hop boucle.
En réinitialisant toutes les cases non parcourues, on se retrouve à nettoyer les erreurs qui pourraient nous mordre "dans le futur". C'est un peu bizarre que ça marche (ce n'est pas une méthode efficace), mais le fait que ça puisse terminer de temps en temps a été prouvé sur (4,5), contrairement à ta méthode.

[elishac]

La solution serait-elle donc de créer copy_matrix, où

Code :

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

1
2
3
4
5
6
7
8
let copy_matrix mat =
 let n=vect_length mat in
 if n=0 then [||] else let p=vect_length mat.(0) in
 let res=make_matrix n p 0 in
 for i=0 to n-1 do
 for j=0 to p-1 do
  res.(i).(j) <-m.(i).(j)
 done done; res;;

ou alors ça aussi c'est faux ?



En ce qui concerne ma deuxième question, ce que je veux dire, c'est qu'il y en a qu'on réinitialise pour rien, étant donné qu'elles l'étaient déjà.
Il doit bien y avoir un moyen pour profiter de cette observation...
Suivant tes notations, on ne réinitialise pas toutes les voisines de C, mais C elle même, peut-être.
Réinitialiser une case avant de la supprimer de la liste des cases parcourues suffit peut-être, non ? (ainsi, de proche en proche, on réinitialise toutes les cases?)

[gasche]

La solution serait-elle donc de créer copy_matrix

Est-ce que pour commencer tu as isolé le problème ? Un exemple de code qui exhibe le comportement inattendu ?

Ta solution marche sans doute correctement, mais au passage elle est trop restrictive : elle ne marche que pour les matrices "rectangulaires", alors qu'un tableau de tableau pourrait avoir des colonnes de taille différentes. Il vaut mieux écrire :

Code :

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

1
2
3
4
5
6
7
8
9
let copy_matrix mat =
  let n=vect_length mat in
  if n=0 then [||] else
    let res = init_vect n (fun _ -> [||]) in
    for i=0 to n-1 do
      for j=0 to vect_length mat.(i) -1 do
        res.(i).(j) <- mat.(i).(j)
    done done;
    res;;

Il y a cependant une solution plus simple :

Code :

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

let copy_matrix = map_vect copy_vect

Pour le deuxième point, oui, ça peut marcher (il est tard et je ne suis sûr de rien). Essaie.

[alex_pi]

Bon, pour embeter Jedai, j'y suis moi aussi allé de ma petite solution dans mon coin, sans vraiment lire le thread, et sans regarder les solution Haskell (j'ai juste volé la fameuse euristique de "minimum de voisin"). Et pour être vraiment hors sujet, j'ai fait ça en OCaml plutôt qu'en CamlLight (mais en même temps, il serait temps que l'éducation nationale laisse tomber ce dernier...)

echiquier.mli :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
type passage
type echiquier
val ech_vide : int -> int -> echiquier
val dim_ech : echiquier -> int * int
type pos = int * int
val pos_valide : echiquier -> pos -> bool
val pos_libre : echiquier -> pos -> bool
val visite_pos : echiquier -> pos -> unit
val libere_pos : echiquier -> pos -> unit
val pos_accessibles : echiquier -> pos -> pos list
val tri_pos : echiquier -> pos list -> pos list

echiquier.ml

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
type passage = Visite | Libre
 
type echiquier = passage array array
 
(*echiquier vide aux dimensions strictement positives *)
let ech_vide l c : echiquier = 
  assert ((l > 0) & (c > 0));
  Array.make_matrix l c Libre
 
let dim_ech (e : echiquier) = 
  let nl = Array.length e in
  let nc = Array.length (e.(0)) in
    (nl, nc)
 
 
type pos = int * int
 
let pos_valide (e : echiquier) ((pl, pc):pos) = 
  let nl, nc = dim_ech e in
    (0 <= pl) & (pl < nl) & (0 <= pc) & (pc < nc)
 
let pos_libre (e : echiquier) ((pl, pc):pos) = 
  e.(pl).(pc) = Libre
 
let visite_pos (e : echiquier) ((pl, pc):pos) = 
  e.(pl).(pc) <- Visite
 
let libere_pos (e : echiquier) ((pl, pc):pos) = 
  e.(pl).(pc) <- Libre
 
 
type deplacement = int * int
 
let (==>) ((pl, pc) : pos) ((dl, dc) : deplacement) : pos =
  (pl + dl, pc + dc)
 
let depls_cav : deplacement list = 
  [(1,2); (1, -2); (-1, 2); (-1, -2); (2, 1); (2, -1); (-2, 1); (-2, -1)]
 
 
let pos_accessibles (e:echiquier) (p : pos) = 
  let lp = List.map ((==>) p) depls_cav in
    List.filter (fun p -> (pos_valide e p && pos_libre e p)) lp
 
let tri_pos (e:echiquier) (lp : pos list) = 
  let lp_nb = List.map (fun p -> (p, List.length (pos_accessibles e p))) lp in
  let lp_nb_sorted = List.sort (fun (_, nb1) (_, nb2) -> compare nb1 nb2) lp_nb in
    List.map fst lp_nb_sorted

memo.mli

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
module PosOrd :
  sig
    type t = Echiquier.pos
    val compare : Echiquier.pos -> int * int -> int
  end
 
module SetPos : Set.S with type elt = Echiquier.pos
module SSPos : Set.S with type elt = SetPos.t
module Make :
  functor (D : sig val nl : int val nc : int end) ->
    sig
      val is_invalid : Echiquier.pos -> SSPos.elt -> bool
      val set_invalid : Echiquier.pos -> SSPos.elt -> unit
    end

memo.ml

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
(* pour la memoization des positions deja testees et invalide *)
 
module PosOrd = 
struct 
  type t = Echiquier.pos
  let compare ((p1l, p1c) : Echiquier.pos) (p2l, p2c) = 
    let c = Pervasives.compare p1l p2l in
      if c = 0 then Pervasives.compare p1c p2c else c
end
 
module SetPos = Set.Make (PosOrd)
 
module SSPos = Set.Make (SetPos)
 
module Make (D : sig 
	       val nl : int
	       val nc : int
	     end) =
struct
  let ech = Array.make_matrix D.nl D.nc SSPos.empty
  let is_invalid ((pl, pc) : Echiquier.pos) sp = 
    SSPos.mem sp ech.(pl).(pc)
 
  let set_invalid ((pl, pc) : Echiquier.pos) sp =
    ech.(pl).(pc) <- SSPos.add sp ech.(pl).(pc)
 
end

caval.ml

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
let nl = ref 8
let nc = ref 8
let verb = ref false
let eurist = ref true
let print = ref false
let speclist = 
  [("--ligne", Arg.Set_int nl, "Nombre de lignes de l'echiquer");
   ("--col", Arg.Set_int nc, "Nombre de colonnes de l'echiquer");
   ("--verb", Arg.Set verb, "Mode verbeux");
   ("--print", Arg.Set print, "Imprime le resultat");
   ("--no-eurist", Arg.Clear eurist, "Mode sans euristique")]
 
let _ = Arg.parse speclist (fun _ -> ()) "caval --ligne nl --col nc [--verb]"
 
let print_verb s = if !verb then print_endline s
 
let _ = 
  if (!nl > 0) & (!nc >0) then
    print_verb (Printf.sprintf "Calcul pour un echiquier de dimensions %d sur %d" !nl !nc)
  else
    failwith "Les dimensions ne sont pas valables"
 
module M = Memo.Make (struct 
			let nl = !nl
			let nc = !nc
		      end)
module SP = Memo.SetPos  
 
open Echiquier
 
exception Solution of pos list
 
let ech = ech_vide !nl !nc
 
let nmax = !nl * !nc
 
let rec parcours (ch : pos list) (n : int) (sp : SP.t) (pos : pos) =
  if M.is_invalid pos sp then
    ()
  else begin
    visite_pos ech pos;
    let nn = succ n in
    let nch = pos :: ch in
    let nsp = SP.add pos sp in
    if nn = nmax then raise (Solution (List.rev nch));
    let lst_acc = 
      if !eurist then 
	tri_pos ech (pos_accessibles ech pos) 
      else 
	pos_accessibles ech pos in
    List.iter (parcours nch nn nsp) lst_acc;
    M.set_invalid pos sp;
    libere_pos ech pos
  end
 
let _ = 
  try 
    parcours [] 0 SP.empty (0,0);
    Printf.printf "Pas de solution pour %d %d" !nl !nc
  with
    | Solution pl -> (Printf.printf "Solution pour %d %d\n" !nl !nc;
		      if !print then List.iter (fun (pl, pc) -> Printf.printf "%d, %d\n" pl pc) pl)

compilation

Code :

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

ocamlbuild caval.native

Sur ma machine, en 40x40, ça prend 0,02, en 100x100, 0,12 et en 500 par 500, 14 secondes, mais ça fait péter la pile

Je n'ai vérifié le résultat que sur un 5 par 5, j'avais un peu la flemme d'aller au dela

[alex_pi]

Ceux qui ont une solution, vous pouvez tester sur 35 x 35 pour me dire ce que ça donne ?

[gasche]

Si tu veux vérifier une solution "à l'oeil", je te conseille de tester ma fonction d'affichage des parcours :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
let affiche_chemin (n, p) chemin =
  let mat = make_matrix n p 0 in
  let coup = ref 0 in
  let joue (x, y) = incr coup; mat.(x).(y) <- !coup in
  do_list joue chemin;
  for i = 0 to n - 1 do
    for j = 0 to p - 1 do
      printf__printf "%-4d" mat.(i).(j)
    done;
    print_newline ()
  done

Au passage, je crois que ton implémentation a des soucis : sur mon ordinateur, elle est plus lente que la mienne (pourtant nettement moins sophistiquée) d'un facteur 2 à 3 (testé pour n = 200 et n = 250). Tu dois avoir des problèmes d'allocation excessive (je n'ai pas regardé le code en détail).

[alex_pi]

En fait c'est parce que j'ai voulu faire mon malin en rajoutant de la memoization, mais il s'avère qu'elle n'est jamais utilisé, et ne fait donc que ralentir le programme...

Tu as testé sur 35 ?

[gasche]

http://bluestorm.info/tmp/elishac-35x35.txt

[alex_pi]

J'ai relu ma liste de déplacement 15 fois... mais quand je mets

Code :

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

[(1,2); (1, -2); (-1, 2); (-1, -2); (2, 1); (2, -1); (-2, 1); (-2, -1)]

comme liste de déplacement, sur 35, ça ne fini jamais, et quand je mets ta liste de déplacements, ça fonctionne instantanéement, mais ça ne marche plus pour 250... Beuha

[gasche]

Essaie avec une liste randomisée à chaque tour ?

"Mon programme termine presque sûrement"

[Jedai]

Il y a une petite amélioration de l'heuristique de Warnsdorff qui donne de meilleurs résultat dans les cas potentiellement problématiques (qui dépendent de la position de départ et de la priorité des mouvements) : entre deux cases qui ont le même nombre de voisins accessibles, toujours choisir celle qui est la plus proche du bord.

Une implémentation (bricolé par votre serviteur) :

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
36
37
38
39
40
41
42
import qualified Data.Set as S
import Data.List
import Data.Ord
import System
 
data Pair = P !Int !Int deriving (Eq, Ord, Show)
type BoardSpec = Pair
type Point = Pair
 
-- add a move to a position
(<+>) :: Point -> Point -> Point
(P x y) <+> (P mx my) = P (x+mx) (y+my)
 
knightMoves :: [Point]
knightMoves = 
    map (uncurry P) [(1,2),(1,-2),(-1,2),(-1,-2),(2,1),(2,-1),(-2,1),(-2,-1)]
 
canGoFrom :: BoardSpec -> Point -> [Point]
canGoFrom (P n m) pos = filter validPos . map (pos <+>) $ knightMoves
    where validPos (P x y) = 0 < x && x <= m && 0 < y && y <= n
 
distFromEdge :: BoardSpec -> Point -> Int
distFromEdge (P m n) (P x y) = min (x-1) (m-x) + min (y-1) (n-y)
 
sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn crit = map fst . sortBy (comparing snd) . map (\x -> (x, crit x))
 
-- returns the list of tours as the list of positions of the knight
findTours :: BoardSpec -> [[Point]]
findTours b@(P n m) = solve (n*m) S.empty [] (P 1 1)
    where 
      solve 1 _ tour p = return (p:tour)
      solve k sUsed tour p = do
        newPos <- sortOn crit (canMoveTo p)
        solve (k-1) (S.insert p sUsed) (p:tour) newPos
            where 
              crit p = P (length . canMoveTo $ p) (distFromEdge b p)
              canMoveTo p = filter (`S.notMember` sUsed) $ canGoFrom b p
 
main = do
  [n] <- map read `fmap` getArgs
  print . head . findTours $ (P n n)

Compilée avec "ghc -O2 -funbox-strict-field --make knightTour.hs" elle est moins rapide que vos solutions mais bien plus régulière (elle n'a pas de problème à 35 par exemple).
(8.7s pour afficher (dans /dev/null) un tour du cavalier pour chaque échiquier carré de côté 5 à 100, essayer avec vos solutions pour voir)

--
Jedaï

[gasche]

Excellent. Ton idée marche très bien et est simple à mettre en oeuvre.

Pour dépasser les 400/500 il faut exprimer ça de façon tail-recursive, actuellement j'ai un débordement de pile (normal puisque ça fait N² appels imbriqués).

La comparaison des perfs sur des machines différentes ne veut rien dire, mais chez moi mon algo met environ 2.5 secondes, et 1.7 secondes si je coupe l'I/O complètement.

[elishac]

Merci à tous pour votre engouement dans mon topic, mais tout ceci me dépasse un peu :-).
Je n'ai toujours rien qui marche, moi.
Alors, qu'est-ce que je fais, je réinitialise (grâce à matrice_cases_accessibles_initiale) la liste des cases accessibles de la case que je veux supprimer ?

[alex_pi]

Effectivement, 3,56 secondes pour aller jusqu'à 100 avec la nouvelle optimisation. Mais bon, j'ai beaucoup alourdi mon code (mon appel récursif se fait sur une fonction à 7 arguments, ça ne va pas dutout !) donc ça doit être facile à améliorer. Mais là, dodo

[elishac]

et pour la fonction d'optimisation du choix de l'élément de la liste des cases accessibles, ce serait un truc de ce genre là? (à placer après la création de la fonction appartient, et avant la création de "rec solution")

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
let case_minimum_possibilites matrice_cases_voisines_restantes cases_parcourues (x,y) = (*fonction qui donne la case qui est accessible depuis la case (x,y) et qui a le moins de possibilités *)
	let nombre_cases_utilisables (i,j)= (* calcul du nombre de cases utilisables (accessibles, non déjà parcourues, et non éliminées par des tests) depuis la case (i,j) *)
		let rec aux= function
			|[]->0
			|a::q-> if appartient a cases_parcourues then (aux q) else 1+(aux q)
		in
		aux matrice_cases_voisines_restantes.(i).(j)
	in
	let rec minimum = function (*qui a une liste de cases associe la case qui a le moins de voisins*)
		|[]->(-1,-1) (*on est dans le cas "non vide", c'est pour enlever le "Warning: this matching is not exhaustive." *)
		|[a]->a
		|a::q->let b=minimum q in 
			if nombre_cases_utilisables a < nombre_cases_utilisables b then a else b
	in
	minimum matrice_cases_voisines_restantes.(x).(y) ;;

ps: je n'ai toujours pas compris l'histoire des tableaux (ce serait plutôt une matrice d'ailleurs, non?)...
effectivement, la fonction "appartient" n'est utilisée que pour "cases_parcourues", donc une matrice de booléens disant si la case a été parcourue ou non serait plus pratique.
Mais alors comment faire pour le backtracking ? Comment savoir la dernière case parcourue ? (alors que dans mon cas, il suffit de faire hd(cases_parcourues)...)
... ou alors, la matrice n'est pas censée remplacer la liste, ce n'est qu'une variable supplémentaire ?!

[gasche]

Tu as lu le code ? Quels endroits te posent problème ?

La case courante (ton hd(cases_parcourues)) est passée en paramètre à la fonction. Il n'y a besoin de listes nulle part (on en utilise pour représenter l'ensemble des mouvements possibles depuis la case, mais on pourrait utiliser autre chose et ce n'est pas lié).