Haskell-数据分析秘籍-二-Haskell 数据分析秘籍（二）第四章数据哈希在本章中，我们将介绍以下食谱：

Haskell 数据分析秘籍（二）

原文：annas-archive.org/md5/3ff53e35b37e2f50c639bfc6fc052f29

译者：飞龙

协议：CC BY-NC-SA 4.0

第四章数据哈希

在本章中，我们将介绍以下食谱：

哈希原始数据类型
哈希自定义数据类型
运行流行的加密哈希函数
对文件运行加密校验和
在数据类型之间进行快速比较
使用高性能哈希表
使用 Google 的 CityHash 哈希函数对字符串进行哈希
计算位置坐标的 Geohash
使用布隆过滤器去除唯一项
运行 MurmurHash，一个简单但快速的哈希算法
使用感知哈希测量图像相似度

介绍

哈希是一种有损的方式，将对象表示为一个小而通常是固定长度的值。哈希数据使我们能够快速查找和轻松处理大量数据集。

哈希函数的输出被称为摘要。一个好的哈希函数的主要特性之一是它必须是确定性的，这意味着给定的输入必须始终产生相同的输出。有时，两个不同的输入可能最终产生相同的输出，我们称之为碰撞。仅凭哈希值，我们无法反转过程在合理的时间内重新发现原始对象。为了最小化碰撞的几率，哈希函数的另一个特性叫做均匀性。换句话说，每个输出出现的概率应该几乎相同。

我们将首先从输入生成一个简单的摘要。然后，在下一个食谱中，我们将对自定义数据类型运行哈希算法。

哈希的另一个重要应用是在加密学中。我们将介绍一些最流行的加密哈希算法，如 SHA-512。我们还将应用这些哈希对文件进行校验和计算，以确保文件完整性。

最后，我们将介绍许多非传统的哈希方法，包括 CityHash、GeoHashing、布隆过滤器、MurmurHash 和 pHash。

哈希原始数据类型

本食谱演示了如何在各种原始数据类型上使用简单的哈希函数。

准备工作

从 Cabal 安装Data.Hashable包，如下所示：

$ cabal install hashable

如何操作……

使用以下行导入哈希函数：
```
import Data.Hashable
```
测试hash函数对字符串的作用，如下所示；该函数实际上是一个包装器，围绕着默认盐值的hashWithSalt函数：
```
main = do
  print $ hash "foo" 
```

使用不同的初始盐值测试hashWithSalt函数，如下所示：

  print $ hashWithSalt 1 "foo"
  print $ hashWithSalt 2 "foo"

我们还可以如下对元组和列表进行哈希：

  print $ hash [ (1 :: Int, "hello", True)
               , (0 :: Int, "goodbye", False) ]

注意以下输出中的前三个哈希尽管输入相同，却产生了不同的结果：

$ runhaskell Main.hs

7207853227093559468
367897294438771247
687941543139326482
6768682186886785615

它是如何工作的……

使用盐值进行哈希意味着在稍微修改数据后再应用哈希函数。就像我们在通过哈希函数处理输入之前“加盐”了一样。即使盐值稍有变化，也会产生完全不同的哈希摘要。

我们需要这种盐的概念来提高密码安全性。哈希函数对于相同的输入总是产生相同的输出，这既有好处也有坏处。对于所有主要的哈希算法，都有现成的彩虹表数据库，其中包含每个常用密码。如果一个具有登录系统服务的网站（例如 Packt Publishing）使用加密哈希存储密码，但没有使用盐，那么如果密码本身被认为是弱密码，它与明文密码没有区别。如果像 Packt Publishing 这样的服务在其加密哈希中使用盐（并且应该使用），那么它就增加了一层安全性，而彩虹表则变得无用。

还有更多……

之前的代码生成了一个字符串的哈希，但这个算法不限于字符串。以下数据类型也实现了 hashable：

Bool
Char
Int
Int8
Int16
Int32
Int64
Word
Word8
Word16
Word32
Word64
ByteString
可哈希项的列表
哈希项的元组
也许是一个可哈希的项

另请参见

关于如何对自定义数据类型使用哈希函数，请参考 哈希一个自定义数据类型 这个配方。

哈希一个自定义数据类型

即使是自定义定义的数据类型也可以轻松进行哈希。当数据本身占用空间过大，无法直接管理时，处理哈希摘要通常非常有用。通过使用数据的摘要引用，我们可以轻松避免携带整个数据类型的开销。这在数据分析中尤其有用。

准备好

通过以下方式从 Cabal 安装 Data.Hashable 包：

$ cabal install hashable

如何实现……

使用 GHC 语言扩展 DeriveGeneric 自动定义我们自定义数据类型的哈希函数，如下所示：
```
{-# LANGUAGE DeriveGeneric #-}
```

使用以下代码行导入相关包：

import GHC.Generics (Generic)
import Data.Hashable

创建一个自定义数据类型，并让 GHC 自动定义其哈希实例，如下所示：
```
data Point = Point Int Int
           deriving (Eq, Generic)

instance Hashable Point
```
在 main 中，创建三个点。让其中两个相同，第三个不同，如以下代码片段所示：
```
main = do
    let p1 = Point 1 1
    let p2 = Point 1 1
    let p3 = Point 3 5
```

打印相同点的哈希值，如下所示：

if p1 == p2
  then putStrLn "p1 = p2"
  else putStrLn "p1 /= p2"
  if hash p1 == hash p2
  then putStrLn "hash p1 = hash p2"
  else putStrLn "hash p1 /= hash p2"

打印不同点的哈希值，如下所示：

  if p1 == p3
    then putStrLn "p1 = p3"
    else putStrLn "p1 /= p3"
  if hash p1 == hash p3
    then putStrLn "hash p1 = hash p3"
    else putStrLn "hash p1 /= hash p3"

输出将如下所示：

$ runhaskell Main.hs

p1 = p2
hash p1 = hash p2
p1 /= p3
hash p1 /= hash p3

还有更多……

我们可以通过为 Hashable 提供实例来为自定义数据类型定义哈希函数。Hashable 实例只需要实现 hashWithSalt :: Int -> a -> Int。为了帮助实现 hashWithSalt，我们还提供了两个有用的函数：

使用盐对指针进行哈希操作，如以下代码片段所示：

hashPtrWithSalt :: Ptr a   --  pointer to the data to hash
                -> Int     --  length, in bytes
                -> Int     --  salt
                -> IO Int  --  hash value

使用盐对字节数组进行哈希操作，如以下代码片段所示：

hashByteArrayWithSalt
    :: ByteArray#  --  data to hash
    -> Int         --  offset, in bytes
    -> Int         --  length, in bytes
    -> Int         --  salt
    -> Int         --  hash value

另请参见

要哈希一个内建的原始类型，请参考 哈希一个原始数据类型 这个配方。

运行流行的加密哈希函数

一个加密哈希函数具有特定的属性，使其与其他哈希函数不同。首先，从给定的哈希摘要输出生成可能的输入消息应该是不可行的，意味着在实践中解决这个问题必须耗费指数级的时间。

例如，如果哈希值产生了摘要66fc01ae071363ceaa4178848c2f6224，那么原则上，发现用于生成摘要的内容应该是困难的。

在实践中，一些哈希函数比其他的更容易破解。例如，MD5 和 SHA-1 被认为很容易破解，不应再使用，但为了完整性，稍后会展示这两个哈希函数。关于 MD5 和 SHA-1 不安全的更多信息可以参考www.win.tue.nl/hashclash/rogue-ca和www.schneier.com/blog/archives/2005/02/cryptanalysis_o.html。

准备工作

从 Cabal 安装Crypto.Hash包，如下所示：

$ cabal install cryptohash

如何操作……

按如下方式导入加密哈希函数库：

import Data.ByteString.Char8 (ByteString, pack)
import Crypto.Hash

按如下方式通过明确关联数据类型来定义每个哈希函数：

skein512_512 :: ByteString -> Digest Skein512_512
skein512_512 bs = hash bs

skein512_384 :: ByteString -> Digest Skein512_384
skein512_384 bs = hash bs

skein512_256 :: ByteString -> Digest Skein512_256
skein512_256 bs = hash bs

skein512_224 :: ByteString -> Digest Skein512_224
skein512_224 bs = hash bs

skein256_256 :: ByteString -> Digest Skein256_256
skein256_256 bs = hash bs

skein256_224 :: ByteString -> Digest Skein256_224
skein256_224 bs = hash bs

sha3_512 :: ByteString -> Digest SHA3_512
sha3_512 bs = hash bs

sha3_384 :: ByteString -> Digest SHA3_384
sha3_384 bs = hash bs

sha3_256 :: ByteString -> Digest SHA3_256
sha3_256 bs = hash bs

sha3_224 :: ByteString -> Digest SHA3_224
sha3_224 bs = hash bs

tiger :: ByteString -> Digest Tiger
tiger bs = hash bs

whirlpool :: ByteString -> Digest Whirlpool
whirlpool bs = hash bs

ripemd160 :: ByteString -> Digest RIPEMD160
ripemd160 bs = hash bs

