Aspiring Physicist. Studying a Maths and Philosophy degree at Durham and trying to fix payroll at Onfolk. Previously building a better bank at Monzo.
by Charles Thomas
As I’ve been learning Quantum Computing, I’ve had to learn some Computer Science along the way. One of the concepts I’d heard of but I hadn’t understood until recently was that of a Turing Machine.
To understand what a Turing Machine was, I decided to write one in Haskell.
To follow along with this project the first thing you’ll need to do is get Haskell installed. To do this visit this page. And follow the instructions there to install Haskell and Cabal (the Haskell package manager)
Once, you’ve installed Haskell, we need to set up the directory structure we’ll be using (take a look at this Github repo for reference). Create a directory called TuringMachineHaskell. This will be the root of our project.
Inside that directory create a folder called src. Then src/Setup.hs and add:
import Distribution.Simple
main = defaultMain
Also inside the src directory create a file called Turing.hs. This is where most of our code will live and add this at the top of the file:
module Turing where
Outside of src but still inside TuringMachineHaskell create the file TuringMachineHaskell.cabal. Add the following code to set up the tests:
cabal-version: 2.4
-- Initial package description 'TuringMachineHaskell.cabal' generated by
-- 'cabal init'. For further documentation, see
-- http://haskell.org/cabal/users-guide/
-- The name of the package.
name: TuringMachineHaskell
-- The package version. See the Haskell package versioning policy (PVP)
-- for standards guiding when and how versions should be incremented.
-- https://pvp.haskell.org
-- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
version: 0.1.0.0
-- A short (one-line) description of the package.
-- synopsis:
-- A longer description of the package.
-- description:
-- A URL where users can report bugs.
-- bug-reports:
-- The license under which the package is released.
license: NONE
-- The file containing the license text.
license-file: LICENSE
-- The package author(s).
author:
-- An email address to which users can send suggestions, bug reports, and
-- patches.
maintainer:
-- A copyright notice.
-- copyright:
-- category:
-- Extra files to be distributed with the package, such as examples or a
-- README.
extra-source-files: CHANGELOG.md
executable TuringMachineHaskell
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
-- Modules included in this executable, other than Main.
-- other-modules: Turing
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
-- Other library packages from which modules are imported.
build-depends: base ^>=4.14.3.0
-- Directories containing source files.
hs-source-dirs: src
-- Base language which the package is written in.
default-language: Haskell2010
To model the machine we’re going to add code to Turing.hs
The first thing a Turing Machine has is a series of states it can move between. In our case, are two special states we need to make a note of:
We are going to represent these and 3 other generic states with the following line:
data State = Halt | StartState | A | B | C deriving (Eq, Show)
The next thing a Turing machine has is a tape and on each square on the tape is a symbol. Let’s represent this as:
data Symbol = Start | Zero | One | Blank deriving (Eq, Show)
type Tape = [Symbol]
A Turing machine also has a list of instructions. In a Turing Machine, the instructions have 5 main parts.
The first two parts of the instructions are a symbol and a state. They are used to work out if we should apply an instruction. If the current state of the Turing machine and the current symbol on the tape match these two, then the instruction is applied.
The three parts of instructions are used when that instruction is applied:
data PositionShift = Backwards | Forwards | Stay deriving (Show)
data Instruction = Instruction {
stateToMatch :: State,
symbolToMatch :: Symbol,
newState :: State,
newSymbol :: Symbol,
positionShift :: PositionShift
} deriving (Show)
Now we can represent the Turing machine itself. We need to keep track of it all the states it could be in, its current state, the tape and the current position on the tape and the instructions.
data TuringMachine = TuringMachine {
states :: [State],
currentState :: State,
tape :: Tape,
currentPosition :: Int,
instructions :: [Instruction]
} deriving (Show)
The first part of the logic of our Turing machine is to:
runMachine :: TuringMachine -> TuringMachine
runMachine machine
| (currentState machine) == Halt = machine
| otherwise = runMachine (machineCycle machine)
Here the machineCycle handles trying to find an instruction to run, if it finds one, it runs it, otherwise it sets the machine to the Halt state.
machineCycle :: TuringMachine -> TuringMachine
machineCycle machine =
case instructionToApply of
Just instruction -> applyInstruction machine instruction
Nothing -> haltMachine machine
where instructionToApply = findInstructionToApply machine (instructions machine)
haltMachine :: TuringMachine -> TuringMachine
haltMachine machine =
TuringMachine {
states = states machine,
currentState = Halt,
tape = tape machine,
currentPosition = currentPosition machine,
instructions = instructions machine
}
To find an instruction to apply it recursively searches the list of instructions:
findInstructionToApply :: TuringMachine -> [Instruction] -> Maybe Instruction
findInstructionToApply machine instructions
| null instructions = Nothing
| shouldApplyInstruction machine (instructions !! 0) = Just (instructions !! 0)
| otherwise = findInstructionToApply machine (tail instructions)
If the instructions array is empty it returns 0, otherwise, it checks the first instruction in the list. If it should be applied it returns it. Otherwise, it calls itself with the remaining instructions.
To determine if an instruction should be applied we use this function. It compares the current state and symbol of the machine to the instruction
shouldApplyInstruction :: TuringMachine -> Instruction -> Bool
shouldApplyInstruction machine instruction =
(currentState machine == stateToMatch instruction) && (currentSymbol machine == symbolToMatch instruction)
currentSymbol :: TuringMachine -> Symbol
currentSymbol machine = (tape machine) !! (currentPosition machine)
Now we need a function to apply the instruction when we’ve found one:
applyInstruction :: TuringMachine -> Instruction -> TuringMachine
applyInstruction machine instruction =
TuringMachine {
states = states machine,
currentState = newState instruction,
tape = newTape (tape machine) (currentPosition machine) (newSymbol instruction),
currentPosition = getNewPosition (machine) (positionShift instruction),
instructions = instructions machine
}
-- Given a tape, a position in the tape to update and a symbol it creates a new tape
newTape :: Tape -> Int -> Symbol -> Tape
newTape tape position newSymbol =
take (position) tape ++ newSymbol : drop (position+1) tape
-- This takes a position and a shift and returns a new position
getNewPosition :: TuringMachine -> PositionShift -> Int
getNewPosition machine Forwards = (currentPosition machine) + 1
getNewPosition machine Stay = (currentPosition machine)
getNewPosition machine Backwards
| (currentPosition machine) == 0 = 0
| otherwise = (currentPosition machine) - 1
Finally, we have a helper that creates a new Turing with an infinite tape:
newTuringMachine :: Tape -> [Instruction] -> TuringMachine
newTuringMachine tape instructions = TuringMachine{
states = [Halt, StartState, A, B, C],
currentState = StartState,
tape = [Start] ++ tape ++ repeat Blank,
currentPosition = 0,
instructions = instructions
}
We can create a test by creating a machine that always outputs one. Create a file called Main.hs inside src and add the code:
module Main where
import Turing
main :: IO ()
main = do
let myMachine = newTuringMachine [One, Zero, One] [
Instruction{stateToMatch = StartState, symbolToMatch=Start, newState = A, newSymbol = Start, positionShift = Forwards},
Instruction{stateToMatch = A, symbolToMatch=Zero, newState = A, newSymbol = Blank, positionShift = Forwards},
Instruction{stateToMatch = A, symbolToMatch=One, newState = A, newSymbol = Blank, positionShift = Forwards},
Instruction{stateToMatch = A, symbolToMatch=Blank, newState = B, newSymbol = Blank, positionShift = Backwards},
Instruction{stateToMatch = B, symbolToMatch=Blank, newState = B, newSymbol = Blank, positionShift = Backwards},
Instruction{stateToMatch = B, symbolToMatch=Start, newState = C, newSymbol = Start, positionShift = Forwards},
Instruction{stateToMatch = C, symbolToMatch=Blank, newState = Halt, newSymbol = One, positionShift = Stay}
]
print (take 10 (tape myMachine))
let outputMachine = runMachine myMachine
print (take 10 (tape outputMachine))
We can run this file by going inside TuringMachineHaskell in a terminal and running: cabal run
Let’s go through and understand what this Turing Machine does.
The first instruction takes the machine from the initial state into a state A and moves the tape forward once (to the first symbol of our input).
The next two instructions say while our machine is in state A replace any 1 or 0 with a blank and move the tape forward once.
The fourth instruction is when it reads its first blank. It sees a blank so we know we’re at the end of the input. So we put the machine into state B and moves the tape back one square. The instruction then says if we’re in state B which happens when we’ve processed the whole input. If we’re on a blank square go backwards. This will set up back the beginning of the tape.
The sixth instruction, says if in state B and can see a start symbol (e.g. we’re back at the start of the tape) then set the state to C and move forward one square.
The final instruction says to write one to the blank square and halt.
So in summary, this machine: