Random.self_init

Maintenant que je travaille un peu dans le domaine de la sécurité, je pense notamment aux générateurs de nombres aléatoires. Après quelques lectures sur le sujet, je me suis demandé comment fonctionnait le module Random de Caml.

Il y a sûrement beaucoup de choses à dire, mais mon attention a été retenue par un truc simple: self_init initialise le générateur de façon très simple, à partir de l'heure et de l'identifiant du processus, données pour le moins aléatoires. Il faut donc vraiment se méfier de cela si on souhaite utiliser le module Random à des fins cryptographiques. En pratique, le petit bout de code suivant devine assez rapidement la graine générée, en supposant connu l'identifiant du processus (ce n'est pas bien dur à deviner sinon) et en supposant approximativement connue l'heure de l'initialisation:

(** Random.self_init relies on caml_sys_random_seed
  * which returns an int.
  * That integer is sec ^ usec ^ ppid<<16 ^ pid.
  * We try to guess the seed to reproduce the output of
  * the random generator.
  * The PID and PPID are supposed to be known,
  * the time in seconds and micro-seconds is supposed
  * to be known resp. with precision 1s and 1000ms.
  * With that knowledge it's really fast;
  * with less it'd take longer. *)

let gen sec usec pid ppid =
  sec lxor usec lxor pid lxor (ppid lsl 16)

let random _ = Random.int 100

(** Given a leaked sequence of numbers consecutively
  * generated by [random] _immediately after_
  * [Random.self_init], call [k] with seeds that allow
  * to reproduce that sequence. *)
let crack leak k =
  let t = Unix.gettimeofday () in
  let sec = int_of_float t in
  let usec = int_of_float (fst (modf t) *. 1_000_000.) in
  let pid = Unix.getpid () in
  let ppid = Unix.getppid () in
    (* Since we sec and usec are xored, trying sec and
     * sec-1 would be useless: all we'd be doing is
     * flipping a bit that is flipped anyway when
     * enumerating posssible values for usec. *)
    for usec = usec - 10000 to usec do
      let seed = gen sec usec pid ppid in
        Random.init seed ;
        if Array.init (Array.length leak) random = leak then
          k seed
    done

let () =
  let leak,valid =
    Random.self_init () ;
    let leak = Array.init 1000 random in
    let valid = Array.init 5000 random in
      leak, valid
  in
  let k seed =
    let guess =
      Random.init seed ;
      ignore (Array.init (Array.length leak) random) ;
      Array.init (Array.length valid) random
    in
      Printf.printf
        "Guessed seed: %d. Validated: %b.\n"
        seed (guess=valid)
  in
    crack leak k ;
    Printf.printf "Search space exhausted.\n"

Quand on le lance, on a quelque chose comme ça en quelques secondes:

$ ocamlopt unix.cmxa crack.ml -o crack && ./crack
Guessed seed: 262818353. Validated: true.
Search space exhausted.

Il y a diverses variations possible. Ce qui m'intéresse, et qui est encore assez obscur pour moi, c'est la génération (répétitive) de graines à partir d'une partie privée et d'une partie publique, utilisée pour éviter d'avoir des séquences générées identiques (ce qui exposerait à des attaques dans certains cas). A quel point on affaiblit ou compromet son secret, en fonction du générateur utilisé, etc?

Quel effet ça fait

Quelle différence entre a→b→c et a→b→c? Pour le savoir, lisez ce qui suit.

De temps en temps, je regarde un article scientifique, ou un bout de code, et je n'en suis pas satisfait. Un truc me chiffonne, ça peut se réparer, mais ya autre chose qui cloche, et au fond c'est tout bancal, ça n'en finit pas, et il vaut mieux tout remettre à plat. Ceci est arrivé récemment dans liquidsoap avec le module de décodage de fichier. Ce n'est pas intéressant de détailler, il y a juste un point dont je voulais parler. Mais avant, je trouve que c'est important de dire qu'il faut remettre les choses à plat de temps en temps.

Donc, il s'agit de décodage. Première question: qu'est ce que c'est un décodeur? J'ai mis un peu de temps à essayer plusieurs styles, pour finalement décider input -> buffer -> unit, une fonction qui prend en entrée une méthode pour lire des données, et un buffer pour écrire le résultat du décodage, et qui ne renvoie rien mais remplit le buffer un peu plus à chaque fois qu'on l'appelle.

A côté de cette notion très générique on a des notions plus spécialisées comme le type file_decoder = { fill : Frame.t -> unit ; close : unit -> unit }. C'est un enregistrement qui contient une fonction de remplissage de flux (on lui donne une frame (un morceau de flux) à remplir) et une fonction de fermeture/nettoyage où l'on libère les ressources allouées pour le décodage.

Ceci étant décidé, j'écris un bout de code générique qui emballe un décodeur pour construire un décodeur_de_fichier:

let file_decoder filename decoder =
  let input = input_from_file filename in
  let buffer = create_buffer () in
  let fill frame =
    while not_enough_data_in buffer do
      decoder input buffer
    done ;
    fill_frame_from_buffer frame buffer
  in
    { fill = fill ; close = fun () -> close input }

Vous me suivez? Maintenant, j'implémente un décodeur, pour le format MP3 en utilisant la bibliothèque mad:

let create_decoder input =
  let resampler = create_resampler () in
  let mad_stream = Mad.openstream input in
    (fun buffer ->
       let data = Mad.decode_frame_float mad_stream in
       let sample_freq,_,_ = Mad.get_output_format fd in
       let content,length =
         resampler ~audio_src_rate:(float sample_freq) data
       in
         put_audio_in_buffer buffer content length)

PAF! Vous voyez le bug? Je parie que non, en tout cas moi je l'avais raté. J'ai réussi à ne pas être d'accord avec moi même, penser a→b→c ici et a→b→c là!...

Le problème, c'est les effets. En mathématiques, une fonction prend un argument et renvoie un résultat. On ne sait pas comment ça se passe "dedans", en tout cas ça n'interagit pas sur le "dehors", et ça se passe pareil à chaque fois: même entrée, même sortie. En informatique, c'est bien plus compliqué. La fonction interagit avec le monde, elle peut afficher quelquechose à l'écran, elle peut aller chercher un résultat sur internet, dans un fichier, ou simplement dans une case mémoire qu'elle partage avec d'autres fonctions. On est ainsi habitué à avoir tout un paquet de fonctions de type a→b, puisqu'il ne s'agit pas seulement de prendre un objet de type a pour calculer un objet de type b mais aussi potentiellement de se livrer à tout un tas d'interactions avec le monde.

Mon code utilise cela, mais se prend les pieds dedans. Ce qui est joli, c'est que j'ai une "solution". Mais voyons d'abord le problème. Notre décodeur prend un canal d'entrée (input), un canal de sortie (buffer), et est supposé avoir comme effet de lire un peu de données en entrée, de les convertir et les écrire en sortie. Il ne renvoie rien d'utile (unit), tout son interet réside dans l'effet; si on l'appelle un assez grand nombre de fois, on finit par avoir assez de données dans notre buffer -- c'est ce qu'on a fait plus haut. On peut cacher un certains nombres d'informations dans le décodeur, c'était mon intention, par exemple j'y ai alloué un resampler pour convertir les données vers la bonne fréquence d'échantillonage: cet outil doit être (et est bien) crée une fois et une seule pour chaque décodeur.

Ce resampler maintient un état interne, tout comme le décodeur mad (mad_stream). Allouer ces objets est aussi un effet! Mais à quel moment a-t-il lieu? Le type ne l'indique pas: dans input->buffer->unit, après quel argument un effet peut-il avoir lieu? Dans le code de file_decoder j'utilise un décodeur comme si le seul effet était le décodage, qui a lieu une fois qu'on a renseigné l'input et l'output. Mais dans le code du décodeur MP3, pas le choix, je m'autorise un effet entre le moment où on m'a donné l'input et le moment où on me donne le décodeur. Résultat, quand on utilise file_decoder avec le create_decoder MP3, on a un son tout haché, car le décodeur et le resampleur sont reinitialisés sans arrêt, ce qui provoque la perte d'une partie des données mémorisées dans leurs buffers internes.

Ces problèmes sont très vicieux, et sont toujours un sujet de recherche active. Mais concrètement, que peut-on y faire avec les outils d'aujourd'hui? Documenter, espérer que tout le monde se comprend? Pas terrible, j'ai réussi à être en désaccord avec moi-même sur une courte période de temps. Comme d'habitude, ce serait bien si le système de type nous servait de garde fou.

En logique, la notion de focalisation (focusing) est liée à la question des effets. Une formule logique est vue comme un jeu entre deux joueurs: un qui prouve l'autre qui réfute, ou encore, l'environnement qui fournit une entrée (argument) et la machine qui renvoie une sortie (valeur de retour). Les connecteurs logiques sont attribués à l'un ou à l'autre joueur: dans (int*int)→(int*int) c'est d'abord l'environnement qui donne un argument, directement composé de deux entiers; puis la machine calcule un résultat, directement composé de deux entiers. Ici je dis directement, car on ne peut pas demander une réponse partielle à la machine, tout ceci vient d'un coup, une unique réponse à une seule question. La dynamique associée au type int→int→(int*int) est exactement la même: il n'y a pas deux questions à l'environnement, mais une seule, les deux entiers en entrée arrivent d'un coup. Là dedans, les seuls effets ne peuvent donc se situer qu'à l'interface entre les deux joueurs, dans le calcul qui se passe entre une question et une réponse.

Commençons à redescendons sur terre. Pour introduire la possibilité d'un effet, en focalisation, on peut introduire un délai. Par exemple, si on veut une paire d'entiers paresseuse (dont le contenu n'est calculé que si nécessaire), on retarde le calcul des int: (unit->int)*(unit->int). Dans l'autre sens, on peut aussi vouloir retarder le moment où un argument est passé, par exemple avec a->(unit*(b->c))... c'est ce qu'il nous faut!

On la refait avec un délai autour du décodeur, implémenté non pas comme (unit*...) mais plus agréablement avec un type variant:

type decoder = Decoder of (buffer -> unit)
type file_decoder = input -> decoder

let file_decoder filename decoder =
  let input = input_from_file filename in
  let buffer = create_buffer () in
  let Decoder f = decoder input in
  let fill frame =
    while not_enough_data_in buffer do
      f buffer
    done ;
    fill_frame_from_buffer frame buffer
  in
    { fill = fill ; close = fun () -> close input }

let create_decoder input =
  let resampler = create_resampler () in
  let mad_stream = Mad.openstream input in
    Decoder (fun buffer ->
       let data = Mad.decode_frame_float mad_stream in
       let sample_freq,_,_ = Mad.get_output_format fd in
       let content,length =
         resampler ~audio_src_rate:(float sample_freq) data
       in
         put_audio_in_buffer buffer content length)

Le code du décodeur MP3 n'a changé que d'un iota, mais cela suffit à forcer sa bonne utilisation dans file_decoder, c'est à dire à passer l'input une fois pour toute, et ne plus passer que le buffer dans les appels suivants. Vraiment? Non, à vrai dire, on peut toujours se prendre les pieds dedans, ne serait-ce que parce que c'est possible de traduire entre le vieux type de décodeur et le nouveau, en violant ainsi la logique qu'on a tenté de forcer. Mais en pratique, ce petit garde fou pousse à faire naturellement la bonne chose, ou au moins à se poser la question.

Tout est bien qui fini bien. Cette histoire pourrait aussi s'intituler "à quoi diable pourrait bien servir un type variant avec un seul constructeur?" Ou encore, "c'est fou comme de belles idées théoriques ont du sens même en dehors de leur strict cadre théorique."

Illumination

For some reason, I've found myself implementing bits of a text-mode rogue-like game. In a nutshell, this is a turn-based kind of game where the player moves on a grid which usually depicts a dungeon or a cave. Some cells of that grid/map might contain a wall/rock, in which case the player cannot see or walk through them. All this is rather straightforward to implement, but the computation of what the player sees deserves some attention.

I started thinking of casting rays, but only found clumsy, costly solutions. So I did a little research. Some people (including crawl) actually developed algorithms along these lines for computing what is called a permissive field of view:

A destination square is visible from a source square if there is any unobstructed line from some point in the source square to some point in the destination square.

It's apparently a modern notion of field of view, that has one advantage over older techniques: it ensures symmetry, i.e., if I can see you, you can see me.

The same article on roguebasin points to several algorithms, including the one implemented in crawl. They all seemed unsatisfyingly complicated to me. I eventually came up with a different idea that looks good and ensures symmetry. It might have been considered already and discarded for some of its funny aspects, but those are interested to look at.

The basic idea is to forget about those lines. We are talking about a discrete universe, let's try to make its physics discrete too. Geometrical optics is only a convenient metaphor, that is justified by more elementary principles such as Fermat's:

The path taken between two points of a ray of light is the path that can be traversed in the least time.

This is in fact a definition of a ray of light that we can take literally in our discrete rogue world:

A cell is visible from another if one of the shortest paths between them is unobstructed.

Let's look at a simple example. For now, suppose that the movements are only allowed along the axis (no diagonals):

.# 
@#y
.x.

The player is represented by @, and # are walls/rocks. The cell marked y is not visible: it is at distance 2, there is only one path of length 2 that connects it to the player but it is obstructed. Cell x is also at distance 2, but it is visible since one of the two paths of length 2 that connects it to the player is not obstructed.

A funny thing happens when you consider the traditional rogue movements which include diagonals: cell y becomes visible! Indeed, the light can take a path of length 2 through x.

I would tend to adopt rules where the topology is the same for players and light. Either embrace the diagonal movements but accept the surprising effect on light, or remove them both for the light and the player. I chose the less experimental way for now. But it is also possible to use different topologies for the two entities.

To finish, I will give the last reason why I like this solution: the code is stupid simple. Assuming that the radius of the field of view will always be within a fixed bound, we can compute once and for all the map of shortest paths with their dependencies.

(** The maps will be used to associate
  * the coordinates of the destination of a path
  * to the lists of the coordinates of possible previous step
  * in shortest paths leading to that destination. *)
module M = Map.Make (struct type t = int*int let compare = compare end)

let neighbors (x,y) =
  [ x-1,y ;
    x,y-1 ;
    x+1,y ;
    x,y+1 ]

let shortest_paths max =
  (** Map of distances to the center of the matrix. *)
  let dist = Array.make_matrix (2*max+1) (2*max+1) max_int in
  (** At each step we compute the shortests paths to cells
    * at distance [d=n+1] from those for distance [n]. *)
  let step d paths_n =
    M.fold
      (fun (x,y) _ m ->
         List.fold_left
           (fun m (x',y') ->
              if dist.(max+x').(max+y') < d then
                (* Seen in a previous iteration. *)
                m
              else if dist.(max+x').(max+y') = d then
                (* We already found a path of length n+1,
                 * but we need to keep track of this new one too. *)
                M.add (x',y') ((x,y)::M.find (x',y') m) m
              else begin
                (* First time we see it: first shortest path. *)
                dist.(max+x').(max+y') <- d ;
                M.add (x',y') [x,y] m
              end)
           m
           (neighbors (x,y)))
      paths_n
      M.empty
  in
  let rec aux d frontiers =
    if d=max then frontiers else
      aux (d+1) (step d (List.hd frontiers) :: frontiers)
  in
    List.rev (aux 1 [M.add (0,0) [] M.empty])

Then, it only remains to parse dependencies:

(** Takes a radius (d) and returns a field of view function
  * for that radius. *)
let fov d =
  let frontiers = shortest_paths d in
    (* The field of view function,
     * which takes a function and calls it on each visible cell.
     * The function [f] returns whether a cell is transparent or not. *)
    fun f ->
      let transparent = Array.make_matrix (2*d+1) (2*d+1) false in
        transparent.(d).(d) <- true ;
        List.iter
          (fun frontier ->
             M.iter
               (fun (x',y') deps ->
                  if
                    List.exists (fun (x,y) -> transparent.(d+x).(d+y)) deps
                  then
                    transparent.(d+x').(d+y') <- f x' y')
               frontier)
          (List.tl frontiers)

Hurray to (impure) functional programming! I leave it to you to glue this to whatever testing code you want. I'll finish with "screenshots".

Without diagonal moves, notice that it is possible to see through a wall on a diagonal:

              .
       .      ..
      ..    ##...
     #.. ###...# .
     #..#......##.#
     #.....@......#
     #...##........
     ...#.........
      ###........
        #.......
        ..####.
         .

With diagonal moves, we now have shadows along the diagonals, but we can see around walls placed along the axis:

        ..#..#...
         .......
   .######.....
   ...........
   .##.......
    #.......#
    #.......####   #
    #..........## ..
   .##..##.@....#...
   #...  ##...##..##
   ###    .......###
         ...........
        ............
       .............
      ###...........
        ............
       .##.####.....

Mise en boîte

Depuis un bon moment, liquidsoap dispose d'un langage de configuration/script fonctionnel, fortement et statiquement typé, qui infère des types à la ML, le tout à l'insu de la plupart des utilisateurs. Pour liquidsoap 1.0 nous irons plus loin dans l'utilisation de concepts avancés avec (un peu) de vrai polymorphisme.

J'ai édité ce post deux ou trois dans les jours suivant sa publication. Peut-être que le blog n'était pas le format idéal.

Pourquoi?

Dans une conf liquidsoap, les fonctions sont parfois utiles pour éviter de recopier du code, ou pour spécifier une action à effectuer en réaction à certains évenements. Mais au coeur même de la génération du flux, les fonctions sont utilisées pour représenter les transitions entre pistes audio. (Détails ici.)

Cette même notion de transition pose des problèmes quant à l'écoulement du temps. Actuellement dans liquidsoap, toutes les sources de flux audio évoluent à la même vitesse, cadencées par une unique horloge. Pour calculer une transition entre deux pistes d'une même source, l'opérateur cross doit obtenir en avance le début de la piste suivante, et le combiner avec la fin de la piste en cours. Cela requiert d'accélérer cette source.

L'implémentation actuelle n'est pas une solution: Les opérateurs qui en ont besoin simulent l'action de l'horloge auprès de leur source, afin de l'accélérer. Cela marche souvent, mais il se peut que deux opérateurs lisent une même source à des vitesses différentes. Le résultat est inattendu, à éviter. Notre mission est d'éviter cela statiquement, avant même la construction des sources. Nous allons donc attacher un paramètre au type des sources, qui représentera son horloge, et spécifier dans le type des opérateurs s'ils requièrent des horloges particulières.

S'il est assez facile de bricoler le système de type pour obtenir l'effet désiré, il faut d'abord identifier les concepts "logiques" mis en jeux. J'ai honte, mais ça m'a pris du temps, car j'ai commencé par chercher dans des contrées exotiques alors que c'est assez connu, bien que pointu.

Polymorphisme

Le polymorphisme est la possibilité de former une quantification universelle sur les types. Si on a un objet de type ∀x. x->x, on peut l'instantier en une fonction de type int->int aussi bien que (bool->bool)->(bool->bool).

Dans les langages dérivés de ML, le polymorphisme est limité à une quantification externe. On peut avoir ∀x. x->x mais pas (∀x. x->x)->int->int. Le polymorphisme dans toute sa généralité, par exemple dans le système F, rend en effet l'inférence de type indécidable.

OCaml permet cependant d'aller un peu plus loin. La clé est que la création d'un type polymorphe doit être explicite dans le programme (cf. ce papier), par exemple associée à la création d'un enregistrement. Considérons la signature suivante:

(** Une source associée à l'horloge 'a *)
type 'a src

(** Une fonction qui renvoie une source qu'on peut
* associer à n'importe quelle horloge. *)
type boxed = { c : 'a. unit -> 'a src }

(** Cet opérateur prend une source en boîte,
* cela pourrait être le cross() de liquidsoap. *)
val box : boxed -> 'a src

val leaf : unit -> 'a src (* en gros, single *)
val node : 'a src list -> 'a src (* en gros, fallback *)

Voyons voir ce qu'on peut et ne peut pas faire avec ce système. On peut créer un certain nombre de sources avec leaf () initialement, elles auront le type '_a src: leur horloge est indéfinie, mais pas généralisable. On est content de ne pas voir de 'a src: cela correspondrait à une source qui peut se brancher sur toutes les horloges à la fois, non-sens. (C'est aussi pour cela qu'on n'a pas écrit boxed = { c : 'a. 'a src }, on n'aurait jamais pu construire de boîte.)

On peut passer une source de type '_a src à notre opérateur node, on obtient une autre source à la même horloge '_a. Si on passe deux sources à node, le système de type requiert que leurs horloges soient les mêmes (des inconnues '_a et '_b sont unifiées).

Maintenant, tentons de former des boîtes:

let b = box { c = leaf }
(* Gagné:
* une boîte qui nous donne une nouvelle feuille à chaque fois,
* horloge au choix. *)

let a = leaf ()
let b = box { c = fun () -> b }
(* Raté, erreur de type:
* la source a est de type '_a src,
* la fonction (fun () -> b) est de type unit -> '_a src,
* qu'on ne peut généraliser en 'a. unit -> 'a src. *)

let b =
box { c = fun () ->
let a = leaf () in
node [a;a] }
(* Gagné, on a une boîte qui nous renvoie une source composée,
* dont on peut choisir l'horloge. *)

On tient clairement le bon concept: le polymorphisme assure que l'horloge peut être choisie. En particulier on va pouvoir créer des nouvelles horloges dédiées à certaines sources (et leurs sous-sources). Reste à transférer ce petit exemple en quelquechose d'agréable à utiliser dans liquidsoap.

Liquidsoap 1.0

Actuellement dans liquidsoap, on écrit des choses comme:

music = playlist("list.txt")
backup = single("default.ogg")
source = fallback([music,backup])
transition = fun (a,b) -> ...
source = cross(transition,source)
output.icecast(source)

En collant au style de notre exemple en OCaml, nous devrions réécrire les choses ainsi:

transition = fun (a,b) -> ...
source =
cross(transition, {
music = playlist("list.txt")
backup = single("default.ogg")
fallback([music,backup])
})
output.icecast(source)

C'est trop lourd, et ma solution ne va différer que d'un epsilon du style courant:

music = playlist("list.txt")
backup = single("default.ogg")
source = fallback([music,backup])
transition = fun (a,b) -> ...
source = cross(transition,{source})
output.icecast(source)

Un point clé qui permet cette simplification est qu'on n'a besoin que d'une partie du polymorphisme: on veut la généricité, mais une seule fois. Pas besoin d'une fonction qui à chaque appel pond une source, comme dans l'exemple en Caml. Il suffit d'une seule source, tant que son horloge est générique.

Je pense qu'on ne peut pas se passer aisément du marqueur {source} qui indique qu'on généralise cette source. Il me semble acceptable de demander à l'utilisateur de marquer le coup quand il utilise cette notion complexe. (Par contre il va nous falloir choisir une syntaxe qui ne rentre pas en conflit avec l'actuel {...}, raccourci pour fun () -> ....)

Comment ça marche

J'ai une implémentation en OCaml qui me semble transposable à liquidsoap.

Comment OCaml vérifie-t-il que { c = fun () -> blah } est bien typé? Il introduit une nouvelle variable de type n pour représenter le 'a de 'a. unit -> 'a src, et vérifie qu'on peut donner le type n src à blah.

Nous allons faire la même chose, mais dans le désordre, pour permettre le genre d'écriture promis plus haut. Pour former une boîte (un type universel) sur une source, il faut que son horloge soit encore indéterminée. On vérifie cela en unifiant le type de cette source avec n src pour une nouvelle variable de type n comme OCaml faisait. Et une fois qu'on a ainsi réussit à former une boîte, on affecte cette variable à type à une valeur interdite Boom pour empêcher son utilisation ailleurs. Au lieu de créer les sources dans une zone protégée, on les crée en dehors, et on les y affecte après coup, ce qui rend alors leur horloge dénuée de sens à l'extérieur.

Un difficulté essentielle du polymorphisme vient du fait que pour inférer, on a besoin de savoir quel type universel on forme. Dans le cas de liquidsoap ma solution est très simple: on ne forme que ∀x. x src. On pourrait avoir d'autres types polymorphes, mais chacun aurait son constructeur particulier.

Ces mécanismes fonctionnent bien sur quelques exemples disponibles dans mon code:

ex0 = single ()
ex0 : '_a src # pas de généralisation, c'est comme avec ref

ex00 = let x = single () in {x}
ex00 : 'a. 'a src

ex1 = fun (x) -> cross(x)
ex1 : 'b. ('a. 'a src) -> 'b src

ex4 = fun (_) -> cross({single("blah.ogg")})
ex4 : 'a.'b. 'a -> 'b src

Un exemple plus subtil est ex2 = fun (x) -> {x}, ou la variation ex4 = fun (x) -> cross({x}) qui se rapproche de ex1. Ici une boîte est formée sur l'argument de la fonction, qui doit donc être une source. Ce genre de construction est problématique: la source doit être introduite avant son horloge. En pratique, cela se traduit par l'impossibilité de former le type de la fonction où devrait apparaitre le symbole interdit: Boom src -> 'a. 'a src.

Exercice

Il me reste treize jours pour finir de rédiger ma thèse. Pendant ce temps là, pour que je ne sois pas le seul à bosser, voici un petit exercice de prog qui m'est passé par la tête. On peut représenter du texte par le type string en Caml. On veut ensuite représenter du texte annoté, quand les annotations forment un arbre: soit deux annotations sont disjointes, soit l'une est incluse dans l'autre. Pensez par exemple à la grammaire au collège, "sujet" , "verbe", "complément" sont regroupés pour former une "phrase":

type annot =
(* Par exemple.. *)
| Sujet | Verbe | Complément | Phrase
type t =
| Text of string
| Annot of string * t
| Concat of t list

Il est aisé de travailler avec ce type. Et il représente exactement ce qu'on veut, il y a bijection. Maintenant, je veux une solution aussi satisfaisante quand les annotations ne forment plus un arbre mais peuvent se recouvrir partiellement. Pensez par exemple à du HTML mal formé: <red>b<b>a</red>b</b>i. Sauf que moi j'ai une utilisation moins crade en tête, mais c'est une autre histoire. Vos idées sont bienvenues, sinon je posterai peut être une solution plus tard...

OCaml write-only

J'ai découvert un petit site sympa suite à une annonce sur la Caml-list: Anarchy Golf. Au golf, on fini un parcours en un nombre minimum de coups. Ici, on résout un problème en un nombre minimum d'octets de code. De nombreux langages sont disponibles, dont OCaml.

Le problème annoncé sur la Caml-list laisse rêveur: trouver un Quine qui soit aussi un palindrome. En clair: un programme dont l'exécution affiche le code du programme, et dont le code est un palindrome, i.e. identique qu'on le lise de droite à gauche ou le contraire. Il est assez simple d'écrire un Quine, quel que soit le langage. J'ai écrit un palindrome en Caml, c'est déja un peu plus ardu. Mais satisfaire aux deux contraintes en même temps est décourageant. Alors j'ai perdu mon temps sur d'autres problèmes plus simples, en attendant de voir les solutions à celui-ci (le 08 Février, 01:46:39 heure japonaise).

La contrainte de concision force à faire des choses illisibles. Par exemple, ma solution pour le problème rot13:

let rec(!)?(c=input_byte stdin)x=output_byte stdout[|c;c;65+c mod x;97+(c-6)mod x|].(c/32);!x;;!26

À ce stade vient l'expression consacrée à Perl: ce code est write-only. Et encore c'est assez lisible comparé aux solutions du champion de Golf en OCaml: ksk.

La concision force à faire des choses qu'on ne pourrait qualifier de bonnes pratiques de programmation. Cela dit, il faut en général réfléchir à un algorithme pas trop con pour pouvoir prétendre au podium. Par exemple, même en déployant toutes les ruses de compression possibles, je sentais bien que je n'atteindrais pas les 54 octets de ksk pour écrire un interpéteur Scheme minimal. Après la fin du défi, quand son code a été publié, j'ai pu constater qu'il avait rusé:

print_string[|"3";"24";"5
8
58"|].(-Obj.magic(@)mod 3)

De là à comprendre la ruse, ce n'est pas si simple. Tout repose sur le fait que le code ne doit pas vraiment implémenter un interpréteur Scheme: il suffit qu'il donne les bonnes réponses pour trois entrées différentes, toujours les mêmes. La plupart des participants ont utilisé cette "faille" pour répondre, par exemple m.ukai, classé second en OCaml:

print_string[|"24";"3";"5
8
58"|].(String.length(read_line())-16)

Ici, la réponse est choisie en fonction de la longueur de la première ligne de l'entrée, cette information étant suffisante pour distinguer les tests. La solution de ksk reste incompréhensible: il n'y a aucune instruction de lecture, aucun test dépendant de l'entrée. Pire: si vous prenez son code et le compilez (en natif ou bytecode) vous obtiendrez un programme déterministe (il affiche toujours 3 chez moi).

La clé du mystère ? Exécuté dans la boucle d'interaction ocaml comme le fait la procédure de vérification du Code Golf, ce code a une sortie aléatoire. Selon les exécutions de ocaml ksk.ml, on reçoit la réponse de l'un des trois tests. Le hasard réside dans l'initialisation de la boucle d'interaction, qui fait que l'opérateur de concaténation (@), transtypé en un int par Obj.magic va avoir une valeur grosso-modo aléatoire. Je ne fais que constater, je ne comprends pas.

Mais cela ne répond toujours pas au problème... enfin, pas toujours. Il aura probablement fallu à ksk pas mal de patience pour soumettre et re-soumettre son code jusqu'à ce que le hasard renvoie les bonnes réponses aux bons tests, et le classe premier! Cette solution est vraiment write-only: c'est illisible, et même son exécution laisse à désirer :)

Moi je trouve ça un peu trop immoral, mais il faut avouer que ça respecte les règles du jeu. Et on aura appris quelquechose. C'est moche, mais ça marche.

Enigmes

Quand on pose une énigme mathématique, à moitié formalisée, on finit toujours par avoir une réponse type: "on enlève le bandeau qu'on a sur les yeux", "on casse la gueule au bourreau", etc. D'où l'idée de formaliser vraiment, sous forme d'un exercice de programmation... (qui a dit "maniaque" ?)

Un groupe de n prisonniers se trouve en mauvaise posture. Ils vont être mis en file indienne, chaque prisonnier voyant seulement les prisonniers devant lui. Puis on leur mettra sur la tête un chapeau bleu, blanc ou rouge, qu'ils ne peuvent voir. Un bourreau procède alors comme suit: en partant du dernier prisonnier il demande "Quelle est la couleur de ton chapeau ?", et le prisonnier n'a le droit qu'à une réponse, qui doit être une couleur. A la fin, les prisonniers qui ont deviné la couleur de leur chapeau sont épargnés, les autres exécutés. Les prisonniers peuvent se concerter avant l'épreuve sur la stratégie à adopter. Quelle est la meilleure stratégie ?

Voici maintenant l'énoncé complètement formalisé. Un prisonnier est représenté par une fonction qui prend deux listes de couleurs (celles qu'il voit devant lui, celles qui ont été prononcées comme réponses derrière lui), et renvoie une couleur (sa réponse). Dans la liste des réponses précédentes, la réponse du dernier de la file est la dernière de la liste. Trouver une fonction prisonniers qui à un entier n associe une liste de n fonctions/prisonniers telle que le nombre de morts calculé par (execution (prisonniers n)) soit le plus petit possible dans le pire cas. La fonction d'exécution est la suivante:

type couleur = Bleu | Blanc | Rouge
type prisonnier = couleur list -> couleur list -> couleur

let random_couleur () =
  let n = Random.int 3 in
    if n = 0 then Bleu else if n = 1 then Blanc else Rouge

let execution (prisonniers : prisonnier list) =
  let prisonniers =
    List.map (fun p -> p, random_couleur ()) prisonniers
  in
  let rec morts avant = function
    | (p,c)::l ->
        let reponse = p (List.map snd l) avant in
          (if reponse = c then 0 else 1) +
          (morts (reponse::avant) l)
    | [] -> 0
  in
    morts [] prisonniers

Amusez-vous bien, et postez vos réponses dans le langage de votre choix...

Edit: une autre énigme beaucoup plus étonnante, que Florent et Julien m'ont racontée. Vous avez devant vous sur une table 7 pièces côté pile et 19 pièces côté face. Mais vos yeux sont bandés (et vous portez des moufles) de sorte que vous ne pouvez savoir l'état d'une pièce. Tout ce que vous pouvez faire c'est en retourner certaines, autant que vous voulez, et les déplacer. Il vous faut les séparer en deux groupes qui contiennent le même nombre de pièces côté pile.

La solution sera une fonction qui prend le nombre de piles et le nombre de faces (je vous aide bien en généralisant) et qui renvoie deux tableaux de taille piles+faces: le premier indique les indices des pièces choisies, le second indique les pièces qu'il faut retourner. La fonction sera passée à la fonction de test suivantes:

(** Perfect Fisher-Yates shuffle
  * (http://www.nist.gov/dads/HTML/fisherYatesShuffle.html). *)
let randomize a =
  let permute i j =
    let tmp = a.(i) in
      a.(i) <- a.(j);
      a.(j) <- tmp
  in
  let l = Array.length a in
    if l>=2 then
      for i=0 to l-2 do
        permute i (i + Random.int (l-i))
      done

let test nb_piles nb_faces joueur =
  let choix,retourne = joueur nb_piles nb_faces in
  let n = nb_piles + nb_faces in
  let a = Array.init n (fun i -> i<nb_piles) in
  (* Nombre de piles à gauche - nombre de piles à droite *)
  let d = ref 0 in
    randomize a ;
    for i = 0 to n-1 do
      if retourne.(i) then a.(i) <- not a.(i) ;
      d := (if choix.(i) then (+) else (-)) !d (if a.(i) then 1 else 0)
    done ;
    !d = 0

A suivre: les solutions commentées...

Application

Je suis en conférence, ce qui me laisse plein de temps pour bosser pendant la plupart des exposés... Bremen est plutôt une jolie ville, le campus est super agréable et il fait beau. Blogger s'est mis à me parler en Allemand. Ici j'ai vu Al. Bundy, pour ceux qui connaissent...

Bon sinon, un petit exemple simple m'est venu pour montrer que l'application en Caml n'est pas aussi simple qu'on le pense en présence d'arguments optionels. L'équation f x y = (f x) y, n'est pas toujours vérifiée. En fait, on n'a pas seulement une notion d'application mais bien une multi-application. Si je parle de ça c'est pour mettre au clair l'origine de la multi-abstraction du langage de script de liquidsoap.

# let f ?(a=false) () = a ;;
val f : ?a:bool -> unit -> bool = 
# f () ~a:true ;;
- : bool = true
# (f ()) ~a:true ;;
This expression is not a function, it cannot be applied
# f () ;;
- : bool = false