在x轴上找到与cdf相交对应的两个点

Question

下面给出了相应的r code。

theta <- seq(0,1, length = 10)
CD_theta <- function(x, p, n){
  1 - pbinom(x, size = n, prob = p) + 1 / 2 * dbinom(x, size = n, prob = p)
}

然后我将数据绘制如下：

mytheta <- CD_theta(5, theta, 10)
df <- data.frame(theta = theta, mytheta = mytheta)
ggplot(df, aes(x = theta, y = mytheta)) +
  geom_line(size = 1, col = "steelblue") +
  ylab("H(Theta)") +
  xlab("Theta")

下面给出了相应的图。

如您所见，有两条水平线（以红色绘制）和两条垂直线（以黑色绘制）。我需要在x轴上找到与H（theta）的交点相对应的两个点。

我在locator()中使用了r函数来计算一次迭代的两个x截距。我想将上述内容重复进行1000次，所以分别查找它们确实很繁琐。

还有其他r个函数可以用来找到这两个x截距点吗？

谢谢。

Answer 1

以下是使用optimize函数的数值方法：

library(reprex)

theta <- seq(0,1, length = 10)
CD_theta <- function(x, p, n){
  1 - pbinom(x, size = n, prob = p) + 1 / 2 * dbinom(x, size = n, prob = p)
}

# Create a function to compute the difference between the "y" you want 
# and the "y" computed with CD_theta function 
# then try to minimize the output of this new function : 
# get the theta value corresponding to this "y"

my_fn <- function(theta_loc, y, x, n) { 
  # the function to optimize
  abs(y - CD_theta(x, theta_loc, n)) # dont forget abs (absolute)
}

# Then use optimize function to compute the theta value 
# between a given interval : c(0,1) in this case
# Note that you can directly modify here the values of y, x and n
v1 <- optimize(my_fn, c(0, 1), y = 0.025, x = 5, n = 10)$`minimum` 
v2 <- optimize(my_fn, c(0, 1), y = 0.975, x = 5, n = 10)$`minimum` 

# print the results
v1 # 0.025
#> [1] 0.2120079
v2 # 0.975
#> [1] 0.7879756

由reprex package（v0.2.0）于2018-09-21创建。

Answer 2

稍微增加曲线的离散度，这变得相当简单：

theta <- seq(0,1, length = 100) # increase length here for more precision on point locations
CD_theta <- function(x, p, n){
  1 - pbinom(x, size = n, prob = p) + 1 / 2 * dbinom(x, size = n, prob = p)
}

mytheta <- CD_theta(5, theta, 10)
df <- data.frame(theta = theta, mytheta = mytheta)
ggplot(df, aes(x = theta, y = mytheta)) +
  geom_line(size = 1, col = "steelblue") +
  ylab("H(Theta)") +
  xlab("Theta")

points <- data.frame(x=c(theta[which.min(abs(mytheta - .975))], # find which point is the nearer
                         theta[which.min(abs(mytheta - .025))]),
                     y=c(.975,.025))

ggplot(df, aes(x = theta, y = mytheta)) +
  geom_line(size = 1, col = "steelblue") +
  ylab("H(Theta)") +
  xlab("Theta") + 
  geom_point(data=points,aes(y=y, x=x), size=5, col="red")

Answer 3

如果要查找精确的Theta和HTheta值，而不受网格大小（此处为N = 10）的影响，请将uniroot应用于CD_theta功能。

CD_theta <- function(x, p, n) {
    1  -  pbinom (x, size = n, prob = p) + 
    1/2 * dbinom(x, size = n, prob = p)
}

u1 = uniroot(function(p) CD_theta(5, p, 10) - 0.025, c(0, 1))
u2 = uniroot(function(p) CD_theta(5, p, 10) - 0.975, c(0, 1))
(Theta1 = u1$root)  # 0.2119934
(Theta2 = u2$root)  # 0.7880066

但是，如果离散化（使用N = 10）对您很重要，请对该网格点之间的此函数执行线性插值。

theta <- seq(0, 1, length = 10)
mytheta <- CD_theta(5, theta, 10)
f <- approxfun(theta, mytheta, method = "linear", 0.0, 1.0)

u1 = uniroot(function(p) f(p) - 0.025, c(0, 1))
u2 = uniroot(function(p) f(p) - 0.975, c(0, 1))
(Theta1 = u1$root)  # 0.2015638
(Theta2 = u2$root)  # 0.7984362