如何在 R 中的三个条件下为两个指标创建散点图

问题描述

我想创建一个有点复杂的条形图,在其中显示有关参与者如何看待 40 个视频的数据。我有一个视频数据列表,其中前 10 个归类为“中性”,接下来的 10 个归类为“令人愉快”,接下来的 10 个归类为“令人不快”,最后十个归类为“痛苦”。对于每个视频,我都有平均威胁和唤醒分数(所有参与者的数据)。我需要显示四个类别的平均威胁和唤醒分数(因此是平均值),还需要显示每个类别中个人 (10) 个视频的数据。我想显示一个条形图,其中包含每个类别的治疗和唤醒平均值,并且还有散布在该类别中的每个视频的威胁和分数。因此将有 4 组 2 个均值(唤醒和威胁)条形图,每个条形图都有散点图。我希望这是有道理的。

这是我的数据框:

structure(list(`YouTube Video` = c(2,4,6,23,13,84,1,27,89,82,79,78,88,87,68,75,69,81,70,85,62,14,52,60,17,21,41,50,57,65,37,39,33,29,12,28,56,35,54,64
),Description = c("single touch with finger","repeated tap with finger (slow)","single touch with flat hand","single push with a spoon","single touch with pen","single touch with cotton bud","Repeated touch with finger (fast)","single push with a plastic whisk","single touch with plastic brush","repeated touch with cotton bud","long stroke with soft brush all over the hand","single stroke top to bottom with soft brush","repeated stroke with plastic brush","single stroke top to bottom with plastic brush","stroke top to bottom with shawl","(long) stroke with multiple fingers all over the hand","stroke with soft sock","single stroke top to bottom with cotton pad","(long) stroke with finger all over the hand","touch top to bottom with fabric","touch top to bottom with scissors","repeated touch with pencil","touch top to bottom with hammer","single push with tip of pencil","repeated touch with rolling pin","repeated touch with Metal chopstick","injection with blunt syringe","single (long) hard push with thumb","single touch with nail file","stroke top to bottom with stanley knife","single stab with nail file","single stab with scissors","scratch top to bottom with scissors","single pinch with tweezers","repeated touch with nail file","single injection with sharp needle","single punch with hand","repeated touch with knife","repeated touch with screwdriver"
),`URL embedded` = c("https://www.youtube-nocookie.com/embed/DGrxS_mWwDg","https://www.youtube-nocookie.com/embed/4LCl3lFTI5A","https://www.youtube-nocookie.com/embed/hZUtrE-RKm4","https://www.youtube-nocookie.com/embed/PP-1YXwLlRY","https://www.youtube-nocookie.com/embed/9kbi3SeqTvA","https://www.youtube-nocookie.com/embed/FrptTIFnmBw","https://www.youtube-nocookie.com/embed/mvZ-J93FhB8","https://www.youtube-nocookie.com/embed/oMD7Mx59g8g","https://www.youtube-nocookie.com/embed/xidtijNKyyQ","https://www.youtube-nocookie.com/embed/eUFhskpG23o","https://www.youtube-nocookie.com/embed/yTOtXyxZwwA","https://www.youtube-nocookie.com/embed/qWqE4EwoQhE","https://www.youtube-nocookie.com/embed/ZqdKx5F1Znk","https://www.youtube-nocookie.com/embed/LiRUSe-EkBU","https://www.youtube-nocookie.com/embed/oAppP1G7v_8","https://www.youtube-nocookie.com/embed/oqKfHwrQwDA","https://www.youtube-nocookie.com/embed/Q5HmjP90gNg","https://www.youtube-nocookie.com/embed/qhjl0GC5rCg","https://www.youtube-nocookie.com/embed/Uh_zkgSw54c","https://www.youtube-nocookie.com/embed/VTlA9jr738k","https://www.youtube-nocookie.com/embed/cuaHBe4I_Ow","https://www.youtube-nocookie.com/embed/X-3k3azNHMI","https://www.youtube-nocookie.com/embed/4hoUl6LOHA8","https://www.youtube-nocookie.com/embed/6EntuJ9nykI","https://www.youtube-nocookie.com/embed/n5aF28PZAcU","https://www.youtube-nocookie.com/embed/bK1XMN1WLEs","https://www.youtube-nocookie.com/embed/7Mld2Gte0zI","https://www.youtube-nocookie.com/embed/IFMtXP4F--I","https://www.youtube-nocookie.com/embed/NZQmIbMjej0","https://www.youtube-nocookie.com/embed/cuI6qKt53ns","https://www.youtube-nocookie.com/embed/_EdsOk7w9l4","https://www.youtube-nocookie.com/embed/DF77B8-cgNs","https://www.youtube-nocookie.com/embed/u8zIL3z18QQ","https://www.youtube-nocookie.com/embed/-t4gHLk4yCY","https://www.youtube-nocookie.com/embed/VfbW0tYdwZQ","https://www.youtube-nocookie.com/embed/5fg_D5MPGTo","https://www.youtube-nocookie.com/embed/vDCH3xNFTss","https://www.youtube-nocookie.com/embed/0mHsdkv9hzM","https://www.youtube-nocookie.com/embed/T-SrpmKS1ts","https://www.youtube-nocookie.com/embed/k5WDZ5hIijY"),Neutral = c(85,76,74,8,16,26,30,19,22,11,9,2,5,6),Pleasant = c(8,24,90,80,72,71,66,1),Unpleasant = c(8,10,15,20,61,59,36,38,40,45,50),Painful = c(0,18,25,34,48,42,42),`Mean Threat` = c("1.4","1.5","1.6","1.9","1.4","1.8","1.3","1.2","5.6","3.2","5.2","2.9","4.0","3.4","3.5","5.5","6.6","8.0","7.8","7.1","4.5","6.3","6.7","6.2","5.0","6.5","5.4"),`Mean Arousal` = c("1.7","2.2","2.1","2.0","2.3","5.3","4.8","3.9","4.6","3.3","4.2","4.7","3.0","3.1","3.8","4.4","6.0","4.9","5.1","4.6"),total_pts_sensations = c(55,104,47,43,162,139,137,131,143,177,151,117,164,116,105,67,133,109,123,150,196,191,182,141,148,181,77,134,128),MeanIntensity = c(2.8,2.7,3.2,3.5,2.6,2.9,3.4,2.8,3.6,3.7,3.9,3.8,3.3,4.4,4.2,4.8,4.1,4)),spec = structure(list(
    cols = list(Video_YouTube = structure(list(),class = c("collector_double","collector")),Video_Questionnaire = structure(list(),Description = structure(list(),class = c("collector_character",`URL embedded` = structure(list(),Neutral = structure(list(),class = c("collector_logical",Pleasant = structure(list(),Unpleasant = structure(list(),Painful = structure(list(),`Mean Threat` = structure(list(),`Mean Arousal` = structure(list(),"collector"))),default = structure(list(),class = c("collector_guess",skip = 1),class = "col_spec"),row.names = c(NA,-40L),class = "data.frame")

解决方法

我建议采用不同的方法:将各个点绘制为“抖动”并添加一条线以显示每个类别的均值,以及分数类型的方面。

首先根据您的描述创建一些虚假数据(注意 - 在将数据添加到您的问题之前完成):

set.seed(1001)
dataset <- data.frame(video = 1:40,category = rep(c("neutral","pleasant","unpleasant","painful"),each = 10),threat = sample(1:10,40,replace = TRUE),arousal = sample(1:10,replace = TRUE))

我们需要一些 tidyverse 包:

library(tidyr) # to reshape the data
library(ggplot2)

然后重塑和绘图:

dataset %>% 
  pivot_longer(cols = c("threat","arousal")) %>% 
  ggplot(aes(category,value)) + 
  geom_jitter(aes(color = category),width = 0.2) + 
  stat_summary(geom = "crossbar",color = "red",fun = mean) + 
  facet_wrap(~name) + 
  guides(color = FALSE) +
  theme_bw()

结果:

enter image description here