Remove elements during infinite sequence generation - haskell

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!

Related

F# - Remove duplicate characters after first in string

What I am trying to do is to remove duplicates of a specific given char in a string but letting the first char to remain. I.e:
let myStr = "hi. my .name."
//a function that gets a string and the element to be removed in the string
someFunc myStr "."
where someFunc returns the string showen as below:
"hi. my name"
It is easy to remove duplicates from a string, but is there a way to remove the duplicates but letting the first duplicated element remain in the string?
Here's one approach:
let keepFirst c s =
Seq.mapFold (fun k c' -> (c', k||c<>c'), k&&c<>c') true s
|> fst
|> Seq.filter snd
|> Seq.map fst
|> Array.ofSeq
|> System.String
let example = keepFirst '.' "hi. my .name."
let someFunc (str : string) c =
let parts = str.Split([| c |])
if Array.length parts > 1 then
seq {
yield Array.head parts
yield string c
yield! Array.tail parts
}
|> String.concat ""
else
str
Note that the character is given as char instead of a string.
let someFunc chr (str:string) =
let rec loop (a: char list) b = function
| [] -> a |> List.rev |> System.String.Concat
| h::t when h = chr -> if b then loop a b t
else loop (h::a) true t
| h::t -> loop (h::a) b t
loop [] false (str.ToCharArray() |> Array.toList)
Note that the character is given as char instead of a string.
Edit: Another way would be using regular expressions
open System.Text.RegularExpressions
let someOtherFunc c s =
let pat = Regex.Escape(c)
Regex.Replace(s, sprintf "(?<=%s.*)%s" pat pat, "")
Note that, in this case the character is given as string.
Edit 2:
let oneMoreFunc (c:char) (s:string) =
let pred = (<>) c
[ s |> Seq.takeWhile pred
seq [c]
s |> Seq.skipWhile pred |> Seq.filter pred ]
|> Seq.concat
|> System.String.Concat
When devising a function, think about gains from making its arguments generic. To pass state through the iteration, barring mutable variables, Seq.scan could be a weapon of choice. It folds into a tuple of new state and an option, then Seq.choose strips out the state and the unwanted elements.
In terms of functional building blocks, make it accept a predicate function 'a -> bool and let it return a function seq<'a> -> seq<'a>.
let filterDuplicates predicate =
Seq.scan (fun (flag, _) x ->
let p = predicate x in flag || p,
if flag && p then None else Some x ) (false, None)
>> Seq.choose snd
This can then easily reused to do other things as well, like 0 together with odd numbers.
filterDuplicates (fun i -> i % 2 = 0) [0..10]
// val it : seq<int> = seq [0; 1; 3; 5; ...]
Supplied with a call to the equality operator and fed into the constructor of System.String, you'll get near the signature you want, char -> seq<char> -> System.String.
let filterDuplicatesOfChar what s =
System.String(Array.ofSeq <| filterDuplicates ((=) what) s)
filterDuplicatesOfChar '.' "hi. my .name."
// val it : string = "hi. my name"

Haskell Data.Vector, huge memory leak

