Merge pull request #42 from MattCowgill/multiple_layers

Enable multiple annotations

.github/workflows/test-coverage.yaml

@@ -0,0 +1,50 @@
+# https://github.com/r-lib/actions/tree/master/examples#test-coverage-workflow
+
+on:
+  push:
+    branches:
+      - main
+      - master
+  pull_request:
+    branches:
+      - main
+      - master
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: macOS-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v1
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - name: Query dependencies
+        run: |
+          install.packages('remotes')
+          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: Cache R packages
+        uses: actions/cache@v2
+        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 dependencies
+        run: |
+          install.packages(c("remotes"))
+          remotes::install_deps(dependencies = TRUE)
+          remotes::install_cran("covr")
+        shell: Rscript {0}
+
+      - name: Test coverage
+        run: covr::codecov()
+        shell: Rscript {0}

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggannotate
 Title: Interactively Annotate ggplot2 Plots
-Version: 0.0.0.9300
+Version: 0.0.1
 Authors@R: 
     c(person(given = "Matt",
            family = "Cowgill",
@@ -13,17 +13,18 @@ Authors@R:
              email = "[email protected]"))
 Description: Place annotations exactly where you want them to go by 
     pointing and clicking.
+Date: 2020-12-15
 License: MIT + file LICENSE
 Imports: 
     ggplot2 (>= 3.2.1),
     rlang (>= 0.4.4),
-    rstudioapi (>= 0.10),
     shiny (>= 1.5.0),
     dplyr,
     purrr,
     clipr,
     stringr,
-    miniUI
+    miniUI,
+    tidyr
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.1.1

NAMESPACE

@@ -1,14 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
+export("%>%")
 export(ggannotate)
 export(make_layer)
 import(ggplot2)
 import(shiny)
 importFrom(clipr,write_clip)
+importFrom(dplyr,"%>%")
 importFrom(dplyr,case_when)
 importFrom(dplyr,if_else)
 importFrom(miniUI,miniPage)
 importFrom(purrr,compact)
+importFrom(rlang,.data)
 importFrom(rlang,`!!!`)
 importFrom(rlang,call2)
 importFrom(rlang,enquo)
@@ -19,8 +22,6 @@ importFrom(rlang,expr_text)
 importFrom(rlang,get_expr)
 importFrom(rlang,parse_expr)
 importFrom(rlang,syms)
-importFrom(rstudioapi,getSourceEditorContext)
-importFrom(rstudioapi,primary_selection)
 importFrom(stats,setNames)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_squish)

NEWS.md

@@ -1,3 +1,6 @@
+# ggannotate 0.1.0
+* Multiple annotations now allowed
+
 # ggannotate 0.0.0.9100
 
 * Added a `NEWS.md` file to track changes to the package.

R/call_to_string.R

@@ -1,11 +1,33 @@
 #' Given a call, create a tidy string
 #' @param call A call
+#' @return A string
 #' @importFrom rlang expr_text
 #' @importFrom stringr str_squish str_replace_all
+#' @keywords internal
 
 call_to_string <- function(call) {
   x <- rlang::expr_text(call)
   x <- stringr::str_squish(x)
   x <- gsub("\\), ", "\\),\n", x)
   x
 }
+
+#' Take a list of calls, return a string
+#' Each element of the list will be converted to a string, and then
+#' combined with the other elements
+#' @param list_of_calls a list of calls
+#' @param sep a character string to separate the items of `list_of_calls` when
+#' they are converted to a single string
+#' @return A length-one character vector; each element of `list_of_calls` will
+#' be converted to a string; each string will be combined, separated by
+#' `sep`
+#' @keywords internal
+calls_to_string <- function(list_of_calls, sep = " + \n") {
+  x <- purrr::map_chr(
+    list_of_calls,
+    call_to_string
+  )
+
+  x <- paste0(x, collapse = sep)
+  x
+}

R/combine_layers.R

