(* Rapidement on reformule les fonctions de la librairie List... *)

let mem e l    = List.fold_left (fun b x -> b || x=e) false l
let map f l    = List.rev (List.fold_left (fun l x -> f x::l) [] l)
let filter f l =
  List.rev (List.fold_left (fun l x -> if f x then x::l else l) [] l)
let length l   = List.fold_left (fun l _ -> l+1) 0 l
let rev l      = List.fold_left (fun l x -> x::l) [] l
let iter f l   = List.fold_left (fun _ x -> f x) () l

(* Deux écritures de l'algorithme de Bezout:
 * Dans les deux versions on suppose a>=b initialement. *)

let rec f a b =
  if b = 0 then (1,0) else
    let (u,v) = f b (a mod b) in
      (v, u - v*(a/b))

let i a b =
  let ab = ref (a,b) in
  let uv = ref (1,0) in
  let qs = ref []    in
    while snd !ab <> 0 do
      let (a,b) = !ab in
        qs := (a/b)::!qs ;
        ab := b, a mod b
    done ;
    while !qs <> [] do
      let q = List.hd !qs in
      let (u,v) = !uv in
        qs := List.tl !qs ;
        uv := (v,u-v*q)
    done ;
    !uv

let pgcd a b =
  let u,v = i a b in
    print_int (a*u + b*v) ; print_newline ()

let _ = pgcd 18 5
let _ = pgcd 32 6
let _ = pgcd 20 12

(* Le problème des reines ... mérite quelques explications.
 *
 * On cherche à énumérer toutes les solutions, mais en évitant certaines
 * recherches trivialement impossibles -- par exemple les essais commençant par
 * placer une reine en (0,0) et la seconde en (1,0) ou encore (1,1). On va en
 * fait poser des reines une par une sur l'échiquier, ligne par ligne, en
 * vérifiant qu'au moment où on pose une nouvelle reine elle n'est pas menacée.
 * Si on en pose ainsi n, on a trouvé une solution.
 *
 * Voici un premier squelette de fonction présentant de façon abstraite cette
 * procédure, où on ne poursuit la recherche sur la ligne suivante que lorsqu'on
 * a posé une reine valide.
 *
 * let reines f n =
 *   let b = Array.create n 0 in (* Représentation de la solution construite *)
 *   (* Ici d'autres définitions si besoin... *)
 *   let rec search i = (* Recherche sur la ligne i *)
 *     if i=n then f b else
 *     for j = 0 to n-1 do
 *       if not (menacée (i,j)) then begin
 *         b.(i) <- j ;
 *         search (i+1)
 *       end
 *     done
 *   in
 *     search 0
 *
 * Une fois qu'on a mis en place le déroulement global de la recherche il faut
 * trouver une solution efficace pour vérifier efficacement qu'une position
 * n'est pas encore menacée. Au lieu de regarder en arrière les reines déja
 * posées, on va aller de l'avant: quand on pose une reine on "grise" les cases
 * qu'elle menace. On va être encore un tout petit peu plus malin que ça en
 * stockant non pas des cases libres mais des alignements libres: colonnes,
 * diagonales montantes et descendantes -- indexées de 0 à 2*n-1.
 *)

let reines f n =
  let b = Array.create n 0     in
  let c = Array.create n true in
  let d = Array.create (2*n-1) true in
  let e = Array.create (2*n-1) true in
  let rec search i =
    if i=n then f b else
    for j = 0 to n-1 do
      if c.(j) && d.(i-j+n-1) && e.(i+j) then begin
        b.(i) <- j ;
        c.(j) <- false ;
        d.(i-j+n-1) <- false ;
        e.(i+j) <- false ;
        search (i+1) ;
        c.(j) <- true ;
        d.(i-j+n-1) <- true ;
        e.(i+j) <- true
      end
    done
  in
    search 0

let affiche b =
  let l = String.make (1 + Array.length b) ' ' in
  let d = String.make (1 + Array.length b) '-' in
    l.[Array.length b] <- '\n' ;
    d.[Array.length b] <- '\n' ;
    print_string d ;
    for i = 0 to Array.length b - 1 do
      l.[b.(i)] <- '#' ;
      print_string l ;
      l.[b.(i)] <- ' '
    done ;
    print_string d

let _ = reines affiche 5

let _ =
  try
    reines (fun _ -> failwith "ok") 5 ;
    print_string "Absence de solutions en taille 5 :(\n"
  with
    | Failure "ok" -> print_string "Existence de solutions en taille 5 :)\n"

(* Les bidules *)

let print l =
  List.iter (fun e -> print_int e ; print_char ' ') l ;
  print_newline ()

let iter_subsets f s =
  let rec aux prefix = function
    | [] -> f prefix
    | e::s ->
        aux (e::prefix) s ;
        aux prefix s
  in
    aux [] s

let rec differences sub =
  let rec aux acc = function
    | [] -> acc
    | h::t -> aux ((List.map (fun e -> abs (h-e)) t)@acc) t
  in
    aux [] sub

let recouvrement s d =
  List.fold_left
    (fun b e -> b && List.mem (abs e) d)
    true
    s

let bidule s =
  iter_subsets (fun sub ->
                  if recouvrement s (differences sub) then print sub) s

let _ = bidule [ 1 ; 2 ; -1 ; 3 ]
let _ = bidule [ 1 ; 4 ; -3 ]