Related
You must use recursion to define rmax2 and you must do so from “scratch”. That is, other than the cons operator, head, tail, and comparisons, you should not use any functions from the Haskell library.
I created a function that removes all instances of the largest item, using list comprehension. How do I remove the last instance of the largest number using recursion?
ved :: Ord a => [a] -> [a]
ved [] =[]
ved as = [ a | a <- as, m /= a ]
where m= maximum as
An easy way to split the problem into two easier subproblems consists in:
get the position index of the rightmost maximum value
write a general purpose function del that eliminates the element of a list at a given position. This does not require an Ord constraint.
If we were permitted to use regular library functions, ved could be written like this:
ved0 :: Ord a => [a] -> [a]
ved0 [] = []
ved0 (x:xs) =
let
(maxVal,maxPos) = maximum (zip (x:xs) [0..])
del k ys = let (ys0,ys1) = splitAt k ys in (ys0 ++ tail ys1)
in
del maxPos (x:xs)
where the pairs produced by zip are lexicographically ordered, thus ensuring the rightmost maximum gets picked.
We need to replace the library functions by manual recursion.
Regarding step 1, that is finding the position of the rightmost maximum, as is commonly done, we can use a recursive stepping function and a wrapper above it.
The recursive step function takes as arguments the whole context of the computation, that is:
current candidate for maximum value, mxv
current rightmost position of maximum value, mxp
current depth into the original list, d
rest of original list, xs
and it returns a pair: (currentMaxValue, currentMaxPos)
-- recursive stepping function:
findMax :: Ord a => a -> Int -> Int -> [a] -> (a, Int)
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (x:xs) = if (x >= mxv) then (findMax x d (d+1) xs)
else (findMax mxv mxp (d+1) xs)
-- top wrapper:
lastMaxPos :: Ord a => [a] -> Int
lastMaxPos [] = (-1)
lastMaxPos (x:xs) = snd (findMax x 0 1 xs)
Step 2, eliminating the list element at position k, can be handled in very similar fashion:
-- recursive stepping function:
del1 :: Int -> Int -> [a] -> [a]
del1 k d [] = []
del1 k d (x:xs) = if (d==k) then xs else x : del1 k (d+1) xs
-- top wrapper:
del :: Int -> [a] -> [a]
del k xs = del1 k 0 xs
Putting it all together:
We are now able to write our final recursion-based version of ved. For simplicity, we inline the content of wrapper functions instead of calling them.
-- ensure we're only using authorized functionality:
{-# LANGUAGE NoImplicitPrelude #-}
import Prelude (Ord, Eq, (==), (>=), (+), ($), head, tail,
IO, putStrLn, show, (++)) -- for testing only
ved :: Ord a => [a] -> [a]
ved [] = []
ved (x:xs) =
let
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (y:ys) = if (y >= mxv) then (findMax y d (d+1) ys)
else (findMax mxv mxp (d+1) ys)
(maxVal,maxPos) = findMax x 0 1 xs
del1 k d (y:ys) = if (d==k) then ys else y : del1 k (d+1) ys
del1 k d [] = []
in
del1 maxPos 0 (x:xs)
main :: IO ()
main = do
let xs = [1,2,3,7,3,2,1,7,3,5,7,5,4,3]
res = ved xs
putStrLn $ "input=" ++ (show xs) ++ "\n" ++ " res=" ++ (show res)
If you are strictly required to use recursion, you can use 2 helper functions: One to reverse the list and the second to remove the first largest while reversing the reversed list.
This result in a list where the last occurrence of the largest element is removed.
We also use a boolean flag to make sure we don't remove more than one element.
This is ugly code and I really don't like it. A way to make things cleaner would be to move the reversal of the list to a helper function outside of the current function so that there is only one helper function to the main function. Another way is to use the built-in reverse function and use recursion only for the removal.
removeLastLargest :: Ord a => [a] -> [a]
removeLastLargest xs = go (maximum xs) [] xs where
go n xs [] = go' n True [] xs
go n xs (y:ys) = go n (y:xs) ys
go' n f xs [] = xs
go' n f xs (y:ys)
| f && y == n = go' n False xs ys
| otherwise = go' n f (y:xs) ys
Borrowing the implementation of dropWhileEnd from Hackage, we can implement a helper function splitWhileEnd:
splitWhileEnd :: (a -> Bool) -> [a] -> ([a], [a])
splitWhileEnd p = foldr (\x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)) ([],[])
splitWhileEnd splits a list according to a predictor from the end. For example:
ghci> xs = [1,2,3,4,3,2,4,3,2]
ghci> splitWhileEnd (< maximum xs) xs
([1,2,3,4,3,2,4],[3,2])
With this helper function, you can write ven as:
ven :: Ord a => [a] -> [a]
ven xs =
let (x, y) = splitWhileEnd (< maximum xs) xs
in init x ++ y
ghci> ven xs
[1,2,3,4,3,2,3,2]
For your case, you can refactor splitWhileEnd as:
fun p = \x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)
splitWhileEnd' p [] = ([], [])
splitWhileEnd' p (x : xs) = fun p x (splitWhileEnd' p xs)
ven' xs = let (x, y) = splitWhileEnd' (< maximum xs) xs in init x ++ y
If init and ++ are not allowed, you can implement them manually. It's easy!
BTW, I guess this may be your homework for Haskell course. I think it's ridiculous if your teacher gives the limitations. Who is programming from scratch nowadays?
Anyway, you can always work around this kind of limitations by reimplementing the built-in function manually. Good luck!
I have to split the given list into non-empty sub-lists each of which
is either in strictly ascending order, in strictly descending order, or contains all equal elements. For example, [5,6,7,2,1,1,1] should become [[5,6,7],[2,1],[1,1]].
Here is what I have done so far:
splitSort :: Ord a => [a] -> [[a]]
splitSort ns = foldr k [] ns
where
k a [] = [[a]]
k a ns'#(y:ys) | a <= head y = (a:y):ys
| otherwise = [a]:ns'
I think I am quite close but when I use it it outputs [[5,6,7],[2],[1,1,1]] instead of [[5,6,7],[2,1],[1,1]].
Here is a kinda ugly solution, with three reverse in one line of code :).
addElement :: Ord a => a -> [[a]] -> [[a]]
addElement a [] = [[a]]
addElement a (x:xss) = case x of
(x1:x2:xs)
| any (check a x1 x2) [(==),(<),(>)] -> (a:x1:x2:xs):xss
| otherwise -> [a]:(x:xss)
_ -> (a:x):xss
where
check x1 x2 x3 op = (x1 `op` x2) && (x2 `op` x3)
splitSort xs = reverse $ map reverse $ foldr addElement [] (reverse xs)
You can possibly get rid of all the reversing if you modify addElement a bit.
EDIT:
Here is a less reversing version (even works for infinite lists):
splitSort2 [] = []
splitSort2 [x] = [[x]]
splitSort2 (x:y:xys) = (x:y:map snd here):splitSort2 (map snd later)
where
(here,later) = span ((==c) . uncurry compare) (zip (y:xys) xys)
c = compare x y
EDIT 2:
Finally, here is a solution based on a single decorating/undecorating, that avoids comparing any two values more than once and is probably a lot more efficient.
splitSort xs = go (decorate xs) where
decorate :: Ord a => [a] -> [(Ordering,a)]
decorate xs = zipWith (\x y -> (compare x y,y)) (undefined:xs) xs
go :: [(Ordering,a)] -> [[a]]
go ((_,x):(c,y):xys) = let (here, later) = span ((==c) . fst) xys in
(x : y : map snd here) : go later
go xs = map (return . snd) xs -- Deal with both base cases
Every ordered prefix is already in some order, and you don't care in which, as long as it is the longest:
import Data.List (group, unfoldr)
foo :: Ord t => [t] -> [[t]]
foo = unfoldr f
where
f [] = Nothing
f [x] = Just ([x], [])
f xs = Just $ splitAt (length g + 1) xs
where
(g : _) = group $ zipWith compare xs (tail xs)
length can be fused in to make the splitAt count in unary essentially, and thus not be as strict (unnecessarily, as Jonas Duregård rightly commented):
....
f xs = Just $ foldr c z g xs
where
(g : _) = group $ zipWith compare xs (tail xs)
c _ r (x:xs) = let { (a,b) = r xs } in (x:a, b)
z (x:xs) = ([x], xs)
The initial try turned out to be lengthy probably inefficient but i will keep it striked for the sake of integrity with the comments. You best just skip to the end for the answer.
Nice question... but turns out to be a little hard candy. My approach is in segments, those of each i will explain;
import Data.List (groupBy)
splitSort :: Ord a => [a] -> [[a]]
splitSort (x:xs) = (:) <$> (x :) . head <*> tail $ interim
where
pattern = zipWith compare <$> init <*> tail
tuples = zipWith (,) <$> tail <*> pattern
groups = groupBy (\p c -> snd p == snd c) . tuples $ (x:xs)
interim = groups >>= return . map fst
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
The pattern function (zipWith compare <$> init <*> tail) is of type Ord a => [a] -> [Ordering] when fed with [5,6,7,2,1,1,1] compares the init of it by the tail of it by zipWith. So the result would be [LT,LT,GT,GT,EQ,EQ]. This is the pattern we need.
The tuples function will take the tail of our list and will tuple up it's elements with the corresponding elements from the result of pattern. So we will end up with something like [(6,LT),(7,LT),(2,GT),(1,GT),(1,EQ),(1,EQ)].
The groups function utilizes Data.List.groupBy over the second items of the tuples and generates the required sublists such as [[(6,LT),(7,LT)],[(2,GT),(1,GT)],[(1,EQ),(1,EQ)]]
Interim is where we monadically get rid of the Ordering type values and tuples. The result of interim is [[6,7],[2,1],[1,1]].
Finally at the main function body (:) <$> (x :) . head <*> tail $ interim appends the first item of our list (x) to the sublist at head (it has to be there whatever the case) and gloriously present the solution.
Edit: So investigating the [0,1,0,1] resulting [[0,1],[0],[1]] problem that #Jonas Duregård discovered, we can conclude that in the result there shall be no sub lists with a length of 1 except for the last one when singled out. I mean for an input like [0,1,0,1,0,1,0] the above code produces [[0,1],[0],[1],[0],[1],[0]] while it should [[0,1],[0,1],[0,1],[0]]. So I believe adding a squeeze function at the very last stage should correct the logic.
import Data.List (groupBy)
splitSort :: Ord a => [a] -> [[a]]
splitSort [] = []
splitSort [x] = [[x]]
splitSort (x:xs) = squeeze $ (:) <$> (x :) . head <*> tail $ interim
where
pattern = zipWith compare <$> init <*> tail
tuples = zipWith (,) <$> tail <*> pattern
groups = groupBy (\p c -> snd p == snd c) $ tuples (x:xs)
interim = groups >>= return . map fst
squeeze [] = []
squeeze [y] = [y]
squeeze ([n]:[m]:ys) = [n,m] : squeeze ys
squeeze ([n]:(m1:m2:ms):ys) | compare n m1 == compare m1 m2 = (n:m1:m2:ms) : squeeze ys
| otherwise = [n] : (m1:m2:ms) : squeeze ys
squeeze (y:ys) = y : squeeze s
*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
Yes; as you will also agree the code has turned out to be a little too lengthy and possibly not so efficient.
The Answer: I have to trust the back of my head when it keeps telling me i am not on the right track. Sometimes, like in this case, the problem reduces down to a single if then else instruction, much simpler than i had initially anticipated.
runner :: Ord a => Maybe Ordering -> [a] -> [[a]]
runner _ [] = []
runner _ [p] = [[p]]
runner mo (p:q:rs) = let mo' = Just (compare p q)
(s:ss) = runner mo' (q:rs)
in if mo == mo' || mo == Nothing then (p:s):ss
else [p] : runner Nothing (q:rs)
splitSort :: Ord a => [a] -> [[a]]
splitSort = runner Nothing
My test cases
*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
*Main> splitSort [1,2,3,5,2,0,0,0,-1,-1,0]
[[1,2,3,5],[2,0],[0,0],[-1,-1],[0]]
For this solution I am making the assumption that you want the "longest rally". By that I mean:
splitSort [0, 1, 0, 1] = [[0,1], [0,1]] -- This is OK
splitSort [0, 1, 0, 1] = [[0,1], [0], [1]] -- This is not OK despite of fitting your requirements
Essentially, There are two pieces:
Firstly, split the list in two parts: (a, b). Part a is the longest rally considering the order of the two first elements. Part b is the rest of the list.
Secondly, apply splitSort on b and put all list into one list of list
Taking the longest rally is surprisingly messy but straight. Given the list x:y:xs: by construction x and y will belong to the rally. The elements in xs belonging to the rally depends on whether or not they follow the Ordering of x and y. To check this point, you zip every element with the Ordering is has compared against its previous element and split the list when the Ordering changes. (edge cases are pattern matched) In code:
import Data.List
import Data.Function
-- This function split the list in two (Longest Rally, Rest of the list)
splitSort' :: Ord a => [a] -> ([a], [a])
splitSort' [] = ([], [])
splitSort' (x:[]) = ([x],[])
splitSort' l#(x:y:xs) = case span ( (o ==) . snd) $ zip (y:xs) relativeOrder of
(f, s) -> (x:map fst f, map fst s)
where relativeOrder = zipWith compare (y:xs) l
o = compare y x
-- This applies the previous recursively
splitSort :: Ord a => [a] -> [[a]]
splitSort [] = []
splitSort (x:[]) = [[x]]
splitSort (x:y:[]) = [[x,y]]
splitSort l#(x:y:xs) = fst sl:splitSort (snd sl)
where sl = splitSort' l
I wonder whether this question can be solve using foldr if splits and groups a list from
[5,6,7,2,1,1,1]
to
[[5,6,7],[2,1],[1,1]]
instead of
[[5,6,7],[2],[1,1,1]]
The problem is in each step of foldr, we only know the sorted sub-list on right-hand side and a number to be processed. e.g. after read [1,1] of [5,6,7,2,1,1,1] and next step, we have
1, [[1, 1]]
There are no enough information to determine whether make a new group of 1 or group 1 to [[1,1]]
And therefore, we may construct required sorted sub-lists by reading elements of list from left to right, and why foldl to be used. Here is a solution without optimization of speed.
EDIT:
As the problems that #Jonas Duregård pointed out on comment, some redundant code has been removed, and beware that it is not a efficient solution.
splitSort::Ord a=>[a]->[[a]]
splitSort numList = foldl step [] numList
where step [] n = [[n]]
step sublists n = groupSublist (init sublists) (last sublists) n
groupSublist sublists [n1] n2 = sublists ++ [[n1, n2]]
groupSublist sublists sortedList#(n1:n2:ns) n3
| isEqual n1 n2 = groupIf (isEqual n2 n3) sortedList n3
| isAscen n1 n2 = groupIfNull isAscen sortedList n3
| isDesce n1 n2 = groupIfNull isDesce sortedList n3
| otherwise = mkNewGroup sortedList n3
where groupIfNull check sublist#(n1:n2:ns) n3
| null ns = groupIf (check n2 n3) [n1, n2] n3
| otherwise = groupIf (check (last ns) n3) sublist n3
groupIf isGroup | isGroup = addToGroup
| otherwise = mkNewGroup
addToGroup gp n = sublists ++ [(gp ++ [n])]
mkNewGroup gp n = sublists ++ [gp] ++ [[n]]
isEqual x y = x == y
isAscen x y = x < y
isDesce x y = x > y
My initial thought looks like:
ordruns :: Ord a => [a] -> [[a]]
ordruns = foldr extend []
where
extend a [ ] = [ [a] ]
extend a ( [b] : runs) = [a,b] : runs
extend a (run#(b:c:etc) : runs)
| compare a b == compare b c = (a:run) : runs
| otherwise = [a] : run : runs
This eagerly fills from the right, while maintaining the Ordering in all neighbouring pairs for each sublist. Thus only the first result can end up with a single item in it.
The thought process is this: an Ordering describes the three types of subsequence we're looking for: ascending LT, equal EQ or descending GT. Keeping it the same every time we add on another item means it will match throughout the subsequence. So we know we need to start a new run whenever the Ordering does not match. Furthermore, it's impossible to compare 0 or 1 items, so every run we create contains at least 1 and if there's only 1 we do add the new item.
We could add more rules, such as a preference for filling left or right. A reasonable optimization is to store the ordering for a sequence instead of comparing the leading two items twice per item. And we could also use more expressive types. I also think this version is inefficient (and inapplicable to infinite lists) due to the way it collects from the right; that was mostly so I could use cons (:) to build the lists.
Second thought: I could collect the lists from the left using plain recursion.
ordruns :: Ord a => [a] -> [[a]]
ordruns [] = []
ordruns [a] = [[a]]
ordruns (a1:a2:as) = run:runs
where
runs = ordruns rest
order = compare a1 a2
run = a1:a2:runcontinuation
(runcontinuation, rest) = collectrun a2 order as
collectrun _ _ [] = ([], [])
collectrun last order (a:as)
| order == compare last a =
let (more,rest) = collectrun a order as
in (a:more, rest)
| otherwise = ([], a:as)
More exercises. What if we build the list of comparisons just once, for use in grouping?
import Data.List
ordruns3 [] = []
ordruns3 [a] = [[a]]
ordruns3 xs = unfoldr collectrun marked
where
pairOrder = zipWith compare xs (tail xs)
marked = zip (head pairOrder : pairOrder) xs
collectrun [] = Nothing
collectrun ((o,x):xs) = Just (x:map snd markedgroup, rest)
where (markedgroup, rest) = span ((o==).fst) xs
And then there's the part where there's a groupBy :: (a -> a -> Bool) -> [a] -> [[a]] but no groupOn :: Eq b => (a -> b) -> [a] -> [[a]]. We can use a wrapper type to handle that.
import Data.List
data Grouped t = Grouped Ordering t
instance Eq (Grouped t) where
(Grouped o1 _) == (Grouped o2 _) = o1 == o2
ordruns4 [] = []
ordruns4 [a] = [[a]]
ordruns4 xs = unmarked
where
pairOrder = zipWith compare xs (tail xs)
marked = group $ zipWith Grouped (head pairOrder : pairOrder) xs
unmarked = map (map (\(Grouped _ t) -> t)) marked
Of course, the wrapper type's test can be converted into a function to use groupBy instead:
import Data.List
ordruns5 [] = []
ordruns5 [a] = [[a]]
ordruns5 xs = map (map snd) marked
where
pairOrder = zipWith compare xs (tail xs)
marked = groupBy (\a b -> fst a == fst b) $
zip (head pairOrder : pairOrder) xs
These marking versions arrive at the same decoration concept Jonas Duregård applied.
I'm calculating the sum of a list after applying someFunction to every element of it like so:
sum (map someFunction myList)
someFunction is very resource heavy so to optimise it I want to stop calculating the sum if it goes above a certain threshold.
It seems like I need to use fold but I don't know how to break out if it if the accumulator reaches the threshold. My guess is to somehow compose fold and takeWhile but I'm not exactly sure how.
Another technique is to use a foldM with Either to capture the early termination effect. Left signals early termination.
import Control.Monad(foldM)
sumSome :: (Num n,Ord n) => n -> [n] -> Either n n
sumSome thresh = foldM f 0
where
f a n
| a >= thresh = Left a
| otherwise = Right (a+n)
To ignore the exit status, just compose with either id id.
sumSome' :: (Num n,Ord n) => n -> [n] -> n
sumSome' n = either id id . sumSome n
One of the options would be using scanl function, which returns a list of intermediate calculations of foldl.
Thus, scanl1 (+) (map someFunction myList) will return the intermediate sums of your calculations. And since Haskell is a lazy language it won't calculate all the values of myList until you need it. For example:
take 5 $ scanl1 (+) (map someFunction myList)
will calculate someFunction 5 times and return the list of these 5 results.
After that you can use either takeWhile or dropWhile and stop the calculation, when a certain condition is True. For example:
head $ dropWhile (< 1000) $ scanl1 (+) [1..1000000000]
will stop the calculation, when sum of the numbers reaches 1000 and returns 1035.
This will do what you ask about without building the intermediate list as scanl' would (and scanl would even cause a thunks build-up on top of that):
foldl'Breaking break reduced reducer acc list =
foldr cons (\acc -> acc) list acc
where
cons x r acc | break acc x = reduced acc x
| otherwise = r $! reducer acc x
cf. related wiki page.
Use a bounded addition operator instead of (+) with foldl.
foldl (\b a -> b + if b > someThreshold then 0 else a) 0 (map someFunction myList)
Because Haskell is non-strict, only calls to someFunction that are necessary to evaluate the if-then-else are themselves evaluated. fold still traverses the entire list.
> foldl (\b a -> b + if b > 10 then 0 else a) 0 (map (trace "foo") [1..20])
foo
foo
foo
foo
foo
15
sum [1..5] > 10, and you can see that trace "foo" only executes 5 times, not 20.
Instead of foldl, though, you should use the strict version foldl' from Data.Foldable.
You could try making your own sum function, maybe call it boundedSum that takes
an Integer upper bound
an [Integer] to sum over
a "sum up until this point" value to be compared with the upper bound
and returns the sum of the list.
boundedSum :: Integer -> [Integer] -> Integer -> Integer
boundedSum upperBound (x : xs) prevSum =
let currentSum = prevSum + x
in
if currentSum > upperBound
then upperBound
else boundedSum upperBound xs currentSum
boundedSum upperBound [] prevSum =
prevSum
I think this way you won't "eat up" more of the list if the sum up until the current element exceeds upperBound.
EDIT: The answers to this question suggest better techniques than mine and the question itself looks rather similar to yours.
This is a possible solution:
last . takeWhile (<=100) . scanl (+) 0 . map (^2) $ [1..]
Dissected:
take your starting list ([1..] in the example)
map your expensive function ((^2))
compute partial sums scanl (+) 0
stop after the partial sums become too large (keep those (<=100))
take the last one
If performance matters, also try scanl', which might improve it.
Something like this using until :: (a -> Bool) -> (a -> a) -> a -> a from the Prelude
sumUntil :: Real a => a -> [a] -> a
sumUntil threshold u = result
where
(_, result) = until stopCondition next (u, 0)
next :: Real a => ([a], a) -> ([a], a)
next ((x:xs), y) = (xs, x + y)
stopCondition :: Real a => ([a], a) -> Bool
stopCondition (ls, x) = null ls || x > threshold
Then apply
sumUntil 10 (map someFunction myList)
This post is already a bit older but I'd like to mention a way to generalize the nice code of #trevor-cook above to break fold with the additional possibility to return not only a default value or the accumulator but also the index and element of the list where the breaking condition was satisfied:
import Control.Monad (foldM)
breakFold step initialValue list exitCondition exitFunction =
either id (exitFunction (length list) (last list))
(foldM f initialValue (zip [0..] list))
where f acc (index,x)
| exitCondition index x acc
= Left (exitFunction index x acc)
| otherwise = Right (step index x acc)
It also only requires to import foldM. Examples for the usage are:
mysum thresh list = breakFold (\i x acc -> x + acc) 0 list
(\i x acc -> x + acc > thresh)
(\i x acc -> acc)
myprod thresh list = breakFold (\i x acc -> x * acc) 1 list
(\i x acc -> acc == thresh)
(\i x acc -> (i,x,acc))
returning
*myFile> mysum 42 [1,1..]
42
*myFile> myprod 0 ([1..5]++[0,0..])
(6,0,0)
*myFile> myprod 0 (map (\n->1/n) [1..])
(178,5.58659217877095e-3,0.0)
In this way, one can use the index and the last evaluated list value as input for further functions.
Despite the age of this post, I'll add a possible solution. I like continuations because I find them very useful in terms of flow control.
breakableFoldl
:: (b -> a -> (b -> r) -> (b -> r) -> r)
-> b
-> [a]
-> (b -> r)
-> r
breakableFoldl f b (x : xs) = \ exit ->
f b x exit $ \ acc ->
breakableFoldl f acc xs exit
breakableFoldl _ b _ = ($ b)
breakableFoldr
:: (a -> b -> (b -> r) -> (b -> r) -> r)
-> b
-> [a]
-> (b -> r)
-> r
breakableFoldr f b l = \ exit ->
fix (\ fold acc xs next ->
case xs of
x : xs' -> fold acc xs' (\ acc' -> f x acc' exit next)
_ -> next acc) b l exit
exampleL = breakableFoldl (\ acc x exit next ->
( if acc > 15
then exit
else next . (x +)
) acc
) 0 [1..9] print
exampleR = breakableFoldr (\ x acc exit next ->
( if acc > 15
then exit
else next . (x +)
) acc
) 0 [1..9] print
I want to print list of triples in a line by line manner. The list contains triples that every first element of the triples should be placed in the coordinates given as the second and the third elements of the tirples. The grid starts from (0,0) coordinates.
below is a 2x2 grid example:
generateGrid [('a',0,0),('b',0,2),('c',1,1), ('d',2,2)]
-> a - b
- c -
- - d
I have an approach to generate this function but I couldn't put everything in code.
I tried to find the maximum number in the triples and create the grid by its incremented value. In that way I could start from (0,0) cooradinate. Then, I wanted to go over all the triples and put the first element in the related coordinate.
How can I make this approach?
Below is my code:
gridMax ((p1, p2, p3):xs) = max (maximum(secList ((p1, p2, p3):xs))) (maximum(thirdList ((p1, p2, p3):xs)))
secList [] = []
secList ((p1, p2, p3):xs) = [p2] ++ secList xs
thirdList [] = []
thirdList ((p1, p2, p3):xs) = [p3] ++ thirdList xs
this way I found the max of the grid which means I should create a (max+1)X(max+1) grid starting from (0,0). I couldn't get the rest of the code.
Because of the laziness of Haskell, we can suppose that we have an infinite grid, so we could just set cells on this grid according the coordinates given in arguments one by one, and record the size of the result grid in this process. When we finished, we could just take the result grid from that infinite grid.
Here is an implementation of this idea:
setVal :: Int -> a -> [a] -> [a]
setVal idx val lst = h ++ (val : tail t)
where (h, t) = splitAt idx lst
setCell :: (Char, Int, Int) -> [[Char]] -> [[Char]]
setCell (c, x, y) grid = setVal x xl grid
where xl = setVal y c $ grid !! x
generateGrid :: [(Char, Int, Int)] -> [[Char]]
generateGrid cs = take (mx+1) $ map (take (my+1)) grid
where (mx, my, grid) = foldr step (0, 0, g) cs
g = repeat $ repeat '-'
step co#(c, x, y) (mx, my, g) =
let g' = setCell co g
mx' = max x mx
my' = max y my
in
(mx', my', g')
Could be tested like this:
*Main> let cs = [('a',0,0),('b',0,2),('c',1,1), ('d',2,2)] :: [(Char, Int, Int)]
*Main> putStr $ unlines $ generateGrid cs
a-b
-c-
--d
Just for fun, here is the Haskell One-Liner:
generateGrid :: [((Int, Int), Char)] -> String
generateGrid xs =
unlines $ map (map snd) $ groupBy ((==) `on` fst . fst) $ assocs $ accumArray (const id) '-' ((0,0), (maximum $ map (fst . fst) xs, maximum $ map (snd . fst) xs)) xs
Lets decode what is going on here:
generateGrid :: [((Int, Int), Char)] -> String
generateGrid xs =
unlines .
map (map snd) .
groupBy ((==) `on` fst . fst) .
assocs .
accumArray (const id)
'-'
((0,0), (maximum $ map (fst . fst) xs, maximum $ map (snd . fst) xs))
$ xs
The first thing we do is create an array using accumArray :: (e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e. It takes a 'default' element - here '-' for obvious reasons; a combining function, here const id - which just returns the second element, which will be the elements drawn from the list; a range, starting at (0,0) and ending at the maximum values; and finally, xs the input list, which is a list of keys (Int, Int) associated with values: Char.
The entire point of this is to "fill in" the empty spaces with ((x,y),'-'). accumArray is a very easy way of doing this.
Then we use assocs to get a list back out of the array.
The next function will take the list of associations and group them into sublists - each sublist containing one row.
Now we have a list of rows - we aren't interested in the indices any longer, so map (map snd) gets rid of them. Finally, unlines combines the rows into a single string seperated by newlines.
I want to take a list (or a string) and split it into sub-lists of N elements. How do I do it in Haskell?
Example:
mysteryFunction 2 "abcdefgh"
["ab", "cd", "ef", "gh"]
cabal update
cabal install split
And then use chunksOf from Data.List.Split
Here's one option:
partition :: Int -> [a] -> [[a]]
partition _ [] = []
partition n xs = (take n xs) : (partition n (drop n xs))
And here's a tail recursive version of that function:
partition :: Int -> [a] -> [[a]]
partition n xs = partition' n xs []
where
partition' _ [] acc = reverse acc
partition' n xs acc = partition' n (drop n xs) ((take n xs) : acc)
You could use:
mysteryFunction :: Int -> [a] -> [[a]]
mysteryFunction n list = unfoldr takeList list
where takeList [] = Nothing
takeList l = Just $ splitAt n l
or alternatively:
mysteryFunction :: Int -> [a] -> [[a]]
mysteryFunction n list = unfoldr (\l -> if null l then Nothing else Just $ splitAt n l) list
Note this puts any remaining elements in the last list, for example
mysteryFunction 2 "abcdefg" = ["ab", "cd", "ef", "g"]
import Data.List
import Data.Function
mysteryFunction n = map (map snd) . groupBy ((==) `on` fst) . zip ([0..] >>= replicate n)
... just kidding...
mysteryFunction x "" = []
mysteryFunction x s = take x s : mysteryFunction x (drop x s)
Probably not the elegant solution you had in mind.
There's already
Prelude Data.List> :t either
either :: (a -> c) -> (b -> c) -> Either a b -> c
and
Prelude Data.List> :t maybe
maybe :: b -> (a -> b) -> Maybe a -> b
so there really should be
list :: t -> ([a] -> t) -> [a] -> t
list n _ [] = n
list _ c xs = c xs
as well. With it,
import Data.List (unfoldr)
g n = unfoldr $ list Nothing (Just . splitAt n)
without it,
g n = takeWhile (not.null) . unfoldr (Just . splitAt n)
A fancy answer.
In the answers above you have to use splitAt, which is recursive, too. Let's see how we can build a recursive solution from scratch.
Functor L(X)=1+A*X can map X into a 1 or split it into a pair of A and X, and has List(A) as its minimal fixed point: List(A) can be mapped into 1+A*List(A) and back using a isomorphism; in other words, we have one way to decompose a non-empty list, and only one way to represent a empty list.
Functor F(X)=List(A)+A*X is similar, but the tail of the list is no longer a empty list - "1" - so the functor is able to extract a value A or turn X into a list of As. Then List(A) is its fixed point (but no longer the minimal fixed point), the functor can represent any given list as a List, or as a pair of a element and a list. In effect, any coalgebra can "stop" decomposing the list "at will".
{-# LANGUAGE DeriveFunctor #-}
import Data.Functor.Foldable
data N a x = Z [a] | S a x deriving (Functor)
(which is the same as adding the following trivial instance):
instance Functor (N a) where
fmap f (Z xs) = Z xs
fmap f (S x y) = S x $ f y
Consider the definition of hylomorphism:
hylo :: (f b -> b) -> (c -> f c) -> c -> b
hylo psi phi = psi . fmap (hylo psi phi) . phi
Given a seed value, it uses phi to produce f c, to which fmap applies hylo psi phi recursively, and psi then extracts b from the fmapped structure f b.
A hylomorphism for the pair of (co)algebras for this functor is a splitAt:
splitAt :: Int -> [a] -> ([a],[a])
splitAt n xs = hylo psi phi (n, xs) where
phi (n, []) = Z []
phi (0, xs) = Z xs
phi (n, (x:xs)) = S x (n-1, xs)
This coalgebra extracts a head, as long as there is a head to extract and the counter of extracted elements is not zero. This is because of how the functor was defined: as long as phi produces S x y, hylo will feed y into phi as the next seed; once Z xs is produced, functor no longer applies hylo psi phi to it, and the recursion stops.
At the same time hylo will re-map the structure into a pair of lists:
psi (Z ys) = ([], ys)
psi (S h (t, b)) = (h:t, b)
So now we know how splitAt works. We can extend that to splitList using apomorphism:
splitList :: Int -> [a] -> [[a]]
splitList n xs = apo (hylo psi phi) (n, xs) where
phi (n, []) = Z []
phi (0, xs) = Z xs
phi (n, (x:xs)) = S x (n-1, xs)
psi (Z []) = Cons [] $ Left []
psi (Z ys) = Cons [] $ Right (n, ys)
psi (S h (Cons t b)) = Cons (h:t) b
This time the re-mapping is fitted for use with apomorphism: as long as it is Right, apomorphism will keep using hylo psi phi to produce the next element of the list; if it is Left, it produces the rest of the list in one step (in this case, just finishes off the list with []).