for simple problems like fibonacci, writing CPS is relatively straightforward
let fibonacciCPS n =
let rec fibonacci_cont a cont =
if a <= 2 then cont 1
else
fibonacci_cont (a - 2) (fun x ->
fibonacci_cont (a - 1) (fun y ->
cont(x + y)))
fibonacci_cont n (fun x -> x)
However, in the case of the rod-cutting exemple from here (or the book intro to algo), the number of closure is not always equal to 2, and can't be hard coded.
I imagine one has to change the intermediate variables to sequences.
(I like to think of the continuation as a contract saying "when you have the value, pass it on to me, then i'll pass it on to my boss after treatment" or something along those line, which defers the actual execution)
For the rod cutting, we have
//rod cutting
let p = [|1;5;8;9;10;17;17;20;24;30|]
let rec r n = seq { yield p.[n-1]; for i in 1..(n-1) -> (p.[i-1] + r (n-i)) } |> Seq.max
[1 .. 10] |> List.map (fun i -> i, r i)
In this case, I will need to attached the newly created continuation
let cont' = fun (results: _ array) -> cont(seq { yield p.[n-1]; for i in 1..(n-1) -> (p.[i-1] + ks.[n-i]) } |> Seq.max)
to the "cartesian product" continuation made by the returning subproblems.
Has anyone seen a CPS version of rod-cutting / has any tips on this ?
I assume you want to explicitly CPS everything, which means some nice stuff like the list comprehension will be lost (maybe using async blocks can help, I don't know F# very well) -- so starting from a simple recursive function:
let rec cutrod (prices: int[]) = function
| 0 -> 0
| n -> [1 .. min n (prices.Length - 1)] |>
List.map (fun i -> prices.[i] + cutrod prices (n - i)) |>
List.max
It's clear that we need CPS versions of the list functions used (map, max and perhaps a list-building function if you want to CPS the [1..(blah)] expression too). map is quite interesting since it's a higher-order function, so its first parameter needs to be modified to take a CPS-ed function instead. Here's an implementation of a CPS List.map:
let rec map_k f list k =
match list with
| [] -> k []
| x :: xs -> f x (fun y -> map_k f xs (fun ys -> k (y :: ys)))
Note that map_k invokes its argument f like any other CPS function, and puts the recursion in map_k into the continuation. With map_k, max_k, gen_k (which builds a list from 1 to some value), the cut-rod function can be CPS-ed:
let rec cutrod_k (prices: int[]) n k =
match n with
| 0 -> k 0
| n -> gen_k (min n (prices.Length - 1)) (fun indices ->
map_k (fun i k -> cutrod_k prices (n - i) (fun ret -> k (prices.[i] + ret)))
indices
(fun totals -> max_k totals k))
Related
I would like to find out, how to write a function, that would accept two parameters i.e. a' and b' (that are functions), as well as a list of lists;
And then if the sum of elements in any list in the list of int-lists (containing integers I mean) is an odd number, it would perform an operation of multiplication - function a'
(mult. with the same integer -> x * x), over each element in that list.
Otherwise, in case if the sum of elements in any list in the list of int-lists is even, it would perform an operation of addition - function b'
(add. with the same integer -> x + x), over each of the elements in that list.
So, the call of the function with the input would as such be:
func a b [[1;3];[8;3]];;
... and then the output should look like this:
- : int list list = [[2; 6]; [64; 9]]
The sum of elements in the first list is even number, so the first list will be additioned
and the sum of elements in the second list is odd number, which means that the second list will be multiplied.
I've written this function in Ocaml as an exercise and I'm really struggling to understand this language; I'd like to know what I'm doing wrong...
Also, strategic help would be much appreciated! - that is, an explanation of how things
actually work here in Ocaml, although I'm not exactly a complete newbie to Ocaml, I'e already learned a lot about tail-recursive functions, it's just the exchange of parameters between functions that's bothering me.
OK, here's the code:
let a = List.map (List.fold_left ( + ) 0)
let b = List.map (List.fold_left ( * ) 0)
let rec func a b lists = if lists = [] then []
else if ((List.map (List.fold_left ( + ) 0)) mod 2 = 0) then List.map
(List.fold_left ( + ) 0)
else List.map (List.fold_left ( * ) 0)
(* Function call: *)
func (fun x -> x*x) (fun x -> x+x) [[1;3];[5;7]];;
You are dealing with lists of lists here. So you need to List.map the list of lists, and also List.map each individual list.
When you do List.map (List.fold_left ( + ) 0) you have partial application to two function:
For List.fold_left you give the function to be applied, and the initial element, and are left with a function that still takes a list.
For List.map the first argument (function to be applied) is given, and you end up with a function that would still take the list of lists: So at this point, it is still an unevaluated function. You can't do mod 2 with it, because you don't have an integer.
Your a and b defined at the top aren't actually used, because they will be shadowed by the function arguments in your func.
When you call func (fun x -> x*x) (fun x -> x+x) [[1;3];[5;7]];;, the a will be (fun x -> x*x), the b will be (fun x -> x+x) and your lists will be [[1;3];[5;7]].
Your func is not a recursive function, it does not call itself. The List.map you are using is not tail recursive, and the List.fold_left is.
See:
https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html#VALmap
https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html#VALfold_left
This might be useful for understanding tail recursion: https://www.cs.cornell.edu/courses/cs3110/2020sp/textbook/data/tail_recursion.html
I'd minimally change your code to this:
let func a b lists =
let is_even l = List.fold_left ( + ) 0 l mod 2 = 0 in
List.map (fun l -> if is_even l then List.map b l else List.map a l) lists
(* Function call: *)
let _ = func (fun x -> x*x) (fun x -> x+x) [[1;4];[5;7]]
It maps the list of lists, so l is a list. Then it checks if the sum of that list is even, and if so, applies the function b to each individual element, otherwise a.
EDIT:
If you wanted to make it tail-recursive, you can switch out the List.map with List.rev_map, then reverse the mapped list with List.rev.
the question in short: What is the most idiomatic way to do "recursive List comprehension" in F#?
more detailed: As I have learned so far (I am new to F#) we have essentially the following tools to "build up" lists: List.map and list comprehension. Imho they both do more or less the same thing, they generate a list by "altering" the elements of a given list (in case of comprehension the given list is of the form [k..n]).
What I want to do is to inductively build up lists (before people ask: for no other reason than curiosity) i.e. is there any built in function with the behavior one would expect from a function called something like "List.maplist" that might take as arguments
a function f : 'a List -> 'a and an n : int,
returning the list
[... ; f (f []) ; f [] ] of length n.
To illustrate what I mean I wrote such a function on my own (as an exercise)
let rec recListComprehension f n =
if n=0 then []
else
let oldList = recListComprehension f (n-1)
f (oldList) :: oldList
or a bit less readable but in turn tail recursive:
let rec tailListComprehension f n list =
if n=0 then list
else tailListComprehension f (n-1) ((f list)::list)
let trecListComprehension f n = tailListComprehension f n []
for example, a list containing the first 200 fibonacci numbers can be generated by
let fiboGen =
function
| a::b::tail -> a+b
| _ -> 1UL
trecListComprehension (fiboGen) 200
to sum up the question: Is there a build in function in F# that behaves more or less like "trecListComprehension" and if not what is the most idiomatic way to achieve this sort of functionality?
PS: sorry for being a bit verbose..
What is the most idiomatic way to do "recursive List comprehension" in F#?
It's the matter of style. You will encounter high-order functions more often. For certain situations e.g. expressing nested computation or achieving laziness, using sequence expression seems more natural.
To illustrate, your example is written in sequence expression:
let rec recListComprehension f n = seq {
if n > 0 then
let oldList = recListComprehension f (n-1)
yield f oldList
yield! oldList }
recListComprehension fiboGen 200 |> Seq.toList
You have a very readable function with both laziness and tail-recursiveness which you can't easily achieve by using Seq.unfold.
Similarly, nested computation of cartesian product is more readable to use sequence expression / list comprehension:
let cartesian xs ys =
[ for x in xs do
for y in ys do
yield (x, y) ]
than to use high-order functions:
let cartesian xs ys =
List.collect (fun x -> List.map (fun y -> (x, y)) ys) xs
I once asked about differences between list comprehension and high-order functions which might be of your interest.
You're basically folding over the numeric range. So it could be written:
let listComp f n = List.fold (fun xs _ -> f xs :: xs) [] [1 .. n]
This has the added benefit of gracefully handling negative values of n.
You could do a Seq.unfold and then do Seq.toList.
See the example from here:
let seq1 = Seq.unfold (fun state -> if (state > 20) then None else Some(state, state + 1)) 0
printfn "The sequence seq1 contains numbers from 0 to 20."
for x in seq1 do printf "%d " x
let fib = Seq.unfold (fun state ->
if (snd state > 1000) then None
else Some(fst state + snd state, (snd state, fst state + snd state))) (1,1)
printfn "\nThe sequence fib contains Fibonacci numbers."
for x in fib do printf "%d " x
I need a very efficient way to find duplicates in an unsorted sequence. This is what I came up with, but it has a few shortcomings, namely it
unnecessarily counts occurrences beyond 2
consumes the entire sequence before yielding duplicates
creates several intermediate sequences
module Seq =
let duplicates items =
items
|> Seq.countBy id
|> Seq.filter (snd >> ((<) 1))
|> Seq.map fst
Regardless of the shortcomings, I don't see a reason to replace this with twice the code. Is it possible to improve this with comparably concise code?
A more elegant functional solution:
let duplicates xs =
Seq.scan (fun xs x -> Set.add x xs) Set.empty xs
|> Seq.zip xs
|> Seq.choose (fun (x, xs) -> if Set.contains x xs then Some x else None)
Uses scan to accumulate sets of all elements seen so far. Then uses zip to combine each element with the set of elements before it. Finally, uses choose to filter out the elements that are in the set of previously-seen elements, i.e. the duplicates.
EDIT
Actually my original answer was completely wrong. Firstly, you don't want duplicates in your outputs. Secondly, you want performance.
Here is a purely functional solution that implements the algorithm you're after:
let duplicates xs =
(Map.empty, xs)
||> Seq.scan (fun xs x ->
match Map.tryFind x xs with
| None -> Map.add x false xs
| Some false -> Map.add x true xs
| Some true -> xs)
|> Seq.zip xs
|> Seq.choose (fun (x, xs) ->
match Map.tryFind x xs with
| Some false -> Some x
| None | Some true -> None)
This uses a map to track whether each element has been seen before once or many times and then emits the element if it is seen having only been seen once before, i.e. the first time it is duplicated.
Here is a faster imperative version:
let duplicates (xs: _ seq) =
seq { let d = System.Collections.Generic.Dictionary(HashIdentity.Structural)
let e = xs.GetEnumerator()
while e.MoveNext() do
let x = e.Current
let mutable seen = false
if d.TryGetValue(x, &seen) then
if not seen then
d.[x] <- true
yield x
else
d.[x] <- false }
This is around 2× faster than any of your other answers (at the time of writing).
Using a for x in xs do loop to enumerate the elements in a sequence is substantially slower than using GetEnumerator directly but generating your own Enumerator is not significantly faster than using a computation expression with yield.
Note that the TryGetValue member of Dictionary allows me to avoid allocation in the inner loop by mutating a stack allocated value whereas the TryGetValue extension member offered by F# (and used by kvb in his/her answer) allocates its return tuple.
Here's an imperative solution (which is admittedly slightly longer):
let duplicates items =
seq {
let d = System.Collections.Generic.Dictionary()
for i in items do
match d.TryGetValue(i) with
| false,_ -> d.[i] <- false // first observance
| true,false -> d.[i] <- true; yield i // second observance
| true,true -> () // already seen at least twice
}
This is the best "functional" solution I could come up with that doesn't consume the entire sequence up front.
let duplicates =
Seq.scan (fun (out, yielded:Set<_>, seen:Set<_>) item ->
if yielded.Contains item then
(None, yielded, seen)
else
if seen.Contains item then
(Some(item), yielded.Add item, seen.Remove item)
else
(None, yielded, seen.Add item)
) (None, Set.empty, Set.empty)
>> Seq.Choose (fun (x,_,_) -> x)
Assuming your sequence is finite, this solution requires one run on the sequence:
open System.Collections.Generic
let duplicates items =
let dict = Dictionary()
items |> Seq.fold (fun acc item ->
match dict.TryGetValue item with
| true, 2 -> acc
| true, 1 -> dict.[item] <- 2; item::acc
| _ -> dict.[item] <- 1; acc) []
|> List.rev
You can provide length of the sequence as the capacity of Dictionary, but it requires to enumerate the whole sequence once more.
EDIT:
To resolve 2nd problem, one could generate duplicates on demand:
open System.Collections.Generic
let duplicates items =
seq {
let dict = Dictionary()
for item in items do
match dict.TryGetValue item with
| true, 2 -> ()
| true, 1 -> dict.[item] <- 2; yield item
| _ -> dict.[item] <- 1
}
Functional solution:
let duplicates items =
let test (unique, result) v =
if not(unique |> Set.contains v) then (unique |> Set.add v ,result)
elif not(result |> Set.contains v) then (unique,result |> Set.add v)
else (unique, result)
items |> Seq.fold test (Set.empty, Set.empty) |> snd |> Set.toSeq
I'm trying to use Seq.cache with a function that I made that returns a sequence of primes up to a number N excluding the number 1. I'm having trouble figuring out how to keep the cached sequence in scope but still use it in my definition.
let rec primesNot1 n =
{2 .. n}
|> Seq.filter (fun i ->
(primesNot1 (i / 2) |> Seq.for_all (fun o -> i % o <> 0)))
|> Seq.append {2 .. 2}
|> Seq.cache
Any ideas of how I could use Seq.cache to make this faster? Currently it keeps dropping from scope and is only slowing down performance.
Seq.cache caches an IEnumerable<T> instance so that each item in the sequence is only calculated once. In your case, though, you're caching the sequence returned by a function, and each time you call the function you get a new cached sequence, which doesn't do you any good. I don't think caching is really the right approach to your problem as you've outlined it; instead you should probably look into memoization.
If instead of defining a function giving the primes less than n you want to define an infinite enumerable sequence of primes, then caching makes more sense. That would look more like this:
let rec upFrom i =
seq {
yield i
yield! upFrom (i+1)
}
let rec primes =
seq {
yield 2
yield!
upFrom 3 |>
Seq.filter (fun p -> primes |> Seq.takeWhile (fun j -> j*j <= p) |> Seq.forall (fun j -> p % j <> 0))
}
|> Seq.cache
I haven't compared the performance of this method compared to yours.
I figured out how to solve my problem with a fold but not my idea of using seq.cache.
let primesNot1 n =
{2 .. n}
|> Seq.fold (fun primes i ->
if primes |> Seq.for_all (fun o -> i % o <> 0) then
List.append primes [i]
else
primes) [2]
Have you taken a look at LazyList? Seems like it's designed to solve the same problem. It's in PowerPack.
Inspired by this question and answer, how do I create a generic permutations algorithm in F#? Google doesn't give any useful answers to this.
EDIT: I provide my best answer below, but I suspect that Tomas's is better (certainly shorter!)
you can also write something like this:
let rec permutations list taken =
seq { if Set.count taken = List.length list then yield [] else
for l in list do
if not (Set.contains l taken) then
for perm in permutations list (Set.add l taken) do
yield l::perm }
The 'list' argument contains all the numbers that you want to permute and 'taken' is a set that contains numbers already used. The function returns empty list when all numbers all taken.
Otherwise, it iterates over all numbers that are still available, gets all possible permutations of the remaining numbers (recursively using 'permutations') and appends the current number to each of them before returning (l::perm).
To run this, you'll give it an empty set, because no numbers are used at the beginning:
permutations [1;2;3] Set.empty;;
I like this implementation (but can't remember the source of it):
let rec insertions x = function
| [] -> [[x]]
| (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys))
let rec permutations = function
| [] -> seq [ [] ]
| x :: xs -> Seq.concat (Seq.map (insertions x) (permutations xs))
Tomas' solution is quite elegant: it's short, purely functional, and lazy. I think it may even be tail-recursive. Also, it produces permutations lexicographically. However, we can improve performance two-fold using an imperative solution internally while still exposing a functional interface externally.
The function permutations takes a generic sequence e as well as a generic comparison function f : ('a -> 'a -> int) and lazily yields immutable permutations lexicographically. The comparison functional allows us to generate permutations of elements which are not necessarily comparable as well as easily specify reverse or custom orderings.
The inner function permute is the imperative implementation of the algorithm described here. The conversion function let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } allows us to use the System.Array.Sort overload which does in-place sub-range custom sorts using an IComparer.
let permutations f e =
///Advances (mutating) perm to the next lexical permutation.
let permute (perm:'a[]) (f: 'a->'a->int) (comparer:System.Collections.Generic.IComparer<'a>) : bool =
try
//Find the longest "tail" that is ordered in decreasing order ((s+1)..perm.Length-1).
//will throw an index out of bounds exception if perm is the last permuation,
//but will not corrupt perm.
let rec find i =
if (f perm.[i] perm.[i-1]) >= 0 then i-1
else find (i-1)
let s = find (perm.Length-1)
let s' = perm.[s]
//Change the number just before the tail (s') to the smallest number bigger than it in the tail (perm.[t]).
let rec find i imin =
if i = perm.Length then imin
elif (f perm.[i] s') > 0 && (f perm.[i] perm.[imin]) < 0 then find (i+1) i
else find (i+1) imin
let t = find (s+1) (s+1)
perm.[s] <- perm.[t]
perm.[t] <- s'
//Sort the tail in increasing order.
System.Array.Sort(perm, s+1, perm.Length - s - 1, comparer)
true
with
| _ -> false
//permuation sequence expression
let c = f |> comparer
let freeze arr = arr |> Array.copy |> Seq.readonly
seq { let e' = Seq.toArray e
yield freeze e'
while permute e' f c do
yield freeze e' }
Now for convenience we have the following where let flip f x y = f y x:
let permutationsAsc e = permutations compare e
let permutationsDesc e = permutations (flip compare) e
My latest best answer
//mini-extension to List for removing 1 element from a list
module List =
let remove n lst = List.filter (fun x -> x <> n) lst
//Node type declared outside permutations function allows us to define a pruning filter
type Node<'a> =
| Branch of ('a * Node<'a> seq)
| Leaf of 'a
let permutations treefilter lst =
//Builds a tree representing all possible permutations
let rec nodeBuilder lst x = //x is the next element to use
match lst with //lst is all the remaining elements to be permuted
| [x] -> seq { yield Leaf(x) } //only x left in list -> we are at a leaf
| h -> //anything else left -> we are at a branch, recurse
let ilst = List.remove x lst //get new list without i, use this to build subnodes of branch
seq { yield Branch(x, Seq.map_concat (nodeBuilder ilst) ilst) }
//converts a tree to a list for each leafpath
let rec pathBuilder pth n = // pth is the accumulated path, n is the current node
match n with
| Leaf(i) -> seq { yield List.rev (i :: pth) } //path list is constructed from root to leaf, so have to reverse it
| Branch(i, nodes) -> Seq.map_concat (pathBuilder (i :: pth)) nodes
let nodes =
lst //using input list
|> Seq.map_concat (nodeBuilder lst) //build permutations tree
|> Seq.choose treefilter //prune tree if necessary
|> Seq.map_concat (pathBuilder []) //convert to seq of path lists
nodes
The permutations function works by constructing an n-ary tree representing all possible permutations of the list of 'things' passed in, then traversing the tree to construct a list of lists. Using 'Seq' dramatically improves performance as it makes everything lazy.
The second parameter of the permutations function allows the caller to define a filter for 'pruning' the tree before generating the paths (see my example below, where I don't want any leading zeros).
Some example usage: Node<'a> is generic, so we can do permutations of 'anything':
let myfilter n = Some(n) //i.e., don't filter
permutations myfilter ['A';'B';'C';'D']
//in this case, I want to 'prune' leading zeros from my list before generating paths
let noLeadingZero n =
match n with
| Branch(0, _) -> None
| n -> Some(n)
//Curry myself an int-list permutations function with no leading zeros
let noLZperm = permutations noLeadingZero
noLZperm [0..9]
(Special thanks to Tomas Petricek, any comments welcome)
If you need distinct permuations (when the original set has duplicates), you can use this:
let rec insertions pre c post =
seq {
if List.length post = 0 then
yield pre # [c]
else
if List.forall (fun x->x<>c) post then
yield pre#[c]#post
yield! insertions (pre#[post.Head]) c post.Tail
}
let rec permutations l =
seq {
if List.length l = 1 then
yield l
else
let subperms = permutations l.Tail
for sub in subperms do
yield! insertions [] l.Head sub
}
This is a straight-forward translation from this C# code. I am open to suggestions for a more functional look-and-feel.
Take a look at this one:
http://fsharpcode.blogspot.com/2010/04/permutations.html
let length = Seq.length
let take = Seq.take
let skip = Seq.skip
let (++) = Seq.append
let concat = Seq.concat
let map = Seq.map
let (|Empty|Cons|) (xs:seq<'a>) : Choice<Unit, 'a * seq<'a>> =
if (Seq.isEmpty xs) then Empty else Cons(Seq.head xs, Seq.skip 1 xs)
let interleave x ys =
seq { for i in [0..length ys] ->
(take i ys) ++ seq [x] ++ (skip i ys) }
let rec permutations xs =
match xs with
| Empty -> seq [seq []]
| Cons(x,xs) -> concat(map (interleave x) (permutations xs))
If you need permutations with repetitions, this is the "by the book" approach using List.indexed instead of element comparison to filter out elements while constructing a permutation.
let permutations s =
let rec perm perms carry rem =
match rem with
| [] -> carry::perms
| l ->
let li = List.indexed l
let permutations =
seq { for ci in li ->
let (i, c) = ci
(perm
perms
(c::carry)
(li |> List.filter (fun (index, _) -> i <> index) |> List.map (fun (_, char) -> char))) }
permutations |> Seq.fold List.append []
perm [] [] s