#Simulate data when there is a perceptual bias and a response-based bias #Lines are short (-1) or long (1) #Response is short (0) or long (1) #Perceived line length (actual line length + perceptual bias + noise) #...is compared to the... #Internal criterion (actual line length + response bias) bias <- .13*6 #13% effect N <- 10 #Number of subjects sims <- 10000 #Number of trials/subject sd <- .065*6*3 #Sensitivity conds <- matrix(0,ncol=4,nrow=10) conds[,1] <- rep(c(5,7),5) #Line length conds[,2] <- c(-1,-1,1,1,0,0,0,0,0,0)*bias #Perceptual bias (-1 is akin to tails in; bias to see short) conds[,3] <- c(0,0,0,0,1,1,-1,-1,0,0)*bias #Response bias (-1 is bias to SAY long; 1 is bias to SAY short) conds[,4] <- c(1,1,2,2,3,3,4,4,5,5) #Condition label (1: tails in Percept, 2: tails out percept, 3: bias to say short, 4: bias to say long, 5: baseline) myH <- matrix(0,nrow=N,ncol=5) #one column for each condition myFA <- matrix(0,nrow=N,ncol=5) myD <- matrix(0,nrow=N,ncol=5) myC <- matrix(0,nrow=N,ncol=5) for (j in 1:N) { #N subjects percept <- matrix(0,nrow=sims,ncol=10) rsp <- matrix(0,nrow=sims,ncol=10) for (i in 1:10) { #10 trial types to simulate (5 conditions x 2 line lengths) ll<-conds[i,1] #Line Length pb<-conds[i,2] #Perceptual Bias rb<-conds[i,3] #Response bias ic <- mean(conds[,1])+rb #Internal criterion mu <- ll+pb #Line Length + Perceptual Bias #Add noise (determined by sensitivity) to perception percept[,i] <- rnorm(sims,mu,sd) #Compare percept to internal criterion rsp[,i] <- ifelse(percept[,i]>ic,1,0) } #End For condition loop myH[j,1] <- mean(rsp[,2]) #Hits = line is long (even) and say long (1) myH[j,2] <- mean(rsp[,4]) myH[j,3] <- mean(rsp[,6]) myH[j,4] <- mean(rsp[,8]) myH[j,5] <- mean(rsp[,10]) myFA[j,1] <- mean(rsp[,1]) #FA = lines is short (odd) and say long (1) myFA[j,2] <- mean(rsp[,3]) myFA[j,3] <- mean(rsp[,5]) myFA[j,4] <- mean(rsp[,7]) myFA[j,5] <- mean(rsp[,9]) myD[j,1] <- qnorm(mean(rsp[,2]))-qnorm(mean(rsp[,1])) #tails in percept myC[j,1] <- (qnorm(mean(rsp[,2]))+qnorm(mean(rsp[,1])))/-2 myD[j,2] <- qnorm(mean(rsp[,4]))-qnorm(mean(rsp[,3])) #tails out percept myC[j,2] <- (qnorm(mean(rsp[,4]))+qnorm(mean(rsp[,3])))/-2 myD[j,3] <- qnorm(mean(rsp[,6]))-qnorm(mean(rsp[,5])) #respond short myC[j,3] <- (qnorm(mean(rsp[,6]))+qnorm(mean(rsp[,5])))/-2 myD[j,4] <- qnorm(mean(rsp[,8]))-qnorm(mean(rsp[,7])) #respond long myC[j,4] <- (qnorm(mean(rsp[,8]))+qnorm(mean(rsp[,7])))/-2 myD[j,5] <- qnorm(mean(rsp[,10]))-qnorm(mean(rsp[,9])) #baseline myC[j,5] <- (qnorm(mean(rsp[,10]))+qnorm(mean(rsp[,9])))/-2 } #End for j SUBJECTS loop Ps <- matrix(0,ncol=6,nrow=2) #Statistical Tests, each row for comparison Px<- 1 #statistical comparisons (#s refer to condition #; compares tails in vs tails out (1 v 2), then compares say short to say long (3 v 4)) i <- c(1,3) j <- c(2,4) for (k in 1:length(i)) { a <- t.test(myD[,i[k]],myD[,j[k]],paired=T) #t-test for d' b <- t.test(myC[,i[k]],myC[,j[k]],paired=T) #t-test for c Ps[Px,1] <- i[k] Ps[Px,2] <- j[k] Ps[Px,3] <- a$statistic Ps[Px,4] <- a$p.value Ps[Px,5] <- b$statistic Ps[Px,6] <- b$p.value Px <- Px+1 } print(round(Ps,2)) par(mfrow=c(2,2)) par(mar=c(4,4,0,0)+0.1) boxplot(myD[,1:2],ylim=c(0,4),ylab="d'",pars=list(bty="n"),xlab="Tail Orientation",names=c("In","Out")) #PLOT d' for tails in vs tails out (perceptual bias) boxplot(myC[,1:2],ylim=c(-1,1),ylab="c",xlab="Tail Orientation",names=c("In","Out")) #PLOT c for tails in vs tails out (perceptual bias) boxplot(myD[,3:4],ylim=c(0,4),ylab="d'", xlab="Response Bias",names=c("Say Short","Say Long")) #PLOT d' for tails in vs tails out (response bias) boxplot(myC[,3:4],ylim=c(-1,1),ylab="c",xlab="Response Bia",names=c("Say Short","Say Long")) #PLOT c for tails in vs tails out (response bias) #Plot Figure 1 tiff(filename="C:/Users/jkwitt/Dropbox/SDT/Fig1.tiff", width = 6, height = 4, unit="in", res=600, antialias="cleartype") par(mfrow=c(1,2)) par(mar=c(4,4,0,0)+0.1) boxplot(myD[,1:2],ylim=c(0,4),ylab="d'",pars=list(bty="n"),xlab="Tail Orientation",names=c("In","Out")) #PLOT d' for tails in vs tails out (perceptual bias) boxplot(myC[,1:2],ylim=c(-1,1),ylab="c",xlab="Tail Orientation",names=c("In","Out")) #PLOT c for tails in vs tails out (perceptual bias) dev.off() #Plot Figure 2 #Params for Figure lt <- 2 #line thickness cx <- 1.2 #font lens <- c(5,7) #line lengths x <- seq(1,11,length.out=sims) #compute means meanD <- apply(myD,2,mean) meanC <- apply(myC,2,mean) #plot fig2 tiff(filename="C:/Users/jkwitt/Dropbox/SDT/Fig2NEW.tiff",width=5.2,height=8.2,units="in",res=600) nf <- layout(matrix(c(0,0,1,1,1,1,0,0,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5), 3, 8, byrow = TRUE), respect = F) layout.show(nf) #baseline par(xpd=TRUE) plot(x,dnorm(x,lens[1],sd),col="blue",type="l",lwd=lt,xlab="Perceived line length (cm)",bty="n",yaxt="n",ylab="",cex.lab=cx) legend(-3,.3,lwd=lt,c("Short lines","Long lines"),col=c("blue","red"),bty="n",cex=cx) #title(main="Baseline (No response bias, no perceptual bias)",cex=1,font=3) xFA <- x[x>mean(lens)] lines(x,dnorm(x,lens[2],sd),col="red",lwd=lt) dText <- paste("d' =", round(meanD[5],1), sep=" ") cText <- paste("c =", round(meanC[5],1), sep=" ") text(8.7,.25, dText,pos=4,cex=cx) text(8.7,.2, cText,pos=4,cex=cx) text(-.5,.45,"a",cex=2,pos=4) text(2,.45,"No response bias",cex=cx, pos=4) text(2,.4,"No perceptual bias",cex=cx, pos=4) par(xpd=FALSE) abline(v=mean(lens),col="purple",lwd=lt) #ResponseBias Less Conservative par(xpd=TRUE) plot(x,dnorm(x,lens[1],sd),col="blue",type="l",lwd=lt,xlab="Perceived line length (cm)",bty="n",yaxt="n",ylab="",cex.lab=cx) lines(x,dnorm(x,lens[2],sd),col="red",lwd=lt) dText <- paste("d' =", round(meanD[3],1), sep=" ") cText <- paste("c =", round(meanC[3],1), sep=" ") text(8.7,.25, dText,pos=4,cex=cx) text(8.7,.2, cText,pos=4,cex=cx) text(0,.45,"b",cex=2) text(.5,.45,"Response bias to say 'short'",cex=cx,pos=4) text(.5,.4,"No perceptual bias",cex=cx,pos=4) par(xpd=FALSE) abline(v=mean(lens)+bias,col="purple",lwd=lt) #ResponseBias More Conservative par(xpd=TRUE) plot(x,dnorm(x,lens[1],sd),col="blue",type="l",lwd=lt,xlab="Perceived line length (cm)",bty="n",yaxt="n",ylab="",cex.lab=cx) lines(x,dnorm(x,lens[2],sd),col="red",lwd=lt) dText <- paste("d' =", round(meanD[4],1), sep=" ") cText <- paste("c =", round(meanC[4],1), sep=" ") text(8.7,.25, dText,pos=4,cex=cx) text(8.7,.2, cText,pos=4,cex=cx) text(0,.45,"c",cex=2) text(.5,.45,"Response bias to say 'long'",cex=cx,pos=4) text(.5,.4,"No perceptual bias",cex=cx,pos=4) par(xpd=FALSE) abline(v=mean(lens)-bias,col="purple",lwd=lt) #tails-in Percept Bias par(xpd=TRUE) plot(x,dnorm(x,lens[1]-bias,sd),col="blue",type="l",lwd=lt,xlab="Perceived line length (cm)",bty="n",yaxt="n",ylab="",cex.lab=cx) lines(x,dnorm(x,lens[2]-bias,sd),col="red",lwd=lt) dText <- paste("d' =", round(meanD[1],1), sep=" ") cText <- paste("c =", round(meanC[1],1), sep=" ") text(8.7,.25, dText,pos=4,cex=cx) text(8.7,.2, cText,pos=4,cex=cx) text(0,.45,"d",cex=2) text(.5,.45,"No response bias",cex=cx,pos=4) text(.5,.4,"Perceptual bias towards shorter",cex=cx,pos=4) par(xpd=FALSE) abline(v=mean(lens),col="purple",lwd=lt) #tails-out Percept Bias par(xpd=TRUE) plot(x,dnorm(x,lens[1]+bias,sd),col="blue",type="l",lwd=lt,xlab="Perceived line length (cm)",bty="n",yaxt="n",ylab="",cex.lab=cx) lines(x,dnorm(x,lens[2]+bias,sd),col="red",lwd=lt) dText <- paste("d' =", round(meanD[2],1), sep=" ") cText <- paste("c =", round(meanC[2],1), sep=" ") text(8.7,.25, dText,pos=4,cex=cx) text(8.7,.2, cText,pos=4,cex=cx) text(-1,.45,"e",cex=2) text(.5,.45,"No response bias",cex=cx,pos=4) text(.5,.4,"Perceptual bias towards longer",cex=cx,pos=4) par(xpd=FALSE) abline(v=mean(lens),col="purple",lwd=lt) dev.off()