Jak sprawić, by ten algorytm był bardziej leniwy bez powtarzania się?

(Zainspirowany moją odpowiedzią na to pytanie ).

Rozważ ten kod (powinien znaleźć największy element, który jest mniejszy lub równy podanemu wejściu):

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

To nie jest zbyt leniwe. Po GTwpisaniu sprawy wiemy na pewno, że końcowa wartość zwrotna będzie Justczymś, a nie Nothing, ale Justnadal nie będzie dostępna do końca. Chciałbym uczynić to bardziej leniwym, aby Justbyło dostępne od razu po wpisaniu GTsprawy. Mój przypadek testowy polega na tym, że chcę Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)ocenić Trueraczej niż dno. Oto jeden ze sposobów, w jaki mogę to zrobić:

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

Jednak teraz powtarzam: podstawowa logika jest teraz zarówno w, jak closestLessi wewnątrz precise. Jak mogę to napisać, żeby było leniwe, ale nie powtarzałem się?

Zamiast używać jawnych opakowań, możesz wykorzystać system typów. Zauważ, że od wersji precise, która wykorzystuje Maybedo pierwszego fragmentu kodu:

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

jest prawie dokładnie tym samym algorytmem, co wersja „ precisebez” Maybez drugiego fragmentu kodu, który można zapisać na Identityfunktorze jako:

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

Można je ujednolicić w wersji polimorficznej w 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

Samo w sobie nie osiąga to wiele, ale jeśli wiemy, że GTgałąź zawsze zwróci wartość, możemy zmusić ją do działania na Identityfunktorze, niezależnie od funktora początkowego. Oznacza to, że możemy zacząć od Maybefunktora, ale wrócić do Identityfunktora w GTgałęzi:

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

Działa to dobrze w przypadku testowym:

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

i jest dobrym przykładem polimorficznej rekurencji.

Kolejną zaletą tego podejścia z punktu widzenia wydajności jest to, że -ddump-simplpokazuje, że nie ma żadnych opakowań ani słowników. Wszystko zostało skasowane na poziomie typu ze specjalnymi funkcjami dla dwóch funktorów:

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

Zaczynając od mojej niezbyt leniwej implementacji, najpierw zmieniłem zdanie precisena otrzymane Justjako argument i odpowiednio uogólniłem jego typ:

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

Potem zmieniłem to na wrapwczesne i nazwałem idw GTprzypadku:

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)

To nadal działa dokładnie tak jak poprzednio, z wyjątkiem korzyści dodatkowego lenistwa.

Myślę, że wersja CPS, na którą sam odpowiedziałeś, jest najlepsza, ale dla kompletności oto kilka innych pomysłów. (EDYCJA: Odpowiedź Buhra jest teraz najbardziej wydajna.)

Pierwszym pomysłem jest pozbyć się closestSoFarakumulatora „ ”, a zamiast tego pozwolić GTskrzynce obsłużyć całą logikę wyboru najmniejszej wartości prawej od argumentu. W tej formie GTsprawa może bezpośrednio zwrócić 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))

Jest to prostsze, ale zajmuje dużo miejsca na stosie, gdy trafisz wiele GTskrzynek. Technicznie można by tego użyć nawet fromMaybew postaci akumulatora (tj. Zastępując fromJustukrytą odpowiedź Luquiego), ale byłaby to zbędna, nieosiągalna gałąź.

Drugi pomysł, że tak naprawdę są dwie „fazy” algorytmu, jedna przed i jedna po naciśnięciu a GT, więc parametryzujesz go wartością logiczną, aby reprezentować te dwie fazy, i używasz typów zależnych do kodowania niezmiennika, że ​​zawsze będzie wynik w drugiej fazie.

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)

Co powiesz na

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

?

Nie tylko zawsze wiemy Just, że po pierwszym odkryciu zawsze wiemyNothing do tego czasu . To właściwie dwie różne „logiki”.

Więc idź w lewo przede wszystkim, dlatego , że wyraźne:

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

Cena jest taka, że ​​powtarzamy co najwyżej jeden krok maksymalnie raz.