pattern - restricciones multiples haskell

Alternativa más limpia a la concordancia de patrones extensa en Haskell

Question

En este momento, tengo un código que funciona esencialmente así:

data Expression 
    = Literal Bool 
    | Variable String
    | Not Expression 
    | Or Expression Expression 
    | And Expression Expression
    deriving Eq

simplify :: Expression -> Expression
simplify (Literal b) = Literal b
simplify (Variable s) = Variable s
simplify (Not e) = case simplify e of
    (Literal b) -> Literal (not b)
    e''          -> Not e''
simplify (And a b) = case (simplify a, simplify b) of
    (Literal False, _) -> Literal False
    (_, Literal False) -> Literal False
    (a'', b'')           -> And a'' b''
simplify (Or a b) = case (simplify a, simplify b) of
    (Literal True, _) -> Literal True
    (_, Literal True) -> Literal True
    (a'', b'')          -> Or a'' b''

Y muchos más patrones de este tipo con respecto a todas las formas en que uno puede simplificar una expresión booleana. A medida que agrego más operadores y reglas, sin embargo, esto crece inmensamente y se siente ... torpe. Sobre todo porque algunas reglas deben agregarse dos veces para tener en cuenta la conmutatividad.

¿Cómo puedo refactorizar muchos y muchos patrones de los cuales algunos (la mayoría, diría yo) son incluso simétricos (por ejemplo, los patrones And y Or)?

En este momento, agregar una regla para simplificar And (Variable "x") (Not (Variable "x")) a Literal False requiere que agregue dos reglas anidadas, que es casi óptima.

Answer 1

Básicamente, el problema es que debe escribir una y otra vez la simplify de las subexpresiones en cada cláusula. Sería mejor hacer primero todas las subexpresiones antes de considerar las leyes que involucran al operador de nivel superior. Una forma sencilla es agregar una versión auxiliar de simplify , que no se reduce:

simplify :: Expression -> Expression
simplify (Literal b) = Literal b
simplify (Variable s) = Variable s
simplify (Not e) = simplify'' . Not $ simplify e
simplify (And a b) = simplify'' $ And (simplify a) (simplify b)
simplify (Or a b) = simplify'' $ Or (simplify a) (simplify b)

simplify'' :: Expression -> Expression
simplify'' (Not (Literal b)) = Literal $ not b
simplify'' (And (Literal False) _) = Literal False
...

Con la pequeña cantidad de operaciones que tiene en booleanos, este es probablemente el enfoque más sensato. Sin embargo, con más operaciones, la duplicación en la simplify podría valer la pena evitarla. Para ello, puede combinar las operaciones unarias y binarias con un constructor común:

data Expression 
    = Literal Bool 
    | Variable String
    | BoolPrefix BoolPrefix Expression 
    | BoolInfix BoolInfix Expression Expression 
    deriving Eq

data BoolPrefix = Negation
data BoolInfix  = AndOp | OrOp

y entonces tienes solo

simplify (Literal b) = Literal b
simplify (Variable s) = Variable s
simplify (BoolPrefix bpf e) = simplify'' . BoolPrefix bpf $ simplify e
simplify (BoolInfix bifx a b) = simplify'' $ BoolInfix bifx (simplify a) (simplify b)

Obviamente, esto hace que la simplify'' sea ​​más torpe, así que quizás no sea una buena idea. Sin embargo, puede evitar esta sobrecarga sintáctica definiendo sinónimos especializados de patrones :

