Question

我试图在Haskell中创建一个命题逻辑模型，我需要一个函数将一些逻辑规则应用于特定的子表达式。功能＆＃34;适用＆＃34;获取一个列表，该列表指示树中子表达式的位置（根据左右序列），逻辑规则和逻辑表达式，并返回一个新的逻辑表达式。

data LogicExp  a = P a                              | 
                     True'                      | 
                     False'                                 | 
                     Not' (LogicExp a)                  |  
                     (LogicExp a) :&  (LogicExp a)  | 
                     (LogicExp a) :|  (LogicExp a)  | 
                     (LogicExp a) :=> (LogicExp a)    |
                     (LogicExp a) :=  (LogicExp a)
    deriving Show


type LExp = LogicExp String

data Position = L | R

deMorgan :: LExp -> LExp
deMorgan (e1 :& e2) = Not' ((Not e1) :| (Not e2))
deMorgan (e1 :| e2) = Not' ((Not e1) :& (Not e2))
deMorgan x = x

apply :: [Position] -> (LExp -> LExp) -> LExp -> LExp
apply [] f e = f e
apply (L:xs) f (e1 :& e2) = (apply xs f e1) :& e2
apply (R:xs) f (e1 :& e2) = e1 :& (apply xs f e2)
apply (L:xs) f (e1 :| e2) = (apply xs f e1) :| e2
apply (R:xs) f (e1 :| e2) = e1 :| (apply xs f e2)
apply (L:xs) f (e1 :=> e2) = (apply xs f e1) :=> e2
apply (R:xs) f (e1 :=> e2) = e1 :=> (apply xs f e2)
apply (L:xs) f (e1 := e2) = (apply xs f e1) := e2
apply (R:xs) f (e1 := e2) = e1 := (apply xs f e2)
apply (x:xs) f (Not' e) = apply xs f e

该功能正常。但是我可以使用一些数据构造函数＆＃34; wildcard＆＃34;有这样一个更简单的功能吗？

apply :: [Position] -> (LExp -> LExp) -> LExp -> LExp
apply [] f e = f e
apply (L:xs) f (e1 ?? e2) = (apply xs f e1) ?? e2
apply (R:xs) f (e1 ?? e2) = e1 ?? (apply xs f e2)
apply (x:xs) f (Not' e) = apply xs f e

Answer 1

目前，我无法回想起任何花哨的技巧。但是，您可能想要做的一件事是将LogicExp构造函数中的公共结构分解出来：

data LogicExp a
    = P a
    | True'
    | False'
    | Not' (LogicExp a) 
    | Bin' BinaryOp (LogicExp a) (LogicExp a)
    deriving Show

data BinaryOp = And' | Or' | Impl' | Equiv'
    deriving Show

apply :: [Position] -> (LExp -> LExp) -> LExp -> LExp
apply [] f e = f e
apply (L:xs) f (Bin' op e1 e2) = Bin' op (apply xs f e1) e2
apply (R:xs) f (Bin' op e1 e2) = Bin' op e1 (apply xs f e2)
apply (x:xs) f (Not' e) = apply xs f e
-- ... and the P, True' and False' cases.

通过这样做，你失去了可爱的中缀构造函数。但是，如果你真的想要它们，那就有一个奇特的技巧：view patterns（另请参阅this question了解更多示例和讨论）。

Answer 2

这是使用其中一个Generics软件包的经典案例，syb或uniplate。

通常uniplate更快，但不如syb。幸运的是，在这种情况下，您可以使用uniplate。

使用uniplate的步骤：

使用DeriveDataTypeable pragma。
自动派生Data和Typeable
导入Data.Data以及类似Data.Generics.Uniplate.Data

您想要的转换函数只是transform，具有相应的类型签名：

doit :: LExp -> LExp
doit = transform deMorgan

其中deMorgan与您编写的完全相同。

完整示例：

{-# LANGUAGE DeriveDataTypeable #-}
module Lib6 where

import Data.Data
import Data.Generics.Uniplate.Data
import Text.Show.Pretty (ppShow)

data LogicExp  a = P a                              |
                     True'                      |
                     False'                                 |
                     Not' (LogicExp a)                  |
                     (LogicExp a) :&  (LogicExp a)  |
                     (LogicExp a) :|  (LogicExp a)  |
                     (LogicExp a) :=> (LogicExp a)    |
                     (LogicExp a) :=  (LogicExp a)
    deriving (Show, Data, Typeable)

type LExp = LogicExp String

data Position = L | R

deMorgan :: LExp -> LExp
deMorgan (e1 :& e2) = Not' ((Not' e1) :| (Not' e2))
deMorgan (e1 :| e2) = Not' ((Not' e1) :& (Not' e2))
deMorgan x = x

doit :: LExp -> LExp
doit = transform deMorgan

example = (P "a" :& P "b") :| (P "c")

test = putStrLn $ ppShow (doit example)

运行test会产生：

Not' (Not' (Not' (Not' (P "a") :| Not' (P "b"))) :& Not' (P "c"))

关于uniplate的简介：

http://community.haskell.org/~ndm/darcs/uniplate/uniplate.htm

如何简化此模式匹配？

2 个答案: