let u0 = 42

let nmax = 10000

let u = Array.make nmax u0

let m = 2147483647

let remplit_u =
    for i = 1 to nmax-1 do
        u.(i) <- (16807 * u.(i-1) + 17) mod m
    done

let affiche_question qn pprint resultats =
    Printf.printf "Q%d) " qn;
    List.iter (fun r -> pprint r; print_string " ")
        resultats;
    print_newline ()

let _ =
    affiche_question 1 print_int
    [ u.(5) mod 101; u.(100) mod 101; u.(997) mod 101 ]


let v = Array.make_matrix 62 1001 0

let remplit_v =
    let p = ref 1 in
    for k = 0 to 61 do
        for n = 0 to 1000 do
            v.(k).(n) <- u.(n) mod !p + !p
        done;
        p := !p * 2
    done

let q2 k = v.(k).(97*k mod 997) mod 101

let _ =
    affiche_question 2 print_int
    [ q2 5; q2 30; q2 61 ]

(* soit p = max { d tels que x(d) <= x }
 * on a x(p+1) = x(p)^2 > x >= x(p)
 *
 * soit alors d = max { k tels que x(p) * k <= x }
 * on a d < x(p) et x(p)d <= x < x(p)d + x(p)
 * donc 0 <= x - x(p)d < x(p)
 *
 * Pour l'unicité, si n = g + x(p) d =
 * g' + x(p')d'
 * un argument de comparaison donne rapidement p=p'
 * puis le reste suit l'argument classique sur la
 * division euclidienne *)

type ternaire = Zero | Un
    | Noeud of ternaire * ternaire * ternaire

let rec pair t = match t with
    Zero -> true
    | Un -> false
    | Noeud(g,_,_) -> pair g

let rec sign t =
    match t with
    Zero -> 0
    | Un -> u.(10) mod 97
    | Noeud(g,p,d) when pair p ->
        (sign g + u.(30)* sign d) mod 97
    | Noeud(g,p,d) ->
        (sign g + u.(20)* sign d) mod 97

(* deborde tres tres vite *)
let rec evalue_x p = if p = 0 then 2 else let x = evalue_x (p-1) in x * x
let rec evalue t = match t with
    | Zero -> 0
    | Un -> 1
    | Noeud(g,p,d) -> evalue g + evalue_x (evalue p) * evalue d

let rec ternarize n =
    if n = 0 then Zero
    else if n = 1 then Un
    else begin
        let p = ref 0 in
        let x = ref 2 in
        while !p < 5 && !x * !x <= n do
            (* on espere que ca passe avant que
             * ca ne depasse ... *)
            incr p;
            x := !x * !x
        done;
        Noeud(ternarize (n mod !x), ternarize !p, ternarize (n / !x))
    end

let string_of_ternaire t =
    let rec aux t n =
        let sn = String.make n ' ' in
        match t with
        Zero -> sn ^ "0"
        | Un -> sn ^ "1"
        | Noeud (g,p,d) ->
                sn ^ "<\n" ^ aux g (n+1)
                ^ "\n" ^ aux p (n+1)
                ^ "\n" ^ aux d (n+1)
                ^ "\n" ^ sn ^ ">"
    in aux t 0

let _ =
    affiche_question 3 print_int
        [ sign (ternarize v.(1).(10));
          sign (ternarize v.(2).(20));
          sign (ternarize v.(32).(30));
          sign (ternarize v.(61).(40)) ]


let rec h n = match n with
    | 0 -> Un
    | _ -> let t = h (n-1) in
        Noeud(t,t,t)

let q4 k = sign (h v.(k).(7*k))

