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
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)
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.
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.
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.
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.
Vector of allowable stimulus values.
N, for number of presentations and H, for the entropy of the pdf.
Value for number of presentations (stopType=N), or Entropy (stopType=H).
Maximum number of presentations regardless of stopType.
If both minInterStimInterval and maxInterStimInterval
are not NA, then between each stimuli there is a random wait period drawn uniformly
between minInterStimInterval and maxInterStimInterval.
minInterStimInterval.
verbose=0 does nothing, verbose=1 stores pdfs for returning,
and verbose=2 stores pdfs and also prints each presentation.
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
Current state of the KTPsi as returned by (eg) KTPsi.start.
The next stimulus to present in a suitable format for passing to opiPresent
Currently ignored.
Either "expectation" or "MAP".
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.
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.
dbTocd, opiPresent
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...
if (FALSE) {
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]
}
}
Run the code above in your browser using DataLab