Skip to content

Commit

Permalink
update
Browse files Browse the repository at this point in the history
  • Loading branch information
Lam Ho authored and Lam Ho committed Mar 19, 2018
1 parent 97efdf4 commit f142972
Show file tree
Hide file tree
Showing 19 changed files with 497 additions and 97 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: MultiBD
Type: Package
Title: Multivariate Birth-Death Processes
Version: 0.2.0
Date: 2016-07-19
Version: 0.2.1
Date: 2018-03-19
Author: Lam S.T. Ho [aut, cre],
Marc A. Suchard [aut],
Forrest W. Crawford [aut],
Expand All @@ -29,5 +29,5 @@ Suggests:
ggplot2,
matrixStats,
plotrix
RoxygenNote: 5.0.1
RoxygenNote: 6.0.1
VignetteBuilder: knitr
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

export(SEIR_prob)
export(SIR_prob)
export(bbd_prob)
export(dbd_prob)
Expand Down
16 changes: 12 additions & 4 deletions R/RcppExports.R
Original file line number Diff line number Diff line change
@@ -1,15 +1,23 @@
# This file was generated by Rcpp::compileAttributes
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

bb_lt_invert_Cpp <- function(t, lambda1, lambda2, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads) {
.Call('MultiBD_bb_lt_invert_Cpp', PACKAGE = 'MultiBD', t, lambda1, lambda2, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads)
.Call('_MultiBD_bb_lt_invert_Cpp', PACKAGE = 'MultiBD', t, lambda1, lambda2, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads)
}

bbd_lt_invert_Cpp <- function(t, a0, b0, lambda1, lambda2, mu2, gamma, x, y, A, Bp1, nblocks, tol, computeMode, nThreads, maxdepth) {
.Call('MultiBD_bbd_lt_invert_Cpp', PACKAGE = 'MultiBD', t, a0, b0, lambda1, lambda2, mu2, gamma, x, y, A, Bp1, nblocks, tol, computeMode, nThreads, maxdepth)
.Call('_MultiBD_bbd_lt_invert_Cpp', PACKAGE = 'MultiBD', t, a0, b0, lambda1, lambda2, mu2, gamma, x, y, A, Bp1, nblocks, tol, computeMode, nThreads, maxdepth)
}

SEIR_Cpp <- function(t, alpha, beta, kappa, S0, E0, I0, Ap1, Bp1, Cp1, direction, nblocks, tol, Lmax, computeMode, nThreads) {
.Call('_MultiBD_SEIR_Cpp', PACKAGE = 'MultiBD', t, alpha, beta, kappa, S0, E0, I0, Ap1, Bp1, Cp1, direction, nblocks, tol, Lmax, computeMode, nThreads)
}

SIR_Cpp <- function(t, alpha, beta, S0, I0, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads) {
.Call('MultiBD_SIR_Cpp', PACKAGE = 'MultiBD', t, alpha, beta, S0, I0, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads)
.Call('_MultiBD_SIR_Cpp', PACKAGE = 'MultiBD', t, alpha, beta, S0, I0, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads)
}

tb_lt_invert_Cpp <- function(t, lambda1, lambda2, lambda3, Ap1, Bp1, Cp1, direction, nblocks, tol, Lmax, computeMode, nThreads) {
.Call('_MultiBD_tb_lt_invert_Cpp', PACKAGE = 'MultiBD', t, lambda1, lambda2, lambda3, Ap1, Bp1, Cp1, direction, nblocks, tol, Lmax, computeMode, nThreads)
}

57 changes: 57 additions & 0 deletions R/SEIR_prob.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,57 @@
###################################################
### Compute transition probabilities of SEIR models
###################################################

