Using R Shiny for Multiple Linear Regression (SelectInput --> multiple=TRUE) - r

I'm having some trouble getting my R Shiny code to produce a dynamic dashboard where the user can select 1 or more independent variables in a linear regression model and print the results. I've been able to successfully follow examples where the user only inputted one independent variable, but with multiple independent variables, I have not found the same luck. I'm not sure what I am doing wrong, but I get an error that reads, "invalid term in model formula".
Below is the code I've used so far:
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
#data(mtcars)
AttributeChoices=c("cyl","disp","hp","drat","wt","qsec","vs")
# Define UI for application
ui = fluidPage(
navbarPage("R Shiny Dashboard",
tabPanel("Welcome",
tabName = "welcome",
icon=icon("door-open"),
fluidPage(theme=shinytheme("cerulean"),
h1("Welcome to my Shiny Dashboard!"),
br(),
p(strong(tags$u("What is this dashboard all about?"))),
p("I'm going to do stuff."),
br(),
p(strong(tags$u("Here's another question."))),
p("Here's my answer."),
br(),
p(strong(tags$u("How can I use this dashboard?"))),
p("You can click on any of the tabs above to see a different analysis of the data.")
)),
tabPanel("Regression",
tabname="regression",
icon=icon("calculator"),
selectInput(inputId = "indep", label = "Independent Variables",
multiple = TRUE, choices = as.list(AttributeChoices), selected = AttributeChoices[1]),
verbatimTextOutput(outputId = "RegOut")
)
))
# Define server logic
server <- function(input, output) {
#-------------------REGRESSION-------------------#
lm_reg <- reactive(
lm(as.formula(paste(mtcars$mpg," ~ ",paste(input$indep,collapse="+"))),data=CFD)
)
output$RegOut = renderPrint({summary(lm_reg())})
}
# Run the application
shinyApp(ui = ui, server = server)
Reading similar posts on StackOverflow seem to suggest the problem might be with the column names having spaces, but that's not the case here in this example. I am not sure how to resolve this issue. Can anyone help point me in the right direction? Thank you!

Here you go, I like to use the recipe package for problems like this instead of relying on very hard string manipulation, the trick is to use the !!! operator, you can even get fancy and let the user pass some select helpers
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(recipes)
#data(mtcars)
AttributeChoices=c("cyl","disp","hp","drat","wt","qsec","vs")
# Define UI for application
ui = fluidPage(
navbarPage("R Shiny Dashboard",
tabPanel("Welcome",
tabName = "welcome",
icon=icon("door-open"),
fluidPage(theme=shinytheme("cerulean"),
h1("Welcome to my Shiny Dashboard!"),
br(),
p(strong(tags$u("What is this dashboard all about?"))),
p("I'm going to do stuff."),
br(),
p(strong(tags$u("Here's another question."))),
p("Here's my answer."),
br(),
p(strong(tags$u("How can I use this dashboard?"))),
p("You can click on any of the tabs above to see a different analysis of the data.")
)),
tabPanel("Regression",
tabname="regression",
icon=icon("calculator"),
selectInput(inputId = "indep", label = "Independent Variables",
multiple = TRUE, choices = as.list(AttributeChoices), selected = AttributeChoices[1]),
verbatimTextOutput(outputId = "RegOut")
)
))
# Define server logic
server <- function(input, output) {
#-------------------REGRESSION-------------------#
recipe_formula <- reactive(mtcars %>%
recipe() %>%
update_role(mpg,new_role = "outcome") %>%
update_role(!!!input$indep,new_role = "predictor") %>%
formula())
lm_reg <- reactive(
lm(recipe_formula(),data = mtcars)
)
output$RegOut = renderPrint({summary(lm_reg())})
}
# Run the application
shinyApp(ui = ui, server = server)

Related

how to create a Histogram from dataframe based on a dropdown in SHINY

