Given the following (simplified) F# asynchronous code, to partition items coming from an asyncSeq
open FSharp.Control
let s : AsyncSeq<'t> = ...
let a =
s
|> AsyncSeq.mapi (fun i a -> (i, a))
|> AsyncSeq.groupBy (fun (i, _) -> int(i) % 3)
|> AsyncSeq.map (fun (index, tWithIndex) -> (index + 1, tWithIndex |> AsyncSeq.map (fun (_, t) -> t)))
|> AsyncSeq.toArraySynchronously
|> Map.ofArray
|> Map.map (fun i a -> a |> AsyncSeq.toArraySynchronously)
let b =
s
|> AsyncSeq.mapi (fun i a -> (i, a))
|> AsyncSeq.groupBy (fun (i, _) -> int(i) % 3)
|> AsyncSeq.map (fun (index, tWithIndex) -> index + 1, AsyncSeq.toArraySynchronously tWithIndex |> Array.map (fun (_, t) -> t))
|> AsyncSeq.toArraySynchronously
|> Map.ofArray
I was expecting a and b to contain the same Map<int, 't[]> value, but b calculation never completes, it gets stuck.
What's wrong with b's expression?
This is a somewhat unexpected behaviour because of how AsyncSeq.groupBy works. It creates an asynchronous sequence (of groups), each of which contains an evaluated key and another asynchronous sequence of values in the group:
AsyncSeq<'TKey * AsyncSeq<'TValue>>
The issue is that the nested AsyncSeq<'TValue> sequences only get all their values when the outer asynchronous sequence of groups is evalauted to the end. If you demand a value from the nested async sequence, it blocks until the outer one is evaluated.
I can imagine an implementation of groupBy where asking for a value in the nested asyn sequence would actually resume the evaluation, but that is clearly not how it is implemented currently.
Aside from doing what you do in the a version, you could also just use the lazy keyword to delay the evaluation in the AsyncSeq.map:
let b =
s
|> AsyncSeq.mapi (fun i a -> (i, a))
|> AsyncSeq.groupBy (fun (i, _) -> int(i) % 3)
|> AsyncSeq.map (fun (index, tWithIndex) ->
index + 1,
lazy ( AsyncSeq.toArraySynchronously tWithIndex
|> Array.map (fun (_, t) -> t) ))
|> AsyncSeq.toArraySynchronously
|> Map.ofArray
Related
Find an 'item/object/type' in a recursive tree type, the tree type is UNSORTED, thus binary search operation is not going to succeed.
Type Tree = T of (Name*Children)
And Children = Tree list
//findTree :Tree*Name -> Tree
My code(which doesn't work)
let rec findTree t n = List.find(fun (T(nameTree,childTree)) -> n=nameTree ) t
I've tried using recursion and auxFunctions, but it ends up being very messy with no success.
Your base type is essentially this (cleaned up missing types):
type Tree =
| Tree of (string * Tree list)
Now the tree is unsorted, so the best you can do is a linear search, recursively going down the child nodes until a match is found. In the following case, the search goes depth-first:
[<CompilationRepresentationAttribute(CompilationRepresentationFlags.ModuleSuffix)>]
module Tree =
let find p tree =
let rec findInner t =
match t with
| Tree(n, _) when p(n) -> Some(t)
| Tree(_, children) -> children |> Seq.choose (findInner)
|> Seq.tryFind (fun _ -> true)
| Tree(_, []) -> None
findInner tree
You can use List.choose and List.tryFind if you want, I used Seq so it would stop early on tryFind.
Also, this version has a predicate match on name. If you always want to use equality, you can add the name as parameter and swap p for name and when p(n) to when n = name.
Now, a little test:
let tree = Tree("A",
[Tree("B",
[Tree("C",[]);
Tree("D",
[Tree("E",[])])
]);
Tree("F",[])
])
tree |> Tree.find (fun n -> n = "B") |> printfn "%A"
tree |> Tree.find (fun n -> n = "D") |> printfn "%A"
tree |> Tree.find (fun n -> n = "E") |> printfn "%A"
tree |> Tree.find (fun n -> n = "TEST") |> printfn "%A"
tree |> Tree.find (fun n -> n = "F") |> printfn "%A"
Which prints, respectively:
Some (Tree ("B", [Tree ("C", []); Tree ("D", [Tree ("E", [])])]))
Some (Tree ("D", [Tree ("E", [])]))
Some (Tree ("E", []))
<null>
Some (Tree ("F", []))
Dictionary<_,_>–and Seq.groupBy by extension–appears to enumerate elements in insertion order, however the order is officially undefined (see this question).
Here's a bit of code to demonstrate:
let groupByPreservesOrder l =
let l2 =
l
|> Seq.groupBy id
|> Seq.map fst
|> Seq.toList
(l = l2)
let l = List.init 1000 (fun i ->
if i % 2 <> 0 then -(i) else i / 2)
groupByPreservesOrder l //true
I need a grouping function that guarantees this behavior. What is the best (consice, efficient, idiomatic, ...) way to go about it?
EDIT
Here's one way to do it:
let groupByStable f items =
let items = items |> Seq.map (fun x -> f x, x) |> Seq.toList
let d = items |> Seq.groupBy fst |> dict
items
|> Seq.distinctBy fst
|> Seq.map (fun (k, _) -> k, Seq.map snd d.[k])
If you want to ensure that the sequence is sorted by first appearance of each key, then here's one way to do it:
let groupByOP f s =
s
|> Seq.mapi (fun i x -> i,x)
|> Seq.groupBy (snd >> f)
|> Seq.sortBy (snd >> Seq.map fst >> Seq.min)
|> Seq.map (fun (k,vs) -> k, vs |> Seq.map snd)
If you additionally want each group to be sorted by initial placement, then I think something like this should work:
let groupByOP f s =
s
|> Seq.mapi (fun i x -> i,x)
|> Seq.groupBy (snd >> f)
|> Seq.map (fun (k,vs) -> k, vs |> Seq.sortBy fst)
|> Seq.sortBy (snd >> Seq.head >> fst)
|> Seq.map (fun (k,vs) -> k, vs |> Seq.map snd)
I have a nested dictionary Map<'a,Map<'b,'T>>, so that for a combination of a*b, the entry is unique.
In order to precompute efficiently, I would need to invert the keys in a Map<'b,Map<'a,'T>>
I have some higher order methods that do the job (|/> will apply the operation in a nested sequence |//> the same, but 2 levels deep, |*> will enumerate the cartesian product of nested sequence), but I am wondering if there is a better way to do this, just in case there is beautiful code to share on this one.
let reversenmap (x:Map<'a,Map<'b,'T>>) :Map<'b,Map<'a,'T>> =
let ret = x |> Map.toSeq |/> Map.toSeq |*> squash12
let ret2 = ret |> Seq.groupByn2 (fun (a,b,t) -> b)
(fun (a,b,t) -> a) |//> Seq.head
|//> (fun (a,b,c) -> c)
ret2 |> Seq.toMapn2
I think the solution from #pad is definitely more idiomatic F# than using non-standard operators like |/> and |*>. I would probably prefer a version that uses sequence expressions instead of Seq.collect, which looks like this (the second part is the same as in the version from #pad):
let reverse (map: Map<'a,Map<'b,'T>>) =
[ for (KeyValue(a, m)) in map do
for (KeyValue(b, v)) in m do yield b, (a, v) ]
|> Seq.groupBy fst
|> Seq.map (fun (b, ats) -> b, ats |> Seq.map snd |> Map.ofSeq)
|> Map.ofSeq
I'm not sure I understand your intention. But from the signature of your function, we could do something like this:
let reverse (map: Map<'a,Map<'b,'T>>) =
map |> Seq.collect (fun (KeyValue(a, m)) ->
m |> Seq.map (fun (KeyValue(b, t)) -> b, (a, t)))
|> Seq.groupBy fst
|> Seq.map (fun (b, ats) -> b, ats |> Seq.map snd |> Map.ofSeq)
|> Map.ofSeq
#pad's solution is remarkably similar to what I came up – I guess it just goes to show that with these sorts of problems, you follow your nose doing the only things that could work until you get there.
Alternatively, if you wanted to stick to folds, you could do:
let invertNesting ( map : Map<'a, Map<'b, 'c>> ) =
let foldHelper ( oldState : Map<'b, Map<'a, 'c>> ) ( k1 : 'a ) ( innerMap : Map<'b, 'c> =
innerMap |> Map.fold (fun tempState k2 v ->
let innerMap' = match ( tempState |> Map.tryFind k2 ) with
| Some(m) -> m
| None -> Map.empty
let innerMap'' = innerMap' |> Map.add k1 v
tempState |> Map.add k2 innerMap'' ) oldState
map |> Map.fold foldHelper Map.empty
While #Tomas Petricek's solution is more readable to me, this appears to be about 25% faster.
I am trying to write a general function in F# that would return all the permutations of a list. I was trying to accomplish this using a recursive algorithm inspired by the java version here
But on the final line of the recursive function, I get the error given in the comments. I am guessing this is something to do with collating the output produced when the recursive loop exits (the output of if(Array.length <= 1) then being executed) with the rest Array.Map function.
I would greatly appreciate it if someone could give an explanation of why this error is happening and how I can go about fixing it.
let GetPermutationsOfList inputList =
let rec innerLoop firstPart secondPart =
if (Array.length secondPart) <= 1 then
[| Array.append firstPart secondPart |]
else
let SliceAtMarkerElement m =
let currentMarkerElement = secondPart.[m]
let everythingBeforeMarkerElement = secondPart.[0 .. m - 1]
let everythingAfterMarkerElement = secondPart.[m+1 .. ]
let newSecondPartList = Array.append everythingBeforeMarkerElement everythingAfterMarkerElement
let newFirstPartList = Array.append firstPart [|currentMarkerElement|]
(newFirstPartList, newSecondPartList)
[|for i in 0 .. ((Array.length secondPart) - 1) -> i|] |>
Array.map(fun c -> SliceAtMarkerElement c) |>
// The following line gives the error
// "Type Mismatch. Expecting a 'a but given a 'a[] The resulting type would be infinite when unifying "a' and "a[]"
Array.map(fun d -> innerLoop (fst d) (snd d))
innerLoop Array.empty (List.toArray inputList)
Assume that your function's indentation is correct, the error message is quite informative. In the innerLoop function, Array.append firstPart secondPart should return 'b []. However, the last line Array.map(fun d -> innerLoop (fst d) (snd d)) forces it to return 'b [] [], which couldn't be unified with 'b [].
I think you would like calculate permutations in each innerLoop and concatenate these results afterwards. You have to use Array.collect instead of Array.map:
[|for i in 0 .. (Array.length secondPart)-1 -> i|]
|> Array.map (fun c -> SliceAtMarkerElement c)
|> Array.collect (fun d -> innerLoop (fst d) (snd d))
The above fragment is employing two temporary arrays, which is wasteful. You can eliminate these extra arrays by using computation expression only:
[| for i in 0 .. (Array.length secondPart)-1 do
let first, second = SliceAtMarkerElement i
yield! innerLoop first second (* concatenating results *)
|]
UPDATE:
As clarified in the comment, you want to return an array of arrays where each array is a permutation. So your change would work and map operations should be:
[| for i in 0 .. (Array.length secondPart)-1 do
let first, second = SliceAtMarkerElement i
yield innerLoop first second (* returning each array as a permutation *)
|]
This is actually a solution to Project Euler Problem 14 in F#. However, I'm running into a System.OutOfMemory exception when attempting to calculate an iterative sequence for larger numbers. As you can see, I'm writing my recursive function with tail calls.
I was running into a problem with StackOverFlowException because I was debugging in visual studio (which disables the tail calls). I've documented that in another question. Here, I'm running in release mode--but I'm getting out of memory exceptions when I run this as a console app (on windows xp with 4gb ram).
I'm really at a loss to understand how I coded myself into this memory overflow & hoping someone can show my the error in my ways.
let E14_interativeSequence x =
let rec calc acc startNum =
match startNum with
| d when d = 1 -> List.rev (d::acc)
| e when e%2 = 0 -> calc (e::acc) (e/2)
| _ -> calc (startNum::acc) (startNum * 3 + 1)
let maxNum pl=
let rec maxPairInternal acc pairList =
match pairList with
| [] -> acc
| x::xs -> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
maxPairInternal (0,0) pl
|> fst
// if I lower this to like [2..99999] it will work.
[2..99999]
|> List.map (fun n -> (n,(calc [] n)))
|> List.map (fun pair -> ((fst pair), (List.length (snd pair))))
|> maxNum
|> (fun x-> Console.WriteLine(x))
EDIT
Given the suggestions via the answers, I rewrote to use a lazy list and also to use Int64's.
#r "FSharp.PowerPack.dll"
let E14_interativeSequence =
let rec calc acc startNum =
match startNum with
| d when d = 1L -> List.rev (d::acc) |> List.toSeq
| e when e%2L = 0L -> calc (e::acc) (e/2L)
| _ -> calc (startNum::acc) (startNum * 3L + 1L)
let maxNum (lazyPairs:LazyList<System.Int64*System.Int64>) =
let rec maxPairInternal acc (pairs:seq<System.Int64*System.Int64>) =
match pairs with
| :? LazyList<System.Int64*System.Int64> as p ->
match p with
| LazyList.Cons(x,xs)-> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
| _ -> acc
| _ -> failwith("not a lazylist of pairs")
maxPairInternal (0L,0L) lazyPairs
|> fst
{2L..999999L}
|> Seq.map (fun n -> (n,(calc [] n)))
|> Seq.map (fun pair -> ((fst pair), (Convert.ToInt64(Seq.length (snd pair)))))
|> LazyList.ofSeq
|> maxNum
which solves the problem. I'd also look at Yin Zhu's solution which is better, though.
As mentioned by Brian, List.* operations are not appropriate here. They cost too much memory.
The stackoverflow problem comes from another place. There are two possible for you to have stackoverflow: calc and maxPairInternal. It must be the first as the second has the same depth as the first. Then the problem comes to the numbers, the number in 3n+1 problem could easily go to very large. So you first get a int32 overflow, then you get a stackoverflow. That's the reason. After changing the numbers to 64bit, the program works.
Here is my solution page, where you can see a memoization trick.
open System
let E14_interativeSequence x =
let rec calc acc startNum =
match startNum with
| d when d = 1L -> List.rev (d::acc)
| e when e%2L = 0L -> calc (e::acc) (e/2L)
| _ -> calc (startNum::acc) (startNum * 3L + 1L)
let maxNum pl=
let rec maxPairInternal acc pairList =
match pairList with
| [] -> acc
| x::xs -> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
maxPairInternal (0L,0) pl
|> fst
// if I lower this to like [2..99999] it will work.
[2L..1000000L]
|> Seq.map (fun n -> (n,(calc [] n)))
|> Seq.maxBy (fun (n, lst) -> List.length lst)
|> (fun x-> Console.WriteLine(x))
If you change List.map to Seq.map (and re-work maxPairInternal to iterate over a seq) that will probably help tons. Right now, you're manifesting all the data at once in a giant structure before processing the whole structure to get a single number result. It is much better to do this lazily via Seq, and just create one row, and compare it with the next row, and create a single row at a time and then discard it.
I don't have time to code my suggestion now, but let me know if you are still having trouble and I'll revisit this.
Stop trying to use lists everywhere, this isn't Haskell! And stop writing fst pair and snd pair everywhere, this isn't Lisp!
If you want a simple solution in F# you can do it directly like this without creating any intermediate data structures:
let rec f = function
| 1L -> 0
| n when n % 2L = 0L -> 1 + f(n / 2L)
| n -> 1 + f(3L * n + 1L)
let rec g (li, i) = function
| 1L -> i
| n -> g (max (li, i) (f n, n)) (n - 1L)
let euler14 n = g (0, 1L) n
That takes around 15s on my netbook. If you want something more time efficient, reuse previous results via an array:
let rec inside (a : _ array) n =
if n <= 1L || a.[int n] > 0s then a.[int n] else
let p =
if n &&& 1L = 0L then inside a (n >>> 1) else
let n = 3L*n + 1L
if n < int64 a.Length then inside a n else outside a n
a.[int n] <- 1s + p
1s + p
and outside (a : _ array) n =
let n = if n &&& 1L = 0L then n >>> 1 else 3L*n + 1L
1s + if n < int64 a.Length then inside a n else outside a n
let euler14 n =
let a = Array.create (n+1) 0s
let a = Array.Parallel.init (n+1) (fun n -> inside a (int64 n))
let i = Array.findIndex (Array.reduce max a |> (=)) a
i, a.[i]
That takes around 0.2s on my netbook.
Found this looking for Microsoft.FSharp.Core.Operators.Checked.
I'm just learning F#, so I thought I'd take the Project Euler 14 Challenge.
This uses recursion but not tail-recursion.
Takes about 3.1 sec for me, but has the advantage that I can almost understand it.
let Collatz (n:int64) = if n % 2L = 0L then n / 2L else n * 3L + 1L
let rec CollatzLength (current:int64) (acc:int) =
match current with
| 1L -> acc
| _ -> CollatzLength (Collatz current) (acc + 1)
let collatzSeq (max:int64) =
seq{
for i in 1L..max do
yield i, CollatzLength i 0
}
let collatz = Seq.toList(collatzSeq 1000000L)
let result, steps = List.maxBy snd collatz