2016-12-24 12 views
4

У меня есть следующий Haskell полиморфного типа данных:Реконструкция дерево Хаффмана из (предпорядка) в битовой строке Haskell

data Tree a = Leaf Int a | Node Int (Tree a) (Tree a) 

Дерево будет сжат в битовой строке из 0 и 1. A '0' означает узел, за которым следует кодировка левого поддерева, а затем кодирование правого поддерева. «1» означает лист, за которым следуют 7 бит информации (например, это может быть символ). Каждый узел/лист должен также содержать частоту сохраненной информации, но это не важно для этой проблемы (поэтому мы можем что-то там положить).

Например, начиная с этого закодированного дерева

[0,0,0,1,1,1,0,1,0,1,1,1,1,1,1,0,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1, 
1,0,0,1,1,1,1,1,1,1,0,0,1,0,0,1,1,1,1,0,1,1,1,1,1,1,0,0,0,0,1] 

предполагается отдать что-то вроде этого

Node 0 (Node 0 (Node 0 (Leaf 0 'k') (Leaf 0 't')) 
     (Node 0 (Node 0 (Leaf 0 'q') (Leaf 0 'g')) (Leaf 0 'r'))) 
(Node 0 (Leaf 0 'w') (Leaf 0 'a')) 

(расстояние не важно, но это не умещается в одной строке) ,

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

Любая помощь или идеи оцениваются!

ответ

1

Хорошо, вот простой (специальный, но понятный) способ.

Нам нужно Buid функции parse со следующим типом:

parse :: [Int] -> Tree Char 

подхода вы упомянули, со стеками, императив один. Здесь мы просто занимаемся рекурсивными вызовами. Стек будет построен компилятором, и он будет иметь только каждый рекурсивный вызов, хранящийся в нем (по крайней мере, вы можете представить это так, если хотите, или просто игнорировать весь этот абзац).

Итак, идея такова: всякий раз, когда вы находите 0, вам нужно сделать два рекурсивных вызова алгоритма. Первый рекурсивный вызов будет читать одну ветвь (левую) дерева. Второй нужно вызвать с остальной частью списка в качестве аргумента. Остальное осталось первым рекурсивным вызовом. Итак, нам нужна функция ДОПОЛНИТЕЛЬНОГО parse' со следующим типом (теперь мы возвращаемся парой, будучи вторым значением по остальным части списка):

parse' :: [Int] -> (Tree Char, [Int]) 

Далее вы можете увидеть кусок кода, где 0 дело так же, как описано выше.
Для случая 1 нам просто нужно взять следующие 7 чисел и внести их в символ как-то (я оставляю для вас определение toChar), то просто верните Leaf и остальную часть списка.

parse' (0:xs) = let (l, xs') = parse' xs 
        (r, xs'') = parse' xs' in (Node 0 l r, xs'') --xs'' should be [] 
parse' (1:xs) = let w = toChar (take 7 xs) in (Leaf 0 w , drop 7 xs) 

Наконец, наша функция синтаксического анализа просто вызывает вспомогательный синтаксический анализ и возвращает первый элемент пары.

parse xs = fst $ parse' xs 
+0

Это именно то, что я искал! Это элегантное и сжатое решение. Я подумывал о том, чтобы как-то вычислить левую и правую ветви рекурсивно, но не мог понять, как подавать соответствующий список в призыв к правильному. Возвращение списка в паре - умная идея! – David

+0

Для чего это стоит, это, по сути, выписанная версия монады «Государство». –

+0

Да, это на самом деле монада «Государство». Точнее, это 'Parser'monad, который работает над' [Int] '. – Euge

1

сделать правильный складку:

import Data.Char (chr) 

data Tree a = Leaf a | Node (Tree a) (Tree a) 
    deriving Show 

build :: [Int] -> [Tree Char] 
build xs = foldr go (\_ _ -> []) xs 0 0 
    where 
    nil = Leaf '?' 
    go 0 run 0 0 = case run 0 0 of 
    []  -> Node nil nil:[] 
    x:[] -> Node x nil:[] 
    x:y:zs -> Node x y :zs 

    go 1 run 0 0 = run 0 1 
    go _ _ _ 0 = error "this should not happen!" 
    go x run v 7 = (Leaf $ chr (v * 2 + x)): run 0 0 
    go x run v k = run (v * 2 + x) (k + 1) 

затем:

\> head $ build [0,0,0,1,1,1,0, ...] -- the list of 01s as in the question 
Node (Node (Node (Leaf 'k') (Leaf 't')) 
     (Node (Node (Leaf 'q') (Leaf 'g')) (Leaf 'r'))) 
(Node (Leaf 'w') (Leaf 'a')) 
+0

Спасибо за ваше решение! Тем не менее, до сих пор я использовал лишь некоторые базовые складки, и я немного потерял, как именно работает ваше решение. Я бы очень признателен за дальнейшие объяснения (особенно на «go» и «run», поскольку имена на самом деле не наводящие на размышления, и аргументы складки) – David

2

