考虑以下二元和一元树的定义,函数flatten
,它将二进制和一元树转换为列表(例如,flatten (Node (Leaf 10) 11 (Leaf 20))
是[10,11,20]
)和函数reverseflatten
,它将列表转换为二叉树(以此处描述的特定方式(Defining a function from lists to binary and unary trees) )并在下图中说明):
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]
不同。怎么可以修改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的定义更改为具有常量模式的定义(我假设您不想要),或者更改您的flatten以将此奇怪模式考虑在内:
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
,因为root的行为与其他节点不同:
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
。因此,考虑到Tree
s的整个领域,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
这是最好的节目吗?没有!特别是,它是偏爱的 - 当flatten
或flatten2
的第一个树参数不是Node
时,你可以做出一些关于UNode
和Leaf
应该做的自由选择(但无论你做出什么选择都不会影响财产你关心的)以及flatten2
应该用叶子做什么。可能如果你在这里做出明智的选择,你可以合并许多模式。
但是这个过程的好处在于它是完全机械的:你可以拿走你感兴趣的属性,转动一个曲柄,然后找出一个具有该属性的函数(或者冲突的方程式告诉你它不可能和为什么)。只有当你有一些有用的东西时,你才需要凝视并思考什么会让它变得更漂亮或更好。是的,等于推理!