R: An implementation of Kontsevich and Tyler Psi algorithm.

KTPsi {OPI}

R Documentation

An implementation of Kontsevich and Tyler `\Psi` algorithm.

Description

An implementation of Kontsevich and Tyler (Vis Res 39 (1999) pages 2729–2737 default parameterised for Standard Automated Perimetry. based on A. Turpin, D. Jankovic and A.M. McKendrick, "Identifying Steep Psychometric Function Slope Quickly in Clinical Applications", Vision Research, 50(23). November 2010. Pages 2476-2485

Usage

KTPsi(
  domains = list(slopes = 1:5, thresholds = 20:40, fps = c(0, 0.025, 0.05, 0.1, 0.2), fns
    = c(0, 0.025, 0.05, 0.1, 0.2)),
  priors = list(slopes = rep(1, length(domains$slopes))/length(domains$slopes),
    thresholds = rep(1, length(domains$thresholds))/length(domains$thresholds), fps =
    rep(1, length(domains$fps))/length(domains$fps), fns = rep(1,
    length(domains$fns))/length(domains$fns)),
  stimValues = 17:40,
  stopType = "N",
  stopValue = 140,
  maxPresentations = 200,
  minInterStimInterval = NA,
  maxInterStimInterval = NA,
  verbose = 0,
  makeStim,
  ...
)

KTPsi.start(
  domains = list(slopes = 1:5, thresholds = 20:40, fps = c(0, 0.025, 0.05, 0.1, 0.2), fns
    = c(0, 0.025, 0.05, 0.1, 0.2)),
  priors = list(slopes = rep(1, length(domains$slopes))/length(domains$slopes),
    thresholds = rep(1, length(domains$thresholds))/length(domains$thresholds), fps =
    rep(1, length(domains$fps))/length(domains$fps), fns = rep(1,
    length(domains$fns))/length(domains$fns)),
  stimValues = 17:40,
  stopType = "N",
  stopValue = 140,
  maxPresentations = 200,
  minInterStimInterval = NA,
  maxInterStimInterval = NA,
  verbose = 0,
  makeStim,
  ...
)

KTPsi.step(state, nextStim = NULL, fixedStimValue = NA)

KTPsi.final(state, method = "expectation")

KTPsi.stop(state)

Arguments

`domains`	A list of 4 vectors: `slopes` The valid slopes in the domain of psychometric functions. `thresholds` The valid thresholds in the domain of psychometric functions. `fps` The valid upper asymptotes (false positives) in the domain of psychometric functions. `fns` The valid lower asymptotes (false negatives) in the domain of psychometric functions.
`priors`	A list of 4 vectors: `slopes` The prior probability vector for `domains$slopes`. `thresholds` The prior probability vector for `domains$thresholds`. `fps` The prior probability vector for `domains$fps`. `fns` The prior probability vector for `domains$fns`. Each prior should the same length as its `domains` counterpart and sum to 1.
`stimValues`	Vector of allowable stimulus values.
`stopType`	`N`, for number of presentations and `H`, for the entropy of the pdf.
`stopValue`	Value for number of presentations (`stopType=N`), or Entropy (`stopType=H`).
`maxPresentations`	Maximum number of presentations regardless of `stopType`.
`minInterStimInterval`	If both `minInterStimInterval` and `maxInterStimInterval` are not `NA`, then between each stimuli there is a random wait period drawn uniformly between `minInterStimInterval` and `maxInterStimInterval`.
`maxInterStimInterval`	`minInterStimInterval`.
`verbose`	`verbose=0` does nothing, `verbose=1` stores pdfs for returning, and `verbose=2` stores pdfs and also prints each presentation.
`makeStim`	A function that takes a stimulus value and numPresentations and returns an OPI datatype ready for passing to opiPresent. See examples.
`...`	Extra parameters to pass to the opiPresent function
`state`	Current state of the KTPsi as returned by (eg) `KTPsi.start`.
`nextStim`	The next stimulus to present in a suitable format for passing to `opiPresent`
`fixedStimValue`	Currently ignored.
`method`	Either `"expectation"` or `"MAP"`.

Details

The assumed psychometric function is the cumulative Gaussian:

\mbox{fp}+(1-\mbox{fp}-\mbox{fn})(1-\mbox{pnorm}(x, \mbox{threshold}, \mbox{slope})

hence domain$slopes are standard deviations and domain$thresholds are the mean.

While it is assumed that domains$thresholds and stimValues are in dB, this need not be the case. As long as the makeStim function converts stimValues into cd/\mbox{m}^2 for the opiPresent function, then any units should work.

The checkFixationOK function is called (if present in stim made from makeStim) after each presentation, and if it returns FALSE, the pdf for that state is not changed (ie the presentation is ignored), but the stim, number of presentations etc is recorded in the state.

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

Value

Single location

KTPsi returns a list containing

npres Total number of presentations used.
respSeq Response sequence stored as a matrix: row 1 is dB values of stimuli, row 2 is 1/0 for seen/not-seen, row 3 is fixated 1/0 (always 1 if checkFixationOK not present in stim objects returned from makeStim).
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.
opiResp A list of responses received from each successful call to opiPresent within KTPsi.

Multilple locations

KTPsi.start returns a list that can be passed to KTPsi.step, KTPsi.stop, and KTPsi.final. It represents the state of a KTPsi at a single location at a point in time and contains the following.

name KTPsi
A copy of all of the parameters supplied to KTPsi.start: domains, priors, stimValues, stopType, stopValue, maxPresentations, makeStim and opiParams.
psi A matrix where psi[domain_index, stim] is the probability of seeing stim assuming the psychometric function for the domain index domain_index.
labels A text representation of psi[domain_index, ], or the the psychometric function for the domain index domain_index.
pdf Current pdf: vector of probabilities the same length as product of lengths of domain elements.
numPresentations The number of times KTPsi.step has been called on this state.
stimuli A vector containing the stimuli used at each call of KTPsi.step.
responses A vector containing the responses received at each call of KTPsi.step.
responseTimes A vector containing the response times received at each call of KTPsi.step.
fixated A vector containing TRUE/FALSE if fixation was OK according to checkFixationOK for each call of KTPsi.step (defaults to TRUE if checkFixationOK not present).
opiResp A list of responses received from each call to opiPresent within KTPsi.step.

KTPsi.step returns a list containing

stat: The new state after presenting a stimuli and getting a response.
resp The return from the opiPresent call that was made.

KTPsi.stop returns TRUE if the KTPsi has reached its stopping criteria, and FALSE otherwise.

KTPsi.final returns an estimate of threshold based on state based on its parameter.

TRUE if the state has reached its stopping criteria, and FALSE otherwise.

References

Kontsevich and Tyler. Vision Research 39 (1999) pages 2729–2737.

A. Turpin, D. Jankovic and A.M. McKendrick, "Identifying Steep Psychometric Function Slope Quickly in Clinical Applications", Vision Research, 50(23). November 2010. Pages 2476-2485

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.

Examples

chooseOpi("SimGaussian")
if(!is.null(opiInitialize(sd = 2)$err))
  stop("opiInitialize failed")

     # This section is for single location KTPsi
     # 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, checkFixationOK=NULL)
  class(s) <- "opiStaticStimulus"
  return(s)
}

KTPsi(makeStim = makeStim, stopType="H", stopValue=  3, tt=30, fpr=0.03)
KTPsi(makeStim = makeStim, stopType="N", stopValue= 27, verbose = 0, tt=30, fpr=0.03)

     # For multiple locations...
## Not run: 
states <- lapply(1:10, function(loc) KTPsi.start(makeStim = makeStim))
unfinished <- 1:10
while (length(unfinished) > 0) {
     loc <- unfinished[[1]]
     states[[loc]] <- KTPsi.step(states[[loc]])$state
     if (KTPsi.stop(states[[loc]]))
         unfinished <- unfinished[-1]
}

## End(Not run)

[Package OPI version 3.0.2 Index]

An implementation of Kontsevich and Tyler \Psi algorithm.