根据对多个回复问题的回答计算得分
我有1到20个多重回答问题的用户数据。换句话说，用户并没有回答相同数量的问题;他们可以选择他们想要回答的20个问题中的多少个。所有问题都有相同数量的响应选项（44个），用户可以根据需要为每个问题选择尽可能少的响应选项。
举个例子，这里是数据的一个子集（代表3个多重响应问题，每个问题有5个响应选项）：
mydata <- structure(list(id = 1:5, q1.response1 = c(1L, NA, 1L, NA, 1L),
q1.response2 = c(NA, 1L, 1L, NA, NA), q1.response3 = c(NA,
1L, 1L, 1L, NA), q1.response4 = c(1L, 1L, 1L, NA, 1L), q1.response5 = c(NA,
1L, 1L, NA, NA), q2.response1 = c(NA, 1L, NA, NA, NA), q2.response2 = c(1L,
NA, 1L, 1L, 1L), q2.response3 = c(NA, 1L, NA, 1L, NA), q2.response4 = c(1L,
NA, NA, NA, 1L), q2.response5 = c(NA, 1L, NA, 1L, NA), q3.response1 = c(1L,
1L, NA, 1L, NA), q3.response2 = c(NA, 1L, NA, NA, NA), q3.response3 = c(1L,
NA, NA, 1L, NA), q3.response4 = c(1L, 1L, NA, NA, NA), q3.response5 = c(1L,
NA, NA, NA, NA)), .Names = c("id", "q1.response1", "q1.response2",
"q1.response3", "q1.response4", "q1.response5", "q2.response1",
"q2.response2", "q2.response3", "q2.response4", "q2.response5",
"q3.response1", "q3.response2", "q3.response3", "q3.response4",
"q3.response5"), class = "data.frame", row.names = c(NA, -5L))
A＆＃34; 1＆＃34;表示他们已经检查了该选项; NA表示他们没有。
我要做的是为5个用户中的每个用户计算以下内容：
，其中n i 是出现在特定问题组合中的回复数，以及i = 1，...，2 k ，其中k是多项选择题的数量。
例如，如果另一个人对3个多重响应问题做出响应（如上例所示），则5个响应选项中的每一个将仅属于2个 3 = 8个可能的组合组合中的1个：
1）仅在问题1中选择的响应选项
2）仅在问题2中选择的响应选项
3）仅在问题3中选择的响应选项
4）在问题1和2中选择的响应选项
5）在问题1和3中选择的响应选项
6）在问题2和3中选择的响应选项
7）在问题1,2和3中选择的响应选项
8）未选择的响应选项
例如，对于样本数据中的受访者＃1：
1）仅在问题1中选择的响应选项：无= 0响应
2）仅在问题2中选择的响应选项：响应2 = 1响应
3）仅在问题3中选择的响应选项：响应3，响应5 = 2响应
4）问题1和2中选择的响应选项：无= 0响应
5）问题1和3中选择的响应选项：响应1 = 1响应
6）在问题2和3中选择的响应选项：无= 0响应
7）在问题1,2和3中选择的响应选项：响应4 = 1响应
8）根本未选择的响应选项：无= 0响应
所以这位受访者的得分是：
（0 * LOG2（0））+（1级*的log 2（1））+（2 * LOG2（2））+（0 * LOG2（0））+（1级*的log 2（1））+（0 *的log 2（ 0））+（1 * log2（1））+（0 * log2（0））= 2
知道如何在R中编写代码吗？
1 个答案:
答案 0 :(得分：3)
我要做的第一件事就是将数据转换为长格式。有很多方法可以做到这一点，例如基本R reshape()函数和reshape2包，但实际上我决定通过使用构造函数构造一个新的data.frame来手动执行此操作。函数data.frame()以及对rep()的一些精心编写的调用。这种方法还取决于将原始data.frame（减去我单独实例化的初始id列）展平为向量as.matrix()，然后c()，它跟随原始数据< em>跨行然后跨列。 rep()调用必须设计为与该订单一致。
mydata;
## id q1.response1 q1.response2 q1.response3 q1.response4 q1.response5 q2.response1 q2.response2 q2.response3 q2.response4 q2.response5 q3.response1 q3.response2 q3.response3 q3.response4 q3.response5
## 1 1 1 NA NA 1 NA NA 1 NA 1 NA 1 NA 1 1 1
## 2 2 NA 1 1 1 1 1 NA 1 NA 1 1 1 NA 1 NA
## 3 3 1 1 1 1 1 NA 1 NA NA NA NA NA NA NA NA
## 4 4 NA NA 1 NA NA NA 1 1 NA 1 1 NA 1 NA NA
## 5 5 1 NA NA 1 NA NA 1 NA 1 NA NA NA NA NA NA
NU <- nrow(mydata);
NQ <- 3;
NO <- 5;
long <- data.frame(id=rep(mydata$id,NQ*NO),question=rep(1:NQ,each=NO*NU),option=rep(1:NO,each=NU,NQ),response=c(as.matrix(mydata[-1])));
long;
## id question option response
## 1 1 1 1 1
## 2 2 1 1 NA
## 3 3 1 1 1
## 4 4 1 1 NA
## 5 5 1 1 1
## 6 1 1 2 NA
## 7 2 1 2 1
## 8 3 1 2 1
## 9 4 1 2 NA
## 10 5 1 2 NA
## 11 1 1 3 NA
## 12 2 1 3 1
## 13 3 1 3 1
## 14 4 1 3 1
## 15 5 1 3 NA
## 16 1 1 4 1
## 17 2 1 4 1
## 18 3 1 4 1
## 19 4 1 4 NA
## 20 5 1 4 1
## 21 1 1 5 NA
## 22 2 1 5 1
## 23 3 1 5 1
## 24 4 1 5 NA
## 25 5 1 5 NA
## 26 1 2 1 NA
## 27 2 2 1 1
## 28 3 2 1 NA
## 29 4 2 1 NA
## 30 5 2 1 NA
## 31 1 2 2 1
## 32 2 2 2 NA
## 33 3 2 2 1
## 34 4 2 2 1
## 35 5 2 2 1
## 36 1 2 3 NA
## 37 2 2 3 1
## 38 3 2 3 NA
## 39 4 2 3 1
## 40 5 2 3 NA
## 41 1 2 4 1
## 42 2 2 4 NA
## 43 3 2 4 NA
## 44 4 2 4 NA
## 45 5 2 4 1
## 46 1 2 5 NA
## 47 2 2 5 1
## 48 3 2 5 NA
## 49 4 2 5 1
## 50 5 2 5 NA
## 51 1 3 1 1
## 52 2 3 1 1
## 53 3 3 1 NA
## 54 4 3 1 1
## 55 5 3 1 NA
## 56 1 3 2 NA
## 57 2 3 2 1
## 58 3 3 2 NA
## 59 4 3 2 NA
## 60 5 3 2 NA
## 61 1 3 3 1
## 62 2 3 3 NA
## 63 3 3 3 NA
## 64 4 3 3 1
## 65 5 3 3 NA
## 66 1 3 4 1
## 67 2 3 4 1
## 68 3 3 4 NA
## 69 4 3 4 NA
## 70 5 3 4 NA
## 71 1 3 5 1
## 72 2 3 5 NA
## 73 3 3 5 NA
## 74 4 3 5 NA
## 75 5 3 5 NA
这是一个如何使用reshape()来完成同样事情的演示。如您所见，这需要连续两次调用reshape()，因为我们需要将option变量和question变量都加宽。这两列的顺序最终与我上面创建的相反，但这是间接的。请注意，这种方法使我们无需在转换之前手动存储（或导出理论上可以完成的）NQ和NO，但代价是安抚怪癖的复杂性。 reshape()函数。
long1 <- transform(structure(reshape(mydata,dir='l',varying=2:ncol(mydata),timevar='option'),reshapeLong=NULL),option=as.integer(sub('^response','',option,perl=T)));
long2 <- transform(structure(reshape(long1,dir='l',idvar=c('id','option'),varying=3:ncol(long1),timevar='question',sep=''),reshapeLong=NULL),question=as.integer(question),response=q,q=NULL);
rownames(long2) <- NULL;
identical(long,long2[names(long)]);
## [1] TRUE
下一步是确定每个用户的哪些选项属于哪个类别。 “类别”我指的是用户选择该特定选项的问题组合。您的公式需要首先总结每个类别中的选项数量。
最初，我想通过将每个问题视为二进制数字并总结每个选择的位值加权数值，将每个用户对特定选项的选择标准化为单个数字。因此，例如，如果用户在问题1和3上选择了特定选项，但在问题2上选择不，那么这将是二进制101，其将标准化为5.这是结果，使用{ {3}}按id和option分组：
combo <- aggregate(cbind(category=response)~id+option,long,function(x) sum(x*2^(length(x):1-1),na.rm=T),na.action=na.pass);
combo;
## id option category
## 1 1 1 5
## 2 2 1 3
## 3 3 1 4
## 4 4 1 1
## 5 5 1 4
## 6 1 2 2
## 7 2 2 5
## 8 3 2 6
## 9 4 2 2
## 10 5 2 2
## 11 1 3 1
## 12 2 3 6
## 13 3 3 4
## 14 4 3 7
## 15 5 3 0
## 16 1 4 7
## 17 2 4 5
## 18 3 4 4
## 19 4 4 0
## 20 5 4 6
## 21 1 5 1
## 22 2 5 6
## 23 3 5 4
## 24 4 5 2
## 25 5 5 0
然而，我意识到这种方法很容易导致问题。问题是它需要乘以最多可扩展到2 k -1 的位置值。对于你的特定情况， k 是20，所以这只是524288，这是完全可管理的，但想象一下，如果你有100个问题;最大的地方价值是633825300114114700748351602688！这不适合32位整数，所以它将被转换为double（大约6.33825300114115e + 29），这将搞砸我们下一步要做的整个聚合（敬请关注），因为附近的类别会被“舍入”在一起，因为双倍的浮动绝对精度。
我想过如何解决这个问题，并意识到只需切换到该类别的字符串表示最有意义。这将使我们能够处理大量问题，同时仍然提供类别的简单且易于比较的表示。我还手动将其设置为因子而不是字符向量，稍后对aggregate()调用有用。所以，这是改进的解决方案，再次使用aggregate()按id和option进行分组：
combo <- aggregate(cbind(category=response)~id+option,long,function(x) factor(paste(replace(x,is.na(x),0),collapse='')),na.action=na.pass);
combo;
## id option category
## 1 1 1 101
## 2 2 1 011
## 3 3 1 100
## 4 4 1 001
## 5 5 1 100
## 6 1 2 010
## 7 2 2 101
## 8 3 2 110
## 9 4 2 010
## 10 5 2 010
## 11 1 3 001
## 12 2 3 110
## 13 3 3 100
## 14 4 3 111
## 15 5 3 000
## 16 1 4 111
## 17 2 4 101
## 18 3 4 100
## 19 4 4 000
## 20 5 4 110
## 21 1 5 001
## 22 2 5 110
## 23 3 5 100
## 24 4 5 010
## 25 5 5 000
作为一种替代方案，为了节省字符，我们可以使用比上述二进制字符串更紧凑的编码。这是构建十六进制字符串的相当复杂的代码行：
combo <- aggregate(cbind(category=response)~id+option,long,function(x) factor(paste(c(0:9,letters[1:6])[colSums(matrix(c(rep(0,ceiling(length(x)/4)*4-length(x)),x)*2^(3:0),4),na.rm=T)+1],collapse='')),na.action=na.pass);
combo;
## id option category
## 1 1 1 5
## 2 2 1 3
## 3 3 1 4
## 4 4 1 1
## 5 5 1 4
## 6 1 2 2
## 7 2 2 5
## 8 3 2 6
## 9 4 2 2
## 10 5 2 2
## 11 1 3 1
## 12 2 3 6
## 13 3 3 4
## 14 4 3 7
## 15 5 3 0
## 16 1 4 7
## 17 2 4 5
## 18 3 4 4
## 19 4 4 0
## 20 5 4 6
## 21 1 5 1
## 22 2 5 6
## 23 3 5 4
## 24 4 5 2
## 25 5 5 0
请注意此结果与前面给出的位置值解决方案的相同之处。这只是因为这个样本数据只有3个问题，因此只有8个类别，这些类别没有扩展到十六进制字母范围。另一方面，相同性很好地证明了两种解决方案如何使用一种数值表示，使用实际整数的位值解决方案，以及使用十六进制字符串的此解决方案。
下一步是汇总类别，总结 n i log 2 n 我 适用于所有类别。
现在，由于 n i = 0的加数为零，我们实际上不必为每个添加值可能的类别;我们可以忽略那些不存在的。这是幸运的，因为有2个 k 类别，这对于大型 k 来说会变得很大。换句话说，我们所要做的就是总结数据中表示的每个类别的表达式以获得结果。此外，由于 n i = 1，加数也为零，因为log 2 （1）= 0，我们可以删除每个类别少于2个成分的人。因此我们有：
res <- aggregate(cbind(score=category)~id,combo,function(x) { nc <- tabulate(x); nc <- nc[nc>1]; sum(nc*log2(nc)); });
res;
## id score
## 1 1 2
## 2 2 4
## 3 3 8
## 4 4 2
## 5 5 2
这是一个非常复杂的问题，我可能在某个地方犯了错误，所以请检查我的工作！
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？