Come faccio a rendere questo algoritmo più pigro senza ripetermi?

(Ispirato dalla mia risposta a questa domanda .)

Considera questo codice (si suppone che trovi l'elemento più grande che sia inferiore o uguale a un dato input):

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

Questo non è molto pigro. Una volta GTinserito il caso, sappiamo per certo che il valore di ritorno finale sarà Justqualcosa piuttosto che Nothing, ma il resto Justnon è disponibile fino alla fine. Vorrei rendere questo pigrone in modo che Justsia disponibile non appena GTviene inserito il caso. Il mio caso di prova per questo è che voglio Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)valutare Truepiuttosto che toccare il fondo. Ecco un modo in cui posso pensare di fare questo:

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

Tuttavia, ora mi sto ripetendo: la logica di base è ora in entrambi closestLesse in precise. Come posso scrivere questo in modo che sia pigro ma senza ripetermi?

Anziché utilizzare wrapper espliciti, è possibile sfruttare il sistema dei tipi. Tieni presente che la versione preciseutilizzata Maybeper il tuo primo frammento di codice:

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

è quasi esattamente lo stesso algoritmo della versione di precisesenza Maybedal tuo secondo frammento di codice, che potrebbe essere scritto nel funzione Identitycome:

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

Questi possono essere unificati in una versione polimorfica in 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

Di per sé, ciò non ottiene molto, ma se sappiamo che il GTramo restituirà sempre un valore, possiamo costringerlo a funzionare nel funzione Identity, indipendentemente dal funzione iniziale. Cioè, possiamo iniziare nel Maybefunctor ma ricorrere al Identityfunctor nel GTramo:

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

Funziona bene con il tuo test case:

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

ed è un bell'esempio di ricorsione polimorfica.

Un'altra cosa bella di questo approccio dal punto di vista delle prestazioni è che -ddump-simplmostra che non ci sono wrapper o dizionari. È stato tutto cancellato a livello di tipo con funzioni specializzate per i due funzioni:

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

A partire dalla mia implementazione non pigra, per prima cosa mi sono rifatturato preciseper ricevere Justcome argomento e generalizzato il suo tipo di conseguenza:

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

Quindi, l'ho cambiato per fare wrappresto e chiamare se stesso idnel GTcaso:

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)

Funziona ancora esattamente come prima, tranne per il beneficio della pigrizia aggiunta.

Penso che la versione CPS a cui hai risposto sia la migliore, ma per completezza qui ci sono alcune idee in più. (EDIT: la risposta di Buhr è ora la più performante.)

La prima idea è quella di sbarazzarsi dell'accumulatore " closestSoFar", e invece lasciare che il GTcaso gestisca tutta la logica di scegliere il valore più giusto più piccolo dell'argomento. In questo modulo, il GTcaso può restituire direttamente un 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))

Questo è più semplice, ma occupa un po 'più di spazio nello stack quando colpisci molti GTcasi. Tecnicamente potresti persino usarlo fromMaybenella forma dell'accumulatore (cioè sostituire l' fromJustimplicito nella risposta di luqui), ma sarebbe un ramo ridondante e irraggiungibile.

L'altra idea che ci sono davvero due "fasi" dell'algoritmo, una prima e una dopo aver colpito a GT, quindi lo si parametrizza con un valore booleano per rappresentare queste due fasi e si usano tipi dipendenti per codificare l'invariante che ci sarà sempre un risulta nella seconda fase.

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)

Che ne dite di

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

?

Non solo lo sappiamo sempre Just, dopo sua prima scoperta, lo sappiamo sempre Nothing fino ad allora. In realtà sono due "logiche" diverse.

Quindi, andiamo a sinistra prima di tutto, quindi crea che esplicito:

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

Il prezzo è che ripetiamo al massimo un passaggio al massimo una volta.