[picture of my code and shiny app][1]I am trying to write a shiny app where I have two drop down menus and I create two histograms from those dropdowns and a salary variable I have stored in a dataframe. I can create the drop downs but I am lost on how to save the selection and use the selection as a independent variable for my model. any help at all would be huge.
I tried using a save button to save the selection from the drop down but I couldn't get that to store the variable in a way that I could verify with my dataframe.
code below
library(dplyr)
library(ggplot2)
library(shiny)
data <- read.csv("C:/Users/lewis/OneDrive/Desktop/STA 580( R
programming)/Final_Project/salaries_entry.csv")
data
wxdata <- data.frame(
Remote = c("0%", "50%", "100%"),
Size = c("Small","Medium","Large")
)
remotelist <- unique(wxdata$Remote)
sizelist <- unique(wxdata$Size)
ui <- fluidPage(
titlePanel("Data Science / Data Engineer Salaries"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h4("The purpose of this app is to give you an idea"),
h4("about the potential money you could be making as an"),
h4("entry level employee in the Data Science field based "),
h4("on a few key factors. Test it out and Get that BAG!")
)
),
inputPanel(
selectInput(
"RemoteWork",
label = "Select Amount of Remote Work",
choices = remotelist
)
),
inputPanel(
selectInput(
"CompanySize",
label = "Select the Size of the Company",
choices = sizelist
)
),
)
server <- function(input, output) {
output$minplot <- renderPlot(draw_plot(input$PlotCity))
}
shinyApp(ui = ui, server = server)

What is the best method for doing multiple regression on a reactive dataframe in r shiny?

I have a reactive dataframe and I want the user to select the dependent and multiple independent variables from that reactive dataframe and return the regression outputs.
Does anyone have recommendations on the best way to do multiple regression on a reactive dataframe in Shiny?
I see this thread: Using R Shiny for Multiple Linear Regression (SelectInput --> multiple=TRUE)
but I have commented showing the code doesn't work.
I also see this question: Perform multiple linear regression with variables based on shiny widget selection
But that is just a simple 1 to 1 regression.
Ok so I took a look at the first answer you said didn't work and I've slightly modified it to allow you to also select the dependent variable. You get an error when you include the dependent variable in the independent variables but I'm sure you could figure out a way to make sure that the dependent variable isn't included in the independent variables as a selection.
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(recipes)
#data(mtcars)
AttributeChoices=c("mpg","cyl","disp","hp","drat","wt","qsec","vs")
# Define UI for application
ui = fluidPage(
navbarPage("R Shiny Dashboard",
tabPanel("Welcome",
tabName = "welcome",
icon=icon("door-open"),
fluidPage(theme=shinytheme("cerulean"),
h1("Welcome to my Shiny Dashboard!"),
br(),
p(strong(tags$u("What is this dashboard all about?"))),
p("I'm going to do stuff."),
br(),
p(strong(tags$u("Here's another question."))),
p("Here's my answer."),
br(),
p(strong(tags$u("How can I use this dashboard?"))),
p("You can click on any of the tabs above to see a different analysis of the data.")
)),
tabPanel("Regression",
tabname="regression",
icon=icon("calculator"),
selectInput(inputId="dependent", label = "Dependent Variables",
choices = as.list(AttributeChoices)),
selectInput(inputId = "indep", label = "Independent Variables",
multiple = TRUE, choices = as.list(AttributeChoices), selected = AttributeChoices[1]),
verbatimTextOutput(outputId = "RegOut")
)
))
# Define server logic
server <- function(input, output) {
#-------------------REGRESSION-------------------#
recipe_formula <- reactive(mtcars %>%
recipe() %>%
update_role(!!!input$dependent,new_role = "outcome") %>%
update_role(!!!input$indep,new_role = "predictor") %>%
formula())
lm_reg <- reactive(
lm(recipe_formula(),data = mtcars)
)
output$RegOut = renderPrint({summary(lm_reg())})
}
# Run the application
shinyApp(ui = ui, server = server)
For some reason it now requires prep(), just add it at the end of the pipe, I also improved the selection as #dodo1672 had said.
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(recipes)
#data(mtcars)
AttributeChoices=c("mpg","cyl","disp","hp","drat","wt","qsec","vs")
# Define UI for application
ui = fluidPage(
navbarPage("R Shiny Dashboard",
tabPanel("Welcome",
tabName = "welcome",
icon=icon("door-open"),
fluidPage(theme=shinytheme("cerulean"),
h1("Welcome to my Shiny Dashboard!"),
br(),
p(strong(tags$u("What is this dashboard all about?"))),
p("I'm going to do stuff."),
br(),
p(strong(tags$u("Here's another question."))),
p("Here's my answer."),
br(),
p(strong(tags$u("How can I use this dashboard?"))),
p("You can click on any of the tabs above to see a different analysis of the data.")
)),
tabPanel("Regression",
tabname="regression",
icon=icon("calculator"),
selectInput(inputId="dependent", label = "Dependent Variables",
choices = as.list(AttributeChoices)),
uiOutput("indep"),
verbatimTextOutput(outputId = "RegOut")
)
))
# Define server logic
server <- function(input, output) {
#-------------------REGRESSION-------------------#
output$indep <- renderUI({
selectInput(inputId = "indep", label = "Independent Variables",
multiple = TRUE, choices = as.list(AttributeChoices[AttributeChoices!= input$dependent]), selected = AttributeChoices[1])
})
recipe_formula <- reactive({
req(input$indep)
mtcars %>%
recipe() %>%
update_role(!!!input$dependent, new_role = "outcome") %>%
update_role(!!!input$indep, new_role = "predictor") %>%
prep() %>%
formula()
})
lm_reg <- reactive(
lm(recipe_formula(),data = mtcars)
)
output$RegOut = renderPrint({
summary(lm_reg())
})
}
# Run the application
shinyApp(ui = ui, server = server)

