I have a fully functioning shiny app for performing regression analysis, with summary(), tidy(), and augment(). However, I would like to add a filter selection in the shiny for the uploaded data. My dataset is quite big and within the dataset, it is divided into 5 types, (so, type_1, type_2, type_3, etc). Right now I have to divide my dataset manually outside the shiny app to 5 different datasets so I can only run the regression for one specific type at a time.
It would be great to be able to choose and select the type within the shiny, without going through all this hassle.
Grateful for all your help.
library(shiny)
library(shinyWidgets)
library(DT)
library(dplyr)
library(nlme)
library(broom)
ui <- navbarPage("dd",
tabPanel("Reg",
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
),
mainPanel(
DTOutput("tb1"),
fluidRow(
column(6, verbatimTextOutput('lmSummary')),
column(6,verbatimTextOutput("tid")),
column(6,verbatimTextOutput("aug"))
)
)
)
)
server <- function(input, output, session) {
data_1 <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(head(data_1()))
output$xvariable <- renderUI({
req(data_1())
xa<-colnames(data_1())
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_1())
ya<-colnames(data_1())
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_1(),input$xvar,input$yvar)
x <- as.numeric(data_1()[[as.name(input$xvar)]])
y <- as.numeric(data_1()[[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_1(), na.action=na.exclude)
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$tid <- renderPrint({
req(lmModel())
tidy(lmModel())
})
output$aug <- renderPrint({
req(lmModel())
augment(lmModel())
})
}
shinyApp(ui, server)
How the uploaded dataset could look like, for better explanation
data_set <- data.frame (Simulation_1 = c(1,2,3,4,5,6,7,8,9,10),
Simulation_2 = c(1,2,3,4,5,6,7,8,9,10),
Simulation_3 = c(1,2,3,4,5,6,7,8,9,10),
type = c("type_1", "type_2", "Type_5",
"type_1", "type_2", "Type_3",
"type_1", "type_2", "Type_1","Type_4")
)
CodePudding user response：
Perhaps you are looking for this
library(shiny)
library(shinyWidgets)
library(DT)
library(dplyr)
library(nlme)
library(broom)
data_set <- data.frame (Simulation_1 = c(1,2,3,4,5,6,7,8,9,10),
Simulation_2 = c(1,2,3,4,5,6,7,8,9,10),
Simulation_3 = c(1,2,3,4,5,6,7,8,9,10),
type = c("type_1", "type_2", "Type_5",
"type_1", "type_2", "Type_3",
"type_1", "type_2", "Type_1","Type_4")
)
ui <- navbarPage("dd",
tabPanel("Reg",
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("col"),
uiOutput("type"),
uiOutput("xvariable"),
uiOutput("yvariable")
),
mainPanel(
DTOutput("tb1"),
fluidRow(
column(6, verbatimTextOutput('lmSummary')),
column(6,verbatimTextOutput("tid")),
column(6,verbatimTextOutput("aug"))
)
)
)
)
server <- function(input, output, session) {
data_0 <- reactive({
# req(input$filedata)
# inData <- input$filedata
# if (is.null(inData)){ return(NULL) }
# mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
data_set
})
output$tb1 <- renderDT(head(data_1()))
output$col <- renderUI({
req(data_0())
selected = colnames(data_0())[length(colnames(data_0()))]
selectInput("mycol", "Choose column", choices = colnames(data_0()), selected = selected)
})
output$type <- renderUI({
req(data_0(),input$mycol)
selectInput("mytype", "Choose Type", choices = unique(data_0()[[input$mycol]]))
})
data_1 <- eventReactive(input$mytype, {
req(data_0(),input$mycol,input$mytype)
df <- data_0()
df$newvar <- df[[input$mycol]]
df %>% dplyr::filter(newvar %in% input$mytype) %>% dplyr::select(- c(newvar))
})
output$xvariable <- renderUI({
req(data_1())
xa<-colnames(data_1())
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_1())
ya<-colnames(data_1())
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_1(),input$xvar,input$yvar)
x <- as.numeric(data_1()[[as.name(input$xvar)]])
y <- as.numeric(data_1()[[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_1(), na.action=na.exclude)
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$tid <- renderPrint({
req(lmModel())
tidy(lmModel())
})
output$aug <- renderPrint({
req(lmModel())
augment(lmModel())
})
}
shinyApp(ui, server)