Linear Regression R Shiny application with multiple independent variable selection - r

Question

I'm not able to modify the script below to make it work with multiple independent variables. It only works when a single independent variable is selected. I've added "multiple = TRUE" in the script to allow the selection of multiple variable at the same time. But that doesn't really affect the plots and stats generated. Any suggestion of how this can be resolved?
Any csv file with numeric and non numeric data would work to test the script. Saving the iris or mtcars r datasets as csv files would work to test the script.
Thank you for your help.
library(shiny)
library(DT)
library(shinyWidgets)
ui <- fluidPage(
titlePanel("Build a Linear Model"),
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
), #sidebarpanel
mainPanel( #DTOutput("tb1"),
fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
)
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[1],
options = list(`style` = "btn-info"))
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[2],
options = list(`style` = "btn-info"),
multiple = TRUE)
})
lmModel <- reactive({
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
if (length(x) == length(y)){
model <- lm(x ~ y, data = data(), na.action=na.exclude)
}else model <- NULL
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
req(lmModel())
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)

Answer 1

You have 2 issues in your code:
the naming convention is wrong; y is usually the dependent variable and x the independent
by extracting the selected columns as vectors out of the data.frame, you loose the nice features of the non-standard evaluation of R, especially for the names of your model. I think this is also the problem that it doesn't work with multiple independent variables
Instead of extracting the data, I use the selected variables to define the formula that can be used in the lm call:
library(shiny)
library(DT)
library(shinyWidgets)
ui <- fluidPage(
titlePanel("Build a Linear Model"),
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
), #sidebarpanel
mainPanel( #DTOutput("tb1"),
fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
)
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[2],
options = list(`style` = "btn-info"),
multiple = TRUE)
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[1],
options = list(`style` = "btn-info"),
multiple = FALSE)
})
lmModel <- reactive({
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
current_formula <- paste0(input$yvar, " ~ ", paste0(input$xvar, collapse = " + "))
current_formula <- as.formula(current_formula)
model <- lm(current_formula, data = data(), na.action=na.exclude)
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
req(lmModel())
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)