Merge pull request #4 from nickjcroucher/testing

Add CI testing

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/workflows/check-standard.yaml

@@ -0,0 +1,82 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macOS-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: rcmdcheck
+
+      - uses: r-lib/actions/check-r-package@v1
+        with:
+          args: 'c("--no-build-vignettes","--no-manual","--no-multiarch")'
+          build_args: 'c("--no-build-vignettes","--no-manual","--no-multiarch")'
+          error-on: '"error"'
+
+      - name: Show testthat output
+        if: always()
+        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload check results
+        if: failure()
+        uses: actions/upload-artifact@main
+        with:
+          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
+          path: check
+
+
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: covr
+
+      - name: Test coverage
+        run: covr::codecov()
+        shell: Rscript {0}

DESCRIPTION

@@ -34,12 +34,18 @@ Imports:
     tidyverse (>= 1.3),
     xlsx (>= 0.6.5),
     cowplot (>= 1.1.1),
-    gtools (>= 3.9)
+    gtools (>= 3.9),
+    ggplot2,
+    dplyr,
+    rlang,
+    stringr
 Suggests: 
     knitr,
     rmarkdown,
     metafor (>= 3.0),
-    ggpubr (>= 0.4)
+    ggpubr (>= 0.4),
+    testthat (>= 3.0.0),
+    roxygen2
 VignetteBuilder: knitr
 RoxygenNote: 7.1.1
 Biarch: true
@@ -51,3 +57,4 @@ LinkingTo:
     rstan (>= 2.18.1),
     StanHeaders (>= 2.18.0)
 SystemRequirements: GNU make
+Config/testthat/edition: 3

NAMESPACE

@@ -14,5 +14,24 @@ export(process_progression_rate_model_output)
 export(validate_progression_estimation_dataset)
 import(Rcpp)
 import(methods)
+importFrom(ggplot2,aes)
+importFrom(ggplot2,element_text)
+importFrom(ggplot2,geom_abline)
+importFrom(ggplot2,geom_errorbar)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,scale_shape_binned)
+importFrom(ggplot2,scale_y_continuous)
+importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_bw)
+importFrom(ggplot2,xlab)
+importFrom(ggplot2,ylab)
+importFrom(magrittr,"%<>%")
+importFrom(magrittr,"%>%")
+importFrom(rlang,"!!")
+importFrom(rlang,":=")
 importFrom(rstan,sampling)
+importFrom(stats,quantile)
+importFrom(stats,setNames)
+importFrom(stringr,str_trim)
 useDynLib(progressionEstimation, .registration = TRUE)

R/functions.R

@@ -16,6 +16,10 @@ require(ggrepel)
 #' @return Data frame containing data extracted from spreadsheet
 #' @export
 #'
