Skip to content

Remove auto_exp, use type=LOG #261

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
lentinj wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Remove auto_exp, use type=LOG #261

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 1 addition & 17 deletions R/init_val.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,7 @@ g3_init_val <- function (
upper = if (!is.null(spread)) max(value * (1-spread), value * (1+spread)),
optimise = !is.null(lower) & !is.null(upper),
parscale = if (is.null(lower) || is.null(upper)) NULL else 'auto',
random = NULL,
auto_exponentiate = TRUE) {
random = NULL) {
stopifnot(is.data.frame(param_template) || is.list(param_template))
stopifnot(is.character(name_spec) && length(name_spec) == 1)
stopifnot(is.numeric(value) || is.null(value))
Expand All @@ -18,7 +17,6 @@ g3_init_val <- function (
stopifnot(is.logical(optimise) || is.null(optimise))
stopifnot(identical(parscale, 'auto') || is.numeric(parscale) || is.null(parscale))
stopifnot(is.logical(random) || is.null(random))
stopifnot(is.logical(auto_exponentiate))

# Parse name_spec --> regex
name_re <- paste0(vapply(strsplit(name_spec, ".", fixed = TRUE)[[1]], function (part) {
Expand Down Expand Up @@ -48,7 +46,6 @@ g3_init_val <- function (
name_re <- paste0(
'^',
name_re,
if (auto_exponentiate) '(_exp)?',
'$')
names_in <- if (is.data.frame(param_template)) param_template$switch else names(param_template)
m <- regmatches(names_in, regexec(name_re, names_in))
Expand All @@ -59,25 +56,15 @@ g3_init_val <- function (
return(param_template)
}

# Make boolean vector for all places to auto_exp
if (auto_exponentiate) {
auto_exp <- vapply(m, function(x) length(x) >= 2 && x[[2]] == '_exp', logical(1))
} else {
auto_exp <- FALSE
}

if (is.data.frame(param_template)) {
if (!is.null(value)) {
param_template[matches, 'value'] <- value
if (any(auto_exp)) param_template[auto_exp, 'value'] <- sapply(param_template[auto_exp, 'value'], log)
}
if (!is.null(lower)) {
param_template[matches, 'lower'] <- lower
if (any(auto_exp)) param_template[auto_exp, 'lower'] <- log(param_template[auto_exp, 'lower'])
}
if (!is.null(upper)) {
param_template[matches, 'upper'] <- upper
if (any(auto_exp)) param_template[auto_exp, 'upper'] <- log(param_template[auto_exp, 'upper'])
}
if (!is.null(random)) {
param_template[matches, 'random'] <- random
Expand All @@ -91,13 +78,11 @@ g3_init_val <- function (
}
if (!is.null(optimise)) param_template[matches, 'optimise'] <- optimise & !param_template[matches, 'random']
if (identical(parscale, 'auto')) {
# NB: Happens post-auto_exp, so don't need to apply it
param_template[matches, 'parscale'] <- diff(c(
param_template[matches, 'lower'],
param_template[matches, 'upper']), lag = length(param_template[matches, 'lower']))
} else if (!is.null(parscale)) {
param_template[matches, 'parscale'] <- parscale
if (any(auto_exp)) param_template[auto_exp, 'parscale'] <- log(param_template[auto_exp, 'parscale'])
}

m <- is.finite(unlist(param_template[matches, 'value'])) & is.finite(param_template[matches, 'lower']) &
Expand All @@ -124,7 +109,6 @@ g3_init_val <- function (
} else { # is.list
if (!is.null(value)) {
param_template[matches] <- value
if (any(auto_exp)) param_template[auto_exp] <- sapply(param_template[auto_exp], log)
}
}

Expand Down
5 changes: 3 additions & 2 deletions R/params.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -114,8 +114,6 @@ g3_parameterized <- function(
return(name_part)
}

if (exponentiate) name <- paste0(name, '_exp')

table_defn <- list()
stock_extra <- NULL

Expand Down Expand Up @@ -179,6 +177,9 @@ g3_parameterized <- function(
out <- substitute(g3_param(x), list(x = name))
}

# log() parameters going into model (we'll exp them further down)
if (exponentiate) out$type <- "LOG"

# Add ifmissing to output, turning strings into parameters
if (!is.null(ifmissing)) {
if (is.character(ifmissing)) ifmissing <- g3_parameterized(ifmissing, by_stock = by_stock)
Expand Down
7 changes: 1 addition & 6 deletions man/init_val.Rd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,7 @@ g3_init_val(
upper = if (!is.null(spread)) max(value * (1-spread), value * (1+spread)),
optimise = !is.null(lower) & !is.null(upper),
parscale = if (is.null(lower) || is.null(upper)) NULL else 'auto',
random = NULL,
auto_exponentiate = TRUE)
random = NULL)
}

\arguments{
Expand Down Expand Up @@ -58,10 +57,6 @@ g3_init_val(
If set to TRUE, any existing optimise/lower/upper/parscale values will be cleared.
Original value left if NULL
}
\item{auto_exponentiate}{
If TRUE, will implicitly match parameters ending with "_exp",
and if this is the case \code{log} all \var{value}/\var{lower}/\var{upper} values
}
}

\details{
Expand Down
2 changes: 1 addition & 1 deletion man/params.Rd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ g3_parameterized(
Either a numeric constant or character.
If character, add another parameter for ifmissing, using the same \var{by_stock} value.
}
\item{exponentiate}{Use \code{exp(value)} instead of the raw parameter value. Will add "_exp" to the parameter name.}
\item{exponentiate}{Optimise value in log space. Set \code{type="LOG"} on the parameter, and convert back to real space in the model}
\item{avoid_zero}{If TRUE, wrap parameter with \code{avoid_zero}}
\item{scale}{
Use \code{scale * value} instead of the raw parameter value.
Expand Down
25 changes: 3 additions & 22 deletions tests/test-init_val.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ library(gadget3)
default_pt <- function (sn) data.frame(
switch = sn,
value = I(as.list( rep(NA, length(sn)) )),
type = "",
lower = NA,
upper = NA,
parscale = NA,
Expand Down Expand Up @@ -195,28 +196,6 @@ ok(ut_cmp_equal(iv_options('x', value = -1, spread = 0.2), list(
optimise = TRUE,
random = FALSE)), "spread on a negative number still sets lower/upper bounds correctly")

#### auto_exp

pt <- default_pt(c('moo.1', 'moo.1_exp', 'baa.2', 'baa.2_exp', 'oink.1', 'oink.1_exp'))
ok(ut_cmp_equal(
g3_init_val(pt, '*.1', 4, auto_exponentiate = TRUE)$value,
I(list(4, log(4), NA, NA, 4, log(4)))), "log() values that are in _exp columns")
ok(ut_cmp_equal(
g3_init_val(pt, '*.1', lower = 22, auto_exponentiate = TRUE)$lower,
c(22, log(22), NA, NA, 22, log(22))), "Can auto_exp lower")
ok(ut_cmp_equal(
g3_init_val(pt, '*.1', upper = 22, auto_exponentiate = TRUE)$upper,
c(22, log(22), NA, NA, 22, log(22))), "Can auto_exp upper")
ok(ut_cmp_equal(
g3_init_val(pt, '*.1', 4, auto_exponentiate = FALSE)$value,
I(list(4, NA, NA, NA, 4, NA))), "Can disable auto_exponentiate, values aren't matched")
ok(ut_cmp_equal(
g3_init_val(pt, '*.1_exp', 8, auto_exponentiate = TRUE)$value,
I(list(NA, 8, NA, NA, NA, 8))), "Manual _exp matching still works, no log()")
ok(ut_cmp_equal(
g3_init_val(pt, '*.1_exp', 8, auto_exponentiate = FALSE)$value,
I(list(NA, 8, NA, NA, NA, 8))), "Manual _exp matching still works")

#### type="LOG"
pt <- default_pt(c("moo"))
pt$type <- "LOG"
Expand All @@ -234,6 +213,8 @@ ok(ut_cmp_equal(
g3_init_val(pt, "moo", 99)$value,
I(list(99)) ), "logarithmic: Can set positive values")

# TODO: Test a parameter that has been exponentiated?

#### Warning

cmp_contains <- function (a, b) {
Expand Down
8 changes: 0 additions & 8 deletions tests/test-run_r.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -212,14 +212,6 @@ ok_group('g3_param_table', {
paste('pt', 2000:2004, 3, sep = '.'),
'pg.2000.1',
'pg.2000.2'))), "Param table turned into multiple parameters, value set")

params.in <- attr(g3_to_r(list( g3a_time(1990, 2000), g3_formula(
quote(d),
d = g3_parameterized('par.years', value = 0, by_year = TRUE, exponentiate = TRUE),
x = NA) )), 'parameter_template')
ok(ut_cmp_identical(grep('^par', names(params.in), value = TRUE), c(
paste0('par.years.', 1990:2000, '_exp'),
NULL)), "exponentiate prefix ends up at the end of parameters")
})

ok_group('parameter_template default', {
Expand Down
7 changes: 4 additions & 3 deletions tests/test-run_tmb.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1090,15 +1090,16 @@ expecteds$param_table_ifmpartab_out <- array(c(

# g3_param_table(by_year, exponentiate)
param_table_byyrexp_out <- 0.0
params[["byyrexp.1990_exp"]] <- 19
params[["byyrexp.1991_exp"]] <- 20
params[["byyrexp.1990"]] <- 19
params[["byyrexp.1991"]] <- 20
actions <- c(actions, gadget3:::f_substitute(~{
param_table_byyrexp_out <- x
REPORT(param_table_byyrexp_out)
}, list(
x = g3_parameterized("byyrexp", by_year = TRUE, exponentiate = TRUE),
end = NULL )))
expecteds$param_table_byyrexp_out <- exp(19)
expecteds$param_table_byyrexp_out <- 19
# TODO: How do we test exponentiate actually did summat?

# g3_param_table w/clashing names
# NB: This isn't a great situation to be in, but should at least work to make it easier to unpick
Expand Down
Loading