Home > Software engineering >  Why my application works well but when I try to modularize it, it doesn't work properly?
Why my application works well but when I try to modularize it, it doesn't work properly?

Time:11-26

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)

CodePudding user response:

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
  })

}

EDIT

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)
  })

}
  • Related