Traversing a rosetree to generate a new rosetree - f#

I have a data type that is very close to a rosetree
type RoseTree<'T> =
{
Root: 'T
Children: LazyList<RoseTree<'T>>
}
I want to take instances of this tree and map it to a new tree but where the calculation in a specific node is dependent on values in other nodes, a simple example would be take a RoseTree and "count" the nodes in some traversal and map it to a RoseTree
so
()
-> ()
->()
-> ()
->()
->()
and get
0
-> 1
-> 2
-> 3
-> 4
-> 5
I can hand write out a specific recursive function to do this, but I was hoping i could use some off the shelf functions to do this sort of thing simply by passing a function that accumulates the 'count'.
(the actual traversal path probably doesnt massively matter)
The usual suspects don't seem to fit though.
map : ('a->'b) -> RoseTree<'a> -> RoseTree<'b>
this maps isolated nodes, with no reference to other nodes.
If this were a List then fold would work, an accumator being folded through each element could generate a new List whilst counting, but folding a tree doesnt seem to work like this (this is the Haskell data-tree implementation)
foldTree :: (a -> [b] -> b) -> Tree a -> b
this seems to process each child by mapping the subtrees over the fold in isolation to each other, there is no accumulator that gets passed around each node in turn.
If we take unfold
unfold : ('a -> 'b * LazyList<'a>) -> 'a -> RoseTree<'a>
then the seed would be something like
int * RoseTree<unit>
but it seems that the unfolder function generates each subtree effectively in isolation to every other subtree by generating a list of new seeds.
(this is quite surprising, I felt that 'unfold' was the goto function to generate any tree).
So out of the standard set of funtional patterns/typeclasses, is there one that can be used for this sort of traveral + accumulator type processing?
(I do know about Zippers, but they seem to be overkill for this sort of general desire to process each node in turn and accumulate.
I can handwrite something that does specifically what i want, something like:
let foldish : ('accum -> 'a -> 'accum * 'b) -> RoseTree<'a> -> 'accum -> RoseTree<'b> =
maybe doing something like a depth first search and traversing the Tree and recording the path I take, then use list.fold to label the nodes with numbers and then unfold a new tree from it, seems a bit mechanical and i'd rather use 'standard' idioms/patterns if one exists).

If you want the output tree to have the same shape as the input tree, this sounds a lot like mapFold:
let rec mapFold (mapping : 'State -> 'T -> 'Result * 'State) (state : 'State) (tree : RoseTree<'T>) : RoseTree<'Result> * 'State =
let result, state' = mapping state tree.Root
let children, state'' =
List.mapFold (mapFold mapping) state' tree.Children
let tree' =
{
Root = result
Children = children
}
tree', state''
Note that I made the children non-lazy for simplicity:
type RoseTree<'T> =
{
Root: 'T
Children: List<RoseTree<'T>>
}
Test case:
let tree =
{
Root = ()
Children =
[
{
Root = ()
Children =
[ { Root = (); Children = [] } ]
}
{
Root = ()
Children =
[
{ Root = (); Children = [] }
{ Root = (); Children = [] }
]
}
]
}
(0, tree)
||> mapFold (fun count _ ->
count, count + 1)
|> fst
|> printfn "%A"
Output:
{ Root = 0
Children =
[{ Root = 1
Children = [{ Root = 2
Children = [] }] };
{ Root = 3
Children = [{ Root = 4
Children = [] }; { Root = 5
Children = [] }] }] }

Related

FsCheck lazy generators

I have issues with generation of data within my tests.
testProperty "calculate Operation against different operations should increase major" <| fun operationIdApi operationIdClient summaryApi summaryClient descriptionApi descriptionClient ->
( notAllEqual [
fun () -> assessEquality <| StringEquals(operationIdApi, operationIdClient)
fun () -> assessEquality <| StringEquals(summaryApi , summaryClient)
fun () -> assessEquality <| StringEquals(descriptionApi, descriptionClient)
]) ==> lazy (
let operationClient = createOpenApiOperation operationIdClient summaryClient descriptionClient
let operationAPI = createOpenApiOperation operationIdApi summaryApi descriptionApi
let actual = calculate operationAPI operationClient
Expect.equal actual (Fact.Semver.IncreaseMajor) "return IncreaseMajor"
)
The code that is actually tested is :
semver {
if operationAPI.OperationId<> operationClient.OperationId then yield! IncreaseMajor
if operationAPI.Summary <> operationClient.Summary then yield! IncreaseMajor
}
The test should fail when the data produced is same OperationId, same summary and different description.
But it does not and it led me to create my own generator or at least try to do so:
I wanted my test to be written like this :
testProperty "calculate Operation against different operations should increase major" <| fun (operationId:ElementSet<string>) (summary:ElementSet<string>) ->
Therefore I create a type accordingly:
type ElementSet<'a> =
| Same of 'a
| Different
and a generator for this type :
let setGen<'a> =
Gen.oneof [
gen {
let! v = Arb.generate<'a>
return Same(v)
}
gen { return Different}
]
type ElementSetGenerator =
static member ElementSet() =
Arb.fromGen setGen<'a>
do Arb.register<ElementSetGenerator>() |> ignore
I was then trying to extract the data to construct my object :
let createOpenApiOperation operationId summary=
let pi = OpenApiOperation(OperationId=operationId.Get, Summary=summary.Get)
pi
The Get method did not exist yet so I was about to implement it by adding a member to my ElementSet<'a>:
type ElementSet<'a> =
| Same of 'a
| Different
with member this.Get =
match this with
| Same s -> s
| Different -> Arb.generate<'a>// some random generation here
And this is where I am stuck. I would love to get some randomness here when I extract data. I wonder if this is the correct way to do so, or if I should have answered the problem earlier?
Thanks for your inputs.
I think I found it, the answer was to handle it at the beginning :
let setGen<'a when 'a:equality> =
Gen.oneof [
gen {
let! v = Arb.generate<'a>
return Same(v)
}
gen {
let! x,y =
Arb.generate<'a>
|> Gen.two
|> Gen.filter (fun (a,b)-> a <> b)
return Different(x,y)
}
]
and then to use two getter to access the values :
type ElementSet<'a> when 'a:equality=
| Same of 'a
| Different of 'a*'a
with member this.Fst = match this with | Same s -> s | Different (a, b)-> a
member this.Snd = match this with | Same s -> s | Different (a, b)-> b
this way I can access values within my test:
testProperty "calculate Operation against different operations should increase major" <| fun (operationId:ElementSet<NonWhiteSpaceString>) (summary:ElementSet<NonWhiteSpaceString>) (description:ElementSet<NonWhiteSpaceString>) ->
let operationClient = createOpenApiOperation operationId.Fst summary.Fst description.Fst
let operationAPI = createOpenApiOperation operationId.Snd summary.Snd description.Snd
let actual = calculate operationAPI operationClient
Expect.equal actual (Fact.Semver.IncreaseMajor) "return IncreaseMajor"
for the record I then have the creation of my stub as follows :
let createOpenApiOperation (operationId:NonWhiteSpaceString) (summary:NonWhiteSpaceString) (description:NonWhiteSpaceString)=
let pi = OpenApiOperation(OperationId=operationId.Get, Summary=summary.Get, Description=description.Get)
pi

How to combine 2 Arbitrary instances to match test method signature

I have a function that should get two actual params for testing.
Both values shall be created by Arbitrary instances as they need to be of some well formdness that cant be totally arbitrary.
So I create the following code
let updating (x:SomeType) (y:SomeOtherType) =
let result = update x y
result.someProp = x.someProp
&& result.otherProp = y.otherProp
let arbSomeType =
Arb.generate<SomeType>
|> Gen.filter fun x -> x.checkSomeStuff
|> Arb.fromGen
let arbSomeType =
Arb.generate<SomeOtherType>
|> Gen.filter fun x -> x.checkPropertiesOfThis
|> Arb.fromGen
But how do I now combine those 2 Arbitrary instances so that they match up with the signature of test method?
//let prop = Prop.forAll arbSomeType + arbSomeType updating
Check.QuickThrowOnFailure prop
Given two types, SomeTypeA and SomeTypeB:
type SomeTypeA =
{ A : obj }
type SomeTypeB =
{ B : obj }
You can create a Property, where the input is those two types, like so:
let prop =
gen { let! a = Arb.generate<SomeTypeA>
let! b = Arb.generate<SomeTypeB>
return a, b }
|> Arb.fromGen
|> Prop.forAll
<| fun (a, b) ->
// 'a' is SomeTypeA
// 'b' is SomeTypeB
true // Dummy - replace with whatever you want to do with 'a' and 'b'.
You also need to take care, that the signature of the testing method now reflects the created Arbitrary - becoming a (uncurried) function on pairs.
// instead of
let updating (x:SomeType) (y:SomeOtherType) = ...
// do this
let updating (x:SomeType, y:SomeOtherType) = ...
How the example works:
The gen computation expression creates a generator of type Gen<SomeTypeA * SomeTypeB>
An Arbitrary<SomeTypeA * SomeTypeB> instance is created from that generator
Finally, a (QuickCheck/FsCheck) property is created from the arbitrary via Prop.forAll
It's always the same path:
Generator[/optional Shrinker] -> Arbitrary -> Property -> <your_code>
Hope that helps.

How do I compose a list of functions?

If I have a type named Person, and list of functions, for example...
let checks = [checkAge; checkWeight; checkHeight]
...where each function is of the type (Person -> bool), and I want to do the equivalent of...
checkAge >> checkWeight >> checkHeight
...but I don't know in advance what functions are in the list, how would I do it?
I tried the following...
checks |> List.reduce (>>)
...but this gives the following error...
error FS0001: Type mismatch. Expecting a
(Person -> bool) -> (Person -> bool) -> Person -> bool
but given a
(Person -> bool) -> (bool -> 'a) -> Person -> 'a
The type 'Person' does not match the type 'bool'
What am I doing wrong?
It looks like Railway oriented programming would be a good fit here.
If you choose to go this route, you basically have two options.
You can either go all in, or the quick route.
Quick route
You rewrite your validation functions to take a Person option instead of just plain Person.
let validAge (record:Record option) =
match record with
| Some rec when rec.Age < 65 && rec.Age > 18 -> record
| None -> None
Now you should be able to easily chain your function.
checks |> List.reduce (>>)
All in
Alternatively, if you are lazy and don't want to match .. with in every validation function, you can write some more code.
(samples taken from [1])
First there's a bit of setup to do.
We'll define a special return type, so we can get meaningful error messages.
type Result<'TSuccess,'TFailure> =
| Success of 'TSuccess
| Failure of 'TFailure
A bind function, to bind the validations together
let bind switchFunction =
function
| Success s -> switchFunction s
| Failure f -> Failure f
You'll have to rewrite your validation functions as well.
let validAge (record:Record) =
if record.Age < 65 && record.Age > 18 then Success input
else Failure "Not the right age bracket"
Now combine with
checks |> List.reduce (fun acc elem -> acc >> bind elem)
Either way, check out the original article.
There's much more there you might be able to use :)
Edit: I just noticed that I was too slow in writing this answer once again.
Besides, I think Helge explained the concetp better than I did as well.
You may somehow have stumbled upon a dreaded concept. Apperently its the Voldemort (dont say his name!) of functional programming.
With no further ado lets walk right into the code:
type Person =
{ Name : string
Age : int
Weight : int
Height : int }
type Result =
| Ok of Person
| Fail
let bind f m =
match m with
| Ok p -> f p
| _ -> Fail
let (>=>) f1 f2 = f1 >> (bind f2)
let checkAge p =
if p.Age > 18 then Ok(p)
else Fail
let checkWeight p =
if p.Weight < 80 then Ok(p)
else Fail
let checkHeight p =
if p.Height > 150 then Ok(p)
else Fail
let checks = [ checkAge; checkWeight; checkHeight ]
let allcheckfunc = checks |> List.reduce (>=>)
let combinedChecks =
checkAge
>=> checkWeight
>=> checkHeight
let p1 =
{ Name = "p1"
Age = 10
Weight = 20
Height = 110 }
let p2 =
{ Name = "p2"
Age = 19
Weight = 65
Height = 180 }
allcheckfunc p1
combinedChecks p1
allcheckfunc p2
combineChecks p2
At this point I could throw around a lot of weirdo lingo (not really true, I couldnt...), but lets just look at what I have done.
I dropped your return value of bool and went for another type (Result) with either (mark that keyword!) Ok or Fail.
Then made a helper (bind) to wrap and unwrapp stuff from that Result-type.
And a new operator (>=>) to combine the stuff in reduce.
Mind that the first check-function to Fail will shortcut the entire chain and more or less immediately (not calling the other functions) return Fail. In addition you will not know where in this chain it did Fail or which functions ahead of any Fail did actually Ok.
There are methods to also accumulate the errors as you go along, so that you get get a feedback of type: "the checkAge returned Fail, but the others was great success"
The code is mostly stolen from here: http://fsharpforfunandprofit.com/posts/recipe-part2/
And you may want to read about the entire website of Wlaschin and even a lot more to get into the finer and harder details if wanted.
Good luck on your journey to the upper floors of the Ivory Tower. ;-)
Footnote: This is called an Either-monad usually. Its not entirely finished and what not in the above code, but never mind... I think it will work in your case...
The >> operator is useful if you have functions that perform some transformation. For example, if you had a list of functions Person -> Person that turn one person into another.
In your case, it seems that you have functions Person -> bool and you want to build a composed function that returns true if all functions return true.
Using List.reduce you can write:
checks|> List.reduce (fun f g -> (fun p -> f p && g p))
Perhaps an easier option is to just write a function that takes a person and uses List.forall:
let checkAll checks person = checks |> List.forall (fun f -> f person)

Functional way to add to Lists that are Class-Members

I want to sort items of a class and collect them in Collection-Classes that beside a List-Member also contain further information that are necessary for the sorting process.
The following example is a a very simplified example for my problem. Although it doesn't make sense, I hope it still can help to understand my Question.
type ItemType = Odd|Even //realworld: more than two types possible
type Item(number) =
member this.number = number
member this.Type = if (this.number % 2) = 0 then Even else Odd
type NumberTypeCollection(numberType:ItemType , ?items:List<Item>) =
member this.ItemType = numberType
member val items:List<Item> = defaultArg items List.empty<Item> with get,set
member this.append(item:Item) = this.items <- item::this.items
let addToCollection (collections:List<NumberTypeCollection>) (item:Item) =
let possibleItem =
collections
|> Seq.where (fun c -> c.ItemType = item.Type) //in my realworld code, several groups may be returned
|> Seq.tryFind(fun _ -> true)
match possibleItem with
|Some(f) -> f.append item
collections
|None -> NumberTypeCollection(item.Type, [item]) :: collections
let rec findTypes (collections:List<NumberTypeCollection>) (items:List<Item>) =
match items with
| [] -> collections
| h::t -> let newCollections = ( h|> addToCollection collections)
findTypes newCollections t
let items = [Item(1);Item(2);Item(3);Item(4)]
let finalCollections = findTypes List.empty<NumberTypeCollection> items
I'm unsatisfied with the addToCollection method, since it requires the items in NumberTypeCollection to be mutual. Maybe there are further issues.
What can be a proper functional solution to solve this issue?
Edit: I'm sorry. May code was too simplified. Here is a little more complex example that should hopefully illustrate why I chose the mutual class-member (although this could still be the wrong decision):
open System
type Origin = Afrika|Asia|Australia|Europa|NorthAmerika|SouthAmerica
type Person(income, taxrate, origin:Origin) =
member this.income = income
member this.taxrate = taxrate
member this.origin = origin
type PersonGroup(origin:Origin , ?persons:List<Person>) =
member this.origin = origin
member val persons:List<Person> = defaultArg persons List.empty<Person> with get,set
member this.append(person:Person) = this.persons <- person::this.persons
//just some calculations to group people into some subgroups
let isInGroup (person:Person) (personGroup:PersonGroup) =
let avgIncome =
personGroup.persons
|> Seq.map (fun p -> float(p.income * p.taxrate) / 100.0)
|> Seq.average
Math.Abs ( (avgIncome / float person.income) - 1.0 ) < 0.5
let addToGroup (personGroups:List<PersonGroup>) (person:Person) =
let possibleItem =
personGroups
|> Seq.where (fun p -> p.origin = person.origin)
|> Seq.where (isInGroup person)
|> Seq.tryFind(fun _ -> true)
match possibleItem with
|Some(f) -> f.append person
personGroups
|None -> PersonGroup(person.origin, [person]) :: personGroups
let rec findPersonGroups (persons:List<Person>) (personGroups:List<PersonGroup>) =
match persons with
| [] -> personGroups
| h::t -> let newGroup = ( h|> addToGroup personGroups)
findPersonGroups t newGroup
let persons = [Person(1000,20, Afrika);Person(1300,22,Afrika);Person(500,21,Afrika);Person(400,20,Afrika)]
let c = findPersonGroups persons List.empty<PersonGroup>
What I may need to emphasize: There can be several different groups with the same origin.
Tomas' solution using groupby is the optimal approach if you want to generate your collections only once, it's a simple and concise.
If you want to be able to add/remove items in a functional, referentially transparent style for this type of problem, I suggest you move away from seq and start using Map.
You have a setup which is fundamentally dictionary-like. You have a unique key and a value. The functional F# equivalent to a dictionary is a Map, it is an immutable data structure based on an AVL tree. You can insert, remove and search in O(log n) time. When you append/remove from the Map, the old Map is maintained and you receive a new Map.
Here is your code expressed in this style
type ItemType =
|Odd
|Even
type Item (number) =
member this.Number = number
member this.Type = if (this.Number % 2) = 0 then Even else Odd
type NumTypeCollection = {Items : Map<ItemType, Item list>}
/// Functions on NumTypeCollection
module NumberTypeCollection =
/// Create empty collection
let empty = {Items = Map.empty}
/// Append one item to the collection
let append (item : Item) numTypeCollection =
let key = item.Type
match Map.containsKey key numTypeCollection.Items with
|true ->
let value = numTypeCollection.Items |> Map.find key
let newItems =
numTypeCollection.Items
|> Map.remove key
|> Map.add key (item :: value) // append item
{Items = newItems }
|false -> {Items = numTypeCollection.Items |> Map.add key [item]}
/// Append a list of items to the collections
let appendList (item : Item list) numTypeCollection =
item |> List.fold (fun acc it -> append it acc) numTypeCollection
Then call it using:
let items = [Item(1);Item(2);Item(3);Item(4)]
let finalCollections = NumberTypeCollection.appendList items (NumberTypeCollection.empty)
If I understand your problem correctly, you're trying to group the items by their type. The easiest way to do that is to use the standard library function Seq.groupBy. The following should implement the same logic as your code:
items
|> Seq.groupBy (fun item -> item.Type)
|> Seq.map (fun (key, values) ->
NumberTypeCollection(key, List.ofSeq values))
Maybe there are further issues.
Probably. It's difficult to tell, since it's hard to detect the purpose of the OP code... still:
Why do you even need an Item class? Instead, you could simply have a itemType function:
let itemType i = if i % 2 = 0 then Even else Odd
This function is referentially transparent, which means that you can replace it with its value if you wish. That makes it as good as a property getter method, but now you've already saved yourself from introducing a new type.
Why define a NumberTypeCollection class? Why not a simple record?
type NumberTypeList = { ItemType : ItemType; Numbers : int list }
You can implement addToCollection like something like this:
let addToCollection collections i =
let candidate =
collections
|> Seq.filter (fun c -> c.ItemType = (itemType i))
|> Seq.tryHead
match candidate with
| Some x ->
let x' = { x with Numbers = i :: x.Numbers }
collections |> Seq.filter ((<>) x) |> Seq.append [x']
| None ->
collections |> Seq.append [{ ItemType = (itemType i); Numbers = [i] }]
Being immutable, it doesn't mutate the input collections, but instead returns a new sequence of NumberTypeList.
Also notice the use of Seq.tryHead instead of Seq.tryFind(fun _ -> true).
Still, if you're attempting to group items, then Tomas' suggestion of using Seq.groupBy is more appropriate.

Proper use of fold in F#

I am new to F#. I am trying to use List.fold to help me generate a list of categories and sub-categories based on their Id and ParentId fields. It seems I probably made this code more complex than need be, as I'm getting the stackoverflow error. What am I doing wrong or missing? All related feedback is appreciated.
// types
type CategoryStructure = {
Id: ValidString;
ParentId: ValidString;
Name: ValidString;
Abbreviation: ValidString;
Description: ValidString;
SapId: ValidString;
Section: ValidString;
SectionPosition: ValidString
}
type DynamicCategories = {
Category: CategoryStructure;
SubCategories: seq<DynamicCategories>
}
// this is the function that produces the stack overflow error
let rec private structureCategories (fullList: CategoryStructure list)
(list: CategoryStructure list) =
List.fold (fun acc elem ->
// get all categories and details
let categories = fullList
let mainAcc =
[
for row in categories do
if row = elem
then
let subs =
List.fold (fun acc' elem' ->
if row.Id = elem'.ParentStructureId
then
let foundSubCategory =
{
Category = elem';
SubCategories = structureCategories fullList list |> Seq.ofList
}
foundSubCategory :: acc'
else acc'
) List.empty<DynamicCategories> categories
|> Seq.ofList
yield{
Category = elem;
SubCategories = subs
}
]
mainAcc # acc
) List.empty<DynamicCategories> list
// this function gets the initial parent categories and calls the above function
let getStructuredCategories () =
let categories = allCategoriesAndDetails () |> List.ofSeq
[
for row in categories do
if row.ParentStructureId = NotValid
then yield row
] |> structureCategories categories |> Seq.ofList
You keep calling structureCategories with the same arguments - fullList and list. Since arguments are same, it proceeds to do exactly the same thing as on the previous pass, and ends up calling itself again, with the same arguments. And so on.
This is unbounded recursion ("unbounded" here means "doesn't know when to stop recurring"), and it is also not "tail recursion", so quite naturally, it causes stack overflow.
If you want to turn the flat list into a tree-like structure, you could do a bit simpler than this:
let getChildren fullList parentId = fullList |> List.filter (fun c -> c.ParentId = parentId)
let rec toTree fullList root =
{ Category = root;
SubCategories =
getChildren fullList root.Id
|> List.map (toTree fullList) }
With this, you'll be left with two problems, which I don't know how to solve without knowing more about your requirements:
This will still cause stack overflow if the original list happens to have cycles.
You need to decide who the root(s) of the tree is (or are). Intuitively, this would be indicated via "empty" ParentId, but it is unclear from your data structure what "empty" means.
And finally, this naive solution, while better than your original one, is still a bit slower than it needs to be. It iterates over the whole list once, and for every node does another pass to determine its children, resulting in overall complexity of O(N^2). This may be fine if you expect relatively small list, but not so fine for larger lists. In that case, I would first turn the list into a hashtable (keyed by ParentId) and then use that to find children instead of List.filter.
Thanks to Fyodor, I saw my mistake. He was dead on about calling the same arguments. I added this bit of code right before the foundSubCategory value:
let modifiedList = elem' :: List.empty<CategoryStructure>
and then called that value in the subsequent code:
let foundSubCategory =
{
Category = elem';
SubCategories = structureCategories fullList modifiedList |> Seq.ofList
}
This solved my issue, but now as Fyodor alluded to, I now have to refactor this into something more efficient.
UPDATE
With the insight that Fyodor pointed out this is the current state of my code, which replaces the original code:
let getStructuredCategories () =
let fullList = allCategoriesAndDetails ()
let parentList () =
allCategoriesAndDetails ()
|> Seq.filter (fun p -> p.ParentStructureId = NotValid)
let rec toTree (fullList': seq<CategoryStructure>) (parent: CategoryStructure) =
fullList'
|> Seq.filter (fun x -> x.ParentStructureId = parent.Id)
|> Seq.map (fun x ->
{
Category = x;
SubCategories =
toTree fullList' x
})
seq {
for row in parentList () do
yield {
Category = row;
SubCategories = toTree fullList row
}
}

Resources