Shiny 反应函数中用户输入计算的意外结果
Unexpected results from user input calculations in Shiny reactive functions
下面 Shiny reprex 的反应环境中的一些计算已经困扰了我一段时间，我希望我能在这里找到解决方案。此应用从侧边栏面板获取四个用户输入，并根据两组乘数 table（在应用顶部创建）计算输出 table。对于这些输入的每组，将根据 sector/subsector 乘数 table 计算三个值 - expenditure_calc、salary_calc 和 emp_calc。对于给定的扇区输入（第一个下拉列表），如果从第二个下拉框中选择“未知子扇区”，则 sector_multiplier_table 用于计算。 And, when one of Subsector 1, Subsector 2... is chosen, the subsector_multiplier_table" is used.
例如，对于以下用户输入，Select扇区：扇区1； Select分部门：分部门1；计算依据：支出；价值：2,000,000，根据子行业乘数table得出的计算结果为：expenditure_calc = 2,000,000； salary_calc = 400,000; emp_calc = 10
在大多数情况下，计算似乎工作正常，但当我选择涉及“未知子部门”的 sectors/subsectors 组合时，它们给出了我无法理解的值。以下是导致计算错误的输入示例：
输入选择1：“Sector 1”，“Subsector 1”，“Expenditure”，1000000 输入选择2：“Sector 1”，“Unknown subsector”，“Emp”，24
感谢任何帮助。
library(tidyverse)
library(DT)
library(magrittr)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinydashboardPlus)
library(shinyWidgets)
# Sector multiplier table
sector <- c("Sector 1", "Sector 2", "Sector 3")
expenditure <- c(1000000, 1000000, 1000000)
salary <- c(250000, 500000, 160000)
emp <- c(5, 7, 9)
sector_multipliers <- data.frame(sector, expenditure, salary, emp)
# Subsector multiplier table
sector <- c("Sector 1", "Sector 1", "Sector 1", "Sector 1", "Sector 2", "Sector 2", "Sector 2", "Sector 3", "Sector 3")
subsector <- c("Subsector 1", "Subsector 2", "Subsector 3", "Subsector 4", "Subsector 1", "Subsector 2", "Subsector 3", "Subsector 1", "Subsector 2")
expenditure <- c(1000000, 1000000, 1000000, 1000000, 1000000, 1000000, 1000000, 1000000, 1000000)
salary <- c(200000, 250000, 300000, 400000, 425000, 280000, 600000, 170000, 150000)
emp <- c(5, 7, 9, 12, 9, 14, 18, 4, 5)
subsector_multipliers <- data.frame(sector, subsector, expenditure, salary, emp)
# Initialize empty data frame to store user input
input_data <- data.frame(sector = character(), subsector = character(), calc_type = character(), calc_value = double(), stringsAsFactors = FALSE)
# UI component
ui <- dashboardPage(
header = dashboardHeader(title = "Calculations", titleWidth = 450),
# UI sidebar panel
sidebar = dashboardSidebar(
minified = F,
width = 300,
pickerInput("sector",
"Select sector:",
choices = sector_multipliers$sector,
options = list(`live-search` = TRUE, title = "Select a sector", selected = NULL)),
pickerInput("subsector",
"Select subsector:",
choices = "",
options = list(`live-search` = TRUE, title = "Select a subsector", selected = NULL)),
radioButtons("calc_type",
label = "Calculation based on:",
choices = list("Expenditure", "Emp"),
selected = "Expenditure"),
numericInput("calc_value",
"Enter value:",
value = "1000000"),
actionButton("add_btn",
"Add Values"),
actionButton("delete_btn",
"Delete Values"),
actionButton("calculate_btn",
"CALCULATE")
),
# UI body
body = dashboardBody(
tabPanel(
"Model input and calculations",
fluidRow(tags$h5("Input selections:"),
actionButton("reset", "Clear All"),
DT::dataTableOutput("input_table")),
br(),
fluidRow(tags$h5("Sector or subsector table join multipliers that are used:"),
DT::dataTableOutput("multipliers_join")
),
br(),
fluidRow(tags$h5("Multiplier calculation output:"),
DT::dataTableOutput("calculation_output"))
)
)
)
server <- function(input, output, session) {
# Populating subsector drop-down after a sector is selected
observeEvent(
input$sector,
updatePickerInput(session, "subsector", "Select Subsector:",
choices = c("Unknown subsector", subsector_multipliers$subsector[subsector_multipliers$sector == input$sector]))
)
# Creating reactive shock table from user inputs
input_table <- reactiveVal(input_data)
observeEvent(input$add_btn, {
# req(input$sector, input$subsector, input$calc_type, input$calc_value)
t = rbind(input_table(), data.frame(sector = input$sector, subsector = input$subsector, calc_type = input$calc_type, calc_value = input$calc_value))
input_table(t)
})
observeEvent(input$delete_btn, {
t = input_table()
print(input$input_table_rows_selected)
if (!is.null(input$input_table_rows_selected)) {
t <- t[-input$input_table_rows_selected,]
}
input_table(t)
})
observeEvent(input$reset, {
input_table(input_data)
})
output$input_table <- DT::renderDataTable({
datatable(input_table(), selection = 'single', editable = F,
colnames = c("Sector", "Subsector", "Expenditure/Emp", "Value"),
options = list(paging = TRUE)) %>%
formatCurrency(columns = c(4), currency = "", interval = 3, mark = ",", digits = 0)
})
# Change input multiplier join tables based on subsector selection
# If subsector is "Unknown subsector" use the sector multiplier table
sector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
filter(input_table()[[2]] == "Unknown subsector") %>%
left_join(sector_multipliers)
})
# If subsector is selected use the subsector multiplier table
subsector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
filter(input_table()[[2]] != "Unknown subsector") %>%
left_join(subsector_multipliers)
})
# Bind shock multiplier tables for unknown and known subsectors
multipliers_join <- reactive({
bind_rows(sector_multipliers_join(), subsector_multipliers_join())
})
output$multipliers_join <- DT::renderDataTable(datatable(multipliers_join()))
# Calculations
calculation_output <- eventReactive(input$calculate_btn, {
req(input$sector, input$subsector, input$calc_type, input$calc_value)
multipliers_join() %>%
mutate(
expenditure_calc = if_else(input_table()[[3]] == "Expenditure", ((calc_value * expenditure) / expenditure),
((calc_value * expenditure) / emp))) %>%
mutate(
salary_calc = if_else(input_table()[[3]] == "Expenditure", ((calc_value * salary) / expenditure),
((calc_value * salary) / emp))) %>%
mutate(
emp_calc = if_else(input_table()[[3]] == "Expenditure", ((calc_value * emp) / expenditure),
((calc_value * emp) / emp)))
})
output$calculation_output <- DT::renderDataTable({
datatable(calculation_output())
})
} # End of server logic
# Run the application
shinyApp(ui = ui, server = server)
你有几个问题。
- 检查向量中的值时，应使用
%in% 而不是 ==
- 在
calculation_output 中，您正在尝试将来自不同 table 的向量与特定值进行比较，并将值分配给新变量。它可能不是相同的顺序。由于您在同一个 table 中有一个名为 calc_type 的列，您可以使用该列。
试试这个
server <- function(input, output, session) {
# Populating subsector drop-down after a sector is selected
observeEvent(
input$sector,
updatePickerInput(session, "subsector", "Select Subsector:",
choices = c("Unknown subsector", subsector_multipliers$subsector[subsector_multipliers$sector == input$sector]))
)
# Creating reactive shock table from user inputs
input_table <- reactiveVal(input_data)
observeEvent(input$add_btn, {
# req(input$sector, input$subsector, input$calc_type, input$calc_value)
t = rbind(input_table(), data.frame(sector = input$sector, subsector = input$subsector, calc_type = input$calc_type, calc_value = input$calc_value))
input_table(t)
})
observeEvent(input$delete_btn, {
t = input_table()
print(input$input_table_rows_selected)
if (!is.null(input$input_table_rows_selected)) {
t <- t[-input$input_table_rows_selected,]
}
input_table(t)
})
observeEvent(input$reset, {
input_table(input_data)
})
output$input_tabl <- DT::renderDataTable({
datatable(input_table(), selection = 'single', editable = F,
colnames = c("Sector", "Subsector", "Expenditure/Emp", "Value"),
options = list(paging = TRUE)) %>%
formatCurrency(columns = c(4), currency = "", interval = 3, mark = ",", digits = 0)
})
### Change input multiplier join tables based on subsector selection
### If subsector is "Unknown subsector" use the sector multiplier table
sector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
dplyr::filter(input_table()[[2]] %in% "Unknown subsector") %>%
#dplyr::filter(sum(input_table()[[2]] %in% "Unknown subsector")>0) %>%
left_join(sector_multipliers)
})
### If subsector is selected use the subsector multiplier table
subsector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
dplyr::filter(!input_table()[[2]] %in% "Unknown subsector") %>%
left_join(subsector_multipliers)
})
# Bind shock multiplier tables for unknown and known subsectors
multipliers_join <- reactive({
bind_rows(sector_multipliers_join(), subsector_multipliers_join())
})
output$multipliers_join <- DT::renderDataTable(datatable(multipliers_join()))
# Calculations
calculation_output <- eventReactive(input$calculate_btn, {
req(input$sector, input$subsector, input$calc_type, input$calc_value)
multipliers_join() %>%
dplyr::mutate(
expenditure_calc = ifelse(calc_type %in% "Expenditure", ((calc_value * expenditure) / expenditure),
((calc_value * expenditure) / emp))) %>%
dplyr::mutate(
salary_calc = ifelse(calc_type %in% "Expenditure", ((calc_value * salary) / expenditure),
((calc_value * salary) / emp))) %>%
dplyr::mutate(
emp_calc = ifelse(calc_type %in% "Expenditure", ((calc_value * emp) / expenditure),
((calc_value * emp) / emp)))
})
output$calculation_output <- DT::renderDataTable({
datatable(calculation_output())
})
} # End of server logic
下面 Shiny reprex 的反应环境中的一些计算已经困扰了我一段时间，我希望我能在这里找到解决方案。此应用从侧边栏面板获取四个用户输入，并根据两组乘数 table（在应用顶部创建）计算输出 table。对于这些输入的每组，将根据 sector/subsector 乘数 table 计算三个值 - expenditure_calc、salary_calc 和 emp_calc。对于给定的扇区输入（第一个下拉列表），如果从第二个下拉框中选择“未知子扇区”，则 sector_multiplier_table 用于计算。 And, when one of Subsector 1, Subsector 2... is chosen, the subsector_multiplier_table" is used.
例如，对于以下用户输入，Select扇区：扇区1； Select分部门：分部门1；计算依据：支出；价值：2,000,000，根据子行业乘数table得出的计算结果为：expenditure_calc = 2,000,000； salary_calc = 400,000; emp_calc = 10
在大多数情况下，计算似乎工作正常，但当我选择涉及“未知子部门”的 sectors/subsectors 组合时，它们给出了我无法理解的值。以下是导致计算错误的输入示例：
输入选择1：“Sector 1”，“Subsector 1”，“Expenditure”，1000000 输入选择2：“Sector 1”，“Unknown subsector”，“Emp”，24
感谢任何帮助。
library(tidyverse)
library(DT)
library(magrittr)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinydashboardPlus)
library(shinyWidgets)
# Sector multiplier table
sector <- c("Sector 1", "Sector 2", "Sector 3")
expenditure <- c(1000000, 1000000, 1000000)
salary <- c(250000, 500000, 160000)
emp <- c(5, 7, 9)
sector_multipliers <- data.frame(sector, expenditure, salary, emp)
# Subsector multiplier table
sector <- c("Sector 1", "Sector 1", "Sector 1", "Sector 1", "Sector 2", "Sector 2", "Sector 2", "Sector 3", "Sector 3")
subsector <- c("Subsector 1", "Subsector 2", "Subsector 3", "Subsector 4", "Subsector 1", "Subsector 2", "Subsector 3", "Subsector 1", "Subsector 2")
expenditure <- c(1000000, 1000000, 1000000, 1000000, 1000000, 1000000, 1000000, 1000000, 1000000)
salary <- c(200000, 250000, 300000, 400000, 425000, 280000, 600000, 170000, 150000)
emp <- c(5, 7, 9, 12, 9, 14, 18, 4, 5)
subsector_multipliers <- data.frame(sector, subsector, expenditure, salary, emp)
# Initialize empty data frame to store user input
input_data <- data.frame(sector = character(), subsector = character(), calc_type = character(), calc_value = double(), stringsAsFactors = FALSE)
# UI component
ui <- dashboardPage(
header = dashboardHeader(title = "Calculations", titleWidth = 450),
# UI sidebar panel
sidebar = dashboardSidebar(
minified = F,
width = 300,
pickerInput("sector",
"Select sector:",
choices = sector_multipliers$sector,
options = list(`live-search` = TRUE, title = "Select a sector", selected = NULL)),
pickerInput("subsector",
"Select subsector:",
choices = "",
options = list(`live-search` = TRUE, title = "Select a subsector", selected = NULL)),
radioButtons("calc_type",
label = "Calculation based on:",
choices = list("Expenditure", "Emp"),
selected = "Expenditure"),
numericInput("calc_value",
"Enter value:",
value = "1000000"),
actionButton("add_btn",
"Add Values"),
actionButton("delete_btn",
"Delete Values"),
actionButton("calculate_btn",
"CALCULATE")
),
# UI body
body = dashboardBody(
tabPanel(
"Model input and calculations",
fluidRow(tags$h5("Input selections:"),
actionButton("reset", "Clear All"),
DT::dataTableOutput("input_table")),
br(),
fluidRow(tags$h5("Sector or subsector table join multipliers that are used:"),
DT::dataTableOutput("multipliers_join")
),
br(),
fluidRow(tags$h5("Multiplier calculation output:"),
DT::dataTableOutput("calculation_output"))
)
)
)
server <- function(input, output, session) {
# Populating subsector drop-down after a sector is selected
observeEvent(
input$sector,
updatePickerInput(session, "subsector", "Select Subsector:",
choices = c("Unknown subsector", subsector_multipliers$subsector[subsector_multipliers$sector == input$sector]))
)
# Creating reactive shock table from user inputs
input_table <- reactiveVal(input_data)
observeEvent(input$add_btn, {
# req(input$sector, input$subsector, input$calc_type, input$calc_value)
t = rbind(input_table(), data.frame(sector = input$sector, subsector = input$subsector, calc_type = input$calc_type, calc_value = input$calc_value))
input_table(t)
})
observeEvent(input$delete_btn, {
t = input_table()
print(input$input_table_rows_selected)
if (!is.null(input$input_table_rows_selected)) {
t <- t[-input$input_table_rows_selected,]
}
input_table(t)
})
observeEvent(input$reset, {
input_table(input_data)
})
output$input_table <- DT::renderDataTable({
datatable(input_table(), selection = 'single', editable = F,
colnames = c("Sector", "Subsector", "Expenditure/Emp", "Value"),
options = list(paging = TRUE)) %>%
formatCurrency(columns = c(4), currency = "", interval = 3, mark = ",", digits = 0)
})
# Change input multiplier join tables based on subsector selection
# If subsector is "Unknown subsector" use the sector multiplier table
sector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
filter(input_table()[[2]] == "Unknown subsector") %>%
left_join(sector_multipliers)
})
# If subsector is selected use the subsector multiplier table
subsector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
filter(input_table()[[2]] != "Unknown subsector") %>%
left_join(subsector_multipliers)
})
# Bind shock multiplier tables for unknown and known subsectors
multipliers_join <- reactive({
bind_rows(sector_multipliers_join(), subsector_multipliers_join())
})
output$multipliers_join <- DT::renderDataTable(datatable(multipliers_join()))
# Calculations
calculation_output <- eventReactive(input$calculate_btn, {
req(input$sector, input$subsector, input$calc_type, input$calc_value)
multipliers_join() %>%
mutate(
expenditure_calc = if_else(input_table()[[3]] == "Expenditure", ((calc_value * expenditure) / expenditure),
((calc_value * expenditure) / emp))) %>%
mutate(
salary_calc = if_else(input_table()[[3]] == "Expenditure", ((calc_value * salary) / expenditure),
((calc_value * salary) / emp))) %>%
mutate(
emp_calc = if_else(input_table()[[3]] == "Expenditure", ((calc_value * emp) / expenditure),
((calc_value * emp) / emp)))
})
output$calculation_output <- DT::renderDataTable({
datatable(calculation_output())
})
} # End of server logic
# Run the application
shinyApp(ui = ui, server = server)
你有几个问题。
- 检查向量中的值时，应使用
%in%而不是== - 在
calculation_output中，您正在尝试将来自不同 table 的向量与特定值进行比较，并将值分配给新变量。它可能不是相同的顺序。由于您在同一个 table 中有一个名为calc_type的列，您可以使用该列。
试试这个
server <- function(input, output, session) {
# Populating subsector drop-down after a sector is selected
observeEvent(
input$sector,
updatePickerInput(session, "subsector", "Select Subsector:",
choices = c("Unknown subsector", subsector_multipliers$subsector[subsector_multipliers$sector == input$sector]))
)
# Creating reactive shock table from user inputs
input_table <- reactiveVal(input_data)
observeEvent(input$add_btn, {
# req(input$sector, input$subsector, input$calc_type, input$calc_value)
t = rbind(input_table(), data.frame(sector = input$sector, subsector = input$subsector, calc_type = input$calc_type, calc_value = input$calc_value))
input_table(t)
})
observeEvent(input$delete_btn, {
t = input_table()
print(input$input_table_rows_selected)
if (!is.null(input$input_table_rows_selected)) {
t <- t[-input$input_table_rows_selected,]
}
input_table(t)
})
observeEvent(input$reset, {
input_table(input_data)
})
output$input_tabl <- DT::renderDataTable({
datatable(input_table(), selection = 'single', editable = F,
colnames = c("Sector", "Subsector", "Expenditure/Emp", "Value"),
options = list(paging = TRUE)) %>%
formatCurrency(columns = c(4), currency = "", interval = 3, mark = ",", digits = 0)
})
### Change input multiplier join tables based on subsector selection
### If subsector is "Unknown subsector" use the sector multiplier table
sector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
dplyr::filter(input_table()[[2]] %in% "Unknown subsector") %>%
#dplyr::filter(sum(input_table()[[2]] %in% "Unknown subsector")>0) %>%
left_join(sector_multipliers)
})
### If subsector is selected use the subsector multiplier table
subsector_multipliers_join <- eventReactive(input$calculate_btn, {
input_table() %>%
dplyr::filter(!input_table()[[2]] %in% "Unknown subsector") %>%
left_join(subsector_multipliers)
})
# Bind shock multiplier tables for unknown and known subsectors
multipliers_join <- reactive({
bind_rows(sector_multipliers_join(), subsector_multipliers_join())
})
output$multipliers_join <- DT::renderDataTable(datatable(multipliers_join()))
# Calculations
calculation_output <- eventReactive(input$calculate_btn, {
req(input$sector, input$subsector, input$calc_type, input$calc_value)
multipliers_join() %>%
dplyr::mutate(
expenditure_calc = ifelse(calc_type %in% "Expenditure", ((calc_value * expenditure) / expenditure),
((calc_value * expenditure) / emp))) %>%
dplyr::mutate(
salary_calc = ifelse(calc_type %in% "Expenditure", ((calc_value * salary) / expenditure),
((calc_value * salary) / emp))) %>%
dplyr::mutate(
emp_calc = ifelse(calc_type %in% "Expenditure", ((calc_value * emp) / expenditure),
((calc_value * emp) / emp)))
})
output$calculation_output <- DT::renderDataTable({
datatable(calculation_output())
})
} # End of server logic