You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

ggplot2中geom_point条件填充匹配错误问题求助

问题与解决方案

问题描述

我想要给p.fdr < 0.05的模型点设置白色填充,但当前代码未正确生效——本该是蓝色的Model 1点显示白色填充,结果却是粉色的Model 2点错误显示了白色填充。我试过对数据框执行排序操作:forestplot <- forestplot %>% arrange(measure, outcome, a_model, estimate, conf.low, conf.high),但问题依旧。

示例代码如下:

conf.low <- sort(runif(6, min = 0, max = 1))
conf.high <- sort(runif(6, min = conf.low[1], max = 1))
estimate <- (conf.low + conf.high) / 2

forestplot <- data.frame(
outcome = c("mean_ssrt_0","mean_ssrt_0", "strp_scr_mnrt_congr", "strp_scr_mnrt_congr", "nihtbx_picvocab_theta_0","nihtbx_picvocab_theta_0"),
measure = c("Stop-Signal Task", "Stop-Signal Task","Emotional Word-Emotional Face Stroop", "Emotional Word-Emotional Face Stroop","NIH Toolbox® Cognition Battery", "NIH Toolbox® Cognition Battery" ),
a_model = c("1", "2", "1", "2", "1", "2"),
  conf.low = conf.low,
  conf.high = conf.high,
  estimate = estimate,
  p.fdr = runif(6, min = 0.05 / 1.3, max = 0.1))


forestplot$outcome <- factor(forestplot$outcome, levels=c('mean_ssrt_0', 'strp_scr_mnrt_congr', 'nihtbx_picvocab_theta_0'), 
                                                      labels=c("Mean SSRT", "RT", "PVT \n (Theta)"))
forestplot$measure <- factor(forestplot$measure, levels=c('Stop-Signal Task',
                                                              'Emotional Word-Emotional Face Stroop',
                                                              'NIH Toolbox® Cognition Battery'))
forestplot$a_model <- factor(forestplot$a_model , levels=c("1","2"))  
forestplot <- forestplot %>% arrange(measure, outcome,a_model, estimate, conf.low, conf.high)


plots <- forestplot %>% 
      split(.$measure) %>% 
      map2(.,names(.), ~ggplot(.x, aes(x = outcome, y =estimate, ymin =conf.low, ymax = conf.high,fill = as.factor(measure))) +
            geom_pointrange(aes(color=a_model, shape = a_model), size=0.5, position=position_dodge2(width=0.5, reverse = TRUE), show.legend = F)+ # add group
            geom_point(aes(shape = a_model), size=1.5, alpha = ifelse(.x$p.fdr < 0.05, 1, 0), position=position_dodge2(width=0.5, reverse = TRUE), show.legend = F, color="white") +
            geom_hline(yintercept = 0, linetype = 'dashed', col = 'black') +
            scale_y_continuous(limits = c(-0.1, 1))+
            coord_flip() +
            xlab('')+ 
            ylab(expression(atop("Est. mean change (in SD units with 95% CI)", paste("per 1 SD increase in gPFS"^"lowDA"))))+
            ggtitle(.y)+
            theme_minimal(base_size = 11)+ 
            guides(fill = "none")  +
            scale_color_manual(labels = c("Model 1", "Model 2"), values = c("#00B8E7", "#F8766D")) +
            labs(color="Model")+
            theme(panel.grid.major = element_blank(),
                   panel.grid.minor = element_blank(),
                   plot.title.position = "plot",
                   plot.title = element_text(size = 10,face="bold"), text = element_text(size = 10)))

    plot <-plot_grid(plots$`Stop-Signal Task`+  ggtitle(bquote(bold(~ "Stop-Signal Task" ~ '')))+ theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.line.y = element_line(color="black", size = 0.5)), 
                      plots$`Emotional Word-Emotional Face Stroop` +  ggtitle(bquote(bold(~ 'Stroop - EWEFS' ~ ''))) + theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.line.y = element_line(color="black", size = 0.5)),
                     plots$`NIH Toolbox® Cognition Battery` +  ggtitle(bquote(bold(~ "NIH Toolbox\U00AE" ~ ''))) + theme(legend.position = "none", axis.ticks.x = element_line(color="black", size = 0.5), axis.line.x = element_line(color="black", size = 0.5),axis.line.y = element_line(color="black", size = 0.5)),  
                      ncol = 1, nrow=3, rel_heights = c(1,1,1), align = 'v') # add 1 col and then the number of rows = to number of plots
  plot

解决方案

