关于在模拟研究中应用lapply(),我遇到了困难 . 这些数据旨在帮助我们了解标准化公式如何影响提案评级工作的结果 .
评估者有三个条件:没有偏见,统一偏见(评估者的偏见增加)和双向偏见(偏见在评分者中均衡为正和负) .
假定提案的真实 Value .
我们希望在每个偏差条件下生成一组复制数据集,以便数据集可以模拟单个提案评估期(面板) . 然后,我们希望复制面板以模拟具有许多建议评估期 .
这是数据结构的示意图:
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)是一组审阅者的随机复制,用于整个提案集 .
我想使用整套提案分数(在所有评估者和提案中)的特征将以下函数应用于"adjust"小组内的分数,以调整评估者中的值 . 这个想法是以某种方式纠正任何偏见(例如,在评价提案时过于苛刻或过于简单) .
应对每个(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中),那将是非常感激的 . 到目前为止我找到的文本没有详细解决这些问题 .
很多,非常感谢提前 .
-Jon
2 回答
我可以't say I fully understand the whole problem (I'm,而不是统计人员!),但你的lapply行失败的原因是
adj.scores
在它需要矩阵时在x
中传递一个列表 .由于你有列表列表(列表!),
rapply
似乎更合适 . 以下似乎产生了一些合理的东西:希望这可以帮助!
我发布适用于我的解决方案的时间已经很晚了 . 我确信可以进行改进,所以请随时发表评论!
这项工作的目的是了解提案评级的线性转换在多大程度上会对提案的选择产生影响 . 我们的想法是尝试将“提议质量”与“评估偏见”和“小组偏见”区分开来 .
实现此目的的一种方法实质上是面板上所有评级的中心,然后使用所有评级的总体均值和sd对面板中心评级进行均值/ sd转换 . 此过程位于
adj.scores
函数中 .这是非常重要的,因为提案是由人们评估的,并且可能有大量的财务激励措施依赖于成功的提案评估(拨款, Contract 等) .
欢迎任何有关改进或竞争策略的想法 .