Функция вставки в Haskell для бинарных деревьев

Question

Я пытаюсь создать функцию с именем "insertm", которая должна вставлять ключ и значение в двоичное дерево. Если ключ уже существует, он должен вернуть "ничто". Если нет, он должен вставить ключ и значение в дерево на основе его значения. Я был в состоянии заставить большую часть этого идти, но я получаю ошибку, которую я не уверен, как исправить.

Вот пример:

      TestQ4> insertm 25 "vw" t5
      Just (10:"ghi")<$,(30:"def")<(20:"abc")<$,(25:"vw")>,$>>
      TestQ4> insertm 20 "vw" t5
      Nothing

Вот мой код:

     data BinaryTree a b = Leaf | Node a b (BinaryTree a b) (BinaryTree a b) 

     insertm :: (Ord a, Show a, Show b) =>
     a -> b -> BinaryTree a b -> Maybe (BinaryTree a b)

     insertm val key Leaf = Just (Node val key Leaf Leaf)
     insertm x y (Node val key left right)
          | x == val = Nothing
          | x < val = Just (Node val key (insertm x y left) right)
          | otherwise = Just (Node val key left (insertm x y right))

И это ошибка, которую я получаю:

       * Couldn't match expected type `BinaryTree a b'
              with actual type `Maybe (BinaryTree a b)'
       * In the fourth argument of `Node', namely `(insertm x y right)'
         In the first argument of `Just', namely
           `(Node val key left (insertm x y right))'
         In the expression: Just (Node val key left (insertm x y right))
       * Relevant bindings include
          right :: BinaryTree a b (bound at TestQ4.hs:101:32)
          left :: BinaryTree a b (bound at TestQ4.hs:101:27)
          key :: b (bound at TestQ4.hs:101:23)
          val :: a (bound at TestQ4.hs:101:19)
          y :: b (bound at TestQ4.hs:101:11)
          x :: a (bound at TestQ4.hs:101:9)
         (Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max- 
            relevant-binds)

          | x < val = Just (Node val key (insertm x y left) right)
                                          ^^^^^^^^^^^^^^^^

Я также получаю ошибку для моего другого случая. Так что я немного застрял, любая помощь будет оценена.

Answer 1

Проблема в том, что (insertm x y left) - это Maybe (BinaryTree a b) in:

 | x < val = Just (Node val key (insertm x y left) right)

не BinaryTree a b, поэтому вы не можете просто создать такой BinaryTree с Maybe (BinaryTree a b) как поддерево.

Однако вы можете «распаковать» значение и использовать его, например:

insertm :: (Ord a, Show a, Show b) => a -> b -> BinaryTree a b -> Maybe (BinaryTree a b)
insertm val key Leaf = Just (Node val key Leaf Leaf)
insertm x y (Node val key left right)
    | x == val = Nothing
    | x < val = case insertm x y left of
        Just l -> Just (Node val key l right)
        Nothing -> Nothing
    | otherwise =  case insertm x y right of
        Just r -> Just (Node val key left r)
        Nothing -> Nothing

Приведенный выше шаблон довольно популярен, мы можем использовать fmap :: Functor f => (a -> b) -> f a -> f b здесь, чтобы отобразить x в Just x на Just (f x) и карту Nothing на Nothing:

insertm :: (Ord a, Show a, Show b) => a -> b -> BinaryTree a b -> Maybe (BinaryTree a b)
insertm val key Leaf = Just (Node val key Leaf Leaf)
insertm x y (Node val key left right)
    | x == val = Nothing
    | x < val = fmap (flip (Node val key) right) (insertm x y left)
    | otherwise = fmap (Node val key left) (insertm x y right)

или как @ JonPurdy говорит:

insertm :: (Ord a, Show a, Show b) => a -> b -> BinaryTree a b -> Maybe (BinaryTree a b)
insertm val key Leaf = Just (Node val key Leaf Leaf)
insertm x y (Node val key left right)
    | x == val = Nothing
    | x < val = Node val key <$> insertm x y left <*> pure right
    | otherwise = Node val key left <$> insertm x y right

(<$>) - это функция, которая эквивалентна fmap, а (<*>) :: f (a -> b) -> f a -> f b - это функция, которая принимает здесь Maybe (BinaryTree a b -> BinaryTree a b) и применяет функцию f, обернутый в Just со значением x, обернутым в правое Just и возвращает Just (f x), если оба значения равны Just с, если один из двух равен Nothing (или оба) , тогда он вернет Nothing.