Як зробити цей алгоритм лазерним, не повторюючи себе?

(Натхненний моєю відповіддю на це запитання .)

Розглянемо цей код (він повинен знайти найбільший елемент, менший або рівний даному входу):

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing where
  precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
  precise closestSoFar Leaf = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise closestSoFar l
    EQ -> Just (k, v)
    GT -> precise (Just (k, v)) r

Це не дуже ліниво. Щойно GTсправа введена, ми точно знаємо, що остаточне значення повернення буде Justчимось, а не Nothing, але Justвсе ще недоступне до кінця. Я хотів би зробити цей лазерний шрифт таким чином, щоб його Justбуло доступно, як тільки GTсправа введена. Мій тест для цього полягає в тому, що я хочу Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)оцінити, Trueа не досягти рівня. Ось один із способів я можу зробити це:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess _ Leaf = Nothing
closestLess i (Node k v l r) = case i `compare` k of
  LT -> closestLess i l
  EQ -> Just (k, v)
  GT -> Just (precise (k, v) r)
  where
    precise :: (Integer, v) -> TreeMap v -> (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> (k, v)
      GT -> precise (k, v) r

Однак я зараз повторюю: основна логіка тепер є closestLessі в, і в precise. Як я можу написати це, щоб це ліниво, але не повторюючись?

Замість того, щоб використовувати явні обгортки, ви можете використовувати типову систему. Зауважте, що версія, preciseяка використовується Maybeдля вашого першого фрагмента коду:

precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Just (k, v)
  GT -> precise (Just (k, v)) r

майже такий самий алгоритм, що і версія preciseбез Maybeдругого фрагмента коду, який можна записати у Identityфунктор як:

precise :: Identity (Integer, v) -> TreeMap v -> Identity (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Identity (k, v)
  GT -> precise (Identity (k, v)) r

Вони можуть бути об'єднані в поліморфну ​​версію в Applicative:

precise :: (Applicative f) => f (Integer, v) -> TreeMap v -> f (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> pure (k, v)
  GT -> precise (pure (k, v)) r

Це само по собі не дуже добре, але якщо ми знаємо, що GTгілка завжди поверне значення, ми можемо змусити її працювати у Identityфункторі, незалежно від стартового функтора. Тобто ми можемо запуститись у Maybeфунктор, але повторно у Identityфункторі у GTгілці:

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing
  where
    precise :: (Applicative t) => t (Integer, v) -> TreeMap v -> t (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> pure (k, v)
      GT -> pure . runIdentity $ precise (Identity (k, v)) r

Це добре працює з вашим тестовим випадком:

> isJust $ closestLess 5 (Node 3 () Leaf undefined)
True

і є приємним прикладом поліморфної рекурсії.

Ще одна приємна річ у цьому підході з точки зору продуктивності - це те, що -ddump-simplсвідчить про відсутність обгортки та словників. Це все було стерто на рівні типу зі спеціалізованими функціями для двох функторів:

closestLess
  = \ @ v i eta ->
      letrec {
        $sprecise
        $sprecise
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise closestSoFar l;
                    EQ -> (k, v2) `cast` <Co:5>;
                    GT -> $sprecise ((k, v2) `cast` <Co:5>) r
                  }
              }; } in
      letrec {
        $sprecise1
        $sprecise1
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise1 closestSoFar l;
                    EQ -> Just (k, v2);
                    GT -> Just (($sprecise ((k, v2) `cast` <Co:5>) r) `cast` <Co:4>)
                  }
              }; } in
      $sprecise1 Nothing eta

Починаючи з моєї неленої реалізації, я спершу відремонтувався preciseна отримання Justаргументу і відповідно узагальнив його тип:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> precise wrap (wrap (k, v)) r

Потім я змінив це на wrapраннє та подзвонив собі idу GTвипадку:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> wrap (precise id (k, v) r)

Це все ще працює точно так, як раніше, за винятком користі від додаткової ліні.

Я думаю, що версія CPS, на яку ви відповіли самі, є найкращою, але для повноти тут є ще кілька ідей. (EDIT: Відповідь Бура зараз найефективніша.)

Перша ідея полягає в тому, щоб позбутися " closestSoFar" акумулятора, а натомість дозволити GTвипадку обробляти всю логіку вибору найменшого значення, найменшого за аргумент. У цій формі GTсправа може безпосередньо повернути Just:

closestLess1 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess1 _ Leaf = Nothing
closestLess1 i (Node k v l r) =
  case i `compare` k of
    LT -> closestLess1 i l
    EQ -> Just (k, v)
    GT -> Just (fromMaybe (k, v) (closestLess1 i r))

Це простіше, але забирає трохи більше місця на стеку, коли ви потрапляєте у багато GTвипадків. Технічно ви могли навіть використовувати це fromMaybeу формі акумулятора (тобто замінюючи fromJustнеявне у відповіді лукі), але це було б зайвою, недосяжною гілкою.

Інша думка про те, що дійсно є дві "фази" алгоритму, одна до і одна після того, як ви натиснете a GT, тому ви параметризуєте його булевим для представлення цих двох фаз і використовуєте залежні типи для кодування інваріанта, що завжди буде результат у другій фазі.

data SBool (b :: Bool) where
  STrue :: SBool 'True
  SFalse :: SBool 'False

type family MaybeUnless (b :: Bool) a where
  MaybeUnless 'True a = a
  MaybeUnless 'False a = Maybe a

ret :: SBool b -> a -> MaybeUnless b a
ret SFalse = Just
ret STrue = id

closestLess2 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess2 i = precise SFalse Nothing where
  precise :: SBool b -> MaybeUnless b (Integer, v) -> TreeMap v -> MaybeUnless b (Integer, v)
  precise _ closestSoFar Leaf = closestSoFar
  precise b closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise b closestSoFar l
    EQ -> ret b (k, v)
    GT -> ret b (precise STrue (k, v) r)

Як щодо

GT -> let Just v = precise (Just (k,v) r) in Just v

?

Ми не тільки завжди знаємо Just, що після його першого відкриття ми також завжди знаємо Nothing до цього часу. Це насправді дві різні "логіки".

Отже, передусім йдемо ліворуч, тому зробимо це явним:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) 
                 deriving (Show, Read, Eq, Ord)

closestLess :: Integer 
            -> TreeMap v 
            -> Maybe (Integer, v)
closestLess i = goLeft 
  where
  goLeft :: TreeMap v -> Maybe (Integer, v)
  goLeft n@(Node k v l _) = case i `compare` k of
          LT -> goLeft l
          _  -> Just (precise (k, v) n)
  goLeft Leaf = Nothing

  -- no more maybe if we're here
  precise :: (Integer, v) -> TreeMap v -> (Integer, v)
  precise closestSoFar Leaf           = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
        LT -> precise closestSoFar l
        EQ -> (k, v)
        GT -> precise (k, v) r

Ціна полягає в тому, що ми повторюємо максимум один крок максимум відразу.