Merge pull request #18 from getwilds/package-app-cleanup

Package app cleanup

.Rbuildignore

@@ -4,3 +4,4 @@
 ^\.Rproj\.user$
 ^data-raw$
 ^LICENSE\.md$
+^\.github$

.github/.gitignore

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

.github/workflows/R-CMD-check.yaml

@@ -0,0 +1,51 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/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:
+
+name: R-CMD-check.yaml
+
+permissions: read-all
+
+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'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        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@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(example_callback)
+export(oncarto_file)
 export(run_app)
 importFrom(dplyr,filter)
 importFrom(dplyr,left_join)

R/example-callback.R

@@ -0,0 +1,22 @@
+#' A function that provides an example dataframe for testing.
+#' @param key A string used internally (in a specific shiny server module
+#' implementation) to indicate which data to return.
+#' @export
+#' @importFrom utils read.table
+#' @examples
+#' example_callback("county-incidence")
+#'
+example_callback <- function(key) {
+  stopifnot(key %in% c("county-incidence", "contact-info"))
+
+  if (key == "county-incidence") {
+    utils::read.table(
+      header = TRUE,
+      system.file(file.path("test", "example-incidence.tsv"), package = "oncarto"),
+      sep = "\t"
+    )
+  } else if (key == "contact-info") {
+    oncarto_file("fh-contact-info.md")
+  }
+}
+

R/get-county-boundaries.R

@@ -9,6 +9,6 @@ get_county_boundaries <- function(state_abbr, county_col_name) {
     crs = 4326
   )
 
-  out[[county_col_name]] = out[['NAMELSAD']]
+  out[[county_col_name]] <- out[['NAMELSAD']]
   out
 }

R/oncarto-file.R

@@ -0,0 +1,23 @@
+#' Get the paths to files installed with oncarto
+#'
+#' This function allows you to quickly access files that are installed with
+#' oncarto.
+#'
+#' @param path The name of the file. If no argument is provided then
+#' all of the example files will be listed.
+#'
+#' @return A vector of file paths
+#' @export
+#' @examples
+#' oncarto_file()
+#'
+oncarto_file <- function(path = NULL){
+  if(is.null(path)) {
+    list.files(
+      system.file(c("app"), package = "oncarto"),
+      full.names = TRUE)
+  } else {
+    system.file(c("app"), path, package = "oncarto",
+                mustWork = TRUE)
+  }
+}

R/run-app.R

@@ -5,8 +5,6 @@
 #' @param logo_width Width of logo in pixels
 #' @param logo_height Height of logo in pixels
 #' @param css Filepath to the .css file that sets aesthetics for the whole app
-#' @param contact_info Filepath to a markdown file that includes contact
-#'  information to be displayed at the bottom of the page
 #' @param callback A callback that returns a function that returns the relevant
 #'  data
 #' @importFrom shiny shinyApp addResourcePath
