Matrix transposition in F# - f#

I'm trying to modify a matrix like this one:
/ 1 2 3 \
\ 4 5 6 /
to return:
/ 1 4 \
| 2 5 |
\ 3 6 /
Instead it is flipping my matrix by the corners. This is the code I have so far:
Let rec matrixadjust = function
| (_::_) : : as xss-> List.map List.head xss :: matrixadjust (List.map List.tail xss)
| _ ->[];;

I think that the best way to work with matrix is using the Array2D data structure. You can build an Array2D from an array of arrays and then create a new Array2D to acomplish what you want:
let arrayOfArrays = [| [| 1; 2; 3 |]; [|4; 5; 6 |] |]
let array2d = Array2D.init 2 3 (fun row column -> arrayOfArrays.[row].[column])
let newArray = Array2D.init (array2d |> Array2D.length2) (array2d |> Array2D.length1) (fun r c -> array2d.[c,r])

Assuming your data structure is a list of lists where each sub-list represents a row you could do it like this. Basically it loops once per source-list row and accumulates the result in the partial binding. Since its doing list accumulation, it reverses the order of the values so you have to do a List.rev on each row at the end.
let flip matrix =
match matrix with
| [] -> []
| x::xs ->
let rec loop matrix partial =
match matrix with
| [] -> partial
| y::ys ->let newPartial = (y, partial) ||> List.map2(fun x y->x::y)
loop ys newPartial
let length = List.length x
loop matrix (List.init length (fun _ -> [] ))
|> List.map(fun x->x |> List.rev)

Related

Deedle - Weighted Average after filtering FilterRowValues

