Skip to content

Instantly share code, notes, and snippets.

@jakubfijalkowski jakubfijalkowski/PDA.fsx
Last active Jan 26, 2016

Embed
What would you like to do?
Turing machine (basic model) & PDA simulation in F#, with some examples
open System
type State = int
type StackSymbol = char
type Symbol = char
let toString = List.toArray >> String
let second f (a, b) = (a, f b)
let safeTail = function | [] -> [] | _ :: rest -> rest
let toChars (s : string) = s.ToCharArray() |> Array.toList
[<Literal>]
let StackGuard = '?'
[<Literal>]
let InputGuard = '#'
type TransitionFunc = (State * StackSymbol * Symbol) -> (State * string)
let runPDA (input : string) (f : TransitionFunc) debug =
let rec run state (stack : StackSymbol list) (input : Symbol list) =
let inputSymbol = defaultArg (List.tryHead input) InputGuard
let stackSymbol = defaultArg (List.tryHead stack) StackGuard
if debug then printf "%c%s%d%s%c; " StackGuard (toString stack) state (toString input) InputGuard
let stack' = safeTail stack
let input' = safeTail input
let state', stackAdd = f (state, stackSymbol, inputSymbol)
let stackNew = (toChars stackAdd |> List.rev) @ stack'
if debug then printfn "%A -> %A" (state, stackSymbol, inputSymbol) (state', stackAdd)
if state' < 0 then
(state', stackNew)
else
run state' stackNew input'
run 0 [] (toChars input)
let REJ = -1, ""
let ACC = -2, ""
let equalZeroOneCount = function
| 0, 'a', 'a' -> 0, "aa"
| 0, 'b', 'a' -> 0, ""
| 0, '?', 'a' -> 0, "a"
| 0, 'a', 'b' -> 0, ""
| 0, 'b', 'b' -> 0, "bb"
| 0, '?', 'b' -> 0, "b"
| 0, 'a', '#' -> REJ
| 0, 'b', '#' -> REJ
| 0, '?', '#' -> ACC
| s -> failwith ("Invalid state: " + string s)
let checkLang input =
runPDA input equalZeroOneCount false |> fst = -2
checkLang "aabbaabba"
open System
type State = int
type Symbol = char
type Move = L | R
[<Literal>]
let EmptySymbol = '.'
[<Literal>]
let GuardSymbol = '#'
type TransitionFunc = State * Symbol -> State * Symbol * Move
let toString = List.toArray >> String
let second f (a, b) = (a, f b)
let safeTail = function | [] -> [] | _ :: rest -> rest
let toChars (s : string) = s.ToCharArray() |> Array.toList
let skipWhileRight f = List.rev >> List.skipWhile f >> List.rev
let turingMachineInternal (left' : char list) (right' : char list) (f : TransitionFunc) debug =
let rec run state left right : (int * char list * char list) =
let symbol = defaultArg (List.tryHead right) EmptySymbol
if debug then printf "%s%d%s; %A " (List.rev left |> toString) state (skipWhileRight ((=) EmptySymbol) right |> toString) (state, symbol)
let state', symbol', move = f (state, symbol)
if debug then printfn "-> %A" (state', symbol', move)
if state' < 0 then
(state', left, symbol' :: safeTail right)
else
let left', right' =
match move with
| L -> (List.tail left, List.head left :: symbol' :: safeTail right)
| R -> (symbol' :: left, safeTail right)
run state' left' right'
let stateResult, left, right = run 0 left' right'
let rightResult = right |> List.takeWhile ((<>) EmptySymbol)
let leftResult = left |> (if List.isEmpty rightResult then List.skipWhile ((=) EmptySymbol) else id) |> List.rev
(stateResult, leftResult @ rightResult)
let turingMachine (input : string) (f : TransitionFunc) debug =
turingMachineInternal [] (toChars input) f debug |> second toString
let turingMachineWithGuard (input : string) (f : TransitionFunc) debug =
turingMachineInternal ['#'] (toChars input) f debug |> second toString
let REJ = -1, '.', R
let ACC = -2, '.', R
// f(n, m) = max 0 (n - m), for every natural (>= 0) n and m
let subTransFunc = function
| 0, 'n' -> 2, '#', R
| 0, 'm' -> 1, '.', R
| 0, '.' -> -1, '.', R
| 1, 'm' -> 1, '.', R
| 1, '.' -> -1, '.', R
| 2, 'n' -> 2, 'n', R
| 2, 'm' -> 3, 'n', R
| 2, '.' -> 10, '.', L
| 3, 'm' -> 3, 'm', R
| 3, '.' -> 4, '.', L
| 4, 'n' -> 5, 'n', L
| 4, 'm' -> 4, 'm', L
| 4, '.' -> 12, '.', R
| 5, 'n' -> 5, 'n', L
| 5, '.' -> 6, '.', R
| 5, '#' -> 6, '#', R
| 6, 'n' -> 7, '.', R
| 7, 'n' -> 7, 'n', R
| 7, 'm' -> 8, 'm', R
| 7, '.' -> 14, '?', L
| 8, 'm' -> 8, 'm', R
| 8, '.' -> 9, '.', L
| 9, 'm' -> 4, '.', L
| 10, 'n' -> 10, 'n', L
| 10, '#' -> -1, 'n', R
| 12, 'm' -> 12, '.', R
| 12, '.' -> 13, '.', L
| 13, '.' -> 13, '.', L
| 13, '#' -> -1, '.', R
| 14, 'n' -> 14, 'n', L
| 14, '.' -> 15, '.', R
| 15, 'n' -> 16, '.', L
| 15, '?' -> 19, '.', L
| 16, 'n' -> 17, 'n', R
| 16, '.' -> 16, '.', L
| 16, '#' -> 18, 'n', R
| 17, '.' -> 18, 'n', R
| 18, 'n' -> 16, '.', L
| 18, '.' -> 18, '.', R
| 18, '?' -> -1, '.', R
| 19, '.' -> 19, '.', L
| 19, '#' -> -1, '.', R
| s -> failwith ("Invalid state: " + string s)
let sub a b =
let _, result = turingMachine (String('n', a) + String('m', b)) subTransFunc false
result.Length
// Language of the form a^i b^j c^k, k = max i j (w/o spaces)
let langAcc = function
| 0, 'a' -> 0, 'a', R
| 0, 'b' -> 1, 'b', R
| 0, 'c' -> 2, 'c', R
| 0, '.' -> ACC
| 1, 'a' -> REJ
| 1, 'b' -> 1, 'b', R
| 1, 'c' -> 2, 'c', R
| 1, '.' -> REJ
| 2, 'a' -> REJ
| 2, 'b' -> REJ
| 2, 'c' -> 2, 'c', R
| 2, '.' -> 3, '?', L
| 3, 'a' -> 5, '.', R
| 3, 'b' -> 3, 'b', L
| 3, 'c' -> 3, 'c', L
| 3, '#' -> 4, '#', R
| 4, 'b' -> 6, '.', R
| 4, 'c' -> REJ
| 4, '?' -> REJ
| 5, 'a' -> 5, 'a', R
| 5, 'b' -> 6, '.', R
| 5, 'c' -> 7, '.', L
| 5, '.' -> 5, '.', R
| 5, '?' -> REJ
| 6, 'b' -> 6, 'b', R
| 6, 'c' -> 7, '.', L
| 6, '.' -> 6, '.', R
| 6, '?' -> REJ
| 7, 'a' -> 5, '.', R
| 7, 'b' -> 7, 'b', L
| 7, '.' -> 7, '.', L
| 7, '#' -> 8, '#', R
| 8, 'b' -> 9, '.', R
| 8, 'c' -> REJ
| 8, '.' -> 8, '.', R
| 8, '?' -> ACC
| 9, 'b' -> 9, 'b', R
| 9, 'c' -> 10, '.', L
| 9, '.' -> 9, '.', R
| 9, '?' -> REJ
| 10, 'b' -> 9, '.', R
| 10, '.' -> 10, '.', L
| 10, '#' -> 8, '#', R
| s -> failwith ("Invalid state: " + string s)
let checkLang input =
turingMachineWithGuard input langAcc false |> fst = -2
sub 999 10
checkLang "aaacccc"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.