Programmation Avancée

TP8: monades (1)

Les exercices suivants portent sur la notion de monade, donnée par la signature suivante:

module type MONAD = sig
  type +'a t
  val return : 'a -> 'a t
  val bind : 'a t -> ('a -> 'b t) -> 'b t
end

Monade d'exceptions

La monade d'exception est basée sur le type 'a t = Val of 'a | Exn of exn. L'idée est qu'un calcul avec exception peut soit retourner normalement une valeur v, auquel cas il sera représenté par Val v, soit retourner en levant une exception e, auquel cas il sera représenter par Exn e.

Question 1

Implémenter la monade d'exception comme un module Exn ayant la signature suivante:

module type EXN = sig
  include MONAD
  val throw : exn -> 'a t
  val try_with : 'a t -> (exn -> 'a t) -> 'a t
  val run : 'a t -> 'a   (* peut lever une exception *)
end

Tester (au moins) sur le code suivant:

let () =
  let module M = Exn in
  let m =
    M.try_with
      (M.throw (Failure "normal"))
      (fun _ ->
         M.try_with
           (M.return 42)
           (fun _ -> M.throw (Failure "pas normal")))
  in
    Printf.printf "Test exn: %d\n" (M.run m)

Monade de non-déterminisme

Considérons la recherche des décompositions d'un entier comme somme d'entiers strictement positifs. Si l'on se restreint aux solutions dont les facteurs de la somme vont décroissant, on peut décrire la recherche en la paramétrant par max et target, donnant respectivement l'entier maximum utilisable et ce qu'il nous manque pour atteindre la somme, avec max<=target. Cette recherche se décrit alors informellement comme "trouver une solution avec max:=max-1 OU trouver une solution pour target:=target-max ET on y rajoute max". Ceci s'écrit (assez) directement:

let rec f max target =
  if target = 0 then return [] else
    if max = 0 then fail else
      (* On met [max] dans la liste, ou pas. *)
      orelse
        (andthen
           (* Ajouter [max] à une solution pour [target-max].
              On met à jour max pour assurer max<=target. *)
           (f (min max (target-max)) (target-max))
           (fun l -> return (max::l)))
        (f (max-1) target)

Question 1 (vous pouvez passer et faire directement la Question 2 sur les monades)

Votre mission est d'implémenter les combinateurs nécessaires pour faire passer le code précédent. Le combinateur fail : 'a t code le calcul qui ne renvoie aucune valeur, il doit donc seulement appeler la continuation d'échec. Le combinateur return : 'a -> 'a t code le calcul qui renvoie une seule valeur, donnée en argument. Le combinateur orelse : 'a t -> 'a t -> 'a t prend deux calculs et renvoie toutes les valeurs renvoyées par ces calculs, tandis que andthen : 'a t -> ('a -> 'b t) -> 'b t prend deux calculs m et n et renvoie toutes les valeurs w renvoyées par n v pour un v renvoyé par m.

Tester:

let print_list l =
  Printf.printf "[%s]\n" (String.concat "," (List.map string_of_int l))

let () =
  let fk () = () in
  let sk l k = print_list l ; k () in
    f 5 5 sk fk

Question 2

Reprendre le dernier exercice, mais le réaliser sous la forme d'une monade, où andthen n'est autre que l'opération bind.

Monade de probabilité

Question 1

Adapter votre monade de non-déterminisme en une monade de calcul probabiliste, qui associe une probabilité à chaque valeur retournée, de sorte que la somme des probabilités des valeurs retournées possibles soit (inférieure ou égale à) 1.

Cette monade devra être équipée de l'opération choice : float -> 'a t -> 'a t -> 'a t, où le calcul choice p m n s'exécute comme m (resp. n) avec probabilité p (resp. 1-p).

Implémenter l'algorithme de tirage aléatoire d'un élement dans une liste. Tester, vérifier que le tirage est uniforme.

Question 2

