I am trying to split a Array containing I and Os, if a certain pattern occurs.
lets assume i have an input, looking like this:
data Bit = O | I deriving (Eq, Show)
let b = [I,I,O,O,O,O,O,I,I,O,O,O,I,O]
that is what i am generating, when encoding [[Bool]] -> [Bit] corresponding input to my encode function would be let a = [[True, False, False, True],[False, False],[False]]
Now my objective is to decode what ive generated,so i need a function that gets me from b to a.
But i can't come up with a way to split b list into 3 sublists, every time it reads either I,O or I,I. Every Odd letter stands for following member or starting array member. I am basically copying utf unicode encoding.
So i am trying to build a function that would get me from b to a.
After some time i came up with this:
split :: [Bit] -> [[Bit]]
split (x1:x2:xs) = if (x1 == I)
then [x2 : split xs]
else x2 : split xs
And i cant figure out, how to split the list into sublist. Any kind of advice/help/code is greatly appreciated
EDIT:
split :: [Bit] ->[[Bit]]
split [] = []
split xs = case foo xs of (ys,I,x2) -> -- generate new subarray like [...,[x2]]
(ys,O,x2) -> -- append existing subarray with value x2 [.....,[previous values]++x2]
foo :: [a] -> ([a],x1,x2)
foo x1:x2:input = (input,x1,x2)
those 2 comments are the last thing i need to figure out. after that im done :)
if feeding b into function split, i want this ouput: [[I,O,O,I],[O,O],[O]]
final step would be to get from b to [[True, False, False, True],[False, False],[False]]
I would start with if (x1 == 1) ...
If x1 is a Bit that can be either I or O, why are you comparing its equality against a Num, 1?
If I got it right, you need something like:
split [] = []
split xs = case foo xs of (ys,r) -> r : split ys
foo :: [a] -> ([a],r)
foo = undefined
In foo, the list should get partially consumed and returns the rest of the list and the value to collect.
EDIT:
data Bit = O | I deriving (Eq, Show)
sampleA = [[True, False, False, True],[False, False],[False]]
sampleB = [I,I,O,O,O,O,O,I,I,O,O,O,I,O]
type TwoBit = (Bit,Bit)
twobit (x:y:xs) = (x,y) : twobit xs
twobit _ = []
split :: [TwoBit] -> [[Bool]]
split [] = []
split xs = case spli xs of (ys,r) -> r : split ys
where
spli :: [TwoBit] -> ([TwoBit],[Bool])
spli (x:xs) = case span (not . pterm) xs of
(ys,zs) -> (zs, map ptrue $ x:ys)
pterm x = (I,O) == x || (I,I) == x
ptrue x = (O,I) == x || (I,I) == x
splitTB = split . twobit
main = print $ splitTB sampleB == sampleA
PS Functions that look like s -> (s,a) could also be represented as State monad.
Related
Implementing Haskell's take and drop functions using foldl.
Any suggestions on how to implement take and drop functions using foldl ??
take x ls = foldl ???
drop x ls = foldl ???
i've tried these but it's showing errors:
myFunc :: Int -> [a] -> [a]
myFunc n list = foldl func [] list
where
func x y | (length y) > n = x : y
| otherwise = y
ERROR PRODUCED :
*** Expression : foldl func [] list
*** Term : func
*** Type : a -> [a] -> [a]
*** Does not match : [a] -> [a] -> [a]
*** Because : unification would give infinite type
Can't be done.
Left fold necessarily diverges on infinite lists, but take n does not. This is so because left fold is tail recursive, so it must scan through the whole input list before it can start the processing.
With the right fold, it's
ntake :: Int -> [a] -> [a]
ntake 0 _ = []
ntake n xs = foldr g z xs 0
where
g x r i | i>=n = []
| otherwise = x : r (i+1)
z _ = []
ndrop :: Int -> [a] -> [a]
ndrop 0 xs = xs
ndrop n xs = foldr g z xs 0 xs
where
g x r i xs#(_:t) | i>=n = xs
| otherwise = r (i+1) t
z _ _ = []
ndrop implements a paramorphism nicely and faithfully, up to the order of arguments to the reducer function g, giving it access to both the current element x and the current list node xs (such that xs == (x:t)) as well as the recursive result r. A catamorphism's reducer has access only to x and r.
Folds usually encode catamorphisms, but this shows that right fold can be used to code up a paramorphism just as well. It's universal that way. I think it is beautiful.
As for the type error, to fix it just switch the arguments to your func:
func y x | ..... = .......
The accumulator in the left fold comes as the first argument to the reducer function.
If you really want it done with the left fold, and if you're really sure the lists are finite, two options:
ltake n xs = post $ foldl' g (0,id) xs
where
g (i,f) x | i < n = (i+1, f . (x:))
| otherwise = (i,f)
post (_,f) = f []
rltake n xs = foldl' g id xs r n
where
g acc x = acc . f x
f x r i | i > 0 = x : r (i-1)
| otherwise = []
r _ = []
The first counts from the left straight up, potentially stopping assembling the prefix in the middle of the full list traversal that it does carry to the end nevertheless, being a left fold.
The second also traverses the list in full turning it into a right fold which then gets to work counting down from the left again, being able to actually stop working as soon as the prefix is assembled.
Implementing drop this way is bound to be (?) even clunkier. Could be a nice exercise.
I note that you never specified the fold had to be over the supplied list. So, one approach that meets the letter of your question, though probably not the spirit, is:
sillytake :: Int -> [a] -> [a]
sillytake n xs = foldl go (const []) [1..n] xs
where go f _ (x:xs) = x : f xs
go _ _ [] = []
sillydrop :: Int -> [a] -> [a]
sillydrop n xs = foldl go id [1..n] xs
where go f _ (_:xs) = f xs
go _ _ [] = []
These each use left folds, but over the list of numbers [1..n] -- the numbers themselves are ignored, and the list is just used for its length to build a custom take n or drop n function for the given n. This function is then applied to the original supplied list xs.
These versions work fine on infinite lists:
> sillytake 5 $ sillydrop 5 $ [1..]
[6,7,8,9,10]
Will Ness showed a nice way to implement take with foldr. The least repulsive way to implement drop with foldr is this:
drop n0 xs0 = foldr go stop xs0 n0
where
stop _ = []
go x r n
| n <= 0 = x : r 0
| otherwise = r (n - 1)
Take the efficiency loss and rebuild the whole list if you have no choice! Better to drive a nail in with a screwdriver than drive a screw in with a hammer.
Both ways are horrible. But this one helps you understand how folds can be used to structure functions and what their limits are.
Folds just aren't the right tools for implementing drop; a paramorphism is the right tool.
You are not too far. Here are a pair of fixes.
First, note that func is passed the accumulator first (i.e. a list of a, in your case) and then the list element (an a). So, you need to swap the order of the arguments of func.
Then, if we want to mimic take, we need to add x when the length y is less than n, not greater!
So we get
myFunc :: Int -> [a] -> [a]
myFunc n list = foldl func [] list
where
func y x | (length y) < n = x : y
| otherwise = y
Test:
> myFunc 5 [1..10]
[5,4,3,2,1]
As you can see, this is reversing the string. This is because we add x at the front (x:y) instead of at the back (y++[x]). Or, alternatively, one could use reverse (foldl ....) to fix the order at the end.
Also, since foldl always scans the whole input list, myFunc 3 [1..1000000000] will take a lot of time, and myFunc 3 [1..] will fail to terminate. Using foldr would be much better.
drop is more tricky to do. I don't think you can easily do that without some post-processing like myFunc n xs = fst (foldl ...) or making foldl return a function which you immediately call (which is also a kind of post-processing).
I found this question from CS 217.
Divide a list into one or more sublists so that each sublist contains integers in nondecreasing (sorted) order.
[3,5,1,8,9,2,1,0] returns [[3,5],[1,8,9],[2],[1],[0]]
[1,2,3,4,5,6] returns [[1,2,3,4,5,6]]
[5,4,3,2,1] returns [[5],[4],[3],[2],[1]]
below code works:
val Q1 = [ 3, 5, 1, 8, 9, 2, 1, 0 ]
val A1 = foldl (
fn (x, a) =>
if x > hd (hd a) then (x::hd a)::tl a
else [x]::a
) [ [ hd Q1 ] ] (tl Q1)
val A1 = map rev (rev A1)
or like this: use 2 temporary list to collect.
fun split l = let
fun split' tmp subset =
fn [] => []
| [x] => (x::tmp)::subset
| (a::(c as b::_)) =>
if a < b then split' (a::tmp) subset c
else split' [] ((a::tmp)::subset) c
in (rev o map rev) (split' [] [] l) end
So many solutions for this question,
But I still want to know how to code it as a pattern match function?
maybe something like below:
(Not sure if it is possible?)
fun split [] = [[]]
| split [x] = [[x]]
| split [a, b] = if a < b then (* here *) else (* here *)
| split (a::b) = if a < hd b then (* here *) else (* here *)
This question really stuck me.
Under the assumption that this is homework, I hesitate to give a complete answer, but here are a few hints:
1) In the empty basis case I think that you want to return [[]] rather than []. Your specification doesn't address this, but since the empty list is the longest list of nondecreasing integers which can be pulled from the front of the empty list, the return value should be the list consisting of the empty list. This is somewhat similar to the fact that the powerset (set of all subsets) of the empty set is the set containing the empty set rather than the empty set itself. It shouldn't really matter how you define this particular case, since the real basis case is ...
2) In the [x] case you really need to return [[x]] rather than [x] since the type of the function that you are trying to write is int list -> int list list
3) In the remaining case you can write the pattern like
| split (x::y::zs) = (* fill this in *)
then test if x <= y to decide what to do. Since both x <= y and x > y will involve split (y::zs) you could compute this once, giving this a name in a let binding and have the if in the scope of that binding, though that is mostly a matter of taste.
Note how the pattern works in this last case. Explicit use of hd should be fairly rare in function definitions which use pattern-matching (though if you flesh out the last case without using a pattern-matching let binding you will be forced to use it in at least one of the branches of the if).
On Edit: Since this isn't homework, here is a complete implementation:
fun split [] = [[]]
| split [x] = [[x]]
| split (x::y::zs) =
let val first::rest = split (y::zs) in
if x <= y then
(x::first) :: rest
else
[x]::first::rest
end;
I have seen some similar questions, but nothing that really helped me. Basically the title says it all. Using SML I want to take a string that I have, and make a list containing each letter found in the string. Any help would be greatly appreciated.
One possibility is to use the basic logic of quicksort to sort the letters while removing duplicates at the same time. Something like:
fun distinctChars []:char list = []
| distinctChars (c::cs) =
let val smaller = List.filter (fn x => x < c) cs
val bigger = List.filter (fn x => x > c) cs
in distinctChars smaller # [c] # distinctChars bigger
end
If the < and > in the definitions of smaller and bigger were to be replaced by <= and >= then it would simply be an implementation of quicksort (although not the most efficient one since it makes two passes over cs when a suitably defined auxiliary function could split into smaller and bigger in just one pass). The strict inequalities have the effect of throwing away duplicates.
To get what you want from here, do something like explode the string into a list of chars, remove non-alphabetical characters from the resulting list, while simultaneously converting to lower case, then invoke the above function -- ideally first refined so that it uses a custom split function rather than List.filter twice.
On Edit: # is an expensive operator and probably results in the naïve SML quicksort not being all that quick. You can use the above idea of a modified sort, but one that modifies mergesort instead of quicksort:
fun split ls =
let fun split' [] (xs,ys) = (xs,ys)
| split' (a::[]) (xs, ys) = (a::xs,ys)
| split' (a::b::cs) (xs, ys) = split' cs (a::xs, b::ys)
in split' ls ([],[])
end
fun mergeDistinct ([], ys) = ys:char list
| mergeDistinct (xs, []) = xs
| mergeDistinct (x::xs, y::ys) =
if x < y then x::mergeDistinct(xs,y::ys)
else if x > y then y::mergeDistinct(x::xs,ys)
else mergeDistinct(x::xs, ys)
fun distinctChars [] = []
| distinctChars [c] = [c]
| distinctChars chars =
let val (xs,ys) = split chars
in mergeDistinct (distinctChars xs, distinctChars ys)
end
You can get a list of all the letters in a few different ways:
val letters = [#"a",#"b",#"c",#"d",#"e",#"f",#"g",#"h",#"i",#"j",#"k",#"l",#"m",#"n",#"o",#"p",#"q",#"r",#"s",#"t",#"u",#"v",#"w",#"x",#"y",#"z"]
val letters = explode "abcdefghijklmnopqrstuvwxyz"
val letters = List.tabulate (26, fn i => chr (i + ord #"a"))
Update: Looking at your question and John's answer, I might have misunderstood your intention. An efficient way to iterate over a string and gather some result (e.g. a set of characters) could be to write a "foldr for strings":
fun string_foldr f acc0 s =
let val len = size s
fun loop i acc = if i < len then loop (i+1) (f (String.sub (s, i), acc)) else acc
in loop 0 acc0 end
Given an implementation of sets with at least setEmpty and setInsert, one could then write:
val setLetters = string_foldr (fn (c, ls) => setInsert ls c) setEmpty "some sentence"
The simplest solution I can think of:
To get the distinct elements of a list:
Take the head
Remove that value from the tail and get the distinct elements of the result.
Put 1 and 2 together.
In code:
(* Return the distinct elements of a list *)
fun distinct [] = []
| distinct (x::xs) = x :: distinct (List.filter (fn c => x <> c) xs);
(* All the distinct letters, in lower case. *)
fun letters s = distinct (List.map Char.toLower (List.filter Char.isAlpha (explode s)));
(* Variation: "point-free" style *)
val letters' = distinct o (List.map Char.toLower) o (List.filter Char.isAlpha) o explode;
This is probably not the most efficient solution, but it's uncomplicated.
What would be the syntax (if possible at all) for returning the list of lists ([[a]]) but without the use of empty list ([]:[a])?
(similar as the second commented guard (2) below, which is incorrect)
This is a function that works correctly:
-- Split string on every (shouldSplit == true)
splitWith :: (Char -> Bool) -> [Char] -> [[Char]]
splitWith shouldSplit list = filter (not.null) -- would like to get rid of filter
(imp' shouldSplit list)
where
imp' _ [] = [[]]
imp' shouldSplit (x:xs)
| shouldSplit x = []:imp' shouldSplit xs -- (1) this line is adding empty lists
-- | shouldSplit x = [imp' shouldSplit xs] -- (2) if this would be correct, no filter needed
| otherwise = let (z:zs) = imp' shouldSplit xs in (x:z):zs
This is the correct result
Prelude> splitWith (== 'a') "miraaaakojajeja234"
["mir","koj","jej","234"]
However, it must use "filter" to clean up its result, so I would like to get rid of function "filter".
This is the result without the use of filter:
["mir","","","","koj","jej","234"]
If "| shouldSplit x = imp' shouldSplit xs" is used instead the first guard, the result is incorrect:
["mirkojjej234"]
The first guard (1) adds empty list so (I assume) compiler can treat the result as a list of lists ([[a]]).
(I'm not interested in another/different solutions of the function, just the syntax clarification.)
.
.
.
ANSWER:
Answer from Dave4420 led me to the answer, but it was a comment, not an answer so I can't accept it as answer. The solution of the problem was that I'm asking the wrong question. It is not the problem of syntax, but of my algorithm.
There are several answers with another/different solutions that solve the empty list problem, but they are not the answer to my question. However, they expanded my view of ways on how things can be done with basic Haskell syntax, and I thank them for it.
Edit:
splitWith :: (Char -> Bool) -> String -> [String]
splitWith p = go False
where
go _ [] = [[]]
go lastEmpty (x:xs)
| p x = if lastEmpty then go True xs else []:go True xs
| otherwise = let (z:zs) = go False xs in (x:z):zs
This one utilizes pattern matching to complete the task of not producing empty interleaving lists in a single traversal:
splitWith :: Eq a => (a -> Bool) -> [a] -> [[a]]
splitWith f list = case splitWith' f list of
[]:result -> result
result -> result
where
splitWith' _ [] = []
splitWith' f (a:[]) = if f a then [] else [[a]]
splitWith' f (a:b:tail) =
let next = splitWith' f (b : tail)
in if f a
then if a == b
then next
else [] : next
else case next of
[] -> [[a]]
nextHead:nextTail -> (a : nextHead) : nextTail
Running it:
main = do
print $ splitWith (== 'a') "miraaaakojajeja234"
print $ splitWith (== 'a') "mirrraaaakkkojjjajeja234"
print $ splitWith (== 'a') "aaabbbaaa"
Produces:
["mir","koj","jej","234"]
["mirrr","kkkojjj","jej","234"]
["bbb"]
The problem is quite naturally expressed as a fold over the list you're splitting. You need to keep track of two pieces of state - the result list, and the current word that is being built up to append to the result list.
I'd probably write a naive version something like this:
splitWith p xs = word:result
where
(result, word) = foldr func ([], []) xs
func x (result, word) = if p x
then (word:result,[])
else (result, x:word)
Note that this also leaves in the empty lists, because it appends the current word to the result whenever it detects a new element that satisfies the predicate p.
To fix that, just replace the list cons operator (:) with a new operator
(~:) :: [a] -> [[a]] -> [[a]]
that only conses one list to another if the original list is non-empty. The rest of the algorithm is unchanged.
splitWith p xs = word ~: result
where
(result, word) = foldr func ([], []) xs
func x (result, word) = if p x
then (word ~: result, [])
else (result, x:word)
x ~: xs = if null x then xs else x:xs
which does what you want.
I guess I had a similar idea to Chris, I think, even if not as elegant:
splitWith shouldSplit list = imp' list [] []
where
imp' [] accum result = result ++ if null accum then [] else [accum]
imp' (x:xs) accum result
| shouldSplit x =
imp' xs [] (result ++ if null accum
then []
else [accum])
| otherwise = imp' xs (accum ++ [x]) result
This is basically just an alternating application of dropWhile and break, isn't it:
splitWith p xs = g xs
where
g xs = let (a,b) = break p (dropWhile p xs)
in if null a then [] else a : g b
You say you aren't interested in other solutions than yours, but other readers might be. It sure is short and seems clear. As you learn, using basic Prelude functions becomes second nature. :)
As to your code, a little bit reworked in non-essential ways (using short suggestive function names, like p for "predicate" and g for a main worker function), it is
splitWith :: (Char -> Bool) -> [Char] -> [[Char]]
splitWith p list = filter (not.null) (g list)
where
g [] = [[]]
g (x:xs)
| p x = [] : g xs
| otherwise = let (z:zs) = g xs
in (x:z):zs
Also, there's no need to pass the predicate as an argument to the worker (as was also mentioned in the comments). Now it is arguably a bit more readable.
Next, with a minimal change it becomes
splitWith :: (Char -> Bool) -> [Char] -> [[Char]]
splitWith p list = case g list of ([]:r)-> r; x->x
where
g [] = [[]]
g (x:xs)
| p x = case z of []-> r; -- start a new word IF not already
_ -> []:r
| otherwise = (x:z):zs
where -- now z,zs are accessible
r#(z:zs) = g xs -- in both cases
which works as you wanted. The top-level case is removing at most one empty word here, which serves as a separator marker at some point during the inner function's work. Your filter (not.null) is essentially fused into the worker function g here, with the conditional opening1 of a new word (i.e. addition1 of an empty list).
Replacing your let with where allowed for the variables (z etc.) to became accessible in both branches of the second clause of the g definition.
In the end, your algorithm was close enough, and the code could be fixed after all.
1 when thinking "right-to-left". In reality the list is constructed left-to-right, in guarded recursion ⁄ tail recursion modulo cons fashion.
I want to replace an element in a list with a new value only at first time occurrence.
I wrote the code below but using it, all the matched elements will change.
replaceX :: [Int] -> Int -> Int -> [Int]
replaceX items old new = map check items where
check item | item == old = new
| otherwise = item
How can I modify the code so that the changing only happen at first matched item?
Thanks for helping!
The point is that map and f (check in your example) only communicate regarding how to transform individual elements. They don't communicate about how far down the list to transform elements: map always carries on all the way to the end.
map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs
Let's write a new version of map --- I'll call it mapOnce because I can't think of a better name.
mapOnce :: (a -> Maybe a) -> [a] -> [a]
There are two things to note about this type signature:
Because we may stop applying f part-way down the list, the input list and the output list must have the same type. (With map, because the entire list will always be mapped, the type can change.)
The type of f hasn't changed to a -> a, but to a -> Maybe a.
Nothing will mean "leave this element unchanged, continue down the list"
Just y will mean "change this element, and leave the remaining elements unaltered"
So:
mapOnce _ [] = []
mapOnce f (x:xs) = case f x of
Nothing -> x : mapOnce f xs
Just y -> y : xs
Your example is now:
replaceX :: [Int] -> Int -> Int -> [Int]
replaceX items old new = mapOnce check items where
check item | item == old = Just new
| otherwise = Nothing
You can easily write this as a recursive iteration like so:
rep :: Eq a => [a] -> a -> a -> [a]
rep items old new = rep' items
where rep' (x:xs) | x == old = new : xs
| otherwise = x : rep' xs
rep' [] = []
A direct implementation would be
rep :: Eq a => a -> a -> [a] -> [a]
rep _ _ [] = []
rep a b (x:xs) = if x == a then b:xs else x:rep a b xs
I like list as last argument to do something like
myRep = rep 3 5 . rep 7 8 . rep 9 1
An alternative using the Lens library.
>import Control.Lens
>import Control.Applicative
>_find :: (a -> Bool) -> Simple Traversal [a] a
>_find _ _ [] = pure []
>_find pred f (a:as) = if pred a
> then (: as) <$> f a
> else (a:) <$> (_find pred f as)
This function takes a (a -> Bool) which is a function that should return True on an type 'a' that you wan to modify.
If the first number greater then 5 needs to be doubled then we could write:
>over (_find (>5)) (*2) [4, 5, 3, 2, 20, 0, 8]
[4,5,3,2,40,0,8]
The great thing about lens is that you can combine them together by composing them (.). So if we want to zero the first number <100 in the 2th sub list we could:
>over ((element 1).(_find (<100))) (const 0) [[1,2,99],[101,456,50,80,4],[1,2,3,4]]
[[1,2,99],[101,456,0,80,4],[1,2,3,4]]
To be blunt, I don't like most of the answers so far. dave4420 presents some nice insights on map that I second, but I also don't like his solution.
Why don't I like those answers? Because you should be learning to solve problems like these by breaking them down into smaller problems that can be solved by simpler functions, preferably library functions. In this case, the library is Data.List, and the function is break:
break, applied to a predicate p and a list xs, returns a tuple where first element is longest prefix (possibly empty) of xs of elements that do not satisfy p and second element is the remainder of the list.
Armed with that, we can attack the problem like this:
Split the list into two pieces: all the elements before the first occurence of old, and the rest.
The "rest" list will either be empty, or its first element will be the first occurrence of old. Both of these cases are easy to handle.
So we have this solution:
import Data.List (break)
replaceX :: Eq a => a -> a -> [a] -> [a]
replaceX old new xs = beforeOld ++ replaceFirst oldAndRest
where (beforeOld, oldAndRest) = break (==old) xs
replaceFirst [] = []
replaceFirst (_:rest) = new:rest
Example:
*Main> replaceX 5 7 ([1..7] ++ [1..7])
[1,2,3,4,7,6,7,1,2,3,4,5,6,7]
So my advice to you:
Learn how to import libraries.
Study library documentation and learn standard functions. Data.List is a great place to start.
Try to use those library functions as much as you can.
As a self study exercise, you can pick some of the standard functions from Data.List and write your own versions of them.
When you run into a problem that can't be solved with a combination of library functions, try to invent your own generic function that would be useful.
EDIT: I just realized that break is actually a Prelude function, and doesn't need to be imported. Still, Data.List is one of the best libraries to study.
Maybe not the fastest solution, but easy to understand:
rep xs x y =
let (left, (_ : right)) = break (== x) xs
in left ++ [y] ++ right
[Edit]
As Dave commented, this will fail if x is not in the list. A safe version would be:
rep xs x y =
let (left, right) = break (== x) xs
in left ++ [y] ++ drop 1 right
[Edit]
Arrgh!!!
rep xs x y = left ++ r right where
(left, right) = break (== x) xs
r (_:rs) = y:rs
r [] = []
replaceValue :: Int -> Int -> [Int] -> [Int]
replaceValue a b (x:xs)
|(a == x) = [b] ++ xs
|otherwise = [x] ++ replaceValue a b xs
Here's an imperative way to do it, using State Monad:
import Control.Monad.State
replaceOnce :: Eq a => a -> a -> [a] -> [a]
replaceOnce old new items = flip evalState False $ do
forM items $ \item -> do
replacedBefore <- get
if item == old && not replacedBefore
then do
put True
return new
else
return old