Skip to content

Commit 9c293dc

Browse files
simon-smart88simon-smart88
committed
refactor plotting functions to return functions that generate the plots
1 parent 44b21a2 commit 9c293dc

File tree

12 files changed

+70
-82
lines changed

12 files changed

+70
-82
lines changed

‎R/plot_hist_f.R‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,24 +3,27 @@
33
#' and extracts values from a raster image, returning a histogram of density
44
#' @param raster SpatRaster object
55
#' @param bins The number of breaks in the histogram
6+
#' @param palette character. The colour palette to use
7+
#' @param name character. The name of the variable
68
#' @param logger Stores all notification messages to be displayed in the Log
79
#' Window. Insert the logger reactive list here for running in
810
#' shiny, otherwise leave the default NULL
9-
#' @return a list of class histogram
11+
#' @return a function that generates a histogram
1012
#' @author Simon Smart <simon.smart@@cantab.net>
1113
#' @examples
1214
#' if (check_suggests(example = TRUE)) {
1315
#' raster <- terra::rast(ncol = 8, nrow = 8)
1416
#' raster[] <- sapply(1:terra::ncell(raster), function(x){
1517
#' rnorm(1, ifelse(x %% 8 != 0, x %% 8, 8), 3)})
16-
#' histogram <- plot_hist(raster, bins = 10)
18+
#' histogram <- plot_hist(raster, bins = 10, palette = "Greens", name = "Example")
19+
#' histogram()
1720
#' } else {
1821
#' message('reinstall with install.packages("shinyscholar", dependencies = TRUE)
1922
#' to run this example')
2023
#' }
2124
#' @export
2225

23-
plot_hist <- function(raster, bins, logger = NULL) {
26+
plot_hist <- function(raster, bins, palette, name, logger = NULL) {
2427

2528
check_suggests()
2629

@@ -40,5 +43,11 @@ plot_hist <- function(raster, bins, logger = NULL) {
4043
max(raster_values, na.rm = TRUE),
4144
length.out = bins + 1))
4245
histogram$density <- histogram$counts / sum(histogram$counts) * 100
43-
histogram
46+
47+
pal <- RColorBrewer::brewer.pal(9, palette)
48+
pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
49+
hist_cols <- pal_ramp(bins)
50+
51+
function(){plot(histogram, freq = F, main = "", xlab = name, ylab = "Frequency (%)", col = hist_cols)}
52+
4453
}

