Is AG(~q ∨ Fp) LTL formula satisfy in model below? why or why not?
model?
First of all AG(~q ∨ Fp) is not an LTL formula, because the operator AG does not belong to LTL. I assume you meant G(~q v Fp).
Modeling: let's encode the system in NuSMV:
MODULE main ()
VAR
state : { S0, S1, S2, S3 };
p : boolean;
q : boolean;
ASSIGN
init(state) := S0;
next(state) := case
state = S0 : {S1, S2};
state = S1 : {S0, S3};
state = S2 : {S0};
state = S3 : {S3};
esac;
INVAR state = S0 <-> (!p & !q);
INVAR state = S1 <-> ( p & q);
INVAR state = S2 <-> (!p & q);
INVAR state = S3 <-> ( p & !q);
LTLSPEC G(!q | F p)
And verify it:
~$ NuSMV -int
NuSMV > reset; read_model -i f.smv; go; check_property
-- specification G (!q | F p) is false
-- as demonstrated by the following execution sequence
Trace Description: LTL Counterexample
Trace Type: Counterexample
-- Loop starts here
-> State: 2.1 <-
state = S0
p = FALSE
q = FALSE
-> State: 2.2 <-
state = S2
q = TRUE
-> State: 2.3 <-
state = S0
q = FALSE
Explanation: So the LTL formula is not satisfied by the model. Why?
G means that the formula is satisfied only if ~q v F p is verified by every reachable state.
State S2 is s.t. ~q is FALSE, so in order to satisfy ~q v F p it must necessarily hold that F p is TRUE, that is it is necessarily the case that sooner or later p becomes TRUE.
There exists an infinite path starting from S2 s.t. p is always FALSE: the path that jumps from S2 to S0 and back and never touches either S1 or S3.
Contradiction: the LTL formula is not satisfied.
Related
I have to make a state machine, which equals a text editor's search funtion.
I need to use foldl/foldr to apply the function to every character of a string.
I have a few states, which I have to work with:
type State = Int
start :: State
start = 0
accept :: State
accept = (-2)
reject :: State
reject = (-1)
And I have type synonim : type Definition = [(State, Char -> State)]
The function should look like this: fsm :: Definition -> String -> Bool
My code looks like this right now:
transition :: Char -> State -> (Char -> State)
transition x y z
| x == z = y
| x == '*' = y
| otherwise = reject
transitions :: [(Char, State)] -> (Char -> State)
transitions ((a,b):xs) e
| a == e || a == '*' = b
| a /= e || a /= '*' = transitions xs e
| otherwise = reject
step :: Definition -> State -> Char -> State
step ((a,b):xs) e f
| a == e = b f
| a /= e = step xs e f
| otherwise = reject
It has a starting state, apply transition or transitions function and if it is accepted, the state accepted is the next starting state.
Here is some test cases, which I have to test the function:
fsm [ (start, transition '*' accept)] "x" == True
fsm [ (start, transition 'a' 1)
, (1, transition 'l' 2)
, (2, transition '*' accept)
] "alma" == True
fsm [ (start, transition '*' 1)
, (1, transition '*' 2)
, (2, transition 'x' 3)
, (3, transition '*' accept)
] "taxi" == True
fsm [ (start, transitions [('\n',accept), ('*', 1)])
, (1, transition '*' start)
] "aa\n" == True
If you fill in the initial state and the string to process in foldl, the types basically imply the rest:
-- foldl :: Foldable t => (State -> Char -> State) -> State -> [Char] -> State
fsm def str = foldl x start str
Here x must have type State -> Char -> State and give you the next state given the current one and the next character, which is what your step function does given a Definition that you have. This gives you:
fsm def str = foldl (step def) start str :: State
Now you have a State but need a Bool saying if it's accepted, which is just a simple comparison:
fsm def str = foldl (step def) start str == accept
Here is my data structure
data Ex =
P String
| (:←) Ex
It has the property that p == ←←p. My custom Eq and Ord instances attempt to define the same. However, I am seeing inconsistent results for test3 (set created from [p,←←p, ←p]) and test4 (set created from [p, ←p, ←←p]). Results as shown below:
*Test> test3
fromList [←q,←←q]
*Test> test4
fromList [q,←q,←←q]
Note that test3 and test4 only differ in the order of the elements from which the set is created. Yet, the results differ.
I think the order of the set creation using Data.Set.fromList should not really matter. Can someone help me find the mistake with my Eq or Ord instance? Full code below, compiled with GHC 8.4.3.
module Test where
import Data.Set as S
data Ex =
P String
| (:←) Ex
instance Show Ex where
show (P s) = s
show ((:←) e) = "←" ++ (show e)
instance Eq Ex where
(P s1) == (P s2) = s1 == s2
(:←) e1 == (:←) e2
| e1 == e2 = True
| otherwise = False
e1 == (:←) e2
| e1 == e2 = False
| (:←) e1 == e2 = True
| otherwise = False
(:←) e1 == e2
| e1 == e2 = False
| e1 == (:←) e2 = True
| otherwise = False
elength :: Ex -> Int
elength (P s) = length s
elength ((:←) e) = elength e + 1
instance Ord Ex where
compare e1 e2
| e1 == e2 = EQ
| otherwise = if (elength e1) <= (elength e2) then LT
else GT
-- Check that ←q == ←←q
test2 = S.fromList [(:←) ((:←) (P "q")), P "q"]
-- output should be : {←←q, ←q}
test3 = S.fromList [P "q", (:←) ((:←) (P "q")), (:←) (P "q")]
-- output should be same as that of test3 : {←←q, ←q}
test4 = S.fromList [P "q", (:←) (P "q"), (:←) ((:←) (P "q"))]
EDIT:
Note that if I modify the elength definition to handle the case, the inconsistency is gone.
elength ((:←) ((:←) e)) = elength e
Perhaps my elength metric and == definitions are at odds in the case of q and ←←q. I would still like to know where exactly they are going wrong
Your Eq instance certainly looks strange to me. I would unravel the cancelled-out pairings two at a time, rather than piecemeal:
instance Eq Ex where
(P s1) == (P s2) = s1 == s2
((:←) e1) == (:←) e2 = e1 == e2
e1 == (:←) ((:←) e2) = e1 == e2
(:←) ((:←) e1) == e2 = e1 == e2
_ == _ = False
Maybe this is equivalent to what you have written; it is rather hard to tell because your pattern-matching does not align well with your goals.
Your Ord instance is also a problem, because you do not define a consistent ordering. For any set of items x y z, where x < y && y < z, it should be the case that x < z. However, there are easy counterexamples according to your rules:
x = P "a"
y = (P "b" :←)
z = ((P "a" :←) :←)
Here x == z despite y being in between them.
One way to fix both problems is to write a simplify function that removes all pairs of cancelling-out constructors, and use that in both Eq and Ord instances. Simplify each argument, so that you know they each have either 0 or 1 levels of negation. From there, Eq is easy, and all you need to do before you can define Ord is to decide whether a negated value should be less than or greater than a non-negated value. You can't choose for them to be equal, because that again breaks transitivity.
If you do write simplify, it will be a lot of wasted work to call simplify every time you touch one of these objects, since you immediately throw away the simplification. I'd choose not to export the constructor for this type, and instead offer a smart constructor that simplifies before returning a value. Then consumers will know everything is negated once or not at all.
To study the details of the State monad, I'm trying to create myself a complete desugared version of a simple state monad function, completing the thought started in How does 'get' actually /get/ the initial state in Haskell?, in the answer by J Cooper.
The example state monad function simply swaps the state and the input value, so that (conceptually) if the input is (v, s) then the output is (s, v). I show three translations, first from do notation to desugared >>= and >>, then placing those operators in function position, and finally attempting to replace them and get/put with their definitions.
The 'do' version and the first two translations work, but the final translation does not. Problems:
Upon loading the module, GHCi reports that z1 is not in scope.
I've not figured out exactly how to represent omitting the argument passing in the >> translation.
How should these be fixed?
FWIW, current Haskell platform (GHC 7.4.2).
Thanks!
-- simpleswap
import Control.Monad.State
-- =============================================
-- 'Do' version
simpleswap1 :: String -> State String String
simpleswap1 inp = do
z1 <- get
put inp
return z1
-- =============================================
-- Desugared to >>= and >>
simpleswap2 :: String -> State String String
simpleswap2 inp =
get >>=
\z1 -> put inp >>
return z1
-- =============================================
-- >>= and >> changed to function position
simpleswap3 :: String -> State String String
simpleswap3 inp =
(>>=) get
(\z1 -> (>>) (put inp) (return z1) )
-- =============================================
-- Attempt to translate >>=, >>, get and put
simpleswap4 :: String -> State String String
simpleswap4 inp =
state $ \s1 ->
-- (>>=)
let (a2, s2) = runState ( {- get -} state $ \sg -> (sg,sg) ) s1
in runState (rhs1 a2) s2
where
rhs1 a2 = \z1 ->
-- (>>)
state $ \s3 ->
let (a4, s4) = runState ( {- put inp -} state $ \_ -> (inp, ()) ) s3
in runState (rhs2 a4) s4
where
rhs2 a4 = return z1
-- =============================================
main = do
putStrLn "version 1004"
let v = "vvv"
let s = "sss"
putStrLn ("Before val: " ++ v ++ " state: " ++ s)
let (v2, s2) = runState (simpleswap4 v) s
putStrLn ("After val: " ++ v2 ++ " state: " ++ s2)
-- =============================================
There are a few minor mistakes in simpleswap4. Here is a corrected version:
simpleswap4 :: String -> State String String
simpleswap4 inp =
state $ \s1 ->
-- (>>=)
let (z1, s2) = runState ( {- get -} state $ \sg -> (sg,sg) ) s1
in runState (rhs1 z1) s2
where
rhs1 z1 =
-- (>>)
state $ \s3 ->
let (_, s4) = runState ( {- put inp -} state $ \_ -> ((), inp) ) s3
in runState rhs2 s4
where
rhs2 = return z1
I've renamed a2 to z1 (in lines 5 and 6). This doesn't change the semantics, but emphasized that the first component of the pair returned by the desugared get call is actually the result that gets bound to z1 in the previous versions of simpleswap.
The type of rhs1 should be String -> State String String. In your version, it gets an additional lambda-bound variable. It's unclear what the difference between a2 and z1 should be in your version. Removing the lambda (in line 8) also has the advantage of fixing your scoping problem. You are using z1 in the nested where-clause, but the where can only see variables bound on the left hand side of the declaration it is attached to.
In line 11, I've replaced a4 with _. This is to emphasize that (>>) does discard the result of the first action. As a consequence, rhs2 is not parameterized over this result either.
I'm trying to implement a lexer in Haskell. For easy console input and output, I've used an intermediate data type Transition Table.
type TransitionTable = [(Int, Transitions String Int)]
type Transitions a b = [(a, b)]
I want to take input from the user for all the states and transitions. I do not want to take the total number of states before hand. I want it to keep taking input for the transitions of each state until the user types "--" . If the user types "---", the current state is discarded and the input terminates.
After a lot of attempts I came up with this, which I think is horrible code.
-- |A function to emulate the while loop for easy IO functionality.
-- Defination:- while #comparator #func #start:
-- *comparator #arg: A function which returns True or False on the basis of #arg.
-- The loop stops when False is returned.
-- *func: The function which is executed repeadly.
-- It is responsible for returning the next #arg for the comparator on the basis of the current #arg.
-- *start: The starting value of #arg to pass to the comparator.
while :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a
while comparator func start =
if comparator start then do
nxt <- func start
while comparator func nxt
else
return start
-- |A modification of putStr which flushes out stdout. Corrents buffer problems.
myPutStr :: String -> IO ()
myPutStr str = putStr str >> hFlush stdout >> return ()
-- Takes input from the console to generate a TransitionTable.
inputTransitionTable :: IO TransitionTable
inputTransitionTable = do
putStrLn "Type -- for next state and --- for completing input entering."
retVal <- while notFinished takeInfo (0, [])
return (snd retVal)
where
-- Returns True when input entry is over.
notFinished (i, _) = i > -1
-- Takes the current state number and the incomplete corrosponding transition table which is populated
-- with user input. Input ends when user enters "---". State number is set to -1 when input is over.
takeInfo (i, states) = do
putStrLn ("Adding transitions to state " ++ show i ++ ": ")
retVal <- while entryNotFinished takeStateInfo ("", [])
let (inpStr, stateInfo) = retVal
case inpStr == "---" of
True -> return (-1, states)
False -> return (i+1, states ++ [(i, stateInfo)])
-- Checks if input entry is over. Returns False if finished.
entryNotFinished (s, _)
| s == "--" || s == "---" = False
| otherwise = True
-- Takes the input state number along with the corresponding transitions.
-- Input ends when the user enters "--".
takeStateInfo (str, state_info) = do
myPutStr "\tEnter transitions symbol: "
symbol <- getLine
if symbol == "--" || symbol == "---" then
return (symbol, state_info)
else do
myPutStr "\t\tEnter the transition state number: "
state' <- getLine
let state = read state' :: Int
return (str, (symbol, state):state_info)
Basically this is how it runs:
*Main> x <- inputTransitionTable
Type -- for next state and --- for completing input entering.
Adding transitions to state 0:
Enter transitions symbol: a
Enter the transition state number: 1
Enter transitions symbol: b
Enter the transition state number: 2
Enter transitions symbol: --
Adding transitions to state 1:
Enter transitions symbol: a
Enter the transition state number: 2
Enter transitions symbol: b
Enter the transition state number: 3
Enter transitions symbol: --
Adding transitions to state 2:
Enter transitions symbol: a
Enter the transition state number: 3
Enter transitions symbol: --
Adding transitions to state 3:
Enter transitions symbol: --
Adding transitions to state 4:
Enter transitions symbol: ---
(0.03 secs, 344420 bytes)
-- Output
*Main> prettyPrintTransitionTable x
State Transitions
0 ("b",2) ("a",1)
1 ("b",3) ("a",2)
2 ("a",3)
3
Is there a better way to do this?
It could be as simple as this, if you add the "deriving Read" declarations and don't care about interaction.
main = do
allInput <- getContents -- scarfs all stdin up to eof
let inLines = lines allInput
let (tableLines, _:otherlines) = break (== "endtable") inLines
let table = ((read $ unlines tableLines) :: TransitionTable)
-- process otherlines here
As others have suggested, for a tasks related to parsing you should look at Parsec. While I have no experience with it, I can still suggest an alternative way of writing your parsing application.
module Main where
import Control.Monad (liftM)
computeTransitions :: [String] -> [(Int, [(String, Int)])]
computeTransitions is = foldl folder [] is
where
getState states = if null states then (0, []) else last states
getTransition transitions = if null transitions then 0 else (snd $ head transitions)
prepend state transition = let (c, ts) = state in (c, transition:ts)
swapLastState states state = if null states then [state] else init states ++ [state]
folder states i =
let currentState = getState states
currentTransition = getTransition (snd currentState)
in case i == "--" of False -> swapLastState states (prepend currentState (i, currentTransition + 1))
True -> states ++ [((fst currentState) + 1, [])]
main = do
inputLines <- liftM (takeWhile (/="---")) (liftM lines getContents)
let result = computeTransitions inputLines
mapM_ (\(s, t) -> putStrLn $ show s ++ "\t" ++ show t) result
I don't know if in your requirements was to print out the intermediary messages, but the computation of the transitions can be transformed to a fold operation (or foldM if you want to print intermediary messages); and instead of the "while" loop I've used the takeWhile function lifted to the Monadic space (so I can apply it on the type IO [String]).
Also note that getContents is lazy in evaluation, and in combination with lines will perform as a "while read line".
Edit:
With #pat's suggestion (and what hlint came up with), here is the refactored version:
module Main where
import Control.Monad (liftM)
computeTransitions :: [String] -> [(Int, [(String, Int)])]
computeTransitions = foldl folder []
where
getState [] = (0, [])
getState states = last states
getTransition [] = 0
getTransition ((_, t):_) = t
prepend (c,ts) transition = (c, transition:ts)
swapLastState [] state = [state]
swapLastState states state = init states ++ [state]
folder states i =
let currentState = getState states
currentTransition = getTransition (snd currentState)
in if i == "--"
then states ++ [(fst currentState + 1, [])]
else swapLastState states (prepend currentState (i, currentTransition + 1))
main = do
inputLines <- liftM (takeWhile (/="---") . lines) getContents
mapM_ (\(s, t) -> putStrLn $ show s ++ "\t" ++ show t) (computeTransitions inputLines)
If m2 and m are equal I want to do an IO operation (send out some stuff over the network) that returns nothing and update my map. I have crafted the following code and wonder (1) if this can be refactored into something less clunky (2) why my case expression that should send out the messages does not get evaluated or at least no messages do get send.
If I uncomment the code at the bottom then things do get send as I want to, but of course it is then send out disregarding what the value of m2 is.
main = withSocketsDo $ do
s <- socket AF_INET Datagram defaultProtocol
(q, m) <- newRq
let m2 = appendMsg "first" key m
_ = case m2 of
val | m2 == m -> do let Just messages = Map.lookup ("192.168.1.1", 4711) m in sendq s (B.pack $ unwords messages) "192.168.1.1" 4711
(q4, m4) = case m2 of
val | m2 == m -> deleteRec key q m2
| otherwise -> (q, m2)
--let Just messages = Map.lookup ("192.168.1.1", 4711) m
--sendq s (B.pack $ unwords messages) "192.168.1.1" 4711
I know that _ is not defined for all cases where m2 and m are not equal, but sendq returns IO () and I could not think of something sensible to add here for | otherwise -> that would return the same type.
The two lines of code starting with _ = case m2 of do exactly nothing! This is because the bound value _ never gets evaluated, because it is not used (or even mentioned) anywhere else.
What you are looking for is, I guess, the function when from Control.Monad. It has type Monad m => Bool -> m () -> m(); you could use it as follows:
when (m == m2) (send the messages ...)
but you would have to use it outside the let block, i.e. as part of the main do expression.
One more thing, your code:
(q4, m4) = case m2 of
val | m2 == m -> deleteRec key q m2
| otherwise -> (q, m2)
can be simplified to:
(q4, m4) = if (m2 == m) then deleteRec key q m2 else (q, m2)