sha512 :: ByteString -> Digest SHA512
sha512 bs = hash bs

sha384 :: ByteString -> Digest SHA384
sha384 bs = hash bs

sha256 :: ByteString -> Digest SHA256
sha256 bs = hash bs

sha224 :: ByteString -> Digest SHA224
sha224 bs = hash bs

sha1 :: ByteString -> Digest SHA1
sha1 bs = hash bs

md5 :: ByteString -> Digest MD5
md5 bs = hash bs

md4 :: ByteString -> Digest MD4
md4 bs = hash bs

md2 :: ByteString -> Digest MD2
md2 bs = hash bs

按如下代码片段测试每个加密哈希函数在相同输入上的表现：

main = do
  let input = pack "haskell data analysis"
  putStrLn $ "Skein512_512: " ++ (show.skein512_512) input
  putStrLn $ "Skein512_384: " ++ (show.skein512_384) input
  putStrLn $ "Skein512_256: " ++ (show.skein512_256) input
  putStrLn $ "Skein512_224: " ++ (show.skein512_224) input
  putStrLn $ "Skein256_256: " ++ (show.skein256_256) input
  putStrLn $ "Skein256_224: " ++ (show.skein256_224) input
  putStrLn $ "SHA3_512: " ++ (show.sha3_512) input
  putStrLn $ "SHA3_384: " ++ (show.sha3_384) input
  putStrLn $ "SHA3_256: " ++ (show.sha3_256) input
  putStrLn $ "SHA3_224: " ++ (show.sha3_224) input
  putStrLn $ "Tiger: " ++ (show.tiger) input
  putStrLn $ "Whirlpool: " ++ (show.whirlpool) input
  putStrLn $ "RIPEMD160: " ++ (show.ripemd160) input
  putStrLn $ "SHA512: " ++ (show.sha512) input
  putStrLn $ "SHA384: " ++ (show.sha384) input
  putStrLn $ "SHA256: " ++ (show.sha256) input
  putStrLn $ "SHA224: " ++ (show.sha224) input
  putStrLn $ "SHA1: " ++ (show.sha1) input
  putStrLn $ "MD5: " ++ (show.md5) input
  putStrLn $ "MD4: " ++ (show.md4) input
  putStrLn $ "MD2: " ++ (show.md2) input

最终输出可在以下截图中看到：
```
$ runhaskell Main.hs
```

另请参见

若要在文件上运行这些加密哈希函数以执行完整性检查，请参考在文件上运行加密校验和的配方。

在文件上运行加密校验和

判断计算机上的文件是否与其他地方的文件不同的最有效方法之一是通过比较它们的加密哈希值。如果两个哈希值相等，虽然文件相等的可能性非常高，但由于碰撞的可能性，不能严格保证文件完全相同。

下载一个文件，例如从www.archlinux.org/download下载 Arch Linux，最好确保其加密哈希值匹配。例如，看看以下截图：

在文件上运行加密校验和

上面的截图显示了截至 2014 年 5 月底 Arch Linux 下载的相应哈希值。

请注意同时提供了 MD5 和 SHA1 哈希值。本配方将展示如何在 Haskell 中计算这些哈希值，以确保数据的完整性。

我们将计算其源文件的 SHA256、SHA512 和 MD5 哈希值。

准备工作

从 Cabal 安装Crypto.Hash包，如下所示：

$ cabal install cryptohash

如何操作……

创建一个名为Main.hs的文件，并插入以下代码：

按如下方式导入相关的包：

import Crypto.Hash
import qualified Data.ByteString as BS

按如下方式定义MD5哈希函数：

md5 :: BS.ByteString -> Digest MD5
md5 bs = hash bs

按如下方式定义SHA256哈希函数：

sha256 :: BS.ByteString -> Digest SHA256
sha256 bs = hash bs

按如下方式定义SHA512哈希函数：

sha512 :: BS.ByteString -> Digest SHA512
sha512 bs = hash bs

使用Data.ByteString包提供的readFile函数打开ByteString类型的文件，如下所示：
```
main = do
  byteStr <- BS.readFile "Main.hs"
```

按如下方式测试文件上的各种哈希值：

    putStrLn $ "MD5: " ++ (show.md5) byteStr
    putStrLn $ "SHA256: " ++ (show.sha256) byteStr
    putStrLn $ "SHA512: " ++ (show.sha512) byteStr

以下是生成的输出：

$ runhaskell Main.hs

MD5: 242334e552ae8ede926de9c164356d18

SHA256:
50364c25e0e9a835df726a056bd5370657f37d20aabc82e0b1719a343ab505d8

SHA512: 1ad6a9f8922b744c7e5a2d06bf603c267ca6becbf52b2b22f8e5a8e2d82fb52d87ef4a13c9a405b06986d5d19b170d0fd05328b8ae29f9d92ec0bca80f7b60e7

另请参见

若要在数据类型上应用加密哈希函数，请参考运行常见加密哈希函数的配方。

执行数据类型间的快速比较

StableName包允许我们对任意数据类型建立常数时间的比较。Hackage 文档优雅地描述了这一点（hackage.haskell.org/package/base-4.7.0.0/docs/System-Mem-StableName.html）：

“稳定名称解决了以下问题：假设你想要用 Haskell 对象作为键来构建哈希表，但你希望使用指针相等性进行比较；可能是因为键非常大，哈希操作会很慢，或者是因为键的大小是无限的。我们不能使用对象的地址作为键来构建哈希表，因为对象会被垃圾收集器移动，这意味着每次垃圾回收后都需要重新哈希。”

如何操作……

按照以下方式导入内置的StableName包：
```
import System.Mem.StableName
```
按照以下方式创建一个自定义数据类型：
```
data Point = Point [Int]
```

在main中，按如下方式定义两个点：

  main = do
    let p1 = Point [1..]
    let p2 = Point [2,4]

获取每个点的稳定名称，并使用以下命令集显示它：

sn1 <- makeStableName p1
sn2 <- makeStableName p2
print $ hashStableName sn1
print $ hashStableName sn2

注意以下结果，我们可以轻松获取任意数据类型的稳定名称：
```
$ runhaskell Main.hs

22
23
```

使用高性能哈希表

Haskell 已经提供了一个基于大小平衡二叉树的Data.Map模块。还有一些优化更好的哈希表库，如unordered-containers包中的Data.HashMap。

例如，Data.Map和Data.HashMap都具有 O(log n)的插入和查找时间复杂度；然而，后者使用了较大的基数，因此在实际操作中，这些操作是常数时间。有关Data.HashMap的更多文档可以在hackage.haskell.org/package/unordered-containers-0.2.4.0/docs/Data-HashMap-Lazy.html找到。

在这个示例中，我们将使用 Hackage 上的 unordered-contains 库，创建一个将单词长度映射到该长度单词集合的映射。

准备就绪

下载一个大文本语料库并将文件命名为big.txt，如下所示：

$ wget norvig.com/big.txt

使用 Cabal 安装Data.HashMap包，方法如下：

$ cabal install unordered-containers

如何操作……

按照以下方式导入HashMap包：

import Data.HashMap.Lazy
import Data.Set (Set)
import qualified Data.Set as Set

创建一个辅助函数来定义一个空的哈希映射，使用以下代码行：
```
emptyMap = empty :: HashMap Int (Set String)
```

使用以下代码片段定义一个函数，将单词插入哈希映射：

insertWord m w = insertWith append key val m
  where append new old = Set.union new old 
    key = length w
    val = Set.singleton w

按照以下方式从映射中查找特定长度的所有单词：

wordsOfLength len m = Set.size(lookupDefault Set.empty len m )

使用以下代码行从文本语料库构建哈希映射：

constructMap text = foldl (\m w -> insertWord m w) emptyMap (words text)

阅读大型文本语料库，构建哈希映射，并打印每个长度单词的数量，代码片段如下：

main = do
  text <- readFile "big.txt"
  let m = constructMap text
  print [wordsOfLength s m | s <- [1..30]]

输出如下：

$ runhaskell Main.hs

[59,385,1821,4173,7308,9806,11104,11503,10174,7948,5823,4024,2586,1597,987,625,416,269,219,139,115,78,51,50,27,14,17,15,11,7]

如果我们绘制数据图表，可以发现一个有趣的趋势，如下图所示：

如何操作……

工作原理……

有关该库的技术细节，请参见作者在以下博客文章中的说明：

blog.johantibell.com/2012/03/announcing-unordered-containers-02.html

使用 Google 的 CityHash 哈希函数处理字符串

Google 的 CityHash 哈希函数专为字符串哈希优化，但并不适用于密码学安全。CityHash 非常适合实现处理字符串的哈希表。我们将在本食谱中使用它来生成 64 位和 128 位的摘要。

准备就绪

如下所示，从 Cabal 安装 cityhash 包：

$ cabal install cityhash

如何做到…

如下所示导入相关包：

import Data.Digest.CityHash
import Data.ByteString.Char8 (pack)
import Data.Word (Word64)
import Data.LargeWord (Word128)

