Добавление средней или срединной линии к графику плотности, которая заканчивается внутри области графика

Вам нужно найти значение y, соответствующее среднему значению, которое требует некоторого округления. Проверьте и убедитесь, что это то, что вам нужно.

library(data.table)
library(ggplot2)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:data.table':
#> 
#>     between, first, last
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

iris <- as.data.table(iris)

iris_summary <- iris[, .(sepal_mean = mean(Sepal.Length),
                                   sepal_se_low = mean(Sepal.Length) - sd(Sepal.Length) / sqrt(length(Sepal.Length)),
                                   sepal_se_high = mean(Sepal.Length) + sd(Sepal.Length) / sqrt(length(Sepal.Length))),
                                    Species]

unique(iris$Species)
#> [1] setosa     versicolor virginica 
#> Levels: setosa versicolor virginica

x.dens.s <- density(iris[Species == "setosa", Sepal.Length])
x.dens.ve <- density(iris[Species == "versicolor", Sepal.Length])
x.dens.vi <- density(iris[Species == "virginica", Sepal.Length])
df.dens <- data.table(x = c(x.dens.s$x, x.dens.ve$x, x.dens.vi$x), y = c(x.dens.s$y, x.dens.ve$y, x.dens.vi$y))
df.dens$Species <- c(rep("setosa", length(x.dens.s$y)), rep("versicolor", length(x.dens.ve$y)),
                 rep("virginica", length(x.dens.vi$y)))

## Add mean value to density dataset
df.dens <- left_join(df.dens, iris_summary)
#> Joining with `by = join_by(Species)`

## Find y-value at mean value
yend <- df.dens |> 
  group_by(Species) |> 
  filter(round(x, 2) == round(sepal_mean, 2)) |> 
  summarise(yend = mean(y))

## Plot
iris_density <- 
  ggplot() +
  geom_density(data=iris, aes(x=Sepal.Length,fill=Species),alpha=0.5) +
  geom_area(data = df.dens[Species == "setosa" & 
                             x %between% c(iris_summary[Species == "setosa", sepal_se_low], 
                                           iris_summary[Species == "setosa", sepal_se_high]),],  
            aes(x=x,y=y), fill = "white", alpha = 0.5) +
  geom_area(data = df.dens[Species == "versicolor" & 
                             x %between% c(iris_summary[Species == "versicolor", sepal_se_low], 
                                           iris_summary[Species == "versicolor", sepal_se_high]),],  
            aes(x=x,y=y), fill = "white", alpha = 0.5) +
  geom_area(data = df.dens[Species == "virginica" & 
                             x %between% c(iris_summary[Species == "virginica", sepal_se_low], 
                                           iris_summary[Species == "virginica", sepal_se_high]),],  
            aes(x=x,y=y), fill = "white", alpha = 0.5)  + 
  geom_segment(aes(x = iris_summary$sepal_mean, y = 0, yend = yend$yend), linetype = 2)

  
iris_density

^{Created on 2024-08-29 with reprex v2.1.0}

Во-первых, вам нужно решить, должна ли линия представлять собой среднее или медиану ваших распределений, потому что они не будут одинаковыми, особенно при асимметричных распределениях. После того, как вы решили, какое значение вам нужно, простой способ сделать это будет следующим:

library(dplyr)
Maximums_statistic <- iris %>% group_by(Species) %>% 
    #Calculate your desired statistic (mean, median) and the densities
      reframe(Mean = mean(Sepal.Length), 
             density.x = (density(Sepal.Length))$x,
             density.y = (density(Sepal.Length))$y) %>%
    #Select the closest x value to your mean 
      mutate(Closest_x = abs(Mean - density.x)) %>% 
      group_by(Species) %>% 
#Which height value corresponds to this x value?
mutate(Corresponding_y = density.y[which(Closest_x == min(Closest_x))]) %>% 
      select(Species, Mean, Height = Corresponding_y) %>% distinct()

С помощью этого фрейма данных теперь вы можете заново построить график, используя geom_segment, а не полную вертикальную линию:

iris_density <- 
    ggplot() +
    geom_density(data=iris, aes(x=Sepal.Length,fill=Species),alpha=0.5) +
    geom_area(data = df.dens[Species == "setosa" & 
                                 x %between% c(iris_summary[Species == "setosa", sepal_se_low], 
                                               iris_summary[Species == "setosa", sepal_se_high]),],  
              aes(x=x,y=y), fill = "white", alpha = 0.5) +
    geom_area(data = df.dens[Species == "versicolor" & 
                                 x %between% c(iris_summary[Species == "versicolor", sepal_se_low], 
                                               iris_summary[Species == "versicolor", sepal_se_high]),],  
              aes(x=x,y=y), fill = "white", alpha = 0.5) +
    geom_area(data = df.dens[Species == "virginica" & 
                                 x %between% c(iris_summary[Species == "virginica", sepal_se_low], 
                                               iris_summary[Species == "virginica", sepal_se_high]),],  
              aes(x=x,y=y), fill = "white", alpha = 0.5)  + 
# This part is new
    geom_segment(data = Maximums_statistic, 
aes(x = Mean, xend = Mean, y = Height, yend = 0),
 linetype = 2, linewidth = 0.7, color = "black")

Надеюсь, это поможет!