Formatting strings into triangles in Haskell

Question

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.

Answer 1

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

Answer 2

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