In addition to the errors I am encountering with legends when using deckgl in an Shiny application (Posted here: How do I remove deckgl legend on shiny dashboard?), I was wondering whether it would be possible to mirror user map interactions between two deckglOutput plots. This will ease user interactions when trying to make comparisons between the two plots. To clarify, if a user interacts with one plot, I would like the other plot to mirror the interaction and therefore show the same view.
So far I have managed to create a button that enables comparisons by plotting two instances of deck.gl but I at a miss as to if/how this would be possible.
Example below:
#packages
library(deckgl)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "a nice map"),
dashboardSidebar(
dateInput(inputId = "date", label ="Select Date:", value = "2019-01-01",
min = "2019-01-01", max = "2019-01-31"),
actionButton(inputId = "reset", label = "Reset Map"),
switchInput(inputId = "compare", label = "Compare", onLabel = "ON", offLabel = "OFF" )),
dashboardBody(
uiOutput("map_out"))
)
server <- function(input, output) {
output$map_out <- renderUI({
if(input$compare == TRUE){
tagList(
deckglOutput('map', height = "45vh"),
deckglOutput('map_compare', height = "45vh"))
} else if(input$compare == FALSE){
deckglOutput('map', height = "90vh")
}
})
output$map <- renderDeckgl({
deckgl(zoom = 10) %>%
add_basemap()})
output$map_compare <- renderDeckgl({
deckgl(zoom = 10) %>%
add_basemap()})
observeEvent(input$date, {
#add a map layer that plots some data
map_data <- input$date
deckgl_proxy("map") %>%
add_geojson_layer(data = map_data,
) %>%
add_legend(
colors = "colour_pal",
labels = "colour_labs",
pos = "bottom-left",
title = "something",
) %>%
update_deckgl()
if(input$compare == TRUE){
deckgl_proxy("map_compare") %>%
add_geojson_layer(data = map_data,
) %>%
update_deckgl()
}
})
observeEvent(input$reset,
output$map <- renderDeckgl({
deckgl(zoom = 10) %>%
add_basemap()})
)
}
shinyApp(ui, server)
Related
I have a Shiny app below, in which I am drawing a scatter plot on iris dataset using libraries highchart, ggplot and plotly.
library(shiny)
library(shinydashboard)
library(highcharter)
library(shinyWidgets)
library(plotly)
library(ggplot2)
library(data.table)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
selectizeInput(inputId = "inp_species", label = "Select by:", choices = c("setosa", "versicolor", "virginica"), selected = "setosa"),
awesomeRadio(inputId = "radioTest", label = "Choose one:",
choices=c("High Charter" = "highcharter",
"Simple Plot" = "simple",
"Plotly" = "plotly"),
inline = FALSE, selected = "highcharter")
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab1",
tabPanel("Tab1", "Tab content 1", uiOutput("tabset1Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output, session) {
iris_dt <- reactive({
iris_table = data.table(copy(iris))
iris_table[Species == input$inp_species]
})
render_content <- reactive({
req(input$radioTest)
print(input$radioTest)
if(input$radioTest=='highcharter'){
output$plot1 <- renderHighchart({
highchart() %>%
hc_add_series(iris_dt(), type = "scatter", hcaes(x = Petal.Width, y = Sepal.Length))
})
out <- highchartOutput("plot1")
}
else if(input$radioTest=='plotly'){
output$plot2 <- renderPlotly({
plot_ly(iris_dt(), x = ~ Petal.Width, y = ~ Sepal.Length)
})
out <- plotlyOutput("plot2")
}
else if(input$radioTest=='simple'){
output$plot3 <- renderPlot({
ggplot(iris_dt(), aes(x = Petal.Width, y = Sepal.Length)) + geom_point()
})
out <- plotOutput("plot3")
}
return(out)
})
# The currently selected tab from the first box
output$tabset1Selected <- renderUI({
render_content()
})
}
)
I am selecting the library to draw the chart dynamically using a selectInput box.
Here is the problem -
I select a species in selectInput box and the highchart library draws a scatter plot
Then I select plotly in the radio button section and the rendering is done using plotly.
I change the species in selectInput and plotly re-renders the plot
Now, when I click on highchart radio button, the plot of the earlier species (from cache) is drawn for a few seconds and then the chart of the selected species is drawn.
Question
Is there a way to clear or disable the cache so that the rendering delay does not happen?
We can disable the animation effect. Although it's not a solution for the problem, it could help in the meantime.
output$plot1 <- renderHighchart({
highchart() %>%
hc_add_series(
data = iris_dt(),
type = "scatter",
hcaes(x = Petal.Width, y = Sepal.Length)
) %>%
hc_plotOptions(
series = list(
animation = FALSE
)
)
})
I have a dashboard where slider is getting updated based on a dropdown widget. My issue is that dropdown selects the name of the column, and slider filters the selected column. The issue is when i create reactive filtered dataset: specifically this line: filter(input$selectx > input$my_slider[1]. i understand that it does not work cause the input$selectx is a character name of the column (eg "mean_radius", and I need a name without quotations (eg mean_radius). I tried quote(), {{}} and other functions but could not sort it out
#loading packages
library(shiny)
library(tidyverse)
library(datateachr) #cancer_sample dataset was used from this data package
library(rstatix)
library(shinythemes)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Cancer", titleWidth = 300),
dashboardSidebar(
width = 300,
selectInput("selectx", label = h3("Select X Variable"),
choices = list("radius_mean", "texture_mean", "perimeter_mean", "area_mean"),
selected = "area_mean"),
tags$br(),
sliderInput("my_slider",
label = h3("Range of X Variable"),
min = min(cancer_sample$area_mean, na.rm = TRUE),
max = max(cancer_sample$area_mean, na.rm = TRUE),
value = c(143.5,2501))
),
dashboardBody(
#makes the place holder for the plot
box(title = "Scatter Plot", solidHeader = TRUE, collapsible = TRUE, width = 12, plotOutput("my_plot", click = "plot_click")),
box(title = "Data Table", solidHeader = TRUE, collapsible = TRUE, width = 12, tableOutput("my_data"))
)
)
server <- function(input, output, session) {
#makes a reactive function to minimize repeated code
filtered <- reactive({
#the dataset that is being used
cancer_sample %>%
#filters the data set based on the area mean range from the slider, and the check boxes that are selected
filter(input$selectx > input$my_slider[1],
input$selectx < input$my_slider[2])
})
observe({
col <- cancer_sample %>% select(input$selectx)
#makes a slider that you can manipulate to show only data points that has an area mean that falls in the certain range
updateSliderInput(session, "my_slider",
value = col,
min = min(col, na.rm = TRUE),
max = max(col, na.rm = TRUE))
})
output$my_plot <- renderPlot({
filtered() %>%
#produces a graph with area_mean on the x-axis and perimeter_mean on the y-axis.
ggplot(aes_string(x = input$selectx, y = perimeter_mean)) +
geom_point(aes(colour = diagnosis))
})
output$my_data <- renderTable(
filtered() %>%
select(ID:area_mean)
)
}
# Run the application
shinyApp(ui = ui, server = server)
Your problem is not shiny connected, so the question could be easily simplified.
Unfortunately you do not provide the dataset here. So I could not provide a working example.
quote will always return what is inside quote(input$selectx) -> input$selectx so this for sure not a solution.
Please use the e.g. .data solution here.
airquality %>% filter(.data[[input$selectx]] > input$my_slider[1],
.data[[input$selectx]] < input$my_slider[2])
I am trying to use shiny controls to modify the data underlying a plotly chloropleth map.
Whenever I change the data the entire plot re-renders, which is quite slow. I'm guessing the bottleneck is redrawing the geojson polygons. Because the geojson never changes, I'm wondering if there is a way to keep the rendered widget intact but modify the z values only.
It looks like using plotlyProxy and plotlyProxyInvoke might be the right direction, but I can only see examples of an entire trace (which includes the geojson data) being replaced.
Sorry if I'm missing something or have been unclear - I have not used plotly very much, and even less so the js side of things.
See below for example code:
library(shiny)
library(dplyr)
library(plotly)
library(readr)
library(rjson)
zip_geojson <- fromJSON(file="https://raw.githubusercontent.com/hms1/testData/main/zip3_2.json")
plot_data <- read_csv(file="https://raw.githubusercontent.com/hms1/testData/main/plot_data.csv")
mapboxToken <- "pk.eyJ1IjoiaG1vcmdhbnN0ZXdhcnQiLCJhIjoiY2tmaTg5NDljMDBwbDMwcDd2OHV6cnd5dCJ9.8eLR4FtlO079Gq0NeSNoeg" #burner token
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("multip",
"n:",
min = 1,
max = 10,
value = 1)
),
mainPanel(
plotlyOutput("cPlot")
)
)
)
server <- function(input, output) {
output$cPlot <- renderPlotly({
plot_data_i <- plot_data%>%
mutate(log_count = case_when(log_count <= input$multip ~ log_count * input$multip,
TRUE ~ log_count))
plot_ly() %>%
add_trace(
type = "choroplethmapbox",
geojson = zip_geojson,
locations = plot_data_i$zip,
z = plot_data_i$log_count
) %>%
layout(
mapbox = list(
style = "light",
zoom = 3,
center = list(lon = -95.7129, lat = 37.0902)
)
) %>%
config(mapboxAccessToken = mapboxToken)
})
}
shinyApp(ui = ui, server = server)
For anyone else who comes across this post later, I found a solution.
It turns out that you can change data using the restyle method in plotlyProxyInvoke, as shown below.
library(shiny)
library(dplyr)
library(plotly)
library(readr)
library(rjson)
zip_geojson <- fromJSON(file="https://raw.githubusercontent.com/hms1/testData/main/zip3_2.json")
plot_data <- read_csv(file="https://raw.githubusercontent.com/hms1/testData/main/plot_data.csv")
mapboxToken <- "pk.eyJ1IjoiaG1vcmdhbnN0ZXdhcnQiLCJhIjoiY2tmaTg5NDljMDBwbDMwcDd2OHV6cnd5dCJ9.8eLR4FtlO079Gq0NeSNoeg"
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("multip",
"n:",
min = 1,
max = 10,
value = 1),
actionButton("Remove", "Remove Trace")
),
mainPanel(
plotlyOutput("cPlot")
)
)
)
server <- function(input, output, session) {
output$cPlot <- renderPlotly({
plot_ly(type = "choroplethmapbox", geojson = zip_geojson) %>%
layout(
mapbox = list(
style = "light",
zoom = 3,
center = list(lon = -95.7129, lat = 37.0902)
)
) %>%
config(mapboxAccessToken = mapboxToken)
})
plotproxy <- plotlyProxy("cPlot", session, deferUntilFlush = FALSE)
observeEvent(input$multip, {
plot_data_i <- plot_data %>%
mutate(log_count = case_when(log_count <= input$multip ~ log_count * input$multip,
TRUE ~ log_count))
plotproxy %>%
plotlyProxyInvoke("restyle", list(z = list(plot_data_i$log_count),
locations = list(plot_data_i$zip)))
})
}
shinyApp(ui = ui, server = server)
I would like to render a map based on selectInput(). I have two selectInput()s: first one product_type and second one product_name. In the second one selectInput() the drop down options should be display only relevant to first selectInput(). Based on these drill down inputs map should change dynamically.
Here is the code:
ui <- shinyUI(dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidPage(
box("",
leafletOutput("abc", width = '100%', height = 300),
height = 350, width = 12),
box("",
selectInput('vtype', label = 'Prod Type',choices = brand$prod_type),
selectInput('vname', label = 'Prod Name',choices = brand$prod_name),
width = 4),
valueBoxOutput("gr", width = 8)
)
)
))
server <- shinyServer(function(input,output,session){
a <- ship %>% select(prod_name,prod_type,LON,LAT) %>% filter(prod_type == input$vtype)
output$gr <- renderValueBox({
box(table(a))
})
output$abc <- renderLeaflet({
leaflet() %>% addProviderTiles(providers$OpenTopoMap )
%>% setView(lat = a$LAT ,lng = A$LON, zoom = 4)
})
})
shinyApp(ui,server)
The dynamically changed points in the map should be marked up. I tried but could not able to build the code.
Any help on this code would be graceful for me.
I hope my example helps. I invented a data.frame 'ship' and made everything dependent on it. That means it is used for your variable 'brand' as well as 'ship'.
I'm not sure how you envisioned the value box, so I put category and products in it.
library(shiny)
library(shinydashboard)
library(dplyr)
library(leaflet)
ship <- data.frame(
product_type = c("food","food","tool","tool","tool","accessories","accessories","lighting","lighting","lighting"),
product_name=c("eggs", "bread","clamp","hammer","screw driver", "watch" ,"sun glases","LED","bulb","briquette"),
LON=c(-61.783,2.632,47.395,20.068,44.563,17.544,-170.730,-65.167,136.189,50.562),
LAT=c(17.078 ,28.163 ,40.430 ,41.143 ,40.534 ,-12.296 ,-14.318 ,-35.377 ,-24.973 ,26.019),
stringsAsFactors = F)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(collapsed = TRUE, disable = FALSE),
dashboardBody(
# fluidPage(
box(
leafletOutput("abc", width = '100%', height = 300),
height = 350,
width = 12),
box(
selectInput('vtype', label = 'Prod Type', choices = c("< select product type>"="", ship$product_type)),
selectInput('vname', label = 'Prod Name', choices = c("< select item>"="", ship$product_name)),
width = 4),
valueBoxOutput("gr", width = 8)
#)
)
)
server <- shinyServer(function(input,output,session){
a <- reactive({
ship %>%
select(product_name, product_type, LON, LAT) %>%
filter(product_type %in% input$vtype)
})
output$gr <- renderValueBox({
valueBox( input$vtype, paste(a()$product_name, collapse=' - ') )
})
observe({
updateSelectInput(session,
inputId='vname',
choices = c("< select item>"="", a()$product_name ))
})
output$abc <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenTopoMap ) %>%
setView(lng=0, lat=0, zoom = 1)
})
observe({
selection <- a() %>% filter(product_name %in% input$vname)
leafletProxy("abc") %>%
flyTo(lat = selection$LAT,
lng = selection$LON,
zoom = 4)
})
})
shinyApp(ui,server)
Please provide example data next time.
Issues between inputs and plot output
Hi,
I'm testing out a basic ShinyApp where I can generate a plot of commercial services broken down by geography and service type.
The idea is I want the user to use three drop-down menu inputs, each dependent upon the previous selection, to subset the data, which then gets output in a ggplot.
However, I'm having issues connecting the inputs to the plot output (see below). The inputs are working fine and reactive when selected, but I can't work out how to link that to the plot, I get the feeling I'm not using the right data source (but have no idea how to ensure it is). Furthermore, I'm not familiar with how I would go about adding a third filter (for "service") seeing as I don't know how to link my data source in the first place.
Sorry this is probably simple, but some help would be really appreciated.
UI
#Data
Test <- dataframe(
Geography1 = c("Region","Local Authority","County"...),
Geography2 = c("North West","Aldershot","Cheshire"...),
Service = c("Shop","Cafe","Library"...),
Overall_rating = c("Awesome","Good","Fantatstic"...),
Locations = c(4000, 1300, 1700...)
)
#SHINY APP
ui <- fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("geography1"),
uiOutput("geography2"),
uiOutput("service")),
mainPanel(
plotOutput("plot", height = "400px"))
)
)
Server
server <- function(input, output) {
output$geography1 = renderUI({
selectInput(inputId = "geog1",
label = "Geography 1:",
choices = as.character(unique(Test$Geography1)),
selected = "Region")
})
output$geography2 = renderUI({
datasub <- Test[Test$Geography1 == input$geog1, "Name"]
selectInput(inputId = "geog2",
label = "Geography2:",
choices = unique(datasub),
selected = unique(datasub)[1])
})
output$service = renderUI({
datasub2 <- unique(datasub)
selectInput(inputId = "service",
label = "Service type:",
choices = unique(...),
selected = unique(...)[1])
})
output$plot = renderPlot({
ggplot(datasub2(),aes(x = Overall_rating, y = Locations, fill= Overall_rating))+
geom_bar(stat = "identity")
})
}
shinyApp(ui, server)
It's hard to tell how the provided data is supposed to be filtered in the app but this code will at least run and be interactive. Hopefully from there you can figure out how to adjust the dataset.
As BigDataScientist said one fault is that you're not using a reactive dataset.
#Data
Test <- data.frame(
Geography1 = c("Region","Local Authority","County"),
Geography2 = c("North West","Aldershot","Cheshire"),
Service = c("Shop","Cafe","Library"),
Overall_rating = c("Awesome","Good","Fantatstic"),
Locations = c(4000, 1300, 1700)
)
#SHINY APP
ui <- fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("geography1"),
uiOutput("geography2"),
uiOutput("service")),
mainPanel(
plotOutput("plot", height = "400px"))
)
)
server <- function(input, output) {
output$geography1 = renderUI({
selectInput(inputId = "geog1",
label = "Geography 1:",
choices = as.character(unique(Test$Geography1)),
selected = "Region")
})
datasub <- reactive({
Test[Test$Geography1 == input$geog1,]
})
output$geography2 = renderUI({
selectInput(inputId = "geog2",
label = "Geography2:",
choices = unique(datasub()[,"Geography2"]),
selected = unique(datasub()[,"Geography2"])[1])
})
datasub2 <- reactive({
datasub()[Test$Geography2 == input$geog2, ]
})
output$service = renderUI({
selectInput(inputId = "service",
label = "Service type:",
choices = unique(datasub2()[,"Service"]),
selected = unique(datasub2()[,"Service"])[1])
})
datasub3 <- reactive({
datasub()[Test$Service == input$service, ]
})
output$plot = renderPlot({
ggplot(datasub3(),aes(x = Overall_rating, y = Locations, fill= Overall_rating))+
geom_bar(stat = "identity")
})
}
shinyApp(ui, server)