Journal Portage de TapTempo en OCaml

Posté par (page perso) . Licence CC by-sa
Tags :
15
10
mar.
2018

Je me désespérais de voir apparaître le portage de TapTempo en OCaml alors je m'y colle.
Taptempocaml est donc le portage du désormais célèbre TapTempo en OCaml.
Ce portage n’a pas la prétention de présenter l’état de l’art de la programmation fonctionnelle. Le but ici est plutôt de fournir le code le plus simple et le plus proche de l’original et ceci pour trois raisons :
I. Bien que le langage fournisse des fonctionnalités très évoluées, dans 93 % des cas, ce dont on a réellement besoin c’est d’une solution simple et directe.
II. La proximité de ce portage avec l’original facilitera aux éventuels lecteurs la comparaison avec celui-ci.
III. Je suis fainéant.

En principe, ce portage est ISO-fonctionnel avec l’original.
Je ne présente ici que la fonction principale :

open I18n.Gettext

let run sampleSize resetTime precision =

  let hitTimePoints = Queue.create() in

  print_string(s_"Hit enter key for each beat (q to quit).\n");

  while input_char stdin <> 'q' do
    let currentTime = Unix.gettimeofday() in

    if Queue.is_empty hitTimePoints
    || currentTime -. Queue.top hitTimePoints > resetTime
    then (
      Queue.clear hitTimePoints; (* Reset if the hit diff is too big. *)
      print_string(s_"[Hit enter key one more time to start bpm computation...]\n")
    )
    else (
      let occurenceCount = Queue.length hitTimePoints in

      (* Remove the older time from hitTimePoints with Queue.pop if the sample size is reached.
            Otherwise it is kept in the queue with Queue.top. *)
      let olderTime = Queue.(if occurenceCount < sampleSize then top else pop) hitTimePoints in

      let bpm = 60. *. float_of_int occurenceCount /. (currentTime -. olderTime) in

      Printf.printf(f_"Tempo: %.*f bpm%!") precision bpm;
    );
    Queue.add currentTime hitTimePoints;
  done;
  print_string(s_"Bye Bye!\n")


let () =
  let sampleSize, resetTime, precision = Options.createFromArgs Sys.argv
  in
  run sampleSize resetTime precision

Si la motivation première de ce portage est la joie de participer à l’enthousiasme frénétique qui entoure cette vague de portage de TapTempo, cet exercice m’aura en outre permit de découvrir la bibliothèque Gettext et le module Arg. Rien que pour cela je remercie mfz ainsi que tout les auteurs des différents portages de TapTempo.

