R/ndr_container.R

In emeyers/NeuroDecodeR: Decode Information from Neural Activity

# The purpose of the ndr_container class is to make the NDR package work with
# the pipe operator (|>). These container functions should never be called
# directly, but instead NDR containers should be generated by constructors of NDR
# objects in order to allow one to build up a full decoding analysis using the
# pipe (|>) operator.




# The constructor for an ndr_container
ndr_container <- function(ndr_object = NULL) {
  
  ndr_container <- list(ds = NULL, fp = NULL, cl = NULL, rm = NULL)
  
  attr(ndr_container, "class") <- "ndr_container"
  
  if (!is.null(ndr_object)){
    ndr_container <- add_ndr_object(ndr_container, ndr_object)
  }
  
  ndr_container
  
}







# A function that is used to make the NDR package work with the pipe operator.
# This function is used in the constructor of NDR objects (i.e., DS, FP, CL, RM
# and CV objects) to either return the NDR object, or to add it to a ndr
# container.
#
# This function takes two arguments:
#  1. ndr_container_or_object: which is either an NDR object or an ndr_container
#  2. ndr_object: which is an NDR object 
#
# Depending on the argument types, it does the following:
# a. if ndr_container_or_object is NULL, then it returns the ndr_object
# b. if ndr_container_or_object is an NDR object, then it add it and the
#    ndr_object to a new container
# c. if ndr_container_or_object is a NDR container, then it adds the ndr_object
#    to the container.

put_ndr_object_in_container <- function(ndr_container_or_object, ndr_object) {
  
  if (is.null(ndr_container_or_object)) {
    
    return(ndr_object)
    
  } else if (class(ndr_container_or_object)[1] == "ndr_container") {
    
    # if a ndr container was passed as an argument, add the classifer to this container
    return(add_ndr_object(ndr_container_or_object, ndr_object))
    
    
  } else  { 
    
    # check to make sure the ndr_container_or_object is a valid ndr object
    test_valid_ndr_object(ndr_container_or_object)
    
    the_ndr_container <- ndr_container()
    the_ndr_container <- add_ndr_object(the_ndr_container, ndr_container_or_object)
    the_ndr_container <- add_ndr_object(the_ndr_container, ndr_object)
    
    return(the_ndr_container)
    
  }
  
}







# A helper method to add an ndr object to an ndr container
add_ndr_object <- function(ndr_container, ndr_object) {
  
  # get the first two characters of the class name
  ndr_class_type <- get_ndr_object_type(ndr_object)
  
  
  # create a vector that can map the short ndr object names to their longer names 
  # this will be used for error messages
  ndr_object_full_names <- c("datasource", "feature-preprocessor", "classifier", 
                             "result metric", "cross-validator")
  names(ndr_object_full_names) <- c("ds", "fp", "cl", "rm", "cv")
  
  
  # test that the ndr_object passed to this function is a valid NDR object
  test_valid_ndr_object(ndr_object)
  
  
  curr_ndr_container_contents <- ndr_container[[ndr_class_type]]
  
  
  # check that no DS/CL/CV already exists in the container
  # if they do already exist, give a warning that they exist 
  if ((ndr_class_type == "ds") || (ndr_class_type == "cl") || (ndr_class_type == "cv")) {
    
    if (!is.null(curr_ndr_container_contents)) {
      warning(paste0("A ", ndr_object_full_names[ndr_class_type], " has already ",
      "been set in the ndr container. Overwritting the previously set ",
      ndr_object_full_names[ndr_class_type], "."))
    }
    
    # add the DS/CL/CV to the container and overwrite any DS/CL/CV that already has been set
    ndr_container[[ndr_class_type]] <- ndr_object
    
  }  else if ((ndr_class_type == "fp") || (ndr_class_type == "rm"))  {

    
    # if current contents are empty add the ndr_object, otherwise append it to objects
    # that have already been set
    if (is.null(curr_ndr_container_contents)) {
      
      ndr_container[[ndr_class_type]] <- list(ndr_object)
      
    } else {
      ndr_container[[ndr_class_type]] <- c(curr_ndr_container_contents, list(ndr_object))
    }
    
  }
    
    # return the container
    ndr_container
    
}