Wie mache ich diesen Algorithmus fauler, ohne mich zu wiederholen?

(Inspiriert von meiner Antwort auf diese Frage .)

Betrachten Sie diesen Code (er soll das größte Element finden, das kleiner oder gleich einer bestimmten Eingabe ist):

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

Das ist nicht sehr faul. Sobald der GTFall eingegeben ist, wissen wir sicher, dass der endgültige Rückgabewert Justeher etwas als sein wird Nothing, aber der Wert Justist erst am Ende verfügbar. Ich möchte dies fauler machen, damit das Justverfügbar ist, sobald der GTFall eingegeben wird. Mein Testfall dafür ist, dass ich eher Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)bewerten Trueals auf den Grund gehen möchte . Hier ist eine Möglichkeit, wie ich mir das vorstellen kann:

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

Jetzt wiederhole ich mich jedoch: Die Kernlogik ist jetzt in beiden closestLessund in precise. Wie kann ich das so schreiben, dass es faul ist, ohne mich zu wiederholen?

Anstatt explizite Wrapper zu verwenden, können Sie das Typsystem nutzen. Beachten Sie, dass die Version von , precisedass Anwendungen Maybefür die ersten Codeausschnitt:

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

ist fast genau der gleiche Algorithmus wie die Version von precisewithout Maybeaus Ihrem zweiten Code-Snippet, der im IdentityFunktor wie folgt geschrieben werden könnte :

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

Diese können zu einer polymorphen Version zusammengefasst werden 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

Das allein bringt nicht viel, aber wenn wir wissen, dass der GTZweig immer einen Wert zurückgibt, können wir ihn zwingen, im IdentityFunktor ausgeführt zu werden, unabhängig vom Startfunktor. Das heißt, wir können im MaybeFunktor beginnen, aber in den IdentityFunktor in der GTBranche zurückkehren:

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

Dies funktioniert gut mit Ihrem Testfall:

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

und ist ein schönes Beispiel für polymorphe Rekursion.

Eine weitere schöne Sache über diesen Ansatz aus Sicht der Leistung ist, dass die -ddump-simplzeigt, dass es keine Wrapper oder Wörterbücher gibt. Es wurde alles auf Typebene mit speziellen Funktionen für die beiden Funktoren gelöscht:

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

Ausgehend von meiner nicht faulen Implementierung habe ich mich zunächst umgestaltet precise, um Justals Argument zu erhalten , und den Typ entsprechend verallgemeinert:

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

Dann habe ich es geändert, um wrapfrüh zu tun und mich mit idin dem GTFall anzurufen :

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)

Dies funktioniert immer noch genauso wie zuvor, mit Ausnahme der zusätzlichen Faulheit.

Ich denke, die CPS-Version, die Sie mit sich selbst beantwortet haben, ist die beste, aber der Vollständigkeit halber hier noch ein paar Ideen. (EDIT: Buhrs Antwort ist jetzt die performanteste.)

Die erste Idee ist, den " closestSoFar" Akkumulator loszuwerden und stattdessen den GTFall die gesamte Logik der Auswahl des am weitesten rechts liegenden Werts als des Arguments behandeln zu lassen. In dieser Form kann der GTFall direkt Folgendes zurückgeben 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))

Dies ist einfacher, benötigt jedoch etwas mehr Platz auf dem Stapel, wenn Sie viele GTFälle treffen . Technisch könnte man das sogar fromMaybein der Akkumulatorform verwenden (dh das fromJustimplizite in luquis Antwort ersetzen ), aber das wäre ein redundanter, nicht erreichbarer Zweig.

Die andere Idee, dass es wirklich zwei "Phasen" des Algorithmus gibt, eine vor und eine nach dem Drücken von a GT, also parametrisieren Sie ihn durch einen Booleschen Wert, um diese beiden Phasen darzustellen, und verwenden abhängige Typen, um die Invariante zu codieren, dass es immer eine geben wird Ergebnis in der zweiten Phase.

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)

Wie wäre es mit

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

?

Wir wissen nicht nur immer Just, nach seiner ersten Entdeckung, wir wissen es auch immer Nothing bis dahin. Das sind eigentlich zwei verschiedene "Logiken".

Also gehen wir zuerst nach links, also machen Sie das deutlich:

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

Der Preis ist, dass wir höchstens einen Schritt höchstens einmal wiederholen.