State Pattern

Part of the Object Oriented Programming section of Coddy's R journey. Lesson 48 of 57.

An object in the state pattern behaves differently depending on its current state. Each state is a list of handler functions, and the object passes every request to the handlers of the state it is in:

states <- list(
  green = list(label = "go", next_state = "yellow"),
  yellow = list(label = "slow down", next_state = "red"),
  red = list(label = "stop", next_state = "green")
)
current <- "green"
for (i in 1:4) {
  cat(current, ":", states[[current]]$label, "\n")
  current <- states[[current]]$next_state
}

Output:

green : go 
yellow : slow down 
red : stop 
green : go

Handlers take an event and return the next state and a reply, so the transitions are data rather than a chain of ifs. A turnstile unlocks when a coin is inserted and locks again after someone passes:

states <- list(
  locked = list(
    coin = function() list(to = "unlocked", say = "unlocked"),
    push = function() list(to = "locked", say = "blocked")
  ),
  unlocked = list(
    coin = function() list(to = "unlocked", say = "already open"),
    push = function() list(to = "locked", say = "welcome")
  )
)
current <- "locked"
for (event in c("push", "coin", "coin", "push")) {
  r <- states[[current]][[event]]()
  current <- r$to
  cat(event, "->", r$say, "\n")
}

Output:

push -> blocked 
coin -> unlocked 
coin -> already open 
push -> welcome

The machine itself is a small closure: it holds the current state, looks up the handler, and answers ignored for an event the state does not know:

make_machine <- function(states, start) {
  current <- start
  list(
    handle = function(event) {
      h <- states[[current]][[event]]
      if (is.null(h)) return("ignored")
      r <- h()
      current <<- r$to
      r$say
    },
    state = function() current
  )
}
states <- list(off = list(press = function() list(to = "on", say = "light on")),
               on = list(press = function() list(to = "off", say = "light off")))
m <- make_machine(states, "off")
for (e in c("press", "kick", "press")) cat(e, ":", m$handle(e), "|", m$state(), "\n")

Output:

press : light on | on 
kick : ignored | on 
press : light off | off

A new state is a new entry in the list. The machine does not change, and only the states that lead to the new one need a new handler:

states <- list(
  off = list(press = function() list(to = "on", say = "on")),
  on = list(press = function() list(to = "off", say = "off"),
            overheat = function() list(to = "broken", say = "fuse blown")),
  broken = list(repair = function() list(to = "off", say = "repaired"))
)
current <- "off"
for (e in c("press", "overheat", "press", "repair")) {
  h <- states[[current]][[e]]
  if (is.null(h)) { cat(e, ": ignored\n"); next }
  r <- h()
  current <- r$to
  cat(e, ":", r$say, "\n")
}

Output:

press : on 
overheat : fuse blown 
press : ignored
repair : repaired

Challenge

Easy

Complete the turnstile in Turnstile.R. The list states has the states locked and unlocked, and each handler returns list(to = ..., say = ...):

locked: coin unlocks with unlocked; push stays locked with blocked;
unlocked: coin stays unlocked with thanks, already open; push locks with welcome and counts one pass.

Then complete make_turnstile(), which starts locked and returns handle(event) (the reply, or ignored for an unknown event), state() and passes(). Count a pass whenever push is handled in the unlocked state. The supplied code reads events and prints each reply with the new state, then the passes.

Your code goes in Turnstile.R. main.R holds the supplied input/output code and cannot be edited.

Try it yourself

source("Turnstile.R")

# Supplied input/output code: keep it as it is
input <- suppressWarnings(readLines(file("stdin")))
t <- make_turnstile()
for (event in input) cat(event, ": ", t$handle(event), " [", t$state(), "]\n", sep = "")
cat("passes: ", t$passes(), "\n", sep = "")