R/defineOrdinalScaleMethod.R

In miquelcaceres/VegX: Vegetation data in Veg-X

#' Ordinal scale method definition
#'
#' A general function to define a method for measurements in an ordinal scale of a given subject.
#'
#' @param name String with the name of the method.
#' @param description String describing the method.
#' @param subject A string to identify the subject (e.g. 'plant cover').
#' @param codes A character vector of ordinal class codes.
#' @param citationString A string with the bibliographic reference for the method.
#' @param DOI A string with the DOI the resource related to \code{citationString}.
#' @param quantifiableCodes A string vector with the subset of \code{codes} that have correspondence in a quantitative scale. These codes
#' can be transformed to midPoints (if supplied in \code{midPoints}) and, correspondingly, codes in the quantitative scale can be transformed to ordinal codes
#' using class limits (if supplied in \code{breaks}).
#' @param breaks A vector of break points (for ordinal scales with class limits)
#' @param midPoints A vector of class midpoints (for ordinal scales that can be translated into quantitative values)
#' @param definitions A character vector of class definitions.
#'
#' @return an object of class \code{\linkS4class{VegXMethodDefinition}}
#'
#' @family define measurement functions
#'
#' @examples
#'
#' #Ordinal scale with three levels
#' defineOrdinalScaleMethod("scale1", "Description for scale1", "subject1",
#'                    codes = c("first", "second","third"))
#'
#' #Braun-Blanquet plant cover scale with five levels that can be translated to cover codes
#' defineOrdinalScaleMethod(name = "Braun-Blanquet",
#'                    description = "Five-level Braun-Blanquet cover scale",
#'                    subject = "plant cover",
#'                    codes = as.character(1:5),
#'                    quantifiableCodes = as.character(1:5),
#'                    breaks = c(0,5,25,50,75,100),
#'                    midPoints = c(2.5,17.5, 37.5, 62.5, 87.5))
#'
#'
#' #Ordinal plant cover scale with seven levels where six can be translated to a quantitative scale
#' defineOrdinalScaleMethod(name = "Recce cover scale",
#'                    description = "Recce recording method by Hurst/Allen",
#'                    subject = "plant cover",
#'                    citation = "Hurst, JM and Allen, RB. (2007) 
#'                         The Recce method for describing New Zealand vegetation – Field protocols. 
#'                         Landcare Research, Lincoln.",
#'                    codes = c("P","1","2","3", "4", "5", "6"),
#'                    quantifiableCodes = c("1","2","3", "4", "5", "6"),
#'                    breaks = c(0, 1, 5, 25, 50, 75, 100),
#'                    midPoints = c(0.05, 0.5, 15, 37.5, 62.5, 87.5),
#'                    definitions = c("Presence", "<1%", "1-5%","6-25%", "26-50%", 
#'                                    "51-75%", "76-100%"))
#'
defineOrdinalScaleMethod<-function(name, description, subject, codes,
                             citationString = "",
                             DOI = "",
                             quantifiableCodes = character(0),
                             breaks = NULL,
                             midPoints = NULL,
                             definitions = NULL) {
  nvals = length(codes)
  attributes = vector("list", nvals)

  if(!is.null(breaks)) if(length(breaks)!= (length(quantifiableCodes)+1)) stop("'breaks' has to have a length equal to the length of 'quantifiableCodes' plus one.")
  if(!is.null(midPoints)) if(length(midPoints)!= length(quantifiableCodes)) stop("'midPoints' has to be of the same length as 'quantifiableCodes'.")
  if(sum(quantifiableCodes %in% codes)< length(quantifiableCodes)) stop("'quantifiableCodes' has to be a subset of 'codes'")

  if(!is.null(definitions)) if(length(definitions)!= length(codes)) stop("'definitions' has to be of the same length as 'codes'.")

  cnt = 1
  for(i in 1:nvals) {
    attributes[[i]] = list(type = "ordinal",
                           code = codes[i],
                           order = i)
    if(!is.null(definitions)) attributes[[i]]$definition = definitions[[i]]
    if(codes[i] %in% quantifiableCodes) {
      if(!is.null(breaks)) {
        attributes[[i]]$lowerLimit = breaks[cnt]
        attributes[[i]]$upperLimit = breaks[cnt+1]
      }
      if(!is.null(midPoints)) {
        attributes[[i]]$midPoint = midPoints[cnt]
      }
      cnt = cnt + 1
    }
  }

  names(attributes) = 1:nvals
  return(new("VegXMethodDefinition",
             name = name,
             description = description,
             citationString = citationString,
             DOI = DOI,
             subject = subject,
             attributeType = "ordinal",
             attributes = attributes))
}