Maintenant, ce qui serait vraiment intéressant, ce serait le portage de TapTempo en Reason

  • # Lisibilité

    Posté par (page perso) . Évalué à 8.

    Merci pour ce journal parce que sans vouloir troller, c'est la première fois que je vois un code OCaml que je comprenne du premier coup.
    Clairement, tu as fait l'effort de faire le portage au plus près de la solution initiale.

    Ce qui serait super cool maintenant, c'est que quelqu'un, pas forcément toi, mette une version plus OCaml comme on en voit traîner régulièrement sur LinuxFr :)

    • [^] # Re: Lisibilité

      Posté par . Évalué à 3. Dernière modification le 12/03/18 à 10:41.

      Ce qui serait super cool maintenant, c'est que quelqu'un, pas forcément toi, mette une version plus OCaml comme on en voit traîner régulièrement sur LinuxFr :)

      Qu'entends-tu par plus OCaml ? Tu veux dire dans un style fonctionnel ? Là son code est fondamentalement impératif (le langage est multi-paradigme) et les traits impératifs se prêtent bien au problème. Ceci étant on pourrait ne pas mettre de boucle while, mais une fonction récursive à la place, du genre :

      let rec loop time = match input_char stdin with
      | exception End_of_file -> ()
      | 'q' -> ()
      | '\n' ->
        let new_time = Mtime_clock.now () in
      
        if Mtime.(Span.to_s (span time new_time)) > reset_delay
        then Sample.clear samples;
      
        Sample.add new_time samples; show_bpm samples; loop new_time
      | _ -> loop time
      in loop @@ Mtime_clock.now ();

      c'est ce genre de code dont tu parles ? (ici j'utilise une horloge monotone et un module à ma sauce pour gérer la logique de calcul du tempo)

      L'avantage que je vois, c'est que cela évite les imbrications, des fois dure à suivre, des if then else. Ici on est protégé des exceptions et seule la touche enter peut être appuyée en cadence. Sans cela, un test comme :

      $ (for i in $(seq 6); do echo; sleep 0.5; done) | ./taptempo | grep bpm
      Tempo: 120 bpm
      Tempo: 120 bpm
      Tempo: 120 bpm
      Tempo: 120 bpm
      Tempo: 120 bpm

      générera une exception (non rattrapée) quand le flux d'entrée est fermé et, selon que l'on accepte ou non n'importe quel caractère, cela peut changer le résultat de celui-ci :

      # seule la touche enter
      $ (for i in $(seq 6); do echo 'taptempo'; sleep 0.5; done) | ./taptempo | grep bpm | wc -l
      5
      
      # n'importe quel caractère
      $ for i in $(seq 6); do echo 'taptempo'; sleep 0.5; done) | ./taptempo | grep bpm | wc -l
      53 # sans compter le calcul du tempo qui s'envole ;-)

      Sapere aude ! Aie le courage de te servir de ton propre entendement. Voilà la devise des Lumières.

      • [^] # Re: Lisibilité

        Posté par (page perso) . Évalué à 2.

        c'est ce genre de code dont tu parles ?

        Voilà, c'est exactement ça et je me doutais bien que ce serait toi qui t'y collerai :)
        Merci, je vais étudier ça de près.

        • [^] # Re: Lisibilité

          Posté par . Évalué à 6.

          Merci, je vais étudier ça de près.

          Dans ce cas, je te propose la version suivante de la boucle principale (dans une approche similaire à celle en Elixir et ce que l'auteur à appeler flow programming).

          let rec loop stamp samples = match input_char stdin with
          | exception End_of_file -> ()
          | 'q' -> ()
          | '\n' ->
            let new_stamp = Mtime_clock.now () in
            let elapsed = Mtime.(Span.to_s (span stamp new_stamp)) in    
            samples
            |- (if elapsed > reset_delay then Sample.reset else ignore)
            |- Sample.add new_stamp
            |- show_bpm
            |> loop new_stamp
          | _ -> loop stamp samples
          in loop (Mtime_clock.now ()) (Sample.create sample_size);

          Ici c'est dans la même veine que le code Rust que tu ne comprenais pas : c'est à base de pipe (on connecte les flux d'entrée et de sortie de fonctions). Il y a deux types de connecteurs de flux sous forme d'opérateurs infixes : |- qui est proche de la commande unix tee (d'où le choix du symbole) et le |> qui fonctionne comme le pipe | du shell.

          Si tu comprends cette commande, alors c'est bon :

          $ (for i in $(seq 6); do echo; sleep 0.5; done) | ./taptempo | tee log1 | grep bpm | tee log2 | cut -d' ' -f2,3
          120 bpm
          120 bpm
          120 bpm
          120 bpm
          120 bpm
          
          $ cat log1
          Appuyer sur la touche entrée en cadence (q pour quitter).
          
          [Appuyer encore sur la touche entrée pour lancer le calcul du tempo...]
          Tempo: 120 bpm
          Tempo: 120 bpm
          Tempo: 120 bpm
          Tempo: 120 bpm
          Tempo: 120 bpm
          
          Au revoir !
          
          $ cat log2
          Tempo: 120 bpm
          Tempo: 120 bpm
          Tempo: 120 bpm
          Tempo: 120 bpm
          Tempo: 120 bpm

          on chaîne les commandes, et on utilise tee pour faire un log de résultats intermédiaires mais sans casser le flux. Comme dans cet exemple OCaml :

          let pipeline str =
            str
            |- Printf.printf "la chaîne est: \"%s\"\n"
            |> String.trim
            |- Printf.printf "on a retiré les espaces: \"%s\"\n"
            |> String.length
            |- Printf.printf "la longueur de la chaîne tronquée est: %i\n"
            |> succ
            |> (fun x -> 3 * x)
          ;;
          val pipeline : string -> int = <fun>

          on prend une chaîne, on lui retire les espaces en préfixe et suffixe (String.trim), on calcule la longueur de la chaîne ainsi obtenue (String.length) puis on effectue des calculs sur cette valeur entière, le tout en faisant quelques commandes de log entre temps. Exemple d'usage :

          pipeline "   hello world !   ";;
          la chaîne est: "   hello world !   "
          on a retiré les espaces: "hello world !"
          la longueur de la chaîne tronquée est: 13
          - : int = 42

          L'opérateur infixe |- se définit tout simplement ainsi :

          (* on applique f à x, puis on retourne x pour pouvoir chaîner *)
          let (|-) x f = (f x : unit); x;;
          val ( |- ) : 'a -> ('a -> unit) -> 'a

          j'ai juste mis une contrainte de type sur la sortie de f de telle sorte que :

          x |- step1 |- step2 |- step3
          
          (* soit bien équivalent à *)
          
          step1 x; step2 x; step3 x

          Maintenant, si on reprend la partie du code qui correspond au traitement à effectuer lors de l'appui sur la touche enter :

          let new_stamp = Mtime_clock.now () in
          let elapsed = Mtime.(Span.to_s (span stamp new_stamp)) in    
          samples
          |- (if elapsed > reset_delay then Sample.reset else ignore)
          |- Sample.add new_stamp
          |- show_bpm
          |> loop new_stamp

          On calcule un nouvelle horodatage et le temps écoulé (en secondes) depuis le dernier appui sur enter; ensuite on enchaîne les traitements sur la file des horodatages :

          • si le temps écoulé est supérieur au délai de réinitialisation alors on reset, sinon on ne fait rien ;
          • on ajoute l'horodatage à la file (ce qui met à jour, dans la structure, la valeur du tempo) ;
          • on affiche le tempo ou le message qui dit d'appuyer une nouvel fois pour lancer le calcul (choix basé sur un type option contenu dans la structure[1]) ;
          • on repart dans la boucle avec comme paramètres le nouvel horodatage et la file mise à jour.

          C'est beau, c'est fin, ça se mange sans faim. :-)


          [1]: en arrière plan, le type de la file d'horodatage est

          type t = {
            size : int ; (* nombre max d'échantillons *)
            queue : Mtime.t Queue.t ; (* FIFO contenant les timestamps *)
            mutable tempo : float option ; (* Some tempo ou None *)
          }

          Sapere aude ! Aie le courage de te servir de ton propre entendement. Voilà la devise des Lumières.

        • [^] # Re: Lisibilité

          Posté par . Évalué à 5. Dernière modification le 13/03/18 à 17:49.

          Comme tu es plus habitué au paradigme impératif, je donne ci-dessous la boucle while équivalente à mon code avec une fonction récursive, puis je donne une explication pour passer de l'un à l'autre.

          (*
            valeurs impératives modifiées pendant la boucle,
            on les définit à l'éxtérieur avant de rentrer dedans
          *)
          let samples = Sample.create sample_size in
          let stamp = ref (Mtime_clock.now ()) in
          let key_pressed = ref (try input_char stdin with End_of_file -> 'q') in
          
          (* on rentre dans la boucle *)
          while !key_pressed <> 'q' do
            (* on ne fait quelque chose qu'en cas d'appui sur 'enter' *)
            if !key_pressed = '\n' then begin
              let new_stamp = Mtime_clock.now () in
              let elapsed = Mtime.(Span.to_s (span !stamp new_stamp)) in
          
              (* logique de mise à jour de la variable `samples` *)
              if elapsed > reset_delay then Sample.reset samples;
              Sample.add new_stamp samples;
          
              (* on affiche le message adapté *)
              show_bpm samples;
          
              (* mise à jour de la variable `stamp` *)
              stamp := new_stamp;
            end;
            (* mise à jour de la variable `key_pressed` *)
            key_pressed := try input_char stdin with End_of_file -> 'q'
          done;

          Le principe d'une boucle while, comme illustré dans cet exemple, est d'être une procédure qui modifie par effet de bords certaines variables qui lui sont globales (ici essentiellement samples et stamp) tant qu'une condition est satisfaite (ici, tant que l'on n'a pas appuyé sur q ou que l'entrée standard est n'est pas au bout). En tant que telle, du point de vue d'OCaml, c'est une expression qui a une valeur (comme n'importe quelle expression du langage) de type unit : ce type ne contient qu'une seule valeur (on parle de type singleton) notée (), c'est la valeur qui ne contient aucune information.

          Pour transformer cette boucle en une fonction récursive, il faut d'abord qu'elle retourne la même valeur, à savoir (), lorsqu'elle termine. Ensuite, les variables globales sur laquelle opérait la boucle sont transformées en paramètres de la fonction : elles ne seront plus globales à la boucle, mais locales. On commence donc par écrire :

          let rec loop stamp samples =

          Ensuite, il faut exprimer la condition d'arrêt de la boucle. Celle-ci dépend du caractère que l'on lit sur l'entrée standard, d'où :

          let rec loop stamp samples = match input_char stdin with

          On fait alors une étude de cas, à la manière d'un switch, en commençant par dire quand la fonction termine (et qui renvoie alors ()) :

          let rec loop stamp samples = match input_char stdin with
          (* cas de fin de boucle *)
          | exception End_of_file
          | 'q' -> ()

          Vient ensuite le cœur de la logique de la boucle, ce qui se passe quand on a appuyé sur enter :

          let rec loop stamp samples = match input_char stdin with
          (* cas de fin de boucle *)
          | exception End_of_file
          | 'q' -> ()
          (* on a pressé 'enter' *)
          | '\n' ->
            (* on remet la même logique qu'avec la boucle while *)
            let new_stamp = Mtime_clock.now () in
            let elapsed = Mtime.(Span.to_s (span !stamp new_stamp)) in
          
            (* logique de mise à jour de la variable `samples` *)
            if elapsed > reset_delay then Sample.reset samples;
            Sample.add new_stamp samples;
          
            (* on affiche le message adapté *)
            show_bpm samples;
          
            (* ici on ne met pas à jour la variable stamp mais
               on relance la boucle avec les nouveux paramètres *)
            loop new_stamp samples

          Il reste enfin à traiter le cas où l'on a appuyé sur une autre touche : on ne fait rien et on relance la boucle avec les mêmes paramètres

          let rec loop stamp samples = match input_char stdin with
          (* je ne réécris pas la gestion des autres cas *)
          
          (* cas par défaut : on boucle sans rien changer *)
          | _ -> loop stamp samples

          Maintenant que le corps de la fonction est écrit, il ne reste plus qu'à l'appeler pour lancer la boucle. Pour ce faire, on appelle la fonction avec, pour paramètres, les valeurs initiales des variables globales de la boucle while :

          let rec loop stamp samples = match input_char stdin with
          (* 
            bla bla
            bla bla
          *)
          in loop (Mtime_clock.now ()) (Sample.create sample_size)

          Voilà le principe général pour transformer une boucle while en fonction récursive : on transforme les variables globales de la boucle en variables locales, et à chaque tour on lui passe les nouvelles valeurs.

          Ceci étant, ce genre d'approche n'est pas propre au paradigme fonctionnel, mais ce dernier en fait un usage omniprésent et c'est la route vers la pureté (absence d'effets de bords)1. Pour l'instant, la variable samples fonctionne toujours pas effet de bords et, dans le message précédent, j'ai juste modifié l'écriture de sa logique de mise à jour en utilisant une approche par pipe avec le code :

          samples
          |- (if elapsed > reset_delay then Sample.reset else ignore)
          |- Sample.add new_stamp
          |- show_bpm
          |> loop new_stamp

          Mais si, à la place d'une structure impérative, j'utilisais une structure purement applicative, j'aurais juste à changer les deux premiers combinateurs de tuyaux : un pipe |> au lieu d'un T |- et utiliser la fonction identity au lieu de ignore

          samples
          |> (if elapsed > reset_delay then Sample.reset else identity)
          |> Sample.add new_stamp
          |- show_bpm (* ici on log donc on utilise toujours le tee *)
          |> loop new_stamp

          Derrière cette vision par pipeline, il y a une notion élémentaire de mathématique (bon c'est pas du niveau primaire, mais début de lycée ;-), à savoir la composition de fonction.

          composition

          que l'on peut écrire (la pipeline est assez visible sur le diagramme) :

          fun x -> x |> f |> g |> h

          L'opérateur de composition est une opérateur d'ordre supérieur : il prend deux fonctions en entrée et en renvoie une en sortie; raison pour laquelle il a une place centrale de le paradigme de la programmation fonctionnelle. Que peux-t-on faire avec une fonction ?

          • les utiliser, ça on le fait dans tous les langages de la même façon ;
          • les composer, ça c'est plus simple à écrire dans un langage fonctionnel.

          J'espère que ces explications t'aideront un peu mieux à comprendre certains principes élémentaires à la base du paradigme fonctionnel.


          1. En réalité, c'est cette recherche d'absence d'effets de bord qui nous les fait écrire ainsi. On obtient alors des fonctions récursives avec appel dits terminaux, que le compilateur optimisera comme une simple boucle (il fera la traduction dans le sens inverse de celle que je viens de faire). Voir mon commentaire sur la version de taptempo en Emacs Lisp. 

          Sapere aude ! Aie le courage de te servir de ton propre entendement. Voilà la devise des Lumières.

          • [^] # Re: Lisibilité

            Posté par (page perso) . Évalué à 1.

            Super, merci beaucoup pour ces explications. Ça donne envie de faire du vrai fonctionnel :)

            Concernant la récursivité en OCaml, y a-t-il une limitation du nombre d'appel récursif comme dans la plupart des langages impératifs ?

            • [^] # Re: Lisibilité

              Posté par . Évalué à 3.

              Concernant la récursivité en OCaml, y a-t-il une limitation du nombre d'appel récursif comme dans la plupart des langages impératifs ?

              Absolument aucune limitation si les appels récursifs sont terminaux : il se font alors en espace constant sur la pile. Voir ma réponse du dessous à gndl.

              Sapere aude ! Aie le courage de te servir de ton propre entendement. Voilà la devise des Lumières.

    • [^] # Re: Lisibilité

      Posté par (page perso) . Évalué à 1.

      Merci à toi pour ta question et à Kantien pour ça brillante réponse. Au final, ça donne un exemple basique de code qui évolue progressivement vers une version fonctionnelle avancée. C’est cette progressivité qui me manque souvent dans la documentation sur OCaml.

      • [^] # Re: Lisibilité

        Posté par . Évalué à 4. Dernière modification le 15/03/18 à 11:45.

        Kantien pour sa brillante réponse.

        Merci.

        C’est cette progressivité qui me manque souvent dans la documentation sur OCaml.

        Tu parles de la documentation officielle ? Celle-ci est plus un manuel de référence du langage qu'une initiation aux principes de la programmation fonctionnelle.

        La traduction de la boucle while que j'ai faite relève des principes généraux de la programmation fonctionnelle. C'est pour cela que j'avais donné un lien vers un de mes commentaires sur le journal de la version de taptempo en Emacs Lisp. Une personne cherchait à écrire la fonction factorielle de manière récursive terminale et ne savait pas comment faire. Il avait écrit la version naïve :

        let rec fact_non_tailrec = function
        | 0 -> 1
        | n -> n * fact_non_tailrec (n - 1)

        qui génère un dépassement de pile sur de grandes entrées :

        fact_non_tailrec 100_000_000;;
        Stack overflow during evaluation (looping recursion?).

        La version impérative pour une telle fonction, à base de boucle for, est la suivante :

        let fact_for_loop n =
          let res = ref 1 in
          for i = n downto 1 do res := !res * i done;
          !res

        La version fonctionnelle avec récursion terminale consiste donc à utiliser un boucle avec un accumulateur, comme dans la version impérative :

        let factorielle n =
          let rec loop res = function
          | 0 -> res
          | n -> loop (n * res) (n-1)
          in loop 1 n

        Dans les deux versions, impérative et fonctionnelle, la boucle dépend de l'entrée n. Mais, dans la version fonctionnelle, l'accumulateur est également un paramètre de la boucle, là où c'est une variable globale pour celle-ci dans le cas impératif.

        Pour l'autre transformation du code, là c'est plutôt une astuce propre aux langages fonctionnels qui permettent d'avoir des opérateurs binaires infixes, donc hors famille Lisp et leur folie des parenthèses. L'idée étant que dans une telle situation :

        step1 x; step2 x; step3 x

        on puisse « factoriser » la variable sur laquelle on effectue notre séquence de transformation :

        (step1 & step2 & step3) x
        (* ou en chaînant à la manière d'une pipeline *)
        x |- step1 |- step2 |- step3

        Ici, il faut pouvoir définir les opérateurs d'ordre supérieur & et |-, ce que peut faire n'importe quel langage fonctionnel, mais leur utilité réside essentiellement dans le fait qu'on les utilise de manière infixe, ce qui fournit du sucre syntaxique à cette approche.

        Sapere aude ! Aie le courage de te servir de ton propre entendement. Voilà la devise des Lumières.

  • # ISO-fonctionnel

    Posté par (page perso) . Évalué à 2.

    Bravo pour ce portage qui me rend curieux de tester l'iso-fonctionnalité avec l'original.
    Peux-tu m'expliquer comment le compiler et l'exécuter ?
    Je vois que le fichier jbuild décrit les dépendances; sont-elles automatiquement téléchargées lors de la construction ?

    • [^] # Re: ISO-fonctionnel

      Posté par . Évalué à 4.

      Peux-tu m'expliquer comment le compiler et l'exécuter ?

      Sans avoir à installer une partie des outils de développements OCaml, le plus simple est sans doute de passer par le gestionnaire de paquets de ta distribution. Sous Debian (ou dérivée), il te faudrait au minimum les paquets suivants :

      $ apt install ocaml ocaml-findlib libgettext-ocaml
      

      ensuite tu vas dans le répertoire des sources, et tu lances la commande suivante :

      $ ocamlfind opt -package unix,gettext-camomile -linkpkg i18n.ml options.ml taptempocaml.ml -o taptempo
      

      Par contre, chez moi, l'internationalisation ne marche pas : j'ai le texte en anglais. De plus, le flux de sortie standard n'est pas vidé sur certaines écritures : je ne vois rien avant d'avoir appuyer plusieurs fois sur enter. Tu peux corriger cela en rajoutant flush stdout; après ces deux lignes de taptempocaml.ml :

      print_string(s_"Hit enter key for each beat (q to quit).\n");
      flush stdout; (* <- à rajouter *)
      
      (* ... *)
      print_string(s_"[Hit enter key one more time to start bpm computation...]\n");
      flush stdout (* <-  à rajouter mais pas besoin du `;' ici *)

      Sapere aude ! Aie le courage de te servir de ton propre entendement. Voilà la devise des Lumières.

    • [^] # Re: ISO-fonctionnel

      Posté par (page perso) . Évalué à 1.

      Merci pour l’intérêt que tu porte à cette implémentation. J’avoue que je ne m’attendais pas à ce que quelqu’un souhaite le tester :-).
      Dans un premier temps, j’ai utiliser un nouveau système de build (jbuilder) que je ne maîtrise pas. Je suis revenu aux bons vieux Makefile pour gérer l’internationalisation. Malheureusement je ne parviens pas à obtenir la traduction des chaînes de format. Les messages d’aide et l’affichage du tempo ne sont donc pas traduits. Les instructions pour compiler, installer et exécuter l’application ont été ajoutées au README.

      • [^] # Re: ISO-fonctionnel

        Posté par (page perso) . Évalué à 3.

        Dans un premier temps, j’ai utiliser un nouveau système de build (jbuilder) que je ne maîtrise pas. Je suis revenu aux bons vieux Makefile pour gérer l’internationalisation.

        Si tu travailles encore avec des Makefile, tu peux essayer ceux-cis: BSD Owl. (Attention, c'est pour bmake. Il y a même un paquet Debia pour une vieille version. )

Suivre le flux des commentaires

Note : les commentaires appartiennent à ceux qui les ont postés. Nous n'en sommes pas responsables.