第十二章：條形碼識別

EAN-13編碼?

在考慮怎樣解碼EAN-13條形碼之前，我們還是得先了解它是怎樣被編碼出來的。EAN-13的編碼規(guī)則有一點復雜。我們先從計算校驗碼——即數(shù)字串的最后一位開始。

-- 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函數(shù)的實現(xiàn)有問題，翻譯時用了比較直接的方法修正了代碼，并相應的修改了下面一段正文中對代碼的描述]

[譯注2：你可能覺得如果把 mapEveryOther 中的 f 和 id 兩個列表元素的位置對調(diào)的話，就可以省略掉 checkDigit 的where塊中的 reverse 過程。事實上這個reverse過程是必須的，而且 f 和 id 也不能對調(diào)。因為EAN-13的標準規(guī)定，“將序列中的最右側(cè)的數(shù)字規(guī)定為 奇數(shù)位，從最右側(cè)開始，其余數(shù)字被交替記為 偶數(shù)位 和 奇數(shù)位，而只有奇數(shù)位的數(shù)字會被乘以3。如果采取最開始說的方法，那么假如輸入的序列包含偶數(shù)個元素的話，那么整個計算過程就是錯誤的。這一點的重要性在后文會有體現(xiàn)。]

直接看代碼應該比文字描述更有助于理解校驗碼的計算方法。函數(shù)從數(shù)字串的最右一位數(shù)字開始，每隔一位就將該數(shù)字乘以3，其余保持原狀。接下來對處理后的列表求和，校驗碼就是將這個列表的和對10取模兩次得到的結果。

條形碼是一系列定寬的條紋，其中黑色的條紋表示二進制的“1”，白色的條紋表示二進制的“0”。表示相同二進制的條紋值連續(xù)排列看起來就是寬一些的條紋。

條形碼中的各個二進制位的順序如下：

• 頭部保護序列，固定編碼101。
• 一個由六個數(shù)字組成的分組，其中每個數(shù)字由7個二進制位表示
• 另一個保護序列，固定編碼01010
• 另一個六個數(shù)字的組成的分組 (譯注：每個數(shù)字也由7個二進制位表示)
• 尾部保護序列，固定編碼101

左右兩個分組中的數(shù)字有不同的編碼。左側(cè)分組的數(shù)字編碼包含了校驗位(parity bit)，而校驗位編碼了條形碼的第13個數(shù)字。

[譯注：請注意區(qū)分此處所提到的校驗位(parity bit)以及后面會經(jīng)常提及的校驗碼(check digit)，在本文中，只需要將這個校驗位理解為一種只由二進制編碼模式(pattern)來區(qū)分(而不是“計算”)的信息，并且了解它只包含奇和偶兩種取值即可，沒必要深究“哪一位是校驗位”。]

數(shù)組與惰性?

填充數(shù)組的列表包含的元素數(shù)目至少要與數(shù)組容量相等。如果列表中沒有提供足夠多的元素，那么程序在運行時就可能發(fā)生錯誤。這個錯誤發(fā)生的時機取決于數(shù)組的性質(zhì)。

我們這里用到的數(shù)組類型對數(shù)組的元素采用了非嚴格求值。如果我們想用一個包含三個元素的列表填充一個多于三個元素的數(shù)組，那么其余的元素將是未定義的。但是只有我們試圖訪問超過第三個元素的時候才會發(fā)生錯誤。

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

Haskell也提供了嚴格求值的數(shù)組，它們會在上述場景中會有不同的行為。我們將在“拆箱，抬舉，和bottom”一章中討論兩種數(shù)組之間的取舍。

數(shù)組的折疊?

bounds 函數(shù)返回在創(chuàng)建數(shù)組時用來指定邊界的元組。 indices 函數(shù)返回數(shù)組中各個索引值組成的列表。我們可以用它們來定義實用的折疊函數(shù)，因為 Data.Array 模塊本身并沒有提供用于數(shù)組的折疊函數(shù)。

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

你可能很好奇為什么數(shù)組模塊不預置像折疊函數(shù)這么有用的東西。我們會發(fā)現(xiàn)一維數(shù)組和列表之間有一些明顯的相似性。例如，都只有兩種自然的方式來折疊他們：從左向右折疊或者從右向左折疊。此外，每次都只能折疊一個元素。

