File: convertDiscrete.R

package info (click to toggle)
r-cran-paramhelpers 1.12-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 984 kB
  • sloc: ansic: 260; sh: 13; makefile: 2
file content (70 lines) | stat: -rw-r--r-- 2,563 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
#' @title Convert encoding name(s) to discrete value(s).
#'
#' @description
#' For a discrete parameter or discrete vector.
#' If the \code{name} is \code{NA}, indicating a missing parameter value due to unsatisfied requirements,
#' \code{NA} is returned.
#'
#' @template arg_par
#' @param name [\code{character}]\cr
#'   Name (string) encoding the value for a discrete parameter,
#'   or a character vector of names for a discrete vector.
#' @return [any]. Parameter value for a discrete parameter
#'   or a list of values for a discrete vector.
#' @examples
#' p = makeDiscreteParam("u", values=c(x1 = "a", x2 = "b", x3 = "b"))
#' discreteNameToValue(p, "x3")
#' @export
discreteNameToValue = function(par, name) {
  # handle missing parameter values (requires)
  if (isScalarNA(name))
    return(NA)
  assertClass(par, "Param")
  assertChoice(par$type, c("discrete", "discretevector"))
  assertCharacter(name, len = ifelse(par$type == "discrete", 1L, par$len))
  d = setdiff(name, names(par$values))
  if (length(d) > 0L)
    stopf("Names not used in values for parameter %s: %s", par$id, collapse(d))
  if (par$type == "discrete")
    par$values[[name]]
  else if (par$type == "discretevector")
    par$values[name]
}

#' @title Convert discrete value(s) to encoding name(s).
#'
#' @description
#' For a discrete parameter or discrete vector.
#' If the value \code{x} is \code{NA}, indicating a missing parameter value due to unsatisfied requirements,
#' \code{NA} is returned.
#'
#' @template arg_par
#' @param x [any]\cr
#'   Parameter value or a list of values for a discrete vector.
#' @return [\code{character}]. Single name for a discrete parameter or a character vector of
#'   names for a discrete vector.
#' @examples
#' p = makeDiscreteParam("u", values=c(x1="a", x2="b", x3="c"))
#' discreteValueToName(p, "b")
#' @export
discreteValueToName = function(par, x) {
  # handle missing parameter values (requires)
  if (isScalarNA(x))
    return(NA_character_)
  assertClass(par, "Param")
  assertChoice(par$type, c("discrete", "discretevector"))
  if (par$type == "discretevector" && length(x) != par$len)
    stopf("Length of x must be %i!", par$len)
  ns = names(par$values)
  getIndex = function(values, v) {
    j = which(vlapply(values, function(w) isTRUE(all.equal(w, v, tolerance = .Machine$double.eps))))
    if (length(j) == 0)
      stop("Value not found!")
    return(j)
  }
  if (par$type == "discrete") {
    ns[getIndex(par$values, x)]
  } else if (par$type == "discretevector")  {
    ns[sapply(x, getIndex, values = par$values)]
  }
}