My application has two selectInputs. It updates the secound selectInput depending on the first selectInput and then it plots a timeline for df data. The app works completely well, but when I try to modularize it, it doesn't work properly (just the selectInputs work, but no plot is built). I have created a minimal example. I really appreciate any help everybody can provide.
library(shiny)
library(plotly)
library(reshape2)
# data preparation
df<-data.frame(Name1<-c("Aix galericulata","Grus grus"," Alces alces"),
Name2<-c("Mandarin Duck","Common Crane" ,"Elk"),
eventDate<-c("2015-03-11","2015-03-10","2015-03-10"),
individualCount<-c(1, 10, 1)
)
colnames(df)<-c("Name1","Name2","eventDate","individualCount")
#----------------------------------------------------------------------------------------
# module dataselect
dataselect_ui<- function(id) {
ns<-NS(id)
tagList(
selectInput(ns("Nametype"),"Select a name type",
choices=c("Name1","Name2","choose"),selected = "choose"),
selectInput(ns("Name"),"Select a name",
choices="",selected = "",selectize=TRUE)
)
}
dataselect_server <- function(id) {
moduleServer(id, function(input, output, session) {
# Putting columns Name1 and Nam2 of df in one column called nameType using melt()function
# This format of data is needed for the choices argument of updateSelectizeInput()
df2<-reshape2::melt(df,id=c("eventDate","individualCount"))
colnames(df2)<-c("eventDate","individualCount","nameType","Name")
observeEvent(
input$Nametype,
updateSelectizeInput(session, "Name", "Select a name",
choices = unique(df2$Name[df2$nameType==input$Nametype]),selected = ""))
# finalDf() is the data used to plot the timeline
finalDf<-reactive({
if(input$Name=="choose"){
return(NULL)
}
if(input$Name==""){
return(NULL)
}
if(input$Nametype=="choose"){
return(NULL)
}
# if the first selectInput is set to Name1, from df select rows their Name1 column is
# equal to the second selectInput value
else if(input$Nametype=="Name1"){
finalDf<-df[which(df$Name1==input$Name) ,]
}
# if the first selectInput is set to Name2, from df select rows their Name2 column is
# equal to the second selectInput value
else if(input$Nametype=="Name2"){
finalDf<-df[which(df$Name2==input$Name) ,]
}
return(
reactive({
input$Name
})
)
})
})
}
#-------------------------------------------------------------------------------------
# application
ui <- fluidPage(
# Application title
navbarPage(
"app",
tabPanel("plot",
sidebarPanel(
dataselect_ui("dataselect")
),
mainPanel(
plotlyOutput("timeline")
)
)
)
)
server <- function(session,input, output) {
dataselect_server("dataselect")
# timeline plot
output$timeline <- renderPlotly({
req(input$Name)
p<-ggplot(finalDf(),aes(x=eventDate,y=individualCount)) +geom_point(alpha=0.2, shape=21, color="black",fill="red",size=5)+
labs( x = "Date Event",y= "Individual Count") +theme_bw()
p<-ggplotly(p)
p
})
}
shinyApp(ui = ui, server = server)
If you return input$Name from the server module, as you correctly do, you have to use the returned value of this module in renderPlotly:
server <- function(session,input, output) {
input_Name <- dataselect_server("dataselect")
# timeline plot
output$timeline <- renderPlotly({
req(input_Name()) # don't forget the parentheses!
p<-ggplot(finalDf(),aes(x=eventDate,y=individualCount)) +geom_point(alpha=0.2, shape=21, color="black",fill="red",size=5)+
labs( x = "Date Event",y= "Individual Count") +theme_bw()
p<-ggplotly(p)
p
})
}
There is a problem in your code: your return statement of reactive(input$Name) is inside the reactive conductor finalDf.
Moreover you need to return finalDf as well, to use it outside the module.
So:
dataselect_server <- function(id) {
moduleServer(id, function(input, output, session) {
......
finalDf <- reactive({
if(input$Name=="choose"){
return(NULL)
}
if(input$Name==""){
return(NULL)
}
if(input$Nametype=="choose"){
return(NULL)
}
if(input$Nametype=="Name1") {
finalDf <- df[which(df$Name1==input$Name) ,]
} else if(input$Nametype=="Name2") {
finalDf <- df[which(df$Name2==input$Name) ,]
}
return(finalDf)
})
return(
list("finalDf" = finalDf, "input_Name" = reactive(input$Name))
)
})
}
and:
server <- function(session,input, output) {
module_outputs <- dataselect_server("dataselect")
input_Name <- module_outputs$input_Name
finalDf <- module_outputs$finalDf
# timeline plot
output$timeline <- renderPlotly({
req(input_Name()) # don't forget the parentheses!
p <- ggplot(finalDf(), aes(x = eventDate, y = individualCount))
+ geom_point(alpha = 0.2, shape = 21, color = "black", fill = "red", size = 5) +
labs(x = "Date Event", y = "Individual Count") + theme_bw()
ggplotly(p)
})
}