上述這些相似性對于二維數(shù)組就已經(jīng)不再成立了。首先，在二維數(shù)組上有意義的折疊方式有很多種。我們也許仍然想要逐個元素地進行折疊，但是對二維數(shù)組，還可以逐行折疊或者逐列折疊。其次，就算同樣是逐個元素折疊，在二維數(shù)組中也不再是只有兩種遍歷方式了。

換句話講，對于二維數(shù)組來說，有意義操作組合太多了，可也沒什么足夠的理由選取其中一部分添加到標準庫。這個問題只存在于多維數(shù)組，所以最好還是讓開發(fā)人員自己編寫合適的折疊函數(shù)。從上面的例子也可以看出，這其實沒什么難度。

修改數(shù)組元素?

盡管存在用來“修改”不可變數(shù)組的函數(shù)，但其實都不怎么實用。以 accum 函數(shù)為例，它接受一個數(shù)組和一個由 (索引，元素值) 值對構成的列表，返回一個新數(shù)組，其中所有在指定索引位置的元素都被替換為指定的元素值。

由于數(shù)組是不可變的，所以哪怕只是修改一個元素，也需要拷貝整個數(shù)組。哪怕對于中等規(guī)模的數(shù)組，這種性能開銷也可能很快變得難以承受。

Data.Array.Diff模塊中的另一個數(shù)組類型DiffArray，嘗試通過保存數(shù)組的連續(xù)版本之間的變化量來減少小規(guī)模修改造成的開銷。遺憾的是，在編寫本書的時候它的實現(xiàn)還不是很高效，對于實際應用來說，它還是太慢了。

習題?

讓我們簡單的探索一下用元組替代數(shù)組的可行性

1. 編寫一個函數(shù)，它接受如下兩個參數(shù)：一個由4個元素組成的元組，一個整數(shù)。整數(shù)參數(shù)為0的時候，該函數(shù)應返回元組中最左側(cè)的元素。整數(shù)參數(shù)為1的時候，返回后一個元素，依此類推。為了使該函數(shù)能通過類型檢查，你需要對參數(shù)的類型做怎樣的限制？
2. 寫一個與上面類似的函數(shù)，第一個參數(shù)改為6個元素組成的元組。
3. 嘗試重構上面的兩個函數(shù)，讓它們共用盡可能多的代碼。你能找到多少可以共用的代碼？

分析彩色圖像?

我們之前說過，我們的解碼器將只支持netpbm圖像。netpbm彩色圖像格式只稍微比第十章中處理的灰度圖像格式復雜一點點。其頭部的識別串為“P6”,頭部的其余部分都和灰度格式完全一樣。在圖像文件的主體部分，每個像素都由3個字節(jié)表示，分別對應紅、綠、藍3個顏色分量。

我們將圖像數(shù)據(jù)表示為像素構成的二維數(shù)組。為了幫我們積累數(shù)組的使用經(jīng)驗，此處將完全采用數(shù)組實現(xiàn)。但實際上對于這個應用來說，我們用“列表的列表”代替數(shù)組也可以。因為數(shù)組在這里的優(yōu)勢不明顯，它的唯一的好處就是很方便取整行。

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

type Pixmap = Array (Int,Int) RGB

我們定義了一些類型的同義詞來提高類型簽名的可讀性。

Haskell為數(shù)組提供了相當高的自由度，我們必須維數(shù)組選擇一種合適的表示形式。這里我們將采取保守的方案，并遵守一個普遍的約定：索引值從0開始。我們不需要顯式的存儲圖像的尺寸，因為用 bounds 函數(shù)可以從數(shù)組直接提取尺寸。

最終的解析器實現(xiàn)相當?shù)暮喍?，這都多虧了我們在第十章中開發(fā)的組合子。

-- 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 函數(shù)，它會將一個分析器調(diào)用指定的次數(shù)，最后構造出一個分析結果組成的列表。

灰度轉(zhuǎn)換?

我們需要將彩色圖像的色彩數(shù)據(jù)轉(zhuǎn)換為黑白的形式。其中一個步驟是將色彩數(shù)據(jù)轉(zhuǎn)換為灰度數(shù)據(jù)。有一個簡單并廣泛應用的公式 [29] 可以將彩色圖像轉(zhuǎn)換為灰度圖像，該公式基于每個色彩通道的相對亮度來計算灰度信息。

