Write a [Haskell] program: Fault Tree Evaluation Learning Outcomes: On successfu

Question

Write a [Haskell] program: Fault Tree Evaluation

Learning Outcomes: On successful completion of this assignment, a student will:

-Have used different approaches to define data types in Haskell

-Have practiced how to use recursive definitions in functional programming paradigm

-Have practiced how to program using functional programming languages

In the first part of this assignment, given a list of probabilities and a list of logical operations, your program will find the probability of the top event (see Fig.1). For simplicity, we also assume that there are two types of operations on the probabilities: OR and AND gates.

Please implement the fault tree

Sample run:

asgCode [[0.5,0.5],[0.5,0.8],[0.5,0.2],[0.2,0.4],[0.1,0.8],[0.2,1]] ["and", "and", "and", "or", "or"]

The logic is like that:

data Tree = Leaf Float | Node [Char] Tree Tree deriving (Show, Eq, Ord)

ex:

Node "or" (Leaf 0.5) (Leaf 0.4) P1 P2 P3 P4 P5 | "or" "or" "and" "and"

P3 P4 P5 P1orP2 | "or" "and" "and"

P5 P1orP2 P3orP4 | "and" "and"

P3orP4 P5and(P1orP2) | "and"

(P3orP4)and(P5and(P1orP2)) | empty

Also, there is a probability part:

To calculate the probability of the top event, you need to use the following steps: If we have an OR gate with two inputs P1 and P2, the output of the OR gate will be another probability which is calculated as:

The output of a gate will eventually be the input of another gate. In the first part of this assignment, you are asked to implement this structure in Haskell. The inputs of your program will be two lists, where you keep the values of each leaf and the logical operators. You need to use a recursive function to build a tree. You need to select two items from the first list and one item from the second list.

Please write easy code, I want to understand the writing logic of the Haskell code. Thank you.

Explanation / Answer

module Language.FaultTree
( Event (..)
, imply
, dot
, cutsets
) where

import Data.List
import Data.Maybe
import Math.SMT.Yices.Pipe
import Math.SMT.Yices.Syntax
import Text.Printf

type Name = String

-- | An event.
data Event
= Leaf   Name        -- ^ Leaf node.
| Branch Name Event   -- ^ Named branch node.
| Not         Event   -- ^ Logical NOT.
| And        [Event] -- ^ Logical AND.
| Or         [Event] -- ^ Logical OR.
deriving (Show, Eq)

-- | Logical implication.
imply :: Event -> Event -> Event
imply a b = Or [Not a, b]

-- | Render a Graphviz dot file from a set of 'Event' (fault) trees.
dot :: [Event] -> String
dot a = unlines
[ "digraph {"
, " rankdir=BT"
, unlines $ map node events'
, unlines $ map edge events'
, "}"
]
where
events'' :: [(Event, String)]
events'' = [ (a, "event_" ++ show i) | (i, a) <- zip [0 ..] $ nub $ concatMap events a ]
events' = fst $ unzip events''
eventId :: Event -> String
eventId a = fromJust $ lookup a events''
node :: Event -> String
node a = case a of
    Leaf   name   -> printf " %s [label="%s"]" (eventId a) name
    Branch name _ -> printf " %s [label="%s"]" (eventId a) name
    Not _         -> printf " %s [label="NOT"]" (eventId a)
    And _         -> printf " %s [label="AND"]" (eventId a)
    Or _         -> printf " %s [label="OR"]" (eventId a)

edge :: Event -> String
edge a = case a of

Leaf _     -> ""
    Branch _ b -> printf " %s -> %s" (eventId b) (eventId a)
    Not b      -> printf " %s -> %s" (eventId b) (eventId a)
    And b      -> unlines [ printf " %s -> %s" (eventId b) (eventId a) | b <- b ]
    Or b      -> unlines [ printf " %s -> %s" (eventId b) (eventId a) | b <- b ]

-- Unique list of events.
events :: Event -> [Event]
events a = case a of
Leaf _     -> [a]
Branch _ b -> a : events b
Not b      -> a : events b
And b      -> a : nub (concatMap events b)
Or b      -> a : nub (concatMap events b)

-- | Minimal cut set analysis.
-- > cutsets pathToYices maxNumberOfLeafEvents failureEvent assumptions
cutsets :: FilePath -> Int -> Event -> [Event] -> IO ()
cutsets yices n event assumes = do
--mapM_ print model
check 1 []
where
eventId :: Event -> String
eventId a = fromJust $ lookup a eventNames
events' = nub $ concatMap events $ event : assumes
eventNames = [ (a, "event_" ++ show i) | (i, a) <- zip [0 ..] events' ]
model :: [CmdY]
model = map var events' ++ mapMaybe expr events' ++ [ASSERT $ VarE $ eventId event] ++ [ ASSERT $ VarE $ eventId assume | assume <- assumes ]
var :: Event -> CmdY
var a = DEFINE (eventId a, VarT "bool") Nothing
expr :: Event -> Maybe CmdY
expr a = case a of
    Leaf _     -> Nothing
    Branch _ b -> Just $ ASSERT $ VarE (eventId a) := VarE (eventId b)
    Not b      -> Just $ ASSERT $ VarE (eventId a) := NOT (VarE $ eventId b)
    And b      -> Just $ ASSERT $ VarE (eventId a) := AND [ VarE $ eventId b | b <- b ]
    Or b      -> Just $ ASSERT $ VarE (eventId a) := OR [ VarE $ eventId b | b <- b ]

nEvents :: Int -> CmdY
nEvents n = ASSERT $ LitI (fromIntegral n) := foldl1 (:+:) [ IF (VarE $ eventId a) (LitI 1) (LitI 0) | a@(Leaf _) <- events' ]

check :: Int -> [[String]] -> IO ()
check i _ | i > n = return ()
check i assumes = do
    result <- quickCheckY yices [] $ model ++ [nEvents i] ++ [ ASSERT $ NOT $ AND [ VarE a | a <- assume ] | assume <- assumes ]
    case result of

Sat a -> do
        putStrLn $ concat [ name ++ " " | Leaf name <- cutSet a ]
        check i $ [ eventId a | a <- cutSet a ] : assumes
      UnSat _ -> check (i + 1) assumes
      a -> error $ "unexpected smt result: " ++ show a

cutSet :: [ExpY] -> [Event]
cutSet result = [ a | (a@(Leaf _), label) <- eventNames, elem' label ]
    where
    match label (VarE label' := LitB True) = label == label'
    match _ _ = False
    elem' a = case find (match a) result of
      Nothing -> False
      Just _ -> True

Related Questions

Navigate

• Browse (All)
• Browse W
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.