Nothing
#' Available NLS test problems
#'
#' @description
#' Returns an overview of 59 NLS test problems originating primarily from the NIST Statistical Reference Datasets (StRD)
#' archive; Bates and Watts (1988); and More, Garbow and Hillstrom (1981).
#'
#' @param fields optional character vector to return a subset of columns in the \link{data.frame}.
#' @return a \link{data.frame} with high-level information about the available test problems. The following columns are returned by default:
#' \itemize{
#' \item \code{"name"} Name of the test problem for use in \code{\link{nls_test_problem}}.
#' \item \code{"class"} Either \code{"formula"} if the model is defined as a \link{formula} or \code{"function"} if defined as a \link{function}.
#' \item \code{"p"} Default number of parameters in the test problem.
#' \item \code{"n"} Default number of residuals in the test problem.
#' \item \code{"check"} One of the following three options: (1) \code{"p, n fixed"} if the listed values for \code{p} and \code{n} are the only ones possible;
#' (2) \code{"p <= n free"} if the values for \code{p} and \code{n} are not fixed, but \code{p} must be smaller or equal to \code{n};
#' (3) \code{"p == n free"} if the values for \code{p} and \code{n} are not fixed, but \code{p} must be equal to \code{n}.
#' }
#' @seealso \code{\link{nls_test_problem}}
#' @seealso \url{https://www.itl.nist.gov/div898/strd/nls/nls_main.shtml}
#' @seealso \url{https://people.math.sc.edu/Burkardt/f_src/test_nls/test_nls.html}
#' @references D.M. Bates and Watts, D.G. (1988). \emph{Nonlinear Regression Analysis and Its Applications}, Wiley, ISBN: 0471816434.
#' @references J.J. Moré, Garbow, B.S. and Hillstrom, K.E. (1981). \emph{Testing unconstrained optimization software}, ACM Transactions on Mathematical Software, 7(1), 17-41.
#' @examples
#' ## available test problems
#' nls_test_list()
#' @export
nls_test_list <- function(fields = c("name", "class", "p", "n", "check")) {
fields <- match.arg(fields, c("name", "class", "p", "n", "check"), several.ok = TRUE)
properties <- data.frame(
name = c("Misra1a", "Chwirut2", "Chwirut1", "Lanczos3",
"Gauss1", "Gauss2", "DanWood", "Misra1b", "Kirby2", "Hahn1",
"Nelson", "MGH17", "Lanczos1", "Lanczos2", "Gauss3", "Misra1c",
"Misra1d", "Roszman1", "ENSO", "MGH09", "Thurber", "BoxBOD",
"Ratkowsky2", "MGH10", "Eckerle4", "Ratkowsky3", "Bennett5", "Isomerization",
"Lubricant", "Sulfisoxazole", "Leaves", "Chloride", "Tetracycline",
"Linear, full rank", "Linear, rank 1", "Linear, rank 1, zero columns and rows", "Rosenbrock",
"Helical valley", "Powell singular", "Freudenstein/Roth", "Bard",
"Kowalik and Osborne", "Meyer", "Watson", "Box 3-dimensional",
"Jennrich and Sampson", "Brown and Dennis", "Chebyquad", "Brown almost-linear",
"Osborne 1", "Osborne 2", "Hanson 1", "Hanson 2", "McKeown 1",
"McKeown 2", "McKeown 3", "Devilliers and Glasser 1", "Devilliers and Glasser 2",
"Madsen example"),
class = c("formula", "formula", "formula",
"formula", "formula", "formula", "formula", "formula", "formula",
"formula", "formula", "formula", "formula", "formula", "formula",
"formula", "formula", "formula", "formula", "formula", "formula",
"formula", "formula", "formula", "formula", "formula", "formula",
"formula", "formula", "formula", "formula", "formula", "formula",
"function", "function", "function", "function", "function", "function",
"function", "function", "function", "function", "function", "function",
"function", "function", "function", "function", "function", "function",
"function", "function", "function", "function", "function", "function",
"function", "function"),
p = c(2L, 3L, 3L, 6L, 8L, 8L,
2L, 2L, 5L, 7L, 3L, 5L, 6L, 6L, 8L, 2L, 2L, 4L, 9L, 4L, 7L, 2L,
3L, 3L, 3L, 4L, 3L, 4L, 9L, 4L, 4L, 3L, 4L,
5L, 5L, 5L, 2L, 3L, 4L, 2L, 3L, 4L, 3L, 6L,
3L, 2L, 4L, 9L, 10L, 5L, 11L, 2L, 3L, 2L, 3L, 5L, 4L, 5L, 2L),
n = c(14L, 54L, 214L, 24L, 250L, 250L, 6L, 14L,
151L, 236L, 128L, 33L, 24L, 24L, 250L, 14L, 14L, 25L, 168L,
11L, 37L, 6L, 9L, 16L, 35L, 15L, 154L,
24L, 53L, 12L, 15L, 54L, 9L,
10L, 10L, 10L, 2L,
3L, 4L, 2L, 15L, 11L, 16L, 31L, 10L, 10L, 20L, 9L, 10L,
33L, 65L, 16L, 16L, 3L, 4L, 10L, 24L, 16L, 3L),
check = c("p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed",
"p <= n free", "p <= n free", "p <= n free",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p <= n free",
"p <= n free", "p <= n free", "p <= n free", "p == n free",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed",
"p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed", "p, n fixed")
)
return(properties[, fields])
}
#' Retrieve an NLS test problem
#'
#' @description
#' Fetches the model definition and model data required to solve a single NLS test problem with \code{\link{gsl_nls}}
#' (or \code{\link[stats]{nls}} if the model is defined as a \link{formula}). Use \code{\link{nls_test_list}} to
#' list the names of the available NLS test problems.
#'
#' @param name Name of the NLS test problem, as returned in the \code{"name"} column of \code{\link{nls_test_list}}.
#' @param p The number of parameters in the NLS test problem constrained by the \code{check} condition returned by \code{\link{nls_test_list}}.
#' If \code{NA} (default), the default number of parameters as listed by \code{\link{nls_test_list}} is used.
#' @param n The number of residuals in the NLS test problem constrained by the \code{check} condition returned by \code{\link{nls_test_list}}.
#' If \code{NA} (default), the default number of residuals as listed by \code{\link{nls_test_list}} is used.
#'
#' @return
#' If the model is defined as a \link{formula}, a \link{list} of class \code{"nls_test_formula"} with elements:
#' \itemize{
#' \item \code{data} a data.frame with \code{n} rows containing the data (predictor and response values) used in the regression problem.
#' \item \code{fn} a \link{formula} defining the test problem model.
#' \item \code{start} a named vector of length \code{p} with suggested starting values for the parameters.
#' \item \code{target} a named vector of length \code{p} with the certified target values for the parameters corresponding to the
#' \emph{best-available} solutions.
#' }
#' If the model is defined as a \link{function}, a \link{list} of class \code{"nls_test_function"} with elements:
#' \itemize{
#' \item \code{fn} a \link{function} defining the test problem model. \code{fn} takes a vector of parameters
#' of length \code{p} as its first argument and returns a numeric vector of length \code{n}.
#' \code{fn}
#' \item \code{y} a numeric vector of length \code{n} containing the response values.
#' \item \code{start} a numeric named vector of length \code{p} with suggested starting values for the parameters.
#' \item \code{jac} a \link{function} defining the analytic Jacobian matrix of the model \code{fn}. \code{jac}
#' takes a vector of parameters of length \code{p} as its first argument and returns an \code{n} by \code{p} dimensional matrix.
#' \item \code{target} a numeric named vector of length \code{p} with the certified target values for the parameters, or a vector of
#' \code{NA}'s if no target solution is available.
#' }
#'
#' @seealso \code{\link{nls_test_list}}
#' @seealso \url{https://www.itl.nist.gov/div898/strd/nls/nls_main.shtml}
#' @seealso \url{https://people.math.sc.edu/Burkardt/f_src/test_nls/test_nls.html}
#' @references D.M. Bates and Watts, D.G. (1988). \emph{Nonlinear Regression Analysis and Its Applications}, Wiley, ISBN: 0471816434.
#' @references J.J. Moré, Garbow, B.S. and Hillstrom, K.E. (1981). \emph{Testing unconstrained optimization software}, ACM Transactions on Mathematical Software, 7(1), 17-41.
#' @note For several problems the optimal least-squares objective of the target solution can be obtained at multiple different parameter locations.
#' @examples
#' ## example regression problem
#' ratkowsky2 <- nls_test_problem(name = "Ratkowsky2")
#' with(ratkowsky2,
#' gsl_nls(
#' fn = fn,
#' data = data,
#' start = start
#' )
#' )
#'
#' ## example optimization problem
#' rosenbrock <- nls_test_problem(name = "Rosenbrock")
#' with(rosenbrock,
#' gsl_nls(
#' fn = fn,
#' y = y,
#' start = start,
#' jac = jac
#' )
#' )
#' @export
nls_test_problem <- function(name, p = NA, n = NA) {
## match arguments
properties <- nls_test_list()
name <- match.arg(name, choices = properties$name)
fid <- match(name, properties$name)
p <- ifelse(is.na(p), properties[fid, "p"], as.integer(p))
n <- ifelse(is.na(n), properties[fid, "n"], as.integer(n))
stopifnot(
"p must be a positive integer" = p >= 1L,
"n must be a positive integer" = n >= 1L
)
check <- properties[fid, "check"]
if(identical(check, "p, n fixed")) {
stopifnot("p, n have fixed values for test problem" = (p == properties[fid, "p"] && n == properties[fid, "n"]))
} else if(identical(check, "p <= n free")) {
stopifnot("p must be smaller than or equal to n for test problem" = (p <= n))
} else {
stopifnot("p must be equal to n for test problem" = (p == n))
}
## test problem data
if(identical(properties[fid, "class"], "formula")) {
if(identical(name, "Misra1a")) {
.data <- data.frame(y = c(10.07, 14.73, 17.94, 23.93, 29.61, 35.18,
40.02, 44.82, 50.76, 55.05, 61.01, 66.4, 75.47, 81.78),
x = c(77.6, 114.9, 141.1, 190.8, 239.9, 289, 332.8,
378.4, 434.8, 477.3, 536.8, 593.1, 689.1, 760))
.fn <- as.formula("y ~ b1*(1-exp(-b2*x))", env = environment())
.start <- c(b1 = 500, b2 = 1e-4)
.target <- c(b1 = 2.3894212918E+02, b2 = 5.5015643181E-04)
} else if(identical(name, "Chwirut2")) {
.data <- data.frame(y = c(92.9, 57.1, 31.05, 11.5875, 8.025, 63.6,
21.4, 14.25, 8.475, 63.8, 26.8, 16.4625, 7.125, 67.3, 41, 21.15,
8.175, 81.5, 13.12, 59.9, 14.62, 32.9, 5.44, 12.56, 5.44, 32,
13.95, 75.8, 20, 10.42, 59.5, 21.67, 8.55, 62, 20.2, 7.76, 3.75,
11.81, 54.7, 23.7, 11.55, 61.3, 17.7, 8.74, 59.2, 16.3, 8.62,
81, 4.87, 14.62, 81.7, 17.17, 81.3, 28.9),
x = c(0.5, 1, 1.75, 3.75, 5.75, 0.875, 2.25, 3.25, 5.25, 0.75, 1.75, 2.75, 4.75,
0.625, 1.25, 2.25, 4.25, 0.5, 3, 0.75, 3, 1.5, 6, 3, 6, 1.5,
3, 0.5, 2, 4, 0.75, 2, 5, 0.75, 2.25, 3.75, 5.75, 3, 0.75, 2.5,
4, 0.75, 2.5, 4, 0.75, 2.5, 4, 0.5, 6, 3, 0.5, 2.75, 0.5, 1.75))
.fn <- as.formula("y ~ exp(-b1*x)/(b2+b3*x)", env = environment())
.start <- c(b1 = 0.1 , b2 = 0.01, b3 = 0.02)
.target <- c(b1 = 1.6657666537E-01, b2 = 5.1653291286E-03, b3 = 1.2150007096E-02)
} else if(identical(name, "Chwirut1")) {
.data <- data.frame(y = c(92.9, 78.7, 64.2, 64.9, 57.1, 43.3, 31.1,
23.6, 31.05, 23.775, 17.7375, 13.8, 11.5875, 9.4125, 7.725, 7.35,
8.025, 90.6, 76.9, 71.6, 63.6, 54, 39.2, 29.3, 21.4, 29.175,
22.125, 17.5125, 14.25, 9.45, 9.15, 7.9125, 8.475, 6.1125, 80,
79, 63.8, 57.2, 53.2, 42.5, 26.8, 20.4, 26.85, 21, 16.4625, 12.525,
10.5375, 8.5875, 7.125, 6.1125, 5.9625, 74.1, 67.3, 60.8, 55.5,
50.3, 41, 29.4, 20.4, 29.3625, 21.15, 16.7625, 13.2, 10.875,
8.175, 7.35, 5.9625, 5.625, 81.5, 62.4, 32.5, 12.41, 13.12, 15.56,
5.63, 78, 59.9, 33.2, 13.84, 12.75, 14.62, 3.94, 76.8, 61, 32.9,
13.87, 11.81, 13.31, 5.44, 78, 63.5, 33.8, 12.56, 5.63, 12.75,
13.12, 5.44, 76.8, 60, 47.8, 32, 22.2, 22.57, 18.82, 13.95, 11.25,
9, 6.67, 75.8, 62, 48.8, 35.2, 20, 20.32, 19.31, 12.75, 10.42,
7.31, 7.42, 70.5, 59.5, 48.5, 35.8, 21, 21.67, 21, 15.64, 8.17,
8.55, 10.12, 78, 66, 62, 58, 47.7, 37.8, 20.2, 21.07, 13.87,
9.67, 7.76, 5.44, 4.87, 4.01, 3.75, 24.19, 25.76, 18.07, 11.81,
12.07, 16.12, 70.8, 54.7, 48, 39.8, 29.8, 23.7, 29.62, 23.81,
17.7, 11.55, 12.07, 8.74, 80.7, 61.3, 47.5, 29, 24, 17.7, 24.56,
18.67, 16.24, 8.74, 7.87, 8.51, 66.7, 59.2, 40.8, 30.7, 25.7,
16.3, 25.99, 16.95, 13.35, 8.62, 7.2, 6.64, 13.69, 81, 64.5,
35.5, 13.31, 4.87, 12.94, 5.06, 15.19, 14.62, 15.64, 25.5, 25.95,
81.7, 61.6, 29.8, 29.81, 17.17, 10.39, 28.4, 28.69, 81.3, 60.9,
16.65, 10.05, 28.9, 28.95),
x = c(0.5, 0.625, 0.75, 0.875, 1, 1.25, 1.75, 2.25, 1.75, 2.25, 2.75, 3.25, 3.75, 4.25, 4.75, 5.25,
5.75, 0.5, 0.625, 0.75, 0.875, 1, 1.25, 1.75, 2.25, 1.75, 2.25,
2.75, 3.25, 3.75, 4.25, 4.75, 5.25, 5.75, 0.5, 0.625, 0.75, 0.875,
1, 1.25, 1.75, 2.25, 1.75, 2.25, 2.75, 3.25, 3.75, 4.25, 4.75,
5.25, 5.75, 0.5, 0.625, 0.75, 0.875, 1, 1.25, 1.75, 2.25, 1.75,
2.25, 2.75, 3.25, 3.75, 4.25, 4.75, 5.25, 5.75, 0.5, 0.75, 1.5,
3, 3, 3, 6, 0.5, 0.75, 1.5, 3, 3, 3, 6, 0.5, 0.75, 1.5, 3, 3,
3, 6, 0.5, 0.75, 1.5, 3, 6, 3, 3, 6, 0.5, 0.75, 1, 1.5, 2, 2,
2.5, 3, 4, 5, 6, 0.5, 0.75, 1, 1.5, 2, 2, 2.5, 3, 4, 5, 6, 0.5,
0.75, 1, 1.5, 2, 2, 2.5, 3, 4, 5, 6, 0.5, 0.625, 0.75, 0.875,
1, 1.25, 2.25, 2.25, 2.75, 3.25, 3.75, 4.25, 4.75, 5.25, 5.75,
3, 3, 3, 3, 3, 3, 0.5, 0.75, 1, 1.5, 2, 2.5, 2, 2.5, 3, 4, 5,
6, 0.5, 0.75, 1, 1.5, 2, 2.5, 2, 2.5, 3, 4, 5, 6, 0.5, 0.75,
1, 1.5, 2, 2.5, 2, 2.5, 3, 4, 5, 6, 3, 0.5, 0.75, 1.5, 3, 6,
3, 6, 3, 3, 3, 1.75, 1.75, 0.5, 0.75, 1.75, 1.75, 2.75, 3.75,
1.75, 1.75, 0.5, 0.75, 2.75, 3.75, 1.75, 1.75))
.fn <- as.formula("y ~ exp(-b1*x)/(b2+b3*x)", env = environment())
.start <- c(b1 = 0.1, b2 = 0.01, b3 = 0.02)
.target <- c(b1 = 1.9027818370E-01, b2 = 6.1314004477E-03, b3 = 1.0530908399E-02)
} else if(identical(name, "Lanczos3")) {
.data <- data.frame(y = c(2.5134, 2.0443, 1.6684, 1.3664, 1.1232,
0.9269, 0.7679, 0.6389, 0.5338, 0.4479, 0.3776, 0.3197, 0.272,
0.2325, 0.1997, 0.1723, 0.1493, 0.1301, 0.1138, 0.1, 0.0883,
0.0783, 0.0698, 0.0624),
x = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5,
0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85,
0.9, 0.95, 1, 1.05, 1.1, 1.15))
.fn <- as.formula("y ~ b1*exp(-b2*x) + b3*exp(-b4*x) + b5*exp(-b6*x)", env = environment())
.start <- c(b1 = 1.2, b2 = 0.3, b3 = 5.6, b4 = 5.5, b5 = 6.5, b6 = 7.6)
.target <- c(b1 = 8.6816414977E-02, b2 = 9.5498101505E-01, b3 = 8.4400777463E-01, b4 = 2.9515951832E+00,
b5 = 1.5825685901E+00, b6 = 4.9863565084E+00)
} else if(identical(name, "Gauss1")) {
.data <- data.frame(y = c(97.62227, 97.80724, 96.62247, 92.59022,
91.23869, 95.32704, 90.3504, 89.46235, 91.7252, 89.86916, 86.88076,
85.9436, 87.60686, 86.25839, 80.74976, 83.03551, 88.25837, 82.01316,
82.74098, 83.30034, 81.2785, 81.85506, 80.75195, 80.09573, 81.07633,
78.81542, 78.38596, 79.93386, 79.48474, 79.95942, 76.10691, 78.3983,
81.4306, 82.48867, 81.65462, 80.84323, 88.68663, 84.74438, 86.83934,
85.97739, 91.28509, 97.22411, 93.51733, 94.10159, 101.9176, 98.43134,
110.4214, 107.6628, 111.7288, 116.5115, 120.7609, 123.9553, 124.2437,
130.7996, 133.296, 130.7788, 132.0565, 138.6584, 142.9252, 142.7215,
144.1249, 147.4377, 148.2647, 152.0519, 147.3863, 149.2074, 148.9537,
144.5876, 148.1226, 148.0144, 143.8893, 140.9088, 143.4434, 139.3938,
135.9878, 136.3927, 126.7262, 124.4487, 122.8647, 113.8557, 113.7037,
106.8407, 107.0034, 102.4629, 96.09296, 94.57555, 86.98824, 84.90154,
81.18023, 76.40117, 67.092, 72.67155, 68.10848, 67.99088, 63.34094,
60.55253, 56.18687, 53.64482, 53.70307, 48.07893, 42.21258, 45.65181,
41.69728, 41.24946, 39.21349, 37.71696, 36.68395, 37.30393, 37.43277,
37.45012, 32.64648, 31.84347, 31.39951, 26.68912, 32.25323, 27.61008,
33.58649, 28.10714, 30.26428, 28.01648, 29.11021, 23.02099, 25.65091,
28.50295, 25.23701, 26.13828, 33.5326, 29.25195, 27.09847, 26.52999,
25.52401, 26.69218, 24.55269, 27.71763, 25.20297, 25.61483, 25.06893,
27.6393, 24.94851, 25.86806, 22.48183, 26.90045, 25.39919, 17.90614,
23.76039, 25.89689, 27.64231, 22.86101, 26.47003, 23.72888, 27.54334,
30.52683, 28.07261, 34.92815, 28.29194, 34.19161, 35.41207, 37.09336,
40.9833, 39.53923, 47.80123, 47.46305, 51.04166, 54.58065, 57.53001,
61.42089, 62.79032, 68.51455, 70.23053, 74.42776, 76.59911, 81.62053,
83.42208, 79.17451, 88.56985, 85.66525, 86.55502, 90.65907, 84.2729,
85.7222, 83.10702, 82.16884, 80.42568, 78.15692, 79.79691, 77.84378,
74.50327, 71.57289, 65.88031, 65.01385, 60.19582, 59.66726, 52.95478,
53.87792, 44.91274, 41.09909, 41.68018, 34.53379, 34.86419, 33.14787,
29.58864, 27.29462, 21.91439, 19.08159, 24.9029, 19.82341, 16.75551,
18.24558, 17.23549, 16.34934, 13.71285, 14.75676, 13.97169, 12.42867,
14.35519, 7.703309, 10.23441, 11.78315, 13.87768, 4.5357, 10.05928,
8.424824, 10.53312, 9.602255, 7.877514, 6.258121, 8.899865, 7.877754,
12.51191, 10.66205, 6.0354, 6.790655, 8.783535, 4.600288, 8.400915,
7.216561, 10.01741, 7.331278, 6.527863, 2.842001, 10.32507, 4.790995,
8.377101, 6.264445, 2.706213, 8.362329, 8.983658, 3.362571, 1.182746,
4.875359),
x = c(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, 142, 143, 144, 145, 146, 147,
148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160,
161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173,
174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186,
187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199,
200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212,
213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225,
226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238,
239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250))
.fn <- as.formula("y ~ b1*exp( -b2*x ) + b3*exp( -(x-b4)**2 / b5**2 ) + b6*exp( -(x-b7)**2 / b8**2 )", env = environment())
.start <- c(b1 = 97.0, b2 = 0.009, b3 = 100.0, b4 = 65.0, b5 = 20.0, b6 = 70.0, b7 = 178., b8 = 16.5)
.target <- c(
b1 = 9.8778210871E+01,
b2 = 1.0497276517E-02,
b3 = 1.0048990633E+02,
b4 = 6.7481111276E+01,
b5 = 2.3129773360E+01,
b6 = 7.1994503004E+01,
b7 = 1.7899805021E+02,
b8 = 1.8389389025E+01
)
} else if(identical(name, "Gauss2")) {
.data <- data.frame(y = c(97.58776, 97.76344, 96.56705, 92.52037,
91.15097, 95.21728, 90.21355, 89.29235, 91.51479, 89.60966, 86.56187,
85.55316, 87.13054, 85.6794, 80.04851, 82.18925, 87.24081, 80.79407,
81.2857, 81.5694, 79.22715, 79.43275, 77.90195, 76.75468, 77.17377,
74.27348, 73.119, 73.84826, 72.4787, 71.92292, 66.92176, 67.93835,
69.56207, 69.07066, 66.53983, 63.87883, 69.71537, 63.60588, 63.37154,
60.01835, 62.67481, 65.80666, 59.14304, 56.62951, 61.21785, 54.3879,
62.93443, 56.65144, 57.13362, 58.29689, 58.91744, 58.50172, 55.22885,
58.30375, 57.43237, 51.69407, 49.93132, 53.7076, 55.39712, 52.89709,
52.31649, 53.9872, 53.54158, 56.45046, 51.32276, 53.11676, 53.28631,
49.80555, 54.69564, 56.41627, 54.59362, 54.3852, 60.15354, 59.78773,
60.49995, 65.43885, 60.70001, 63.71865, 67.77139, 64.70934, 70.78193,
70.38651, 77.22359, 79.52665, 80.13077, 85.67823, 85.20647, 90.24548,
93.61953, 95.86509, 93.46992, 105.8137, 107.8269, 114.0607, 115.5019,
118.511, 119.6177, 122.194, 126.9903, 125.7005, 123.7447, 130.6543,
129.7168, 131.824, 131.8759, 131.9994, 132.1221, 133.4414, 133.8252,
133.6695, 128.2851, 126.5182, 124.755, 118.4016, 122.0334, 115.2059,
118.7856, 110.7387, 110.2003, 105.1729, 103.4472, 94.5428, 94.40526,
94.57964, 88.76605, 87.28747, 92.50443, 86.27997, 82.44307, 80.47367,
78.36608, 78.74307, 76.12786, 79.13108, 76.76062, 77.60769, 77.76633,
81.2822, 79.74307, 81.97964, 80.02952, 85.95232, 85.96838, 79.94789,
87.17023, 90.50992, 93.23373, 89.14803, 93.11492, 90.34337, 93.69421,
95.74256, 91.85105, 96.74503, 87.60996, 90.47012, 88.1169, 85.70673,
85.01361, 78.5304, 81.34148, 75.19295, 72.66115, 69.85504, 66.29476,
63.58502, 58.33847, 57.50766, 52.80498, 50.79319, 47.0349, 46.4709,
43.09016, 34.11531, 39.28235, 32.68386, 30.44056, 31.98932, 23.6333,
23.69643, 20.26812, 19.07074, 17.59544, 16.08785, 18.94267, 18.61354,
17.258, 16.62285, 13.48367, 15.37647, 13.47208, 15.96188, 12.32547,
16.3388, 10.43833, 9.628715, 13.12268, 8.772417, 11.76143, 12.5502,
11.33108, 11.20493, 7.816916, 6.800675, 14.26581, 10.66285, 8.911574,
11.56733, 11.58207, 11.59071, 9.730134, 11.44237, 11.22912, 10.17213,
12.50905, 6.201493, 9.019605, 10.80607, 13.09625, 3.914271, 9.567886,
8.038448, 10.23104, 9.36741, 7.695971, 6.118575, 8.793207, 7.796692,
12.45065, 10.61601, 6.001003, 6.765098, 8.764653, 4.586418, 8.390783,
7.209202, 10.01209, 7.327461, 6.525136, 2.840065, 10.32371, 4.790035,
8.376431, 6.26398, 2.705892, 8.362109, 8.983507, 3.362469, 1.182678,
4.875312),
x = c(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, 142, 143, 144, 145, 146, 147,
148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160,
161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173,
174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186,
187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199,
200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212,
213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225,
226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238,
239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250))
.fn <- as.formula("y ~ b1*exp( -b2*x ) + b3*exp( -(x-b4)**2 / b5**2 ) + b6*exp( -(x-b7)**2 / b8**2 )", env = environment())
.start <- c(b1 = 96, b2 = 0.009, b3 = 103, b4 = 106, b5 = 18, b6 = 72, b7 = 151, b8 = 18)
.target <- c(
b1 = 9.9018328406E+01,
b2 = 1.0994945399E-02,
b3 = 1.0188022528E+02,
b4 = 1.0703095519E+02,
b5 = 2.3578584029E+01,
b6 = 7.2045589471E+01,
b7 = 1.5327010194E+02,
b8 = 1.9525972636E+01
)
} else if(identical(name, "DanWood")) {
.data <- data.frame(y = c(2.138, 3.421, 3.597, 4.34, 4.882, 5.66),
x = c(1.309, 1.471, 1.49, 1.565, 1.611, 1.68))
.fn <- as.formula("y ~ b1*x**b2", env = environment())
.start <- c(b1 = 1, b2 = 5)
.target <- c(b1 = 7.6886226176E-01, b2 = 3.8604055871E+00)
} else if(identical(name, "Misra1b")) {
.data <- data.frame(y = c(10.07, 14.73, 17.94, 23.93, 29.61, 35.18,
40.02, 44.82, 50.76, 55.05, 61.01, 66.4, 75.47, 81.78),
x = c(77.6, 114.9, 141.1, 190.8, 239.9, 289, 332.8, 378.4,
434.8, 477.3, 536.8, 593.1, 689.1, 760))
.fn <- as.formula("y ~ b1 * (1-(1+b2*x/2)**(-2))", env = environment())
.start <- c(b1 = 500, b2 = 0.0001)
.target <- c(
b1 = 3.3799746163E+02,
b2 = 3.9039091287E-04
)
} else if(identical(name, "Kirby2")) {
.data <- data.frame(y = c(0.0082, 0.0112, 0.0149, 0.0198, 0.0248,
0.0324, 0.042, 0.0549, 0.0719, 0.0963, 0.1291, 0.171, 0.2314,
0.3227, 0.4809, 0.7084, 1.022, 1.458, 1.952, 2.541, 3.223, 3.999,
4.852, 5.732, 6.727, 7.835, 9.025, 10.267, 11.578, 12.944, 14.377,
15.856, 17.331, 18.885, 20.575, 22.32, 22.303, 23.46, 24.06,
25.272, 25.853, 27.11, 27.658, 28.924, 29.511, 30.71, 31.35,
32.52, 33.23, 34.33, 35.06, 36.17, 36.84, 38.01, 38.67, 39.87,
40.03, 40.5, 41.37, 41.67, 42.31, 42.73, 43.46, 44.14, 44.55,
45.22, 45.92, 46.3, 47, 47.68, 48.06, 48.74, 49.41, 49.76, 50.43,
51.11, 51.5, 52.12, 52.76, 53.18, 53.78, 54.46, 54.83, 55.4,
56.43, 57.03, 58, 58.61, 59.58, 60.11, 61.1, 61.65, 62.59, 63.12,
64.03, 64.62, 65.49, 66.03, 66.89, 67.42, 68.23, 68.77, 69.59,
70.11, 70.86, 71.43, 72.16, 72.7, 73.4, 73.93, 74.6, 75.16, 75.82,
76.34, 76.98, 77.48, 78.08, 78.6, 79.17, 79.62, 79.88, 80.19,
80.66, 81.22, 81.66, 82.16, 82.59, 83.14, 83.5, 84, 84.4, 84.89,
85.26, 85.74, 86.07, 86.54, 86.89, 87.32, 87.65, 88.1, 88.43,
88.83, 89.12, 89.54, 89.85, 90.25, 90.55, 90.93, 91.2, 91.55,
92.2),
x = c(9.65, 10.74, 11.81, 12.88, 14.06, 15.28, 16.63,
18.19, 19.88, 21.84, 24, 26.25, 28.86, 31.85, 35.79, 40.18, 44.74,
49.53, 53.94, 58.29, 62.63, 67.03, 71.25, 75.22, 79.33, 83.56,
87.75, 91.93, 96.1, 100.28, 104.46, 108.66, 112.71, 116.88, 121.33,
125.79, 125.79, 128.74, 130.27, 133.33, 134.79, 137.93, 139.33,
142.46, 143.9, 146.91, 148.51, 151.41, 153.17, 155.97, 157.76,
160.56, 162.3, 165.21, 166.9, 169.92, 170.32, 171.54, 173.79,
174.57, 176.25, 177.34, 179.19, 181.02, 182.08, 183.88, 185.75,
186.8, 188.63, 190.45, 191.48, 193.35, 195.22, 196.23, 198.05,
199.97, 201.06, 202.83, 204.69, 205.86, 207.58, 209.5, 210.65,
212.33, 215.43, 217.16, 220.21, 221.98, 225.06, 226.79, 229.92,
231.69, 234.77, 236.6, 239.63, 241.5, 244.48, 246.4, 249.35,
251.32, 254.22, 256.24, 259.11, 261.18, 264.02, 266.13, 268.94,
271.09, 273.87, 276.08, 278.83, 281.08, 283.81, 286.11, 288.81,
291.08, 293.75, 295.99, 298.64, 300.84, 302.02, 303.48, 305.65,
308.27, 310.41, 313.01, 315.12, 317.71, 319.79, 322.36, 324.42,
326.98, 329.01, 331.56, 333.56, 336.1, 338.08, 340.6, 342.57,
345.08, 347.02, 349.52, 351.44, 353.93, 355.83, 358.32, 360.2,
362.67, 364.53, 367, 371.3))
.fn <- as.formula("y ~ (b1 + b2*x + b3*x**2) / (1 + b4*x + b5*x**2)", env = environment())
.start <- c(b1 = 2, b2 = -0.1, b3 = 0.003, b4 = -0.001, b5 = 0.00001)
.target <- c(
b1 = 1.6745063063E+00,
b2 = -1.3927397867E-01,
b3 = 2.5961181191E-03,
b4 = -1.7241811870E-03,
b5 = 2.1664802578E-05
)
} else if(identical(name, "Hahn1")) {
.data <- data.frame(y = c(0.591, 1.547, 2.902, 2.894, 4.703, 6.307,
7.03, 7.898, 9.47, 9.484, 10.072, 10.163, 11.615, 12.005, 12.478,
12.982, 12.97, 13.926, 14.452, 14.404, 15.19, 15.55, 15.528,
15.499, 16.131, 16.438, 16.387, 16.549, 16.872, 16.83, 16.926,
16.907, 16.966, 17.06, 17.122, 17.311, 17.355, 17.668, 17.767,
17.803, 17.765, 17.768, 17.736, 17.858, 17.877, 17.912, 18.046,
18.085, 18.291, 18.357, 18.426, 18.584, 18.61, 18.87, 18.795,
19.111, 0.367, 0.796, 0.892, 1.903, 2.15, 3.697, 5.87, 6.421,
7.422, 9.944, 11.023, 11.87, 12.786, 14.067, 13.974, 14.462,
14.464, 15.381, 15.483, 15.59, 16.075, 16.347, 16.181, 16.915,
17.003, 16.978, 17.756, 17.808, 17.868, 18.481, 18.486, 19.09,
16.062, 16.337, 16.345, 16.388, 17.159, 17.116, 17.164, 17.123,
17.979, 17.974, 18.007, 17.993, 18.523, 18.669, 18.617, 19.371,
19.33, 0.08, 0.248, 1.089, 1.418, 2.278, 3.624, 4.574, 5.556,
7.267, 7.695, 9.136, 9.959, 9.957, 11.6, 13.138, 13.564, 13.871,
13.994, 14.947, 15.473, 15.379, 15.455, 15.908, 16.114, 17.071,
17.135, 17.282, 17.368, 17.483, 17.764, 18.185, 18.271, 18.236,
18.237, 18.523, 18.627, 18.665, 19.086, 0.214, 0.943, 1.429,
2.241, 2.951, 3.782, 4.757, 5.602, 7.169, 8.92, 10.055, 12.035,
12.861, 13.436, 14.167, 14.755, 15.168, 15.651, 15.746, 16.216,
16.445, 16.965, 17.121, 17.206, 17.25, 17.339, 17.793, 18.123,
18.49, 18.566, 18.645, 18.706, 18.924, 19.1, 0.375, 0.471, 1.504,
2.204, 2.813, 4.765, 9.835, 10.04, 11.946, 12.596, 13.303, 13.922,
14.44, 14.951, 15.627, 15.639, 15.814, 16.315, 16.334, 16.43,
16.423, 17.024, 17.009, 17.165, 17.134, 17.349, 17.576, 17.848,
18.09, 18.276, 18.404, 18.519, 19.133, 19.074, 19.239, 19.28,
19.101, 19.398, 19.252, 19.89, 20.007, 19.929, 19.268, 19.324,
20.049, 20.107, 20.062, 20.065, 19.286, 19.972, 20.088, 20.743,
20.83, 20.935, 21.035, 20.93, 21.074, 21.085, 20.935),
x = c(24.41, 34.82, 44.09, 45.07, 54.98, 65.51, 70.53, 75.7, 89.57, 91.14,
96.4, 97.19, 114.26, 120.25, 127.08, 133.55, 133.61, 158.67,
172.74, 171.31, 202.14, 220.55, 221.05, 221.39, 250.99, 268.99,
271.8, 271.97, 321.31, 321.69, 330.14, 333.03, 333.47, 340.77,
345.65, 373.11, 373.79, 411.82, 419.51, 421.59, 422.02, 422.47,
422.61, 441.75, 447.41, 448.7, 472.89, 476.69, 522.47, 522.62,
524.43, 546.75, 549.53, 575.29, 576, 625.55, 20.15, 28.78, 29.57,
37.41, 39.12, 50.24, 61.38, 66.25, 73.42, 95.52, 107.32, 122.04,
134.03, 163.19, 163.48, 175.7, 179.86, 211.27, 217.78, 219.14,
262.52, 268.01, 268.62, 336.25, 337.23, 339.33, 427.38, 428.58,
432.68, 528.99, 531.08, 628.34, 253.24, 273.13, 273.66, 282.1,
346.62, 347.19, 348.78, 351.18, 450.1, 450.35, 451.92, 455.56,
552.22, 553.56, 555.74, 652.59, 656.2, 14.13, 20.41, 31.3, 33.84,
39.7, 48.83, 54.5, 60.41, 72.77, 75.25, 86.84, 94.88, 96.4, 117.37,
139.08, 147.73, 158.63, 161.84, 192.11, 206.76, 209.07, 213.32,
226.44, 237.12, 330.9, 358.72, 370.77, 372.72, 396.24, 416.59,
484.02, 495.47, 514.78, 515.65, 519.47, 544.47, 560.11, 620.77,
18.97, 28.93, 33.91, 40.03, 44.66, 49.87, 55.16, 60.9, 72.08,
85.15, 97.06, 119.63, 133.27, 143.84, 161.91, 180.67, 198.44,
226.86, 229.65, 258.27, 273.77, 339.15, 350.13, 362.75, 371.03,
393.32, 448.53, 473.78, 511.12, 524.7, 548.75, 551.64, 574.02,
623.86, 21.46, 24.33, 33.43, 39.22, 44.18, 55.02, 94.33, 96.44,
118.82, 128.48, 141.94, 156.92, 171.65, 190, 223.26, 223.88,
231.5, 265.05, 269.44, 271.78, 273.46, 334.61, 339.79, 349.52,
358.18, 377.98, 394.77, 429.66, 468.22, 487.27, 519.54, 523.03,
612.99, 638.59, 641.36, 622.05, 631.5, 663.97, 646.9, 748.29,
749.21, 750.14, 647.04, 646.89, 746.9, 748.43, 747.35, 749.27,
647.61, 747.78, 750.51, 851.37, 845.97, 847.54, 849.93, 851.61,
849.75, 850.98, 848.23))
.fn <- as.formula("y ~ (b1+b2*x+b3*x**2+b4*x**3) / (1+b5*x+b6*x**2+b7*x**3)", env = environment())
.start <- c(b1 = 10, b2 = -1, b3 = 0.05, b4 = -0.00001, b5 = -0.05, b6 = 0.001, b7 = -0.000001)
.target <- c(
b1 = 1.0776351733E+00,
b2 = -1.2269296921E-01,
b3 = 4.0863750610E-03,
b4 = -1.4262662514E-06,
b5 = -5.7609940901E-03,
b6 = 2.4053735503E-04,
b7 = -1.2314450199E-07
)
} else if(identical(name, "Nelson")) {
.data <- data.frame(y = c(15, 17, 15.5, 16.5, 15.5, 15, 16, 14.5,
15, 14.5, 12.5, 11, 14, 13, 14, 11.5, 14, 16, 13, 13.5, 13, 13.5,
12.5, 12.5, 12.5, 12, 11.5, 12, 13, 11.5, 13, 12.5, 13.5, 17.5,
17.5, 13.5, 12.5, 12.5, 15, 13, 12, 13, 12, 13.5, 10, 11.5, 11,
9.5, 15, 15, 15.5, 16, 13, 10.5, 13.5, 14, 12.5, 12, 11.5, 11.5,
6.5, 5.5, 6, 6, 18.5, 17, 15.3, 16, 13, 14, 12.5, 11, 12, 12,
11.5, 12, 6, 6, 5, 5.5, 12.5, 13, 16, 12, 11, 9.5, 11, 11, 11,
10, 10.5, 10.5, 2.7, 2.7, 2.5, 2.4, 13, 13.5, 16.5, 13.6, 11.5,
10.5, 13.5, 12, 7, 6.9, 8.8, 7.9, 1.2, 1.5, 1, 1.5, 13, 12.5,
16.5, 16, 11, 11.5, 10.5, 10, 7.27, 7.5, 6.7, 7.6, 1.5, 1, 1.2,
1.2),
x1 = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
16, 16, 16, 16, 16, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32,
32, 32, 32, 32, 32, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
48, 48, 48, 48, 48, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
64, 64, 64, 64, 64),
x2 = c(180, 180, 180, 180, 225, 225, 225,
225, 250, 250, 250, 250, 275, 275, 275, 275, 180, 180, 180, 180,
225, 225, 225, 225, 250, 250, 250, 250, 275, 275, 275, 275, 180,
180, 180, 180, 225, 225, 225, 225, 250, 250, 250, 250, 275, 275,
275, 275, 180, 180, 180, 180, 225, 225, 225, 225, 250, 250, 250,
250, 275, 275, 275, 275, 180, 180, 180, 180, 225, 225, 225, 225,
250, 250, 250, 250, 275, 275, 275, 275, 180, 180, 180, 180, 225,
225, 225, 225, 250, 250, 250, 250, 275, 275, 275, 275, 180, 180,
180, 180, 225, 225, 225, 225, 250, 250, 250, 250, 275, 275, 275,
275, 180, 180, 180, 180, 225, 225, 225, 225, 250, 250, 250, 250,
275, 275, 275, 275))
.fn <- as.formula("log(y) ~ b1 - b2*x1 * exp(-b3*x2)", env = environment())
.start <- c(b1 = 2, b2 = 0.0001, b3 = -0.01)
.target <- c(
b1 = 2.5906836021E+00,
b2 = 5.6177717026E-09,
b3 = -5.7701013174E-02
)
} else if(identical(name, "MGH17")) {
.data <- data.frame(y = c(0.844, 0.908, 0.932, 0.936, 0.925, 0.908,
0.881, 0.85, 0.818, 0.784, 0.751, 0.718, 0.685, 0.658, 0.628,
0.603, 0.58, 0.558, 0.538, 0.522, 0.506, 0.49, 0.478, 0.467,
0.457, 0.448, 0.438, 0.431, 0.424, 0.42, 0.414, 0.411, 0.406),
x = c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120,
130, 140, 150, 160, 170, 180, 190, 200, 210, 220, 230, 240,
250, 260, 270, 280, 290, 300, 310, 320))
.fn <- as.formula("y ~ b1 + b2*exp(-x*b4) + b3*exp(-x*b5)", env = environment())
.start <- c(b1 = 50, b2 = 150, b3 = -100, b4 = 1, b5 = 2)
.target <- c(
b1 = 3.7541005211E-01,
b2 = 1.9358469127E+00,
b3 = -1.4646871366E+00,
b4 = 1.2867534640E-02,
b5 = 2.2122699662E-02
)
} else if(identical(name, "Lanczos1")) {
.data <- data.frame(y = c(2.5134, 2.044333373291, 1.668404436564,
1.366418021208, 1.123232487372, 0.9268897180037, 0.7679338563728,
0.6388775523106, 0.5337835317402, 0.4479363617347, 0.377584788435,
0.3197393199326, 0.2720130773746, 0.2324965529032, 0.1996589546065,
0.1722704126914, 0.1493405660168, 0.1300700206922, 0.1138119324644,
0.1000415587559, 0.0883320908454, 0.0783354401935, 0.06976693743449,
0.06239312536719),
x = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3,
0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85,
0.9, 0.95, 1, 1.05, 1.1, 1.15))
.fn <- as.formula("y ~ b1*exp(-b2*x) + b3*exp(-b4*x) + b5*exp(-b6*x)", env = environment())
.start <- c(b1 = 1.2, b2 = 0.3, b3 = 5.6, b4 = 5.5, b5 = 6.5, b6 = 7.6)
.target <- c(
b1 = 9.5100000027E-02,
b2 = 1.0000000001E+00,
b3 = 8.6070000013E-01,
b4 = 3.0000000002E+00,
b5 = 1.5575999998E+00,
b6 = 5.0000000001E+00
)
} else if(identical(name, "Lanczos2")) {
.data <- data.frame(y = c(2.5134, 2.04433, 1.6684, 1.36642, 1.12323,
0.92689, 0.767934, 0.638878, 0.533784, 0.447936, 0.377585, 0.319739,
0.272013, 0.232497, 0.199659, 0.17227, 0.149341, 0.13007, 0.113812,
0.100042, 0.0883321, 0.0783354, 0.0697669, 0.0623931),
x = c(0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55,
0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1, 1.05, 1.1, 1.15
))
.fn <- as.formula("y ~ b1*exp(-b2*x) + b3*exp(-b4*x) + b5*exp(-b6*x)", env = environment())
.start <- c(b1 = 1.2, b2 = 0.3, b3 = 5.6, b4 = 5.5, b5 = 6.5, b6 = 7.6)
.target <- c(
b1 = 9.6251029939E-02,
b2 = 1.0057332849E+00,
b3 = 8.6424689056E-01,
b4 = 3.0078283915E+00,
b5 = 1.5529016879E+00,
b6 = 5.0028798100E+00
)
} else if(identical(name, "Gauss3")) {
.data <- data.frame(y = c(97.58776, 97.76344, 96.56705, 92.52037,
91.15097, 95.21728, 90.21355, 89.29235, 91.51479, 89.60965, 86.56187,
85.55315, 87.13053, 85.67938, 80.04849, 82.18922, 87.24078, 80.79401,
81.28564, 81.56932, 79.22703, 79.43259, 77.90174, 76.75438, 77.17338,
74.27296, 73.1183, 73.84732, 72.47746, 71.92128, 66.91962, 67.93554,
69.55841, 69.06592, 66.53371, 63.87094, 69.70526, 63.59295, 63.35509,
59.99747, 62.64843, 65.77345, 59.10141, 56.5775, 61.15313, 54.30767,
62.83535, 56.52957, 56.98427, 58.11459, 58.69576, 58.23322, 54.9049,
57.91442, 56.96629, 51.13831, 49.27123, 52.92668, 54.47693, 51.8171,
51.05401, 52.51731, 51.8371, 54.48196, 49.05859, 50.52315, 50.32755,
46.44419, 50.89281, 52.13203, 49.78741, 49.01637, 54.18198, 53.17456,
53.20827, 57.43459, 51.95282, 54.20282, 57.46687, 53.60268, 58.86728,
57.66652, 63.71034, 65.24244, 65.10878, 69.96313, 68.85475, 73.32574,
76.21241, 78.06311, 75.37701, 87.54449, 89.50588, 95.82098, 97.4839,
100.8607, 102.4851, 105.7311, 111.3489, 111.0305, 110.192, 118.3581,
118.8086, 122.4249, 124.0953, 125.9337, 127.8533, 131.0361, 133.3343,
135.1278, 131.7113, 131.9151, 132.1107, 127.6898, 133.2148, 128.2296,
133.5902, 127.2539, 128.3482, 124.8694, 124.6031, 117.0648, 118.1966,
119.5408, 114.7946, 114.278, 120.3484, 114.8647, 111.6514, 110.1826,
108.4461, 109.0571, 106.5308, 109.4691, 106.8709, 107.3192, 106.9,
109.6526, 107.1602, 108.2509, 104.9631, 109.3601, 107.6696, 99.77286,
104.9644, 106.1376, 106.5816, 100.1286, 101.6691, 96.44254, 97.34169,
96.97412, 90.7346, 93.37949, 82.12331, 83.01657, 78.8736, 74.86971,
72.79341, 65.14744, 67.02127, 60.16136, 57.13996, 54.05769, 50.42265,
47.8243, 42.85748, 42.45495, 38.30808, 36.95794, 33.94543, 34.19017,
31.66097, 23.56172, 29.61143, 23.88765, 22.49812, 24.86901, 17.29481,
18.09291, 15.34813, 14.77997, 13.87832, 12.88891, 16.20763, 16.29024,
15.29712, 14.97839, 12.1133, 14.24168, 12.53824, 15.19818, 11.70478,
15.83745, 10.03585, 9.307574, 12.868, 8.571671, 11.60415, 12.42772,
11.23627, 11.13198, 7.761117, 6.75825, 14.23375, 10.63876, 8.893581,
11.55398, 11.57221, 11.58347, 9.724857, 11.43854, 11.22636, 10.17015,
12.50765, 6.200494, 9.018902, 10.80557, 13.09591, 3.914033, 9.567723,
8.038338, 10.23096, 9.367358, 7.695937, 6.118552, 8.793192, 7.796682,
12.45064, 10.61601, 6.001, 6.765096, 8.764652, 4.586417, 8.390782,
7.209201, 10.01209, 7.327461, 6.525136, 2.840065, 10.32371, 4.790035,
8.376431, 6.26398, 2.705892, 8.362109, 8.983507, 3.362469, 1.182678,
4.875312),
x = c(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, 142, 143, 144, 145, 146, 147,
148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160,
161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173,
174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186,
187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199,
200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212,
213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225,
226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238,
239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250))
.fn <- as.formula("y ~ b1*exp( -b2*x ) + b3*exp( -(x-b4)**2 / b5**2 ) + b6*exp( -(x-b7)**2 / b8**2 )", env = environment())
.start <- c(b1 = 94.9, b2 = 0.009, b3 = 90.1, b4 = 113, b5 = 20, b6 = 73.8, b7 = 140, b8 = 20)
.target <- c(
b1 = 9.8940368970E+01,
b2 = 1.0945879335E-02,
b3 = 1.0069553078E+02,
b4 = 1.1163619459E+02,
b5 = 2.3300500029E+01,
b6 = 7.3705031418E+01,
b7 = 1.4776164251E+02,
b8 = 1.9668221230E+01
)
} else if(identical(name, "Misra1c")) {
.data <- data.frame(y = c(10.07, 14.73, 17.94, 23.93, 29.61, 35.18,
40.02, 44.82, 50.76, 55.05, 61.01, 66.4, 75.47, 81.78),
x = c(77.6, 114.9, 141.1, 190.8, 239.9, 289, 332.8, 378.4, 434.8, 477.3,
536.8, 593.1, 689.1, 760))
.fn <- as.formula("y ~ b1*(1-(1+2*b2*x)**(-.5))", env = environment())
.start <- c(b1 = 500, b2 = 0.0001)
.target <- c(
b1 = 6.3642725809E+02,
b2 = 2.0813627256E-04
)
} else if(identical(name, "Misra1d")) {
.data <- data.frame(y = c(10.07, 14.73, 17.94, 23.93, 29.61, 35.18,
40.02, 44.82, 50.76, 55.05, 61.01, 66.4, 75.47, 81.78),
x = c(77.6, 114.9, 141.1, 190.8, 239.9, 289, 332.8, 378.4, 434.8, 477.3,
536.8, 593.1, 689.1, 760))
.fn <- as.formula("y ~ b1*b2*x*((1+b2*x)**(-1))", env = environment())
.start <- c(b1 = 500, b2 = 0.0001)
.target <- c(
b1 = 4.3736970754E+02,
b2 = 3.0227324449E-04
)
} else if(identical(name, "Roszman1")) {
.data <- data.frame(y = c(0.252429, 0.252141, 0.251809, 0.297989,
0.296257, 0.295319, 0.339603, 0.337731, 0.33382, 0.38951, 0.386998,
0.438864, 0.434887, 0.427893, 0.471568, 0.461699, 0.461144, 0.513532,
0.506641, 0.505062, 0.535648, 0.533726, 0.568064, 0.612886, 0.624169),
x = c(-4868.68, -4868.09, -4867.41, -3375.19, -3373.14, -3372.03,
-2473.74, -2472.35, -2469.45, -1894.65, -1893.4, -1497.24, -1495.85,
-1493.41, -1208.68, -1206.18, -1206.04, -997.92, -996.61, -996.31,
-834.94, -834.66, -710.03, -530.16, -464.17))
.fn <- as.formula("y ~ b1 - b2*x - atan(b3/(x-b4))/pi", env = environment())
.start <- c(b1 = 0.1, b2 = -0.00001, b3 = 1000, b4 = -100)
.target <- c(
b1 = 2.0196866396E-01,
b2 = -6.1953516256E-06,
b3 = 1.2044556708E+03,
b4 = -1.8134269537E+02
)
} else if(identical(name, "ENSO")) {
.data <- data.frame(y = c(12.9, 11.3, 10.6, 11.2, 10.9, 7.5, 7.7,
11.7, 12.9, 14.3, 10.9, 13.7, 17.1, 14, 15.3, 8.5, 5.7, 5.5,
7.6, 8.6, 7.3, 7.6, 12.7, 11, 12.7, 12.9, 13, 10.9, 10.4, 10.2,
8, 10.9, 13.6, 10.5, 9.2, 12.4, 12.7, 13.3, 10.1, 7.8, 4.8, 3,
2.5, 6.3, 9.7, 11.6, 8.6, 12.4, 10.5, 13.3, 10.4, 8.1, 3.7, 10.7,
5.1, 10.4, 10.9, 11.7, 11.4, 13.7, 14.1, 14, 12.5, 6.3, 9.6,
11.7, 5, 10.8, 12.7, 10.8, 11.8, 12.6, 15.7, 12.6, 14.8, 7.8,
7.1, 11.2, 8.1, 6.4, 5.2, 12, 10.2, 12.7, 10.2, 14.7, 12.2, 7.1,
5.7, 6.7, 3.9, 8.5, 8.3, 10.8, 16.7, 12.6, 12.5, 12.5, 9.8, 7.2,
4.1, 10.6, 10.1, 10.1, 11.9, 13.6, 16.3, 17.6, 15.5, 16, 15.2,
11.2, 14.3, 14.5, 8.5, 12, 12.7, 11.3, 14.5, 15.1, 10.4, 11.5,
13.4, 7.5, 0.6, 0.3, 5.5, 5, 4.6, 8.2, 9.9, 9.2, 12.5, 10.9,
9.9, 8.9, 7.6, 9.5, 8.4, 10.7, 13.6, 13.7, 13.7, 16.5, 16.8,
17.1, 15.4, 9.5, 6.1, 10.1, 9.3, 5.3, 11.2, 16.6, 15.6, 12, 11.5,
8.6, 13.8, 8.7, 8.6, 8.6, 8.7, 12.8, 13.2, 14, 13.4, 14.8),
x = c(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, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151,
152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164,
165, 166, 167, 168))
.fn <- as.formula("y ~ b1 + b2*cos( 2*pi*x/12 ) + b3*sin( 2*pi*x/12 ) + b5*cos( 2*pi*x/b4 ) + b6*sin( 2*pi*x/b4 ) + b8*cos( 2*pi*x/b7 ) + b9*sin( 2*pi*x/b7 )", env = environment())
.start <- c(b1 = 11.0, b2 = 3.0, b3 = 0.5, b4 = 40.0, b5 = -0.7,
b6 = -1.3, b7 = 25.0, b8 = -0.3, b9 = 1.4)
.target <- c(
b1 = 1.0510749193E+01,
b2 = 3.0762128085E+00,
b3 = 5.3280138227E-01,
b4 = 4.4311088700E+01,
b5 = -1.6231428586E+00,
b6 = 5.2554493756E-01,
b7 = 2.6887614440E+01,
b8 = 2.1232288488E-01,
b9 = 1.4966870418E+00
)
} else if(identical(name, "MGH09")) {
.data <- data.frame(y = c(0.1957, 0.1947, 0.1735, 0.16, 0.0844, 0.0627,
0.0456, 0.0342, 0.0323, 0.0235, 0.0246),
x = c(4, 2, 1, 0.5, 0.25, 0.167, 0.125, 0.1, 0.0833, 0.0714, 0.0625))
.fn <- as.formula("y ~ b1 * (x^2 + x * b2) / (x^2 + x * b3 + b4)", env = environment())
.start <- c(b1 = 25, b2 = 39, b3 = 41.5, b4 = 39)
.target <- c(b1 = 1.9280693458E-01, b2 = 1.9128232873E-01, b3 = 1.2305650693E-01, b4 = 1.3606233068E-01)
} else if(identical(name, "Thurber")) {
.data <- data.frame(y = c(80.574, 84.248, 87.264, 87.195, 89.076,
89.608, 89.868, 90.101, 92.405, 95.854, 100.696, 101.06, 401.672,
390.724, 567.534, 635.316, 733.054, 759.087, 894.206, 990.785,
1090.109, 1080.914, 1122.643, 1178.351, 1260.531, 1273.514, 1288.339,
1327.543, 1353.863, 1414.509, 1425.208, 1421.384, 1442.962, 1464.35,
1468.705, 1447.894, 1457.628),
x = c(-3.067, -2.981, -2.921,
-2.912, -2.84, -2.797, -2.702, -2.699, -2.633, -2.481, -2.363,
-2.322, -1.501, -1.46, -1.274, -1.212, -1.1, -1.046, -0.915,
-0.714, -0.566, -0.545, -0.4, -0.309, -0.109, -0.103, 0.01, 0.119,
0.377, 0.79, 0.963, 1.006, 1.115, 1.572, 1.841, 2.047, 2.2))
.fn <- as.formula("y ~ (b1+x*(b2+x*(b3+b4*x))) / (1+x*(b5+x*(b6+x*b7)))", env = environment())
.start <- c(b1 = 1000, b2 = 1000, b3 = 400, b4 = 40, b5 = 0.7, b6 = 0.3, b7 = 0.03)
.target <- c(
b1 = 1.2881396800E+03,
b2 = 1.4910792535E+03,
b3 = 5.8323836877E+02,
b4 = 7.5416644291E+01,
b5 = 9.6629502864E-01,
b6 = 3.9797285797E-01,
b7 = 4.9727297349E-02
)
} else if(identical(name, "BoxBOD")) {
.data <- data.frame(
y = c(109, 149, 149, 191, 213, 224),
x = c(1, 2, 3, 5, 7, 10)
)
.fn <- as.formula("y ~ b1 * (1 - exp(-b2 * x))", env = environment())
.start <- c(b1 = 1, b2 = 1)
.target <- c(b1 = 2.1380940889E+02, b2 = 5.4723748542E-01)
} else if(identical(name, "Ratkowsky2")) {
.data <- data.frame(y = c(8.93, 10.8, 18.59, 22.33, 39.35, 56.11, 61.73, 64.62, 67.08),
x = c(9, 14, 21, 28, 42, 57, 63, 70, 79))
.fn <- as.formula("y ~ b1 / (1 + exp(b2 - b3 * x))", env = environment())
.start <- c(b1 = 100, b2 = 1, b3 = 0.1)
.target <- c(b1 = 7.2462237576E+01, b2 = 2.6180768402E+00, b3 = 6.7359200066E-02)
} else if(identical(name, "MGH10")) {
.data <- data.frame(y = c(34780, 28610, 23650, 19630, 16370, 13720,
11540, 9744, 8261, 7030, 6005, 5147, 4427, 3820, 3307, 2872),
x = c(50, 55, 60, 65, 70, 75, 80, 85, 90, 95, 100, 105, 110,
115, 120, 125))
.fn <- as.formula("y ~ b1 * exp(b2 / (x + b3))", env = environment())
.start <- c(b1 = 2, b2 = 400000, b3 = 25000)
.target <- c(b1 = 5.6096364710E-03, b2 = 6.1813463463E+03, b3 = 3.4522363462E+02)
} else if(identical(name, "Eckerle4")) {
.data <- data.frame(y = c(0.0001575, 0.0001699, 0.000235, 0.0003102,
0.0004917, 0.000871, 0.0017418, 0.00464, 0.0065895, 0.0097302,
0.0149002, 0.023731, 0.0401683, 0.0712559, 0.1264458, 0.2073413,
0.2902366, 0.3445623, 0.3698049, 0.3668534, 0.3106727, 0.2078154,
0.1164354, 0.0616764, 0.03372, 0.0194023, 0.0117831, 0.0074357,
0.0022732, 0.00088, 0.0004579, 0.0002345, 0.0001586, 0.0001143,
7.1e-05),
x = c(400, 405, 410, 415, 420, 425, 430, 435, 436.5,
438, 439.5, 441, 442.5, 444, 445.5, 447, 448.5, 450, 451.5, 453,
454.5, 456, 457.5, 459, 460.5, 462, 463.5, 465, 470, 475, 480,
485, 490, 495, 500))
.fn <- as.formula("y ~ (b1 / b2) * exp(-0.5 * ((x - b3) / b2)^2)", env = environment())
.start <- c(b1 = 1, b2 = 10, b3 = 500)
.target <- c(b1 = 1.5543827178E+00, b2 = 4.0888321754E+00, b3 = 4.5154121844E+02)
} else if(identical(name, "Ratkowsky3")) {
.data <- data.frame(y = c(16.08, 33.83, 65.8, 97.2, 191.55, 326.2,
386.87, 520.53, 590.03, 651.92, 724.93, 699.56, 689.96, 637.56, 717.41),
x = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15))
.fn <- as.formula("y ~ b1 / ((1 + exp(b2 - b3 * x))^(1 / b4))", env = environment())
.start <- c(b1 = 100, b2 = 10, b3 = 1, b4 = 1)
.target <- c(b1 = 6.9964151270E+02, b2 = 5.2771253025E+00, b3 = 7.5962938329E-01, b4 = 1.2792483859E+00)
} else if(identical(name, "Bennett5")) {
.data <- data.frame(y = c(-34.834702, -34.3932, -34.152901, -33.979099,
-33.845901, -33.732899, -33.640301, -33.5592, -33.486801, -33.4231,
-33.365101, -33.313, -33.260899, -33.2174, -33.176899, -33.139198,
-33.101601, -33.066799, -33.035, -33.003101, -32.971298, -32.942299,
-32.916302, -32.890202, -32.864101, -32.841, -32.817799, -32.797501,
-32.7743, -32.757, -32.733799, -32.7164, -32.6991, -32.678799,
-32.6614, -32.644001, -32.626701, -32.612202, -32.597698, -32.583199,
-32.568699, -32.554298, -32.539799, -32.525299, -32.510799, -32.499199,
-32.487598, -32.473202, -32.461601, -32.435501, -32.435501, -32.4268,
-32.4123, -32.400799, -32.392101, -32.380501, -32.366001, -32.3573,
-32.348598, -32.339901, -32.3284, -32.319698, -32.311001, -32.2994,
-32.290699, -32.282001, -32.2733, -32.264599, -32.256001, -32.247299,
-32.238602, -32.2299, -32.224098, -32.215401, -32.2038, -32.198002,
-32.1894, -32.183601, -32.1749, -32.169102, -32.1633, -32.154598,
-32.145901, -32.140099, -32.131401, -32.125599, -32.119801, -32.111198,
-32.1054, -32.096699, -32.0909, -32.088001, -32.0793, -32.073502,
-32.067699, -32.061901, -32.056099, -32.050301, -32.044498, -32.038799,
-32.033001, -32.027199, -32.0243, -32.018501, -32.012699, -32.004002,
-32.001099, -31.9953, -31.9895, -31.9837, -31.9779, -31.972099,
-31.969299, -31.963501, -31.957701, -31.9519, -31.9461, -31.9403,
-31.937401, -31.931601, -31.9258, -31.922899, -31.917101, -31.911301,
-31.9084, -31.902599, -31.8969, -31.893999, -31.888201, -31.8853,
-31.882401, -31.8766, -31.873699, -31.867901, -31.862101, -31.8592,
-31.8563, -31.8505, -31.8447, -31.841801, -31.8389, -31.833099,
-31.8302, -31.827299, -31.8216, -31.818701, -31.812901, -31.809999,
-31.8071, -31.8013, -31.798401, -31.7955, -31.7897, -31.7868),
x = c(7.447168, 8.102586, 8.452547, 8.711278, 8.916774, 9.087155,
9.23259, 9.359535, 9.472166, 9.573384, 9.665293, 9.749461,
9.827092, 9.899128, 9.966321, 10.02928, 10.08851, 10.14443,
10.19738, 10.24767, 10.29556, 10.34125, 10.38495, 10.42682,
10.467, 10.50564, 10.54283, 10.57869, 10.61331, 10.64678,
10.67915, 10.71052, 10.74092, 10.77044, 10.7991, 10.82697,
10.85408, 10.88047, 10.90619, 10.93126, 10.95572, 10.97959,
11.00291, 11.0257, 11.04798, 11.06977, 11.0911, 11.11198,
11.13244, 11.15248, 11.17213, 11.19141, 11.21031, 11.22887,
11.24709, 11.26498, 11.28256, 11.29984, 11.31682, 11.33352,
11.34994, 11.3661, 11.382, 11.39766, 11.41307, 11.42824,
11.4432, 11.45793, 11.47244, 11.48675, 11.50086, 11.51477,
11.52849, 11.54202, 11.55538, 11.56855, 11.58156, 11.59442,
11.607121, 11.61964, 11.632, 11.64421, 11.65628, 11.6682,
11.67998, 11.69162, 11.70313, 11.71451, 11.72576, 11.73688,
11.74789, 11.75878, 11.76955, 11.7802, 11.79073, 11.80116,
11.81148, 11.8217, 11.83181, 11.84182, 11.85173, 11.86155,
11.87127, 11.88089, 11.89042, 11.89987, 11.90922, 11.91849,
11.92768, 11.93678, 11.94579, 11.95473, 11.96359, 11.97237,
11.98107, 11.9897, 11.99826, 12.00674, 12.01515, 12.02349,
12.03176, 12.03997, 12.0481, 12.05617, 12.06418, 12.07212,
12.08001, 12.08782, 12.09558, 12.10328, 12.11092, 12.1185,
12.12603, 12.1335, 12.14091, 12.14827, 12.15557, 12.16283,
12.17003, 12.17717, 12.18427, 12.19132, 12.19832, 12.20527,
12.21217, 12.21903, 12.22584, 12.2326, 12.23932, 12.24599,
12.25262, 12.2592, 12.26575, 12.27224))
.fn <- as.formula("y ~ b1 * (b2 + x)^(-1 / b3)", env = environment())
.start <- c(b1 = -2000, b2 = 50, b3 = 0.8)
.target <- c(b1 = -2.5235058043E+03, b2 = 4.6736564644E+01, b3 = 9.3218483193E-01)
} else if(identical(name, "Isomerization")) {
.data <- data.frame(
x1 = c(205.8, 404.8, 209.7, 401.6, 224.9, 402.6, 212.7, 406.2, 133.3, 470.9, 300.0, 301.6, 297.3,
314.0, 305.7, 300.1, 305.4, 305.2, 300.1, 106.6, 417.2, 251.0, 250.3, 145.1),
x2 = c(90.9, 92.9, 174.9, 187.2, 92.7, 102.2, 186.9, 192.6, 140.8, 144.2, 68.3, 214.6, 142.2,
146.7, 142.0, 143.7, 141.1, 141.5, 83.0, 209.6, 83.9, 294.4, 148.0, 291.0),
x3 = c(37.1, 36.3, 49.4, 44.9, 116.3, 128.9, 134.4, 134.9, 87.6, 86.9, 81.7, 101.7,
10.5, 157.1, 86.0, 90.2, 87.4, 87.0, 66.4, 33.0, 32.9, 41.5, 14.7, 50.2),
y = c(3.541, 2.397, 6.694, 4.722, 0.593, 0.268, 2.797, 2.451, 3.196, 2.021, 0.896, 5.084,
5.686, 1.193, 2.648, 3.303, 3.054, 3.302, 1.271, 11.648, 2.002, 9.604, 7.754, 11.590)
)
.fn <- as.formula("y ~ (b1 * b3 * (x2 - x3 / 1.632)) / (1 + b2 * x1 + b3 * x2 + b4 * x3)", env = environment())
.start <- c(b1 = 10, b2 = 0, b3 = 0, b4 = 0)
.target <- c(b1 = 35.9202075907984, b2 = 0.0708438158538416, b3 = 0.0377302429939232, b4 = 0.167135941532392)
} else if(identical(name, "Lubricant")) {
.data <- data.frame(
y = c(5.10595, 6.38705, 7.38511, 5.79057,
5.10716, 6.36113, 7.97329, 10.4725, 11.9272, 12.4262, 9.1563,
4.54223, 5.82452, 6.70515, 7.71659, 5.29782, 6.22654, 7.57338,
10.354, 11.9844, 12.4435, 9.52333, 8.34496, 5.17275, 6.64963,
5.80754, 7.74101, 6.23206, 4.6606, 4.29865, 7.96731, 9.34225,
10.5109, 11.8215, 13.068, 8.80445, 6.8553, 6.11898, 3.38099,
4.45783, 5.20675, 6.29101, 7.32719, 5.76988, 4.08766, 3.37417,
5.83919, 6.72635, 7.76883, 8.91362, 9.98334, 8.32329, 7.1321),
x1 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 25, 25, 25, 25,
25, 25, 25, 25, 25, 25, 25, 25, 37.7777777778, 37.7777777778,
37.7777777778, 37.7777777778, 37.7777777778, 37.7777777778,
37.7777777778, 37.7777777778, 37.7777777778, 37.7777777778,
37.7777777778, 37.7777777778, 37.7777777778, 37.7777777778,
37.7777777778, 98.8888888889, 98.8888888889, 98.8888888889,
98.8888888889, 98.8888888889, 98.8888888889, 98.8888888889,
98.8888888889, 98.8888888889, 98.8888888889, 98.8888888889,
98.8888888889, 98.8888888889, 98.8888888889, 98.8888888889
),
x2 = c(1, 740.803, 1407.47, 363.166, 1,
805.5, 1868.09, 3285.1, 3907.47, 4125.47, 2572.03, 1, 805.5,
1505.92, 2339.96, 422.941, 1168.37, 2237.29, 4216.89, 5064.29,
5280.88, 3647.27, 2813.94, 516.822, 1737.99, 1008.73, 2749.24,
1375.82, 191.084, 1, 2922.94, 4044.6, 4849.8, 5605.78, 6273.85,
3636.72, 1948.96, 1298.47, 1, 685.95, 1423.64, 2791.43, 4213.37,
2103.67, 402.195, 1, 2219.7, 3534.75, 4937.71, 6344.17, 7469.35,
5640.94, 4107.89) / 1000
)
.fn <- as.formula("y ~ b1 / (b2 + x1) + b3 * x2 + b4 * x2**2 + b5 * x2**3 + (b6 * x2 + b7 * x2**3) * exp(-x1 / (b8 + b9 * x2**2))", env = environment())
.start <- c(b1 = 1000, b2 = 1, b3 = 1, b4 = 1, b5 = 0, b6 = 1, b7 = 0, b8 = 1, b9 = 0)
.target <- c(b1 = 1054.54053185586, b2 = 206.545778895884, b3 = 1.46031478978246,
b4 = -0.259654831213851, b5 = 0.0225737061160327, b6 = 0.401384284921933,
b7 = 0.0352840506436575, b8 = 57.404631430396, b9 = -0.476721102261905)
} else if(identical(name, "Sulfisoxazole")) {
.data <- data.frame(
x = c(0.25, 0.5, 0.75, 1, 1.5, 2, 3, 4, 6, 12, 24, 48),
y = c(215.6, 189.2, 176, 162.8, 138.6, 121, 101.2, 88, 61.6, 22, 4.4, 0.1)
)
.fn <- as.formula("y ~ b1 * exp(-b2 * x) + b3 * exp(-b4 * x)", env = environment())
.start <- c(b1 = 100, b2 = 1, b3 = 0, b4 = 0)
.target <- c(b1 = 81.2440378005701, b2 = 1.30598900748147, b3 = 162.594414330483, b4 = 0.161785643456763)
} else if(identical(name, "Leaves")) {
.data <- data.frame(
x = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5, 7.5,
8.5, 9.5, 10.5, 11.5, 12.5, 13.5, 14.5),
y = c(1.3, 1.3, 1.9, 3.4, 5.3, 7.1, 10.6, 16,
16.4, 18.3, 20.9, 20.5, 21.3, 21.2, 20.9)
)
.fn <- as.formula("y ~ b1 / (1 + b2 * exp(-b3 * x))**(1 / b4)", env = environment())
.start <- c(b1 = 10, b2 = 250, b3 = 1, b4 = 1)
.target <- c(b1 = 21.2040375905717, b2 = 296.449927062274, b3 = 0.777218543698019, b4 = 1.61890922917627)
} else if(identical(name, "Chloride")) {
.data <- data.frame(
y = c(17.3, 17.6, 17.9, 18.3, 18.5, 18.9, 19,
19.3, 19.8, 19.9, 20.2, 20.5, 20.6, 21.1, 21.5, 21.9, 22, 22.3,
22.6, 22.8, 23, 23.2, 23.4, 23.7, 24, 24.2, 24.5, 25, 25.4, 25.5,
25.9, 25.9, 26.3, 26.2, 26.5, 26.5, 26.6, 27, 27, 27, 27, 27.3,
27.8, 28.1, 28.1, 28.1, 28.4, 28.6, 29, 29.2, 29.3, 29.4, 29.4, 29.4),
x = c(2.45, 2.55, 2.65, 2.75, 2.85, 2.95, 3.05, 3.15,
3.25, 3.35, 3.45, 3.55, 3.65, 3.75, 3.85, 3.95, 4.05, 4.15, 4.25,
4.35, 4.45, 4.55, 4.65, 4.75, 4.85, 4.95, 5.05, 5.15, 5.25, 5.35,
5.45, 5.55, 5.65, 5.75, 5.85, 5.95, 6.05, 6.15, 6.25, 6.35, 6.45,
6.55, 6.65, 6.75, 6.85, 6.95, 7.05, 7.15, 7.25, 7.35, 7.45, 7.55,
7.65, 7.75)
)
.fn <- as.formula("y ~ b1 * (1 - b2 * exp(-b3 * x))", env = environment())
.start <- c(b1 = 10, b2 = 1, b3 = 0)
.target <- c(b1 = 39.0948975505463, b2 = 0.828436576821748, b3 = 0.158522388849914)
} else if(identical(name, "Tetracycline")) {
.data <- data.frame(
x = c(1, 2, 3, 4, 6, 8, 10, 12, 16),
y= c(0.7, 1.2, 1.4, 1.4, 1.1, 0.8, 0.6, 0.5, 0.3)
)
.fn <- as.formula("y ~ b3 * (exp(-b1 * (x - b4)) - exp(-b2 * (x - b4)))", env = environment())
.start <- c(b1 = 0, b2 = 0, b3 = 1, b4 = 0)
.target <- c(b1 = 0.148801441927812, b2 = 0.715743513376835, b3 = 2.64966476940712, b4 = 0.412231010811697)
}
return(
structure(
list(
data = .data,
fn = .fn,
start = .start,
target = .target
),
class = "nls_test_formula"
)
)
} else {
.fn <- function(x) {
stopifnot(
"x must be numeric" = is.numeric(x),
"x is not of correct length" = (length(x) == p)
)
fval <- .Call("C_nls_test_f", id = fid, p = as.integer(p), n = as.integer(n), x = as.numeric(x), PACKAGE = "gslnls")
return(fval)
}
.jac <- function(x) {
stopifnot(
"x must be numeric" = is.numeric(x),
"x is not of correct length" = (length(x) == p)
)
jacval <- .Call("C_nls_test_j", id = fid, p = as.integer(p), n = as.integer(n), x = as.numeric(x), PACKAGE = "gslnls")
colnames(jacval) <- names(x)
return(jacval)
}
if(identical(check, "p, n fixed") || (p == properties[fid, "p"] && n == properties[fid, "n"])) {
## fortran start/target values
.start_sol <- .Call("C_nls_test_start_sol", id = fid, p = as.integer(p), n = as.integer(n), PACKAGE = "gslnls")
names(.start_sol[["start"]]) <- paste0("x", seq_len(p))
names(.start_sol[["target"]]) <- paste0("x", seq_len(p))
## complete target solutions for default p, n
if(identical(name, "Bard")) {
.start_sol[["target"]] <- c(x1 = 0.082410559205674, x2 = 1.13303607641391, x3 = 2.34369519368503)
} else if(identical(name, "Kowalik and Osborne")) {
.start_sol[["target"]] <- c(x1 = 0.192806933062332, x2 = 0.191282334026554, x3 = 0.123056495197012, x4 = 0.136062334411325)
} else if(identical(name, "Meyer")) {
.start_sol[["target"]] <- c(x1 = 0.0056096363281157, x2 = 6181.34636748647, x3 = 345.223635336449)
} else if(identical(name, "Watson")) {
.start_sol[["target"]] <- c(x1 = -0.0157250959480399, x2 = 1.01243486077537, x3 = -0.232991564688241,
x4 = 1.26042992304726, x5 = -1.5137287597865, x6 = 0.992996361989885)
} else if(identical(name, "Brown and Dennis")) {
.start_sol[["target"]] <- c(x1 = -11.594436774009, x2 = 13.2036289039192, x3 = -0.403439671815375,
x4 = 0.236778987189955)
} else if(identical(name, "Chebyquad")) {
.start_sol[["target"]] <- c(x1 = 0.583953092107561, x2 = 0.416046907892861, x3 = 0.199490672310222,
x4 = 0.800509327690258, x5 = 0.764380891528748, x6 = 0.499999999999716,
x7 = 0.955794653864209, x8 = 0.0442053461358728, x9 = 0.235619108470807)
} else if(identical(name, "Osborne 1")) {
.start_sol[["target"]] <- c(x1 = 0.375410049869887, x2 = -1.46468686469542, x3 = 1.93584664236735,
x4 = 0.0221227007674338, x5 = 0.012867534096761)
} else if(identical(name, "Osborne 2")) {
.start_sol[["target"]] <- c(x1 = 1.30997715328786, x2 = 0.633661697904263, x3 = 0.599430531018239,
x4 = 0.431553792022525, x5 = 0.754183220356582, x6 = 1.36581181488186,
x7 = 4.82369886594852, x8 = 0.904288595549707, x9 = 4.56887459992441,
x10 = 5.67534147196337, x11 = 2.39868486617073)
} else if(identical(name, "Hanson 1")) {
.start_sol[["target"]] <- c(x1 = 8.84420349211553, x2 = 0.123190563700324)
} else if(identical(name, "Hanson 2")) {
.start_sol[["target"]] <- c(x1 = 26.0785277317674, x2 = -0.0648890754465511, x3 = 0.0820989362396577)
} else if(identical(name, "Devilliers and Glasser 1")) {
.start_sol[["target"]] <- c(x1 = 60.137, x2 = 1.371, x3 = 3.112, x4 = 1.761)
} else if(identical(name, "Devilliers and Glasser 2")) {
.start_sol[["target"]] <- c(x1 = 53.81, x2 = 1.27, x3 = 3.012, x4 = 2.13, x5 = 0.507)
}
} else {
.start_sol <- list(
start = structure(rep(NA_real_, times = p), names = paste0("x", seq_len(p))),
target = structure(rep(NA_real_, times = p), names = paste0("x", seq_len(p)))
)
}
return(
structure(
list(
fn = .fn,
y = rep(0, n),
start = .start_sol[["start"]],
jac = .jac,
target = .start_sol[["target"]]
),
class = "nls_test_function"
)
)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.