nested - How to implement “efficient generalized fold” in F#? -

in paper of martin et al. read efficient generalized folds nestet data types. paper talks haskell , want try in f#.

so far managed follow nest example including implementation of gfold.

type pair<'a> = 'a * 'a type nest<'a> = nil | cons of 'a * nest<pair<'a>>  let example =     cons(1,         cons((2, 3),             cons(((4, 5), (6, 7)),                 nil             )         )     )  let pair (f:'a -> 'b) ((a, b):pair<'a>) : pair<'b> = f a, f b  let rec nest<'a, 'r> (f:'a -> 'r) : nest<'a> -> nest<'r> = function     | nil -> nil     | cons(x, xs) -> cons(f x, nest (pair f) xs)  //val gfold : e:'r -> f:('a * 'r -> 'r) -> g:(pair<'a> -> 'a) -> _arg1:nest<'a> -> 'r let rec gfold e f g : nest<'a> -> 'r = function     | nil -> e     | cons(x, xs) ->         f(x, gfold e f g (nest g xs))  let uncurry f (a, b) = f b  let = uncurry (+)  let sum = example |> gfold 0 up 

unfortunately, gfold seems have quadratic complexity , that's why authors came efold. can guess, that's 1 couldn't working. after fiddling many type annotations, came version has tiny squiggle left:

let rec efold<'a, 'b, 'r> (e:'r) (f:'a * 'r -> 'r) (g:(pair<'a> -> pair<'a>) -> 'a -> 'a) (h:_) (nest:nest<'a>) : 'r =     match nest     | nil -> e     | cons(x, xs) -> f(h x, efold e f g ((g << pair) h) xs)                                                         ^^ 

the remaining unspecified type 1 of h. compiler infers val h : ('a -> 'a) think there need different types.

the error message provided reads

error type mismatch. expecting a
nest<'a>
given a
nest<pair<'a>>
resulting type infinite when unifying ''a' , 'pair<'a>'

with correct type of h error should vanish. don't understand enough haskell translate f#.

see this discussion possible typo in paper.

---

update: understand kvb's answer:

so h transforms input type intermediate type, in regular fold accumulator may of different type. g used reduce 2 intermediate typed values 1 while f gets intermediate type , input type produce output typed values. of course e of output type.

h indeed directly applied values encountered during recursion. g on other hand used make h applicable progressively deeper types.

just looking @ first f examples, doesn't seem work apart applying h , fuelling recursion. in sophisticated approach can see important 1 wrt. comes out, i.e. it's work horse.

is right?

the correct definition of efold in haskell like:

efold :: forall n m b.     (forall a. n a)->     (forall a.(m a, n (pair a)) -> n a)->     (forall a.pair (m a) -> m (pair a))->     (forall a.(a -> m b) -> nest -> n b)  efold e f g h nil = e  efold e f g h (cons (x,xs)) = f (h x, efold e f g (g . pair h) xs 

this can't translated f# in full generality because n , m "higher-kinded types" - type constructors create type when given argument - aren't supported in f# (and have no clean representation in .net).

interpretation

your update asks how interpret arguments fold. perhaps easiest way see how fold works expand out happens when apply fold example. this:

efold e f g h example ≡     f (h 1, f ((g << pair h) (2, 3), f ((g << pair (g << pair h)) ((4,5), (6,7)), e))) 

so h maps values type can serve f 's first agument. g used apply h more nested pairs (so can go using h function of type a -> m b pair -> m (pair b) pair (pair a) -> m (pair (pair b)) etc.), , f repeatedly applied spine combine results of h results of nested calls f. finally, e used once, serve seed of nested call f.

i think explanation agrees you've deduced. f critical combining results of different layers. g matters, too, since tells how combine pieces within layer (e.g. when summing nodes, needs sum left , right nested sums; if wanted use fold build new nest values @ each level reversed of input, use g looks fun (a,b) -> b,a).

simple approach

one option create specialized implementations of efold each n, m pair care about. example, if want sum lengths of lists contained in nest n _ , m _ both int. can generalize slightly, case n _ , m _ don't depend on arguments:

let rec efold<'n,'m,'a> (e:'n) (f:'m*'n->'n) (g:pair<'m> -> 'm) (h:'a->'m) : nest<'a> -> 'n = function | nil -> e | cons(x,xs) -> f (h x, efold e f g (g << (pair h)) xs)  let total = efold 0 up id example 

on other hand, if n , m use arguments, you'd need define separate specialization (plus, may need create new types each polymorphic argument, since f#'s encoding of higher-rank types awkward). instance, collect nest's values list want n 'a = list<'a> , m 'b = 'b. instead of defining new types argument type of e can observe value of type forall 'a.list<'a> [], can write:

type listidf =     abstract apply : 'a * list<pair<'a>> -> list<'a>  type listidg =     abstract apply : pair<'a> -> pair<'a>  let rec efold<'a,'b> (f:listidf) (g:listidg) (h:'a -> 'b) : nest<'a> -> list<'b> = function | nil -> [] | cons(x,xs) -> f.apply(h x, efold f g (pair h >> g.apply) xs)  let tolist n = efold { new listidf member __.apply(a,l) = a::(list.collect (fun (x,y) -> [x;y]) l) } { new listidg member __.apply(p) = p } id n 