(* tous les h sont impairs *)
(* on peut donc calculer sign o h d'un coup *)
let rec q4h n =
    match n with
    | 0 -> u.(10) mod 97
    | _ -> let s = q4h (n-1) in
        (s + u.(20) * s) mod 97

let q4rapide k = q4h v.(k).(7*k)

let _ =
    affiche_question 4 print_int
        [q4 0; q4 2; q4rapide 4; q4rapide 8]

let gen = Array.make_matrix 62 997 Zero

(* premiere approche pour obtenir la question 5 *)
let remplit_gen =
    for k = 0 to 48 do
        for n = 0 to 996 do
            gen.(k).(n) <-
                if k = 0
                then begin if u.(n) mod 7 = 0
                    then Zero else Un end
                else
                    let kp = max 0 (k-1-(u.(n) mod 2)) in
                    let g = gen.(kp).( (n+1) mod 997 ) in
                    let p = v.(kp).(n) in
                    let d = gen.(kp).( (n+2) mod 997 ) in
                    if d = Zero
                    then g
                    else Noeud(g, ternarize p, d)
        done
    done


let q5 k n = sign gen.(k).(n)

let _ =
    affiche_question 5 print_int
        [ q5 6 35; q5 8 45; q5 10 55; q5 12 65; q5 14 75 ]

(* decrementation naive *)
let rec dec t = match t with
    Zero -> failwith "decrementation de 0"
    | Un -> Zero
    | Noeud(Zero,p,Un) -> xprime p
    | Noeud(Zero,p,d) -> Noeud(xprime p, p, dec d)
    | Noeud(g,p,d) -> Noeud(dec g,p,d)
and xprime p = match p with
    | Zero -> Un
    | _ -> let q = dec p in
          let xpq = xprime q in
          Noeud(xpq, q, xpq)

let q6 k = sign (dec (gen.(k).((19*k) mod 997)))

let _ =
    affiche_question 6 print_int
        [ q6 6; q6 16; q6 26 ]

(* pour incrementer il faut tester l'egalite à un x(p)-1 connaissant p *)
(* or xprime p defini precedemment calcule exactement x(p)-1 *)
(* je pense qu'on peut faire mieux avec une reconnaissance des arbres de la
 * forme x(p)-1 qui ont une forte symétrie, mais ça passe avec un test naif *)
let rec inc t = match t with
    | Zero -> Un
    | Un -> Noeud(Zero,Zero,Un)
    | Noeud(g,p,d) -> let xpp = xprime p in
        if g = xpp && d = xpp
        then Noeud(Zero,inc p,Un)
        else if g = xpp
            then Noeud(Zero,p,inc d)
            else Noeud(inc g,p,d)

let q7 k = sign (inc (gen.(k).((17*k) mod 997)))

let _ =
    affiche_question 7 print_int
        [ q7 6; q7 7; q7 16 ]

let rec compare t1 t2 = match t1, t2 with
    (* cas de base *)
    | Zero, Zero -> 0
    | Zero, _ -> -1
    | _, Zero -> 1
    | Un, Un -> 0
    | Un, _ -> -1
    | _, Un -> 1
    (* cas general *)
    | Noeud(g1,p1,d1), Noeud(g2,p2,d2) ->
            let cp = compare p1 p2 in
            if cp = 0
            then let cd = compare d1 d2 in
                if cd = 0
                then compare g1 g2
                else cd
            else cp

let q8 k = compare gen.(k).((29*k) mod 997) gen.(k).((31*k) mod 997)

let _ =
    affiche_question 8 print_int
        [ q8 6; q8 8; q8 16 ]

let rec add t1 t2 = match t1, t2 with
    | Zero, _ -> t2
    | _, Zero -> t1
    | Un, _ -> inc t2
    | _, Un -> inc t1
    | Noeud(g1,p1,d1), Noeud(g2,p2,d2) ->
            match compare p1 p2 with
            | 1 -> normalize (Noeud(add t1 g2, p2, d2))
            | -1 -> normalize (Noeud(add t2 g1, p1, d1))
            | _ -> normalize (Noeud(add g1 g2, p1, add d1 d2))
and normalize t = match t with
    | Noeud(Noeud(g1,p1,d1), p, d) ->  begin
            match compare p1 p with
            | -1 -> normalize_right t
            | 0 -> normalize_right (Noeud(g1,p,add d1 d))
            | _ -> normalize (Noeud(normalize(Noeud(g1,p,d)),p1,d1))
    end
    | _ -> t
and normalize_right t = match t with
    | Noeud(g,p,Noeud(g1,p1,d1)) -> begin
            match compare p p1 with
            | 0 -> Noeud(Noeud(g,p,g1),inc p,d1)
            | -1 -> normalize (Noeud(normalize_right(Noeud(g,p,g1)),
                                    p1,normalize_right(Noeud(Zero,p,d1))))
            | _ -> t
    end
    | _ -> t

let q9 k = sign (add gen.(k).((41*k) mod 997) gen.(k).((43*k) mod 997))

let _ =
    affiche_question 9 print_int
        [ q9 6; q9 12; q9 16 ]

let rec mul t1 t2 = match t1 with
    | Zero -> Zero
    | Un -> t2
    | Noeud(g,p,d) -> normalize(Noeud(mul g t2, p, mul d t2))

(* probleme *)
let q10 k = sign (mul gen.(k).((43*k) mod 997) gen.(k).((41*k) mod 997))

let _ =
    affiche_question 10 print_int
        [ q10 5; q10 8; q10 10 ]

let rec taille t = match t with
    | Zero | Un -> 0 | Noeud(g,p,d) -> 1 + taille g + taille p + taille d

let rec concat_u l1 l2 = match l2 with
    | [] -> l1
    | t::q when List.mem t l1 -> concat_u l1 q
    | t::q -> t :: concat_u l1 q

let rec parties t = match t with
    | Zero | Un -> []
    | Noeud(g,p,d) ->
        let pg = parties g in
        let pp = parties p in
        let pd = parties d in
        t :: (concat_u (concat_u pg pp) pd)

let nparties t = List.length (parties t)

let q11 k = let x = gen.(k).((23*k) mod 997) in
    (nparties x, taille x)

let _ =
    affiche_question 11 (fun (a,b) ->
            Printf.printf "(%d,%d)" a b)
        [ q11 8; q11 16; q11 24(* ; q11 32 *) ] (* dernier cas un peu lent *)

(* il faut faire du partage de sous-arbres *)

type ternaire_compact = Zero | Un | Noeud of int * int * int

let max_taille = 1000000
let taille = ref 0
let stockage = Array.make max_taille Zero
let lookup = Hashtbl.create u0

let ajoute t =
    if not (Hashtbl.mem lookup t)
    then begin
        let n = !taille in
        stockage.(n) <- t;
        incr taille;
        Hashtbl.add lookup t n
    end

let adresse t = Hashtbl.find lookup t

(* pour faire du copier coller facilement *)
let noeud (a,b,c) =  Noeud(adresse a, adresse b, adresse c)
let unpack n = match n with
    | Noeud(a,b,c) -> (stockage.(a), stockage.(b), stockage.(c))
    | _ -> failwith "invalide"

let ternarize_hash = Hashtbl.create 42
let rec ternarize n =
    try
        Hashtbl.find ternarize_hash n
    with Not_found -> let t =
        if n = 0 then Zero
        else if n = 1 then Un
        else begin
            let p = ref 0 in
            let x = ref 2 in
            while !x * !x <= n && !x * !x != 0 do
                (* on espere que ca passe avant que
                 * ca ne depasse ... *)
                incr p;
                x := !x * !x
            done;
            let d = ref 1 in
            let y = ref !x in
            while !x + !y <= n do
                incr d;
                y := !y + !x
            done;
            noeud (ternarize (n mod !x),
                ternarize !p,
                ternarize (n / !x))
        end
    in Hashtbl.add ternarize_hash n t; ajoute t; t

let gen = Array.make_matrix 62 997 Zero

(* premiere approche pour obtenir la question 5 *)
let remplit_gen =
    for k = 0 to 10 do
        for n = 0 to 996 do
            let t =
                if k = 0
                then begin if u.(n) mod 7 = 0
                    then Zero else Un end
                else
                    let kp = max 0 (k-1-(u.(n) mod 2)) in
                    let g = gen.(kp).( (n+1) mod 997 ) in
                    let p = v.(kp).(n) in
                    let d = gen.(kp).( (n+2) mod 997 ) in
                    if d = Zero
                    then g
                    else noeud(g, ternarize p, d)
            in
            ajoute t;
            gen.(k).(n) <- t
        done
    done

let tabule f =
    let f_table = Array.make max_taille None in
    let rec f_tabulee t =
        let a = adresse t in

        (if f_table.(a) = None
        then let v = f f_tabulee t in
            f_table.(a) <- Some v);

        match f_table.(a) with
        | Some v -> v
        | None -> failwith "impossible"
    in f_tabulee

let pop =
    let aux rpop n =
        match n with
        | Zero -> 0
        | Un -> 1
        | _ -> let g,p,d = unpack n in
            rpop g + rpop d
    in tabule aux

let q12 k = let x = gen.(k).((37*k) mod 997) in
    pop x mod 97

let _ =
    affiche_question 12 print_int
        [ q12 48; q12 55 ]

let rec dec t = let dt = match t with
    Zero -> failwith "decrementation de 0"
    | Un -> Zero
    | _ -> begin match unpack t with
        | Zero,p,Un -> xprime p
        | Zero,p,d -> noeud(xprime p, p, dec d)
        | g,p,d -> noeud(dec g, p, d)
    end in ajoute dt; dt
and xprime p = let v = match p with
    | Zero -> Un
    | _ -> let q = dec p in
          let xpq = xprime q in
          noeud(xpq, q, xpq)
    in ajoute v; v

let pair =
    let aux rpair t =
        match t with
        Zero -> true
        | Un -> false
        | Noeud(g,_,_) -> rpair stockage.(g)
    in tabule aux

let sign =
    let aux rsign t = match t with
    | Zero -> 0
    | Un -> u.(10) mod 97
    | _ -> begin match unpack t with
        | g,p,d when pair p ->
            (rsign g + u.(30) * rsign d) mod 97
        | g,p,d -> (rsign g + u.(20) * rsign d) mod 97
        end
    in tabule aux

let q13 k = let x = gen.(k).((19*k) mod 997) in
    sign (dec (gen.(k).((19*k) mod 997)))

    (*
let _ =
    affiche_question 13 print_int
        [ q13 48; q13 55 ]
*)
let rec evalue_x p = if p = 0 then 2 else let x = evalue_x (p-1) in x * x
let rec evalue t = match t with
    | Zero -> 0
    | Un -> 1
    | _ -> let g,p,d = unpack t in evalue g + evalue_x (evalue p) * evalue d

let rec complement n p = (* renvoie (-n) tq n + (-n) mod x(p) = 0 *)
    let v = match n with
    | Zero -> Zero
    | Un -> dec (noeud(Zero,p,Un))
    | _ -> let g,p1,d = unpack n in
        let dp = dec p in
        if p1 = p
        then complement g p
        else if p1 = dp
            then noeud(complement g dp, dp, complement d dp)
            else noeud(complement n dp, dp, xprime dp)
    in Printf.printf "-(%d) =  %d [ %d ]\n" (evalue n) (evalue v) (evalue p); v

let _ =
    let p = 3 in
    let tp = ternarize p in
    for i = 3 to 3 do
        let ti = ternarize i in
        Printf.printf "-(%d) = %d [x(%d)]\n"
            i (evalue (complement ti tp)) p
    done

let _ =
    Printf.printf "nombre d'arbres %d\n" !taille