R/object.R

In LeiLi-Uchicago/Cookie: An sampling method to select representative samples from large population

#' The Cookie Data object Class
#'
#' The Cookie Data object is used to store the all the data, process and results.
#'
#' @slot raw.data Raw data frame
#' @slot factor.type Types of factor
#' @slot normalize.data Normalized data frame
#' @slot dist.matrix Distance matrix
#' @slot reduction A list of dimmensional reduction objects for this object
#' @slot sample.size.test A list of sample size initial test for this object
#' @slot samplings A list of sampling results
#' @slot version  Version of Cookie this object was built under
#'
#' @name Cookie-class
#' @rdname Cookie-class
#' @exportClass Cookie
#'
Cookie <- setClass(
  Class = "Cookie",
  slots = list(
    raw.data = "data.frame",
    factor.type = "vector",
    normalize.data = "data.frame",
    dist.matrix = "matrix",
    reduction = "list",
    sample.size.test = "list",
    samplings = "list",
    version = "character"
  )
)

#' The Dimmension Reduction Class
#'
#' The DimReduction object stores a dimension reduction result generated by t-SNE, UMAP or MDS
#'
#' @slot embedding Embeddings data frame (required)
#' @slot method Method this embedding was built under
#'
#' @name DimReduction-class
#' @rdname DimReduction-class
#' @exportClass DimReduction
#'
DimReduction <- setClass(
  Class = 'DimReduction',
  slots = c(
    embedding = 'matrix',
    method = 'character'
  )
)


#' The Sample Size Test Class
#'
#' The SampleSizeTest object stores a dimension reduction result generated by t-SNE, UMAP or MDS
#'
#' @slot prime.factor Prime factor (if determined)
#' @slot coverage Coverage on each factor under different sample size
#' @slot selection Sample selected under different sample size
#'
#' @name SampleSizeTest-class
#' @rdname SampleSizeTest-class
#' @exportClass SampleSizeTest
#'
SampleSizeTest <- setClass(
  Class = 'SampleSizeTest',
  slots = c(
    prime.factor = 'character',
    coverage = 'data.frame',
    selection = 'data.frame'
  )
)


#' The Sampling Class
#'
#' The Sampling object stores a dimension reduction result generated by t-SNE, UMAP or MDS
#'
#' @slot prime.factor Prime factor (if determined)
#' @slot important.factor Important factor
#' @slot size Size
#' @slot sampling Sample selected under different sample size
#'
#' @name Sampling-class
#' @rdname Sampling-class
#' @exportClass Sampling
#'
Sampling <- setClass(
  Class = 'Sampling',
  slots = c(
    prime.factor = 'character',
    important.factor = 'character',
    size = 'numeric',
    sampling = 'data.frame',
    coverage = 'data.frame',
    coveragecc = 'data.frame'
  )
)


#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Functions
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#' Create a Cookie object
#'
#' Create a Cookie object from a data frame
#'
#' @param data Data frame of raw data.
#' @param factor.type Types of each factor. Can be "char","num"
#'
#' @importFrom utils packageVersion
#' @export
#'
#'
createCookieObject <- function(
  data = NULL,
  factor.type = NULL
) {
  if(!is.null(data) && !is.null(factor.type)) {
    if(length(factor.type) != dim(data)[2]) {
      stop("The length of factor.type is nit equal to factors in data!")
    }

    types <- unique(factor.type)
    unrecognize <- setdiff(types, c("char","num"))
    if(length(unrecognize) > 0) {
      cat("Unrecognized type!",unrecognize[1],"Please check you input!\n")
      stop()
    }

    # convert data format to "character" for all char factors to accelerate the distance calculation
    for (i in 1:length(factor.type)) {
      if(factor.type[i] %in% c("char")){
        data[,i] <- as.character(data[,i])
      } else {
        data[,i] <- as.numeric(data[,i])
      }
    }

    object <- new(
      Class = 'Cookie',
      raw.data = data,
      factor.type = factor.type,
      normalize.data = data.frame(),
      dist.matrix = matrix(),
      reduction = list(),
      sample.size.test = list(),
      samplings = list(),
      version = as.character(packageVersion(pkg = 'Cookie'))
    )
  } else {
    stop("Please provide data and factor type")
  }

  return(object)
}


#' Create a DimReduction object
#'
#' Create a DimReduction object from a data frame
#'
#' @param embedding Data frame of raw data.
#' @param method Method generate this embedding, could be t-SNE, UMAP or MDS
#'
#' @export
#'
#'
createDimReductionObject <- function(
  data = NULL,
  method = NULL
) {
  if(!is.null(data) && !is.null(method)) {
    object <- new(
      Class = 'DimReduction',
      embedding = data,
      method = method
    )
  } else {
    stop("Please provide data and method")
  }
  return(object)
}


#' Create a SampleSizeTest object
#'
#' Create a SampleSizeTest object from a data frame
#'
#' @param prime.factor Prime factor
#' @param coverage Coverage
#' @param selection Method generate this embedding, could be t-SNE, UMAP or MDS
#'
#' @export
#'
#'
createSampleSizeTestObject <- function(
  prime.factor = NULL,
  coverage = NULL,
  selection = NULL
) {
  object <- new(
    Class = 'SampleSizeTest',
    prime.factor = prime.factor,
    coverage = coverage,
    selection = selection
  )
  return(object)
}


#' Create a Sampling object
#'
#' Create a Sampling object from a data frame
#'
#' @param prime.factor Prime factor
#' @param important.factor Important factors
#' @param size Sample size
#' @param coverage Coverage
#' @param sampling Sampling results
#'
#' @export
#'
#'
createSamplingObject <- function(
  prime.factor = NULL,
  important.factor = NULL,
  size = NULL,
  sampling = NULL,
  coverage = NULL,
  coveragecc = NULL
) {
  object <- new(
    Class = 'Sampling',
    prime.factor = prime.factor,
    important.factor = important.factor,
    size = size,
    sampling = sampling,
    coverage = coverage,
    coveragecc = coveragecc
  )
  return(object)
}