Выравнивание количества испытаний в двух подмножествах данных на основе перекрывающихся распределений

Question

Я провел эксперимент, в котором субъекты (n = 14) должны были реагировать на клавиатуре на раздражители, представленные на экране.Они могут получить денежный штраф за неправильные ответы в двух разных условиях -> эти два условия в следующих случаях называются штрафом 4 и штрафом 14.Я измерил время решения (DT) этих предметов в задаче среди других переменных.Все данные представлены в таблице с именем «OutputTable_Online».Вот как выглядит OutputTable_Online (верхняя часть): OutputTable_Online (нижняя часть):

То, что я хочу сделать, - это усреднить переменные с именем «amp_RFDI_sb», «amp_RAPB_sb», «amp_RADM_sb»"для каждого Subjectnbr и каждого штрафа в зависимости от StimType.Вся информация, которая мне нужна, находится в OutputTable_Online, как видно на изображениях выше.Вот код, который я использую для этого:

Melt_OutputTable_Online <- melt(OutputTable_Online, 
                       id.var = c('Subjectnbr', 'Penalty','Trial_Nbr', 
'StimType'), measure.var = c('ampl_RFDI_sb', 'ampl_RAPB_sb', 'ampl_RADM_sb', 
'ampl_LFDI_sb', 'ampl_LAPB_sb', 'ampl_LADM_sb', 'ampl_RFDI_ss', 
'ampl_RAPB_ss', 'ampl_RADM_ss', 'ampl_LFDI_ss', 'ampl_LAPB_ss', 
'ampl_LADM_ss', 'ampl_RFDI_sm', 'ampl_RAPB_sm', 'ampl_RADM_sm', 
'ampl_LFDI_sm', 'ampl_LAPB_sm', 'ampl_LADM_sm', 'ampl_RFDI_sl', 
'ampl_RAPB_sl', 'ampl_RADM_sl', 'ampl_LFDI_sl', 'ampl_LAPB_sl', 
'ampl_LADM_sl'))

Cast_Melt_OutputTable_Online <- cast(Melt_OutputTable_Online, 
Subjectnbr * Penalty ~ StimType * variable, mean)

Вот результат этого процесса:

Однако, как и ожидалось, распределение DT смещается вправо, когданаказание было 14, поскольку субъекты дольше ожидали ответа (они были более осторожны).Следовательно, средний DT больше в штрафной 14, чем в штрафной 4.

Распределения плотности на уровне группы для штрафа 4 (черный) и штрафа 14 (зеленый) представлены на рисунке здесь;вертикальные линии представляют среднее на уровне группы. Вот код, который я использовал для построения этого графика:

OutputTable_Online_DT <- ddply(OutputTable_Online, "Penalty", summarise, 
grp.mean=mean(DT))

