Print Diamond Pattern using Haskell

Question

I need to write a Haskell program that will generate a diamond output recursively. Here is some sample output for given input

input : 1
output :

 *
* *
 *

input : 2
output :

    *
   * *
    *
 *     *
* *   * *
 *     *
    *
   * *
    *

input : 3
output :

             *             
            * *             
             *              
          *     *           
         * *   * *          
          *     *           
             *              
            * *             
             *              

    *                 *    
   * *               * *   
    *                 *    
 *     *           *     * 
* *   * *         * *   * *
 *     *           *     * 
    *                 *    
   * *               * *   
    *                 *    
             *             
            * *             
             *              
          *     *           
         * *   * *          
          *     *           
             *              
            * *             
             *     

I wrote following functions:

next 0 = [1,0,1]
next n = map (+3^n) (next (n-1)) ++ next (n-1) ++ map (+3^n) (next (n-1))
lpad n = map (++"*") (zipWith ($) (map (take)(next (n-1))) ((repeat(repeat ' '))))
pretty n = putStrLn $ intercalate "\n" $ lpad n

which gives following outputs:

pretty 1

 *
*
 *

pretty 2

    *
   *
    *
 *
*
 *
    *
   *
    *

Can anyone help me with the remaining halves? Thanks in advance.

Answer 1

I liked the task, so I wrote an alternative solution.

We could build it up, a bit like you would with a pretty printer. Look into the pretty package to take these ideas and use them properly, but let's stick to plain old [String] for this.

First let's make a blank grid

blank :: Int -> [String]
blank n = replicate (3^n) $ replicate (3^n) ' '

Then let's define a diamond.

diamond :: Int -> [String]
diamond 0 = ["*"]
diamond n = let 
        o = diamond (n-1) 
        x = blank (n-1) in
    joinMatrix [[x,o,x]
               ,[o,x,o]
               ,[x,o,x]]

But how can we join this matrix of [String] together? First get all the Strings that should be concatenated together next to each other instead of under each other using transpose, then concat them all:

joinLine :: [[String]] -> [String]
joinLine = map concat.transpose

To do that to a whole matrix we need to join the lines on each row, then concat all the lines together into one list of lines:

joinMatrix :: [[[String]]] -> [String]
joinMatrix = concat.map joinLine

helper functions for printing:

put = mapM_ putStrLn
d n = put $ diamond n

You could argue that the numerical solution is more efficient, and it is, but d 4 is the largest that fits on my screen and isn't slow. You could also argue that this solution is clearer.

*Main> d 0
*
*Main> d 1
 * 
* *
 * 
*Main>  d 2
    *    
   * *   
    *    
 *     * 
* *   * *
 *     * 
    *    
   * *   
    *    

(It works for higher n too, but they would make this post unnecessarily long on the page.)

Answer 2

For n==0, next n describes the whole picture up to mirroring. This is not the case anymore for greater n. So, in a first step, we change the next function to output a symmetric picture:

mmap = map . map

next :: Int -> [[Int]]
next 0 = [[1],[0,2],[1]]
next n = sn ++ map (\a -> a ++ map (+2*3^n) a) nn ++ sn
  where
    nn = next (n - 1)
    sn = mmap (+3^n) nn

Now, next n describes the positions of all stars. To print them, we first compute the relative distances.

diffs :: [Int] -> [Int]
diffs (x:xs) = x: diffs' x (xs)
  where
    diffs' x (y:ys) = y - x - 1 : diffs' y ys
    diffs' _ [] = []
diffs [] = []

lpad :: Int -> [[Char]]
lpad = map (concatMap $ \n -> replicate n ' ' ++ "*") . map diffs . next'

Applied to one line, diffs returns the list of the number of spaces we need to put before each star and lpad generates the picture from that. Print it as before:

pretty :: Int -> IO ()
pretty n = putStrLn $ unlines $ lpad n

Answer 3

This is derived from AndrewC's solution. The space blocks are recursively generated and I prefer to use operators to make the code clearer:

diamond
    = putStr
    . unlines
    . fst
    . (iterate f (["*"], [" "]) !!)
  where
    f (d, e)
        = (  e + d + e
         ++  d + e + d
         ++  e + d + e
          ,  e + e + e
         ++  e + e + e
         ++  e + e + e
          )

    (+) = zipWith (++)

A generalization. If we would like to have this:

             +             
            - -            
             +             
          -     -          
         + +   + +         
          -     -          
             +             
            - -            
             +             
    -                 -    
   + +               + +   
    -                 -    
 +     +           +     + 
- -   - -         - -   - -
 +     +           +     + 
    -                 -    
   + +               + +   
    -                 -    
             +             
            - -            
             +             
          -     -          
         + +   + +         
          -     -          
             +             
            - -            
             +             

then the solution is star 3 where

star
    = putStr
    . unlines
    . (\(d, p, e) -> d)
    . (iterate f (["-"], ["+"], [" "]) !!)
  where
    f (d, p, e)
        = (  e + p + e
         ++  d + e + d
         ++  e + p + e
          ,  e + d + e
         ++  p + e + p
         ++  e + d + e
          ,  e + e + e
         ++  e + e + e
         ++  e + e + e
          )

    (+) = zipWith (++)