-- 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中的數(shù)組都是 Functor 類型類的成員，所以我們可以直接用 fmap 函數(shù)一次性將整張圖片或者單行掃描線從彩色格式轉(zhuǎn)為灰度格式。

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

pixmapToGreymap :: Pixmap -> Greymap
pixmapToGreymap = fmap luminance

上面給出來的 pixmapToGreymap 函數(shù)只是拿來舉個例子，因為我們只需要檢查圖片的部分行來提取可能存在的條形碼，也就沒必要在以后用不到的數(shù)據(jù)上做多余的轉(zhuǎn)換工作了。

灰度二值化和類型安全?

接下來要處理的子問題是如何將灰度圖像轉(zhuǎn)換為二值圖像，二值圖像的每個像素都只處于“打開”或“關閉”兩種狀態(tài)之一。

..FIXME: 此處的digit做value譯.. FIXME: 本段里的bit應該是指pixel

在一個圖像處理程序中通常需要同時處理大量的數(shù)值，有時為了方便，可能會把同一種數(shù)值類型用于不同的目的。例如，我們只要約定數(shù)字1表示一個像素處于“打開”狀態(tài)，而0表示一個像素處于“關閉”狀態(tài)，就可以直接使用 Pixel 類型表示像素的開/關狀態(tài)了。

然而，這種做法有潛在的迷惑性。如果想知道某個特定的 Pixel 類型的值究竟是代表一個數(shù)值還是一個“開”/“關”狀態(tài)，就不能靠類型簽名輕易確定了。在某些場景中，我們可能很輕易的就使用了錯誤類型的數(shù)值，而且編譯器也不會檢查到錯誤，因為這個值的類型與簽名指定的類型是吻合的。

我們可以嘗試通過引入類型別名來解決這個問題。和前文中把 Pixel 聲明為 Word8 的別名一樣，我們也可以把 Bit 類型聲明為 Pixel 類型的別名。這么做雖然可能提高一定的可讀性，但類型別名還是不會讓編譯器替我們做什么有用的工作。

編譯器將把Pixel和Bit當做完全相同的類型，所以就算把 Pixel 類型的值253傳給一個接受Bit類型的值(0或1)的函數(shù)，編譯器也不會報錯。

