以特定方式展平二叉树
Flattening a binary tree in a specific manner
考虑以下二元树和一元树的定义，一个函数 flatten，它将二元树和一元树转换为列表（例如，flatten (Node (Leaf 10) 11 (Leaf 20)) 是 [10,11,20]）和一个函数， reverseflatten，它将列表转换为二叉树（以此处描述的特定方式（）并在下图 中说明）：
data Tree a = Leaf a | Node (Tree a) a (Tree a) | UNode a (Tree a) deriving (Show)
flatten :: Tree a -> [a]
flatten (Leaf x) = [x]
flatten (Node l x r) = flatten l ++ [x] ++ flatten r
flatten (UNode l x) = [l] ++ flatten x
reverseflatten :: [a] -> Tree a
reverseflatten [x] = (Leaf x)
reverseflatten [x,y] = UNode x (Leaf y)
reverseflatten [x,y,z] = Node (Leaf x) y (Leaf z)
reverseflatten (x:y:xs) = revflat2 (x:y:xs)
revflat2 :: [a] -> Tree a
revflat2 [x] = (Leaf x)
revflat2 [x,y] = UNode y (Leaf x)
revflat2 [x,y,z] = Node (Leaf x) y (Leaf z)
revflat2 (x:y:xs) = Node (Leaf x) y (revflat2 ([head $ tail xs] ++ [head xs] ++ tail (tail xs)))
reverseflatten [1..5]是Node (Leaf 1) 2 (Node (Leaf 4) 3 (Leaf 5)，但(reverseflatten(flatten(reverseflatten [1..5])))与reverseflatten [1..5]不一样return。如何修改 flatten 使 reverseflatten x: xs 与 (reverseflatten(flatten(reverseflatten x:xs))) 相同？
reverseflatten形成下图中的树系列。
比如图中reverseflatten [x,y,z]形成树2，reverseflatten [x,y,z, x']形成树3，reverseflatten [x,y,z, x', y']形成树4，reverseflatten [x,y,z, x', y', z']形成树5，reverseflatten [x,y,z, x', y', z', x'']形成树6等等。
我要的是reverseflatten x: xs和(reverseflatten(flatten(reverseflatten x:xs)))是一样的。所以我需要设计flatten所以才有这个效果
我做了以下尝试（其中 flatten Node l x r 应该分为 r 是叶子的情况和不是叶子的情况）：
flatten :: Tree a -> [a]
flatten (Leaf x) = [x]
flatten (UNode l x) = [l] ++ flatten x
flatten (Node l x r)
| r == Leaf y = [l, x, r]
| otherwise = flatten (Node l x (revflat2 ([head $ tail r] ++ [head r] ++ tail (tail r)))
但这会产生：
experiment.hs:585:1: error:
parse error (possibly incorrect indentation or mismatched brackets)
|
585 | flatten (UNode l x) = [l] ++ flatten x
| ^
我认为您的问题是树的第一个节点与其他节点的模式不同，因为如果您查看 Tree1，它变为 [x,y,z]，而 Tree4 变为 [x ,y,[x',z,y']].
可以看到子节点的顺序和第一个节点的顺序不一样，这就是为什么有人说感觉不自然的原因。要修复它，您可以将 reverseFlattening 的定义更改为具有恒定模式的定义，我假设您不想要，或者更改您的展平以考虑到这种奇怪的模式：
data Tree a = Leaf a | Node (Tree a) a (Tree a) | UNode a (Tree a) deriving (Show)
reverseFlatten :: [a] -> Tree a
reverseFlatten [x] = (Leaf x)
reverseFlatten [x,y] = UNode y (Leaf x)
reverseFlatten [x,y,z] = Node (Leaf x) y (Leaf z)
reverseFlatten (x:y:xs) = Node (Leaf x) y (reverseFlatten ((xs !! 1) : (head xs) : (drop 2 xs)))
flatten :: Tree a -> [a]
flatten (Leaf x) = [x]
flatten (UNode l (Leaf x)) = [l,x]
flatten (Node (Leaf l) x r) = l : x : flattenRest r
flattenRest :: Tree a -> [a]
flattenRest (Leaf x) = [x]
flattenRest (UNode l (Leaf x)) = [l,x]
flattenRest (Node (Leaf l) x r) = x : l : flattenRest r
请注意，我为您的 UNode 和左侧节点扩展了模式匹配，因为您已经知道它将是一棵左侧树，因此如果您已经知道结果是什么，则无需调用您的函数。
可测试规范
首先我们可以将您的规范 reverseflatten (flatten (reverseflatten (x : xs))) = reverseflatten (x : xs) 实施为 QuickCheck 属性。
我们通过flatten和reverseflatten对其进行参数化，因此很容易插入不同的实现。
我们将元素类型专门化为 Int 因为我们必须告诉 QuickCheck 在某个时候生成什么。
类型变量a其实就是Tree Int的意思，不过泛化以后会有用
import Test.QuickCheck
prop_flat :: (Eq a, Show a) =>
(a -> [Int]) -> ([Int] -> a) -> (Int, [Int]) -> Property
prop_flat f rf (x0, xs0) =
(rf . f . rf) xs === rf xs
where
xs = x0 : xs0
-- Also remember to derive both Show and Eq on Tree.
我们可以通过将其应用于不正确的实现来检查它是否是一个重要的 属性。
ghci> quickCheck $ prop_flat flatten reverseflatten
*** Failed! Falsifiable (after 5 tests and 8 shrinks):
(0,[0,0,1,0])
Node (Leaf 0) 0 (Node (Leaf 0) 1 (Leaf 0)) /= Node (Leaf 0) 0 (Node (Leaf 1) 0 (Leaf 0))
展平，先取
现在 flatten 的实施需要像 reverseflatten 一样分为两个阶段，因为根节点的行为与其他节点不同：
在根部，Node (Leaf x) y (Leaf z)→[x, y, z]，
但在内部节点中，Node (Leaf x) y (Leaf z) → [y, x, z]
另请注意，您展示的所有树，以及那些实际上可以由 reverseflatten 生成的树都向右倾斜，所以我们真的只知道如何处理模式 Leaf x， UNode x (Leaf y) 和 Node (Leaf x) y r，但不是 UNode x (Node ...) 或 Node (Node ...) y r 等其他模式。因此，考虑到 Trees 的整个域，flatten1 是高度偏的：
flatten1 :: Tree a -> [a]
flatten1 (Leaf x) = [x]
flatten1 (UNode x (Leaf y)) = [x, y]
flatten1 (Node (Leaf x) y r) = x : y : flatten1' r
flatten1' :: Tree a -> [a]
flatten1' (Leaf x) = [x]
flatten1' (UNode x (Leaf y)) = [x, y]
flatten1' (Node (Leaf y) x r) = x : y : flatten1' r
尽管有偏见，QuickCheck 同意：
ghci> quickCheck $ prop_flat flatten1 reverseflatten
+++ OK, passed 100 tests.
扁平化，总版本
总的功能可以通过稍微概括模式来获得，但是正如上面的测试所示，规范没有涵盖这些额外的情况。每当我们在嵌套 Leaf y 上进行模式匹配时，我们只是获取整棵树 ys 并将其展平。如果结果确实是 ys = Leaf y，那么它将被展平为单例列表，因此保留了原始语义。
flatten2 :: Tree a -> [a]
flatten2 (Leaf x) = [x]
flatten2 (UNode x ys) = x : flatten2 ys
flatten2 (Node xs y r) = flatten2 xs ++ y : flatten2' r
flatten2' :: Tree a -> [a]
flatten2' (Leaf x) = [x]
flatten2' (UNode x ys) = x : flatten2' ys
flatten2' (Node ys x r) = x : flatten2' ys ++ flatten2' r
扁平化，完全指定版本
与其在其域的未指定部分任意泛化函数，我们还可以限制其域以与规范完全匹配。这导致了另一种类型定义：在所有示例中，UNode 只有一个叶子子树，类似地 Node 只有一个叶子作为左子树，因此我们将这些叶子解包到构造函数中。
data Tree' a = Leaf' a | UNode' a a | Node' a a (Tree' a)
deriving (Eq, Show)
flatten' 的实现是 flatten1 的直接改编：
flatten' :: Tree' a -> [a]
flatten' (Leaf' x) = [x]
flatten' (UNode' x y) = [x, y]
flatten' (Node' x y r) = x : y : f'' r
f'' :: Tree' a -> [a]
f'' (Leaf' x) = [x]
f'' (UNode' x y) = [x, y]
f'' (Node' x y r) = y : x : f'' r
reverseflatten' 同样改编自 reverseflatten.
的重构版本
reverseflatten' :: [a] -> Tree' a
reverseflatten' (x : []) = Leaf' x
reverseflatten' (x : y : []) = UNode' x y
reverseflatten' (x : y : z : r) = Node' x y (rf'' z r)
rf'' :: a -> [a] -> Tree' a
rf'' x [] = Leaf' x
rf'' x (y : []) = UNode' x y
rf'' x (y : z : r) = Node' y x (rf'' z r)
QuickCheck 验证：
ghci> quickCheck $ prop_flat flatten' reverseflatten'
+++ OK, passed 100 tests.
让我们假设一个稍微强一点的属性，不假思索地计算一下，看看它能把我们带到哪里。即，更强的 属性 将是每当 xs 不为空时，我们有：
flatten (reverseflatten xs) = xs
根据reverseflatten的定义，有四种情况需要考虑。第一个是这样的：
flatten (reverseflatten [x]) = [x]
flatten (Leaf x) = [x]
下一个：
flatten (reverseflatten [x,y]) = [x,y]
flatten (UNode x (Leaf y)) = [x,y]
然后：
flatten (reverseflatten [x,y,z]) = [x,y,z]
flatten (Node (Leaf x) y (Leaf z)) = [x,y,z]
最后：
flatten (reverseflatten (x:y:xs)) = x:y:xs
flatten (revflat2 (x:y:xs)) = x:y:xs
因为前面的模式已经捕捉到了xs匹配[]或[_]的情况，我们只需要考虑revflat2的一种情况，即xs 至少有两个元素。
flatten (revflat2 (x:y:w:z:xs)) = x:y:w:z:xs
flatten (Node (Leaf x) y (revflat2 (z:w:xs))) = x:y:w:z:xs
啊哈！为此，最好有一个新的 属性 助手，即：
flatten2 (revflat2 (z:w:xs)) = w:z:xs
（当然，我们实际上会使用名称 x 和 y 而不是 w 和 z。）
再次让我们不假思索地计算。 xs有三种情况，即[]、[_]和更长。当 xs 为 []:
flatten2 (revflat2 [x,y]) = [y,x]
flatten2 (UNode y (Leaf x)) = [y,x]
对于[_]：
flatten2 (revflat2 [x,y,z]) = [y,x,z]
flatten2 (Node (Leaf x) y (Leaf z)) = [y,x,z]
更长时间：
flatten2 (revflat2 (x:y:w:z:xs)) = y:x:w:z:xs
flatten2 (Node (Leaf x) y (revflat2 (z:w:xs))) = y:x:w:z:xs
根据归纳假设，我们有flatten2 (revflat2 (z:w:xs)) = w:z:xs，所以最后这个等式可以变成：
flatten2 (Node (Leaf x) y rest) = y:x:flatten2 rest
现在我们可以只提取每个案例的所有最后几行，然后他们制作一个程序：
flatten (Leaf x) = [x]
flatten (UNode x (Leaf y)) = [x,y]
flatten (Node (Leaf x) y (Leaf z)) = [x,y,z]
flatten (Node (Leaf x) y rest) = x:y:flatten2 rest
flatten2 (UNode y (Leaf x)) = [y,x]
flatten2 (Node (Leaf x) y (Leaf z)) = [y,x,z]
flatten2 (Node (Leaf x) y rest) = y:x:flatten2 rest
这是最好的节目吗？不！特别是，它是部分的——当 Node 或 UNode 的第一个树参数不是时，您可以自由选择 flatten 和 flatten2 应该做什么a Leaf（但无论你做出什么选择都不会影响你关心的属性）以及flatten2应该如何处理树叶。如果您在这里做出明智的选择，您可能可以合并许多模式。
但是这个过程的优点在于它 完全 机械化：您可以根据自己的 属性 兴趣，转动曲柄，然后用它来实现功能属性（或相互矛盾的方程式告诉您这是不可能的以及为什么）。只有当你有了一些有用的东西时，你才需要凝视并思考什么能让它变得更漂亮或更好。耶，等式推理！
考虑以下二元树和一元树的定义，一个函数 flatten，它将二元树和一元树转换为列表（例如，flatten (Node (Leaf 10) 11 (Leaf 20)) 是 [10,11,20]）和一个函数， reverseflatten，它将列表转换为二叉树（以此处描述的特定方式（
data Tree a = Leaf a | Node (Tree a) a (Tree a) | UNode a (Tree a) deriving (Show)
flatten :: Tree a -> [a]
flatten (Leaf x) = [x]
flatten (Node l x r) = flatten l ++ [x] ++ flatten r
flatten (UNode l x) = [l] ++ flatten x
reverseflatten :: [a] -> Tree a
reverseflatten [x] = (Leaf x)
reverseflatten [x,y] = UNode x (Leaf y)
reverseflatten [x,y,z] = Node (Leaf x) y (Leaf z)
reverseflatten (x:y:xs) = revflat2 (x:y:xs)
revflat2 :: [a] -> Tree a
revflat2 [x] = (Leaf x)
revflat2 [x,y] = UNode y (Leaf x)
revflat2 [x,y,z] = Node (Leaf x) y (Leaf z)
revflat2 (x:y:xs) = Node (Leaf x) y (revflat2 ([head $ tail xs] ++ [head xs] ++ tail (tail xs)))
reverseflatten [1..5]是Node (Leaf 1) 2 (Node (Leaf 4) 3 (Leaf 5)，但(reverseflatten(flatten(reverseflatten [1..5])))与reverseflatten [1..5]不一样return。如何修改 flatten 使 reverseflatten x: xs 与 (reverseflatten(flatten(reverseflatten x:xs))) 相同？
reverseflatten形成下图中的树系列。
比如图中reverseflatten [x,y,z]形成树2，reverseflatten [x,y,z, x']形成树3，reverseflatten [x,y,z, x', y']形成树4，reverseflatten [x,y,z, x', y', z']形成树5，reverseflatten [x,y,z, x', y', z', x'']形成树6等等。
我要的是reverseflatten x: xs和(reverseflatten(flatten(reverseflatten x:xs)))是一样的。所以我需要设计flatten所以才有这个效果
我做了以下尝试（其中 flatten Node l x r 应该分为 r 是叶子的情况和不是叶子的情况）：
flatten :: Tree a -> [a]
flatten (Leaf x) = [x]
flatten (UNode l x) = [l] ++ flatten x
flatten (Node l x r)
| r == Leaf y = [l, x, r]
| otherwise = flatten (Node l x (revflat2 ([head $ tail r] ++ [head r] ++ tail (tail r)))
但这会产生：
experiment.hs:585:1: error:
parse error (possibly incorrect indentation or mismatched brackets)
|
585 | flatten (UNode l x) = [l] ++ flatten x
| ^
我认为您的问题是树的第一个节点与其他节点的模式不同，因为如果您查看 Tree1，它变为 [x,y,z]，而 Tree4 变为 [x ,y,[x',z,y']].
可以看到子节点的顺序和第一个节点的顺序不一样，这就是为什么有人说感觉不自然的原因。要修复它，您可以将 reverseFlattening 的定义更改为具有恒定模式的定义，我假设您不想要，或者更改您的展平以考虑到这种奇怪的模式：
data Tree a = Leaf a | Node (Tree a) a (Tree a) | UNode a (Tree a) deriving (Show)
reverseFlatten :: [a] -> Tree a
reverseFlatten [x] = (Leaf x)
reverseFlatten [x,y] = UNode y (Leaf x)
reverseFlatten [x,y,z] = Node (Leaf x) y (Leaf z)
reverseFlatten (x:y:xs) = Node (Leaf x) y (reverseFlatten ((xs !! 1) : (head xs) : (drop 2 xs)))
flatten :: Tree a -> [a]
flatten (Leaf x) = [x]
flatten (UNode l (Leaf x)) = [l,x]
flatten (Node (Leaf l) x r) = l : x : flattenRest r
flattenRest :: Tree a -> [a]
flattenRest (Leaf x) = [x]
flattenRest (UNode l (Leaf x)) = [l,x]
flattenRest (Node (Leaf l) x r) = x : l : flattenRest r
请注意，我为您的 UNode 和左侧节点扩展了模式匹配，因为您已经知道它将是一棵左侧树，因此如果您已经知道结果是什么，则无需调用您的函数。
可测试规范
首先我们可以将您的规范 reverseflatten (flatten (reverseflatten (x : xs))) = reverseflatten (x : xs) 实施为 QuickCheck 属性。
我们通过
flatten和reverseflatten对其进行参数化，因此很容易插入不同的实现。我们将元素类型专门化为
Int因为我们必须告诉 QuickCheck 在某个时候生成什么。类型变量
a其实就是Tree Int的意思，不过泛化以后会有用
import Test.QuickCheck
prop_flat :: (Eq a, Show a) =>
(a -> [Int]) -> ([Int] -> a) -> (Int, [Int]) -> Property
prop_flat f rf (x0, xs0) =
(rf . f . rf) xs === rf xs
where
xs = x0 : xs0
-- Also remember to derive both Show and Eq on Tree.
我们可以通过将其应用于不正确的实现来检查它是否是一个重要的 属性。
ghci> quickCheck $ prop_flat flatten reverseflatten
*** Failed! Falsifiable (after 5 tests and 8 shrinks):
(0,[0,0,1,0])
Node (Leaf 0) 0 (Node (Leaf 0) 1 (Leaf 0)) /= Node (Leaf 0) 0 (Node (Leaf 1) 0 (Leaf 0))
展平，先取
现在 flatten 的实施需要像 reverseflatten 一样分为两个阶段，因为根节点的行为与其他节点不同：
在根部，
Node (Leaf x) y (Leaf z)→[x, y, z]，但在内部节点中，
Node (Leaf x) y (Leaf z)→[y, x, z]
另请注意，您展示的所有树，以及那些实际上可以由 reverseflatten 生成的树都向右倾斜，所以我们真的只知道如何处理模式 Leaf x， UNode x (Leaf y) 和 Node (Leaf x) y r，但不是 UNode x (Node ...) 或 Node (Node ...) y r 等其他模式。因此，考虑到 Trees 的整个域，flatten1 是高度偏的：
flatten1 :: Tree a -> [a]
flatten1 (Leaf x) = [x]
flatten1 (UNode x (Leaf y)) = [x, y]
flatten1 (Node (Leaf x) y r) = x : y : flatten1' r
flatten1' :: Tree a -> [a]
flatten1' (Leaf x) = [x]
flatten1' (UNode x (Leaf y)) = [x, y]
flatten1' (Node (Leaf y) x r) = x : y : flatten1' r
尽管有偏见，QuickCheck 同意：
ghci> quickCheck $ prop_flat flatten1 reverseflatten
+++ OK, passed 100 tests.
扁平化，总版本
总的功能可以通过稍微概括模式来获得，但是正如上面的测试所示，规范没有涵盖这些额外的情况。每当我们在嵌套 Leaf y 上进行模式匹配时，我们只是获取整棵树 ys 并将其展平。如果结果确实是 ys = Leaf y，那么它将被展平为单例列表，因此保留了原始语义。
flatten2 :: Tree a -> [a]
flatten2 (Leaf x) = [x]
flatten2 (UNode x ys) = x : flatten2 ys
flatten2 (Node xs y r) = flatten2 xs ++ y : flatten2' r
flatten2' :: Tree a -> [a]
flatten2' (Leaf x) = [x]
flatten2' (UNode x ys) = x : flatten2' ys
flatten2' (Node ys x r) = x : flatten2' ys ++ flatten2' r
扁平化，完全指定版本
与其在其域的未指定部分任意泛化函数，我们还可以限制其域以与规范完全匹配。这导致了另一种类型定义：在所有示例中，UNode 只有一个叶子子树，类似地 Node 只有一个叶子作为左子树，因此我们将这些叶子解包到构造函数中。
data Tree' a = Leaf' a | UNode' a a | Node' a a (Tree' a)
deriving (Eq, Show)
flatten' 的实现是 flatten1 的直接改编：
flatten' :: Tree' a -> [a]
flatten' (Leaf' x) = [x]
flatten' (UNode' x y) = [x, y]
flatten' (Node' x y r) = x : y : f'' r
f'' :: Tree' a -> [a]
f'' (Leaf' x) = [x]
f'' (UNode' x y) = [x, y]
f'' (Node' x y r) = y : x : f'' r
reverseflatten' 同样改编自 reverseflatten.
reverseflatten' :: [a] -> Tree' a
reverseflatten' (x : []) = Leaf' x
reverseflatten' (x : y : []) = UNode' x y
reverseflatten' (x : y : z : r) = Node' x y (rf'' z r)
rf'' :: a -> [a] -> Tree' a
rf'' x [] = Leaf' x
rf'' x (y : []) = UNode' x y
rf'' x (y : z : r) = Node' y x (rf'' z r)
QuickCheck 验证：
ghci> quickCheck $ prop_flat flatten' reverseflatten'
+++ OK, passed 100 tests.
让我们假设一个稍微强一点的属性，不假思索地计算一下，看看它能把我们带到哪里。即，更强的 属性 将是每当 xs 不为空时，我们有：
flatten (reverseflatten xs) = xs
根据reverseflatten的定义，有四种情况需要考虑。第一个是这样的：
flatten (reverseflatten [x]) = [x]
flatten (Leaf x) = [x]
下一个：
flatten (reverseflatten [x,y]) = [x,y]
flatten (UNode x (Leaf y)) = [x,y]
然后：
flatten (reverseflatten [x,y,z]) = [x,y,z]
flatten (Node (Leaf x) y (Leaf z)) = [x,y,z]
最后：
flatten (reverseflatten (x:y:xs)) = x:y:xs
flatten (revflat2 (x:y:xs)) = x:y:xs
因为前面的模式已经捕捉到了xs匹配[]或[_]的情况，我们只需要考虑revflat2的一种情况，即xs 至少有两个元素。
flatten (revflat2 (x:y:w:z:xs)) = x:y:w:z:xs
flatten (Node (Leaf x) y (revflat2 (z:w:xs))) = x:y:w:z:xs
啊哈！为此，最好有一个新的 属性 助手，即：
flatten2 (revflat2 (z:w:xs)) = w:z:xs
（当然，我们实际上会使用名称 x 和 y 而不是 w 和 z。）
再次让我们不假思索地计算。 xs有三种情况，即[]、[_]和更长。当 xs 为 []:
flatten2 (revflat2 [x,y]) = [y,x]
flatten2 (UNode y (Leaf x)) = [y,x]
对于[_]：
flatten2 (revflat2 [x,y,z]) = [y,x,z]
flatten2 (Node (Leaf x) y (Leaf z)) = [y,x,z]
更长时间：
flatten2 (revflat2 (x:y:w:z:xs)) = y:x:w:z:xs
flatten2 (Node (Leaf x) y (revflat2 (z:w:xs))) = y:x:w:z:xs
根据归纳假设，我们有flatten2 (revflat2 (z:w:xs)) = w:z:xs，所以最后这个等式可以变成：
flatten2 (Node (Leaf x) y rest) = y:x:flatten2 rest
现在我们可以只提取每个案例的所有最后几行，然后他们制作一个程序：
flatten (Leaf x) = [x]
flatten (UNode x (Leaf y)) = [x,y]
flatten (Node (Leaf x) y (Leaf z)) = [x,y,z]
flatten (Node (Leaf x) y rest) = x:y:flatten2 rest
flatten2 (UNode y (Leaf x)) = [y,x]
flatten2 (Node (Leaf x) y (Leaf z)) = [y,x,z]
flatten2 (Node (Leaf x) y rest) = y:x:flatten2 rest
这是最好的节目吗？不！特别是，它是部分的——当 Node 或 UNode 的第一个树参数不是时，您可以自由选择 flatten 和 flatten2 应该做什么a Leaf（但无论你做出什么选择都不会影响你关心的属性）以及flatten2应该如何处理树叶。如果您在这里做出明智的选择，您可能可以合并许多模式。
但是这个过程的优点在于它 完全 机械化：您可以根据自己的 属性 兴趣，转动曲柄，然后用它来实现功能属性（或相互矛盾的方程式告诉您这是不可能的以及为什么）。只有当你有了一些有用的东西时，你才需要凝视并思考什么能让它变得更漂亮或更好。耶，等式推理！