basic reporting template

.gitignore

@@ -0,0 +1,2 @@
+
+report.html

R/phenotypeCohort.R

@@ -29,12 +29,12 @@ phenotypeCohort <- function(cohort){
     CohortCharacteristics::summariseCharacteristics(
       strata = c("sex"),
       ageGroup = age_groups,
-      tableIntersectCount = list(
-        "Number visits prior year" = list(
-          tableName = "visit_occurrence",
-          window = c(-365, -1)
-        )
-      ),
+      # tableIntersectCount = list(
+      #   "Number visits prior year" = list(
+      #     tableName = "visit_occurrence",
+      #     window = c(-365, -1)
+      #   )
+      # ),
       otherVariables = "days_in_cohort",
       otherVariablesEstimates = c("min", "q25", "median", "q75", "max")
     )

R/reportPhenotype.R

@@ -7,6 +7,24 @@
 #' @export
 #'
 #' @examples
-reportPhenotype <- function(result){
+reportPhenotype <- function(result,
+                            dir = here::here()){
 
+    input <- system.file("rmd", "phenotype_report.Rmd",
+                         package = "phenotypeR")
+
+    cohortNames <- result |>
+      dplyr::filter(group_level != "overall") |>
+      dplyr::select("group_level") |>
+      dplyr::distinct() |>
+      dplyr::pull()
+    cohortNames <- paste0(cohortNames, collapse = "; ")
+    workingTitle <- paste('phenotypeR results for cohort', cohortNames)
+
+    rmarkdown::render(input = input,
+                      params = list(title = workingTitle,
+                                    result = result),
+                      output_file = "report.html",
+                      output_dir = dir,
+                      clean = TRUE)
 }

inst/rmd/phenotype_report.Rmd

@@ -0,0 +1,31 @@
+---
+title: "`r params$title`"
+output: html_document
+date: "2024-06-22"
+params:
+  title: title
+  result: result
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+## Result overview
+
+```{r}
+summary(result)
+```
+
+
+```{r}
+settings(result)
+```
+
+# Demographics
+
+```{r}
+CohortCharacteristics::tableCharacteristics(result)
+```
+
+

tests/testthat/test-phenotypeCohort.R

@@ -1,6 +1,9 @@
 test_that("run with a single cohort", {
-  cdm_local <- omock::mockPerson(nPerson = 10) |>
+  cdm <- omock::mockCdmReference() |>
+    omock::mockPerson(nPerson = 10) |>
+    omock::mockObservationPeriod() |>
     omock::mockCohort(name = "my_cohort")
+
   db <- DBI::dbConnect(duckdb::duckdb())
   cdm <- CDMConnector::copyCdmTo(con = db, cdm = cdm_local,
                           schema ="main", overwrite = TRUE)

tests/testthat/test-reportPhenotype.R

@@ -1,3 +1,18 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
+test_that("basic working example with one cohort", {
+
+  cdm_local <- omock::mockCdmReference() |>
+    omock::mockPerson(nPerson = 10) |>
+    omock::mockObservationPeriod() |>
+    omock::mockCohort(name = "my_cohort")
+
+  db <- DBI::dbConnect(duckdb::duckdb())
+  cdm <- CDMConnector::copyCdmTo(con = db, cdm = cdm_local,
+                                 schema ="main", overwrite = TRUE)
+  my_result <- cdm$my_cohort |> phenotypeCohort()
+  reportPhenotype(result = my_result)
+
+})
+
+test_that("basic working example with two cohorts", {
+
 })

tests/testthat/test-shinyPhenotype.R

@@ -1,3 +1,3 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
-})
+test_that("basic example", {
+
+  })