Printing 2D Grid From List of Triples - haskell

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.

Related

Split a list into non-empty sub-lists in Haskell

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.

Haskell Split String at every character into list of n size string [duplicate]

For example, I need a function:
gather :: Int -> [a] -> [[a]]
gather n list = ???
where gather 3 "Hello!" == ["Hel","ell","llo","ol!"].
I have a working implementation:
gather :: Int-> [a] -> [[a]]
gather n list =
unfoldr
(\x ->
if fst x + n > length (snd x) then
Nothing
else
Just
(take
n
(drop
(fst x)
(snd x)),
(fst x + 1, snd x)))
(0, list)
but I am wondering if there is something already built into the language for this? I scanned Data.List but didn't see anything.
You could use tails:
gather n l = filter ((== n) . length) $ map (take n) $ tails l
or using takeWhile instead of filter:
gather n l = takeWhile ((== n) . length) $ map (take n) $ tails l
EDIT: You can remove the filter step by dropping the last n elements of the list returned from tails as suggested in the comments:
gather n = map (take n) . dropLast n . tails
where dropLast n xs = zipWith const xs (drop n xs)
The dropping of tails can be arranged for automagically, thanks to the properties of zipping,
import Data.List (tails)
g :: Int -> [a] -> [[a]]
g n = foldr (zipWith (:)) (repeat []) . take n . tails
or else a simple transpose . take n . tails would suffice. Testing:
Prelude Data.List> g 3 [1..10]
[[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7],[6,7,8],[7,8,9],[8,9,10]]
Prelude Data.List> transpose . take 3 . tails $ [1..10]
[[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7],[6,7,8],[7,8,9],[8,9,10],[9,10],[10]]
(edit 2018-09-16:) The use of zipping can be expressed on a higher level, with traverse ZipList:
g :: Int -> [a] -> [[a]]
g n = getZipList . traverse ZipList . take n . tails

Haskell, print modified list values with map

I have written the following code, which should take a list of values and print only the values > average, modifying them as val - avg.
For example printModVal [9,0,6] should print 4 1, one element per line, using System.IO print function.
import Data.List
import System.IO
printModVal :: [Float] -> IO ()
printModVal xs = ???
where
average = (foldr (+) 0 xs) / genericLength xs
--use map here and print the values > average as value-average
modVal :: Float -> Float -> Float
modVal x y = x - y
mapVal :: (a->b) -> [a] -> [b]
mapVal f [] = []
mapVal f (x:xs) = f x : mapVal f xs
I would like to know how, at this point, how can I use mapVal (with modVal as mapping function) inside the function printModVal, in order to print the values > 0 (once modified by the mapping function).
Thank you.
You have to apply a filter.
Either to the resulting list
printModVal xs = mapM_ print $ filter (> 0) (mapVal (\x -> modVal x average) xs)
where
average = (foldr (+) 0 xs) / genericLength xs
or to the incoming list
printModVal xs = mapM_ print $ mapVal (\x -> modVal x average) (filter (> average) xs)
where
average = (foldr (+) 0 xs) / genericLength xs
map does never change the length of the list it processes.
Any function with the signature (a->b)->[a]->[b] is very limited in what it can do due to parametricity.

Nondeterminism for infinite inputs

Using lists to model nondeterminism is problematic if the inputs can take infinitely many values. For example
pairs = [ (a,b) | a <- [0..], b <- [0..] ]
This will return [(0,1),(0,2),(0,3),...] and never get around to showing you any pair whose first element is not 0.
Using the Cantor pairing function to collapse a list of lists into a single list can get around this problem. For example, we can define a bind-like operator that orders its outputs more intelligently by
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor (map f as)
cantor :: [[a]] -> [a]
cantor xs = go 1 xs
where
go _ [] = []
go n xs = hs ++ go (n+1) ts
where
ys = filter (not.null) xs
hs = take n $ map head ys
ts = mapN n tail ys
mapN :: Int -> (a -> a) -> [a] -> [a]
mapN _ _ [] = []
mapN n f xs#(h:t)
| n <= 0 = xs
| otherwise = f h : mapN (n-1) f t
If we now wrap this up as a monad, we can enumerate all possible pairs
newtype Select a = Select { runSelect :: [a] }
instance Monad Select where
return a = Select [a]
Select as >>= f = Select $ as >>>= (runSelect . f)
pairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a,b)
This results in
>> take 15 pairs
[(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4),(1,3),(2,2),(3,1),(4,0)]
which is a much more desirable result. However, if we were to ask for triples instead, the ordering on the outputs isn't as "nice" and it's not even clear to me that all outputs are eventually included --
>> take 15 triples
[(0,0,0),(0,0,1),(1,0,0),(0,1,0),(1,0,1),(2,0,0),(0,0,2),(1,1,0),(2,0,1),(3,0,0),(0,1,1),(1,0,2),(2,1,0),(3,0,1),(4,0,0)]
Note that (2,0,1) appears before (0,1,1) in the ordering -- my intuition says that a good solution to this problem will order the outputs according to some notion of "size", which could be an explicit input to the algorithm, or could be given implicitly (as in this example, where the "size" of an input is its position in the input lists). When combining inputs, the "size" of a combination should be some function (probably the sum) of the size of the inputs.
Is there an elegant solution to this problem that I am missing?
TL;DR: It flattens two dimensions at a time, rather than flattening three at once. You can't tidy this up in the monad because >>= is binary, not ternary etc.
I'll assume you defined
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor $ map f as
to interleave the list of lists.
You like that because it goes diagonally:
sums = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a+b)
gives
ghci> take 36 sums
[0,1,1,2,2,2,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7]
so it's pleasingly keeping the "sizes" in order, but the pattern appears to be broken for triples, and you doubt completeness, but you needn't. It's doing the same trick, but twice, rather than for all three at once:
triplePairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
c <- Select [0..]
return $ (a,(b,c))
The second pair is treated as a single source of data, so notice that:
ghci> map fst $ take 36 pairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
ghci> map fst $ take 36 triplePairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
and (adding some spaces/newlines for clarity of pattern):
ghci> map snd $ take 36 pairs
[0, 1,0, 2,1,0, 3,2,1,0, 4,3,2,1,0, 5,4,3,2,1,0, 6,5,4,3,2,1,0, 7,6,5,4,3,2,1,0]
ghci> map snd $ take 36 triplePairs
[(0,0), (0,1),(0,0), (1,0),(0,1),(0,0), (0,2),(1,0),(0,1),(0,0),
(1,1),(0,2),(1,0),(0,1),(0,0),
(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(1,2),(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0)]
so you can see it's using exactly the same pattern. This doesn't preserve total sums and it oughtn't because we're getting to three dimensions by flattening two dimensions first before flattening the third in. The pattern is obscured, but it's just as guaranteed to make it to the end of the list.
Sadly if you want to do three dimensions in a sum-preserving way, you'll have to write cantor2, cantor3 and cantor4 functions, possibly a cantorN function, but you'll have to ditch the monadic interface, which is inherently based on the bracketing of >>=, hence two-at-a-time flattening of dimensions.
import Control.Applicative
import Control.Arrow
data Select a = Select [a]
| Selects [Select a]
instance Functor Select where
fmap f (Select x) = Select $ map f x
fmap f (Selects xss) = Selects $ map (fmap f) xss
instance Applicative Select where
pure = Select . (:[])
Select fs <*> xs = Selects $ map (`fmap`xs) fs
Selects fs <*> xs = Selects $ map (<*>xs) fs
instance Monad Select where
return = pure
Select xs >>= f = Selects $ map f xs
Selects xs >>= f = Selects $ map (>>=f) xs
runSelect :: Select a -> [a]
runSelect = go 1
where go n xs = uncurry (++) . second (go $ n+1) $ splitOff n xs
splitOff n (Select xs) = second Select $ splitAt n xs
splitOff n (Selects sls) = (concat hs, Selects $ tsl ++ rl)
where ((hs, tsl), rl) = first (unzip . map (splitOff n)) $ splitAt n sls
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; return (a,b) }
[(0,0),(0,1),(1,0),(1,1),(0,2),(1,2),(2,0),(2,1),(2,2),(0,3),(1,3),(2,3),(3,0),(3,1),(3,2)]
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; c<‌-Select [0..]; return (a,b,c) }
[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1),(0,0,2),(0,1,2),(0,2,0),(0,2,1),(0,2,2),(1,0,2),(1,1,2)]
Note that this is still not quite Cantor-tuples ((0,1,1) shouldn't come before (1,0,0)), but getting it correct would be possible as well in a similar manner.
A correct multidimentional enumerator could be represented with a temporary state object
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
class Space a b where
slice :: a -> ([b], a)
instance Space [a] a where
slice (l:ls) = ([l], ls)
slice [] = ([], [])
instance (Space sp x) => Space ([sp], [sp]) x where
slice (fs, b:bs) = let
ss = map slice (b : fs)
yield = concat $ map fst ss
in (yield, (map snd ss, bs))
Here an N dimensional space is represented by a tuple of lists of N-1 dimensional subspaces that have and haven't been touched by the enumeration.
You can then use the following to produce a well ordered list
enumerate :: (Space sp x) => sp -> [x]
enumerate sp = let (sl, sp') = slice sp
in sl ++ enumerate sp'
Example in Ideone.
The omega package does exactly what you want and guarantees that every element will be eventually visited:
import Control.Applicative
import Control.Monad.Omega
main = print . take 200 . runOmega $
(,,) <$> each [0..] <*> each [0..] <*> each [0..]
Another option would be to use LogicT. It gives more flexibility (if you need) and has operations such as (>>-) that ensure that every combination is eventually encountered.
import Control.Applicative
import Control.Monad
import Control.Monad.Logic
-- | Convert a list into any MonadPlus.
each :: (MonadPlus m) => [a] -> m a
each = msum . map return
-- | A fair variant of '(<*>)` that ensures that both branches are explored.
(<#>) :: (MonadLogic m) => m (a -> b) -> m a -> m b
(<#>) f k = f >>- (\f' -> k >>- (\k' -> return $ f' k'))
infixl 4 <#>
main = print . observeMany 200 $
(,,) <$> each [0..] <#> each [0..] <#> each [0..]

Haskell from List of Pairs to Pair of Lists

I want to create a simple (involving sets and lists) function that can do the following, and i'm not sure where to start.
split:: [(a,b)] -> ([a],[b])
Let's take it step by step. The two cases for the function are:
split [] = ???
split ((a,b):ps) = ???
One case is easy enough.
split [] = ([], [])
For the other one, we have to use the function recursively, someway
split ((a,b):ps) = ???? where
(as, bs) = split ps
I think it's easy to see that the solution is
split ((a,b):ps) = (a:as, b:bs) where
(as, bs) = split ps
In addition to Guido's solution, there is more than one way to do it in haskell.
Please take a look at fst and snd, which takes the first / second element out of a pair, respectively.
GHCi> :t fst
fst :: (a, b) -> a
GHCi> :t snd
snd :: (a, b) -> b
You should be familiar with map if you are playing with functional programming languages, which takes a function and a list, applies the function on every element of that list, and gives you all the results in another list:
GHCi> :t map
map :: (a -> b) -> [a] -> [b]
Given a list of pairs, you want two lists, one contains all first elements in order, and the other contains all second elements:
GHCi> let split xs = (map fst xs, map snd xs)
GHCi> split [(1,2),(3,4),(5,6)]
([1,3,5],[2,4,6])
GHCi>
One step further, as #jozefg has pointed out in the comment, that this method is not efficient as #Guido 's one, but we can make some changes to improve it (which is exactly what #Guido 's solution):
Now it's time to take a look at how map is implemented here
map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs
so we can try to change our split a little:
we still need the base case, (i.e. what if xs is empty):
split [] = ([], [])
split ls = (map fst ls, map snd ls) -- attention!
and we break the list into head and tail, just like map:
split (x:xs) = (fst x: map fst xs, snd x: map snd xs)
Now we can do a pattern matching, (a,b) = x, so we don't have to call two individual functions to break a pair into two:
split (x:xs) = (a: map fst xs, b: map snd xs)
where (a,b) = x
Compare the code here with the line I commented "attention!", have you realized that if we know the result of (map fst xs, map snd xs), we can simply reuse that result to speed up. Luckily, we already have split ls = (map fst ls, map snd ls)!
Using this fact, we finally come up with this version:
split [] = ([], [])
split (x:xs) = (a:as , b:bs)
where (a,b) = x
(as,bs) = split xs
So there are essentially the same! (but as you can see, the last version we have is more efficient.)

Resources