Testing if a projection is uniform over an F# sequence - f#

I want to check if a projection over a sequence has a uniform value in F#.
Here's what I have:
module Seq =
let isUniformBy (f) (xs : seq<_>) =
let l =
xs
|> Seq.map f
|> Seq.distinct
|> Seq.truncate 2
|> Seq.length
l < 2
let isUniform xs = isUniformBy id xs
printfn "%b" <| Seq.isUniformBy id [ 1; 2; 3 ] // false
printfn "%b" <| Seq.isUniformBy id [ 1; 1; 1 ] // true
printfn "%b" <| Seq.isUniformBy id [ ] // true
printfn "%b" <| Seq.isUniformBy id [ 1; 1 ] // true
printfn "%b" <| Seq.isUniformBy id [ 1; 1; 2 ] // false
printfn "%b" <| Seq.isUniformBy id [ 1; 2 ] // false
printfn "%b" <| Seq.isUniformBy (fun x -> x % 2) [ 2; 4; 6; 8 ] // true
I was wondering if there was a built-in function for this already?
And if not, what is the best way to implement this?

We can reduce the problem to comparing adjacent elements - because for uniformity, we can't have any element that's not the same as one preceding it.
This means we only need to check if there's one such pair - we only need to enumerate the sequence until we find the pair.
let isUniform xs =
xs
|> Seq.pairwise
|> Seq.exists (fun (a, b) -> a <> b)
|> not
let isUniformBy (f) (lst : seq<_>) =
lst |> Seq.map f |> isUniform
The base method is isUniform, so we can pass a projected sequence to it from isUniformBy, avoiding a pass through id. Additionally, we only use O(1) space.
Tests
assert( Seq.isUniformBy id [ 1; 2; 3 ] = false)
assert( Seq.isUniformBy id [ 1; 1; 1 ] = true)
assert( Seq.isUniformBy id [ ] = true)
assert( Seq.isUniformBy id [ 1; 1 ] = true)
assert( Seq.isUniformBy id [ 1; 1; 2 ] = false)
assert( Seq.isUniformBy id [ 1; 2 ] = false)
assert( Seq.isUniformBy (fun x -> x % 2) [ 2; 4; 6; 8 ] = true)

You can combine the first two calls using Seq.distinctBy (link), and then simplify slightly more via Seq.tryExactlyOne (link), although it will then report false for an empty sequence:
let isUniformBy f xs =
xs
|> Seq.distinctBy f
|> Seq.tryExactlyOne
|> Option.isSome

If this is not about the best (that is, most readable, and efficient), but the shortest way, I'd follow OP's approach and optimize it a bit:
module Seq =
let isUniformBy f x = Seq.groupBy f x |> Seq.length < 2
// val isUniformBy : f:('a -> 'b) -> x:seq<'a> -> bool when 'b : equality
[ id, [ 1; 2; 3 ] // false
id, [ 1; 1; 1 ] // true
id, [ ] // true
id, [ 1; 1 ] // true
id, [ 1; 1; 2 ] // false
id, [ 1; 2 ] // false
(fun x -> x % 2), [ 2; 4; 6; 8 ]] // true
|> Seq.iter ((<||) Seq.isUniformBy >> printfn "%b")

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"]

Replicate list items n times in a F# sequence

I have a sequence in F#:
let n = 2
let seq1 = {
yield "a"
yield "b"
yield "c"
}
I want to print every item in the sequence n times. I can do it this way:
let printx line t =
for i = 1 to t do
printfn "%s" line
seq1 |> Seq.iter (fun i -> printx i n)
Output of this is:
a
a
b
b
c
c
I think this is not the best solution. How to replicate the items in the sequence?
You can create a function to replicate each element of an input sequence:
let replicateAll n s = s |> Seq.collect (fun e -> Seq.init n (fun _ -> e))
then
seq1 |> replicateAll 2 |> Seq.iter (printfn "%s")
I would rather go with a sequence computation expression.
Looks cleaner:
let replicateAll n xs = seq {
for x in xs do
for _ in 1..n do
yield x
}
There is actually a replicate function:
let xs = [1; 2; 3; 4; 5]
xs |> List.collect (fun x -> List.replicate 3 x)
//val it : int list = [1; 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 5]
And you can do function composition on it, which will get rid of the lambda:
let repCol n xs = (List.replicate >> List.collect) n xs

Slice/Group a sequence of equal chars in F#