Failure to display DataTable in RShiny App

I'm hoping to display a reactive datatable for my Shiny app. I'm using renderDataTable() and have made sure that the data table is returned in the reactive function. I've noticed that the datatable renders fine outside of the Shiny App, so not a variable/computation error. The reason I'm hoping to use a datatable in the first place is so that I can display cleaned up column names and display the dataframe in a more clean manner. Please let me know what else I can try, or if I should change my approach.
Here is the server code:
server <- function(input, output) {
dataset <- reactive({
shiny_tuition_salary <- datatable(df_tuition_salary %>%
select(name, mean_net_cost, state) %>%
filter(mean_net_cost >= input$input_budget[1],
mean_net_cost <= input$input_budget[2],
state == input$input_state) %>%
select(name, mean_net_cost))
return(shiny_tuition_salary)
})
output$df <- renderDataTable({
dataset()
})
}
Currently nothing is displayed under the Table tab in the app. The app also successfully displays the table when DataTable is not used at all (i.e. removing datatable() from the server and using RenderTable instead of RenderDataTable), so I'm positive there's an issue with my implementation of RenderDataTable()
Thanks!
EDIT: Here's the ui code and a sample df_tuition_salary as well
ui <- fluidPage(
titlePanel("What colleges match your budget and rank?"),
# Sidebar laayout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "input_budget",
label = "Budget:",
min = 0,
max = 50000,
value = c(0, 15000)),
selectInput(inputId = "input_state",
label = "State (limited data, may limit options):",
choices = df_tuition_salary$state)
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
id = 'output_df',
# tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("df"))
)
)
)
)
df_tuition_salary:
df_tuition_salary <- data.frame(name = c("Aaniiih Nakoda College", "Abilene Christian University"),
mean_net_cost = c(7508.2414, 24884.0828),
state = c("N/A", "N/A"))
use dataTableOutput() function.
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
id = 'output_df',
# tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", dataTableOutput("df"))
)

Display error message when api call comes back empty in Shiny?

