# You will probably not be eaten by a grue

Michael Droste tweeted

Should I use Stata, R, Matlab, Julia, etc etc for my research? What #econtwitter WON’T tell you is that all of these share a fatal flaw: you can’t play Oregon Trail on them… … At least, until now! Now you can play Oregon Trail (1978) in Stata.

That’s clearly a challenge that any sensible R programmer would ignore. However, it does fit into an idea I’ve been thinking about for a while. If you have a script in SAS or SPSS that reads in and formats a complicated data set, how can you use that in R? One answer is to translate the script to R, but that’s a lot of work – every time. A better answer would be to write either a translator or an interpreter that runs the script.

So, in the Oregon Trail case, rather than following the Python version and Stata version in reimplementing the code, I decided to write an interpreter for a small subset of BASIC and use it to run the original code.

library(OregonTrail)
play()

I have not tested all the BASIC code paths, but I think I have tested all the R code paths, so it’s possible that it works.

### Interpreting BASIC

The necessary interpreter is fairly small – it’s almost a finite-state machine; you could think of it as a finite-state machine with an oracle for arithmetic expressions. It’s here. A particular advantage of this approach is that the 1970s use of GOTO in BASIC is trivial to interpret, but a bit of a pain to either translate to R code or understand and re-implement.

The main tricky part was that BASIC uses parentheses both for array access and for function calls, and uses = to test for equality. In order to use R’s eval as the oracle for arithmetic, I had to rewrite BASIC arithmetic expressions into R syntax. This is the same sort of task as rewriting R arithmetic syntax into SQL for my sqlsurvey package and RStudio’s dbplyr.

The basic evaluation loop is this function

step<-function(state){
thisline<-basic[state$counter] thiscmd<-command[state$counter]
state<-switch(thiscmd,
GOTO=GOTO(thisline, state),
GOSUB=GOSUB(thisline, state),
RETURN=RETURN(thisline, state),
DATA=basic_DATA(thisline, state),
RESTORE=RESTORE(thisline, state),
PRINT=basic_PRINT(thisline, state),
INPUT=INPUT(thisline,state),
LET=LET(thisline,state),
IF =basic_IF(thisline, state),
ON = ON(thisline,state),
QUIT={state$finished<-TRUE; state}, END={state$finished<-TRUE; state},
DIM = basic_DIM(thisline,state),
assignment(thisline,state)
)

state
}

where advance is the function that goes to the next line.

### Now you have two problems

There are a lot of regular expressions. Here, working out the target of GOTO

GOTO<-function(thisline, state){
tolineno<-as.numeric(gsub("^.*GOTO[[:blank:]]([0-9]+)","\\1",thisline)[1])
codeline<-which(lineno==tolineno)
if(length(codeline)!=1)
stop(paste("GOTO considered harmful:",thisline))
state$counter<-codeline state } and much more messily, to work out the target and value of an assignment assignment<-function(thisline, state){ expr<-gsub("^[0-9]* ","",thisline) target<-trimws(gsub("(.+)=.+","\\1",expr)) target<-gsub("$","_",target,fixed=TRUE)

value_expr<-trimws(gsub(".+=(.+)","\\1",expr))
value_expr<-    gsub("$","_",value_expr,fixed=TRUE) value_expr<-rewrite(parse(text=value_expr)[[1]]) target_expr<-rewrite(parse(text=target)[[1]]) state$variables<-eval(bquote(within(state$variables, .(target_expr)<-.(value_expr)))) if(state$debug) print(state\$variables)
}

### Parsing arithmetic

The only part of this that isn’t a finite-state machine is the evaluation of logical and arithmetic expressions, which needs a stack, both for the rewriting and for R’s eval to evaluate the code (as seen in the code for assignment above)

rewrite<-function(expr){
if (length(expr)==2){
if (expr[[1]] == as.name("TAB") ||
expr[[1]] == as.name("RND") ||
expr[[1]] == as.name("CLK")||
expr[[1]] == as.name("INT") ||
expr[[1]] == as.name("(") ||
expr[[1]] == as.name("-"))
{
expr[[2]]<-rewrite(expr[[2]])
return(expr)
} else{
expr[[2]]<-rewrite(expr[[2]])
expr<-bquote(.(expr[[1]])[.(expr[[2]])])
return(expr)
}
}

if (length(expr)==1){
if (expr==as.name("=")) expr<-as.name("==")
return(expr)
}

## length=3
expr[[1]]<-rewrite(expr[[1]])
expr[[2]]<-rewrite(expr[[2]])
expr[[3]]<-rewrite(expr[[3]])
return(expr)
}