I need to extract the sequence of equal chars in a text.
For example:
The string "aaaBbbcccccccDaBBBzcc11211" should be converted to a list of strings like
["aaa";"B";"bb";"ccccccc";"D";"a";"BBB";"z";"cc";"11";"2";"11"].
That's my solution until now:
let groupSequences (text:string) =
let toString chars =
System.String(chars |> Array.ofList)
let rec groupSequencesRecursive acc chars = seq {
match (acc, chars) with
| [], c :: rest ->
yield! groupSequencesRecursive [c] rest
| _, c :: rest when acc.[0] <> c ->
yield (toString acc)
yield! groupSequencesRecursive [c] rest
| _, c :: rest when acc.[0] = c ->
yield! groupSequencesRecursive (c :: acc) rest
| _, [] ->
yield (toString acc)
| _ ->
yield ""
}
text
|> List.ofSeq
|> groupSequencesRecursive []
groupSequences "aaaBbbcccccccDaBBBzcc11211"
|> Seq.iter (fun x -> printfn "%s" x)
|> ignore
I'm a F# newbie.
This solution can be better?
Here a completely generic implementation:
let group xs =
let folder x = function
| [] -> [[x]]
| (h::t)::ta when h = x -> (x::h::t)::ta
| acc -> [x]::acc
Seq.foldBack folder xs []
This function has the type seq<'a> -> 'a list list when 'a : equality, so works not only on strings, but on any (finite) sequence of elements, as long as the element type supports equality comparison.
Used with the input string in the OP, the return value isn't quite in the expected shape:
> group "aaaBbbcccccccDaBBBzcc11211";;
val it : char list list =
[['a'; 'a'; 'a']; ['B']; ['b'; 'b']; ['c'; 'c'; 'c'; 'c'; 'c'; 'c'; 'c'];
['D']; ['a']; ['B'; 'B'; 'B']; ['z']; ['c'; 'c']; ['1'; '1']; ['2'];
['1'; '1']]
Instead of a string list, the return value is a char list list. You can easily convert it to a list of strings using a map:
> group "aaaBbbcccccccDaBBBzcc11211" |> List.map (List.toArray >> System.String);;
val it : System.String list =
["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]
This takes advantage of the String constructor overload that takes a char[] as input.
As initially stated, this implementation is generic, so can also be used with other types of lists; e.g. integers:
> group [1;1;2;2;2;3;4;4;3;3;3;0];;
val it : int list list = [[1; 1]; [2; 2; 2]; [3]; [4; 4]; [3; 3; 3]; [0]]
How about with groupby
"aaaBbbcccccccD"
|> Seq.groupBy id
|> Seq.map (snd >> Seq.toArray)
|> Seq.map (fun t -> new string (t))
If you input order matters, here is a method that works
"aaaBbbcccccccDaBBBzcc11211"
|> Seq.pairwise
|> Seq.toArray
|> Array.rev
|> Array.fold (fun (accum::tail) (ca,cb) -> if ca=cb then System.String.Concat(accum,string ca)::tail else string(ca)::accum::tail) (""::[])
This one is also based on recursion though the matching gets away with smaller number of checks.
let chop (txt:string) =
let rec chopInner txtArr (word: char[]) (res: List<string>) =
match txtArr with
| h::t when word.[0] = h -> chopInner t (Array.append word [|h|]) res
| h::t when word.[0] <> h ->
let newWord = word |> (fun s -> System.String s)
chopInner t [|h|] (List.append res [newWord])
| [] ->
let newWord = word |> (fun s -> System.String s)
(List.append res [newWord])
let lst = txt.ToCharArray() |> Array.toList
chopInner lst.Tail [|lst.Head|] []
And the result is as expected:
val text : string = "aaaBbbcccccccDaBBBzcc11211"
> chop text;;
val it : string list =
["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]
When you're folding, you'll need to carry along both the previous value and the accumulator holding the temporary results. The previous value is wrapped as option to account for the first iteration. Afterwards, the final result is extracted and reversed.
"aaaBbbcccccccDaBBBzcc11211"
|> Seq.map string
|> Seq.fold (fun state ca ->
Some ca,
match state with
| Some cb, x::xs when ca = cb -> x + ca::xs
| _, xss -> ca::xss )
(None, [])
|> snd
|> List.rev
// val it : string list =
// ["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]
Just interesting why everyone publishing solutions based on match-with? Why not go plain recursion?
let rec groups i (s:string) =
let rec next j = if j = s.Length || s.[i] <> s.[j] then j else next(j+1)
if i = s.Length then []
else let j = next i in s.Substring(i, j - i) :: (groups j s)
"aaaBbbcccccccDaBBBzcc11211" |> groups 0
val it : string list = ["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]
As someone other here:
Know thy fold ;-)
let someString = "aaaBbbcccccccDaBBBzcc11211"
let addLists state elem =
let (p, ls) = state
elem,
match p = elem, ls with
| _, [] -> [ elem.ToString() ]
| true, h :: t -> (elem.ToString() + h) :: t
| false, h :: t -> elem.ToString() :: ls
someString
|> Seq.fold addLists ((char)0, [])
|> snd
|> List.rev

How do I write a ZipN-like function in F#?

I want to create a function with the signature seq<#seq<'a>> ->seq<seq<'a>> that acts like a Zip method taking a sequence of an arbitrary number of input sequences (instead of 2 or 3 as in Zip2 and Zip3) and returning a sequence of sequences instead of tuples as a result.
That is, given the following input:
[[1;2;3];
[4;5;6];
[7;8;9]]
it will return the result:
[[1;4;7];
[2;5;8];
[3;6;9]]
except with sequences instead of lists.
I am very new to F#, but I have created a function that does what I want, but I know it can be improved. It's not tail recursive and it seems like it could be simpler, but I don't know how yet. I also haven't found a good way to get the signature the way I want (accepting, e.g., an int list list as input) without a second function.
I know this could be implemented using enumerators directly, but I'm interested in doing it in a functional manner.
Here's my code:
let private Tail seq = Seq.skip 1 seq
let private HasLengthNoMoreThan n = Seq.skip n >> Seq.isEmpty
let rec ZipN_core = function
| seqs when seqs |> Seq.isEmpty -> Seq.empty
| seqs when seqs |> Seq.exists Seq.isEmpty -> Seq.empty
| seqs ->
let head = seqs |> Seq.map Seq.head
let tail = seqs |> Seq.map Tail |> ZipN_core
Seq.append (Seq.singleton head) tail
// Required to change the signature of the parameter from seq<seq<'a> to seq<#seq<'a>>
let ZipN seqs = seqs |> Seq.map (fun x -> x |> Seq.map (fun y -> y)) |> ZipN_core
let zipn items = items |> Matrix.Generic.ofSeq |> Matrix.Generic.transpose
Or, if you really want to write it yourself:
let zipn items =
let rec loop items =
seq {
match items with
| [] -> ()
| _ ->
match zipOne ([], []) items with
| Some(xs, rest) ->
yield xs
yield! loop rest
| None -> ()
}
and zipOne (acc, rest) = function
| [] -> Some(List.rev acc, List.rev rest)
| []::_ -> None
| (x::xs)::ys -> zipOne (x::acc, xs::rest) ys
loop items
Since this seems to be the canonical answer for writing a zipn in f#, I wanted to add a "pure" seq solution that preserves laziness and doesn't force us to load our full source sequences in memory at once like the Matrix.transpose function. There are scenarios where this is very important because it's a) faster and b) works with sequences that contain 100s of MBs of data!
This is probably the most un-idiomatic f# code I've written in a while but it gets the job done (and hey, why would there be sequence expressions in f# if you couldn't use them for writing procedural code in a functional language).
let seqdata = seq {
yield Seq.ofList [ 1; 2; 3 ]
yield Seq.ofList [ 4; 5; 6 ]
yield Seq.ofList [ 7; 8; 9 ]
}
let zipnSeq (src:seq<seq<'a>>) = seq {
let enumerators = src |> Seq.map (fun x -> x.GetEnumerator()) |> Seq.toArray
if (enumerators.Length > 0) then
try
while(enumerators |> Array.forall(fun x -> x.MoveNext())) do
yield enumerators |> Array.map( fun x -> x.Current)
finally
enumerators |> Array.iter (fun x -> x.Dispose())
}
zipnSeq seqdata |> Seq.toArray
val it : int [] [] = [|[|1; 4; 7|]; [|2; 5; 8|]; [|3; 6; 9|]|]
By the way, the traditional matrix transpose is much more terse than #Daniel's answer. Though, it requires a list or LazyList that both will eventually have the full sequence in memory.
let rec transpose =
function
| (_ :: _) :: _ as M -> List.map List.head M :: transpose (List.map List.tail M)
| _ -> []
To handle having sub-lists of different lengths, I've used option types to spot if we've run out of elements.
let split = function
| [] -> None, []
| h::t -> Some(h), t
let rec zipN listOfLists =
seq { let splitted = listOfLists |> List.map split
let anyMore = splitted |> Seq.exists (fun (f, _) -> f.IsSome)
if anyMore then
yield splitted |> List.map fst
let rest = splitted |> List.map snd
yield! rest |> zipN }
This would map
let ll = [ [ 1; 2; 3 ];
[ 4; 5; 6 ];
[ 7; 8; 9 ] ]
to
seq
[seq [Some 1; Some 4; Some 7]; seq [Some 2; Some 5; Some 8];
seq [Some 3; Some 6; Some 9]]
and
let ll = [ [ 1; 2; 3 ];
[ 4; 5; 6 ];
[ 7; 8 ] ]
to
seq
[seq [Some 1; Some 4; Some 7]; seq [Some 2; Some 5; Some 8];
seq [Some 3; Some 6; null]]
This takes a different approach to yours, but avoids using some of the operations that you had before (e.g. Seq.skip, Seq.append), which you should be careful with.
I realize that this answer is not very efficient, but I do like its succinctness:
[[1;2;3]; [4;5;6]; [7;8;9]]
|> Seq.collect Seq.indexed
|> Seq.groupBy fst
|> Seq.map (snd >> Seq.map snd);;
Another option:
let zipN ls =
let rec loop (a,b) =
match b with
|l when List.head l = [] -> a
|l ->
let x1,x2 =
(([],[]),l)
||> List.fold (fun acc elem ->
match acc,elem with
|(ah,at),eh::et -> ah#[eh],at#[et]
|_ -> acc)
loop (a#[x1],x2)
loop ([],ls)

f# sequence of running total

Ok, this looks like it should be easy, but I'm just not getting it. If I have a sequence of numbers, how do I generate a new sequence made up of the running totals? eg for a sequence [1;2;3;4], I want to map it to [1;3;6;10]. In a suitably functional way.
Use List.scan:
let runningTotal = List.scan (+) 0 >> List.tail
[1; 2; 3; 4]
|> runningTotal
|> printfn "%A"
Seq.scan-based implementation:
let runningTotal seq' = (Seq.head seq', Seq.skip 1 seq') ||> Seq.scan (+)
{ 1..4 }
|> runningTotal
|> printfn "%A"
Another variation using Seq.scan (Seq.skip 1 gets rid of the leading zero):
> {1..4} |> Seq.scan (+) 0 |> Seq.skip 1;;
val it : seq<int> = seq [1; 3; 6; 10]
> Seq.scan (fun acc n -> acc + n) 0 [1;2;3;4];;
val it : seq<int> = seq [0; 1; 3; 6; ...]
With lists:
> [1;2;3;4] |> List.scan (fun acc n -> acc + n) 0 |> List.tail;;
val it : int list = [1; 3; 6; 10]
Edit: Another way with sequences:
let sum s = seq {
let x = ref 0
for i in s do
x := !x + i
yield !x
}
Yes, there's a mutable variable, but I find it more readable (if you want to get rid of the leading 0).
Figured it was worthwhile to share how to do this with Record Types in case that's also what you came here looking for.
Below is a fictitious example demonstrating the concept using runner laps around a track.
type Split = double
type Lap = { Num : int; Split : Split }
type RunnerLap = { Lap : Lap; TotalTime : double }
let lap1 = { Num = 1; Split = 1.23 }
let lap2 = { Num = 2; Split = 1.13 }
let lap3 = { Num = 3; Split = 1.03 }
let laps = [lap1;lap2;lap3]
let runnerLapsAccumulator =
Seq.scan
(fun rl l -> { rl with Lap = l; TotalTime = rl.TotalTime + l.Split }) // acumulator
{ Lap = { Num = 0; Split = 0.0 }; TotalTime = 0.0 } // initial state
let runnerLaps = laps |> runnerLapsAccumulator
printfn "%A" runnerLaps
Not sure this is the best way but it should do the trick
let input = [1; 2; 3; 4]
let runningTotal =
(input, 0)
|> Seq.unfold (fun (list, total) ->
match list with
| [] ->
None
| h::t ->
let total = total + h
total, (t, total) |> Some)
|> List.ofSeq

Resources