使用以下代码片段测试不同的哈希函数在输入字符串上的效果：

main = do
 (pack str) (1 :: Word128)  let str = "cityhash"
  print $ cityHash64 (pack str)
  print $ cityHash64WithSeed (pack str) (1 :: Word64)
  print $ cityHash64WithSeed (pack str) (2 :: Word64)
  print $ cityHash128 (pack str)
  print $ cityHash128WithSeed
  print $ cityHash128WithSeed (pack str) (2 :: Word128)

如下所示显示输出：

$ runhaskell Main.hs

11900721293443925155
10843914211836357278
12209340445019361150
116468032688941434670559074973810442908
218656848647432546431274347445469875003
45074952647722073214392556957268553766

它是如何工作的…

Google 在其博客公告中描述了该包，地址为 google-opensource.blogspot.com/2011/04/introducing-cityhash.html，如下所示：

"我们方法的关键优势在于，大多数步骤至少包含两个独立的数学运算。现代 CPU 在这种类型的代码上表现最好。"

另请参见

要查看更通用的哈希函数，请参考 哈希原始数据类型 和 哈希自定义数据类型 这两个食谱。

计算位置坐标的 Geohash

Geohash 是一种实际的经纬度坐标编码。与典型的哈希函数不同，Geohash 在位置上有细微变化时，输出摘要也会发生小变化。Geohash 允许高效的邻近搜索，精度由摘要长度决定。

准备就绪

安装 Geohashing 库，如下所示：

$ cabal install geohash

如何做到…

如下所示导入 Geohash 库：
```
import Data.Geohash
```

创建一个经纬度坐标对的地理哈希值，如下所示：

  main = do
    let geohash1 = encode 10 (37.775, -122.419)
    putStrLn $ "geohash1 is " ++ (show geohash1)

使用以下代码片段显示地理哈希值：

case geohash1 of
  Just g -> putStrLn $ "decoding geohash1: " ++ (show.decode) g
  Nothing -> putStrLn "error encoding"

创建另一个相似的经纬度坐标对的地理哈希值，如下所示：

let geohash2 = encode 10 (37.175, -125.419)
putStrLn $ "geohash2 is " ++ (show geohash2)

使用以下代码片段显示地理哈希值：

case geohash2 of
Just g -> putStrLn $ "decoding geohash2: " ++ (show.decode) g
Nothing -> putStrLn "error encoding"

输出如下所示。请注意，由于它们的相似性，地理哈希值似乎共享相同的前缀。

$ runhaskell Main.hs

geohash1 is Just "9q8yyk9pqd"

decoding geohash1: Just (37.775000631809235,-122.4189966917038)

geohash2 is Just "9nwg6p88j6"

decoding geohash2: Just (37.175001204013824,-125.4190045595169)

使用 Bloom 过滤器去除唯一项

Bloom 过滤器是一种抽象数据类型，用于测试某个项是否存在于集合中。与典型的哈希映射数据结构不同，Bloom 过滤器仅占用恒定的空间。它的优势在于处理数十亿数据时非常有效，例如 DNA 链条的字符串表示："GATA"、"CTGCTA" 等。

在本食谱中，我们将使用 Bloom 过滤器尝试从列表中移除唯一的 DNA 链条。这通常是需要的，因为一个典型的 DNA 样本可能包含成千上万只出现一次的链条。Bloom 过滤器的主要缺点是可能会产生假阳性结果，即它可能错误地认为某个元素存在。尽管如此，假阴性是不可发生的：Bloom 过滤器永远不会错误地认为某个元素不存在，即使它实际存在。

准备就绪

如下所示，从 Cabal 导入 Bloom 过滤器包：

$ cabal install bloomfilter

如何做到…

如下所示导入 Bloom 过滤器包：

import Data.BloomFilter (fromListB, elemB, emptyB, insertB)
import Data.BloomFilter.Hash (cheapHashes)
import Data.Map (Map, empty, insertWith)
import qualified Data.Map as Map

创建一个函数来移除列表中的唯一元素。首先检查每个项目是否存在于布隆过滤器中；如果存在，将其添加到哈希映射中。如果不存在，则将其添加到布隆过滤器中，代码示例如下：

removeUniques strands = foldl bloomMapCheck 
                        (emptyBloom, emptyMap) strands

  where emptyBloom = emptyB (cheapHashes 3) 1024
        emptyMap = empty :: Map String Int
        bloomMapCheck (b, m) x
        | elemB x b = (b, insertWith (+) x 1 m)
        | otherwise = (insertB x b, m)

在几个 DNA 链示例上运行算法，如下所示：

main = do
let strands = ["GAT", "GATC", "CGT", "GAT"
                        , "GAT", "CGT", "GAT", "CGT"]
print $ snd $ removeUniques strands

我们看到以下可能至少出现两次的串：

$ runhaskell Main.hs

fromList [("CGT",2),("GAT",3)]

它是如何工作的…

布隆过滤器由几个哈希函数和一个初始化为零的数字列表组成。当将元素插入该数据结构时，会根据每个哈希函数计算哈希，并更新列表中相应的项。布隆过滤器的成员测试是通过计算输入的每个哈希函数并测试所有相应的列表元素是否都超过某个阈值来进行的。

它是如何工作的…

例如，在前面的图示中，三个哈希函数会应用于每个输入。当计算x、y和z的哈希时，表示布隆过滤器的列表中的相应元素会增加。我们可以通过计算三个哈希并检查相应索引是否都达到所需值来确定w是否存在于此布隆过滤器中。在此情况下，w并不存在于布隆过滤器中。

运行 MurmurHash，一个简单但快速的哈希算法

有时，哈希函数的优先级应该是最大化其计算速度。MurmurHash 算法正是为此目的而存在。当处理大规模数据集时，速度至关重要。

提示

快速哈希算法也有其负面影响。如果哈希算法 A 比哈希算法 B 快 10 倍，那么用随机内容搜索时，找到用 A 生成摘要的内容也会比用 B 快 10 倍。哈希算法应该快速，但不能快到影响算法的安全性。

准备中

从 Cabal 安装 Murmur 哈希算法，如下所示：

$ cabal install murmur-hash

如何操作…

导入 Murmur 哈希算法，如下所示：
```
import Data.Digest.Murmur32
```

定义一个自定义数据类型并实现一个实例来使用 Murmur，如下所示：

data Point = Point Int Int
  instance (Hashable32 Point) where 
  hash32Add (Point x y) h = x `hash32Add` (y `hash32Add` h)

在不同的输入上运行哈希算法，使用以下代码片段：

main = do
  let p1 = Point 0 0
  let p2 = Point 2 3
  putStrLn $ "hash of string: " 
                           ++ (show.hash32) "SO FAST WOW."
  putStrLn $ "hash of a data-type: " ++ (show.hash32) p1
  putStrLn $ "hash of another data-type: " ++ (show.hash32) p2

生成以下哈希：

$ runhaskell Main.hs

hash of string: Hash32 0xa18fa3d2

hash of a data-type: Hash32 0x30408e22

hash of another data-type: Hash32 0xfda11257

使用感知哈希衡量图像相似度

感知哈希从图像文件中生成一个小的摘要，其中图像的微小变化只会导致哈希值的轻微变化。这在快速比较成千上万张图像时非常有用。

准备中

从www.phash.org安装pHash库。在基于 Debian 的系统上，我们可以使用apt-get命令进行安装，如下所示：

$ sudo apt-get install libphash0-dev

从 Cabal 安装phash库，如下所示：

$ cabal install phash

找到三张几乎相同的图像。我们将使用以下图像：

准备中

这是我们将使用的第二张图片

准备中

下面的图像是第三张：

准备中

如何操作…

导入phash库，代码如下：

import Data.PHash
import Data.Maybe (fromJust, isJust)

对一张图片进行哈希处理，结果如下：

main = do
  phash1 <- imageHash "image1.jpg"
  putStrLn $ "image1: " ++ show phash1

对一张相似的图片进行哈希处理，结果如下：

  phash2 <- imageHash "image2.jpg"
    putStrLn $ "image2: " ++ show phash2

对一张稍微不同的图片进行哈希处理，结果如下：

  phash3 <- imageHash "image3.jpg"
  putStrLn $ "image3: " ++ show phash3

使用以下代码片段计算前两张图片的相似度：

  if isJust phash1 && isJust phash2
    then do putStr "hamming distance between image1 and image2: "
    print $ hammingDistance (fromJust phash1) (fromJust phash2)
  else print "Error, could not read images"

计算第一张图片与第三张图片的相似度，结果如下：

  if isJust phash1 && isJust phash3
    then do putStr "hamming distance between image1 and image3: "
    print $ hammingDistance 
    (fromJust phash1) (fromJust phash3)
  else print "Error, could not read images"

输出哈希值如下：

$ runhaskell Main.hs

image1: Just (PHash 14057618708811251228)

image2: Just (PHash 14488838648009883164)

image3: Just (PHash 9589915937059962524)

hamming distance between image1 and image2: 4

hamming distance between image1 and image3: 10

它是如何工作的…

