Define concat function for Digits - haskell

I have a list chars and I would like to concat all characters, which are digits and which are next to each other
For example: ['1','5','+','2','4'] => ["15","+","24"]
concat1 :: [Char] -> [Char] -> [String]
concat1 [] [] = []
concat1 [a] [b]
| (isDigit a) && (isDigit b) = [a] ++ [b]
I tried to write this code, but it doesn't seem to be right approach and debugger tells me this:
Couldn't match type `Char' with `[Char]'
Expected type: [String]
Actual type: [Char]
* In the expression: [a] ++ [b]
In an equation for `concat1':
concat1 [a] [b] | (isDigit a) && (isDigit b) = [a] ++ [b]

The type of concat1 is wrong: your example indicates you want one input list and an output list. The input list (ex: ['1','5','+','2','4']) is of type [Char] and the output (ex: ["15","+","24"]) of type [String]. That gives the signature
concat1 :: [Char] -> [String]
For the implementation, you probably want to use span, which finds the prefix satisfying a certain predicate function and also returns the remaining elements.
concat1 [] = []
concat1 (e : es)
| isDigit e = let (d, es') = span isDigit (e : es) in d : concat1 es'
| otherwise = [ e ] : concat1 es
Then, trying it out at GHCi:
ghci> concat1 ['1','5','+','2','4']
["15","+","24"]

An idea might be to construct a more generic function: a groupWith :: Eq b => (a -> b) -> [a] -> [(b,[a])] function like the one that is defined in Python's itertools:
groupWith :: Eq b => (a -> b) -> [a] -> [(b,[a])]
groupWith f = steps . map ((,) =<< f)
where steps [] = []
steps ((b,a):xs) = (b,(a : map snd ys)) : steps zs
where (ys,zs) = span ((b == ) . fst) xs
Given a function f :: a -> b and a list xs, it will construct groups [(b,[a])] such that every group represents the longest possible sequence of xs where f x is the same. So for groupWith isDigit "15+24", we get:
*Main Data.Char> groupWith isDigit ['1','5','+','2','4']
[(True,"15"),(False,"+"),(True,"24")]
Now we can simply obtain the second element snd of every tuple, so:
*Main Data.Char> map snd $ groupWith isDigit ['1','5','+','2','4']
["15","+","24"]
We can easily reuse this piece of code if we for instance wish to discriminate based on more conditions.

You can use groupBy in order to group together adjacent elements in a list over some equivalence function. You can use is like this:
import Data.List (groupBy)
import Data.Function (on)
import Data.Char (isDigit)
groupDigits :: String -> [String]
groupDigits = groupBy ((&&) `on` isDigit)
Prelude Data.List Data.Function Data.Char> groupDigits ['1','5','+','2','4']
["15","+","24"]

I guess as #4castle mentioned groupBy is the ideal tool for this job however my approach would be slightly different.
import Data.List (groupBy)
import Data.Function (on)
groupDigits :: String -> [String]
groupDigits = groupBy ((==) `on` ((&&) <$> (>'/') <*> (<':')))
*Main> groupDigits ['1','5','+','2','4']
["15","+","24"]
*Main> groupDigits ['1','5','+','+','2','4']
["15","++","24"]
The difference is instead of using (&&) operator i use an XNOR (which is simply (==) in Haskell).
And also my implementation of isDigit :: Char -> Bool is a little different than it is in Data.Char.

Related

Given a list, how can I perform some transformation only on sub-lists whose each two elements satisfy a binary predicate?

(In my actual use case I have a list of type [SomeType], SomeType having a finite number of constructors, all nullary; in the following I'll use String instead of [SomeType] and use only 4 Chars, to simplify a bit.)
I have a list like this "aaassddddfaaaffddsssadddssdffsdf" where each element can be one of 'a', 's', 'd', 'f', and I want to do some further processing on each contiguous sequence of non-as, let's say turning them upper case and reversing the sequence, thus obtaining "aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD". (I've added the reversing requirement to make it clear that the processing involves all the contiguous non 'a'-s at the same time.)
To turn each sub-String upper case, I can use this:
func :: String -> String
func = reverse . map Data.Char.toUpper
But how do I run that func only on the sub-Strings of non-'a's?
My first thought is that Data.List.groupBy can be useful, and the overall solution could be:
concat $ map (\x -> if head x == 'a' then x else func x)
$ Data.List.groupBy ((==) `on` (== 'a')) "aaassddddfaaaffddsssadddssdffsdf"
This solution, however, does not convince me, as I'm using == 'a' both when grouping (which to me seems good and unavoidable) and when deciding whether I should turn a group upper case.
I'm looking for advices on how I can accomplish this small task in the best way.
You could classify the list elements by the predicate before grouping. Note that I’ve reversed the sense of the predicate to indicate which elements are subject to the transformation, rather than which elements are preserved.
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Arrow ((&&&))
import Data.Function (on)
import Data.Monoid (First(..))
mapSegmentsWhere
:: forall a. (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
mapSegmentsWhere p f
= concatMap (applyMatching . sequenceA) -- [a]
. groupBy ((==) `on` fst) -- [[(First Bool, a)]]
. map (First . Just . p &&& id) -- [(First Bool, a)]
where
applyMatching :: (First Bool, [a]) -> [a]
applyMatching (First (Just matching), xs)
= applyIf matching f xs
applyIf :: forall a. Bool -> (a -> a) -> a -> a
applyIf condition f
| condition = f
| otherwise = id
Example use:
> mapSegmentsWhere (/= 'a') (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Here I use the First monoid with sequenceA to merge the lists of adjacent matching elements from [(Bool, a)] to (Bool, [a]), but you could just as well use something like map (fst . head &&& map snd). You can also skip the ScopedTypeVariables if you don’t want to write the type signatures; I just included them for clarity.
If we need to remember the difference between the 'a's and the rest, let's put them in different branches of an Either. In fact, let's define a newtype now that we are at it:
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Bifoldable
import Data.Char
import Data.List
newtype Bunched a b = Bunched [Either a b] deriving (Functor, Foldable)
instance Bifunctor Bunched where
bimap f g (Bunched b) = Bunched (fmap (bimap f g) b)
instance Bifoldable Bunched where
bifoldMap f g (Bunched b) = mconcat (fmap (bifoldMap f g) b)
fmap will let us work over the non-separators. fold will return the concatenation of the non-separators, bifold will return the concatenation of everything. Of course, we could have defined separate functions unrelated to Foldable and Bifoldable, but why avoid already existing abstractions?
To split the list, we can use an unfoldr that alternately searches for as and non-as with the span function:
splitty :: Char -> String -> Bunched String String
splitty c str = Bunched $ unfoldr step (True, str)
where
step (_, []) = Nothing
step (True, span (== c) -> (as, ys)) = Just (Left as, (False, ys))
step (False, span (/= c) -> (xs, ys)) = Just (Right xs, (True, ys))
Putting it to work:
ghci> bifold . fmap func . splitty 'a' $ "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Note: Bunched is actually the same as Tannen [] Either from the bifunctors package, if you don't mind the extra dependency.
There are other answers here, but I think they get too excited about iteration abstractions. A manual recursion, alternately taking things that match the predicate and things that don't, makes this problem exquisitely simple:
onRuns :: Monoid m => (a -> Bool) -> ([a] -> m) -> ([a] -> m) -> [a] -> m
onRuns p = go p (not . p) where
go _ _ _ _ [] = mempty
go p p' f f' xs = case span p xs of
(ts, rest) -> f ts `mappend` go p' p f' f rest
Try it out in ghci:
Data.Char> onRuns ('a'==) id (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Here is a simple solution - function process below - that only requires that you define two functions isSpecial and func. Given a constructor from your type SomeType, isSpecial determines whether it is one of those constructors that form a special sublist or not. The function func is the one you included in your question; it defines what should happen with the special sublists.
The code below is for character lists. Just change isSpecial and func to make it work for your lists of constructors.
isSpecial c = c /= 'a'
func = reverse . map toUpper
turn = map (\x -> ([x], isSpecial x))
amalgamate [] = []
amalgamate [x] = [x]
amalgamate ((xs, xflag) : (ys, yflag) : rest)
| xflag /= yflag = (xs, xflag) : amalgamate ((ys, yflag) : rest)
| otherwise = amalgamate ((xs++ys, xflag) : rest)
work = map (\(xs, flag) -> if flag then func xs else xs)
process = concat . work . amalgamate . turn
Let's try it on your example:
*Main> process "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
Applying one function at a time, shows the intermediate steps taken:
*Main> turn "aaassddddfaaaffddsssadddssdffsdf"
[("a",False),("a",False),("a",False),("s",True),("s",True),("d",True),
("d",True),("d",True),("d",True),("f",True),("a",False),("a",False),
("a",False),("f",True),("f",True),("d",True),("d",True),("s",True),
("s",True),("s",True),("a",False),("d",True),("d",True),("d",True),
("s",True),("s",True),("d",True),("f",True),("f",True),("s",True),
("d",True),("f",True)]
*Main> amalgamate it
[("aaa",False),("ssddddf",True),("aaa",False),("ffddsss",True),
("a",False),("dddssdffsdf",True)]
*Main> work it
["aaa","FDDDDSS","aaa","SSSDDFF","a","FDSFFDSSDDD"]
*Main> concat it
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
We can just do what you describe, step by step, getting a clear simple minimal code which we can easily read and understand later on:
foo :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
foo p f xs = [ a
| g <- groupBy ((==) `on` fst)
[(p x, x) | x <- xs] -- [ (True, 'a'), ... ]
, let (t:_, as) = unzip g -- ( [True, ...], "aaa" )
, a <- if t then as else (f as) ] -- final concat
-- unzip :: [(b, a)] -> ([b], [a])
We break the list into same-p spans and unpack each group with the help of unzip. Trying it out:
> foo (=='a') reverse "aaabcdeaa"
"aaaedcbaa"
So no, using == 'a' is avoidable and hence not especially good, introducing an unnecessary constraint on your data type when all we need is equality on Booleans.

how to show only the repeated element?

Im new to Haskell.
How to show only the repeated elements ?
Given as input: bbbool, expected output: bo
I found a way to do this from internet:
import qualified Data.Set as Set
dup :: Ord a => [a] -> Maybe a
dup xs = dup' xs Set.empty
where dup' [] _ = Nothing
dup' (x:xs) s = if Set.member x s
then Just x
else dup' xs (Set.insert x s)
dupString :: (Ord a, Show a) => [a] -> [Char]
dupString x = case dup x of
Just x -> "First duplicate: " ++ (show x)
Nothing -> "No duplicates"
But the problem is, it will only show the first repeated element.
for example : bbbool = b
I hope that my question is clear.
A simple way to do this would be, assuming you only look for adjacent repeated elements:
import Data.List (group)
findRepeating :: Eq a => [a] -> [a]
findRepeating = map head . filter ((> 1) . length) . group
You may want to sequence it with nub to deal with repeated elements, since for "bbbXaaaXbbb" it returns "bab".
Edit: if you meant all repeating elements, this should do:
import qualified Data.Map as M
findRepeating :: (Foldable k, Ord a) => t a -> [a]
findRepeating = M.keys . M.filter (> 1) . foldr (\x acc -> M.insertWith (+) x 1 acc) M.empty
This approach counts how many times each element shows up and then returns those that happened to appear more than once. The order in which they are returned is undefined.

Removing duplicate elements in a Seq

wondering how to implement nub over a Seq a
I get that one could do:
nubSeq :: Seq a -> Seq a
nubSeq = fromList . nub . toList
Just wondering is there something standard that does not convert to Lists in order to call nub :: [a]->[a]?
An implementation that occurred to me, based obviously on nub, is:
nubSeq :: (Eq a) => Seq a -> Seq a
nubSeq = Data.Sequence.foldrWithIndex
(\_ x a -> case x `Data.Sequence.elemIndexR` a of
Just _ -> a
Nothing -> a |> x) Data.Sequence.empty
But there must be something more elegant?
thanks.
Not sure whether this qualifies as more elegant but it splits the concerns in independent functions (caveat: you need an Ord constraint on a):
seqToNubMap takes a Seq and outputs a Map associating to each a the smallest index at which it appeared in the sequence
mapToList takes a Map of values and positions and produces a list of values in increasing order according to the specified positions
nubSeq combines these to generate a sequence without duplicates
The whole thing should be O(n*log(n)), I believe:
module NubSeq where
import Data.Map as Map
import Data.List as List
import Data.Sequence as Seq
import Data.Function
seqToNubMap :: Ord a => Seq a -> Map a Int
seqToNubMap = foldlWithIndex (\ m k v -> insertWith min v k m) Map.empty
mapToList :: Ord a => Map a Int -> [a]
mapToList = fmap fst . List.sortBy (compare `on` snd) . Map.toList
nubSeq :: Ord a => Seq a -> Seq a
nubSeq = Seq.fromList . mapToList . seqToNubMap
Or a simpler alternative following #DavidFletcher's comment:
nubSeq' :: forall a. Ord a => Seq a -> Seq a
nubSeq' xs = Fold.foldr cons nil xs Set.empty where
cons :: a -> (Set a -> Seq a) -> (Set a -> Seq a)
cons x xs seen
| x `elem` seen = xs seen
| otherwise = x <| xs (Set.insert x seen)
nil :: Set a -> Seq a
nil _ = Seq.empty
Another way with an Ord constraint - use a scan to make the sets of
elements that appear in each prefix of the list. Then we can filter out
any element that's already been seen.
import Data.Sequence as Seq
import Data.Set as Set
nubSeq :: Ord a => Seq a -> Seq a
nubSeq xs = (fmap fst . Seq.filter (uncurry notElem)) (Seq.zip xs seens)
where
seens = Seq.scanl (flip Set.insert) Set.empty xs
Or roughly the same thing as a mapAccumL:
nubSeq' :: Ord a => Seq a -> Seq a
nubSeq' = fmap fst . Seq.filter snd . snd . mapAccumL f Set.empty
where
f s x = (Set.insert x s, (x, x `notElem` s))
(If I was using lists I would use Maybes instead of the pairs with
Bool, then use catMaybes instead of filtering. There doesn't seem to be catMaybes
for Sequence though.)
I think your code should be pretty efficient. Since Sequences are tree data structures using another tree type data structure like Map or HashMap to store and lookup the previous items doesn't make too much sense to me.
Instead i take the first item and check it's existence in the rest. If exists i drop that item and proceed the same with the rest recursively. If not then construct a new sequence with first element is the unique element and the rest is the result of nubSeq fed by the rest. Should be typical. I use ViewPatterns.
{-# LANGUAGE ViewPatterns #-}
import Data.Sequence as Seq
nubSeq :: Eq a => Seq a -> Seq a
nubSeq (viewl -> EmptyL) = empty
nubSeq (viewl -> (x :< xs)) | elemIndexL x xs == Nothing = x <| nubSeq xs
| otherwise = nubSeq xs
*Main> nubSeq . fromList $ [1,2,3,4,4,2,3,6,7,1,2,3,4]
fromList [6,7,1,2,3,4]

Haskell: change all indices from a list to some value

If I am given a list of objects and another list for some indices from this list, is there an easy way to change every object in this list with an index from the list of indices to a different value?
E.g. I am hoping there exists some function f such that
f 0 [4,2,5] [6,5,8,4,3,6,2,7]
would output
[6,5,0,4,0,0,2,7]
Here is a beautiful version that uses lens:
import Control.Lens
f :: a -> [Int] -> [a] -> [a]
f x is = elements (`elem` is) .~ x
Here is an efficient version that doesn't have any dependencies other than base. Basically, we start by sorting (and removing duplicates from the) indices list. That way, we don't need to scan the whole list for every replacement.
import Data.List
f :: a -> [Int] -> [a] -> [a]
f x is xs = snd $ mapAccumR go is' (zip xs [1..])
where
is' = map head . group . sort $ is
go [] (y,_) = ([],y)
go (i:is) (y,j) = if i == j then (is,x) else (i:is,y)
You can define a helper function to replace a single value and then use it to fold over your list.
replaceAll :: a -> [Int] -> [a] -> [a]
replaceAll repVal indices values = foldl (replaceValue repVal) values indices
where replaceValue val vals index = (take index vals) ++ [val] ++ (drop (index + 1) vals)
Sort the indices first. Then you can traverse the two lists in tandem.
{-# LANGUAGE ScopedTypeVariables #-}
import Prelude (Eq, Enum, Num, Ord, snd, (==), (<$>))
import Data.List (head, group, sort, zip)
f :: forall a. (Eq a, Enum a, Num a, Ord a) => a -> [a] -> [a] -> [a]
f replacement indices values =
go (head <$> group (sort indices)) (zip [0..] values)
where
go :: [a] -> [(a, a)] -> [a]
go [] vs = snd <$> vs
go _ [] = []
go (i:is) ((i', v):vs) | i == i' = replacement : go is vs
go is (v:vs) = snd v : go is vs
The sorting incurs an extra log factor on the length of the index list, but the rest is linear.

List included in another list in haskell

I want to see if a list is included in another list and extract that list from a list of lists, for example i want to see if ["bc","abc"] is included in [["a","b","c","a","b","c","de"],["a","bc","abc","de"],["a","bc","abc","d","e"],....] and i want to make a list of the lists that contian that particular list like [["a","bc","abc","de"],["a","bc","abc","d","e"]] .
for [["aabbcc","aacc"]] I want to match only something like this ["cc","aabbcc","aacc"] or ["c","c","aabbcc","aacc"] but not [["ccaabbcc","aacc"]].
Can someone help me?
From what I understand you want something that cares for the order of the elements in the list
If you DO care the order of elements:
import Data.List (subsequences)
included :: Eq a => [a] -> [[a]] -> [[a]]
included ls nest = filter (\x -> any (ls==) $ subsequences x) nest
TEST:
*Main> included [1,2,3,4] [[1,3,4,5,2],[1,2,4,5],[1,2,3,4,5]]
[[1,2,3,4,5]]
If you do NOT care the order of elements:
import Data.List (subsequences, permutations, concat)
included :: Eq a => [a] -> [[a]] -> [[a]]
included ls nest = filter func nest
where
func x = any (ls==) $ concat $ map subsequences $ permutations x
TEST:
*Main> included [1,2,3,4] [[1,3,4,5,2],[1,2,4,5],[1,2,3,4,5]]
[[1,3,4,5,2],[1,2,3,4,5]]
Assuming that the answer to my question in the comments is no,
import Data.List
g :: (Eq a) => [a] -> [[a]] -> [[a]]
g a xs = [x | x <- xs,
or [and . map (uncurry (==)) $ zip a y | y <- init $ tails x]]
Testing:
Prelude Data.List> g ["bc","abc"] [["a","bc","a","abc","de"],["a","bc","abc","de
"],["a","bc","abc","d","e"]]
[["a","bc","abc","de"],["a","bc","abc","d","e"]]
Assuming that the answer to Will's question in the comments is “no”:
import Data.List (isInfixOf)
foo :: Eq a => [a] -> [[a]] -> [[a]]
foo needle haystack = filter (needle `isInfixOf`) haystack
(Untested.)

Resources