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

9

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

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

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. Как я могу написать это так, чтобы это было лениво, но не повторялось?

Джозеф Сибл-Восстановить Монику
источник

Ответы:

4

Вместо того, чтобы использовать явные оболочки, вы можете использовать систему типов. Обратите внимание, что версия, 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
К. А. Бур
источник
2
Это довольно крутое решение
Luqui
3

Начиная с моей не ленивой реализации, я сначала рефакторинг, 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)

Это по-прежнему работает точно так же, как и раньше, за исключением добавленной лени.

Джозеф Сибл-Восстановить Монику
источник
1
Все ли эти idпромежуточные Justи финальные значения (k,v)устранены компилятором? скорее всего, нет, функции должны быть непрозрачными, и вы могли бы (возможно, по типу) использовать их first (1+)вместо того, idчтобы все, что знает компилятор. но это делает для компактного кода ... конечно, мой код - это распутывание и спецификация вашего здесь с дополнительным упрощением (устранение ids). также очень интересно, как более общий тип служит в качестве ограничения, отношения между задействованными значениями (хотя и недостаточно жесткими, с first (1+)разрешением as wrap).
Уилл Несс
1
(продолжение). Ваша полиморфность preciseиспользуется в двух типах, непосредственно соответствующих двум специализированным функциям, используемым в более подробном варианте. там хорошее взаимодействие Кроме того, я бы не назвал этот CPS, wrapон не используется в качестве продолжения, он не создается "изнутри", он складывается - путем рекурсии - снаружи. Может быть , если бы были использованы в качестве продолжения вы могли бы избавиться от этих посторонних idс ... Кстати , мы можем увидеть здесь еще раз , что старый образец функционального аргумента используется как индикатор того , что делать, переключение между двумя курсами действия ( Justили id).
Будет Несс
3

Я думаю, что версия 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)
Ли Яо Ся
источник
Я не думал о своем ответе как о CPS, пока вы не указали его. Я думал о чем-то более близком к трансформации рабочего-обертки. Я думаю, Раймонд Чен снова наносит удар!
Джозеф Сибл-Восстановить Монику
2

Как насчет

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

?

luqui
источник
Потому что это неполное совпадение с образцом. Даже если моя функция целая, полная, я не люблю, чтобы ее части были частичными.
Джозеф Сибл-Восстановить Монику
Итак, вы сказали «мы знаем наверняка», все еще с некоторым сомнением. Возможно, это здорово.
Луки
Мы точно знаем, учитывая, что мой второй блок кода в моем вопросе всегда возвращается, Justно является полным. Я знаю, что ваше решение в том виде, в котором оно написано, на самом деле является полным, но оно хрупкое в том смысле, что казалось бы безопасная модификация может привести к его падению.
Джозеф Сибл-Восстановить Монику
Это также немного замедлит работу программы, поскольку GHC не может доказать, что так будет всегда Just, поэтому он добавит тест, чтобы убедиться, что он не Nothingкаждый раз повторяется.
Джозеф Сибл-Восстановить Монику
1

Мало того, что мы всегда знаем 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

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

Уилл Несс
источник