在十六进制（或二进制）中可视化这些哈希值的相似性要容易得多，因为哈明距离是按比特操作的。

三张图片的十六进制表示如下：

图片 1: c316b1bc36947e1c
图片 2: c912b1fc36947e1c
图片 3: 851639bc3650fe9c

通过比较这些值，我们可以看到，图片 1 和图片 2 仅相差四个字符，而图片 1 和图片 3 相差整整 10 个字符。

第五章树的舞蹈

本节涵盖了从创建简单的二叉树到哈夫曼编码等实际应用：

定义二叉树数据类型
定义玫瑰树（多路树）数据类型
深度优先遍历树
广度优先遍历树
为树实现可折叠实例
计算树的高度
实现二叉搜索树数据结构
验证二叉搜索树的顺序属性
使用自平衡树
实现最小堆数据结构
使用哈夫曼树对字符串进行编码
解码哈夫曼编码

简介

树是广泛应用于各种数据分析技术中的常见数据结构。树是一个节点的层次化连接，所有节点都在一个强大的根节点下。每个节点可以有零个或多个子节点，但每个子节点只与一个父节点相关联。此外，根节点是唯一没有父节点的特殊节点。所有没有子节点的节点也称为叶子节点。

在 Haskell 中，我们可以优雅地表示树，因为数据结构的递归性质利用了函数式编程的递归特性。本节将介绍创建我们自己的树以及使用库中现有的实现。

我们将实现堆和哈夫曼树，它们是数据分析中最著名的树结构之一。在本书的其他章节中，我们还会遇到 HTML/XML 遍历、层次聚类和决策树，这些都在很大程度上依赖于树数据结构。

定义二叉树数据类型

在二叉树中，每个节点最多有两个子节点。我们将定义一个数据结构来包含每个节点的左子树和右子树。

准备工作

本节中的代码将表示以下树结构。根节点标记为n3，值为3。它有一个左节点n1，值为1，和一个右节点n2，值为2。

准备工作

如何做...

这段代码不需要任何导入。我们可以直接定义数据结构递归地。树可以是一个带有值的节点，也可以是空/null：

data Tree a = Node { value	:: a
                   , left  :: (Tree a)
                   , right:: (Tree a) }
            | Leaf 
            deriving Show

在 main 中，创建如上图所示的树并将其打印出来：

main = do
  let n1 = Node { value = 1, left = Leaf, right = Leaf }
  let n2 = Node { value = 2, left = Leaf, right = Leaf }
  let n3 = Node { value = 3, left = n1,   right = n2 }
  print n3

完整的树结构打印结果如下：

$ runhaskell Main.hs

Node { value = 3
 , left = Node  { value = 1
 , left = Leaf
 , right = Leaf }
 , right = Node { value = 2
 , left = Leaf
 , right = Leaf }
 }

另见

如果树中的节点需要超过两个子节点，则请参阅下一节，定义玫瑰树（多路树）数据类型。

定义玫瑰树（多路树）数据类型

玫瑰树放松了每个节点最多两个子节点的限制。它可以包含任意数量的元素。玫瑰树在解析 HTML 时很常见，用于表示文档对象模型（DOM）。

准备工作

我们将在本节中表示以下树结构。根节点有三个子节点：

准备工作

如何做...

本节的配方不需要任何导入：

玫瑰树数据类型与二叉树的数据类型相似，不同之处在于它不会使用左、右子节点，而是存储一个任意数量的子节点的列表：
```
data Tree a = Node { value  :: a
                   , children  :: [Tree a] } 
                   deriving Show
```

从前面的图示构建树并将其打印出来：

main = do
  let n1 = Node { value = 1, children = [] }
  let n2 = Node { value = 2, children = [] }
  let n3 = Node { value = 3, children = [] }
  let n4 = Node { value = 6, children = [n1, n2, n3] }
  print n4

打印的输出将如下所示：

$ runhaskell Main.hs

Node { value = 6
 , children = [ Node { value = 1
 , children = [] }
 , Node { value = 2
 , children = [] }
 , Node { value = 3
 , children = [] } ] 
 }

它是如何工作的……

玫瑰树不像使用专用的左、右字段来表示子节点，而是使用列表数据结构来表示任意数量的子节点。如果每个节点最多只能有两个子节点，则可以使用玫瑰树模拟二叉树。

另见

要表示一个二叉树，使用之前的方案可能会更简单，定义二叉树数据类型。

深度优先遍历树

本方案将展示一种遍历树的方法。该算法从根节点开始，沿着一条分支深入探索所有节点，直到回到较浅的节点继续探索。

由于我们会在递归地检查子节点之前检查每个节点，因此我们称之为先序遍历。相反，如果我们在检查每个节点之后再检查其子节点，那么我们称这种方法为后序遍历。介于两者之间的是中序遍历，但自然地，玫瑰树没有唯一的中序遍历。

使用深度优先方法的最大优势是最小的空间复杂度。视频游戏中的 AI 常常使用深度优先方法来确定对抗对手时的最佳动作。然而，在庞大或无限的树中，如果我们不断访问后续子节点，深度优先搜索可能永远无法终止。

准备就绪

我们将以深度优先的方式遍历以下树。我们从节点r开始，首先探索节点n1，然后是n2，接着返回查找n3，最后回溯到n4，并最终结束。

准备就绪

如何实现……

我们将使用Data.Tree中的现有玫瑰树实现：

import Data.Tree (rootLabel, subForest, Tree(..))
import Data.List (tails)

这个函数将会深度优先遍历树：

depthFirst :: Tree a -> [a]

depthFirst (Node r forest) = 
  r : concat [depthFirst t | t <- forest]

这是一个深度优先实现，目的是将树中的所有值相加：

add :: Tree Int -> Int

add (Node r forest) = r + sum [add t | t <- forest]

定义一个树来表示前面的图示：

someTree :: Tree Int

someTree = r
  where r  = Node { rootLabel = 0, subForest = [n1, n4] }
        n1 = Node { rootLabel = 1, subForest = [n2, n3] }
        n2 = Node { rootLabel = 2, subForest = [] }
        n3 = Node { rootLabel = 3, subForest = [] }
        n4 = Node { rootLabel = 4, subForest = [] }

测试深度优先函数：

main = do
  print $ depthFirst someTree
  print $ add someTree

这将打印出以下两行输出：
```
$ runhaskell Main.hs

[0,1,2,3,4]
10
```

它是如何工作的……

在这个方案中，我们使用了来自Data.Tree的内置玫瑰树数据结构。与我们在前一个方案中的实现类似，它的Tree数据类型具有以下构造函数：

data Tree a = Node { rootLabel :: a
                   , subForest :: Forest a }

我们在每个子节点上递归运行depthFirst算法，并将其附加到节点的值上，从而创建一个表示树遍历的列表。

另见

如果更倾向于按树的层次遍历树，请查看下一节，广度优先遍历树。

广度优先遍历树

在树的广度优先搜索方法中，节点按照树的深度顺序被访问。首先访问根节点，然后是它的子节点，再接着是每个子节点的子节点，依此类推。这个过程比深度优先遍历需要更大的空间复杂度，但在优化搜索算法时非常有用。

例如，假设你试图从维基百科文章中找到所有相关的主题。以广度优先的方式遍历文章中的所有链接，有助于确保主题从一开始就具有相关性。

准备就绪

请查看下图中的树。广度优先遍历将从根节点r开始，然后继续到下一级，遇到n1和n4，最后是n2和n3。

准备就绪

如何实现...

我们将使用来自Data.Tree的现有玫瑰树实现：

import Data.Tree (rootLabel, subForest, Tree(..))
import Data.List (tails)

实现树的广度优先遍历：

breadthFirst :: Tree a -> [a]

breadthFirst t = bf [t]
  where bf forest | null forest = []
                  | otherwise   = map rootLabel forest ++
                         bf (concat (map subForest forest))

为了演示，实现一个函数来添加树中每个节点的值。
```
add :: Tree Int -> Int

add t = sum $ breadthFirst t
```

根据前面的图表创建一棵树：

someTree :: Tree Int

someTree = root
  where root = Node { rootLabel = 0, subForest = [n1, n4] }
        n1   = Node { rootLabel = 1, subForest = [n2, n3] }
        n2   = Node { rootLabel = 2, subForest = [] }
        n3   = Node { rootLabel = 3, subForest = [] }
        n4   = Node { rootLabel = 4, subForest = [] }

在main中测试广度优先算法：

main = do
  print $ breadthFirst someTree
  print $ add someTree

输出结果如下：
```
$ runhaskell Main.hs

[0,1,4,2,3]
10
```

它是如何工作的…

在这个配方中，我们使用了Data.Tree中的内置玫瑰树数据结构。与我们之前某个配方中的实现类似，它具有以下构造器的Tree数据类型：

data Tree a = Node { rootLabel :: a
                   , subForest :: Forest a }

我们通过创建一个列表来执行广度优先搜索，该列表从节点的直接子节点的值开始。然后，附加子节点的子节点的值，依此类推，直到树完全遍历。

另见

