Classe Arrow et type Circuit, en Haskell

Voir aussi : video youtube - code source

Dans l’article précédent (La classe de types Arrow, en Haskell), on a vu que le concept d’Arrow est une généralisation du concept de Monade, à travers quelques applications basiques. On va désormais voir une application plus intéressante des arrows, le type Circuit, à travers plusieurs exemples et implémentations.

Le type Circuit

Ce type permet de simuler un circuit et peut être défini de la façon suivante :

newtype Circuit a b = Circuit (a -> (Circuit a b, b))

Ainsi, un Circuit a b prend une entrée de type a et produit une sortie de type b ainsi qu’un nouveau Circuit a b. On peut le voir comme le type StreamFunc de l’article précédent (qui permet de gérer un flux de données) mais avec, en plus, la possibilité de modifier le circuit lui-même.

Pour pouvoir utiliser le type Circuit en tant qu’arrow, on doit instancier quelques classes (pour le code complet, voir le fichier Circuit.hs) :

instance Cat.Category Circuit where
  id :: Circuit a a
  ...

  (.) :: Circuit b c -> Circuit a b -> Circuit a c
  ...

instance Arrow Circuit where
  arr :: (a -> b) -> Circuit a b
  ...

  first :: Circuit a b -> Circuit (a, c) (b, c)
  ...

instance ArrowChoice Circuit where
  left :: Circuit a b -> Circuit (Either a c) (Either b c)
  ...

On notera que la récursivité du type Circuit se retrouve également dans les instances. Par exemple pour la fonction first (qui transforme une arrow “à une entrée/sortie” en arrow “à deux entrées/sorties” où la première entrée/sortie correspond à l’arrow initiale) :

  first :: Circuit a b -> Circuit (a, c) (b, c)
  first (Circuit f) = Circuit $ \(a, c) ->
    let (cir, b) = f a
    in (first cir, (b, c))

Pour obtenir le résultat de first, on applique donc la fonction du circuit initial sur la valeur d’entrée, ce qui nous donne la valeur de sortie ainsi que le nouveau circuit, sur lequel on appliquera first, récursivement.

La fonction runCircuit suivante permet d’exécuter un circuit, c’est-à-dire d’appliquer le circuit sur tous les éléments de l’entrée, tout en mettant à jour successivement le circuit lui-même :

runCircuit :: Circuit a b -> [a] -> [b]
runCircuit _ [] = []
runCircuit (Circuit f) (a:as) =
  let (cir, b) = f a
  in b : runCircuit cir as

Enfin, on peut définir des fonctions pour construire des circuits. Par exemple, pour accumuler le résultat d’un calcul tout en produisant des sorties et tout au long des entrées :

