如何用不同的水平线注释 ggplot2 中的每个条？

Question

我绘制了一系列代表比例置信区间模拟的条形图。我想在每个条中添加一条线，表示成功的比例。

我要绘制的比例在绘图的数据框中。我还没有弄清楚如何在每个单独的条内为该数据点添加线元素。

可视化来自 Harvey Matulsky 的 Intuitive Biostatistics 第 36 页。这是从给定的样本空间中抽取样本，记录成功的比例，并计算置信区间的模拟。

我使用 geom_segment 绘制了条形图，因此我可以使条形图从置信区间的下端开始，而不是从 x 轴开始绘制它们。我在整个图表中添加了一条水平线，显示了样本空间中成功的真实比例（红球和白球集合中的红球）。

我尝试使用 geom_hline 和 geom_segment 映射到数据点 trial_df$proportion 来做一些事情。我无法走上正轨。

这是我的整个可视化的代码。它被分解成一些函数，然后整个模拟运行，打印绘图的数据框，然后运行我到目前为止的绘图（每个条上缺少比例线）。

    library(ggplot2)

    run_trials <- function(sample_space, N) {
            sample(sample_space,
                   size = N,
                   replace = TRUE)
    }

    success_count <- function(trials, success_value) {
            result <- sum(trials == success_value)
            result
    }

    proportion <- function(trials, success_value) {
            success_count(trials, success_value) / length(trials)
    }

    wald_mod <- function(success_count, trial_count) {
            z <- 1.96
            p_prime <- (success_count + (0.5 * z^2)) / (trial_count + z^2)
            W <- z * sqrt((p_prime * (1 - p_prime)) / (trial_count + z^2))
            result <- c((p_prime - W), (p_prime + W))
            result
    }

    get_trial_results <- function(trials, success_value) {
            p <- proportion(trials, success_value)
            successes <- success_count(trials, success_value)
            confidence_interval <- wald_mod(successes, length(trials))

            result <- list(p, confidence_interval)
            result
    }

    run_simulation <- function() {
            sample_space <- c(rep('Red', 25), rep('White', 75))
            N <- 15

            trials_df <- data.frame(trials_index = integer(),
                                    proportion = double(),
                                    ci_min = double(),
                                    ci_max = double())

            for (i in 1:20) {
                    t <- run_trials(sample_space, N)
                    t_results <- get_trial_results(t, "Red")
                    trials_df <- rbind(trials_df, c(i, t_results[[1]][1], t_results[[2]][1], t_results[[2]][2]))
            }
            names(trials_df) <- c("trials_index", "proportion", "ci_min", "ci_max")

            print(trials_df)

            ggplot(trials_df, aes(trials_index, ci_max)) +
                    geom_segment(aes(xend = trials_index, yend = ci_min), size = 4, lineend = "butt",
                                 color = "turquoise4") +
                    geom_abline(slope = 0, intercept = proportion(sample_space, "Red"), linetype = "dashed")
    }

    run_simulation()

