3

最初の部分は、次の型シグネチャを持つ評価関数です。

evaluate :: Logic Expr -> [(Variable, Bool)] -> Bool

これは、論理式と代入ペアのリストを入力として受け取り、指定されたブール代入に従って式の値を返します。割り当てリストは、各ペアに変数とそのブール代入が含まれる個別のペアのリストです。つまり、式 A ∧ B と代入 A = 1 および B = 0 を関数に渡す場合、関数は 0 を返す必要があります (これは Digital Logic Design によるもので、0 は false に対応し、1 は true に対応します)。

これは私がこれまでにできたことです:

type Variable =  Char

data LogicExpr = V Variable
                 | Negation  LogicExpr
                 | Conjunction LogicExpr LogicExpr
                 | Disjunction  LogicExpr LogicExpr 
                 | Implication  LogicExpr LogicExpr 


evaluate :: LogicExpr -> [(Variable,Bool)] -> Bool

evaluate (V a) ((x1,x2):xs) | a==x1 = x2
                            | otherwise = (evaluate(V a)xs)

evaluate (Negation a) l | (evaluate a l)==True = False
                        | otherwise = True

evaluate (Conjunction a b) l = (evaluate a l)&&(evaluate b l)

evaluate (Disjunction a b) l = (evaluate a l)||(evaluate b l)

evaluate (Implication a b) l
    | (((evaluate b l)==False)&&((evaluate a l)==True)) = False
    | otherwise = True

次の部分は定義するgenerateTruthTableことです。これは、論理式を入力として取り、代入ペアのリストのリストの形式で式の真理値表を返す関数です。つまり、式 E = A ∧ B を関数に渡す場合、関数は A = 0、B = 0、E = 0 | を返す必要があります。A = 0、B = 1、E = 0 | A = 1、B = 0、E = 0 | A = 1、B = 1、E = 1。

構文に詳しくないので、リストを返す方法がわかりません。

4

2 に答える 2

14

標準ライブラリ関数、コードの再利用。また、括弧の使用法と間隔は本当に打ちのめされています。

evaluate (V a) l =
    case lookup a l
      of Just x -> x
         Nothing -> error $ "Unbound variable: " ++ show a
-- same as
evaluate (V a) l = maybe (error $ "Unbound variable: " ++ show a) id $ lookup a l

evaluate (Negation a) l = not $ evaluate a l

evaluate (Implication a b) l = evaluate (Negation a `Disjunction` b) l

さて、あなたはgenerateTruthTable?それは簡単です。ブール変数のすべての可能な状態を取得し、評価された式をそれぞれの最後に追加するだけです。

generateTruthTable :: [Variable] -> LogicExpr -> [[(Variable, Bool)]]
generateTruthTable vs e = [l ++ [('E', evaluate e l)] | l <- allPossible vs]

これらすべての可能な状態を生成する関数があれば。

allPossible :: [Variable] -> [[(Variable, Bool)]]

私の機能的な腸の本能に従うと、これはカタモルフィズムであるべきだと感じます. 結局のところ、リスト内のすべてを調べる必要がありますが、別の構造のものを返します。これは入門レベルの CS クラスであるため、おそらく簡単な方法で分解できます。(コース番号が何であるかは気にしません。これは入門的なものです。)

allPossible = foldr step initial where
    step v ls = ???; initial = ???

さて、foldr :: (a -> b -> b) -> b -> [a] -> b最初の 2 つのパラメータは と でなければなりませstep :: a -> b -> binitial :: b。さて、allPossible :: [Variable] -> [[(Variable, Bool)]] = foldr step initial :: [a] -> b. うーん、これは と を意味する必要がa = Variableありb = [[(Variable, Bool)]]ます。stepこれはとにとって何を意味するのinitialでしょうか?

    step :: Variable -> [[(Variable, Bool)]] -> [[(Variable, Bool)]]
    initial :: [[(Variable, Bool)]]

面白い。どういうわけか、step変数の状態のリストから単一の変数を追加する方法と、initial変数をまったく含まないリストを追加する方法が必要です。