accum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b
accum acc f = Circuit $ \a ->
  let (b, acc') = f a acc
      cir = accum acc' f
  in (cir, b)

Et si l’accumulateur correspond directement aux sorties produites :

accum_ :: b -> (a -> b -> b) -> Circuit a b
accum_ acc f = accum acc (\a b -> let b' = f a b in (b', b'))

Exemples d’utilisation :

ghci> runCircuit (accum_ 0 (+)) [1,1,1]
[1,2,3]

ghci> runCircuit (accum_ 0 (+)) [1,2,3,4]
[1,3,6,10]

Exemple 1

Dans ce premier exemple, on va calculer quelques mesures statistiques basiques sur une entrée. On a déjà vu comment calculer la somme, en utilisant la fonction accum_ :

sumC :: Num a => Circuit a a
sumC = accum_ 0 (+)

ghci> xs = [2, 3, 1::Int]

ghci> runCircuit sumC xs
[2,5,6]

Pour calculer la taille de l’entrée, on peut définir une arrow qui ignore la valeur en entrée et retourne 1 à la place, et la composer avec l’arrow sumC :

lengthC :: Num b => Circuit a b
lengthC = arr (const 1) >>> sumC
-- ou: lengthC = const 1 ^>> sumC

ghci> runCircuit lengthC xs
[1,2,3]

Le calcul de la moyenne est très naturel : on calcule la somme et la taille, et on divise. Avec la notation do des arrows, cela donne :

meanC1 :: Fractional a => Circuit a a
meanC1 = proc input -> do
    s <- sumC -< input
    n <- lengthC -< input
    returnA -< (s / n)

ghci> runCircuit meanC1 xs
[2.0,2.5,2.0]

Et avec les opérateurs :

meanC2 :: Fractional a => Circuit a a
meanC2 = sumC &&& lengthC >>^ uncurry (/)

Exemple 1, avec Yampa

La bibliothèque Yampa implémente le type SF, qui ressemble un peu au type Circuit précédent, et instancie également Arrow. On peut notamment l’utiliser pour implémenter notre exemple de mesures statistiques.

Pour calculer la somme, on utilise la fonction sscan, là où on utilisait accum_ précédemment :

sumSF :: Num a => SF a a
sumSF = sscan (+) 0

ghci> xs = deltaEncode 0 [2, 3, 1::Int]

ghci> embed sumSF xs
[2,5,6]

La fonction embed permet de tester nos arrows sur des entrées prédéfinies.

Pour la taille, on utilise les fonctionnalités des arrows, d’où un code très similaire à celui de la section précédente :

lengthSF :: Num b => SF a b
lengthSF = const 1 ^>> sumSF

ghci> embed lengthSF xs
[1,2,3]

Idem pour la moyenne, en notation do :

meanSF1 :: Fractional a => SF a a
meanSF1 = proc input -> do
    s <- sumSF -< input
    n <- lengthSF -< input
    returnA -< (s / n)

ghci> ys = deltaEncode 0 [2, 3, 1::Double]

ghci> embed meanSF1 ys
[2.0,2.5,2.0]

Et avec les opérateurs :

meanSF2 :: Fractional a => SF a a
meanSF2 = sumSF &&& lengthSF >>^ uncurry (/)

Exemple 2, avec Yampa

Pour ce dernier exemple, on va implémenter le “guessing game” suivant. L’ordinateur choisit aléatoirement un nombre entre 0 et 100. Le joueur a 7 tentatives pour deviner le nombre. À chaque tentative, l’ordinateur indique si le nombre proposé est trop petit, trop grand ou si c’est le bon nombre.

On va utiliser de nouveau la bibliothèque Yampa mais contrairement à l’exemple basique précédent, on a désormais des interactions avec l’utilisateur : en entrée, on saisit les nombres qu’il va proposer, et en sortie, on lui affiche les indications de jeu (trop petit, trop grand, gagné, perdu). Pour cela, Yampa fournit la fonction réactimate suivante :

reactimate 
    :: IO a                             -- initialisation
    -> (Bool -> IO (DTime, Maybe a))    -- lire une entrée
    -> (Bool -> b -> IO Bool)           -- écrire une sortie
    -> SF a b                           -- fonction principale
    -> IO ()

Autrement dit, on a essentiellement à définir nos fonctions d’entrée/sortie (les interactions avec le joueur), définir la fonction principale (logique de jeu) et appeler reactimate.

On commence par définir quelques paramètres et type pour décrire le jeu :

maxTries, minGuess, maxGuess :: Int
maxTries = 7
minGuess = 0
maxGuess = 100

data GameStatus 
    = TooLow
    | TooHigh 
    | Win 
    | Lose 
    deriving (Eq, Show)

On définit un type Sample, représentant une entrée du joueur. Ici ce type correspond à un Maybe Int car le joueur doit entrer un nombre au clavier mais peut éventuellement faire des erreurs de saisie. On définit également l’entrée initiale du jeu (pas de nombre) et une fonction pour lire la prochaine entrée (saisir une ligne et essayer de la convertir en nombre) :

newtype Sample = Sample { _input :: Maybe Int }

initialSample :: IO Sample
initialSample = return (Sample Nothing)

nextSample :: Bool -> IO (DTime, Maybe Sample)
nextSample _ = do
    input <- readMaybe <$> getLine
    return (0, Just (Sample input))

Comme le jeu fonctionne en tour-à-tour, on peut ignorer la gestion du temps (par exemple, en datant tous les échantillons par \(t=0\)).

Pour les sorties, on affiche l’état du jeu et une invite pour la prochaine entrée, si le jeu n’est pas terminé. La fonction retourne un booléen indiquant si l’application est terminée ou non :

outputResult :: Bool -> (Int, Maybe GameStatus) -> IO Bool
outputResult _ (tries, mRes) = do
    forM_ mRes print
    if mRes == Just Win || mRes == Just Lose
        then return True
        else do
            putStrLn $ "\nnumber (" ++ show (maxTries - tries) ++ " lives)?"
            return False

Enfin, pour la fonction de jeu principale, on définit une arrow qui prend une entrée (Sample) et retourne le nombre de tentatives et l’état du jeu. Ici, le jeu est très simple donc l’arrow se résume à compter les entrées valides et à les comparer avec le nombre à trouver :

guess :: Int -> SF Sample (Int, Maybe GameStatus)
guess target = proc (Sample input) -> do
    let countInput x = if isNothing x then 0 else 1
    totalTries <- sscan (+) 0 -< countInput input
    let result = updateResult target totalTries <$> input
    returnA -< (totalTries, result)

updateResult :: Int -> Int -> Int -> GameStatus
updateResult target tries nb
    | nb == target      = Win
    | tries >= maxTries = Lose
    | nb < target       = TooLow
    | otherwise         = TooHigh

La fonction main se résume à choisir un nombre aléatoirement et à appeler reactimate sur les fonctions précédentes :

main :: IO ()
main = do
    target <- randomRIO (minGuess, maxGuess)
    reactimate initialSample nextSample outputResult (guess target)

Exemple d’exécution :

number (7 lives)?
50
TooHigh

number (6 lives)?
25
TooLow

...

number (3 lives)?
35
Win

Pour une implémentation avec le type Circuit, voir le fichier guess-circuit.hs.

Conclusion

Le type Circuit permet de lire un flux d’entrée et de produire un flux de sortie tout en s’adaptant dynamiquement. Il profite avantageusement des fonctionnalités sur les arrows.

La bibliothèque Yampa est également basée sur ce principe. Ici, on a vu des exemples simples, notamment un jeu en tour-à-tour avec un seul type d’entrée mais Yampa permet des applications beaucoup plus complexes, ce qui sera l’objet du prochain article.

Voir aussi :

• Haskell/Arrow tutorial
• Programming with Arrows
• Yampa: Elegant Functional Reactive Programming Language for Hybrid Systems