Merge more 0.4.2

R/create_template.R

@@ -529,7 +529,7 @@ create_template <- function(path, name, common_objects, modules, author,
   # Install package ====
   if (install){
   devtools::document(path)
-  devtools::install_local(path = path, force = TRUE)
+  devtools::install(path, force = TRUE)
   }
 
   invisible()

R/plot_hist_f.R

@@ -3,28 +3,31 @@
 #' and extracts values from a raster image, returning a histogram of density
 #' @param raster SpatRaster object
 #' @param bins The number of breaks in the histogram
+#' @param palette character. The colour palette to use
+#' @param name character. The name of the variable
 #' @param logger Stores all notification messages to be displayed in the Log
 #'   Window. Insert the logger reactive list here for running in
 #'   shiny, otherwise leave the default NULL
-#' @return a list of class histogram
+#' @return a function that generates a histogram
 #' @author Simon Smart <simon.smart@@cantab.net>
 #' @examples
 #' if (check_suggests(example = TRUE)) {
 #'   raster <- terra::rast(ncol = 8, nrow = 8)
 #'   raster[] <- sapply(1:terra::ncell(raster), function(x){
 #'     rnorm(1, ifelse(x %% 8 != 0, x %% 8, 8), 3)})
-#'   histogram <- plot_hist(raster, bins = 10)
+#'   histogram <- plot_hist(raster, bins = 10, palette = "Greens", name = "Example")
+#'   histogram()
 #' } else {
 #'   message('reinstall with install.packages("shinyscholar", dependencies = TRUE)
 #'   to run this example')
 #' }
 #' @export
 
-plot_hist <- function(raster, bins, logger = NULL) {
+plot_hist <- function(raster, bins, palette, name, logger = NULL) {
 
   check_suggests()
 
-  if (!("SpatRaster" %in% class(raster))){
+  if (!inherits(raster, "SpatRaster")){
     logger |> writeLog(type = "error", "The raster must be a SpatRaster")
     return()
   }
@@ -34,11 +37,32 @@ plot_hist <- function(raster, bins, logger = NULL) {
     return()
   }
 
+  if (!inherits(palette, "character")){
+    logger |> writeLog(type = "error", "palette must be a character string")
+    return()
+  }
+
+  if (!inherits(name, "character")){
+    logger |> writeLog(type = "error", "name must be a character string")
+    return()
+  }
+
+  if (!(palette %in% c("Greens", "YlOrRd", "Greys", "Blues"))){
+    logger |> writeLog(type = "error", "palette must be either 'Greens', 'YlOrRd', 'Greys' or 'Blues'")
+    return()
+  }
+
   raster_values <- terra::values(raster)
   histogram <- graphics::hist(raster_values, plot = FALSE,
                               breaks = seq(min(raster_values, na.rm = TRUE),
                                            max(raster_values, na.rm = TRUE),
                                            length.out = bins + 1))
   histogram$density <- histogram$counts / sum(histogram$counts) * 100
-  histogram
+
+  pal <- RColorBrewer::brewer.pal(9, palette)
+  pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
+  hist_cols <- pal_ramp(bins)
+
+  function(){plot(histogram, freq = F, main = "", xlab = name, ylab = "Frequency (%)", col = hist_cols)}
+
 }

R/plot_scatter_f.R

@@ -5,27 +5,29 @@
 #' @param raster SpatRaster. Raster to be sampled
 #' @param sample numeric. Number of points to sample
 #' @param axis character. Which axis coordinates of the raster to return
+#' @param name character. The name of the raster variable
 #' @param logger Stores all notification messages to be displayed in the Log
 #'   Window. Insert the logger reactive list here for running in
 #'   shiny, otherwise leave the default NULL
-#' @return a dataframe containing the axis values and the cell values
+#' @return a function that generates a scatterplot
 #' @author Simon Smart <simon.smart@@cantab.net>
 #' @examples
 #' if (check_suggests(example = TRUE)) {
 #'   raster <- terra::rast(ncol = 8, nrow = 8)
 #'   raster[] <- sapply(1:terra::ncell(raster), function(x){
 #'      rnorm(1, ifelse(x %% 8 != 0, x %% 8, 8), 3)})
-#'   scatterplot <- plot_scatter(raster, sample = 10, axis = "y")
+#'   scatterplot <- plot_scatter(raster, sample = 10, axis = "Longitude", name = "Example")
+#'   scatterplot()
 #' } else {
 #'   message('reinstall with install.packages("shinyscholar", dependencies = TRUE)
 #'   to run this example')
 #' }
 #' @export
-plot_scatter <- function(raster, sample, axis, logger = NULL) {
+plot_scatter <- function(raster, sample, axis, name, logger = NULL) {
 
   check_suggests()
 
-  if (!("SpatRaster" %in% class(raster))){
+  if (!inherits(raster, "SpatRaster")){
     logger |> writeLog(type = "error", "The raster must be a SpatRaster")
     return()
   }
@@ -35,13 +37,28 @@ plot_scatter <- function(raster, sample, axis, logger = NULL) {
     return()
   }
 
-  if (!(axis %in% c("x", "y"))){
-    logger |> writeLog(type = "error", "axis must be either x or y")
+  if (!inherits(axis, "character")){
+    logger |> writeLog(type = "error", "axis must be a character string")
     return()
   }
 
-  samp <- terra::spatSample(raster, sample, method = "random", xy = TRUE, as.df = TRUE)
-  colnames(samp)[3] <- "value"
-  samp[, c(axis, "value")]
+  if (!(axis %in% c("Longitude", "Latitude"))){
+    logger |> writeLog(type = "error", "axis must be either Latitude or Longitude")
+    return()
+  }
+
+  if (!inherits(name, "character")){
+    logger |> writeLog(type = "error", "name must be a character string")
+    return()
+  }
+
+  if (axis == "Longitude"){short_axis <- "x"} else {short_axis <- "y"}
+
+  sampled <- terra::spatSample(raster, sample, method = "random", xy = TRUE, as.df = TRUE)
+  colnames(sampled)[3] <- "value"
+  sampled <-sampled[, c(short_axis, "value")]
+
+  function(){plot(sampled[[1]], sampled[[2]], xlab = axis, ylab = name)}
+
 
 }

README.md

@@ -85,7 +85,7 @@ This creates a directory with the following structure:
 │   └── shiny
 │       ├── common.R                                            Data objects shared between modules
 │       ├── global.R                                            Loads package and modules
-│       ├── helpers.R                                           Functions to create module UI
+│       ├── ui_helpers.R                                        Functions to create module UI
 │       ├── server.R                                            App server
 │       ├── ui.R                                                App UI
 │       ├── modules 

inst/shiny/modules/plot_auto.R

@@ -25,7 +25,8 @@ plot_auto_module_server <- function(id, common, parent_session, map) {
     req(common$raster)
 
     # FUNCTION CALL ####
-    histogram <- plot_hist(common$raster, as.numeric(input$bins))
+    raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
+    histogram <- plot_hist(common$raster, as.numeric(input$bins), input$pal, raster_name, common$logger)
     # LOAD INTO COMMON ####
     common$histogram_auto <- histogram
     # METADATA ####
@@ -37,20 +38,12 @@ plot_auto_module_server <- function(id, common, parent_session, map) {
     shinyjs::show("download")
   })
 
-  plot_function <- function(){
-    pal <- RColorBrewer::brewer.pal(9, common$meta$plot_auto$pal)
-    pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
-    bins <- common$meta$plot_auto$bins
-    cols <- pal_ramp(bins)
-    plot(common$histogram_auto, freq = FALSE, main = "", xlab = common$meta$plot_auto$name, ylab = "Frequency (%)", col = cols)
-  }
-
   output$hist <- renderPlot({
     watch("plot_auto")
     req(common$histogram_auto)
     # Included here so that the module is only 'used' if the results are rendered
     common$meta$plot_auto$used <- TRUE
-    plot_function()
+    common$histogram_auto()
   })
 
   output$download <- downloadHandler(
@@ -59,7 +52,7 @@ plot_auto_module_server <- function(id, common, parent_session, map) {
     },
     content = function(file) {
       png(file, width = 1000, height = 500)
-      plot_function()
+      common$histogram_auto()
       dev.off()
     })
 

inst/shiny/modules/plot_auto.Rmd

@@ -3,10 +3,6 @@ Plots the data as a histogram
 ```
 
 ```{r, echo = {{plot_auto_knit}}, include = {{plot_auto_knit}}}
-histogram <- plot_hist(raster, {{plot_auto_bins}})
-pal <- RColorBrewer::brewer.pal(9, {{plot_auto_pal}})
-pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
-hist_cols <- pal_ramp({{plot_auto_bins}})
-
-plot(histogram, freq = F, main = "", xlab = {{plot_auto_name}}, ylab = "Frequency (%)", col = hist_cols)
+histogram <- plot_hist(raster, {{plot_auto_bins}}, {{plot_auto_pal}}, {{plot_auto_name}})
+histogram()
 ```

inst/shiny/modules/plot_hist.R

@@ -21,13 +21,14 @@ plot_hist_module_server <- function(id, common, parent_session, map) {
       return()
     }
     # FUNCTION CALL ####
-    histogram <- plot_hist(common$raster, as.numeric(input$bins))
+    raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
+    histogram <- plot_hist(common$raster, as.numeric(input$bins), input$pal, raster_name, common$logger)
     # LOAD INTO COMMON ####
     common$histogram <- histogram
     # METADATA ####
     common$meta$plot_hist$bins <- as.numeric(input$bins)
     common$meta$plot_hist$pal <- input$pal
-    common$meta$plot_hist$name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
+    common$meta$plot_hist$name <- raster_name
     # TRIGGER ####
     trigger("plot_hist")
     show_results(parent_session)
@@ -45,7 +46,7 @@ plot_hist_module_server <- function(id, common, parent_session, map) {
   output$hist <- renderPlot({
     watch("plot_hist")
     req(common$histogram)
-    plot_function()
+    common$histogram()
   })
 
   output$download <- downloadHandler(
@@ -54,7 +55,7 @@ plot_hist_module_server <- function(id, common, parent_session, map) {
     },
     content = function(file) {
       png(file, width = 1000, height = 500)
-      plot_function()
+      common$histogram()
       dev.off()
     })
 

inst/shiny/modules/plot_hist.Rmd

@@ -6,11 +6,6 @@ Plots the data as a histogram
 {r, fig.width = 8, fig.height = 5}
 ```
 ```{r, echo = {{plot_hist_knit}}, include = {{plot_hist_knit}}}
-
-histogram <- plot_hist(raster, {{plot_hist_bins}})
-pal <- RColorBrewer::brewer.pal(9, {{plot_hist_pal}})
-pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
-hist_cols <- pal_ramp({{plot_hist_bins}})
-
-plot(histogram, freq = F, main = "", xlab = {{plot_hist_name}}, ylab = "Frequency (%)", col = hist_cols)
+histogram <- plot_hist(raster, {{plot_hist_bins}}, {{plot_hist_pal}}, {{plot_hist_name}})
+histogram()
 ```

inst/shiny/modules/plot_scatter.R

@@ -8,7 +8,6 @@ plot_scatter_module_ui <- function(id) {
   )
 }
 
-
 plot_scatter_module_server <- function(id, common, parent_session, map) {
   moduleServer(id, function(input, output, session) {
 
@@ -21,29 +20,24 @@ plot_scatter_module_server <- function(id, common, parent_session, map) {
       return()
     }
     # FUNCTION CALL ####
-    if (input$axis == "Longitude"){axis <- "x"} else {axis <- "y"}
-    scatterplot <- plot_scatter(common$raster, input$sample, axis)
+    raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
+    scatterplot <- plot_scatter(common$raster, input$sample, input$axis, raster_name)
     # LOAD INTO SPP ####
     common$scatterplot <- scatterplot
     # METADATA ####
-    common$meta$plot_scatter$axis_short <- axis
-    common$meta$plot_scatter$axis_long <- input$axis
+    common$meta$plot_scatter$axis <- input$axis
     common$meta$plot_scatter$sample <- input$sample
-    common$meta$plot_scatter$name <-  c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
+    common$meta$plot_scatter$name <- raster_name
     # TRIGGER ####
     trigger("plot_scatter")
     show_results(parent_session)
     shinyjs::show("download")
   })
 
-  plot_function <- function(){
-    plot(common$scatterplot[[1]], common$scatterplot[[2]], xlab = common$meta$plot_scatter$axis_long, ylab = common$meta$plot_scatter$name)
-  }
-
   output$result <- renderPlot({
     watch("plot_scatter")
     req(common$scatterplot)
-    plot_function()
+    common$scatterplot()
   })
 
   output$download <- downloadHandler(
@@ -52,7 +46,7 @@ plot_scatter_module_server <- function(id, common, parent_session, map) {
     },
     content = function(file) {
       png(file, width = 1000, height = 500)
-      plot_function()
+      common$scatterplot()
       dev.off()
     })
 
@@ -83,8 +77,7 @@ plot_scatter_module_rmd <- function(common) {
   # Variables used in the module's Rmd code
   list(
       plot_scatter_knit = !is.null(common$scatterplot),
-      plot_scatter_axis_short = common$meta$plot_scatter$axis_short,
-      plot_scatter_axis_long = common$meta$plot_scatter$axis_long,
+      plot_scatter_axis = common$meta$plot_scatter$axis,
       plot_scatter_sample = common$meta$plot_scatter$sample,
       plot_scatter_name = common$meta$plot_scatter$name)
 }

inst/shiny/modules/plot_scatter.Rmd

@@ -3,9 +3,6 @@ Plots the data on a scatter plot
 ```
 
 ```{r, echo = {{plot_scatter_knit}}, include = {{plot_scatter_knit}}}
-
-scatterplot <- plot_scatter(raster, {{plot_scatter_sample}}, {{plot_scatter_axis_short}})
-
-plot(scatterplot[[1]], scatterplot[[2]], xlab = {{plot_scatter_axis_long}}, ylab = {{plot_scatter_name}})
-
+scatterplot <- plot_scatter(raster, {{plot_scatter_sample}}, {{plot_scatter_axis}}, {{plot_scatter_name}})
+scatterplot()
 ```

inst/shiny/modules/plot_semi.R

@@ -35,7 +35,8 @@ plot_semi_module_server <- function(id, common, parent_session, map) {
   observeEvent(triggers(), {
     req(common$raster)
     # FUNCTION CALL ####
-    histogram <- plot_hist(common$raster, as.numeric(input$bins))
+    raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
+    histogram <- plot_hist(common$raster, as.numeric(input$bins), input$pal, raster_name, common$logger)
     # LOAD INTO COMMON ####
     common$histogram_semi <- histogram
     # METADATA ####
@@ -49,18 +50,10 @@ plot_semi_module_server <- function(id, common, parent_session, map) {
     shinyjs::show("download")
   })
 
-  plot_function <- function(){
-    pal <- RColorBrewer::brewer.pal(9, common$meta$plot_semi$pal)
-    pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
-    bins <- common$meta$plot_semi$bins
-    cols <- pal_ramp(bins)
-    plot(common$histogram_semi, freq = FALSE, main = "", xlab = common$meta$plot_semi$name, ylab = "Frequency (%)", col = cols)
-  }
-
   output$hist <- renderPlot({
     watch("plot_semi_update")
     req(common$histogram_semi)
-    plot_function()
+    common$histogram_semi()
   })
 
   output$download <- downloadHandler(
@@ -69,7 +62,7 @@ plot_semi_module_server <- function(id, common, parent_session, map) {
     },
     content = function(file) {
       png(file, width = 1000, height = 500)
-      plot_function()
+      common$histogram_semi()
       dev.off()
     })
 

inst/shiny/modules/plot_semi.Rmd

@@ -3,10 +3,6 @@ Plots the data as a histogram
 ```
 
 ```{r, echo = {{plot_semi_knit}}, include = {{plot_semi_knit}}}
-histogram <- plot_hist(raster, {{plot_semi_bins}})
-pal <- RColorBrewer::brewer.pal(9, {{plot_semi_pal}})
-pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
-hist_cols <- pal_ramp({{plot_semi_bins}})
-
-plot(histogram, freq = F, main = "", xlab = {{plot_semi_name}}, ylab = "Frequency (%)", col = hist_cols)
+histogram <- plot_hist(raster, {{plot_semi_bins}}, {{plot_semi_pal}}, {{plot_semi_name}})
+histogram()
 ```