OPI (version 1.6)

ZEST: ZEST

Description

An implementation of the Bayesian test procedures of King-Smith et al. and Watson and Pelli. Note that we use the term pdf throughout as in the original paper, even though they are discrete probability functions in this implementation.

Usage

ZEST(domain=0:40, prior=rep(1/length(domain),length(domain)), 
     likelihood=sapply(domain,function(tt) {0.03+(1-0.03-0.03)*(1-pnorm(domain,tt,1))}),
     stopType="S", stopValue=1.5,
     minStimulus=head(domain,1), 
     maxStimulus=tail(domain,1),
     maxSeenLimit=2, minNotSeenLimit=2,
     maxPresentations=100,
     verbose=0, 
     makeStim, 
     stimChoice="mean",
     ...) 
ZEST.start(domain=0:40, prior=rep(1/length(domain),length(domain)), 
     likelihood=sapply(domain,function(tt) {0.03+(1-0.03-0.03)*(1-pnorm(domain,tt,1))}),
     stopType="S", stopValue=1.5,
     minStimulus=head(domain,1), 
     maxStimulus=tail(domain,1),
     maxSeenLimit=2, minNotSeenLimit=2,
     maxPresentations=100,
     makeStim, 
     stimChoice="mean",
     ...) 
ZEST.step(state, nextStim=NULL)
ZEST.stop(state)
ZEST.final(state)

Arguments

domain

Vector of values over which pdf is kept.

prior

Starting probability distribution over domain. Same length as domain.

likelihood

Matrix where likelihood[s,t] is likelihood of seeing s given t is the true threshold. That is, Pr(s|t) where s and t are indexes into domain.

stopType

N, for number of presentations; S, for standard deviation of the pdf; and H, for the entropy of the pdf.

stopValue

Value for number of presentations (stopType=N), standard deviation (stopType=S) or Entropy (stopType=H).

minStimulus

The smallest stimuli that will be presented. Could be different from domain[1].

maxStimulus

The largest stimuli that will be presented. Could be different from tail(domain,1).

minNotSeenLimit

Will terminate if minStimulus value is not seen this many times.

maxSeenLimit

Will terminate if maxStimulus value is seen this many times.

maxPresentations

Maximum number of presentations regarless of stopType.

verbose

verbose=0 does nothing, verbose=1 stores pdfs for returning, and verbose=2 stores pdfs and also prints each presentaion.

makeStim

A function that takes a dB value and numPresentations and returns an OPI datatype ready for passing to opiPresent. See examples.

stimChoice

A true ZEST procedure uses the "mean" of the current pdf as the stimulus, but "median" and "mode" (as used in a QUEST procedure) are provided for your enjoyment.

...

Extra parameters to pass to the opiPresent function

state

Current state of the ZEST returned by ZEST.start and ZEST.step.

nextStim

A valid object for opiPresent to use as its nextStim.

Value

• Single location{

  ZEST returns a list containing

  • npres:
  { Total number of presentations used.}

• respSeq:
  Response sequence stored as a matrix: row 1 is dB values, row 2 is 1/0 for seen/not-seen.
• pdfs:
  If verbose is bigger than 0, then this is a list of the pdfs used for each presentation, otherwise NULL.
• final
  The mean/median/mode of the final pdf, depending on stimChoice, which is the determined threshold.
• }

subsection

Multilple locations

code

median

itemize

• state:

item

• pdf:
• numPresentations:
• stimuli:
• responses:
• responseTimes:
• resp:

Details

This is an implementation of King-Smith et al.'s ZEST procedure and Watson and Pelli's QUEST procedure. All presentaions are rounded to an element of the supplied domain.

Note this function will repeatedly call opiPresent for a stimulus until opiPresent returns NULL (ie no error occured).

If more than one ZEST is to be interleaved (for example, testing multiple locations), then the ZEST.start, ZEST.step, ZEST.stop and ZEST.final calls can maintain the state of the ZEST after each presentation, and should be used. If only a single ZEST is required, then the simpler ZEST can be used. See examples below.

References

