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
Related
it seems, I need help with my recursive function, it not applied. I have an example, but I don't understand what I must to do. where is my mistake? I will be glad to any help!
my function:
let rec split = function
| [] -> ([],[])
| [x] -> ([x], [])
| x :: y :: tail -> split ((fun z -> z)(fun acc -> (x :: fst acc, y :: snd acc))) tail
let res = split [1; 2; 3; 4; 5]
printfn "%A" res
example:
let rec split cont = function
| [] -> cont ([],[])
| [x] -> cont ([x], [])
| x :: y :: tail -> split (fun acc -> cont (x :: fst acc, y :: snd acc)) tail
let res = split (fun x -> x) [1; 2; 3; 4; 5]
printfn "%A" res
I found it...
let rec split = function
| x :: y :: xs -> let (xs1, xs2) = split xs in (x :: xs1, y :: xs2)
| [x] -> ([x], [])
| [] -> ([],[])
// let res = split [1; 2; 3; 4; 5]
// printfn "%A" res
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
I am talking about the zip operations in the context of heterogeneous lists. I am working on a lightly dependently typed language that uses them as tuples.
type T =
| S of string
| R of T list
let rec zip l =
let is_all_r_empty x = List.forall (function R [] -> true | _ -> false) x
let rec loop acc_total acc_head acc_tail x =
match x with
| S _ :: _ -> R l
| R [] :: ys ->
if List.isEmpty acc_head && is_all_r_empty ys then List.rev acc_total |> R
else R l
| R (x :: xs) :: ys -> loop acc_total (x :: acc_head) (R xs :: acc_tail) ys
| [] ->
match acc_tail with
| _ :: _ -> loop ((List.rev acc_head |> zip) :: acc_total) [] [] (List.rev acc_tail)
| _ -> List.rev acc_total |> R
loop [] [] [] l
let rec unzip l =
let transpose l =
let is_all_empty x = List.forall (function _ :: _ -> false | _ -> true) x
let rec loop acc_total acc_head acc_tail = function
| (x :: xs) :: ys -> loop acc_total (x :: acc_head) (xs :: acc_tail) ys
| [] :: ys ->
if List.isEmpty acc_head && is_all_empty ys then loop acc_total acc_head acc_tail ys
else l
| [] ->
match acc_tail with
| _ :: _ -> loop (List.rev acc_head :: acc_total) [] [] (List.rev acc_tail)
| _ -> List.rev acc_total
loop [] [] [] l
let is_all_r x = List.forall (function R _ -> true | _ -> false) x
match l with
| R x when is_all_r x -> List.map unzip x |> transpose |> List.map R
| R x -> x
| S _ -> failwith "Unzip called on S."
//let a = R [R [S "a"; S "t"]; R [S "b"; S "w"]; R [S "c"; S "e"]]
//let b = R [R [S "1"; S "4"]; R [S "5"; S "r"]; R [S "3"; S "6"]]
//let c = R [R [S "z"; S "v"]; R [S "x"; S "b"]; R [S "c"; S "2"]]
//
//let t3 = zip [a;b]
//let t4 = zip [t3;c]
//let u1 = unzip t4
//let r1 = u1 = [t3;c]
//let u2 = unzip t3
//let r2 = u2 = [a;b] // The above works fine on tuples with regular dimensions.
let a = R [R [S "q"; S "w"; S "e"]]
let b = R [R [S "a"; S "s"]; R [S "z"]; S "wqe"]
let ab = [a;b]
let t = zip ab
let t' = unzip t
ab = t' // This is false, but I would like the ziping and then unziping to be reversible if possible.
Zipping and unzipping in general can be expressed as a dimensional shift or a series of transposes. That is all these two functions are doing.
They behave well on regular tuples, but I would like zip+unzip to be isomorphic on irregular ones as well. My intuition is telling me that this would be asking too much of them though.
I need a second opinion here.
#r "../../packages/FsCheck.2.8.0/lib/net452/FsCheck.dll"
type T =
| S of string
| VV of T list
let transpose l on_fail on_succ =
let is_all_vv_empty x = List.forall (function VV [] -> true | _ -> false) x
let rec loop acc_total acc_head acc_tail = function
| VV [] :: ys ->
if List.isEmpty acc_head && is_all_vv_empty ys then
if List.isEmpty acc_total then failwith "Empty inputs in the inner dimension to transpose are invalid."
else List.rev acc_total |> on_succ
else on_fail ()
| VV (x :: xs) :: ys -> loop acc_total (x :: acc_head) (VV xs :: acc_tail) ys
| _ :: _ -> on_fail ()
| [] ->
match acc_tail with
| _ :: _ -> loop (VV (List.rev acc_head) :: acc_total) [] [] (List.rev acc_tail)
| _ -> List.rev acc_total |> on_succ
loop [] [] [] l
let rec zip l =
match l with
| _ :: _ -> transpose l (fun _ -> l) (List.map (function VV x -> zip x | x -> x)) |> VV
| _ -> failwith "Empty input to zip is invalid."
let rec unzip l =
let is_all_vv x = List.forall (function VV _ -> true | _ -> false) x
match l with
| VV x ->
match x with
| _ :: _ when is_all_vv x -> let t = List.map (unzip >> VV) x in transpose t (fun _ -> x) id
| _ :: _ -> x
| _ -> failwith "Empty inputs to unzip are invalid."
| S _ -> failwith "Unzip called on S."
open FsCheck
open System
let gen_t =
let mutable gen_t = None
let gen_s () = Gen.map S Arb.generate<string>
let gen_vv size = Gen.nonEmptyListOf (gen_t.Value size) |> Gen.map VV
gen_t <-
fun size ->
match size with
| 0 -> gen_s()
| _ when size > 0 -> Gen.oneof [gen_s (); gen_vv (size-1)]
| _ -> failwith "impossible"
|> Some
gen_t.Value
|> Gen.sized
let gen_t_list_irregular = Gen.nonEmptyListOf gen_t
let gen_t_list_regular = Gen.map2 List.replicate (Gen.choose(1,10)) gen_t
type MyGenerators =
static member Tuple() = Arb.fromGen gen_t
static member TupleList() = Arb.fromGen gen_t_list_regular
Arb.register<MyGenerators>()
let zip_and_unzip orig = zip orig |> unzip
let zip_and_unzip_eq_orig orig = zip_and_unzip orig = orig
// For regular tuples it passes with flying colors.
Check.One ({Config.Quick with EndSize = 10}, zip_and_unzip_eq_orig)
// I can't get it to be isomorphic for irregularly sized arrays as expected.
//let f x =
// let x' = zip x
// printfn "x'=%A" x'
// printfn "unzip x'=%A" (unzip x')
// printfn "zip_and_unzip_eq_orig x=%A" (zip_and_unzip_eq_orig x)
//
//f [VV [VV [S "12"; S "qwe"]; VV [S "d"]]; VV [VV [S ""; S "ug"]; VV [S ""]]]
No matter what, I try I cannot figure out how to make the pair isomorphic for irregularly sized tuples and I feel it is unlikely that anyone will tell me differently so I'll put the above attempt as an answer for now.
On the upside, based on the tests above, I am decently sure that it should be isomorphic for all regularly sizes tuples. I guess this should suffice. I've tightened the code up a little compared to the example I had in the question.
This irregular zipping and unzipping problem would make an interesting math puzzle.
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)
I would like to start some questions about simplifying different expressions in F#.
Anyone have ideas for better and/or simpler implementation of insertAt (parameters could be reordered, too). Lists or Sequences could be used.
Here is some start implementation:
let insertAt x xs n = Seq.concat [Seq.take n xs; seq [x]; Seq.skip n xs]
The implementation dannyasher posted is a non-tail-recursive one. In order to make the function more efficient, we'll have to introduce an explicit accumulator parameter which makes the function tail-recursive and allows the compiler to optimize the recursion overhead away:
let insertAt =
let rec insertAtRec acc n e list =
match n, list with
| 0, _ -> (List.rev acc) # [e] # list
| _, x::xs -> insertAtRec (x::acc) (n - 1) e xs
| _ -> failwith "Index out of range"
insertAtRec []
Tail-recursive using Seqs:
let rec insertAt = function
| 0, x, xs -> seq { yield x; yield! xs }
| n, x, xs -> seq { yield Seq.hd xs; yield! insertAt (n-1, x, Seq.skip 1 xs) }
Here's an F# implementation of the Haskell list insertion:
let rec insertAt x ys n =
match n, ys with
| 1, _
| _, [] -> x::ys
| _, y::ys -> y::insertAt x ys (n-1)
let a = [1 .. 5]
let b = insertAt 0 a 3
let c = insertAt 0 [] 3
>
val a : int list = [1; 2; 3; 4; 5]
val b : int list = [1; 2; 0; 3; 4; 5]
val c : int list = [0]
My Haskell isn't good enough to know whether the case of passing an empty list is correctly taken care of in the Haskell function. In F# we explicitly take care of the empty list in the second match case.
Danny
For case you really want to work with sequence:
let insertAt x ys n =
let i = ref n
seq {
for y in ys do
decr i
if !i = 0 then yield x
yield y
}
For all other cases dannyasher's answer is definitly nicer and faster.
From the Haskell Wiki - http://www.haskell.org/haskellwiki/99_questions/21_to_28
insertAt :: a -> [a] -> Int -> [a]
insertAt x ys 1 = x:ys
insertAt x (y:ys) n = y:insertAt x ys (n-1)
I'm not an F# programmer so I don't know the equivalent syntax for F# but this is a nice recursive definition for insertAt