首页 / 技术问答 / R问答列表 / 问答详情

R 根据选中三个复选框中的一个或两个来调整绘图

我有这个apply.

enter image description here

Individually checking "Show p-value levels" or "Show 95% confidence levels" works fine. However, when both are checked, I need the asterisks to be positioned above the error bars. At the moment, when both are checked, it looks like this:enter image description here

有没有一种方法可以写:如果输入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(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))

推荐答案

作为第一步，我建议重构您的绘图代码，并将条件层的所有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)

enter image description here

R相关问答推荐

使用R的序列覆盖

抖动点与嵌套类别变量箱形图的位置不对齐

R中的子集文件—读取文件名索引为4位数字序列，例如0001到4000，而不是1到4000)

使用sf或terra的LINESTRAING的累积长度

提取第一个下划线和最后一个下划线之间的任何内容，例外情况除外

R中的时间序列(Ts)函数计数不正确

以更少间隔的较小表中的聚合离散频率表

如何提取所有完美匹配的10个核苷酸在一个成对的匹配与生物字符串在R？>

R：从geom_ol()中删除轮廓并导出为pdf

展开对数比例绘图的轴(添加填充)

如何使这些react 表对象相互独立？

将具有坐标列表列的三角形转换为多个多边形

如何在PrePlot()中将多个元素设置为斜体

删除数据帧中特定行号之间的每第三行和第四行

仅当后续值与特定值匹配时，才在列中回填Nas

计算Mean by分组和绑定到R中的数据集

如何构建一个for循环来循环处理动物ID？

自定义交互作用图的标签

如何创建直方图与对齐的每月箱？

如何在一个GGPLATE中绘制多个灰度平滑？

实用课程推荐
相关教程推荐
休闲君评测 |  TOOLFK工具网 |  古诗文网 |  良许Linux教程网 |  Python之禅 |  红色石头 |  入党申请书 | 

© 2020 Hi LearnFk 意见反馈 免责声明 关于我们 桂ICP备11002319号-3 友链&广告位+QQ: 1963612630