I have a renderDataTable object in my R Shiny App in the server application, that shows all titles of those games that are being brushed in a Scatterplot from the user and shows them in a datatable with some more statistics.
output$dtable <- renderDataTable({
brushedPoints(daten(), input$brush_plot) %>% na.omit()
%>% select(GAME.NAME,input$x, input$y)
})
}
Now, I want to show all games by default, if the user does not brush the plot.
I think I have to use an if-else branch at the beginning of the renderDataTable function, but I dont know which arguments to pass..
I already tried if (!input$brush_plot) and if(!brushedPoints()) .. and then (daten()%>% select..) but that didn't work..
How can I do that?
I think you want to check:
if (length(input$brush_plot) > 0) {
daten()
} else {
brushedPoints(daten(), input$brush_plot) %>%
na.omit() %>%
select(GAME.NAME,input$x, input$y)
}
Related
I am having trouble transitioning my map from static to reactive so a user can select what data they want to look at. Somehow I'm not successfully connecting the input to the dataframe. My data is from a shapefile and looks roughly like this:
NAME Average Rate geometry
1 Alcona 119.7504 0.1421498 MULTIPOLYGON (((-83.88711 4...
2 Alger 120.9212 0.1204398 MULTIPOLYGON (((-87.11602 4...
3 Allegan 128.4523 0.1167062 MULTIPOLYGON (((-85.54342 4...
4 Alpena 114.1528 0.1410852 MULTIPOLYGON (((-83.3434 44...
5 Antrim 124.8554 0.1350004 MULTIPOLYGON (((-84.84877 4...
6 Arenac 127.8809 0.1413534 MULTIPOLYGON (((-83.7555 43...
In the server section below, you can see that I tried to use reactive to get the selected variable and when I write print(select) it does print the correct variable name, but when I try to put it into the colorNumeric() function it's clearly not being recognized. The map I get is all just the same shade of blue instead of different shades based on the value of the variable in that county.
ui <- fluidPage(
fluidRow(
selectInput(inputId="var",
label="Select variable",
choices=list("Average"="Average",
"Rate"="Rate"),
selected=1)
),
fluidRow(
leafletOutput("map")
)
)
server <- function(input, output, session) {
# Data sources
counties <- st_read("EITC_counties.shp") %>%
st_transform(crs="+init=epsg:4326")
counties_clean <- select(counties, NAME, X2020_Avg., X2020_Takeu)
counties_clean <- counties_clean %>%
rename("Average"="X2020_Avg.",
"Rate"="X2020_Takeu")
# Map
variable <- reactive({
input$var
})
output$map <- renderLeaflet({
select <- variable()
print(select)
pal <- colorNumeric(palette = "Blues", domain = counties_clean$select, na.color = "black")
color_pal <- counties_clean$select
leaflet()%>%
setView( -84.51, 44.18, zoom=5) %>%
addPolygons(data=counties_clean, layerId=~NAME,
weight = 1, smoothFactor=.5,
fillOpacity=.7,
fillColor=~pal(color_pal()),
highlightOptions = highlightOptions(color = "white",
weight = 2,
bringToFront = TRUE)) %>%
addProviderTiles(providers$CartoDB.Positron)
})
}
shinyApp(ui, server)
I've tried making the reaction into an event and also using the observe function using a leaflet proxy but it only produced errors. I also tried to skip the reactive definition and just put input$var directly into the palette (counties_clean$input$var), but it similarly did not show any color variation.
When I previously created a static map setting the palette using counties_clean$Average it came out correctly, but replacing Average with a user input is where I appear to be going wrong. Thanks in advance for any guidance you can provide and please let me know if I can share any additional clarification.
Unfortunately, your code is not reproducible without the data, but the mistake is most likely in this line
color_pal <- counties_clean$select
What this line does, is to extract a column named select from your data. This column is not existing, so it will return NULL.
What you want though, is to extract a column whose name is given by the content of select, so you want to try:
color_pal <- counties_clean[[select]]
I have a r leaflet map that has multiple layers and each layer can be checked or unchecked. I am trying to find a way to have a select all/deselect all option.
Below is my code where the overlays are reactive groups.
df() is a reactive dataframe
myLocation() is a reactive location (long,lat)
So in the map in the upper right hand corner is where I want a select all/ deselect all option
groups <- reactive({as.character(unique(df()$Folder))})
groupColors <- reactive({
colorFactor(palette = rainbow(length(groups())),
domain = df()$Folder)
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
leaflet::addMarkers(lng=c(myLocation()[1]), lat=c(myLocation()[2]),
popup = paste("Lat/Long: ",myLocation()[2],"/",myLocation()[1]),
popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE))
%>%
############more code here
#this section is where a select all/ deselect option has to be placed
addLayersControl(overlayGroups=groups(),options =
layersControlOptions(collapsed = TRUE))
})
Following shiny tutorial... try using leafletProxy to modify your existing map and use the hideGroup() function from leaflet to add/remove the entire group.
I have made four Plots in four boxes on a Shiny Dashboard Page. I wish to represent all the four plots dynamically in one box based on an input from Slider ranging from 1 to 4. All the plots are different and are not related. I wish to know the basic Syntax to do that. Thank you
As #Pork Chop commented you should check out the website which is going to help you in asking the question on stackoverflow.
As you are new in this community i am going give you a hint how to update shiny plots with input from slider.
Here is the code:
library(shiny)
library(shinydashboard)
library(ggplot2)
data <- data.frame(x=c(1,2,3,4),y=c(10,11,12,13))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(sliderInput("slider","Slider", min=1, max=4, step =1, value=1)),
dashboardBody(
fluidRow(column(6,plotOutput('plot1'),plotOutput('plot2')),
column(6,plotOutput('plot3'),plotOutput('plot4'))
)))
server <- function(input, output, session) {
output$plot1 <- renderPlot({
ggplot(data,aes_string(x=input$slider, y="y"))+geom_point(size=5)
})
output$plot2 <- renderPlot({
ggplot(data,aes_string(y=input$slider, x="y"))+geom_point(size=5)
})
output$plot3 <- renderPlot({
ggplot(data,aes_string(y=input$slider, x="y"))+geom_line(size=5)
})
output$plot4 <- renderPlot({
ggplot(data,aes_string(x=input$slider, y="y"))+geom_line(size=5)
})
}
shinyApp(ui, server)
Next time do not forget to create some sample code and sample data!
I'm working on leaflet with shiny. The tools is basic, i have a map with some markers (coming from a table with LONG and LAT).
What I want to do is to open a table or a graph when i click on the marker.
Is there a simple way to do it?
Do you have a really simple example: you have a maker on a map, you click on the marker, and there is a plot or a table or jpeg that s opening?
Here is another example, taken from here and a little bit adapted. When you click on a marker, the table below will change accordingly.
Apart from that, a good resource is this manual here:
https://rstudio.github.io/leaflet/shiny.html
library(leaflet)
library(shiny)
myData <- data.frame(
lat = c(54.406486, 53.406486),
lng = c(-2.925284, -1.925284),
id = c(1,2)
)
ui <- fluidPage(
leafletOutput("map"),
p(),
tableOutput("myTable")
)
server <- shinyServer(function(input, output) {
data <- reactiveValues(clickedMarker=NULL)
# produce the basic leaflet map with single marker
output$map <- renderLeaflet(
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lat = myData$lat, lng = myData$lng, layerId = myData$id)
)
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(myData,id == data$clickedMarker$id)
)
})
})
})
shinyApp(ui, server)
There is a leaflet example file here:
https://github.com/rstudio/shiny-examples/blob/ca20e6b3a6be9d5e75cfb2fcba12dd02384d49e3/063-superzip-example/server.R
# When map is clicked, show a popup with city info
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_shape_click
if (is.null(event))
return()
isolate({
showZipcodePopup(event$id, event$lat, event$lng)
})
})
Online demo (see what happens when you click on a bubble):
http://shiny.rstudio.com/gallery/superzip-example.html
On the client side, whenever a click on a marker takes place, JavaScript takes this event and communicates with the Shiny server-side which can handle it as input$map_shape_click.
I am developing an R Markdown Shiny document to:
Subset a data frame to include the "date" column and some numeric data columns. The way the shiny user input is set up, you select radio buttons for the data columns to include, then hit the "Subset Data" button to create d() - NO PROBLEM:)
Generate a list of plots (plotList), one for each numeric data column (plotted against the date column). I am using the openair package timePlot function to generate the plots, and lapply to generate the list of plot objects (plotList) - NO PROBLEM:)
use renderPlot to output all the plots in plotList to the R Markdown document - PROBLEM:(
I know there have been similar questions (e.g https://gist.github.com/wch/5436415/, Reactivity in R shiny with toy example, and dynamically add plots to web page using shiny), and please believe me I have tried and tried (e.g. using a for loop in stead of lapply-not my preference, but if it worked then who cares; adding local() and/or observe(); etc). No matter what I do I can't get it to to work. I am new to R Markdown and to Shiny, I just can't figure this out - please help!
Here is a reproducible example (to be run as an R markdown shiny document).
First the chunk that creates a reactive dataset d():
```{r reactive-dataset, echo=FALSE,message=FALSE}
library(openair)
library(dplyr)
data<-mydata[1:50,]
print(tbl_df(data))
inputPanel(
checkboxGroupInput(inputId="p",
label="select pollutants to plot",
choices=names(data)[-1]
),
actionButton(inputId="import",
label="Subset Data")
)
d<-eventReactive(input$import,{
d<-data %>% select(date,one_of(input$p))
})
renderPrint({tbl_df(d())})
```
Now the second chunk, to create plotList and output it (PART THAT DOESN'T WORK):
Attempt 1: only last plot is displayed
```{r plot,echo=FALSE,message=FALSE}
renderPlot({
i<-names(d())[-1]
tp<-function(x){
p<-timePlot(d(),
pollutant=print(x),
main="Minute Validation",
ylab="Minute Conc. (ug/m3 or ppb)",
key=T)
p$plot
}
lapply(i,tp)
})
```
Attempt 2 (based on Reactivity in R shiny with toy example). No plots are displayed
```{r plot,echo=FALSE,message=FALSE}
plotList<-reactive({
i<-names(d())[-1]
tp<-function(x){
p<-timePlot(d(),
pollutant=print(x),
main="Minute Validation",
ylab="Minute Conc. (ug/m3 or ppb)",
key=T)
p$plot
}
lapply(i,tp)
})
observe({
for (j in 1:length(plotList())){
local({
my_j<-j
renderPlot({plotList()[[my_j]]})
})#end local
} #end for loop
}) #end observe
```
I have fiddled with this endlessly, referring the to similar questions that I have linked to above.
[New answer]
I finally got this worked out. The key is to exactly follow the example in the third link of your post, using renderUI first!
```{r plot,echo=FALSE,message=FALSE}
tp_list <- reactive({
i<-names(d())[-1]
tp<-function(x){
p<-timePlot(d(),
pollutant=print(x),
main="Minute Validation",
ylab="Minute Conc. (ug/m3 or ppb)",
key=T)
p$plot
}
lapply(i, tp)
})
renderUI({
plot_output_list <- lapply(1:length(tp_list()), function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname)
})
do.call(tagList, plot_output_list)
})
observe({
for (i in 1:length(tp_list())) {
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
output[[plotname]] <- renderPlot({
tp_list()[[my_i]]
})
})
}
})
```
[Original answer based on lattice panels]
This is not exactly what you want, but I got all the plots displayed in one plot.
```{r plot,echo=FALSE,message=FALSE}
renderPlot({
i<-names(d())[-1]
tp<-function(x){
p<-timePlot(d(),
pollutant=print(x),
main="Minute Validation",
ylab="Minute Conc. (ug/m3 or ppb)",
key=T)
p$plot
}
tp(i)
})
```