How to convert CPS-style gcd computation to use the Continuation Monad - ocaml

Let us consider the following implementation of the Continuation monad, for CPS-style computations yielding and integer:
module Cont : sig
type 'a t = ('a -> int) -> int
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val callCC: (('a -> 'b t) -> 'a t) -> 'a t
end = struct
type 'a t = ('a -> int) -> int
let return x =
fun cont -> cont x
let bind m f =
fun cont -> m (fun x -> (f x) cont)
let callCC k =
fun cont -> k (fun x -> (fun _ -> cont x)) cont
end
How can we rewrite the CPS-style implementation of gcd computation (see How to memoize recursive functions?) and especially the memoization to take advantage of the Cont monad?
After defining
let gcd_cont k (a,b) =
let (q, r) = (a / b, a mod b) in
if r = 0 then Cont.return b else k (b,r)
I tried to use the type solver to give me cue about the type that the memoization function should have:
# let gcd memo ((a,b):int * int) =
Cont.callCC (memo gcd_cont (a,b)) (fun x -> x)
;;
val gcd :
(((int * int -> int Cont.t) -> int * int -> int Cont.t) ->
int * int -> (int -> 'a Cont.t) -> int Cont.t) ->
int * int -> int = <fun>
However I could not turn this hint into an actual implementation. Is someone able to do this? The logic behind using “callCC” in the memoization function is that if a value is found in the cache, then this is is an early exit condition.

I feel like the issue is that in his answer to How to memoize recursive functions?, Michael called CPS style what is not CPS style. In CPS style, the extra continuation argument k is used whenever one wants to return a value - the value is then applied to k instead.
This is not really what we want here, and not what implements:
let gcd_cont k (a,b) =
let (q, r) = (a / b, a mod b) in
if r = 0 then b else k (b,r)
Here, k is not used for returning (b is returned directly), it is used instead of performing a recursive call. This unwinds the recursion: within gcd_cont, one can think of k as gcd_cont itself, just like if let rec was used. Later on, gcd_cont can be turned into a truly recursive function using a fixpoint combinator, that basically "feeds it to itself":
let rec fix f x = f (fix f) x
let gcd = fix gcd_cont
(this is equivalent to the call function that Michael defines)
The difference with defining gcd directly using a let rec is that the version with unwinded recursion allows one to "instrument" the recursive calls, as the recursion itself is performed by the fixpoint combinator. This is what we want for memoization: we only want to perform recursion if the result is not in the cache. Thus the definition of a memo combinator.
If the function is defined with a let rec, the recursion is closed at the same time as defining the function, so one cannot instrument the recursive call-sites to insert memoization.
As a side note, the two answers basically implement the same thing: the only difference is the way they implement recursion in the fixpoint combinator: Michael's fixpoint combinator uses let rec, Jackson's one uses a reference, i.e. "Landin's knot" — an alternative way of implementing recursion, if you have references in your language.
Sooo, to conclude, I'd say implementing that in the continuation monad is not really possible / does not really make sense, as the thing was not CPS in the first place.

Related

How to lift a value into a monad

I'm trying to use the Writer monad in OCaml.
module Writer : Monad = struct
type 'a t = 'a * string
let return x = (x, "")
let (>>=) m f =
let (x, s1) = m in
let (y, s2) = f x in
(y, s1 ^ s2)
end
The statement below works.
Writer.(>>=) (Writer.return 2) (fun x -> Writer.return 1);;
But the statement below does not.
Writer.(>>=) (Writer.return 2) (fun x -> (x, "inc"));;
Error: This expression has type 'a * 'b but an expression was expected of type
'c Writer.t
I tried
Writer.(>>=) (Writer.return 2) (fun x -> ((x, "inc") : int Writer.t))
Error: This expression has type 'a * 'b but an expression was expected of type
int Writer.t
What am I doing wrong here? How can I lift a value into a monad in OCaml?
As mentioned, the code works with:
Writer.(>>=) (Writer.return 2) (fun x -> Writer.return 1);;
This is because the signature that describes the monad, here Monad, probably has this form:
module type Monad = sig
type 'a t
val return : 'a -> 'a t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
end
As the concrete implementation of 'a t is not yet known (the type module potentially serving several implementations), 'a t is "abstract".
One approach would therefore be to "de-abstract" it.
This is possible by reflecting in the signature of the Writer module that we want to implement the Monad module while not making the type 'a t abstract, in this way:
module Writer : Monad with type 'a t = 'a * string = struct
type 'a t = 'a * string
let return x = (x, "")
let (>>=) m f =
let (x, s1) = m in
let (y, s2) = f x in
(y, s1 ^ s2)
end
In this way, the type `'a t' will no longer be abstract.
As a side note, I personally think it's not particularly bad that the Writer (or Reader, or State) type is abstract. The fact that it's a couple seems to me to be an implementation detail, some piping that doesn't need to be leaked.
A more fundamental issue is that the signature constraint
module Any_monad : Monad
is almost always a mistake in OCaml.
Signature constraints remove information that stick out of the signature. Thus, after the constraint, Any_monad could be replaced by any other monads fulfilling the monad signature (if we temporarily exclude side-effectful monads). For instance, you could replace the Writer monad with this very useful monad:
module Nil = struct
type 'a t = unit
let bind x f = ()
let (>>=) = bind
let return x = ()
end
In other words, an useful monad needs to have functions that are not part of the monad interface. In the case of the Writer monad that would be a write function:
module Writer: sig
include Monad
val write: string -> unit t
val read: 'a t -> string
end = struct
...
end
Notice that we have extended the signature before using it as a constraint.
Once, those functions available, your original code can be rewritten as:
Writer.(return 2 >>= fun x -> write "inc" >>= fun () -> return x)
You're constraining your monad implementation to be a Monad but, in fact, you want its type to have the Writer signature. To put it in other words, you're upcasting your implementation and forgetting that it also have to implement operations specific to the Writer monad. Obviously, this renders your Writer monad useless as you can't write anything.
To get it fixed, we first need to define the Writer module type, a common definition might look something like this,
module type Writer = sig
type state
val write : state -> unit t
val read : 'a t -> state t
val listen : 'a t -> ('a * state) t
val exec : unit t -> state
include Monad with type 'a t := 'a t
end
Now you need to implement the newly added operations with the state type set to string and then you will be able to use your Writer monad without breaking its abstraction,
module Writer : Writer with type state = string = struct
type state = string
type 'a t = 'a * string
let return x = (x, "")
let (>>=) m f =
let (x, s1) = m in
let (y, s2) = f x in
(y, s1 ^ s2)
let write x = (),x
let read (_,x) = x
let listen (x,s) = ((x,s),s)
let exec (_,x) = x
end
There are few libraries that implement monads in OCaml, so you don't need to re-invent it by your own. You can try the monads library that we develop at CMU. It could be installed with
opam install monads

if-then-else expression works but cond does not in ocaml factorial function

let cond (a,b,c) =
match a with
| true -> b
| false -> c
let rec fact n =
cond (n=0,1, n * fact (n-1))
let rec fact n =
if n=0 then 1 else n * fact (n-1)
In the above code segments, the first version gives a stack overflow exception
while the second one works fine. what is the difference between these two?
they seem to function the same but apparently don't.
OCaml is strict, i.e. all arguments for function cond are evaluated when cond is called. This includes the call to fact(n-1) when n is zero, i.e. you will evaluate fact(-1) etc. Therefore you have an unterminated recursion and hence a stack overflow.
The second example with the if-then-else statement evaluates only one of the cases, such that the recursion is finite.
In addition to the actual answer, a possible way to introduce laziness is to use intermediate functions:
let cond (a,b,c) =
match a with
| true -> b ()
| false -> c ()
val cond : bool * (unit -> 'a) * (unit -> 'a) -> 'a = <fun>
With this definition, you define fact as follows:
let rec fact n =
cond (n=0, (fun () -> 1), (fun () -> (n * fact (n-1))))
val fact : int -> int = <fun>
Each (fun () -> ...) expression creates a temporary object, a closure, which captures the variables in its surrounding environment. Closures without parameters are called thunks.
The closures bound to b and c delay the evaluation of each branch of the test, until you force the execution by calling them.
Closures are not free, in term of resources: unless a compiler finds a way to optimize them, you need to allocate memory each time you evaluate them.

Cartesian (outer) product of lists in OCaml

I would like to iterate over all combinations of elements from a list of lists which have the same length but not necessarily the same type. This is like the cartesian product of two lists (which is easy to do in OCaml), but for an arbitrary number of lists.
First I tried to write a general cartesian (outer) product function which takes a list of lists and returns a list of tuples, but that can't work because the input list of lists would not have elements of the same type.
Now I'm down to a function of the type
'a list * 'b list * 'c list -> ('a * 'b * 'c) list
which unfortunately fixes the number of inputs to three (for example). It's
let outer3 (l1, l2, l3) =
let open List in
l1 |> map (fun e1 ->
l2 |> map (fun e2 ->
l3 |> map (fun e3 ->
(e1,e2,e3))))
|> concat |> concat
This works but it's cumbersome since it has to be redone for each number of inputs. Is there a better way to do this?
Background: I want to feed the resulting flat list to Parmap.pariter.
To solve your task for arbitrary ntuple we need to use existential types. We can use GADT, but they are close by default. Of course we can use open variants, but I prefer a little more syntactically heavy but more portable solution with first class modules (and it works because GADT can be expressed via first class modules). But enough theory, first of all we need a function that will produce the n_cartesian_product for us, with type 'a list list -> 'a list list
let rec n_cartesian_product = function
| [] -> [[]]
| x :: xs ->
let rest = n_cartesian_product xs in
List.concat (List.map (fun i -> List.map (fun rs -> i :: rs) rest) x)
Now we need to fit different types into one type 'a, and here comes existential types, let's define a signature:
module type T = sig
type t
val x : t
end
Now let's try to write a lifter to this existential:
let int x = (module struct type t = int let x = x end : T)
it has type:
int -> (module T)
Let's extend the example with few more cases:
let string x = (module struct type t = string let x = x end : T)
let char x = (module struct type t = char let x = x end : T)
let xxs = [
List.map int [1;2;3;4];
List.map string ["1"; "2"; "3"; "4"];
List.map char ['1'; '2'; '3'; '4']
]
# n_cartesian_product xxs;;
- : (module T) list list =
[[<module>; <module>; <module>]; [<module>; <module>; <module>];
[<module>; <module>; <module>]; [<module>; <module>; <module>];
...
Instead of first class modules you can use other abstractions, like objects or functions, if your type requirements allow this (e.g., if you do not need to expose the type t). Of course, our existential is very terse, and maybe you will need to extend the signature.
I used #ivg 's answer but in a version with a GADT. I reproduce it here for reference. In a simple case where only the types float and int can appear in the input lists, first set
type wrapped = Int : int -> wrapped | Float : float -> wrapped
this is a GADT without type parameter. Then
let wrap_f f = Float f
let wrap_i i = Int f
wrap types into the sum type. On wrapped value lists we can call n_cartesian_product from #ivg 's answer. The result is a list combinations: wrapped list list which is flat (for the present purposes).
Now to use Parmap, i have e.g. a worker function work : float * int * float * float -> float. To get the arguments out of the wrappers, I pattern match:
combinations |> List.map (function
| [Float f1; Int i; Float f2; Float f3] -> (f1, i, f2, f3)
| _ -> raise Invalid_argument "wrong parameter number or types")
to construct the flat list of tuples. This can be finally fed to Parmap.pariter with the worker function work.
This setup is almost the same as using a regular sum type type wrapsum = F of float | I of int instead of wrapped. The pattern matching would be the same; the only difference seems to be that getting a wrong input, e.g. (F 1, I 1, F 2.0, F, 3.0) would be detected only at runtime, not compile time as here.

A curry function that executes another function n times

I'm solving an old exam to practice SML. One task I found interesting was: Write a function repeat that executes another function with the signature 'a -> 'a.
I assumed the requested function is a curry function and used the o-Operator:
fun repeat (1, f: 'a->'a) = f
| repeat (n, f: 'a->'a) = f o repeat (n-1, f);
However, the o operator was not formally introduced in out course, and I wonder how I could write this without it?
Not the less verbose, but in some way, the most explicit, then after, the less verbose, with explanations.
A curried function is a function getting a single argument. If an expression has more arguments, then there are as many nested functions. The first outer level function gets an argument, and is made of an inner level function which may it‑self be made of an inner function, and so on. Any of this inner level function may be returned, not just the innermost, as explained later (this is a kind of “partial evaluation”). An inner function is “specialized” with the arguments (formally, the arguments are bound in a closure) of the outer functions.
We know there are at least a function argument f and integer argument counter. There needs to be an argument seed also, to invoke the function f the first time.
The order of nesting may be arbitrary or specified. If not specified, I personally prefer to put the least varying arguments on the outer‑scope and the most varying in the inner‑scope. Here, I would say it is, from least to most varying: f, counter seed.
This is already enough to suggest the beginning of a template:
val repeat: ('a -> 'a) -> int -> 'a -> 'a =
fn f: 'a -> 'a =>
fn count: int =>
fn seed: 'a =>
…
We already implemented the ('a -> 'a) -> int -> 'a part of the signature. Remains the last -> 'a which means an 'a is to be returned, and it will be evaluated by an inner loop.
A loop may be something of this form (in pseudo‑code):
val rec loop = fn i =>
if condition-to-stop
then return-something-or-`()`
else loop (i + 1) or (i - 1)
If the loop is to compute something, it will need an extra argument acting as an accumulator, and will return that accumulator as its final result.
Implementing the loop and putting it inside the curried function template above, we get:
val repeat: ('a -> 'a) -> int -> 'a -> 'a =
fn f: 'a -> 'a =>
fn count: int =>
fn seed: 'a =>
let
val rec loop = fn (counter, x) =>
if counter <= 0 then x
else loop (counter - 1, f x)
in
loop (count, seed)
end
Do you understand the let … in … end construct here?
Note the guard on counter may use a pattern as you did, but as SML's integer may be negative (there is no strict natural in SML), that's safer to catch this case too, thus the if … then … else instead of a pattern matching. Mileage may vary on that point, but that's not the question's focus.
The same as above, using fun instead of val rec:
fun repeat (f: 'a -> 'a) (count: int) (seed: 'a): 'a =
let
fun loop (counter, x) =
if counter <= 0 then x
else loop (counter - 1, f x)
in
loop (count, seed)
end
Note for repeat the arguments are not separated by a , (neither a *). This is the way to write a curried function using fun (on the contrary, loop is not curried). Compare it with the prior val version of the same function. If no type is specified and only names, the parenthesis can be omitted.
A test function to be used as the f argument:
val appendAnX = fn s: string => s ^ "x"
The test:
val () = print (repeat appendAnX 5 "Blah:")
Curried function are more abstract than function getting a tuple (which is formally a single argument, thus makes a curried function too, but that's another story and a bit cheating), as the outer function(s) may be partially applied:
This is a partial application, leaving the last argument, seed, unbound:
val repeatAppendAnXThreeTimes = repeat appendAnX 3
Then this function may be applied specifiying only this seed:
val () = print (repeatAppendAnXThreeTimes "Blah:")
Similarly, both counter and seed may be left free:
val repeatAppendAnX = repeat appendAnX
val () = print (repeatAppendAnX 4 "Blah:")
Another way of defining repeatAppendAnXThreeTimes. Compare it to its other definition above:
val repeatAppendAnXThreeTimes = repeatAppendAnX 3
val () = print (repeatAppendAnXThreeTimes "Blah:")

ocaml function takes function as parameter and output a function

I need to find a way to combine two functions and output them as one.
I have the following code where take in a list of function ('a->'a) list then output a function ('a->'a) using the List.fold_left.
I figured out the base case, but I tried a lot of ways to combine two functions. The output should have the type ('a -> 'a) list -> ('a -> 'a).
example output:
# pipe [] 3;;
- : int = 3
# pipe [(fun x-> 2*x);(fun x -> x + 3)] 3 ;;
- : int = 9
# pipe [(fun x -> x + 3);(fun x-> 2*x)] 3;;
- : int = 12
function:
let p l =
let f acc x = fun y-> fun x->acc in (* acc & x are functions 'a->'a *)
let base = fun x->x in
List.fold_left f base l
Since you know that you have to use a left fold, you now have to solve a fairly constrained problem: given two functions of type 'a -> 'a, how do you combine them into a single function of the same type?
In practice, there is one general way of combining functions: composition. In math, this is usually written as f ∘ g where f and g are the functions. This operation produces a new function which corresponds to taking an argument, applying g to it and then applying f to the result. So if h = f ∘ g, then we can also write this as h(x) = f(g(x)).
So your function f is actually function composition. (You should really give it a better name than f.) It has to take in two functions of type 'a -> 'a and produce another function of the same type. This means it produces a function of one argument where you produce a function taking two arguments.
So you need to write a function compose (a more readable name than f) of type ('a -> 'a) -> ('a -> 'a) -> ('a -> 'a). It has to take two arguments f and g and produce a function that applies both of them to its argument.
I hope this clarifies what you need to do. Figuring out exactly how to do it in OCaml is a healthy exercise.