On considère le jeu suivant, dont l'enjeu mirobolant est de gagner une chèvre. Le joueur est placé devant trois portes, et il sait que derrière une seule d'entre elles se trouve une chèvre. Il choisit une première porte. On lui ouvre alors une autre porte qui ne cachait pas de chèvre. Le joueur peut alors de nouveau choisir une porte parmi les trois, et s'il découvre la chèvre il l'emporte.

Le jeu se formalise comme la fonction play ci-dessous, qui prend en argument une stratégie de type first représentant un comportement du joueur, c'est à dire un calcul probabiliste renvoyant un entier (la première porte choisie) ainsi qu'une fonction de type second représentant la stratégie au deuxième tour (son argument est la porte révélée entre les deux tours). Je suppose ici que A.pick est la fonction de choix uniforme dans une liste.

let doors = [1;2;3]

type second = int -> int P.t
type first = (int*second) P.t

let (>>=) = P.bind
let play (strategy:first) =
  A.pick doors >>= fun chevre ->
  strategy >>= fun (first,strategy) ->
  let empty_doors =
    List.filter
      (fun d -> d <> first && d <> chevre)
      doors
  in
  A.pick empty_doors >>= fun empty ->
  strategy empty >>= fun second ->
  P.return (second = chevre)

Votre mission est de trouver la meilleure stratégie, de l'implémenter et d'évaluer ainsi sa probabilité de succès.

Par exemple, voici la stratégie qui choisit une porte au hasard et ne change pas son choix au deuxième tour:

let () =
  let second first =
    fun _ -> M.return first
  in
  let first : first =
    P.bind
      (A.pick doors)
      (fun p -> P.return (p, second p))
  in
    Printf.printf "P[win] = %.3f\n" (play first (dirac true))

Monade de continuations

On pose 'a -> unit le type des continuations 'a cont. La monade de continuation est construite sur le type 'a t = 'a cont -> unit.

Question 1

Ecrire cette monade, comme un module Cont implémentant la signature suivante:

module type CONT = sig
  include MONAD
  val run : unit t -> unit
end

Un test:

let () =
  let m = Cont.bind (Cont.return 21) (fun x -> Cont.return (2*x)) in
    Cont.run
      (Cont.bind m
         (fun x -> Printf.printf "Test cont: %d\n" x ; Cont.return ()))

Question 2

Traduire List.iter dans la monade de continuation, comme une fonction iter de type ('a -> unit Cont.t) -> 'a list -> unit Cont.t. La tester en affichant les éléments d'une liste avec printf.

Question 3

Ajouter les opérations suivantes à votre monade:

type 'a cont
val throw : 'a cont -> 'a -> 'b t
val callcc : ('a cont -> 'a t) -> 'a t

La sémantique a été vue en cours: callcc (fun k -> ...) permet d'accéder à la continuation courante k dans un calcul; throw k v appelle une continuation en lui passant une valeur.

Vous devriez ainsi pouvoir écrire le code suivant, issu du cours, qui change iter en un find avec backtracking:

let find pred lst =
  Cont.callcc (fun k ->
    Cont.bind
      (iter
         (fun x ->
            if pred x then
              Cont.callcc (fun k' -> Cont.throw k (Some (x,k')))
            else Cont.return ())
         lst)
      (fun () -> Cont.throw k None))

let () =
  Cont.run
    (Cont.bind
       (find (fun x -> x mod 2 = 0) [1;2;3;4;5])
       (function
          | Some (x,_) ->
              Printf.printf "Found %d\n" x ;
              Cont.return ()
          | None ->
              Printf.printf "Not found.\n" ;
              Cont.return ()))

Question 4

Ecrire et tester une fonction print_all qui appelle find une seule fois mais utilise les continuations retournées pour obtenir successivement toutes les valeurs possibles et les afficher avec printf. On a fait un aller-retour entre un itérateur et un générateur en CPS.