From b8ac1393b9e1bef8c48b26b790cf5759ccd69fed Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Thu, 19 Jan 2017 09:10:37 +0100 Subject: Predict parent decline without fitting for non-SFO models --- NAMESPACE | 1 + R/twa.R | 40 +++++++++++++++++++++++++++++++++++--- docs/reference/index.html | 2 +- docs/reference/one_box.html | 5 +++++ docs/reference/plot.one_box-2.png | Bin 11641 -> 5828 bytes docs/reference/plot.one_box-4.png | Bin 0 -> 10603 bytes docs/reference/plot.one_box.html | 8 +++++--- man/one_box.Rd | 5 +++++ man/plot.one_box.Rd | 12 +++++++++--- 9 files changed, 63 insertions(+), 10 deletions(-) create mode 100644 docs/reference/plot.one_box-4.png diff --git a/NAMESPACE b/NAMESPACE index af0eefa..c4d671f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ S3method(GUS,chent) S3method(GUS,numeric) S3method(max_twa,one_box) +S3method(one_box,character) S3method(one_box,mkinfit) S3method(one_box,numeric) S3method(plot,TOXSWA_cwa) diff --git a/R/twa.R b/R/twa.R index 59e15f9..e3c0076 100644 --- a/R/twa.R +++ b/R/twa.R @@ -65,6 +65,34 @@ one_box.numeric <- function(x, return(result) } +#' @rdname one_box +#' @param parms A named numeric vector containing the model parameters +#' @export +one_box.character <- function(x, parms, + t_end = 100, res = 0.01, ...) +{ + parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE") + if (length(x) == 1 & x %in% parent_models_available) { + m <- mkinmod(parent = mkinsub(x)) + } else { + stop("If you specify the decline model using a character string, ", + "x has to be one of\n ", + paste(parent_models_available, collapse = ", ")) + } + + if (!setequal(names(parms), m$par)) { + stop("Please supply the parameters\n", + paste(m$par, collapse = ", ")) + } + + t_out <- seq(0, t_end, by = res) + pred <- mkinpredict(m, odeparms = parms, odeini = c(parent = 1), + outtimes = t_out, solution_type = "analytical")[-1] + result <- ts(pred, 0, t_end, frequency = 1/res) + class(result) <- c("one_box", "ts") + return(result) +} + #' @rdname one_box #' @importFrom mkin mkinpredict #' @export @@ -99,9 +127,15 @@ one_box.mkinfit <- function(x, t_end = 100, res = 0.01, ...) { #' @seealso \code{\link{sawtooth}} #' @export #' @examples -#' fomc_fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE) -#' fomc_pred <- one_box(fomc_fit) -#' plot(sawtooth(fomc_pred, 3, 7), max_twa = 21) +#' dfop_pred <- one_box("DFOP", parms = c(k1 = 0.2, k2 = 0.02, g = 0.7)) +#' plot(dfop_pred) +#' plot(sawtooth(dfop_pred, 3, 7), max_twa = 21) +#' +#' # Use a fitted mkinfit model +#' m_2 <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO")) +#' fit_2 <- mkinfit(m_2, FOCUS_2006_D, quiet = TRUE) +#' pred_2_saw <- sawtooth(pred_2, 2, 7) +#' plot(pred_2_saw, max_twa = 21, max_twa_var = "m1") plot.one_box <- function(x, xlim = range(time(x)), ylim = c(0, max(x)), xlab = "Time", ylab = "Fraction of initial", diff --git a/docs/reference/index.html b/docs/reference/index.html index e458048..8f57cd2 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -82,7 +82,7 @@

Create a time series of decline data

Plot time series of decline data

diff --git a/docs/reference/one_box.html b/docs/reference/one_box.html index 791528a..c8f8ad3 100644 --- a/docs/reference/one_box.html +++ b/docs/reference/one_box.html @@ -79,6 +79,9 @@ This does not create objects of type ts.

# S3 method for numeric one_box(x, t_end = 100, res = 0.01, ...) +# S3 method for character +one_box(x, parms, t_end = 100, res = 0.01, ...) + # S3 method for mkinfit one_box(x, t_end = 100, res = 0.01, ...) @@ -93,6 +96,8 @@ decline. If x is an mkinfit object, the decline is calculated from this objectResolution of the time series
...
Further arguments passed to methods
+
parms
+
A named numeric vector containing the model parameters
diff --git a/docs/reference/plot.one_box-2.png b/docs/reference/plot.one_box-2.png index 1941d44..1145f68 100644 Binary files a/docs/reference/plot.one_box-2.png and b/docs/reference/plot.one_box-2.png differ diff --git a/docs/reference/plot.one_box-4.png b/docs/reference/plot.one_box-4.png new file mode 100644 index 0000000..9664c14 Binary files /dev/null and b/docs/reference/plot.one_box-4.png differ diff --git a/docs/reference/plot.one_box.html b/docs/reference/plot.one_box.html index 235fb80..ec784c5 100644 --- a/docs/reference/plot.one_box.html +++ b/docs/reference/plot.one_box.html @@ -106,9 +106,11 @@ be shown if max_twa is not NULL.

Examples

- 
fomc_fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)
-fomc_pred <- one_box(fomc_fit)
-plot(sawtooth(fomc_pred, 3, 7), max_twa = 21)
+ 
dfop_pred <- one_box("DFOP", parms = c(k1 = 0.2, k2 = 0.02, g = 0.7))
+plot(dfop_pred)
plot(sawtooth(dfop_pred, 3, 7), max_twa = 21)

+# Use a fitted mkinfit model
+m_2 <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"))
#> Successfully compiled differential equation model from auto-generated C code.
fit_2 <- mkinfit(m_2, FOCUS_2006_D, quiet = TRUE)
+pred_2_saw <- sawtooth(pred_2, 2, 7)
#> Error in as.matrix(x): Objekt 'pred_2' nicht gefunden
plot(pred_2_saw, max_twa = 21, max_twa_var = "m1")
#> Error in plot(pred_2_saw, max_twa = 21, max_twa_var = "m1"): Objekt 'pred_2_saw' nicht gefunden