{-# LANGUAGE PatternSynonyms #-}

pattern Not :: Expression -> Expression
pattern Not x = BoolPrefix Negation x

infixr 3 :∧
pattern (:∧) :: Expression -> Expression -> Expression
pattern a:∧b = BoolInfix AndOp a b

infixr 2 :∨
pattern (:∨) :: Expression -> Expression -> Expression
pattern a:∨b = BoolInfix OrOp a b

Para el caso, tal vez también

pattern F, T :: Expression
pattern F = Literal False
pattern T = Literal True

Con eso, entonces puedes escribir

simplify'' :: Expression -> Expression
simplify'' (Not (Literal b)) = Literal $ not b
simplify'' (F :∧ _) = F
simplify'' (_ :∧ F) = F
simplify'' (T :∨ _) = T
simplify'' (a :∧ Not b) | a==b  = T
...

Sin embargo, debo agregar una advertencia: cuando intenté algo similar a esos sinónimos de patrón, no para los booleanos sino para los mapeos afines, el compilador era extremadamente lento . (Además, GHC-7.10 aún no admite sinónimos de patrones polimórficos; esto ha cambiado bastante a partir de ahora).

Tenga en cuenta también que, en general, todo esto no proporcionará la forma más simple posible; para eso, deberá encontrar el punto fijo de simplify .

Answer 2

Continuando con su idea de Binary Op Expression Expression , podríamos tener el tipo de datos:

data Expression
    = Literal Bool
    | Variable String
    | Not Expression
    | Binary Op Expression Expression
    deriving Eq

data Op = Or | And deriving Eq

Y una función auxiliar.

{-# LANGUAGE ViewPatterns #-}

simplifyBinary  :: Op -> Expression -> Expression -> Expression
simplifyBinary  binop (simplify -> leftexp) (simplify -> rightexp) =
    case oneway binop leftexp rightexp ++ oneway binop rightexp leftexp of
        simplified : _ -> simplified
        []             -> Binary binop leftexp rightexp
  where
    oneway :: Op -> Expression -> Expression -> [Expression]
    oneway And (Literal False) _ = [Literal False]
    oneway Or  (Literal True)  _ = [Literal True]
    -- more cases here
    oneway _   _               _ = []

La idea es que ponga los casos de simplificación en una oneway y luego simplifyBinary se encargará de revertir los argumentos, para evitar tener que escribir los casos simétricos.

Answer 3

Creo que Einstein dijo: "Simplifica lo más posible, pero no más". Usted tiene un tipo de datos complicado y un concepto correspondientemente complicado, por lo que asumo que cualquier técnica solo puede ser mucho más clara para el problema en cuestión.

Dicho esto, la primera opción es utilizar en su lugar una estructura de caso.

simplify x = case x of
   Literal _  -> x
   Variable _ -> x
   Not e      -> simplifyNot $ simplify e
   ...
   where
     sharedFunc1 = ...
     sharedFunc2 = ...

Esto tiene el beneficio adicional de incluir funciones compartidas que serán utilizables por todos los casos pero no en el espacio de nombres de nivel superior. También me gusta cómo se liberan los casos de su paréntesis. (También tenga en cuenta que en los primeros dos casos solo devuelvo el término original, no creando uno nuevo). A menudo utilizo este tipo de estructura para romper otras funciones de simplificación, como en el caso de Not

Este problema en particular puede prestarse para basar la Expression en un functor subyacente, de modo que pueda fmap una simplificación de las subexpresiones y luego realizar las combinaciones específicas del caso dado. Se verá algo como lo siguiente:

simplify :: Expression'' -> Expression''
simplify = Exp . reduce . fmap simplify . unExp

Los pasos en esto son "Expansión de desenvolvimiento Expression'' en la representación del funtor subyacente, mapeando la simplificación en el término subyacente, y luego reduciendo esa simplificación y envolviendo de nuevo en la nueva Expression''

{-# Language DeriveFunctor #-}

newtype Expression'' = Exp { unExp :: ExpressionF Expression'' }

data ExpressionF e
  = Literal Bool 
  | Variable String
  | Not e 
  | Or e e
  | And e e
  deriving (Eq,Functor)

Ahora, he empujado la complejidad hacia la función de reduce , que es solo un poco menos compleja porque no tiene que preocuparse primero por reducir el subterm. Pero ahora contendrá únicamente la lógica empresarial de combinar un término con otro.

Esta puede o no ser una buena técnica para usted, pero puede facilitar algunas mejoras. Por ejemplo, si es posible formar expresiones no válidas en su idioma, podría simplificarlo con Maybe fallos valorados.

simplifyMb :: Expression'' -> Maybe Expression''
simplifyMb = fmap Exp . reduceMb <=< traverse simplifyMb . unExp

Aquí, traverse aplicará simplfyMb a los subterms de ExpressionF , dando como resultado una expresión de Maybe subterms, ExpressionF (Maybe Expression'') , y luego, si alguno de los subterms es Nothing , devolverá Nothing , si todos son Just x , devolverá Just (e::ExpressionF Expression'') . Traverse no está realmente separado en distintas fases como esa, pero es más fácil de explicar como si lo fuera. También tenga en cuenta que necesitará pragmas de lenguaje para DeriveTraversable y DeriveFoldable, así como derivaciones en el tipo de datos de ExpressionF .

¿La baja? Bueno, por un lado, la suciedad de tu código estará en un montón de envoltorios de Exp todas partes. Considere la aplicación de simplfyMb del término simple a continuación:

simplifyMb (Exp $ Not (Exp $ Literal True))

También es mucho para tener una fmap , pero si entiendes el patrón traverse y fmap arriba, puedes reutilizarlo en muchos lugares, así que eso es bueno. También creo que la definición de simplificar de esa manera lo hace más robusto a lo que sea en lo que puedan convertirse las construcciones específicas de ExpressionF . No los menciona, por lo que la simplificación profunda no se verá afectada por los refactores. La función de reducción por otro lado será.

Answer 4

Podría escribir un simplificador genérico para todas las operaciones binarias:

simplifyBinWith :: (Bool -> Bool -> Bool) -- the boolean operation
                -> (Expression -> Expression -> Expression) -- the constructor
                -> Expression -> Expression -- the two operands
                -> Expression) -- the simplified result
simplifyBinWith op cons a b = case (simplify a, simplify b) of
    (Literal x, Literal y) -> Literal (op x y)
    (Literal x, b'')        -> tryAll (x `op`) b''
    (a'',        Literal y) -> tryAll (`op` y) a''
    (a'',        b'')        -> cons a'' b''
  where
    tryAll f term = case (f True, f False) of -- what would f do if term was true of false
      (True,  True)  -> Literal True
      (True,  False) -> term
      (False, True)  -> Not term
      (False, False) -> Literal False

De esa manera, su función de simplify se convertiría en

simplify :: Expression -> Expression
simplify (Not e)   = case simplify e of
    (Literal b) -> Literal (not b)
    e''          -> Not e''
simplify (And a b) = simplifyBinWith (&&) And a b
simplify (Or a b)  = simplifyBinWith (||) Or a b
simplify t         = t

y podría extenderse fácilmente a más operaciones binarias. También funcionaría bien con la idea de Binary Op Expression Expression , pasaría Op lugar de un constructor de Expression para simplifyBinWith y el patrón en simplify podría generalizarse:

simplify :: Expression -> Expression
simplify (Not e)         = case simplify e of
    (Literal b) -> Literal (not b)
    e''          -> Not e''
simplify (Binary op a b) = simplifyBinWith (case op of
    And -> (&&)
    Or -> (||)
    Xor -> (/=)
    Implies -> (<=)
    Equals -> (==)
    …
  ) op a b
simplify t               = t
  where
    simplifyBinWith f op a b = case (simplify a, simplify b) of
      (Literal x, Literal y) -> Literal (f x y)
      …
      (a'',        b'')        -> Binary op a'' b''

Answer 5

Una cosa que puedes hacer es simplificar a medida que construyes, en lugar de construir primero y luego destruir repetidamente. Asi que:

module Simple (Expression, true, false, var, not, or, and) where

import Prelude hiding (not, or, and)

data Expression
    = Literal Bool
    | Variable String
    | Not Expression
    | Or Expression Expression
    | And Expression Expression
    deriving (Eq, Ord, Read, Show)

true = Literal True
false = Literal False
var = Variable

not (Literal True) = false
not (Literal False) = true
not x = Not x

or (Literal True) _ = true
or _ (Literal True) = true
or x y = Or x y

and (Literal False) _ = false
and _ (Literal False) = false
and x y = And x y

Podemos probarlo en ghci:

> and (var "x") (and (var "y") false)
Literal False

Tenga en cuenta que los constructores no se exportan: esto garantiza que las personas que construyen uno de estos no puedan evitar el proceso de simplificación. En realidad, esto puede ser un inconveniente; de vez en cuando es bueno ver el formulario "completo". Un enfoque estándar para lidiar con esto es hacer que los constructores inteligentes exportados formen parte de una clase de tipo; puede usarlos para crear un formulario "completo" o una forma "simplificada". Para evitar tener que definir el tipo dos veces, podríamos usar un parámetro newtype o phantom; Elegiré este último aquí para reducir el ruido en la coincidencia de patrones.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
module Simple (Format(..), true, false, var, not, or, and) where

import Prelude hiding (not, or, and)

data Format = Explicit | Simplified

data Expression (a :: Format)
    = Literal Bool
    | Variable String
    | Not (Expression a)
    | Or (Expression a) (Expression a)
    | And (Expression a) (Expression a)
    deriving (Eq, Ord, Read, Show)

class Expr e where
    true, false :: e
    var :: String -> e
    not :: e -> e
    or, and :: e -> e -> e

instance Expr (Expression Explicit) where
    true = Literal True
    false = Literal False
    var = Variable
    not = Not
    or = Or
    and = And

instance Expr (Expression Simplified) where
    true = Literal True
    false = Literal False
    var = Variable

    not (Literal True) = false
    not (Literal False) = true
    not x = Not x

    or (Literal True) _ = true
    or _ (Literal True) = true
    or x y = Or x y

    and (Literal False) _ = false
    and _ (Literal False) = false
    and x y = And x y

Ahora en ghci podemos "ejecutar" el mismo término de dos maneras diferentes:

> :set -XDataKinds
> and (var "x") (and (var "y") false) :: Expression Explicit
And (Variable "x") (And (Variable "y") (Literal False))
> and (var "x") (and (var "y") false) :: Expression Simplified
Literal False

Es posible que desee agregar más reglas más adelante; por ejemplo, tal vez quieras:

and (Variable x) (Not (Variable y)) | x == y = false
and (Not (Variable x)) (Variable y) | x == y = false

Tener que repetir ambos "pedidos" de patrones es un poco molesto. ¡Debemos abstenernos de eso! La declaración de datos y las clases serán las mismas, pero agregaremos la función auxiliar eitherOrder y la usaremos en las definiciones de and y or . Aquí hay un conjunto más completo de simplificaciones usando esta idea (y nuestra versión final del módulo):

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
module Simple (Format(..), true, false, var, not, or, and) where

import Data.Maybe
import Data.Monoid
import Prelude hiding (not, or, and)
import Control.Applicative ((<|>))

data Format = Explicit | Simplified

data Expression (a :: Format)
    = Literal Bool
    | Variable String
    | Not (Expression a)
    | Or (Expression a) (Expression a)
    | And (Expression a) (Expression a)
    deriving (Eq, Ord, Read, Show)

class Expr e where
    true, false :: e
    var :: String -> e
    not :: e -> e
    or, and :: e -> e -> e

instance Expr (Expression Explicit) where
    true = Literal True
    false = Literal False
    var = Variable
    not = Not
    or = Or
    and = And

eitherOrder :: (e -> e -> e)
            -> (e -> e -> Maybe e)
            -> e -> e -> e
eitherOrder fExplicit fSimplified x y = fromMaybe
    (fExplicit x y)
    (fSimplified x y <|> fSimplified y x)

instance Expr (Expression Simplified) where
    true = Literal True
    false = Literal False
    var = Variable

    not (Literal True) = false
    not (Literal False) = true
    not (Not x) = x
    not x = Not x

    or = eitherOrder Or go where
        go (Literal True) _ = Just true
        go (Literal False) x = Just x
        go (Variable x) (Variable y) | x == y = Just (var x)
        go (Variable x) (Not (Variable y)) | x == y = Just true
        go _ _ = Nothing

    and = eitherOrder And go where
        go (Literal True) x = Just x
        go (Literal False) _ = Just false
        go (Variable x) (Variable y) | x == y = Just (var x)
        go (Variable x) (Not (Variable y)) | x == y = Just false
        go _ _ = Nothing

Ahora en ghci podemos hacer simplificaciones más complicadas, como:

> and (not (not (var "x"))) (var "x") :: Expression Simplified
Variable "x"

Y aunque solo escribimos una orden de la regla de reescritura, ambas órdenes funcionan correctamente:

> and (not (var "x")) (var "x") :: Expression Simplified
Literal False
> and (var "x") (not (var "x")) :: Expression Simplified
Literal False