]> nmode's Git Repositories - Rnaught/commitdiff
Remove input args from output lists
authorNaeem Model <me@nmode.ca>
Wed, 21 Jun 2023 06:17:43 +0000 (06:17 +0000)
committerNaeem Model <me@nmode.ca>
Wed, 21 Jun 2023 06:17:43 +0000 (06:17 +0000)
R/ID.R
R/IDEA.R
R/WP.R
R/WP_known.R
R/WP_unknown.R
R/seqB.R

diff --git a/R/ID.R b/R/ID.R
index 7b0a1b97815cce42f9606c51aa57cd4dc685809d..b5fc8c2e78c7139aa4e696510bc3bf34e1921400 100644 (file)
--- a/R/ID.R
+++ b/R/ID.R
 #'         \code{inputs} is a list of the original input variables \code{NT, mu}.\r
 #'\r
 #' @examples\r
-#'\r
 #' ## ===================================================== ##\r
 #' ## Illustrate on weekly data                             ##\r
 #' ## ===================================================== ##\r
 #'\r
 #' NT <- c(1, 4, 10, 5, 3, 4, 19, 3, 3, 14, 4)\r
 #' ## obtain Rhat when serial distribution has mean of five days\r
-#' res1 <- ID(NT=NT, mu=5/7)\r
-#' res1$Rhat\r
+#' ID(NT=NT, mu=5/7)\r
 #' ## obtain Rhat when serial distribution has mean of three days\r
-#' res2        <- ID(NT=NT, mu=3/7)\r
-#' res2$Rhat\r
+#' ID(NT=NT, mu=3/7)\r
 #'\r
 #' ## ========================================================= ##\r
 #' ## Compute Rhat using only the first five weeks of data      ##\r
 #' ## ========================================================= ##\r
 #'\r
-#'\r
-#' res3 <- ID(NT=NT[1:5], mu=5/7)              # serial distribution has mean of five days\r
-#' res3$Rhat\r
+#' ID(NT=NT[1:5], mu=5/7) # serial distribution has mean of five days\r
 #'\r
 #' @export\r
 ID <- function(NT, mu) {\r
@@ -50,5 +45,5 @@ ID <- function(NT, mu) {
 \r
     R0_ID <- exp(sum(y) / TT)\r
 \r
-    return(list=c(Rhat=R0_ID, inputs=list(NT=NT, mu=mu)))\r
+    return(R0_ID)\r
 }\r
index 7668540c66755d9025167a9e789cb27da98a0875..53cfaa7626b2fc31d18052faaf909d1947aead3b 100644 (file)
--- a/R/IDEA.R
+++ b/R/IDEA.R
 #'         \code{inputs} is a list of the original input variables \code{NT, mu}.\r
 #'\r
 #' @examples\r
-#'\r
 #' ## ===================================================== ##\r
 #' ## Illustrate on weekly data                             ##\r
 #' ## ===================================================== ##\r
 #'\r
 #' NT <- c(1, 4, 10, 5, 3, 4, 19, 3, 3, 14, 4)\r
 #' ## obtain Rhat when serial distribution has mean of five days\r
-#' res1 <- IDEA(NT=NT, mu=5/7)\r
-#' res1$Rhat\r
+#' IDEA(NT=NT, mu=5/7)\r
 #' ## obtain Rhat when serial distribution has mean of three days\r
-#' res2        <- IDEA(NT=NT, mu=3/7)\r
-#' res2$Rhat\r
+#' IDEA(NT=NT, mu=3/7)\r
 #'\r
 #' ## ========================================================= ##\r
 #' ## Compute Rhat using only the first five weeks of data      ##\r
 #' ## ========================================================= ##\r
 #'\r
-#'\r
-#' res3 <- IDEA(NT=NT[1:5], mu=5/7)            # serial distribution has mean of five days\r
-#' res3$Rhat\r
+#' IDEA(NT=NT[1:5], mu=5/7) # serial distribution has mean of five days\r
 #'\r
 #' @export\r
 IDEA <- function(NT, mu) {\r
@@ -59,6 +54,6 @@ IDEA <- function(NT, mu) {
         IDEA2 <- TT * sum(y2) - sum(s)^2\r
         IDEA <- exp(IDEA1 / IDEA2)\r
 \r
-        return(list(Rhat=IDEA, inputs=list(NT=NT, mu=mu)))\r
+        return(IDEA)\r
     }\r
 }\r
diff --git a/R/WP.R b/R/WP.R
index 9e44bf9e35b7a02c501e3eddb8d5067bd6d10540..8d528d5a13958efb20e1f754e58762a4270a2b56 100644 (file)
--- a/R/WP.R
+++ b/R/WP.R
 #' res3        <- WP(NT=NT)    
 #' res3$Rhat
 #' ## find mean of estimated serial distribution
-#' serial      <-      res3$SD
-#' sum(serial$supp*serial$pmf)
+#' serial <- res3$SD
+#' sum(serial$supp * serial$pmf)
 #'
 #' ## ========================================================= ##
 #' ## Compute Rhat using only the first five weeks of data      ##
 #' ## ========================================================= ##
 #' 
-#' res4 <- WP(NT=NT[1:5], mu=5/7, method="known")      # serial distribution has mean of five days
+#' res4 <- WP(NT=NT[1:5], mu=5/7, method="known") # serial distribution has mean of five days
 #' res4$Rhat
 #'
 #' @export
@@ -99,10 +99,10 @@ WP <- function(NT, mu="NA", method="unknown", search=list(B=100, shape.max=10, s
             p <- diff(pexp(0:range.max, 1/mu))
             p <- p / sum(p)
             res <- WP_known(NT=NT, p=p)
-            Rhat <- res$Rhat
+            Rhat <- res
             JJ <- NA
         }
     }
 
-    return(list(Rhat=Rhat, check=length(JJ), SD=list(supp=1:range.max, pmf=p), inputs=list(NT=NT, mu=mu, method=method, search=search, tol=tol)))
+    return(list(Rhat=Rhat, check=length(JJ), SD=list(supp=1:range.max, pmf=p)))
 }
