I am building an RShiny dashboard that allows the user to select two variables which then is plotted onto a bivariate map. This is the code so far:
library(ggplot2)
library(ggspatial)
library(cowplot)
library(tidyverse)
library(sf)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(biscale)
library(tools)
data <- structure(list(
mean_pci = c(45676.758, 24152.725, 48797.093, 43445.612, 25898.389, 28334.789, 40320.323, 24833.757, 22664.184, 34335.008),
mean_pop = c(2545.349, 9781.295, 6784.606, 2512.415, 4666.243, 3532.699, 4313.023, 8745.735, 6445.338, 5860.371),
count_airbnb = c(36, 67, 73, 81, 56, 54, 4, 96, 87, 53),
log_mean_price = c(2.285454, 1.820976, 2.112407, 2.157243, 2.341376, 2.235902, 2.503111, 2.368511, 1.818979, 1.795798)
), class = "data.frame", row.names = c(NA, -10L))
ui <- fluidPage(
titlePanel("Bivariate maping"),
sidebarLayout(
sidebarPanel(
selectInput("x_variable", h4("Select x variable:"),
choices = c("Mean per capita income" = "mean_pci",
"Mean population" = "mean_pop",
"Number of airbnbs" = "count_airbnb",
"Mean price of airbnbs" = "log_mean_price"),
selected = "mean_pci"),
selectInput("y_variable", h4("Select y variable:"),
choices = c("Mean per capita income" = "mean_pci",
"Mean population" = "mean_pop",
"Number of airbnbs" = "count_airbnb",
"Mean price of airbnbs" = "log_mean_price"),
selected = "mean_pci"),
),
mainPanel(
plotOutput("plot", width = "100%", height = "800px")
)
)
)
# Define server logic
server <- function(input, output, session){
plot_reactive <- reactive({
biClasses <- bi_class(data, x = input$x_variable, y = input$y_variable, style = "quantile", dim = 3)
bi_Map <- ggplot()+
geom_sf(data = biClasses, mapping = aes(fill = bi_class), color = "black", size = 0.1, show.legend = FALSE) +
bi_scale_fill(pal = "DkViolet", dim = 3) +
coord_sf(crs = st_crs(7131), datum = NA) +
theme(plot.margin = unit(c(0.5,0.5,0.5,0.5), "cm"),
plot.title = element_text(size = 18, face = "bold", hjust = 0.5)) +
annotation_scale(location = "bl", line_width = 0.2, height = unit(0.05, "in")) +
annotation_north_arrow(location = "tl", which_north = "true",
height = unit(1.25, "cm"), width = unit(1.25, "cm"),
style = north_arrow_fancy_orienteering) +
theme_minimal()
bi_Legend <- bi_legend(pal = "DkViolet", dim = 3, xlab = input$x_variable, ylab = input$y_variable, size = 7)
plot <- ggdraw() +
draw_plot(bi_Map, 0, 0, 1, 1) +
draw_plot(bi_Legend, 0.55, 0.358, 0.28, 0.28)
})
output$plot <- renderPlot({
plot_reactive()
})
}
# Run app
shinyApp(ui = ui, server = server)
I am having the error: the condition has length > 1, which is happening in this line of code:
biClasses <- bi_class(data, x = input$x_variable, y = input$y_variable, style = "quantile", dim = 3)
Note: ui function works and displays correctly.
It is not happy with the input$x_variable, input$y_variable.
When just plotting the map outside a Shiny app and pass mean_pci and mean_pop in the x and y options, the map displays correctly: Note this code is not reproducible without full dataset with geometry
library(ggplot2)
library(ggspatial)
library(cowplot)
library(tidyverse)
library(sf)
library(dplyr)
library(biscale)
biClasses <- bi_class(data, x = mean_pop, y = mean_pci, style = "quantile", dim = 3)
bi_Map <- ggplot()+
geom_sf(data = biClasses, mapping = aes(fill = bi_class), color = "black", size = 0.1, show.legend = FALSE) +
bi_scale_fill(pal = "DkViolet", dim = 3) +
coord_sf(crs = st_crs(7131), datum = NA) +
theme(plot.margin = unit(c(0.5,0.5,0.5,0.5), "cm"),
plot.title = element_text(size = 18, face = "bold", hjust = 0.5)) +
annotation_scale(location = "bl", line_width = 0.2, height = unit(0.05, "in")) +
annotation_north_arrow(location = "tl", which_north = "true",
height = unit(1.25, "cm"), width = unit(1.25, "cm"),
style = north_arrow_fancy_orienteering) +
theme_minimal()
bi_Legend <- bi_legend(pal = "DkViolet", dim = 3, xlab = "Higher pop", ylab = "Higher pci", size = 7)
plot <- ggdraw() +
draw_plot(bi_Map, 0, 0, 1, 1) +
draw_plot(bi_Legend, 0.55, 0.358, 0.28, 0.28)
plot
Traceback details for the error:
> traceback()
13: execCallbacks(timeoutSecs, all, loop$id)
12: run_now(timeoutMs/1000, all = FALSE)
11: service(timeout)
10: serviceApp()
9: ..stacktracefloor..(serviceApp())
8: withCallingHandlers(expr, error = doCaptureStack)
7: domain$wrapSync(expr)
6: promises::with_promise_domain(createStackTracePromiseDomain(),
expr)
5: captureStackTraces({
while (!.globals$stopped) {
..stacktracefloor..(serviceApp())
}
})
4: ..stacktraceoff..(captureStackTraces({
while (!.globals$stopped) {
..stacktracefloor..(serviceApp())
}
}))
3: runApp(x)
2: print.shiny.appobj(x)
1: (function (x, ...)
UseMethod("print"))(x)
The function bi_class() is expecting column names or vectors as its arguments, but you are proving it with strings with the names of columns. This is because, despite your inputs containing the names of the columns, the object input$x_variable is just a string with the name, not the actual column of the dataframe.
Therefore, you need to point your function to the actual columns.
To solve this, we need to use input$x_variable and input$y_variable to actually point to columns in our dataframe.
Use the mutate function to create two new columns based on your text inputs: "var_x" and "var_y". These two columns will be always expected by the bi_class function, so we only need to create them before we pass data to bi_class. But, in order to pass strings as column names, we need to convert strings into symbols, i.e., tell mutate that out text inputs are actually column names with !!sym():
#use your inputs to create new columns
data2 <- data |>
#the original columns will be renamed
mutate(x_variable = !!sym(input$x_variable),
y_variable = !!sym(input$y_variable))
#then use the newly created variables in your function
biClasses <- bi_class(data2, x = x_variable, y = y_variable, style = "quantile", dim = 3)
Notice that we need to use the injection operator (!!) and the sym function in order to tell mutate that the strings are actually columns in the dataframe.