在模擬多元數據進行回歸時，如何設置R平方（包括示例代碼）？

Question

我正在嘗試模擬三變量數據集，以便我可以在其上運行線性回歸模型。 'X1'和'X2'將是連續的獨立變量（mean = 0，sd = 1），'Y'將是連續因變量。

變量將是回歸模型將產生如下系數：Y = 5 + 3（X1） - 2（X2）

我想模擬這個數據集，使得得到的回歸模型的R平方值為0.2。 如何確定'sd.value'的值，以便回歸模型具有此R平方？

n <- 200 
set.seed(101) 
sd.value <- 1

X1 <- rnorm(n, 0, 1)
X2 <- rnorm(n, 0, 1)
Y <- rnorm(n, (5 + 3*X1 - 2*X2), sd.value)

simdata <- data.frame(X1, X2, Y)

summary(lm(Y ~ X1 + X2, data=simdata))

Answer 1

看看這段代碼，它應該足夠接近你想要的東西：

simulate <- function(n.obs=10^4, beta=c(5, 3, -2), R.sq=0.8) {
    stopifnot(length(beta) == 3)
    df <- data.frame(x1=rnorm(n.obs), x2=rnorm(n.obs))  # x1 and x2 are independent
    var.epsilon <- (beta[2]^2 + beta[3]^2) * (1 - R.sq) / R.sq
    stopifnot(var.epsilon > 0)
    df$epsilon <- rnorm(n.obs, sd=sqrt(var.epsilon))
    df$y <- with(df, beta[1] + beta[2]*x1 + beta[3]*x2 + epsilon)
    return(df)
}
get.R.sq <- function(desired) {
    model <- lm(y ~ x1 + x2, data=simulate(R.sq=desired))
    return(summary(model)$r.squared)
}
df <- data.frame(desired.R.sq=seq(from=0.05, to=0.95, by=0.05))
df$actual.R.sq <- sapply(df$desired.R.sq, FUN=get.R.sq)
plot(df)
abline(a=0, b=1, col="red", lty=2)

基本上你的問題歸結為找出var.epsilon的表達式。 由於我們有y = b1 + b2 * x1 + b3 * x2 + epsilon，而Xs和epsilon都是獨立的，我們有var [y] = b2 ^ 2 * var [x1] + b3 ^ 2 * var [x2] + var [eps]，其中var [Xs] = 1假設。 然后，您可以求解var [eps]作為R平方的函數。

Answer 2

所以R ^ 2的公式是1-var（殘差）/ var（總計）

在這種情況下， Y的方差將是3^2+2^2+sd.value^2 ，因為我們添加了三個獨立的隨機變量。 並且，漸近地，殘差方差將簡單地為sd.value^2 。

因此，您可以使用此函數顯式計算rsquared：

rsq<-function(x){1-x^2/(9+ 4+x^2)}

使用小代數，您可以計算此函數的反函數：

rsqi<-function(x){sqrt(13)*sqrt((1-x)/x)}

所以設置sd.value<-rsqi(rsquared)可以給你你想要的東西。

我們可以測試如下：

simrsq<-function(x){
  Y <- rnorm(n, (5 + 3*X1 - 2*X2), rsqi(x))
  simdata <- data.frame(X1, X2, Y)
  summary(lm(Y ~ X1 + X2, data=simdata))$r.squared
}

> meanrsq<-rep(0,9)
> for(i in 1:50)
+   meanrsq<-meanrsq+Vectorize(simrsq)((1:9)/10)
> meanrsq/50
[1] 0.1031827 0.2075984 0.3063701 0.3977051 0.5052408 0.6024988 0.6947790
[8] 0.7999349 0.8977187

所以它看起來是正確的。

Answer 3

我就是這樣做的（ 盲目迭代算法 ，假設沒有知識，因為當你純粹對“如何模擬這個”感興趣時）：

simulate.sd <- function(nsim=10, n=200, seed=101, tol=0.01) {
  set.seed(seed)
  sd.value <- 1
  rsquare <- 1:nsim
  results <- 1:nsim
  for (i in 1:nsim) {
    # tracking iteration: if we miss the value, abort at sd.value > 7.
    iter <- 0 
    while (rsquare[i] > (0.20 + tol) | rsquare[i] < (0.2 - tol)) {
      sd.value <- sd.value + 0.01
      rsquare[i] <- simulate.sd.iter(sd.value, n)
      iter <- iter + 1
      if (iter > 3000) { break }
    }
    results[i] <- sd.value  # store the current sd.value that is OK!
    sd.value <- 1
  }
  cbind(results, rsquare)
}

simulate.sd.iter <- function(sd.value, n=200) {  # helper function
  # Takes the sd.value, creates data, and returns the r-squared
  X1 <- rnorm(n, 0, 1)
  X2 <- rnorm(n, 0, 1)
  Y <- rnorm(n, (5 + 3*X1 - 2*X2), sd.value)
  simdata <- data.frame(X1, X2, Y)
  return(summary(lm(Y ~ X1 + X2, data=simdata))$r.squared)
}

simulate.sd()

有幾點需要注意：

• 我讓X1和X2變化，因為這影響了這個尋求的sd.value 。
• 容差是您想要這個估計的精確程度。 r平方為~0.19或~0.21，你還好嗎？ 公差為0.01。
• 請注意，過於精確的公差可能無法讓您找到結果。
• 值1是一個相當糟糕的起始值，使得這個迭代算法非常慢。

得到的10個結果的矢量是：

[1] 5.64 5.35 5.46 5.42 5.79 5.39 5.64 5.62 4.70 5.55 ，

我的機器大約需要13秒鍾。

我的下一步是從4.5開始，在迭代中加0.001而不是0.01，並且可能會降低容差。 祝好運！

好吧，一些nsim = 100的摘要統計，耗時150秒，步數增加0.001，容差仍然是0.01：

  Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 4.513   4.913   5.036   5.018   5.157   5.393 

你為什么對此感興趣？

Answer 4

這是生成多個線性回歸的另一個代碼，其中錯誤遵循正態分布：OPS抱歉此代碼只產生多重回歸

 sim.regression<-function(n.obs=10,coefficients=runif(10,-5,5),s.deviation=.1){ n.var=length(coefficients) M=matrix(0,ncol=n.var,nrow=n.obs) beta=as.matrix(coefficients) for (i in 1:n.var){ M[,i]=rnorm(n.obs,0,1) } y=M %*% beta + rnorm(n.obs,0,s.deviation) return (list(x=M,y=y,coeff=coefficients)) }