Сложность реализации дерева Хаффмана в Haskell

Рассмотрим Fork. У него есть два поддерева, и каждое из этих поддеревьев имеет некоторую кодировку.

Допустим, кодировка левого поддерева:

[(x, pathToX), (y, pathToY)]

И допустим, что правая кодировка поддерева:

[(a, pathToA), (b, pathToB)]

Теперь вы видите, какой должна быть кодировка всего форка? Это должно быть так:

[(a, True : pathToA), (b, True : pathToB), (x, False : pathToX), (y, False : pathToY)]

Согласны ли вы с этим? Если нет, то подумайте. Может быть, поработать над некоторыми небольшими примерами. Пока вы не согласитесь, что это так.

Видишь, что я там сделал? Я добавил False к каждому пути в левом поддереве, а затем добавил True к каждому пути в правом поддереве.

Давайте запишем это в синтаксисе Haskell:

encode (Fork left right) = prependToEach False (encode left) ++ prependToEach True (encode right)

Теперь вы, возможно, заметили, что здесь я сжульничал: я использую функцию prependToEach, которой не существует. Ну ничего, давайте определимся!

prependToEach x list = map (prepend x) list

Видеть? Добавление чего-либо к каждому элементу списка — это просто отображение функции добавления одного элемента в список.

Но я, конечно, опять схалтурил: такой функции, как prepend, пока нет. Так пусть будет один!

prepend x (a, path) = (a, x : path)

И вот! Теперь осталось только определить базовый вариант: каким должен быть путь Leaf? Что ж, согласно приведенному вами примеру, каждый Leaf будет иметь пустой путь, отражающий тот факт, что вам не нужно делать никаких ходов, чтобы перейти от этого листа к тому же листу:

encode (Leaf a) = [(a, [])]

А теперь, собирая все вместе:

encode :: HTree a -> [(a, [Bool])]
encode (Leaf a) = [(a, [])]
encode (Fork left right) = prependToEach False (encode left) ++ prependToEach True (encode right)
    where
    prependToEach x list = map (prepend x) list
    prepend x (a, path) = (a, x : path)

И теперь, когда мы понимаем, как это было построено и почему, мы можем немного сократить его, используя списковые включения (хотя я считаю этот шаг очень необязательным):

encode :: HTree a -> [(a, [Bool])]
encode (Leaf a) = [(a, [])]
encode (Fork left right) = [(x, False : p) | (x, p) <- encode left] ++ [(x, True : p) | (x, p) <- encode right]

P.S. обратите внимание, что тип не может называться htree, потому что имена типов в Haskell должны быть написаны с заглавной буквы. Вы можете заметить, что в последнем фрагменте я переименовал его в HTree.

Ответ Федора хороший, но стоит с осторожностью использовать (++). Часто, если вы не в кафе, это может привести к тому, что ваш код будет работать очень медленно для определенных входных данных, в данном случае несбалансированного дерева.

Причина в том, что (список из N элементов) ++ (список из 1 элемента) должен создать совершенно новый список из N+1 элементов. Таким образом, добавление только нескольких элементов за раз может быть медленным.

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

Вот пример функции encode, использующей этот метод:

data HTree a = Leaf a | Fork (HTree a) (HTree a) deriving (Show, Eq)

encode :: HTree a -> [(a, [Bool])]
encode tree = go [] tree [] where
  go :: [Bool] -> HTree a -> [(a, [Bool])] -> [(a, [Bool])]
  go path (Leaf leaf) = ((leaf, path):)
  go path (Fork left right) = go (False:path) left . go (True:path) right

Обратите внимание, что вам на самом деле не нужны подписи типов, я просто включил их для ясности (и, вероятно, это хорошая практика), но удалил только 3 строки:

encode tree = go [] tree [] where
  go path (Leaf leaf) = ((leaf, path):)
  go path (Fork left right) = go (False:path) left . go (True:path) right

Обратите внимание, что это возвращает пути от листа к корню, если вы хотите, чтобы они были от корня к листу, вы можете либо просто изменить их в конце, либо снова использовать мой трюк с функцией возврата.