C 语言版的一个问题的 Haskell 实现

Question

原题在此：
http://bbs.chinaunix.net/thread-1260094-1-1.html

Haskell Code:

1. #!/usr/bin/runhaskell
3. import System.Environment
5. f' 1 = [0]
6. f' n = prefix ++ middle ++ postfix
7.   where half = n `div` 2
8.         (prefix, postfix) = splitAt (half) $ f' (n-1)
9.         middle = if n `mod` 2 == 1
10.                   then [half]
11.                   else [half-1]
13. f'' _ 0 = []
14. f'' offset n = f'' (offset+1) (n-1) ++ [thisLine]
15.   where thisLine = white ++ foldr ((++) . (++" ")) "" items
16.         white = map (const ' ') [1..offset]
17.         items = map (show) (f' n)
19. f n = mapM_ (putStrLn) $ f'' 0 n
21. main = do
22.   [str] <- getArgs
23.   let n = read str
24.   f n

复制代码
打印结果：

1. flw@debian:~/study$ ./ttt.hs 10
2.          0
3.         0 0
4.        0 1 0
5.       0 1 1 0
6.      0 1 2 1 0
7.     0 1 2 2 1 0
8.    0 1 2 3 2 1 0
9.   0 1 2 3 3 2 1 0
10. 0 1 2 3 4 3 2 1 0
11. 0 1 2 3 4 4 3 2 1 0
12. flw@debian:~/study$ ./ttt.hs 20
13.                    0
14.                   0 0
15.                  0 1 0
16.                 0 1 1 0
17.                0 1 2 1 0
18.               0 1 2 2 1 0
19.              0 1 2 3 2 1 0
20.             0 1 2 3 3 2 1 0
21.            0 1 2 3 4 3 2 1 0
22.           0 1 2 3 4 4 3 2 1 0
23.          0 1 2 3 4 5 4 3 2 1 0
24.         0 1 2 3 4 5 5 4 3 2 1 0
25.        0 1 2 3 4 5 6 5 4 3 2 1 0
26.       0 1 2 3 4 5 6 6 5 4 3 2 1 0
27.      0 1 2 3 4 5 6 7 6 5 4 3 2 1 0
28.     0 1 2 3 4 5 6 7 7 6 5 4 3 2 1 0
29.    0 1 2 3 4 5 6 7 8 7 6 5 4 3 2 1 0
30.   0 1 2 3 4 5 6 7 8 8 7 6 5 4 3 2 1 0
31. 0 1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1 0
32. 0 1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1 0

复制代码

[ 本帖最后由 flw 于 2008-9-4 18:07 编辑 ]

Answer 1

2. (defun draw (n)
3.   (let ((L (make-list (+ n 1) " ")))
4.     (let ((f (lambda (l)
5.                (cond ((= (% l 2) 0)
6.                       (setq L (append (cdr L) (list (format "%d" (/ l 2))))))
7.                      (t (setq L (append (cdr L) (list " ")))))
8.                (mapcar 'insert L) (mapcar 'insert (cdr (reverse L)))
9.                (newline)
10.                (if (= l n) t
11.                  (funcall f (+ l 1))))))
12.       (funcall f 0))))

复制代码

Answer 2

原帖由 flw 于 2008-9-4 22:30 发表
我对预定义函数的熟悉程度还不够啊。
谢谢 MMMIX 的指点。

哈哈，互相帮助吧，我写的时候也是参照了你的代码的。

最近正为 Monad transformer 头疼呢，不过这两天看 GHC 的 monad transformer 的实现还是蛮有收获的

[ 本帖最后由 MMMIX 于 2008-9-4 22:42 编辑 ]

Answer 3

我对预定义函数的熟悉程度还不够啊。
谢谢 MMMIX 的指点。

Answer 4

原帖由 aero 于 2008-9-4 22:05 发表
还处于完全看不懂的阶段。

看看这个也许有帮助，How to read Haskell
http://www.haskell.org/haskellwiki/How_to_read_Haskell

Answer 5

还处于完全看不懂的阶段。

Answer 6

我的版本:

2. module Main where
4. import System.Environment (getArgs)
5. import Data.List (intersperse)
6. import Control.Monad (sequence_)
8. -- | Digit palindrome stream
9. digitPalindroms :: [[Int]]
10. digitPalindroms = map digitPalindrom [1..]
11.     where
12.         digitPalindrom :: Int -> [Int]
13.         digitPalindrom 1 = [0]
14.         digitPalindrom n = [0..c] ++ (reverse [0..f])
15.             where
16.                 n' = fromIntegral $ n - 2
17.                 c  = ceiling $ n' / 2
18.                 f  = floor $ n' / 2
20. -- | Prefix stream
21. prefixes :: [String]
22. prefixes = map (n -> replicate n ' ') [0..]
24. -- | Generate a digit palindrom triangle
25. --
26. -- XXX: need a better genTriangle
27. genTriangle :: Int -> [String]
28. genTriangle n = zipWith (++) prefixes' strs
29.     where
30.         ints2str ns = concat . intersperse " " $ map show ns
31.         strs = map ints2str $ take n digitPalindroms
33.         prefixes' = reverse $ take n prefixes
35. -- | Unlines string list, then put the result to stdout
36. putStrs :: [String] -> IO ()
37. putStrs = mapM_ putStrLn
39. main = do
40.     args <- getArgs
41.     let ns = map read args
42.     sequence_ $ map putStrs $ map genTriangle ns

复制代码

Answer 7

flw 代码改进易读性后的版本：

2. import System.Environment
3. import Data.List
5. f' 1 = [0]
6. f' n = prefix ++ middle ++ postfix
7.     where
8.         half = n `div` 2
9.         (prefix, postfix) = splitAt half $ f' (n-1)
10.         middle = if odd n then [half] else [half-1]
12. f'' _ 0 = []
13. f'' offset n = f'' (offset+1) (n-1) ++ [thisLine]
14.     where
15.         thisLine = white ++ (concat $ intersperse " " items)
16.         white = replicate offset ' '
17.         items = map (show) (f' n)
19. f n = mapM_ (putStrLn) $ f'' 0 n
21. main = do
22.     [str] <- getArgs
23.     let n = read str
24.     f n

复制代码

Answer 8

貌似Haskell的语法比较对我胃口，呵呵。