Merge pull request #29 from CRI-iAtlas/fix_documentation_and_column_n…

…ames Fix documentation and column names
CRI-iAtlas · Dec 16, 2021 · 3b19e8e · 3b19e8e
2 parents 0661214 + 557b9c2
commit 3b19e8e
Show file tree

Hide file tree

Showing 30 changed files with 510 additions and 372 deletions.
diff --git a/.Rprofile b/.Rprofile
@@ -1,3 +1,15 @@
+# For Ubuntu 18.04 (also known as Bionic)
+options(repos = c(
+  REPO_NAME = "https://packagemanager.rstudio.com/all/__linux__/bionic/latest",
+  getOption("repos")
+))
+
+# For Ubuntu 20.04 (also known as Focal)
+options(repos = c(
+  REPO_NAME = "https://packagemanager.rstudio.com/all/__linux__/focal/latest",
+  getOption("repos")
+  ))
+
 if (interactive()) {
   source("renv/activate.R")
   suppressMessages(require(devtools))

diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -1,12 +1,10 @@
+# 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
+    branches: [main, master, staging, develop]
   pull_request:
-    branches:
-      - main
-      - master
+    branches: [main, master, staging, develop]
 
 name: R-CMD-check
 
@@ -20,8 +18,9 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-          - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest", http-user-agent: "R/4.1.0 (ubuntu-20.04) R (4.1.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" }
+          - {os: macOS-latest,   r: '4.1.0'}
+          - {os: windows-latest, r: '4.1.0'}
+          - {os: ubuntu-20.04, r: '4.1.0', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
@@ -31,47 +30,24 @@ jobs:
     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-pandoc@v1
-
-      - name: Query dependencies
-        run: |
-          install.packages('remotes', repos = "http://cran.us.r-project.org")
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Restore R package cache
-        uses: actions/cache@v2
+      - uses: r-lib/actions/setup-r-dependencies@v1
         with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
-        run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
+          extra-packages: rcmdcheck
 
-      - name: Install dependencies
-        run: |
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
+      - uses: r-lib/actions/check-r-package@v1
 
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_REMOTE_: false
-        run: |
-          options(crayon.enabled = TRUE)
-          rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
+      - name: Show testthat output
+        if: always()
+        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
 
       - name: Upload check results
         if: failure()

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: iatlas.modules
 Title: iAatlas Modules
 Type: Package
-Version: 0.5.7
+Version: 0.6.0
 Date: 2021-1-30
 Author: Andrew Lamb
 Maintainer: Andrew Lamb <Andrew.Lamb@sagebase.org>

diff --git a/R/barplot_server.R b/R/barplot_server.R
@@ -4,8 +4,8 @@
 #' @param id Module ID
 #' @param plot_data_function A shiny::reactive that returns a function
 #' The function must take an argument called ".feature_class" and return a
-#' dataframe with columns "sample", "feature", "feature_value", "group",
-#' and optionally "group_description"
+#' dataframe with columns "sample_name", "feature_name", "feature_value",
+#' "group_name", and optionally "group_description"
 #' @param feature_classes A shiny::reactive that returns a vector of strings.
 #' One of these strings are passed to plot_data_function
 #' @param barplot_xlab A shiny::reactive that returns a string
@@ -75,9 +75,9 @@ barplot_server <- function(
         plotly_bar(
           summarized_barplot_data(),
           source_name = barplot_source_name(),
-          x_col = "group",
+          x_col = "group_name",
           y_col = "MEAN",
-          color_col = "feature",
+          color_col = "feature_name",
           error_col = "SE",
           text_col = "text",
           xlab = barplot_xlab(),
@@ -101,8 +101,8 @@ barplot_server <- function(
       barplot_eventdata <- shiny::reactive({
         shiny::req(barplot_source_name(), summarized_barplot_data())
         eventdata <- plotly::event_data("plotly_click", barplot_source_name())
-        if(is.null(eventdata) & !is.null(input$test_event_data)){
-          eventdata <- input$test_event_data
+        if(is.null(eventdata) & !is.null(input$mock_event_data)){
+          eventdata <- input$mock_event_data
         }
         shiny::validate(shiny::need(eventdata, "Click on above barplot."))
         return(eventdata)
@@ -116,10 +116,10 @@ barplot_server <- function(
       scatterplot_data <- shiny::reactive({
         shiny::req(barplot_data(), selected_group())
         barplot_data() %>%
-          dplyr::filter(.data$group == selected_group()) %>%
-          dplyr::select("sample", "group", "feature", "feature_value") %>%
+          dplyr::filter(.data$group_name == selected_group()) %>%
+          dplyr::select("sample_name", "group_name", "feature_name", "feature_value") %>%
           tidyr::pivot_wider(
-            ., values_from = "feature_value", names_from = "feature"
+            ., values_from = "feature_value", names_from = "feature_name"
           )
       })
 

diff --git a/R/barplot_server_functions.R b/R/barplot_server_functions.R
@@ -2,25 +2,36 @@ build_barplot_data <- function(plot_data_function, feature_class_choice){
   data <-
     plot_data_function(.feature_class = feature_class_choice) %>%
     dplyr::select(dplyr::any_of(
-      c("sample", "feature", "feature_value", "group", "group_description")
+      c(
+        "sample_name",
+        "feature_name",
+        "feature_value",
+        "group_name",
+        "group_description"
+      )
     ))
 }
 
 summarise_barplot_se <- function(data, title){
   data %>%
-    dplyr::select("group", "feature", "feature_value") %>%
+    dplyr::select("group_name", "feature_name", "feature_value") %>%
     tidyr::drop_na() %>%
-    dplyr::group_by_at(dplyr::vars("group", "feature")) %>%
+    dplyr::group_by_at(dplyr::vars("group_name", "feature_name")) %>%
     dplyr::summarise(
       "MEAN" = mean(.data$feature_value),
       "SE" = .data$MEAN / sqrt(dplyr::n()),
       .groups = "drop"
     ) %>%
-    create_plotly_text(.data$feature, .data$group, c("MEAN", "SE"), title)
+    create_plotly_text(
+      .data$feature_name,
+      .data$group_name,
+      c("MEAN", "SE"),
+      title
+    )
 }
 
 get_barplot_group_data <- function(barplot_data){
   barplot_data %>%
-    dplyr::select("group", "description" = "group_description") %>%
+    dplyr::select("group_name", "group_description") %>%
     dplyr::distinct()
 }
diff --git a/R/distributions_plot_server.R b/R/distributions_plot_server.R
@@ -1,12 +1,13 @@
 
-#' Barplot Server
+#' Distributions Plot Server
 #'
 #' @param id Module ID
 #' @param plot_data_function A shiny::reactive that returns a function.
 #' The function must take an argument called ".feature" and return a
-#' dataframe with columns "sample", "feature", "feature_value", "group",
-#' and optionally "group_description", "color"
-#' @param features A shiny::reactive that returns a dataframe with "feature",
+#' dataframe with columns "sample_name", "feature_name", "feature_value",
+#' "group_name",
+#' and optionally "group_description", "group_color"
+#' @param features A shiny::reactive that returns a dataframe with "feature_name",
 #' "feature_display", and any other additional optional columns to group the
 #' features by. If not given, the argument to plot_data_function will be Null.
 #' @param distplot_xlab A shiny::reactive that returns a string
@@ -143,9 +144,9 @@ distributions_plot_server <- function(
 
       plot_fill_colors <- shiny::reactive({
         shiny::req(distplot_data())
-        if("color" %in% colnames(distplot_data())){
+        if("group_color" %in% colnames(distplot_data())){
           fill_colors <- distplot_data() %>%
-            dplyr::select("group", "color") %>%
+            dplyr::select("group_name", "group_color") %>%
             dplyr::distinct() %>%
             tibble::deframe(.)
         } else {
@@ -176,7 +177,7 @@ distributions_plot_server <- function(
         plotly_function()(
           plot_data = distplot_data(),
           source_name = distplot_source_name(),
-          x_col = "group",
+          x_col = "group_name",
           y_col = "feature_value",
           fill_colors = plot_fill_colors(),
           title = plot_title(),
@@ -188,14 +189,17 @@ distributions_plot_server <- function(
       distplot_eventdata <- shiny::reactive({
         shiny::req(distplot_source_name(), distplot_data(), plotly_function())
         eventdata <- plotly::event_data("plotly_click", distplot_source_name())
+        if(is.null(eventdata) & !is.null(input$mock_event_data)){
+          eventdata <- input$mock_event_data
+        }
         shiny::validate(shiny::need(eventdata, "Click on above barplot."))
         return(eventdata)
       })
 
       group_data <- shiny::reactive({
         shiny::req("group_description" %in% colnames(distplot_data()))
         distplot_data() %>%
-          dplyr::select("group", "description" = "group_description") %>%
+          dplyr::select("group_name", "group_description") %>%
           dplyr::distinct()
       })
 

diff --git a/R/distributions_plot_server_functions.R b/R/distributions_plot_server_functions.R
@@ -47,8 +47,8 @@ create_distplot_data <- function(
     reafctor_by_tbl_value_column(reorder_method_choice) %>%
     dplyr::select(dplyr::any_of(
       c(
-        "sample", "feature", "feature_value", "group", "group_description",
-        "color"
+        "sample_name", "feature_name", "feature_value", "group_name", "group_description",
+        "group_color"
       )
     ))
 }
diff --git a/R/drilldown_histogram_server.R b/R/drilldown_histogram_server.R
@@ -3,7 +3,7 @@
 #'
 #' @param id Module ID
 #' @param plot_data A shiny::reactive that returns a dataframe with columns
-#' "group", "feature_value"
+#' "group_name", "feature_value"
 #' @param eventdata A shiny::reactive that returns a dataframe with column
 #' "key"
 #' @param ... arguments sents to plotly_histogram
@@ -30,10 +30,10 @@ drilldown_histogram_server <- function(
         shiny::req(
           plot_data(),
           selected_group(),
-          selected_group() %in% plot_data()$group
+          selected_group() %in% plot_data()$group_name
         )
         plot_data() %>%
-          dplyr::filter(.data$group == selected_group()) %>%
+          dplyr::filter(.data$group_name == selected_group()) %>%
           dplyr::select("feature_value")
       })
 

diff --git a/R/drilldown_scatterplot_server.R b/R/drilldown_scatterplot_server.R
@@ -3,7 +3,7 @@
 #'
 #' @param id Module ID
 #' @param scatterplot_data A shiny::reactive that returns a dataframe with columns
-#' "sample", "group", "feature", "feature_value"
+#' "sample_name", "group_name", and two value columns
 #' @param x_feature_input A shiny::reactive that returns a string
 #' @param y_feature_input A shiny::reactive that returns a string
 #' @param selected_group A string, this gets added to the sample label
@@ -25,7 +25,7 @@ drilldown_scatterplot_server <- function(
       scatterplot_feature_columns <- shiny::reactive({
         scatterplot_data() %>%
           colnames() %>%
-          setdiff(c("sample", "group"))
+          setdiff(c("sample_name", "group_name"))
       })
 
       display_feature_selection_ui <- shiny::reactive({

diff --git a/R/drilldown_scatterplot_server_functions.R b/R/drilldown_scatterplot_server_functions.R
@@ -16,11 +16,11 @@ format_scatterplot_data <- function(
 ){
   plot_data %>%
     dplyr::select(dplyr::all_of(c(
-      "sample", "group", "x" =  x_feature, "y" = y_feature
+      "sample_name", "group_name", "x" =  x_feature, "y" = y_feature
     ))) %>%
     tidyr::drop_na() %>%
     create_plotly_text(
-      .data$sample, .data$group, c("x", "y"), "Sample"
+      .data$sample_name, .data$group_name, c("x", "y"), "Sample"
     ) %>%
     dplyr::select("x", "y", "text")
 }