Live4thee

“Programming in Haskell” 的第十一章讲的是countdown problem，就是说给定一系列操作，比如加减乘除，和一系列自然数，比如2,5,9,17，求出可能的组合方法使得表达式的结果为给定数值，比如24。在这个简单的例子中，我们找到两种解法：

1. (5-2)*(17-9)
2. (5+9)/2+17

大家都知道，这就是在文曲星中常见的24点游戏。用Haskell写一道程序做这个工作只需近一百行代码。有兴趣的话，则可以去Channel9看视频，这一课的讲授者是Graham Hutton博士，也就是”Programming in Haskell”的作者。从问题的表述到求解，看着很清晰自然。（我后来花了点时间想自己写，一时之间却也写不出来，知易行难！）

最有趣的还是优化工作，给定六个数的时侯回比较慢一点。但Dr. Graham介绍了一些技巧使得原本需要45秒的计算最终降为1秒以内。Awesome!

周末看了一篇”The Evolution of a Haskell Programmer“，里面列举了Haskell程序员写阶乘函数fac的各种实现方法，可以用两个成语来形容：琳琅满目、叹为观止。虽然感觉上有点类似孔乙己在纠缠茴香豆的茴字有几种写法，不过内容还真的挺有意思。其中有两个实现方法可以稍微聊一聊：1. CPS；2.利用Y combinator。

