ReplicateM Equivalent in F# - haskell

Is there any equivalent function for ReplicateM (of Haskell) in F#?
Example :
replicateM 2 [1,2,3] =
[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]

You can find it in F#+ and it's defined for both List and Seq:
#r #"c:\packages\FSharpPlus-1.0.0\lib\net45\FSharpPlus.dll"
open FSharpPlus
List.replicateM 2 [1;2;3]
// val it : List<int list> =
// [[1; 1]; [1; 2]; [1; 3]; [2; 1]; [2; 2]; [2; 3]; [3; 1]; [3; 2]; [3; 3]]
Seq.replicateM 2 [1;2;3]
// val it : seq<int> list =
// [seq [1; 1]; seq [1; 2]; seq [1; 3]; seq [2; 1]; seq [2; 2]; seq [2; 3];
// seq [3; 1]; seq [3; 2]; seq [3; 3]]
If you are translating from Haskell there is a Compatibility.Haskell module in this project with that function and other Haskell bindings.
In fact the last argument can be a list or any other Applicative but if you don't want to use the library and you're happy with a version that works only with list you can define it like this:
let replicateM n x =
let k m m' = List.collect (fun x ->
List.collect(fun xs ->
[List.Cons(x,xs)]) m') m
List.foldBack k (List.replicate n x) [[]]

The function is not available in standard libraries, so if you do not want to rely on external libraries, you'll need to write it yourself. The easiest implementation looks like this:
let rec replicateM m l = seq {
if m = 1 then
// If we want just one replication, generate singleton lists
for v in l do yield [v]
else
// Otherwise, iterate over all lists with m-1 replicates
for s in replicateM (m - 1) l do
// .. and append elements from 'l' to the front
for v in l do yield v::s }

Related

Haskell Partitions of a number [duplicate]

