¿Cómo hago que este algoritmo sea más perezoso sin repetirme?

9

(Inspirado por mi respuesta a esta pregunta ).

Considere este código (se supone que debe encontrar el elemento más grande que sea menor o igual que una entrada dada):

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

Esto no es muy vago. Una vez que GTse ingresa el caso, sabemos con certeza que el valor de retorno final será Justalgo más que Nothing, pero Justaún no estará disponible hasta el final. Me gustaría hacerlo más perezoso para que Justesté disponible tan pronto como GTse ingrese el caso. Mi caso de prueba para esto es que quiero Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)evaluar en Truelugar de tocar fondo. Aquí hay una forma en que puedo pensar en hacer esto:

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

Sin embargo, ahora me estoy repitiendo: la lógica central ahora está en ambos closestLessy en precise. ¿Cómo puedo escribir esto para que sea flojo pero sin repetirme?

haskell lazy-evaluation dry Joseph Sible-Reinstate a Monica
fuente

Respuestas:

4

En lugar de usar contenedores explícitos, puede aprovechar el sistema de tipos. Tenga en cuenta que la versión preciseque usa Maybepara su primer fragmento de código:

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

es casi exactamente el mismo algoritmo que la versión precisesin Maybede su segundo fragmento de código, que podría escribirse en el Identityfunctor como:

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

Estos se pueden unificar en una versión polimórfica en 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

Por sí solo, eso no logra mucho, pero si sabemos que la GTrama siempre devolverá un valor, podemos obligarla a ejecutarse en el Identityfunctor, independientemente del functor inicial. Es decir, podemos comenzar en el Maybefunctor pero recurrir al Identityfunctor en la GTrama:

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

Esto funciona bien con su caso de prueba:

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

y es un buen ejemplo de recursividad polimórfica.

Otra cosa buena de este enfoque desde el punto de vista del rendimiento es que -ddump-simplmuestra que no hay contenedores ni diccionarios. Todo se ha borrado a nivel de tipo con funciones especializadas para los dos functores:

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
KA Buhr
fuente
2
Esta es una solución genial
luqui
3

A partir de mi implementación no perezosa, primero refactoré precisepara recibir Justcomo argumento, y generalicé su tipo en consecuencia:

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

Luego, lo cambié para hacerlo wraptemprano y llamarlo iden el 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)

Esto todavía funciona exactamente como antes, excepto por el beneficio de la pereza adicional.

Joseph Sible-Reinstate a Monica
fuente
1
¿Todos los ids en el medio Justy la final son (k,v)eliminados por el compilador? Probablemente no, se supone que las funciones son opacas, y podría haberlo utilizado (de forma factible) en first (1+)lugar de idtodo lo que el compilador sabe. pero es un código compacto ... por supuesto, mi código es el de desentrañar y especificar el suyo aquí, con la simplificación adicional (la eliminación de los ids). También es muy interesante cómo el tipo más general sirve como una restricción, una relación entre los valores involucrados (aunque no lo suficientemente ajustados, con el first (1+)permiso como wrap).
Will Ness
1
(cont.) su polimórfico precisese usa en dos tipos, que corresponden directamente a las dos funciones especializadas utilizadas en la variante más detallada. Buena interacción allí. Además, no llamaría a esto CPS, wrapno se usa como una continuación, no está construido "en el interior", está apilado, por recursividad, en el exterior. Tal vez si se utiliza como continuación usted podría deshacerse de esas extrañas ids ... por cierto podemos ver aquí una vez más que viejo patrón del argumento funcional utilizado como indicador de qué hacer, el cambio entre las dos líneas de acción ( Justo id).
Will Ness
3

Creo que la versión de CPS que respondió usted mismo es la mejor, pero para completar, aquí hay algunas ideas más. (EDITAR: la respuesta de Buhr es ahora la más eficaz).

La primera idea es deshacerse del " closestSoFar" acumulador y, en su lugar, dejar que el GTcaso maneje toda la lógica de elegir el valor de la derecha más pequeño que el argumento. De esta forma, el GTcaso puede devolver directamente 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))

Esto es más simple, pero ocupa un poco más de espacio en la pila cuando llegas a muchos GTcasos. Técnicamente, incluso podría usar eso fromMaybeen forma de acumulador (es decir, reemplazar lo fromJustimplícito en la respuesta de luqui), pero eso sería una rama redundante e inalcanzable.

La otra idea es que en realidad hay dos "fases" del algoritmo, una antes y otra después de presionar a GT, por lo que lo parametrizas con un booleano para representar estas dos fases, y usas tipos dependientes para codificar el invariante de que siempre habrá un resultado en la segunda 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)
Li-yao Xia
fuente
No pensé en mi respuesta como CPS hasta que lo señaló. Estaba pensando en algo más cercano a una transformación trabajador-envoltorio. ¡Supongo que Raymond Chen ataca de nuevo!
Joseph Sible-Reinstate Monica
2

Qué tal si 

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

?

luqui
fuente
Porque esa es una coincidencia de patrón incompleta. Incluso si mi función es un todo es total, no me gusta que algunas partes sean parciales.
Joseph Sible-Reinstate Monica
Entonces dijiste "lo sabemos con certeza" aún con alguna duda. Quizás eso sea saludable.
luqui
Lo sabemos con certeza, dado que mi segundo bloque de código en mi pregunta siempre regresa Justpero es total. Sé que su solución tal como está escrita es de hecho total, pero es frágil ya que una modificación aparentemente segura podría resultar en un fondo.
Joseph Sible-Reinstate Monica
Esto también ralentizará un poco el programa, ya que GHC no puede probar que siempre lo será Just, por lo que agregará una prueba para asegurarse de que no Nothingse repita cada vez.
Joseph Sible-Reinstate Monica
1

No solo sabemos siempre Just, después de su primer descubrimiento, también siempre sabemosNothing hasta entonces. Eso es en realidad dos "lógicas" diferentes.

Entonces, primero vamos a la izquierda, así que explícalo:

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

El precio es que repetimos como máximo un paso como máximo una vez.

Will Ness
fuente