1. CPS - Continuation-passing style
   CPS是Gerald Jay Sussman和Guy L. Steele在1975年创建Scheme语言时提出的，其大意是处理的结果并不是像平时习惯的那样直接给出，而是给出一个临时结果。比如，写parser时，假设输入很复杂，我们不必一下给出解析的结果，而是步步为营。我们可以写出许多很简单，容易测试的小parser，比如parseNumber, parseString, 等等。每一步尝试一种解析，直到剩下的输入都不能被解析的为止。下面是个CPS风格的fac函数：
   > facCps k 0 = k 1
   > facCps k n = facCps (k . (n*)) (n - 1)
   > fac = facCps id
   • `.’在Haskell中是个函数组合算子，比如f (g x) = (f . g) x
   • (*) 在Haskell中是个函数，有两个参数，求得乘积。(n*)也是个函数，只有一个参数，如果给定m，则返回n*m — 这叫做currying，Haskell中所有函数都是currying的。
   • 函数id直接返回输入参数本身，比如id 3 = 3, id fac = fac
2. Y combinator
   Y combinator是递归函数理论中的重要概念，说它是计算机科学的奠基性基础理论也不为过 — MIT的计算机科学系的系徽就是它。它的数学形式是Y(f )= f (Y (f))，也就是说给定一个函数f，Y会求出该函数的不动点。有很多教程教你怎样一步步推导出Y函数，然而在Haskell中几乎直接原样照搬就行：
   > y f = f (y f)
   > fac = y (\f n -> if  n == 0 then 1 else n * f (n-1))
   • Haskell是lazy的，所以上面的递归定义没问题；
   • Haskell中函数名不能用大写字母开头，大写字母开头的是类名，类型名及其构造方法。

我以上帝的名义发誓，昨天我人品爆发居然写了个求平方根函数sqr = y (\f x -> x / f x)，因为y = x/y的不动点y’就是x的平方根，我敲了个sqr 3，居然得到1.732050… 精确到小数点后十几位 — 后来不能重现，每次都stack overflow — 而用稍微瞄一眼就知道这是应该的，因为这次没有递归结束条件，会无穷无尽递归下去。我确信没有误敲sqrt，从而调用了系统内置的平方根函数。莫非那是上帝开的小玩笑？:-)

源代码来自：http://www.cs.nott.ac.uk/~gmh/compiler.lhs

> data Expr                 =  Val Int | Add Expr Expr
>
> eval                      :: Expr -> Int
> eval (Val n)              =  n
> eval (Add x y)            =  eval x + eval y
>
> type Stack                =  [Int]
>
> type Code                 =  [Op]
>
> data Op                   =  PUSH Int | ADD
>
> exec                      :: Code -> Stack -> Stack
> exec []           s       =  s
> exec (PUSH n : c) s       =  exec c (n:s)
> exec (ADD    : c) (m:n:s) =  exec c (n+m:s)
>
> comp’                 :: Expr -> Code -> Code
> comp’ (Val n)   c     =  PUSH n : c
> comp’ (Add x y) c     =  comp’ x (comp’ y (ADD : c))
>
> comp                      :: Expr -> Code
> comp e                    =  comp’ e []

它只支持整型和求和，表达式转换成指令的列表后在堆栈上执行，结果放在栈顶。假设expr为 Add (Val 1) (Val 2)，则 comp expr 会得到 [PUSH 1,PUSH 2,ADD]，把这个结果丢给exec 则得到[3]。

*Main> let e = Add (Val 1) (Val 2)
*Main> exec (comp e) []
[3]

区区23行代码，代码之美，莫过于此！

第七课的小练习：http://www.cs.nott.ac.uk/~gmh/chapter7.ppt

> map’ :: (a -> b) -> [a] -> [b]
> map’ f = foldr (\a b -> (f a) : b) []
>
> filter’ :: (a -> Bool) -> [a] -> [a]
> filter’ f = foldr f’ [] where
>     f’ a b = if f a then a:b else b

本想自力更生试着用Haskell写个JSON解析器，一不小心网上一搜一大把，并且忍不住瞄了几眼。那就做个简单的修改加翻译吧，原文链接：http://snippets.dzone.com/posts/show/3660

> import Text.ParserCombinators.Parsec
> import System
> import qualified Data.Map as Map

引入一些必要的库，比如Parsec，祭起我们的利器哈！

> mainParser = do {
>               val <- valueParser
>             ; skipMany space
>             ; eof
>             ; return val
>             }

解析器的主函数，该函数以典型的Monad风格对输入数据调用valueParser函数进行解析，do中的操作是序列华的，每一个行都是一次匹配，这三行的意思是，它期待的输入的格式是JSON数据、可能的一些空字符、文件尾巴，如果解析成功就返回解析后的数据val。

> main :: IO ()
> main = do {
>         args <- getArgs
>       ; val <- parseFromFile mainParser $ args !! 0
>       ; print val
>       }

main函数先得到命令行参数存在列表args中，列表的第一个元素(args !! 0)作为文件名，parserFromFile是Parsec里的一个函数，它调用mainParser对命令行指定的文件进行解析，最后在打印出解析结果val。

> data JSON = ListValue [JSON]
>           | LiteralString String
>           | LiteralInt Integer
>           | LiteralBoolean Bool
>           | RecordValue (Map.Map String JSON)
>             deriving Show


上面的这些玩意儿叫做ADT，它的意思是：我们有JSON这样一种数据结构，它有五个构造函数ListValue, LiteralString, LiteralInt, LiteralBoolean和RecordValue，每个构造函数后面跟着的都是一种类型。最后，该数据结构继承所有Show类具有的行为 — 这使得JSON类型的数据可以用print显示出来。

有了上面的定义后，我们可以方便的构造出一些JSON类型的数据，比如：

LiteralString "abc"
LiteralInt 123

在GHC或者Hugs中可以用:t来显示给定输入的类型：

:t LiteralString "abc"
LiteralString "abc" :: JSON

这是说LiteralString “abc”是个JSON类型。好了，接下来写几个简单的parser，我们可以dive & conquer。第一个Parser用来识别字符串 — 字符串以’”‘开头，中间是一个或者多个字符，最后有个’”‘收尾。解析成功后会返回一个JSON类型的字符串。
> literalString :: Parser JSON
> literalString = do {
>     char '"'
>     ; val <- many1 letter
>     ; char '"'
>     ; return $ LiteralString val
>     }

接下来雷同的便是解析整型、布尔型：
> literalInt :: Parser JSON
> literalInt = do {
>     ; val <- many1 digit
>     ; return $ LiteralInt (read val)
>     }
>
> literalBoolean :: Parser JSON
> literalBoolean =
>         do {
>           string “true”
>         ; return $ LiteralBoolean True
>         }
>     <|> do {
>         string “false”
>         ; return $ LiteralBoolean False
>         }

这里’<|>’是个combinator，它用来连接两个parser，如果前一个解析不成功，就用下一个来解析。用’<|>’可以把整个JSON的解析写成如下形式：
> valueParser :: Parser JSON
> valueParser =
>      literalString
>  <|> literalInt
>  <|> literalBoolean
>  <|> recordParser
>  <|> listParser

其中还有两个parser没有实现：recordParser和listParser，分别用来解析object和array。list以’['打头，']‘结尾，其中的数据以’,'分割：
> listParser :: Parser JSON
> listParser = do {
>     char '['
>     ; words <- sepBy1 valueParser listSeparator
>     ; char ']‘
>     ; return $ ListValue words
>     }
>
> listSeparator :: Parser ()
> listSeparator = do {
>     skipMany space
>     ; char ‘,’
>     ; skipMany space
>     }

最后就是解析object啦，打完收功！
> recordParser :: Parser JSON
> recordParser = do {
>     char '{'
>     ; defs <- endBy definitionParser listSeparator
>     ; char '}'
>     ; return $ RecordValue $ Map.fromList defs
>     }
>
> definitionParser :: Parser (String, JSON)
> definitionParser = do {
>     skipMany space
>     ; key <- many1 letter
>     ; char ‘:’
>     ; skipMany space
>     ; val <- valueParser
>     ; return (key, val)
>     }
>
> definitionSeparator :: Parser ()
> definitionSeparator = do {
>     skipMany space
>     ; char ‘,’
>     ; skipMany space
>     ; return ()
>     }