Writing a Turing Machine in Haskell

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.

Setting up the project

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

Modelling the machine

To model the machine we're going to add code to Turing.hs

State

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:

• The start state which is the state it starts in
• The halt state which is the state it finishes in

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 Tape

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]

Instructions

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:

• A new state to put the machine into
• Aa new symbol to write to the current position on a tape
• An indication of whether to move the tape forward a square, back a square or to keep it in the same place.

data PositionShift = Backwards | Forwards | Stay deriving (Show)

data Instruction = Instruction { 
    stateToMatch :: State, 
    symbolToMatch :: Symbol, 
    newState :: State, 
    newSymbol :: Symbol, 
    positionShift :: PositionShift 
} deriving (Show)

The Machine

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 Logic

The first part of the logic of our Turing machine is to:

• Look at its current state
• If it's in a halted state, end the program
• If not we try and see if there is an instruction we can process.

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
    }

Looking for an instruction

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)

Applying an instruction

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

Creating a new machine

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
    }

Testing it

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

Understanding the machine

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:

• reads the input replacing the 1s and 0s with blanks until it reaches a blank square (the end of the input)
• reverses the tape until it gets to the start,
• moves forward one square, write 1 to the tape and halts Toucan Over 100 word limit We’re working to increase this limit and keep load times short. In the meantime, try highlighting up to 100 words at one time to translate. Don’t show again

Comments

[E.R. Nurwijayadi]

I do not get it.

where is the output?