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", []))
Related
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
I set myself the following challenge (and failed):
I want to write a map functional, map f lofls, that takes a function, f 'a -> 'b and a list of lists, lofls 'a list list and applies the function f on every element of the list of lists. The constraint that I added is that I am not allowed to used nested maps for lists, and I have to do it recursively.
I tried to do it in F# but any language should do. Any ideas?
Edit
Here is my attempt (which works but is ugly and I am not a fan of the use of rev either . . .)
let map f lis =
let rec map2 f lis aux =
match (lis, aux) with
|([], []) -> []
|([], aux) -> [aux]
|(hd::tl, aux) ->
match hd with
|[] -> (List.rev aux) :: (map2 f tl [])
|x::xs -> map2 f (xs::tl) ( (f x) :: aux )
map2 f lis []
(I also realised that this has been posted in a more concise form already)
Lets go step by step, from simple to complex.
This is the signature that you want your map function to have:
('a -> 'b) -> 'a list list -> 'b list list
The simple solution is this:
let map0 (f:'a -> 'b) (lofls:'a list list) : 'b list list = lofls |> List.map (List.map f)
But that one is not recursive and it uses nested maps.
A recursive solution could be this:
let rec map1 (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [] -> []
| l::rest -> (List.map f l) :: map1 f rest
It is recursive although it is still calling List.map in there.
So, here is the next level:
let rec map (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [ ] -> [ ]
| [ ] :: rest -> [ ] :: (rest |> map f)
| ( e::restl ) :: rest ->
match restl :: rest |> map f with
| [ ] -> [ ]
| [ ] :: rest -> [ f e ] :: rest
| ( restl ) :: rest -> ( f e :: restl ) :: rest
Another way:
let rec mapNested f lofls =
match lofls with
| [] -> []
| h::t -> (map f h) :: (mapNested f t)
and map f lst =
match lst with
| [] -> []
| h::t -> (f h) :: (map f t)
If this were a homework question, which I am sure it is not, the answer depends on what constitutes "a nested map for lists".
A construct like map [] (map [] f) can be rewritten with pipelining as f |> map [] |> map [], or with the function composition operator as (map [] >> map []) f, but may be still considered a nested map.
let mapNested f =
let rec map acc g = function
| [] -> List.rev acc
| x::xs -> map (g x::acc) g xs
f |> map [] |> map []
// val mapNested : f:('a -> 'b) -> ('a list list -> 'b list list)
This is the opportunity to demonstrate your grasp of lambda calculus and the Y combinator. Nested passing of the map function as an argument should clearly pass muster.
let rec Y f x = f (Y f) x
let map f acc g = function
| [] -> List.rev acc
| x::xs -> f (g x::acc) g xs
let map1 f =
Y map [] f
// val map1 : f:('a -> 'b) -> ('a list -> 'b list)
let map2 f =
Y map [] f
|> Y map []
// val map2 : f:('a -> 'b) -> ('a list list -> 'b list list)
A tail recursive way
let mapNested f lofls =
let rec map f lst acc =
match lst with
| [] -> List.rev acc
| h::t -> map f t (f h :: acc)
map (fun x -> map f x []) lofls []
I'm not sure why this question is tagged with SML, but since it is, here is how it can be done in SML:
First, this is the idiomatic solution that you're explicitly avoiding:
fun mapmap f = map (map f)
(You could write val mapmap = map o map if it weren't for ML's value restriction.)
And if you'd like to write mapmap using explicit recursion:
fun mapmap f [] = []
| mapmap f (xs::xss) = map f xs :: mapmap f xss
and map f [] = []
| map f (x::xs) = f x :: map f xs
One reason behind why this function is hard to write with a single explicitly recursive function is that the call stack is used for two things:
Collecting the result of each inner list, and
Collecting the result of the outer list.
One of those uses of the call stack can be turned into an explicit stack in an accumulating argument. This is how e.g. a tail-recursive rev is defined:
fun rev xs =
let fun aux [] acc = acc
| aux (x::xs) acc = aux xs (x::acc)
in aux xs [] end
The accumulating argument similarly isn't needed in the interface to mapmap, so it can be hidden in an inner helper function. So a single function that performs explicit recursion on both the inner and the outer list is complicated by this explicit bookkeeping:
fun mapmap f xss =
let fun aux f [] _ = []
| aux f ([]::xss) ys = rev ys :: aux f xss []
| aux f ((x::xs)::xss) ys = aux f (xs::xss) (f x :: ys)
in aux f xss [] end
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