+#' @importFrom magrittr %>%
+#' @importFrom magrittr %<>%
+#' @importFrom stringr str_trim
+#'
 process_input_xlsx <- function(fn = "progression_estimation_input.xlsx", use_strain = FALSE) {
   max_col_num <- 7
   if (use_strain) {
@@ -64,6 +68,9 @@ combine_rows <- function(df, col_name = "type") {
 #' @return A list of lists used as an input to stan models
 #' @export
 #'
+#' @importFrom rlang :=
+#' @importFrom rlang !!
+#'
 process_input_data <- function(input_df, type = "type", use_strain = FALSE, combine_strain = FALSE, condense = FALSE) {
   if (!(type %in% colnames(input_df))) {
     stop("Type column not in input data")
@@ -222,19 +229,19 @@ fit_progression_rate_model<-function(input_data,
 }
 
 get_mean<-function(parameter,model) {
-  return(rstan::summary(model,pars=c(parameter))$summary[,1])
+  return(as.numeric(rstan::summary(model,pars=c(parameter))$summary[,1]))
 }
 
 get_upper<-function(parameter,model) {
-  return(rstan::summary(model,pars=c(parameter))$summary[,8])
+  return(as.numeric(rstan::summary(model,pars=c(parameter))$summary[,8]))
 }
 
 get_lower<-function(parameter,model) {
-  return(rstan::summary(model,pars=c(parameter))$summary[,4])
+  return(as.numeric(rstan::summary(model,pars=c(parameter))$summary[,4]))
 }
 
 get_median<-function(parameter,model) {
-  return(rstan::summary(model,pars=c(parameter))$summary[,6])
+  return(as.numeric(rstan::summary(model,pars=c(parameter))$summary[,6]))
 }
 
 #' Process the model output for downstream analysis
@@ -250,6 +257,8 @@ get_median<-function(parameter,model) {
 #' @return A data frame
 #' @export
 #'
+#' @importFrom stats setNames
+#'
 process_progression_rate_model_output<-function(model_output,
                                                 input_df,
                                                 type = "type",
@@ -344,9 +353,9 @@ process_progression_rate_model_output<-function(model_output,
   }
   progression_rates_df <- data.frame(
     "type" = j_levels,
-    "nu" = get_median(nu_name,model_output),
-    "nu_lower" = get_lower(nu_name,model_output),
-    "nu_upper" = get_upper(nu_name,model_output)
+    "nu" = as.numeric(get_median(nu_name,model_output)),
+    "nu_lower" = as.numeric(get_lower(nu_name,model_output)),
+    "nu_upper" = as.numeric(get_upper(nu_name,model_output))
   )
   input_df %<>% dplyr::left_join(progression_rates_df, by = setNames("type",type))
 
@@ -397,6 +406,9 @@ process_progression_rate_model_output<-function(model_output,
 #' @return ggplot2 plot
 #' @export
 #'
+#' @importFrom ggplot2 geom_abline
+#' @importFrom ggplot2 geom_point
+#'
 plot_case_carrier_predictions <- function(model_output_df, n_label = 3, label_col = "type", legend = TRUE, just_legend = FALSE) {
 
   if (!("carriage_prediction" %in% colnames(model_output_df))) {
@@ -510,6 +522,17 @@ plot_case_carrier_predictions <- function(model_output_df, n_label = 3, label_co
 #' @return
 #' @export
 #'
+#' @importFrom ggplot2 element_text
+#' @importFrom ggplot2 ggplot
+#' @importFrom ggplot2 aes
+#' @importFrom ggplot2 geom_errorbar
+#' @importFrom ggplot2 scale_y_continuous
+#' @importFrom ggplot2 scale_shape_binned
+#' @importFrom ggplot2 theme
+#' @importFrom ggplot2 theme_bw
+#' @importFrom ggplot2 xlab
+#' @importFrom ggplot2 ylab
+#'
 plot_progression_rates <- function(model_output_df, type = "type", unit_time = "unit time", type_name = "type",
                                    colour_col = NULL, colour_palette = NULL, use_sample_size = FALSE) {
   if (!(any(grepl("nu",colnames(model_output_df))))) {
@@ -680,7 +703,7 @@ combine_with_existing_datasets <- function(new_df, old_df) {
     new_df %>% dplyr::select(study) %>% dplyr::distinct() %>% dplyr::pull()
   old_studies <-
     old_df %>% dplyr::select(study) %>% dplyr::distinct() %>% dplyr::pull()
-  if (length(intersect(new_studies,old_studies)) < 1) {
+  if (length(intersect(new_studies,old_studies)) > 0) {
     stop("Names of studies in new data must not be present in old studies")
   }
   combined_df <- dplyr::bind_rows(old_df, new_df)
@@ -752,6 +775,8 @@ validate_progression_estimation_dataset <- function(df) {
 #' @return Data frame containing adjusted estimates of invasiveness for a study
 #' @export
 #'
+#' @importFrom stats quantile
+#'
 get_type_invasiveness_for_study <- function(df, fit, study = NULL, type = "type", use_strain_invasiveness = FALSE) {
 
   # Check study name in list

README.md

@@ -1,11 +1,18 @@
-[![DOI:10.1101/2021.01.08.425840](http://img.shields.io/badge/DOI-10.1101/2021.09.01.458483-B31B1B.svg)](https://doi.org/10.1101/2021.09.01.458483)
-[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.5762037.svg)](https://doi.org/10.5281/zenodo.5762037)
-
 # progressionEstimation
 R and stan package for the estimation of microbial progression rates
 
 This package uses Bayesian models implemented in stan to estimate the rates at which microbes progress from carriage to disease using case and carrier data.
 
+Pre-print: [![DOI:10.1101/2021.01.08.425840](http://img.shields.io/badge/DOI-10.1101/2021.09.01.458483-B31B1B.svg)](https://doi.org/10.1101/2021.09.01.458483)
+
+Release: [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.5762037.svg)](https://doi.org/10.5281/zenodo.5762037)
+
+License: [![License: GPL v3](https://img.shields.io/badge/License-GPL%20v3-brightgreen.svg)](https://github.com/nickjcroucher/progressionEstimation/blob/master/LICENSE)   
+
+Build: ![build](https://github.com/nickjcroucher/progressionEstimation/workflows/build/check-standard.yaml/badge.svg)
+
+Code coverage: [![codecov](https://codecov.io/gh/nickjcroucher/progressionEstimation/branch/main/graph/badge.svg?token=CZ63KCRN63)](https://codecov.io/gh/nickjcroucher/progressionEstimation)
+
 ## Quick start
 
 The case and carrier data can be input into the model using the spreadsheet `progression_estimation_input.xlsx`, or read into R and converted to a data frame or tibble with the same format. The required columns are:

inst/stan/type_specific_type_modified_by_strain_negbin.stan

@@ -26,7 +26,7 @@ parameters {
   vector<lower=-6.0,upper=1.0>[j_max] log_nu_j;
 
   // log GPSC invasiveness ~ Cauchy
-  vector<lower=-3, upper=3>[k_max-1-1] log_nu_k;
+  vector<lower=-1.25, upper=1.25>[k_max] log_nu_k;
 
   // negative binomial overdispersions
   real<lower=0> phi_nb;
@@ -39,7 +39,7 @@ transformed parameters {
   vector<lower=0,upper=10.0>[j_max] nu_j;
   vector[k_max] nu_k;
   real mu_mod = 0; // position parameter of Cauchy for strain invasiveness
-  real tau_mod = 1; // scale parameter of Cauchy for strain invasiveness
+  real tau_mod = 0.5; // scale parameter of Cauchy for strain invasiveness
 
   // calculate serotype invasiveness on a real scale
   for (j in 1:j_max) {
@@ -49,7 +49,7 @@ transformed parameters {
   // calculate serotype invasiveness on a real scale
   nu_k[1] = 1;
   for (k in 2:k_max) {
-    nu_k[k] = pow(10, log_nu_k[k-1]);
+    nu_k[k] = pow(10, mu_mod + tau_mod * tan(log_nu_k[k]));
   }
 
 }

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(progressionEstimation)
+
+test_check("progressionEstimation")

tests/testthat/test_input.R

@@ -0,0 +1,20 @@
+require(tidyverse)
+require(magrittr)
+require(progressionEstimation)
+require(testthat)
+
+testthat::test_that("Input XLSX can be processed",{
+  input_xlsx <-
+    progressionEstimation::process_input_xlsx("progression_estimation_input_test.xlsx")
+  testthat::expect_equal(nrow(input_xlsx),22)
+  is_valid <- validate_progression_estimation_dataset(input_xlsx)
+  testthat::expect_equal(is_valid,NULL)
+})
+
+testthat::test_that("Input XLSX can be processed and appended to data",{
+  input_xlsx <-
+    progressionEstimation::process_input_xlsx("progression_estimation_input_test.xlsx")
+  combined_data <-
+    progressionEstimation::combine_with_existing_datasets(input_xlsx,S_pneumoniae_infant_serotype)
+  testthat::expect_gt(nrow(combined_data),nrow(input_xlsx))
+})