I have an interactive visualization that connects to a city government's police data API.
When certain combinations of inputs are selected, my API call comes back empty and I get a nasty red error message (as my plot inputs are unavailable).
Can someone tell me how to display a more informative error message along the lines of, "there are no incidents matching your selection, please try again"? I would like this error message to appear as a showNotification and my ggplot not to render.
Below is an extremely stripped down version of what I am doing. Note how when a combination like "AVONDALE" and "CHEMICAL IRRITANT" is selected, the chart renders, whereas when a combination like "ENGLISH WOODS" and "TASER-BEANBAG-PEPPERBALL-40MM FOAM" is selected, an error message is returned. This error message is what I would like to address with a showNotification alert.
Note that this uses the Socrata API, so the package RSocrata must be installed and loaded.
install.packages("RSocrata")
library(shiny)
library(reshape2)
library(dplyr)
library(plotly)
library(shinythemes)
library(tibble)
library(RSocrata)
# Define UI for application that draws a histogram
ui <- fluidPage(
navbarPage("Example",
theme = shinytheme("united"),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
# neighborhood selector
selectizeInput("neighbSelect",
"Neighborhoods:",
choices = c("AVONDALE", "CLIFTON", "ENGLISH WOODS"),
multiple = FALSE)),
# incident description selector
selectizeInput("incSelect",
"Incident Type:",
choices = c("CHEMICAL IRRITANT", "TASER-BEANBAG-PEPPERBALL-40MM FOAM"),
multiple = FALSE))
),
# Output plot
mainPanel(
plotlyOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
forceInput <- reactive({
forceInput <- read.socrata(paste0("https://data.cincinnati-oh.gov/resource/e2va-wsic.json?$where=sna_neighborhood= '", input$neighbSelect, "' AND incident_description= '", input$incSelect, "'"))
})
# Render plot
output$plot <- renderPlotly({
ggplot(data = forceInput(), aes(x = sna_neighborhood)) +
geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you so much for any help anyone can offer!
Im going to give an example with the shinyalert library to have the popup. Here I added the sample choice TEST to indicate no data:
#install.packages("RSocrata")
library(shiny)
library(reshape2)
library(dplyr)
library(plotly)
library(shinythemes)
library(tibble)
library(RSocrata)
library(shinyalert)
# Define UI for application that draws a histogram
ui <- fluidPage(
useShinyalert(),
navbarPage("Example",
theme = shinytheme("united"),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
# neighborhood selector
selectizeInput("neighbSelect",
"Neighborhoods:",
choices = c("AVONDALE", "CLIFTON", "ENGLISH WOODS","TEST"),
multiple = FALSE)),
# incident description selector
selectizeInput("incSelect",
"Incident Type:",
choices = c("CHEMICAL IRRITANT", "TASER-BEANBAG-PEPPERBALL-40MM FOAM"),
multiple = FALSE))
),
# Output plot
mainPanel(
plotlyOutput("plot")
)
)
)
# Define server logic
server <- function(input, output,session) {
forceInput <- reactive({
forceInput <- read.socrata(paste0("https://data.cincinnati-oh.gov/resource/e2va-wsic.json?$where=sna_neighborhood= '", input$neighbSelect, "' AND incident_description= '", input$incSelect, "'"))
if(nrow(forceInput)==0){
shinyalert("Oops!", "No data returned", type = "error")
forceInput <- NULL
}
forceInput
})
# Render plot
output$plot <- renderPlotly({
req(forceInput())
ggplot(data = forceInput(), aes(x = sna_neighborhood)) +
geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)

Dynamic UI - SelectInput Not Showing

Thank you all in advance for your help.
I'm still relatively new to R-Shiny and I'm trying to explore dynamic UI. I've done some research into renderUI, reactive, and observe functions but I'm still not sure of the right way to go about doing what I'm trying to accomplish which is:
User selects Y - dynamically populates choices based on loaded data in global.r
User selects X - dynamically populates choices based on loaded data in global.r
R plots the two
My problem is that the select inputs do not display - that makes sense to me given they are reactive. How do I show those select inputs when the page loads?
ui.R
require(shiny)
shinyUI(fluidPage(
tabPanel("Pineapple",
tabPanel("",
sidebarLayout(
sidebarPanel(
helpText("Choose X and Y"),
uiOutput("pineapple.pick_Y"),
uiOutput("pineapple.pick_X"),
),
mainPanel(
plotOutput("pineapple.plot")
)
)
)
)
))
server.R
shinyServer(function(input, output, session){
output$pineapple.plot <- renderPlot({
df <- data.frame(blue = c(1,2,3),
red = c(4,5,6),
boy = c("steve","steve","bill"),
girl = c("stacey","lauren","stacey")
plot(input$pineapple.pick_X,input$pineapple.pick_Y,data=df)
})
output$pineapple.pick_X <- renderUI({
selectInput("pineapple.x", label = h6("Select X"),
choices = c("blue","red"),
selected = "blue")
})
output$pineapple.pick_Y <- renderUI({
selectInput("pineapple.y", label = h6("Select Y"),
choices = c("boy","girl"),
selected = "boy")
})
})
Found a way around it - There wasn't a need to a dynamic UI really, just used variables I stored in global.R to pull the choices.
Thanks!

Resources