将lapply()用于模拟研究列表列表中构造的数据
||
关于lapply()在模拟研究中的应用,我碰壁了。这些数据旨在帮助我们了解标准化公式如何影响提案评级活动的结果。
评估者需要满足以下三个条件:无偏差,统一偏差(各个评估者之间的偏差增加)和双向偏差(各个评估者之间的偏差为正负平衡)。
假定提案的真实价值是已知的。
我们希望在每个偏差条件下生成一组重复的数据集,以便这些数据集可以模拟一个提案评估期(一个小组)。然后,我们想复制面板以模拟具有许多投标评估期。
这是数据结构的示意图:
The data structure looks like this:
p = number of proposals
r = number of raters
n.panels = number of replicate panels
t.reps = list of several replicate panels
three bias conditions: n.bias - no bias
u.bias - uniform bias (raters higher than previous rater)
b.bias - bidirectional bias (balanced up and down bias)
-|
t 1 |..| --> 10*(n.bias(p*r)) + 10*(u.bias(p*r)) + 10*(b.bias(p*r) {panel replication 1}
. 2 |..| --> 10*(n.bias(p*r)) + 10*(u.bias(p*r)) + 10*(b.bias(p*r) {panel replication 2}
r : : : : :
e : : : : :
p n.panels |..| --> 10*(n.bias(p*r)) + 10*(u.bias(p*r)) + 10*(b.bias(p*r) {n. panels replications}
s
_|
以下R代码正确生成数据:
########## start of simulation parameters
set.seed(271828)
means <- matrix(c(rep(50,3), rep(60,3), rep(70,4) ), ncol = 1) # matrix of true proposal values
bias.u <- matrix(c(0,2,4,6,8), nrow=1) # unidirectional bias
bias.b <- matrix(c(0,3,-3, 5, -5), nrow=1) # bidirectional bias
ones.u <- matrix(rep(1,ncol(bias.u)), nrow = 1) # number of raters is the number of columns (r)
ones.b <- matrix(rep(1,ncol(bias.b)), nrow = 1)
ones.2 <- matrix(rep(1,nrow(means)), ncol = 1) # number of proposals is the number of rows (p)
true.ratings <- means%*%ones.u # gives matrix of true proposal value for each rater (p*r)
uni.bias <- ones.2%*%bias.u
bid.bias <- ones.2%*%bias.b # gives matrix of true rater bias for each proposal (p*r)
n.val <- nrow(means)*ncol(ones.u)
# true.ratings
# uni.bias
# bid.bias
library(MASS)
#####
##### generating replicate data...
#####
##########-------------------- analyzing mse of adjusted scores across replications
##########-------------------- developing random replicates of panel data
##########----- This means that there are (reps) replications in each of the bias conditions
##########----- to represent a plausible set of ratings in a particular collection
##########----- of panels. So for one proposal cycle (panel) , there are 3 * (reps) * nrow(means)
##########----- number of proposal ratings.
##########-----
##########----- There are (n.panels) replications of the total number of proposal ratings placed in a list
##########----- (t.reps).
n.panels <- 2 # put in the number of replicate panels that should be produced
reps <- 10 # put in the number of times each bias condition should be included in a panel
t.reps <- list()
n.bias <- list()
u.bias <- list()
b.bias <- list()
for (i in 1:n.panels)
{
{
for(j in 1:reps)
n.bias[[j]] <- true.ratings + matrix(round(rnorm(n.val,4,2), digits=0), nrow = nrow(means))
for(j in 1:reps)
u.bias[[j]] <- true.ratings + uni.bias + matrix(round(rnorm(n.val,4,2), digits=0), nrow = nrow(means))
for(j in 1:reps)
b.bias[[j]] <- true.ratings + bid.bias + matrix(round(rnorm(n.val,4,2), digits=0), nrow = nrow(means))
}
t.reps[[i]] <- list(n.bias, u.bias, b.bias)
}
# t.reps
列表(t.reps)中的每个元素都是一组审阅者的随机复制
整套建议。
我想将以下功能应用于“调整”面板中的分数
使用整个提案分数集的特征(在所有评分者和提案中)
调整评估者中的值。这个想法是纠正一种或另一种偏见
(例如,对建议进行评级时过于苛刻或过于容易)。
该调整应应用于每个(重复)数据集。
因此,对于一个面板,将有30个重复数据集(每个偏差条件10个)
并且每个重复数据集将有5个评分者对10个提案进行评分,结果
共有300项提案。
因此,其想法是进行随机复制,以了解调整后的分数与未调整后的分数之间的比较。
我试图在(t.reps)列表中的整个列表中使用lapply()函数,但此方法不起作用。
adj.scores <- function(x, tot.dat)
{
t.sd <- sd(array(tot.dat))
t.mn <- mean(array(tot.dat))
ones.t.mn <- diag(1,ncol(x))
p <- nrow(x)
r <- ncol(x)
ones.total <- matrix(1,p,r)
r.sd <- diag(apply(x,2, sd))
r.mn <- diag(apply(x,2, mean))
den.r.sd <- ginv(r.sd)
b.shift <- x%*%den.r.sd
a <- t.mn*ones.t.mn - den.r.sd%*%r.mn
a.shift <- ones.total%*%a
l.x <- b.shift + a.shift
return(l.x)
}
########## I would like to do something like this...
########## apply the function to each element in the list t.reps
dat.1 <- matrix(unlist(t.reps[[1]]), ncol=5)
adj.rep.1 <- lapply(t.reps[[1]], adj.scores, tot.dat = dat.1)
我对其他方法/解决方法持开放态度,这些方法/解决方法将允许使用整个评分组中的统计信息在一组提案评分中调整评分者。可能有些R功能我不知道或没有遇到过。
另外,如果有人可以推荐一本书(R,Perl或Python)中的数据结构编程书籍,将不胜感激。到目前为止,我发现的文本并未详细解决这些问题。
非常感谢。
-乔恩
没有找到相关结果
已邀请:
2 个回复
镰茧钩
似乎更合适。以下内容似乎会产生合理的结果:
希望这可以帮助!
提孺局缎