Model is not retrieved correctly from mongodb

Question

I have an R script which creates a model, serialize it and store it in a models collection inside a test mongo database:

library(mongolite)

mongo_host="localhost"
mongo_port=27017
url_path = sprintf("mongodb://%s:%s", mongo_host, mongo_port)  
mongo_database="test"

mongo_collection <- "models"  
mongo_con<-mongo(collection = mongo_collection
                 ,url = paste0(url_path,"/",mongo_database))

mySerializationFunc<-function(value){
  return (base64enc::base64encode(serialize(value, NULL,refhook = function(x) "dummy value")))
}

myUnserializationFunc<-function(value){
 return (unserialize(value,refhook = function(chr) list(dummy = 0L)))
}


insertDocumentIntoCollection <- function(connection,object) {
  str<-paste0('{"modelName": "',object$modelName,'", "objectModel" :',paste0('{"$binary":{"base64":"',mySerializationFunc(object$objectModel),'","subType": "0"}}}'))
  connection$insert(str)
}

getDocumentFromCollection<-function(connection,modelName){
 
 strConditions=paste0('{"modelName":"',modelName,'"}')
 strSelect=paste0('{"objectModel":true,"_id":false}')
 return(connection$find(query=strConditions,fields=strSelect))
}

modelName<-"irisTestAll"

lst<-list()
lst$modelName<-modelName
lst$objectModel<-randomForest::randomForest(as.formula("Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width"),iris)

# Store the model in mongoDB
insertDocumentIntoCollection(mongo_con,lst) 

Then, I can retrieve the model, unserialize it and perform predictions:

# Retrieve the model
mdl<-getDocumentFromCollection(mongo_con,modelName)

# By using "mdl[[1]][[1]]" we get allways the first model
mdl<-myUnserializationFunc(mdl[[1]][[1]])

predict(mdl,iris)

Now, I have created the shiny version of the creation of the model (exactly the same code):

library(shiny)
library(mongolite)

mongo_host="localhost"
mongo_port=27017
url_path = sprintf("mongodb://%s:%s", mongo_host, mongo_port)  
mongo_database="test"
mongo_collection <- "models"  

mongo_con<-mongo(collection = mongo_collection
                 ,url = paste0(url_path,"/",mongo_database))

mySerializationFunc<-function(value){
  return (base64enc::base64encode(serialize(value, NULL,refhook = function(x) "dummy value")))
}

insertDocumentIntoCollection <- function(connection,object) {
  str<-paste0('{"modelName": "',object$modelName,'", "objectModel" :',paste0('{"$binary":{"base64":"',mySerializationFunc(object$objectModel),'","subType": "0"}}}'))
  connection$insert(str)
}

ui <- fluidPage(
  actionButton("aa","Generate model")
)

server <- function(input, output, session){
  observeEvent(input$aa,{
    lst<-list()
    lst$modelName<-"irisTestAll"
    lst$objectModel<-randomForest::randomForest(as.formula("Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width"),iris)
    
    # Store the model in mongoDB
    insertDocumentIntoCollection(mongo_con,lst)    
    
  })
}

shinyApp(ui, server)

The app seems to work fine, however when I retrieve the model (model stored using the app) from mongo to perform predictions:

modelName<-"irisTestAll"
# Retrieve the model
mdl<-getDocumentFromCollection(mongo_con,modelName)

# By using "mdl[[1]][[1]]" we get allways the first model
mdl<-myUnserializationFunc(mdl[[1]][[1]])

predict(mdl,iris)

I get this error:

Error in eval(predvars, data, env) : 
  invalid 'enclos' argument of type 'list'

So, it seems that storing from R console works fine but fails when it is done using shiny. Any idea how to solve it? Thanks.

Answer 1

The issue is neither with shiny nor with mongodb, it's with serialization / deserialization.

Upon de-serializing the randomForest model object, the environment contains a dummy value:

mdl <- getDocumentFromCollection(mongo_con,modelName)
mdl <- myUnserializationFunc(mdl[[1]][[1]])

attr(mdl$terms, ".Environment")
# $dummy
# [1] 0

which leads to prediction error:

predict(mdl, newdata=iris)
# Error in eval(predvars, data, env) : 
# invalid 'enclos' argument of type 'list'

Let's replace the environment properly (modify the myUnserializationFunc()?) and the prediction will work fine:

attr(mdl$terms, ".Environment") <- .GlobalEnv

attr(mdl$terms, ".Environment") # check
# <environment: R_GlobalEnv>

# now predict
predict(mdl, newdata=iris)
#        1        2        3        4        5        6        7        8   ...
# 5.102515 4.766670 4.666158 4.804332 5.055100 5.382859 4.891974 5.051596   
# ...