第十二章：条形码识别

EAN-13编码¶

在考虑怎样解码EAN-13条形码之前，我们还是得先了解它是怎样被编码出来的。EAN-13的编码规则有一点复杂。我们先从计算校验码——即数字串的最后一位开始。

-- file: ch12/Barcode.hs
checkDigit :: (Integral a) => [a] -> a
checkDigit ds = productSum `mod` 10 `mod` 10
    where productSum = sum products (mapEveryOther (*3) (reverse ds))

mapEveryOther :: (a -> a) -> [a] -> [a]
mapEveryOther f = zipWith ($) (cycle [f,id])

[译注1：原文对checkDigit函数的实现有问题，翻译时用了比较直接的方法修正了代码，并相应的修改了下面一段正文中对代码的描述]

[译注2：你可能觉得如果把 mapEveryOther 中的 f 和 id 两个列表元素的位置对调的话，就可以省略掉 checkDigit 的where块中的 reverse 过程。事实上这个reverse过程是必须的，而且 f 和 id 也不能对调。因为EAN-13的标准规定，“将序列中的最右侧的数字规定为 奇数位，从最右侧开始，其余数字被交替记为 偶数位 和 奇数位，而只有奇数位的数字会被乘以3。如果采取最开始说的方法，那么假如输入的序列包含偶数个元素的话，那么整个计算过程就是错误的。这一点的重要性在后文会有体现。]

直接看代码应该比文字描述更有助于理解校验码的计算方法。函数从数字串的最右一位数字开始，每隔一位就将该数字乘以3，其余保持原状。接下来对处理后的列表求和，校验码就是将这个列表的和对10取模两次得到的结果。

条形码是一系列定宽的条纹，其中黑色的条纹表示二进制的“1”，白色的条纹表示二进制的“0”。表示相同二进制的条纹值连续排列看起来就是宽一些的条纹。

条形码中的各个二进制位的顺序如下：

• 头部保护序列，固定编码101。
• 一个由六个数字组成的分组，其中每个数字由7个二进制位表示
• 另一个保护序列，固定编码01010
• 另一个六个数字的组成的分组 (译注：每个数字也由7个二进制位表示)
• 尾部保护序列，固定编码101

左右两个分组中的数字有不同的编码。左侧分组的数字编码包含了校验位(parity bit)，而校验位编码了条形码的第13个数字。

[译注：请注意区分此处所提到的校验位(parity bit)以及后面会经常提及的校验码(check digit)，在本文中，只需要将这个校验位理解为一种只由二进制编码模式(pattern)来区分(而不是“计算”)的信息，并且了解它只包含奇和偶两种取值即可，没必要深究“哪一位是校验位”。]

数组与惰性¶

填充数组的列表包含的元素数目至少要与数组容量相等。如果列表中没有提供足够多的元素，那么程序在运行时就可能发生错误。这个错误发生的时机取决于数组的性质。

我们这里用到的数组类型对数组的元素采用了非严格求值。如果我们想用一个包含三个元素的列表填充一个多于三个元素的数组，那么其余的元素将是未定义的。但是只有我们试图访问超过第三个元素的时候才会发生错误。

ghci> let a = listArray (0,5) "bar"
ghci> a ! 2
'r'
ghci> a ! 4
*** Exception: (Array.!): undefined array element

Haskell也提供了严格求值的数组，它们会在上述场景中会有不同的行为。我们将在“拆箱，抬举，和bottom”一章中讨论两种数组之间的取舍。

数组的折叠¶

bounds 函数返回在创建数组时用来指定边界的元组。 indices 函数返回数组中各个索引值组成的列表。我们可以用它们来定义实用的折叠函数，因为 Data.Array 模块本身并没有提供用于数组的折叠函数。

-- file: ch12/Barcode.hs
-- | Strict left fold, similar to foldl' on lists.
foldA :: Ix k => (a -> b -> a) -> a -> Array k b -> a
foldA f s a = go s (indices a)
	where go s (j:js) = let s' = f s (a ! j)
                    	in s' `seq` go s' js
      	go s _ = s

-- | Strict left fold using the first element of the array as its
-- starting value, similar to foldl1 on lists.
foldA1 :: Ix k => (a -> a -> a) -> Array k a -> a
foldA1 f a = foldA f (a ! fst (bounds a)) a

你可能很好奇为什么数组模块不预置像折叠函数这么有用的东西。我们会发现一维数组和列表之间有一些明显的相似性。例如，都只有两种自然的方式来折叠他们：从左向右折叠或者从右向左折叠。此外，每次都只能折叠一个元素。

上述这些相似性对于二维数组就已经不再成立了。首先，在二维数组上有意义的折叠方式有很多种。我们也许仍然想要逐个元素地进行折叠，但是对二维数组，还可以逐行折叠或者逐列折叠。其次，就算同样是逐个元素折叠，在二维数组中也不再是只有两种遍历方式了。

换句话讲，对于二维数组来说，有意义操作组合太多了，可也没什么足够的理由选取其中一部分添加到标准库。这个问题只存在于多维数组，所以最好还是让开发人员自己编写合适的折叠函数。从上面的例子也可以看出，这其实没什么难度。

修改数组元素¶

尽管存在用来“修改”不可变数组的函数，但其实都不怎么实用。以 accum 函数为例，它接受一个数组和一个由 (索引，元素值) 值对构成的列表，返回一个新数组，其中所有在指定索引位置的元素都被替换为指定的元素值。

由于数组是不可变的，所以哪怕只是修改一个元素，也需要拷贝整个数组。哪怕对于中等规模的数组，这种性能开销也可能很快变得难以承受。

Data.Array.Diff模块中的另一个数组类型DiffArray，尝试通过保存数组的连续版本之间的变化量来减少小规模修改造成的开销。遗憾的是，在编写本书的时候它的实现还不是很高效，对于实际应用来说，它还是太慢了。

习题¶

让我们简单的探索一下用元组替代数组的可行性

1. 编写一个函数，它接受如下两个参数：一个由4个元素组成的元组，一个整数。整数参数为0的时候，该函数应返回元组中最左侧的元素。整数参数为1的时候，返回后一个元素，依此类推。为了使该函数能通过类型检查，你需要对参数的类型做怎样的限制？
2. 写一个与上面类似的函数，第一个参数改为6个元素组成的元组。
3. 尝试重构上面的两个函数，让它们共用尽可能多的代码。你能找到多少可以共用的代码？

分析彩色图像¶

我们之前说过，我们的解码器将只支持netpbm图像。netpbm彩色图像格式只稍微比第十章中处理的灰度图像格式复杂一点点。其头部的识别串为“P6”,头部的其余部分都和灰度格式完全一样。在图像文件的主体部分，每个像素都由3个字节表示，分别对应红、绿、蓝3个颜色分量。

我们将图像数据表示为像素构成的二维数组。为了帮我们积累数组的使用经验，此处将完全采用数组实现。但实际上对于这个应用来说，我们用“列表的列表”代替数组也可以。因为数组在这里的优势不明显，它的唯一的好处就是很方便取整行。

-- file: ch12/Barcode.hs
type Pixel = Word8
type RGB = (Pixel, Pixel, Pixel)

type Pixmap = Array (Int,Int) RGB

我们定义了一些类型的同义词来提高类型签名的可读性。

Haskell为数组提供了相当高的自由度，我们必须维数组选择一种合适的表示形式。这里我们将采取保守的方案，并遵守一个普遍的约定：索引值从0开始。我们不需要显式的存储图像的尺寸，因为用 bounds 函数可以从数组直接提取尺寸。

最终的解析器实现相当的简短，这都多亏了我们在第十章中开发的组合子。

-- file: ch12/Barcode.hs
parseRawPPM :: Parse Pixmap
parseRawPPM =
    parseWhileWith w2c (/= '\n') ==> \header -> skipSpaces ==>&
    assert (header == "P6") "invalid raw header" ==>&
    parseNat ==> \width -> skipSpaces ==>&
    parseNat ==> \height -> skipSpaces ==>&
    parseNat ==> \maxValue ->
    assert (maxValue == 255) "max value out of spec" ==>&
    parseByte ==>&
    parseTimes (width * height) parseRGB ==> \pxs ->
    identity (listArray ((0,0),(width-1,height-1)) pxs)

parseRGB :: Parse RGB
parseRGB = parseByte ==> \r ->
        parseByte ==> \g ->
        parseByte ==> \b ->
        identity (r,g,b)

parseTimes :: Int -> Parse a -> Parse [a]
parseTimes 0 _ = identity []
parseTimes n p = p ==> \x -> (x:) <$> parseTimes (n-1) p

上面的代码中唯一需要注意的是 parseTimes 函数，它会将一个分析器调用指定的次数，最后构造出一个分析结果组成的列表。

灰度转换¶

我们需要将彩色图像的色彩数据转换为黑白的形式。其中一个步骤是将色彩数据转换为灰度数据。有一个简单并广泛应用的公式 [29] 可以将彩色图像转换为灰度图像，该公式基于每个色彩通道的相对亮度来计算灰度信息。