问题根源是白色点的geom_point层没有针对Model 1做筛选,且位置匹配逻辑出错。修改方式如下:

  • 在添加白色填充点的geom_point中,通过data参数明确筛选出p.fdr < 0.05且a_model == "1"的行,确保只给符合条件的Model 1点加白色填充。
  • 保持position_dodge2的参数和主点层完全一致,避免位置偏移。

修改后的完整代码:

conf.low <- sort(runif(6, min = 0, max = 1))
conf.high <- sort(runif(6, min = conf.low[1], max = 1))
estimate <- (conf.low + conf.high) / 2

forestplot <- data.frame(
outcome = c("mean_ssrt_0","mean_ssrt_0", "strp_scr_mnrt_congr", "strp_scr_mnrt_congr", "nihtbx_picvocab_theta_0","nihtbx_picvocab_theta_0"),
measure = c("Stop-Signal Task", "Stop-Signal Task","Emotional Word-Emotional Face Stroop", "Emotional Word-Emotional Face Stroop","NIH Toolbox® Cognition Battery", "NIH Toolbox® Cognition Battery" ),
a_model = c("1", "2", "1", "2", "1", "2"),
  conf.low = conf.low,
  conf.high = conf.high,
  estimate = estimate,
  p.fdr = runif(6, min = 0.05 / 1.3, max = 0.1))


forestplot$outcome <- factor(forestplot$outcome, levels=c('mean_ssrt_0', 'strp_scr_mnrt_congr', 'nihtbx_picvocab_theta_0'), 
                                                      labels=c("Mean SSRT", "RT", "PVT \n (Theta)"))
forestplot$measure <- factor(forestplot$measure, levels=c('Stop-Signal Task',
                                                              'Emotional Word-Emotional Face Stroop',
                                                              'NIH Toolbox® Cognition Battery'))
forestplot$a_model <- factor(forestplot$a_model , levels=c("1","2"))  
forestplot <- forestplot %>% arrange(measure, outcome,a_model, estimate, conf.low, conf.high)


plots <- forestplot %>% 
      split(.$measure) %>% 
      map2(.,names(.), ~ggplot(.x, aes(x = outcome, y =estimate, ymin =conf.low, ymax = conf.high,fill = as.factor(measure))) +
            geom_pointrange(aes(color=a_model, shape = a_model), size=0.5, position=position_dodge2(width=0.5, reverse = TRUE), show.legend = F)+ # add group
            # 修改这里:筛选Model1且p.fdr<0.05的行来绘制白色点
            geom_point(data = .x %>% filter(a_model == "1" & p.fdr < 0.05), 
                       aes(shape = a_model), size=1.5, 
                       position=position_dodge2(width=0.5, reverse = TRUE), 
                       show.legend = F, color="white") +
            geom_hline(yintercept = 0, linetype = 'dashed', col = 'black') +
            scale_y_continuous(limits = c(-0.1, 1))+
            coord_flip() +
            xlab('')+ 
            ylab(expression(atop("Est. mean change (in SD units with 95% CI)", paste("per 1 SD increase in gPFS"^"lowDA"))))+
            ggtitle(.y)+
            theme_minimal(base_size = 11)+ 
            guides(fill = "none")  +
            scale_color_manual(labels = c("Model 1", "Model 2"), values = c("#00B8E7", "#F8766D")) +
            labs(color="Model")+
            theme(panel.grid.major = element_blank(),
                   panel.grid.minor = element_blank(),
                   plot.title.position = "plot",
                   plot.title = element_text(size = 10,face="bold"), text = element_text(size = 10)))

    plot <-plot_grid(plots$`Stop-Signal Task`+  ggtitle(bquote(bold(~ "Stop-Signal Task" ~ '')))+ theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.line.y = element_line(color="black", size = 0.5)), 
                      plots$`Emotional Word-Emotional Face Stroop` +  ggtitle(bquote(bold(~ 'Stroop - EWEFS' ~ ''))) + theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.line.y = element_line(color="black", size = 0.5)),
                     plots$`NIH Toolbox® Cognition Battery` +  ggtitle(bquote(bold(~ "NIH Toolbox\U00AE" ~ ''))) + theme(legend.position = "none", axis.ticks.x = element_line(color="black", size = 0.5), axis.line.x = element_line(color="black", size = 0.5),axis.line.y = element_line(color="black", size = 0.5)),  
                      ncol = 1, nrow=3, rel_heights = c(1,1,1), align = 'v') # add 1 col and then the number of rows = to number of plots
  plot

内容的提问来源于stack exchange,提问作者Katherine Drummond

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.01 13:20:28