我在我的代码中添加了@Simon 的解决方案并改进了我的情节的标签。开发这个小模拟帮助我理解了置信区间。

    library(ggplot2)

    run_experiment <- function(sample_space, N) {
            sample(sample_space,
                   size = N,
                   replace = TRUE)
    }

    success_count <- function(experiment, success_value) {
            result <- sum(experiment == success_value)
            result
    }

    proportion <- function(experiment, success_value) {
            success_count(experiment, success_value) / length(experiment)
    }

    wald_mod <- function(success_count, trial_count) {
            z <- 1.96
            p_prime <- (success_count + (0.5 * z^2)) / (trial_count + z^2)
            W <- z * sqrt((p_prime * (1 - p_prime)) / (trial_count + z^2))
            result <- c((p_prime - W), (p_prime + W))
            result
    }

    get_experiment_results <- function(experiment, success_value) {
            p <- proportion(experiment, success_value)
            successes <- success_count(experiment, success_value)
            confidence_interval <- wald_mod(successes, length(experiment))
            p_plot_value <- confidence_interval[1] + p * abs(diff(confidence_interval))

            result <- list(c(p, p_plot_value), confidence_interval)
            result
    }

    run_simulation <- function() {
            sample_space <- c(rep('Red', 25), rep('White', 75))
            N <- 15

            experiments_df <- data.frame()

            for (i in 1:20) {
                    t <- run_experiment(sample_space, N)
                    t_results <- get_experiment_results(t, "Red")

                    experiments_df <- rbind(experiments_df, c(i, t_results[[1]][[1]], t_results[[1]][[2]], t_results[[2]][[1]], t_results[[2]][[2]]))
            }
            names(experiments_df) <- c("experiment_index", "proportion", "proportion_plot_value", "ci_min", "ci_max")

            print(experiments_df)

            # Jaap's answer on SO solves floating bar plot.
            # https://stackoverflow.com/questions/29916770/geom-bar-from-min-to-max-data-value
            # Simon's answer to me on SO solves plotting the proportion.
            # https://stackoverflow.com/questions/29916770/geom-bar-from-min-to-max-data-value
            ggplot(experiments_df, aes(experiment_index)) +
                    geom_segment(aes(xend = experiment_index, yend = ci_min, y = ci_max), size = 4, lineend = "butt",
                                 color = "turquoise4") +
                    geom_segment(aes(xend = experiment_index, yend = proportion_plot_value-.001, y = proportion_plot_value+.001), size = 4, lineend = "butt",
                                 color = "black") +
                    geom_abline(slope = 0, intercept = proportion(sample_space, "Red"), linetype = "dashed") +
                    coord_cartesian(ylim = c(0, 1)) +
                    labs(x = "Experiment", y = "Probability",
                         title = "Each bar shows 95% CI computed from one
    simulated experiment",
                         subtitle = "Dashed line is true proportion in sample space",
                         caption = "Intuitive Biostatistics. Harvey Mitulsky. p. 36") 
    }

    run_simulation()

My final plot (which my reputation points don't yet permit me to paste)

Answer 1

首先计算相对于条形下端的比例：

trials_df <- data.frame(trials_index = integer(),
                          proportion = double(),
                          ci_min = double(),
                          ci_max = double())

  for (i in 1:20) {
    t <- run_trials(sample_space, N)
    t_results <- get_trial_results(t, "Red")
    trials_df <- rbind(trials_df, c(i, t_results[[1]][1], t_results[[2]][1], t_results[[2]][2], t_results[[2]][1]+t_results[[1]][1]*asbs(diff(t_results[[2]][2], t_results[[2]][1]))))
  }
  names(trials_df) <- c("trials_index", "proportion", "ci_min", "ci_max", 'proportion_max')

你可以在每个条上只画一条小的水平线：

  ggplot(trials_df, aes(trials_index, ci_max)) +
    geom_segment(aes(xend = trials_index, yend = ci_min), size = 4, #lineend = "butt",
                 color = "turquoise4") +
    geom_segment(aes(xend = trials_index, yend = proportion_max-.001, y = proportion_max+.001), size = 4, lineend = "butt",
                 color = "turquoise3") +
    geom_abline(slope = 0, intercept = proportion(sample_space, "Red"), linetype = "dashed")

你想要其中之一吗？

要颜色比例较低的每条可以做到：

ggplot(trials_df, aes(trials_index, ci_max)) +
    geom_segment(aes(xend = trials_index, yend = ci_min), size = 4, #lineend = "butt",
                 color = "turquoise4") +
    geom_segment(aes(xend = trials_index, yend = ci_min, y = proportion_max), size = 4, lineend = "butt",
                 color = "turquoise3") +
    geom_abline(slope = 0, intercept = proportion(sample_space, "Red"), linetype = "dashed")