如果空间复杂度成为问题，那么之前的配方，深度优先遍历树，可能会提供更好的方法。

为树实现一个`Foldable`实例

遍历树的概念可以通过实现一个Foldable实例来推广。通常，fold 操作用于列表；例如，foldr1 (+) [1..10]遍历一个数字列表以产生总和。类似地，我们可以应用foldr1 (+) tree来找到树中所有节点的总和。

准备就绪

我们将通过以下树来折叠并获取所有节点值的总和。

准备就绪

如何实现...

导入以下内置包：

import Data.Monoid (mempty, mappend)
import qualified Data.Foldable as F
import Data.Foldable (Foldable, foldMap)

Data.Tree中的树已经实现了Foldable，因此我们将定义自己的树数据类型用于演示：

data Tree a = Node { value :: a
                   , children :: [Tree a] }
                   deriving Show

为Foldable实例实现foldMap函数。这个实现将给我们树的后序遍历：

instance Foldable Tree where
  foldMap f Null = mempty
  foldMap f (Node val xs) = foldr mappend (f val) 
                             [foldMap f x | x <- xs]

定义一个函数通过树折叠以找到所有节点的和：
```
add :: Tree Integer -> Integer

add = F.foldr1 (+)
```

构造一个表示前面图表中树的树：

someTree :: Tree Integer

someTree = root
  where root = Node { value = 0, children = [n1, n4] }
        n1   = Node { value = 1, children = [n2, n3] }
        n2   = Node { value = 2, children = [] }
        n3   = Node { value = 3, children = [] }
        n4   = Node { value = 4, children = [] }

通过在树上运行add函数来测试折叠操作：
```
main :: IO ()
main = print $ add someTree
```
结果将打印如下：
```
$ runhaskell Main.hs

10
```

它是如何工作的...

定义Foldable实例所需的函数是foldMap或foldr。在本节中，我们定义了foldMap :: (Foldable t, Data.Monoid.Monoid m) => (a -> m) -> t a -> m函数，该函数实际上将一个函数f映射到树中的每个节点，并通过使用Data.Monoid中的mappend将其连接起来。

另请参见

遍历树的其他方法在前两节中讨论过，深度优先遍历树和广度优先遍历树。

计算树的高度

树的高度是从根节点到最深路径的长度。例如，一个平衡二叉树的高度应该大约是节点数量的以 2 为底的对数。

准备就绪

只要我们保持一致，树的高度可以定义为最长路径中节点的数量或边的数量。在本节中，我们将通过节点的数量来计算。该树的最长路径包含三个节点和两条边。因此，这棵树的高度为三个单位。

准备就绪

如何操作...

从Data.List导入maximum function，并从Data.Tree导入内置的树数据结构：
```
import Data.List (maximum)
import Data.Tree
```

定义一个函数来计算树的高度：

height :: Tree a -> Int

height (Node val []) = 1
height (Node val xs) = 1 + maximum (map height xs)

构建一棵树，我们将在其上运行算法：

someTree :: Tree Integer

someTree = root
  where root = 0 [n1, n4]
        n1   = 1 [n2, n3]
        n2   = 2 []
        n3   = 3 []
        n4   = 4 []

在main中测试该函数：
```
main = print $ height someTree
```
树的高度将如下所示打印出来：
```
$ runhaskell Main.hs

3
```

它是如何工作的...

height函数通过递归查找其子树中的最大高度，并返回该值加一。

实现二叉搜索树数据结构

二叉搜索树对二叉树施加了一种顺序属性。这个顺序属性要求在每个节点中，左子树中的节点不能大于当前节点，右子树中的节点不能小于当前节点。

如何操作...

创建一个二叉BSTree模块，用于暴露我们的二叉搜索树数据结构。将以下代码插入一个名为BSTree.hs的文件中：
```
module BSTree (insert, find, single) where
```

定义二叉树的数据结构：

data Tree a = Node	{value	:: a
                   , left   :: (Tree a)
                   , right  :: (Tree a)}
             | Null
             deriving (Eq, Show)

定义一个便捷函数来创建一个单节点树：
```
single :: a -> Tree a

single n = Node n Null Null
```

实现一个函数，用于向二叉搜索树中插入新值：

insert :: Ord a => Tree a -> a -> Tree a

insert (Node v l r) v'
  | v' < v      = Node v (insert l v') r
  | v' > v      = Node v l (insert r v')
  | otherwise   = Node v l r

insert _ v' = Node v' Null Null

实现一个函数，用于在二叉搜索树中查找具有特定值的节点：

find :: Ord a => Tree a -> a -> Bool

find (Node v l r) v'
  | v' < v      = find l v'
  | v' > v      = find r v'
  | otherwise   = True

find Null v' = False

现在，测试BSTree模块，在一个新的文件中写入以下代码，可以命名为Main.hs：
```
import BSTree
```

在main中，通过对不同的值调用insert函数构造一棵二叉搜索树：

main = do
  let tree = single 5
  let nodes = [6,4,8,2,9]
  let bst = foldl insert tree nodes

打印树并测试find函数：

  print bst
  print $ find bst 1
  print $ find bst 2

输出应如下所示：

$ runhaskell Main.hs

Node { value = 5
 , left = Node { value = 4
 , left = Node { value = 2
 , left = Null
 , right = Null }
 , right = Null }
 , right = Node { value = 6
 , left = Null
 , right = Node { value = 8
 , left = Null
 , right = Node { value = 9
 , left = Null
 , right = Null }
 }
 }
 }

False

True

它是如何工作的...

二叉搜索树数据结构的核心功能是insert和find，分别用于在二叉搜索树中插入和查找元素。查找节点是通过遍历树并利用其顺序性质来完成的。如果值低于预期，它会检查左节点；否则，如果值较大，它会检查右节点。最终，这个递归算法要么找到所需的节点，要么到达叶节点，从而找不到该节点。

二叉搜索树不保证树是平衡的，因此不能期望有快速的 O(log n)查找操作。二叉搜索树总有可能最终看起来像一个列表数据结构（例如，当我们按照[1,2,3,4,5]的顺序插入节点时，检查最终结构）。

另请参见

给定一棵二叉树，可以使用以下名为验证二叉搜索树的顺序性质的实例来验证顺序性质。如果要使用平衡的二叉树，请参考实例使用自平衡树。

验证二叉搜索树的顺序性质

给定一棵二叉树，本实例将介绍如何验证它是否满足顺序性质，即左子树中的所有元素都较小，而右子树中的所有元素都较大。

准备工作

我们将验证以下树是否为二叉搜索树：

准备工作

如何实现...

本实例无需导入任何包。请按照以下步骤检查树是否为二叉搜索树：

定义一个二叉树的数据结构：

data Tree a = Node { value  :: a
                   , left  :: (Tree a)
                   , right :: (Tree a)}
            | Null
    deriving (Eq, Show)

根据前面的图示构建一棵树：

someTree :: Tree Int

someTree = root  
  where root = Node 0 n1 n4
        n1   = Node 1 n2 n3
        n2   = Node 2 Null Null
        n3   = Node 3 Null Null
        n4   = Node 4 Null Null

定义一个函数来验证树是否遵循二叉顺序性质：

valid :: Ord t => Tree t -> Bool

valid (Node v l r) = leftValid && rightValid
  where leftValid  = if notNull l 
                       then valid l && value l <= v 
                       else True
        rightValid = if notNull r 
                       then valid r && v <= value r 
                       else True
        notNull t  =  t /= Null

在main中测试该功能：
```
main = print $ valid someTree
```
很明显，这棵树不遵循顺序性质，因此，输出结果如下：
```
$ runhaskell Main.hs

False
```

工作原理...

valid函数递归地检查左子树是否包含小于当前节点的元素，右子树是否包含大于当前节点的元素。

使用自平衡树

AVL 树是一种平衡的二叉搜索树。每个子树的高度差最多为一。在每次插入或删除时，树会通过一系列旋转操作调整节点，使其保持平衡。平衡的树确保了高度最小化，从而保证查找和插入操作在*O(log n)*时间内完成。在这个实例中，我们将直接使用 AVL 树包，但自平衡树也可以在Data.Set和Data.Map实现中找到。

准备工作

我们将使用AvlTree包来使用Data.Tree.AVL：

$ cabal install AvlTree

如何实现...

导入相关的 AVL 树包：

import Data.Tree.AVL
import Data.COrdering

从一个值列表中设置一个 AVL 树，并读取其中的最小值和最大值：

main = do
  let avl  = asTree fstCC [4,2,1,5,3,6]
  let min  = tryReadL avl
  let max  = tryReadR avl
  print min
  print max

最小值和最大值如下所示：
```
$ runhaskell Main.hs

Just 1
Just 6
```

工作原理...

asTree :: (e -> e -> COrdering e) -> [e] -> AVL 函数接受一个排序属性和一个元素列表，生成相应元素的 AVL 树。fstCC :: Ord a => a -> a -> COrdering a 函数来自 Data.Cordering，其定义如下：

一个为 'Ord' 实例提供的组合比较，它在认为两个参数相等时保留第一个参数，第二个参数则被丢弃。

还有更多…

Haskell 的 Data.Set 和 Data.Map 函数实现高效地使用了平衡二叉树。我们可以通过简单地使用 Data.Set 来重写这个方法：

import qualified Data.Set as S

main = do
  let s = S.fromList [4,2,1,5,3,6]
  let min = S.findMin s
  let max = S.findMax s
  print min
  print max

实现一个最小堆数据结构

堆是一个具有形状属性和堆属性的二叉树。形状属性通过定义每个节点除非位于最后一层，否则都必须有两个子节点，强制树以平衡的方式表现。堆属性确保如果是最小堆，则每个节点小于或等于其任何子节点，最大堆则相反。

堆用于常数时间查找最大或最小元素。我们将在下一个示例中使用堆来实现我们自己的霍夫曼树。

入门

安装 lens 库以便于数据操作：

$ cabal install lens

如何实现...

在 MinHeap.hs 文件中定义 MinHeap 模块：

module MinHeap (empty, insert, deleteMin, weights) where

import Control.Lens (element, set)
import Data.Maybe (isJust, fromJust)

我们将使用一个列表来表示二叉树数据结构，仅用于演示目的。最好将堆实现为实际的二叉树（如我们在前面的章节中所做的），或者我们应使用实际的数组来提供常数时间访问其元素。为了简化起见，我们将定义根节点从索引 1 开始。给定一个位于索引 i 的节点，左子节点将始终位于 2i*，右子节点位于 2i + 1*：
```
data Heap v = Heap { items :: [Node v] }
              deriving Show

data Node v = Node { value :: v, weight :: Int }
              deriving Show
```
我们定义一个方便的函数来初始化一个空堆：
```
empty = Heap []
```

在堆中插入一个节点的方法是将节点添加到数组的末尾，然后将其上浮：

insert v w (Heap xs) = percolateUp position items'
  where items'   = xs ++ [Node v w]
        position = length items' - 1

从堆中删除一个节点的方法是将根节点与最后一个元素交换，然后从根节点开始向下浮动：
```
deleteMin (Heap xs) = percolateDown 1 items'
  where items' = set (element 1) (last xs) (init xs)
```

创建一个函数来查看最小值：

viewMin heap@(Heap (_:y:_)) = 
  Just (value y, weight y, deleteMin heap)
viewMin _                   = Nothing

从一个节点向下浮动意味着确保当前节点的堆属性成立；否则，将节点与其较大或较小的子节点（根据是最大堆还是最小堆）交换。这个过程会递归地应用直到叶节点：
```
percolateDown i items
   | isJust left && isJust right = percolateDown i' 
                                     (swap i i' items)
   | isJust left = percolateDown l (swap i l items)
   | otherwise = Heap items
```

定义 left、right、i'、l 和 r 变量：

  where left   = if l >= length items
                   then Nothing
                   else Just $ items !! l
        right  = if r >= length items
                   then Nothing
                   else Just $ items !! r
        i'     = if (weight (fromJust left)) < 
                      (weight (fromJust right))
                 then l else r
        l      = 2*i
        r      = 2*i + 1

上浮一个节点意味着递归地将节点与其父节点交换，直到树的堆属性成立：

percolateUp i items
  | i == 1 = Heap items
  | w < w' = percolateUp c (swap i c items)
  | otherwise = Heap items
   where  w  = weight $ items !! i
          w' = weight $ items !! c
          c  = i `div` 2

我们定义一个方便的函数来交换列表中两个索引处的元素：

swap i j xs = set (element j) vi (set (element i) vj xs)
  where vi = xs !! i
        vj = xs !! j

为了查看堆在数组表示中的每个节点的权重，我们可以定义如下函数：
```
weights heap = map weight ((tail.items) heap)
```

最后，在一个我们可以命名为 Main.hs 的不同文件中，我们可以测试最小堆：

import MinHeap

main = do
  let heap = foldr (\x -> insert x x) 
               empty [11, 5, 3, 4, 8]
  print $ weights heap
  print $ weights $ iterate deleteMin heap !! 1
  print $ weights $ iterate deleteMin heap !! 2
  print $ weights $ iterate deleteMin heap !! 3
  print $ weights $ iterate deleteMin heap !! 4

堆的数组表示中的权重输出如下：

$ runhaskell Main.hs

[3,5,4,8,11]
[4,5,11,8]
[5,8,11]
[8,11]
[11]

还有更多…

本节代码用于理解堆数据结构，但效率并不高。Hackage 上有更好的堆实现，包括我们将要探索的Data.Heap库：

导入堆库：

import Data.Heap (MinHeap, MaxHeap, empty, insert, view)

定义一个辅助函数，从列表构建最小堆：

minheapFromList :: [Int] -> MinHeap Int
minheapFromList ls = foldr insert empty ls

定义一个辅助函数，从列表构造最大堆：

maxheapFromList :: [Int] -> MaxHeap Int
maxheapFromList ls = foldr insert empty ls

测试堆：

main = do
  let myList = [11, 5, 3, 4, 8]
  let minHeap = minheapFromList myList
  let maxHeap = maxheapFromList myList
  print $ view minHeap
  print $ view maxHeap

视图函数返回一个Maybe数据结构中的元组。元组的第一个元素是执行查找操作后的值，第二个元素是删除该值后的新堆：
```
$ runhaskell Main.hs
Just (3, fromList [(4,()),(11,()),(5,()),(8,())])
Just (11, fromList [(8,()),(3,()),(5,()),(4,())])
```

使用哈夫曼树对字符串进行编码

哈夫曼树通过计算字符的概率分布来优化每个字符所占的空间，从而实现高效的数据编码。想象一下将这本书压缩成一张纸，再恢复回来而不丢失任何信息。哈夫曼树允许这种基于统计数据的最优无损数据压缩。

在本节中，我们将实现一个哈夫曼树，从文本源生成它的哈夫曼编码的字符串表示。

例如，字符串“hello world”包含 11 个字符，这些字符根据编码方式和架构的不同，可能只需要占用 11 个字节的空间来表示。本节代码将把该字符串转换成 51 位，或 6.375 字节。

准备工作

请确保连接到互联网，因为本节会从norgiv.com/big.txt下载文本以分析许多字符的概率分布。我们将使用前一个食谱中实现的最小堆，通过导入MinHeap：

如何操作...

导入以下包。我们将使用之前的MinHeap模块，因此请确保包含之前食谱中的代码：

import Data.List (group, sort)
import MinHeap
import Network.HTTP ( getRequest, getResponseBody, simpleHTTP )
import Data.Char (isAscii)
import Data.Maybe (fromJust)
import Data.Map (fromList, (!))

定义一个函数，返回字符与其频率的关联列表：

freq xs = map (\x -> (head x, length x)) . 
            group . sort $ xs

哈夫曼树的数据结构就是一个二叉树：

data HTree  =  HTree { value :: Char
                     , left  :: HTree
                     , right :: HTree }
            | Null
            deriving (Eq, Show)

使用一个值构造哈夫曼树：
```
single v = HTree v Null Null
```

定义一个函数，通过最小堆构建哈夫曼树：

htree heap = if length (items heap) == 2
             then case fromJust (viewMin heap) of 
                    (a,b,c) -> a
             else htree $ insert newNode (w1 + w2) heap3

  where (min1, w1, heap2) = fromJust $ viewMin heap
        (min2, w2, heap3) = fromJust $ viewMin heap2
        newNode           = HTree { value  = ' '
                                  , left   = min1
                                  , right  = min2 }

从哈夫曼树获取哈夫曼编码的映射：

codes htree = codes' htree ""

  where codes' (HTree v l r) str
            | l==Null && r==Null = [(v, str)]
            | r==Null            = leftCodes
            | l==Null            = rightCodes
            | otherwise          = leftCodes ++ rightCodes
            where  leftCodes  = codes' l ('0':str)
                   rightCodes = codes' r ('1':str)

定义一个函数，使用哈夫曼编码将字符串编码为文本：
```
encode str m = concat $ map (m !) str
```

通过在main中执行以下操作来测试整个过程。下载并计算频率可能需要几分钟：

main = do
  rsp <- simpleHTTP (getRequest 
           "http://norvig.com/big.txt")
  html <- fmap (takeWhile isAscii) (getResponseBody rsp)
  let freqs = freq html
  let heap = foldr (\(v,w) -> insert (single v) w) 
               empty freqs
  let m = fromList $ codes $ htree heap
  print $ encode "hello world" m

哈夫曼树的字符串表示形式如下所示：

$ runhaskell Main.hs

"010001110011110111110001011101000100011011011110010"

工作原理...

首先，我们通过从norvig.com/big.txt下载文本来获取分析数据源。接下来，我们获取每个字符的频率映射并将其放入堆中。哈夫曼树通过将两个最低频率的节点合并，直到最小堆中只剩下一个节点。最后，使用哈夫曼编码对示例字符串“hello world”进行编码。

另见

要读取编码后的哈夫曼值，请参阅下一节，解码哈夫曼编码。

