我希望用户能够显示一个或多个类别的控制手段,并为线显示为水平线(s)对应于相同类别 colored颜色 的条(s)跨越图.类似这样的东西(在Paint中粗略编辑):
因为我希望用户可以 Select 多行,所以我try 第一次使用pickerInput.输入部分看起来像是在工作.但是,我怎么加上
geom_hline(aes(yintercept = Control), linetype = "dashed", size = 1.5)
图中的 colored颜色 应与条形图相同,并且仅在 Select 器菜单中选中时才显示?
我的代码是:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('cat','Select Category', unique(table_E.9_9$Ent_or_Rev)),
pickerInput(
inputId = "controls",
label = "Show average of non-recipients",
choices = unique(table_E.9_9$variable),
multiple = TRUE,
selected = "Retail Trade"
),
checkboxInput("p_values",label = "Show p-value levels", value = FALSE),
checkboxInput("error_bars",label = "Show 95% confidence intervals", value = FALSE),
actionButton("Explain_p_values", "Explain p-values"),
actionButton("Explain_error_bars", "Explain 95% confidence intervals")
),
mainPanel(plotOutput('plot_overall'))
)
)
server <- function(input, output, session) {
observeEvent(input$Explain_p_values, {showModal(modalDialog(p_value_text))})
observeEvent(input$Explain_error_bars, {showModal(modalDialog(CI_text))})
output$plot_overall <- renderPlot({
cbPalette_4 <- c("#999999", "#F0E442", "#0072B2", "#D55E00")
fun_select_cat <- function(table, cat) {
table %>%
filter(Ent_or_Rev == cat)
}
table_E.9_9_filtered <- fun_select_cat(table_E.9_9, input$cat) |>
ungroup()
control_y <- table_E.9_9_filtered %>% pull(Control) |> unique()
title <- if (input$cat == "Number of Enterprises") {
input$cat
} else {
paste(input$cat, "(USD)", sep = " ")
}
layer_error <- if (input$error_bars) {
geom_errorbar(aes(ymin = lower, ymax = higher), width = 0.25, position = position_dodge(width = 0.9))
}
layer_p <- if (input$p_values) {
column_y_text <- if (input$error_bars) {
"higher" #if p-values and error_bars checked then add stars at higher CI otherwise at the obs
} else {
"new_est"
}
max_y_text <- table_E.9_9_filtered |> # if asterisks column not NA then either put asterisks higher than error bars if error_bar checked
filter(!is.na(Sig)) |> # or put it at bar height if not checked
pull(column_y_text) |> # keep the height of tallest bar
max()
list(
geom_text(aes(label = Sig, y = 1.05 * .data[[column_y_text]], group=variable), position = position_dodge(width = 0.9), na.rm = TRUE), # asterisks go just above either bar or obs
if (!is.na(max_y_text)) expand_limits(y = c(0, max_y_text * 1.05)) # if tallest bar has asterisk then expand limit
)
}
table_E.9_9_filtered |>
ggplot(aes(x = Treatment, y = new_est, fill = variable)) +
geom_col(position = position_dodge(width = 0.9)) +
scale_fill_manual(values = cbPalette_4) +
scale_y_continuous(labels = label_comma(), expand = c(0, 0)) +
theme_classic() +
scale_x_discrete(drop = FALSE) +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.text = element_text(size = 12),
legend.title = element_blank(),
legend.text = element_text(size = 12)
) +
layer_p +
layer_error +
labs(title = title, x = NULL, y = NULL)
})
}
shinyApp(ui = ui, server = server)
dput(table_E.9_9)
:
structure(list(Treatment = structure(c(1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L), levels = c("Long Term", "Short Term", "Lump Sum"), class = "factor"),
variable = c("Manufacturing", "Manufacturing", "Retail Trade",
"Retail Trade", "Services", "Services", "Transportation",
"Transportation", "Manufacturing", "Manufacturing", "Retail Trade",
"Retail Trade", "Services", "Services", "Transportation",
"Transportation", "Manufacturing", "Manufacturing", "Retail Trade",
"Retail Trade", "Services", "Services", "Transportation",
"Transportation"), Control = c(0.89, 185.99, 11.05, 1356.55,
1.56, 233.14, 0.94, 136.04, 0.89, 185.99, 11.05, 1356.55,
1.56, 233.14, 0.94, 136.04, 0.89, 185.99, 11.05, 1356.55,
1.56, 233.14, 0.94, 136.04), Estimate = c(0.02, 51.9, 3.89,
1601.42, 0.23, 198.64, 0.53, 100.76, 0.28, 254.11, 4.24,
770.01, 0.45, 718.68, 0.38, 101, 0.03, 17.82, 2.34, 464.6,
-0.04, 70.95, -0.12, -3.85), SE = c(0.27, 120.79, 1.28, 824.74,
0.33, 205.6, 0.29, 85.37, 0.23, 221.06, 1.03, 338.12, 0.38,
440.08, 0.29, 61.26, 0.21, 133.58, 0.95, 273.59, 0.29, 218.2,
0.18, 48.33), Sig = c(NA, NA, "∗∗∗", "∗", NA, NA,
"∗", NA, NA, NA, "∗∗∗", "∗∗", NA, NA, NA, NA,
NA, NA, "∗∗", "∗", NA, NA, NA, NA), Ent_or_Rev = c("Number of Enterprises",
"Net Revenues", "Number of Enterprises", "Net Revenues",
"Number of Enterprises", "Net Revenues", "Number of Enterprises",
"Net Revenues", "Number of Enterprises", "Net Revenues",
"Number of Enterprises", "Net Revenues", "Number of Enterprises",
"Net Revenues", "Number of Enterprises", "Net Revenues",
"Number of Enterprises", "Net Revenues", "Number of Enterprises",
"Net Revenues", "Number of Enterprises", "Net Revenues",
"Number of Enterprises", "Net Revenues"), new_est = c(0.91,
237.89, 14.94, 2957.97, 1.79, 431.78, 1.47, 236.8, 1.17,
440.1, 15.29, 2126.56, 2.01, 951.82, 1.32, 237.04, 0.92,
203.81, 13.39, 1821.15, 1.52, 304.09, 0.82, 132.19), lower = c(0.3808,
1.14160000000001, 12.4312, 1341.4796, 1.1432, 28.804, 0.9016,
69.4748, 0.7192, 6.82240000000002, 13.2712, 1463.8448, 1.2652,
89.2632, 0.7516, 116.9704, 0.5084, -58.0068, 11.528, 1284.9136,
0.9516, -123.582, 0.4672, 37.4632), higher = c(1.4392, 474.6384,
17.4488, 4574.4604, 2.4368, 834.756, 2.0384, 404.1252, 1.6208,
873.3776, 17.3088, 2789.2752, 2.7548, 1814.3768, 1.8884,
357.1096, 1.3316, 465.6268, 15.252, 2357.3864, 2.0884, 731.762,
1.1728, 226.9168)), class = c("grouped_df", "tbl_df", "tbl",
"data.frame"), row.names = c(NA, -24L), groups = structure(list(
Ent_or_Rev = c("Net Revenues", "Net Revenues", "Net Revenues",
"Net Revenues", "Number of Enterprises", "Number of Enterprises",
"Number of Enterprises", "Number of Enterprises"), variable = c("Manufacturing",
"Retail Trade", "Services", "Transportation", "Manufacturing",
"Retail Trade", "Services", "Transportation"), .rows = structure(list(
c(2L, 10L, 18L), c(4L, 12L, 20L), c(6L, 14L, 22L), c(8L,
16L, 24L), c(1L, 9L, 17L), c(3L, 11L, 19L), c(5L, 13L,
21L), c(7L, 15L, 23L)), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = c(NA, -8L), .drop = TRUE, class = c("tbl_df",
"tbl", "data.frame")))