F#: n-ary tree extract single element and save computations - f#

Given the type for a tree:
type id = int;;
type tree = T of id * tree list;;
let ex = T(12,[T(3,[T(4,[T(38,[])])]);T(23,[T(22,[])]);T(1,[])]);;
Given that all id's are unique I would like to get a tree from a given id like so:
get 23 ex = t(23, [t(22,[])]);
So far I only been able to make a function like this:
let rec child c n =
match c with
| [] -> []
| e::es -> (get n e) # (child es n)
and get id t =
match t with
| T(id1,c) when id=id1-> [t]
| T(_,c) -> child c id;;
Which is fine, but the function does a total run through of all nodes in the tree. Is it possible to make a function that terminates when it finds the right node and thereby skips some computations?

You would need to make the recursive call return a value that somehow contains the response about whether it found the node. If it did - just return it, if it didn't - keep (recursively) searching the rest of the tree.
To do this, F# has a handy built-in type - Option. It's a sum type defined as type Option<'t> = Some of 't | None. So I would make the get function return an Option<tree> rather than tree list, and then the child function can decide whether it wants to proceed:
let rec child c n =
match c with
| [] -> None
| e::es -> match get n e with
| Some x -> Some x // node found - just return it
| None -> child es n // not found - keep searching
and get id t =
match t with
| T(id1,c) when id=id1-> Some t
| T(_,c) -> child c id;;
Also note that your child function is actually available in the standard library under the name of List.tryPick:
let rec child c n = List.tryPick (get n) c
Which makes the whole thing collapse into this:
let rec get id t =
match t with
| T(id1,_) when id=id1 -> Some t
| T(_,c) -> List.tryPick (get id) c

Related

How can I get values with discriminited union type from recursive function