#' Transition probabilities of an SEIR process
#'
#' Computes the transition pobabilities of an SIR process
#' using the bivariate birth process representation
#' @param t time
#' @param alpha removal rate
#' @param kappa rate at which an exposed person becomes infective
#' @param beta infection rate
#' @param S0 initial susceptible population
#' @param E0 initial exposed population
#' @param I0 initial infectious population
#' @param nSE number of infection events
#' @param nEI number of events at which an exposed person becomes infective
#' @param nIR number of removal events
#' @param direction direction of the transition probabilities (either \code{Forward} or \code{Backward})
#' @param nblocks number of blocks
#' @param tol tolerance
#' @param computeMode computation mode
#' @param nThreads number of threads
#' @return a matrix of the transition probabilities
#' @export

SEIR_prob <- function(t, alpha, beta, kappa, S0, E0, I0, nSE, nEI, nIR, direction = c("Forward","Backward"),
nblocks = 20, tol = 1e-12, computeMode = 0, nThreads = 4) {

direction <- match.arg(direction)
dir = 0
if (direction == "Backward") dir = 1

####################################
### t is too small
### set probability 1 at a0, b0, c0
####################################

res = array(0, dim= c(nSE + 1,nEI + 1,nIR+1))
if (t < tol) {
res[1,1,1] = 1
} else {
Lmax = nblocks # initialize Lmax
tmp = SEIR_Cpp(t, alpha, beta, kappa, S0, E0, I0, nSE + 1, nEI + 1, nIR + 1, dir, nblocks, tol,
Lmax, computeMode, nThreads)
for (i in 0:nSE) {
for (j in 0:nEI) {
for (k in 0:nIR)
res[i+1,j+1,k+1] = tmp[i + j*(nSE+1) + k*(nSE+1)*(nEI+1) + 1]
}
}
}

return(abs(res))
}


2 changes: 0 additions & 2 deletions R/SIR_prob.R
Original file line number Diff line number Diff line change
Expand Up @@ -73,8 +73,6 @@ SIR_prob <- function(t, alpha, beta, S0, I0, nSI, nIR, direction = c("Forward","
Lmax, computeMode, nThreads),
nrow = nSI + 1, byrow = T)

print(paste("L =",Lmax))

rownames(res) = 0:nSI # Infection events
colnames(res) = 0:nIR # Removal events

Expand Down
1 change: 0 additions & 1 deletion man/Eyam.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/MultiBD.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

48 changes: 48 additions & 0 deletions man/SEIR_prob.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

11 changes: 5 additions & 6 deletions man/SIR_prob.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/bbd_prob.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/dbd_prob.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

95 changes: 79 additions & 16 deletions src/RcppExports.cpp
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
// This file was generated by Rcpp::compileAttributes
// Generated by using Rcpp::compileAttributes() -> do not edit by hand
// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#include <Rcpp.h>
Expand All @@ -7,10 +7,10 @@ using namespace Rcpp;

