-
Notifications
You must be signed in to change notification settings - Fork 0
/
mutation.R
38 lines (38 loc) · 1.19 KB
/
mutation.R
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
#' Factory function that creates normal mutation function
#'
#' Given the domain bounds and standard deviation returns a function
#' compatible with GA interface that performs a mutation on the given
#' individual using truncated normal distribution.
#'
#' @param lower - Lower bound of the problem's domain
#' @param upper - Upper bound of the problem's domain
#' @param sd - Standard deviation of the truncated normal distribution
#' used for the mutation
#'
#' @return Function that takes two parameters (the GA object \code{object}
#' and an individual to perform the mutation on \code{parent}) and returns
#' a new individual that is the result of normal mutation applied to the parent.
#'
#' @export
#'
#' @examples
#' mutation <- rtnorm_mutation(
#' lower = rep(-500, 5),
#' upper = rep(500, 5),
#' sd = rep(50, 5)
#' )
rtnorm_mutation <- function(lower, upper, sd) {
function(object, parent) {
parent <- as.vector(object@population[parent, ])
random_coordinate <- function(i) {
msm::rtnorm(
mean = parent[[i]],
sd = sd[[i]],
lower = lower[[i]],
upper = upper[[i]],
n = 1
)
}
as.vector(mapply(random_coordinate, seq_along(lower)))
}
}