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
I'm trying to implement a PDA in Haskell based on my lecturer's notes, she has described the general process to us and left the actual function implementation up to us. I feel like I have the majority of it working bar one little bug in the nextsteps function.
The rules of the PDA are as follows:
[((1,"a",""),(1,"a")),((1,"b",""),(1,"b")),((1,"a",""),(2,"")),((1,"b",""),(2,"")),((1,"",""),(2,"")),((2,"a","a"),(2,"")),((2,"b","b"),(2,""))]
run :: PDA -> String -> Result
run _ "" = Reject
run (state,finalState,rules) str = findpath [(state,str,""(state,finalState,rules)
data Result = Accept | Reject deriving Show
type PDA = (Int,[Int],[Transition])
-- Takes in the start state, the current value read by the input string, the current stack and the new state along with the change to the stack
-- ((1,"a",""),(1,"a"))
type Transition = ((Int, String, String),(Int,String))
-- contains the current state, current input string and current state of the stack
-- (1,"abba","ba")
type Configuration = (Int, String, String)
--if the list of configurations isnt accepted, apply the PDA transitions to it and try again
findpath :: [Configuration] -> PDA -> Result
findpath [] pda = Reject
findpath (h:t) (a,b,c) = if accept (h:t) b == True then Accept else findpath (nextsteps (h:t) c) (a,b,c)
accept' :: Configuration -> [Int] -> Bool
accept' config [] = False
accept' (x,y,z) [a] = if x == a && y == "" && z == "" then True else False
accept:: [Configuration] -> [Int] -> Bool
accept [] _ = False
accept _ [] = False
accept (h:t) finalState = if accept' h finalState then True else accept t finalState
-- apply a given transition to a configuration based on the values in the configuration and transition
step :: Configuration -> Transition -> [Configuration]
step (a,b,"")((d,"",""),(g,"")) = if a == d then [(g,b,"")] else []
step (a,(b:bs),"")((d,"",""),(g,h)) = if a == d then [(g,bs,[b])] else []
step (a,(b:bs),"") ((d,"",f),(g,"")) = if a == d then [(g,(b:bs),f)] else []
step (a,(b:bs),"") ((d,"",f),(g,h)) = if a == d then [(g,(b:bs),h)] else []
step (a,(b:bs),"") ((d,[e],""),(g,"")) = if a == d && b == e then [(g,bs,"")] else []
step (a,(b:bs),"") ((d,[e],""),(g,h)) = if a == d && b == e then [(g,bs,[b])] else []
step (a,(b:bs),"") ((d,[e],f),(g,"")) = if a == d && b == e then [(g,bs,"")] else []
step (a,(b:bs),"") ((d,[e],f),(g,h)) = if a == d && b == e then [] else []
step (a,b,c) ((d,"",""),(g,"")) = if a == d then [(g,b,c)] else []
step (a,(b:bs),c) ((d,"",""),(g,h)) = if a == d then [(g,bs,c)] else []
step (a,b,(c:cs))((d,"",[f]),(g,"")) = if a == d && c == f then [(g,b,cs)] else []
step (a,b,(c:cs)) ((d,"",[f]),(g,h)) = if a == d && c == f then [(g,b,cs++h)] else []
step (a,(b:bs),c) ((d,[e],""),(g,"")) = if a == d then [(g,bs,c)] else []
step (a,(b:bs),c) ((d,[e],""),(g,h)) = if a == d && b == e then [(g,bs,[b]++c)] else []
step (a,(b:bs),(c:cs)) ((d,[e],[f]),(g,""))= if a == d && b == e && c == f then [(g,bs,cs)] else []
step (a,(b:bs),(c:cs)) ((d,[e],[f]),(g,h)) = if a == d && b == e && c == f then [(g,bs,cs++h)] else []
-- apply the entire ruleset of the PDA over one configuration and return a list of the results
steps :: Configuration -> [Transition] -> [Configuration]
steps config [] = []
steps (a,b,c) (h:t) = if b /= "" then step (a,b,c) h ++ steps (a,b,c) t else []
-- take in a list of configurations and apply the entire rulest over each configuration and return a list of results
nextsteps :: [Configuration] -> [Transition] -> [Configuration]
nextsteps config [] = []
nextsteps (h : t) rules = steps h rules ++ nextsteps t rules
The program works for certain strings and not others, I'm certain its to do with my nextsteps function. In my lecturer's notes she gives the example
nextsteps [(1,"bbabba","a"),(2,"abbabba",""),(2,"bbabba","") rules = [(1,"babba","ba"),(2,"babba","a"),(2,"bbabba","a")]
However, when I call the function on the exact same inputs I get [(1,"babba","ba"),(2,"babba","a"),(2,"babba","a"),(2,"bbabba","a")].
I'm not sure where this extra duplicate value is coming from and is the main reason why strings that shouldn't be excepted are getting accepted. I have tried removing the tail of the configurations list and only applying the steps function to the head of the list, and that will make sure any list that shouldn't be accepted is Rejected, but also Rejected inputs that should be Accepted.
I have a piece of Haskell code below. The problem is the clause (enigmaInput,_) = (filter (\(a,b) -> b == cipherChar0) stecker)!!0 will fail for the first 2 guards. How can I assign it for the last 2 guards only. Thanks!
followMenu :: Crib->Menu->Stecker->Offsets->Maybe Stecker
followMenu c [] s o = Just s
followMenu crib menu stecker offsets
| (length stecker) == 1 && initAdd == Nothing = Nothing
| (length stecker) == 1 && initAdd /= Nothing = followMenu crib (tail menu) (fromMb initAdd) offsets
| (length stecker) /= 1 && normalAdd == Nothing = Nothing
| otherwise = followMenu crib (tail menu) (fromMb normalAdd) offsets
where (_,_,cipherChar0) = crib!!(menu!!0)
(_,_,cipherChar1) = crib!!(menu!!1)
(enigmaInput,_) = (filter (\(a,b) -> b == cipherChar0) stecker)!!0
enigmaOutput = enigmaEncode enigmaInput (SimpleEnigma rotor3 rotor2 rotor1 reflector1) offsets
(_,initInput) = stecker!!0
initOutput = enigmaEncode initInput (SimpleEnigma rotor3 rotor2 rotor1 reflector1) offsets
(_,_,initCipher) = crib!!(menu!!0)
initAdd = steckerAdd initOutput initCipher stecker
normalAdd = steckerAdd enigmaOutput cipherChar1 stecker
You don't really need to, since (filter (\(a,b) -> b == cipherChar0) stecker)!!0 won't be evaluated until the value of enigmaInput is needed, and you don't use enigmaInput in the first two guard cases. This is a nice feature of lazy evaluation.
There is no way to attach a where clause to some but not all of a set of guarded equations, besides restructuring your pattern matches and guards of course.
I've written a TLA+ spec of the Towers of Hanoi problem:
TEX
ASCII
------------------------------- MODULE Hanoi -------------------------------
EXTENDS Sequences, Integers
VARIABLE A, B, C
CanMove(x,y) == /\ Len(x) > 0
/\ IF Len(y) > 0 THEN Head(y) > Head(x) ELSE TRUE
Move(x,y,z) == /\ CanMove(x,y)
/\ x' = Tail(x)
/\ y' = <<Head(x)>> \o y
/\ z' = z
Invariant == C /= <<1,2,3>> \* When we win!
Init == /\ A = <<1,2,3>>
/\ B = <<>>
/\ C = <<>>
Next == \/ Move(A,B,C) \* Move A to B
\/ Move(A,C,B) \* Move A to C
\/ Move(B,A,C) \* Move B to A
\/ Move(B,C,A) \* Move B to C
\/ Move(C,A,B) \* Move C to A
\/ Move(C,B,A) \* Move C to B
=============================================================================
The TLA Model checker will solve the puzzle for me when I specify the Invariant formula as an Invariant.
I want to make it a bit less verbose though, ideally I don't want to pass in the unchanged variable to Move(), but I can't figure out how. What I want to do is to write
Move(x,y) == /\ CanMove(x,y)
/\ x' = Tail(x)
/\ y' = <<Head(x)>> \o y
/\ UNCHANGED (Difference of and {A,B,C} and {y,x})
How can I express that in the TLA language?
Instead of variables A, B, C, you should have a single sequence, towers, where the towers are indexes. This would also have the advantage of being generic in the number of towers. Your Next formula would be shorter, too:
CanMove(i,j) == /\ Len(towers[i]) > 0
/\ Len(towers[j]) = 0 \/ Head(towers[j]) > Head(towers[i])
Move(i, j) == /\ CanMove(i, j)
/\ towers' = [towers EXCEPT ![i] = Tail(#),
![j] = <<Head(towers[i])>> \o #]
Init == towers = << <<1,2,3>>, <<>>, <<>> >> \* Or something more generic
Next == \E i, j \in DOMAIN towers: i /= j /\ Move(i, j)
Alternatively, if you want to continue using letters, you can use a record instead of a sequence for towers, and all you need to change in my suggested spec is:
Init == towers = [a |-> <<1, 2, 3>>, b |-> <<>>, c |-> <<>>]
So im still very new to programming and I'm struggling a lot with the Syntax of Haskell. I kind of know what I want to implement but im not really sure how to do it so I came here to ask.
So what I have is a "pile" of Numbers in no particular order that are defined by 3 different functions. An example for this would be:
lowestnumber = 4
highestnumber 5 = True
highestnumber _ = False
above 4 = 11
above 11 = 18
above 18 = 2
above 2 = 3
above 3 = 5
above 5 = error "highest Number"
above _ = error "Not part of the pile"
Now for one I want to write a function that checks if a certain number is part of this pile and a different function "sum' = " that sums up all the elements of the list without an input variable. First I solved these problems by defining a list and using listcommands in order to sum up and see if something is "elem" of that list but I am supposed to solve it without using lists.
So I have ideas of how to solve this but I have no idea of how to actually write it without receiving countless errors.
Some examples of what I've tried for the check function:
check x = if above x /= error "Not part of the stack" || lowestnumber == x then True else False
I also tried the checks with "_" like this but it wouldn't work either:
check x if above x == _ || lowestnumber == x then True else False
My idea for the sum function was this:
sum' = lowestnumber + above lowestnumber + above (above lowestnumber) + above (above (above lowestnumber))
or also something like
sum' = lowestnumber + (above sum')
Which I understand woul
and so on but I did not figure out how I could implement this using recursion which is apparently the way to go.
Well hopefully this question isnt too stupid! I hope you can help me :)
Edit: Ok, so these are the solutions to my 3 function-problems
sumup' a b
|highestNumber a == True = a+b
|otherwise = sumup' (above a) (a+b)
sumup = sumup' lowestNumber 0
check' a b
|a == b = True
|True == highestNumber a && a==b = True
|True == highestNumber a && a/=b = False
|check' (above a) (b) == True = True
|otherwise = False
check b = check' (lowestNumber) (b)
above' :: Integer -> Integer -> Bool
above' x y
| check x == False = False
| check y == False = False
| highestNumber y == True = False
| highestNumber x == True = True
| x==y = True
| above' x (above y) == True = True
| otherwise = False
If you want to do this without lists, keep a running total, and use recursion.
If you're at the highestnumber, just add that to your current total and stop,
otherwise, add the number to your total total + n and move on to the next one above n:
add n total |highestnumber n = total + n
|otherwise = add (above n) (total + n)
Then you can do
answer = add lowestnumber 0
You're supposed to do this without lists, well that's sad because it would be very much the idiomatic solution.
The nextmost idiomatic one would be something generic that is able to traverse your pile there. You basically want a fold over the numbers:
foldlMyPile :: (a -> Int -> a) -> a -> {- Pile -> -} a
foldlMyPile f = go lowestNumber
where go n accum
| highestNumber n = result
| otherwise = go (above n) result
where result = f accum n
Once you've got this, you can use it to define sum, element etc. much like they are defined on lists:
sumPile :: Int
sumPile = foldlMyPile (+) 0
elemPile :: Int -> Bool
elemPile n = foldlMyPile $ \alreadyFound n' -> alreadyFound || n==n'
Various higher order functions in Haskell capture various recursion (and corecursion†) patterns, like iterate, foldr, unfoldr, etc.
Here we can use until :: (a -> Bool) -> (a -> a) -> a -> a, where until p f x yields the result of iteratively applying f until p holds, starting with x:
sumPile = snd $
until (highestnumber . fst)
(\(a,b)->(above a, b + above a))
(lowestnumber, lowestnumber)
also,
inThePile p = p==until (\n-> highestnumber n || n==p) above lowestnumber
†basically, recursion with accumulator, building its result on the way forward from the starting case, whereas regular recursion builds its result on the way back from the base case.
About your three new functions.
sumup' a b
| highestNumber a == True = a+b
| otherwise = sumup' (above a) (a+b)
sumup = sumup' lowestNumber 0 -- sum up all numbers in the pile
this is almost exactly as in AndrewC'c answer. it is good, except == Temp is totally superfluous, not needed. sumup' also would usually be made an internal function, moved into a where clause. As such, it doesn't have to have a descriptive name. Some use (Scheme-inspired?) loop, some go (since do is a reserved syntax keyword). I personally started to use just g recently:
sumup = g lowestNumber 0 -- sum up all numbers in the pile
where
g n tot -- short, descriptive/suggestive var names
| highestNumber n = n + tot
| otherwise = g (above n) (n + tot)
check b = check' lowestNumber b -- don't need any parens here
check' a b
|a == b = True
|True == highestNumber a && a==b = True -- `True ==` not needed
|True == highestNumber a && a/=b = False -- `True ==` not needed
|check' (above a) (b) == True = True -- `== True` not needed
|otherwise = False
This usually would be written as
check' a b = (a == b) ||
(highestNumber a && a==b) ||
( not (highestNumber a && a/=b)
&& check' (above a) b )
in the 2nd test, if a==b were true, it'd already worked in the 1st rule, so we can assume that a/=b henceforth. so 2nd test is always false; and we get
check' a b = (a == b) ||
(not (highestNumber a) && check' (above a) b)
which is rather OK looking. It can be also written with guards again, as
check' a b | (a == b) = True
| highestNumber a = False
| otherwise = check' (above a) b
or, using short suggestive variable names, and with swapped order of arguments, for consistency,
check' n i | highestNumber i = i == n
| otherwise = i == n || check' n (above i)
which is rather similar to how the first, sumup code is structured.
Now, the third function. First of all, it can easily be defined in terms of check' too, just starting with the given low number instead of the lowest one:
higher top low = check low && not (highestNumber low)
&& check' top (above low)
("higher" is a more distinctive name, yes?). Your version:
higher :: Integer -> Integer -> Bool
higher x y
| check x == False = False -- not(check x == False) -- ==
| check y == False = False -- check x == True -- ==
| highestNumber y == True = False -- check x
| highestNumber x == True = True
| x==y = True
| higher x (above y) == True = True
| otherwise = False
again, simplifying,
higher x y = check x && check y
&& not (highestNumber y)
&& ( highestNumber x
|| x==y -- really?
|| higher x (above y) ) -- too strong
so this one seems buggy.
First I solved these problems by defining a list and using
listcommands in order to sum up and see if something is "elem" of that
list but I am supposed to solve it without using lists.
You can solve this by expanding elem, like so:
x `elem` [1,2,3]
is the same as
x == 1 || x == 2 || x == 3
And while your at it
sum' = 4 + 11 + 18 + 2 + 4 + 5
You could also construct a list of all your elements with something like
elements = takeUntil highestnumber (iterate above lowestnumber)
takeUntil p xs = foldr (\x r -> if p x then [x] else x:r) [] xs
This is the only way I see you can write your check and sum' functions without using constants.
we can't use takeWhile (not . highestnumber) because we'll miss the highest number. So, takeUntil must be defined this way to include the breaking element in its output.