index 6b0e2eaaf08dfae932cc9a074d3ea33a51bd3247..563b7ae3ab9e3ebb6267ce1e19208336d35cc57a 100644 (file)
@@ -19,5 +19,5 @@ WP_known <- function(NT, p) {
     }
 
     Rhat <- sum(NT[-1]) / sum(mu_t)
-       return(list(Rhat=Rhat))
+       return(Rhat)
 }
index c5b0a356483b6369d37cd3bcbd77889cc5dd3886..ebb7cc71760213d2be0e98133c64919975ec7f7a 100644 (file)
@@ -36,8 +36,8 @@ WP_unknown <- function(NT, B=100, shape.max=10, scale.max=10, tol=0.999) {
             p <- diff(pgamma(0:range.max, shape=shape[i], scale=scale[j]))
             p <- p / sum(p)
             mle <- WP_known(NT, p)
-            resLL[i,j] <- computeLL(p, NT, mle$R)
-            resR0[i,j] <- mle$R
+            resLL[i,j] <- computeLL(p, NT, mle)
+            resR0[i,j] <- mle
         }
     }
        
index 0f8a1b93d0c10eefcf7b6441c617d5aa79128174..7938311f2f853179d607461ba05f0616a947e175 100644 (file)
--- a/R/seqB.R
+++ b/R/seqB.R
 #' ## ============================================================= ##
 #'
 #' Rpost <-    res1$posterior
-#' loc <- which(Rpost$pmf==max(Rpost$pmf))
-#' Rpost$supp[loc]             # posterior mode
-#' res1$Rhat           # compare with posterior mean
+#' loc <- which(Rpost$pmf == max(Rpost$pmf))
+#' Rpost$supp[loc] # posterior mode
+#' res1$Rhat # compare with posterior mean
 #'
-#' par(mfrow=c(2,1), mar=c(2,2,1,1))
+#' par(mfrow=c(2, 1), mar=c(2, 2, 1, 1))
 #' plot(Rpost$supp, Rpost$pmf, col="black", type="l", xlab="", ylab="")
 #' abline(h=1/(20/0.01+1), col="red")
 #' abline(v=res1$Rhat, col="blue")
 #' abline(v=Rpost$supp[loc], col="purple")
 #' legend("topright", legend=c("prior", "posterior", "posterior mean (Rhat)", "posterior mode"), col=c("red", "black", "blue", "purple"), lty=1)
-#' plot(Rpost$supp, Rpost$pmf, col="black", type="l", xlim=c(0.5,1.5), xlab="", ylab="")
+#' plot(Rpost$supp, Rpost$pmf, col="black", type="l", xlim=c(0.5, 1.5), xlab="", ylab="")
 #' abline(h=1/(20/0.01+1), col="red")
 #' abline(v=res1$Rhat, col="blue")
 #' abline(v=Rpost$supp[loc], col="purple")
@@ -70,7 +70,6 @@
 #' ## ========================================================= ##
 #' ## Compute Rhat using only the first five weeks of data      ##
 #' ## ========================================================= ##
-#'
 #' 
 #' res3 <- seqB(NT=NT[1:5], mu=5/7)    # serial distribution has mean of five days
 #' res3$Rhat
@@ -121,6 +120,6 @@ seqB <- function(NT, mu, kappa=20) {
 
         Rhat <- sum(R * posterior)
 
-        return(list(Rhat=Rhat, posterior=list(supp=R, pmf=posterior), group=group, inputs=list(NT=NT, mu=mu, kappa=kappa)))
+        return(list(Rhat=Rhat, posterior=list(supp=R, pmf=posterior), group=group))
     }  
 }