Как заставить эту функцию лениво потреблять входной поток битов? - PullRequest
Новая
       22

Как заставить эту функцию лениво потреблять входной поток битов?

7 голосов
/ 25 октября 2019

Я представляю себе такую ​​функцию, как

takeChunkUntil :: [a] -> ([a] -> Bool) -> ([a], [a])

Надеюсь, ленивый.

Он берет элементы из первого списка, пока группа их не удовлетворяет предикату,затем возвращает этот подсписок, а также остальные элементы.

ОТВЕТИТЬ НА НЕКОТОРЫЕ ВОПРОСЫ:
Конечная цель - сделать что-то, что читает коды Хаффмана лениво. Поэтому, если у вас есть строка битов, представленная здесь как Bool, bs, вы можете написать take n $ decode huffmanTree bs, чтобы получить первые n кодированных значений, потребляя при этом только столько bs, сколько необходимо. Если вы хотите, я опубликую более подробную информацию и мои попытки решения. Это может занять много времени :) (Обратите внимание, что я учитель, которому эта проблема была задана студентом, но я не пытался помочь ему, поскольку это было выше моего понимания, однако мне сейчас очень любопытно.)

Продолжение: Вот и все:

Определение дерева Хаффмана: 

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

Цель: написать функцию отложенного декодирования, которая возвращает пару декодированныхзначения и логическое значение, указывающее, остались ли какие-либо значения, которые не были достаточно длинными, чтобы их можно было декодировать в значение. Примечание: мы используем Bool для представления бита: True = 1, False = 0. 

decode :: BTree a -> [Bool] -> ([a], Bool)

Вот суть: первая функция, которую я написал, была функцией, которая декодирует одно значение. Ничего не возвращает, если входной список был пуст, в противном случае возвращает декодированное значение и оставшийся «бит». 

decode1 :: BTree a -> [Bool] -> Maybe (a, [Bool])
decode1 (Leaf v) bs = Just (v, bs)
decode1 _ [] = Nothing
decode1 (Fork left right) (b:bs) 
  | b         = decode1 right bs
  | otherwise = decode1 left bs

Сначала я решил, что мне нужна какая-то хвостовая рекурсия, чтобы сделать это ленивым. Вот что не не работает. Во всяком случае, я думаю, что нет. Обратите внимание, как это рекурсивно, но я передаю список «символов, декодированных до сих пор» и добавляю новый. Неэффективно и, возможно, (если мое понимание верно) не приведет к хвостовой рекурсии. 

decodeHelp :: BTree a -> [a] -> [Bool] -> ([a],Bool)
decodeHelp t symSoFar bs = case decode1 t bs of
    Nothing -> (symSoFar,False)
    Just (s,remain) -> decodeHelp t (symSoFar ++ [s]) remain

Поэтому я подумал, как мне написать лучшую рекурсию, в которой я декодирую символ и добавляю его кследующий звонок? Ключ должен вернуть список [Maybe a], в котором Just a является успешно декодированным символом, а Nothing означает, что ни один символ не может быть декодирован (т. Е. Оставшихся логических значений недостаточно) 

decodeHelp2 :: BTree a -> [Bool] -> [Maybe a]
decodeHelp2 t bs = case decode1 t bs of
    Nothing -> [Nothing]
    Just (s, remain) -> case remain of
        [] -> []
        -- in the following line I can just cons Just s onto the
        -- recursive call. My understand is that's what make tail
        -- recursion work and lazy.
        _  -> Just s : decodeHelp2 t remain

Но, очевидно, это не то, чего хочет набор проблем из результата. Как я могу превратить все эти [Maybe a] в ([a], Bool)? Моей первой мыслью было применить scanl

Вот функция сканирования. Он накапливает Maybe a в ([a], Bool)

sFunc :: ([a], Bool) -> Maybe a -> ([a], Bool)
sFunc (xs, _) Nothing = (xs, False)
sFunc (xs, _) (Just x) = (xs ++ [x], True)

Тогда вы можете написать 

decodeSortOf :: BTree a -> [Bool] -> [([a], Bool)]
decodeSortOf t bs = scanl sFunc ([],True) (decodeHelp2 t bs)

Я проверил это работает и ленив:

take 3 $ decodeSortOf xyz_code [True,False,True,True,False,False,False,error "foo"] дает [("",True),("y",True),("yz",True)]

Но это не желаемый результат. Помогите, я застрял!

Ответы [ 2 ]

3 голосов
/ 25 октября 2019

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

import Data.List (inits, tails)

takeChunkUntil :: ([a] -> Bool) -> [a] -> Maybe ([a], [a])
takeChunkUntil p as = _ $ zip (inits as) (tails as)
2 голосов
/ 25 октября 2019

Мы можем использовать явную рекурсию здесь, где, если предикат удовлетворен, мы добавляем к первому элементу кортежа. Если нет, мы создаем 2-кортеж, в который мы помещаем (оставшийся) список во второй элемент 2-кортежа. Например: 

import Control.Arrow(first)

takeChunkUntil :: ([a] -> Bool) -> [a] -> ([a], [a])
takeChunkUntil p = go []
    where go _ [] = ([], [])
          go gs xa@(x:xs) | not (p (x:gs)) = first (x:) (go (x:gs) xs)
                          | otherwise = ([], xa)

Здесь мы предполагаем, что порядок элементов в группе не имеет отношения к предикату (поскольку мы каждый раз передаем список в обратном порядке). Если это уместно, мы можем использовать список различий , например. Я оставляю это как упражнение.

Это работает и для бесконечного списка, например: 

Prelude Control.Arrow> take 10 (fst (takeChunkUntil (const False) (repeat 1)))
[1,1,1,1,1,1,1,1,1,1]
...