Density_OutputTable_Online <- ggplot(OutputTable_Online, aes(x = DT, 
fill=Penalty))
Density_OutputTable_Online <- Density_OutputTable_Online + 
geom_density(aes(y = ..count.., group=Penalty), alpha=0.2)+
geom_vline(data=OutputTable_Online_DT,aes(xintercept=grp.mean, 
color=Penalty),linetype="dashed", size=1)+ ggtitle("Density distributions 
for both penalty conditions") + scale_color_manual(labels = c("P4", "P14"), 
values = c("black", "green"))+ scale_fill_manual(labels = c("P4", "P14"), 
values = c("black", "green"))+ labs(x = "DT (ms)", y = "Density of trials 
(a.u.)")+ coord_cartesian(ylim=c(0, 3.5), xlim=c(0, 3000))
Density_OutputTable_Online

Вот моя проблема: когда я делаю усреднение для переменных «amp_RFDI_sb», «amp_RAPB_sb"," amp_RADM_sb "и т. д., как описано выше, полученные средние значения могут фактически зависеть от DT (то есть, поскольку DT отличается в 2 штрафных условиях).Я хотел бы избавиться от этого мешающего фактора.Для этого ** я хотел бы гомогенизировать среднее значение DT по двум условиям наказания по каждому предмету.Я думал, что один из способов сделать это - выбрать для каждого субъекта испытания, представленные во фракции распределений, указанных выше, которые перекрывают друг друга (то есть, когда зеленый распределитель перекрывает черный распределитель).Другими словами, я хотел бы иметь одинаковое распределение испытаний в каждом условии штрафа в OutputTable_Online, когда я строю график распределения плотности DT перед выполнением процедуры усреднения для переменных «amp_RFDI_sb», «amp_RAPB_sb», «amp_RADM_sb» и т. Д.

Один из способов сделать это - выровнять число испытаний в условиях Штрафа 4 и Штрафа 14 в каждой корзине DT.Однако я понятия не имею, как это сделать, основываясь на данных, представленных в OutputTable_Online, как описано выше. **

Любой совет будет очень кстати.

Заранее благодарю за помощь

Джерард

Answer 1

Чтобы иметь возможность получить один и тот же DT в обоих вышеупомянутых условиях штрафа, я поднастроил таблицу на основе бинов DT (используя функцию подмножества) и гомогенизировал для каждого бина количество испытаний в каждом условии на основе условияэто было наименьшее количество испытаний.Для этого я использовал функцию «образец».Я сделал это для каждого предмета таблицы, используя цикл for.Вот код:

# Loop for each Subject.
for (s in c(unique(DF_ampl_sb$Subjectnbr)))
{
tmp1<- subset(DF_ampl_sb,subset=Subjectnbr==s)
tmp2<- subset(tmp1,subset=DT>1&DT<=250)
tmp3<- subset(tmp1,subset=DT>250&DT<=500)
tmp4<- subset(tmp1,subset=DT>500&DT<=750)
tmp5<- subset(tmp1,subset=DT>750&DT<=1000)
tmp6<- subset(tmp1,subset=DT>1000&DT<=1250)
tmp7<- subset(tmp1,subset=DT>1250&DT<=1500)
tmp8<- subset(tmp1,subset=DT>1500&DT<=1750)
tmp9<- subset(tmp1,subset=DT>1750&DT<=2000)
tmp10<- subset(tmp1,subset=DT>2000&DT<=2250)
tmp11<- subset(tmp1,subset=DT>2250&DT<=2500)
tmp12<- subset(tmp1,subset=DT>2500&DT<=2750)
tmp13<- subset(tmp1,subset=DT>2750&DT<=3000)

tmp2_Penalty1<- subset(tmp2,subset=Penalty==1)
tmp2_Penalty2<- subset(tmp2,subset=Penalty==2)

tmp2_Penalty1<- tmp2_Penalty1[sample(nrow(tmp2_Penalty1), min(dim(tmp2_Penalty2) 
[1],dim(tmp2_Penalty1)[1])), ]
tmp2_Penalty2<- tmp2_Penalty2[sample(nrow(tmp2_Penalty2), min(dim(tmp2_Penalty2) 
[1],dim(tmp2_Penalty1)[1])), ]

tmp3_Penalty1<- subset(tmp3,subset=Penalty==1)
tmp3_Penalty2<- subset(tmp3,subset=Penalty==2)

tmp3_Penalty1<- tmp3_Penalty1[sample(nrow(tmp3_Penalty1), min(dim(tmp3_Penalty2)[1],dim(tmp3_Penalty1)[1])), ]
tmp3_Penalty2<- tmp3_Penalty2[sample(nrow(tmp3_Penalty2), min(dim(tmp3_Penalty2)[1],dim(tmp3_Penalty1)[1])), ]

tmp4_Penalty1<- subset(tmp4,subset=Penalty==1)
tmp4_Penalty2<- subset(tmp4,subset=Penalty==2)

tmp4_Penalty1<- tmp4_Penalty1[sample(nrow(tmp4_Penalty1), min(dim(tmp4_Penalty2) 
[1],dim(tmp4_Penalty1)[1])), ]
tmp4_Penalty2<- tmp4_Penalty2[sample(nrow(tmp4_Penalty2), min(dim(tmp4_Penalty2) 
[1],dim(tmp4_Penalty1)[1])), ]

tmp5_Penalty1<- subset(tmp5,subset=Penalty==1)
tmp5_Penalty2<- subset(tmp5,subset=Penalty==2)

tmp5_Penalty1<- tmp5_Penalty1[sample(nrow(tmp5_Penalty1), min(dim(tmp5_Penalty2) 
[1],dim(tmp5_Penalty1)[1])), ]
tmp5_Penalty2<- tmp5_Penalty2[sample(nrow(tmp5_Penalty2), min(dim(tmp5_Penalty2) 
[1],dim(tmp5_Penalty1)[1])), ]

tmp6_Penalty1<- subset(tmp6,subset=Penalty==1)
tmp6_Penalty2<- subset(tmp6,subset=Penalty==2)

tmp6_Penalty1<- tmp6_Penalty1[sample(nrow(tmp6_Penalty1), min(dim(tmp6_Penalty2)[1],dim(tmp6_Penalty1)[1])), ]
tmp6_Penalty2<- tmp6_Penalty2[sample(nrow(tmp6_Penalty2), min(dim(tmp6_Penalty2)[1],dim(tmp6_Penalty1)[1])), ]

tmp7_Penalty1<- subset(tmp7,subset=Penalty==1)
tmp7_Penalty2<- subset(tmp7,subset=Penalty==2)

tmp7_Penalty1<- tmp7_Penalty1[sample(nrow(tmp7_Penalty1), min(dim(tmp7_Penalty2)[1],dim(tmp7_Penalty1)[1])), ]
tmp7_Penalty2<- tmp7_Penalty2[sample(nrow(tmp7_Penalty2), min(dim(tmp7_Penalty2)[1],dim(tmp7_Penalty1)[1])), ]

tmp8_Penalty1<- subset(tmp8,subset=Penalty==1)
tmp8_Penalty2<- subset(tmp8,subset=Penalty==2)

tmp8_Penalty1<- tmp8_Penalty1[sample(nrow(tmp8_Penalty1), min(dim(tmp8_Penalty2) 
[1],dim(tmp8_Penalty1)[1])), ]
tmp8_Penalty2<- tmp8_Penalty2[sample(nrow(tmp8_Penalty2), min(dim(tmp8_Penalty2) 
[1],dim(tmp8_Penalty1)[1])), ]

tmp9_Penalty1<- subset(tmp9,subset=Penalty==1)
tmp9_Penalty2<- subset(tmp9,subset=Penalty==2)

tmp9_Penalty1<- tmp9_Penalty1[sample(nrow(tmp9_Penalty1), min(dim(tmp9_Penalty2) 
[1],dim(tmp9_Penalty1)[1])), ]
tmp9_Penalty2<- tmp9_Penalty2[sample(nrow(tmp9_Penalty2), min(dim(tmp9_Penalty2) 
[1],dim(tmp9_Penalty1)[1])), ]

tmp10_Penalty1<- subset(tmp10,subset=Penalty==1)
tmp10_Penalty2<- subset(tmp10,subset=Penalty==2)

tmp10_Penalty1<- tmp10_Penalty1[sample(nrow(tmp10_Penalty1), min(dim(tmp10_Penalty2) 
[1],dim(tmp10_Penalty1)[1])), ]
tmp10_Penalty2<- tmp10_Penalty2[sample(nrow(tmp10_Penalty2), min(dim(tmp10_Penalty2) 
[1],dim(tmp10_Penalty1)[1])), ]

tmp11_Penalty1<- subset(tmp11,subset=Penalty==1)
tmp11_Penalty2<- subset(tmp11,subset=Penalty==2)

tmp11_Penalty1<- tmp11_Penalty1[sample(nrow(tmp11_Penalty1), min(dim(tmp11_Penalty2) 
[1],dim(tmp11_Penalty1)[1])), ]
tmp11_Penalty2<- tmp11_Penalty2[sample(nrow(tmp11_Penalty2), min(dim(tmp11_Penalty2) 
[1],dim(tmp11_Penalty1)[1])), ]

tmp12_Penalty1<- subset(tmp12,subset=Penalty==1)
tmp12_Penalty2<- subset(tmp12,subset=Penalty==2)

tmp12_Penalty1<- tmp12_Penalty1[sample(nrow(tmp12_Penalty1), min(dim(tmp12_Penalty2) 
[1],dim(tmp12_Penalty1)[1])), ]
tmp12_Penalty2<- tmp12_Penalty2[sample(nrow(tmp12_Penalty2), min(dim(tmp12_Penalty2) 
[1],dim(tmp12_Penalty1)[1])), ]

tmp13_Penalty1<- subset(tmp13,subset=Penalty==1)
tmp13_Penalty2<- subset(tmp13,subset=Penalty==2)

tmp13_Penalty1<- tmp13_Penalty1[sample(nrow(tmp13_Penalty1), min(dim(tmp13_Penalty2) 
[1],dim(tmp13_Penalty1)[1])), ]
tmp13_Penalty2<- tmp13_Penalty2[sample(nrow(tmp13_Penalty2), min(dim(tmp13_Penalty2) 
[1],dim(tmp13_Penalty1)[1])), ]


# Add the content to the data frame (DF_rms_sb) by binding the data (row-binding).
DF_ampl_sb_tmp <- rbind (DF_ampl_sb_tmp,tmp2_Penalty1, tmp2_Penalty2, tmp3_Penalty1, 
tmp3_Penalty2, tmp4_Penalty1, tmp4_Penalty2, tmp5_Penalty1, tmp5_Penalty2, 
tmp6_Penalty1, tmp6_Penalty2, tmp7_Penalty1, tmp7_Penalty2, tmp8_Penalty1, 
tmp8_Penalty2, tmp9_Penalty1, tmp9_Penalty2, tmp10_Penalty1, tmp10_Penalty2, 
tmp11_Penalty1, tmp11_Penalty2, tmp12_Penalty1, tmp12_Penalty2,tmp13_Penalty1, 
tmp13_Penalty2)

# Remove objects from a specified environment.
rm(tmp1, tmp2_Penalty1, tmp2_Penalty2, tmp3_Penalty1, tmp3_Penalty2, tmp4_Penalty1, 
tmp4_Penalty2, tmp5_Penalty1, tmp5_Penalty2, tmp6_Penalty1, tmp6_Penalty2, 
tmp7_Penalty1, tmp7_Penalty2, tmp8_Penalty1, tmp8_Penalty2, tmp9_Penalty1, 
tmp9_Penalty2, tmp10_Penalty1, tmp10_Penalty2, tmp11_Penalty1, tmp11_Penalty2, 
tmp12_Penalty1, tmp12_Penalty2, tmp13_Penalty1, tmp13_Penalty2)

}
}
dim(DF_ampl_sb_tmp)
DF_ampl_sb <- DF_ampl_sb_tmp

Возможно, существует другой способ подстановки таблицы, здесь я определил бины вручную в цикле (т. Е. От tmp2 до tmp13).Тем не менее, это уже работает довольно хорошо.Вот вид дистрибутива, который я получаю до использования кода: введите описание изображения здесь

И после этого, используя его: введите описание изображения здесь

Gerard