Question

设一个包含3个变量的数据集（这里是正常和独立但它们可以相关）

data = data.frame(x1 = rnorm(10000),
x2 = rnorm(10000),
x3 = rnorm(10000))

我想获得x1，x2和x3的最窄范围，使得95％的观察值落在所有三个范围内。

到目前为止，我有以下代码。

is.between <- function(x, a, b){
    x <= max(c(a, b)) & x >= min(c(a, b))
  }   
getlims <- function(lims, x1, x2, x3){
      abs(mean(
        is.between(x1, lims[1], lims[2]) & 
          is.between(x2, lims[3], lims[4]) & 
          is.between(x3, lims[5], lims[6]) 
      ) - 0.95) 
    }

optim(initial_values, getlims, x1=x1,x2=x2,x3=x3)

其中lims [1,2]是x1的范围，lims [3,4]是x2的范围，lims [5,6]是x3的范围。

它提供的限制包含我观察的95％，但不保证它将是较小的体积[1,2] * lims [3,4] * lims [5,6]。

Answer 1

我认为这实际上是离散优化中的一个问题。它是以三维方式给出的，我已经在二维中对其进行了重新设计以获得更好的可视化，它可以立即扩展到更多维度。

让我们尝试将其解决为具有约束的非线性优化问题。

set.seed(1009)
N <- 1000
x <- rnorm(N); y <- rnorm(N)

还需要这些坐标的0.05和0.95分位数。

q1 <- quantile(x, 0.05); q2 <- quantile(x, 0.95)
q3 <- quantile(y, 0.05); q4 <- quantile(y, 0.95)

我们定义了两个函数，fmin要最小化的函数，fbnd定义约束的函数。也就是说，我们需要fbnd(x) >= 0，以这种方式表示至少95％的点位于矩形内。

fmin <- function(p) (p[2]-p[1]) * (p[4]-p[3])
fbnd <- function(p) {
    c(0.05 - sum(x < p[1] | x > p[2] | y < p[3] | y > p[4]) / N,
      q1 - p[1], p[2] - q2,
      q3 - p[3], p[4] - q4 )
}

作为起点，我们可以取x和y坐标的范围。

start <- c(range(x), range(y))

优化求解器必须最小化具有非线性约束的函数。包 nloptr 中的auglag例程是候选解算器。

S <- nloptr::auglag(start, fn=fmin, hin=fbnd)
S$par; S$value
# [1] -2.301263  2.308038 -2.079166  2.130744
# [1] 19.40474

我们可以通过将矩形边界移动到下一个上部或下部x- resp来改进解决方案。 y坐标。这是必要的步骤，因为目标函数是局部常数。

r <- S$par
r[1] <- min(x[x >= r[1]]); r[2] <- max(x[x <= r[2]])
r[3] <- min(y[y >= r[3]]); r[4] <- max(y[y <= r[4]])
r
# [1] -2.299467  2.281395 -2.079166  2.127260

我们可以看到，50个点位于矩形之外，面积为19.26905。

(r[2]-r[1]) * (r[4]-r[3])                          # 19.26905
sum(x < r[1] | x > r[2] | y < r[3] | y > r[4])     # 50

解决方案仍然是当地的最低要求。幸运的是，目标函数也是局部单调的，所以通常不会发生这种情况。当然，可以通过应用全局求解器来验证解决方案。

R中的3维预测极限

1 个答案: