Выравнивание двоичного дерева определенным образом

Question

Рассмотрим следующие определения двоичных и унарных деревьев, функцию flatten, которая преобразует двоичные и унарные деревья в списки (например, flatten (Node (Leaf 10) 11 (Leaf 20)) is [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].Как можно изменить 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">

Я хочу, чтобы 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 
    | ^

Answer 1

Тестируемая спецификация

Сначала мы можем реализовать вашу спецификацию 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, сначала возьмите

Теперь реализацию 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.Следовательно, учитывая, что весь домен Tree с, 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.

Answer 2

Давайте выдвинем гипотезу о более сильном свойстве и просто посчитаем, не задумываясь, и посмотрим, куда оно нас приведет.А именно, тем более сильным свойством будет то, что всякий раз, когда 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

Aha!Чтобы это работало, было бы неплохо иметь помощника с новым свойством, а именно:

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 следует делать с листьями.Вероятно, если вы сделаете правильный выбор, вы можете объединить многие шаблоны.

Но что хорошо в этом процессе, так это то, что он полностью механический: вы можете взять интересующее вас имущество, повернутьпровернуть, и получить функцию с этим свойством (или противоречивые уравнения, которые говорят вам, что это невозможно и почему).Только когда у вас есть что-то, что работает, вам нужно смотреть и думать о том, что сделало бы это красивее или лучше.Уууууууу!

Answer 3

Я думаю, что ваша проблема в том, что первый узел дерева не имеет тот же шаблон, что и другие, поскольку, если вы посмотрите на Tree1, он идет [x, y, z], тогда как Tree4 идет [x, y, [x ', z, y']].

Вы можете видеть, что порядок дочерних узлов не соответствует порядку расположения первого, поэтому некоторые люди отметили, что он выглядит неестественным.Чтобы исправить это, вы можете либо изменить свое определение reverseFlattens на определение с постоянным шаблоном, который, как я полагаю, вам не нужен, либо изменить выравнивание, чтобы учесть этот странный шаблон:

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 и левого Node, поскольку вы уже знаете, что это будет левостороннее дерево, поэтому нет необходимости вызывать вашу функцию, если вы уже знаете, каким будет результат.