R/stateMachine.R

In emiruz/automata.r: Flexible state machine builder and associated tools for R

require(magrittr)
#source("sys-utils.R")

automata.state.class <- "automata.r.state"

INIT <- function(parallel=F) {
  state <- list()
  state$automata <- list()
  state$parallel <- parallel
  state
}

BEGIN_AUTOMATA <- function(state, name, startAt, log=T) {
  automata <- list()
  automata$startAt <- startAt
  automata$log <- log
  automata$name <- name
  automata$states <- list()
  state$currentAutomataName <- name
  attr(automata, "class") <- automata.state.class
  state$automata[[name]] <- automata
  state
}

END_AUTOMATA <- function(state) {
  state$currentAutomataName <- NULL
  state
}

VAR <- function(state, name, value) {
  if(is.null(state$currentAutomataName)) stop("Need BEGIN_AUTOMATA first.")
  state$automata[[state$currentAutomataName]][[name]] <- value
  state
}

STATE <- function(state, name, as=function(s)s, when=function(s)T, failOnError=F) {
  if(is.null(state$currentAutomataName)) stop("Need BEGIN_AUTOMATA first.")
  stateNode <- state$automata[[state$currentAutomataName]]$states[[name]]
  if (is.null(stateNode$definitions)) stateNode$definitions <- list()
  stateNode$name <- name
  stateNode$definitions[[NROW(stateNode$definitions)+1]] <- list(name=name,as=as,when=when, failOnError=failOnError)
  state$automata[[state$currentAutomataName]]$states[[name]] <- stateNode
  state
}

TRANSITION <- function(state, from, to, when=function(s)T, onError=F) {
  if(is.null(state$currentAutomataName)) stop("Need BEGIN_AUTOMATA first.")
  stateNode <- state$automata[[state$currentAutomataName]]$states[[from]]
  if (is.null(stateNode$transitions)) stateNode$transitions <- list()
  stateNode$transitions[[NROW(stateNode$transitions)+1]] <- list(name=to, when=when, onError=onError)
  state$automata[[state$currentAutomataName]]$states[[from]] <- stateNode
  state
}

EXEC <- function(state) {
  LOG.info("ENGINE STARTED")
  for (automata in state$automata) {
     if(is.null(automata$states[[automata$startAt]])) stop (paste("Can't find start state for", automata$name))
     state$automata[[automata$name]]$currentNode <- automata$states[[automata$startAt]]
  }
  active  <- 1; while(active > 0) {
    active <- 0
    for (automata in state$automata) {
      if (is.null(automata$currentNode)) next
      active <- active + 1
      foundDef <- F
      for(def in automata$currentNode$definitions) {
        if (!def$when(automata)) next
        foundDef <- T
        LOG.info("FOUND DEF", automata$name, automata$currentNode$name)
        error <- F
        automata <- tryCatch(LOG.exec(paste("STATE", automata$name, automata$currentNode$name),
                                      def$as, automata), error=function(e) {
                                          error <<- T
                                          automata
                                      })
        if (attr(automata,"class") != automata.state.class) {
            error <- T
            LOG.error(automata$name, automata$currentNode$name,
                      "Object returned from state was not automata state.")
        }
        transitions <- automata$currentNode$transitions
        if (error && def$failOnError) {
            automata$currentNode <- NULL
            next
        }
        automata$currentNode <- NULL
        foundTrans <- F
        for(trans in transitions) {
          if (error && !trans$onError) next
          if (!trans$when(automata)) next
          foundTrans <- T
          automata$currentNode <- automata$states[[trans$name]]
          break
        }
        if (!foundTrans) LOG.info("AUTOMATA STOP", "No valid transitions found.")
        state$automata[[automata$name]] <- automata
        break
      }
      if (!foundDef) {
        LOG.info("NO VALID DEF FOUND", automata$name, automata$currentNode$name)
        state$automata[[automata$name]]$currentNode <- NULL
      }
    }
  }
}

# INIT() %>%
#   BEGIN_AUTOMATA("automata1","start") %>% 
#   VAR("avar",1235) %>%
#     STATE("start", as=function(s)s, when=function(s)T) %>%
#     STATE("middle", as=function(s){print(s) ;s}, when=function(s)T) %>%
#     STATE("end", as=function(s){Sys.sleep(1);s}, when=function(s)T) %>%
#     TRANSITION("start","middle", function(s)T) %>%
#     TRANSITION("middle","end", function(s)T) %>%
#     TRANSITION("end","start", function(s)T) %>%
#   END_AUTOMATA %>%
#   BEGIN_AUTOMATA("automata2","start") %>% VAR("avar",1235) %>%
#   STATE("start", as=function(s)s, when=function(s)T) %>%
#   STATE("middle", as=function(s){print(s$avar) ;s}, when=function(s)T) %>%
#   STATE("end", as=function(s){Sys.sleep(1);s}, when=function(s)T) %>%
#  TRANSITION("start","middle", function(s)T) %>%
#   TRANSITION("middle","end", function(s)T) %>%
#   TRANSITION("end","start", function(s)T) %>%
#   END_AUTOMATA %>%
EXEC