Как сделать этот алгоритм более ленивым, не повторяя себя?

(Вдохновлен моим ответом на этот вопрос .)

Рассмотрим этот код (он должен найти самый большой элемент, который меньше или равен заданному входу):

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, на которую вы ответили сами, является лучшей, но для полноты изложения приведу еще несколько идей. (РЕДАКТИРОВАТЬ: ответ Бура в настоящее время является наиболее эффективным.)

Первая идея состоит в том, чтобы избавиться от " 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

Цена повторяется не более одного шага не более одного раза.