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)
})
```
Related
I am creating a shiny dashboard. I have a single selectInput that will update multiple places in the UI. Currently I am having to us multiple renderUI functions to do this. I was wondering whether there was a way to only use 1. For example I have this:
output$fig_con_1 <- renderUI({
commodity_impact_graph(l_impact_val)
})
output$tab1 <- renderUI({
includeHTML(wetland_path)
})
output$tab2 <- renderUI({
includeHTML(river_path)
})
I wish to achieve something akin to this:
output[all areas of the UI] <- renderUI({
commodity_impact_graph(l_impact_val)
includeHTML(wetland_path)
includeHTML(river_path)
})
Try this
output$all <- renderUI({
tagList(
commodity_impact_graph(l_impact_val)
includeHTML(wetland_path)
includeHTML(river_path)
)
})
I'd like to create several ui which use an input parameter. The problem is that the new UI created are still reacting to the input even when I put an isolate()
The right behaviour would give a custom UI created and isolated from the new inputs coming from the selectInput()
For instance I'd like a first UI with the year 2019 selected and second UI with the year 2020.
Here we can see that adding 2020 will change in each UI which is wrong.
library(shiny)
customplotUI <- function(id){
ns <- NS(id)
fluidPage(
sidebarPanel(id=ns("sidebarpanel"),
actionButton(ns("add"),label = "Add"),
selectInput(inputId=ns("years"),label="Year :", choices = c(2019,2020),selected = 2019, multiple = TRUE)),
mainPanel(div(id=ns("placeholder"))
)
)
}
customplot <- function(input,output,session){
ns <- session$ns
output$res <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
data[data$year %in% input$years,]})
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
IdNS <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
print(Id()('div'))
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
verbatimTextOutput(IdNS()('chart'))
)
)
id <- Id()('chart')
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
#data[data$year %in% isolate(input$years),]
data[data$year %in% input$years,]
})
})
}
ui <- fluidPage(
customplotUI(id="customplot")
)
server <- function(input, output, session){
callModule(customplot,id="customplot",session=session)
}
shinyApp(ui, server)
Perhaps I'm misunderstanding what you're trying to accomplish, but when I run the code, using the commented line with isolate seems to work as intended.
I'm guessing that in creating the minimal reprex (thank you for doing this btw!), you might have gone a little too minimal and removed another reactive that updates data. If you are trying to have the individual UI elements update based on some other input but keep the same filtering scheme, you need to capture the current value of input$years outside of the renderPrint statement.
Here you can see the subset of rows is unchanged, but the last column updates based on input box:
...
id <- Id()('chart')
targetYears <- input$years
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),
value=c("mtcars2019","mtcars2020"),
yrInput = paste(input$years, collapse =" "))
data[data$year %in% targetYears, ]
...
isolate only prevents a change in the reactive from triggering an update. If the update is triggered by something else, the current/updated value of the reactive is still used. Through the wonders of R's scoping rules, by capturing the value of input$years in non-reactive variable, targetYears, outside of the renderPrint call and then using that in the renderPrint expression it will always use the the value of the input when output[[id]] was created. The isolate is not needed as you are using observeEvent which will prevent the observer from executing when you change the input.
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.
Hi having a couple of problems
a) creating the correct text to pass variables to ggvis - not even sure aes_string is applicable
b) The plot propagates in browser rather than rendering in the rmarkdown document
Here is an example
---
title: "Untitled"
author: "pssguy"
date: "Sunday, August 24, 2014"
output: html_document
runtime: shiny
---
```{r, echo = FALSE, message=FALSE}
library(ggplot2)
library(ggvis)
library(dplyr)
selectInput("category3", "Choose Dataset:", c("mpg", "disp", "qsec"))
# ggplot renders correctly within renderPlot
renderPlot({
ggplot(mtcars,aes_string(input$category3,"disp"))+geom_point()
})
# ggvis works within document with hard coded info
mtcars %>% ggvis(~wt,~disp)
mtcars %>% ggvis(aes_string(paste("~",input$category3,","),"~disp"))
#Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
# This needs correcting anyways
renderPlot({
mtcars %>% ggvis(aes_string(paste("~",input$category3,","),"~disp"))
})
# <text>:1:7: unexpected ',' 1: ~ mpg ,
# even if the above is corrected the plot opens in a browser rather than the document
renderPlot({
mtcars %>% ggvis(~wt,~disp)
})
```
TIA
This should do it:
---
title: "Untitled"
output: html_document
runtime: shiny
---
```{r, echo = FALSE, message=FALSE}
library(ggplot2)
library(ggvis)
library(dplyr)
selectInput("category3", "Choose Dataset:", c("mpg", "disp", "qsec"))
# ggplot renders correctly within renderPlot
renderPlot({
print(input$category3)
ggplot(mtcars,aes_string(input$category3,"disp"))+geom_point()
})
# ggvis with dynamically changing columns
reactive({
if (!is.null(input$category3))
col <- input$category3
else
col <- "mpg"
mtcars %>% ggvis(prop("x", as.name(col)), ~disp)
}) %>% bind_shiny('foo')
ggvisOutput('foo')
```
It's a little complicated because you need a NULL check for the category, and you need to explicitly tell knitr to put a ggvis output on the page.