refactor ETL

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
+export(articles_by_jp)
 export(colors_license)
 export(colors_license_unpaywall)
 export(colors_source_disclosure)

R/data.R

@@ -1,10 +1,11 @@
+# crossref ====
 #' Hybrid open access articles via [Crossref](https://www.crossref.org)
-#' 
+#'
 #' Contains information about the overall publication volume, and, if available, cost information from the Open APC Initiative.
-#' 
-#' @format 
+#'
+#' @format
 #' A data frame with the following variables:
-#' 
+#'
 #' | **Variable**               | **Description**                                                    |
 #' | -------------------------- | ------------------------------------------------------------------ |
 #' | `license`                  | Normalized open content license statement                          |
@@ -27,14 +28,14 @@
 #' | `subdomain`                | Email subdomain first or corresponding author                      |
 #' | `domain`                   | Email domain first or corresponding author                         |
 #' | `suffix`                   | Email suffix first or corresponding author                         |
-#' 
+#'
 #' @source [Crossref](https://www.crossref.org)
-#' 
+#'
 #' @section License:
 #' See Crossref [Terms and Conditions](https://www.crossref.org/requestaccount/termsandconditions.html)
-#' 
+#'
 #' @family data
-#' 
+#'
 #' @export
 # storing this as a function ensures this is read in only at compile time, not run time
 hybrid_publications <- function() {
@@ -62,9 +63,29 @@ hybrid_publications <- function() {
       domain = col_character(),
       suffix = col_character()
     )
-  )
+  ) %>%
+    # reorder factor levels for better cosmetic results
+    mutate(
+      license = forcats::fct_infreq(.data$license),
+      journal_title = forcats::fct_relevel(.data$journal_title, sort),
+      publisher = forcats::fct_infreq(.data$publisher),
+    )
+}
+
+#' @describeIn hybrid_publications number of articles by journal and publisher
+#'
+#' @examples
+#' articles_by_jp()
+#' @export
+#' @family data
+articles_by_jp <- function() {
+  # this is smaller by a factor of 100 than the whole thing, useful for shiny UI functions as well as plots
+  hybrid_publications() %>%
+    group_by(.data$journal_title, .data$publisher) %>%
+    summarise(n = n())
 }
-
+
+# unpaywall ====
 #' Unpaywall data
 # TODO improve docs
 #' @family data
@@ -79,4 +100,4 @@ unpaywall_df <- function() {
       articles = col_integer()
     )
   )
-}
+}

R/helpers.R

@@ -41,3 +41,44 @@ find_all_ints <- function(x) {
   x <- as.integer(x)
   min(x):max(x)
 }
+
+#' Run a shiny module
+#'
+#' Used for testing and development.
+#' Based on [Cole Arendt](https://github.com/colearendt)s [suggestion](https://community.rstudio.com/t/tips-for-module-development/14510).
+#'
+#' @inheritParams shiny::NS
+#'
+#' @param ui part of the module
+#'
+#' @inheritParams shiny::callModule
+#'
+#' @param ui_params, module_params list of parameters to be passed to the `ui` and `module` (= server function) of the module, respectively.
+#'
+#' @family CICD
+#'
+#' @examples
+#' runModule(ui = jpPickerInput, module = jpPicker)
+#' @export
+#' @keywords internal
+# TODO this should be factored out to a separate pkg as per https://github.com/subugoe/metaR/issues/94
+runModule <- function(id = "test_module",
+                      ui,
+                      module,
+                      ui_params = list(),
+                      module_params = list()) {
+  actualUI <- do.call(ui, c(id = id, ui_params))
+
+  actualServer <- function(input, output, session) {
+    do.call(
+      callModule,
+      c(
+        module = module,
+        id = id,
+        module_params
+      )
+    )
+  }
+
+  shinyApp(actualUI, actualServer)
+}

R/modules.R

@@ -0,0 +1,53 @@
+jpPickerInput <- function(id) {
+  ns <- NS(id)
+
+  tagList(
+    selectizeInput(
+      inputId = ns("publishers"),
+      label = "Selected Publishers",
+      choices = c(All = "", forcats::fct_unique(articles_by_jp()$publisher)),
+      multiple = TRUE
+    ),
+    selectizeInput(
+      inputId = ns("journals"),
+      label = "Selected Journals",
+      choices = c(All = "", unique(articles_by_jp()$journal_title)),
+      multiple = TRUE
+    )
+  )
+}
+
+jpPicker <- function(input, output, session) {
+  jpFiltered <- reactive({
+    if (is.null(input$publishers)) {
+      res <- articles_by_jp()
+    } else {
+      res <- filter(
+        .data = articles_by_jp(),
+        .data$publisher %in% input$publishers
+      )
+    }
+    if (!is.null(input$journals)) {
+      res <- filter(
+        .data = res,
+        .data$journal_title %in% input$journals
+      )
+    }
+    res
+  })
+
+  # only update journal input when publishers change, not when journals change
+  observeEvent(
+    eventExpr = input$publishers,
+    handlerExpr = {
+      updateSelectizeInput(
+        session = session,
+        inputId = "journals",
+        choices = c(All = "", levels(jpFiltered()$journal_title))
+      )
+    }
+  )
+
+  # might add additional submit button here with isolation, but seems fast enough for now
+  jpFiltered
+}