Simulation based density and distribution functions of visual inference under a multiple choice lineup

Source: R/multi.r

Simulation based p value to observe x or more picks of the data plot in K evaluations of a multiple choice lineup test under the assumption that the data plot is consistent with the null hypothesis. We distinguish between three different scenarios:

  • Scenario I: in each of K evaluations a different data set and a different set of (m-1) null plots is shown.

  • Scenario II: in each of K evaluations the same data set but a different set of (m-1) null plots is shown.

  • Scenario III: the same lineup, i.e. same data and same set of null plots, is shown to K different observers.

dmulti(x, K, k, m = 20, type = "scenario3", N = 5000)

pmulti(x, K, k, m = 20, type = "scenario3", N = 5000)

qmulti(q, K, k, m = 20, type = "scenario3", N = 5000)

Arguments

x

(vector) of the number of observed data picks

K

integer value, specifying the number of participants/evaluations

k

(vector) of integer values of the number of observed picks in a multiple choice lineup evaluation

m

lineup size, defaults to m=20

type

character, one of "scenario1", "scenario2", or "scenario3"

N

integer value, number of simulations.

q

(vector) of the number of observed data picks

Value

list consisting of two named items:

  • dmulti: density estimates and vector k

  • pmulti: distribution estimates and vector k

  • qmulti: quantile estimates and vector k

Examples

k=rpois(5,lambda=1)+1
m=20
dmulti(0:5,K=5,k=k, type="scenario1", m)
#> $density
#> [1] 0.6572 0.2894 0.0482 0.0052 0.0000 0.0000
#> 
#> $k
#> [1] 1 1 2 2 2
#> 
## compare to Poisson Binomial:
library(poibin)
dpoibin(0:5, pp=k/m)
#> [1] 0.6579225 0.2885625 0.0492750 0.0040750 0.0001625 0.0000025

qmulti(c(0.95, 0.99), K=5, k=2)
#> $quantile
#> 0.95 0.99 
#>    2    3 
#> 
#> $k
#> [1] 2
#> 

if (FALSE) { # \dontrun{
(k <- rpois(5, lambda=1.5)+1)
reps1 <- plyr::ldply(1:10, function(x) dmulti(0:5, 5, k, type="scenario1")$density)
reps2 <- plyr::ldply(1:10, function(x) dmulti(0:5, 5, k, type="scenario2")$density)
reps3 <- plyr::ldply(1:10, function(x) dmulti(0:5, 5, k, type="scenario3")$density)
reps1$type <- "I"
reps2$type <- "II"
reps3$type <- "III"
reps <- rbind(reps1, reps2, reps3)
library(reshape2)
library(RColorBrewer)
cols <- brewer.pal(8, "Paired")

mr <- melt(reps, measure.vars=1:6)
mr$variable <- as.numeric(gsub("V", "", mr$variable))
mr$type <- factor(mr$type)
mr$offset <- with(mr, 0.1*c(0,-1,1)[as.numeric(type)])
qplot(variable+offset, value, data=mr, alpha=I(0.75), colour=type) +
  geom_point(aes(x=1:6, y=dpoibin(0:5, pp=k*1/m)), pch=1, size=4,
    inherit.aes=FALSE)+
  xlab("x")+ylab("P(X=x)")+ggtitle(paste(k, collapse=",")) +
  theme_bw() + scale_colour_manual(values=cols[-c(1,3,5,6,7)])
 } # }