简体   繁体   中英

R Shiny reactivity missing when using modules and picking input from lists

  1. I have a R Shiny Module which does Linear Regressions, taking a data.table as an input.
  2. I am trying to use this module in an App where I am trying to give the names of the data.table as a reactive input. I am using the below code.
  3. The error is that it did not turn out to be reactive - try changing the input from iris to mtcars and you will observe that the select options for regression variables dont change(and I am unable to figure out what I am missing).
  4. Note that below is a reproducible code (original code is too large and will take the names from excel files).
    Please help.

Code for App


#### ---- REQUIRED LIBRARIES -----

library(shiny)
library(readxl)
library(dplyr)
library(xts)




# START OF UI ----

ui <- navbarPage(title = "study",
                 inverse=TRUE,
                 
                 tabPanel("Data Inputs",
                         
                            tabPanel("Regression",
                                     
                                     
                                     uiOutput("dummy.input"),
                                     Linear.Regression.UI("dummy")
                                     
                      
                          )#end of tabsPanel Regressions
                 )#end of tabPanel Data Inputs
                 
               
                 
)#end of navbarPage




# START OF SERVER -----



server <- function(input, output, session, data.tibble){
  
  
  dummy.list <- reactive(list(iris= iris, mtcars = mtcars))
  
  output$dummy.input <- renderUI({
    selectInput(inputId = "dummy.input.select",
                label = "Select dummy input here",
                choices = names(dummy.list()),
                multiple = FALSE)
  })
  
  
  
  Linear.Regression.Server("dummy", data.tibble = dummy.list()[[input$dummy.input.select]])
  
  
  
  
  
}



shinyApp(ui, server)

Code for Regression Module

Linear.Regression.UI <- function(id){
  ns <- NS(id)
  tagList(
    actionButton(ns("ClickforRegression"), label = "Click Here to Do Regression"),
    
    uiOutput(ns("Select.Regression.Y.Input")),
    uiOutput(ns("Select.Regression.X.Input")),
    
    verbatimTextOutput(ns("Linear.Model.Output.Summary"))
  )#end of tagList

}#end of Linear.Regression.UI


Linear.Regression.Server <- function(id, data.tibble){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    
    
    
    output$Select.Regression.Y.Input <- renderUI({
                                            selectInput(inputId = ns("Regression.Y.Input"),
                                            label = "Select Regression Dependent Variable",
                                            choices = names(data.tibble),
                                                       )#end of selectInput for Regression.Y.Input
      
    })#end of renderUI for output$Select.Regression.Y.Input.
    
    
    
    output$Select.Regression.X.Input <- renderUI({
                                            selectInput(inputId = ns("Regression.X.Input"),
                                            label = "Select Regression Independent Variables",
                                             choices= names(data.tibble),
                                             multiple=TRUE
                                                       )#end of selectInput for Regression.X.Input
      
    })#end of renderUI for output$Select.Regression.X.Input.
    
    
    
    
    
    
    
    
    
    
    linear.model <- reactiveVal()  ##linear.model is in the observeEvent handler. Yet, we need to define linear.model in reactiveVal().  Why?
    observeEvent(eventExpr = input$ClickforRegression,
                 linear.model(lm(reformulate(input$Regression.X.Input, input$Regression.Y.Input), data = data.tibble))  # Why put in brackets instead of the assignement operator?
                 )#end of observeEvent
    
    
    output$Linear.Model.Output.Summary <- renderPrint(summary(linear.model()))
    
    
  })#end of moduleServer
  
}

Try this

Linear.Regression.UI <- function(id){
  ns <- NS(id)
  tagList(
    actionButton(ns("ClickforRegression"), label = "Click Here to Do Regression"),
    
    uiOutput(ns("Select.Regression.Y.Input")),
    uiOutput(ns("Select.Regression.X.Input")),
    
    verbatimTextOutput(ns("Linear.Model.Output.Summary"))
  )#end of tagList
  
}#end of Linear.Regression.UI

Linear.Regression.Server <- function(id, data.tibble){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    
    output$Select.Regression.Y.Input <- renderUI({
      selectInput(inputId = ns("Regression.Y.Input"),
                  label = "Select Regression Dependent Variable",
                  choices = names(data.tibble()),
      )#end of selectInput for Regression.Y.Input
      
    })#end of renderUI for output$Select.Regression.Y.Input.
    
    output$Select.Regression.X.Input <- renderUI({
      selectInput(inputId = ns("Regression.X.Input"),
                  label = "Select Regression Independent Variables",
                  choices= names(data.tibble()),
                  multiple=TRUE
      )#end of selectInput for Regression.X.Input
      
    })#end of renderUI for output$Select.Regression.X.Input.

    
    linear.model <- reactiveVal()  ##linear.model is in the observeEvent handler. Yet, we need to define linear.model in reactiveVal().  Why?
    observeEvent(eventExpr = input$ClickforRegression, {
      req(input$Regression.X.Input, input$Regression.Y.Input)
      dfvars <- names(data.tibble())
      myvars <- c(input$Regression.X.Input, input$Regression.Y.Input)
      inds <- which(dfvars %in% myvars)
      
      if (length(dfvars[inds]) > 0 )
                 linear.model(lm(reformulate(input$Regression.X.Input, input$Regression.Y.Input), data = data.tibble()))  # Why put in brackets instead of the assignement operator?
    })#end of observeEvent
    
    
    output$Linear.Model.Output.Summary <- renderPrint(summary(linear.model()))
    
    
  })#end of moduleServer
  
}

# START OF UI ----

ui <- navbarPage(title = "study",
                 inverse=TRUE,
                 
                 tabPanel("Data Inputs",
                          
                          tabPanel("Regression",
                                   uiOutput("dummy.input"),
                                   Linear.Regression.UI("dummy")
                          )#end of tabsPanel Regressions
                 )#end of tabPanel Data Inputs
                 
)#end of navbarPage

# START OF SERVER -----

server <- function(input, output, session, data.tibble){
  
  
  dummy.list <- reactive(list(iris= iris, mtcars = mtcars))
  
  output$dummy.input <- renderUI({
    selectInput(inputId = "dummy.input.select",
                label = "Select dummy input here",
                choices = names(dummy.list()),
                multiple = FALSE)
  })
  
  observe({
    req(input$dummy.input.select)
    Linear.Regression.Server("dummy", data.tibble = reactive({dummy.list()[[input$dummy.input.select]]}))
  })
  
}

shinyApp(ui, server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM