Formatting strings into triangles in Haskell - haskell

I have a list of lists of strings and I need to format them into a triangle using periods such that each list is on its own line, and the strings of each list are separated by at least one period. Additionally, each character must have dots above and below. This is probably best explained by example:
> dots [["test"], ["hello", "world"], ["some", "random", "words"], ["even", "more", "random", "words"]]
should return
............test.....................
.......hello.......world.............
...some......random......words.......
not....really......random.....anymore
Finally, it should use the least amount of periods possible, i.e. the approach of padding out every word to the length of the maximum word is too wasteful; that is the above example should not return
.....................test........................
..............hello.........world................
.......some..........random........words.........
not...........really........random........anymore
I can easily write the a function that does the put the periods either side to make it into a triangle shape, my problem is with the periods in between words.
I have a function that works as long as the word length is 1, which is obviously pretty useless for the task. Nevertheless, my function dots:
dots :: [[String]] -> [[String]]
dots xss = map dots' xss
where dots' (x:[]) = [x]
dots' (x:xs) = [x] ++ ["."] ++ dots' xs
This is a homework exercise, so hints would be preferred, but I've been trying to do this for hours with no luck.

First you need a function, that adds placeholders to a list like this:
addPlaceholders [ ["test"]
, ["hello", "world"]
, ["some", "random", "words"]
, ["not", "really", "random", "anymore"]
]
==> [ ["" , "" , "" , "test" , "" , "" , "" ]
, ["" , "" , "hello" , "" , "world" , "" , "" ]
, ["" , "some", "" , "random", "" , "words", "" ]
, ["not", "" , "really", "" , "random", "" , "anymore"]
]
Now you need to fill these "" with dots. So you can write an auxiliary function, that adds dots to a list:
addDots ["test", "", "random", ""]
==> ["test..","......","random","......"]
and then fill is simply
fill = transpose . map addDots . transpose
And your function is just
triangle = map concat . fill . addPlaceholders

First, some terminology: for a given row, e.g. ["some", "more", "random", "words"], we will call a given word's index in the row its "logical column". Thus "more" has logical column 1 in that row; and "words" has logical column 3. Once we have chosen a position for each word, we will also have a "physical column" that says how many characters (dots or other word characters) should appear before it when rendering the row.
Let's make a simplifying assumption (the problem is hard enough even simplified): in the final layout, a word at row r, logical column c must be in between the words at row r+1, logical columns c and c+1.
One idea for tackling this problem is to add a third kind of column, let's call it a "checkerboard column", as an intermediate step. Rows an even number of steps from the bottom will have all their words in even checkerboard columns, and rows an odd number of steps from the bottom will have all their words in odd checkerboard columns. One can then choose a width for each checkerboard column, and set the physical column of a word to be the sum of the widths of the checkerboard columns smaller than it.
However, this has a slight problem; consider this checkerboard, where I've explicitly marked out the checkerboard column boundaries:
| | |aa| | |
| | b| |c| |
|d| |e | |f|
g| |hh| |i| |j
Because we have chosen a width for each checkerboard column, words in different checkerboard columns can never overlap. This rules out solutions like the following one, which are slightly narrower:
aa
b c
d e f
g hh i j
Note that aa and hh overlap -- though they are not on adjacent rows, so this is okay.
Another solution is to lay out the words in this order:
4
3 7
2 6 9
1 5 8 10
When laying out a given word, we can then simply choose the smallest physical column for it that doesn't violate the rules by looking at the position and length of the words above/left and below/left of it (which will already have been calculated). I have an implementation of this algorithm, which I will add to this answer in a few days (per the site guidelines about homework), but this hint should be enough for you to reproduce something very like it yourself. The interesting algorithmic bit of my implementation is a ten-line function of type Map (Row, LogicalColumn) String -> Map (Row, PhysicalColumn) String, and I recommend you make an attempt at a similarly typed function. It should be possible to do this with a clever traversal of the input lists directly (hence eliminating any map indexing costs), but I couldn't quite wrap my head around it. We can prove by induction (where the variable we are inducting on is the order we lay out words) that this approach produces the solution with minimal width.
As promised, the code I came up with:
import Control.Applicative
import Data.List
import Data.Map hiding (empty, map)
import Data.Ord
type Row = Int
type PhysicalColumn = Int
type LogicalColumn = Int
layout :: Map (Row, LogicalColumn) [a] -> Map (Row, PhysicalColumn) [a]
layout m = munge answer where
answer = mapWithKey positionFor m
positionFor (r, c) as = maximumBy (comparing snd) . concat $
[ [(as, 0)]
, addLength as <$> lookup (r+1, c ) answer
, addLength as <$> lookup (r-1, c-1) answer
]
addLength as (v, p) = (as, p + length v)
lookup k m = maybe empty pure (Data.Map.lookup k m)
munge = fromAscList . map (\((r, _), (w, c)) -> ((r, c), w)) . toAscList
parse :: String -> Map (Row, LogicalColumn) String
parse = fromList
. enumerate
. map words
. lines
enumerate :: [[a]] -> [((Row, LogicalColumn), a)]
enumerate xss = concat . zipWith (\i xs -> [((i, j), x) | (j, x) <- xs]) [0..] . map (zip [0..]) $ xss
groups :: Eq b => (a -> (b, c)) -> [a] -> [(b, [c])]
groups f
= map (\pairs -> (fst . head $ pairs, map snd pairs))
. groupBy ((==) `on` fst)
. map f
flatten :: Map (Int, Int) [a] -> [(Int, [(Int, [a])])]
flatten
= map (\(r, pairs) -> (r, map (concat <$>) (groups id pairs)))
. groups (\((r, c), a) -> (r, (c, a)))
. toAscList
pad :: a -> [(Int, [a])] -> [a]
pad blank = go 0 where
go n ((target, v):rest) = replicate (target-n) blank ++ v ++ go (target+length v) rest
go _ [] = []
pprint = unlines . map (pad ' ' . snd) . flatten
allTogetherNow = putStr . pprint . layout . parse

