I have an app that looks like this when p-values is not selected:
And when p-values is selected, the y-axis is expanded so that the asterisks don't get cut off:
The line of code for this is:
{if(input$p_values) expand_limits(y= c(0, new_est_y *1.05))} +
but I want to include the condition that the y-axis only be extended if the tallest bar requires asterisks above it, i.e. if !is.na(Sig) for max(new_est), for that specific category. Is there a way in Shiny to convey: if(input$p_values) AND if(!is.na(Sig_y)) AND if(new_est_y ==max(new_est_y) then expand_limits?
For example. In Number of Enterprises, the tallest bar is Lump Sum, and if Sig were NA, I would not want the y-axis to be extended:
My code is:
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-values", value = FALSE),
actionButton("Explain_p_values", "Explain p-values")),
mainPanel(plotOutput('plot_overall'))
))
server <- function(input, output, session) {
observeEvent(input$Explain_p_values, {showModal(modalDialog(p_value_text))})
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) expand_limits(y= c(0, new_est_y *1.05))} +
{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(table_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))
You can replace your current condition with
if (input$p_values & table_2 |>
filter(new_est == max(new_est)) |>
ungroup() |>
select(Sig) |>
(\(.) all(!is.na(.)))()
)
It additionally checks that for the relevant variable (your table is already filtered at this point), Sig
is not NA
at the maximum of new_est
.
Also notice that this relies on the fact that your table is already grouped, which I assumed since this is the case in your given example. If it is not, you can delete the ungroup()
.