@@ -15,7 +13,7 @@
 #'
 
 run_app <- function(title, logo_src, logo_href, logo_width, logo_height, css,
-                    contact_info, callback) {
+                    callback) {
 
   shiny::addResourcePath(prefix = "img", directoryPath = dirname(logo_src))
   logo_src <- file.path("img", basename(logo_src))
@@ -29,7 +27,7 @@ run_app <- function(title, logo_src, logo_href, logo_width, logo_height, css,
         shiny::includeCSS(css),
         set_title(title),
         shinydashboard::tabItems(
-          ui_county_incidence("incidence", contact_info),
+          ui_county_incidence("incidence", callback),
           ui_background("background")
         )
       )

R/server-county-incidence.R

@@ -9,60 +9,43 @@ server_county_incidence <- function(id, callback, state_abbr,
 
   shiny::moduleServer(id, function(input, output, session) {
     # Warning message if map can't be shown
-    warning_message <- "<h4>No cancer incidence data are available for this specific combination of inputs. Please try a different combination of inputs.</h4>"
+    warning_message <- htmltools::tags$h4("No cancer incidence data are available for this specific combination of inputs. Please try a different combination of inputs.")
 
     # Get the shape file that includes county boundaries for the given US state
     county_boundaries <- get_county_boundaries(state_abbr, county_col_name)
 
-    # Get input cancer incidence data based on the user-provided 'get_data' fn
-    # and table name
-    #fn_to_get_data <- get(func_to_apply)
-    #input_data <- fn_to_get_data(data_table_name)
-
-    input_data <- callback()
-
-    # Filter the incidence data by the input parameters
     county_level_incidence <- shiny::reactive({
-      input_data |>
+      callback("county-incidence") |>
         dplyr::filter(cancer_type == input$cancer_type, race == input$race,
                       sex == input$sex, age == input$age, stage == input$stage,
                       year == input$year)
     })
 
-
-    # Determine if there is county-level incidence data to visualize
-    filters_too_strict <- shiny::eventReactive(county_level_incidence(), {
-      return(all(is.na(county_level_incidence()[[incidence_col_name]])))
+    output$choropleth <- leaflet::renderLeaflet({
+      if(nrow(county_level_incidence()) == 0) {
+        NULL
+      } else {
+          # Join the cancer data with counties boundaries based on county name
+          county_level_incidence_with_shape <- county_boundaries |>
+            dplyr::left_join(county_level_incidence(), by = county_col_name)
+
+          # Generate color palette based on the selected cancer data
+          pal <- make_palette(county_level_incidence_with_shape,
+                              incidence_col_name, "#F4F4F4", "#FFB500",
+                              "transparent")
+
+          # Make the leaflet map
+          make_leaflet(county_level_incidence_with_shape, pal, incidence_col_name,
+                       county_col_name, "Age-Adjusted Incidence Rate")
+      }
     })
 
-    shiny::observeEvent(filters_too_strict(),{
-        # If data do not exist for this combination of inputs, print a warning and
-        # return NULL instead of a map
-        if (isTRUE(filters_too_strict())) {
-          output$choropleth <- NULL
-          output$map_message <- renderUI({HTML(warning_message)})
-        }
-
-        # Otherwise, do not print a warning, and return the map
-        else {
-          # Set warning message to NULL
-          output$map_message <- NULL
-          output$choropleth <- leaflet::renderLeaflet({
-            # Join the cancer data with counties boundaries based on county name
-            county_level_incidence_with_shape <- county_boundaries |>
-              dplyr::left_join(county_level_incidence(), by = county_col_name)
-
-            # Generate color palette based on the selected cancer data
-            pal <- make_palette(county_level_incidence_with_shape,
-                                incidence_col_name, "#F4F4F4", "#FFB500",
-                                "transparent")
-
-            # Make the leaflet map
-            make_leaflet(county_level_incidence_with_shape, pal, incidence_col_name,
-                         county_col_name, "Age-Adjusted Incidence Rate")
-          })
-        }
+    output$map_message <- renderUI({
+      if(nrow(county_level_incidence()) == 0) {
+        warning_message
+      } else {
+        NULL
       }
-    )
+    })
   })
 }

R/ui-county-incidence.R

@@ -5,7 +5,7 @@
 #' @importFrom leaflet leafletOutput
 #' @importFrom htmltools a
 #'
-ui_county_incidence <- function(id, contact_info) {
+ui_county_incidence <- function(id, callback) {
   shinydashboard::tabItem(
     tabName = "county-incidence",
     shiny::fluidRow(
@@ -56,7 +56,7 @@ ui_county_incidence <- function(id, contact_info) {
         8,
         shinydashboard::box(
           width = 12,
-          shiny::uiOutput(
+          shiny::htmlOutput(
             shiny::NS(id, "map_message")
           ),
           shinycssloaders::withSpinner(
@@ -73,7 +73,7 @@ ui_county_incidence <- function(id, contact_info) {
         12,
         shinydashboard::box(
           width = 12,
-          shiny::includeMarkdown(contact_info)
+          shiny::includeMarkdown(callback("contact-info"))
         )
       )
     )

README.md

@@ -1,34 +1,35 @@
-## Oncarto
+# Oncarto
 
 <!-- badges: start -->
-
+[![Project Status: Prototype – Useable, some support, open to feedback, unstable API.](https://getwilds.org/badges/badges/prototype.svg)](https://getwilds.org/badges/#prototype)
+[![R-CMD-check](https://github.com/getwilds/oncarto/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/getwilds/oncarto/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 
-Oncarto (Oncology Cartographer) is an R package / Shiny dashboard developed by the Fred Hutch Data Science Lab ([DaSL](https://hutchdatascience.org)) for the automated integration and visualization of publicly available cancer incidence data for the Fred Hutch Cancer Center catchment area.
-
-### Background
+Oncarto (Oncology Cartographer) is a flexible Shiny application, structured
+as an R package, for visualizing and communicating geospatial data related to
+cancer epidemiology.
 
-To be filled in
-
-### Installation
+## Installation
 
 You can install the development version of `oncarto` as follows:
 
 ```{r}
-# To be filled in
+# install.packages("pak")
+pak::pak("getwilds/oncarto")
 ```
 
-### Example
+## Getting Started
 
-This is a basic example of how to...
+Get Oncarto running locally:
 
 ```{r}
 library(oncarto)
-## basic example code
-```
 
-### Contact
-
-This project is managed by the Fred Hutch Data Science Lab (DaSL)'s [Human-Computer Interaction](https://hutchdatascience.org/hci/) and [Translational Analytics](https://hutchdatascience.org/tr-analytics/) teams. You can read more about our group, mission, and other work on the DaSL [homepage](https://hutchdatascience.org).
-
-To report any bugs, submit patches, or request new features, please log an issue in our [issue tracker](https://github.com/getwilds/oncarto/issues/new). For direct inquiries, please send an email to DaSL Translational Analytics at [analytics\@fredhutch.org](mailto:[email protected]){.email}.
+run_app(title = "Oncarto (Oncology Cartographer)", 
+        logo_src = oncarto_file("fh-logo.png"), 
+        logo_href = "https://hutchdatascience.org", 
+        logo_width = "155px", 
+        logo_height = "35px", 
+        css = oncarto_file("fh.css"), 
+        callback = example_callback)
+```