P.E. King-Smith, S.S. Grigsny, A.J. Vingrys, S.C. Benes, and A. Supowit. "Efficient and Unbiased Modifications of the QUEST Threshold Method: Theory, Simulations, Experimental Evaluation and Practical Implementation", Vision Research 34(7) 1994. Pages 885-912.

A.B. Watson and D.G. Pelli. "QUEST: A Bayesian adaptive psychophysical method", Perception and Psychophysics 33 1983. Pages 113-l20.

Please cite: A. Turpin, P.H. Artes and A.M. McKendrick "The Open Perimetry Interface: An enabling tool for clinical visual psychophysics", Journal of Vision 12(11) 2012.

http://perimetry.org/OPI

See Also

dbTocd, opiPresent

Examples

chooseOpi("SimHenson")
if (!is.null(opiInitialize(type="C", cap=6)))
    stop("opiInitialize failed")

    ##############################################
    # This section is for single location ZESTs
    ##############################################

    # Stimulus is Size III white-on-white as in the HFA
makeStim <- function(db, n) { 
    s <- list(x=9, y=9, level=dbTocd(db), size=0.43, color="white",
             duration=200, responseWindow=1500)
    class(s) <- "opiStaticStimulus"

    return(s)
}

repp <- function(...) sapply(1:50, function(i) ZEST(makeStim=makeStim, ...))
a <- repp(stopType="H", stopValue=  3, verbose=0, tt=30, fpr=0.03)
b <- repp(stopType="S", stopValue=1.5, verbose=0, tt=30, fpr=0.03)
c <- repp(stopType="S", stopValue=2.0, verbose=0, tt=30, fpr=0.03)
d <- repp(stopType="N", stopValue= 50, verbose=0, tt=30, fpr=0.03)
e <- repp(prior=dnorm(0:40,m=0,s=5), tt=30, fpr=0.03)
f <- repp(prior=dnorm(0:40,m=10,s=5), tt=30, fpr=0.03)
g <- repp(prior=dnorm(0:40,m=20,s=5), tt=30, fpr=0.03)
h <- repp(prior=dnorm(0:40,m=30,s=5), tt=30, fpr=0.03)

layout(matrix(1:2,1,2))
boxplot(lapply(list(a,b,c,d,e,f,g,h), function(x) unlist(x["final",])))
boxplot(lapply(list(a,b,c,d,e,f,g,h), function(x) unlist(x["npres",])))

    ##############################################
    # This section is for multiple ZESTs
    ##############################################
makeStimHelper <- function(db,n, x, y) {  # returns a function of (db,n)
    ff <- function(db, n) db+n

    body(ff) <- substitute(
        {s <- list(x=x, y=y, level=dbTocd(db), size=0.43, color="white",
                  duration=200, responseWindow=1500)
         class(s) <- "opiStaticStimulus"
         return(s)
        }
        , list(x=x,y=y))
    return(ff)
}

    # List of (x, y, true threshold) triples
locations <- list(c(9,9,30), c(-9,-9,32), c(9,-9,31), c(-9,9,33))

    # Setup starting states for each location
states <- lapply(locations, function(loc) {
    ZEST.start(
        domain=-5:45,
        minStimulus=0,
        maxStimulus=40,
        makeStim=makeStimHelper(db,n,loc[1],loc[2]),
        stopType="S", stopValue= 1.5, tt=loc[3], fpr=0.03, fnr=0.01)
})

    # Loop through until all states are "stop"
while(!all(st <- unlist(lapply(states, ZEST.stop)))) {
    i <- which(!st)                         # choose a random, 
    i <- i[runif(1, min=1, max=length(i))]  # unstopped state
    r <- ZEST.step(states[[i]])             # step it
    states[[i]] <- r$state                  # update the states
}

finals <- lapply(states, ZEST.final)    # get final estimates of threshold
for(i in 1:length(locations)) {
    #cat(sprintf("Location (%+2d,%+2d) ",locations[[i]][1], locations[[i]][2]))
    #cat(sprintf("has threshold %4.2f\n", finals[[i]]))
}

if (!is.null(opiClose()))
    warning("opiClose() failed")