R/model_dataset_R6.R

In EntirelyDS/modelr: R6 Class Library For Generic Modelling

# R6 Model Dataset class
#' @export
ModelDataset <- R6::R6Class("ModelDataset",
  public = list(
    initialize = function(name, dataset_opts, get_f, split_f){
      if (check_opts(dataset_opts, 'dataset', 'ModelDataset')){
        private$dataset_options <- dataset_opts
      }else{
        private$dataset_options <- list()
      }
      required_args <- c('dataset_opts', 'io_opts')
      if (
        check_method(get_f, required_args, 'get_f', 'get', 'ModelDataset')
      ){
        private$get_fn <- get_f
      }else{
        private$get_fn <- function(dataset, io_opts, ...) return(list())
      }
      required_args <- c('dataset', 'dataset_opts')
      if (
        check_method(
          split_f, required_args, 'split_f', 'split', 'ModelDataset'
        )
      ){
        private$split_fn <- split_f
      }else{
        private$split_fn <- function(dataset, dataset_opts, ...) return(list())
      }
      notify_success('ModelDataset')
      invisible(self)
    },
    print = function(){
      print(
        list(
          "dataset_opts" = private$dataset_options,
          "get" = private$get_fn,
          "split" = private$split_fn,
          "fit_data" = head(fit_data),
          "test_data" = head(test_data),
          "predict_data" = head(predict_data)
        )
      )
    },
    get = function(io_opts, ...){
      private$full_data <- private$get_fn(self$dataset_opts, io_opts, ...)
      invisible(self)
    },
    split = function(){
      split_data <- private$split_fn(private$full_data, self$dataset_opts, ...)
      private$fit_data <- split_data$fit
      private$test_data <- split_data$test
      private$predict_data <- split_data$predict
      invisible(self)
    }
  ),
  active = list(
    dataset_opts = function(dataset_options){
      if (missing(dataset_options)){
        return(private$dataset_options)
      }else{
        if (check_opts(dataset_options, 'dataset', 'ModelDataset', init=FALSE)){
          private$dataset_options <- dataset_options
        }
      }
    },
    get_f = function(get_fn){
      if (missing(get_fn)){
        return(private$get_fn)
      }else{
        required_args <- c('dataset_opts', 'io_opts')
        if (
          check_method(
            get_fn, required_args, 'get_f', 'get', 'ModelDataset', FALSE
          )
        ){
          private$get_fn <- get_fn
        }
      }
     },
    split_f = function(split_fn){
      if (missing(split_fn)){
        return(private$split_fn)
      }else{
        required_args <- c('dataset', 'dataset_opts')
        if (
          check_method(
            split_fn, required_args, 'split_f', 'split', 'ModelDataset', FALSE
          )
        ){
          private$split_fn <- split_fn
        }
      }
    },
    data = function(){
      return(private$full_data)
    },
    fit = function(){
      return(private$fit_data)
    },
    test = function(){
      return(private$test_data)
    },
    predict = function(){
      return(private$predict_data)
    }
  ),
  private = list  (
    dataset_options = list(),
    full_data = NA,
    fit_data = NA,
    test_data = NA,
    predict_data = NA,
    get_fn = NA,
    split_fn = NA
  )

)