Вставка дерева с использованием State Monad - PullRequest
Новая
       50

Вставка дерева с использованием State Monad

2 голосов
/ 27 мая 2020

У меня есть дерево и операция вставки, определенная как "Выучи Haskell для Великого Добра!" : 

data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq) 

treeInsert :: (Ord a) => a -> Tree a -> Tree a  
treeInsert x EmptyTree = Node x EmptyTree EmptyTree
treeInsert x (Node a left right)   
    | x == a = Node x left right  
    | x < a  = Node a (treeInsert x left) right  
    | x > a  = Node a left (treeInsert x right)

Я хотел бы повторно реализовать treeInsert с помощью State Monad, но я даже не уверен, как должно выглядеть объявление функции. У меня пока есть это: 

treeInsert :: (Ord a) => a -> Tree a -> State (Tree a) a

Как бы вы написали treeInsert, используя State Monad?

1 Ответ

3 голосов
/ 27 мая 2020

Предупреждение: этот ответ содержит спойлеры.

Вы можете довольно легко написать оболочку вокруг существующей функции treeInsert, которая позволит вам использовать do-notation так, как вы хотите. Согласно комментариям, есть функция modify, которая принимает функцию изменения f :: s -> s и превращает ее в State s (), которое является «действием» для изменения состояния s. Это означает, что вы можете написать: 

stateTreeInsert :: (Ord a) => a -> State (Tree a) ()
stateTreeInsert x = modify (treeInsert x)

или более кратко: 

stateTreeInsert :: (Ord a) => a -> State (Tree a) ()
stateTreeInsert = modify . treeInsert

Затем вы можете определить «действие», например: 

insertSomeStuff :: (Ord a, Num a) => State (Tree a) ()
insertSomeStuff = do
  stateTreeInsert 0
  stateTreeInsert 1
  stateTreeInsert 2

, а затем примените его к конкретному дереву, используя execState: 

main = print $ execState insertSomeStuff EmptyTree

Однако, я думаю, вас больше интересовала повторная реализация treeInsert с нуля в форме манипулирования состоянием.

Проблема в том, что «простой» способ сделать это не очень интересен или не вызывает нареканий c. Это просто неудобно. Это будет выглядеть примерно так: 

awkwardTreeInsert :: (Ord a) => a -> State (Tree a) ()
awkwardTreeInsert x = do
  t <- get
  case t of
    EmptyTree -> put $ Node x EmptyTree EmptyTree
    Node a l r -> case compare x a of
      LT -> do put l                 -- replace tree with left child
               awkwardTreeInsert x   -- insert into left child
               l' <- get             -- get the answer
               put $ Node a l' r     -- overwrite with whole tree w/ updated left child
      GT -> do put r
               awkwardTreeInsert x
               r' <- get
               put $ Node a l r'
      EQ -> return ()

Проблема здесь в том, что состояние, как мы его написали, может одновременно содержать только одно дерево. Итак, если мы хотим вызвать алгоритм рекурсивно для вставки чего-либо в ветку, нам нужно перезаписать «большое дерево» одним из его дочерних элементов, запустить рекурсивную вставку, получить ответ и перезаписать его «большим деревом». с заменой соответствующего дочернего элемента.

В любом случае, он работает так же, как stateTreeInsert, поэтому: 

insertSomeStuff :: (Ord a, Num a) => State (Tree a) ()
insertSomeStuff = do
  awkwardTreeInsert 0
  awkwardTreeInsert 1
  awkwardTreeInsert 2

main = print $ execState insertSomeStuff EmptyTree
...