Im getting an error with this function. Im new to f# so I don't fully know what the code is doing, I tried duplicating a function that only takes one parameter to find vowels in a string.
let rec countDigraph c1 c2 L =
match L with
| [] -> 0
| hd::tl when hd = c1 -> 1 + count c1 tl
| hd::tl when tl = c2 -> 1 + count c2 tl
| _::tl ->0 + countDigraph c1 c2 tl
gets called later in the code:
let printCountDigraph digraph L =
let c1 = List.head digraph
let c2 = List.head digraph
printfn "%A,%A: %A" c1 c2 (countDigraph c1 c2 L)
let digraphs = [['a';'i']; ['c';'h']; ['e';'a']; ['i';'e']; ['o';'u']; ['p';'h']; ['s';'h']; ['t';'h']; ['w';'h'];]
List.iter (fun digraph -> printCountDigraph digraph L) digraphs
In countDigraph, you need to check that the first two characters of the list match the digraph. You seem to be trying to do this by first checking the first one (in the first case) and then the second one (in the second case), but this is not how pattern matching works.
The easiest option is to have a single clause that uses the pattern l1::l2::tl to extract the first two letters, followed by the rest of the list. You need to think whether e.g. eai counts as two digraphs or just one. If two, you need to recursively call countDigraph on c2::tl as below - if just one, you would recursively call countDigraph on just tl.
let rec countDigraph c1 c2 L =
match L with
| [] -> 0
| l1::l2::tl when l1=c1 && l2=c2 -> 1 + countDigraph c1 c2 (c2::tl)
| _::tl ->0 + countDigraph c1 c2 tl
The rest of the code gets much easier if you represent digraphs as a list of pairs, rather than a list of two-element lists:
let printCountDigraph (c1, c2) L =
printfn "%A,%A: %A" c1 c2 (countDigraph c1 c2 L)
let digraphs = [('a','i'); ('c','h'); ('e','a'); ('i','e');
('o','u'); ('p','h'); ('s','h'); ('t','h'); ('w','h')]
let L = List.ofSeq "chai"
List.iter (fun digraph -> printCountDigraph digraph L) digraphs
Suppose I have a table with products and events (processing steps), like
type Event = | E1 | E2
let events = Series.ofValues [ E1;E2;E2 ]
let products = Series.ofValues [ "A";"A";"B"]
let df = Frame(["Product"; "Event"], [products; events])
df.Print()
Product Event
0 -> A E1
1 -> A E2
2 -> B E2
and a transition function which determines a new state given the old state and the event
type State = S0 | S1 | S2
let evolve (s:State) (e:Event) :State =
match s,e with
| _, E1 -> S1
| S0, E2 -> S0
| _, E2 -> S2
How can the state transitions be mapped?
The result should be something like
let stateTransitions = df |> ???
stateTransitions.Print()
Product Event NewState
0 -> A E1 S1
1 -> A E2 S2
2 -> B E2 S0
Update: I know how to get the final state of every product but the aggregate function does not show the transitions.
let finalStates =
df
|> Frame.aggregateRowsBy ["Product"] ["Event"]
(fun s -> s.Values |> Seq.fold evolve S0)
finalStates.Print()
Product Event
0 -> A S2
1 -> B S0
I guess there is no existing function. I did grouping/nesting by product, fold with storing all states and build a new series/column of the results, unnest.
let stateTransitions =
df
|> Frame.groupRowsByString "Product"
|> Frame.nest
|> Series.mapValues (fun nf ->
let events = nf.Columns.["Event"].As<Event>()
let values' =
events.Values
|> Seq.fold (fun acc e ->
let s = acc |> List.head
let s' = evolve s e
s'::acc) [S0]
|> Seq.rev
|> Seq.tail
let states' =
Seq.zip events.Keys values'
|> Series.ofObservations
nf.AddColumn("NewState", states')
nf
)
|> Frame.unnest
|> Frame.indexRowsOrdinally
stateTransitions.Print()
Product Event NewState
0 -> A E1 S1
1 -> A E2 S2
2 -> B E2 S0
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))
I need to implement a simple dynamic programming algorithm in 2D in F#. For simple 1D cases Seq.unfold seems to be the way to go, see e.g. https://stackoverflow.com/a/7986083/5363
Is there a nice (and efficient) way to achieve a similar result in 2D, e.g. rewrite the following pseudo-code in functional style:
let alpha =
let result = Array2D.zeroCreate N T
for i in 0 .. N-1 do
result.[0, i] <- (initialPi i) * (b i observations.[0])
for t in 1 .. T-1 do
for i in 0 .. N-1 do
let s = row t-1 result |> Seq.mapi (fun j alpha_t_j -> alpha_t_j * initialA.[i, j]) () |> Seq.sum
result.[t, i] <- s * (b i observations.[t])
result
assume that all the missing functions and arrays are defined above.
EDIT: Actually read code, this is at least functional, does have a slightly different return type, although you could avoid that with a conversion
let alpha =
let rec build prev idx max =
match idx with
|0 ->
let r = (Array.init N (fun i -> (initialPi y) * (b i observations.[0]))
r:: (build r 1 max)
|t when t=max -> []
|_ ->
let s = prev |> Seq.mapi (fun j alpha_t_j -> alpha_t_j * initialA.[i, j]) () |> Seq.sum
let r = Array.init N (fun i -> s * (b i observations.[t]))
r:: build r (idx+1 max)
build [] 0 T |> List.toArray
Is it possible to combine memoization and tail-recursion somehow? I'm learning F# at the moment and understand both concepts but can't seem to combine them.
Suppose I have the following memoize function (from Real-World Functional Programming):
let memoize f = let cache = new Dictionary<_, _>()
(fun x -> match cache.TryGetValue(x) with
| true, y -> y
| _ -> let v = f(x)
cache.Add(x, v)
v)
and the following factorial function:
let rec factorial(x) = if (x = 0) then 1 else x * factorial(x - 1)
Memoizing factorial isn't too difficult and making it tail-recursive isn't either:
let rec memoizedFactorial =
memoize (fun x -> if (x = 0) then 1 else x * memoizedFactorial(x - 1))
let tailRecursiveFactorial(x) =
let rec factorialUtil(x, res) = if (x = 0)
then res
else let newRes = x * res
factorialUtil(x - 1, newRes)
factorialUtil(x, 1)
But can you combine memoization and tail-recursion? I made some attempts but can't seem to get it working. Or is this simply not possible?
As always, continuations yield an elegant tailcall solution:
open System.Collections.Generic
let cache = Dictionary<_,_>() // TODO move inside
let memoizedTRFactorial =
let rec fac n k = // must make tailcalls to k
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
if n=0 then
k 1
else
fac (n-1) (fun r1 ->
printfn "multiplying by %d" n //***
let r = r1 * n
cache.Add(n,r)
k r)
fun n -> fac n id
printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in cache do
printfn "%d: %d" k v
printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2
printfn "---"
// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3
There are two kinds of tests. First, this demos that calling F(4) caches F(4), F(3), F(2), F(1) as you would like.
Then, comment out the *** printf and uncomment the final test (and compile in Release mode) to show that it does not StackOverflow (it uses tailcalls correctly).
Perhaps I'll generalize out 'memoize' and demonstrate it on 'fib' next...
EDIT
Ok, here's the next step, I think, decoupling memoization from factorial:
open System.Collections.Generic
let cache = Dictionary<_,_>() // TODO move inside
let memoize fGuts n =
let rec newFunc n k = // must make tailcalls to k
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
fGuts n (fun r ->
cache.Add(n,r)
k r) newFunc
newFunc n id
let TRFactorialGuts n k memoGuts =
if n=0 then
k 1
else
memoGuts (n-1) (fun r1 ->
printfn "multiplying by %d" n //***
let r = r1 * n
k r)
let memoizedTRFactorial = memoize TRFactorialGuts
printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in cache do
printfn "%d: %d" k v
printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2
printfn "---"
// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3
EDIT
Ok, here's a fully generalized version that seems to work.
open System.Collections.Generic
let memoize fGuts =
let cache = Dictionary<_,_>()
let rec newFunc n k = // must make tailcalls to k
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
fGuts n (fun r ->
cache.Add(n,r)
k r) newFunc
cache, (fun n -> newFunc n id)
let TRFactorialGuts n k memoGuts =
if n=0 then
k 1
else
memoGuts (n-1) (fun r1 ->
printfn "multiplying by %d" n //***
let r = r1 * n
k r)
let facCache,memoizedTRFactorial = memoize TRFactorialGuts
printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in facCache do
printfn "%d: %d" k v
printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2
printfn "---"
// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3
let TRFibGuts n k memoGuts =
if n=0 || n=1 then
k 1
else
memoGuts (n-1) (fun r1 ->
memoGuts (n-2) (fun r2 ->
printfn "adding %d+%d" r1 r2 //%%%
let r = r1+r2
k r))
let fibCache, memoizedTRFib = memoize TRFibGuts
printfn "---"
let r5 = memoizedTRFib 4
printfn "%d" r5
for KeyValue(k,v) in fibCache do
printfn "%d: %d" k v
printfn "---"
let r6 = memoizedTRFib 5
printfn "%d" r6
printfn "---"
// comment out %%% line, then run this
//let r7 = memoizedTRFib 100000
//printfn "%d" r7
The predicament of memoizing tail-recursive functions is, of course, that when tail-recursive function
let f x =
......
f x1
calls itself, it is not allowed to do anything with a result of the recursive call, including putting it into cache. Tricky; so what can we do?
The critical insight here is that since the recursive function is not allowed to do anything with a result of recursive call, the result for all arguments to recursive calls will be the same! Therefore if recursion call trace is this
f x0 -> f x1 -> f x2 -> f x3 -> ... -> f xN -> res
then for all x in x0,x1,...,xN the result of f x will be the same, namely res. So the last invocation of a recursive function, the non-recursive call, knows the results for all the previous values - it is in a position to cache them. The only thing you need to do is to pass a list of visited values to it. Here is what it might look for factorial:
let cache = Dictionary<_,_>()
let rec fact0 l ((n,res) as arg) =
let commitToCache r =
l |> List.iter (fun a -> cache.Add(a,r))
match cache.TryGetValue(arg) with
| true, cachedResult -> commitToCache cachedResult; cachedResult
| false, _ ->
if n = 1 then
commitToCache res
cache.Add(arg, res)
res
else
fact0 (arg::l) (n-1, n*res)
let fact n = fact0 [] (n,1)
But wait! Look - l parameter of fact0 contains all the arguments to recursive calls to fact0 - just like the stack would in a non-tail-recursive version! That is exactly right. Any non-tail recursive algorithm can be converted to a tail-recursive one by moving the "list of stack frames" from stack to heap and converting the "postprocessing" of recursive call result into a walk over that data structure.
Pragmatic note: The factorial example above illustrates a general technique. It is quite useless as is - for factorial function it is quite enough to cache the top-level fact n result, because calculation of fact n for a particular n only hits a unique series of (n,res) pairs of arguments to fact0 - if (n,1) is not cached yet, then none of the pairs fact0 is going to be called on are.
Note that in this example, when we went from non-tail-recursive factorial to a tail-recursive factorial, we exploited the fact that multiplication is associative and commutative - tail-recursive factorial execute a different set of multiplications than a non-tail-recursive one.
In fact, a general technique exists for going from non-tail-recursive to tail-recursive algorithm, which yields an algorithm equivalent to a tee. This technique is called "continuatuion-passing transformation". Going that route, you can take a non-tail-recursive memoizing factorial and get a tail-recursive memoizing factorial by pretty much a mechanical transformation. See Brian's answer for exposition of this method.
I'm not sure if there's a simpler way to do this, but one approach would be to create a memoizing y-combinator:
let memoY f =
let cache = Dictionary<_,_>()
let rec fn x =
match cache.TryGetValue(x) with
| true,y -> y
| _ -> let v = f fn x
cache.Add(x,v)
v
fn
Then, you can use this combinator in lieu of "let rec", with the first argument representing the function to call recursively:
let tailRecFact =
let factHelper fact (x, res) =
printfn "%i,%i" x res
if x = 0 then res
else fact (x-1, x*res)
let memoized = memoY factHelper
fun x -> memoized (x,1)
EDIT
As Mitya pointed out, memoY doesn't preserve the tail recursive properties of the memoee. Here's a revised combinator which uses exceptions and mutable state to memoize any recursive function without overflowing the stack (even if the original function is not itself tail recursive!):
let memoY f =
let cache = Dictionary<_,_>()
fun x ->
let l = ResizeArray([x])
while l.Count <> 0 do
let v = l.[l.Count - 1]
if cache.ContainsKey(v) then l.RemoveAt(l.Count - 1)
else
try
cache.[v] <- f (fun x ->
if cache.ContainsKey(x) then cache.[x]
else
l.Add(x)
failwith "Need to recurse") v
with _ -> ()
cache.[x]
Unfortunately, the machinery which is inserted into each recursive call is somewhat heavy, so performance on un-memoized inputs requiring deep recursion can be a bit slow. However, compared to some other solutions, this has the benefit that it requires fairly minimal changes to the natural expression of recursive functions:
let fib = memoY (fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2)))
let _ = fib 5000
EDIT
I'll expand a bit on how this compares to other solutions. This technique takes advantage of the fact that exceptions provide a side channel: a function of type 'a -> 'b doesn't actually need to return a value of type 'b, but can instead exit via an exception. We wouldn't need to use exceptions if the return type explicitly contained an additional value indicating failure. Of course, we could use the 'b option as the return type of the function for this purpose. This would lead to the following memoizing combinator:
let memoO f =
let cache = Dictionary<_,_>()
fun x ->
let l = ResizeArray([x])
while l.Count <> 0 do
let v = l.[l.Count - 1]
if cache.ContainsKey v then l.RemoveAt(l.Count - 1)
else
match f(fun x -> if cache.ContainsKey x then Some(cache.[x]) else l.Add(x); None) v with
| Some(r) -> cache.[v] <- r;
| None -> ()
cache.[x]
Previously, our memoization process looked like:
fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2))
|> memoY
Now, we need to incorporate the fact that fib should return an int option instead of an int. Given a suitable workflow for option types, this could be written as follows:
fun fib n -> option {
printfn "%i" n
if n <= 1 then return n
else
let! x = fib (n-1)
let! y = fib (n-2)
return x + y
} |> memoO
However, if we're willing to change the return type of the first parameter (from int to int option in this case), we may as well go all the way and just use continuations in the return type instead, as in Brian's solution. Here's a variation on his definitions:
let memoC f =
let cache = Dictionary<_,_>()
let rec fn n k =
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
f fn n (fun r ->
cache.Add(n,r)
k r)
fun n -> fn n id
And again, if we have a suitable computation expression for building CPS functions, we can define our recursive function like this:
fun fib n -> cps {
printfn "%i" n
if n <= 1 then return n
else
let! x = fib (n-1)
let! y = fib (n-2)
return x + y
} |> memoC
This is exactly the same as what Brian has done, but I find the syntax here is easier to follow. To make this work, all we need are the following two definitions:
type CpsBuilder() =
member this.Return x k = k x
member this.Bind(m,f) k = m (fun a -> f a k)
let cps = CpsBuilder()
I wrote a test to visualize the memoization. Each dot is a recursive call.
......720 // factorial 6
......720 // factorial 6
.....120 // factorial 5
......720 // memoizedFactorial 6
720 // memoizedFactorial 6
120 // memoizedFactorial 5
......720 // tailRecFact 6
720 // tailRecFact 6
.....120 // tailRecFact 5
......720 // tailRecursiveMemoizedFactorial 6
720 // tailRecursiveMemoizedFactorial 6
.....120 // tailRecursiveMemoizedFactorial 5
kvb's solution returns the same results are straight memoization like this function.
let tailRecursiveMemoizedFactorial =
memoize
(fun x ->
let rec factorialUtil x res =
if x = 0 then
res
else
printf "."
let newRes = x * res
factorialUtil (x - 1) newRes
factorialUtil x 1
)
Test source code.
open System.Collections.Generic
let memoize f =
let cache = new Dictionary<_, _>()
(fun x ->
match cache.TryGetValue(x) with
| true, y -> y
| _ ->
let v = f(x)
cache.Add(x, v)
v)
let rec factorial(x) =
if (x = 0) then
1
else
printf "."
x * factorial(x - 1)
let rec memoizedFactorial =
memoize (
fun x ->
if (x = 0) then
1
else
printf "."
x * memoizedFactorial(x - 1))
let memoY f =
let cache = Dictionary<_,_>()
let rec fn x =
match cache.TryGetValue(x) with
| true,y -> y
| _ -> let v = f fn x
cache.Add(x,v)
v
fn
let tailRecFact =
let factHelper fact (x, res) =
if x = 0 then
res
else
printf "."
fact (x-1, x*res)
let memoized = memoY factHelper
fun x -> memoized (x,1)
let tailRecursiveMemoizedFactorial =
memoize
(fun x ->
let rec factorialUtil x res =
if x = 0 then
res
else
printf "."
let newRes = x * res
factorialUtil (x - 1) newRes
factorialUtil x 1
)
factorial 6 |> printfn "%A"
factorial 6 |> printfn "%A"
factorial 5 |> printfn "%A\n"
memoizedFactorial 6 |> printfn "%A"
memoizedFactorial 6 |> printfn "%A"
memoizedFactorial 5 |> printfn "%A\n"
tailRecFact 6 |> printfn "%A"
tailRecFact 6 |> printfn "%A"
tailRecFact 5 |> printfn "%A\n"
tailRecursiveMemoizedFactorial 6 |> printfn "%A"
tailRecursiveMemoizedFactorial 6 |> printfn "%A"
tailRecursiveMemoizedFactorial 5 |> printfn "%A\n"
System.Console.ReadLine() |> ignore
That should work if mutual tail recursion through y are not creating stack frames:
let rec y f x = f (y f) x
let memoize (d:System.Collections.Generic.Dictionary<_,_>) f n =
if d.ContainsKey n then d.[n]
else d.Add(n, f n);d.[n]
let rec factorialucps factorial' n cont =
if n = 0I then cont(1I) else factorial' (n-1I) (fun k -> cont (n*k))
let factorialdpcps =
let d = System.Collections.Generic.Dictionary<_, _>()
fun n -> y (factorialucps >> fun f n -> memoize d f n ) n id
factorialdpcps 15I //1307674368000