Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/80.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R 从给定总体效应大小的类方差分析设计中随机抽取_R_Statistics - Fatal编程技术网

R 从给定总体效应大小的类方差分析设计中随机抽取

R 从给定总体效应大小的类方差分析设计中随机抽取,r,statistics,R,Statistics,假设你有一个正态分布变量y,带有一个三组分类预测因子x,它具有正交对比度c1和c2。我试图在R中创建一个程序,给定x、c1和c2,创建y,这样c1和c2的效果大小r1和r2由用户指定 例如,假设x、c1、c2、r1和r2的创建方式如下: x <- factor(rep(c(1, 2, 3), 100)) contrasts(x) <- matrix(c(0, -.5, .5, -2/3, 1/3, 1/3), nrow = 3, ncol = 2, dimnames = lis

假设你有一个正态分布变量
y
,带有一个三组分类预测因子
x
,它具有正交对比度
c1
c2
。我试图在R中创建一个程序,给定x、c1和c2,创建y,这样c1和c2的效果大小r1和r2由用户指定

例如,假设x、c1、c2、r1和r2的创建方式如下:

x <- factor(rep(c(1, 2, 3), 100))
contrasts(x) <- matrix(c(0, -.5, .5, -2/3, 1/3, 1/3), 
  nrow = 3, ncol = 2, dimnames = list(c("1", "2", "3"), c("c1", "c2")))

contrasts(x)
    c1         c2
1  0.0 -0.6666667
2 -0.5  0.3333333
3  0.5  0.3333333

r1 <- .09
r2 <- 0

x承蒙同事们的慷慨建议,我现在有了一个函数,可以在给定指定数量的组、一组对比度、一组回归系数、指定的每个单元格N和指定的组内方差的情况下创建模拟数据

sim.factor <- function(levels, contr, beta, perCell, errorVar){
  # Build design matrix X
  X <- cbind(rep(1,levels*perCell), kronecker(contr, rep(1,perCell)))
  # Generate y
  y <- X %*% beta + rnorm(levels*perCell, sd=sqrt(errorVar))
  # Build and return data frame
  dat <- cbind.data.frame(y, X[,-1])
  names(dat)[-1] <- colnames(contr)
  return(dat)
}
sim.factor
ws.var <- function(levels, contr, beta, perCell, dc){
  # Build design matrix X
  X <- cbind(rep(1,levels), contr)
  # Generate the expected means
  means <- X %*% beta
  # Find the sum of squares due to each contrast 
  var <- (t(means) %*% contr)^2 / apply(contr^2 / perCell, 2, sum)
  # Calculate the within-conditions sum of squares
  wvar <- var[1] / dc - sum(var)
  # Convert the sum of squares to variance
  errorVar <- wvar / (3 * (perCell - 1))
  return(errorVar)
}
contr <- contr.helmert(3)
colnames(contr) <- c("c1","c2")
beta <- c(0, 1, 0)
perCell <- 50
levels = 3
dc <- .08
N <- 1000

# Calculate the error variance
errorVar <- ws.var(levels, contr, beta, perCell, dc)

# To store delta R^2 values
d1 <- vector("numeric", length = N)

# Use the functions
for(i in 1:N)
{
   d <- sim.factor(levels=3,
                   contr=contr,
                   beta=beta,
                   perCell=perCell,
                   errorVar=errorVar)
   d1[i] <- lm.sumSquares(lm(y ~ c1 + c2, data = d))[1, 2] # From the lmSupport package
}

m <- round(mean(d1), digits = 3)

bmp("Testing simulation functions.bmp")
hist(d1, xlab = "Percentage of variance due to c1", main = "")
text(.18, 180, labels = paste("Mean =", m))
dev.off()