I am new to F#. I am attempting to calculate a weighted average after filtering my Frame by two timestamps and an instrument_id.
example data:
| trade_qty | trade_price | trade_timestamp | instrument_id
| 1000 | 100.59 | 1/26/2018 16:00:00 | 1
| 2000 | 105.10 | 1/26/2018 15:59:30 | 1
| 3000 | 97.59 | 1/26/2018 15:59:00 | 1
I found I can filter easily: e.g. instrument 1 between two times
frameVolume
|> Frame.filterRowValues (fun c.GetAs<DateTime>
("trade_timestamp)>DateTime(2018,1,27,15,31,0))
|> Frame.filterRowValues (fun c.GetAs<DateTime>
("trade_timestamp)<DateTime(2018,1,27,16,00,0))
|> Frame.filterRowValues (fun c.GetAs<int>("instrument_id")=
1
I am stuck here. I haven't figured out how to 1/sum(trade_qty) * Sum(trade_price*trade_qty)
I have tried:
|>Frame.GetColumn<float>("trade_qty") *
Frame.GetColumn<float>("trade_price")
For context, I'd like to use this as a function to be fed into another function in order to calculate the weighted average price over several intervals.
Any Thoughts? Thank you!
It's nice that Deedle provides higher-order functions similar to the built in higher-order functions for F# List, Arrays, and Seqs. Using this knowledge, it makes the task simpler. Here is an implementation of the function you are describing:
#I "..\packages\Deedle.1.2.5"
#load "Deedle.fsx"
open System
open Deedle
let weightedAverage after before frame: float =
let filteredFrame =
frame
|> Frame.filterRowValues (fun r -> r.GetAs<DateTime>("trade_timestamp") < before)
|> Frame.filterRowValues (fun r -> r.GetAs<DateTime>("trade_timestamp") > after)
|> Frame.filterRowValues (fun r -> r.GetAs<int>("instrument_id") = 1)
let quantities: Series<int, float> = filteredFrame |> Frame.getCol "trade_qty"
let tradePrices: Series<int, float> = filteredFrame |> Frame.getCol "trade_price"
let weightedSum =
(quantities, tradePrices)
||> Series.zip
|> Series.mapValues (fun (q, p) -> (OptionalValue.get q * OptionalValue.get p))
|> Series.reduceValues (fun acc curr -> acc + curr)
let total =
quantities
|> Series.reduceValues (fun acc curr -> acc + curr)
weightedSum / total
let path = __SOURCE_DIRECTORY__ + "\data.csv"
let df = Frame.ReadCsv(path, separators = "|")
let ans = df |> weightedAverage (DateTime(2017, 1, 1)) (DateTime(2019, 1, 1))

F# get set of subsets containing k elements

Given a set with n elements {1, 2, 3, ..., n}, I want to declare a function which returns the set containing the sets with k number of elements such as:
allSubsets 3 2
Would return [[1;2];[1;3];[2;3]] since those are the sets with 2 elements in a set created by 1 .. n
I've made the initial create-a-set-part but I'm a little stuck on how to find out all the subsets with k elements in it.
let allSubsets n k =
Set.ofList [1..n] |>
UPDATE:
I managed to get a working solution using yield:
let allSubsets n k =
let setN = Set.ofList [1..n]
let rec subsets s =
set [
if Set.count s = k then yield s
for e in s do
yield! subsets (Set.remove e s) ]
subsets setN
allSubsets 3 2
val it : Set<Set<int>> = set [set [1; 2]; set [1; 3]; set [2; 3]]
But isn't it possible to do it a little cleaner?
What you have is pretty clean, but it's also pretty inefficient. Try running allSubsets 10 3 and you'll know what I mean.
This is what I came up with:
let input = Set.ofList [ 1 .. 15 ]
let subsets (size:int) (input: Set<'a>) =
let rec inner elems =
match elems with
| [] -> [[]]
| h::t ->
List.fold (fun acc e ->
if List.length e < size then
(h::e)::e::acc
else e::acc) [] (inner t)
inner (Set.toList input)
|> Seq.choose (fun subset ->
if List.length subset = size then
Some <| Set.ofList subset
else None)
|> Set.ofSeq
subsets 3 input
The inner recursive function is a modified power set function from here. My first hunch was to generate the power set and then filter it, which would be pretty elegant, but that proved to be rather inefficient as well.
If this was to be production-quality code, I'd look into generating lists of indices of a given length, and use them to index into the input array. This is how FsCheck generates subsets, for example.
You can calculate the powerset and then filter in order to get only the ones with the specified length":
let powerset n k =
let lst = Set.toList n
seq [0..(lst.Length |> pown 2)-1]
|> Seq.map (fun i ->
set ([0..lst.Length-1] |> Seq.choose (fun x ->
if i &&& (pown 2 x) = 0 then None else Some lst.[x])))
|> Seq.filter (Seq.length >> (=) k)
However this is not efficient for large sets (n) of where k is close to n. But it's easy to optimize, you'll have to filter out early based on the digit count of the binary representation of each number.
This function implements the popular n-choose-k function:
let n_choose_k (arr: 'a []) (k: int) : 'a list list =
let len = Array.length arr
let rec choose lo x =
match x with
| 0 -> [[]]
| i -> [ for j in lo..(len-1) do
for ks in choose (j+1) (i-1) do
yield arr.[j]::ks ]
choose 0 k
> n_choose_k [|1..3|] 2;;
val it : int list list = [[1; 2]; [1; 3]; [2; 3]]
You can use Set.toArray and Set.ofList to convert to and from Set.
You can consider the following approach:
get powerset
let rec powerset xs =
match xs with
| [] -> [ [] ]
| h :: t -> List.fold (fun ys s -> (h :: s) :: s :: ys) [] (powerset t)
filter all subsets with a neccessary number of elements
let filtered xs k = List.filter (fun (x: 'a list) -> x.Length = k) xs
finally get the requested allSubsets
let allSubsets n k = Set.ofList (List.map (fun xs -> Set.ofList xs) (filtered (powerset [ 1 .. n ]) k))
Just to check and play with you can use:
printfn "%A" (allSubsets 3 2) // set [ set [1; 2]; set [1; 3]; set [2; 3] ]

How can I convert this imperative style merge-sort implementation into functional style?

This is how I implemented merge-sort in F# using imperative style:
let merge (l1: List<string>, l2: List<string>) =
let r: List<string> = new List<string>()
let mutable (i,j, cnt1, cnt2) = (0,0, l1.Count, l2.Count)
while i < cnt1 && j < cnt2 do
if l1.[i] <= l2.[j] then
r.Add (l1.[i])
i <- i + 1
else
r.Add (l2.[j])
j <- j + 1
if i = cnt1 then
while j < cnt2 do
r.Add (l2.[j])
j <- j + 1
else
while i < cnt1 do
r.Add (l1.[i])
i <- i + 1
r
Can you convert this to alternate 'functional' styled implementation and explain how it works, if possible? Even though I am studying list comprehensions and all that at the moment, I can't come up with an idea to use it here.
You're using .NET List<'T> which is renamed to ResizeArray<'T> in F# to avoid confusion. If you use functional list, merge function would look like this:
let merge(xs, ys) =
let rec loop xs ys acc =
match xs, ys with
| [], [] -> List.rev acc (* 1 *)
| [], y::ys' -> loop xs ys' (y::acc) (* 2 *)
| x::xs', [] -> loop xs' ys (x::acc) (* 3 *)
| x::xs', y::_ when x <= y -> loop xs' ys (x::acc) (* 4 *)
| _::_, y::ys' -> loop xs ys' (y::acc) (* 5 *)
loop xs ys []
To explain this function in terms of your imperative version:
The 4th and 5th patterns are corresponding to the first while loop where you compare two current elements and add the smaller one into a resulting list.
The 2nd and 3rd patterns are similar to your 2nd and 3rd while loops.
The first pattern is the case where i = cnt1 and j = cnt2 and we should return results. Since a new element is always prepended to the accumulator, we need to reverse it to get a list in the increasing order.
To be precise, your merge function is just one part of merge-sort algorithm. You need a function to split a list in two halves, call merge-sort on two halves and merge two sorted halves into one. The split function below is left for you as an exercise.
let rec mergeSort ls =
match ls with
| [] | [_] -> ls
| _ -> let xs, ys = split ls
let xs', ys' = mergeSort xs, mergeSort ys
merge(xs', ys')
To add a more simple but naive alternative to pad's:
let rec merge x y =
match (x, y) with
| ([], []) -> []
| ([], rest) -> rest
| (rest, []) -> rest
| (fx :: xs, fy :: _) when fx <= fy -> fx :: merge xs y
| (fx :: _, fy :: ys) -> fy :: merge x ys
Similarly to pad's, we're pattern matching over the function parameters.
I first put them into a tuple so that I can pattern match them both at the same time.
I then take care of the base cases with both or either of the parameters being empty.
I then use when guard to check which first item is smaller
I finally take the first item and cons it to the result of another call to merge with the rest of the items the smaller item was taken from and the whole of the other list. So if the first item of x is smaller, I append the first item of x (fx in this case) to the result of a call to merge passing in the rest of x (xs) and the whole of y (because the first item of y was larger).

More volatile sequence than "classical"

For cartesian production there is a good enough function - sequence which defined like that:
let rec sequence = function
| [] -> Seq.singleton []
| (l::ls) -> seq { for x in l do for xs in sequence ls do yield (x::xs) }
but look at its result:
sequence [[1..2];[1..10000]] |> Seq.skip 1000 ;;
val it : seq = seq [[1; 1001]; [1; 1002]; [1; 1003]; [1; 1004]; ...]
As we can see the first "coordinate" of the product alters very slowly and it will change the value when the second list is ended.
I wrote my own sequence as following (comments below):
/// Sum of all producted indeces = n
let rec hyper'plane'indices indexsum maxlengths =
match maxlengths with
| [x] -> if indexsum < x then [[indexsum]] else []
| (i::is) -> [for x in [0 .. min indexsum (i-1)] do for xs in hyper'plane'indices (indexsum-x) is do yield (x::xs)]
| [] -> [[]]
let finite'sequence = function
| [] -> Seq.singleton []
| ns ->
let ars = [ for n in ns -> Seq.toArray n ]
let length'list = List.map Array.length ars
let nmax = List.max length'list
seq {
for n in [0 .. nmax] do
for ixs in hyper'plane'indices n length'list do
yield (List.map2 (fun (a:'a[]) i -> a.[i]) ars ixs)
}
The key idea is to look at (two) lists as at (two) orthogonal dimensions where every element marked by its index in the list. So we can enumerate all elements by enumerating every element in every section of cartesian product by hyper plane (in 2D case this is a line). In another words imagine excel's sheet where first column contains values from [1;1] to [1;10000] and second - from [2;1] to [2;10000]. And "hyper plane" with number 1 is the line that connects cell A2 and cell B1. For the our example
hyper'plane'indices 0 [2;10000];; val it : int list list = [[0; 0]]
hyper'plane'indices 1 [2;10000];; val it : int list list = [[0; 1]; [1; 0]]
hyper'plane'indices 2 [2;10000];; val it : int list list = [[0; 2]; [1; 1]]
hyper'plane'indices 3 [2;10000];; val it : int list list = [[0; 3]; [1; 2]]
hyper'plane'indices 4 [2;10000];; val it : int list list = [[0; 4]; [1; 3]]
Well if we have indeces and arrays that we are producing from the given lists than we can now define sequence as {all elements in plane 0; than all elements in plane 1 ... and so on } and get more volatile function than original sequence.
But finite'sequence turned out very gluttonous function. And now the question. How I can improve it?
With best wishes, Alexander. (and sorry for poor English)
Can you explain what exactly is the problem - time or space complexity or performance? Do you have a specific benchmark in mind? I am not sure how to improve on the time complexity here, but I edited your code a bit to remove the intermediate lists, which might help a bit with memory allocation behavior.
Do not do this:
for n in [0 .. nmax] do
Do this instead:
for n in 0 .. nmax do
Here is the code:
let rec hyper'plane'indices indexsum maxlengths =
match maxlengths with
| [] -> Seq.singleton []
| [x] -> if indexsum < x then Seq.singleton [indexsum] else Seq.empty
| i :: is ->
seq {
for x in 0 .. min indexsum (i - 1) do
for xs in hyper'plane'indices (indexsum - x) is do
yield x :: xs
}
let finite'sequence xs =
match xs with
| [] -> Seq.singleton []
| ns ->
let ars = [ for n in ns -> Seq.toArray n ]
let length'list = List.map Array.length ars
let nmax = List.max length'list
seq {
for n in 0 .. nmax do
for ixs in hyper'plane'indices n length'list do
yield List.map2 Array.get ars ixs
}
Does this fare any better? Beautiful problem by the way.
UPDATE: Perhaps you are more interested to mix the sequences fairly than in maintaining the exact formula in your algorithm. Here is a Haskell code that mixes a finite number of possibly infinite sequences fairly, where fairness means that for every input element there is a finite prefix of the output sequence that contains it. You mention in the comment that you have a 2D incremental solution that is hard to generalize to N dimensions, and the Haskell code does exactly that:
merge :: [a] -> [a] -> [a]
merge [] y = y
merge x [] = x
merge (x:xs) (y:ys) = x : y : merge xs ys
prod :: (a -> b -> c) -> [a] -> [b] -> [c]
prod _ [] _ = []
prod _ _ [] = []
prod f (x:xs) (y:ys) = f x y : a `merge` b `merge` prod f xs ys where
a = [f x y | x <- xs]
b = [f x y | y <- ys]
prodN :: [[a]] -> [[a]]
prodN [] = [[]]
prodN (x:xs) = prod (:) x (prodN xs)
I have not ported this to F# yet - it requires some thought as sequences do not match to head/tail very well.
UPDATE 2:
A fairly mechanical translation to F# follows.
type Node<'T> =
| Nil
| Cons of 'T * Stream<'T>
and Stream<'T> = Lazy<Node<'T>>
let ( !! ) (x: Lazy<'T>) = x.Value
let ( !^ ) x = Lazy.CreateFromValue(x)
let rec merge (xs: Stream<'T>) (ys: Stream<'T>) : Stream<'T> =
lazy
match !!xs, !!ys with
| Nil, r | r, Nil -> r
| Cons (x, xs), Cons (y, ys) -> Cons (x, !^ (Cons (y, merge xs ys)))
let rec map (f: 'T1 -> 'T2) (xs: Stream<'T1>) : Stream<'T2> =
lazy
match !!xs with
| Nil -> Nil
| Cons (x, xs) -> Cons (f x, map f xs)
let ( ++ ) = merge
let rec prod f xs ys =
lazy
match !!xs, !!ys with
| Nil, _ | _, Nil -> Nil
| Cons (x, xs), Cons (y, ys) ->
let a = map (fun x -> f x y) xs
let b = map (fun y -> f x y) ys
Cons (f x y, a ++ b ++ prod f xs ys)
let ofSeq (s: seq<'T>) =
lazy
let e = s.GetEnumerator()
let rec loop () =
lazy
if e.MoveNext()
then Cons (e.Current, loop ())
else e.Dispose(); Nil
!! (loop ())
let toSeq stream =
stream
|> Seq.unfold (fun stream ->
match !!stream with
| Nil -> None
| Cons (x, xs) -> Some (x, xs))
let empty<'T> : Stream<'T> = !^ Nil
let cons x xs = !^ (Cons (x, xs))
let singleton x = cons x empty
let rec prodN (xs: Stream<Stream<'T>>) : Stream<Stream<'T>> =
match !!xs with
| Nil -> singleton empty
| Cons (x, xs) -> prod cons x (prodN xs)
let test () =
ofSeq [
ofSeq [1; 2; 3]
ofSeq [4; 5; 6]
ofSeq [7; 8; 9]
]
|> prodN
|> toSeq
|> Seq.iter (fun xs ->
toSeq xs
|> Seq.map string
|> String.concat ", "
|> stdout.WriteLine)

Avoiding code duplication in F#

I have two snippets of code that tries to convert a float list to a Vector3 or Vector2 list. The idea is to take 2/3 elements at a time from the list and combine them as a vector. The end result is a sequence of vectors.
let rec vec3Seq floatList =
seq {
match floatList with
| x::y::z::tail -> yield Vector3(x,y,z)
yield! vec3Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 3?"
}
let rec vec2Seq floatList =
seq {
match floatList with
| x::y::tail -> yield Vector2(x,y)
yield! vec2Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 2?"
}
The code looks very similiar and yet there seems to be no way to extract a common portion. Any ideas?
Here's one approach. I'm not sure how much simpler this really is, but it does abstract some of the repeated logic out.
let rec mkSeq (|P|_|) x =
seq {
match x with
| P(p,tail) ->
yield p
yield! mkSeq (|P|_|) tail
| [] -> ()
| _ -> failwith "List length mismatch" }
let vec3Seq =
mkSeq (function
| x::y::z::tail -> Some(Vector3(x,y,z), tail)
| _ -> None)
As Rex commented, if you want this only for two cases, then you probably won't have any problem if you leave the code as it is. However, if you want to extract a common pattern, then you can write a function that splits a list into sub-list of a specified length (2 or 3 or any other number). Once you do that, you'll only use map to turn each list of the specified length into Vector.
The function for splitting list isn't available in the F# library (as far as I can tell), so you'll have to implement it yourself. It can be done roughly like this:
let divideList n list =
// 'acc' - accumulates the resulting sub-lists (reversed order)
// 'tmp' - stores values of the current sub-list (reversed order)
// 'c' - the length of 'tmp' so far
// 'list' - the remaining elements to process
let rec divideListAux acc tmp c list =
match list with
| x::xs when c = n - 1 ->
// we're adding last element to 'tmp',
// so we reverse it and add it to accumulator
divideListAux ((List.rev (x::tmp))::acc) [] 0 xs
| x::xs ->
// add one more value to 'tmp'
divideListAux acc (x::tmp) (c+1) xs
| [] when c = 0 -> List.rev acc // no more elements and empty 'tmp'
| _ -> failwithf "not multiple of %d" n // non-empty 'tmp'
divideListAux [] [] 0 list
Now, you can use this function to implement your two conversions like this:
seq { for [x; y] in floatList |> divideList 2 -> Vector2(x,y) }
seq { for [x; y; z] in floatList |> divideList 3 -> Vector3(x,y,z) }
This will give a warning, because we're using an incomplete pattern that expects that the returned lists will be of length 2 or 3 respectively, but that's correct expectation, so the code will work fine. I'm also using a brief version of sequence expression the -> does the same thing as do yield, but it can be used only in simple cases like this one.
This is simular to kvb's solution but doesn't use a partial active pattern.
let rec listToSeq convert (list:list<_>) =
seq {
if not(List.isEmpty list) then
let list, vec = convert list
yield vec
yield! listToSeq convert list
}
let vec2Seq = listToSeq (function
| x::y::tail -> tail, Vector2(x,y)
| _ -> failwith "float array not multiple of 2?")
let vec3Seq = listToSeq (function
| x::y::z::tail -> tail, Vector3(x,y,z)
| _ -> failwith "float array not multiple of 3?")
Honestly, what you have is pretty much as good as it can get, although you might be able to make a little more compact using this:
// take 3 [1 .. 5] returns ([1; 2; 3], [4; 5])
let rec take count l =
match count, l with
| 0, xs -> [], xs
| n, x::xs -> let res, xs' = take (count - 1) xs in x::res, xs'
| n, [] -> failwith "Index out of range"
// split 3 [1 .. 6] returns [[1;2;3]; [4;5;6]]
let rec split count l =
seq { match take count l with
| xs, ys -> yield xs; if ys <> [] then yield! split count ys }
let vec3Seq l = split 3 l |> Seq.map (fun [x;y;z] -> Vector3(x, y, z))
let vec2Seq l = split 2 l |> Seq.map (fun [x;y] -> Vector2(x, y))
Now the process of breaking up your lists is moved into its own generic "take" and "split" functions, its much easier to map it to your desired type.

Resources