Time complexity O() of two two part functions - f#

What would the time complexity be of these two algorithms?
let rec fol f a = function
| [] -> a
| x::xs -> fol f (f a x) xs;;
let mergelist xs = List.fol (#) [] xs
and
let rec folB f xs a =
match xs with
| [] -> a
| y::ys -> f y (folB f ys a);;
let mergelist2 xs = List.folB (#) xs []
and how would i be able to test it my self?
Should return something like
mergelist [[1;2];[];[3];[4;5;6]];;
val it : int list = [1; 2; 3; 4; 5; 6]

Here is a quick&dirty snippet of how you can compare the two operations with n lists of length 3 each:
let rec fol f a = function
| [] -> a
| x::xs -> fol f (f a x) xs;;
let rec folB f xs a =
match xs with
| [] -> a
| y::ys -> f y (folB f ys a);;
let compareThemFor n =
let testList = List.replicate n [1;2;3]
let count = ref 0
let myCons x xs =
incr count
x :: xs
let myApp ys =
List.foldBack myCons ys
let mergelist = fol myApp []
mergelist testList |> ignore
let countA = !count
count := 0
let mergelist2 xs = folB myApp xs []
mergelist2 testList |> ignore
let countB = !count
(countA, countB)
and this is what you will get:
> compareThemFor 2;;
val it : int * int = (3, 6)
> compareThemFor 3;;
val it : int * int = (9, 9)
> compareThemFor 4;;
val it : int * int = (18, 12)
> compareThemFor 5;;
val it : int * int = (30, 15)
> compareThemFor 6;;
val it : int * int = (45, 18)
as you can see the second is far better and I hope the comments above helps you understand why.
Just in case here is the n=3 version for mergelist:
mergelist [[1;2;3];[3;4;5];[6;7;8]]
{ second case in `fol` with `x=[1;2;3]` and `xs=[[3;4;5];[6;7;8]]` }
= fol (#) ([] # [1;2;3]) [[3;4;5];[6;7;8]] // one # of 0 elements = 0 operations
{ second case in `fol` with `x=[3;4;5]` and `xs=[[6;7;8]]` }
= fol (#) ([1;2;3] # [3;4;5]) [[6;7;8]] // one # of 3 elements = 3 operations
{ second case in `fol` with `x=[6;7;8]` and `xs=[]` }
= fol (#) ([1;2;3;3;4;5] # [6;7;8]) [] // one # of 6 elements = 6 operations
{ first case }
= [1;2;3;3;4;5;6;7;8] // 0+3+(3+3)=9 Operations Total
please note that you prepend [1,2,3] multiple times ...

Related

How to allow a function to accept a generic list of functions?

How to allow a function to accept a generic list of functions?
I have the code below, but the compiler is rejecting the line where I try to set partiallyAppliedAdds, with the error:
Type mismatch. Expecting a int -> int' given a int -> 'a -> 'b'
type ApplicativeFunctor(fnList: 'a list) =
member private this.fnList: 'a list = fnList
member this.ap (apTarget: int list) = ([], this.fnList) ||> List.fold (fun (acc: 'a list) fn -> acc # (apTarget |> List.map fn))
let add1 a = a + 1
ApplicativeFunctor([add1]).ap([1]) // [2]
let arg1 = [1; 3]
let add x = fun y -> x + y
let partiallyAppliedAdds = ApplicativeFunctor[add].ap(arg1) // Type mismatch. Expecting a int -> int' given a int -> 'a -> 'b'
Is this easily accomplishable in F#, or should I approach this differently?
To fix your version, you do:
type ApplicativeFunctor<'a,'b>(fnList: list<'a -> 'b>) =
member private _.fnList = fnList
member this.ap apTarget =
([], this.fnList)
||> List.fold (fun acc fn -> acc # List.map fn apTarget)
let add1 a = a + 1
let res1 = ApplicativeFunctor([add1]).ap([1]) (* [2] *)
printfn "%A" res1
let paAdd = ApplicativeFunctor[fun x y -> x + y].ap([1;3])
printfn "%A" paAdd
But the general approach is just
let ap fs xs =
List.foldBack2 (fun f x state ->
f x :: state
) fs xs []
let add x y z = x + y + z
let xs = [1..3]
let ys = [10;20;30]
let zs = [100;200;300]
let res1 = (ap (ap (List.map add xs) ys) zs)
printfn "%A" res1 (* [111;222;333] *)
(* Custom operators *)
let (<!>) = List.map
let (<*>) = ap
let res2 = add <!> xs <*> ys <*> zs
printfn "%A" res2 (* [111;222;333] *)

How to sum adjacent numbers of same sign using List.fold in F#

Let's say I have a list in F# like this: [5,-2, -6, 7, -2, 2, 14, 2]
I want to write a function that will use List.fold to return a new list such as [5, -8, 7, -2, 18]
My template looks like this:
let sumAdjacentOfSameSign (lst :int list) : int list =
let f x y =
if x.Length = 0 then
[y]
elif System.Math.Sign(x) = System.Math.Sign(y) then ...
else y :: x
List.fold f [] lst
I need to fill in the ... part but can't quite say how.
Making the fewest changes to your code, I would do this:
let sumAdjacentOfSameSign (lst :int list) : int list =
let f (x : int list) (y : int) =
if x.Length = 0 then
[y]
elif System.Math.Sign(x.Head) = System.Math.Sign(y) then
(x.Head + y) :: x.Tail
else y :: x
List.fold f [] lst
|> List.rev // note that you have to reverse the resulting list
But I would suggest simplifying f to:
let f (x : int list) (y : int) =
match x with
| head :: tail when
System.Math.Sign(head) = System.Math.Sign(y) ->
(head + y) :: tail
| _ -> y :: x

recursion with several functions F#

I need some help with my hometask: to express one function (sort) through others (smallest, delete, insert). If you know how, please, tell me, how I can do running my recursion cicle? it doing now only one step. maybe something like this: val4 -> head :: tail |> sort tail on line 25 (val4)?
let rec smallest = function
| x :: y :: tail when x <= y -> smallest (x :: tail)
| x :: y :: tail when x > y -> smallest (y :: tail)
| [x] -> Some x
| _ -> None
let rec delete (n, xs) =
match (n, xs) with
| (n, x :: xs) when n <> x -> x :: delete (n, xs)
| (n, x :: xs) when n = x -> xs
| (n, _) -> []
let rec insert (xs, n) =
match (xs, n) with
| ([x], n) when x < n -> [x]#[n]
| (x :: xs, n) when x < n -> x :: insert (xs, n)
| (x :: xs, n) when x >= n -> n :: x :: xs
| (_, _) -> []
let rec sort = function
| xs -> let val1 = smallest xs
let val2 = val1.[0]
let val3 = delete (val2, xs)
let val4 = insert (val3, val2)
val4
let res = sort [5; 4; 3; 2; 1; 1]
printfn "%A" res
This is sort of like insertion sort, but since you're always finding the smallest number in the whole list instead of the next highest number, it will recurse forever unless you skip whatever you've already found to be the smallest.
Furthermore, your insert and delete functions act not on the item index, but on equality to the value, so it won't be able to handle repeated numbers.
Keeping most of your original code the same, usually you have an inner recursive function to help you keep track of state. This is a common FP pattern.
let sort lst =
let size = lst |> List.length
let rec sort' xs = function
| index when index = size -> xs
| index ->
let val1 = smallest (xs |> List.skip index)
let val2 = val1.[0]
let val3 = delete (val2, xs)
let val4 = insert (val3, val2)
sort' val4 (index + 1)
sort' lst 0
let res = sort [5; 3; 2; 4; 1; ]
printfn "%A" res
Needless to say, this isn't correct or performant, and each iteration traverses the list multiple times. It probably runs in cubic time.
But keep learning!
I found it... I only had changed 4 & 5 lines above in the "smallest" on this: | [x] -> Some x
| _ -> None, when there was: | [x] -> [x]
| _ -> []
let rec sort = function
| xs -> match xs with
| head :: tail -> let val1 = smallest xs
match val1 with
| Some x -> let val2 = delete (x, xs)
let val3 = insert (val2, x)
let val4 = (fun list -> match list with head :: tail -> head :: sort tail | _ -> [])
val4 val3
| None -> []
| _ -> []
// let res = sort [5; 4; 3; 2; 1]
// printfn "%A" res

Rewrite msort, so it uses pattern matching in F# [duplicate]

This question already has answers here:
Merge sort for f sharp
(2 answers)
Closed 5 years ago.
The code underneath is the code for mergesort in f# and I have to rewrite it, so it uses pattern matching.
let rec msort xs =
let sz = List.length xs
if sz < 2 then xs
else let n = sz / 2
let ys = xs.[0..n-1]
let zs = xs.[n..sz-1]
in merge (msort ys) (msort zs)
So far I've gotten is to here:
let rec msort (vs: int list) =
let sz = List.length xs
match xs with
| List.length < 2 -> vs
| _ ->
let n = sz / 2
let ys = xs.[0..n-1]
let zs = xs.[n..sz-1]
in merge (msort ys) (msort zs)
I can't seem to figure out a better way. Is there anyone who can help me on my way?
I would probably do it like this:
let rec msort (values: int list) =
let n = values.Length / 2
if n = 0
then values
else let rec merge (xs: int list) (ys: int list) =
match (xs, ys) with
| ([], ys) -> ys
| (xs, []) -> xs
| (x :: xs1, y :: ys1) ->
if x < y
then x :: merge xs1 ys
else y :: merge xs ys1
let (first, second) = values |> List.splitAt n
merge (msort first) (msort second)
Pattern matching isn't too useful on the initial logic (length of the list, early exits for length 0 and 1), but I think it makes it more readable when matching the cases for the sub-lists after the split. Even so, there's only one if/then in the msort portion and it could be replaced with a pattern match if you really wanted to:
let rec msort (values: int list) =
match values.Length / 2 with
| 0 -> values
| n ->
let rec merge (xs: int list) (ys: int list) =
match (xs, ys) with
| ([], ys) -> ys
| (xs, []) -> xs
| (x :: xs1, y :: ys1) ->
if x < y
then x :: merge xs1 ys
else y :: merge xs ys1
let (first, second) = values |> List.splitAt n
merge (msort first) (msort second)
This leaves only the if/then for x<y in the merge implementation, and I wouldn't change that.
Almost the same, but I propose a custom split:
let split2 (li: int list) =
let n = (List.length li) / 2
let rec looprec (len: int) (l1: int list) (l2: int list) =
if len > 0 then
match l1 with
| x::tail -> looprec (len-1) tail (x::l2)
| _ -> (List.rev l2, l1)
else
(List.rev l2, l1)
in looprec n li []
let rec merge (l1: int list) (l2: int list) =
match (l1,l2) with
| (x,[]) -> x
| ([],y) -> y
| (x::tx,y::ty) ->
if x <= y
then x::merge tx l2
else y::merge l1 ty
let rec msort (li: int list) =
match li with
| [] -> []
| [x] -> [x]
| _ -> let (l1,l2) = split2 li
in merge (msort l1) (msort l2)
let d= msort [3;20;12]
printfn "%A" d

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)

Resources