Using the following continuation monad:
type ContinuationMonad() =
member this.Bind (m, f) = fun c -> m (fun a -> f a c)
member this.Return x = fun k -> k x
let cont = ContinuationMonad()
I fail to see why the following gives me a stack overflow:
let map f xs =
let rec map xs =
cont {
match xs with
| [] -> return []
| x :: xs ->
let! xs = map xs
return f x :: xs
}
map xs id;;
let q = [1..100000] |> map ((+) 1)
While the following doesn't:
let map f xs =
let rec map xs =
cont {
match xs with
| [] -> return []
| x :: xs ->
let! v = fun g -> g(f x)
let! xs = map xs
return v :: xs
}
map xs id;;
let q = [1..100000] |> map ((+) 1)
To fix your example, add this method to your definition of the monad:
member this.Delay(mk) = fun c -> mk () c
Apparently the part that overflows is the destruction of the large input list in the recursive call of map. Delaying it solves the problem.
Note that your second version puts the recursive call to map behind another let! which desugars to Bind and an extra lambda, in effect delaying the recursive call to map.
I had to pursue a few false trails before reaching this conclusion. What helped was observing that StackOverflow is thrown by OCaml as well (albeit at a higher N) unless the recursive call is delayed. While F# TCO has some quirks, OCaml is more proven, so this convinced me that the problem is indeed with the code and not the compiler:
let cReturn x = fun k -> k x
let cBind m f = fun c -> m (fun a -> f a c)
let map f xs =
(* inner map loop overflows trying to pattern-match long lists *)
let rec map xs =
match xs with
| [] -> cReturn []
| x :: xs ->
cBind (map xs) (fun xs -> cReturn (f x :: xs)) in
map xs (fun x -> x)
let map_fixed f xs =
(* works without overflowing by delaying the recursive call *)
let rec map xs =
match xs with
| [] -> cReturn []
| x :: xs ->
cBind (fun c -> map xs c) (fun xs -> cReturn (f x :: xs)) in
map xs (fun x -> x)
let map_fused f xs =
(* manually fused version avoids the problem by tail-calling `map` *)
let rec map xs k =
match xs with
| [] -> k []
| x :: xs ->
map xs (fun xs -> k (f x :: xs)) in
map xs (fun x -> x)
The F# compiler is sometimes not very clever - in the first case it computes map xs then f x and then joins them, so map xs is not in a tail position. In the second case, it can reorder the map xs to be in tail position easily.
Related
Given a list of elements, I need to turn each element into a pair of the index number and the element. There are several ways to do it; this is the most concise I have found so far:
List.mapi (fun i x->i,x) xs
But is there a more concise/idiomatic way to do it? For example, does F# have some built-in function to turn two elements into a pair, some equivalent of the C++ make_pair?
There is a function in the standard library that does exactly that: List.indexed
Eight Ways to Write Indexed
As there is more than one way to do it (TIMTOWTDI) it is always good to learn about different approaches and it different pros and cons. Remember that there is never only one way to solve something. Here some examples you can learn from if you try to understand them.
1. The List Comprehension
let indexed1 xs =
let mutable idx = 0
[ for x in xs do
yield idx,x
idx <- idx + 1 ]
2. Ziping It!
let indexed2 xs =
List.zip
(List.init (List.length xs) id)
xs
3. Recursion
let indexed3 xs =
let rec cata idx xs =
match xs with
| [] -> []
| x::xs -> (idx,x) :: cata (idx+1) xs
cata 0 xs
4. Tail-Recursion
let indexed4 xs =
let rec loop idx result xs =
match xs with
| [] -> result
| x::xs -> loop (idx+1) ((idx,x) :: result) xs
List.rev (loop 0 [] xs)
5. Folding it
let indexed5 xs =
let mutable idx = -1
List.fold (fun state x ->
idx <- idx + 1
(idx,x) :: state
) [] xs
|> List.rev
6. Folding without mutable
let indexed6 xs =
List.fold (fun (idx,state) x ->
(idx+1), (idx,x) :: state
) (0,[]) xs
|> snd
|> List.rev
7. Folding it Backwards
let indexed7 xs =
let lastIdx = List.length xs - 1
List.foldBack (fun x (idx,xs) ->
(idx-1), ((idx,x) :: xs)
) xs (lastIdx,[])
|> snd
8. Arraying it
let indexed8 xs =
let arr = Array.ofList xs
let mutable result = []
for idx=(arr.Length - 1) downto 0 do
result <- (idx,arr.[idx]) :: result
result
I have to write a program which give in output a tuple with: min and max of a not-empty list and the value that appears most often.
In particular:
min_max [1;0;-1;2;0;-4] ==> (-4; 2)
min_max: int list -> (int * int)
mode [-1;2;1;2;5;-1;5;5;2] ==> 2
mode: int list -> int
This is the code that I wrote for max (min is almost equal) but how can I do to receive as output a tuple with the two values?
let rec max_list xs =
match xs with
| [] -> failwith "xs" "Empty list"
| [x] -> x
| x1::x2::xs' -> max_list((max2 x1 x2)::xs');;
I'll take the first suggestion from #Mark Seemann's answer and run with it, in order to make it generic, working with any collection type, and handle the case of the empty collection sensibly.
let tryMinMax xs =
Seq.fold (function
| Some(mn, mx) -> fun i -> Some(min mn i, max mx i)
| None -> fun i -> Some(i, i) ) None xs
[1;0;-1;2;0;-4]
|> tryMinMax
// val it : (int * int) option = Some (-4, 2)
For the most frequent part of the question:
let mostFrequent xs =
xs
|> Seq.countBy id
|> Seq.maxBy snd
|> fst
[1;0;-1;2;0;-4]
|> mostFrequent
// val it : int = 0
let minMax xs =
xs
|> List.fold
(fun (mn, mx) i -> min mn i, max mx i)
(System.Int32.MaxValue, System.Int32.MinValue)
Not particularly efficient, but fun to write:
let mode xs =
xs
|> List.groupBy id
|> List.map (fun (i, is) -> i, Seq.length is)
|> List.maxBy snd
|> fst
Option without the use of standard modules:
open System
let tryMinMax xs =
let rec minMax xs mn mx =
match xs with | [] -> mn, mx | h::t -> minMax t (min mn h) (max mx h)
match xs with | [] -> None | _ -> Some(minMax xs Int32.MaxValue Int32.MinValue)
dotnetfiddle
On the second question - show their attempts to solve.
This is a reference question to this: StackOverflow in continuation monad
with whom I played a little and would need a few clarifications.
1) I suppose this:
member this.Delay(mk) = fun c -> mk () c
makes the behavior in computational workflow do the diffrence as showed by toyvo between these:
cBind (map xs) (fun xs -> cReturn (f x :: xs))
cBind (fun c -> map xs c) (fun xs -> cReturn (f x :: xs))
So I don't exactly understand what is the trick, when
(fun c -> map xs c) is only different notation of (map xs)
2) Inference issue. - In OP's second map example I found out it doesn't compile due to inference problem with v value, because it infers f as a -> b list, instead of desired a -> b. Why it infers in this way? In case let v = f x it would infer well.
3) It seems to me that VS shows inaccurate type signatures in the tooltips:
return type of the monad's Return is: ('e->'f)->f, while the return type of the Bind is only 'c->'b. -It seems it simplify ('e->'f) to only c in the Bind case, or am I missing something here?
Thanks for the clarification,
tomas
Edit - testing dump:
let cReturn x = fun k -> k x
let cBind m f =
printfn "cBind %A" <| m id
fun c -> m (fun a -> f a c)
let map_fixed f xs =
let rec map xs =
printfn "map %A" xs
match xs with
| [] -> cReturn []
| x :: xs -> cBind (fun c -> map xs c) (fun xs -> cReturn (f x :: xs))
map xs (fun x -> x)
let map f xs =
let rec map xs =
printfn "map %A" xs
match xs with
| [] -> cReturn []
| x :: xs -> cBind (map xs) (fun xs -> cReturn (f x :: xs))
map xs (fun x -> x)
[1..2] |> map_fixed ((+) 1) |> printfn "%A"
[1..2] |> map ((+) 1) |> printfn "%A"
map_fixed:
map [1; 2]
map [2]
map []
cBind []
map []
cBind [3]
map [2]
map []
cBind []
map []
[2; 3]
map:
map [1; 2]
map [2]
map []
cBind []
cBind [3]
[2; 3]
Edit to question 2:
let map f xs =
let rec map xs =
cont {
match xs with
| [] -> return []
| x :: xs ->
let v = f x // Inference ok
//let! v = cont { return f x } // ! Inference issue - question 2
let! xs = map xs
return v :: xs
}
map xs id
The issue is exactly that fun c -> map xs c is not the same as map xs. They have the same "meaning" in some sense, but their runtime semantics are different. In the latter case, evaluating the expression results in an immediate call to the map function with xs as an argument (returning another function as the result). On the other hand, evaluating fun c -> map xs c does not result in an immediate call to map! The call to map is delayed until the resulting function is actually applied. This is the critical difference that prevents a stack overflow.
Regarding your other questions, I can't quite make out what you're asking in your second question. For your third question, the compiler has inferred the most general type possible for Bind. You're right that the traditional type that you might expect is more specific than this, but it's not really a problem that you can call Bind in a wider set of contexts than is strictly necessary. And if you really want a more specific type, you can always add annotations to constrain the signature.
For cartesian production there is a good enough function - sequence which defined like that:
let rec sequence = function
| [] -> Seq.singleton []
| (l::ls) -> seq { for x in l do for xs in sequence ls do yield (x::xs) }
but look at its result:
sequence [[1..2];[1..10000]] |> Seq.skip 1000 ;;
val it : seq = seq [[1; 1001]; [1; 1002]; [1; 1003]; [1; 1004]; ...]
As we can see the first "coordinate" of the product alters very slowly and it will change the value when the second list is ended.
I wrote my own sequence as following (comments below):
/// Sum of all producted indeces = n
let rec hyper'plane'indices indexsum maxlengths =
match maxlengths with
| [x] -> if indexsum < x then [[indexsum]] else []
| (i::is) -> [for x in [0 .. min indexsum (i-1)] do for xs in hyper'plane'indices (indexsum-x) is do yield (x::xs)]
| [] -> [[]]
let finite'sequence = function
| [] -> Seq.singleton []
| ns ->
let ars = [ for n in ns -> Seq.toArray n ]
let length'list = List.map Array.length ars
let nmax = List.max length'list
seq {
for n in [0 .. nmax] do
for ixs in hyper'plane'indices n length'list do
yield (List.map2 (fun (a:'a[]) i -> a.[i]) ars ixs)
}
The key idea is to look at (two) lists as at (two) orthogonal dimensions where every element marked by its index in the list. So we can enumerate all elements by enumerating every element in every section of cartesian product by hyper plane (in 2D case this is a line). In another words imagine excel's sheet where first column contains values from [1;1] to [1;10000] and second - from [2;1] to [2;10000]. And "hyper plane" with number 1 is the line that connects cell A2 and cell B1. For the our example
hyper'plane'indices 0 [2;10000];; val it : int list list = [[0; 0]]
hyper'plane'indices 1 [2;10000];; val it : int list list = [[0; 1]; [1; 0]]
hyper'plane'indices 2 [2;10000];; val it : int list list = [[0; 2]; [1; 1]]
hyper'plane'indices 3 [2;10000];; val it : int list list = [[0; 3]; [1; 2]]
hyper'plane'indices 4 [2;10000];; val it : int list list = [[0; 4]; [1; 3]]
Well if we have indeces and arrays that we are producing from the given lists than we can now define sequence as {all elements in plane 0; than all elements in plane 1 ... and so on } and get more volatile function than original sequence.
But finite'sequence turned out very gluttonous function. And now the question. How I can improve it?
With best wishes, Alexander. (and sorry for poor English)
Can you explain what exactly is the problem - time or space complexity or performance? Do you have a specific benchmark in mind? I am not sure how to improve on the time complexity here, but I edited your code a bit to remove the intermediate lists, which might help a bit with memory allocation behavior.
Do not do this:
for n in [0 .. nmax] do
Do this instead:
for n in 0 .. nmax do
Here is the code:
let rec hyper'plane'indices indexsum maxlengths =
match maxlengths with
| [] -> Seq.singleton []
| [x] -> if indexsum < x then Seq.singleton [indexsum] else Seq.empty
| i :: is ->
seq {
for x in 0 .. min indexsum (i - 1) do
for xs in hyper'plane'indices (indexsum - x) is do
yield x :: xs
}
let finite'sequence xs =
match xs with
| [] -> Seq.singleton []
| ns ->
let ars = [ for n in ns -> Seq.toArray n ]
let length'list = List.map Array.length ars
let nmax = List.max length'list
seq {
for n in 0 .. nmax do
for ixs in hyper'plane'indices n length'list do
yield List.map2 Array.get ars ixs
}
Does this fare any better? Beautiful problem by the way.
UPDATE: Perhaps you are more interested to mix the sequences fairly than in maintaining the exact formula in your algorithm. Here is a Haskell code that mixes a finite number of possibly infinite sequences fairly, where fairness means that for every input element there is a finite prefix of the output sequence that contains it. You mention in the comment that you have a 2D incremental solution that is hard to generalize to N dimensions, and the Haskell code does exactly that:
merge :: [a] -> [a] -> [a]
merge [] y = y
merge x [] = x
merge (x:xs) (y:ys) = x : y : merge xs ys
prod :: (a -> b -> c) -> [a] -> [b] -> [c]
prod _ [] _ = []
prod _ _ [] = []
prod f (x:xs) (y:ys) = f x y : a `merge` b `merge` prod f xs ys where
a = [f x y | x <- xs]
b = [f x y | y <- ys]
prodN :: [[a]] -> [[a]]
prodN [] = [[]]
prodN (x:xs) = prod (:) x (prodN xs)
I have not ported this to F# yet - it requires some thought as sequences do not match to head/tail very well.
UPDATE 2:
A fairly mechanical translation to F# follows.
type Node<'T> =
| Nil
| Cons of 'T * Stream<'T>
and Stream<'T> = Lazy<Node<'T>>
let ( !! ) (x: Lazy<'T>) = x.Value
let ( !^ ) x = Lazy.CreateFromValue(x)
let rec merge (xs: Stream<'T>) (ys: Stream<'T>) : Stream<'T> =
lazy
match !!xs, !!ys with
| Nil, r | r, Nil -> r
| Cons (x, xs), Cons (y, ys) -> Cons (x, !^ (Cons (y, merge xs ys)))
let rec map (f: 'T1 -> 'T2) (xs: Stream<'T1>) : Stream<'T2> =
lazy
match !!xs with
| Nil -> Nil
| Cons (x, xs) -> Cons (f x, map f xs)
let ( ++ ) = merge
let rec prod f xs ys =
lazy
match !!xs, !!ys with
| Nil, _ | _, Nil -> Nil
| Cons (x, xs), Cons (y, ys) ->
let a = map (fun x -> f x y) xs
let b = map (fun y -> f x y) ys
Cons (f x y, a ++ b ++ prod f xs ys)
let ofSeq (s: seq<'T>) =
lazy
let e = s.GetEnumerator()
let rec loop () =
lazy
if e.MoveNext()
then Cons (e.Current, loop ())
else e.Dispose(); Nil
!! (loop ())
let toSeq stream =
stream
|> Seq.unfold (fun stream ->
match !!stream with
| Nil -> None
| Cons (x, xs) -> Some (x, xs))
let empty<'T> : Stream<'T> = !^ Nil
let cons x xs = !^ (Cons (x, xs))
let singleton x = cons x empty
let rec prodN (xs: Stream<Stream<'T>>) : Stream<Stream<'T>> =
match !!xs with
| Nil -> singleton empty
| Cons (x, xs) -> prod cons x (prodN xs)
let test () =
ofSeq [
ofSeq [1; 2; 3]
ofSeq [4; 5; 6]
ofSeq [7; 8; 9]
]
|> prodN
|> toSeq
|> Seq.iter (fun xs ->
toSeq xs
|> Seq.map string
|> String.concat ", "
|> stdout.WriteLine)
I have a simple f# quick sort function defined as:
let rec qsort(xs:List<int>) =
let smaller = xs |> List.filter(fun e -> e < xs.Head)
let larger = xs |> List.filter(fun e -> e > xs.Head)
match xs with
| [] -> []
| _ -> qsort(smaller)#[xs.Head]#qsort(larger)
Is there a way in f# to write it more like Haskell:
qsort :: [Int] -> [Int]
qsort [] = []
qsort (x:xs) =
qsort smaller ++ [x] ++ qsort larger
where
smaller = [a | a <- xs, a <= x]
larger = [b | b <- xs, b >= x]
I know the f# algorithm is missing a <= and >=. The question is more about syntax/readibility.
Thanks.
This is the most 'Haskellian' way I can think of, the only thing missing is being able to declare smaller/larger as a 'where' clause:
let rec qsort:int list -> int list = function
| [] -> []
| x::xs -> let smaller = [for a in xs do if a<=x then yield a]
let larger = [for b in xs do if b>x then yield b]
qsort smaller # [x] # qsort larger
I know it's not part of your question, but I'd use List.partition to split the list in smaller/larger in a single pass:
let rec qsort = function
| [] -> []
| x::xs -> let smaller,larger = List.partition (fun y -> y<=x) xs
qsort smaller # [x] # qsort larger
You want your second match clause to be x :: xs, and to use the # (append) operator where your Haskell example uses ++:
let rec qsort xs =
match xs with
| [] -> []
| x :: xs ->
let smaller = qsort (xs |> List.filter(fun e -> e <= x))
let larger = qsort (xs |> List.filter(fun e -> e > x))
smaller # [x] # larger
It's not quite the same as the Haskell definition by cases syntax, but hopefully similar enough for you!
...Or you could make a tail recursive qsort by using CPS:
let qSort lst =
let rec qs l cont =
match l with
| [] -> cont []
| (x::xs) -> qs (List.filter (fun e -> e <= x) xs) (fun smaller ->
qs (List.filter (fun e -> e > x) xs) (fun larger ->
smaller # (x :: larger) |> cont))
qs lst id
This seems to be as concise as it can get (combining the ideas from other answers, and using currying for operators):
let rec qsort = function
| [] -> []
| (x:int) :: xs ->
let smaller = List.filter ((>=) x) xs
let larger = List.filter ((<) x) xs
qsort smaller # [x] # qsort larger
haskell 'where' syntax, which lets you use the name of a function before its definition, kind of maps to f# 'let rec ... and'
let qsort xs =
let rec sort xs =
match ls with
|[] -> ....
|h::t -> (smaller t) # h # (larger t)
and smaller ls = //the 'and' lets you define the
// function after where it is used,
// like with 'where' in haskell
... define smaller in terms of sort
and larger ls =
... same
sort xs
let rec QuickSort l =
match l with
| [] -> []
| _ -> QuickSort([for e in l do if e < (List.head l) then yield e]) #[(List.head l)]# QuickSort([for e in l do if e > (List.head l) then yield e])
Don't forget that List has a partition method, so
let rec quicksort ls =
match ls with
| [] -> []
| h :: t -> let fore, aft = List.partition (fun i -> i < h) t
(quicksort fore) # (h :: quicksort aft)
I had done some analysis of sorting algorithms in F# a few years ago in a very imperative style; I was trying to beat the .NET stock implementation, and managed to do so here. Went to make the following reply to myself today, but FPish won't let me create an account. Argh! Gotta make my post somewhere, and here's as good as anywhere, lol...
While reading "Learn You a Haskell For Great Good" yesterday, the author set up an example for implementing quicksort. The description was quite clear and even before I got to the sample code, an elegant recursive solution (in Haskell) popped into my head. Guess I had never really had an intuitive feel for how quicksort does its thing, because the trivial solution is quite easy, if not very efficient.
Here is my version in F#:
let rec quicksort = function
| [] -> []
| pivot :: xs ->
(left pivot xs) # pivot :: (right pivot xs)
and left pivot xs = quicksort [ for x in xs do if x <= pivot then yield x ]
and right pivot xs = quicksort [ for x in xs do if x > pivot then yield x ]
And, the equivalent Haskell (I like this one... clean!):
quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort (pivot : xs) =
left ++ pivot : right
where
left = quicksort [ x | x <- xs, x <= pivot ]
right = quicksort [ x | x <- xs, x > pivot ]
For grins, here's another F# version (mostly tail-recursive) that's about 2x the speed of the trivial version. Haven't bothered to time this against my original post, though, so no idea how it stacks up to the mutable version in my OP on FPish.net (FSHub) from a few years ago...
let rec quicksort' xs =
let rec aux pivot left right = function
| [] -> (quicksort' left) # pivot :: (quicksort' right)
| x :: xs ->
if x <= pivot then
aux pivot (x :: left) right xs
else
aux pivot left (x::right) xs
match xs with
| [] -> []
| x :: xs -> aux x [] [] xs