R/class-skrmdb.r

In ABS-dev/skrmdb: Package to estimate ED50

#' Accessor to retrieve the numeric median effective dose from a skrmdb object
#'
#' This is an accessor function for retrieving the numeric value of the
#' effective median dose from a \code{\link{skrmdb-class}} object object
#' generated by \code{ReedMuench}, \code{SpearKarb}, or \code{DragBehr}.
#'
#' @param x class skrmdb.
#' @return the estimated ED50.
#' @examples
#' temp <- DragBehr(y=c(0, 3,5, 8, 10, 10), n=rep(10, 6), x=1:6)
#' getED(temp)
#' @export
getED <- function(x) {
  return(as.numeric(x$ed))
}

#' Accessor to retrieve the variance from a skrmdb object
#'
#' This is an accessor function for retrieving the numeric value of the variance
#' from a \code{\link{skrmdb-class}} object object generated by
#' \code{ReedMuench}, \code{SpearKarb}, or \code{DragBehr}.
#'
#' @param x class skrmdb.
#' @return the estimated variance.
#' @examples
#' temp <- DragBehr(y=c(0, 3,5, 8, 10, 10), n=rep(10, 6), x=1:6)
#' getvar(temp)
#' @export
getvar <- function(x) {
  return(as.numeric(x$var))
}

#' Accessor to retrieve the the data used in the call to create an skrmdb object
#'
#' This is an accessor function for retrieving the data used to compute the
#' effective median dose from a \code{\link{skrmdb-class}} object object
#' generated by \code{ReedMuench}, \code{SpearKarb}, or \code{DragBehr}.
#'
#' @param x class skrmdb.
#' @return a dataframe containing the sorted data.
#' @examples
#' temp <- DragBehr(y=c(0, 3,5, 8, 10, 10), n=rep(10, 6), x=1:6)
#' getdata(temp)
#' @export
getdata <- function(x) {
  return(as.data.frame(x$data))
}

#' @export
print.skrmdb <- function(x, ...) {
  if (length(x$ed) == 0) {
    cat("empty construct\n")
  } else {
    cat(paste("ED50 by the", x$eval, "method\n"))
    cat("ed:  ", signif(x$ed, digits = 3), "\n")
    if (x$eval == "Spearman-K\344rber") {
      cat(paste("var: ", signif(x$var, digits = 3), "\n"))
    }
    if (length(x$messages) > 0) {
      message(paste0(x$messages, collapse = "\n"))
    }
  }
  invisible(x)
}

#' Class definition for skrmdb object
#'
#' The skrmdb object holds output from functions in the skrmdb package. A valid
#' skrmdb object is a list whicn contains the followling components:
#'
#' @param eval Evaluation method. One of 'ReedMuench', 'SpearKarb', or
#'   'DragBehr'. character string.
#' @param ed Median effective dose by eval method. numeric.
#' @param var Variance (for Spearman-Kärber method only). numeric.
#' @param data The data used to compute the effective median dose. data.frame,
#'   numeric.
#' @param message Messages and warnings generated durning the calculation.
#'   character string.
#'
#' @name skrmdb-class
NULL


new_skrmdb <- function(eval = character(), A,
                       ed = numeric(),
                       var = NA_real_) {
  messages <- character()
  if (attr(A, "warning.increasing")) {
    messages <- c(messages, "Count trend is increasing with dilution.")
  } else {
    messages <- c(messages, "Count trend is decreasing with dilution.")
  }
  if (attr(A, "warning.duplicate")) {
    messages <- c(messages, "Duplicate dilutions found. Results combined.")
  }
  if (attr(A, "warning.uneven")) {
    messages <- c(messages, "Uneven dilution scheme.")
  }
  if (attr(A, "warning.monotonic")) {
    messages <- c(messages, "y is not monotonic. ED50 may be unreliable.")
  }
  if (attr(A, "warning.bracket")) {
    messages <- c(messages,
                  "Dilutions fail to bracket the midpoint. ED50 is unreliable.")
  }
  structure(list(eval = eval,
                 ed   = ed,
                 var  = var,
                 data = as.data.frame(A),
                 messages = messages),
            class = "skrmdb")
}