Найти значение x, которое будет одинаково разделять перекрытие между двумя кривыми - PullRequest
1 голос
/ 12 апреля 2019

Используя некоторый код, взятый из ответа @Ramnath в этом предыдущем вопросе, я хотел бы найти значение x, которое будет равным образом разделять область перекрытия между двумя кривыми.Смотрите следующий пример:

library(ggplot2)
x  = seq(-7, 10, length = 200)
y1 = dnorm(x, mean = 0,sd = 1)
y2 = dnorm(x, mean = 3,sd = 2)

mydf = data.frame(x, y1, y2)

p0 = ggplot(mydf, aes(x = x)) +                         
  geom_line(aes(y = y1), colour = 'blue') +
  geom_line(aes(y = y2), colour = 'red') +
  geom_area(aes(y = pmin(y1, y2)), fill = 'gray60')

Любые предложения будут высоко оценены!

1 Ответ

2 голосов
/ 12 апреля 2019

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

Для иллюстрации я добавил дополнительные столбцы данныхотметить все шаги, но это не обязательно, если вы просто хотите найти местоположение разделительной линии напрямую.

# overlap
mydf$overlap = apply(mydf[,c("y1","y2")], 1, min)

# area of overlap
mydf$overlap.area = cumsum(mydf$overlap * median(diff(mydf$x)))

# Find x that divides overlap area in half

# Method 1: Directly from the data. Could be inaccurate if x values are
#  not sufficiently close together.
x0a = mydf$x[which.min(abs(mydf$overlap.area - 0.5*max(mydf$overlap.area)))]

# Method 2: Use uniroot function to find x value where cumulative overlap 
#  area is 50% of total overlap area. More accurate.

# First generate an interpolation function for cumulative area.
#  Subtract half the cumulative area so that function will cross
#  zero at the halfway point
f = approxfun(mydf$x, mydf$overlap.area - 0.5*max(mydf$overlap.area))

# Find x value at which interpolation function crosses zero
x0b = uniroot(f, range(mydf$x))$root

p0 = ggplot(mydf, aes(x = x)) +                         
  geom_line(aes(y = y1), colour = 'blue') +
  geom_line(aes(y = y2), colour = 'red') +
  geom_area(aes(y = pmin(y1, y2)), fill = 'gray60') +
  geom_line(aes(y=overlap), colour="purple") +
  geom_line(aes(y=overlap.area), colour="green") +
  geom_vline(xintercept=c(x0a,x0b), color=c("orange","darkgreen"), 
             linetype=c("solid", "dashed")) +
  theme_classic()
p0

enter image description here

...