R 如何在成对的参与者中获得四种可能结果之一的观察频率？

我有一个关于参与者对二元（例如，正确或不正确）问题（干预前后）的第一个和第二个答案的答案数据集。第一个答案不一致的参与者在第二个答案之前分成两组。使用R，我需要计算出配对参与者以下结果的频率

错误的变为正确的，正确的保留 他们的回答

正确的人改为不正确的人，错误的人保留他们的答案

两人都保留了第一个答案

两者都会更改其第一个答案（即切换）

相关变量如下：

• 组号。这是分配给个人和对的。因此，只有重复的组数表示对
• 第一个和第二个答案（针对每位参与者）

玻璃钢 第一 第二 条件 2. 0 0 独奏 3. 0 0 一对 3. 1. 0 一对 4. 0 0 独奏 5. 0 1. 一对 ... ... ... ...

库（dplyr）
我的_数据%>%
过滤器（条件==“对”）%>%
计数（Grp，`1st`，`2nd`）%>%
分组依据（Grp）%>%
变异（份额=n/总和（n））%>%
解组（）
#Grp`1st``2nd`n份
#      
#1     3     0     0     1   0.5
#2     3     1     0     1   0.5
#3     5     0     1     1   1  

铸造和绘制数据似乎很有效。如下所示：

widerData <- data %>%
  select(-participant) %>%
  pivot_wider(names_from = id_in_group,
              values_from = c(first_answer, second_answer)) %>%
  mutate(
    typology = case_when(
      treatment %in% treatments &
        second_answer_1 + second_answer_2 == 2 ~ 'Both changed to correct',
      treatment %in% treatments &
        second_answer_1 + second_answer_2 == 0 ~ 'Both changed to incorrect',
      treatment %in% treatments &
        second_answer_1 == 0 &
        second_answer_2 == 1 ~ 'Both kept old positions',
      treatment %in% treatments &
        second_answer_1 == 1 & second_answer_2 == 0 ~ 'Position interchange',
      !(treatment %in% treatments)  &
        first_answer_1 == second_answer_1 ~ 'Single old position kept',
      !(treatment %in% chat_treatments)  &
        first_answer_1 != second_answer_1 ~ 'Single position changed'
    )
  )

bar_fun <- function(df) {
  df %>%
    group_by(treatment, typology) %>%
    tally() %>%
    group_by(treatment) %>%
    mutate(freq = n / sum(n)) %>%
    ggplot(aes(x = typology, y = freq, fill=freq)) + geom_bar(stat = 'identity',show.legend = FALSE) +
    facet_wrap(~ treatment) +
    theme(axis.text.x = element_text(angle = 90)) +
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    geom_text(
      aes(label = percent_format(accuracy = 1)(freq)),
      position = position_dodge(width = 0.9),
      vjust = -0.25
    )+
    ylab('Share of participants')+
    ylim(0,1)
  
}
bar_fun(widerData%>% filter((treatment %in% treatments)))

widerData%
选择（-participant）%>%
pivot\u更宽（名称\u from=id\u在\u组中，
值\u from=c（第一个\u答案，第二个\u答案））%>%
变异(
类型学=案例(
治疗%（以%治疗为单位）&
第二个答案\u 1+第二个答案\u 2==2~'都更改为正确'，
治疗%（以%治疗为单位）&
第二个答案\u 1+第二个答案\u 2==0~'都更改为不正确'，
治疗%（以%治疗为单位）&
第二个答案=0&
第二个_答案_2==1~‘两人都保持原来的位置’，
治疗%（以%治疗为单位）&
第二个答案=1和第二个答案=0~‘位置交换’，
！（治疗百分比占治疗百分比）&
第一个答案=第二个答案~‘保留单个旧位置’，
！（治疗百分比在%chat\u治疗中）&
第一个答案第1！=第二个答案第1~‘单位置已更改’
)
)
酒吧乐趣%
分组依据（治疗、类型学）%>%
计数（）%>%
（治疗组）%>%
变异（频率=n/和（n））%>%
ggplot（aes（x=类型，y=频率，fill=频率））+geom_条形图（stat='identity'，show.legend=FALSE）+
小平面包裹（~处理）+
主题（axis.text.x=元素\文本（角度=90））+
比例连续（标签=比例：：百分比格式（精度=1））+
geom_文本(
aes（标签=百分比格式（精度=1）（频率）），
位置=位置减淡（宽度=0.9），
vjust=-0.25
)+
ylab（“参与者份额”）+
ylim（0,1）
}
bar_fun（宽数据%>%过滤器（（治疗百分比中的治疗百分比）））

---

请参见

您是否有可能使用

dput（）

添加一些数据（甚至是假的），以便我们能为您提供更多帮助？另外：我为无法制作的帖子道歉。如果我有时间，我会设法解决这个问题。唉，我现在已经到了每周可以花在这个模拟数据上的时间限制。谢谢你的链接。正如你们所展示的，这确实提供了一个新的表格，但它向我展示了每个参与者在他们组中所占的百分比。由于小组规模为1或2，每个参与者都是其小组的100%（1）或50%（0.5）。我需要的是参与者群体反应的百分比（我在OP中提到的四个百分比）。无论如何谢谢你！然后，您可能希望查看

tidyr:：complete

，以显示每组的所有组合；上面的代码仅显示在数据中找到的组合。

widerData <- data %>%
  select(-participant) %>%
  pivot_wider(names_from = id_in_group,
              values_from = c(first_answer, second_answer)) %>%
  mutate(
    typology = case_when(
      treatment %in% treatments &
        second_answer_1 + second_answer_2 == 2 ~ 'Both changed to correct',
      treatment %in% treatments &
        second_answer_1 + second_answer_2 == 0 ~ 'Both changed to incorrect',
      treatment %in% treatments &
        second_answer_1 == 0 &
        second_answer_2 == 1 ~ 'Both kept old positions',
      treatment %in% treatments &
        second_answer_1 == 1 & second_answer_2 == 0 ~ 'Position interchange',
      !(treatment %in% treatments)  &
        first_answer_1 == second_answer_1 ~ 'Single old position kept',
      !(treatment %in% chat_treatments)  &
        first_answer_1 != second_answer_1 ~ 'Single position changed'
    )
  )

bar_fun <- function(df) {
  df %>%
    group_by(treatment, typology) %>%
    tally() %>%
    group_by(treatment) %>%
    mutate(freq = n / sum(n)) %>%
    ggplot(aes(x = typology, y = freq, fill=freq)) + geom_bar(stat = 'identity',show.legend = FALSE) +
    facet_wrap(~ treatment) +
    theme(axis.text.x = element_text(angle = 90)) +
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    geom_text(
      aes(label = percent_format(accuracy = 1)(freq)),
      position = position_dodge(width = 0.9),
      vjust = -0.25
    )+
    ylab('Share of participants')+
    ylim(0,1)
  
}
bar_fun(widerData%>% filter((treatment %in% treatments)))