sophisticated approach

while f# doesn't directly support higher-kinded types, turns out it's possible simulate them in faithful way. approach taken higher library. here's minimal version of like.

we create type app<'t,'a> represent type application t<'a>, we'll create dummy companion type can serve first type argument app<_,_>:

type app<'f, 't>(token : 'f, value : obj) =              if obj.referenceequals(token, unchecked.defaultof<'f>)             raise <| new system.invalidoperationexception("invalid token")      // apply secret token have access encapsulated value     member self.apply(token' : 'f) : obj =         if not (obj.referenceequals(token, token'))             raise <| new system.invalidoperationexception("invalid token")         value  

now can define companion types type constructors care (and these can live in shared library):

// app<const<'a>, 'b> represents value of type 'a (that is, ignores 'b) type const<'a> private () =     static let token = const ()     static member inj (value : 'a) =         app<const<'a>, 'b>(token, value)     static member prj (app : app<const<'a>, 'b>) : 'a =         app.apply(token) :?> _  // app<list, 'a> represents list<'a> type list private () =      static let token = list()     static member inj (value : 'a list) =         app<list, 'a>(token, value)     static member prj (app : app<list, 'a>) : 'a list =         app.apply(token) :?> _  // app<id, 'a> represents plain 'a type id private () =     static let token = id()     static member inj (value : 'a) =         app<id, 'a>(token, value)     static member prj (app : app<id, 'a>) : 'a =         app.apply(token) :?> _  // app<nest, 'a> represents nest<'a> type nest private () =     static let token = nest()     static member inj (value : nest<'a>) =         app<nest, 'a>(token, value)     static member prj (app : app<nest, 'a>) : nest<'a> =         app.apply(token) :?> _ 

now can define higher-rank types arguments of efficient fold once , all:

// forall a. n type e<'n> =     abstract apply<'a> : unit -> app<'n,'a>  // forall a.(m a, n (pair a)) -> n a) type f<'m,'n> =     abstract apply<'a> : app<'m,'a> * app<'n,'a*'a> -> app<'n,'a>  // forall a.pair (m a) -> m (pair a)) type g<'m> =     abstract apply<'a> : app<'m,'a> * app<'m,'a> -> app<'m,'a*'a> 

so fold just:

let rec efold<'n,'m,'a,'b> (e:e<'n>) (f:f<'m,'n>) (g:g<'m>) (h:'a -> app<'m,'b>) : nest<'a> -> app<'n,'b> = function | nil -> e.apply() | cons(x,xs) -> f.apply(h x, efold e f g (g.apply << pair h) xs) 

now call efold need sprinkle in calls various inj , prj methods, otherwise looks we'd expect:

let tolist n =      efold { new e<_> member __.apply() = list.inj [] }            { new f<_,_> member __.apply(m,n) = id.prj m :: (n |> list.prj |> list.collect (fun (x,y) -> [x;y])) |> list.inj }           { new g<_> member __.apply(m1,m2) = (id.prj m1, id.prj m2) |> id.inj }           id.inj           n     |> list.prj  let sumelements n =     efold { new e<_> member __.apply() = const.inj 0 }           { new f<_,_> member __.apply(m,n) = const.prj m + const.prj n |> const.inj }           { new g<_> member __.apply(m1,m2) = const.prj m1 + const.prj m2 |> const.inj }           const.inj           n     |> const.prj  let reverse n =      efold { new e<_> member __.apply() = nest.inj nil }           { new f<_,_> member __.apply(m,n) = cons(id.prj m, nest.prj n) |> nest.inj }           { new g<_> member __.apply(m1,m2) = (id.prj 2, id.prj m1) |> id.inj }           id.inj           n     |> nest.prj 

hopefully pattern here clear: in each object expression, application method projects out each argument, operates on them, , injects result app<_,_> type. inline magic, can make more consistent (at cost of few type annotations):

let inline (|prj|) (app:app< ^t, 'a>) = (^t : (static member prj : app< ^t, 'a> -> 'b) app) let inline prj (prj x) = x let inline inj x = (^t : (static member inj : 'b -> app< ^t, 'a>) x)  let tolist n =      efold { new e<list> member __.apply() = inj [] }            { new f<id,_> member __.apply(prj m, prj n) = m :: (n |> list.collect (fun (x,y) -> [x;y])) |> inj }           { new g<_> member __.apply(prj m1,prj m2) = (m1, m2) |> inj }           inj           n     |> prj  let sumelements n =     efold { new e<const<_>> member __.apply() = inj 0 }           { new f<const<_>,_> member __.apply(prj m, prj n) = m + n |> inj }           { new g<_> member __.apply(prj m1,prj m2) = m1 + m2 |> inj }           inj           n     |> prj  let reverse n =      efold { new e<_> member __.apply() = nest.inj nil }           { new f<id,_> member __.apply(prj m,prj n) = cons(m, n) |> inj }           { new g<_> member __.apply(prj m1,prj m2) = (m2, m1) |> inj }           inj           n     |> prj