@@ -0,0 +1,181 @@
+#' Take lists corresponding to several annotations, combine annotations
+#' that share parameters and geom, and return a list-of-lists.
+#' @name combine_layers
+#' @param lists List of lists to combine. Each sub-list should have
+#' at least these two elements:
+#' \itemize{
+#'   \item{`geom`}{length-one character vector such as `"text"`, or `"point"`}
+#'   \item{`aes`}{named list containing variable-value mappings,
+#'   such as `list(x = 3, y = 40)`)}
+#' }
+#'
+#' It can also have two optional additional elements:
+#' \itemize{}
+#'   \item{`param`}{named list containing parameter names and values, such as
+#' `list(colour = "black")`}
+#'   \item{`facets`}{named list containing facet variable-value pairs, such as
+#'   `list(cyl = 4)`}
+#' }
+#'
+#'
+#' @return A list of lists. Each sub-list will have `geom`, `aes`, `params`,
+#' and `facet` elements.
+#'
+#' Any supplied lists that share a geom, parameters, and facet variable + level
+#' will be combined, so the length of the returned list will not necessarily
+#' equal the number of lists supplied to `lists`.
+#'
+#' The order of the
+#' sub-lists in the returned list may also differ from the order
+#' in the supplied list.
+#'
+#' @examples
+#' library(ggplot2)
+#'
+#' layer_1 <- list(
+#'   geom = "text",
+#'   aes = list(x = 3, y = 30, label = "Some text"),
+#'   facets = list(cyl = 4),
+#'   params = list(colour = "red")
+#' )
+#'
+#' layer_2 <- list(
+#'   geom = "text",
+#'   aes = list(x = 4, y = 35, label = "Some other text"),
+#'   facets = list(cyl = 4),
+#'   params = list(colour = "red")
+#' )
+#'
+#' layer_3 <- list(
+#'   geom = "point",
+#'   aes = list(x = 3, y = 40)
+#' )
+#'
+#' layer_4 <- list(
+#'   geom = "text",
+#'   aes = list(x = 4, y = 45, label = "Some more text"),
+#'   params = list(colour = "black")
+#' )
+#'
+#' lists <- list(layer_1, layer_2, layer_3, layer_4)
+#'
+#' # combine_layers() combined layers 1 and 2 as they share a geom and params.
+#'
+#' layers <- combine_layers(lists)
+#'
+#' # The resulting list can be used to create ggplot2 annotations
+#'
+#' annots <- purrr::map(
+#'   layers,
+#'   ~ make_layer(
+#'     geom = .x$geom,
+#'     aes = .x$aes,
+#'     params = .x$params
+#'   ) %>%
+#'     eval()
+#' )
+#'
+#' ggplot2::ggplot() +
+#'   annots
+#' @noRd
+#' @importFrom rlang .data
+
+combine_layers <- function(lists) {
+  if (missing(lists)) {
+    stop("Must supply list of lists")
+  }
+
+  if (length(lists) == 0) {
+    stop("Must supply list of lists")
+  }
+
+  if (inherits(lists, "reactivevalues")) {
+    lists <- shiny::reactiveValuesToList(lists)
+  }
+
+  check_element_is_layer <- function(element) {
+    element_is_list <- is.list(element)
+    has_expected_sub_elements <- all(c("geom", "aes")
+    %in% names(element))
+    has_no_unexpected_sub_elements <- all(names(element) %in%
+      c(
+        "geom", "aes",
+        "facets", "params"
+      ))
+
+    aes_is_list <- is.list(element[["aes"]])
+
+    all(
+      element_is_list,
+      has_expected_sub_elements,
+      aes_is_list,
+      has_no_unexpected_sub_elements
+    )
+  }
+
+  each_element_is_layer <- all(purrr::map_lgl(
+    lists,
+    check_element_is_layer
+  ))
+
+  stopifnot(each_element_is_layer)
+
+  x <- dplyr::tibble(layer = lists)
+  x <- tidyr::unnest_wider(x, .data$layer)
+
+  x <- dplyr::group_by(x, dplyr::across(!dplyr::one_of("aes")))
+
+  x <- x %>%
+    dplyr::summarise(aes = list(.data$aes), .groups = "drop") %>%
+    dplyr::mutate(annot = dplyr::row_number())
+
+  x <- split(x, x$annot)
+
+  create_aes_out <- function(split_tib) {
+    aes_col <- split_tib %>%
+      dplyr::select(.data$aes) %>%
+      tidyr::unnest_longer(.data$aes)
+
+    if (all(is.na(aes_col))) {
+      list_out <- list(aes = NULL)
+    } else {
+      list_out <- aes_col %>%
+        tidyr::unnest_wider(.data$aes) %>%
+        as.list()
+    }
+
+    list_out
+  }
+
+  aes <- purrr::map(x, create_aes_out)
+
+  geoms <- purrr::map(x, ~ .x[["geom"]])
+
+  add_element_or_flatten <- function(list, element) {
+    if (is.null(list[[element]])) {
+      out <- list()
+    } else {
+      out <- purrr::flatten(list[[element]])
+    }
+    out
+  }
+
+  params <- purrr::map(x, add_element_or_flatten,
+    element = "params"
+  )
+
+  facets <- purrr::map(x, add_element_or_flatten,
+    element = "facets"
+  )
+
+  out <- list(
+    aes = aes,
+    params = params,
+    facets = facets,
+    geom = geoms
+  )
+
+  purrr::transpose(out)
+}
+
+safely_combine_layers <- purrr::safely(combine_layers)

R/date_functions.R

@@ -1,5 +1,6 @@
 #' Check if x and/or y-scales of a built ggplot2 object are date scales
-#' @param built_plot A built ggplot2 object, created with `ggplot2::ggplot_build()`
+#' @param built_plot A built ggplot2 object, created with
+#' `ggplot2::ggplot_build()`
 check_if_date <- function(built_plot) {
   p <- built_plot
 
@@ -39,7 +40,8 @@ num_to_date <- function(numdate) {
 #' The list object returned by Shiny (eg. `input$plot_click`) does not return
 #' dates or flipped scales in a manner that can be easily dealt with. This
 #' function corrects the date and/or flipped scales.
-#' @param input_list List; returned by Shiny on input, such as `input$plot_click`
+#' @param input_list List; returned by Shiny on input,
+#' such as `input$plot_click`
 #' @param axis_classes List; output of `check_if_date()`
 #' @param flipped_coords Logical; returned by `ggplot2::summarise_coord()$flip`
 #' @noRd

R/geom_specific_ui.R

@@ -143,7 +143,7 @@ rect_ui <- tagList(
   fluidRow(
     column(
       6,
-      sliderInput("alpha", "Fill opacity",
+      sliderInput("alpha", "Fill opacity (alpha)",
         min = 0, max = 1, value = 0.25, step = 0.05
       )
     ),