如何在R中多次確定系數的給定值上生成數據？

Question

我需要生成關於多次確定系數的給定值的數據。 例如，如果我指示R ^ 2 = 0.77，我想生成數據，其創建回歸模型，其中R ^ 2 = 0.77

但這些數據必須在一定范圍內。 例如，sample = 100，我需要4個變量（x1 - dependent var），其中的值范圍為5-15。 怎么樣？ 我用的是optim

optim(0.77, fn, gr = NULL,
      method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN",
                 "Brent"),
      lower = 5, upper = 15,
      control = list(), hessian = FALSE)

但我不知道如何為我的目的創建函數fn 。 請幫忙寫這個功能

Answer 1

首先，這是一個解決方案：

library(mvtnorm)

get.r <-  function(x) c((x+sqrt(x**2+3*x))/(3),(x-sqrt(x**2+3*x))/(3))

set.seed(123)
cv <- get.r(0.77)[1]
out <- rmvnorm(100,sigma=matrix(c(1,cv,cv,cv,cv,1,cv,cv,cv,cv,1,cv,cv,cv,cv,1),ncol=4))
out1 <- as.data.frame(10*(out-min(out))/diff(range(out))+5)

range(out1)
# [1]  5 15

lm1 <- lm(V1~V2+V3+V4,data=out1)

summary(lm1)
# Call:
#   lm(formula = V1 ~ V2 + V3 + V4, data = out1)
# 
# Residuals:
#   Min       1Q   Median       3Q      Max 
# -1.75179 -0.64323 -0.03397  0.64770  2.23142 
# 
# Coefficients:
#   Estimate Std. Error t value Pr(>|t|)    
# (Intercept)  0.36180    0.50940   0.710 0.479265    
# V2           0.29557    0.09311   3.175 0.002017 ** 
# V3           0.31433    0.08814   3.566 0.000567 ***
# V4           0.35438    0.07581   4.674 9.62e-06 ***
# ---
# Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
# 
# Residual standard error: 0.927 on 96 degrees of freedom
# Multiple R-squared:  0.7695,  Adjusted R-squared:  0.7623 
# F-statistic: 106.8 on 3 and 96 DF,  p-value: < 2.2e-16

現在讓我解釋一下我是如何到達那里的。 我們可以在統計上構建這個。 首先，我們需要了解一點關聯和協方差。 一個相關的公式是

Corr（X，Y）= Cov（X，Y）/ sqrt（Var（X）Var（Y））

協方差的一個公式是：

Cov（X，Y）= E（XY） - E（X）E（Y）

在您的問題中，您希望獲得回歸模型的多重關聯：

Y = X1 + X2 + X3

讓我們盡可能簡單，並強制所有變量的方差為1，讓任意兩個變量之間的成對相關相等，並將其稱為r。

現在我們正在尋找Y和X1 + X2 + X3之間相關性的平方，即：

R ^ 2 = [Cov（Y，X1 + X2 + X3）] ^ 2 / [Var（Y）Var（X1 + X2 + X3）]

注意

Cov（Y，X1 + X2 + X3）= Cov（Y，X1）+ Cov（Y，X2）+ Cov（Y，X3）

進一步注意，每個變量的方差為1，成對相關為r，因此上述結果相當於3r。

另請注意

Var（X1 + X2 + X3）= Var（X1）+ Var（X2）+ Var（X3）+ Cov（X1，X2）+ Cov（X1，X3）+ Cov（X2，X3）。

由於每個方差為1，因此相當於3 + 6r

R ^ 2 = 9r ^ 2 /（3 + 6r）= 3r ^ 2 /（1 + 2r）

我們可以使用二次方程來求解r和get

r =（R ^ 2 +/- sqrt（（R ^ 2）^ 2 + 3R ^ 2））/ 3

如果我們用R ^ 2 = 0.77代替，則r = -0.3112633或0.8245966。 我們可以使用得到你需要使用什么rmvnorm()的內mvtnorm包。 由於R ^ 2對線性變換是不變的，我們可以對結果變量進行變換，使它們落在5到15之間。

更新：

如果我們想要使用n預測變量進行模擬，我們可以使用以下內容（請注意，我沒有變換每個預測變量的范圍，但是可以在事后完成而不改變多個R ^ 2）：

get.r <- function(x,n) c(((n-1)*x+sqrt(((n-1)*x)**2+4*n*x))/(2*n),
                         ((n-1)*x-sqrt(((n-1)*x)**2+4*n*x))/(2*n))

sim.data <- function(R2, n) {
  sig.mat <- matrix(get.r(R2,n+1)[1],n+1,n+1)
  diag(sig.mat) <- 1

  out <- as.data.frame(rmvnorm(100,sigma=sig.mat))

  return(out)
}

Answer 2

這不是答案，但我想分享我的所作所為。 我不相信optim可以按照你想要的方式使用。 我嘗試了一種“強力”方法來找到一個可行的數據集，但最高的r平方我“randomed”是0.23：

# Initializing our boolean and counter.
rm(list = ls())
Done <- FALSE
count <- 1
maxr2 <- .000001

# I set y ahead of time.
y <- sample(5:15, 100, replace = TRUE)

# Running until an appropriate r-squared is found.
while(!Done) {

  # Generating a sample data set to optimize y on.
  a <- sample(5:15, 100, replace = TRUE)
  b <- sample(5:15, 100, replace = TRUE)
  c <- sample(5:15, 100, replace = TRUE)
  data <- data.frame(y = y, a = a, b = b, c = c)

  # Making our equation and making a linear model.
  EQ <- "y ~ a + b + c" # Creating the equation.
  model <- lm(EQ, data) # Running the model.
  if (count != 1) { if (summary(model)$r.squared > maxr2) { maxr2 <- summary(model)$r.squared } }
  r2 <- summary(model)$r.squared # Grabbing the r-squared.
  print(r2) # Printing r-squared out to see what is popping out.
  if (r2 <= 0.78 & r2 >= 0.76) { Done <- TRUE } # If the r-squared is satfisfactory, pop it out.
  count <- count + 1 # Incrementing our counter.
  if (count >= 1000000) { Done <- TRUE ; print("A satisfactory r-squared was not found.") } # Setting this to run at most 1,000,000 times.

}

# Data will be your model that has an r-squared of 0.77 if you found one.

optim的問題在於它優化了單個參數，單個值。 optim的第一個參數是par參數，它是要優化的值的列表。 這可以用於通過某些衰減函數來優化r平方，該函數依賴於幾個值（這些將是您的par ）。 但是，在這種情況下，你要求優化整個列以最大化r平方，這對於optim來說是沒有意義的（據我所知）。