‎R/plot_scatter_f.R‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -5,23 +5,25 @@
55
#' @param raster SpatRaster. Raster to be sampled
66
#' @param sample numeric. Number of points to sample
77
#' @param axis character. Which axis coordinates of the raster to return
8+
#' @param name character. The name of the raster variable
89
#' @param logger Stores all notification messages to be displayed in the Log
910
#' Window. Insert the logger reactive list here for running in
1011
#' shiny, otherwise leave the default NULL
11-
#' @return a dataframe containing the axis values and the cell values
12+
#' @return a function that generates a scatterplot
1213
#' @author Simon Smart <simon.smart@@cantab.net>
1314
#' @examples
1415
#' if (check_suggests(example = TRUE)) {
1516
#' raster <- terra::rast(ncol = 8, nrow = 8)
1617
#' raster[] <- sapply(1:terra::ncell(raster), function(x){
1718
#' rnorm(1, ifelse(x %% 8 != 0, x %% 8, 8), 3)})
18-
#' scatterplot <- plot_scatter(raster, sample = 10, axis = "y")
19+
#' scatterplot <- plot_scatter(raster, sample = 10, axis = "Longitude", name = "Example")
20+
#' scatterplot()
1921
#' } else {
2022
#' message('reinstall with install.packages("shinyscholar", dependencies = TRUE)
2123
#' to run this example')
2224
#' }
2325
#' @export
24-
plot_scatter <- function(raster, sample, axis, logger = NULL) {
26+
plot_scatter <- function(raster, sample, axis, name, logger = NULL) {
2527

2628
check_suggests()
2729

@@ -35,13 +37,18 @@ plot_scatter <- function(raster, sample, axis, logger = NULL) {
3537
return()
3638
}
3739

38-
if (!(axis %in% c("x", "y"))){
39-
logger |> writeLog(type = "error", "axis must be either x or y")
40+
if (!(axis %in% c("Longitude", "Latitude"))){
41+
logger |> writeLog(type = "error", "axis must be either Longitude or Latitude")
4042
return()
4143
}
4244

43-
samp <- terra::spatSample(raster, sample, method = "random", xy = TRUE, as.df = TRUE)
44-
colnames(samp)[3] <- "value"
45-
samp[, c(axis, "value")]
45+
if (axis == "Longitude"){short_axis <- "x"} else {short_axis <- "y"}
46+
47+
sampled <- terra::spatSample(raster, sample, method = "random", xy = TRUE, as.df = TRUE)
48+
colnames(sampled)[3] <- "value"
49+
sampled <-sampled[, c(short_axis, "value")]
50+
51+
function(){plot(sampled[[1]], sampled[[2]], xlab = axis, ylab = name)}
52+
4653

4754
}

‎inst/shiny/modules/plot_auto.R‎

Lines changed: 4 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ plot_auto_module_server <- function(id, common, parent_session, map) {
2525
req(common$raster)
2626

2727
# FUNCTION CALL ####
28-
histogram <- plot_hist(common$raster, as.numeric(input$bins))
28+
raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
29+
histogram <- plot_hist(common$raster, as.numeric(input$bins), input$pal, raster_name, common$logger)
2930
# LOAD INTO COMMON ####
3031
common$histogram_auto <- histogram
3132
# METADATA ####
@@ -37,20 +38,12 @@ plot_auto_module_server <- function(id, common, parent_session, map) {
3738
shinyjs::show("download")
3839
})
3940

40-
plot_function <- function(){
41-
pal <- RColorBrewer::brewer.pal(9, common$meta$plot_auto$pal)
42-
pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
43-
bins <- common$meta$plot_auto$bins
44-
cols <- pal_ramp(bins)
45-
plot(common$histogram_auto, freq = FALSE, main = "", xlab = common$meta$plot_auto$name, ylab = "Frequency (%)", col = cols)
46-
}
47-
4841
output$hist <- renderPlot({
4942
watch("plot_auto")
5043
req(common$histogram_auto)
5144
# Included here so that the module is only 'used' if the results are rendered
5245
common$meta$plot_auto$used <- TRUE
53-
plot_function()
46+
common$histogram_auto()
5447
})
5548

5649
output$download <- downloadHandler(
@@ -59,7 +52,7 @@ plot_auto_module_server <- function(id, common, parent_session, map) {
5952
},
6053
content = function(file) {
6154
png(file, width = 1000, height = 500)
62-
plot_function()
55+
common$histogram_auto()
6356
dev.off()
6457
})
6558

‎inst/shiny/modules/plot_auto.Rmd‎

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,6 @@ Plots the data as a histogram
33
```
44

55
```{r, echo = {{plot_auto_knit}}, include = {{plot_auto_knit}}}
6-
histogram <- plot_hist(raster, {{plot_auto_bins}})
7-
pal <- RColorBrewer::brewer.pal(9, {{plot_auto_pal}})
8-
pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
9-
hist_cols <- pal_ramp({{plot_auto_bins}})
10-
11-
plot(histogram, freq = F, main = "", xlab = {{plot_auto_name}}, ylab = "Frequency (%)", col = hist_cols)
6+
histogram <- plot_hist(raster, {{plot_auto_bins}}, {{plot_auto_pal}}, {{plot_auto_name}})
7+
histogram()
128
```

‎inst/shiny/modules/plot_hist.R‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,13 +21,14 @@ plot_hist_module_server <- function(id, common, parent_session, map) {
2121
return()
2222
}
2323
# FUNCTION CALL ####
24-
histogram <- plot_hist(common$raster, as.numeric(input$bins))
24+
raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
25+
histogram <- plot_hist(common$raster, as.numeric(input$bins), input$pal, raster_name, common$logger)
2526
# LOAD INTO COMMON ####
2627
common$histogram <- histogram
2728
# METADATA ####
2829
common$meta$plot_hist$bins <- as.numeric(input$bins)
2930
common$meta$plot_hist$pal <- input$pal
30-
common$meta$plot_hist$name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
31+
common$meta$plot_hist$name <- raster_name
3132
# TRIGGER ####
3233
trigger("plot_hist")
3334
show_results(parent_session)
@@ -45,7 +46,7 @@ plot_hist_module_server <- function(id, common, parent_session, map) {
4546
output$hist <- renderPlot({
4647
watch("plot_hist")
4748
req(common$histogram)
48-
plot_function()
49+
common$histogram()
4950
})
5051

5152
output$download <- downloadHandler(
@@ -54,7 +55,7 @@ plot_hist_module_server <- function(id, common, parent_session, map) {
5455
},
5556
content = function(file) {
5657
png(file, width = 1000, height = 500)
57-
plot_function()
58+
common$histogram()
5859
dev.off()
5960
})
6061

‎inst/shiny/modules/plot_hist.Rmd‎

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -6,11 +6,6 @@ Plots the data as a histogram
66
{r, fig.width = 8, fig.height = 5}
77
```
88
```{r, echo = {{plot_hist_knit}}, include = {{plot_hist_knit}}}
9-
10-
histogram <- plot_hist(raster, {{plot_hist_bins}})
11-
pal <- RColorBrewer::brewer.pal(9, {{plot_hist_pal}})
12-
pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
13-
hist_cols <- pal_ramp({{plot_hist_bins}})
14-
15-
plot(histogram, freq = F, main = "", xlab = {{plot_hist_name}}, ylab = "Frequency (%)", col = hist_cols)
9+
histogram <- plot_hist(raster, {{plot_hist_bins}}, {{plot_hist_pal}}, {{plot_hist_name}})
10+
histogram()
1611
```

‎inst/shiny/modules/plot_scatter.R‎

Lines changed: 7 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@ plot_scatter_module_ui <- function(id) {
88
)
99
}
1010

11-
1211
plot_scatter_module_server <- function(id, common, parent_session, map) {
1312
moduleServer(id, function(input, output, session) {
1413

@@ -21,29 +20,24 @@ plot_scatter_module_server <- function(id, common, parent_session, map) {
2120
return()
2221
}
2322
# FUNCTION CALL ####
24-
if (input$axis == "Longitude"){axis <- "x"} else {axis <- "y"}
25-
scatterplot <- plot_scatter(common$raster, input$sample, axis)
23+
raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
24+
scatterplot <- plot_scatter(common$raster, input$sample, input$axis, raster_name)
2625
# LOAD INTO SPP ####
2726
common$scatterplot <- scatterplot
2827
# METADATA ####
29-
common$meta$plot_scatter$axis_short <- axis
30-
common$meta$plot_scatter$axis_long <- input$axis
28+
common$meta$plot_scatter$axis <- input$axis
3129
common$meta$plot_scatter$sample <- input$sample
32-
common$meta$plot_scatter$name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
30+
common$meta$plot_scatter$name <- raster_name
3331
# TRIGGER ####
3432
trigger("plot_scatter")
3533
show_results(parent_session)
3634
shinyjs::show("download")
3735
})
3836

39-
plot_function <- function(){
40-
plot(common$scatterplot[[1]], common$scatterplot[[2]], xlab = common$meta$plot_scatter$axis_long, ylab = common$meta$plot_scatter$name)
41-
}
42-
4337
output$result <- renderPlot({
4438
watch("plot_scatter")
4539
req(common$scatterplot)
46-
plot_function()
40+
common$scatterplot()
4741
})
4842

4943
output$download <- downloadHandler(
@@ -52,7 +46,7 @@ plot_scatter_module_server <- function(id, common, parent_session, map) {
5246
},
5347
content = function(file) {
5448
png(file, width = 1000, height = 500)
55-
plot_function()
49+
common$scatterplot()
5650
dev.off()
5751
})
5852

@@ -83,8 +77,7 @@ plot_scatter_module_rmd <- function(common) {
8377
# Variables used in the module's Rmd code
8478
list(
8579
plot_scatter_knit = !is.null(common$scatterplot),
86-
plot_scatter_axis_short = common$meta$plot_scatter$axis_short,
87-
plot_scatter_axis_long = common$meta$plot_scatter$axis_long,
80+
plot_scatter_axis = common$meta$plot_scatter$axis,
8881
plot_scatter_sample = common$meta$plot_scatter$sample,
8982
plot_scatter_name = common$meta$plot_scatter$name)
9083
}

‎inst/shiny/modules/plot_scatter.Rmd‎

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,6 @@ Plots the data on a scatter plot
33
```
44

55
```{r, echo = {{plot_scatter_knit}}, include = {{plot_scatter_knit}}}
6-
7-
scatterplot <- plot_scatter(raster, {{plot_scatter_sample}}, {{plot_scatter_axis_short}})
8-
9-
plot(scatterplot[[1]], scatterplot[[2]], xlab = {{plot_scatter_axis_long}}, ylab = {{plot_scatter_name}})
10-
6+
scatterplot <- plot_scatter(raster, {{plot_scatter_sample}}, {{plot_scatter_axis}}, {{plot_scatter_name}})
7+
scatterplot()
118
```

‎inst/shiny/modules/plot_semi.R‎

Lines changed: 4 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,8 @@ plot_semi_module_server <- function(id, common, parent_session, map) {
3535
observeEvent(triggers(), {
3636
req(common$raster)
3737
# FUNCTION CALL ####
38-
histogram <- plot_hist(common$raster, as.numeric(input$bins))
38+
raster_name <- c(common$meta$select_query$name, common$meta$select_async$name, common$meta$select_user$name)
39+
histogram <- plot_hist(common$raster, as.numeric(input$bins), input$pal, raster_name, common$logger)
3940
# LOAD INTO COMMON ####
4041
common$histogram_semi <- histogram
4142
# METADATA ####
@@ -49,18 +50,10 @@ plot_semi_module_server <- function(id, common, parent_session, map) {
4950
shinyjs::show("download")
5051
})
5152

52-
plot_function <- function(){
53-
pal <- RColorBrewer::brewer.pal(9, common$meta$plot_semi$pal)
54-
pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
55-
bins <- common$meta$plot_semi$bins
56-
cols <- pal_ramp(bins)
57-
plot(common$histogram_semi, freq = FALSE, main = "", xlab = common$meta$plot_semi$name, ylab = "Frequency (%)", col = cols)
58-
}
59-
6053
output$hist <- renderPlot({
6154
watch("plot_semi_update")
6255
req(common$histogram_semi)
63-
plot_function()
56+
common$histogram_semi()
6457
})
6558

6659
output$download <- downloadHandler(
@@ -69,7 +62,7 @@ plot_semi_module_server <- function(id, common, parent_session, map) {
6962
},
7063
content = function(file) {
7164
png(file, width = 1000, height = 500)
72-
plot_function()
65+
common$histogram_semi()
7366
dev.off()
7467
})
7568

‎inst/shiny/modules/plot_semi.Rmd‎

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,6 @@ Plots the data as a histogram
33
```
44

55
```{r, echo = {{plot_semi_knit}}, include = {{plot_semi_knit}}}
6-
histogram <- plot_hist(raster, {{plot_semi_bins}})
7-
pal <- RColorBrewer::brewer.pal(9, {{plot_semi_pal}})
8-
pal_ramp <- colorRampPalette(c(pal[1], pal[9]))
9-
hist_cols <- pal_ramp({{plot_semi_bins}})
10-
11-
plot(histogram, freq = F, main = "", xlab = {{plot_semi_name}}, ylab = "Frequency (%)", col = hist_cols)
6+
histogram <- plot_hist(raster, {{plot_semi_bins}}, {{plot_semi_pal}}, {{plot_semi_name}})
7+
histogram()
128
```

0 commit comments

Comments
 (0)