Ну, вы пытаетесь разобрать дерево байтов из битового потока. Parsing - один из тех случаев, когда он платит, чтобы создать некоторую структуру: мы собираемся написать библиотеку миниатюрных парсерных комбинаторов в стиле How to Replace Failure by a List of Successes, что позволит нам написать наш код в идиоматическом функциональном стиле и делегировать много работайте на машине.

Перевод the old rhyme на язык монадных трансформаторов, и чтение «строка», как «бит-строкой», мы имеем

newtype Parser a = Parser (StateT [Bool] [] a) 
    deriving (Functor, Applicative, Monad, Alternative) 

runParser :: Parser a -> [Bool] -> [(a, [Bool])] 
runParser (Parser m) = runStateT m 

Анализатор представляет собой монадическая вычисления, который работает statefully на потоке Booleans, получая набор успешно проанализированных a с. GHC GeneralizedNewtypeDeriving сверхдержавы позволяют мне отойти от шаблонных экземпляров Monad и др.

Цель состоит в том, чтобы написать Parser (Tree SevenBits) - синтаксический анализатор, который возвращает дерево перегородок булевых. (Вы можете превратить 7 бит в Word8 в свой досуг на deriving a Functor instance за Tree и используя fmap.) Я собираюсь использовать следующее определение Tree, потому что оно проще - я уверен, что вы можете понять, как адаптировать этот код в ваших целях.

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving Show 

type SevenBits = (Bool, Bool, Bool, Bool, Bool, Bool, Bool) 

Вот парсер, который пытается потреблять один бит из входного потока, в противном случае, если он пуст:

one :: Parser Bool 
one = Parser $ do 
    stream <- get 
    case stream of 
     [] -> empty 
     (x:xs) -> put xs *> return x 

Вот один, который пытается потреблять конкретных биты из входного потока, в противном случае, если он не соответствует:

bit :: Bool -> Parser() 
bit b = do 
    i <- one 
    guard (i == b) 

Здесь я потянув последовательность из семи Booleans из входного потока с использованием replicateM и упаковывая их в кортеж. Мы будем использовать это для заполнения содержимого узлов Leaf.

sevenBits :: Parser SevenBits 
sevenBits = pack7 <$> replicateM 7 one 
    where pack7 [a,b,c,d,e,f,g] = (a, b, c, d, e, f, g) 

Теперь мы можем, наконец, написать код, который анализирует структуру дерева. Мы будем выбирать между вариантами Node и Leaf, используя <|>.

tree :: Parser (Tree SevenBits) 
tree = node <|> leaf 
    where node = bit False *> liftA2 Node tree tree 
      leaf = bit True *> fmap Leaf sevenBits 

Если node удается разбор младшего бита из головы потока, она продолжает рекурсивно разобрать кодирование левого поддерева с последующим правом поддерева, секвенирование аппликативных действий с liftA2. Хитрость заключается в том, что node терпит неудачу, если он не встречает низкий бит в начале входного потока, который сообщает <|>, чтобы отказаться от node и вместо этого попробуйте leaf.

Обратите внимание, что структура tree отражает структуру самого типа Tree. Это аппликативный синтаксический анализ на работе. Мы могли бы поочередно структурировать этот синтаксический анализатор монадически, сначала используя one для разбора произвольного бита, а затем используя анализ case на бит, чтобы определить, следует ли продолжать разбирать пару деревьев или лист. По-моему, эта версия проще, более декларативной и менее многословной.

Также сравните этот код с низкоуровневым стилем решения foldr @ behzad.nouri. Вместо того, чтобы создавать явную машину конечного состояния, которая переключается между узлами анализа и листьями - идея с императивным вкусом - моя конструкция позволяет вам декларативно описать грамматику на машине с помощью стандартных функций, таких как liftA2 и <|>, и полагайте, что абстракции будут выполнять правильная вещь.

В любом случае, здесь я разбираю простое дерево, состоящее из пары Leaf s, содержащей (двоично-кодированные) номера 0 и 1. Как вы можете видеть, он возвращает единственный успешный синтаксический разбор и пустой поток оставшихся бит.

ghci> runParser tree $ map (>0) [0, 1, 0,0,0,0,0,0,0, 1, 0,0,0,0,0,0,1] 
[(Node (Leaf (False, False, False, False, False, False, False)) (Leaf (False, False, False, False, False, False, True)),[])] 
+0

Благодарим вас за подробный ответ! Однако я считаю, что это решение выходит за рамки этого упражнения и моих знаний об Haskell в данный момент. Тем не менее, я вернусь к этому, когда мне станет более комфортно работать с более продвинутыми темами Haskell (также приветствуются любые предложения о том, как улучшить функциональное программирование за вводным курсом!) – David

+0

@David Более чем счастлив ответить на любые ваши вопросы о моем код! Моя любимая книга Haskell - [_Learn You A Haskell_] (http://learnyouahaskell.com/), которую вы можете читать онлайн бесплатно - она ​​читаема и смешна и содержит доступную экспозицию monads & co. –