QUESTP: QUEST+
In OPI: Open Perimetry Interface
QUESTP R Documentation
QUEST+
Description
An implementation of the Bayesian test procedure QUEST+ by AB Watson.
This is mostly a translation of the MATLAB implementation by P Jones (see References).
Its use is similar to ZEST. The objective is to estimate parameters of a function
that defines the probability of responding stimuli. The steps are optimized based on entropy rather than
the mean or the mode of the current pdfs.
Usage
QUESTP(
Fun,
stimDomain,
paramDomain,
likelihoods = NULL,
priors = NULL,
stopType = "H",
stopValue = 4,
maxSeenLimit = 2,
minNotSeenLimit = 2,
minPresentations = 1,
maxPresentations = 100,
minInterStimInterval = NA,
maxInterStimInterval = NA,
verbose = 0,
makeStim,
...
)
QUESTP.Prior(state, priors = NULL)
QUESTP.Likelihood(state)
QUESTP.start(
Fun,
stimDomain,
paramDomain,
likelihoods = NULL,
priors = NULL,
stopType = "H",
stopValue = 4,
maxSeenLimit = 2,
minNotSeenLimit = 2,
minPresentations = 1,
maxPresentations = 100,
makeStim,
...
)
getTargetStim(state)
QUESTP.step(state, nextStim = NULL)
QUESTP.stop(state)
QUESTP.final(state, Choice = "mean")
QUESTP.stdev(state, WhichP = NULL)
QUESTP.entropy(state)
Arguments
Fun
Function to be evaluated, of the form pseen = function(stim, param){...}. Outputs a probability of seen.
stimDomain
Domain of values for the stimulus. Can be multi-dimensional (list, one element per dimension)
paramDomain
Domain of values for pdfs of the parameters in Fun. Can be multi-parametric (list, one element per parameter).
likelihoods
Pre-computed likelihoods if available (for QUESTP.start)
priors
Starting probability distributions for the parameter domains (list, one element per parameter)
stopType
N, for number of presentations; S, for standard deviation
of the pdf; and H, for the entropy of the pdf (default).
stopValue
Value for number of presentations (stopType=N), standard deviation
(stopType=S) or Entropy (stopType=H).
maxSeenLimit
Will terminate if maxStimulus value is seen this many times.
minNotSeenLimit
Will terminate if minStimulus value is not seen this many times.
minPresentations
Minimum number of presentations
maxPresentations
Maximum number of presentations regarless 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 presentaion.
makeStim
A function that takes a dB 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 QUESTP returned by QUESTP.start and QUESTP.step.
nextStim
A valid object for opiPresent to use as its nextStim.
Choice
How to compute final values in QUESTP.final ("mean","mode","median")
WhichP
Which parameter (numeric index) to monitor when calling QUESTP.stdev directly
(returns max(stdev) if unspecified)
Details
An implementation of the Bayesian test procedure QUEST+ by AB Watson.
This is mostly a translation of the MATLAB implementation by P Jones (see References).
Its use is similar to ZEST. The objective is to estimate parameters of a function
that defines the probability of responding to stimuli. The steps are optimized based on entropy rather than
the mean or the mode of the current pdfs.
The stimulus, parameter and response domain are separate and can be multidimensional.
Each parameter has its own pdf. For evaluation, the pdfs are chained as a long vector
(so no co-variances are considered). More complex functions will require larger combined pdfs
and longer computation time for likelihoods and updating at each step. In these cases, it is recommended
to pre-calculate the likelihoods using QUESTP.Likelihood and store them.
The function to be fitted needs to output a probability of seen (i.e. pseen = function(stim, param){...})
and must take stim and param as inputs. stim is a vector with length = number of stimulus dimensions
(in simple one-dimensional cases, the intensity in dB). param is a vector with length = number
of parameters to be fitted in Fun.
For example, QUEST+ can fit a Gaussian psychometric function with stimDomain = {0, 1,..., 39, 40} dB
and paramDomain = ({0, 1,..., 39, 40}; {0.5, 1,..., 5.5, 6}) dB for the mean and
standard deviation respectively. A standard ZEST procedure can be replicated by setting
stimDomain = {0, 1,..., 39, 40} dB and paramDomain = ({0, 1,..., 39, 40}; {1}) dB, i.e. by setting the
stimDomain = paramDomain for the mean and by having a static standard deviation = 1 dB. Note however that
the stimulus selection is always based on entropy and not on the mean/mode of the current pdf. See examples below
Note this function will repeatedly call opiPresent for a stimulus until opiPresent
returns NULL (ie no error occurred).
The checkFixationOK function is called (if present in stim made from makeStim)
after each presentation, and if it returns FALSE, the pdf for that location is not changed
(ie the presentation is ignored), but the stim, number of presentations etc is recorded in
the state.
If more than one QUESTP is to be interleaved (for example, testing multiple locations), then the
QUESTP.start, QUESTP.step, QUESTP.stop and QUESTP.final calls can maintain
the state of the QUESTP after each presentation, and should be used. If only a single QUESTP is
required, then the simpler QUESTP can be used, which is a wrapper for the four functions
that maintain state. See examples below.
Value
Single location
QUESTP returns a list containing
-
npres Total number of presentations used.
-
respSeq Response sequence stored as a data frame: column 1 is a string identified of a (potentially)
multidimensional stimulus values of stimuli (dimensions chained into a string), column 2
is 1/0 for seen/not-seen, column 3 is fixated 1/0 (always 1 if checkFixationOK not
present in stim objects returned from makeStim). All additional columns report each stimulus
dimension, one for each row.
-
pdfs If verbose is bigger than 0, then this is a list of the pdfs used for each presentation, otherwise NULL.
-
final The mean (default, strongly suggested)/median/mode of the parameters' pdf, depending on Choice.
-
opiResp A list of responses received from each successful call to opiPresent within QUESTP.
Multiple locations
QUESTP.start returns a list that can be passed to QUESTP.step, QUESTP.stop, and
QUESTP.final. It represents the state of a QUESTP at a single location at a point in time and contains the following.
-
name QUESTP
A copy of all of the parameters supplied to QUESTP.start: stimDomain,
paramDomain, likelihoods, priors, stopType, stopValue,
maxSeenLimit, minNotSeenLimit, minPresentations, maxPresentations,
makeStim, and opiParams.
-
pdf Current pdf: vector of probabilities, collating all parameter domains.
-
priorsP List of starting pdfs, one for each parameter.
-
numPresentations The number of times QUESTP.step has been called on this state.
-
stimuli A vector containing the stimuli used at each call of QUESTP.step.
-
responses A vector containing the responses received at each call of QUESTP.step.
-
responseTimes A vector containing the response times received at each call of QUESTP.step.
-
fixated A vector containing TRUE/FALSE if fixation was OK according to
checkFixationOK for each call of QUESTP.step (defaults to TRUE if
checkFixationOK not present).
-
opiRespA list of responses received from each call to opiPresent within QUESTP.step.
QUESTP.step returns a list containing
-
state The new state after presenting a stimuli and getting a response.
-
resp The return from the opiPresent call that was made.
QUESTP.stop returns TRUE if the QUESTP has reached its stopping criteria, and FALSE otherwise.
QUESTP.final returns an estimate of parameters based on state. If state$Choice
is mean then the mean is returned (the only one that really makes sense for QUEST+).
If state$Choice is mode then the
mode is returned. If state$Choice is median then the median is returned.
References
Andrew B. Watson; QUEST+: A general multidimensional Bayesian adaptive psychometric method.
Journal of Vision 2017;17(3):10. doi: https://doi.org/10.1167/17.3.10.
Jones, P. R. (2018). QuestPlus: a MATLAB implementation of the QUEST+ adaptive psychometric
method, Journal of Open Research Software, 6(1):27. doi: http://doi.org/10.5334/jors.195
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.
See Also
dbTocd, opiPresent
Examples
chooseOpi("SimHenson")
if(!is.null(opiInitialize(type="C", cap=6)))
stop("opiInitialize failed")
#########################################################
# This section is for single location QUESTP
# This example fits a FoS curve
# Note: only fitting threshold and slope,
# modify the domain for FPR and FNR to fit those as well
#########################################################
# 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)
}
#True parameters (variability is determined according to Henson et al. based on threshold)
loc <- list(threshold = 20, fpr = 0.05, fnr = 0.05)
#Function to fit (Gaussian psychometric function)
pSeen <- function(x, params){return(params[3] +
(1 - params[3] - params[4]) *
(1 - pnorm(x, params[1], params[2])))}
#QUEST+
QP <- QUESTP(Fun = pSeen,
stimDomain = list(0:50),
paramDomain = list(seq(0, 40, 1), #Domain for the 50% threshold (Mean)
seq(.5, 8, .5), #Domain for the slope (SD)
seq(0.05, 0.05, 0.05), #Domain for the FPR (static)
seq(0.05, 0.05, 0.05)), #Domain for the FNR (static)
stopType="H", stopValue=4, maxPresentations=500,
makeStim = makeStim,
tt=loc$threshold, fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
#Plots results
#Henson's FoS function (as implemented in OPI - ground truth)
HensFunction <- function(Th){
SD <- exp(-0.081*Th + 3.27)
SD[SD > 6] <- 6
return(SD)
}
#Stimulus domain
dB_Domain <- 0:50
FoS <- pSeen(dB_Domain, params = QP$final) # Estimated FoS
FoS_GT <- pSeen(dB_Domain, params = c(loc$threshold, HensFunction(loc$threshold),
loc$fpr, loc$fnr)) #Ground truth FoS (based on Henson et al.)
#Plot (seen stimuli at the top, unseen stimuli at the bottom)
plot(dB_Domain, FoS_GT, type = "l", ylim = c(0, 1), xlab = "dB", ylab = "% seen", col = "blue")
lines(dB_Domain, FoS, col = "red")
points(QP$respSeq$stimuli, QP$respSeq$responses, pch = 16,
col = rgb(red = 1, green = 0, blue = 0, alpha = 0.1))
legend("top", inset = c(0, -.2),legend = c("True","Estimated","Stimuli"),
col=c("blue", "red","red"), lty=c(1,1,0),
pch = c(16, 16, 16), pt.cex = c(0, 0, 1),
horiz = TRUE, xpd = TRUE, xjust = 0)
if (!is.null(opiClose()))
warning("opiClose() failed")
chooseOpi("SimHenson")
if(!is.null(opiInitialize(type="C", cap=6)))
stop("opiInitialize failed")
######################################################################
# This section is for single location QUESTP
# This example shows that QUEST+ can replicate a ZEST procedure
# by fitting a FoS curve with fixed Slope, FPR and FNR
# Compared with ZEST
# Note that QUEST+ should be marginally more efficient in selecting
# the most informative stimulus
######################################################################
# 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)
}
#True parameters (variability is determined according to Henson et al. based on threshold)
loc <- list(threshold = 30, fpr = 0.03, fnr = 0.03)
#Function to fit (Gaussian psychometric function - Fixed slope (same as default likelihood in ZEST))
pSeen <- function(domain, tt){{0.03+(1-0.03-0.03)*(1-pnorm(domain,tt,1))}}
# ZEST-like QUEST+ procedure
QP <- QUESTP(Fun = pSeen,
stimDomain = list(0:40),
paramDomain = list(seq(0, 40, 1)),
stopType="S", stopValue=1.5, maxPresentations=500,
makeStim = makeStim,
tt=loc$threshold, fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
# ZEST
ZE <- ZEST(domain = 0:40,
stopType="S", stopValue=1.5, maxPresentations=500,
makeStim = makeStim,
tt=loc$threshold, fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
#Plots results
#Henson's FoS function (as implemented in OPI - ground truth)
HensFunction <- function(Th){
SD <- exp(-0.081*Th + 3.27)
SD[SD > 6] <- 6
return(SD)
}
#Stimulus domain
dB_Domain <- 0:50
FoS_QP <- pSeen(domain = dB_Domain, tt = QP$final) # Estimated FoS
FoS_ZE <- pSeen(domain = dB_Domain, tt = ZE$final) # Estimated FoS
#Plot (seen stimuli at the top, unseen stimuli at the bottom)
plot(dB_Domain, FoS_QP, type = "l", ylim = c(0, 1), xlab = "dB", ylab = "% seen", col = "blue")
lines(dB_Domain, FoS_ZE, col = "red")
points(QP$respSeq$stimuli, QP$respSeq$responses, pch = 16,
col = rgb(red = 0, green = 0, blue = 1, alpha = 0.5))
points(ZE$respSeq[1,], ZE$respSeq[2,], pch = 16,
col = rgb(red = 1, green = 0, blue = 0, alpha = 0.5))
legend("bottomleft", legend = c("QUEST+","ZEST","Stimuli QUEST+", "Stimuli ZEST"),
col=c("blue", "red","blue","red"), lty=c(1,1,0,0),
pch = c(16, 16, 16, 16), pt.cex = c(0, 0, 1, 1),
horiz = FALSE, xpd = TRUE, xjust = 0)
abline(v = loc$threshold, lty = "dashed")
if (!is.null(opiClose()))
warning("opiClose() failed")
chooseOpi("SimHenson")
if(!is.null(opiInitialize(type="C", cap=6)))
stop("opiInitialize failed")
#########################################################
# This section is for single location QUESTP
# This example fits a broken stick spatial summation function
# with a multi-dimensional stimulus (varying in size and intensity).
# Stimulus sizes are limited to GI, GII, GIII, GIV and GV.
# The example also shows how to use a helper function to
# simulate responses to multi-dimensional stimuli
# (here, the simulated threshold varies based on stimulus size)
#########################################################
makeStim <- function(stim, n) {
s <- list(x=9, y=9, level=dbTocd(stim[1]), size=stim[2], color="white",
duration=200, responseWindow=1500, checkFixationOK=NULL)
class(s) <- "opiStaticStimulus"
return(s)
}
# Helper function for true threshold (depends on log10(stimulus size),
# diameter assumed to be the second element of stim vector)
ttHelper_SS <- function(location) { # returns a function of (stim)
ff <- function(stim) stim
body(ff) <- substitute(
{return(SensF(log10(pi*(stim[2]/2)^2), c(location$Int1, location$Int2, location$Slo2)))}
)
return(ff)
}
# Function of sensivity vs SSize (log10(stimulus area))
SensF <- function(SSize, params){
Sens <- numeric(length(SSize))
for (i in 1:length(SSize)){
Sens[i] <- min(c(params[1] + 10*SSize[i], params[2] + params[3]*SSize[i]))
}
Sens[Sens < 0] <- 0
return(Sens)
}
Sizes <- c(0.1, 0.21, 0.43, 0.86, 1.72)
#True parameters (variability is determined according to Henson et al. based on threshold)
loc <- list(Int1 = 32, Int2 = 28, Slo2 = 2.5, fpr = 0.05, fnr = 0.05, x = 9, y = 9)
# Function to fit (probability of seen given a certain stimulus intensity and size,
# for different parameters)
pSeen <- function(stim, params){
Th <- SensF(log10(pi*(stim[2]/2)^2), params)
return(0.03 +
(1 - 0.03 - 0.03) *
(1 - pnorm(stim[1], Th, 1)))
}
set.seed(111)
#QUEST+ - takes some time to calculate likelihoods
## Not run:
QP <- QUESTP(Fun = pSeen,
stimDomain = list(0:50, Sizes),
paramDomain = list(seq(0, 40, 1), # Domain for total summation intercept
seq(0, 40, 1), # Domain for partial summation intercept
seq(0, 3, 1)), # Domain for partial summation slope
stopType="H", stopValue=1, maxPresentations=500,
makeStim = makeStim,
ttHelper=ttHelper_SS(loc), tt = 30,
fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
#Stimulus sizes
G <- log10(c(pi*(0.1/2)^2, pi*(0.21/2)^2, pi*(0.43/2)^2, pi*(0.86/2)^2, pi*(1.72/2)^2));
SizesP <- seq(min(G), max(G), .05)
# True and estimated response
Estim_Summation <- SensF(SizesP, params = QP$final) # Estimated spatial summation
GT_Summation <- SensF(SizesP, params = c(loc$Int1, loc$Int2, loc$Slo2)) # True spatial summation
#Plot
plot(10^SizesP, GT_Summation, type = "l", ylim = c(0, 40), log = "x",
xlab = "Stimulus area (deg^2)", ylab = "Sensitivity (dB)", col = "blue")
lines(10^SizesP, Estim_Summation, col = "red")
points(pi*(QP$respSeq$stimuli.2/2)^2, QP$respSeq$stimuli.1, pch = 16,
col = rgb(red = 1, green = 0, blue = 0, alpha = 0.3))
legend("top", inset = c(0, -.2),legend = c("True","Estimated","Stimuli"),
col=c("blue", "red","red"), lty=c(1,1,0),
pch = c(16, 16, 16), pt.cex = c(0, 0, 1),
horiz = TRUE, xpd = TRUE, xjust = 0)
## End(Not run)
if (!is.null(opiClose()))
warning("opiClose() failed")
OPI documentation built on Nov. 7, 2023, 9:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
| QUESTP | R Documentation |
QUEST+
Description
An implementation of the Bayesian test procedure QUEST+ by AB Watson. This is mostly a translation of the MATLAB implementation by P Jones (see References). Its use is similar to ZEST. The objective is to estimate parameters of a function that defines the probability of responding stimuli. The steps are optimized based on entropy rather than the mean or the mode of the current pdfs.
Usage
QUESTP(
Fun,
stimDomain,
paramDomain,
likelihoods = NULL,
priors = NULL,
stopType = "H",
stopValue = 4,
maxSeenLimit = 2,
minNotSeenLimit = 2,
minPresentations = 1,
maxPresentations = 100,
minInterStimInterval = NA,
maxInterStimInterval = NA,
verbose = 0,
makeStim,
...
)
QUESTP.Prior(state, priors = NULL)
QUESTP.Likelihood(state)
QUESTP.start(
Fun,
stimDomain,
paramDomain,
likelihoods = NULL,
priors = NULL,
stopType = "H",
stopValue = 4,
maxSeenLimit = 2,
minNotSeenLimit = 2,
minPresentations = 1,
maxPresentations = 100,
makeStim,
...
)
getTargetStim(state)
QUESTP.step(state, nextStim = NULL)
QUESTP.stop(state)
QUESTP.final(state, Choice = "mean")
QUESTP.stdev(state, WhichP = NULL)
QUESTP.entropy(state)
Arguments
Fun |
Function to be evaluated, of the form |
stimDomain |
Domain of values for the stimulus. Can be multi-dimensional (list, one element per dimension) |
paramDomain |
Domain of values for pdfs of the parameters in Fun. Can be multi-parametric (list, one element per parameter). |
likelihoods |
Pre-computed likelihoods if available (for QUESTP.start) |
priors |
Starting probability distributions for the parameter domains (list, one element per parameter) |
stopType |
|
stopValue |
Value for number of presentations ( |
maxSeenLimit |
Will terminate if |
minNotSeenLimit |
Will terminate if |
minPresentations |
Minimum number of presentations |
maxPresentations |
Maximum number of presentations regarless of |
minInterStimInterval |
If both |
maxInterStimInterval |
|
verbose |
|
makeStim |
A function that takes a dB 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 QUESTP returned by |
nextStim |
A valid object for |
Choice |
How to compute final values in QUESTP.final ("mean","mode","median") |
WhichP |
Which parameter (numeric index) to monitor when calling QUESTP.stdev directly (returns max(stdev) if unspecified) |
Details
An implementation of the Bayesian test procedure QUEST+ by AB Watson. This is mostly a translation of the MATLAB implementation by P Jones (see References). Its use is similar to ZEST. The objective is to estimate parameters of a function that defines the probability of responding to stimuli. The steps are optimized based on entropy rather than the mean or the mode of the current pdfs.
The stimulus, parameter and response domain are separate and can be multidimensional. Each parameter has its own pdf. For evaluation, the pdfs are chained as a long vector (so no co-variances are considered). More complex functions will require larger combined pdfs and longer computation time for likelihoods and updating at each step. In these cases, it is recommended to pre-calculate the likelihoods using QUESTP.Likelihood and store them.
The function to be fitted needs to output a probability of seen (i.e. pseen = function(stim, param){...})
and must take stim and param as inputs. stim is a vector with length = number of stimulus dimensions
(in simple one-dimensional cases, the intensity in dB). param is a vector with length = number
of parameters to be fitted in Fun.
For example, QUEST+ can fit a Gaussian psychometric function with stimDomain = {0, 1,..., 39, 40} dB
and paramDomain = ({0, 1,..., 39, 40}; {0.5, 1,..., 5.5, 6}) dB for the mean and
standard deviation respectively. A standard ZEST procedure can be replicated by setting
stimDomain = {0, 1,..., 39, 40} dB and paramDomain = ({0, 1,..., 39, 40}; {1}) dB, i.e. by setting the
stimDomain = paramDomain for the mean and by having a static standard deviation = 1 dB. Note however that
the stimulus selection is always based on entropy and not on the mean/mode of the current pdf. See examples below
Note this function will repeatedly call opiPresent for a stimulus until opiPresent
returns NULL (ie no error occurred).
The checkFixationOK function is called (if present in stim made from makeStim)
after each presentation, and if it returns FALSE, the pdf for that location is not changed
(ie the presentation is ignored), but the stim, number of presentations etc is recorded in
the state.
If more than one QUESTP is to be interleaved (for example, testing multiple locations), then the
QUESTP.start, QUESTP.step, QUESTP.stop and QUESTP.final calls can maintain
the state of the QUESTP after each presentation, and should be used. If only a single QUESTP is
required, then the simpler QUESTP can be used, which is a wrapper for the four functions
that maintain state. See examples below.
Value
Single location
QUESTP returns a list containing
-
npresTotal number of presentations used. -
respSeqResponse sequence stored as a data frame: column 1 is a string identified of a (potentially) multidimensional stimulus values of stimuli (dimensions chained into a string), column 2 is 1/0 for seen/not-seen, column 3 is fixated 1/0 (always 1 ifcheckFixationOKnot present in stim objects returned frommakeStim). All additional columns report each stimulus dimension, one for each row. -
pdfsIfverboseis bigger than 0, then this is a list of the pdfs used for each presentation, otherwise NULL. -
finalThe mean (default, strongly suggested)/median/mode of the parameters' pdf, depending onChoice. -
opiRespA list of responses received from each successful call toopiPresentwithinQUESTP.
Multiple locations
QUESTP.start returns a list that can be passed to QUESTP.step, QUESTP.stop, and
QUESTP.final. It represents the state of a QUESTP at a single location at a point in time and contains the following.
-
nameQUESTP A copy of all of the parameters supplied to QUESTP.start:
stimDomain,paramDomain,likelihoods,priors,stopType,stopValue,maxSeenLimit,minNotSeenLimit,minPresentations,maxPresentations,makeStim, andopiParams.-
pdfCurrent pdf: vector of probabilities, collating all parameter domains. -
priorsPList of starting pdfs, one for each parameter. -
numPresentationsThe number of timesQUESTP.stephas been called on this state. -
stimuliA vector containing the stimuli used at each call ofQUESTP.step. -
responsesA vector containing the responses received at each call ofQUESTP.step. -
responseTimesA vector containing the response times received at each call ofQUESTP.step. -
fixatedA vector containing TRUE/FALSE if fixation was OK according tocheckFixationOKfor each call ofQUESTP.step(defaults to TRUE ifcheckFixationOKnot present). -
opiRespA list of responses received from each call toopiPresentwithinQUESTP.step.
QUESTP.step returns a list containing
-
stateThe new state after presenting a stimuli and getting a response. -
respThe return from theopiPresentcall that was made.
QUESTP.stop returns TRUE if the QUESTP has reached its stopping criteria, and FALSE otherwise.
QUESTP.final returns an estimate of parameters based on state. If state$Choice
is mean then the mean is returned (the only one that really makes sense for QUEST+).
If state$Choice is mode then the
mode is returned. If state$Choice is median then the median is returned.
References
Andrew B. Watson; QUEST+: A general multidimensional Bayesian adaptive psychometric method. Journal of Vision 2017;17(3):10. doi: https://doi.org/10.1167/17.3.10.
Jones, P. R. (2018). QuestPlus: a MATLAB implementation of the QUEST+ adaptive psychometric method, Journal of Open Research Software, 6(1):27. doi: http://doi.org/10.5334/jors.195
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.
See Also
dbTocd, opiPresent
Examples
chooseOpi("SimHenson")
if(!is.null(opiInitialize(type="C", cap=6)))
stop("opiInitialize failed")
#########################################################
# This section is for single location QUESTP
# This example fits a FoS curve
# Note: only fitting threshold and slope,
# modify the domain for FPR and FNR to fit those as well
#########################################################
# 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)
}
#True parameters (variability is determined according to Henson et al. based on threshold)
loc <- list(threshold = 20, fpr = 0.05, fnr = 0.05)
#Function to fit (Gaussian psychometric function)
pSeen <- function(x, params){return(params[3] +
(1 - params[3] - params[4]) *
(1 - pnorm(x, params[1], params[2])))}
#QUEST+
QP <- QUESTP(Fun = pSeen,
stimDomain = list(0:50),
paramDomain = list(seq(0, 40, 1), #Domain for the 50% threshold (Mean)
seq(.5, 8, .5), #Domain for the slope (SD)
seq(0.05, 0.05, 0.05), #Domain for the FPR (static)
seq(0.05, 0.05, 0.05)), #Domain for the FNR (static)
stopType="H", stopValue=4, maxPresentations=500,
makeStim = makeStim,
tt=loc$threshold, fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
#Plots results
#Henson's FoS function (as implemented in OPI - ground truth)
HensFunction <- function(Th){
SD <- exp(-0.081*Th + 3.27)
SD[SD > 6] <- 6
return(SD)
}
#Stimulus domain
dB_Domain <- 0:50
FoS <- pSeen(dB_Domain, params = QP$final) # Estimated FoS
FoS_GT <- pSeen(dB_Domain, params = c(loc$threshold, HensFunction(loc$threshold),
loc$fpr, loc$fnr)) #Ground truth FoS (based on Henson et al.)
#Plot (seen stimuli at the top, unseen stimuli at the bottom)
plot(dB_Domain, FoS_GT, type = "l", ylim = c(0, 1), xlab = "dB", ylab = "% seen", col = "blue")
lines(dB_Domain, FoS, col = "red")
points(QP$respSeq$stimuli, QP$respSeq$responses, pch = 16,
col = rgb(red = 1, green = 0, blue = 0, alpha = 0.1))
legend("top", inset = c(0, -.2),legend = c("True","Estimated","Stimuli"),
col=c("blue", "red","red"), lty=c(1,1,0),
pch = c(16, 16, 16), pt.cex = c(0, 0, 1),
horiz = TRUE, xpd = TRUE, xjust = 0)
if (!is.null(opiClose()))
warning("opiClose() failed")
chooseOpi("SimHenson")
if(!is.null(opiInitialize(type="C", cap=6)))
stop("opiInitialize failed")
######################################################################
# This section is for single location QUESTP
# This example shows that QUEST+ can replicate a ZEST procedure
# by fitting a FoS curve with fixed Slope, FPR and FNR
# Compared with ZEST
# Note that QUEST+ should be marginally more efficient in selecting
# the most informative stimulus
######################################################################
# 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)
}
#True parameters (variability is determined according to Henson et al. based on threshold)
loc <- list(threshold = 30, fpr = 0.03, fnr = 0.03)
#Function to fit (Gaussian psychometric function - Fixed slope (same as default likelihood in ZEST))
pSeen <- function(domain, tt){{0.03+(1-0.03-0.03)*(1-pnorm(domain,tt,1))}}
# ZEST-like QUEST+ procedure
QP <- QUESTP(Fun = pSeen,
stimDomain = list(0:40),
paramDomain = list(seq(0, 40, 1)),
stopType="S", stopValue=1.5, maxPresentations=500,
makeStim = makeStim,
tt=loc$threshold, fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
# ZEST
ZE <- ZEST(domain = 0:40,
stopType="S", stopValue=1.5, maxPresentations=500,
makeStim = makeStim,
tt=loc$threshold, fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
#Plots results
#Henson's FoS function (as implemented in OPI - ground truth)
HensFunction <- function(Th){
SD <- exp(-0.081*Th + 3.27)
SD[SD > 6] <- 6
return(SD)
}
#Stimulus domain
dB_Domain <- 0:50
FoS_QP <- pSeen(domain = dB_Domain, tt = QP$final) # Estimated FoS
FoS_ZE <- pSeen(domain = dB_Domain, tt = ZE$final) # Estimated FoS
#Plot (seen stimuli at the top, unseen stimuli at the bottom)
plot(dB_Domain, FoS_QP, type = "l", ylim = c(0, 1), xlab = "dB", ylab = "% seen", col = "blue")
lines(dB_Domain, FoS_ZE, col = "red")
points(QP$respSeq$stimuli, QP$respSeq$responses, pch = 16,
col = rgb(red = 0, green = 0, blue = 1, alpha = 0.5))
points(ZE$respSeq[1,], ZE$respSeq[2,], pch = 16,
col = rgb(red = 1, green = 0, blue = 0, alpha = 0.5))
legend("bottomleft", legend = c("QUEST+","ZEST","Stimuli QUEST+", "Stimuli ZEST"),
col=c("blue", "red","blue","red"), lty=c(1,1,0,0),
pch = c(16, 16, 16, 16), pt.cex = c(0, 0, 1, 1),
horiz = FALSE, xpd = TRUE, xjust = 0)
abline(v = loc$threshold, lty = "dashed")
if (!is.null(opiClose()))
warning("opiClose() failed")
chooseOpi("SimHenson")
if(!is.null(opiInitialize(type="C", cap=6)))
stop("opiInitialize failed")
#########################################################
# This section is for single location QUESTP
# This example fits a broken stick spatial summation function
# with a multi-dimensional stimulus (varying in size and intensity).
# Stimulus sizes are limited to GI, GII, GIII, GIV and GV.
# The example also shows how to use a helper function to
# simulate responses to multi-dimensional stimuli
# (here, the simulated threshold varies based on stimulus size)
#########################################################
makeStim <- function(stim, n) {
s <- list(x=9, y=9, level=dbTocd(stim[1]), size=stim[2], color="white",
duration=200, responseWindow=1500, checkFixationOK=NULL)
class(s) <- "opiStaticStimulus"
return(s)
}
# Helper function for true threshold (depends on log10(stimulus size),
# diameter assumed to be the second element of stim vector)
ttHelper_SS <- function(location) { # returns a function of (stim)
ff <- function(stim) stim
body(ff) <- substitute(
{return(SensF(log10(pi*(stim[2]/2)^2), c(location$Int1, location$Int2, location$Slo2)))}
)
return(ff)
}
# Function of sensivity vs SSize (log10(stimulus area))
SensF <- function(SSize, params){
Sens <- numeric(length(SSize))
for (i in 1:length(SSize)){
Sens[i] <- min(c(params[1] + 10*SSize[i], params[2] + params[3]*SSize[i]))
}
Sens[Sens < 0] <- 0
return(Sens)
}
Sizes <- c(0.1, 0.21, 0.43, 0.86, 1.72)
#True parameters (variability is determined according to Henson et al. based on threshold)
loc <- list(Int1 = 32, Int2 = 28, Slo2 = 2.5, fpr = 0.05, fnr = 0.05, x = 9, y = 9)
# Function to fit (probability of seen given a certain stimulus intensity and size,
# for different parameters)
pSeen <- function(stim, params){
Th <- SensF(log10(pi*(stim[2]/2)^2), params)
return(0.03 +
(1 - 0.03 - 0.03) *
(1 - pnorm(stim[1], Th, 1)))
}
set.seed(111)
#QUEST+ - takes some time to calculate likelihoods
## Not run:
QP <- QUESTP(Fun = pSeen,
stimDomain = list(0:50, Sizes),
paramDomain = list(seq(0, 40, 1), # Domain for total summation intercept
seq(0, 40, 1), # Domain for partial summation intercept
seq(0, 3, 1)), # Domain for partial summation slope
stopType="H", stopValue=1, maxPresentations=500,
makeStim = makeStim,
ttHelper=ttHelper_SS(loc), tt = 30,
fpr=loc$fpr, fnr=loc$fnr,
verbose = 2)
#Stimulus sizes
G <- log10(c(pi*(0.1/2)^2, pi*(0.21/2)^2, pi*(0.43/2)^2, pi*(0.86/2)^2, pi*(1.72/2)^2));
SizesP <- seq(min(G), max(G), .05)
# True and estimated response
Estim_Summation <- SensF(SizesP, params = QP$final) # Estimated spatial summation
GT_Summation <- SensF(SizesP, params = c(loc$Int1, loc$Int2, loc$Slo2)) # True spatial summation
#Plot
plot(10^SizesP, GT_Summation, type = "l", ylim = c(0, 40), log = "x",
xlab = "Stimulus area (deg^2)", ylab = "Sensitivity (dB)", col = "blue")
lines(10^SizesP, Estim_Summation, col = "red")
points(pi*(QP$respSeq$stimuli.2/2)^2, QP$respSeq$stimuli.1, pch = 16,
col = rgb(red = 1, green = 0, blue = 0, alpha = 0.3))
legend("top", inset = c(0, -.2),legend = c("True","Estimated","Stimuli"),
col=c("blue", "red","red"), lty=c(1,1,0),
pch = c(16, 16, 16), pt.cex = c(0, 0, 1),
horiz = TRUE, xpd = TRUE, xjust = 0)
## End(Not run)
if (!is.null(opiClose()))
warning("opiClose() failed")
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.