Equalize number of trials in two data subsets based on overlapping distributions - r

Question

I did an experiment where subjects (n = 14) had to respond on a keyboard to stimuli presented on a screen. They could get a monetary penalty for incorrect responses in two different conditions --> these two conditions are called Penalty 4 and Penalty 14 in the followings. I measured the decision time (DT) of these subjects in the task among other variables.
All the data are present in a table called 'OutputTable_Online'. Here is what OutputTable_Online looks like (top part):
OutputTable_Online (bottom part):
What I want to do is to average the variables named "ampl_RFDI_sb", "ampl_RAPB_sb", "ampl_RADM_sb" for each 'Subjectnbr' and each 'Penalty' as a function of the 'StimType'. All the information I need is in OutputTable_Online as can be seen in the images above. Here is the code I use for this:
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)
Here is the output of this process:
However, as expected, the DT distribution is shifted to the right when the penalty was 14 as subjects waited longer to respond (they were more cautious). Hence, the average DT is longer in the Penalty 14 than in the Penalty 4 condition.
The group-level density distributions for Penalty 4 (black) and Penalty 14 (green) are represented on the figure here; vertical lines represent the group-level average. Here is the code I used to plot this:
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
Here is my issue: when I do the averaging for the variables "ampl_RFDI_sb", "ampl_RAPB_sb", "ampl_RADM_sb", etc as described above, the resulting averages could actually depend on the DT (i.e., as DT is different in the 2 penalty conditions). I would like to get rid of this confounding factor. To do so, **I would like to homogenize the average DT across the two penalty conditions in each subject. I was thinking that one way to do so would be to select in each subject the trials present in the fraction of the distributions plotted above that overlap each other (i.e., where the green distrib overlap the black distrib). Put differently, I would like to have the same distribution of trials in each penalty condition in OutputTable_Online when I plot the density distribution of DTs before doing the averaging procedure for the variables "ampl_RFDI_sb", "ampl_RAPB_sb", "ampl_RADM_sb", etc.
One way to do this would be to equalize the number trials in the Penalty 4 and Penalty 14 conditions in each DT bin. However, I have no idea of how to do this based on the data present in OutputTable_Online as described above.**
Any tip would be very welcome.
Thank you in advance for your help,
Gerard

Answer 1

To be able to get the same DT in both penalty conditions above, I subsetted the table based on bins of DT (using the subset function) and homogenized, for each bin, the number of trials in each condition based on the condition that had the lowest number of trials. To do so, I used the "sample" function. I did that for each subject of the table using a for loop. Here is the code:
# 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
There might be another way of subseting the table, here I defined the bins manually in the loop (i.e. from tmp2 to tmp13). However, it already works pretty well. Here is the kind of distribution I obtain before using the code: enter image description here
And after, using it:
enter image description here
Gerard