Getting a sum of values in R Shiny - r

I have this R Shiny that gives me values of Meters covered based on the drill selected and the time selected by the user. Here is my code.
library(shiny)
library(dplyr)
# MyData <- read.csv("/Users/sonamoravcikova/Desktop/ShinyTest/ForShiny1.csv")
MyData <- structure(list(Drill = c("GP Warm Up", "5v2 Rondo", "11v11", "10v6 Drop
Behind Ball"), PlayerLoadPerMinute = c(7.72949670665213, 6.49382926701571,
9.67483408668731, 5.86770863636364), MetersPerMinute = c(69.9524820610687,
45.823744973822, 95.9405092879257, 58.185375), class = "data.frame", row.names
= c(NA, -4L)))
# Define UI ----
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
#Select number of drills
numericInput("num", h3("Number of Drills"), value = 1),
),
mainPanel(
#Show boxes for the number of drill selected and select drill type
selectInput("DrillName1",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM1"),
br(),
conditionalPanel(
condition = "input.num > '1'",
selectInput("DrillName2",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider2",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM2")),
br(),
conditionalPanel(
condition = "input.num > '2'",
selectInput("DrillName3",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider3",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM3"))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
#Calculate number of meters covered
lapply(1:10, function(x) {
output[[paste0("MpM", x)]] <- renderText({
chosendrill <- input[[paste0("DrillName", x)]]
MpM <- MyData %>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input[[paste0("slider", x)]])
paste0("Meters covered: ", paste0(MpM_text, collapse = " "))
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
Now I'm trying to just add all of the values that I get for the individual drills together so that I will get Meters covered for the whole session but I have no idea how to do that. So if someone could help me out where to start I would appreciate it. Thanks

Related

Calculating sum in Shiny

I'm trying to create a shiny app as a practice planner where users can select which drills they are going to do and how long they will do each drill and the app then shows them the total meters covered for the whole practice. Now I'm trying to calculate the total values of meters covered during a session based on the drills selected and the number of minutes selected for each drill. However my total is always equal to 0 even though it works for calculating each drill separately. Could someone help me figure out what I'm doing wrong please. Below is my code with sample data.
library(shiny)
library(dplyr)
# MyData <- read.csv("/Users/sonamoravcikova/Desktop/ShinyTest/ForShiny1.csv")
MyData <- structure(list(Drill = c("GP Warm Up", "5v2 Rondo", "11v11", "10v6 Drop
Behind Ball"), PlayerLoadPerMinute = c(7.72949670665213, 6.49382926701571,
9.67483408668731, 5.86770863636364), MetersPerMinute = c(69.9524820610687,
45.823744973822, 95.9405092879257, 58.185375), class = "data.frame", row.names
= c(NA, -4L)))
# Define UI ----
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
#Select number of drills
numericInput("num", h3("Number of Drills"), value = 1),
textOutput("MpM_Total")
),
mainPanel(
#Show boxes for the number of drill selected and select drill type
selectInput("DrillName1",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM1"),
br(),
conditionalPanel(
condition = "input.num > '1'",
selectInput("DrillName2",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider2",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM2")),
br(),
conditionalPanel(
condition = "input.num > '2'",
selectInput("DrillName3",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider3",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM3"))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
#Calculate number of meters covered
lapply(1:10, function(x) {
MetersPerMin <- reactive({
chosendrill <- input[[paste0("DrillName",x)]]
MpM <- MyData %>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input[[paste0("slider",x)]])
})
output[[paste0("MpM", x)]] <- renderText({
paste0("Meters covered: ", MetersPerMin())
})
MpM_Sum <- reactive({
sum(MetersPerMin())
})
output$MpM_Total <- renderText({
paste("Total Meters Covered", MpM_Sum())
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
library(shiny)
library(dplyr)
MyData <- data.frame(Drill = c('GP Warm Up', '5v2 Rondo', '11v11', '10v6 Drop Behind Ball'),
PlayerLoadPerMinute = c(7.72949670665213, 6.49382926701571, 9.67483408668731, 5.86770863636364),
MetersPerMinute = c(69.9524820610687, 45.823744973822, 95.9405092879257, 58.185375))
MpM <- MyData %>%
distinct(MetersPerMinute, .keep_all = T)
# Define UI ----
ui <- fluidPage(
titlePanel('Practice Planner'),
sidebarLayout(
sidebarPanel(
#Select number of drills
numericInput('num', h3('Number of Drills'), value = 1),
textOutput('MpM_Total')
),
mainPanel(
#Show boxes for the number of drill selected and select drill type
selectInput('DrillName1',
label = 'Choose a Drill:',
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput('slider1',
label = h3('Slider'),
min = 0,
max = 60,
value = 0),
textOutput('MpM1'),
br(),
conditionalPanel(
condition = 'input.num > "1"',
selectInput('DrillName2',
label = 'Choose a Drill:',
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput('slider2',
label = h3('Slider'),
min = 0,
max = 60,
value = 0),
textOutput('MpM2')
),
br(),
conditionalPanel(
condition = 'input.num > "2"',
selectInput('DrillName3',
label = 'Choose a Drill:',
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput('slider3',
label = h3('Slider'),
min = 0,
max = 60,
value = 0),
textOutput('MpM3')
)
)
)
)
# Define server logic ----
server <- function(input, output, session) {
MetersPerMin <- reactive({
idx <- input$num
if (idx < 1) {
idx <- 1
} else if (idx > 3) {
idx <- 3
}
mpms <- sapply(1:idx, function(x) {
chosendrill <- input[[ paste0('DrillName', x) ]]
mpm <- (MpM$MetersPerMinute[ MpM$Drill == chosendrill ]) * (input[[ paste0('slider', x) ]])
output[[ paste0('MpM', x) ]] <- renderText(paste0('Meters covered: ', mpm))
mpm
})
mpms
})
output$MpM_Total <- renderText({
paste('Total Meters Covered', sum(MetersPerMin()))
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

Calculations in RShiny

I’m super new to RShiny and I’m trying to create an app that will calculate the total meters players will run during practice. I have a csv file in which I have meters per minute for each drill and I want this app to calculate the total based on the drills selected and the time selected.
And I don’t know how to pull the data from the csv file for the specific drill selected and multiply it by the number of minutes selected.
This is what I have right now but it doesn’t work.
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
numericInput("num", h3("Number of Drills"), value = 1)
),
mainPanel(
selectInput("DrillName",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider11",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
conditionalPanel(
condition = "input.num > '1'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '2'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '3'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '4'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '5'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
textOutput("MpM1")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$MpM1 <- renderText({
chosendrill <- (input$DrillName)
MpM <- unique.data.frame(MyData$MetersPerMinute)
MpM1 <- (MpM[[chosendrill]]) * (input$slider11)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
I'm not certain of a lot of details of what you are looking for, and I don't have your data set, but I think I was able to come up with a relatively simple update of your app to hopefully show how to make it work. First, I made a test dataset, which I just used mtcars and renamed some columns to match yours. Then I wrote the file, then read it in, so that way I can show how one can read data for a shiny app. Otherwise, if you are looking to have more dynamic read in of data, refer to #r2evans comment on shiny::fileInput, or maybe even a reactiveFileReader.
The next thing I did was update the inputId of many of your inputs, as you used the same name for different inputs. As I expect you want each input to do something different, a different inputId is needed. Additionally, I put a new textOutput for each conditionalPanel, so that each can display their own data. I also added some spacing for visual clarity with br().
For the server side, I changed a couple of things. First, I have never used unique.data.frame, but I have used distinct from dplyr, so I used that instead. Then, I changed your MpM_text, I'm nto really certain what exactly you wanted to happen, but this shows how to use rows that match the input and to use them to multiply against something else. This was then output in a paste0.
I also did a repeat of this for the other 5 drills that were in the conditionalPanel, just as a little show of how you can repeat the calculations with different inputs/outputs. Again, I'm not sure what the precise nature of your program/data, but hopefully this helps to point you in the right direction. If you are posting on stack in the future, I'd suggest making your code as simple as possible that will show whatever error you are seeing, including any necessary data so that the viewers can easily recreate your issue. Best of luck, shiny can be a pain sometimes to figure out, but I've really enjoyed using it over the years and so I hope you have success yourself!
library(shiny)
library(dplyr)
MyData<-mtcars%>% #Since I don't have your dataset, I made my own using mtcars
rename(Drill = cyl, #Renaming column names to match yours
MetersPerMinute = mpg)
write.table(MyData, "Test.csv") #Writing it into a csv so I can demonstrate how to read and use the data from a csv
MyData<-read.table("Test.csv") #reading the csv
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
numericInput("num", h3("Number of Drills"), value = 1)
),
mainPanel(
selectInput("DrillName",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider11",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM1"),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '1'",
selectInput("DrillName1", #name of the select input should differ if expecting to be used separately, changed to `DrillName1`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM2")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '2'",
selectInput("DrillName2", #name of the select input should differ if expecting to be used separately, changed to `DrillName2`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider2", #name of the sliderinput should differ if expecting to be used separately, changed to 2
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM3")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '3'",
selectInput("DrillName3", #name of the select input should differ if expecting to be used separately, changed to `DrillName3`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider3", #name of the sliderinput should differ if expecting to be used separately, changed to 3
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM4")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '4'",
selectInput("DrillName4", #name of the select input should differ if expecting to be used separately, changed to `DrillName4`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider4", #name of the sliderinput should differ if expecting to be used separately, changed to 4
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM5")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '5'",
selectInput("DrillName5", #name of the select input should differ if expecting to be used separately, changed to `DrillName5`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider5", #name of the sliderinput should differ if expecting to be used separately, changed to 5
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM6"))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$MpM1 <- renderText({
chosendrill <- (input$DrillName)
# MpM <- unique.data.frame(MyData$MetersPerMinute) #This doesn't work for me. I've never used unique.data.frame though.
# Instead I'll use distinct from dplyr, which is considerably faster, according to dplyr!
MpM <- MyData%>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input$slider11)
#I'm not certain what the data looks like, or what the result you want should look like
# In the mtcars dataset I used for example, it has multiple matches to each cyl, or "Drill", so this will put multiple outputs
paste0("Drill Meters per minute * slider: ", paste0(MpM_text, collapse = " "))
})
lapply(2:6, function(x) { #This is just showing how to repeat the calculations for multiple sliders
output[[paste0("MpM", x)]] <- renderText({
chosendrill <- input[[paste0("DrillName",x-1)]]
MpM <- MyData%>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input[[paste0("slider",x-1)]])
paste0("Drill Meters per minute * slider: ", paste0(MpM_text, collapse = " "))
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

How to render dynamic UIs based on user selection with shiny

Given the set of shiny UIs and their differings arguments (to be read from a rdf, here given as explicit lists) how can the user select a desired type of input (for a data-model with many different inputs, all presetted with defaults) to be changed?
library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = "seq(1,20,1)", selected = 10),
list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = "c(25,75)" ),
list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "pkInp01",
label = "Select CF-Model Inputs for change",
choices = inputWidget,
selected = inputWidget[1:2],
multiple = TRUE,
options = list(`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} inputs of {1} selected") ),
uiOutput("inpUI"),
),
mainPanel(
dataTableOutput("table01")
)
)
)
#-----------------generateArguments4invoke_map---------------------------.
server <- function(input, output, session) {
#B: obs <- reactiveValues(
#A: pckdWdgt <- inputWidget[match(input$pkInp01, inputWidget)],
#A: wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
#B: )
#B: observe({
#B: obs$pW01 = inputWidget[match(input$pkInp01, inputWidget)]
#B: obs$wA02 = inpWidgArgs[match(input$pkInp01, inputWidget)]
#B: })
#------------------renderAsManyInputUisAsPicked------------
output$inpUI <- renderUI({
#A: invoke_map(match.fun(pckdWdgt), wdgtArgs)
#B: invoke_map(match.fun(obs$pW01), obs$WA02)
invoke_map(list(selectInput, sliderInput), list(
list(inputId = "inpUI01", label = "selectInput01", choices = seq(1,20,1), selected = 10),
list(inputId = "inpUI02", label = "sliderInput02", min= 0, max = 100, value = c(25,75) )
)
)
})
}
}
#-----------------------------------------------------
shinyApp(ui, server)
With map() or invoke_map() it should be possible to pass the type of function/UIinput and its arguments (compare: https://hadley.shinyapps.io/ms-render-palette-full).
Two approaches (A: and B:) below fail (possible reason: environment/namespace?) Any suggestion highly appreciated.
Many thanks in advance
I cleaned some of your code and created the solution. To start a few minor things: The choices argument in seInp01 shouldn't be between quotations. The same goes for the value argument in slInp01. Lastly there is a trailing comma behind your uiOutput argument in the UI. For the functionality of the code I just put some codes that you already came up with in the right place, you had the right idea.
The code:
library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = seq(1,20,1), selected = 10),
list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = c(25,75) ),
list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "pkInp01",
label = "Select CF-Model Inputs for change",
choices = inputWidget,
selected = inputWidget[1:2],
multiple = TRUE,
options = list(`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} inputs of {1} selected") ),
uiOutput("inpUI")
),
mainPanel(
dataTableOutput("table01")
)
)
)
#-----------------generateArguments4invoke_map---------------------------.
server <- function(input, output, session) {
#------------------renderAsManyInputUisAsPicked------------
output$inpUI <- renderUI({
wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
invoke_map(input$pkInp01, wdgtArgs)
})
}
}
#-----------------------------------------------------
shinyApp(ui, server)

How to implement eventReactive with multiple reactive eventExpr?

I am having trouble when initializing a shiny app in R. I would like eventReactive to trigger from any of several events, which are chained by reactive expressions. The app mostly works as intended, but does not display upon initialization and instead requires user to select an actionButton before results are displayed. Why is this?
I read documentation for eventReactive, played with ignoreNULL and ignoreInit settings, and done many online searches.
Example below.
require(shiny)
require(ggplot2)
ui <- fluidPage(
titlePanel("Car Weight"),
br(),
uiOutput(outputId = "cylinders"),
sidebarLayout(
mainPanel(
# plotOutput(outputId = "trend"),
# plotOutput(outputId = "hist"),
tableOutput("table"),
uiOutput(outputId = "dataFilter"),
actionButton(inputId = "update1", label = "Apply Filters"),
width = 9
),
sidebarPanel(
actionButton(inputId = "update2", label = "Apply Filters"),
uiOutput(outputId = "modelFilter"),
actionButton(inputId = "update3", label = "Apply Filters"),
width = 3
)
)
)
server <- function(input, output) {
# Read data. Real code will pull from database.
df <- mtcars
df$model <- row.names(df)
# Get cylinders
output$cylinders <- renderUI(
selectInput(
inputId = "cyl",
label = "Select Cylinders",
choices = c("", as.character(unique(df$cyl)))
)
)
# Subset data by cyl.
df2 <-
reactive(droplevels(df[df$cyl == input$cyl, ]))
# Filter data.
df3 <-
eventReactive({
##############################################################
# Help needed:
# Why does this block not update upon change in 'input$cyl'?
##############################################################
input$update1
input$update2
input$update3
input$cyl
},
{
req(input$modelFilter)
modelFilterDf <-
data.frame(model = input$modelFilter)
df3a <-
merge(df2(), modelFilterDf, by = "model")
df3a[df3a$wt >= input$dataFilter[1] &
df3a$wt <= input$dataFilter[2],]
},
ignoreNULL = FALSE,
ignoreInit = FALSE)
# Plot table.
output$table <- renderTable(df3())
# Filter by data value.
output$dataFilter <-
renderUI({
req(df2()$wt[1])
sliderInput(
inputId = "dataFilter",
label = "Filter by Weight (1000 lbs)",
min = floor(min(df2()$wt, na.rm = TRUE)),
max = ceiling(max(df2()$wt, na.rm = TRUE)),
value = c(
min(df2()$wt, na.rm = TRUE),
max(df2()$wt, na.rm = TRUE)
),
step = round(
max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
) / 100,
round = round(log((
max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
) / 100))
)
})
# Filter by lot / wafer.
output$modelFilter <- renderUI({
req(input$cyl)
checkboxGroupInput(
inputId = "modelFilter",
label = "Filter by Model",
choices = as.character(unique(df2()$model)),
selected = as.character(unique(df2()$model))
)
})
}
# Run shiny.
shinyApp(ui = ui, server = server)
I found a solution. Perhaps not the most elegant, but it works.
The problem was that input$modelFilter and input$modelFilter were one update behind df2. This did not matter when the user selected input$update, since df2 did not update, and only posed a problem during a newly created df2, since the filter would not match the data.
To resolve this, I added values <- reactiveValues(update = 0) which will increase by +1 every time df3 is created, and will reset back to 0 when a new df2 is created. If values$update > 0 then the data is filtered, otherwise, the unfiltered data is returned.
Possibly useful link: How can I set up triggers or execution order for eventReactive or ObserveEvent?
require(shiny)
require(ggplot2)
ui <- fluidPage(
titlePanel("Car Weight"),
br(),
uiOutput(outputId = "cylinders"),
sidebarLayout(
mainPanel(
tableOutput("table"),
uiOutput(outputId = "dataFilter"),
actionButton(inputId = "update1", label = "Apply Filters"),
width = 9
),
sidebarPanel(
actionButton(inputId = "update2", label = "Apply Filters"),
uiOutput(outputId = "modelFilter"),
actionButton(inputId = "update3", label = "Apply Filters"),
width = 3
)
)
)
server <- function(input, output) {
# Read data. Real code will pull from database.
df <- mtcars
df$model <- row.names(df)
df <- df[order(df$model), c(12,1,2,3,4,5,6,7,8,9,10,11)]
# Get cylinders
output$cylinders <- renderUI({
selectInput(
inputId = "cyl",
label = "Select Cylinders",
choices = c("", as.character(unique(df$cyl)))
)})
# Check if data frame has been updated.
values <- reactiveValues(update = 0)
# Subset data by cyl.
df2 <-
reactive({
values$update <- 0
df2 <- droplevels(df[df$cyl == input$cyl,])})
# Filter data.
df3 <-
eventReactive({
input$update1
input$update2
input$update3
df2()
},
{
if (values$update > 0) {
req(input$modelFilter)
modelFilterDf <-
data.frame(model = input$modelFilter)
df3a <-
merge(df2(), modelFilterDf, by = "model")
df3a <- df3a[df3a$wt >= input$dataFilter[1] &
df3a$wt <= input$dataFilter[2], ]
} else {
df3a <- df2()
}
values$update <- values$update + 1
df3a
},
ignoreNULL = FALSE,
ignoreInit = TRUE)
# Plot table.
output$table <- renderTable(df3())
# Filter by data value.
output$dataFilter <-
renderUI({
req(df2()$wt[1])
sliderInput(
inputId = "dataFilter",
label = "Filter by Weight (1000 lbs)",
min = floor(min(df2()$wt, na.rm = TRUE)),
max = ceiling(max(df2()$wt, na.rm = TRUE)),
value = c(floor(min(df2()$wt, na.rm = TRUE)),
ceiling(max(df2()$wt, na.rm = TRUE))),
step = round(max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)) / 100,
round = round(log((
max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
) / 100))
)
})
# Filter by lot / wafer.
output$modelFilter <- renderUI({
req(input$cyl)
checkboxGroupInput(
inputId = "modelFilter",
label = "Filter by Model",
choices = as.character(unique(df2()$model)),
selected = as.character(unique(df2()$model))
)
})
}
# Run shiny.
shinyApp(ui = ui, server = server)

How Can I Have Two Numeric Inputs in R Shiny

Below I have an R code that takes an input value from the numericInput object and stores it in an Excel spreadsheet. I am now trying to have two numericInput's, but I'm not sure how to do that. Below in the code, I tried to just duplicate the object as a last resort effort, but it gave me an error. (I'm not surprised) Any advice?
library(shiny)
library(xlsxjars)
library(rJava)
library(xlsx)
ui <- fluidPage(
numericInput(inputId = "num",
label = "Choose a number",
min = 0, max = 1000000, value = 1),
actionButton(inputId = "submit",
label = "Submit"),
numericInput(inputId = "num2",
label = "Choose a number2", min = 0, max = 1000000, value = 1),
)
server <- function(input, output) {
options(java.parameters = "- Xmx1024m")
wb <- loadWorkbook(file = "F:\\RProject-Rough\\DirectEffect.xlsx")
sheet<-getSheets(wb)
observeEvent(input$submit, {
addDataFrame(c(input$num,input$num2), sheet$'Direct Effects',
col.names = FALSE, row.names = FALSE, startRow = 3,startColumn = 5)
saveWorkbook(wb,"F:\\RProject-Rough\\DirectEffect.xlsx")
})
}
shinyApp(ui = ui, server = server)
First of all, after your second numericInput, there is a comma that does not belong there.
Secondly, addDataFrame takes a data.frame as an argument and not a vector.
The following works for me:
library(shiny)
library(xlsxjars)
library(rJava)
library(xlsx)
ui <- fluidPage(
numericInput(inputId = "num",
label = "Choose a number",
min = 0, max = 1000000, value = 1),
actionButton(inputId = "submit",
label = "Submit"),
numericInput(inputId = "num2",
label = "Choose a number2", min = 0, max = 1000000, value = 1)
)
server <- function(input, output) {
options(java.parameters = "- Xmx1024m")
wb <- loadWorkbook(file = "/PATH/TO/test.xlsx")
sheet <- getSheets(wb)
observeEvent(input$submit, {
addDataFrame(data.frame(c(input$num,input$num2)), sheet$`Direct Effects`,
col.names = FALSE, row.names = FALSE, startRow = 3, startColumn = 5)
saveWorkbook(wb, "/PATH/TO/test.xlsx")
})
}
shinyApp(ui = ui, server = server)

Resources