-- file: ch12/Barcode.hs
luminance :: (Pixel, Pixel, Pixel) -> Pixel
luminance (r,g,b) = round (r' * 0.30 + g' * 0.59 + b' * 0.11)
    where r' = fromIntegral r
          g' = fromIntegral g
          b' = fromIntegral b

Haskell中的数组都是 Functor 类型类的成员，所以我们可以直接用 fmap 函数一次性将整张图片或者单行扫描线从彩色格式转为灰度格式。

-- file: ch12/Barcode.hs
type Greymap = Array (Int,Int) Pixel

pixmapToGreymap :: Pixmap -> Greymap
pixmapToGreymap = fmap luminance

上面给出来的 pixmapToGreymap 函数只是拿来举个例子，因为我们只需要检查图片的部分行来提取可能存在的条形码，也就没必要在以后用不到的数据上做多余的转换工作了。

灰度二值化和类型安全¶

接下来要处理的子问题是如何将灰度图像转换为二值图像，二值图像的每个像素都只处于“打开”或“关闭”两种状态之一。

..FIXME: 此处的digit做value译.. FIXME: 本段里的bit应该是指pixel

在一个图像处理程序中通常需要同时处理大量的数值，有时为了方便，可能会把同一种数值类型用于不同的目的。例如，我们只要约定数字1表示一个像素处于“打开”状态，而0表示一个像素处于“关闭”状态，就可以直接使用 Pixel 类型表示像素的开/关状态了。

然而，这种做法有潜在的迷惑性。如果想知道某个特定的 Pixel 类型的值究竟是代表一个数值还是一个“开”/“关”状态，就不能靠类型签名轻易确定了。在某些场景中，我们可能很轻易的就使用了错误类型的数值，而且编译器也不会检查到错误，因为这个值的类型与签名指定的类型是吻合的。

我们可以尝试通过引入类型别名来解决这个问题。和前文中把 Pixel 声明为 Word8 的别名一样，我们也可以把 Bit 类型声明为 Pixel 类型的别名。这么做虽然可能提高一定的可读性，但类型别名还是不会让编译器替我们做什么有用的工作。

编译器将把Pixel和Bit当做完全相同的类型，所以就算把 Pixel 类型的值253传给一个接受Bit类型的值(0或1)的函数，编译器也不会报错。

如果另外定义一个单色(monochrome)类型，编译器就会阻止我们像上述的例子那样意外混用不同类型。

-- file: ch12/Barcode.hs
data Bit = Zero | One
           deriving (Eq, Show)

threshold :: (Ix k, Integral a) => Double -> Array k a -> Array k Bit
threshold n a = binary <$> a
    where binary i | i < pivot  = Zero
                    | otherwise  = One
          pivot    = round $ least + (greatest - least) * n
          least    = fromIntegral $ choose (<) a
          greatest = fromIntegral $ choose (>) a
          choose f = foldA1 $ \x y -> if f x y then x else y

threshold 函数会先计算输入数组中的最大值和最小值，结合参数提供的一个介于0到1之间的阈值，求出一个“枢轴”(pivot)值。对于数组中的每个元素，如果该元素的值小于这个枢轴值，则计算结果为 Zero ，否则结果为 One 。注意到这里我们用到了一个在 数组的折叠 一节中编写的折叠函数。

[译注：针对这段代码，需要指出一个关于RGB颜色模式的注意点。在前面我们通过 luminance 函数将要给彩色图片中的像素中的三个颜色分量转换为了一个灰度值，这个灰度值可以理解为“当一个RGB颜色的三个分量同时取该值的时候该像素的颜色”。在这个定义下，纯白色的灰度值为255，随着灰度值越来越小，这个颜色将会呈现为越来越深的灰色，直到灰度值为0，此时该像素为纯黑色。可见这里有一个比较反直觉的地方，即“灰度值越大，颜色越浅”。这个特征反映到二值化函数 threshold 的返回值中就是“深色的像素返回值为 Zero ，浅色的像素返回值为 One ”。]

游程编码¶

我们如何解决线条宽度的问题呢。答案就是对图像数据进行游程编码(run length encode)。

-- file: ch12/Barcode.hs
type Run = Int
type RunLength a = [(Run, a)]

runLength :: Eq a => [a] -> RunLength a
runLength = map rle . group
    where rle xs = (length xs, head xs)

group 函数会把一个列表中所有连续的相同元素分别放入一个子列表中。

group [1,1,2,3,3,3,3]
[[1,1],[2],[3,3,3,3]]

我们的 runLength 函数将( group 返回的列表中的)每个子列表表示为子列表长度和首个元素组成的对。

ghci>  let bits = [1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1]
ghci>  runLength bits
Loading package array-0.1.0.0 ... linking ... done.
Loading package containers-0.1.0.1 ... linking ... done.
Loading package bytestring-0.9.0.1 ... linking ... done.
[(2,1),(2,0),(2,1),(2,0),(6,1),(2,0),(4,1)]

[译注：上述ghci输出的最后一行的列表中，每一个“长度-值”对就是一个“游程”]

由于我们进行游程编码的数据只包含0和1，因此编码的数字只会在0和1两个值之间变化。既然这样，我们就可以只保留长度而丢弃被编码数字，而不会丢失任何有用的信息。

-- file: ch12/Barcode.hs
runLengths :: Eq a => [a] -> [Run]
runLengths = map fst . runLength

ghci> runLengths bits
[2,2,2,2,6,4,4]

上面给出的位模式并不是我们随便编出来的；而是上面我们捕获的图像中的某一行里面的编码的左侧保护序列和第一个编码数字。如果我们丢弃表示保护序列的条纹，游程编码后的值就是[2, 6, 4, 4]。我们怎样在“引入数组”一节中的编码表中找到匹配的位模式呢？

[译注1：此处稍微做一下展开。首先，在 灰度二值化和类型安全 一节中我们已经知道， Zero 才是代表黑色条纹的值。此处的0是与 Zero 对应的，它同样表示黑色条纹，相应的，1表示白色条纹，与 EAN-13编码 一节中介绍EAN-13条码编码格式时约定的0/1所代表的颜色相反，再次请读者留心这点，因为接下来的内容都会遵守这个约定。]

[译注2：如果你实在看不出这个游程编码的值是如何表示之前捕获的图像中数字的，这里我们来详细解释一下。前文说过，由于条纹在照片中的实际宽度受到拍摄距离等因素的影响，因此我们不能对其有任何假设。而且一般来说，条形码中表示每1位的条纹所占的宽度几乎不可能只有1个像素，而是会由纵向上的复数个像素表示一位。比方说上面给出的序列，很明显就是用了两个像素来表示每个1个二进制位，其实际表示的二进制序列为“01010001100”(0为黑色，1为白色)，当”以1为黑色，0为白色”时，该序列即“10101110011”。这样就可以看出，该序列就是由“101”(左侧保护序列)和“0111001”(倒数第2位识别错误的“7”的奇校验编码)以及下一位数字的第一个二进制位”0”组成的了。]

缩放游程，查找相近的匹配¶

一个合理的方法是缩放这些游程编码值，让它们的和为1。我们将使用 Ratio Int 类型替代一般的 Double 类型来保存这些缩放后的值，因为 Ratio 值在 ghci 的输出中可读性更好。这点可以为交互式调试与开发提供方便。

-- file: ch12/Barcode.hs
type Score = Ratio Int

scaleToOne :: [Run] -> [Score]
scaleToOne xs = map divide xs
    where divide d = fromIntegral d / divisor
        divisor = fromIntegral (sum xs)
-- A more compact alternative that "knows" we're using Ratio Int:
-- scaleToOne xs = map (% sum xs) xs

type ScoreTable = [[Score]]

-- "SRL" means "scaled run length".
asSRL :: [String] -> ScoreTable
asSRL = map (scaleToOne . runLengths)

leftOddSRL = asSRL leftOddList
leftEvenSRL = asSRL leftEvenList
rightSRL = asSRL rightList
paritySRL = asSRL parityList

我们定义了类型别名 Score，这样其余的大部分代码就不需要关心 Score 底层的类型是什么。当我们的代码开发完毕，一头埋进 ghci 做后续调试的时候，只要我们愿意，我们还是能把“ Score ”对应的底层类型改为 Double ，而不需要修改其它代码。

我们可以用 scalarToOne 函数来缩放我们所要寻找的数字序列。我们解决了拍摄距离所导致的条纹宽度不能确定的问题。现在，在缩放后的游程编码表和从图像中的提取出游程编码序列间应该有十分接近的匹配。

接下来的问题是如何将直观感觉上的“十分接近”转化为对“足够接近”的度量。给出两个缩放过的长度序列，我们可以像下面这样计算出一个大概的“差异度”(distance)。

精确匹配的两个值之间的差异度是0，匹配程度越低，差异度的值就越大。

ghci> let group = scaleToOne [2,6,4,4]
ghci> distance group (head leftEvenSRL)
13%28
ghci> distance group (head leftOddSRL)
17%28

对给定的一个经过缩放的游程编码表，我们从中选择与输入序列最接近的几个匹配结果。

-- file: ch12/Barcode.hs
bestScores :: ScoreTable -> [Run] -> [(Score, Digit)]
bestScores srl ps = take 3 . sort $ scores
    where scores = zip [distance d (scaleToOne ps) | d <- srl] digits
          digits = [0..9]

列表推导式¶

我们在上面的例子中引入的新表示法叫做 列表推导式(list comprehension) ，列表推导式可以以一个或多个列表为基础创建新列表。

ghci> [ (a,b) | a <- [1,2], b <- "abc" ]
[(1,'a'),(1,'b'),(1,'c'),(2,'a'),(2,'b'),(2,'c')]

竖线右侧的每一个 生成器表达式(generator expression) 组合，都会代入到竖线左侧的表达式中求值。生成表达式绑定了左侧的变量a，a又用“<-”绑定到右侧的元素列表。正如上面的例子展示的，生成表达式的组合将按照深度优先的顺序遍历：先是第一个列表的第一个元素分别与第二个列表中的每个元素分别组合，以此类推。

我们还可以在列表推导式的右侧为生成器指定guard。guard是一个 Bool 表达式。如果guard的值为 False , 则该元素被跳过。

ghci> [ (a,b) | a <- [1..6], b <- [5..7], even (a + b ^ 2) ]
[(1,5),(1,7),(2,6),(3,5),(3,7),(4,6),(5,5),(5,7),(6,6)]

其中还可以用 let 表达式绑定本地变量(local variable)。

ghci> let vowel = (`elem` "aeiou")
ghci> [ x | a <- "etaoin", b <- "shrdlu", let x = [a,b], all vowel x ]
["eu","au","ou","iu"]

如果生成器表达式中的某个模式匹配失败了，那么也不会有错误发生，只会跳过未匹配的列表元素。

ghci> [ a | (3,a) <- [(1,'y'),(3,'e'),(5,'p')] ]
"e"

列表推导式功能强大用法简洁，但可能不太容易看懂。如果能小心使用，它也可以让我们的代码更容易理解。

-- file: ch12/Barcode.hs
-- our original
zip [distance d (scaleToOne ps) | d <- srl] digits

-- the same expression, expressed without a list comprehension
zip (map (flip distance (scaleToOne ps)) srl) digits

-- the same expression, written entirely as a list comprehension
[(distance d (scaleToOne ps), n) | d <- srl, n <- digits]

记录匹配数字的奇偶性¶

对左侧分组数字的每一个匹配，我们必须记录它是在奇校验编码表还是偶校验编码表中匹配到的。

-- file: ch12/Barcode.hs
data Parity a = Even a | Odd a | None a
                deriving (Show)

fromParity :: Parity a -> a
fromParity (Even a) = a
fromParity (Odd a) = a
fromParity (None a) = a

parityMap :: (a -> b) -> Parity a -> Parity b
parityMap f (Even a) = Even (f a)
parityMap f (Odd a) = Odd (f a)
parityMap f (None a) = None (f a)

instance Functor Parity where
    fmap = parityMap

我们将匹配到的数字包装在该数字的实际编码所采用的奇偶性内，并且使它成为一个 Functor 实体，这样我们就可以方便的操作奇偶编码值(parity-encoded values)了。

[译注：此处所说的“奇偶编码值”可以理解为“对同一个数字同时具有奇校验编码和偶校验编码两种形式的编码值”(即左分组中所有的编码值都是“奇偶编码值”)，为了简化描述，后文也会采用这种简称，请读者留意。]

我们可能需要对奇偶编码值按它们包含的数字进行排序。 Data.Function 模块提供的一个好用的组合子 on 可以帮助我们实现这个功能。

-- file: ch12/Barcode.hs
on :: (a -> a -> b) -> (c -> a) -> c -> c -> b
on f g x y = g x `f` g y

compareWithoutParity = compare `on` fromParity

它的作用可能不是很明确，你可以试着去想象这样一个函数：它接受两个参数f和g，返回值是一个函数，这个返回的函数也有两个参数，分别为 x 和 y 。 on 将 g 分别对 x 和 y 应用，然后将 f 应用于这两个结果(所以它的名字叫 on )。

把匹配数字装入奇偶性的方法一目了然。

-- file: ch12/Barcode.hs
type Digit = Word8

bestLeft :: [Run] -> [Parity (Score, Digit)]
bestLeft ps = sortBy compareWithoutParity
          	((map Odd (bestScores leftOddSRL ps)) ++
           		(map Even (bestScores leftEvenSRL ps)))

bestRight :: [Run] -> [Parity (Score, Digit)]
bestRight = map None . bestScores rightSRL

一旦在奇校验表或偶校验表里找到了左侧分组某个编码的几个最佳匹配，我们就可以将他们按照匹配的质量排序。

键盘惰性¶

定义 Parity 类型时,我们可以使用haskell的记录( record )语法来避免手写formParity函数。也就是说，可以这么写：

-- file: ch12/Barcode.hs
data AltParity a = AltEven {fromAltParity :: a}
             	| AltOdd  {fromAltParity :: a}
             	| AltNone {fromAltParity :: a}
               	deriving (Show)

那我们为什么没这么做呢？答案说起来有些丢人，而且与 ghci 的交互调试有关。当我们告诉GHC让它自动把一个类型派生为 Show 的实体时，GHC会根据我们是否使用记录语法来定义这个类型而生成不同的代码。

ghci> show $ Even 1
"Even 1"
ghci> show $ AltEven 1
"AltEven {fromAltParity = 1}"
ghci> length . show $ Even 1
6
ghci> length . show $ AltEven 1
27

使用记录语法定义生成的Show实体明显很“啰嗦”，同时这也会给调试带来很大的干扰。比方说在我们检查 ghci 输出的奇偶编码值列表的时候，这样的输出结果会特别长以至于我们不得不一行行地扫读输出结果。

当然我们可以手动实现干扰更少的Show实体。避开记录语法写起来也更简洁，而且通过编写我们自己的 formParity 函数可以让GHC帮我们派生输出更简洁的 Show 实例。其实也并不是非这么做不可，但是程序员的惰性有时也的确会为代码引入一些特别的做法。

列表分块¶

使用列表时常常需要对它进行分块(chunk)。例如，条形码中的每个数字都由四个连续的数字编码而成。我们可以将表示一个行的列表转换为如下这种包含四个元素的列表组成的列表。

-- file: ch12/Barcode.hs
chunkWith :: ([a] -> ([a], [a])) -> [a] -> [[a]]
chunkWith _ [] = []
chunkWith f xs = let (h, t) = f xs
             	in h : chunkWith f t

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = chunkWith (splitAt n)

像这种需要手写泛型的列表操作函数的情况比较罕见。因为一般在 Data.List 模块里翻一翻就能找到完全符合要求或者基本满足需要的函数。

生成候选数字列表¶

这几个辅助函数一旦就绪，为每个数字分组生成候选匹配的函数也就很容易搞定了。 首先，我们先得做一些前期的检查，来确定这些匹配是否都是有意义的。只有以黑色( Zero )条纹开始，并且条纹数量足够多的游程列表才是有意义的。下面是这个函数中的前几个等式。

-- file: ch12/Barcode.hs
candidateDigits :: RunLength Bit -> [[Parity Digit]]
candidateDigits ((_, One):_) = []
candidateDigits rle | length rle < 59 = []

[译注：代码中的59表示条形码中的条纹数，它是这样求出的：3(左侧保护序列101)+4x6(每个数字的条纹数目4x左侧分组的数字数)+5(两个分组中间的保护序列10101)+4x6(同左分组)+3(右侧保护序列) = 59。]

只要任意一次 bestLeft 或 bestRight 的应用得到一个空列表，我们都不能返回有效结果。否则，我们将丢弃 Score 值，返回一个由标记了编码奇偶性的候选数字列表组成的列表。外部的列表有12个元素，每个元素都代表条形码中的一个数字。子列表中的每个数字都根据匹配质量排序。

下面给出这个函数的其余部分

-- file: ch12/Barcode.hs
candidateDigits rle
    | any null match = []
    | otherwise      = map (map (fmap snd)) match
  where match = map bestLeft left ++ map bestRight right
        left = chunksOf 4 . take 24 . drop 3 $ runLengths
        right = chunksOf 4 . take 24 . drop 32 $ runLengths
        runLengths = map fst rle

我们看一看从上面图像中提取出的每个线条分组(表示一个数字的四个线条算作一组)对应的候选数字。

ghci> :type inputinput :: [(Run, Bit)]ghci> take 7 input[(2,Zero),(2,One),(2,Zero),(2,One),(6,Zero),(4,One),(4,Zero)]ghci> mapM_ print $ candidateDigits input[Even 1,Even 5,Odd 7,Odd 1,Even 2,Odd 5][Even 8,Even 7,Odd 1,Odd 2,Odd 0,Even 6][Even 0,Even 1,Odd 8,Odd 2,Odd 4,Even 9][Odd 1,Odd 0,Even 8,Odd 2,Even 2,Even 4][Even 3,Odd 4,Odd 5,Even 7,Even 0,Odd 2][Odd 2,Odd 4,Even 7,Even 0,Odd 1,Even 1][None 1,None 5,None 0][None 1,None 5,None 2][None 4,None 5,None 2][None 6,None 8,None 2][None 7,None 8,None 3][None 7,None 3,None 8]

答案的森林¶

但事实上，用不了可变的数组和散列表并没有想象中那么悲剧。数组和散列表经常被用作由键索引的值的集合，而在Haskell中，我们使用 树 来实现这个功能。

在Haskell中实现一个简单的树类型非常简单。不仅如此，更实用的树类型实现起来也是出奇的简单。比方说红黑树。红黑树这种自平衡结构，就是因为其平衡算法出了名的难写，才让几代CS在校生闻风丧胆。

综合运用Haskell的代数数据类型组合、模式匹配、guard等特性可以把最可怕的平衡操作的代码缩减至只有短短几行。但是我们先不急着构造树类型，先来关注为什么它们在纯函数式语言中特别有用。

对函数式程序员来说，树的吸引力在于修改代价低。我们不用打破不可变原则：树就和其他东西一样不可变。然而，我们修改一棵树的时候，可以在新旧两棵树之间共享大部分的结构。举例来说，有一颗有10000个节点的树，我们可能想要在里面添加或者移除一个节点，这种情况下，新旧两棵树能够共享大约9985个节点。换句话说，每次更新树的时候所需要修改的元素数目取决于树的高度，或者说是节点数的对数。

Haskell标准库提供了两种采用平衡树实现的集合类型：Data.Map用于键/值对， Data.Set 用于集合。鉴于在下一节会用到 Data.Map ，我们就先简要地介绍一下这个模块。 Data.Set 与 Data.Map 很相似，相信你应该也能很快掌握。

map简介¶

Data.Map 模块提供了参数化类型 Map k a ,将键类型k映射到关联值类型a。尽管其内部为一个size-balanced tree，但是它的实现对我们是不可见的。

[译注1：Size-Balanced Tree（SBT）是一种通过大小(Size)域来保持平衡的二叉搜索树，因此得名。]

[译注2：原文对于value的使用有些混乱。为了明确表达，从此处开始，key都译为“键”，而value在表达“map中由key所映射到的值”时都译为“映射值”]

Map 的键是严格求值的，但是映射值却是非严格求值。换句话说，map的 脊柱 ，或者说结构，是一直在更新的，但是map中映射的值还是要等到我们强迫对它们求值的时候才被计算出来。

记住这点很重要，因为对于不期望内存泄漏的程序员来说， Map 类型对映射值采用的惰性求值策略往往是内存泄漏的源头。

由于 Data.Map 模块包含几个与 Prelude 模块中冲突的名字，所以它通常用限定形式导入。本章靠前的部分中，我们再导入它时添加了一个前缀 M 。

类型约束¶

Map类型并不对键值的类型做任何显式的约束，但是该模块中多数实用函数都要求键类型为 Ord 类型类的实体。需要强调的是，这里体现了Haskell中一个常见设计模式： 类型约束的设置应该推迟到最终应用的地方，而不需要库作者为这种事情做额外劳动。

Map 类型和该模块中的函数都没有对映射值的类型设置约束。

部分应用时的尴尬¶

由于某些原因，Data.Map 模块中的某些函数的类型签名并不便于部分应用。函数操作的map总是作为最后一个参数，但是它们是第一个参数才更便于局部应用。结果造成使用部分应用Map函数的代码几乎总得通过适配函数(adapter function)来调整参数顺序。

map API入门¶

Data.Map 模块有一个巨大的“暴露区”(surface area)：它导出了很多函数。而其中只有为数不多的几个函数算得上是该模块中最常用的核心部分。

如果需要创建一个空的 map ,可以使用 empty 函数。如果要创建包含一个键/值对的 map ，则应该使用 singleton 函数。

ghci> M.empty
Loading package array-0.1.0.0 ... linking ... done.
Loading package containers-0.1.0.1 ... linking ... done.
fromList []
ghci> M.singleton "foo" True
fromList [("foo",True)]

由于 Map 的实现对我们是透明的，我们就无法对 Map 类型的值进行模式匹配。不过，该模块提供了一些查找函数可供我们使用，其中有两个函数应用特别广泛。查找函数有一个稍微复杂的类型签名，但是不要着急，这些很快在第14章中都会弄明白的。

ghci> :type M.lookup
M.lookup :: (Ord k, Monad m) => k -> M.Map k a -> m a

返回值中的类型参数m通常是Maybe类型。话句话说，如果map中包含具有给定键的映射值，lookup函数会把映射值装入 Just 返回。否则返回 Nothing 。

ghci> let m = M.singleton "foo" 1 :: M.Map String Int
ghci> case M.lookup "bar" m of { Just v -> "yay"; Nothing -> "boo" }
"boo"

findWithDefault 函数额外指定一个参数值，如果map中不包含查找的键，则返回该指定值。

要在map中添加一个键值对，最有用的函数是 insert 和 insertWith’ 。insert函数就是简单的在map中插入键/值对，如果该键已经存在，则覆盖其关联的任何值。

ghci> :type M.insert
M.insert :: (Ord k) => k -> a -> M.Map k a -> M.Map k a
ghci> M.insert "quux" 10 m
fromList [("foo",1),("quux",10)]
ghci> M.insert "foo" 9999 m
fromList [("foo",9999)]

insertWith' 函数会额外接受一个 组合函数(combining function) 。如果map中没有指定的键，就把该键/值对原封不动插入。否则，就先对新旧两个映射值应用组合函数，把应用的结果作为新的映射值更新到map中。

ghci> :type M.insertWith'
M.insertWith' :: (Ord k) => (a -> a -> a) -> k -> a -> M.Map k a -> M.Map k a
ghci> M.insertWith' (+) "zippity" 10 m
fromList [("foo",1),("zippity",10)]
ghci> M.insertWith' (+) "foo" 9999 m
fromList [("foo",10000)]

函数名最后的钩号暗示我们 insertWith' 将对组合函数严格求值。这个设计帮你避免了内存泄漏。该函数同时存在一个惰性的变种(即没有最后钩号的 insertWith )，但你大概永远用不到它。

delete 函数从map中删除指定键。如果键不存在的话， delete 会将map原封不动返回。

ghci> :type M.delete
M.delete :: (Ord k) => k -> M.Map k a -> M.Map k a
ghci> M.delete "foo" m
fromList []

最后，还有几个常用的函数用于在maps上进行类似集合的操作。例如，我们接下来会用到的 union。这个函数是“左偏”(left biased)的：如果两个map包含相同的键，返回map中将包含左侧map中对应的关联值。

ghci> m `M.union` M.singleton "quux" 1
fromList [("foo",1),("quux",1)]
ghci> m `M.union` M.singleton "foo" 0

fromList [("foo",1)]

到此我们仅仅讲到了Data.Map中百分之十的API。在第13章中我们会更加广泛深入的讲解其中的API。我们鼓励你自行浏览模块的文档，相信你会从中获得更多启发。这个模块滴水不漏的设计一定会让你印象深刻。

延伸阅读¶

[Okasaki99]一书将教我们如何优雅且严密地实现纯函数式数据结构，其中包括多种平衡树。该书还中还包含了作者对于纯函数式数据结构和惰性求值的宝贵思考。

我们把Okasaki这本书列为为函数式程序员的必读书目。如果你不方便翻阅Okasaki这本书，可以去看Okasaki的博士论文，[Okasaki96]是该书的一个不很完整的精简版本，在网上可以免费获得。

批量求解校验码¶

我们暂时不考虑搜索的方案，先来关注如何计算校验码。条形码的校验码可以是十个数字中的任意一个。对于一个给定的校验码，怎样反推出它是从怎样的输入序列中计算出来的呢？

-- file: ch12/Barcode.hs
type Map a = M.Map Digit [a]

在这个map中，键值是一个校验码，映射值是一个可以计算出这个校验码的序列。以它为基础，我们进一步定义两种map类型。

我们将把这两种类型的map统称为“答案map”(solution map)，因为它们包含了“求解”每个校验码对应的各个数字序列。

给定一个数字，我们可以按如下方法更新一个给定的答案map

-- file: ch12/Barcode.hs
updateMap :: Parity Digit       -- ^ new digit
          -> Digit              -- ^ existing key
          -> [Parity Digit]     -- ^ existing digit sequence
          -> ParityMap          -- ^ map to update
          -> ParityMap
updateMap digit key seq = insertMap key (fromParity digit) (digit:seq)

insertMap :: Digit -> Digit -> [a] -> Map a -> Map a
insertMap key digit val m = val `seq` M.insert key' val m
    where key' = (key + digit) `mod` 10

从map中取出一个既存的校验码，一个可以求出该校验码的序列，一个新的输入数字，这个函数将可以求出新的校验码的新序列更新至map。

这部分内容可能有点不太好消化，看一个例子应该会更明白。我们假设现在要查找数字是 4 ，它是序列 [1, 3] 对应的校验码，我们想要添加到map的数字是 8 。 4+8 ，模10得 2 ，那么 2 就是要插入到map中的键。能计算出新校验码 2 的序列就是 [8, 1, 3] ，这个序列就是要插入的映射值。

[译注： 在实际调用 updateMap 函数的时候， digit 是一个候选数字，key是指“在插入候选数字 new 之前，由这个不完整的‘猜测’序列算出的临时校验码”， seq 就是 key 所对应的“不完整的‘猜测’序列(指条形码的编码数字序列)”。 updateMap 的实际功能就是将 digit 插入到列表 seq 的最前面，然后由插入的seq再求出一个校验码的临时值。并以这个临时值和插入后的序列分别为键值和映射值，插入到指定的map中。这之中需要注意的地方是在 insertMap 函数中，key' 表示新求出的临时校验码，这个校验码的算法与前文checkDigit的算法并不相同：没有对输入序列进行 mapEveryOther (*3) (reverse ds) 和类似 (10 -) 这样的计算。实际上，这两个操作只是被推迟了，并且由于校验码只有一位数，因此校验码的值与“(10 - 校验码)”的值也是一一对应的(即“单射”)，所以map中保存这个没有经过 (10 - ) 操作的键值也是没有问题的，只要在需要提取真正的校验码时用10减去这个键值就可以了，除了这些之外，其计算方法与 checkDigit 函数中的方法是等价的。]

对候选数字序列中的每一个数字，我们都会通过当前数字和之前的map生成一个新的答案map。

-- file: ch12/Barcode.hs
useDigit :: ParityMap -> ParityMap -> Parity Digit -> ParityMap
useDigit old new digit =
    new `M.union` M.foldWithKey (updateMap digit) M.empty old

我们再通过一个例子演示这段代码的实际功能。这次，我们用ghci交互演示。

ghci> let single n = M.singleton n [Even n] :: ParityMap
ghci> useDigit (single 1) M.empty (Even 1)
fromList [(2,[Even 1,Even 1])]
ghci> useDigit (single 1) (single 2) (Even 2)
fromList [(2,[Even 2]),(3,[Even 2,Even 1])]

[译注：这个函数的参数中， old 代表上一候选数字应用此函数时产生的map，而 old 代表“条形码中的上一个数字位置”通过不断折叠应用此函数所产生的map， digit 表示当前考察的候选数字。这个函数的实际作用是在某个候选数字列表中遍历的过程中，当前考察的这个候选数字插入到给定map的每个映射值的最前方，并求得新的临时校验码，然后将这个临时校验码和插入后的序列作为键值对插入到map中，并与前一候选数字应用此函数的结果map做“并集”操作( M.union )，由于候选数字序列是按照匹配程度降序排列的，因此如果当前序列中的键值与前一候选数字产生的某个键值发生冲突，那么它就会被 `` M.Union`` 的“左偏”性质覆盖掉，而保留前一候选数字所产生的新序列。]

传给 useDigits 函数的新答案map(即参数 new 对应的map)最开始是空的。其值将通过在输入数字的序列上折叠 useDigits 函数来填充。

-- file: ch12/Barcode.hs
incorporateDigits :: ParityMap -> [Parity Digit] -> ParityMap
incorporateDigits old digits = foldl' (useDigit old) M.empty digits

incooperateDigit 函数可以用旧的答案map生成完整的新的答案map。

ghci> incorporateDigits (M.singleton 0 []) [Even 1, Even 5]
fromList [(1,[Even 1]),(5,[Even 5])]

[译注： incorporate 函数中，参数 old 代表条码中上一个位置的数字组成的可能的数字逆序序列以及他们对应的临时校验码组成的map，参数digits表示该位置上的候选数字列表。]

最终，我们必须构造完整的答案map。我们先创建一个空的map，然后在条形码的数字序列上依次折叠。我们为每个位置生成一个包含截止到该位置的猜测序列的 new map。这个map将作为下一位置上的折叠过程的 old map出现。

-- file: ch12/Barcode.hs
finalDigits :: [[Parity Digit]] -> ParityMap
finalDigits = foldl' incorporateDigits (M.singleton 0 [])
            . mapEveryOther (map (fmap (*3)))

(回想一下，我们在“EAN-13编码”一节中定义checkDigit函数的时候，要求计算校验码的之前，数字要每隔一位乘以3后再进行下一步处理。)

finalDigits 函数接受的列表有多少个元素呢？我们还不知道数字序列的第一个数字是什么，所以很明显第一位数字不能计入，并且在调用``finalDigits`` 时校验码还只是猜测值，我们也不该把它计入。所以这个输入列表应该有11个元素。

从 finalDigits 返回后，答案map必然还不完整，因为我们还没有确定首位数字是什么。

用首位数字补全答案map¶

我们还没说过如何从左侧分组的奇偶编码类型中提取出首位数字。其实只要直接重用我们前面编写的代码就可以了。

-- file: ch12/Barcode.hs
firstDigit :: [Parity a] -> Digit
firstDigit = snd
           . head
           . bestScores paritySRL
           . runLengths
           . map parityBit
           . take 6
  where parityBit (Even _) = Zero
        parityBit (Odd _) = One

现在这个不完整的答案map中的每个元素都包含一个由数字和编码奇偶性信息组成的逆序的列表。接下来的任务就是通过计算每个序列的首位数字来创建一个完整的答案map，并通过它创建最终的答案map(即键值都是正确的校验码，映射值都是完整的12位正序列表的map)。

-- file: ch12/Barcode.hs
addFirstDigit :: ParityMap -> DigitMap
addFirstDigit = M.foldWithKey updateFirst M.empty

updateFirst :: Digit -> [Parity Digit] -> DigitMap -> DigitMap
updateFirst key seq = insertMap key digit (digit:renormalize qes)
  where renormalize = mapEveryOther (`div` 3) . map fromParity
        digit = firstDigit qes
        qes = reverse seq

[译注： mapKeys 将第一个参数指定的函数逐一应用于map中的每个key，并用结果替换掉原key值。]

如此往复，我们最终消去了Parity类型，并撤销了之前乘以3的操作。最后一步，就是完成校验码的计算。

-- file: ch12/Barcode.hs
buildMap :: [[Parity Digit]] -> DigitMap
buildMap = M.mapKeys (realCheckDigit)
         . addFirstDigit
         . finalDigits
         	where realCheckDigit c = (10 - c) `mod` 10 

找出正确的序列¶

我们现在有一个包含了所有可能的校验码与对应序列映射的map。剩下的就是逐一验证我们对校验码的猜测值，检查在答案map中是否存在对应的键值。

-- file: ch12/Barcode.hs
solve :: [[Parity Digit]] -> [[Digit]]
solve [] = []
solve xs = catMaybes $ map (addCheckDigit m) checkDigits
    where checkDigits = map fromParity (last xs)
          m = buildMap (init xs)
          addCheckDigit m k = (++[k]) <$> M.lookup k m

[译注：catMaybes 接受一个 Maybe 类型元素组成的列表，返回一个只由 Just 构造器的参数值构成的列表(即参数列表中的 Nothing 值会被直接忽略)。

我们用从照片上取下来的那一行来试验，看看能否得到正确的结果。

ghci> listToMaybe . solve . candidateDigits $ input
Just [9,7,8,0,1,3,2,1,1,4,6,7,7]

太棒了！这正是照片中编码的数字序列。