sketch of interacting R6 classes for simple ABM

ABM_sketch_R6.R

#################################################################
#
#   MASH
#   R6-ified
#   How to nest interacting classes
#   Hector Sanchez & Sean Wu
#   May 9, 2017
#
#################################################################

library(R6)

creatureMale <- R6Class(classname = "creatureMale",
                 portable = TRUE,
                 cloneable = FALSE,
                 lock_class = FALSE,
                 lock_objects = FALSE,

                 # public members
                 public = list(

                   initialize = function(myID){
                     private$myID = myID
                     private$state = 1L # 1: alive, 0: dead
                   },

                  #  modifiers & accessors

                  GetMyState = function(){
                    return(private$state)
                  },
                  
                  GetMyID = function(){
                    return(private$myID)
                  },

                  GetMyMate = function(){
                    return(private$myMate)
                  },

                  ChangeMyMate = function(myMate){
                    private$myMate = myMate
                  }

                 ),

                 # private members
                 private = list(

                   myID = NULL,
                   state = NULL,
                   myMate = NULL

                 )
)

creatureFemale <- R6Class(classname = "creatureFemale",
                 portable = TRUE,
                 cloneable = FALSE,
                 lock_class = FALSE,
                 lock_objects = FALSE,

                 # public members
                 public = list(

                   initialize = function(myID){
                     private$myID = myID
                     private$state = 1L # 1: alive, 0: dead
                   },

                   # female creatures mate and the ID of who mated with who is recorded
                   mate = function(males){
                    myOptions = sapply(males,function(x){
                      if(is.null(x$GetMyMate())){
                        return(x$GetMyID())
                      }
                    })
                    myOptions = Reduce(f = c,x = myOptions)
                    # myMate = sample(x = myOptions,size = 1L)
                    myMate = myOptions[sample(x = length(myOptions),size = 1L)]
                    private$myMate = myMate
                    males[[myMate]]$ChangeMyMate(myMate = private$myID) # mating exchange of ID is reciprocal
                   },
                   
                   #  modifiers & accessors
                   
                   GetMyState = function(){
                     return(private$state)
                   },
                   
                   GetMyID = function(){
                     return(private$myID)
                   },
                   
                   GetMyMate = function(){
                     return(private$myMate)
                   },
                   
                   ChangeMyMate = function(myMate){
                     private$myMate = myMate
                   }

                 ),

                 # private members
                 private = list(

                   myID = NULL,
                   state = NULL,
                   myMate = NULL

                 )
)

creaturePopulation <- R6Class(classname = "creaturePopulation",
                 portable = TRUE,
                 cloneable = FALSE,
                 lock_class = FALSE,
                 lock_objects = FALSE,

                 # public members
                 public = list(

                   initialize = function(nF, nM){

                     private$males = vector(mode="list",length=nM)
                     private$females = vector(mode="list",length=nF)

                     for(m in 1:nM){
                       private$males[[m]] = creatureMale$new(myID = m)
                     }
                     for(f in 1:nF){
                       private$females[[f]] = creatureFemale$new(myID = f)
                     }
                     
                     private$nM = length(private$males)
                     private$nF = length(private$females)
                     
                   },
                   
                   allFmate = function(){
                     nF = length(private$females)
                     for(f in 1:nF){
                       private$females[[f]]$mate(private$males)
                     }
                   },
                   
                   getFemaleMates = function(){
                     # browser()
                     out = vector(mode="list",length=private$nF)
                     for(f in 1:private$nF){
                       out[[f]] = private$females[[f]]$GetMyMate()
                     }
                     return(out)
                   },
                   
                   getMaleMates = function(){
                     # browser()
                     out = vector(mode="list",length=private$nM)
                     for(m in 1:private$nM){
                       out[[m]] = private$males[[m]]$GetMyMate()
                     }
                     return(out)
                   }

                 ),

                 # private members
                 private = list(

                   nM = NULL,
                   nF = NULL,
                   males = NULL,
                   females = NULL

                 )
)

xx = creaturePopulation$new(nF=100,nM=100)
xx$allFmate()
Reduce(x = xx$getFemaleMates(),f = c)
length(Reduce(x = xx$getFemaleMates(),f = c))
sum(duplicated(Reduce(x = xx$getFemaleMates(),f = c)))
Reduce(x = xx$getMaleMates(),f = c)
length(Reduce(x = xx$getMaleMates(),f = c))
sum(duplicated(Reduce(x = xx$getMaleMates(),f = c)))