File: sample.R

package info (click to toggle)
r-cran-paramhelpers 1.14-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 992 kB
  • sloc: ansic: 102; sh: 13; makefile: 2
file content (141 lines) | stat: -rw-r--r-- 4,195 bytes parent folder | download | duplicates (2)
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#' @title Sample a random value from a parameter or a parameter set uniformly.
#'
#' @template desc_dep_pars_na
#'
#' @template arg_par_or_set
#' @template arg_disc_names
#' @template arg_trafo
#' @return The return type is determined by the type of the parameter. For a set
#'   a named list of such values in the correct order is returned.
#' @export
#' @examples
#' # bounds are necessary here, can't sample with Inf bounds:
#' u = makeNumericParam("x", lower = 0, upper = 1)
#' # returns a random number between 0 and 1:
#' sampleValue(u)
#'
#' p = makeDiscreteParam("x", values = c("a", "b", "c"))
#' # can be either "a", "b" or "c"
#' sampleValue(p)
#'
#' p = makeIntegerVectorParam("x", len = 2, lower = 1, upper = 5)
#' # vector of two random integers between 1 and 5:
#' sampleValue(p)
#'
#' ps = makeParamSet(
#'   makeNumericParam("x", lower = 1, upper = 10),
#'   makeIntegerParam("y", lower = 1, upper = 10),
#'   makeDiscreteParam("z", values = 1:2)
#' )
#' sampleValue(ps)
sampleValue = function(par, discrete.names = FALSE, trafo = FALSE) {
  UseMethod("sampleValue")
}

#' @export
sampleValue.Param = function(par, discrete.names = FALSE, trafo = FALSE) {

  assertFlag(discrete.names)
  assertFlag(trafo)
  type = par$type
  if (!is.null(par$len) && is.na(par$len)) {
    stop("Cannot sample with NA length!")
  }

  if (isNumericTypeString(type)) {
    if (anyInfinite(c(par$lower, par$upper))) {
      stop("Cannot sample with Inf bounds!")
    }
    if (isIntegerTypeString(type)) {
      x = as.integer(round(runif(par$len, min = par$lower - 0.5, max = par$upper + 0.5)))
    } else {
      x = runif(par$len, min = par$lower, max = par$upper)
    }
  } else if (isLogicalTypeString(type)) {
    x = sample(c(TRUE, FALSE), par$len, replace = TRUE)
  } else if (isDiscreteTypeString(type, FALSE)) {
    x = sample(names(par$values), par$len, replace = TRUE)
    if (!discrete.names) {
      x = if (type == "discretevector") {
        par$values[x]
      } else {
        par$values[[x]]
      }
    }
  } else {
    stopf("Cannot generate random value for %s variable!", type)
  }
  if (trafo && !is.null(par$trafo)) {
    x = par$trafo(x)
  }
  # if the components have names, set them
  if (!is.null(par$cnames)) {
    names(x) = par$cnames
  }
  return(x)
}

#' @export
sampleValue.ParamSet = function(par, discrete.names = FALSE, trafo = FALSE) {
  # sample value for each param, do it until we a get one which is not forbidden
  repeat {
    val = lapply(par$pars, sampleValue, discrete.names = discrete.names, trafo = trafo)
    if (is.null(par$forbidden) || !isForbidden(par, val)) {
      break
    }
  }
  # set conditional params to NA is condition not OK
  val = lapply(seq_along(val), function(i) {
    if (!is.null(par$pars[[i]]$requires) && !requiresOk(par$pars[[i]], val)) {
      type = par$pars[[i]]$type
      type = switch(type,
        numericvector = "numeric",
        integervector = "integer",
        logicalvector = "logical",
        discrete = "character",
        discretevector = "character",
        type
      )
      as(NA, type)
    } else {
      val[[i]]
    }
  })
  names(val) = names(par$pars)
  return(val)
}


#' @title Sample n random values from a parameter or a parameter set uniformly.
#'
#' @template desc_dep_pars_na
#'
#' @template arg_par_or_set
#' @param n (`integer(1)`)\cr
#'   Number of values.
#' @template arg_disc_names
#' @template arg_trafo
#' @return `list`. For consistency always a list is returned.
#' @export
#' @examples
#' p = makeIntegerParam("x", lower = -10, upper = 10)
#' sampleValues(p, 4)
#'
#' p = makeNumericParam("x", lower = -10, upper = 10)
#' sampleValues(p, 4)
#'
#' p = makeLogicalParam("x")
#' sampleValues(p, 4)
#'
#' ps = makeParamSet(
#'   makeNumericParam("u", lower = 1, upper = 10),
#'   makeIntegerParam("v", lower = 1, upper = 10),
#'   makeDiscreteParam("w", values = 1:2)
#' )
#' sampleValues(ps, 2)
sampleValues = function(par, n, discrete.names = FALSE, trafo = FALSE) {
  assert(checkClass(par, "Param"), checkClass(par, "ParamSet"))
  n = asInt(n)
  assertFlag(discrete.names)
  replicate(n, sampleValue(par, discrete.names = discrete.names, trafo = trafo), simplify = FALSE)
}