如果另外定義一個單色(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 函數(shù)會先計算輸入數(shù)組中的最大值和最小值，結合參數(shù)提供的一個介于0到1之間的閾值，求出一個“樞軸”(pivot)值。對于數(shù)組中的每個元素，如果該元素的值小于這個樞軸值，則計算結果為 Zero ，否則結果為 One 。注意到這里我們用到了一個在 數(shù)組的折疊 一節(jié)中編寫的折疊函數(shù)。

[譯注：針對這段代碼，需要指出一個關于RGB顏色模式的注意點。在前面我們通過 luminance 函數(shù)將要給彩色圖片中的像素中的三個顏色分量轉(zhuǎn)換為了一個灰度值，這個灰度值可以理解為“當一個RGB顏色的三個分量同時取該值的時候該像素的顏色”。在這個定義下，純白色的灰度值為255，隨著灰度值越來越小，這個顏色將會呈現(xiàn)為越來越深的灰色，直到灰度值為0，此時該像素為純黑色?？梢娺@里有一個比較反直覺的地方，即“灰度值越大，顏色越淺”。這個特征反映到二值化函數(shù) threshold 的返回值中就是“深色的像素返回值為 Zero ，淺色的像素返回值為 One ”。]

游程編碼?

我們?nèi)绾谓鉀Q線條寬度的問題呢。答案就是對圖像數(shù)據(jù)進行游程編碼(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 函數(shù)會把一個列表中所有連續(xù)的相同元素分別放入一個子列表中。

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

我們的 runLength 函數(shù)將( 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輸出的最后一行的列表中，每一個“長度-值”對就是一個“游程”]

由于我們進行游程編碼的數(shù)據(jù)只包含0和1，因此編碼的數(shù)字只會在0和1兩個值之間變化。既然這樣，我們就可以只保留長度而丟棄被編碼數(shù)字，而不會丟失任何有用的信息。

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

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

上面給出的位模式并不是我們隨便編出來的；而是上面我們捕獲的圖像中的某一行里面的編碼的左側(cè)保護序列和第一個編碼數(shù)字。如果我們丟棄表示保護序列的條紋，游程編碼后的值就是[2, 6, 4, 4]。我們怎樣在“引入數(shù)組”一節(jié)中的編碼表中找到匹配的位模式呢？

[譯注1：此處稍微做一下展開。首先，在 灰度二值化和類型安全 一節(jié)中我們已經(jīng)知道， Zero 才是代表黑色條紋的值。此處的0是與 Zero 對應的，它同樣表示黑色條紋，相應的，1表示白色條紋，與 EAN-13編碼 一節(jié)中介紹EAN-13條碼編碼格式時約定的0/1所代表的顏色相反，再次請讀者留心這點，因為接下來的內(nèi)容都會遵守這個約定。]

[譯注2：如果你實在看不出這個游程編碼的值是如何表示之前捕獲的圖像中數(shù)字的，這里我們來詳細解釋一下。前文說過，由于條紋在照片中的實際寬度受到拍攝距離等因素的影響，因此我們不能對其有任何假設。而且一般來說，條形碼中表示每1位的條紋所占的寬度幾乎不可能只有1個像素，而是會由縱向上的復數(shù)個像素表示一位。比方說上面給出的序列，很明顯就是用了兩個像素來表示每個1個二進制位，其實際表示的二進制序列為“01010001100”(0為黑色，1為白色)，當”以1為黑色，0為白色”時，該序列即“10101110011”。這樣就可以看出，該序列就是由“101”(左側(cè)保護序列)和“0111001”(倒數(shù)第2位識別錯誤的“7”的奇校驗編碼)以及下一位數(shù)字的第一個二進制位”0”組成的了。]

縮放游程，查找相近的匹配?

一個合理的方法是縮放這些游程編碼值，讓它們的和為1。我們將使用 Ratio Int 類型替代一般的 Double 類型來保存這些縮放后的值，因為 Ratio 值在 ghci 的輸出中可讀性更好。這點可以為交互式調(diào)試與開發(fā)提供方便。

-- 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 底層的類型是什么。當我們的代碼開發(fā)完畢，一頭埋進 ghci 做后續(xù)調(diào)試的時候，只要我們愿意，我們還是能把“ Score ”對應的底層類型改為 Double ，而不需要修改其它代碼。

我們可以用 scalarToOne 函數(shù)來縮放我們所要尋找的數(shù)字序列。我們解決了拍攝距離所導致的條紋寬度不能確定的問題?，F(xiàn)在，在縮放后的游程編碼表和從圖像中的提取出游程編碼序列間應該有十分接近的匹配。

接下來的問題是如何將直觀感覺上的“十分接近”轉(zhuǎn)化為對“足夠接近”的度量。給出兩個縮放過的長度序列，我們可以像下面這樣計算出一個大概的“差異度”(distance)。

精確匹配的兩個值之間的差異度是0，匹配程度越低，差異度的值就越大。

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

對給定的一個經(jīng)過縮放的游程編碼表，我們從中選擇與輸入序列最接近的幾個匹配結果。

-- 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) ，列表推導式可以以一個或多個列表為基礎創(chuàng)建新列表。

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

豎線右側(cè)的每一個 生成器表達式(generator expression) 組合，都會代入到豎線左側(cè)的表達式中求值。生成表達式綁定了左側(cè)的變量a，a又用“<-”綁定到右側(cè)的元素列表。正如上面的例子展示的，生成表達式的組合將按照深度優(yōu)先的順序遍歷：先是第一個列表的第一個元素分別與第二個列表中的每個元素分別組合，以此類推。

我們還可以在列表推導式的右側(cè)為生成器指定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"]

如果生成器表達式中的某個模式匹配失敗了，那么也不會有錯誤發(fā)生，只會跳過未匹配的列表元素。

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]

記錄匹配數(shù)字的奇偶性?

對左側(cè)分組數(shù)字的每一個匹配，我們必須記錄它是在奇校驗編碼表還是偶校驗編碼表中匹配到的。

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

我們將匹配到的數(shù)字包裝在該數(shù)字的實際編碼所采用的奇偶性內(nèi)，并且使它成為一個 Functor 實體，這樣我們就可以方便的操作奇偶編碼值(parity-encoded values)了。

