How do I do convolution in F#? - f#

I would like convolve a discrete signal with a discrete filter. The signal and filter is sequences of float in F#.
The only way I can figure out how to do it is with two nested for loops and a mutable array to store the result, but it does not feel very functional.
Here is how I would do it non-functional:
conv = double[len(signal) + len(filter) - 1]
for i = 1 to len(signal)
for j = 1 to len(filter)
conv[i + j] = conv[i + j] + signal(i) * filter(len(filter) - j)

I don't know F#, but I'll post some Haskell and hopefully it will be close enough to use. (I only have VS 2005 and an ancient version of F#, so I think it would be more confusing to post something that works on my machine)
Let me start by posting a Python implementation of your pseudocode to make sure I'm getting the right answer:
def convolve(signal, filter):
conv = [0 for _ in range(len(signal) + len(filter) - 1)]
for i in range(len(signal)):
for j in range(len(filter)):
conv[i + j] += signal[i] * filter[-j-1]
return conv
Now convolve([1,1,1], [1,2,3]) gives [3, 5, 6, 3, 1]. If this is wrong, please tell me.
The first thing we can do is turn the inner loop into a zipWith; we're essentially adding a series of rows in a special way, in the example above: [[3,2,1], [3,2,1], [3,2,1]]. To generate each row, we'll zip each i in the signal with the reversed filter:
makeRow filter i = zipWith (*) (repeat i) (reverse filter)
(Note: according to a quick google, zipWith is map2 in F#. You might have to use a list comprehension instead of repeat)
Now:
makeRow [1,2,3] 1
=> [3,2,1]
makeRow [1,2,3] 2
=> [6,4,2]
To get this for all i, we need to map over signal:
map (makeRow filter) signal
=> [[3,2,1], [3,2,1], [3,2,1]]
Good. Now we just need a way to combine the rows properly. We can do this by noticing that combining is adding the new row to the existing array, except for the first element, which is stuck on front. For example:
[[3,2,1], [6,4,2]] = 3 : [2 + 6, 1 + 4] ++ [2]
// or in F#
[[3; 2; 1]; [6; 4; 2]] = 3 :: [2 + 6; 1 + 4] # [2]
So we just need to write some code that does this in the general case:
combine (front:combinable) rest =
let (combinable',previous) = splitAt (length combinable) rest in
front : zipWith (+) combinable combinable' ++ previous
Now that we have a way to generate all the rows and a way to combine a new row with an existing array, all we have to do is stick the two together with a fold:
convolve signal filter = foldr1 combine (map (makeRow filter) signal)
convolve [1,1,1] [1,2,3]
=> [3,5,6,3,1]
So that's a functional version. I think it's reasonably clear, as long as you understand foldr and zipWith. But it's at least as long as the imperative version and like other commenters said, probably less efficient in F#. Here's the whole thing in one place.
makeRow filter i = zipWith (*) (repeat i) (reverse filter)
combine (front:combinable) rest =
front : zipWith (+) combinable combinable' ++ previous
where (combinable',previous) = splitAt (length combinable) rest
convolve signal filter = foldr1 combine (map (makeRow filter) signal)
Edit:
As promised, here is an F# version. This was written using a seriously ancient version (1.9.2.9) on VS2005, so be careful. Also I couldn't find splitAt in the standard library, but then I don't know F# that well.
open List
let gen value = map (fun _ -> value)
let splitAt n l =
let rec splitter n l acc =
match n,l with
| 0,_ -> rev acc,l
| _,[] -> rev acc,[]
| n,x::xs -> splitter (n - 1) xs (x :: acc)
splitter n l []
let makeRow filter i = map2 ( * ) (gen i filter) (rev filter)
let combine (front::combinable) rest =
let combinable',previous = splitAt (length combinable) rest
front :: map2 (+) combinable combinable' # previous
let convolve signal filter =
fold1_right combine (map (makeRow filter) signal)

Try this function:
let convolute signal filter =
[|0 .. Array.length signal + Array.length filter - 1|] |> Array.map (fun i ->
[|0 .. i|] |> Array.sum_by (fun j -> signal.[i] * filter.[Array.length filter - (i - j) - 1]))
It's probably not the nicest function solution, but it should do the job. I doubt there exists a purely functional solution that will match the imperative one for speed however.
Hope that helps.
Note: The function is currently untested (though I've confirmed it compiles). Let me know if it doesn't quite do what it should. Also, observe that the i and j variables do not refer to the same things as is your original post.

Indeed, you generally want to avoid loops (plain, nested, whatever) and anything mutable in functional programming.
There happens to be a very simple solution in F# (and probably almost every other functional language):
let convolution = Seq.zip seq1 seq2
The zip function simply combines the two sequences into one of pairs containing the element from seq1 and the element from seq2. As a note, there also exist similar zip functions for the List and Array modules, as well as variants for combining three lists into triples (zip3). If you want tom ore generally zip (or "convolute") n lists into a list of n-tuples, then you'll need to write your own function, but it's pretty straightforward.
(I've been going by this description of convolution by the way - tell me if you mean something else.)

In principle, it should be possible to use the (Fast) Fourier Transform, or the related (Discrete) Cosine Transform, to calculate the convolution of two functions reasonably efficiently. You calculate the FFT for both functions, multiply them, and apply the inverse FFT on the result.
mathematical background
That's the theory. In practice you'd probably best find a math library that implements it for you.

Related

unexpected return type from list comprehension

I am teaching myself a bit of F# by doing a bit of simple matrix mathematics. I decided to write a set of simple functions for combining two matrices as I thought that this would be a good way of learning list comprehensions. However when I compile it my unit tests produce a type mismatch exception.
//return a column from the matrix as a list
let getColumn(matrix: list<list<double>>, column:int) =
[for row in matrix do yield row.Item(column)]
//return a row from the matrix as a list
let getRow(matrix: list<list<double>>, column:int) =
matrix.Item(column)
//find the minimum width of the matrices in order to avoid index out of range exceptions
let minWidth(matrix1: list<list<double>>,matrix2: list<list<double>>) =
let width1 = [for row in matrix1 do yield row.Length] |> List.min
let width2 = [for row in matrix2 do yield row.Length] |> List.min
if width1 > width2 then width2 else width1
//find the minimum height of the matrices in order to avoid index out of range exceptions
let minHeight(matrix1: list<list<double>>,matrix2: list<list<double>>) =
let height1 = matrix1.Length
let height2 = matrix2.Length
if height1 > height2 then height2 else height1
//combine the two matrices
let concat(matrix1: list<list<double>>,matrix2: list<list<double>>) =
let width = minWidth(matrix1, matrix2)
let height = minHeight(matrix1, matrix2)
[for y in 0 .. height do yield [for x in 0 .. width do yield (List.fold2 (fun acc a b -> acc + (a*b)), getRow(matrix1, y), getColumn(matrix2, x))]]
I was expecting the function to return a list of lists of type
double list list
However what it actually returns looks more like some kind of lambda expression
((int -> int list -> int list -> int) * double list * double list) list list
Can somebody tell me what is being returned, and how to force it to be evaluated into the list of lists that I originally expected?
There's a short answer and a long answer to your question.
The short answer
The short version is that F# functions (like List.fold2) take multiple parameters not with commas the way you think they do, but with spaces in between. I.e., you should NOT call List.fold2 like this:
List.fold2 (function, list1, list2)
but rather like this:
List.fold2 function list1 list2
Now, if you just remove the commas in your List.fold2 call, you'll see that the compiler complains about your getRow(matrix1, y) call, and tells you to put parentheses around them. (And the outer pair of parentheses around List.fold2 isn't actually needed). So this:
(List.fold2 (fun acc a b -> acc + (a*b)), getRow(matrix1, y), getColumn(matrix2, x))
Needs to turn into this:
List.fold2 (fun acc a b -> acc + (a*b)) (getRow(matrix1, y)) (getColumn(matrix2, x))
The long answer
The way F# functions take multiple parameters is actually very different from most other languages such as C#. In fact, all F# functions take exactly one parameter! "But wait," you're probably thinking right now, "you just now showed me the syntax for F# functions taking multiple parameters!" Yes, I did. What's going on under the hood is a combination of currying and partial application. I'd write a long explanation, but Scott Wlaschin has already written one, that's much better than I could have written, so I'll just point you to the https://fsharpforfunandprofit.com/series/thinking-functionally.html series to help you understand what's going on here. (The sections on currying and partial application are the ones you want, but I'd recommend reading the series in order because the later parts build on concepts introduced in earlier parts).
And yes, this "long" answer appears shorter than the "short" answer, but if you go read that series (and then the rest of Scott Wlaschin's excellent site), you'll find that it's much longer than the short answer. :-)
If you have more questions, I'll be happy to try to explain.

How to make this loop more functional without bringing too much overheads

for i in a..b do
res <- res * myarray.[i]
res
Do I have to use like
Array.fold (*) 1 (Array.sub myarray a (b - a + 1))
, which I believe is rather slow and not that concise?
Don't know if you'll find it any better, but you could do:
Seq.fold (fun r i -> r * myarray.[i]) 1 {a .. b}
Daniel's solution is pretty neat and I think it should be nearly as efficient as the for loop, because it does not need to clone the array.
If you wanted a more concise solution, then you can use indexer instead of Array.sub, which does need to clone some part of the array, but it looks quite neat:
myarray.[a .. b] |> Seq.fold (*) 1
This clones a part of the array because the slicing operation returns an array. You could define your own slicing operation that returns the elements as seq<'T> (and thus does not clone the whole array):
module Array =
let slice a b (arr:'T[]) =
seq { for i in a .. b -> arr.[i] }
Using this function, you could write:
myarray |> Array.slice a b |> Seq.fold (*) 1
I believe this more directly expresses the functionality that you're trying to implement. As always with performance - you should measure the performance to see if you need to make such optimizations or if the first version is fast enough for your purpose.
If you're concerned with speed then I'd shy away from using seq unless you're prototyping. Either stick with the for loop or rewrite as a recursive function. The example you gave is simplistic and sometimes more complex problems are better represented as recursion.
let rec rangeProduct a b total (array : _[]) =
if a <= b then
rangeProduct (a + 1) b (total * array.[a]) array
else
total
let res = myArray |> rangeProduct a b res
There is no overhead here, it's as fast as possible, there is no mutation, and it's functional.

How to efficiently find out if a sequence has at least n items?

Just naively using Seq.length may be not good enough as will blow up on infinite sequences.
Getting more fancy with using something like ss |> Seq.truncate n |> Seq.length will work, but behind the scene would involve double traversing of the argument sequence chunk by IEnumerator's MoveNext().
The best approach I was able to come up with so far is:
let hasAtLeast n (ss: seq<_>) =
let mutable result = true
use e = ss.GetEnumerator()
for _ in 1 .. n do result <- e.MoveNext()
result
This involves only single sequence traverse (more accurately, performing e.MoveNext() n times) and correctly handles boundary cases of empty and infinite sequences. I can further throw in few small improvements like explicit processing of specific cases for lists, arrays, and ICollections, or some cutting on traverse length, but wonder if any more effective approach to the problem exists that I may be missing?
Thank you for your help.
EDIT: Having on hand 5 overall implementation variants of hasAtLeast function (2 my own, 2 suggested by Daniel and one suggested by Ankur) I've arranged a marathon between these. Results that are tie for all implementations prove that Guvante is right: a simplest composition of existing algorithms would be the best, there is no point here in overengineering.
Further throwing in the readability factor I'd use either my own pure F#-based
let hasAtLeast n (ss: seq<_>) =
Seq.length (Seq.truncate n ss) >= n
or suggested by Ankur the fully equivalent Linq-based one that capitalizes on .NET integration
let hasAtLeast n (ss: seq<_>) =
ss.Take(n).Count() >= n
Here's a short, functional solution:
let hasAtLeast n items =
items
|> Seq.mapi (fun i x -> (i + 1), x)
|> Seq.exists (fun (i, _) -> i = n)
Example:
let items = Seq.initInfinite id
items |> hasAtLeast 10000
And here's an optimally efficient one:
let hasAtLeast n (items:seq<_>) =
use e = items.GetEnumerator()
let rec loop n =
if n = 0 then true
elif e.MoveNext() then loop (n - 1)
else false
loop n
Functional programming breaks up work loads into small chunks that do very generic tasks that do one simple thing. Determining if there are at least n items in a sequence is not a simple task.
You already found both the solutions to this "problem", composition of existing algorithms, which works for the majority of cases, and creating your own algorithm to solve the issue.
However I have to wonder whether your first solution wouldn't work. MoveNext() is only called n times on the original method for certain, Current is never called, and even if MoveNext() is called on some wrapper class the performance implications are likely tiny unless n is huge.
EDIT:
I was curious so I wrote a simple program to test out the timing of the two methods. The truncate method was quicker for a simple infinite sequence and one that had Sleep(1). It looks like I was right when your correction sounded like overengineering.
I think clarification is needed to explain what is happening in those methods. Seq.truncate takes a sequence and returns a sequence. Other than saving the value of n it doesn't do anything until enumeration. During enumeration it counts and stops after n values. Seq.length takes an enumeration and counts, returning the count when it ends. So the enumeration is only enumerated once, and the amount of overhead is a couple of method calls and two counters.
Using Linq this would be as simple as:
let hasAtLeast n (ss: seq<_>) =
ss.Take(n).Count() >= n
Seq take method blows up if there are not enough elements.
Example usage to show it traverse seq only once and till required elements:
seq { for i = 0 to 5 do
printfn "Generating %d" i
yield i }
|> hasAtLeast 4 |> printfn "%A"

N-gram split function for string similarity comparison

As part of excersise to better understand F# which I am currently learning , I wrote function to
split given string into n-grams.
1) I would like to receive feedback about my function : can this be written simpler or in more efficient way?
2) My overall goal is to write function that returns string similarity (on 0.0 .. 1.0 scale) based on n-gram similarity; Does this approach works well for short strings comparisons , or can this method reliably be used to compare large strings (like articles for example).
3) I am aware of the fact that n-gram comparisons ignore context of two strings. What method would you suggest to accomplish my goal?
//s:string - target string to split into n-grams
//n:int - n-gram size to split string into
let ngram_split (s:string, n:int) =
let ngram_count = s.Length - (s.Length % n)
let ngram_list = List.init ngram_count (fun i ->
if( i + n >= s.Length ) then
s.Substring(i,s.Length - i) + String.init ((i + n) - s.Length)
(fun i -> "#")
else
s.Substring(i,n)
)
let ngram_array_unique = ngram_list
|> Seq.ofList
|> Seq.distinct
|> Array.ofSeq
//produce tuples of ngrams (ngram string,how much occurrences in original string)
Seq.init ngram_array_unique.Length (fun i -> (ngram_array_unique.[i],
ngram_list |> List.filter(fun item -> item = ngram_array_unique.[i])
|> List.length)
)
I don't know much about evaluating similarity of strings, so I can't give you much feedback regarding points 2 and 3. However, here are a few suggestions that may help to make your implementation simpler.
Many of the operations that you need to do are already available in some F# library function for working with sequences (lists, arrays, etc.). Strings are also sequences (of characters), so you can write the following:
open System
let ngramSplit n (s:string) =
let ngrams = Seq.windowed n s
let grouped = Seq.groupBy id ngrams
Seq.map (fun (ngram, occurrences) ->
String(ngram), Seq.length occurrences) grouped
The Seq.windowed function implements a sliding window, which is exactly what you need to extract the n-grams of your string. The Seq.groupBy function collects the elements of a sequence (n-grams) into a sequence of groups that contain values with the same key. We use id to calculate the key, which means that the n-gram is itself the key (and so we get groups, where each group contains the same n-grams). Then we just convert n-gram to string and count the number of elements in the group.
Alternatively, you can write the entire function as a single processing pipeline like this:
let ngramSplit n (s:string) =
s |> Seq.windowed n
|> Seq.groupBy id
|> Seq.map (fun (ngram, occurrences) ->
String(ngram), Seq.length occurrences)
Your code looks OK to me. Since ngram extraction and similarity comparison are used very often. You should consider some efficiency issues here.
The MapReduce pattern is very suitable for your frequency counting problem:
get a string, emit (word, 1) pairs out
do a grouping of the words and adds all the counting together.
let wordCntReducer (wseq: seq<int*int>) =
wseq
|> Seq.groupBy (fun (id,cnt) -> id)
|> Seq.map (fun (id, idseq) ->
(id, idseq |> Seq.sumBy(fun (id,cnt) -> cnt)))
(* test: wordCntReducer [1,1; 2,1; 1,1; 2,1; 2,2;] *)
You also need to maintain a <word,int> map during your ngram building for a set of strings. As it is much more efficient to handle integers rather than strings during later processing.
(2) to compare the distance between two short strings. A common practice is to use Edit Distance using a simple dynamic programming. To compute the similarity between articles, a state-of-the-art method is to use TFIDF feature representation. Actuallym the code above is for term frequency counting, extracted from my data mining library.
(3) There are complex NLP methods, e.g. tree kernels based on the parse tree, to in-cooperate the context information in.
I think you have some good answers for question (1).
Question (2):
You probably want cosine similarity to compare two arbitrary collections of n-grams (the larger better). This gives you a range of 0.0 - 1.0 without any scaling needed. The Wikipedia page gives an equation, and the F# translation is pretty straightforward:
let cos a b =
let dot = Seq.sum (Seq.map2 ( * ) a b)
let magnitude v = Math.Sqrt (Seq.sum (Seq.map2 ( * ) v v))
dot / (magnitude a * magnitude b)
For input, you need to run something like Tomas' answer to get two maps, then remove keys that only exist in one:
let values map = map |> Map.toSeq |> Seq.map snd
let desparse map1 map2 = Map.filter (fun k _ -> Map.containsKey k map2) map1
let distance textA textB =
let a = ngramSplit 3 textA |> Map.ofSeq
let b = ngramSplit 3 textB |> Map.ofSeq
let aValues = desparse a b |> values
let bValues = desparse b a |> values
cos aValues bValues
With character-based n-grams, I don't know how good your results will be. It depends on what kind of features of the text you are interested in. I do natural language processing, so usually my first step is part-of-speech tagging. Then I compare over n-grams of the parts of speech. I use T'n'T for this, but it has bizarro licencing issues. Some of my colleagues use ACOPOST instead, a Free alternative (as in beer AND freedom). I don't know how good the accuracy is, but POS tagging is a well-understood problem these days, at least for English and related languages.
Question (3):
The best way to compare two strings that are nearly identical is Levenshtein distance. I don't know if that is your case here, although you can relax the assumptions in a number of ways, eg for comparing DNA strings.
The standard book on this subject is Sankoff and Kruskal's "Time Warps, String Edits, and Maromolecules". It's pretty old (1983), but gives good examples of how to adapt the basic algorithm to a number of applications.
Question 3:
My reference book is Computing Patterns in Strings by Bill Smyth

How To Apply a Function to an Array of float Arrays?

Let's suppose I have n arrays, where n is a variable (some number greater than 2, usually less than 10).
Each array has k elements.
I also have an array of length n that contains a set of weights that dictate how I would like to linearly combine all the arrays.
I am trying to create a high performance higher order function to combine these arrays in F#.
How can I do this, so that I get a function that takes an array of arrays (arrs is a sample), a weights array (weights), and then computed a weighted sum based on the weights?
let weights = [|.6;;.3;.1|]
let arrs = [| [|.0453;.065345;.07566;1.562;356.6|] ;
[|.0873;.075565;.07666;1.562222;3.66|] ;
[|.06753;.075675;.04566;1.452;3.4556|] |]
thanks for any ideas.
Here's one solution:
let combine weights arrs =
Array.map2 (fun w -> Array.map ((*) w)) weights arrs
|> Array.reduce (Array.map2 (+))
EDIT
Here's some (much needed) explanation of how this works. Logically, we want to do the following:
Apply each weight to its corresponding row.
Add together the weight-adjusted rows.
The two lines above do just that.
We use the Array.map2 function to combine corresponding weights and rows; the way that we combine them is to multiply each element in the row by the weight, which is accomplished via the inner Array.map.
Now we have an array of weighted rows and need to add them together. We can do this one step at a time by keeping a running sum, adding each array in turn. The way we sum two arrays pointwise is to use Array.map2 again, using (+) as the function for combining the elements from each. We wrap this in an Array.reduce to apply this addition function to each row in turn, starting with the first row.
Hopefully this is a reasonably elegant approach to the problem, though the point-free style admittedly makes it a bit tricky to follow. However, note that it's not especially performant; doing in-place updates rather than creating new arrays with each application of map, map2, and reduce would be more efficient. Unfortunately, the standard library doesn't contain nice analogues of these operations which work in-place. It would be relatively easy to create such analogues, though, and they could be used in almost exactly the same way as I've done here.
Something like this did it for me:
let weights = [|0.6;0.3;0.1|]
let arrs = [| [|0.0453;0.065345;0.07566;1.562;356.6|] ;
[|0.0873;0.075565;0.07666;1.562222;3.66|] ;
[|0.06753;0.075675;0.04566;1.452;3.4556|] |]
let applyWeight x y = x * y
let rotate (arr:'a[][]) =
Array.map (fun y -> (Array.map (fun x -> arr.[x].[y])) [|0..arr.Length - 1|]) [|0..arr.[0].Length - 1|]
let weightedarray = Array.map (fun x -> Array.map(applyWeight (fst x)) (snd x)) (Array.zip weights arrs)
let newarrs = Array.map Array.sum (rotate weightedarray)
printfn "%A" newarrs
By the way.. the 0 preceding a float value is necessary.

Resources