I am trying to make a basic 2D engine with haskell and the SDL1.2 bindings (for fun, I am just learning).
Ideally the world is to be procedurally generated, chunk by chunk, allowing free exploration.
Right now my chunk is composed of 200*200 tiles which I represent using a type:
Mat [Tile] = Vec.Vector (Vec.Vector [Tile])
and these functions:
fromMat :: [[a]] -> Mat a
fromMat xs = Vec.fromList [Vec.fromList xs' | xs' <- xs]
(§) :: Mat a -> (Int, Int) -> a
v § (r, c) = (v Vec.! r) Vec.! c
I am using cyclic list of tiles in order to allow for sprite animation, and later for dynamic behaviour.
Each frame of the game loop, the program reads the part of the vector relevant to the current camera position, display the corresponding tiles and return a new vector in which every of these cyclic lists has been replaced by it's tail.
Here is the code responsible for this:
applyTileMat :: Chunk -> SDL.Surface -> SDL.Surface -> IO Chunk
applyTileMat ch src dest =
let m = chLand $! ch
(x,y) = chPos ch
wid = Vec.length (m Vec.! 0) - 1
hei = (Vec.length m) - 1
(canW,canH) = canvasSize ch in
do sequence $ [ applyTile (head (m § (i,j))) (32*(j-x), 32*(i-y)) src dest | i <- [y..(y+canH)], j <- [x..(x+canW)]]
m' <-sequence $ [sequence [(return $! tail (m § (i,j))) | j <- [0..wid]] | i <- [0..hei]] --weird :P
return ch { chLand = fromMat m' }
the first sequence does the display part, the second one returns the new vector m'.
At first I was using the following comprehension to get m'
let !m' = [id $! [(tail $! (m § (i,j))) | j <- [0..wid]] | i <- [0..hei]]
but doing so results in ever increasing memory usage. I think it has to do with lazy evaluation preventing the data to be properly garbage collected, but I don't really understand why.
In this particular case, it doesn't really mater since I have to look at the whole vector. But I don't know how I should do if I wanted to only "update" part of my chunk each frame, thus making a new chunk with only part of the data from the previous one.
I am probably not using Data.Vector the way it's intended, but it's the simplest data structure I found with O(n) random access.
The whole code is there:
https://github.com/eniac314/wizzard/blob/master/tiler.hs
The problem is indeed that vectors are lazy in the elements. First, let's look at why your example doesn't work.
let !m' = [id $! [(tail $! (m § (i,j))) | j <- [0..wid]] | i <- [0..hei]]
The bang pattern in !m doesn't do much. All ! does is ensure that a variable is a constructor or a lambda, instead of a function application. Here !m can be discerned to be either an [] or a (:) without evaluating any elements. Similarly, the įd $!-s don't force any actual elements of the inner lists.
return ch { chLand = fromMat m' }
fromMat is the next culprit. fromMat doesn't force the inner vectors, and also doesn't force the elements. As a result, references to old vectors stick around in the thunks indefinitely.
Often the correct solution is to import Control.DeepSeq, and use force or $!! to fully evaluate vectors. Unfortunately, we can't do that here because of the cyclic lists (trying to force one results in an infinite loop).
What we really need is a function that brings all the elements of a vector to weak head normal form:
whnfElements :: Vector a -> Vector a
whnfElements v = V.foldl' (flip seq) () v `seq` v
We can use this to define a strict map for vectors:
vmap' :: (a -> b) -> Vector a -> Vector b
vmap' f = whnfElements . V.map f
Now updating becomes:
update :: Mat [Tile] -> Mat [Tile]
update = (vmap' . vmap') tail

Irrefutable pattern failed inside of Let statement

I'm learning haskell and am currently trying to parse Integers and Floats from strings.
However, when trying my readNum function on "342" or any "number" that doesn't have a single or more non-numeric characters ghci reports to me:
* Exception: parse.hs:125:18-46: Irrefutable pattern failed for pattern (i, (a
: as))
data Token
= IntTok Int | FloatTok Float | EOF
readNum :: String->(Token, String)
readNum [] = (EOF, [])
readNum xs = let (i, (a:as)) = span isDigit xs --This is line 125
in (case a of
('.') -> let (j, (b:c:bs)) = span isDigit as
in (if ((toLower b) == 'e' && (c == '+' || c == '-' || (isDigit c)))
then (let (k, d) = span isDigit bs in (FloatTok (read (concat [i,[a],j, [b],[c],k])::Float), d))
else (FloatTok (read (concat [i,[a],j])::Float), (b:c:bs)))
_ -> (IntTok (read i::Int), (a:as)))
Is there a better way to handle the case when span isDigit xs returns an empty list as the second element of the tuple?
-Thanks
You're getting the error because if you use a simple Integer like "342" then span isDigit "342" is just ("342",[]), which can't match (l,a:as). A pattern that is supposed to always match is called an irrefutable pattern. As you've found out, patterns in let bindings are irrefutable, so...
You need to to stick to patterns that will always match in a let binding. For example you could do
readNum xs = let (i, ps) = span isDigit xs
in (case ps of
('.':as) -> let (j, qs) = span isDigit as in case qs of
b:c:bs -> if ..........
_ -> error "not enough stuff after decimal number"
_ -> ....
I gave a silly error message, but clearly you should write more sensible code there.

How To Change List of Chars To String?

In F# I want to transform a list of chars into a string. Consider the following code:
let lChars = ['a';'b';'c']
If I simply do lChars.ToString, I get "['a';'b';'c']". I'm trying to get "abc". I realize I could probably do a List.reduce to get the effect I'm looking for but it seems like there should be some primitive built into the library to do this.
To give a little context to this, I'm doing some manipulation on individual characters in a string and when I'm done, I want to display the resulting string.
I've tried googling this and no joy that way. Do I need to just bite the bullet and build a List.reduce expression to do this transformation or is there some more elegant way to do this?
Have you tried
System.String.Concat(Array.ofList(lChars))
How many ways can you build a string in F#?
Here's another handful:
let chars = ['H';'e';'l';'l';'o';',';' ';'w';'o';'r';'l';'d';'!']
//Using an array builder
let hw1 = new string [|for c in chars -> c|]
//StringBuilder-Lisp-like approach
open System.Text
let hw2 =
string (List.fold (fun (sb:StringBuilder) (c:char) -> sb.Append(c))
(new StringBuilder())
chars)
//Continuation passing style
let hw3 =
let rec aux L k =
match L with
| [] -> k ""
| h::t -> aux t (fun rest -> k (string h + rest) )
aux chars id
Edit: timings may be interesting? I turned hw1..3 into functions and fed them a list of 500000 random characters:
hw1: 51ms
hw2: 16ms
hw3: er... long enough to grow a beard? I think it just ate all of my memory.
Didn't see this one here, so:
let stringFromCharList (cl : char list) =
String.concat "" <| List.map string cl
"" is just an empty string.
FSI output:
> stringFromCharList ['a'..'d'];;
val it : string = "abcd"
EDIT:
Didn't like this syntax coming back to this so here's a more canonically functional one:
['a'..'z'] |> List.map string |> List.reduce (+)
['a';'b';'c'] |> List.fold_left (fun acc c -> acc ^ (string c)) ""
Edited:
Here is yet another funny way to do your task:
type t =
| N
| S of string
static member Zero
with get() = N
static member (+) (a: t, b: t) =
match a,b with
| S a, S b -> S (a+b)
| N, _ -> b
| _, N -> a
let string_of_t = function
|N -> ""
|S s -> s
let t_of_char c = S (string c)
['a'; 'b'; 'c'] |> List.map t_of_char |> List.sum |> string_of_t
Sadly, just extending System.String with 'Zero' member does not allow to use List.sum with strings.
Edited (answer to Juilet):
Yes, you are right, left fold is slow. But i know more slow right fold :) :
#r "FSharp.PowerPack"
List.fold_right (String.make 1 >> (^)) ['a';'b';'c'] ""
and of course there is fast and simple:
new System.String(List.to_array ['1';'2';'3'])
And i used 'sprintf' seems to me easier:
let t = "Not what you might expect"
let r = [ for i in "aeiou" -> i]
let q = [for a in t do if not (List.exists (fun x -> x=a) r) then yield a]
let rec m = function [] -> "" | h::t -> (sprintf "%c" h) + (m t)
printfn "%A" (m q)
The following solution works for me:
let charList = ["H";"E";"L";"L";"O"]
let rec buildString list =
match list with
| [] -> ""
| head::tail -> head + (buildString tail)
let resultBuildString = buildString charList
[|'w'; 'i'; 'l'; 'l'|]
|> Array.map string
|> Array.reduce (+)
or as someone else posted:
System.String.Concat([|'w'; 'i'; 'l'; 'l'|])

Simplifying some Haskell code

So I'm working on a minimax implementation for a checkers-like game to help myself learn Haskell better. The function I'm having trouble with takes a list for game states, and generates the list of immediate successor game states. Like checkers, if a jump is available, the player must take it. If there's more than one, the player can choose.
For the most part, this works nicely with the list monad: loop over all the input game states, loop over all marbles that could be jumped, loop over all jumps of that marble. This list monad nicely flattens all the lists out into a simple list of states at the end.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list. The code below is the best way I've come up with of doing that, but it seems really ugly to me. Any suggestions on how to clean it up?
eHex :: Coord -> Coord -- Returns the coordinates immediately to the east on the board
nwHex :: Coord -> Coord -- Returns the coordinates immediately to the northwest on the board
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states = do
ws <- states
case children ws of
[] -> return ws
n#_ -> n
where
children ws#(ZertzState s1 s2 b p) = do
(c, color) <- occupiedCoords ws
(start, end) <- [(eHex, wHex), (wHex, eHex), (swHex, neHex),
(neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
if (hexOccupied b $ start c) && (hexOpen b $ end c)
then case p of
1 -> return $ ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
(-1) -> return $ ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
else []
EDIT: Provide example type signatures for the *Hex functions.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list.
Why? I've written minimax several times, and I can't imagine a use for such a function. Wouldn't you be better off with a function of type
nextStates :: [ZertzState] -> [Maybe [ZertzState]]
or
nextStates :: [ZertzState] -> [[ZertzState]]
However if you really want to return "either the list of next states, or if that list is empty, the original state", then the type you want is
nextStates :: [ZertzState] -> [Either ZertzState [ZertzState]]
which you can then flatten easily enough.
As to how to implement, I recommend defining a helper function of type
[ZertzState] -> [(ZertzState, [ZertzState])]
and than you can map
(\(start, succs) -> if null succs then Left start else Right succs)
over the result, plus various other things.
As Fred Brooks said (paraphrasing), once you get the types right, the code practically writes itself.
Don't abuse monads notation for list, it's so heavy for nothing. Moreover you can use list comprehension in the same fashion :
do x <- [1..3]
y <- [2..5] <=> [ x + y | x <- [1..3], y <- [2..5] ]
return x + y
now for the 'simplification'
listOfHex :: [(Coord -> Coord,Coord -> Coord)]
listOfHex = [ (eHex, wHex), (wHex, eHex), (swHex, neHex)
, (neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states =
[if null ws then ws else children ws | ws <- states]
where -- I named it foo because I don t know what it do....
foo True 1 = ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
foo True (-1) = ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
foo False _ = []
foo _ _ = error "Bleh"
children ws#(ZertzState s1 s2 b p) =
[ foo (valid c hex) p | (c, _) <- occupiedCoords ws, hex <- listOfHex ]
where valid c (start, end) =
(hexOccupied b $ start c) && (hexOpen b $ end c)
The let in the let in list commprehension at the top bother me a little, but as I don't have all the code, I don't really know how to do it in an other way. If you can modify more in depth, I suggest you to use more combinators (map, foldr, foldl' etc) as they really reduce code size in my experience.
Note, the code is not tested, and may not compile.

Resources