[譯注：此處所說的“奇偶編碼值”可以理解為“對同一個數(shù)字同時具有奇校驗編碼和偶校驗編碼兩種形式的編碼值”(即左分組中所有的編碼值都是“奇偶編碼值”)，為了簡化描述，后文也會采用這種簡稱，請讀者留意。]

我們可能需要對奇偶編碼值按它們包含的數(shù)字進行排序。 Data.Function 模塊提供的一個好用的組合子 on 可以幫助我們實現(xiàn)這個功能。

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

它的作用可能不是很明確，你可以試著去想象這樣一個函數(shù)：它接受兩個參數(shù)f和g，返回值是一個函數(shù)，這個返回的函數(shù)也有兩個參數(shù)，分別為 x 和 y 。 on 將 g 分別對 x 和 y 應用，然后將 f 應用于這兩個結果(所以它的名字叫 on )。

把匹配數(shù)字裝入奇偶性的方法一目了然。

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

一旦在奇校驗表或偶校驗表里找到了左側(cè)分組某個編碼的幾個最佳匹配，我們就可以將他們按照匹配的質(zhì)量排序。

鍵盤惰性?

定義 Parity 類型時,我們可以使用haskell的記錄( record )語法來避免手寫formParity函數(shù)。也就是說，可以這么寫：

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

那我們?yōu)槭裁礇]這么做呢？答案說起來有些丟人，而且與 ghci 的交互調(diào)試有關。當我們告訴GHC讓它自動把一個類型派生為 Show 的實體時，GHC會根據(jù)我們是否使用記錄語法來定義這個類型而生成不同的代碼。

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實體明顯很“啰嗦”，同時這也會給調(diào)試帶來很大的干擾。比方說在我們檢查 ghci 輸出的奇偶編碼值列表的時候，這樣的輸出結果會特別長以至于我們不得不一行行地掃讀輸出結果。

當然我們可以手動實現(xiàn)干擾更少的Show實體。避開記錄語法寫起來也更簡潔，而且通過編寫我們自己的 formParity 函數(shù)可以讓GHC幫我們派生輸出更簡潔的 Show 實例。其實也并不是非這么做不可，但是程序員的惰性有時也的確會為代碼引入一些特別的做法。

列表分塊?

使用列表時常常需要對它進行分塊(chunk)。例如，條形碼中的每個數(shù)字都由四個連續(xù)的數(shù)字編碼而成。我們可以將表示一個行的列表轉(zhuǎn)換為如下這種包含四個元素的列表組成的列表。

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

像這種需要手寫泛型的列表操作函數(shù)的情況比較罕見。因為一般在 Data.List 模塊里翻一翻就能找到完全符合要求或者基本滿足需要的函數(shù)。

生成候選數(shù)字列表?

這幾個輔助函數(shù)一旦就緒，為每個數(shù)字分組生成候選匹配的函數(shù)也就很容易搞定了。 首先，我們先得做一些前期的檢查，來確定這些匹配是否都是有意義的。只有以黑色( Zero )條紋開始，并且條紋數(shù)量足夠多的游程列表才是有意義的。下面是這個函數(shù)中的前幾個等式。

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

[譯注：代碼中的59表示條形碼中的條紋數(shù)，它是這樣求出的：3(左側(cè)保護序列101)+4x6(每個數(shù)字的條紋數(shù)目4x左側(cè)分組的數(shù)字數(shù))+5(兩個分組中間的保護序列10101)+4x6(同左分組)+3(右側(cè)保護序列) = 59。]

只要任意一次 bestLeft 或 bestRight 的應用得到一個空列表，我們都不能返回有效結果。否則，我們將丟棄 Score 值，返回一個由標記了編碼奇偶性的候選數(shù)字列表組成的列表。外部的列表有12個元素，每個元素都代表條形碼中的一個數(shù)字。子列表中的每個數(shù)字都根據(jù)匹配質(zhì)量排序。

下面給出這個函數(shù)的其余部分

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

我們看一看從上面圖像中提取出的每個線條分組(表示一個數(shù)字的四個線條算作一組)對應的候選數(shù)字。

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]

答案的森林?

但事實上，用不了可變的數(shù)組和散列表并沒有想象中那么悲劇。數(shù)組和散列表經(jīng)常被用作由鍵索引的值的集合，而在Haskell中，我們使用 樹 來實現(xiàn)這個功能。

在Haskell中實現(xiàn)一個簡單的樹類型非常簡單。不僅如此，更實用的樹類型實現(xiàn)起來也是出奇的簡單。比方說紅黑樹。紅黑樹這種自平衡結構，就是因為其平衡算法出了名的難寫，才讓幾代CS在校生聞風喪膽。

綜合運用Haskell的代數(shù)數(shù)據(jù)類型組合、模式匹配、guard等特性可以把最可怕的平衡操作的代碼縮減至只有短短幾行。但是我們先不急著構造樹類型，先來關注為什么它們在純函數(shù)式語言中特別有用。

對函數(shù)式程序員來說，樹的吸引力在于修改代價低。我們不用打破不可變原則：樹就和其他東西一樣不可變。然而，我們修改一棵樹的時候，可以在新舊兩棵樹之間共享大部分的結構。舉例來說，有一顆有10000個節(jié)點的樹，我們可能想要在里面添加或者移除一個節(jié)點，這種情況下，新舊兩棵樹能夠共享大約9985個節(jié)點。換句話說，每次更新樹的時候所需要修改的元素數(shù)目取決于樹的高度，或者說是節(jié)點數(shù)的對數(shù)。

Haskell標準庫提供了兩種采用平衡樹實現(xiàn)的集合類型：Data.Map用于鍵/值對， Data.Set 用于集合。鑒于在下一節(jié)會用到 Data.Map ，我們就先簡要地介紹一下這個模塊。 Data.Set 與 Data.Map 很相似，相信你應該也能很快掌握。

map簡介?

Data.Map 模塊提供了參數(shù)化類型 Map k a ,將鍵類型k映射到關聯(lián)值類型a。盡管其內(nèi)部為一個size-balanced tree，但是它的實現(xiàn)對我們是不可見的。

[譯注1：Size-Balanced Tree（SBT）是一種通過大小(Size)域來保持平衡的二叉搜索樹，因此得名。]

[譯注2：原文對于value的使用有些混亂。為了明確表達，從此處開始，key都譯為“鍵”，而value在表達“map中由key所映射到的值”時都譯為“映射值”]

Map 的鍵是嚴格求值的，但是映射值卻是非嚴格求值。換句話說，map的 脊柱 ，或者說結構，是一直在更新的，但是map中映射的值還是要等到我們強迫對它們求值的時候才被計算出來。

記住這點很重要，因為對于不期望內(nèi)存泄漏的程序員來說， Map 類型對映射值采用的惰性求值策略往往是內(nèi)存泄漏的源頭。

由于 Data.Map 模塊包含幾個與 Prelude 模塊中沖突的名字，所以它通常用限定形式導入。本章靠前的部分中，我們再導入它時添加了一個前綴 M 。

類型約束?

Map類型并不對鍵值的類型做任何顯式的約束，但是該模塊中多數(shù)實用函數(shù)都要求鍵類型為 Ord 類型類的實體。需要強調(diào)的是，這里體現(xiàn)了Haskell中一個常見設計模式： 類型約束的設置應該推遲到最終應用的地方，而不需要庫作者為這種事情做額外勞動。

Map 類型和該模塊中的函數(shù)都沒有對映射值的類型設置約束。

部分應用時的尷尬?

由于某些原因，Data.Map 模塊中的某些函數(shù)的類型簽名并不便于部分應用。函數(shù)操作的map總是作為最后一個參數(shù)，但是它們是第一個參數(shù)才更便于局部應用。結果造成使用部分應用Map函數(shù)的代碼幾乎總得通過適配函數(shù)(adapter function)來調(diào)整參數(shù)順序。

map API入門?

Data.Map 模塊有一個巨大的“暴露區(qū)”(surface area)：它導出了很多函數(shù)。而其中只有為數(shù)不多的幾個函數(shù)算得上是該模塊中最常用的核心部分。

如果需要創(chuàng)建一個空的 map ,可以使用 empty 函數(shù)。如果要創(chuàng)建包含一個鍵/值對的 map ，則應該使用 singleton 函數(shù)。

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 的實現(xiàn)對我們是透明的，我們就無法對 Map 類型的值進行模式匹配。不過，該模塊提供了一些查找函數(shù)可供我們使用，其中有兩個函數(shù)應用特別廣泛。查找函數(shù)有一個稍微復雜的類型簽名，但是不要著急，這些很快在第14章中都會弄明白的。

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