I would approach the problem as follows.
First, neglect the length of each word. Think of a n by m chessboard, and place each word in a square so that words end up only in black squares. Now, the number of rows n is the number of lists of words you have. Figure out what m should be.
You may wish to "center" the allocation in each row, so to obtain a triangle in the end.
Then, consider word length. How wide (in characters) should each of the m column be? For each column, compute its width. Fill each square with dots so to reach the intended width.
I make no claim this is the simpler approach -- it's just the first one that came up to me :)

Related

Haskell - Exclude lists based on a test in a nested list comprehension

I want to create a series of possible equations based on a general specification:
test = ["12", "34=", "56=", "78"]
Each string (e.g. "12") represents a possible character at that location, in this case '1' or '2'.)
So possible equations from test would be "13=7" or "1=68".
I know the examples I give are not balanced but that's because I'm deliberately giving a simplified short string.
(I also know that I could use 'sequence' to search all possibilities but I want to be more intelligent so I need a different approach explained below.)
What I want is to try fixing each of the equals in turn and then removing all other equals in the equation. So I want:
[["12","=","56","78"],["12","34","=","78”]]
I've written this nested list comprehension:
(it needs: {-# LANGUAGE ParallelListComp #-} )
fixEquals :: [String] -> [[String]]
fixEquals re
= [
[
if index == outerIndex then equals else remain
| equals <- map (filter (== '=')) re
| remain <- map (filter (/= '=')) re
| index <- [1..]
]
| outerIndex <- [1..length re]
]
This produces:
[["","34","56","78"],["12","=","56","78"],["12","34","=","78"],["12","34","56","”]]
but I want to filter out any with empty lists within them. i.e. in this case, the first and last.
I can do:
countOfEmpty :: (Eq a) => [[a]] -> Int
countOfEmpty = length . filter (== [])
fixEqualsFiltered :: [String] -> [[String]]
fixEqualsFiltered re = filter (\x -> countOfEmpty x == 0) (fixEquals re)
so that "fixEqualsFiltered test" gives:
[["12","=","56","78"],["12","34","=","78”]]
which is what I want but it doesn’t seem elegant.
I can’t help thinking there’s another way to filter these out.
After all, it’s whenever "equals" is used in the if statement and is empty that we want to drop the equals so it seems a waste to build the list (e.g. ["","34","56","78”] and then ditch it.)
Any thoughts appreciated.
I don't know if this is any cleaner than your code, but it might be a bit more clear and maybe more efficient using a recursion:
fixEquals = init . f
f :: [String] -> [[String]]
f [] = [[]]
f (x:xs) | '=' `elem` x = ("=":removeEq xs) : map (removeEq [x] ++) (f xs)
| otherwise = map (x:) (f xs)
removeEq :: [String] -> [String]
removeEq = map (filter (/= '='))
The way it works is that, if there's an '=' in the current string, then it splits the return into two, if not just calls recursively. The init is needed as in the last element returned there's no equal in any string.
Finally, I believe you can probably find a better data structure to do what you need to achieve instead of using list of strings
Let
xs = [["","34","56","78"],["12","=","56","78"],["12","34","=","78"],["12","34","56",""]]
in
filter (not . any null) xs
will give
[["12","=","56","78"],["12","34","=","78"]]
If you want list comprehension then do
[x | x <- xs, and [not $ null y | y <- x]]
I think I'd probably do it this way. First, a preliminary that I've written so many times it's practically burned into my fingers by now:
zippers :: [a] -> [([a], a, [a])]
zippers = go [] where
go _ [] = []
go b (h:e) = (b,h,e):go (h:b) e
Probably running it once or twice in ghci will be a more clear explanation of what this does than any English writing I could do:
> zippers "abcd"
[("",'a',"bcd"),("a",'b',"cd"),("ba",'c',"d"),("cba",'d',"")]
In other words, it gives a way of selecting each element of a list in turn, giving the "leftovers" of what was before and after the selection point. Given that tool, here's our plan: we'll nondeterministically choose a String to serve as our equals sign, double-check that we've got an equals sign in the first place, and then clear out the equals from the others. So:
fixEquals ss = do
(prefix, s, suffix) <- zippers ss
guard ('=' `elem` s)
return (reverse (deleteEquals prefix) ++ ["="] ++ deleteEquals suffix)
deleteEquals = map (filter ('='/=))
Let's try it:
> fixEquals ["12", "34=", "56=", "78"]
[["12","=","56","78"],["12","34","=","78"]]
Perfect! But this is just a stepping-stone to actually generating the equations, right? It turns out to be not that hard to go all the way in one step, skipping this intermediate. Let's do that:
equations ss = do
(prefixes, s, suffixes) <- zippers ss
guard ('=' `elem` s)
prefix <- mapM (filter ('='/=)) (reverse prefixes)
suffix <- mapM (filter ('='/=)) suffixes
return (prefix ++ "=" ++ suffix)
And we can try it in ghci:
> equations ["12", "34=", "56=", "78"]
["1=57","1=58","1=67","1=68","2=57","2=58","2=67","2=68","13=7","13=8","14=7","14=8","23=7","23=8","24=7","24=8"]
The easiest waty to achieve what you want is to create all the combinations and to filter the ones that have a meaning:
Prelude> test = ["12", "34=", "56=", "78"]
Prelude> sequence test
["1357","1358","1367","1368","13=7","13=8","1457","1458","1467","1468","14=7","14=8","1=57","1=58","1=67","1=68","1==7","1==8","2357","2358","2367","2368","23=7","23=8","2457","2458","2467","2468","24=7","24=8"
Prelude> filter ((1==).length.filter('='==)) $ sequence test
["13=7","13=8","14=7","14=8","1=57","1=58","1=67","1=68","23=7","23=8","24=7","24=8","2=57","2=58","2=67","2=68"]
You pointed the drawback: imagine we have the followig list of strings: ["=", "=", "0123456789", "0123456789"]. We will generate 100 combinations and drop them all.
You can look at the combinations as a tree. For the ["12", "34"], you have:
/ \
1 2
/ \ / \
3 4 3 4
You can prune the tree: just ignore the subtrees when you have two = on the path.
Let's try to do it. First, a simple combinations function:
Prelude> :set +m
Prelude> let combinations :: [String] -> [String]
Prelude| combinations [] = [""]
Prelude| combinations (cs:ts) = [c:t | c<-cs, t<-combinations ts]
Prelude|
Prelude> combinations test
["1357","1358","1367","1368","13=7","13=8","1457","1458","1467","1468","14=7","14=8","1=57","1=58","1=67","1=68","1==7","1==8","2357","2358","2367","2368","23=7","23=8","2457","2458","2467","2468","24=7","24=8", ...]
Second, we need a variable to store the current number of = signs met:
if we find a second = sign, just drop the subtree
if we reach the end of a combination with no =, drop the combination
That is:
Prelude> let combinations' :: [String] -> Int -> [String]
Prelude| combinations' [] n= if n==1 then [""] else []
Prelude| combinations' (cs:ts) n = [c:t | c<-cs, let p = n+(fromEnum $ c=='='), p <= 1, t<-combinations' ts p]
Prelude|
Prelude> combinations' test 0
["13=7","13=8","14=7","14=8","1=57","1=58","1=67","1=68","23=7","23=8","24=7","24=8","2=57","2=58","2=67","2=68"]
We use p as the new number of = sign on the path: if p>1, drop the subtree.
If n is zero, we don't have any = sign in the path, drop the combination.
You may use the variable n to store more information, eg type of the last char (to avoid +* sequences).

How to display the data from the list as tabular form

--[(Teacher,subject,class,extrasub)]
test =[("Sam","Maths","Std5","PE"),
("Sam","Maths","Std7","PE"),
("Sam","geography","Std6","PE"),
("Jake","English","Std9","Red Cross"),
("Jake","English","Std9","Guards")]
It should look like this
Teacher Subject Class ExtraClass
Sam Maths Std5 PE
Std7
Geography Std6
Jake English Std9 Red Cross
Guards
i want the output to be like this
[
("Jake","English","Std9","Red Cross"),
("","","","Guards"),
("Sam","Maths","Std7","PE"),
("","","Std5",""),
("","geography","Std6","PE")]
test2 :: [([Char], [Char], [Char], [Char])]
test2 = test3 $ concat $ groupBy (\(x,_,_,_) (y,_,_,_) -> x==y) (sort test1)
test3 [] = []
test3 [x] = []
test3 ((a1,b1,c1,d1):(a2,b2,c2,d2):xs) =
if(a1==a2 && b1== b2&& d1==d2)
then [("","",c1,d1)]
else if (a1==a2)
then [("","",c1,d1)]
else [("",b1,c1,d1)]
i was thinking of this approach using foldl' but couldnt get it. any suggestion on how to go about on this
This is actually quite hard. You will have to solve two problems:
How to transform the input so that duplicate fields in consecutive rows are replaced with blank
space.
How to print the result in nice columns.
Let us discuss these problems one by one.
Transform the input.
What do we have to do? If there are duplicate values in consecutive cells along any given
column, we would like to replace all of them, except the first, with blank space. So, we may do
like this:
Analyze each column as a list.
If there are duplicate values, keep only the first one and replace all others with blank
space.
The tricky moment is that, if the first column's value changes, we would like to stop
blanking cells and print at least one row in full. To ensure this, we may break the table in
sections so that for each possible value of the first column, there is one section.
How do we accomplish this? My take:
-- First, I'd like to define some type synonyms to make type signatures more
-- intuitive.
type Row = [String]
type Table = [Row]
-- It would be easier to deal with a row represented as a list, rather than a
-- tuple.
tupleToList :: (String, String, String, String) -> Row
tupleToList (a, b, c, d) = [a, b, c, d]
-- With some handy library functions, we can convert our input to Rows and
-- section it by teacher's name in one pass:
test' :: [Table]
test' = groupBy equalFirstColumn . map tupleToList $ test
where
equalFirstColumn = ((==) `on` head)
-- Now, we have to blank the repeating values. If the columns were lists, we
-- would do it like this:
blankRepetitions :: [String] -> [String]
blankRepetitions (x:xs) = x: replicate (length bef) "" ++ blankRepetitions aft
where (bef, aft) = span (== x) xs
blankRepetitions [ ] = [ ]
-- Luckily, there is a library function that can turn columns to rows and vice
-- versa. Let's use it.
test'' :: [Table]
test'' = map (transpose . map blankRepetitions . transpose) test'
-- Now we can turn our groups back into a single table. Why not add a row with
-- column captions as well.
test3 :: Table
test3 = ["Teacher", "Subject", "Class", "ExtraClass"] : concat test''
Take some time to study this and see if it works as expected. I have a lingering suspicion that
the way I deal with blanking has some flaws to it...
Print the result.
By far the simplest way to obtain a nice looking table is simply to pad every cell with spaces
so that every cell has the same width:
pad :: Int -> String -> String
pad w s = " " ++ s ++ (replicate (w - length s) ' ')
But what width to choose? The width of the longest cell seems like a nice choice. So, we can go
like that:
columnize :: Table -> String
columnize xss = unlines . map concat . (map.map) (pad maxwidth) $ xss
where maxwidth = maximum . map length . concat $ xss
Notice how map.map processes a list of lists in the same way as a single map would process
a plain one.
That's it! See how it's easy to deal with a complicated problem once you turn it into a few
smaller ones.

How to split a [String] in to [[String]] based on length

I'm trying to split a list of Strings in to a List of Lists of Strings
so like in the title [String] -> [[String]]
This has to be done based on length of characters, so that the Lists in the output are no longer than 10. So if input was length 20 this would be broken down in to 2 lists and if length 21 in to 3 lists.
I'm not sure what to use to do this, I don't even know how to brake down a list in to a list of lists never mind based on certain length.
For example if the limit was 5 and the input was:
["abc","cd","abcd","ab"]
The output would be:
[["abc","cd"],["abcd"],["ab"]]
I'd like to be pointed in the right direction and what methods to use, list comprehension? recursion?
Here's an intuitive solution:
import Data.List (foldl')
breakup :: Int -> [[a]] -> [[[a]]]
breakup size = foldl' accumulate [[]]
where accumulate broken l
| length l > size = error "Breakup size too small."
| sum (map length (last broken ++ [l])) <= size
= init broken ++ [last broken ++ [l]]
| otherwise = broken ++ [[l]]
Now, let's go through it line-by-line:
breakup :: Int -> [[a]] -> [[[a]]]
Since you hinted that you may want to generalize the function to accept different size limits, our type signature reflects this. We also generalize beyond [String] (that is, [[Char]]), since our problem is not specific to [[Char]], and could equally apply to any [[a]].
breakup size = foldl' accumulate [[]]
We're using a left fold because we want to transform a list, left-to-right, into our target, which will be a list of sub-lists. Even though we're not concerned with efficiency, we're using Data.List.foldl' instead of Prelude's own foldl because this is standard practice. You can read more about foldl vs. foldl' here.
Our folding function is called accumulate. It will consider a new item and decide whether to place it in the last-created sub-list or to start a new sub-list. To make that judgment, it uses the size we passed in. We start with an initial value of [[]], that is, a list with one empty sub-list.
Now the question is, how should you accumulate your target?
where accumulate broken l
We're using broken to refer to our constructed target so far, and l (for "list") to refer to the next item to process. We'll use guards for the different cases:
| length l > size = error "Breakup size too small."
We need to raise an error if the item surpasses the size limit on its own, since there's no way to place it in a sub-list that satisfies the size limit. (Alternatively, we could build a safe function by wrapping our return value in the Maybe monad, and that's something you should definitely try out on your own.)
| sum (map length (last broken ++ [l])) <= size
= init broken ++ [last broken ++ [l]]
The guard condition is sum (map length (last broken ++ [l])) <= size, and the return value for this guard is init broken ++ [last broken ++ [l]]. Translated into plain English, we might say, "If the item can fit in the last sub-list without going over the size limit, append it there."
| otherwise = broken ++ [[l]]
On the other hand, if there isn't enough "room" in the last sub-list for this item, we start a new sub-list, containing only this item. When the accumulate helper is applied to the next item in the input list, it will decide whether to place that item in this sub-list or start yet another sub-list, following the same logic.
There you have it. Don't forget to import Data.List (foldl') up at the top. As another answer points out, this is not a performant solution if you plan to process 100,000 strings. However, I believe this solution is easier to read and understand. In many cases, readability is the more important optimization.
Thanks for the fun question. Good luck with Haskell, and happy coding!
You can do something like this:
splitByLen :: Int -> [String] -> [[String]]
splitByLen n s = go (zip s $ scanl1 (+) $ map length s) 0
where go [] _ = []
go xs prev = let (lst, rest) = span (\ (x, c) -> c - prev <= n) xs
in (map fst lst) : go rest (snd $ last lst)
And then:
*Main> splitByLen 5 ["abc","cd","abcd","ab"]
[["abc","cd"],["abcd"],["ab"]]
In case there is a string longer than n, this function will fail. Now, what you want to do in those cases depends on your requirements and that was not specified in your question.
[Update]
As requested by #amar47shah, I made a benchmark comparing his solution (breakup) with mine (splitByLen):
import Data.List
import Data.Time.Clock
import Control.DeepSeq
import System.Random
main :: IO ()
main = do
s <- mapM (\ _ -> randomString 10) [1..10000]
test "breakup 10000" $ breakup 10 s
test "splitByLen 10000" $ splitByLen 10 s
putStrLn ""
r <- mapM (\ _ -> randomString 10) [1..100000]
test "breakup 100000" $ breakup 10 r
test "splitByLen 100000" $ splitByLen 10 r
test :: (NFData a) => String -> a -> IO ()
test s a = do time1 <- getCurrentTime
time2 <- a `deepseq` getCurrentTime
putStrLn $ s ++ ": " ++ show (diffUTCTime time2 time1)
randomString :: Int -> IO String
randomString n = do
l <- randomRIO (1,n)
mapM (\ _ -> randomRIO ('a', 'z')) [1..l]
Here are the results:
breakup 10000: 0.904012s
splitByLen 10000: 0.005966s
breakup 100000: 150.945322s
splitByLen 100000: 0.058658s
Here is another approach. It is clear from the problem that the result is a list of lists and we need a running length and an inner list to keep track of how much we have accumulated (We use foldl' with these two as input). We then describe what we want which is basically:
If the length of the current input string itself exceeds the input length, we ignore that string (you may change this if you want a different behavior).
If the new length after we have added the length of the current string is within our input length, we add it to the current result list.
If the new length exceeds the input length, we add the result so far to the output and start a new result list.
chunks len = reverse . map reverse . snd . foldl' f (0, [[]]) where
f (resSoFar#(lenSoFar, (currRes: acc)) curr
| currLength > len = resSoFar -- ignore
| newLen <= len = (newLen, (curr: currRes):acc)
| otherwise = (currLength, [curr]:currRes:acc)
where
newLen = lenSoFar + currLength
currLength = length curr
Every time we add a result to the output list, we add it to the front hence we need reverse . map reverse at the end.
> chunks 5 ["abc","cd","abcd","ab"]
[["abc","cd"],["abcd"],["ab"]]
> chunks 5 ["abc","cd","abcdef","ab"]
[["abc","cd"],["ab"]]
Here is an elementary approach. First, the type String doesn't matter, so we can define our function in terms of a general type a:
breakup :: [a] -> [[a]]
I'll illustrate with a limit of 3 instead of 10. It'll be obvious how to implement it with another limit.
The first pattern will handle lists which are of size >= 3 and the the second pattern handles all of the other cases:
breakup (a1 : a2 : a3 : as) = [a1, a2, a3] : breakup as
breakup as = [ as ]
It is important to have the patterns in this order. That way the second pattern will only be used when the first pattern does not match, i.e. when there are less than 3 elements in the list.
Examples of running this on some inputs:
breakup [1..5] -> [ [1,2,3], [4,5] ]
breakup [1..4] -> [ [1,2,3], [4] ]
breakup [1..2] -> [ [1,2] ]
breakup [1..3] -> [ [1,2,3], [] ]
We see these is an extra [] when we run the function on [1..3]. Fortunately this is easy to fix by inserting another rule before the last one:
breakup [] = []
The complete definition is:
breakup :: [a] -> [[a]]
breakup [] = []
breakup (a1 : a2 : a3 : as) = [a1, a2, a3] : breakup as
breakup as = [ as ]

Dynamic List Comprehension in Haskell

Suppose I have a list comprehension that returns a list of sequences, where the elements chosen depend on each other (see example below). Is there a way to (conveniently) program the number of elements and their associated conditions based on an earlier computation? For example, return type [[a,b,c]] or [[a,b,c,d,e]] depending on another value in the program? Also, are there other/better ways than a list comprehension to formulate the same idea?
(I thought possible, although cumbersome and limited, to write out a larger list comprehension to start with and trim it by adding to s a parameter and helper functions that could make one or more of the elements a value that could easily be filtered later, and the associated conditions True by default.)
s = [[a, b, c, d] | a <- list, someCondition a,
b <- list, b /= a, not (someCondition b),
otherCondition a b,
c <- list, c /= a, c /= b, not (someCondition c),
otherCondition b c,
d <- list, d /= a, d /= b, d /= c,
someCondition d, someCondition (last d),
otherCondition c d]
The question is incredibly difficult to understand.
Is there a way to (conveniently) program the number of elements and their associated conditions based on an earlier computation?
The problem is "program" is not really an understandable verb in this sentence, because a human programs a computer, or programs a VCR, but you can't "program a number". So I don't understand what you are trying to say here.
But I can give you code review, and maybe through code review I can understand the question you are asking.
Unsolicited code review
It sounds like you are trying to solve a maze by eliminating dead ends, maybe.
What your code actually does is:
Generate a list of cells that are not dead ends or adjacent to dead ends, called filtered
Generate a sequence of adjacent cells from step 1, sequences
Concatenate four such adjacent sequences into a route.
Major problem: this only works if a correct route is exactly eight tiles long! Try to solve this maze:
[E]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[ ]
|
[ ]-[ ]-[ ]-[E]
So, working backwards from the code review, it sounds like your question is:
How do I generate a list if I don't know how long it is beforehand?
Solutions
You can solve a maze with a search (DFS, BFS, A*).
import Control.Monad
-- | Maze cells are identified by integers
type Cell = Int
-- | A maze is a map from cells to adjacent cells
type Maze = Cell -> [Cell]
maze :: Maze
maze = ([[1], [0,2,5], [1,3], [2],
[5], [4,6,1,9], [5,7], [6,11],
[12], [5,13], [9], [7,15],
[8,16], [14,9,17], [13,15], [14,11],
[12,17], [13,16,18], [17,19], [18]] !!)
-- | Find paths from the given start to the end
solve :: Maze -> Cell -> Cell -> [[Cell]]
solve maze start = solve' [] where
solve' path end =
let path' = end : path
in if start == end
then return path'
else do neighbor <- maze end
guard (neighbor `notElem` path)
solve' path' neighbor
The function solve works by depth-first search. Rather than putting everything in a single list comprehension, it works recursively.
In order to find a path from start to end, if start /= end,
Look at all cells adjacent to the end, neighbor <- maze end,
Make sure that we're not backtracking over a cell guard (negihbor `notElem` path),
Try to find a path from start to neighbor.
Don't try to understand the whole function at once, just understand the bit about recursion.
Summary
If you want to find the route from cell 0 to cell 19, recurse: We know that cell 18 and 19 are connected (because they are directly connected), so we can instead try to solve the problem of finding a route from cell 0 to cell 18.
This is recursion.
Footnotes
The guard,
someCondition a == True
Is equivalent to,
someCondition a
And therefore also equivalent to,
(someCondition a == True) == True
Or,
(someCondition a == (True == True)) == (True == (True == True))
Or,
someCondition a == (someCondition a == someCondition a)
The first one, someCondition a, is fine.
Footnote about do notation
The do notation in the above example is equivalent to list comprehension,
do neighbor <- maze end
guard (neighbor `notElem` path)
solve' path' neighbor
The equivalent code in list comprehension syntax is,
[result | neighbor <- maze end,
neighbor `notElem` path,
result <- solve' path' neighbor]
Is there a way to (conveniently) program the number of elements and their associated conditions based on an earlier computation? For example, return type [[a,b,c]] or [[a,b,c,d,e]] depending on another value in the program?
I suppose you want to encode the length of the list (or vector) statically in the type signature. Length of the standard lists cannot be checked on type level.
One approach to do that is to use phantom types, and introduce dummy data types which will encode different sizes:
newtype Vector d = Vector { vecArray :: UArray Int Float }
-- using EmptyDataDecls extension too
data D1
data D2
data D3
Now you can create vectors of different length which will have distinct types:
vector2d :: Float -> Float -> Vector D2
vector2d x y = Vector $ listArray (1,2) [x,y]
vector3d :: Float -> Float -> Float -> Vector D3
vector3d x y z = Vector $ listArray (1,3) [x,y,z]
If the length of the output depends on the length of the input, then consider using type-level arithmetics to parametrize the output.
You can find more by googling for "Haskell statically sized vectors".
A simpler solution is to use tuples, which are fixed length. If your function can produce either a 3-tuple, or a 5-tuple, wrap them with an Either data type: `Either (a,b,c) (a,b,c,d,e).
Looks like you're trying to solve some logic puzzle by unique selection from finite domain. Consult these:
Euler 43 - is there a monad to help write this list comprehension?
Splitting list into a list of possible tuples
The way this helps us is, we carry our domain around while we're making picks from it; and the next pick is made from the narrowed domain containing what's left after the previous pick, so a chain is naturally formed. E.g.
p43 = sum [ fromDigits [v0,v1,v2,v3,v4,v5,v6,v7,v8,v9]
| (dom5,v5) <- one_of [0,5] [0..9] -- [0..9] is the
, (dom6,v6) <- pick_any dom5 -- initial domain
, (dom7,v7) <- pick_any dom6
, rem (100*d5+10*d6+d7) 11 == 0
....
-- all possibilities of picking one elt from a domain
pick_any :: [a] -> [([a], a)]
pick_any [] = []
pick_any (x:xs) = (xs,x) : [ (x:dom,y) | (dom,y) <- pick_any xs]
-- all possibilities of picking one of provided elts from a domain
-- (assume unique domains, i.e. no repetitions)
one_of :: (Eq a) => [a] -> [a] -> [([a], a)]
one_of ns xs = [ (ys,y) | let choices = pick_any xs, n <- ns,
(ys,y) <- take 1 $ filter ((==n).snd) choices ]
You can trivially check a number of elements in your answer as a part of your list comprehension:
s = [answer | a <- .... , let answer=[....] , length answer==4 ]
or just create different answers based on a condition,
s = [answer | a <- .... , let answer=if condition then [a,b,c] else [a]]
You have Data.List.subsequences
You can write your list comprehension in monadic form (see guards in Monad Comprehensions):
(Explanation: The monad must be an instance of MonadPlus which supports failure.
guard False makes the monad fail evaluating to mzero., subsequent results are appended with mplus = (++) for the List monad.)
import Control.Monad (guard)
myDomain = [1..9] -- or whatever
validCombinations :: [a] -> [[a]]
validCombinations domainList = do
combi <- List.subsequences domainList
case combi of
[a,b] -> do
guard (propertyA a && propertyB b)
return combi
[a,b,c] -> do
guard (propertyA a && propertyB b && propertyC c)
return combi
_ -> guard False
main = do
forM_ (validCombinations myDomain) print
Update again, obtaining elements recursively, saving combinations and checks
import Control.Monad
validCombinations :: Eq a => Int -> Int -> [a] -> [(a -> Bool)] -> [a] -> [[a]]
validCombinations indx size domainList propList accum = do
elt <- domainList -- try all domain elements
let prop = propList!!indx
guard $ prop elt -- some property
guard $ elt `notElem` accum -- not repeated
{-
case accum of
prevElt : _ -> guard $ some_combined_check_with_previous elt prevElt
_ -> guard True
-}
if size > 1 then do
-- append recursively subsequent positions
other <- validCombinations (indx+1) (size-1) domainList propList (elt : accum)
return $ elt : other
else
return [elt]
myDomain = [1..3] :: [Int]
myProps = repeat (>1)
main = do
forM_ (validCombinations 0 size myDomain myProps []) print
where
size = 2
result for size 2 with non trivial result:
[2,3]
[3,2]

Two-dimensional zipper

Inspired by the recent question about 2d grids in Haskell, I'm wondering if it would be possible to create a two-dimensional zipper to keep track of a position in a list of lists. A one-dimensional zipper on a list allows us to really efficiently move locally in a large list (the common example being a text editor). But lets say we have a second dimension like this:
grid =
[[ 1, 2, 3, 4, 5]
,[ 6, 7, 8, 9,10]
,[11,12,13,14,15]
,[16,17,18,19,20]
,[21,22,23,24,25]]
Can we create some kind of zipper data structure to efficiently move not only left and right but up and down in the grid here? If so, what if we replace the list of lists with an infinite list of infinite lists, can we still get efficient movement?
Not quite, no. One of the key aspects of how zippers work is that they represent a location in a structure by a path used to reach it, plus extra fragments created along the way, with the end result that you can backtrack along that path and rebuild the structure as you go. The nature of the paths available through the data structure thus constrains the zipper.
Because locations are identified by paths, each distinct path represents a different location, so any data structure with multiple paths to the same value can't be used with a zipper--for example, consider a cyclic list, or any other structure with looping paths.
Arbitrary movement in 2D space doesn't really fit the above requirements, so we can deduce that a 2D zipper would necessarily be somewhat limited. Perhaps you'd start from the origin, walk a path through the structure, and then backtrack along that path some distance in order to reach other points, for example. This also implies that for any point in the structure, there are other points that can only be reached via the origin.
What you can do is build some notion of 2D distance into the data structure, so that as you follow a path down through the structure, the points "below" you are close to each other; the idea is to minimize the amount of backtracking needed on average to move a short distance in 2D space. This ends up being roughly the same approach needed to search 2D space by distance--nearest neighbor searches, efficient geometric intersection, that sort of thing--and can be done with the same kind of data structure, namely space partitioning to create a higher-dimensional search tree. Implementing a zipper for a quadtree, a kd-tree, or similar structures is straightforward, just like any other tree.
Well you can use something simple like the following code. We represent a table by the top rows of the selected element, the bottom rows of the selected element, plus the elements to the left of the selected one, and the elements to the right of the selected one.
The top rows and the left elements are stored in a reverse order to enable efficient movement.
I'm not sure if this qualifies as a zipper though, because even though we hold a "location" in the data structure, it is not a "path".
-- Table sel left right top bottom
data Table a = Table a [a] [a] [[a]] [[a]] deriving Show
left :: Table a -> Table a
left tab#(Table _ [] _ _ _) = tab
left (Table sel (l:ls) rs ts bs) = Table l ls (sel:rs) ts bs
right :: Table a -> Table a
right tab#(Table _ _ [] _ _) = tab
right (Table sel ls (r:rs) ts bs) = Table r (sel:ls) rs ts bs
up :: Table a -> Table a
up tab#(Table _ _ _ [] _) = tab
up (Table sel ls rs (t:ts) bs) = Table sel' ls' rs' ts (b:bs)
where
(ls',(sel':rs')) = splitAt (length ls) t
b = ls ++ (sel:rs)
down :: Table a -> Table a
down tab#(Table _ _ _ _ []) = tab
down (Table sel ls rs ts (b:bs)) = Table sel' ls' rs' (t:ts) bs
where
(ls',(sel':rs')) = splitAt (length ls) b
t = ls ++ (sel:rs)
tableToList :: Table a -> [[a]]
tableToList (Table sel ls rs ts bs) = (reverse ts) ++ [ls ++ (sel:rs)] ++ bs
listToTable :: [[a]] -> Table a
listToTable [] = error "cannot make empty table"
listToTable ([]:_) = error "cannot make empty table"
listToTable ((t:tr):ts) = Table t [] tr [] ts
This even works for infinite lists -
selected :: Table a -> a
selected (Table sel _ _ _ _) = sel
a :: Table Int
a = listToTable $ replicate 10 [1..]
selected a #=> 1
selected $ down a #=> 1
selected $ right $ down a #=> 2
I was looking for something similar: a way to cheaply and easily navigate (which includes going “backwards”) a doubly-infinite list of lists. Here's my take at it.
If I read the others answers carefully, what I'm presenting here isn't really a zipper: while navigation is amortized O(1), the memory used by the zipper structure network is never released. On the other hand, it ought to tie the knot enough for “cells” to be shared no matter the path we take to get to them, which is the kind of topology we'd want on a 2D list of lists.
To compensate, the list of lists used to generate it ought to eventually go unreferenced and garbage-collected.
data FakeZip2D a = Z2 { z2Val :: a
, goUp :: !( Maybe (FakeZip2D a) )
, goDown :: Maybe (FakeZip2D a)
, goLeft :: !( Maybe (FakeZip2D a) )
, goRight :: Maybe (FakeZip2D a)
}
fromList2 :: [[a]] -> Maybe (FakeZip2D a)
fromList2 xss = head (head zss) where
extended = [ repeat Nothing ] ++
map (\z -> [Nothing] ++ z ++ repeat Nothing) zss ++
[ repeat Nothing ]
zss = zipWith4' row xss extended (drop 1 extended) (drop 2 extended)
row xs prev cur next = Just <$> zipWith5' Z2 xs (tail prev) (tail next)
cur (drop 2 cur)
-- totally inspired by https://stackoverflow.com/a/54096748/12274
zipWith4' f (a:as) (b:bs) ~(c:cs) ~(d:ds) =
f a b c d : zipWith4' f as bs cs ds
zipWith5' f (a:as) (b:bs) ~(c:cs) (d:ds) ~(e:es) =
f a b c d e : zipWith5' f as bs cs ds es
The data structure ought to be self-explanatory. Up and left can afford to be strict because we're building from singly-linked lists. AFAIK, there's no point in maing them lazy in Haskell, as they wouldn't let anything go out of scope anyway.
The lattice is built recursively, expanding the borders of the provided input with Nothing. The lazy-enough variants of zipWith I needed are inspired from answers to another series of questions of mine on the topic.
Here it is in action:
demo :: IO ()
demo = do
let multList2 = [[ i*j | j <- [0..] ] | i <- [0..] ]
multZ2 = fromList2 multList2
let rows = iterate (>>= goDown) multZ2
cols = map (iterate (>>= goRight)) rows
putStrLn "Multiplication table"
mapM_ (print . map z2Val) $ take 5 $ map (catMaybes . take 5) cols
putStrLn "List of squares"
let goDiag = goRight >=> goDown
print $ map z2Val $ take 25 $ catMaybes $ iterate (>>= goDiag) multZ2
putStrLn "Convoluted list of squares"
let goDiag' = goDown >=> goRight >=> goUp >=> goLeft >=> goDiag
print $ map z2Val $ take 25 $ catMaybes $ iterate (>>= goDiag') multZ2
The interface can likely be made even easier to use by dropping the Maybes. At your own risk, naturally.
This might be slightly off-topic as it's not a real zipper either, but it solved my problem; and since this is the question that came up when I first looked for a solution, I'm posting it here with the intent it helps someone else.

Resources