added back in crude method for writing pruned transmission record, an…

NAMESPACE

@@ -11,6 +11,7 @@ export(plot_age_states)
 export(plot_daily_states)
 export(plot_epi_distribution)
 export(plot_treatment_seeking)
+export(prune_transmission_record)
 export(sim_epi)
 export(simplegen_file)
 export(simplegen_project)

R/RcppExports.R

@@ -5,3 +5,7 @@ indiv_sim_cpp <- function(args, args_functions, args_progress) {
     .Call(`_SIMPLEGEN_indiv_sim_cpp`, args, args_functions, args_progress)
 }
 
+prune_transmission_record_cpp <- function(args) {
+    invisible(.Call(`_SIMPLEGEN_prune_transmission_record_cpp`, args))
+}
+

R/main.R

@@ -604,3 +604,63 @@ sim_epi <- function(project,
   invisible(project)
 }
 
+#------------------------------------------------
+#' @title Prune the transmission record
+#'
+#' @description TODO
+#'
+#' @param project a SIMPLEGEN project, as produced by the
+#'   \code{simplegen_project()} function.
+#' @param transmission_record_location the file path to a transmission record
+#'   already written to file.
+#' @param pruned_record_location the file path that the pruned transmission
+#'   record will be written to.
+#' @param overwrite_pruned_record if \code{TRUE} the pruned transmission record
+#'   will overwrite any existing file by the same name. \code{FALSE} by default.
+#' @param silent whether to suppress written messages to the console.
+#' 
+#' @export
+
+prune_transmission_record <- function(project,
+                                      transmission_record_location = "",
+                                      pruned_record_location = "",
+                                      overwrite_pruned_record = FALSE,
+                                      silent = FALSE) {
+
+  # check inputs
+  assert_custom_class(project, "simplegen_project")
+  assert_string(transmission_record_location)
+  assert_string(pruned_record_location)
+  assert_single_logical(overwrite_pruned_record)
+  assert_single_logical(silent)
+
+  # check transmission record exists
+  if (!file.exists(transmission_record_location)) {
+    stop(sprintf("could not find file at %s", transmission_record_location))
+  }
+
+  # optionally return warning if will overwrite pruned transmission record file
+  if (!overwrite_pruned_record) {
+    if (file.exists(pruned_record_location)) {
+      stop(sprintf("file already exists at %s. Change target location, or use argument `overwrite_pruned_record = TRUE` to manually override this warning", pruned_record_location))
+    }
+  }
+
+  # subset sample details to a vector of inoc_IDs
+  inoc_IDs <- unlist(project$sample_details$inoc_IDs)
+  if (length(inoc_IDs) == 0) {
+    stop("no malaria positive hosts in sample")
+  }
+
+  # define argument list
+  args <- list(transmission_record_location = transmission_record_location,
+               pruned_record_location = pruned_record_location,
+               inoc_IDs = inoc_IDs,
+               silent = silent)
+
+  # run efficient C++ code
+  prune_transmission_record_cpp(args)
+
+  # return project unchanged
+  invisible(project)
+}

docs/pkgdown.yml

@@ -5,5 +5,5 @@ articles:
   basic_tutorial: basic_tutorial.html
   installation: installation.html
   model_description: model_description.html
-last_built: 2020-09-07T19:55Z
+last_built: 2020-09-08T08:16Z
 

inst/extdata/pruned_record_test1.txt

@@ -0,0 +1,4 @@
+0;
+5 0;
+10 5;11 5;
+15 10;16 11;

inst/extdata/trans_record_test1.txt

@@ -0,0 +1,4 @@
+0;1;2;3;4;
+5 0;6 0;7 1;8 1;9 2;
+10 5;11 5;12 5;13 6;14 6;
+15 10;16 11;17 11;18 12;19 12;

src/RcppExports.cpp

@@ -18,9 +18,20 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// prune_transmission_record_cpp
+void prune_transmission_record_cpp(Rcpp::List args);
+RcppExport SEXP _SIMPLEGEN_prune_transmission_record_cpp(SEXP argsSEXP) {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< Rcpp::List >::type args(argsSEXP);
+    prune_transmission_record_cpp(args);
+    return R_NilValue;
+END_RCPP
+}
 
 static const R_CallMethodDef CallEntries[] = {
     {"_SIMPLEGEN_indiv_sim_cpp", (DL_FUNC) &_SIMPLEGEN_indiv_sim_cpp, 3},
+    {"_SIMPLEGEN_prune_transmission_record_cpp", (DL_FUNC) &_SIMPLEGEN_prune_transmission_record_cpp, 1},
     {NULL, NULL, 0}
 };