返回值中的類型參數(shù)m通常是Maybe類型。話句話說，如果map中包含具有給定鍵的映射值，lookup函數(shù)會把映射值裝入 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 函數(shù)額外指定一個參數(shù)值，如果map中不包含查找的鍵，則返回該指定值。

要在map中添加一個鍵值對，最有用的函數(shù)是 insert 和 insertWith’ 。insert函數(shù)就是簡單的在map中插入鍵/值對，如果該鍵已經(jīng)存在，則覆蓋其關聯(lián)的任何值。

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' 函數(shù)會額外接受一個 組合函數(shù)(combining function) 。如果map中沒有指定的鍵，就把該鍵/值對原封不動插入。否則，就先對新舊兩個映射值應用組合函數(shù)，把應用的結果作為新的映射值更新到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)]

函數(shù)名最后的鉤號暗示我們 insertWith' 將對組合函數(shù)嚴格求值。這個設計幫你避免了內(nèi)存泄漏。該函數(shù)同時存在一個惰性的變種(即沒有最后鉤號的 insertWith )，但你大概永遠用不到它。

delete 函數(shù)從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 []

最后，還有幾個常用的函數(shù)用于在maps上進行類似集合的操作。例如，我們接下來會用到的 union。這個函數(shù)是“左偏”(left biased)的：如果兩個map包含相同的鍵，返回map中將包含左側(cè)map中對應的關聯(lián)值。

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。我們鼓勵你自行瀏覽模塊的文檔，相信你會從中獲得更多啟發(fā)。這個模塊滴水不漏的設計一定會讓你印象深刻。

延伸閱讀?

[Okasaki99]一書將教我們?nèi)绾蝺?yōu)雅且嚴密地實現(xiàn)純函數(shù)式數(shù)據(jù)結構，其中包括多種平衡樹。該書還中還包含了作者對于純函數(shù)式數(shù)據(jù)結構和惰性求值的寶貴思考。

我們把Okasaki這本書列為為函數(shù)式程序員的必讀書目。如果你不方便翻閱Okasaki這本書，可以去看Okasaki的博士論文，[Okasaki96]是該書的一個不很完整的精簡版本，在網(wǎng)上可以免費獲得。

批量求解校驗碼?

我們暫時不考慮搜索的方案，先來關注如何計算校驗碼。條形碼的校驗碼可以是十個數(shù)字中的任意一個。對于一個給定的校驗碼，怎樣反推出它是從怎樣的輸入序列中計算出來的呢？

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

在這個map中，鍵值是一個校驗碼，映射值是一個可以計算出這個校驗碼的序列。以它為基礎，我們進一步定義兩種map類型。

我們將把這兩種類型的map統(tǒng)稱為“答案map”(solution map)，因為它們包含了“求解”每個校驗碼對應的各個數(shù)字序列。

給定一個數(shù)字，我們可以按如下方法更新一個給定的答案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中取出一個既存的校驗碼，一個可以求出該校驗碼的序列，一個新的輸入數(shù)字，這個函數(shù)將可以求出新的校驗碼的新序列更新至map。

這部分內(nèi)容可能有點不太好消化，看一個例子應該會更明白。我們假設現(xiàn)在要查找數(shù)字是 4 ，它是序列 [1, 3] 對應的校驗碼，我們想要添加到map的數(shù)字是 8 。 4+8 ，模10得 2 ，那么 2 就是要插入到map中的鍵。能計算出新校驗碼 2 的序列就是 [8, 1, 3] ，這個序列就是要插入的映射值。

