aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2017-01-19 09:10:37 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2017-01-19 09:12:36 +0100
commitb8ac1393b9e1bef8c48b26b790cf5759ccd69fed (patch)
tree1167f81e8ec2feb25bdfc4ceeea0a91b7b6cc18f
parent3d4f6f8c582c19c38587ead305a1229ff069da63 (diff)
Predict parent decline without fitting for non-SFO models
-rw-r--r--NAMESPACE1
-rw-r--r--R/twa.R40
-rw-r--r--docs/reference/index.html2
-rw-r--r--docs/reference/one_box.html5
-rw-r--r--docs/reference/plot.one_box-2.pngbin11641 -> 5828 bytes
-rw-r--r--docs/reference/plot.one_box-4.pngbin0 -> 10603 bytes
-rw-r--r--docs/reference/plot.one_box.html8
-rw-r--r--man/one_box.Rd5
-rw-r--r--man/plot.one_box.Rd12
9 files changed, 63 insertions, 10 deletions
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
@@ -66,6 +66,34 @@ one_box.numeric <- function(x,
}
#' @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
one_box.mkinfit <- function(x, t_end = 100, res = 0.01, ...) {
@@ -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 @@
<p><a href="one_box.html">Create a time series of decline data</a></p>
<ul>
- <li><code><a href="one_box.html">one_box</a></code></li><li><code><a href="one_box.html">one_box.numeric</a></code></li><li><code><a href="one_box.html">one_box.mkinfit</a></code></li>
+ <li><code><a href="one_box.html">one_box</a></code></li><li><code><a href="one_box.html">one_box.numeric</a></code></li><li><code><a href="one_box.html">one_box.character</a></code></li><li><code><a href="one_box.html">one_box.mkinfit</a></code></li>
</ul>
<p><a href="plot.one_box.html">Plot time series of decline data</a></p>
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 <code>ts</code>.</p>
<span class='co'># S3 method for numeric</span>
<span class='fu'>one_box</span>(<span class='no'>x</span>, <span class='kw'>t_end</span> <span class='kw'>=</span> <span class='fl'>100</span>, <span class='kw'>res</span> <span class='kw'>=</span> <span class='fl'>0.01</span>, <span class='no'>...</span>)
+<span class='co'># S3 method for character</span>
+<span class='fu'>one_box</span>(<span class='no'>x</span>, <span class='no'>parms</span>, <span class='kw'>t_end</span> <span class='kw'>=</span> <span class='fl'>100</span>, <span class='kw'>res</span> <span class='kw'>=</span> <span class='fl'>0.01</span>, <span class='no'>...</span>)
+
<span class='co'># S3 method for mkinfit</span>
<span class='fu'>one_box</span>(<span class='no'>x</span>, <span class='kw'>t_end</span> <span class='kw'>=</span> <span class='fl'>100</span>, <span class='kw'>res</span> <span class='kw'>=</span> <span class='fl'>0.01</span>, <span class='no'>...</span>)</pre>
@@ -93,6 +96,8 @@ decline. If x is an mkinfit object, the decline is calculated from this object</
<dd>Resolution of the time series</dd>
<dt>...</dt>
<dd>Further arguments passed to methods</dd>
+ <dt>parms</dt>
+ <dd>A named numeric vector containing the model parameters</dd>
</dl>
diff --git a/docs/reference/plot.one_box-2.png b/docs/reference/plot.one_box-2.png
index 1941d44..1145f68 100644
--- a/docs/reference/plot.one_box-2.png
+++ b/docs/reference/plot.one_box-2.png
Binary files 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
--- /dev/null
+++ b/docs/reference/plot.one_box-4.png
Binary files 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.</dd>
<h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2>
- <pre class="examples"><div class='input'><span class='no'>fomc_fit</span> <span class='kw'>&lt;-</span> <span class='fu'>mkinfit</span>(<span class='st'>"FOMC"</span>, <span class='no'>FOCUS_2006_C</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)
-<span class='no'>fomc_pred</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='one_box.html'>one_box</a></span>(<span class='no'>fomc_fit</span>)
-<span class='fu'>plot</span>(<span class='fu'><a href='sawtooth.html'>sawtooth</a></span>(<span class='no'>fomc_pred</span>, <span class='fl'>3</span>, <span class='fl'>7</span>), <span class='kw'>max_twa</span> <span class='kw'>=</span> <span class='fl'>21</span>)</div><img src='plot.one_box-2.png' alt='' width='540' height='400' /></pre>
+ <pre class="examples"><div class='input'><span class='no'>dfop_pred</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='one_box.html'>one_box</a></span>(<span class='st'>"DFOP"</span>, <span class='kw'>parms</span> <span class='kw'>=</span> <span class='fu'>c</span>(<span class='kw'>k1</span> <span class='kw'>=</span> <span class='fl'>0.2</span>, <span class='kw'>k2</span> <span class='kw'>=</span> <span class='fl'>0.02</span>, <span class='kw'>g</span> <span class='kw'>=</span> <span class='fl'>0.7</span>))
+<span class='fu'>plot</span>(<span class='no'>dfop_pred</span>)</div><img src='plot.one_box-2.png' alt='' width='540' height='400' /><div class='input'><span class='fu'>plot</span>(<span class='fu'><a href='sawtooth.html'>sawtooth</a></span>(<span class='no'>dfop_pred</span>, <span class='fl'>3</span>, <span class='fl'>7</span>), <span class='kw'>max_twa</span> <span class='kw'>=</span> <span class='fl'>21</span>)</div><img src='plot.one_box-4.png' alt='' width='540' height='400' /><div class='input'>
+<span class='co'># Use a fitted mkinfit model</span>
+<span class='no'>m_2</span> <span class='kw'>&lt;-</span> <span class='fu'>mkinmod</span>(<span class='kw'>parent</span> <span class='kw'>=</span> <span class='fu'>mkinsub</span>(<span class='st'>"SFO"</span>, <span class='st'>"m1"</span>), <span class='kw'>m1</span> <span class='kw'>=</span> <span class='fu'>mkinsub</span>(<span class='st'>"SFO"</span>))</div><div class='output co'>#&gt; <span class='message'>Successfully compiled differential equation model from auto-generated C code.</span></div><div class='input'><span class='no'>fit_2</span> <span class='kw'>&lt;-</span> <span class='fu'>mkinfit</span>(<span class='no'>m_2</span>, <span class='no'>FOCUS_2006_D</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)
+<span class='no'>pred_2_saw</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='sawtooth.html'>sawtooth</a></span>(<span class='no'>pred_2</span>, <span class='fl'>2</span>, <span class='fl'>7</span>)</div><div class='output co'>#&gt; <span class='error'>Error in as.matrix(x): Objekt &#39;pred_2&#39; nicht gefunden</span></div><div class='input'><span class='fu'>plot</span>(<span class='no'>pred_2_saw</span>, <span class='kw'>max_twa</span> <span class='kw'>=</span> <span class='fl'>21</span>, <span class='kw'>max_twa_var</span> <span class='kw'>=</span> <span class='st'>"m1"</span>)</div><div class='output co'>#&gt; <span class='error'>Error in plot(pred_2_saw, max_twa = 21, max_twa_var = &quot;m1&quot;): Objekt &#39;pred_2_saw&#39; nicht gefunden</span></div></pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="sidebar">
<h2>Contents</h2>
diff --git a/man/one_box.Rd b/man/one_box.Rd
index 0085f3f..dc524a8 100644
--- a/man/one_box.Rd
+++ b/man/one_box.Rd
@@ -3,6 +3,7 @@
\name{one_box}
\alias{one_box}
\alias{one_box.numeric}
+\alias{one_box.character}
\alias{one_box.mkinfit}
\title{Create a time series of decline data}
\usage{
@@ -10,6 +11,8 @@ one_box(x, t_end = 100, res = 0.01, ...)
\method{one_box}{numeric}(x, t_end = 100, res = 0.01, ...)
+\method{one_box}{character}(x, parms, t_end = 100, res = 0.01, ...)
+
\method{one_box}{mkinfit}(x, t_end = 100, res = 0.01, ...)
}
\arguments{
@@ -21,6 +24,8 @@ decline. If x is an mkinfit object, the decline is calculated from this object}
\item{res}{Resolution of the time series}
\item{...}{Further arguments passed to methods}
+
+\item{parms}{A named numeric vector containing the model parameters}
}
\description{
The time series starts with the amount specified for the first application.
diff --git a/man/plot.one_box.Rd b/man/plot.one_box.Rd
index 6245b4c..e2c9a42 100644
--- a/man/plot.one_box.Rd
+++ b/man/plot.one_box.Rd
@@ -31,9 +31,15 @@ be shown if max_twa is not NULL.}
Plot time series of decline data
}
\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")
}
\seealso{
\code{\link{sawtooth}}

Contact - Imprint