R/functions_check.R

In shinyypr: Run Ypr Shiny App

chk_parameter_names <- function(x) {
  y <- setdiff(x[["Parameter"]], parameters)
  if (length(y)) {
    abort_chk(paste(
      "The following parameter%s %r unrecognised:",
      cc(y, conj = " and ")
    ), n = length(y), tidy = TRUE)
  }
  invisible(x)
}

chk_colnames <- function(x) {
  if (!identical(sort(colnames(x)), sort(c("Parameter", "Value")))) {
    abort_chk("Column names in uploaded data must be 'Parameter' and 'Value'.")
  }
  invisible(x)
}

chk_population <- function(x, x_name = NULL) {
  if (is.null(x_name)) {
    x_name <- deparse_backtick_chk(substitute(x))
  }
  chk_string(x_name, x_name = "x_name")
  chk_s3_class(x, "ypr_population", x_name = x_name)
  chk_named(x, x_name = x_name)
  chk_unique(names(x), x_name = x_name)
  chk_superset(names(x), parameters, x_name = x_name)
  do.call("chk_parameters", x)
  x
}

chk_parameters <- function(tmax, k, Linf, t0, k2, Linf2, L2, Wb, Ls, Sp, es,
                           tR, Rk, BH, fb, n, nL, Ln, Sm, pi, Lv, Vp, Llo, Lup, rho,
                           Hm, Nc, Wa, fa, Rmax, q) {
  chk_s3_class(tmax, "integer")
  chk_scalar(tmax)
  chk_not_any_na(tmax)
  chk_range(tmax, c(1L, 100L))
  chk_s3_class(k, "numeric")
  chk_scalar(k)
  chk_not_any_na(k)
  chk_range(k, c(0.015, 15))
  chk_s3_class(Linf, "numeric")
  chk_scalar(Linf)
  chk_not_any_na(Linf)
  chk_range(Linf, c(1, 1000))
  chk_s3_class(t0, "numeric")
  chk_scalar(t0)
  chk_not_any_na(t0)
  chk_range(t0, c(-10, 10))
  chk_s3_class(k2, "numeric")
  chk_scalar(k2)
  chk_not_any_na(k2)
  chk_range(k2, c(0, 15))
  chk_s3_class(Linf2, "numeric")
  chk_scalar(Linf2)
  chk_not_any_na(Linf2)
  chk_range(Linf2, c(1, 1000))
  chk_s3_class(L2, "numeric")
  chk_scalar(L2)
  chk_not_any_na(L2)
  chk_range(L2, c(-100, 1000))
  chk_s3_class(Wb, "numeric")
  chk_scalar(Wb)
  chk_not_any_na(Wb)
  chk_range(Wb, c(2, 4))
  chk_s3_class(Ls, "numeric")
  chk_scalar(Ls)
  chk_not_any_na(Ls)
  chk_range(Ls, c(-100, 1000))
  chk_s3_class(Sp, "numeric")
  chk_scalar(Sp)
  chk_not_any_na(Sp)
  chk_range(Sp, c(0, 1000))
  chk_s3_class(es, "numeric")
  chk_scalar(es)
  chk_not_any_na(es)
  chk_range(es, c(0.01, 1))
  chk_s3_class(tR, "integer")
  chk_scalar(tR)
  chk_not_any_na(tR)
  chk_range(tR, c(0L, 10L))
  chk_s3_class(Rk, "numeric")
  chk_scalar(Rk)
  chk_not_any_na(Rk)
  chk_range(Rk, c(1, 100))
  chk_s3_class(BH, "integer")
  chk_scalar(BH)
  chk_not_any_na(BH)
  chk_range(BH, c(0L, 1L))
  chk_s3_class(fb, "numeric")
  chk_scalar(fb)
  chk_not_any_na(fb)
  chk_range(fb, c(0.5, 2))
  chk_s3_class(n, "numeric")
  chk_scalar(n)
  chk_not_any_na(n)
  chk_range(n, c(0, 1))
  chk_s3_class(nL, "numeric")
  chk_scalar(nL)
  chk_not_any_na(nL)
  chk_range(nL, c(0, 1))
  chk_s3_class(Ln, "numeric")
  chk_scalar(Ln)
  chk_not_any_na(Ln)
  chk_range(Ln, c(-100, 1000))
  chk_s3_class(Sm, "numeric")
  chk_scalar(Sm)
  chk_not_any_na(Sm)
  chk_range(Sm, c(0, 1))
  chk_s3_class(pi, "numeric")
  chk_scalar(pi)
  chk_not_any_na(pi)
  chk_range(pi, c(0, 1))
  chk_s3_class(Lv, "numeric")
  chk_scalar(Lv)
  chk_not_any_na(Lv)
  chk_range(Lv, c(-100, 1000))
  chk_s3_class(Vp, "numeric")
  chk_scalar(Vp)
  chk_not_any_na(Vp)
  chk_range(Vp, c(0, 100))
  chk_s3_class(Llo, "numeric")
  chk_scalar(Llo)
  chk_not_any_na(Llo)
  chk_range(Llo, c(0, 1000))
  chk_s3_class(Lup, "numeric")
  chk_scalar(Lup)
  chk_not_any_na(Lup)
  chk_range(Lup, c(0, 1000))
  chk_s3_class(rho, "numeric")
  chk_scalar(rho)
  chk_not_any_na(rho)
  chk_range(rho, c(0, 1))
  chk_s3_class(Hm, "numeric")
  chk_scalar(Hm)
  chk_not_any_na(Hm)
  chk_range(Hm, c(0, 1))
  chk_s3_class(Nc, "numeric")
  chk_scalar(Nc)
  chk_not_any_na(Nc)
  chk_range(Nc, c(0, 1))
  chk_s3_class(Wa, "numeric")
  chk_scalar(Wa)
  chk_not_any_na(Wa)
  chk_range(Wa, c(0.001, 0.1))
  chk_s3_class(fa, "numeric")
  chk_scalar(fa)
  chk_not_any_na(fa)
  chk_range(fa, c(1e-04, 100))
  chk_s3_class(Rmax, "numeric")
  chk_scalar(Rmax)
  chk_not_any_na(Rmax)
  chk_range(Rmax, c(1, 1e+06))
  chk_s3_class(q, "numeric")
  chk_scalar(q)
  chk_not_any_na(q)
  chk_range(q, c(0, 1))
}