[譯注： 在實際調(diào)用 updateMap 函數(shù)的時候， digit 是一個候選數(shù)字，key是指“在插入候選數(shù)字 new 之前，由這個不完整的‘猜測’序列算出的臨時校驗碼”， seq 就是 key 所對應的“不完整的‘猜測’序列(指條形碼的編碼數(shù)字序列)”。 updateMap 的實際功能就是將 digit 插入到列表 seq 的最前面，然后由插入的seq再求出一個校驗碼的臨時值。并以這個臨時值和插入后的序列分別為鍵值和映射值，插入到指定的map中。這之中需要注意的地方是在 insertMap 函數(shù)中，key' 表示新求出的臨時校驗碼，這個校驗碼的算法與前文checkDigit的算法并不相同：沒有對輸入序列進行 mapEveryOther (*3) (reverse ds) 和類似 (10 -) 這樣的計算。實際上，這兩個操作只是被推遲了，并且由于校驗碼只有一位數(shù)，因此校驗碼的值與“(10 - 校驗碼)”的值也是一一對應的(即“單射”)，所以map中保存這個沒有經(jīng)過 (10 - ) 操作的鍵值也是沒有問題的，只要在需要提取真正的校驗碼時用10減去這個鍵值就可以了，除了這些之外，其計算方法與 checkDigit 函數(shù)中的方法是等價的。]

對候選數(shù)字序列中的每一個數(shù)字，我們都會通過當前數(shù)字和之前的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])]

[譯注：這個函數(shù)的參數(shù)中， old 代表上一候選數(shù)字應用此函數(shù)時產(chǎn)生的map，而 old 代表“條形碼中的上一個數(shù)字位置”通過不斷折疊應用此函數(shù)所產(chǎn)生的map， digit 表示當前考察的候選數(shù)字。這個函數(shù)的實際作用是在某個候選數(shù)字列表中遍歷的過程中，當前考察的這個候選數(shù)字插入到給定map的每個映射值的最前方，并求得新的臨時校驗碼，然后將這個臨時校驗碼和插入后的序列作為鍵值對插入到map中，并與前一候選數(shù)字應用此函數(shù)的結果map做“并集”操作( M.union )，由于候選數(shù)字序列是按照匹配程度降序排列的，因此如果當前序列中的鍵值與前一候選數(shù)字產(chǎn)生的某個鍵值發(fā)生沖突，那么它就會被 `` M.Union`` 的“左偏”性質(zhì)覆蓋掉，而保留前一候選數(shù)字所產(chǎn)生的新序列。]

傳給 useDigits 函數(shù)的新答案map(即參數(shù) new 對應的map)最開始是空的。其值將通過在輸入數(shù)字的序列上折疊 useDigits 函數(shù)來填充。

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

incooperateDigit 函數(shù)可以用舊的答案map生成完整的新的答案map。

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

[譯注： incorporate 函數(shù)中，參數(shù) old 代表條碼中上一個位置的數(shù)字組成的可能的數(shù)字逆序序列以及他們對應的臨時校驗碼組成的map，參數(shù)digits表示該位置上的候選數(shù)字列表。]

最終，我們必須構造完整的答案map。我們先創(chuàng)建一個空的map，然后在條形碼的數(shù)字序列上依次折疊。我們?yōu)槊總€位置生成一個包含截止到該位置的猜測序列的 new map。這個map將作為下一位置上的折疊過程的 old map出現(xiàn)。

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

(回想一下，我們在“EAN-13編碼”一節(jié)中定義checkDigit函數(shù)的時候，要求計算校驗碼的之前，數(shù)字要每隔一位乘以3后再進行下一步處理。)

finalDigits 函數(shù)接受的列表有多少個元素呢？我們還不知道數(shù)字序列的第一個數(shù)字是什么，所以很明顯第一位數(shù)字不能計入，并且在調(diào)用``finalDigits`` 時校驗碼還只是猜測值，我們也不該把它計入。所以這個輸入列表應該有11個元素。

從 finalDigits 返回后，答案map必然還不完整，因為我們還沒有確定首位數(shù)字是什么。

用首位數(shù)字補全答案map?

我們還沒說過如何從左側(cè)分組的奇偶編碼類型中提取出首位數(shù)字。其實只要直接重用我們前面編寫的代碼就可以了。

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

現(xiàn)在這個不完整的答案map中的每個元素都包含一個由數(shù)字和編碼奇偶性信息組成的逆序的列表。接下來的任務就是通過計算每個序列的首位數(shù)字來創(chuàng)建一個完整的答案map，并通過它創(chuàng)建最終的答案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 將第一個參數(shù)指定的函數(shù)逐一應用于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 

找出正確的序列?

我們現(xiàn)在有一個包含了所有可能的校驗碼與對應序列映射的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 構造器的參數(shù)值構成的列表(即參數(shù)列表中的 Nothing 值會被直接忽略)。

我們用從照片上取下來的那一行來試驗，看看能否得到正確的結果。

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

太棒了！這正是照片中編碼的數(shù)字序列。