Merge pull request #20 from sgmap/trees-with-daggy
Exploration d'idiomes fonctionnels pour le traitement d'arbrespull/41/merge
Laurent Bossavit
GitHub
commit
4fb2bf8c21
|
|
@ -36,6 +36,7 @@
|
|||
"yaml-loader": "^0.5.0"
|
||||
},
|
||||
"devDependencies": {
|
||||
"akh": "^3.1.2",
|
||||
"autoprefixer": "^7.1.1",
|
||||
"babel-cli": "^6.24.1",
|
||||
"babel-core": "^6.24.1",
|
||||
|
|
@ -54,8 +55,12 @@
|
|||
"core-js": "^2.4.1",
|
||||
"css-loader": "^0.28.1",
|
||||
"eslint": "^4.4.1",
|
||||
"daggy": "^1.1.0",
|
||||
"eslint-plugin-react": "^7.0.1",
|
||||
"express": "^4.15.3",
|
||||
"fantasy-combinators": "0.0.1",
|
||||
"fantasy-land": "^3.3.0",
|
||||
"fantasy-tuples": "^1.0.0",
|
||||
"file-loader": "^0.11.1",
|
||||
"html-loader": "^0.5.1",
|
||||
"img-loader": "^2.0.0",
|
||||
|
|
@ -65,6 +70,7 @@
|
|||
"mocha-webpack": "^0.7.0",
|
||||
"nearley-loader": "0.0.2",
|
||||
"postcss-loader": "^2.0.5",
|
||||
"ramda-fantasy": "^0.8.0",
|
||||
"react-hot-loader": "^3.0.0-beta.6",
|
||||
"redux-devtools": "^3.4.0",
|
||||
"redux-devtools-dock-monitor": "^1.1.2",
|
||||
|
|
|
|||
|
|
@ -0,0 +1,428 @@
|
|||
import R from 'ramda'
|
||||
import {expect} from 'chai'
|
||||
import daggy from 'daggy'
|
||||
import {Maybe as M} from 'ramda-fantasy'
|
||||
import {StateT, Writer} from 'akh'
|
||||
|
||||
describe('simplified tree walks', function() {
|
||||
|
||||
// Notre domaine peut se simplifier à une liste d'équations à trous:
|
||||
// a: 45
|
||||
// b: a + c
|
||||
// d: a + 4
|
||||
// e: b + d
|
||||
// Disons que je veux connaitre "e", alors il va me manquer "c"
|
||||
// Si je connais "c", alors je peux calculer "e"
|
||||
// Et mon ambition est aussi de pouvoir visualiser le calcul en HTML
|
||||
// Donc j'ai une structure plate que je transforme en arbre (ce n'est pas
|
||||
// le focus de la présente exploration), je veux pouvoir demander des choses
|
||||
// diverses à cet arbre: l'évaluer, repérer les trous, le transformer en HTML
|
||||
|
||||
// Plus tard je vais avoir des trucs plus sophistiqués, par exemple:
|
||||
// b: a + (bleu: b, vert: c)
|
||||
// qui est équivalent à:
|
||||
// b: b-bleu + b-vert
|
||||
// b-bleu: a + b
|
||||
// b-vert: a + c
|
||||
// Le but du jeu est de pouvoir le représenter de façon compacte, mais
|
||||
// d'avoir un arbre simple à manipuler
|
||||
|
||||
// Pour intégrer dans le simulateur, il faut remplir les exigences
|
||||
// suivantes:
|
||||
// X décorer l'arbre avec une valeur à chaque noeud
|
||||
// X réaliser le calcul de façon efficiente (1 fois par variable)
|
||||
// - savoir "court-circuiter" le calcul de variables manquantes dans les conditionnelles
|
||||
// - avoir un moyen de gérer les composantes et filtrage
|
||||
|
||||
// Ce qu'on décrit est un framework de programmation déclarative: on stipule des
|
||||
// définitions (salaire net = brut - cotisations) mais on les donne sans ordre
|
||||
// impératif, on laisse au moteur le soin de calculer les dépendances
|
||||
|
||||
// Chaque élément de notre base de règles est une définition:
|
||||
|
||||
const Def = daggy.taggedSum('Def', {
|
||||
Assign: ['name', 'expr']
|
||||
})
|
||||
const {Assign} = Def
|
||||
|
||||
// Par contre, à l'exécution, il faut bien calculer des "effets de bord"
|
||||
// pour rester performant: chaque évaluation d'une définition doit mettre
|
||||
// à jour le 'dictionnaire' des valeurs connues, puis le mettre à disposition
|
||||
// de la suite du calcul - on verra comment au Chapitre 3
|
||||
|
||||
// La partie droite d'une définition est une expression:
|
||||
|
||||
const Expr = daggy.taggedSum('Expr',{
|
||||
Num: ['x'],
|
||||
Add: ['x', 'y'],
|
||||
Var: ['name']
|
||||
// NotIf: ['condition','formule'],
|
||||
// OnlyIf: ['condition','formule'],
|
||||
// AnyOf: ['conditions'],
|
||||
// AllOf: ['conditions'],
|
||||
})
|
||||
const {Num, Add, Var} = Expr
|
||||
|
||||
// Chapitre 1...
|
||||
|
||||
// Le type Expr est la traduction en JS du type suivant en Haskell,
|
||||
// "naivement récursif":
|
||||
// data Expr = Num Int | Var String | Add Expr Expr
|
||||
|
||||
// Il se trouve qu'on peut gagner beaucoup en introduisant une petite
|
||||
// complexité: on va exprimer la récursion avec un niveau d'indirection,
|
||||
// la première étape étant de rendre le type polymorphique sur ce qui
|
||||
// est récursif:
|
||||
|
||||
// data ExprF r = Num Int | Var String | Add r r
|
||||
|
||||
// Par exemple, une addition de deux additions c'est de type ExprF (ExprF r),
|
||||
// et si je veux décrire des imbrications plus poussées d'additions dans
|
||||
// des additions il me faudra un ExprF (ExprF (ExprF r)) et ainsi de
|
||||
// suite: on a "déroulé" la récursion dans le type d'origine.
|
||||
|
||||
// On peut alors retrouver le type d'origine en introduisant un
|
||||
// "constructeur de point fixe de type", appelé Fx, et en introduisant
|
||||
// ce qu'on appelle un "functor type" (c'est le suffixe F)
|
||||
|
||||
// data Expr = Fx ExprF
|
||||
|
||||
// Le point fixe de f est une solution à l'équation x = f x - on
|
||||
// peut l'appliquer à des fonctions récursives, voir par exemple:
|
||||
// https://www.vex.net/~trebla/haskell/fix.xhtml
|
||||
|
||||
// En JS ça ne marche pas parce que JS est strict et non lazy...
|
||||
|
||||
// Quand au point fixe d'un type, c'est le point fixe de son
|
||||
// constructeur: une solution à l'équation T = Fx T
|
||||
|
||||
// En JS c'est juste une fonction qui emballe et une qui déballe:
|
||||
|
||||
const Fx = daggy.tagged('Fx',['x'])
|
||||
Fx.prototype.project = function() { return this.x }
|
||||
const unFix = fx => fx.project()
|
||||
|
||||
// Les helpers suivants rendent moins pénible la construction de valeurs
|
||||
// notamment pour les tests
|
||||
|
||||
let num = x => Fx(Num(x))
|
||||
let add = (x, y) => Fx(Add(x,y))
|
||||
let ref = (name) => Fx(Var(name))
|
||||
|
||||
// Une application de la théorie des catégories permet de dériver
|
||||
// la fonction "fold" suivante, qui généralise aux structures récursives
|
||||
// la notion de "reduction" (comme pour les listes), on l'appelle aussi
|
||||
// un catamorphisme
|
||||
|
||||
// fold :: Functor f => (f a -> a) -> Fix f -> a
|
||||
const fold = R.curry((algebra, x) => R.compose(algebra, R.map(fold(algebra)), unFix)(x))
|
||||
|
||||
// Cf. https://www.schoolofhaskell.com/user/bartosz/understanding-algebras
|
||||
|
||||
// Dans ce contexte, un "algebre" est une fonction qui nous dit comment calculer
|
||||
// la réduction pour un noeud à partir des valeurs calculées pour les noeuds fils
|
||||
|
||||
// Cette fonction fournit la traversée
|
||||
Expr.prototype.map = function(f) {
|
||||
return this.cata({
|
||||
Num: (x) => this, // fixed
|
||||
Add: (x, y) => Add(f(x), f(y)),
|
||||
Var: (name) => this
|
||||
})
|
||||
}
|
||||
|
||||
// Celle-ci l'évaluation
|
||||
const evaluator = state => a => {
|
||||
return a.cata({
|
||||
Num: (x) => M.Just(x),
|
||||
Add: (x, y) => R.lift(R.add)(x,y),
|
||||
Var: (name) => M.toMaybe(state[name]) // Doesn't typecheck
|
||||
})
|
||||
}
|
||||
|
||||
let evaluate = (expr, state={}) =>
|
||||
fold(evaluator(state), expr)
|
||||
.getOrElse(null) // for convenience
|
||||
|
||||
// Voici donc l'évaluation d'un arbre...
|
||||
|
||||
it('should provide a protocol for evaluation', function() {
|
||||
let tree = num(45),
|
||||
result = evaluate(tree)
|
||||
expect(result).to.equal(45)
|
||||
});
|
||||
|
||||
it('should evaluate expressions', function() {
|
||||
let tree = add(num(45),num(25)),
|
||||
result = evaluate(tree)
|
||||
expect(result).to.equal(70)
|
||||
});
|
||||
|
||||
it('should evaluate nested expressions', function() {
|
||||
let tree = add(num(45),add(num(15),num(10))),
|
||||
result = evaluate(tree)
|
||||
expect(result).to.equal(70)
|
||||
});
|
||||
|
||||
// Problème: on évalue l'arbre tout entier d'un seul coup; mais
|
||||
// peut-on aussi "décorer" l'arbre pendant sa traversée avec les
|
||||
// valeurs intermédiaires ? On verra que oui, au Chapitre 2; en
|
||||
// attendant on voudrait aussi savoir quelles sont les variables
|
||||
// manquantes...
|
||||
|
||||
const collector = state => a => {
|
||||
return a.cata({
|
||||
Num: (x) => [],
|
||||
Add: (x, y) => R.concat(x,y),
|
||||
Var: (name) => state[name] ? [] : [name]
|
||||
})
|
||||
}
|
||||
|
||||
let missing = (expr, state={}) =>
|
||||
fold(collector(state), expr)
|
||||
|
||||
it('should evaluate expressions involving variables', function() {
|
||||
let tree = add(num(45),ref("a")),
|
||||
result = evaluate(tree,{a:25})
|
||||
expect(result).to.equal(70)
|
||||
});
|
||||
|
||||
it('should evaluate expressions involving missing variables', function() {
|
||||
let tree = add(num(45),ref("b")),
|
||||
result = evaluate(tree,{a:25})
|
||||
expect(result).to.equal(null)
|
||||
});
|
||||
|
||||
it('should provide a protocol for missing variables', function() {
|
||||
let tree = ref("a"),
|
||||
result = missing(tree)
|
||||
expect(result).to.deep.equal(["a"])
|
||||
});
|
||||
|
||||
it('should locate missing variables in expressions', function() {
|
||||
let tree = add(num(45),ref("a")),
|
||||
result = missing(tree)
|
||||
expect(result).to.deep.equal(["a"])
|
||||
});
|
||||
|
||||
it('should locate missing variables in nested expressions', function() {
|
||||
let tree = add(add(num(35),ref("a")),num(25)),
|
||||
result = missing(tree)
|
||||
expect(result).to.deep.equal(["a"])
|
||||
});
|
||||
|
||||
it('should locate missing variables in nested expressions', function() {
|
||||
let tree = add(add(num(35),ref("a")),num(25)),
|
||||
result = missing(tree,{a:25})
|
||||
expect(result).to.deep.equal([])
|
||||
});
|
||||
|
||||
// Chapitre 2...
|
||||
|
||||
// Pour annoter l'arbre avec les valeurs intermédiaires on utilise un
|
||||
// type "Cofree Comonad": ce sont des paires (fst,snd) dont la première
|
||||
// valeur est un noeud de l'arbre et la seconde l'annotation; on a un
|
||||
// constructeur ann et une fonction de lecture
|
||||
|
||||
// Cf https://github.com/willtim/recursion-schemes/
|
||||
// or http://www.timphilipwilliams.com/slides/HaskellAtBarclays.pdf
|
||||
|
||||
const AnnF = daggy.tagged('AnnF',['fr','a'])
|
||||
let ann = ({fst, snd}) => Fx(AnnF(fst,snd))
|
||||
let nodeValue = annf => {
|
||||
let {fr, a} = unFix(annf)
|
||||
return a
|
||||
}
|
||||
|
||||
// fork est l'opérateur "&&&" de Haskell: (f &&& g) x = Pair(f(x),g(x))
|
||||
let fork = (f, g) => x => ({fst:f(x), snd:g(x)})
|
||||
|
||||
// synthesize combine l'application d'un algèbre fourni f et de l'annotation
|
||||
let synthesize = f => {
|
||||
let algebra = f => R.compose(ann, fork(R.identity, R.compose(f, R.map(nodeValue))))
|
||||
return fold(algebra(f))
|
||||
}
|
||||
|
||||
let annotate = (state, tree) => synthesize(evaluator(state))(tree)
|
||||
|
||||
it('should annotate tree with evaluation results', function() {
|
||||
let tree = add(num(45),add(num(15),num(10))),
|
||||
result = nodeValue(annotate({},tree)).getOrElse(null)
|
||||
expect(result).to.equal(70)
|
||||
});
|
||||
|
||||
// Chapitre 3
|
||||
|
||||
// On sait evaluer des expressions, il faut aussi être capable de
|
||||
// gérer les règles définissant les variables appelées dans ces
|
||||
// expressions; voyons ce que ça donne avec un algèbre plus simple:
|
||||
|
||||
let calculate = R.curry((rules, name) => {
|
||||
let find = (rules, name) => R.find(x => R.prop("name",x) == name,rules).expr,
|
||||
expr = find(rules, name)
|
||||
return fold(evaluator2(calculate(rules)), expr)
|
||||
})
|
||||
|
||||
const evaluator2 = calculate => a => {
|
||||
return a.cata({
|
||||
Num: (x) => x,
|
||||
Add: (x, y) => x+y,
|
||||
Var: (name) => calculate(name)
|
||||
})
|
||||
}
|
||||
|
||||
it('should resolve variable dependencies', function() {
|
||||
let rule1 = Assign("a",add(ref("b"),ref("b"))),
|
||||
rule2 = Assign("b",num(15)),
|
||||
rules = [rule1,rule2],
|
||||
result = calculate(rules,"a")
|
||||
expect(result).to.equal(30)
|
||||
});
|
||||
|
||||
// Utilisons un Writer (un idiome fonctionnel pour par exemple écrire des logs)
|
||||
// pour examiner le calcul de plus près.
|
||||
|
||||
const Str = daggy.tagged("Str",['s'])
|
||||
Str.zero = Str("")
|
||||
Str.prototype.zero = Str.zero
|
||||
Str.prototype.concat = function(b) { return Str(this.s+b.s)}
|
||||
|
||||
let trace = R.curry((rules, name) => {
|
||||
let find = (rules, name) => R.find(x => R.prop("name",x) == name,rules).expr,
|
||||
expr = find(rules, name)
|
||||
return fold(tracer(trace(rules)), expr)
|
||||
})
|
||||
|
||||
const tracer = recurse => a => {
|
||||
let log = (x, s) => Writer.tell(Str(s)).map(_ => x)
|
||||
return a.cata({
|
||||
Num: (x) => log(x, x+","),
|
||||
Add: (x, y) => x.chain(xx => y.chain(yy => log(xx+yy,"+,"))),
|
||||
Var: (name) => recurse(name).chain(x => log(x,name+","))
|
||||
})
|
||||
}
|
||||
|
||||
// On voit qu'on a calculé la valeur de b 2 fois! Ce n'est pas utile,
|
||||
// puisque cette valeur ne changera pas au cours du calcul; et comme on
|
||||
// répète le calcul autant de fois qu'il y a de références à une variable
|
||||
// donnée, si l'arbre est un tant soit peu complexe les performances seront
|
||||
// très mauvaises.
|
||||
|
||||
it('should trace the shape of the computation', function() {
|
||||
let rule1 = Assign("a",add(ref("b"),ref("b"))),
|
||||
rule2 = Assign("b",num(15)),
|
||||
rules = [rule1,rule2],
|
||||
result = trace(rules,"a").run(Str.zero)
|
||||
expect(result.value).to.equal(30)
|
||||
expect(result.output.s).to.equal("15,b,15,b,+,")
|
||||
});
|
||||
|
||||
// Pour corriger ce problème on va avoir besoin de formuler une version
|
||||
// "monadique" du catamorphisme, c'est-à-dire qu'on va pouvoir l'associer
|
||||
// à un contexte (ou monade) dans lequel tout le calcul va se dérouler,
|
||||
// et qui va pouvoir accumuler des informations au fur et à mesure, par
|
||||
// exemple un cache des variables déjà calculées.
|
||||
|
||||
// On a déjà vu un exemple de monade, c'était Writer: voyons comment on
|
||||
// reformule le catamorphisme pour qu'il se déroule dans la monade Writer.
|
||||
// L'implémentation de cataM est inspirée de
|
||||
// https://github.com/DrBoolean/excursion/
|
||||
// D'abord on ajoute de la plomberie:
|
||||
|
||||
const cataM = (of, algM) => m =>
|
||||
m.project()
|
||||
.traverse(of, x => x.cataM(of, algM))
|
||||
.chain(algM)
|
||||
|
||||
const traverse = function(of, f) {
|
||||
return this.cata({
|
||||
Num: (x) => of(this),
|
||||
Add: (x, y) => f(x).chain(xx => f(y).chain(yy => of(Add(xx,yy)))),
|
||||
Var: (name) => of(this)
|
||||
})
|
||||
}
|
||||
Expr.prototype.traverse = traverse
|
||||
Fx.prototype.cataM = function(of, alg) { return cataM(of, alg)(this) }
|
||||
|
||||
// Maintenant que c'est fait on voit qu'on a simplifié l'expression du
|
||||
// catamorphisme: on n'a plus à expliciter l'enchaînement (sauf pour la
|
||||
// récursion de plus haut niveau dans les variables)
|
||||
|
||||
let trace2 = R.curry((rules, name) => {
|
||||
let find = (rules, name) => R.find(x => R.prop("name",x) == name,rules).expr,
|
||||
expr = find(rules, name)
|
||||
return cataM(Writer.of, tracer2(trace2(rules)))(expr)
|
||||
})
|
||||
|
||||
const tracer2 = recurse => a => {
|
||||
let log = (x, s) => Writer.tell(Str(s)).map(_ => x)
|
||||
return a.cata({
|
||||
Num: (x) => log(x,x+","),
|
||||
Add: (x, y) => log(x+y,"+,"),
|
||||
Var: (name) => recurse(name).chain(x => log(x,name+","))
|
||||
})
|
||||
}
|
||||
|
||||
it('should trace the shape of the computation, showing two passes through b', function() {
|
||||
let rule1 = Assign("a",add(ref("b"),ref("c"))),
|
||||
rule2 = Assign("b",num(15)),
|
||||
rule3 = Assign("c",num(10)),
|
||||
rules = [rule1,rule2,rule3],
|
||||
result = trace2(rules,"a").run(Str.zero)
|
||||
expect(result.value).to.equal(25)
|
||||
expect(result.output.s).to.equal("15,b,10,c,+,")
|
||||
});
|
||||
|
||||
// On a la possibilité "d'encapsuler" une monade dans une autre:
|
||||
// on va se doter d'un State, une monade qui permet de stocker un
|
||||
// état et de le modifier en le propageant dans tout le calcul, et
|
||||
// conserver Writer à l'intérieur (on utilise la variante StateT,
|
||||
// le T veut dire "transformation de monade")
|
||||
|
||||
// On peut aller plus loin et mémoiser le catamorphisme:
|
||||
// https://idontgetoutmuch.wordpress.com/2011/05/15/monadic-caching-folds/
|
||||
// ça ne semble pas nécessaire ici puisque tout se passe au niveau de
|
||||
// la récursion sur "Var"
|
||||
|
||||
const S = StateT(Writer)
|
||||
const log = (x, s) => S.lift(S.inner.tell(Str(s)).map(_ => x))
|
||||
|
||||
let trace3 = R.curry((rules, name) => {
|
||||
let find = (rules, name) => R.find(x => R.prop("name",x) == name,rules).expr,
|
||||
expr = find(rules, name)
|
||||
return cataM(S.of, tracer3(trace3(rules)))(expr)
|
||||
})
|
||||
|
||||
const memoize = f => name => {
|
||||
let cache = result =>
|
||||
result
|
||||
.chain(x => result.modify(state => R.assoc(name,run(result),state))
|
||||
.chain(z => S.of(x)))
|
||||
|
||||
return S.get.chain(state => {
|
||||
let cached = state[name]
|
||||
return cached ?
|
||||
S.of(cached.value.value) : cache(f(name))
|
||||
})
|
||||
}
|
||||
|
||||
const tracer3 = recurse => a => {
|
||||
return a.cata({
|
||||
Num: (x) => log(x,x+","),
|
||||
Add: (x, y) => log(x+y,"+,"),
|
||||
Var: memoize ((name) => recurse(name).chain(x => log(x,name+",")))
|
||||
})
|
||||
}
|
||||
|
||||
const run = (c, state) => Writer.run(StateT.run(c, state),Str.zero)
|
||||
|
||||
it('should trace the shape of the computation, showing one pass through b', function() {
|
||||
let rule1 = Assign("a",add(ref("b"),ref("b"))),
|
||||
rule2 = Assign("b",num(15)),
|
||||
rules = [rule1,rule2],
|
||||
result = run(trace3(rules,"a"),{})
|
||||
expect(result.value.value).to.equal(30)
|
||||
expect(result.output.s).to.equal("15,b,+,")
|
||||
});
|
||||
|
||||
});
|
||||
Loading…
Reference in New Issue