R/class.R

Defines functions valid valid2

#' A class type of discrete-time finite state space
#' Markov chain in stat2003 package.
#'
#' @param p   A numeric symmetric matrix. The transition matrix of the
#'   Markov chain. The rows must sum to 1.
#' @param p_start  A numeric vector. The initial distribution of the
#'   Markov chain. The rows must sum to 1 and has same dimension as p.
#' @param statespace  A character vector. The state space of the
#'   Markov chain. statespace must has same dimension as p.
#'
#' @seealso \code{\link{dmc_equi}} returns the equilibrium
#' distribution for a discrete-time Markov chain.
#' @seealso \code{\link{dmc_inv}} returns the invariant
#' distribution for a discrete-time Markov chain.
#' @seealso \code{\link{dmc_simu}} simulates a discrete-time Markov chain
#' by returning one possible sequence and a states against steps plot.
#' @seealso \code{\link{dmc_tp}} can calculate transient probabilities at a
#' specific step, and also can give a graph about transient probabilities
#' from step zero to that specific step.
#' @seealso \code{\link{dmc_irreclass}} focuses on irreducible classes for
#' a given discrete-time Markov chain
#' @seealso \code{\link{dmc_period}} returns the period of each state for
#' a given discrete-time Markov chain
#'
#' @examples
#'
#'
#' m <- matrix(c(1, 0, 0, 0, 0, 0,
#'               1/4, 0, 3/4, 0, 0, 0,
#'               0, 1/2, 0, 1/2, 0, 0,
#'               0, 0, 1/2, 0, 1/3, 1/6,
#'               0, 0, 0, 0, 1/4, 3/4,
#'               0, 0, 0, 0, 1/3, 2/3), nr = 6, nc=6, byrow = TRUE)
#' A <- new("stat2003.d", p_start = c(0, 0, 0, 1, 0, 0), p = m,
#'         statespace = c("1", "2", "3", "4", "5", "6") )
#'
#'
#'@export
setClass("stat2003.d", slots = c(p_start = "vector", p = "matrix",
                               statespace = "character"))

valid <- function(object) {

  for (i in 1 : nrow(object@p)) {
    if (sum(object@p[i,]) != 1)  stop("sum of row of p not equal to 1 !")
  }

  if (nrow(object@p) != ncol(object@p)) {
    paste("p must be a square matrix!")
  } else if (any(object@p < 0 | object@p > 1)) {
    paste("All elements of p must be lie in [0,1]")
  } else if (nrow(object@p) != NROW(object@p_start)) {
    paste("p_start must be have same dimension as p!")
  } else if (any(object@p_start < 0 | object@p_start > 1)) {
    paste("All elements of p_start must be lie in [0,1]")
  } else if (sum(object@p_start) != 1) {
    paste("sum of row of p_start not equal to 1 !")
  } else if (nrow(object@p) != NROW(object@statespace)) {
    paste("statespace must be have same dimension as p!")
  } else {
    TRUE
  }
}

setValidity("stat2003.d", valid)


#' A class type of linear birth-death in stat2003 package.
#'
#' @param lb  A numeric scalar and it is the rate of linear Birth.
#' If the Markov chaindoesn't contain linear Birth, setting lb to zero.
#' Default value of lb is zero.
#' @param ld  A numeric scalar and it is the rate of linear Death.
#' If the Markov chain doesn't contain linear Death, setting ld to zero.
#' Default value of ld is zero.
#' @param im  A numeric scalar and it is the rate of Immigration.
#' If the Markov chain doesn't contain Immigration, setting im to zero.
#' Default value of im is zero.
#' @param em  A numeric scalar and it is the rate of Emigration.
#' If the Markov chain doesn't contain Emigration, setting em to zero.
#' Default value of em is zero.
#' @param nstate An integer. Size of statespace of this Birth-death process,
#‘ if it has infinity state space, setting nstate to zero.
#’ Default value of nstate is zero.
#'
#' @seealso \code{\link{bd_equi}} will return the equilibrium
#' distribution of a birth-death process
#' @seealso \code{\link{bd_rate}} will return the generator matrix by
#' given birth-death rates for a linear birth death process.
#' @seealso \code{\link{bd_trans}} will return the transition matrix by
#' given birth-death rates for a linear birth death process.
#' @seealso \code{\link{bd_simu}} simulates a finite statespace Birth-death
#' process by returning a plot about states and time.
#'
#'
#' @examples
#' A <- new("stat2003.bd", lb = 1, ld = 1, im = 3, em = 4,
#' nstate = 0)
#'
#'
#'@export
setClass("stat2003.bd", slots = c(lb = "numeric", ld = "numeric",
                                  im = "numeric", em = "numeric",
                                  nstate = "numeric"),
         prototype = list(lb = 0, ld = 0, im = 0, em = 0,
                          nstate = 0))

valid2 <- function(object) {

  if (object@lb < 0) {
    paste("lb must greater or equal to zero.")
  } else if (object@ld < 0) {
    paste("ld must greater or equal to zero.")
  } else if (object@im < 0) {
    paste("im must greater or equal to zero.")
  } else if (object@em < 0) {
    paste("em must greater or equal to zero.")
  } else if (object@nstate < 0) {
    paste("nstate must greater or equal to zero.")
  } else if (object@lb == 0 & object@ld == 0 &
             object@im == 0 & object@em == 0) {
    paste("lb, ld, im and em cannot all be zero.")
  } else if (object@nstate %% 1 != 0) {
    paste("nstate must be an integer!")
  } else {
    TRUE
  }
}

setValidity("stat2003.bd", valid2)
paulnorthrop/stat2003 documentation built on May 24, 2019, 10:31 p.m.