I tried to implement the fibonacci sequence in F# using pattern matching like this:
let fibonacci m=
let rec fib = function
| (0, _, z) -> z
| (n, y, z) -> fib (n-1) z (y+z)
fib m 0 1
Here I expect the first argument to fib to keep track of how far along in the sequence we are, and the next two arguments to be successive terms in the sequence.
However, I'm getting a compile-time error on fib (n-1) z (y+z):
Type mismatch. Expecting a
'a -> 'b -> 'c
but given a
'c
The resulting type would be infinite when unifying ''a' and ''b -> 'c -> 'a'
I tried specifying types like so:
let fibonacci m=
let rec fib = function
| (0, _, z:int) -> z
| (n:int, y:int, z:int) -> fib (n-1) z (y+z)
fib m 0 1
And then I get a different compile error on fib (n-1):
This value is not a function and cannot be applied
I'm still trying to get my head around functional programming. I think the problem might be my lack of understanding in what the first pattern actually means. I want it mean that when the position argument is zero, it returns the second argument term.
Could someone help me with this problem which is obviously due to some basic misunderstanding on my part
The problem is you're calling the function with curried arguments when in fact is defined as expecting tupled arguments:
let fibonacci m =
let rec fib = function
| (0, _, z) -> z
| (n, y, z) -> fib (n-1, z, y+z)
fib (m, 0, 1)
This is because you are using function which pattern match a single argument, in your case against a tuple. The alternative is to use match
let fibonacci m =
let rec fib a b c =
match (a, b, c) with
| (0, _, z) -> z
| (n, y, z) -> fib (n-1) z (y+z)
fib m 0 1
You can think of function as a shorthand for a single argument function followed by a match over that argument.
Related
I want to take two streams of integers in increasing order and combine them into one stream that contains no duplicates and should be in increasing order. I have defined the functionality for streams in the following manner:
type 'a susp = Susp of (unit -> 'a)
let force (Susp f) = f()
type 'a str = {hd : 'a ; tl : ('a str) susp }
let merge s1 s2 = (* must implement *)
The first function suspends computation by wrapping a computation within a function, and the second function evaluates the function and provides me with the result of the computation.
I want to emulate the logic of how you go about combining lists, i.e. match on both lists and check which elements are greater, lesser, or equal and then append (cons) the integers such that the resulting list is sorted.
However, I know I cannot just do this with streams of course as I cannot traverse it like a list, so I think I would need to go integer by integer, compare, and then suspend the computation and keep doing this to build the resulting stream.
I am at a bit of a loss how to implement such logic however, assuming it is how I should be going about this, so if somebody could point me in the right direction that would be great.
Thank you!
If the the input sequences are sorted, there is not much difference between merging lists and sequences. Consider the following merge function on lists:
let rec merge s t =
match s, t with
| x :: s , [] | [], x :: s -> x :: s
| [], [] -> s
| x :: s', y :: t' ->
if x < y then
x :: (merge s' t)
else if x = y then
x :: (merge s' t')
else
y :: (merge s t')
This function is only using two properties of lists:
the ability to split the potential first element from the rest of the list
the ability to add an element to the front of the list
This suggests that we could rewrite this function as a functor over the signature
module type seq = sig
type 'a t
(* if the seq is non-empty we split the seq into head and tail *)
val next: 'a t -> ('a * 'a t) option
(* add back to the front *)
val cons: 'a -> 'a t -> 'a t
end
Then if we replace the pattern matching on the list with a call to next, and the cons operation with a call to cons, the previous function is transformed into:
module Merge(Any_seq: seq ) = struct
open Any_seq
let rec merge s t =
match next s, next t with
| Some(x,s), None | None, Some (x,s) ->
cons x s
| None, None -> s
| Some (x,s'), Some (y,t') ->
if x < y then
cons x (merge s' t)
else if x = y then
cons x (merge s' t')
else
cons y (merge s t')
end
Then, with list, our implementation was:
module List_core = struct
type 'a t = 'a list
let cons = List.cons
let next = function
| [] -> None
| a :: q -> Some(a,q)
end
module List_implem = Merge(List_core)
which can be tested with
let test = List_implem.merge [1;5;6] [2;4;9]
Implementing the same function for your stream type is then just a matter of writing a similar Stream_core module for stream.
I'm trying to create an infinite Stream in F# that contains armstrong numbers. An armstrong number is one whose cubes of its digits add up to the number. For example, 153 is an armstrong number because 1^3 + 5^3 + 3^3 = 153. so far, I have created several functions to help me do so. They are:
type 'a stream = Cons of 'a * (unit -> 'a stream);;
let rec upfrom n = Cons (n, fun() -> upfrom (n+1));;
let rec toIntArray = function
| 0 -> []
| n -> n % 10 :: toIntArray (n / 10);;
let rec makearmstrong = function
| [] -> 0
| y::ys -> (y * y * y) + makearmstrong ys;;
let checkarmstrong n = n = makearmstrong(toIntArray n);;
let rec take n (Cons(x,xsf)) =
match n with
| 0 -> []
| _ -> x :: take (n-1)(xsf());;
let rec filter p (Cons (x, xsf)) =
if p x then Cons (x, fun() -> filter p (xsf()))
else filter p (xsf());;
And finally:
let armstrongs = filter (fun n -> checkarmstrong n)(upfrom 1);;
Now, when I do take 4 armstrongs;;, (or any number less than 4) this works perfectly and gives me [1;153;370;371] but if I do take 5 armstrongs;;nothing happens, it seems like the program freezes.
I believe the issue is that there are no numbers after 407 that are the sums of their cubes (see http://oeis.org/A046197), but when your code evaluates the equivalent of take 1 (Cons(407, filter checkarmstrong (upfrom 408))) it's going to force the evaluation of the tail and filter will recurse forever, never finding a matching next element. Also note that your definition of Armstrong numbers differs from, say, Wikipedia's, which states that the power the digits are raised to should be the number of digits in the number.
let rec f n =
match n with
| 0 | 1 | 2 -> 1
| _ -> f (n - 2) + f (n - 3)
Without CPS or Memoization, how could it be made tail recursive?
let f n = Seq.unfold (fun (x, y, z) -> Some(x, (y, z, x + y))) (1I, 1I, 1I)
|> Seq.nth n
Or even nicer:
let lambda (x, y, z) = x, (y, z, x + y)
let combinator = Seq.unfold (lambda >> Some) (1I, 1I, 1I)
let f n = combinator |> Seq.nth n
To get what's going on here, refer this snippet. It defines Fibonacci algorithm, and yours is very similar.
UPD There are three components here:
The lambda which gets i-th element;
The combinator which runs recursion over i; and
The wrapper that initiates the whole run and then picks up the value (from a triple, like in #Tomas' code).
You have asked for a tail-recursive code, and there are actually two ways for that: make your own combinator, like #Tomas did, or utilize the existing one, Seq.unfold, which is certainly tail-recursive. I preferred the second approach as I can split the entire code into a group of let statements.
The solution by #bytebuster is nice, but he does not explain how he created it, so it will only help if you're solving this specific problem. By the way, your formula looks a bit like Fibonacci (but not quite) which can be calculated analytically without any looping (even without looping hidden in Seq.unfold).
You started with the following function:
let rec f0 n =
match n with
| 0 | 1 | 2 -> 1
| _ -> f0 (n - 2) + f0 (n - 3)
The function calls f0 for arguments n - 2 and n - 3, so we need to know these values. The trick is to use dynamic programming (which can be done using memoization), but since you did not want to use memoization, we can write that by hand.
We can write f1 n which returns a three-element tuple with the current and two past values values of f0. This means f1 n = (f0 (n - 2), f0 (n - 1), f0 n):
let rec f1 n =
match n with
| 0 -> (0, 0, 1)
| 1 -> (0, 1, 1)
| 2 -> (1, 1, 1)
| _ ->
// Here we call `f1 (n - 1)` so we get values
// f0 (n - 3), f0 (n - 2), f0 (n - 1)
let fm3, fm2, fm1 = (f1 (n - 1))
(fm2, fm1, fm2 + fm3)
This function is not tail recurisve, but it only calls itself recursively once, which means that we can use the accumulator parameter pattern:
let f2 n =
let rec loop (fm3, fm2, fm1) n =
match n with
| 2 -> (fm3, fm2, fm1)
| _ -> loop (fm2, fm1, fm2 + fm3) (n - 1)
match n with
| 0 -> (0, 0, 1)
| 1 -> (0, 1, 1)
| n -> loop (1, 1, 1) n
We need to handle arguments 0 and 1 specially in the body of fc. For any other input, we start with initial three values (that is (f0 0, f0 1, f0 2) = (1, 1, 1)) and then loop n-times performing the given recursive step until we reach 2. The recursive loop function is what #bytebuster's solution implements using Seq.unfold.
So, there is a tail-recursive version of your function, but only because we could simply keep the past three values in a tuple. In general, this might not be possible if the code that calculates which previous values you need does something more complicated.
Better even than a tail recursive approach, you can take advantage of matrix multiplication to reduce any recurrence like that to a solution that uses O(log n) operations. I leave the proof of correctness as an exercise for the reader.
module NumericLiteralG =
let inline FromZero() = LanguagePrimitives.GenericZero
let inline FromOne() = LanguagePrimitives.GenericOne
// these operators keep the inferred types from getting out of hand
let inline ( + ) (x:^a) (y:^a) : ^a = x + y
let inline ( * ) (x:^a) (y:^a) : ^a = x * y
let inline dot (a,b,c) (d,e,f) = a*d+b*e+c*f
let trans ((a,b,c),(d,e,f),(g,h,i)) = (a,d,g),(b,e,h),(c,f,i)
let map f (x,y,z) = f x, f y, f z
type 'a triple = 'a * 'a * 'a
// 3x3 matrix type
type 'a Mat3 = Mat3 of 'a triple triple with
static member inline ( * )(Mat3 M, Mat3 N) =
let N' = trans N
map (fun x -> map (dot x) N') M
|> Mat3
static member inline get_One() = Mat3((1G,0G,0G),(0G,1G,0G),(0G,0G,1G))
static member (/)(Mat3 M, Mat3 N) = failwith "Needed for pown, but not supported"
let inline f n =
// use pown to get O(log n) time
let (Mat3((a,b,c),(_,_,_),(_,_,_))) = pown (Mat3 ((0G,1G,0G),(0G,0G,1G),(1G,1G,0G))) n
a + b + c
// this will take a while...
let bigResult : bigint = f 1000000
I'm implementing a packrat parser in OCaml, as per the Master Thesis by B. Ford. My parser should receive a data structure that represents the grammar of a language and parse given sequences of symbols.
I'm stuck with the memoization part. The original thesis uses Haskell's lazy evaluation to accomplish linear time complexity. I want to do this (memoization via laziness) in OCaml, but don't know how to do it.
So, how do you memoize functions by lazy evaluations in OCaml?
EDIT: I know what lazy evaluation is and how to exploit it in OCaml. The question is how to use it to memoize functions.
EDIT: The data structure I wrote that represents grammars is:
type ('a, 'b, 'c) expr =
| Empty of 'c
| Term of 'a * ('a -> 'c)
| NTerm of 'b
| Juxta of ('a, 'b, 'c) expr * ('a, 'b, 'c) expr * ('c -> 'c -> 'c)
| Alter of ('a, 'b, 'c) expr * ('a, 'b, 'c) expr
| Pred of ('a, 'b, 'c) expr * 'c
| NPred of ('a, 'b, 'c) expr * 'c
type ('a, 'b, 'c) grammar = ('a * ('a, 'b, 'c) expr) list
The (not-memoized) function that parse a list of symbols is:
let rec parse g v xs = parse' g (List.assoc v g) xs
and parse' g e xs =
match e with
| Empty y -> Parsed (y, xs)
| Term (x, f) ->
begin
match xs with
| x' :: xs when x = x' -> Parsed (f x, xs)
| _ -> NoParse
end
| NTerm v' -> parse g v' xs
| Juxta (e1, e2, f) ->
begin
match parse' g e1 xs with
| Parsed (y, xs) ->
begin
match parse' g e2 xs with
| Parsed (y', xs) -> Parsed (f y y', xs)
| p -> p
end
| p -> p
end
( and so on )
where the type of the return value of parse is defined by
type ('a, 'c) result = Parsed of 'c * ('a list) | NoParse
For example, the grammar of basic arithmetic expressions can be specified as g, in:
type nt = Add | Mult | Prim | Dec | Expr
let zero _ = 0
let g =
[(Expr, Juxta (NTerm Add, Term ('$', zero), fun x _ -> x));
(Add, Alter (Juxta (NTerm Mult, Juxta (Term ('+', zero), NTerm Add, fun _ x -> x), (+)), NTerm Mult));
(Mult, Alter (Juxta (NTerm Prim, Juxta (Term ('*', zero), NTerm Mult, fun _ x -> x), ( * )), NTerm Prim));
(Prim, Alter (Juxta (Term ('<', zero), Juxta (NTerm Dec, Term ('>', zero), fun x _ -> x), fun _ x -> x), NTerm Dec));
(Dec, List.fold_left (fun acc d -> Alter (Term (d, (fun c -> int_of_char c - 48)), acc)) (Term ('0', zero)) ['1';'2';'3';])]
The idea of using lazyness for memoization is use not functions, but data structures, for memoization. Lazyness means that when you write let x = foo in some_expr, foo will not be evaluated immediately, but only as far as some_expr needs it, but that different occurences of xin some_expr will share the same trunk: as soon as one of them force computation, the result is available to all of them.
This does not work for functions: if you write let f x = foo in some_expr, and call f several times in some_expr, well, each call will be evaluated independently, there is not a shared thunk to store the results.
So you can get memoization by using a data structure instead of a function. Typically, this is done using an associative data structure: instead of computing a a -> b function, you compute a Table a b, where Table is some map from the arguments to the results. One example is this Haskell presentation of fibonacci:
fib n = fibTable !! n
fibTable = [0,1] ++ map (\n -> fib (n - 1) + fib (n - 2)) [2..]
(You can also write that with tail and zip, but this doesn't make the point clearer.)
See that you do not memoize a function, but a list: it is the list fibTable that does the memoization. You can write this in OCaml as well, for example using the LazyList module of the Batteries library:
open Batteries
module LL = LazyList
let from_2 = LL.seq 2 ((+) 1) (fun _ -> true)
let rec fib n = LL.at fib_table (n - 1) + LL.at fib_table (n - 2)
and fib_table = lazy (LL.Cons (0, LL.cons 1 <| LL.map fib from_2))
However, there is little interest in doing so: as you have seen in the example above, OCaml does not particularly favor call-by-need evaluation -- it's reasonable to use, but not terribly convenient as it was forced to be in Haskell. It is actually equally simple to directly write the cache structure by direct mutation:
open Batteries
let fib =
let fib_table = DynArray.of_list [0; 1] in
let get_fib n = DynArray.get fib_table n in
fun n ->
for i = DynArray.length fib_table to n do
DynArray.add fib_table (get_fib (i - 1) + get_fib (i - 2))
done;
get_fib n
This example may be ill-chosen, because you need a dynamic structure to store the cache. In the packrat parser case, you're tabulating parsing on a known input text, so you can use plain arrays (indexed by the grammar rules): you would have an array of ('a, 'c) result option for each rule, of the size of the input length and initialized to None. Eg. juxta.(n) represents the result of trying the rule Juxta from input position n, or None if this has not yet been tried.
Lazyness is a nice way to present this kind of memoization, but is not always expressive enough: if you need, say, to partially free some part of your result cache to lower memory usage, you will have difficulties if you started from a lazy presentation. See this blog post for a remark on this.
Why do you want to memoize functions? What you want to memoize is, I believe, the parsing result for a given (parsing) expression and a given position in the input stream. You could for instance use Ocaml's Hashtables for that.
The lazy keyword.
Here you can find some great examples.
If it fits your use case, you can also use OCaml streams instead of manually generating thunks.
I am new to F# and was reading about tail recursive functions and was hoping someone could give me two different implementations of a function foo - one that is tail recursive and one that isn't so that I can better understand the principle.
Start with a simple task, like mapping items from 'a to 'b in a list. We want to write a function which has the signature
val map: ('a -> 'b) -> 'a list -> 'b list
Where
map (fun x -> x * 2) [1;2;3;4;5] == [2;4;6;8;10]
Start with non-tail recursive version:
let rec map f = function
| [] -> []
| x::xs -> f x::map f xs
This isn't tail recursive because function still has work to do after making the recursive call. :: is syntactic sugar for List.Cons(f x, map f xs).
The function's non-recursive nature might be a little more obvious if I re-wrote the last line as | x::xs -> let temp = map f xs; f x::temp -- obviously its doing work after the recursive call.
Use an accumulator variable to make it tail recursive:
let map f l =
let rec loop acc = function
| [] -> List.rev acc
| x::xs -> loop (f x::acc) xs
loop [] l
Here's we're building up a new list in a variable acc. Since the list gets built up in reverse, we need to reverse the output list before giving it back to the user.
If you're in for a little mind warp, you can use continuation passing to write the code more succinctly:
let map f l =
let rec loop cont = function
| [] -> cont []
| x::xs -> loop ( fun acc -> cont (f x::acc) ) xs
loop id l
Since the call to loop and cont are the last functions called with no additional work, they're tail-recursive.
This works because the continuation cont is captured by a new continuation, which in turn is captured by another, resulting in a sort of tree-like data structure as follows:
(fun acc -> (f 1)::acc)
((fun acc -> (f 2)::acc)
((fun acc -> (f 3)::acc)
((fun acc -> (f 4)::acc)
((fun acc -> (f 5)::acc)
(id [])))))
which builds up a list in-order without requiring you to reverse it.
For what its worth, start writing functions in non-tail recursive way, they're easier to read and work with.
If you have a big list to go through, use an accumulator variable.
If you can't find a way to use an accumulator in a convenient way and you don't have any other options at your disposal, use continuations. I personally consider non-trivial, heavy use of continuations hard to read.
An attempt at a shorter explanation than in the other examples:
let rec foo n =
match n with
| 0 -> 0
| _ -> 2 + foo (n-1)
let rec bar acc n =
match n with
| 0 -> acc
| _ -> bar (acc+2) (n-1)
Here, foo is not tail-recursive, because foo has to call foo recursively in order to evaluate 2+foo(n-1) and return it.
However, bar ís tail-recursive, because bar doesn't have to use the return value of the recursive call in order to return a value. It can just let the recursively called bar return its value immediately (without returning all the way up though the calling stack). The compiler sees this and optimized this by rewriting the recursion into a loop.
Changing the last line in bar into something like | _ -> 2 + (bar (acc+2) (n-1)) would again destroy the function being tail-recursive, since 2 + leads to an action that needs to be done after the recursive call is finished.
Here is a more obvious example, compare it to what you would normally do for a factorial.
let factorial n =
let rec fact n acc =
match n with
| 0 -> acc
| _ -> fact (n-1) (acc*n)
fact n 1
This one is a bit complex, but the idea is that you have an accumulator that keeps a running tally, rather than modifying the return value.
Additionally, this style of wrapping is usually a good idea, that way your caller doesn't need to worry about seeding the accumulator (note that fact is local to the function)
I'm learning F# too.
The following are non-tail recursive and tail recursive function to calculate the fibonacci numbers.
Non-tail recursive version
let rec fib = function
| n when n < 2 -> 1
| n -> fib(n-1) + fib(n-2);;
Tail recursive version
let fib n =
let rec tfib n1 n2 = function
| 0 -> n1
| n -> tfib n2 (n2 + n1) (n - 1)
tfib 0 1 n;;
Note: since the fibanacci number could grow really fast you could replace last line tfib 0 1 n to
tfib 0I 1I n to take advantage of Numerics.BigInteger Structure in F#
Also, when testing, don't forget that indirect tail recursion (tailcall) is turned off by default when compiling in Debug mode. This can cause tailcall recursion to overflow the stack in Debug mode but not in Release mode.