Assume the following mutually recursive structure:
type Tree<'a> =
| Empty
| Node of 'a * 'a Forest
and Forest<'a> =
| Nil
| Cons of 'a Tree * 'a Forest
Goal: Generate the common catamorphisms for this structure: foldl, foldr, foldk.
I have generated the naive-catamorphism as follows:
let rec foldTree fEmpty fNode fNil fCons =
function
| Empty -> fEmpty
| Node (a, f) -> fNode a (foldForest fEmpty fNode fNil fCons f)
and foldForest fEmpty fNode fNil fCons =
function
| Nil -> fNil
| Cons (t, f') -> fCons (foldTree fEmpty fNode fNil fCons t) (foldForest fEmpty fNode fNil fCons f')
How do I go about 'mechanically' generating the tail-recursive foldl (using accumulators) and tail-recursive foldr (using continuations)?
I have been through Scott's Recursive Types and Folds series and I understand how to generate the folds for a recursive structure 'mechanically'. However I cannot find anything on google to do the 'mechanical' thing for recursive data structures.
PS: One can get rid of the mutual-recursion above by in-lining but lets retain it as it represents a simplified version of the mutual recursion in tpetricek's Markdown parser.
I'm totally unsure if that's what you're looking for but this seems to give what you want (sort-of).
The key point being to handle only what is "inside" the type and leaves what is "outside" be handled by something else (some abstraction)
//val foldTree : 'a -> ('b -> 'c -> 'a) -> ('b Forest -> 'c) -> 'b Tree -> 'a
let foldTree fEmpty fNode fForest = function
Empty -> fEmpty
| Node (a, f) -> fNode a (fForest f)
// val foldForest : 'a -> ('b -> 'a -> 'a) -> ('c Tree -> 'b) -> 'c Forest -> 'a
let rec foldForest fNil fCons fTree =
let recurse = foldForest fNil fCons fTree
function
Nil -> fNil
| Cons (t, f) -> fCons (fTree t) (recurse f)
let foldForestAcc fNil fCons fTree =
let rec aux acc = function
Nil -> acc
| Cons (t, f) -> aux (fCons (fTree t) acc) f
aux fNil
let foldForestCont fNil fCons fTree =
let rec aux cont = function
Nil -> cont fNil
| Cons (t, f) -> aux (fCons (fTree t) >> cont) f
aux id
Here is also an alternative if it's more suited to what you seek :
let fold fEmpty fNode fNil fCons =
let rec auxT = function
Empty -> fEmpty
| Node (a, f) -> fNode a (auxF f)
and auxF = function
Nil -> fNil
| Cons (t, f) -> fCons (auxT t) (auxF f)
auxT
let foldAcc fEmpty fNode fNil fCons =
let rec auxT acc = function
Empty -> acc
| Node (a, f) -> fNode a (auxF fNil f)
and auxF acc = function
Nil -> acc
| Cons (t, f) -> auxF (fCons (auxT fEmpty t) acc) f
auxT fEmpty
let foldCont fEmpty fNode fNil fCons =
let rec auxT cont = function
Empty -> cont fEmpty
| Node (a, f) -> cont (fNode a (auxF id f))
and auxF cont = function
Nil -> cont fNil
| Cons (t, f) -> auxF (cont >> fCons (auxT id t)) f
auxT id
Related
I am trying to write methods on arbitrary trees in OCaml. Here is my tree constructor:
type 'a tree =
| Leaf of 'a
| Node of ('a tree) list
I am having trouble with fold_tree:
let rec fold_tree (f : 'b list -> 'b) (g : 'a -> 'b) (t : 'a tree): 'b.
For example, fold_tree sum (fun x -> x) (node [node [leaf 7; leaf 8]; leaf 9])=24
Not sure what you are trying to accomplish here... Is it something like this?
let rec fold_tree f acc (t:'a tree) =
match t with
| Leaf e -> f acc e
| Node l ->
List.fold_left
(
fun a e -> fold_tree f a e
) acc l
Example of usage:
let data = Node [Node [Leaf 7; Leaf 8; Leaf 100]; Leaf 9; Leaf 10;]
let ans = fold_tree (fun a e -> a + e) 0 data
let () = print_endline(string_of_int ans)
I set myself the following challenge (and failed):
I want to write a map functional, map f lofls, that takes a function, f 'a -> 'b and a list of lists, lofls 'a list list and applies the function f on every element of the list of lists. The constraint that I added is that I am not allowed to used nested maps for lists, and I have to do it recursively.
I tried to do it in F# but any language should do. Any ideas?
Edit
Here is my attempt (which works but is ugly and I am not a fan of the use of rev either . . .)
let map f lis =
let rec map2 f lis aux =
match (lis, aux) with
|([], []) -> []
|([], aux) -> [aux]
|(hd::tl, aux) ->
match hd with
|[] -> (List.rev aux) :: (map2 f tl [])
|x::xs -> map2 f (xs::tl) ( (f x) :: aux )
map2 f lis []
(I also realised that this has been posted in a more concise form already)
Lets go step by step, from simple to complex.
This is the signature that you want your map function to have:
('a -> 'b) -> 'a list list -> 'b list list
The simple solution is this:
let map0 (f:'a -> 'b) (lofls:'a list list) : 'b list list = lofls |> List.map (List.map f)
But that one is not recursive and it uses nested maps.
A recursive solution could be this:
let rec map1 (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [] -> []
| l::rest -> (List.map f l) :: map1 f rest
It is recursive although it is still calling List.map in there.
So, here is the next level:
let rec map (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [ ] -> [ ]
| [ ] :: rest -> [ ] :: (rest |> map f)
| ( e::restl ) :: rest ->
match restl :: rest |> map f with
| [ ] -> [ ]
| [ ] :: rest -> [ f e ] :: rest
| ( restl ) :: rest -> ( f e :: restl ) :: rest
Another way:
let rec mapNested f lofls =
match lofls with
| [] -> []
| h::t -> (map f h) :: (mapNested f t)
and map f lst =
match lst with
| [] -> []
| h::t -> (f h) :: (map f t)
If this were a homework question, which I am sure it is not, the answer depends on what constitutes "a nested map for lists".
A construct like map [] (map [] f) can be rewritten with pipelining as f |> map [] |> map [], or with the function composition operator as (map [] >> map []) f, but may be still considered a nested map.
let mapNested f =
let rec map acc g = function
| [] -> List.rev acc
| x::xs -> map (g x::acc) g xs
f |> map [] |> map []
// val mapNested : f:('a -> 'b) -> ('a list list -> 'b list list)
This is the opportunity to demonstrate your grasp of lambda calculus and the Y combinator. Nested passing of the map function as an argument should clearly pass muster.
let rec Y f x = f (Y f) x
let map f acc g = function
| [] -> List.rev acc
| x::xs -> f (g x::acc) g xs
let map1 f =
Y map [] f
// val map1 : f:('a -> 'b) -> ('a list -> 'b list)
let map2 f =
Y map [] f
|> Y map []
// val map2 : f:('a -> 'b) -> ('a list list -> 'b list list)
A tail recursive way
let mapNested f lofls =
let rec map f lst acc =
match lst with
| [] -> List.rev acc
| h::t -> map f t (f h :: acc)
map (fun x -> map f x []) lofls []
I'm not sure why this question is tagged with SML, but since it is, here is how it can be done in SML:
First, this is the idiomatic solution that you're explicitly avoiding:
fun mapmap f = map (map f)
(You could write val mapmap = map o map if it weren't for ML's value restriction.)
And if you'd like to write mapmap using explicit recursion:
fun mapmap f [] = []
| mapmap f (xs::xss) = map f xs :: mapmap f xss
and map f [] = []
| map f (x::xs) = f x :: map f xs
One reason behind why this function is hard to write with a single explicitly recursive function is that the call stack is used for two things:
Collecting the result of each inner list, and
Collecting the result of the outer list.
One of those uses of the call stack can be turned into an explicit stack in an accumulating argument. This is how e.g. a tail-recursive rev is defined:
fun rev xs =
let fun aux [] acc = acc
| aux (x::xs) acc = aux xs (x::acc)
in aux xs [] end
The accumulating argument similarly isn't needed in the interface to mapmap, so it can be hidden in an inner helper function. So a single function that performs explicit recursion on both the inner and the outer list is complicated by this explicit bookkeeping:
fun mapmap f xss =
let fun aux f [] _ = []
| aux f ([]::xss) ys = rev ys :: aux f xss []
| aux f ((x::xs)::xss) ys = aux f (xs::xss) (f x :: ys)
in aux f xss [] end
I am trying to get first and last element of the list in OCaml. I expect that my function will be like
'a list -> 'a * 'a
What I am trying to do is
let lista = [1;2;3;4;6;0];;
let rec first_last myList =
match myList with
[x] -> (List.hd lista,x)
| head::tail ->
first_last tail;;
first_last lista;;
Of course because of I made list as integer then I am doing this syntax like
*int list -> int * 'a
The point is that I dont have idea how to do this function for 'a.
Whats the direction?
The direction is to write two different functions first and last and implement the first_and_last function as:
let first_and_last xs = first xs, last xs
Another possibility with only one function:
let rec first_last = function
| [] -> failwith "too bad"
| [e] -> failwith "too bad"
| [e1;e2] -> (e1,e2)
| e1 :: _ :: r -> first_last (e1::r)
You may prefer it like that:
let rec first_last myList = match myList with
| [] -> failwith "too bad"
| [e] -> failwith "too bad"
| [e1;e2] -> (e1,e2)
| e1 :: _ :: r -> first_last (e1::r)
You can create two separate functions to return first element and last element, and then in your first_and_last function return a tuple (first_element, last_element).
let rec first_element list =
match list with
| [] -> failwith "List is empty"
| first_el::rest_of_list -> first_el
let rec last_element list =
match list with
| [] -> failwith "List is empty"
| [x] -> x
| first_el::rest_of_list -> last_element rest_of_list
You can create a helper function that has a base-case of the empty-list - for which it returns itself, and otherwise checks if the next recursive call will return an empty list. If it does, return the current element (which is by definition the last element in the list), and if it doesn't, return what was returned by the recursive call.
For the regular (non-helper) method, if the list is at least one element long (i.e. hd::tl = hd::[]) then you can just concatenate the list you got from the last function onto the head from ls.
It can be implemented as follow:
let rec last ls =
match ls with
| [] -> []
| hd::tl -> let next = last tl in
if next = [] then [hd]
else next
;;
let first_last ls =
match ls with
| [] -> failwith "Oh no!!!!! Empty list!"
| hd::tl -> hd::last tl
;;
Yet another take on this problem.
let first_last xs =
let rec last_non_empty = function
| [x] -> x
| _ :: xs' -> last_non_empty xs'
| [] -> failwith "first_last: impossible case!"
in
match xs with
| [] -> failwith "first_last"
| x::_ -> (x, last_non_empty xs)
Some properties of this implementation:
(1) it meets the specification 'a list -> 'a * 'a:
utop > #typeof "first_last";;
val first_last : 'a list -> 'a * 'a
(2) it works for singleton lists: first_last [x] = (x,x):
utop> first_last [1];;
- : int * int = (1, 1) utop> first_last ["str"];;
- : bytes * bytes = ("str", "str")
(3) it's tail-recursive (hence it won't cause stack overflow for sufficiently big lists):
utop > first_last (Array.to_list (Array.init 1000000 (fun x -> x+1)));;
- : int * int = (1, 1000000)
(4) it traverses the input list one time only; (5) it avoids creating new lists as it goes down the recursive ladder; (6) it avoids polluting the namespace (with the price of not allowing the reuse of a function like last).
And another rather simple variant, from the first principles (I was trying to illustrate "wishful thinking" in the spirit of the SICP book):
(* Not tail-recursive, might result in stack overflow *)
let rec first_last = function
| [] -> failwith "first_last"
| [x] -> (x,x)
| x :: xs -> (x, snd (first_last xs))
You could write it like this:
let first_last = function
| [] -> assert false
| x :: xs -> (x, List.fold_left (fun _ y -> y) x xs)
Or, if you are using the Base library, you could write in this way:
let first_last xs = (List.hd_exn xs, List.reduce_exn ~f:(fun _ y -> y) xs)
The basic idea is that List.fold_left (fun _ y -> y) x xs will compute the last element of x :: xs. You can prove this by induction on xs: if xs = [] then List.fold_left (fun _ y -> y) x [] = x, which is the last element of x :: []; moreover, if xs = x' :: xs' then List.fold_left (fun _ y -> y) x (x' :: xs') can be rewritten as List.fold_left (fun _ y -> y) x' xs', because List.fold_left f acc (x :: xs) = List.fold_left (f acc x) xs, hence we are finished, because this is the last element of x' :: xs' by our induction hypothesis.
I have an assignment to create map_reverse function.
let rec map_rev func = function
[] -> []
| h::t -> map_rev func t # func h;;
let f x = x * 7;;
open Printf
let a = map_rev f [1;2;10;20;400]
let () = List.iter (printf "%d ") a
Now, the compiler will not allow this line:
let a = map_rev f [1;2;10;20;400]
because:
'This expression has type 'a * 'b but an expression was expected of type 'c -> 'd list'.
Could anyone point my mistake? Why does it expect 'c -> 'd list?
The type of a map reverse function should be ('a -> 'b) -> 'a list -> 'b list. Your map_rev function has type ('a -> 'b list) -> 'a list -> 'b list. So the key is to figure out why the compiler thinks func returns a list.
let rec map_rev func = function
[] -> []
| h::t -> map_rev func t # [func h ];;
I would enjoy to receive some helpful comments concerning an example given on:
http://caml.inria.fr/pub/docs/manual-ocaml-400/manual021.html#toc79
7.12 Explicit polymorphic type annotations
type 'a t = Leaf of 'a | Node of ('a * 'a) t
let rec depth : 'a. 'a t -> 'b = function
|Leaf _ -> 1
| Node x -> 1 + depth x
I understand this example function, but when I try to define a 'map-like' function of type
'a. 'a t -> ('a -> 'b) -> 'b t
e.g.:
let rec tmap: 'a. 'a t ->(f:'a->'b) -> 'b t = function
|Leaf x -> Leaf( f x)
|Node x -> let res = tmap x in Node(res);;
I get the following error:
Characters 67-77:
|Leaf x -> Leaf( f x)
^^^^^^^^^^
Error: This expression has type 'c t but an expression was expected of type
(f:'a -> 'b) -> 'b t
which I do not completely understand.
I would appreciate any helpful comment.
You forgot to get the second argument.
let rec tmap:
'a. 'a t ->(f:'a->'b) -> 'b t = (* asking for two arguments *)
function (* takes only the first argument *)
|Leaf x -> Leaf( f x)
|Node x -> let res = tmap x in Node(res);;
Also, 'b must be polymorphic too, as you want to generate nested tuples as long as you descend through the tree.
This should be, thanks to ivg:
let rec tmap : 'a 'b. 'a t -> f:('a->'b) -> 'b t = fun t ~f ->
match t with
|Leaf x -> Leaf( f x)
|Node x -> let f (a,b) = (f a, f b) in Node ( tmap x ~f ) ;;
You have a few problems, like improperly placed parenthesis around f, forgotten argument to the tmap function in the Node branch, and you've forget the quantifier for 'b. So, finally, with the help of PatJ we can write the following:
type 'a t = Leaf of 'a | Node of ('a * 'a) t
let rec depth : 'a. 'a t -> 'b = function
| Leaf _ -> 1
| Node x -> 1 + depth x
let rec tmap: 'a 'b. 'a t -> f:('a -> 'b) -> 'b t =
fun t ~f -> match t with
| Leaf x -> Leaf (f x)
| Node x ->
Node (tmap ~f:(fun (x,y) -> f x, f y) x)
tmap (Node (Leaf (7,8))) ~f:(fun x -> x + 1, x + 2);;
- : (int * int) t = Node (Leaf ((8, 9), (9, 10)))
many thanks for your great help.
Now my test cases work out as intended:
let int_tree = Node(Node(Leaf((3,-1),(0,4))));;
let char_tree = Node(Node(Leaf(('a','c'),('d','c'))));;
tmap int_tree ~f:(fun x -> x*x);;
- : int t = Node (Node (Leaf ((9, 1), (0, 16))))
tmap char_tree ~f:(fun x -> Char.uppercase x);;
- : char t = Node (Node (Leaf (('A', 'C'), ('D', 'C'))))