解码哈夫曼编码

这段代码在很大程度上依赖于前面的食谱，使用哈夫曼树编码字符串。接下来使用相同的哈夫曼树数据结构来解码哈夫曼编码的字符串表示。

准备工作

阅读前面的食谱，使用哈夫曼树编码字符串。本食谱中使用的是相同的HTree数据结构。

如何操作...

我们沿着树进行遍历，直到遇到叶子节点。然后，前置找到的字符并从根节点重新开始。这个过程会持续进行，直到没有输入可用为止：

decode :: String -> HTree -> String
decode str htree = decode' str htree
  where  decode' "" _ = ""
      decode' ('0':str) (HTree _ l _)
        | leaf l    = value l : decode' str htree
        | otherwise = decode' str l
      decode' ('1':str) (HTree v _ r)
        | leaf r    = value r : decode' str htree
        | otherwise = decode' str r
      leaf tree = left tree == Null && right tree == Null

另请参见

要使用哈夫曼树编码数据，请参见前面的食谱，使用哈夫曼树编码字符串。

第六章图基础

本章我们将涵盖以下方法：

从边的列表表示图
从邻接表表示图
对图进行拓扑排序
深度优先遍历图
图的广度优先遍历
使用 Graphviz 可视化图
使用有向无环图
处理六边形和方形网格网络
查找图中的最大团
确定两个图是否同构

介绍

本节关于图的内容是对前一节关于树的内容的自然扩展。图是表示网络的基本数据结构，本章将涵盖一些重要的算法。

图减轻了树的一些限制，使得可以表示网络数据，如生物基因关系、社交网络和道路拓扑。Haskell 支持多种图数据结构库，提供了各种有用的工具和算法。本节将涵盖图的表示、拓扑排序、遍历以及与图相关的包等基础话题。

从边的列表表示图

图可以通过一组边来定义，其中边是顶点的元组。在Data.Graph包中，顶点就是Int。在这个方法中，我们使用buildG函数根据一组边构建图数据结构。

准备就绪

我们将构建如下图所示的图：

准备就绪

如何做……

创建一个新文件，我们将其命名为Main.hs，并插入以下代码：

导入Data.Graph包：
```
import Data.Graph
```

使用导入库中的buildG函数构建图：

myGraph :: Graph

myGraph= buildG bounds edges  
  where  bounds = (1,4)
      edges = [ (1,3), (1,4)
              , (2,3), (2,4) 
              , (3,4) ]

打印图、它的边和顶点：

main = do
  print $ "The edges are " ++ (show.edges) myGraph
  print $ "The vertices are " ++ (show.vertices) myGraph

它是如何工作的……

一组边被传递给buildG :: Bounds -> [Edge] -> Graph函数以构建图数据结构。第一个参数指定了顶点的上下边界，第二个参数指定了组成图的边的列表。

这种图数据类型实际上是一个 Haskell 数组，表示从顶点到顶点列表的映射。它使用了内建的Data.Array包，意味着我们可以在图中使用Data.Array提供的所有函数。

另见

要了解另一种构建图的方式，请参见下一个方法，从邻接表表示图。

从邻接表表示图

给定邻接表构建图可能会更方便。在本方法中，我们将使用内建的Data.Graph包来读取顶点与其连接的顶点列表之间的映射。

准备就绪

我们将构建如下图所示的图：

准备就绪

如何做……

创建一个新文件，我们将其命名为Main.hs，并插入以下代码：

导入Data.Graph包：
```
import Data.Graph
```

使用 graphFromEdges' 函数获取包含图形的元组。元组的第一个元素是图数据结构 Graph，第二个元素是从节点编号到其相应值的映射 Vertex -> (node, key, [key])：

myGraph :: Graph

myGraph = fst $ graphFromEdges'   [ ("Node 1", 1, [3, 4] )
                                  , ("Node 2", 2, [3, 4]) 
                                  , ("Node 3", 3, [4])
                                  , ("Node 4", 4, []) ]

输出一些图形计算结果：

main = do
  putStrLn $ "The edges are "++ (show.edges) myGraph 
  putStrLn $ "The vertices are "++ (show.vertices) myGraph

运行代码会显示图形的边和节点：

$ runhaskell Main.hs

The edges are [(0,2), (0,3), (1,2), (1,3), (2,3)]
The vertices are [0, 1, 2, 3]

它是如何工作的...

我们可能会注意到，每个节点的键已经由算法自动分配。graphFromEdges' 函数实际上返回一个类型为 (Graph, Vertex -> (node, key, [key])) 的元组，其中第一个元素是图数据结构，第二个元素是从节点编号到其实际键的映射。

与之前的配方一样，这个图数据结构实际上是来自 Data.Array 包的一个数组，这意味着我们可以在图形中使用 Data.Array 提供的所有函数。

参见：

如果我们希望从边的列表创建图形，之前的配方 从邻接表表示图形 可以完成这个任务。

对图进行拓扑排序

如果图是有向图，那么拓扑排序是图的自然排序之一。在依赖关系网络中，拓扑排序将揭示满足这些依赖关系的所有顶点的可能排列。

Haskell 内置的图形包提供了一个非常有用的函数 topSort，可以对图形进行拓扑排序。在这个配方中，我们将创建一个依赖关系图，并对其进行拓扑排序。

准备工作

我们将从用户输入中读取数据。每一对行将表示一个依赖关系。

创建一个名为 input.txt 的文件，文件内容是以下依赖项对：

$ cat input.txt

understand Haskell
do Haskell data analysis
understand data analysis
do Haskell data analysis
do Haskell data analysis
find patterns in big data

该文件描述了一个依赖关系列表，内容如下：

必须理解 Haskell 才能进行 Haskell 数据分析
必须理解数据分析才能进行 Haskell 数据分析
必须进行 Haskell 数据分析才能在大数据中找到模式

提示

我们将使用 Data.Graph 提供的 topsort 算法。请注意，这个函数不能检测循环依赖。

如何实现...

在一个新文件中，我们将其命名为 Main.hs，插入以下代码：

从图形、映射和列表包中导入以下内容：

import Data.Graph
import Data.Map (Map, (!), fromList)
import Data.List (nub)

从输入中读取并根据依赖关系构建图形。对图执行拓扑排序并输出有效的顺序：
```
main = do
  ls <- fmap lines getContents
  let g = graph ls
  putStrLn $ showTopoSort ls g
```

从字符串列表构建图形，其中每一对行表示一个依赖关系：

graph :: Ord k => [k] -> Graph

graph ls = buildG bounds edges
  where bounds = (1, (length.nub) ls)
    edges = tuples $ map (mappingStrToNum !) ls
    mappingStrToNum = fromList $ zip (nub ls) [1..]
    tuples (a:b:cs) = (a, b) : tuples cs
    tuples _ = []

对图进行拓扑排序，并输出有效的排序顺序：

showTopoSort :: [String] -> Graph -> String

showTopoSort ls g = 
  unlines $ map (mappingNumToStr !) (topSort g)
  where mappingNumToStr = fromList $ zip [1..] (nub ls)

编译代码并将依赖项的文本文件作为输入：

$ runhaskell Main.hs < input.txt

understand data analysis
understand Haskell
do Haskell data analysis
find patterns in big data

深度优先遍历图形

使用深度优先搜索，能够遍历图形以查看节点的期望顺序。实现拓扑排序、解决迷宫问题以及寻找连通分量，都是依赖于图的深度优先遍历的有用算法示例。

如何实现...

开始编辑一个新的源文件，我们将其命名为Main.hs：

导入所需的包：

import Data.Graph
import Data.Array ((!))

从邻接表构建图形：

graph :: (Graph, Vertex -> (Int, Int, [Int]))

graph = graphFromEdges'  [ (1, 1, [3, 4] )
                         , (2, 2, [3, 4]) 
                         , (3, 3, [4])
                         , (4, 4, []) ]

扫描图形进行深度优先遍历：

depth g i = depth' g [] i
depth' g2(gShape, gMapping) seen i = 
  key : concat (map goDeeper adjacent)
  where goDeeper v = if v `elem` seen 
                      then [] 
                      else depth' g (i:seen) v
         adjacent = gShape ! i
         (_, key, _) = gMapping i

打印出访问的顶点列表：
```
main = print $ depth graph 0
```
运行算法以查看遍历顺序。
```
$ runhaskell Main.hs
[1, 3, 4, 4]
```

我们从节点 1（索引为 0）开始。我们沿着第一条边遍历到节点 3。从节点 3，我们沿着第一条边遍历到节点 4。由于 4 没有出边，我们回到节点 3。由于 3 没有剩余的出边，我们回到节点 1。从节点 1，我们沿着第二条边遍历到节点 4。

进行广度优先遍历图形

使用广度优先搜索，可以遍历图形以查看节点的顺序。在一个无限图中，深度优先遍历可能永远无法返回到起始节点。广度优先遍历算法的一个显著例子是找到两个节点之间的最短路径。

在本教程中，我们将打印出图中节点的广度优先遍历。

如何操作...

