Related
(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.
Function, which finds in the list of integers one of the longest ordered increments of subscripts (not necessarily consecutive) numbers. Example:
• Sequence [21,27,15,14,18,16,14,17,22,13] = [14,16,17,22]
I have a problem with the function which takes the initial number from the array, and looks for a sequence:
fstLen:: Int -> [Int] -> [Int]
fstLen a [] = a: []
fstLen x (l:ls) = if x < l then x:(fstLen l ls) else fstLen x ls
I have problems in place, 14,18,16,14,17,22,13
14 < 18 but then 18 > 16 and my algorithm takes the number 16 as the basis and is looking for a new sequence and I need to go back to 14
How can I do it?
(sorry for my english)
You could always just use subsequences from Data.List to get all the possible subsequences in a list. When you get these subsequences, just take the sorted ones with this function and filter:
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
Then get the maximum length subsequence with maximumBy(or another method), with the ordering being comparinglength.
Here is what the code could look like:
import Data.Ord (comparing)
import Data.List (subsequences, maximumBy, nub)
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
max_sequence :: (Ord a) => [a] -> [a]
max_sequence xs = maximumBy (comparing length) $ map nub $ filter isSorted (subsequences xs)
Which seems to work correctly:
*Main> max_sequence [21,27,15,14,18,16,14,17,22,13]
[14,16,17,22]
Note: used map nub to remove duplicate elements from the sub sequences. If this is not used, then this will return [14,14,17,22] as the maximum sub sequence, which may be fine if you allow this.
A more efficient n log n solution can be done by maintaining a map where
keys are the first element of an increasing sequence.
values are a tuple: (length of the sequence, the actual sequence)
and the map maintains the invariance that for each possible size of an increasing sequence, only the lexicographically largest one is retained.
Extra traceShow bellow to demonstrate how the map changes while folding from the end of the list:
import Debug.Trace (traceShow)
import Data.Map (empty, elems, insert, delete, lookupGT, lookupLT)
-- longest (strictly) increasing sequence
lis :: (Ord k, Show k, Foldable t) => t k -> [k]
lis = snd . maximum . elems . foldr go empty
where
go x m = traceShow m $ case x `lookupLT` m of
Nothing -> m'
Just (k, v) -> if fst a < fst v then m' else k `delete` m'
where
a = case x `lookupGT` m of
Nothing -> (1, [x])
Just (_, (i, r)) -> (i + 1, x:r)
m' = insert x a m
then:
\> lis [21,27,15,14,18,16,14,17,22,13]
fromList []
fromList [(13,(1,[13]))]
fromList [(22,(1,[22]))]
fromList [(17,(2,[17,22])),(22,(1,[22]))]
fromList [(14,(3,[14,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(14,(4,[14,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(27,(1,[27]))]
[15,16,17,22]
It is not necessary to retain the lists within the map. One can reconstruct the longest increasing sequence only using the keys and the length of the sequences (i.e. only the first element of the tuples).
Excellent question! Looking forward to a variety of answers.
Still improving my answer. The answer below folds to build increasing subsequences from the right. It also uses the the list monad to prepend new elements to subsequences if the new element is smaller than the head of the subsequence. (This is my first real application of the list monad.) For example,
λ> [[3], [1]] >>= (prepIfSmaller 2)
[[2,3],[3],[1]]
This solution is about as short as I can make it.
import Data.List (maximumBy)
maxSubsequence :: Ord a => [a] -> [a]
maxSubsequence [] = []
maxSubsequence xs = takeLongest $ go [] xs
where
takeLongest :: Ord a => [[a]] -> [a]
takeLongest = maximumBy (\ x y -> compare (length x) (length y))
go :: Ord a => [[a]] -> [a] -> [[a]]
go = foldr (\x subs -> [x] : (subs >>= (prepIfSmaller x)))
where prepIfSmaller x s#(h:_) = (if x < h then [x:s] else []) ++ [s]
Quick test.
λ> maxSubsequence [21,27,15,14,18,16,14,17,22,13]
[15,16,17,22]
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]
Need to create a list of tuples from a tuple with a static element and a list. Such as:
(Int, [String]) -> [(Int, String)]
Feel like this should be a simple map call but am having trouble actually getting it to output a tuple as zip would need a list input, not a constant.
I think this is the most direct and easy to understand solution (you already seem to be acquainted with map anyway):
f :: (Int, [String]) -> [(Int, String)]
f (i, xs) = map (\x -> (i, x)) xs
(which also happens to be the desugared version of [(i, x) | x < xs], which Landei proposed)
then
Prelude> f (3, ["a", "b", "c"])
[(3,"a"),(3,"b"),(3,"c")]
This solution uses pattern matching to "unpack" the tuple argument, so that the first tuple element is i and the second element is xs. It then does a simple map over the elements of xs to convert each element x to the tuple (i, x), which I think is what you're after. Without pattern matching it would be slightly more verbose:
f pair = let i = fst pair -- get the FIRST element
xs = snd pair -- get the SECOND element
in map (\x -> (i, x)) xs
Furthermore:
The algorithm is no way specific to (Int, [String]), so you can safely generalize the function by replacing Int and String with type parameters a and b:
f :: (a, [b]) -> [(a, b)]
f (i, xs) = map (\x -> (i, x)) xs
this way you can do
Prelude> f (True, [1.2, 2.3, 3.4])
[(True,1.2),(True,2.3),(True,3.4)]
and of course if you simply get rid of the type annotation altogether, the type (a, [b]) -> [(a, b)] is exactly the type that Haskell infers (only with different names):
Prelude> let f (i, xs) = map (\x -> (i, x)) xs
Prelude> :t f
f :: (t, [t1]) -> [(t, t1)]
Bonus: you can also shorten \x -> (i, x) to just (i,) using the TupleSections language extension:
{-# LANGUAGE TupleSections #-}
f :: (a, [b]) -> [(a, b)]
f (i, xs) = map (i,) xs
Also, as Ørjan Johansen has pointed out, the function sequence does indeed generalize this even further, but the mechanisms thereof are a bit beyond the scope.
For completeness, consider also cycle,
f i = zip (cycle [i])
Using foldl,
f i = foldl (\a v -> (i,v) : a ) []
Using a recursive function that illustrates how to divide the problem,
f :: Int -> [a] -> [(Int,a)]
f _ [] = []
f i (x:xs) = (i,x) : f i xs
A list comprehension would be quite intuitive and readable:
f (i,xs) = [(i,x) | x <- xs]
Do you want the Int to always be the same, just feed zip with an infinite list. You can use repeat for that.
f i xs = zip (repeat i) xs
If you have a list such as this in Haskell:
data TestType = A | B | C deriving (Ord, Eq, Show)
List1 :: [TestType]
List1 = [A,B,C,B,C,A,B,C,C,C]
Is it possible to write a function to determin which element is represented the least in a list (so in this case 'A')
My initial thought was to write a helper function such as this but now I am not sure if this is the right approach:
appears :: TestType -> [TestType] -> Int
appears _ [] = 0
appears x (y:ys) | x==y = 1 + (appears x ys)
| otherwise = appears x ys
I am still fairly new to Haskell, so apologies for the potentially silly question.
Many thanks
Slightly alternative version to Matt's approach
import Data.List
import Data.Ord
leastFrequent :: Ord a => [a] -> a
leastFrequent = head . minimumBy (comparing length) . group . sort
You can build a map counting how often each item occurs in the list
import qualified Data.Map as Map
frequencies list = Map.fromListWith (+) $ zip list (repeat 1)
Then you can find the least/most represented using minimumBy or maximumBy from Data.List on the list of Map.assocs of the frequency map, or even sort it by frequency using sortBy.
module Frequencies where
import Data.Ord
import Data.List
import qualified Data.Map as Map
frequencyMap :: Ord a => [a] -> Map.Map a Int
frequencyMap list = Map.fromListWith (+) $ zip list (repeat 1)
-- Caution: leastFrequent will cause an error if called on an empty list!
leastFrequent :: Ord a => [a] -> a
leastFrequent = fst . minimumBy (comparing snd) . Map.assocs . frequencyMap
ascendingFrequencies :: Ord a => [a] -> [(a,Int)]
ascendingFrequencies = sortBy (comparing snd) . Map.assocs . frequencyMap
Here's another way to do it:
sort the list
group the list
find the length of each group
return the group with the shortest length
Example:
import GHC.Exts
import Data.List
fewest :: (Eq a) => [a] -> a
fewest xs = fst $ head sortedGroups
where
sortedGroups = sortWith snd $ zip (map head groups) (map length groups)
groups = group $ sort xs
A less elegant idea would be:
At first sort and group the list
then pairing the cases with their number of representations
at last sort them relative to their num of representations
In code this looks like
import Data.List
sortByRepr :: (Ord a) => [a] ->[(a,Int)]
sortByRepr xx = sortBy compareSnd $ map numOfRepres $ group $ sort xx
where compareSnd x y = compare (snd x) (snd y)
numOfRepres x = (head x, length x)
the least you get by applying head to the resulting list.