// bb_lt_invert_Cpp
std::vector<double> bb_lt_invert_Cpp(double t, const std::vector<double>& lambda1, const std::vector<double>& lambda2, const int Ap1, const int Bp1, const int direction, const int nblocks, const double tol, int& Lmax, const int computeMode, const int nThreads);
RcppExport SEXP MultiBD_bb_lt_invert_Cpp(SEXP tSEXP, SEXP lambda1SEXP, SEXP lambda2SEXP, SEXP Ap1SEXP, SEXP Bp1SEXP, SEXP directionSEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP LmaxSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP) {
RcppExport SEXP _MultiBD_bb_lt_invert_Cpp(SEXP tSEXP, SEXP lambda1SEXP, SEXP lambda2SEXP, SEXP Ap1SEXP, SEXP Bp1SEXP, SEXP directionSEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP LmaxSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP) {
BEGIN_RCPP
Rcpp::RObject __result;
Rcpp::RNGScope __rngScope;
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< double >::type t(tSEXP);
Rcpp::traits::input_parameter< const std::vector<double>& >::type lambda1(lambda1SEXP);
Rcpp::traits::input_parameter< const std::vector<double>& >::type lambda2(lambda2SEXP);
Expand All @@ -22,16 +22,16 @@ BEGIN_RCPP
Rcpp::traits::input_parameter< int& >::type Lmax(LmaxSEXP);
Rcpp::traits::input_parameter< const int >::type computeMode(computeModeSEXP);
Rcpp::traits::input_parameter< const int >::type nThreads(nThreadsSEXP);
__result = Rcpp::wrap(bb_lt_invert_Cpp(t, lambda1, lambda2, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads));
return __result;
rcpp_result_gen = Rcpp::wrap(bb_lt_invert_Cpp(t, lambda1, lambda2, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads));
return rcpp_result_gen;
END_RCPP
}
// bbd_lt_invert_Cpp
std::vector<double> bbd_lt_invert_Cpp(double t, const int a0, const int b0, const std::vector<double>& lambda1, const std::vector<double>& lambda2, const std::vector<double>& mu2, const std::vector<double>& gamma, const std::vector<double>& x, const std::vector<double>& y, const int A, const int Bp1, const int nblocks, const double tol, const int computeMode, const int nThreads, const int maxdepth);
RcppExport SEXP MultiBD_bbd_lt_invert_Cpp(SEXP tSEXP, SEXP a0SEXP, SEXP b0SEXP, SEXP lambda1SEXP, SEXP lambda2SEXP, SEXP mu2SEXP, SEXP gammaSEXP, SEXP xSEXP, SEXP ySEXP, SEXP ASEXP, SEXP Bp1SEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP, SEXP maxdepthSEXP) {
RcppExport SEXP _MultiBD_bbd_lt_invert_Cpp(SEXP tSEXP, SEXP a0SEXP, SEXP b0SEXP, SEXP lambda1SEXP, SEXP lambda2SEXP, SEXP mu2SEXP, SEXP gammaSEXP, SEXP xSEXP, SEXP ySEXP, SEXP ASEXP, SEXP Bp1SEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP, SEXP maxdepthSEXP) {
BEGIN_RCPP
Rcpp::RObject __result;
Rcpp::RNGScope __rngScope;
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< double >::type t(tSEXP);
Rcpp::traits::input_parameter< const int >::type a0(a0SEXP);
Rcpp::traits::input_parameter< const int >::type b0(b0SEXP);
Expand All @@ -48,16 +48,42 @@ BEGIN_RCPP
Rcpp::traits::input_parameter< const int >::type computeMode(computeModeSEXP);
Rcpp::traits::input_parameter< const int >::type nThreads(nThreadsSEXP);
Rcpp::traits::input_parameter< const int >::type maxdepth(maxdepthSEXP);
__result = Rcpp::wrap(bbd_lt_invert_Cpp(t, a0, b0, lambda1, lambda2, mu2, gamma, x, y, A, Bp1, nblocks, tol, computeMode, nThreads, maxdepth));
return __result;
rcpp_result_gen = Rcpp::wrap(bbd_lt_invert_Cpp(t, a0, b0, lambda1, lambda2, mu2, gamma, x, y, A, Bp1, nblocks, tol, computeMode, nThreads, maxdepth));
return rcpp_result_gen;
END_RCPP
}
// SEIR_Cpp
std::vector<double> SEIR_Cpp(const double t, const double alpha, const double beta, const double kappa, const long int S0, const long int E0, const long int I0, const int Ap1, const int Bp1, const int Cp1, const int direction, const int nblocks, const double tol, int& Lmax, const int computeMode, const int nThreads);
RcppExport SEXP _MultiBD_SEIR_Cpp(SEXP tSEXP, SEXP alphaSEXP, SEXP betaSEXP, SEXP kappaSEXP, SEXP S0SEXP, SEXP E0SEXP, SEXP I0SEXP, SEXP Ap1SEXP, SEXP Bp1SEXP, SEXP Cp1SEXP, SEXP directionSEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP LmaxSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< const double >::type t(tSEXP);
Rcpp::traits::input_parameter< const double >::type alpha(alphaSEXP);
Rcpp::traits::input_parameter< const double >::type beta(betaSEXP);
Rcpp::traits::input_parameter< const double >::type kappa(kappaSEXP);
Rcpp::traits::input_parameter< const long int >::type S0(S0SEXP);
Rcpp::traits::input_parameter< const long int >::type E0(E0SEXP);
Rcpp::traits::input_parameter< const long int >::type I0(I0SEXP);
Rcpp::traits::input_parameter< const int >::type Ap1(Ap1SEXP);
Rcpp::traits::input_parameter< const int >::type Bp1(Bp1SEXP);
Rcpp::traits::input_parameter< const int >::type Cp1(Cp1SEXP);
Rcpp::traits::input_parameter< const int >::type direction(directionSEXP);
Rcpp::traits::input_parameter< const int >::type nblocks(nblocksSEXP);
Rcpp::traits::input_parameter< const double >::type tol(tolSEXP);
Rcpp::traits::input_parameter< int& >::type Lmax(LmaxSEXP);
Rcpp::traits::input_parameter< const int >::type computeMode(computeModeSEXP);
Rcpp::traits::input_parameter< const int >::type nThreads(nThreadsSEXP);
rcpp_result_gen = Rcpp::wrap(SEIR_Cpp(t, alpha, beta, kappa, S0, E0, I0, Ap1, Bp1, Cp1, direction, nblocks, tol, Lmax, computeMode, nThreads));
return rcpp_result_gen;
END_RCPP
}
// SIR_Cpp
std::vector<double> SIR_Cpp(const double t, const double alpha, const double beta, const long int S0, const long int I0, const int Ap1, const int Bp1, const int direction, const int nblocks, const double tol, int& Lmax, const int computeMode, const int nThreads);
RcppExport SEXP MultiBD_SIR_Cpp(SEXP tSEXP, SEXP alphaSEXP, SEXP betaSEXP, SEXP S0SEXP, SEXP I0SEXP, SEXP Ap1SEXP, SEXP Bp1SEXP, SEXP directionSEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP LmaxSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP) {
RcppExport SEXP _MultiBD_SIR_Cpp(SEXP tSEXP, SEXP alphaSEXP, SEXP betaSEXP, SEXP S0SEXP, SEXP I0SEXP, SEXP Ap1SEXP, SEXP Bp1SEXP, SEXP directionSEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP LmaxSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP) {
BEGIN_RCPP
Rcpp::RObject __result;
Rcpp::RNGScope __rngScope;
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< const double >::type t(tSEXP);
Rcpp::traits::input_parameter< const double >::type alpha(alphaSEXP);
Rcpp::traits::input_parameter< const double >::type beta(betaSEXP);
Expand All @@ -71,7 +97,44 @@ BEGIN_RCPP
Rcpp::traits::input_parameter< int& >::type Lmax(LmaxSEXP);
Rcpp::traits::input_parameter< const int >::type computeMode(computeModeSEXP);
Rcpp::traits::input_parameter< const int >::type nThreads(nThreadsSEXP);
__result = Rcpp::wrap(SIR_Cpp(t, alpha, beta, S0, I0, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads));
return __result;
rcpp_result_gen = Rcpp::wrap(SIR_Cpp(t, alpha, beta, S0, I0, Ap1, Bp1, direction, nblocks, tol, Lmax, computeMode, nThreads));
return rcpp_result_gen;
END_RCPP
}
// tb_lt_invert_Cpp
std::vector<double> tb_lt_invert_Cpp(double t, const std::vector<double>& lambda1, const std::vector<double>& lambda2, const std::vector<double>& lambda3, const int Ap1, const int Bp1, const int Cp1, const int direction, const int nblocks, const double tol, int& Lmax, const int computeMode, const int nThreads);
RcppExport SEXP _MultiBD_tb_lt_invert_Cpp(SEXP tSEXP, SEXP lambda1SEXP, SEXP lambda2SEXP, SEXP lambda3SEXP, SEXP Ap1SEXP, SEXP Bp1SEXP, SEXP Cp1SEXP, SEXP directionSEXP, SEXP nblocksSEXP, SEXP tolSEXP, SEXP LmaxSEXP, SEXP computeModeSEXP, SEXP nThreadsSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< double >::type t(tSEXP);
Rcpp::traits::input_parameter< const std::vector<double>& >::type lambda1(lambda1SEXP);
Rcpp::traits::input_parameter< const std::vector<double>& >::type lambda2(lambda2SEXP);
Rcpp::traits::input_parameter< const std::vector<double>& >::type lambda3(lambda3SEXP);
Rcpp::traits::input_parameter< const int >::type Ap1(Ap1SEXP);
Rcpp::traits::input_parameter< const int >::type Bp1(Bp1SEXP);
Rcpp::traits::input_parameter< const int >::type Cp1(Cp1SEXP);
Rcpp::traits::input_parameter< const int >::type direction(directionSEXP);
Rcpp::traits::input_parameter< const int >::type nblocks(nblocksSEXP);
Rcpp::traits::input_parameter< const double >::type tol(tolSEXP);
Rcpp::traits::input_parameter< int& >::type Lmax(LmaxSEXP);
Rcpp::traits::input_parameter< const int >::type computeMode(computeModeSEXP);
Rcpp::traits::input_parameter< const int >::type nThreads(nThreadsSEXP);
rcpp_result_gen = Rcpp::wrap(tb_lt_invert_Cpp(t, lambda1, lambda2, lambda3, Ap1, Bp1, Cp1, direction, nblocks, tol, Lmax, computeMode, nThreads));
return rcpp_result_gen;
END_RCPP
}

static const R_CallMethodDef CallEntries[] = {
{"_MultiBD_bb_lt_invert_Cpp", (DL_FUNC) &_MultiBD_bb_lt_invert_Cpp, 11},
{"_MultiBD_bbd_lt_invert_Cpp", (DL_FUNC) &_MultiBD_bbd_lt_invert_Cpp, 16},
{"_MultiBD_SEIR_Cpp", (DL_FUNC) &_MultiBD_SEIR_Cpp, 16},
{"_MultiBD_SIR_Cpp", (DL_FUNC) &_MultiBD_SIR_Cpp, 13},
{"_MultiBD_tb_lt_invert_Cpp", (DL_FUNC) &_MultiBD_tb_lt_invert_Cpp, 13},
{NULL, NULL, 0}
};

RcppExport void R_init_MultiBD(DllInfo *dll) {
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
}
27 changes: 27 additions & 0 deletions src/SEIR_Cpp.cpp
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
#include "bbd.h"

// [[Rcpp::export]]
std::vector<double> SEIR_Cpp(const double t, const double alpha, const double beta, const double kappa,
const long int S0, const long int E0, const long int I0,
const int Ap1, const int Bp1, const int Cp1, const int direction,
const int nblocks, const double tol, int& Lmax, const int computeMode, const int nThreads) {

const int matsize = Ap1*Bp1*Cp1;
std::vector<double> lambda1(matsize), lambda2(matsize), lambda3(matsize);

for (int a=0; a<Ap1; ++a) { //nSE
for (int b=0; b<Bp1; ++b) { // nEI
for (int c=0; c<Cp1; ++c) { // nIR
double Spop = std::max(0.0, S0-a+0.0);
double Epop = std::max(0.0, E0+a-b+0.0);
double Ipop = std::max(0.0, I0+b-c+0.0);
lambda1[a + b*Ap1 + c*Ap1*Bp1] = beta*Spop*Ipop; // Infection rate is beta*S*I
lambda2[a + b*Ap1 + c*Ap1*Bp1] = kappa*Epop;
lambda3[a + b*Ap1 + c*Ap1*Bp1] = alpha*Ipop;
}
}
}

return(tb_lt_invert_Cpp(t, lambda1, lambda2, lambda3, Ap1, Bp1, Cp1, direction,
nblocks, tol, Lmax, computeMode, nThreads));
}
Loading

0 comments on commit f142972

Please sign in to comment.