单独检查“显示 p 值水平”或“显示 95% 置信水平”效果很好。但是,当两者都被选中时,我需要将星号放置在误差线上方。目前,当两者都检查时,它看起来像这样:
我仍在学习 Shiny 以及输入和 if 语句如何工作。有没有一种方法可以写:如果输入 A 被检查但没有输入 B 则执行此操作;如果检查了输入 B 但未检查 A,则执行此操作;如果两者都检查然后执行此操作? (无论是否检查输入 C,所有这些选项都应该发生。)
我的代码:
cbPalette <- c("#E69F00", "#56B4E9", "#009E73") #color-blind friendly palette or "#CC79A7"?
fun_select_cat <- function(table, cat) {
table %>%
filter(variable == cat)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(selectInput('cat','Select Category', c('Number of Enterprises','Assets','Costs','Net Revenues','Revenues')),
checkboxInput("control_mean",label = "Show average for non-recipients", value = FALSE),
checkboxInput("p_values",label = "Show p-value levels", value = FALSE),
checkboxInput("error_bars",label = "Show 95% confidence intervals", value = FALSE), ),
mainPanel(plotOutput('plot_overall'))
))
server <- function(input, output, session) {
output$plot_overall <- renderPlot({
control_y = fun_select_cat(table_2, input$cat) %>% pull(Control)
Sig_height_y = fun_select_cat(table_2, input$cat) %>% pull(Sig_height)
Sig_y = fun_select_cat(table_2, input$cat) %>% pull(Sig)
new_est_y = fun_select_cat(table_2, input$cat) %>% pull(new_est)
fun_select_cat(table_2, input$cat) %>%
ggplot(aes(x = Treatment, y = new_est, fill = Treatment)) +
geom_col() + scale_fill_manual(values = cbPalette) +
guides(fill = FALSE) +
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)) +
{if(input$p_values) geom_text(aes(label = Sig_y), y = Sig_height_y)} +
{if(input$p_values & table_2 |>
filter(new_est == max(new_est)) |>
ungroup() |>
select(Sig) |>
(\(.) all(!is.na(.)))()) expand_limits(y= c(0, new_est_y *1.05))} +
{if(input$error_bars) geom_errorbar(aes(ymin= lower, ymax=higher), width= 0.25)} +
{if(input$control_mean) annotate("text", x = 3.6, y = 1.078 * control_y,
label = "Control\nmean",
colour = "#CC79A7",
fontface =2,
size = 4.5)} +
{if(input$control_mean)expand_limits(x= c(1, length(levels(table_2$Treatment)) + 0.75))} +
{if(input$control_mean) geom_hline(aes(yintercept = Control), linetype='dashed', col = '#CC79A7', size = 1.5)} +
if(input$cat %in% c("Number of Enterprises", "Assets")
) {labs(title= input$cat, x = NULL, y = NULL)
} else{labs(title = paste(input$cat, "(USD) for the last 30 days", sep =" "), x = NULL, y = NULL)}
})
}
shinyApp(ui = ui, server = server)
dput(表_2)
structure(list(Treatment = structure(c(1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L), levels = c("Long Term",
"Short Term", "Lump Sum"), class = "factor"), variable = c("Number of Enterprises",
"Assets", "Costs", "Net Revenues", "Revenues", "Number of Enterprises",
"Assets", "Costs", "Net Revenues", "Revenues", "Number of Enterprises",
"Assets", "Costs", "Net Revenues", "Revenues"), Control = c(73.23,
100036.59, 92636.84, 54533.59, 150207.24, 73.23, 100036.59, 92636.84,
54533.59, 150207.24, 73.23, 100036.59, 92636.84, 54533.59, 150207.24
), Estimate = c(9.93, 36050.66, 32055.29, 28226.05, 61379.4,
14.67, 29404.54, 71903.23, 35576.39, 107746.75, 3.39, 16441.81,
8497.42, 14824.71, 23177.47), SE = c(3.96, 12589.11, 16478.13,
12334.27, 24346.05, 3.92, 10977.68, 24360.84, 13382.81, 34895.03,
3.57, 10029.27, 10462.44, 8143.69, 16080.92), Sig = c("�\u0088\u0097�\u0088\u0097",
"�\u0088\u0097�\u0088\u0097�\u0088\u0097", "�\u0088\u0097", "�\u0088\u0097�\u0088\u0097",
"�\u0088\u0097�\u0088\u0097", "�\u0088\u0097�\u0088\u0097�\u0088\u0097",
"�\u0088\u0097�\u0088\u0097�\u0088\u0097", "�\u0088\u0097�\u0088\u0097�\u0088\u0097",
"�\u0088\u0097�\u0088\u0097�\u0088\u0097", "�\u0088\u0097�\u0088\u0097�\u0088\u0097",
NA, NA, NA, "�\u0088\u0097", NA), new_est = c(83.16, 136087.25,
124692.13, 82759.64, 211586.64, 87.9, 129441.13, 164540.07, 90109.98,
257953.99, 76.62, 116478.4, 101134.26, 69358.3, 173384.71), lower = c(75.3984,
111412.5944, 92394.9952, 58584.4708, 163868.382, 80.2168, 107924.8772,
116792.8236, 63879.6724, 189559.7312, 69.6228, 96821.0308, 80627.8776,
53396.6676, 141866.1068), higher = c(90.9216, 160761.9056, 156989.2648,
106934.8092, 259304.898, 95.5832, 150957.3828, 212287.3164, 116340.2876,
326348.2488, 83.6172, 136135.7692, 121640.6424, 85319.9324, 204903.3132
), Sig_height = c(87.318, 142891.6125, 130926.7365, 86897.622,
222165.972, 92.295, 135913.1865, 172767.0735, 94615.479, 270851.6895,
80.451, 122302.32, 106190.973, 72826.215, 182053.9455)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -15L), groups = structure(list(
variable = c("Assets", "Costs", "Net Revenues", "Number of Enterprises",
"Revenues"), .rows = structure(list(c(2L, 7L, 12L), c(3L,
8L, 13L), c(4L, 9L, 14L), c(1L, 6L, 11L), c(5L, 10L, 15L)), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -5L), .drop = TRUE))
作为第一步,我建议重构您的绘图代码,并将条件层的所有
if
条件移至 ggplot
“管道”之外。这样可以更轻松地指定您的条件并添加附加条件。
library(shiny)
library(ggplot2)
library(scales)
library(dplyr, warn = FALSE)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("cat", "Select Category", c("Number of Enterprises", "Assets", "Costs", "Net Revenues", "Revenues")),
checkboxInput("control_mean", label = "Show average for non-recipients", value = FALSE),
checkboxInput("p_values", label = "Show p-value levels", value = FALSE),
checkboxInput("error_bars", label = "Show 95% confidence intervals", value = FALSE),
),
mainPanel(plotOutput("plot_overall"))
)
)
server <- function(input, output, session) {
output$plot_overall <- renderPlot({
table_2_filtered <- fun_select_cat(table_2, input$cat) |>
ungroup()
control_y <- table_2_filtered %>% pull(Control) |> unique()
title <- if (input$cat %in% c("Number of Enterprises", "Assets")) {
input$cat
} else {
paste(input$cat, "(USD) for the last 30 days", sep = " ")
}
layer_error <- if (input$error_bars) {
geom_errorbar(aes(ymin = lower, ymax = higher), width = 0.25)
}
layer_p <- if (input$p_values) {
column_y_text <- if (input$error_bars) {
"higher"
} else {
"new_est"
}
max_y_text <- table_2_filtered |>
filter(!is.na(Sig)) |>
pull(column_y_text) |>
max()
list(
geom_text(aes(label = Sig, y = 1.05 * .data[[column_y_text]]), na.rm = TRUE),
if (!is.na(max_y_text)) expand_limits(y = c(0, max_y_text * 1.05))
)
}
layer_control <- if (input$control_mean) {
list(
annotate("label",
x = 3.6, y = control_y,
label = "Control\nmean",
colour = "#CC79A7",
fontface = 2,
size = 4.5,
label.size = 0,
fill = NA,
vjust = 0
),
geom_hline(aes(yintercept = Control), linetype = "dashed", col = "#CC79A7", size = 1.5),
expand_limits(x = c(1, nlevels(table_2$Treatment) + 0.75))
)
}
table_2_filtered |>
ggplot(aes(x = Treatment, y = new_est, fill = Treatment)) +
geom_col() +
scale_fill_manual(values = cbPalette) +
guides(fill = FALSE) +
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)
) +
layer_p +
layer_error +
layer_control +
labs(title = title, x = NULL, y = NULL)
})
}
shinyApp(ui = ui, server = server)