This question already has an answer here:
Haskell get all the numbers whose sum is X
(1 answer)
Closed last year.
I'm Trying to create a program that finds every paritions of a number.
For example the ways to decompose 4 are:
[1, 1, 1, 1]
[1, 1, 2]
[1, 3]
[2, 2]
[4]
I've done it in Python with:
n = 4
x = [0 for i in range(n+1)]
t = [0 for i in range(n+1)]
x[0] = 1
def partition(i):
for j in range(x[i-1], (n - t[i-1])//2 + 1):
x[i] = j
t[i] = t[i-1] + j
partition(i+1)
x[i] = n - t[i-1]
print(x[1:i+1])
partition(1)
But i need to write it in Haskell. Is there any way?
Here's a hint:
It will be valuable to reverse the order while thinking about this, so you are trying to generate:
[1, 1, 1, 1]
[2, 1, 1]
[2, 2]
[3, 1]
[4]
So, first choose every possible first element, here 1, 2, 3, or 4. Say we've chosen 1, then there are 3 remaining. We can recursively compute all the partitions of 3, and then prepend 1 to each of them.
(Oh, that's not quite right! Still a good place to start. But you will have e.g. [1,2,1] generated, so you will need to add a parameter, I think, saying "don't generate any numbers greater than m")
And we have to make sure to get the base case right. How many partitions are there of 0? There is one, the empty partition!
You can also translate it very literally using mutable vectors. The main difference is that you need to separate reads and writes very explicitly in Haskell, so it becomes a bit more messy.
This is what I came up with without understanding your algorithm:
import Data.Foldable ( for_ )
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as M
main :: IO ()
main = do
let n = 4
x <- M.replicate (n + 1) 0
t <- M.replicate (n + 1) 0
M.write x 0 1
let partition i = do
x' <- M.read x (i - 1)
t' <- M.read t (i - 1)
for_ [x' .. (n - t') `quot` 2] $ \j -> do
M.write x i j
t' <- M.read t (i - 1)
M.write t i (t' + j)
partition (i + 1)
t' <- M.read t (i - 1)
M.write x i (n - t')
x' <- V.freeze (M.slice 1 i x)
print (V.toList x')
partition 1

Calculate module of "Just int" in Haskell

I'm trying to calculate the module of an index of a list.
list=[5,6,7,8]
a = elemIndex 7 list
b = mod a 2
Ideally, this would give me b = 0 since a = 2 (technically).
But I'm getting error messages since a is not 2 but Just 2.
You can do this with fmap :: Functor f => (a -> b) -> f a -> f b or its operator variant (<$>) :: Functor f => (a -> b) -> f a -> f b to apply a function to the item wrapped in the Just … data constructor:
b = (`mod` 2) <$> a
this will then return Just 0 when a is Just 2, and Nothing if the elemIndex returned a Nothing. This thus means that if elemIndex fails (because the index is out of range), b will be Nothing.
You can just use pattern matching with let to get to the inner part of the Maybe value when it is guaranteed to be Just _:
list = [5,6,7,8]
a = elemIndex 7 list
b = mod a 2
foo list = [b | n <- [5,6,7,8]
, let a = elemIndex n [5,6,7,8]
, let Just i = a
, let b = mod i 2]
= [b | n <- list
, let Just i = elemIndex n list
, let b = mod i 2]
= [b | (_, i) <- zip list [0..]
, let b = mod a 2]
= ls where ls = [0,1] ++ ls
bar list = [(n,b) | n <- list
, let Just i = elemIndex n list
, let b = mod i 2]
= [(n,b) | (n, i) <- zip list [0..]
, let b = mod i 2]
= zip list ls where ls = cycle [0,1]
Normally this kind of pattern matching is frowned upon since it is partial, i.e. can cause error if the value is actually Nothing, but here it is correct by construction.
But then really, why put it into a Just -- just use it as it is. And we did.

OCaml equivalent to Haskell's # in pattern matching (a.k.a. as-pattern)

In Haskell, while pattern matching, I can use # to get the entire structure in a pattern. (For easier Googling, this structure is known as an as-pattern.)
For example, x:xs decomposes a list into a head and a tail; I can also get the entire list with xxs#(x:xs).
Does OCaml have something like this?
You can use as:
let f = function
| [] -> (* ... *)
| (x::xs) as l ->
(*
here:
- x is the head
- xs is the tail
- l is the whole list
*)
Let me extend Etienne's answer a little bit with some examples:
let x :: xs as list = [1;2;3];;
val x : int = 1
val xs : int list = [2; 3]
val list : int list = [1; 2; 3]
When you write <pattern> as <name>, the variable <name> is bound to the whole pattern on the left, in other words, the scope of as extends as far to the left as possible (speaking more techically as has lower priority than constructors, i.e., the constructors bind tighter). So, in case of the deep pattern matching, you might need to use parentheses to limit the scope, e.g.,
let [x;y] as fst :: ([z] as snd) :: xs as list = [[1;2];[3]; [4]];;
val x : int = 1
val y : int = 2
val fst : int list = [1; 2]
val z : int = 3
val snd : int list = [3]
val xs : int list list = [[4]]
val list : int list list = [[1; 2]; [3]; [4]]

group by until changed sequence

I have a big Excel file, which i read with Excel Provider in F#.
The rows should be grouped by some column. Processing crashes with OutOfMemoryException. Not sure whether the Seq.groupBy call is guilty or excel type provider.
To simplify it I use 3D Point here as a row.
type Point = { x : float; y: float; z: float; }
let points = seq {
for x in 1 .. 1000 do
for y in 1 .. 1000 do
for z in 1 .. 1000 ->
{x = float x; y = float y; z = float z}
}
let groups = points |> Seq.groupBy (fun point -> point.x)
The rows are already ordered by grouped column, e.g. 10 points with x = 10, then 20 points with x = 20 and so one. Instead of grouping them I need just to split the rows in chunks until changed. Is there some way to enumerate the sequence just once and get sequence of rows splitted, not grouped, by some column value or some f(row) value?
If the rows are already ordered then this chunkify function will return a seq<'a list>. Each list will contain all the points with the same x value.
let chunkify pred s = seq {
let values = ref []
for x in s do
match !values with
|h::t -> if pred h x then
values := x::!values
else
yield !values
values := [x]
|[] -> values := [x]
yield !values
}
let chunked = points |> chunkify (fun x y -> x.x = y.x)
Here chunked has a type of
seq<Point list>
Another solution, along the same lines as Kevin's
module Seq =
let chunkBy f src =
seq {
let chunk = ResizeArray()
let mutable key = Unchecked.defaultof<_>
for x in src do
let newKey = f x
if (chunk.Count <> 0) && (newKey <> key) then
yield chunk.ToArray()
chunk.Clear()
key <- newKey
chunk.Add(x)
}
// returns 2 arrays, each with 1000 elements
points |> Seq.chunkBy (fun pt -> pt.y) |> Seq.take 2
Here's a purely functional approach, which is surely slower, and much harder to understand.
module Seq =
let chunkByFold f src =
src
|> Seq.scan (fun (chunk, (key, carry)) x ->
let chunk = defaultArg carry chunk
let newKey = f x
if List.isEmpty chunk then [x], (newKey, None)
elif newKey = key then x :: chunk, (key, None)
else chunk, (newKey, Some([x]))) ([], (Unchecked.defaultof<_>, None))
|> Seq.filter (snd >> snd >> Option.isSome)
|> Seq.map fst
Lets start with the input
let count = 1000
type Point = { x : float; y: float; z: float; }
let points = seq {
for x in 1 .. count do
for y in 1 .. count do
for z in 1 .. count ->
{x = float x; y = float y; z = float z}
}
val count : int = 1000
type Point =
{x: float;
y: float;
z: float;}
val points : seq<Point>
If we try to evalute points then we get a OutOfMemoryException:
points |> Seq.toList
System.OutOfMemoryException: Exception of type 'System.OutOfMemoryException' was thrown.
at Microsoft.FSharp.Collections.FSharpList`1.Cons(T head, FSharpList`1 tail)
at Microsoft.FSharp.Collections.SeqModule.ToList[T](IEnumerable`1 source)
at <StartupCode$FSI_0011>.$FSI_0011.main#()
Stopped due to error
It might be same reason that groupBy fails, but I'm not sure. But it tells us that we have to use seq and yield to return the groups with. So we get this implementation:
let group groupBy points =
let mutable lst = [ ]
seq { for p in points do match lst with | [] -> lst <- [p] | p'::lst' when groupBy p' p -> lst <- p::lst | lst' -> lst <- [p]; yield lst' }
val group : groupBy:('a -> 'a -> bool) -> points:seq<'a> -> seq<'a list>
It is not the most easily read code. It takes each point from the points sequence and prepends it to an accumulator list while the groupBy function is satisfied. If the groupBy function is not satisfied then a new accumulator list is generated and the old one is yielded. Note that the order of the accumulator list is reversed.
Testing the function:
for g in group (fun p' p -> p'.x = p.x ) points do
printfn "%f %i" g.[0].x g.Length
Terminates nicely (after some time).
Other implementation with bug fix and better formatting.
let group (groupBy : 'a -> 'b when 'b : equality) points =
let mutable lst = []
seq {
yield! seq {
for p in points do
match lst with
| [] -> lst <- [ p ]
| p' :: lst' when (groupBy p') = (groupBy p) -> lst <- p :: lst
| lst' ->
lst <- [ p ]
yield (groupBy lst'.Head, lst')
}
yield (groupBy lst.Head, lst)
}
Seems there is no one line purely functional solution or already defined Seq method which I have overseen.
Therefore as an alternative here my own imperative solution. Comparable to #Kevin's answer but actually satisfies more my need. The ref cell contains:
The group key, which is calculated just once for each row
The current chunk list (could be seq to be conform to Seq.groupBy), which contains the elements in the input order for which the f(x) equals to the sored group key (requires equality).
.
let splitByChanged f xs =
let acc = ref (None,[])
seq {
for x in xs do
match !acc with
| None,_ ->
acc := Some (f x),[x]
| Some key, chunk when key = f x ->
acc := Some key, x::chunk
| Some key, chunk ->
let group = chunk |> Seq.toList |> List.rev
yield key, group
acc := Some (f x),[x]
match !acc with
| None,_ -> ()
| Some key,chunk ->
let group = chunk |> Seq.toList |> List.rev
yield key, group
}
points |> splitByChanged (fun point -> point.x)
The function has the following signature:
val splitByChanged :
f:('a -> 'b) -> xs:seq<'a> -> seq<'b * 'a list> when 'b : equality
Correctures and even better solutions are welcome

Remove elements during infinite sequence generation

I found a great haskell solution (source) for generating a Hofstadter sequence:
hofstadter = unfoldr (\(r:s:ss) -> Just (r, r+s:delete (r+s) ss)) [1..]
Now, I am trying to write such a solution in F#, too. Unfortunately (I am not really familar to F#) I had no success so far.
My problem is, that when I use a sequence in F#, it seems not to be possible to remove an element (like it is done in the haskell solution).
Other data structures like arrays, list or set which allow to remove elements are not generating an infinite sequence, but operate on certain elements, only.
So my question: Is it possible in F# to generate an infinite sequence, where elements are deleted?
Some stuff I tried so far:
Infinite sequence of numbers:
let infinite =
Seq.unfold( fun state -> Some( state, state + 1) ) 1
Hofstadter sequence - not working, because there is no del keyword and there are more syntax errors
let hofstadter =
Seq.unfold( fun (r :: s :: ss) -> Some( r, r+s, del (r+s) ss)) infinite
I thought about using Seq.filter, but found no solution, either.
I think you need more than a delete function on sequence. Your example requires pattern matching on inifinite collections, which sequence doesn't support.
The F# counterpart of Haskell list is LazyList from F# PowerPack. LazyList is also potentially infinite and it supports pattern matching, which helps you to implement delete easily.
Here is a faithful translation:
open Microsoft.FSharp.Collections.LazyList
let delete x xs =
let rec loop x xs = seq {
match xs with
| Nil -> yield! xs
| Cons(x', xs') when x = x' -> yield! xs'
| Cons(x', xs') ->
yield x'
yield! loop x xs'
}
ofSeq (loop x xs)
let hofstadter =
1I |> unfold (fun state -> Some(state, state + 1I))
|> unfold (function | (Cons(r, Cons(s, ss))) ->
Some(r, cons (r+s) (delete (r+s) ss))
| _ -> None)
|> toSeq
There are a few interesting things here:
Use sequence expression to implement delete to ensure that the function is tail-recursive. A non-tail-recursive version should be easy.
Use BigInteger; if you don't need too many elements, using int and Seq.initInfinite is more efficient.
Add a case returning None to ensure exhaustive pattern matching.
At last I convert LazyList to sequence. It gives better interoperability with .NET collections.
Implementing delete on sequence is uglier. If you are curious, take a look at Remove a single non-unique value from a sequence in F# for reference.
pad's solution is nice but, likely due to the way LazyList is implemented, stack overflows somewhere between 3-4K numbers. For curiosity's sake I wrote a version built around a generator function (unit -> 'a) which is called repeatedly to get the next element (to work around the unwieldiness of IEnumerable). I was able to get the first 10K numbers (haven't tried beyond that).
let hofstadter() =
let delete x f =
let found = ref false
let rec loop() =
let y = f()
if not !found && x = y
then found := true; loop()
else y
loop
let cons x f =
let first = ref true
fun () ->
if !first
then first := false; x
else f()
let next =
let i = ref 0
fun () -> incr i; !i
Seq.unfold (fun next ->
let r = next()
let s = next()
Some(r, (cons (r+s) (delete (r+s) next)))) next
In fact, you can use filter and a design that follows the haskell solution (but, as #pad says, you don't have pattern matching on sequences; so I used lisp-style destruction):
let infinite = Seq.initInfinite (fun i -> i+1)
let generator = fun ss -> let (r, st) = (Seq.head ss, Seq.skip 1 ss)
let (s, stt) = (Seq.head st, Seq.skip 1 st)
let srps = seq [ r + s ]
let filtered = Seq.filter (fun t -> (r + s) <> t) stt
Some (r, Seq.append srps filtered)
let hofstadter = Seq.unfold generator infinite
let t10 = Seq.take 10 hofstadter |> Seq.toList
// val t10 : int list = [1; 3; 7; 12; 18; 26; 35; 45; 56; 69]
I make no claims about efficiency though!

Resources