在新文件中插入以下代码，可以命名为Main.hs：

导入所需的包：

import Data.Graph
import Data.Array ((!))

从边的列表构建图形：

graph :: Graph
graph = buildG bounds edges
  where  bounds = (1,7)
         edges = [ (1,2), (1,5)
                 , (2,3), (2,4) 
                 , (5,6), (5,7) 
                 , (3,1) ]

扫描图形进行广度优先遍历：

breadth g i = bf [] [i]
  where bf :: [Int] -> [Int] -> [Int]
        bf seen forest | null forest = []
                       | otherwise   = forest ++ 
                                       bf (forest ++ seen) 
                             (concat (map goDeeper forest))
          where goDeeper v = if elem v seen 
                              then [] else (g ! v)

打印出深度优先遍历的访问顶点列表：
```
main = do
  print $ breadth graph 1
```

运行代码显示遍历结果：

$ runhaskell Main.hs
[1, 5, 2, 7, 6, 4, 3, 1]

使用 Graphviz 可视化图形

使用graphviz库，可以轻松绘制表示图形的图像。在数据分析的世界中，直观地解读图像可以揭示数据中的一些特征，这些特征是人眼容易捕捉到的。本教程将帮助我们根据所处理的数据构建一个图表。更多的可视化技术在第十一章，数据可视化中进行了详细说明。

准备工作

从www.graphviz.org/Download.php安装graphviz库，因为 Haskell 包需要它。

接下来，通过运行以下命令从 cabal 安装该软件包：

$ cabal install graphviz

如何操作...

在新文件中插入以下代码。我们将文件命名为Main.hs：

导入包：
```
import Data.GraphViz
```

从节点和边创建图形：

graph :: DotGraph Int

graph = graphElemsToDot graphParams nodes edges

使用默认参数创建图形。此函数可以修改以调整图形的可视化参数：
```
graphParams :: GraphvizParams Int String Bool () String

graphParams = defaultParams
```

根据相应的边创建代码：

nodes :: [(Int, String)]

nodes = map (\x -> (x, "")) [1..4]

edges:: [(Int, Int, Bool)]

edges= [ (1, 3, True)
       , (1, 4, True) 
    , (2, 3, True)
    , (2, 4, True)
    , (3, 4, True)]

执行main以输出图形：

main = addExtension (runGraphviz graph) Png "graph"

如何操作...

使用有向无环词图

我们使用有向无环词图（DAWG）从大量字符串语料库中快速检索，且在空间复杂度上几乎不占空间。想象一下，使用 DAWG 压缩词典中的所有单词，从而实现高效的单词查找。这是一种强大的数据结构，当处理大量单词时非常有用。关于 DAWG 的一个非常好的介绍可以在 Steve Hanov 的博客文章中找到：stevehanov.ca/blog/index.php?id=115。

我们可以使用此方法将 DAWG 集成到我们的代码中。

准备工作

使用 cabal 安装 DAWG 包：

$ cabal install dawg

如何做...

我们命名一个新文件Main.hs并插入以下代码：

导入以下包：

import qualified Data.DAWG.Static as D
import Network.HTTP ( simpleHTTP, getRequest,  
                      getResponseBody)
import Data.Char (toLower, isAlphaNum, isSpace)
import Data.Maybe (isJust)

在main函数中，下载大量文本以存储：

main = do
  let url = "http://norvig.com/big.txt"
  body <- simpleHTTP (getRequest url) >>= getResponseBody

从由语料库构建的 DAWG 中查找一些字符串：

  let corp = corpus body
  print $ isJust $ D.lookup "hello" corp
  print $ isJust $ D.lookup "goodbye" corp

构建一个获取函数：

getWords :: String -> [String]

getWords str = words $ map toLower wordlike
  where wordlike = 
           filter (\x -> isAlphaNum x || isSpace x) str

从语料库字典创建一个 DAWG：

corpus :: String -> D.DAWG Char () ()

corpus str = D.fromLang $ getWords str

运行代码显示，这两个词确实存在于大规模语料库中。请注意，需要一个耗时的预处理步骤来构建 DAWG：
```
$ runhaskell Main.hs

True
True
```

提示

一个天真的方法可能是使用Data.List中的isInfixOf函数执行子字符串搜索。在一台配备 8 GB RAM 的 Intel i5 处理器的 Typical ThinkPad T530 上，执行isInfixOf操作的平均时间约为 0.16 秒。然而，如果我们预处理 DAWG 数据结构，则查找时间小于 0.01 秒！

处理六边形和方形网格网络

有时，我们处理的图具有严格的结构，例如六边形或方形网格。许多视频游戏使用六边形网格布局来促进对角线移动，因为在方形网格中对角线移动会使得移动距离的值变得复杂。另一方面，方形网格结构经常用于图像处理算法（如洪泛填充）中的像素遍历。

处理六边形和方形网格网络

Haskell 包列表中有一个非常有用的库用于处理这样的拓扑结构。我们可以获取网格的索引以遍历世界，这实质上是嵌入图中的路径。对于每个网格索引，我们可以查询库以找到相邻的索引，有效地使用网格作为图形。

入门指南

查阅位于github.com/mhwombat/grid/wiki的包文档：

使用 cabal 安装 grid 包：

$ cabal install grid

如何做...

在一个新文件中，我们将命名为Main.hs，插入以下代码：

导入以下库：

import Math.Geometry.Grid (indices, neighbours)
import Math.Geometry.Grid.Hexagonal (hexHexGrid)
import Math.Geometry.Grid.Square (rectSquareGrid)
import Math.Geometry.GridMap ((!))
import Math.Geometry.GridMap.Lazy (lazyGridMap)

在main函数中，打印一些六边形和网格函数的示例：

main = do
  let putStrLn' str = putStrLn ('\n':str)
  putStrLn' "Indices of hex grid:"
  print $ indices hex
  putStrLn' "Neighbors around (1,1) of hex grid:"
  print $ neighbours hex (1,1)
  putStrLn' "Indices of rect grid:"
  print $ indices rect
  putStrLn' "Neighbors around (1,1) of rect grid:"
  print $ neighbours rect (1,1)
  putStrLn' "value of hex at index (1,1)"
  print $ hexM ! (1,1)

使用一个辅助函数来构建六边形网格：
```
hex = hexHexGrid 4
```
使用一个辅助函数来构建方形网格：
```
rect = rectSquareGrid 3 5
```
创建一个带有相关数值的六边形网格：
```
hexM = lazyGridMap hex [1..]
```

在图中查找最大的团

Haskell 带有许多重要的图形库，其中一个便利的图形库是来自Data.Algorithm.MaximalCliques的团检测库。图中的团是一个子图，其中所有节点之间都有连接，如下所示：

在图中查找最大的团

例如，上述图中包含两个不同颜色阴影的团。也许，该图表示相互链接的网页。从图的结构可以直观推断，由于网络连接的结构，可能存在两个互联网社区的集群。随着连接的网络增加，查找最大团变得成倍困难。

在这个食谱中，我们将使用最大团问题的高效实现。

入门

使用 cabal 安装 clique 库：

$ cabal install maximal-cliques

如何操作...

在一个新文件中编写以下代码，我们将其命名为Main.hs：

导入所需的库：
```
import Data.Algorithm.MaximalCliques
```

在main中，打印出最大团：

main = print $ getMaximalCliques edges nodes

创建以下图形：

edges 1 5 = True  
edges 1 2 = True
edges 2 3 = True
edges 2 5 = True
edges 4 5 = True
edges 3 4 = True
edges 4 6 = True
edges _ _ = False

确定节点范围：
```
nodes = [1..6]
```

它是如何工作的...

该库应用递归的 Bron-Kerbosch 枢轴算法来识别无向图中的最大团。算法的核心思想是智能回溯，直到找到最大团为止。

确定两个图是否同构

图形可以拥有任意标签，但它们的拓扑可能是同构的。在数据分析的世界里，我们可以检查不同的图形网络，并识别出连接模式相同的节点群体。这帮助我们发现当两个看似不同的图形网络最终拥有相同的网络映射时。也许这时我们可以声明节点之间的一一同构关系，并从中学习一些关于图形本质的深刻知识。

我们将使用Data.Graph.Automorphism中的isIsomorphic函数来检测两个图是否在其连接上相同。

在这个食谱中，我们将让库计算下图中两个图是否在其连接上是同构的：

确定两个图是否同构

入门

安装 Automorphism 库：

$ cabal install hgal

如何操作...

在一个新文件中编写以下代码，我们将其命名为Main.hs：

导入以下包：

import Data.Graph
import Data.Graph.Automorphism

构建一个图：

graph = buildG (0,4) [ (1, 3), (1, 4) 
                     , (1, 2), (2, 3)
                     , (2, 4), (3, 4) ]

构建另一个图：

graph' = buildG (0,4) [ (3, 1), (3, 2) 
                      , (3, 4), (4, 1)
                      , (4, 2), (1, 2) ]

检查图形是否具有相同的拓扑：

main = print $ isIsomorphic graph graph'

Haskell-数据分析秘籍-二-