- I have a R Shiny Module which does Linear Regressions, taking a data.table as an input.
- 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.
- 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).
- 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
}
CodePudding user response：
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)