関数型プログラミングのパラダイムにすでに「クリック」することができている場合は、これで十分です。そうでない場合は、ここでどんな指示を受けたとしても、課題の期日までに 2 時間ほど待たされることになります。頑張ってください。課題の期限が過ぎてもまだ行き詰まっている場合は、教授に尋ねるか、ここで緊急ではない質問をしてください。


言語に基本的なユーザビリティの問題がある場合 (「構文は何ですか」、「実行時のセマンティクスは何ですか」、「 xxxの既存の機能はありますか」など):

  • Haskell 98 Language and Librariesは、ベース言語とライブラリの標準的な定義を自由に入手できます。Haskell wikiには、さらに多くのリンクがあります。
  • 98 以降の言語拡張については、GHC のドキュメントを参照してください。
  • GHC、Hugs、およびその他の最新の Haskell 実装も、Haskell 98 で指定されているよりもはるかに豊富な標準ライブラリを提供します。階層ライブラリの完全なドキュメントもオンラインで入手できます。
  • Hoogλeは、拡張された Haskell 標準ライブラリに特化した検索エンジンです。 はよ!は似ていますが、標準ディストリビューションをはるかに超えた Haskell ライブラリのコレクションであるHackageDBもカバーしています。

クラスで同様のリソースが提供されていることを願っていますが、提供されていない場合でも、上記のすべてが Google 検索で簡単に見つけることができます。

適切な参考文献があれば、プログラマーなら誰でも、数時間以内に新しい言語の構文を習得し、数日以内にランタイムを実際に理解できるようになるはずです。もちろん、新しいパラダイムを習得するには時間がかかる場合があり、学生を同じ基準に保つのはやや不公平ですが、それがクラスの目的です.

スタック オーバーフローのより高度な問題に関する質問は、回答が少ないかもしれませんが、提供される怒りもはるかに少なくなります :) 宿題の質問は、「私のために仕事をしてください! ほとんどの人の目に。


ネタバレ

ごまかさないでください。ただし、Haskell でどのように素晴らしいことができるかを少しだけお見せします...

{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances, PatternGuards #-}

module Expr (Ring(..), (=:>), Expr(..), vars, eval, evalAll) where

import Control.Monad.Error

infixl 5 =:>, :=>
infixl 6 +:, -:, :+, :-
infixl 7 *:, :*

class (Eq a) => Ring a where
    (+:) :: a -> a -> a; (-:) :: a -> a -> a; x -: y = x +: invert y
    (*:) :: a -> a -> a; invert :: a -> a; invert x = zero -: x
    zero :: a; one :: a
(=:>) :: (Ring a) => a -> a -> a
(=:>) = flip (-:)

instance (Num a) => Ring a where
    (+:) = (+); (-:) = (-); (*:) = (*)
    invert = negate; zero = 0; one = 1

instance Ring Bool where
    (+:) = (||); (*:) = (&&)
    invert = not; zero = False; one = True

data Expr a b
  = Expr a b :+ Expr a b | Expr a b :- Expr a b
  | Expr a b :* Expr a b | Expr a b :=> Expr a b
  | Invert (Expr a b) | Var a | Const b

paren :: ShowS -> ShowS
paren ss s = '(' : ss (')' : s)

instance (Show a, Show b) => Show (Expr a b) where
    showsPrec _ (Const c) = ('@':) . showsPrec 9 c
    showsPrec _ (Var v) = ('$':) . showsPrec 9 v
    showsPrec _ (Invert e) = ('!':) . showsPrec 9 e

    showsPrec n e@(a:=>b)
      | n > 5 = paren $ showsPrec 0 e
      | otherwise = showsPrec 7 a . ('=':) . ('>':) . showsPrec 5 b

    showsPrec n e@(a:*b)
      | n > 7 = paren $ showsPrec 0 e
      | otherwise = showsPrec 7 a . ('*':) . showsPrec 7 b

    showsPrec n e | n > 6 = paren $ showsPrec 0 e
    showsPrec _ (a:+b) = showsPrec 6 a . ('+':) . showsPrec 6 b
    showsPrec _ (a:-b) = showsPrec 6 a . ('-':) . showsPrec 6 b

vars :: (Eq a) => Expr a b -> [a]
vars (a:+b) = vars a ++ vars b
vars (a:-b) = vars a ++ vars b
vars (a:*b) = vars a ++ vars b
vars (a:=>b) = vars a ++ vars b
vars (Invert e) = vars e; vars (Var v) = [v]; vars _ = []

eval :: (Eq a, Show a, Ring b, Monad m) => [(a, b)] -> Expr a b -> m b
eval m (a:+b) = return (+:) `ap` eval m a `ap` eval m b
eval m (a:-b) = return (-:) `ap` eval m a `ap` eval m b
eval m (a:*b) = return (*:) `ap` eval m a `ap` eval m b
eval m (a:=>b) = return (=:>) `ap` eval m a `ap` eval m b
eval m (Invert e) = return invert `ap` eval m e
eval m (Var v)
  | Just c <- lookup v m = return c
  | otherwise = fail $ "Unbound variable: " ++ show v
eval _ (Const c) = return c

namedProduct :: [(a, [b])] -> [[(a, b)]]
namedProduct = foldr (\(v, cs) l -> concatMap (\c -> map ((v, c):) l) cs) [[]]

evalAll :: (Eq a, Show a, Ring b) => [b] -> a -> Expr a b -> [[(a, b)]]
evalAll range name e =
    [ vs ++ [(name, either error id $ eval vs e)]
    | vs <- namedProduct $ zip (vars e) (repeat range)
    ]
$ ghci
GHCi、バージョン 6.10.2: http://www.haskell.org/ghc/ :? 助けを求める
パッケージ ghc-prim をロード中 ... リンク中 ... 完了。
パッケージ整数を読み込んでいます...リンクしています...完了。
パッケージベースを読み込んでいます...リンクしています...完了。
前奏曲> :l Expr.hs
[1/1] Expr のコンパイル ( Expr.hs、解釈済み )
わかりました、モジュールがロードされました: Expr.
*Expr> mapM_print . evalAll [1..3] 'C' $ Var 'A' :* Var 'B'
パッケージ mtl-1.1.0.2 を読み込み中 ... リンク中 ... 完了。
[('A',1),('B',1),('C',1)]
[('A',1),('B',2),('C',2)]
[('A',1),('B',3),('C',3)]
[('A',2),('B',1),('C',2)]
[('A',2),('B',2),('C',4)]
[('A',2),('B',3),('C',6)]
[('A',3),('B',1),('C',3)]
[('A',3),('B',2),('C',6)]
[('A',3),('B',3),('C',9)]
*Expr> let expr = Var 'A' :=> (Var 'B' :+ Var 'C') :* Var 'D'
*式>式
$'A'=>($'B'+$'C')*$'D'
*Expr> mapM_print $ evalAll [True, False] 'E' expr
[('A',True),('B',True),('C',True),('D',True),('E',True)]
[('A',True),('B',True),('C',True),('D',False),('E',False)]
[('A',True),('B',True),('C',False),('D',True),('E',True)]
[('A',True),('B',True),('C',False),('D',False),('E',False)]
[('A',True),('B',False),('C',True),('D',True),('E',True)]
[('A',True),('B',False),('C',True),('D',False),('E',False)]
[('A',True),('B',False),('C',False),('D',True),('E',False)]
[('A',True),('B',False),('C',False),('D',False),('E',False)]
[('A',False),('B',True),('C',True),('D',True),('E',True)]
[('A',False),('B',True),('C',True),('D',False),('E',True)]
[('A',False),('B',True),('C',False),('D',True),('E',True)]
[('A',False),('B',True),('C',False),('D',False),('E',True)]
[('A',False),('B',False),('C',True),('D',True),('E',True)]
[('A',False),('B',False),('C',True),('D',False),('E',True)]
[('A',False),('B',False),('C',False),('D',True),('E',True)]
[('A',False),('B',False),('C',False),('D',False),('E',True)]
于 2009-06-05T20:22:58.040 に答える
2

基本evaluateは非常に簡単です。

import Data.Maybe (fromJust)
import Data.List (nub)

type Variable = Char
data LogicExpr
   = Var Variable
   | Neg LogicExpr
   | Conj LogicExpr LogicExpr
   | Disj LogicExpr LogicExpr
   | Impl LogicExpr LogicExpr
   deriving (Eq, Ord)

-- evaluates an expression
evaluate :: LogicExpr -> [(Variable, Bool)] -> Bool
evaluate (Var v) bs      = fromJust (lookup v bs)
evaluate (Neg e) bs      = not (evaluate e bs)
evaluate (Conj e1 e2) bs = evaluate e1 bs && evaluate e2 bs
evaluate (Disj e1 e2) bs = evaluate e1 bs || evaluate e2 bs
evaluate (Impl e1 e2) bs = not (evaluate e1 bs) || evaluate e2 bs

真理値表を生成するには、最初に式内のすべての変数を見つけてから、これらの変数に対して可能な割り当てをすべて生成する必要があります。evaluateこれらの代入の真理値は、既に実装されている関数を使用して簡単に決定できます。

-- get variables in an expression
varsp :: LogicExpr -> [Variable]
varsp (Var v)      = [v]
varsp (Neg e)      = varsp e
varsp (Conj e1 e2) = varsp e1 ++ varsp e2
varsp (Disj e1 e2) = varsp e1 ++ varsp e2
varsp (Impl e1 e2) = varsp e1 ++ varsp e2

-- get variables in an expression without duplicates
vars :: LogicExpr -> [Variable]
vars = nub . varsp

-- possible boolean values
bools = [True, False]

-- all possible combinations of variable assignments
booltable :: [Variable] -> [[(Variable, Bool)]]
booltable [] = [[]]
booltable (a:as) = [(a,b) : r | b <- bools, r <- booltable as]

-- variable assignments and corresponding evaluation of an expression
truthtable :: LogicExpr -> [([(Variable, Bool)], Bool)]
truthtable e = [(bs, evaluate e bs) | bs <- booltable (vars e)]

標準ライブラリの暗い隅を探索したい場合は、 sReadを簡単に入力するためのインスタンスを作成することもできます。LogicExpr

-- read a right-associative infix operator
readInfix opprec constr repr prec r
   = readParen (prec > opprec)
     (\r -> [(constr e1 e2, u) |
             (e1,s) <- readsPrec (opprec+1) r,
             (op,t) <- lex s,
             op == repr,
             (e2,u) <- readsPrec (opprec) t]) r

instance Read LogicExpr where
   readsPrec prec r
      =  readInfix 1 Impl "->" prec r
      ++ readInfix 2 Disj "|" prec r
      ++ readInfix 3 Conj "&" prec r
      ++ readParen (prec > 4)
         (\r -> [(Neg e, t) |
                 ("!",s) <- lex r,
                 (e,t)   <- readsPrec 4 s]) r
      ++ readParen (prec > 5)
         (\r -> [(Var v, s) |
                 ([v], s) <- lex r]) r

また、真理値表はきれいに印刷できます。

showcell :: (Variable, Bool) -> String
showcell (v,b) = v : "=" ++ show b

showrow :: [(Variable, Bool)] -> Bool -> String
showrow []     b = show b
showrow [a]    b = showcell a ++ " => " ++ show b
showrow (a:as) b = showcell a ++ " && " ++ showrow as b

printrow :: ([(Variable, Bool)], Bool) -> IO ()
printrow = putStrLn . uncurry showrow

printtbl :: [([(Variable, Bool)], Bool)] -> IO ()
printtbl = mapM_ printrow

すべてをまとめた真理値表は、次のように生成できます。

Prelude Main> printtbl $ truthtable $ read "(a -> b) & (b -> a)"
a=True && b=True => True
a=True && b=False => False
a=False && b=True => False
a=False && b=False => True

Prelude Main> printtbl $ truthtable $ read "(a | b) | (!a & !b)"
a=True && b=True => True
a=True && b=False => True
a=False && b=True => True
a=False && b=False => True
于 2009-06-09T03:53:33.373 に答える