Commit 165c3f44 authored by Poppy Miller's avatar Poppy Miller
Browse files

State of package before submitting to CRAN (re-added correct code to fix calc_lambda_j_prop)

parent e636df90
test <- R6::R6Class(
"test",
private = list(
x1 = NULL,
x2 = NULL,
x3 = R6::R6Class(
"x3",
public = list(
a = NULL,
b = NULL,
initialize = function(x3, x1 = private$x1) {
private$c = x3$c
private$d = x3$d
self$a = x1
self$b = x3$b
}
),
private = list(
c = NULL,
d = NULL
)
)
),
public = list(
initialize = function(x1 = NA, x2 = NA, x3 = list())
{
private$x1 <- x1
private$x2 <- x2
if (is.null(private$x3$a)) {
private$x3 <- private$x3$new(x3, x1)
} else {
stop("something is already here!")
}
},
extract = function()
{
return(list(x1 = private$x1, x2 = private$x2, x3 = private$x3))
}
)
)
res <- test$new(x1 = 1, x2 = 2, list(a=3, b=4, c=5, d=6))
res
res$extract()
#' Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.
#'
#' A dataset containing the number of human cases of campylobacteriosis and numbers of source samples
#' positive for \emph{Campylobacter} for each bacterial subtype.
#'
#' @format A data frame with 115 rows and 10 variables:
#' \describe{
#' \item{Human}{number of human cases of campylobacteriosis between 2005-2008 in the Manawatu
#' region of New Zealand}
#' \item{ChickenA}{number of samples of chicken from supplier A out of a total of 239 tested}
#' \item{ChickenB}{number of samples of chicken from supplier B out of a total of 196 tested}
#' \item{ChickenC}{number of samples of chicken from supplier C out of a total of 127 tested}
#' \item{Bovine}{number of bovine samples out of a total of 595 tested}
#' \item{Ovine}{number of ovine samples out of a total of 552 tested}
#' \item{Environment}{number of environmental samples out of a total of 524 tested}
#' \item{Time}{Time id for the samples}
#' \item{Location}{Location id for the samples}
#' \item{Type}{MLST type id for the samples}
#' }
"campy"
......@@ -6,7 +6,6 @@
# Purpose: Source attribution model interface #
#####################################################
#' Runs the HaldDP source attribution model
#'
#' @docType class
......@@ -220,7 +219,7 @@
#'
#' The parameters are defined as follows:
#' \deqn{a_{jtl}} is the unknown source effect for source \eqn{j}, time \eqn{t}, location \eqn{l}
#' \deqn{q_{k(i)}} is the unknown type effect for type \eqn{i} in group \eqn{k}.
#' \deqn{q_{s(i)}} is the unknown type effect for type \eqn{i} in group \eqn{s}.
#' \deqn{x_{ij}} is the known number of positive samples for each source \eqn{j} type\eqn{i} combination
#' \deqn{n_{ij}} is the known total number of samples for each source \eqn{j} type \eqn{i} combination
#' \deqn{k_{j}} is the fixed prevalence in source (i.e. the number of positive samples
......@@ -328,7 +327,6 @@ HaldDP <- R6::R6Class(
alpha_updaters = NULL,
updaters = NULL,
save_chain_state = function(iter)
# FINISHED
{
for (time in 1:private$nTimes) {
for (location in 1:private$nLocations) {
......@@ -346,7 +344,6 @@ HaldDP <- R6::R6Class(
private$posterior$s[, iter] <- private$DPModel_impl$qNodes$s
},
create_posterior = function()
# FINISHED
{
if (private$append == FALSE |
isTRUE(all.equal(private$n_iter_old, 0)))
......@@ -401,7 +398,6 @@ HaldDP <- R6::R6Class(
}
},
assign_updaters = function()
# FINISHED
{
r_updaters <- list()
alpha_updaters <- list()
......@@ -468,7 +464,6 @@ HaldDP <- R6::R6Class(
recursive = TRUE)
},
set_data = function(data)
# FINISHED
{
if (!is.data.frame(data))
stop("data must be a data frame.")
......@@ -596,7 +591,6 @@ HaldDP <- R6::R6Class(
}
},
set_k = function(k)
# FINISHED
{
if (!is.data.frame(k))
stop("k must be a data frame.")
......@@ -642,7 +636,6 @@ HaldDP <- R6::R6Class(
}
},
set_a_q = function(a_q)
# FINISHED
{
if (length(a_q) != 1 |
!isFinitePositive(a_q) |
......@@ -651,7 +644,6 @@ HaldDP <- R6::R6Class(
private$a_q <- a_q
},
set_priors = function(priors)
# FINISHED
{
if (!is.list(priors) |
!all(c("a_alpha", "a_r", "a_theta", "b_theta") %in% names(priors)))
......@@ -804,7 +796,6 @@ HaldDP <- R6::R6Class(
private$priors <- HaldDP_priors$new(priors)
},
set_inits = function(inits)
# FINISHED
{
## r values
if (!("r" %in% names(inits))) {
......@@ -990,7 +981,6 @@ HaldDP <- R6::R6Class(
},
set_niter = function(n_iter)
# FINISHED
{
## check n_iter
if (isFiniteInteger(n_iter) &
......@@ -1005,7 +995,6 @@ HaldDP <- R6::R6Class(
}
},
set_append = function(append)
# FINISHED
{
if (isFiniteLogical(append) & length(append) == 1)
{
......@@ -1016,7 +1005,6 @@ HaldDP <- R6::R6Class(
}
},
set_burn_in = function(burn_in)
# FINISHED
{
if (!isFiniteInteger(burn_in) | burn_in < 0) {
stop("burn_in is not a positive integer.")
......@@ -1025,7 +1013,6 @@ HaldDP <- R6::R6Class(
}
},
set_thin = function(thin)
# FINISHED
{
if (!isFiniteInteger(thin) | thin <= 0) {
stop("thin is not a positive integer.")
......@@ -1034,7 +1021,6 @@ HaldDP <- R6::R6Class(
}
},
set_n_r = function(n_r)
# FINISHED
{
if (!isFiniteInteger(n_r) | n_r <= 0 | n_r > private$nTypes) {
stop("n_r is not a positive real number or it is larger than the number of types.")
......@@ -1043,7 +1029,6 @@ HaldDP <- R6::R6Class(
}
},
set_params_fix = function(params_fix)
# FINISHED
{
if (is.null(params_fix))
{
......@@ -1100,7 +1085,6 @@ HaldDP <- R6::R6Class(
},
flatten_alpha = function(object)
# FINISHED
{
res <- NULL
ncol_old = 0
......@@ -1121,14 +1105,12 @@ HaldDP <- R6::R6Class(
return(res)
},
flatten_q_s = function(object, names)
# FINISHED
{
res <- t(object)
colnames(res) <- paste(names, colnames(res), sep = "_")
return(res)
},
flatten_r = function(object)
# FINISHED
{
res <- NULL
ncol_old = 0
......@@ -1147,7 +1129,6 @@ HaldDP <- R6::R6Class(
return(res)
},
flatten_lambda_i = function(object)
# FINISHED
{
res <- NULL
ncol_old = 0
......@@ -1168,7 +1149,6 @@ HaldDP <- R6::R6Class(
return(res)
},
flatten_lambda_j = function(object)
# FINISHED
{
res <- NULL
ncol_old = 0
......@@ -1192,7 +1172,6 @@ HaldDP <- R6::R6Class(
calc_CI = function(x, alpha, CI_type)
{
# x is the MCMC output
if (!is.atomic(alpha) |
!isFinitePositive(alpha) |
alpha > 1)
......@@ -1210,7 +1189,6 @@ HaldDP <- R6::R6Class(
},
calc_CI_alpha = function(object, alpha, CI_type)
# FINISHED
{
res <- array(
dim = c(dim(object)[1],
......@@ -1236,7 +1214,6 @@ HaldDP <- R6::R6Class(
return(res)
},
calc_CI_q = function(object, alpha, CI_type)
# FINISHED
{
res <-
sapply(setNames(1:dim(object)[1], dimnames(object)$type), function(x)
......@@ -1245,7 +1222,6 @@ HaldDP <- R6::R6Class(
return(res)
},
calc_CI_r = function(object, alpha, CI_type)
# FINISHED
{
res <- array(
dim = c(dim(object)[1],
......@@ -1271,7 +1247,6 @@ HaldDP <- R6::R6Class(
return(res)
},
calc_CI_lambda_i = function(object, alpha, CI_type)
# FINISHED
{
res <- array(
dim = c(dim(object)[1],
......@@ -1296,7 +1271,6 @@ HaldDP <- R6::R6Class(
return(res)
},
calc_CI_lambda_j = function(object, alpha, CI_type)
# FINISHED
{
res <- array(
dim = c(dim(object)[1],
......@@ -1328,7 +1302,6 @@ HaldDP <- R6::R6Class(
types,
iters,
flatten)
# FINISHED
{
if (!mode(params) %in% c("character") |
length(params) > 7 |
......@@ -1513,7 +1486,6 @@ HaldDP <- R6::R6Class(
public = list(
#TODO : change r init to an x/colsums(x) and remove from model!
initialize = function(data, k, priors, a_q, inits = NULL)
# FINISHED
{
## read in data
private$set_data(data) # sets y, X, names and number of sources, types, times and locations
......@@ -1566,7 +1538,6 @@ HaldDP <- R6::R6Class(
private$create_posterior()
},
update = function(n_iter, append = TRUE)
# FINISHED
{
if (!missing(append)) {
if (all(is.na(private$posterior$r))) {
......@@ -1687,7 +1658,6 @@ HaldDP <- R6::R6Class(
## Functions to access the data and results
print_data = function()
# FINISHED
{
return(
list(
......@@ -1708,18 +1678,15 @@ HaldDP <- R6::R6Class(
)
},
print_priors = function()
# FINISHED
{
return(list(priors = private$priors,
a_q = private$a_q))
},
print_inits = function()
# FINISHED
{
return(private$inits)
},
print_fit_params = function()
# FINISHED
{
return(
list(
......@@ -1732,13 +1699,11 @@ HaldDP <- R6::R6Class(
)
},
print_acceptance = function()
# FINISHED
{
return(private$acceptance)
},
extract = function(params = c("alpha", "q", "s", "r", "lambda_i", "lambda_j", "lambda_j_prop"),
# FINISHED
times = NULL,
locations = NULL,
sources = NULL,
......@@ -1746,7 +1711,7 @@ HaldDP <- R6::R6Class(
iters = NULL,
flatten = FALSE,
drop = TRUE)
# FINISHED
{
params_checked <-
private$check_extract_summary_params(params, times, locations,
......@@ -1836,7 +1801,7 @@ HaldDP <- R6::R6Class(
iters = NULL,
flatten = FALSE,
CI_type = "chen-shao")
# FINISHED
{
object <-
self$extract(params, times, locations, sources, types, iters, flatten, drop = F)
......
......@@ -117,12 +117,25 @@ Posterior_HaldDP = R6::R6Class(
}
},
calc_lambda_j_prop = function() {
# TODO: check with multiple times and locations
if (is.null(self$lambda_j)) self$calc_lambda_j()
calc_lambda_j_prop = function(n_iter, nSources, nTimes,
nLocations,
namesSources, namesTimes,
namesLocations,
namesIters,
k) {
if (is.null(self$lambda_j)) self$calc_lambda_j(nSources, nTimes,
nLocations, nTypes, n_iter,
namesSources, namesTimes,
namesLocations, namesTypes,
namesIters)
self$lambda_j_prop <- self$lambda_j
for (iter in 1:dim(self$lambda_j)[4]) {
self$lambda_j_prop[,,,iter] <- self$lambda_j[,,,iter] / sum(self$lambda_j[,,,iter])
for (times in 1:nTimes) {
for (locations in 1:nLocations) {
self$lambda_j_prop[,times,locations,iter] <-
self$lambda_j[,times,locations,iter] / sum(self$lambda_j[,times,locations,iter])
}
}
}
}
)
......
#' Simulated data: Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.
#'
#' A simulated dataset containing the number of human cases of campylobacteriosis and numbers of source samples
#' positive for \emph{Campylobacter} for each bacterial subtype.
#'
#' @format A data frame with 364 rows and 10 variables:
#' \describe{
#' \item{Human}{number of human cases of campylobacteriosis}
#' \item{Source1}{number of Source1 samples}
#' \item{Source2}{number of Source2 samples}
#' \item{Source3}{number of Source3 samples}
#' \item{Source4}{number of Source4 samples}
#' \item{Source5}{number of Source5 samples}
#' \item{Source6}{number of Source6 samples}
#' \item{Time}{Time id for the samples}
#' \item{Location}{Location id for the samples}
#' \item{Type}{MLST type id for the samples}
#' }
"sim_SA_data"
#' Simulated data prevalences.
#'
#' Source prevalences for the simulated data (sim_SA_data).
#'
#' @format A data frame with 12 rows and 3 variables:
#' \describe{
#' \item{Value}{prevalence values}
#' \item{Time}{Time id for the samples}
#' \item{Source}{Source id for the samples}
#' }
"sim_SA_prev"
#' True values for the parameters generating the simulated data.
#'
#' A list containing the true values of the parameters used to simulate the sim_SA_data dataset.
#'
#' @format A list with 5 items:
#' \describe{
#' \item{alpha}{A dataframe with 24 rows and 4 variables: Value contains the true alpha values,
#' Time, Location and Source contain the time, location and source id's respectively.}
#' \item{q}{A dataframe with 91 rows and 2 variables: Value contains the true q values, and
#' Type contains the type id's.}
#' \item{lambda_i}{A dataframe with 364 rows and 4 variables: Value contains the true lambda_i values,
#' Time, Location and Type contain the time, location and type id's respectively.}
#' \item{lambda_j}{A dataframe with 24 rows and 4 variables: Value contains the true lambda_j values,
#' Time, Location and Source contain the time, location and source id's respectively.}
#' \item{r}{A dataframe with 2184 rows and 5 variables: Value contains the true r values,
#' Time, Type, Location and Source contain the time, type, location and source id's respectively.}
#' }
"sim_SA_true"
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/campy.R
\docType{data}
\name{campy}
\alias{campy}
\title{Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.}
\format{A data frame with 115 rows and 10 variables:
\describe{
\item{Human}{number of human cases of campylobacteriosis between 2005-2008 in the Manawatu
region of New Zealand}
\item{ChickenA}{number of samples of chicken from supplier A out of a total of 239 tested}
\item{ChickenB}{number of samples of chicken from supplier B out of a total of 196 tested}
\item{ChickenC}{number of samples of chicken from supplier C out of a total of 127 tested}
\item{Bovine}{number of bovine samples out of a total of 595 tested}
\item{Ovine}{number of ovine samples out of a total of 552 tested}
\item{Environment}{number of environmental samples out of a total of 524 tested}
\item{Time}{Time id for the samples}
\item{Location}{Location id for the samples}
\item{Type}{MLST type id for the samples}
}}
\usage{
campy
}
\description{
A dataset containing the number of human cases of campylobacteriosis and numbers of source samples
positive for \emph{Campylobacter} for each bacterial subtype.
}
\keyword{datasets}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/sim_SA_data.R
\docType{data}
\name{sim_SA_data}
\alias{sim_SA_data}
\title{Simulated data: Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.}
\format{A data frame with 364 rows and 10 variables:
\describe{
\item{Human}{number of human cases of campylobacteriosis}
\item{Source1}{number of Source1 samples}
\item{Source2}{number of Source2 samples}
\item{Source3}{number of Source3 samples}
\item{Source4}{number of Source4 samples}
\item{Source5}{number of Source5 samples}
\item{Source6}{number of Source6 samples}
\item{Time}{Time id for the samples}
\item{Location}{Location id for the samples}
\item{Type}{MLST type id for the samples}
}}
\usage{
sim_SA_data
}
\description{
A simulated dataset containing the number of human cases of campylobacteriosis and numbers of source samples
positive for \emph{Campylobacter} for each bacterial subtype.
}
\keyword{datasets}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/sim_SA_prev.R
\docType{data}
\name{sim_SA_prev}
\alias{sim_SA_prev}
\title{Simulated data prevalences.}
\format{A data frame with 12 rows and 3 variables:
\describe{
\item{Value}{prevalence values}
\item{Time}{Time id for the samples}
\item{Source}{Source id for the samples}
}}
\usage{
sim_SA_prev
}
\description{
Source prevalences for the simulated data (sim_SA_data).
}
\keyword{datasets}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/sim_SA_true.R
\docType{data}
\name{sim_SA_true}
\alias{sim_SA_true}
\title{True values for the parameters generating the simulated data.}
\format{A list with 5 items:
\describe{
\item{alpha}{A dataframe with 24 rows and 4 variables: Value contains the true alpha values,
Time, Location and Source contain the time, location and source id's respectively.}
\item{q}{A dataframe with 91 rows and 2 variables: Value contains the true q values, and
Type contains the type id's.}
\item{lambda_i}{A dataframe with 364 rows and 4 variables: Value contains the true lambda_i values,
Time, Location and Type contain the time, location and type id's respectively.}
\item{lambda_j}{A dataframe with 24 rows and 4 variables: Value contains the true lambda_j values,
Time, Location and Source contain the time, location and source id's respectively.}
\item{r}{A dataframe with 2184 rows and 5 variables: Value contains the true r values,
Time, Type, Location and Source contain the time, type, location and source id's respectively.}
}}
\usage{
sim_SA_true
}
\description{
A list containing the true values of the parameters used to simulate the sim_SA_data dataset.
}
\keyword{datasets}
  • Didn't actually submit to cran. Upload failed, then found bug, so didn't upload again.

Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment