This function extracts the C source code associated with the
model. The code may have been automatically generated by
mparse or manually provided by the user during model
creation. It is useful for inspecting the implementation,
debugging complex propensity functions, or verifying the code used
in the simulation.
Value
A character vector where each element corresponds to a line of the C source code stored in the model.
Examples
## Extract code from an mparse-generated SIR model.
model <- mparse(
transitions = c("S -> beta * S * I/(S + I + R) -> I",
"I -> gamma * I -> R"),
compartments = c("S", "I", "R"),
gdata = c(beta = 0.16, gamma = 0.077),
u0 = data.frame(S = 99, I = 1, R = 0),
tspan = 1:10
)
C_code(model)
#> [1] "/* Generated by SimInf (v10.1.0.9000) */"
#> [2] ""
#> [3] "#include <R_ext/Rdynload.h>"
#> [4] "#include \"SimInf.h\""
#> [5] ""
#> [6] "/**"
#> [7] " * Make sure the necessary macros are defined so that the"
#> [8] " * compiler can replace them when compiling the model."
#> [9] " * 'SIMINF_MODEL_RUN' defines the function name of the function"
#> [10] " * that will be called from R to run a trajectory of the model."
#> [11] " * 'SIMINF_R_INIT' is the name of the function that R will call"
#> [12] " * when this model is loaded into R. 'SIMINF_FORCE_SYMBOLS'"
#> [13] " * defines whether R allows the entry point for the run function"
#> [14] " * to be searched for as a character string."
#> [15] " * If this file is compiled from SimInf (when calling run), the"
#> [16] " * macros are defined by SimInf before calling 'R CMD SHLIB'."
#> [17] " * If this file is compiled as part of a package, then the"
#> [18] " * definitions are set in the variable 'PKG_CPPFLAGS' in"
#> [19] " * 'src/Makevars' and 'src/Makevars.in'."
#> [20] " */"
#> [21] "#if !defined(SIMINF_MODEL_RUN)"
#> [22] "# error Definition for 'SIMINF_MODEL_RUN' is missing."
#> [23] "#endif"
#> [24] "#if !defined(SIMINF_R_INIT)"
#> [25] "# error Definition for 'SIMINF_R_INIT' is missing."
#> [26] "#endif"
#> [27] "#if !defined(SIMINF_FORCE_SYMBOLS)"
#> [28] "# error Definition for 'SIMINF_FORCE_SYMBOLS' is missing."
#> [29] "#endif"
#> [30] ""
#> [31] "/**"
#> [32] " * @param u The compartment state vector in the node."
#> [33] " * @param v The continuous state vector in the node."
#> [34] " * @param ldata The local data vector in the node."
#> [35] " * @param gdata The global data vector."
#> [36] " * @param t Current time."
#> [37] " * @return propensity."
#> [38] " */"
#> [39] "static double trFun1("
#> [40] " const int *u,"
#> [41] " const double *v,"
#> [42] " const double *ldata,"
#> [43] " const double *gdata,"
#> [44] " double t)"
#> [45] "{"
#> [46] " return gdata[0]*u[0]*u[1]/(u[0]+u[1]+u[2]);"
#> [47] "}"
#> [48] ""
#> [49] "/**"
#> [50] " * @param u The compartment state vector in the node."
#> [51] " * @param v The continuous state vector in the node."
#> [52] " * @param ldata The local data vector in the node."
#> [53] " * @param gdata The global data vector."
#> [54] " * @param t Current time."
#> [55] " * @return propensity."
#> [56] " */"
#> [57] "static double trFun2("
#> [58] " const int *u,"
#> [59] " const double *v,"
#> [60] " const double *ldata,"
#> [61] " const double *gdata,"
#> [62] " double t)"
#> [63] "{"
#> [64] " return gdata[1]*u[1];"
#> [65] "}"
#> [66] ""
#> [67] "/**"
#> [68] " * Post time step function."
#> [69] " *"
#> [70] " * @param v_new If a continuous state vector is used by a model,"
#> [71] " * this is the new continuous state vector in the node after"
#> [72] " * the post time step."
#> [73] " * @param u The compartment state vector in the node."
#> [74] " * @param v The current continuous state vector in the node."
#> [75] " * @param ldata The local data vector in the node."
#> [76] " * @param gdata The global data vector that is common to all nodes."
#> [77] " * @param node The node index. Note the node index is zero-based,"
#> [78] " * i.e., the first node is 0."
#> [79] " * @param t Current time in the simulation."
#> [80] " * @return error code (<0), or 1 if node needs to update the"
#> [81] " * transition rates, or 0 when it doesn't need to update"
#> [82] " * the transition rates."
#> [83] " */"
#> [84] "static int ptsFun("
#> [85] " double *v_new,"
#> [86] " const int *u,"
#> [87] " const double *v,"
#> [88] " const double *ldata,"
#> [89] " const double *gdata,"
#> [90] " int node,"
#> [91] " double t)"
#> [92] "{"
#> [93] " return 0;"
#> [94] "}"
#> [95] ""
#> [96] "/**"
#> [97] " * Run a trajectory of the model."
#> [98] " *"
#> [99] " * @param model The model."
#> [100] " * @param solver The name of the numerical solver."
#> [101] " * @return A model with a trajectory attached to it."
#> [102] " */"
#> [103] "static SEXP SIMINF_MODEL_RUN(SEXP model, SEXP solver)"
#> [104] "{"
#> [105] " static SEXP(*SimInf_run)(SEXP, SEXP, TRFun*, PTSFun) = NULL;"
#> [106] " TRFun tr_fun[] = {&trFun1, &trFun2};"
#> [107] ""
#> [108] " if (!SimInf_run) {"
#> [109] " SimInf_run = (SEXP(*)(SEXP, SEXP, TRFun*, PTSFun))"
#> [110] " R_GetCCallable(\"SimInf\", \"SimInf_run\");"
#> [111] ""
#> [112] " if (!SimInf_run) {"
#> [113] " Rf_error(\"Cannot find function 'SimInf_run'.\");"
#> [114] " }"
#> [115] " }"
#> [116] ""
#> [117] " return SimInf_run(model, solver, tr_fun, &ptsFun);"
#> [118] "}"
#> [119] ""
#> [120] "/**"
#> [121] " * A NULL-terminated array of routines to register for the .Call"
#> [122] " * interface, see section '5.4 Registering native routines' in"
#> [123] " * the 'Writing R Extensions' manual."
#> [124] " */"
#> [125] "static const R_CallMethodDef callMethods[] ="
#> [126] "{"
#> [127] " SIMINF_CALLDEF(SIMINF_MODEL_RUN, 2),"
#> [128] " {NULL, NULL, 0}"
#> [129] "};"
#> [130] ""
#> [131] "/**"
#> [132] " * This routine will be invoked when R loads the shared object/DLL,"
#> [133] " * see section '5.4 Registering native routines' in the"
#> [134] " * 'Writing R Extensions' manual."
#> [135] " */"
#> [136] "void SIMINF_R_INIT(DllInfo *info)"
#> [137] "{"
#> [138] " R_registerRoutines(info, NULL, callMethods, NULL, NULL);"
#> [139] " R_useDynamicSymbols(info, FALSE);"
#> [140] " R_forceSymbols(info, SIMINF_FORCE_SYMBOLS);"
#> [141] "}"