How would you convert this mutable tree into an immutable one? - f#

How would you convert type Node into an immutable tree?
This class implements a range tree that does not allow overlapping or adjacent ranges and instead joins them. For example if the root node is {min = 10; max = 20} then it's right child and all its grandchildren must have a min and max value greater than 21. The max value of a range must be greater than or equal to the min. I included a test function so you can run this as is and it will dump out any cases that fail.
I recommend starting with the Insert method to read this code.
module StackOverflowQuestion
open System
type Range =
{ min : int64; max : int64 }
with
override this.ToString() =
sprintf "(%d, %d)" this.min this.max
[<AllowNullLiteralAttribute>]
type Node(left:Node, right:Node, range:Range) =
let mutable left = left
let mutable right = right
let mutable range = range
// Symmetric to clean right
let rec cleanLeft(node : Node) =
if node.Left = null then
()
elif range.max < node.Left.Range.min - 1L then
cleanLeft(node.Left)
elif range.max <= node.Left.Range.max then
range <- {min = range.min; max = node.Left.Range.max}
node.Left <- node.Left.Right
else
node.Left <- node.Left.Right
cleanLeft(node)
// Clean right deals with merging when the node to merge with is not on the
// left outside of the tree. It travels right inside the tree looking for an
// overlapping node. If it finds one it merges the range and replaces the
// node with its left child thereby deleting it. If it finds a subset node
// it replaces it with its left child, checks it and continues looking right.
let rec cleanRight(node : Node) =
if node.Right = null then
()
elif range.min > node.Right.Range.max + 1L then
cleanRight(node.Right)
elif range.min >= node.Right.Range.min then
range <- {min = node.Right.Range.min; max = range.max}
node.Right <- node.Right.Left
else
node.Right <- node.Right.Left
cleanRight(node)
// Merger left is called whenever the min value of a node decreases.
// It handles the case of left node overlap/subsets and merging/deleting them.
// When no more overlaps are found on the left nodes it calls clean right.
let rec mergeLeft(node : Node) =
if node.Left = null then
()
elif range.min <= node.Left.Range.min - 1L then
node.Left <- node.Left.Left
mergeLeft(node)
elif range.min <= node.Left.Range.max + 1L then
range <- {min = node.Left.Range.min; max = range.max}
node.Left <- node.Left.Left
else
cleanRight(node.Left)
// Symmetric to merge left
let rec mergeRight(node : Node) =
if node.Right = null then
()
elif range.max >= node.Right.Range.max + 1L then
node.Right <- node.Right.Right
mergeRight(node)
elif range.max >= node.Right.Range.min - 1L then
range <- {min = range.min; max = node.Right.Range.max}
node.Right <- node.Right.Right
else
cleanLeft(node.Right)
let (|Before|After|BeforeOverlap|AfterOverlap|Superset|Subset|) r =
if r.min > range.max + 1L then After
elif r.min >= range.min then
if r.max <= range.max then Subset
else AfterOverlap
elif r.max < range.min - 1L then Before
elif r.max <= range.max then
if r.min >= range.min then Subset
else BeforeOverlap
else Superset
member this.Insert r =
match r with
| After ->
if right = null then
right <- Node(null, null, r)
else
right.Insert(r)
| AfterOverlap ->
range <- {min = range.min; max = r.max}
mergeRight(this)
| Before ->
if left = null then
left <- Node(null, null, r)
else
left.Insert(r)
| BeforeOverlap ->
range <- {min = r.min; max = range.max}
mergeLeft(this)
| Superset ->
range <- r
mergeLeft(this)
mergeRight(this)
| Subset -> ()
member this.Left with get() : Node = left and set(x) = left <- x
member this.Right with get() : Node = right and set(x) = right <- x
member this.Range with get() : Range = range and set(x) = range <- x
static member op_Equality (a : Node, b : Node) =
a.Range = b.Range
override this.ToString() =
sprintf "%A" this.Range
type RangeTree() =
let mutable root = null
member this.Add(range) =
if root = null then
root <- Node(null, null, range)
else
root.Insert(range)
static member fromArray(values : Range seq) =
let tree = new RangeTree()
values |> Seq.iter (fun value -> tree.Add(value))
tree
member this.Seq
with get() =
let rec inOrder(node : Node) =
seq {
if node <> null then
yield! inOrder node.Left
yield {min = node.Range.min; max = node.Range.max}
yield! inOrder node.Right
}
inOrder root
let TestRange() =
printf "\n"
let source(n) =
let rnd = new Random(n)
let rand x = rnd.NextDouble() * float x |> int64
let rangeRnd() =
let a = rand 1500
{min = a; max = a + rand 15}
[|for n in 1 .. 50 do yield rangeRnd()|]
let shuffle n (array:_[]) =
let rnd = new Random(n)
for i in 0 .. array.Length - 1 do
let n = rnd.Next(i)
let temp = array.[i]
array.[i] <- array.[n]
array.[n] <- temp
array
let testRangeAdd n i =
let dataSet1 = source (n+0)
let dataSet2 = source (n+1)
let dataSet3 = source (n+2)
let result1 = Array.concat [dataSet1; dataSet2; dataSet3] |> shuffle (i+3) |> RangeTree.fromArray
let result2 = Array.concat [dataSet2; dataSet3; dataSet1] |> shuffle (i+4) |> RangeTree.fromArray
let result3 = Array.concat [dataSet3; dataSet1; dataSet2] |> shuffle (i+5) |> RangeTree.fromArray
let test1 = (result1.Seq, result2.Seq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let test2 = (result2.Seq, result3.Seq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let test3 = (result3.Seq, result1.Seq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let print dataSet =
dataSet |> Seq.iter (fun r -> printf "%s " <| string r)
if not (test1 && test2 && test3) then
printf "\n\nTest# %A: " n
printf "\nSource 1: %A: " (n+0)
dataSet1 |> print
printf "\nSource 2: %A: " (n+1)
dataSet2 |> print
printf "\nSource 3: %A: " (n+2)
dataSet3 |> print
printf "\nResult 1: %A: " (n+0)
result1.Seq |> print
printf "\nResult 2: %A: " (n+1)
result2.Seq |> print
printf "\nResult 3: %A: " (n+2)
result3.Seq |> print
()
for i in 1 .. 10 do
for n in 1 .. 1000 do
testRangeAdd n i
printf "\n%d" (i * 1000)
printf "\nDone"
TestRange()
System.Console.ReadLine() |> ignore
Test cases for Range
After (11, 14) | | <-->
AfterOverlap (10, 14) | |<--->
AfterOverlap ( 9, 14) | +---->
AfterOverlap ( 6, 14) |<--+---->
"Test Case" ( 5, 9) +---+
BeforeOverlap ( 0, 8) <----+-->|
BeforeOverlap ( 0, 5) <----+ |
BeforeOverlap ( 0, 4) <--->| |
Before ( 0, 3) <--> | |
Superset ( 4, 10) <+---+>
Subset ( 5, 9) +---+
Subset ( 6, 8) |<->|
This is not an answer.
I adapted my test case to run against Juliet's code. It fails on a number of cases however I do see it passing some test.
type Range =
{ min : int64; max : int64 }
with
override this.ToString() =
sprintf "(%d, %d)" this.min this.max
let rangeSeqToJTree ranges =
ranges |> Seq.fold (fun tree range -> tree |> insert (range.min, range.max)) Nil
let JTreeToRangeSeq node =
let rec inOrder node =
seq {
match node with
| JNode(left, min, max, right) ->
yield! inOrder left
yield {min = min; max = max}
yield! inOrder right
| Nil -> ()
}
inOrder node
let TestJTree() =
printf "\n"
let source(n) =
let rnd = new Random(n)
let rand x = rnd.NextDouble() * float x |> int64
let rangeRnd() =
let a = rand 15
{min = a; max = a + rand 5}
[|for n in 1 .. 5 do yield rangeRnd()|]
let shuffle n (array:_[]) =
let rnd = new Random(n)
for i in 0 .. array.Length - 1 do
let n = rnd.Next(i)
let temp = array.[i]
array.[i] <- array.[n]
array.[n] <- temp
array
let testRangeAdd n i =
let dataSet1 = source (n+0)
let dataSet2 = source (n+1)
let dataSet3 = source (n+2)
let result1 = Array.concat [dataSet1; dataSet2; dataSet3] |> shuffle (i+3) |> rangeSeqToJTree
let result2 = Array.concat [dataSet2; dataSet3; dataSet1] |> shuffle (i+4) |> rangeSeqToJTree
let result3 = Array.concat [dataSet3; dataSet1; dataSet2] |> shuffle (i+5) |> rangeSeqToJTree
let test1 = (result1 |> JTreeToRangeSeq, result2 |> JTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let test2 = (result2 |> JTreeToRangeSeq, result3 |> JTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let test3 = (result3 |> JTreeToRangeSeq, result1 |> JTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let print dataSet =
dataSet |> Seq.iter (fun r -> printf "%s " <| string r)
if not (test1 && test2 && test3) then
printf "\n\nTest# %A: " n
printf "\nSource 1: %A: " (n+0)
dataSet1 |> print
printf "\nSource 2: %A: " (n+1)
dataSet2 |> print
printf "\nSource 3: %A: " (n+2)
dataSet3 |> print
printf "\n\nResult 1: %A: " (n+0)
result1 |> JTreeToRangeSeq |> print
printf "\nResult 2: %A: " (n+1)
result2 |> JTreeToRangeSeq |> print
printf "\nResult 3: %A: " (n+2)
result3 |> JTreeToRangeSeq |> print
()
for i in 1 .. 1 do
for n in 1 .. 10 do
testRangeAdd n i
printf "\n%d" (i * 10)
printf "\nDone"
TestJTree()

Got it working! I think the hardest part was figuring out how to make recursive calls on children while passing state back up the stack.
Performance is rather interesting. When inserting mainly ranges that collide and get merged together the mutable version is faster while if you insert mainly none overlapping nodes and fill out the tree the immutable version is faster. I've seen performance swing a max of 100% both ways.
Here's the complete code.
module StackOverflowQuestion
open System
type Range =
{ min : int64; max : int64 }
with
override this.ToString() =
sprintf "(%d, %d)" this.min this.max
type RangeTree =
| Node of RangeTree * int64 * int64 * RangeTree
| Nil
// Clean right deals with merging when the node to merge with is not on the
// left outside of the tree. It travels right inside the tree looking for an
// overlapping node. If it finds one it merges the range and replaces the
// node with its left child thereby deleting it. If it finds a subset node
// it replaces it with its left child, checks it and continues looking right.
let rec cleanRight n node =
match node with
| Node(left, min, max, (Node(left', min', max', right') as right)) ->
if n > max' + 1L then
let node, n' = right |> cleanRight n
Node(left, min, max, node), n'
elif n >= min' then
Node(left, min, max, left'), min'
else
Node(left, min, max, left') |> cleanRight n
| _ -> node, n
// Symmetric to clean right
let rec cleanLeft x node =
match node with
| Node(Node(left', min', max', right') as left, min, max, right) ->
if x < min' - 1L then
let node, x' = left |> cleanLeft x
Node(node, min, max, right), x'
elif x <= max' then
Node(right', min, max, right), max'
else
Node(right', min, max, right) |> cleanLeft x
| Nil -> node, x
| _ -> node, x
// Merger left is called whenever the min value of a node decreases.
// It handles the case of left node overlap/subsets and merging/deleting them.
// When no more overlaps are found on the left nodes it calls clean right.
let rec mergeLeft n node =
match node with
| Node(Node(left', min', max', right') as left, min, max, right) ->
if n <= min' - 1L then
Node(left', min, max, right) |> mergeLeft n
elif n <= max' + 1L then
Node(left', min', max, right)
else
let node, min' = left |> cleanRight n
Node(node, min', max, right)
| _ -> node
// Symmetric to merge left
let rec mergeRight x node =
match node with
| Node(left, min, max, (Node(left', min', max', right') as right)) ->
if x >= max' + 1L then
Node(left, min, max, right') |> mergeRight x
elif x >= min' - 1L then
Node(left, min, max', right')
else
let node, max' = right |> cleanLeft x
Node(left, min, max', node)
| node -> node
let (|Before|After|BeforeOverlap|AfterOverlap|Superset|Subset|) (min, max, min', max') =
if min > max' + 1L then After
elif min >= min' then
if max <= max' then Subset
else AfterOverlap
elif max < min' - 1L then Before
elif max <= max' then
if min >= min' then Subset
else BeforeOverlap
else Superset
let rec insert min' max' this =
match this with
| Node(left, min, max, right) ->
match (min', max', min, max) with
| After -> Node(left, min, max, right |> insert min' max')
| AfterOverlap -> Node(left, min, max', right) |> mergeRight max'
| Before -> Node(left |> insert min' max', min, max, right)
| BeforeOverlap -> Node(left, min', max, right) |> mergeLeft min'
| Superset -> Node(left, min', max', right) |> mergeLeft min' |> mergeRight max'
| Subset -> this
| Nil -> Node(Nil, min', max', Nil)
let rangeSeqToRangeTree ranges =
ranges |> Seq.fold (fun tree range -> tree |> insert range.min range.max) Nil
let rangeTreeToRangeSeq node =
let rec inOrder node =
seq {
match node with
| Node(left, min, max, right) ->
yield! inOrder left
yield {min = min; max = max}
yield! inOrder right
| Nil -> ()
}
inOrder node
let TestImmutableRangeTree() =
printf "\n"
let source(n) =
let rnd = new Random(n)
let rand x = rnd.NextDouble() * float x |> int64
let rangeRnd() =
let a = rand 15000
{min = a; max = a + rand 150}
[|for n in 1 .. 200 do yield rangeRnd()|]
let shuffle n (array:_[]) =
let rnd = new Random(n)
for i in 0 .. array.Length - 1 do
let n = rnd.Next(i)
let temp = array.[i]
array.[i] <- array.[n]
array.[n] <- temp
array
let print dataSet =
dataSet |> Seq.iter (fun r -> printf "%s " <| string r)
let testRangeAdd n i =
let dataSet1 = source (n+0)
let dataSet2 = source (n+1)
let dataSet3 = source (n+2)
let result1 = Array.concat [dataSet1; dataSet2; dataSet3] |> shuffle (i+3) |> rangeSeqToRangeTree
let result2 = Array.concat [dataSet2; dataSet3; dataSet1] |> shuffle (i+4) |> rangeSeqToRangeTree
let result3 = Array.concat [dataSet3; dataSet1; dataSet2] |> shuffle (i+5) |> rangeSeqToRangeTree
let test1 = (result1 |> rangeTreeToRangeSeq, result2 |> rangeTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let test2 = (result2 |> rangeTreeToRangeSeq, result3 |> rangeTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
let test3 = (result3 |> rangeTreeToRangeSeq, result1 |> rangeTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max)
if not (test1 && test2 && test3) then
printf "\n\nTest# %A: " n
printf "\nSource 1: %A: " (n+0)
dataSet1 |> print
printf "\nSource 2: %A: " (n+1)
dataSet2 |> print
printf "\nSource 3: %A: " (n+2)
dataSet3 |> print
printf "\n\nResult 1: %A: " (n+0)
result1 |> rangeTreeToRangeSeq |> print
printf "\nResult 2: %A: " (n+1)
result2 |> rangeTreeToRangeSeq |> print
printf "\nResult 3: %A: " (n+2)
result3 |> rangeTreeToRangeSeq |> print
()
for i in 1 .. 10 do
for n in 1 .. 100 do
testRangeAdd n i
printf "\n%d" (i * 10)
printf "\nDone"
TestImmutableRangeTree()
System.Console.ReadLine() |> ignore

It looks like you're defining a binary tree which is basically a union of a bunch of ranges. So, you have the following scenarios:
(10, 20) left (10, 20)
/ \ --> / \
(0, 5) (25, 30) (7, 8) (7, 8) (25, 30)
/
(0, 5)
(10, 20) right (10, 20)
/ \ --> / \
(0, 5) (25, 30) (21, 22) (0, 5) (21, 22)
\
(25, 30)
(10, 20) subset (10, 20)
/ \ --> / \
(0, 5) (25, 30) (15, 19) (0, 5) (25, 30)
(10, 20) R-superset (10, 30)
/ \ --> /
(0, 5) (25, 30) (11, 30) (0, 5)
(10, 20) L-superset (0, 20)
/ \ --> \
(0, 5) (25, 30) (0, 10) (25, 30)
(10, 20) LR-superset (0, 30)
/ \ -->
(0, 5) (25, 30) (0, 30)
The L- R- and LR-superset cases are interesting because it requires merging/deleting nodes when you insert a node whose range already contains other nodes.
The following is hastily written and not tested very well, but appears to satisfy the simple definition above:
type JTree =
| JNode of JTree * int64 * int64 * JTree
| Nil
let rec merge = function
| JNode(JNode(ll, lmin, lmax, lr), min, max, r) when min <= lmin -> merge <| JNode(ll, min, max, r)
| JNode(l, min, max, JNode(rl, rmin, rmax, rr)) when max >= rmax -> merge <| JNode(l, min, max, rr)
| n -> n
let rec insert (min, max) = function
| JNode(l, min', max', r) ->
let node =
// equal.
// e.g. Given Node(l, 10, 20, r) insert (10, 20)
if min' = min && max' = max then JNode(l, min', max', r)
// before. Insert left
// e.g. Given Node(l, 10, 20, r) insert (5, 7)
elif min' >= max then JNode(insert (min, max) l, min', max', r)
// after. Insert right
// e.g. Given Node(l, 10, 20, r) insert (30, 40)
elif max' <= min then JNode(l, min', max', insert (min, max) r)
// superset
// e.g. Given Node(l, 10, 20, r) insert (0, 40)
elif min' >= min && max' <= max then JNode(l, min, max, r)
// overlaps left
// e.g. Given Node(l, 10, 20, r) insert (5, 15)
elif min' >= min && max' >= max then JNode(l, min, max', r)
// overlaps right
// e.g. Given Node(l, 10, 20, r) insert (15, 40)
elif min' <= min && max' <= max then JNode(l, min', max, r)
// subset.
// e.g. Given Node(l, 10, 20, r) insert (15, 17)
elif min' <= min && max >= max then JNode(l, min', max', r)
// shouldn't happen
else failwith "insert (%i, %i) into Node(l, %i, %i, r)" min max min' max'
// balances left and right sides
merge node
| Nil -> JNode(Nil, min, max, Nil)
JTree = Juliet Tree :) The merge function does all the heavy lifting. It'll merge as far as possible down the left spine, then as far as possible down the right spine.
I'm not wholly convinced that my overlaps left and overlaps right cases are implemented properly, but the other cases should be correct.

Related

F# list group by running total?

I have the following list of tuples ordered by the first item. I want to cluster the times by
If the second item of the tuple is greater then 50, it will be in its own cluster.
Otherwise, cluster the items whose sum is less than 50.
The order cannot be changed.
code:
let values =
[("ACE", 78);
("AMR", 3);
("Aam", 6);
("Acc", 1);
("Adj", 23);
("Aga", 12);
("All", 2);
("Ame", 4);
("Amo", 60);
//....
]
values |> Seq.groupBy(fun (k,v) -> ???)
The expected value will be
[["ACE"] // 78
["AMR"; "Aam"; "Acc"; "Adj"; "Aga"; "All"] // 47
["Ame"] // 4
["Amo"] // 60
....]
Ideally, I want to evenly distribute the second group (["AMR"; "Aam"; "Acc"; "Adj"; "Aga"; "All"] which got the sum of 47) and the third one (["Ame"] which has only 4).
How to implement it in F#?
I had the following solution. It uses a mutable variable. It's not F# idiomatic? Is for ... do imperative in F# or is it a syntactic sugar of some function construct?
seq {
let mutable c = []
for v in values |> Seq.sortBy(fun (k, _) -> k) do
let sum = c |> Seq.map(fun (_, v) -> v) |> Seq.sum
if not(c = []) && sum + (snd v) > 50
then
yield c
c <- [v]
else
c <- List.append c [v]
}
I think I got it. Not the nicest code ever, but works and is immutable.
let foldFn (acc:(string list * int) list) (name, value) =
let addToLast last =
let withoutLast = acc |> List.filter ((<>) last)
let newLast = [((fst last) # [name]), (snd last) + value]
newLast |> List.append withoutLast
match acc |> List.tryLast with
| None -> [[name],value]
| Some l ->
if (snd l) + value <= 50 then addToLast l
else [[name], value] |> List.append acc
values |> List.fold foldFn [] |> List.map fst
Update: Since append can be quite expensive operation, I added prepend only version (still fulfills original requirement to keep order).
let foldFn (acc:(string list * int) list) (name, value) =
let addToLast last =
let withoutLast = acc |> List.filter ((<>) last) |> List.rev
let newLast = ((fst last) # [name]), (snd last) + value
(newLast :: withoutLast) |> List.rev
match acc |> List.tryLast with
| None -> [[name],value]
| Some l ->
if (snd l) + value <= 50 then addToLast l
else ([name], value) :: (List.rev acc) |> List.rev
Note: There is still # operator on line 4 (when creating new list of names in cluster), but since the theoretical maximum amount of names in cluster is 50 (if all of them would be equal 1), the performance here is negligible.
If you remove List.map fst on last line, you would get sum value for each cluster in list.
Append operations are expensive. A straight-forward fold with prepended intermediate results is cheaper, even if the lists need to be reversed after processing.
["ACE", 78; "AMR", 3; "Aam", 6; "Acc", 1; "Adj", 23; "Aga", 12; "All", 2; "Ame", 4; "Amd", 6; "Amo", 60]
|> List.fold (fun (r, s1, s2) (t1, t2) ->
if t2 > 50 then [t1]::s1::r, [], 0
elif s2 + t2 > 50 then s1::r, [t1], t2
else r, t1::s1, s2 + t2 ) ([], [], 0)
|> fun (r, s1, _) -> s1::r
|> List.filter (not << List.isEmpty)
|> List.map List.rev
|> List.rev
// val it : string list list =
// [["ACE"]; ["AMR"; "Aam"; "Acc"; "Adj"; "Aga"; "All"]; ["Ame"; "Amd"];
// ["Amo"]]
Here is a recursive version - working much the same way as fold-versions:
let groupBySums data =
let rec group cur sum acc lst =
match lst with
| [] -> acc |> List.where (not << List.isEmpty) |> List.rev
| (name, value)::tail when value > 50 -> group [] 0 ([(name, value)]::(cur |> List.rev)::acc) tail
| (name, value)::tail ->
match sum + value with
| x when x > 50 -> group [(name, value)] 0 ((cur |> List.rev)::acc) tail
| _ -> group ((name, value)::cur) (sum + value) acc tail
(data |> List.sortBy (fun (name, _) -> name)) |> group [] 0 []
values |> groupBySums |> List.iter (printfn "%A")
Yet another solution using Seq.mapFold and Seq.groupBy:
let group values =
values
|> Seq.mapFold (fun (group, total) (name, count) ->
let newTotal = count + total
let newGroup = group + if newTotal > 50 then 1 else 0
(newGroup, name), (newGroup, if newGroup = group then newTotal else count)
) (0, 0)
|> fst
|> Seq.groupBy fst
|> Seq.map (snd >> Seq.map snd >> Seq.toList)
Invoke it like this:
[ "ACE", 78
"AMR", 3
"Aam", 6
"Acc", 1
"Adj", 23
"Aga", 12
"All", 2
"Ame", 4
"Amo", 60
]
|> group
|> Seq.iter (printfn "%A")
// ["ACE"]
// ["AMR"; "Aam"; "Acc"; "Adj"; "Aga"; "All"]
// ["Ame"]
// ["Amo"]

Get element from set of tuples in F#

I want to find tuple in a set by first two values and return third value of the tuple (or None if found nothing). I woluld like something like that:
type Point = (int * int * int)
type Path = Set<Point>
let f (x:int) (y:int) (p:Path) : int Option =
if Set.exists ((=) (x, y, _z)) p
then Some _z
else None
let p:Path = Set.ofList [ (0, 1, 100); (1, 1, 500); (1, 2, 50); ]
f 1 2 p
But this not works because, apparently, pattern matching does not allowed in expressions. What is the right approach? Thanks.
You can convert the set to list and use List.tryFind
let f (x:int) (y:int) (p:Path) : int Option =
Set.toList p
|> List.tryFind (fun (px, py, _) -> x = px && y = py)
|> Option.map (fun (_, _, pz) -> pz)
Iterating on hvester's answer:
let f (x:int) (y:int) (p:Path) : int Option =
p |> Seq.tryPick (function
| x', y', z' when x = x' && y = y' -> Some z'
| _ -> None)
tryPick essentially does a find and map in one step.
This is a pretty neat solution with fold
let f x y p = Set.fold (function |None -> (fun (x_,y_,z) -> if x=x_ && y=y_ then Some z else None) |f ->fun _ -> f) None p
Is this what you want to do?
let f (x:int) (y:int) (p:Path) : int Option =
match p |> Set.filter (fun (x', y', _) -> x' = x && y' = y) |> Set.toList with
| [(_, _, z)] -> Some z
| [] -> None
| _ -> failwith "More than one point was found!"
Example:
> let p:Path = Set.ofList [ (0, 1, 100); (1, 1, 500); (1, 2, 50); ];;
val p : Path = set [(0, 1, 100); (1, 1, 500); (1, 2, 50)]
> f 1 2 p;;
val it : Option<int> = Some 50

Finding an index of a max value of a list in F#

I'm trying to write a function that takes a list for example
let list = [5;23;29;1]
let x = max list // This will return 2 because 29 will be the max value and it's "indexed" at position 2
I'm not sure about how to go about writing the max function
Since my list will only contain four elements I currently have some code like this
let list = (1, newMap1 |> getScore) :: (2, newMap2 |> getScore) :: (3, newMap3 |> getScore) :: (4, newMap4 |> getScore) :: []
I consider this a terrible approach but I'm still stuck on how to return (x, _) after I find the max of (_, y). I'm very confident with imperative approaches but I'm stumped on how to do this functionally
There is a couple of ways to do this. At the low-level, you can write a recursive function to iterate and pattern match over a list. This is good exercise if you are learning F#.
Similarly, you can implement this using the fold function. Here, the idea is that we keep some state, consisting of the "best value" and the index of the best value. At each step, we either keep the original information, or update it:
let _, maxValue, maxIndex =
list |> List.fold (fun (index, maxSoFar, maxIndex) v ->
if v > maxSoFar then (index+1, v, index+1)
else (index+1, maxSoFar, maxIndex)) (-1, System.Int32.MinValue, -1)
Finally, the shortest option I can think of is to use mapi and maxBy functions:
list
|> Seq.mapi (fun i v -> i, v)
|> Seq.maxBy snd
Here's an answer only using pattern matching and recursion.
let list = [5;23;29;1]
let rec findIndexOfMaxValue (maxValue:int) indexOfMaxValue currentIndex aList =
match aList with
| [] -> indexOfMaxValue
| head::tail -> match head with
| head when head > maxValue -> findIndexOfMaxValue head currentIndex (currentIndex + 1) tail
| _ -> findIndexOfMaxValue maxValue indexOfMaxValue (currentIndex + 1) tail
[<EntryPoint>]
let main argv =
let indexOfMaxValue = findIndexOfMaxValue 0 0 0 list
printfn "The index of the maximum value is %A." indexOfMaxValue
//The index of the maximum value is 2.
0
Out of interest, I made a timing script comparing my algorithm with the other ones provided:
open System.Diagnostics
let n = 5000
let random = System.Random 543252
let randomlists =
[for i in [1..n] -> [ for i in [1..n] -> random.Next (0, n*n)]]
let stopWatch =
let sw = Stopwatch ()
sw.Start ()
sw
let timeIt (name : string) (a : int list -> 'T) : unit =
let t = stopWatch.ElapsedMilliseconds
let v = a (randomlists.[0])
for i = 1 to (n - 1) do
a randomlists.[i] |> ignore
let d = stopWatch.ElapsedMilliseconds - t
printfn "%s, elapsed %d ms, result %A" name d v
let rec findIndexOfMaxValue (maxValue:int) indexOfMaxValue currentIndex aList =
match aList with
| [] -> indexOfMaxValue
| head::tail -> match head with
| head when head > maxValue -> findIndexOfMaxValue head currentIndex (currentIndex + 1) tail
| _ -> findIndexOfMaxValue maxValue indexOfMaxValue (currentIndex + 1) tail
let findIndexOfMaxValueFoldAlg list =
let _, maxValue, maxIndex =
list |> List.fold (fun (index, maxSoFar, maxIndex) v ->
if v > maxSoFar then (index+1, v, index+1)
else (index+1, maxSoFar, maxIndex)) (-1, System.Int32.MinValue, -1)
maxIndex
let findIndexOfMaxValueSimpleSeq list = list
|> Seq.mapi (fun i v -> i, v)
|> Seq.maxBy snd
|> fst
let findIndexOfMaxValueSimpleList list =
list
|> List.mapi (fun i x -> i, x)
|> List.maxBy snd
|> fst
[<EntryPoint>]
let main argv =
timeIt "recursiveOnly" (findIndexOfMaxValue 0 0 0)
timeIt "simpleSeq" findIndexOfMaxValueSimpleSeq
timeIt "simpleList" findIndexOfMaxValueSimpleList
0
The results I get are:
recursiveOnly, elapsed 356ms, result 3562
foldAlgorithm, elapsed 1602ms, result 3562
simpleSeq, elapsed 4504ms, result 3562
simpleList, elapsed 4395ms, result 3562
I have these functions in my helper library:
module List =
let maxIndexBy projection list =
list
|> List.mapi (fun i x -> i, projection x)
|> List.maxBy snd
|> fst
let maxIndex list = maxIndexBy id list
Returns the index of the max element, optionally using a given projection function. You can write the same functions for the Seq and Array modules easily by replacing the "List" part and renaming the arguments.

How do you sum up and average a Sequence?

Say I have a coordinate (x, y) and its neighbors in a sequences of sequence (-1, 1)(0, 1)(1, 1)(-1, 0)(0, 0)(1, 0)(-1, -1)(0, -1)(1, -1)
let n = [1 .. -1 .. -1]
|> Seq.collect (fun j -> [-1 .. 1] |> Seq.map(fun i -> [i, j]))
n |> Seq.iter(printf "%A")
I'm trying to add x and y to each element in the sequence respectively
Then get Color p = GetPixel(x+i, y+j) for every element in sequence, sum up and average out their R, G, B for (x,y)
So we have 9 Red, 9 Green, 9 Blue to Ave(Red), Ave(Blue), Ave(Green)
let offsets = seq { for i in -1 .. 1 do for j in -1 .. 1 do yield (i, j) }
let neighbourhood (x, y) = Seq.map (fun (i, j) -> (x + i, y + j)) offsets
let avgColours (cs : System.Drawing.Color seq) =
let ((r, g, b), c) = cs |> Seq.fold (fun ((r, g, b), c) col -> ((r + int col.R, g + int col.G, b + int col.B), c + 1)) ((0, 0, 0), 0)
System.Drawing.Color.FromArgb(r / c, g / c, b / c)
let avgNeighbours p = p |> neighbourhood |> Seq.map (fun (x, y) -> GetPixel(x, y)) |> avgColours
Something like this?
let f x y =
let n = [1 .. -1 .. -1] |> Seq.collect (fun j -> [-1 .. 1] |> Seq.map(fun i -> (i, j)))
n |> Seq.map (fun (i,j) -> x+i,y+j)
|> Seq.map bitmapobject.GetPixel
|> Seq.map (fun c -> float c.R, float c.G, float c.B)
|> Seq.fold (fun (R,G,B) (r,g,b) -> (R+r, G+g, B+b)) (0.0, 0.0, 0.0)
|> (fun (r,g,b) -> (r/9.0, g/9.0, b/9.0))

Further optimizing Number to Roman Numeral function in F#

I'm new to F# and I'm curious if this can still be optimized further. I am not particularly sure if I've done this correctly as well. I'm curious particularly on the last line as it looks really long and hideous.
I've searched over google, but only Roman Numeral to Number solutions only show up, so I'm having a hard time comparing.
type RomanDigit = I | IV | V | IX
let rec romanNumeral number =
let values = [ 9; 5; 4; 1 ]
let capture number values =
values
|> Seq.find ( fun x -> number >= x )
let toRomanDigit x =
match x with
| 9 -> IX
| 5 -> V
| 4 -> IV
| 1 -> I
match number with
| 0 -> []
| int -> Seq.toList ( Seq.concat [ [ toRomanDigit ( capture number values ) ]; romanNumeral ( number - ( capture number values ) ) ] )
Thanks for anyone who can help with this problem.
A slightly shorter way of recursively finding the largest digit representation that can be subtracted from the value (using List.find):
let units =
[1000, "M"
900, "CM"
500, "D"
400, "CD"
100, "C"
90, "XC"
50, "L"
40, "XL"
10, "X"
9, "IX"
5, "V"
4, "IV"
1, "I"]
let rec toRomanNumeral = function
| 0 -> ""
| n ->
let x, s = units |> List.find (fun (x,s) -> x <= n)
s + toRomanNumeral (n-x)
If I had to use a Discriminated Union to represent the roman letters I would not include IV and IX.
type RomanDigit = I|V|X
let numberToRoman n =
let (r, diff) =
if n > 8 then [X], n - 10
elif n > 3 then [V], n - 5
else [], n
if diff < 0 then I::r
else r # (List.replicate diff I)
Then, based in this solution you can go further and extend it to all numbers.
Here's my first attempt, using fold and partial application:
type RomanDigit = I|V|X|L|C|D|M
let numberToRoman n i v x =
let (r, diff) =
if n > 8 then [x], n - 10
elif n > 3 then [v], n - 5
else [], n
if diff < 0 then i::r
else r # (List.replicate diff i)
let allDigits (n:int) =
let (_, f) =
[(I,V); (X,L); (C,D)]
|> List.fold (fun (n, f) (i, v) ->
(n / 10, fun x -> (numberToRoman (n % 10) i v x) # f i)) (n, (fun _ -> []))
f M
Here's a tail-recursive version of #Philip Trelford's answer:
let toRomanNumeral n =
let rec iter acc n =
match n with
| 0 -> acc
| n ->
let x, s = units |> List.find (fun (x, _) -> x <= n)
iter (acc + s) (n-x)
iter "" n

Resources