I'm trying to get a Shiny app built that updates predictions based on changes in variables from textInput. I built a smaller version using mtcars into a dataframe.
data(mtcars)
df <- data.frame(Color=c(rep("red",5),rep("grey",10),rep("white",10),rep("black",5),rep("chrome",2)))
df$Model <- rownames(mtcars)
mtcars$Model <- rownames(mtcars)
df_merged <- merge(mtcars,df)
head(df_merged)
lm.model <- lm(mpg ~ cyl + disp + hp + drat, df_merged)
ui <- fluidPage(
titlePanel("What if scenarios"),
sidebarLayout(
sidebarPanel(width = 3,
# Input: text input for the number of texts to be reviewed ----
actionButton("hidden", "Toggle"),
selectInput(inputId = "model",
label = "Model:",
value = unique(df_merged$model)),
textInput(inputId = "cyl",
label = "CYL:",
value = df_merged$cyl),
textInput(inputId = "disp",
label = "disp",
value = df_merged$disp),
textInput(inputId = "hp",
label = "HP",
value = df_merged$hp),
textInput(inputId = "drat",
label = "drat",
value = df_merged$drat),
),
mainPanel(
plotOutput(outputId = "distPlot"),
DT::dataTableOutput(outputId = "comparisonTable")
)
)
)
server <- function(input, output) {
plotData <- reactive({
model <- input$model
mpg <- as.numeric(input$mpg)
cyl <- as.numeric(input$cyl)
disp <- as.numeric(input$disp)
hp <- as.numeric(input$hp)
drat <- as.numeric(input$drat)
input_dat <- tibble(mpg = mpg,
cyl = cyl,
disp = disp,
hp = hp,
drat = drat)
setDT(input_dat)
pred <- predict.lm(model, input_dat)
return(new dt with pred populated)
})
output$comparisonTable <- DT::renderDataTable({
DT::datatable(plotData(),
rownames= FALSE,
options = list(bFilter = 0, #remove filter
bLengthChange=0,
scrollX = TRUE))#remove number of items to display dropdown
})
}
shinyApp(ui, server)
This isn't a total 1:1 example since my actual app is pulling from somewhere else and not just a linear model, so after all the data is processed through the inputs the prediction is already generated in the data table that's returned at the end of the server function.
I am trying to get it to update the populated text inputs when you change the model to their respective variables (i.e. when you change from an AMC Javelin to a Datsun 710, the mpg, cyl, disp, hp, drat text changes to match) and a new prediction is generated in the new dataframe.
I know the issue is the fact that the df is loaded outside of the app entirely but I don't know how to make prepopulate inputs in text-input outside of the UI, so that is what I'm looking for help on.
Thank you!
Related
When I build a shiny app, I would like the default values of my filters to reflect the min and max of the working dataset.
For instance, is the app user filters to a specific subgroup (e.g., 4 cylinder cars), how can I reactively change the default values for min and max MPG in the inputs?
library(shiny)
library(shinyWidgets)
library(tidyverse)
ui <-
fluidPage(
## side panel
#############################################################################
sidebarPanel(
pickerInput(
inputId = 'cyl',
label = 'Cylinders',
choices = sort(unique(mtcars$cyl)),
options = list(`actions-box` = TRUE),
multiple = TRUE,
selected = unique(mtcars$cyl)
),
numericInput("mpg_max", "MPG max", 50, min = 0, max = 50), # hardcoded max
numericInput("mpg_min", "MPG min", 0, min = 0, max = 50), # hardcoded min
),
## main panel
#############################################################################
plotOutput("plot")
)
server <- function(input, output) {
output$plot <- renderPlot({
mtcars %>%
filter(
cyl %in% input$cyl
# between(mpg, input$mpg_min, input$mpg_max)
) %>%
ggplot(aes(x = wt, y = mpg)) +
geom_point() +
coord_cartesian(ylim = c(input$mpg_min, input$mpg_max))
})
}
shinyApp(ui, server)
If the user changes the Cylinder input to 4 there are no mpg values below 20, but I'm not sure how to update the default input values for MPG min with this info because reactive programming tends to happen in the server rather than ui area of a shiny app.
observeEvent() was the solution!
library(shiny)
library(shinyWidgets)
library(tidyverse)
ui <-
fluidPage(
## side panel
#############################################################################
sidebarPanel(
pickerInput(
inputId = 'cyl',
label = 'Cylinders',
choices = sort(unique(mtcars$cyl)),
options = list(`actions-box` = TRUE),
multiple = TRUE,
selected = unique(mtcars$cyl)
),
numericInput("mpg_max", "MPG max", 50, min = 0, max = 50),
numericInput("mpg_min", "MPG min", value = min(mtcars$mpg)-5, min = 0, max = 50),
),
## main panel
#############################################################################
plotOutput("plot")
)
server <- function(session, input, output) {
observeEvent(input$cyl, {
x <- mtcars %>% filter(cyl %in% input$cyl) %>% summarise(min(mpg)) %>% pull()
updateNumericInput(session, "mpg_min", value = x-5)
})
output$plot <- renderPlot({
mtcars %>%
filter(
cyl %in% input$cyl,
between(mpg, input$mpg_min, input$mpg_max)
) %>%
ggplot(aes(x = wt, y = mpg)) +
geom_point() +
coord_cartesian(ylim = c(input$mpg_min, input$mpg_max))
})
}
shinyApp(ui, server)
I'm trying to create a way in which a user can store their selections as inputs. Here is an example of what I would like to accomplish:
1) Run the app, it will immediately generate a table with three rows. You name it using Sample Label something like "Sample1"
2) Click the Save Sample button, which then creates an input as a checkbox within the panel I created, that when clicked, will automatically adjust the filters to how they were when clicking the Save Sample button.
3) You then set disp to 160 and hp to 110, which returns two rows. Repeat the same steps. You name it something like "Sample2" and hit "Save Sample". Now there are two checkboxes: Sample1 and Sample2. You can now toggle them around so the user can pick whatever setting they want. In theory, you can do this as many times as you want.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
selectInput("disp", "Disp", choices = unique(sort(mtcars$disp)), selected = 275.8),
selectInput("hp", "hp", choices = unique(sort(mtcars$hp)), selected = 180),
div(style="display:inline-block", textInput(('sample_name'), label = 'Sample Name',width = 200)),
div(style="display:inline-block", actionButton(('select_sample'),icon = icon('save'), label = 'Save Sample')),
panel(h2("User Created Inputs go here")),
DT::dataTableOutput("cardata")
)
server <- function(input,output,session) {
compileData <- reactive({
res <- mtcars %>% filter(hp == input$hp & disp == input$disp)
})
output$cardata <- DT::renderDataTable({
compileData()
})
}
shinyApp(ui,server)
Perhaps this might be something helpful for you.
You can save the filter settings in a reactiveValues dataframe. When filters are created, then a checkbox group will be automatically updated with the new name.
The table data will be filtered based on these selected checkboxes. For this example, if no boxes are selected, then the data shown is based on the two input selections. However, if any checkbox is selected, then the data table will include filtered data based on these choices.
Let me know if this is close to what you had in mind.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
selectInput("disp", "Disp", choices = unique(sort(mtcars$disp)), selected = 275.8),
selectInput("hp", "hp", choices = unique(sort(mtcars$hp)), selected = 180),
div(style="display:inline-block", textInput(('sample_name'), label = 'Sample Name',width = 200)),
div(style="display:inline-block", actionButton(('select_sample'),icon = icon('save'), label = 'Save Sample')),
panel(h2("User Created Inputs go here"),
uiOutput("checkboxes")
),
DT::dataTableOutput("cardata")
)
server <- function(input,output,session) {
rv <- reactiveValues(filters = data.frame(
id = character(),
disp = double(),
hp = double()
))
compileData <- reactive({
if (is.null(input$checkboxes)) {
mtcars %>% filter(hp == input$hp & disp == input$disp)
} else {
merge(mtcars, rv$filters[rv$filters$id %in% input$checkboxes, ], by = c("disp", "hp"))
}
})
output$cardata <- DT::renderDataTable({
compileData()
})
observeEvent(input$select_sample, ignoreInit = FALSE, {
rv$filters <- rbind(rv$filters, data.frame(
id = input$sample_name,
disp = input$disp,
hp = input$hp
)
)
})
output$checkboxes <- renderUI({
checkboxGroupInput("checkboxes", "Filters:", choices = rv$filters$id, selected = NULL)
})
}
shinyApp(ui,server)
I am trying to build a shiny app that gives new predictions based on various user inputs.
However, even though the input values are updating with the inputs, the prediction value does not update. Im am having trouble figuring out why.
The model is a random forest regression model, in the example I am using numeric variables but in my situation the inputs are categorical (I dont think this change should effect anything) This is why the sidebar is all select input as opposed to select numeric
I made a reproducible example with the mtcars dataset
model <- ranger(mpg ~ disp + hp + wt, data = mtcars)
ui <- fluidPage(
sidebarPanel(
selectInput('disp', 'disp',
choices = unique(mtcars$disp),
selected = unique(mtcars$disp)[1]),
selectInput('hp', 'hp',
choices = unique(mtcars$hp),
selected = unique(mtcars$hp)[1]),
selectInput('wt', 'wt',
choices = unique(mtcars$wt)),
actionButton("Enter", "Enter Values"),
width = 2
),
mainPanel(
tableOutput('mpg')
)
)
server <- function(input, output, session) {
val <- reactive({
new <- mtcars[1, ]
new$disp <- input$disp
new$hp <- input$hp
new$wt <- input$wt
new
})
out <- eventReactive(
input$Enter,
{
val <- val()
val$pred <- predict(model, data = val)$predictions
val
})
output$mpg <- renderTable({
out()
})
}
shinyApp(ui, server)
There are several issues here.
1) You are using selectInput incorrectly. See below. Basically, using indexes like mtcars$disp[1] will create static values, no matter what is selected.
2) You are using renderTable() when you are only producing a single value as output. Why not just use renderText()? See below.
3) The eventReactive trigger (i.e., input$enter) needs to be used to create the data frame of input values. The model prediction can run on the data frame later, but the initial trigger actually pulls the values from selectInput, so the trigger needs to be in the same block where the data frame is created.
This ran correctly and produced the desired output on my machine:
library(shiny)
library(ranger)
model <- ranger(mpg ~ disp + hp + wt, data = mtcars)
ui <- fluidPage(
sidebarPanel(
selectInput('disp', 'disp',
unique(mtcars$disp)),
selectInput('hp', 'hp',
unique(mtcars$hp)),
selectInput('wt', 'wt',
unique(mtcars$wt)),
actionButton("enter", label = "Enter Values"),
width = 2
),
mainPanel(
textOutput('mpg')
)
)
server <- function(input, output, session) {
val <- eventReactive(
input$enter, {
data.frame(
disp = input$disp,
hp = input$hp,
wt = input$wt,
stringsAsFactors = F
)}
)
output$mpg <- renderText({
predict(model, val())[[1]]
})
}
shinyApp(ui, server)
Reformulating my question, I´m trying to synthetize a data frame reactively, with a selectinput = c("col_1","col_2","col_3","col_4","col_5")
My dataframe looks something like this
Date . Store_ID . Sales . Stock . ETC
I need to be able to sum all the data in the same stores, with the different user selected columns.
Using the mtcars dataframe as an example to work with, my objective is to have a table like this
SelectInput = disp
cyl - disp
4 - sum(every 4 cylinders disp)
6 - sum(every 6 cylinders disp)
8 - sum(every 8 cylinders disp)
SelectInput = qsec
cyl . qsec
4 . sum(every 4 cylinders qsec)
6 . sum(every 6 cylinders qsec)
8 . sum(every 8 cylinders qsec)
library(shiny)
library(tidyverse)
ui <- bootstrapPage(
selectInput(
"col",
"Column",
colnames(mtcars),
selected = "mpg"),
plotOutput("histCentile", height = 200)
)
server <- function(input, output) {
data <- reactive({
mtcars() %>%
group_by(cyl = cyl) %>%
pull(input$col) %>%
sum()
})
output$histCentile <- renderPlot({
hist(data()$[[input$col]],
main = "Graph",
xlab = "Units",
xlim = range(data()$[[input$col]]),
col = '#00DD00',
border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm not sure what you're trying to do but here is a minimal reproducible example using reactive to filter data based on the selectInput variable.
library(shiny)
library(tidyverse)
ui <- bootstrapPage(
selectInput(
"col",
"Column",
colnames(mtcars),
selected = "mpg"),
textOutput("selected_col")
)
server <- function(input, output) {
data <- reactive({
mtcars %>% pull(input$col) %>% sum()
})
output$selected_col <- renderText({
sprintf("The sum of column %s is %f", input$col, data())
})
}
# Run the application
shinyApp(ui = ui, server = server)
Explanation: In data we sum the values from input$col based on the selectInput selection. data is therefore a reactive value, which we show in output$selected_col.
Update
There are a few issues with your updated code example:
In the reactive block, you're summarising data to give a single number. Plotting a histogram based on a single number makes no sense. Secondly, there is a typo: it should be mtcars not mtcars(); and lastly, group_by(cyl = cyl) is unnecessary as you don't do any group-wise calculation afterwards (it should also be group_by(cyl)).
You don't actually need a reactive block here at all, since you can do the filtering in renderPlot directly but I guess that is a matter of personal preference.
The following dynamically updates a histogram based on the selected column from selectInput
library(shiny)
library(tidyverse)
ui <- bootstrapPage(
selectInput(
"col",
"Column",
colnames(mtcars),
selected = "mpg"),
plotOutput("histo")
)
server <- function(input, output) {
data <- reactive({
mtcars %>% pull(input$col)
})
output$histo <- renderPlot({
hist(data())
})
}
# Run the application
shinyApp(ui = ui, server = server)
Update - Solution
Thanks to Maurits Evers help, and some research, I managed to do what I wanted to
library(shiny)
library(tidyverse)
ui <- bootstrapPage(
selectInput(
"col",
"Column",
colnames(mtcars),
selected = "mpg"),
plotOutput("histo")
)
server <- function(input, output) {
data <- reactive({
Graphby <- input$col
with(mtcars,aggregate(qsec,list(cyl=cyl),sum))
aggregate(mtcars[[Graphby]],list(cyl=mtcars$cyl),sum)
})
output$histo <- renderPlot({
hist(data()$x)
})
}
# Run the application
shinyApp(ui = ui, server = server)
What it does is an interactive histogram by merging groups of data like this
in a reactive way, by choosing different columns.
I am challenged trying to implement a feature into my Shiny app. The problem is two-fold:
Is it possible to have 2 inputs from the same variable? I have one variable that is a list of indicators. I want the user to be able to select 2 indicators with selectInput, and then draw a scatter plot. There has to be 2 selectInputs because other parts of the app will rely on only the first selectInput. My data is long. I don't think it will work if I make it wide because my data includes latitude and longitude information so it wouldn't make sense to create a selectInput with names(data), for example.
If I can have 2 selectInputs from the same variable, how would I call the values in my plot, since the value is called 'value' for both the inputs?
EDIT: Following Gregor's suggestion to reference the inputs with aes_string, I would expect the following example of mtcars gathered into long format to work, but I instead get an aesthetics or object not found error. I think I probably need to filter the data, but I don't understand how I can do that since my variable indicators now refers to both 'indicators' and 'indicators2'. I.e., I can't have
filtered <-
cars %>%
filter(indicators == input$indicators,
indicators == input$indicators2)
Maybe I need to create a reactive expression that creates a new data frame instead? This is my non-working reproducible code with long-form mtcars:
library(ggplot2)
library(shiny)
cars <- mtcars %>%
gather(indicators, value, mpg:carb)
ui <- fluidPage(
# Application title
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
selectInput("indicators",
label = "select indicator:",
choices = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
),
selectInput("indicators2",
label = "select indicator:",
choices = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
)
),
mainPanel(
plotOutput("carsPlot")
)
)
)
server <- function(input, output) {
output$carsPlot <- renderPlot({
ggplot(cars, aes_string(x = input$indicators, y = input$indicators2)) +
geom_point(shape = 1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use aes_string to pass input$indicators and input$indicators2 to ggplot like this. There is no need to cast your data into wide format since ggplot can actually handle long data better.
library(ggplot2)
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
selectInput("indicators",
label = "select indicator:",
choices = names(mtcars)),
selectInput("indicators2",
label = "select indicator:",
choices = names(mtcars))
),
mainPanel(
plotOutput("carsPlot")
)
)
)
server <- function(input, output) {
output$carsPlot <- renderPlot({
ggplot(mtcars, aes_string(x = input$indicators, y = input$indicators2)) +
geom_point(shape = 1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Here another solution with a selectInput in multiple mode.
library(dplyr)
library(tidyr)
library(ggplot2)
library(shiny)
cars <- mtcars %>%
gather(indicators, value, mpg:carb)
ui <- fluidPage(
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
uiOutput("ui_indicators")
),
mainPanel(
plotOutput("carsPlot")
)
)
)
server <- function(input, output) {
output$ui_indicators <- renderUI({
choices <- unique(cars$indicators)
selectInput("indicators",
label = "select indicators :",
choices = choices,
multiple = TRUE)
})
output$carsPlot <- renderPlot({
filtered <- cars %>% filter(indicators %in% input$indicators)
ggplot(filtered, aes(x = indicators, y = value)) +
geom_point(shape=1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Building on the tip from Gregor on aes_string, I managed to fix this. I ended up using the wide data and adding a proper reactive statement that creates a new data frame out of the selected indicators.
My server function now looks like this:
server <- function(input, output) {
selectedVars <- reactive({
cars[, c(input$indicators, input$indicators2)]
})
output$carsPlot <- renderPlot({
ggplot(selectedVars(), aes_string(x = input$indicators, y = input$indicators2)) +
geom_point(shape = 1)
})
}
All works beautifully, and I am beginning to learn more about the utility of reactive functions in Shiny :)
Gregor de Cillia provided the answer I was looking for.
The two inputs (which are not a problem) can be referenced using aes_string.