使用 Haskell 打印菱形图案

Question

我需要编写一个 Haskell 程序，以递归方式生成菱形输出。 这是给定输入的一些示例输出

输入：1
输出：

 *
* *
 *

输入：2
输出：

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

输入：3
输出：

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

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

我写了以下函数：

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

提供以下输出：

漂亮 1

 *
*
 *

漂亮 2

    *
   *
    *
 *
*
 *
    *
   *
    *

谁能帮我处理剩下的一半？提前致谢。

Answer 1

我喜欢这个任务，所以我写了一个替代解决方案。

我们可以构建它，就像您使用漂亮的打印机一样。查看pretty 包以获取这些想法并正确使用它们，但我们还是坚持使用普通的旧[String]。

首先让我们制作一个空白网格

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

然后让我们定义一个菱形。

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]]

但是我们如何才能将[String] 的矩阵连接在一起呢？ 首先使用transpose获取所有应该连接在一起的Strings，而不是使用transpose，然后concat它们全部：

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

要对整个矩阵执行此操作，我们需要将每一行的行连接起来，然后将所有行连接到一个行列表中：

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

打印辅助函数：

put = mapM_ putStrLn
d n = put $ diamond n

您可能会争辩说数值解更有效，而且确实如此，但d 4 是适合我屏幕的最大且不慢的。你也可以争辩说这个解决方案更清晰。

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

（它也适用于更高的 n，但他们会使这篇文章在页面上不必要地过长。）

Answer 2

对于n==0，next n 描述了整个图片直到镜像。对于更大的n，情况不再如此。所以，第一步，我们改变next函数来输出对称图片：

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

现在，next n 描述了所有星星的位置。为了打印它们，我们首先计算相对距离。

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'

应用于一行，diffs 返回我们需要在每个星之前放置的空格数列表，lpad 从中生成图片。像以前一样打印：

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

Answer 3

这源自 AndrewC 的解决方案。空间块是递归生成的，我更喜欢使用运算符让代码更清晰：

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 (++)

概括。 如果我们想要这个：

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

那么解决方案是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 (++)