Skip to content

Instantly share code, notes, and snippets.

@jakubfijalkowski
Last active January 26, 2016 18:44
Show Gist options
  • Save jakubfijalkowski/2e8c5c46c6f44a33141f to your computer and use it in GitHub Desktop.
Save jakubfijalkowski/2e8c5c46c6f44a33141f to your computer and use it in GitHub Desktop.
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