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))
  
}

在模拟多元数据进行回归时，如何设置R平方（包括示例代码）？

4 个答案: