R/parameter_dimension.R

In philliplab/modgenTester: Test and reporting for modgen models with R

#' Gets the TypeID of a parameter dimension
#' @param parameterID ID of the parameter the dimension is of.
#' @param position The position of the dimension in the table
#' @param channel Connection to the Access database
#' @export

get_PD_typeID <- function(parameterID, position, channel){
  stopifnot(as.integer(parameterID) == parameterID)  
  stopifnot(as.integer(position) == position)  
  x <- sqlQuery(channel, paste("select TypeID from ParameterDimensionDic where ParameterID = ", 
                               parameterID, " and DisplayPosition = ", position,  sep = ""))
  if (nrow(x) == 0){stop("Parameter dimension does not exist")}
  if (nrow(x) != 1){stop("More than one dimension matches given name")}
  return(x$TypeID[1])
}

#' Gets the description of a Type
#' @param typeID ID of the type whose description is required.
#' @param channel Connection to the Access database
#' @param type_description_table_name Name of the table containing the type description
#' @export

get_typeID_description <- function(typeID, channel, type_description_table_name){
  stopifnot(as.integer(typeID) == typeID)  
  x <- sqlQuery(channel, paste("select Description from ", type_description_table_name, 
                               " where TypeID = ", typeID, sep = ""))
  if (nrow(x) == 0){stop("Type does not exist in supplied table")}
  if (nrow(x) != 1){stop("More than one type matches given ID")}
  return(as.character(x$Description[1]))
}

#' The PDim Class
#' Describes a classification dimension
#' 
#' @rdname PDim
#' @aliases PDim-class
#' @exportClass PDim

.PDim <- setClass(
  Class = "PDim",
  representation = representation(
    parameterID = 'numeric',
    position = 'numeric',
    description = 'character',
    typeID = 'numeric',
    lookup_table_name = 'character',
    type_description_table_name = 'character',
    lookup = 'data.frame'
  ),
  validity = function(object){
    if (object@parameterID != as.integer(object@parameterID)){
      stop('parameterID must be an integer')
    }
    if (object@typeID != as.integer(object@typeID)){
      stop('typeID must be an integer')
    }
    if (object@position != as.integer(object@position)){
      stop('position must be an integer')
    }
    return(TRUE)
  }
)

#' Constructs a parameter dimension object
#' @param parameterID ID of the parameter the dimension is of.
#' @param position The positioin of the dimension in the table
#' @param channel Connection to the Access database
#' @export

new_ParameterDimension <- function(parameterID, position, channel){
  typeID <- get_PD_typeID(parameterID, position, channel)
  type_description_table_name <- get_typeID_description_table_name(typeID, channel)  
  description <- get_typeID_description(typeID, channel, type_description_table_name)
  lookup_table_name <- get_typeID_lookup_table_name(typeID, channel)
  lookup <- get_typeID_lookup(typeID, channel)
  return(.PDim(parameterID = parameterID,
              type_description_table_name = type_description_table_name,
               position = position,
               description = description,
               typeID = typeID,
               lookup_table_name = lookup_table_name,
               lookup = lookup
               ))
}