Como faço para tornar esse algoritmo mais preguiçoso sem me repetir?


9

(Inspirado pela minha resposta a esta pergunta .)

Considere este código (ele deve encontrar o maior elemento que é menor ou igual a uma determinada entrada):

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

Isso não é muito preguiçoso. Depois que o GTcaso é inserido, sabemos com certeza que o valor final de retorno será Justalgo em vez de Nothing, mas o Justainda não estará disponível até o final. Eu gostaria de tornar isso mais preguiçoso para que ele Justfique disponível assim que o GTcaso for inserido. Meu caso de teste para isso é que eu quero Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)avaliar em Truevez de chegar ao fundo. Aqui está uma maneira de pensar em fazer isso:

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

No entanto, agora estou me repetindo: a lógica principal está agora em ambos closestLesse em precise. Como posso escrever isso para que seja preguiçoso, mas sem me repetir?

Respostas:


4

Em vez de usar wrappers explícitos, você pode aproveitar o sistema de tipos. Observe que a versão preciseusada Maybepara o seu primeiro trecho 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

é quase exatamente o mesmo algoritmo da versão precisesem Maybedo seu segundo trecho de código, que pode ser escrito no 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

Eles podem ser unificados em uma versão polimórfica no 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 si só, isso não realiza muito, mas se sabemos que o GTramo sempre retornará um valor, podemos forçá-lo a executar no Identityfunctor, independentemente do functor inicial. Ou seja, podemos iniciar no Maybefunctor, mas recorrer ao Identityfunctor no 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

Isso funciona bem com seu caso de teste:

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

e é um bom exemplo de recursão polimórfica.

Outra coisa legal dessa abordagem do ponto de vista do desempenho é que -ddump-simplmostra que não há wrappers ou dicionários. Tudo foi apagado no nível de tipo com funções especializadas para os dois 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

2
Esta é uma solução muito legal
luqui

3

A partir de minha implementação não preguiçosa, primeiro refatorei precisepara receber Justcomo argumento e generalizei seu tipo de acordo:

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

Então, eu mudei para fazer wrapcedo e chame-se de idno 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)

Isso ainda funciona exatamente como antes, exceto pelo benefício da preguiça adicionada.


11
Todos os ids no meio Juste a final são (k,v)eliminados pelo compilador? provavelmente não, as funções devem ser opacas, e você poderia (usualmente digitar) usado em first (1+)vez de idtudo o que o compilador sabe. mas isso cria um código compacto ... é claro, meu código é o desenrolar e a especificação de vocês aqui, com a simplificação adicional (a eliminação dos id). Também é muito interessante como o tipo mais geral serve como restrição, uma relação entre os valores envolvidos (embora não seja suficientemente rígido, first (1+)sendo permitido como wrap).
Will Ness

11
(continuação) seu polimórfico preciseé usado em dois tipos, correspondendo diretamente às duas funções especializadas usadas na variante mais detalhada. boa interação lá. Além disso, eu não chamaria isso de CPS, wrapnão é usado como uma continuação, não é construído "por dentro", é empilhado - por recursão - por fora. Talvez, se fosse usado como continuação, você poderia se livrar daquelas coisas estranhas id... mas podemos ver aqui mais uma vez aquele velho padrão de argumento funcional usado como indicador do que fazer, alternando entre os dois cursos de ação ( Justou id).
Will Ness

3

Eu acho que a versão do CPS que você respondeu consigo mesma é a melhor, mas para completar, aqui estão mais algumas idéias. (EDIT: A resposta de Buhr agora é a que tem maior desempenho.)

A primeira idéia é se livrar do " closestSoFar" acumulador e, em vez disso, deixar o GTcaso lidar com toda a lógica de escolher o valor mais à direita menor que o argumento. Nesse formulário, o GTcaso pode retornar diretamente um 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))

Isso é mais simples, mas ocupa um pouco mais de espaço na pilha quando você atinge muitos GTcasos. Tecnicamente, você pode até usá-lo fromMaybena forma de acumulador (ou seja, substituindo o fromJustimplícito na resposta de luqui), mas isso seria um ramo redundante e inacessível.

A outra idéia de que realmente existem duas "fases" do algoritmo, uma antes e uma depois que você pressiona a GT, então você o define por um booleano para representar essas duas fases e usa tipos dependentes para codificar o invariante de que sempre haverá um resultar na 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)

Não pensei na minha resposta como CPS até que você a apontou. Eu estava pensando em algo mais próximo de uma transformação de trabalhador-invólucro. Acho que Raymond Chen ataca novamente!
Joseph Sible-Reinstate Monica

2

E se

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

?


Porque essa é uma correspondência incompleta de padrões. Mesmo que minha função seja um todo, não gosto de partes parciais.
Joseph Sible-Reinstate Monica

Então você disse "sabemos com certeza" ainda com alguma dúvida. Talvez isso seja saudável.
luqui 14/12/19

Temos certeza, dado que meu segundo bloco de código na minha pergunta sempre retorna, Justmas é total. Sei que a sua solução, como está escrita, é de fato total, mas é frágil, pois uma modificação aparentemente segura pode resultar em um fundo.
Joseph Sible-Reinstate Monica

Isso também desacelerará um pouco o programa, como o GHC não pode provar que sempre será Just, então adicionará um teste para garantir que não seja Nothingsempre que ele voltar.
Joseph Sible-Reinstate Monica

1

Não apenas sabemos sempre Just, depois de sua primeira descoberta, também sempre sabemos Nothing até então. Na verdade, são duas "lógicas" diferentes.

Então, vamos para a esquerda antes de tudo, para tornar isso explícito:

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

O preço é que repetimos no máximo uma etapa no máximo uma vez.

Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.