I am trying to obtain a specific value from one list with a multiple recursion so I have :
type PowerSystem =
| System of string * int
| Junction of string * List<PowerSystem>
let Starship =
Junction("Core",
[
Junction("Users",
[
System("Main Computer",-10);
System("Library Computer",-10);
Junction("Defence",)]
let rec JunctionPath (pSystem:PowerSystem) =
match pSystem with
| Junction(name,aList) -> SplitList2 aList
| System(name,aNumber) -> [name]
and SplitList2 list =
match list with
| [] -> printfn "%A" []
| head::tail -> printfn "%A" List.filter (fun e->e="Port Phasers" (JunctionPath head)#(SplitList2 tail))
JunctionPath Starship
I get error FS0001: The type ''a -> string list' does not match the type 'unit'
I want to get the name of junctions when the system is called Main Computer but I can't call other functions. I tryed in different ways to get those values but I can't found the way. Thanks in advance
SplitList2 only has the side effect of printfn hence returns unit ().
In JunctionPath the first branch returns a list of string - [name] - and the second a unit due to calling SplitList2. This is not allowed as both (in general all) pattern match branches should return the same type. This is why you get your error "error FS0001: The type ''a -> string list' does not match the type 'unit'"
(It would be clearer if you, in future, note the line references in the error as that points to the problematic line).
Now in answer to your last point:
I want to get the name of junctions when the system is called Main
Computer but I can't call other functions. I tryed in different ways
to get those values but I can't found the way.
this does not make sense since what is "Port Phasers"? Anyway, without testing, I have modified SplitList2 to return a list on either branch. Then we pipe the result of JunctionPath into a printfn. However the logic of the line List.filter (fun e->e="Port Phasers" (JunctionPath head)#(SplitList2 tail)) still does not make sense, so I updated it as I think you meant it (although you should have had another error for this?). (This is not tail recursive and can be improved but one step at a time)
type PowerSystem =
| System of string * int
| Junction of string * List<PowerSystem>
let Starship =
Junction("Core",
[
Junction("Users",
[
System("Main Computer",-10);
System("Library Computer",-10);
Junction("Defence",)]
let rec JunctionPath (pSystem:PowerSystem) =
match pSystem with
| Junction(name,aList) -> SplitList2 aList
| System(name,aNumber) -> [name]
and SplitList2 list =
match list with
| [] -> []
| head::tail -> List.filter (fun e->e="Port Phasers") (JunctionPath head)#(SplitList2 tail))
JunctionPath Starship |> printfn "%A%

Pattern matching against a string property

I'm de-serializing some mappings from JSON and later on I need to pattern match based on a string field of the de-serialized types like this:
let mappings = getWorkItemMappings
let result =
workItemMappings
|> Seq.find (fun (m: WorkItemMapping) -> m.Uuid = workTime.workItemUuid)
match mapping.Name with
Even if I complete the pattern match for all cases I still get Incomplete pattern matches on this expression.. Which is obvious to me due to the string type of the Name field.
Is there a way tell the compiler which values for the Name field are available?.
I think I could create a union type for the possible mapping types and try to de-serialize the JSON to this union type but I would like to if there's another option.
If you are pattern matching on a string value, the compiler has no static guarantee that it will only have certain values, because it is always possible to construct a string of a different value. The fact that it comes from JSON does not help - you may always have an invalid JSON.
The best option is to add a default case which throws a custom descriptive exception. Either one that you handle somewhere else (to indicate that the JSON file was invalid) or (if you check the validity elsewhere) something like this:
let parseFood f =
match f with
| "burger" -> 1
| "pizza" -> 2
| _ -> raise(invalidArg "f" $"Expected burger or pizza but got {f}")
Note that the F# compiler is very cautious. It does not even let you handle enum values using pattern matching, because under the cover, there are ways of creating invalid enum values! For example:
type Foo =
| A = 1
let f (a:Foo) =
match a with
| Foo.A -> 0
warning FS0104: Enums may take values outside known cases. For example, the value 'enum (0)' may indicate a case not covered by the pattern(s).
Very hard to understand what you're asking. Maybe this snippet can be of help. It demos how literal string constants can be used in pattern matching, and reused in functions. This gives some added safety and readability when adding and removing cases. If you prefer not to serialize a DU directly, then perhaps this is useful as part of the solution.
type MyDu =
| A
| B
| C
let [<Literal>] A' = "A"
let [<Literal>] B' = "B"
let [<Literal>] C' = "C"
let strToMyDuOption (s: string) =
match s with
| A' -> Some A
| B' -> Some B
| C'-> Some C
| _ -> None
let strToMyDu (s: string) =
match s with
| A' -> A
| B' -> B
| C'-> C
| s -> failwith $"MyDu case {s} is unknown."
let myDuToStr (x: MyDu) =
match x with
| A -> A'
| B -> B'
| C -> C'
// LINQPad
let dump x = x.Dump()
strToMyDuOption A' |> dump
strToMyDuOption "x" |> dump
myDuToStr A |> dump

Stackless trampoline Monad/Computation Expression

I am working on a functional programming language of my own design and I stumbled on a problem that is beyond my skills to solve. I would like to know if anyone has any advice on how to solve it or a reason for why it is impossible.
The code below is an overview of a solution that is not the ideal but a compromise.
This problem is at the heart of the runtime system I am currently using. Instead of relying on the .Net stack I am using a monad to perform operations on a trampoline. This should help with step through debugging and allow for users to not have to worry about stack space. Here is a simplified version of the monad I am currently using.
type 't StackFree =
|Return of 't //Return a value
|StackPush of ('t->'t StackFree)*'t StackFree //Pushes a return handler onto the "Stack"
|Continuation of (unit->'t StackFree) //Perform a simple opperation
type StackFreeMonad() =
member this.Delay(fn) =
Continuation(fn)
member this.Bind(expr,fn) =
StackPush(fn,expr)
member this.Return(value) =
Return(value)
member this.ReturnFrom(x) =x
let stackfree = StackFreeMonad()
This was not the original design but it was the best I could get to work with F# computation expressions in an ideal world the above computation expression would work on this type.
type 't Running =
|Result of 't
|Step of (unit->'t Running)
So in order to convert a StackFree into a Running type I have to use this conversion function
//this method loops through the StackFree structure finding the next computation and managing a pseudo stack with a list.
let prepareStackFree<'t> :'t StackFree->'t Running =
let rec inner stack stackFree =
Step(fun ()->
match stackFree with
//takes the return values and passes it to the next function on the "Stack"
|Return(value)->
match stack with
|[]->Result(value)
|x::xs -> inner xs (x value)
//pushes a new value on the the "Stack"
|StackPush(ret,next) ->
inner (ret::stack) next
//performs a single step
|Continuation(fn)->
inner stack (fn()))
inner []
Here is a brief example of the two types in action.
let run<'t> :'t StackFree->'t =
let rec inner = function
|Step(x)-> inner (x())
|Result(x)-> x
stackFreeToRunning>>inner
//silly function to recompute an intiger value using recursion
let rec recompute number = stackfree {
if number = 0 then return 0
else
let! next = recompute (number-1)
return next+1
}
let stackFreeValue = recompute 100000
let result = run stackFreeValue
do printfn "%i" result
I have spent several hours trying to get a Computation Expression that works directly on the Running type and cutting out the middleman StackFree. However I cannot figure out how to do it. At this point I am seriously considering the possibility that a solution to this problem is impossible. However I cannot figure out the reason that it is impossible.
I have gotten close a few times but the resulting solutions ended up using the stack in some confusing way.
Is it possible to have a computation expression that operates on the Running type without utilizing the .Net stack? If this is not possible why is it not possible. There must be some simple mathematical reasoning that I am missing.
NB: These are not the actual types I am using they are simplified for this questions the real ones keep track of scope and position in the script. Furthermore I am aware of the serious performance cost of this type of abstraction
Edit: Here is another way to approach the problem. This implementation is flawed because it uses the stack. Is there anyway to get the exact behavior below without using the stack?
type RunningMonad() =
member this.Delay(fn) =
Step(fun ()->fn ())
member this.Bind(m, fn) =
Step(fun ()->
match m with
|Result(value)-> fn value
//Here is the problem
|Step(next)-> this.Bind(next(),fn))
member this.Return(v) =
Result(v)
member this.ReturnFrom(x) = x
The bind implementation in the above computation expression creates a function that calls another function. So as you go deeper and call bind more and more you have to chase a bunch of function calls and then eventually you hit a stackoverflow exception.
Edit2: Clarity.
Better late than never!
This is addressed in section 4 of Stackless Scala with Free Monads. Bjarnason tackles the problem by adding a new constructor to the Trampoline datatype, representing a subroutine call to another trampoline. He keeps this new constructor private, in order to ensure that you can't build left-nested Binds (which would overflow the stack when executing the trampoline).
I am by no means an F#er, but I'll muddle through. In WishF#ul, an imaginary dialect of F# which I just made up, you can express the new existentially quantified constructor directly:
type Tram<'a> =
| Done of 'a
| Step of (unit -> Tram<'a>)
| Call<'x> of Tram<'x> * ('x -> Tram<'a>) // don't export this
type TramMonad() =
member this.Return(x) = Done(x)
member this.Bind(ma, f) = match ma with
| Call(mx, k) -> Call(mx, fun x -> this.Bind(k(x), f))
| _ -> Call(ma, f)
// i confess to not quite understanding what your Delay and ReturnFrom methods are for
let tram = new TramMonad()
let rec runTram t =
let next mx f = match mx with
| Done(x) -> f x
| Step(k) -> Step(fun () -> tram.Bind(k(), f))
| Call(my, g) -> tram.Bind(my, fun x -> tram.Bind(g x, f))
match t with
| Done(x) -> x
| Step(k) -> runTram(k())
| Call(mx, f) -> runTram(next mx f)
Note that all of the recursive calls to runTram are in tail position. It takes a bit of puzzling, but you can convince yourself that Bind won't construct a deeply-nested continuation, so runT will always operate in O(1) stack space.
Sadly we're working in F#, not WishF#ul, so we have to resort to an object-oriented encoding of the existential type in the Call constructor. Here goes...
module rec Trampoline =
type Call<'a> =
abstract member Rebind<'b> : ('a -> Tram<'b>) -> Tram<'b>
abstract member Next : unit -> Tram<'a>
type Tram<'a> =
| Done of 'a
| Step of (unit -> Tram<'a>)
| Call of Call<'a>
type TramMonad() =
member this.Return(x) = Done(x)
member this.Bind(ma, f) =
match ma with
| Call(aCall) -> aCall.Rebind(f)
| _ -> call ma f
let tram = new TramMonad()
let rec call<'a, 'x>(mx : Tram<'x>) (f : 'x -> Tram<'a>) : Tram<'a> = Call {
new Call<'a> with
member this.Rebind<'b>(g : 'a -> Tram<'b>) : Tram<'b> =
call<'b, 'x> mx (fun x -> tram.Bind(f x, g) : Tram<'b>)
member this.Next() =
match mx with
| Done(x) -> f x
| Step(k) -> Step(fun () -> tram.Bind(k(), f))
| Call(aCall) -> aCall.Rebind(f)
}
let rec runTram t =
match t with
| Done(x) -> x
| Step(k) -> runTram(k())
| Call(aCall) -> runTram(aCall.Next())
I recommend reading the whole paper, which goes on to generalise this stackless construction to any free monad, not just trampolines (which are Free (Unit -> _)). Phil Freeman's Stack Safety for Free builds on this work, generalising the trampoline paper's free monad to a free monad transformer.

using a function inside a discriminated union

I would like to do some unit tests on a function that accepts a DU and returns another :
type Commands =
| Schedule of string
| Abandon of string
type Events =
| Scheduled of string
| Abandonned of string
the function is the following :
let exec state = function
| Schedule (cmd) -> Choice1Of2( Scheduled("yes"))
| Abandon(cmd) -> Choice1Of2( Abandonned ("no"))
My tests are as follows :
let result:Choice<Events,string> = exec "initial state" <| Schedule("myCommand");;
result has the following type Choice<Events,string>, I would have loved to get some quick function in order to use them like this :
assertEvent Scheduled (fun e -> Assert.Equal("should produce GameScheduled Event",gameScheduled, e)) result
But to do that I would have the following home made assert function :
let assertEvent<'TEvent> f g result =
match result with
| Choice1Of2(e) ->
match e with
| f(evt) -> g(evt)
| _ -> Assert.None("event not recognised",Some(e))
| Choice2Of2(reason) -> Assert.None("reason",Some(reason))
I was expecting the function f to allow pattern matching on the fly but it does not. Instead I have the following error :
The pattern disciminator 'f' is not defined
Am I doing somthing wrong somewhere ? my fsharp skills are not that high...
A normal function like f can't be used as a pattern discriminator, but you can pass Active Patterns around as arguments:
let assertEvent<'TEvent> (|F|_|) g result =
match result with
| Choice1Of2(e) ->
match e with
| F(evt) -> g(evt)
| _ -> Assert.None("event not recognised",Some(e))
| Choice2Of2(reason) -> Assert.None("reason",Some(reason))
This does, however, require you to also pass an Active Pattern as an argument, which is a bit cumbersome:
assertEvent
(function Scheduled(x) -> Some x | _ -> None)
(fun e -> Assert.Equal("should produce GameScheduled Event",gameScheduled, e))
result
This isn't the way I'd approach the problem, though. What I'd prefer is to write a boolean expression that attempts to pull out and compare the values that I want to verify.
For starters, you could create a little generic helper function to pull out one of the choices from Choice<'a, 'b>:
let toOption1 = function Choice1Of2 x -> Some x | _ -> None
This function has the type Choice<'a,'b> -> 'a option. (I'll leave it as an exercise to define an equivalent toOption2 function.)
Now you can define a boolean expression that pulls out the data if it's there, and compares it with an expected value:
result
|> toOption1
|> Option.map (function Scheduled x -> x | _ -> "")
|> Option.exists ((=) expected)
This is a boolean expression, so you can use Unquote to turn it into an assertion. This is similar to this approach that I've previously described.

Applying a function to a custom type in F#

On my journey to learning F#, I've run into a problem I cant solve. I have defined a custom type:
type BinTree =
| Node of int * BinTree * BinTree
| Empty
I have made a function which takes a tree, traverses it, and adds the elements it visits to a list, and returns it:
let rec inOrder tree =
seq{
match tree with
| Node (data, left, right) ->
yield! inOrder left
yield data;
yield! inOrder right
| Empty -> ()
}
|> Seq.to_list;
Now I want to create a function, similar to this, which takes a tree and a function, traverses it and applies a function to each node, then returns the tree:
mapInOrder : ('a -> 'b) -> 'a BinTree -> 'b BinTree
This seems easy, and it probably is! But I'm not sure how to return the tree. I've tried this:
let rec mapInOrder f tree =
match tree with
| Node(data, left, right) ->
mapInOrder f left
Node(f(data), left, right)
mapInOrder f right
| Empty -> ()
but this returns a unit. I havent worked with custom types before, so I'm probably missing something there!
Try this:
let rec mapInOrder f = function
| Node(a,l,r) ->
let newL = mapInOrder f l
let b = f a
let newR = mapInOrder f r
Node(b,newL,newR)
| Empty -> Empty
If the function is side-effect free, then traversal order is unimportant and you can instead write:
let rec map f = function
| Node(a,l,r) -> Node(f a, map f l, map f r)
| Empty -> Empty
A match is an expression. It returns the value of the matching case. That implies that all match cases must have the same type. The match expression itself then has that type.
In your first attempt, your Empty clause returned (), and thus had unit type--not the tree type you were looking for.
Since mapInOrder just returns the match result, it too took on unit return type.
The Node clause was fine because its return value is the result of calling mapInOrder, so it also took on unit type and the requirement that all match clauses have the same type was satisfied.
A key change in kvb's suggestion was making the Empty clause return a tree instead of unit. Once you do that, you get compiler errors and warnings pointing to the other problems.
You can often work through issues like this by explicitly coding the type you'd like, and then seeing where the compile errors and warnings show up.

Resources