firmo23
Reputation: 8444
Display two visualizations that are based on two different dataframes in modularized shiny app
In the modularized shiny app below I want to create one map which is created and one plot below the map. The 2 visualizations are based on 2 different dataframes though and I do not know exactly how display them both.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)
library(plotly)
# Some data
data<-structure(list(scientificName = c("Turdus merula Linnaeus, 1758",
"Passer domesticus (Linnaeus, 1758)", "Cantharellus cinereus (Pers.) Fr.",
"Flammulina fennae Bas", "Mycena crocata (Schrad.) P.Kumm.",
"Lepista luscina (Fr.) Singer", "Mycena permixta (Britzelm.) Sacc.",
"Rhodophyllus byssisedus (Pers.) Quel.", "Rhodophyllus porphyrophaeus (Fr.) J.E.Lange",
"Panaeolus rickenii Hora"), decimalLatitude = c(52.204429, 51.387818,
52.176667, 50.066111, 49.179167, 49.419444, 52.3, 52.3, 49.419444,
49.179167), decimalLongitude = c(21.189275, 19.62673, 19.088056,
19.502778, 22.434722, 20.380556, 20.566667, 20.566667, 20.380556,
22.434722)), row.names = c(1L, 2L, 32L, 35L, 37L, 38L, 39L, 40L,
41L, 42L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
))
data$year<-c(1990,1989,2003,1990,1980,1990,1989,2003,1990,1980)
# Define the side panel UI and server
sideUI <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("ye")),
uiOutput(ns("scient")),
actionButton(ns("action"),"Submit")
)
}
sideServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
# define a reactive and return it
react<-eventReactive(input$action,{
omited <-subset(data, data$scientificName %in% isolate(input$sci))
})
output$ye<-renderUI({
pickerInput(
inputId = session$ns("yea"),
label = "Year",
choices = sort(unique(data$year),decreasing=F),
selected = unique(data$year),
multiple = T
)
})
output$scient<-renderUI({
data <-subset(data, data$year %in% input$yea)
pickerInput(
inputId = session$ns("sci"),
label = "Scientific name",
choices = unique(data$scientificName),
selected = unique(data$scientificName)[1],
)
})
return(react)
counted<-reactive({data.frame(react() %>%
group_by(year) %>%
summarise(count=n()
))
})
return(counted)
})
}
# In this case this server not needed but using uiOuput/renderUI in real case
# sideServer <- function(id) { moduleServer(id,function(input, output, session) { })}
# Define the UI and server functions for the map
mapUI <- function(id) {
ns <- NS(id)
tagList(
leafletOutput(ns("map")),
plotlyOutput(ns("plot"))
)
}
mapServer <- function(id, city) {
moduleServer(
id,
function(input, output, session) {
output$map<-renderLeaflet({
leaflet(data = city()) %>% addTiles() %>%
addMarkers(~decimalLatitude, ~decimalLongitude, popup = ~as.character(scientificName), label = ~as.character(scientificName))
})
})
}
plotServer <- function(id, city) {
moduleServer(
id,
function(input, output, session) {
output$plot<-renderPlotly({
fig <- plot_ly(data=city(), x = ~as.factor(year), y = ~count, type = 'scatter', mode = 'lines')
fig%>% layout(title = paste("Count of",input$sci ,"through the years"),
xaxis = list(title = "Years",tickangle=45),
yaxis = list (title = "Count"))
})
})
}
# Build ui & server and then run
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(sideUI("side")),
dashboardBody(mapUI("mapUK"))
)
server <- function(input, output, session) {
# use the reactive in another module
city_input <- sideServer("side")
mapServer("mapUK", city_input)
plotServer("plotPl",city_input)
}
shinyApp(ui, server)
Upvotes: 0
Views: 82
Answers (1)
gss
Reputation: 1453
- You have
plotlyOutput(ns("plot"))in different module thanserverwhere isoutput$plot<-renderPlotly({(the latter is inplotServerwhile ui output is inmapUI). I decided to make newuiforplotServer, but you can also try to move elements fromplotServerintomapServer. - As you said, the problem is with returning multiple elements. But not just two dataframes, also some input. To return more than one element, you need to create list, say like this:
return(list(element1 = _object_to_return1, element2 = _object_to_return2)). - I said above "return some input", that's because here:
fig%>% layout(title = paste("Count of",input$sci ,"through the years")you are using input, but input from different module. As you already know, you do not have direct access to objects from different modules and the same is withinputs. That means you need to returninputas well, butinputneeds to be wrapped intoreactive()function. In your case, when there is module with tworeturns function, it should be one and look like this:return(list(react = react, counted = counted, sci = reactive(input$sci))). - Now, because you have returned list, you need to access elements inside this list as normal elements from list, so when you pass arguments to function, it won't be
reactas previously, butcity_input$react. You also need to add parameters to the server function - not justcity, but also parameter forcounteddataframe andinput. - In case it won't be obvious for you - to access input from other module (after passing as argument) you access it as a normal function, so below you can see that I use
sci()instead ofinput$sci
Here is full code:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)
library(plotly)
# Some data
data<-structure(list(scientificName = c("Turdus merula Linnaeus, 1758",
"Passer domesticus (Linnaeus, 1758)", "Cantharellus cinereus (Pers.) Fr.",
"Flammulina fennae Bas", "Mycena crocata (Schrad.) P.Kumm.",
"Lepista luscina (Fr.) Singer", "Mycena permixta (Britzelm.) Sacc.",
"Rhodophyllus byssisedus (Pers.) Quel.", "Rhodophyllus porphyrophaeus (Fr.) J.E.Lange",
"Panaeolus rickenii Hora"), decimalLatitude = c(52.204429, 51.387818,
52.176667, 50.066111, 49.179167, 49.419444, 52.3, 52.3, 49.419444,
49.179167), decimalLongitude = c(21.189275, 19.62673, 19.088056,
19.502778, 22.434722, 20.380556, 20.566667, 20.566667, 20.380556,
22.434722)), row.names = c(1L, 2L, 32L, 35L, 37L, 38L, 39L, 40L,
41L, 42L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
))
data$year<-c(1990,1989,2003,1990,1980,1990,1989,2003,1990,1980)
# Define the side panel UI and server
sideUI <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("ye")),
uiOutput(ns("scient")),
actionButton(ns("action"),"Submit")
)
}
sideServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
# define a reactive and return it
react<-eventReactive(input$action,{
omited <-subset(data, data$scientificName %in% isolate(input$sci))
})
output$ye<-renderUI({
pickerInput(
inputId = session$ns("yea"),
label = "Year",
choices = sort(unique(data$year),decreasing=F),
selected = unique(data$year),
multiple = T
)
})
output$scient<-renderUI({
data <-subset(data, data$year %in% input$yea)
pickerInput(
inputId = session$ns("sci"),
label = "Scientific name",
choices = unique(data$scientificName),
selected = unique(data$scientificName)[1],
)
})
counted<-reactive({react() %>%
group_by(year) %>%
summarise(count=n()
)
})
return(list(react = react, counted = counted, sci = reactive(input$sci)))
})
}
# In this case this server not needed but using uiOuput/renderUI in real case
# sideServer <- function(id) { moduleServer(id,function(input, output, session) { })}
# Define the UI and server functions for the map
mapUI <- function(id) {
ns <- NS(id)
tagList(
leafletOutput(ns("map"))
)
}
mapServer <- function(id, city) {
moduleServer(
id,
function(input, output, session) {
output$map<-renderLeaflet({
leaflet(data = city()) %>% addTiles() %>%
addMarkers(~decimalLatitude, ~decimalLongitude, popup = ~as.character(scientificName), label = ~as.character(scientificName))
})
})
}
plotUI <- function(id) {
ns <- NS(id)
tagList(
plotlyOutput(ns("plot"))
)
}
plotServer <- function(id, city, sci) {
moduleServer(
id,
function(input, output, session) {
output$plot<-renderPlotly({
fig <- plot_ly(data=city(), x = ~as.factor(year), y = ~count, type = 'scatter', mode = 'markers+lines')
fig%>% layout(title = paste("Count of", sci(),"through the years"),
xaxis = list(title = "Years",tickangle=45),
yaxis = list (title = "Count"))
})
})
}
# Build ui & server and then run
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(sideUI("side")),
dashboardBody(mapUI("mapUK"), plotUI("plotPl"))
)
server <- function(input, output, session) {
# use the reactive in another module
city_input <- sideServer("side")
mapServer("mapUK", city_input$react)
plotServer("plotPl", city_input$counted, sci = city_input$sci)
}
shinyApp(ui, server)
What I have changed and didn't describe above is that from this:
counted<-reactive({data.frame(react() %>%
group_by(year) %>%
summarise(count=n()
))
})
I have removed data.frame() function. You don't need this, it will be data.frame even without this function.
I have also changed mode = 'lines' into mode = 'markers+lines', because I saw no data in plot. But then I realized it's because for each animal is only one year in data.frame (and just with lines you can't see line if there is only one point on plot). I understand that you posted just a part of data. That's of course fine.
Upvotes: 1
Related Questions
- Show different data.frames in different tabs in a Shiny app
- plot two different datasets in shiny
- How to generate multiple plots using modules?
- How to display and hide different plots in a shiny app at the same place
- Render multiple plots from from single dataset (shiny)
- Produce two plots with the same plotOutput() in a shiny app
- How to download two different dataframes in the same file in a shiny app
- Using a dataframe built within a Shiny server for two outputs
- Render 2 outputs referencing the same data set
- Multiple plots side by side in a Shiny app