QUEST

©1994-2015 Andrew B. Watson

Credits & Version

Copyright 1994-2015 by Andrew B. Watson. All rights reserved. Do not distribute or reproduce without permission. No warranties expressed or implied. This version is compatible with Mathematica 10.

Date of this version : Jan 9 2015

History

Changes 4.0->5.0

Loads Audio Package.

No longer loads Package FilledPlot due to conflict with sounds. FilledListPlotABW added as work-around.
QuestExperiment: First trial is always at guess for each condition.
ContrastThreshold
DisplayStimulus2IFC
GetResponse2IFC
DisplayStimulusYN
GetResponseYN
QuestPlot argument order changed, option name changed, also accepts several conditions, options to PsychometricFit and PsychometricPlot.
New options to QuestPlot.
new LoadStimuli
new LoadFixAndBlank.
"value" changed to "strength" throughout.

Changes 5.0->5.1

Functions GetResponseYN and GetResponse2IFC now return -1 if the observer responds "Exit".

QuestExperiment: If a response of -1 is received during the main trial loop, the loop is exited and the existing data are returned.

Changes 5.1-5.2

Spell message turned off during initialization.
Added DisplayGamma to options of ContrastThreshold.
Added options to Simulated Observer.

Changes 5.2-5.3

DisplayMaskedStimulus uses Combine2Images    
Fixed luminance assignment for zero in DisplayStimulus 1/10/97
     Function[i,ColorMap[i + offset[[2]],
      stim[[2,i]] dBInverse[strength],2,254
      ,{{0,.5^gamma}}, gamma]] /@ cindx;
Added gamma to LoadFixAndBlank 1/15/96
LoadStimuli can now take list of image pbm files; returns max dimensions 1/15/96
LoadFixAndBlank may now take a dimensions argument 1/15/96
ContrastThrehold now loads stimuli first, then fix and blank.
Added Options[GetResponse2IFC] = {Interval->1}; 1/29/97
Added Abort[] option to GetResponse2IFC 2/3/97

Changes 5.3-5.4

In QuestExperiment, trials is now a list. 4/18/97.

{1997,7,16,22,53,48} added Screen option to ContrastThreshold

Changes 6-6.1

Added PostFeedbackPause to Options[GetResponse2IFC];

Feedback fucntion now uses PlaySound function from Cienamtica, and FeedbackNotes option to contrastThreshold.

6.1-7.0

Extracted Cinematica material and placed in separate notebook CinematicaPsychophysics.nb 10/30/98.

Removed MinMax, IndexMax (are in Miscellany.m).

Removed Needs["Miscellaneous`Audio`"]

Added ability to read prior data into QuestExperiment 11/9/98. abw.

Small changes to tutorial.

4/12/05

4/12/05 added Scatter option. abw.

{2006,3,20,16,45,59.654008}

Discovered and fixed bug in scatter option. May have made data collected since 4/12/05 less efficient.

Updated to Mathematica 6.0 5/6/07.

{2014,8,8,11,1,40.503850}

Date[]

Changed QuestMethod options to strings.
Changes to QuestPlot
Replaced Shuffle with RandomSample
Moved SequenceToTable to Psychometrica.nb
Added real experiment to Tutorial

{2014, 8, 15, 18, 13, 20.480145}

Date[]

JAS added The option DesiredAccuracies to QuestExperiment.
JAS Introduced GammaCheckFreq and DeltaCheckFreq to QuestExperiment.

{2014, 12, 9, 10, 21, 49.087570}

ABW Changed DesiredAccuracies to TargetProbabilities,
ABW Changed DCF and GCF to dcf and gcf 
ABW moved the solve code to an If clause.
ABW Changed randy to catch
ABW RandomCoice instead of RandomSample
ABW Nearest instead of “JAS’s” code (actually ABW’s old code).
JAS fixed one bugs in the new code and altered the usage statement and Tutorial accordingly.
JAS changed QuestParameters in the Real Experiment to reflect the 0.1 guessing rate.

{2014,12,18,11,34,1.767761}

Minor formatting and text changes. ABW

{2015, 1, 9, 12, 10, 30.576651}

Added QuestMovie. Revised usage message. ABW

Introduction

This notebook implements the QUEST adaptive psychometric procedure. For additional details and background, consult:

Watson, A. B., & Pelli, D. G. (1983). QUEST: A Bayesian adaptive psychometric method. Perception and Psychophysics 33(2), 113-120.

Watson, A. B., & Fitzhugh, A. (1990). The method of constant stimuli is inefficient. Perception & Psychophysics 47(1), 87-91.

Emerson, P. L. (1986). Observations on maximum likelihood and Bayesian methods of forced-choice sequential threshold estimation. Perception & Psychophysics 39, 151-153.

King-Smith, P. E., Grigsby, S. S., Vingrys, A. J., Benes, S. C. & Supowit, A. (1994). Efficient and unbiased modifications of the QUEST threshold method: Theory, simulations, experimental evaluation, and practical implementation. Vision Research 34(7), 885-912.

Treutwein, B. (1995). Adaptive psychophysical procedures. Vision Research 35(17), 2503-2522.

This Notebook begins with a discussion of basic concepts and data structures that underly the functions. This should be read by anyone intending to use the software. The function definitions follow. Users can skip that section and look at the tutorial.

This Notebook depends upon another Notebook (Psychometrica.ma) which defines a number of useful psychometric functions, as well as functions for fitting and plotting psychometric data.

Preliminaries

<< Psychometrica.m

Concepts and data structures

It is not necessary to read this section to use this software. It describes some internal aspects of the Quest package. To allow some generality, I have tried to write a set of minimal functions that make few assumptions about the larger structure of the experiment. To understand the software, we must define a few abstractions and data structures. First is the condition, which identifies stimulus or experimental condition over which a set of data are to collected. Within a condition, the stimuli vary in some measure that we call strength. For example, strength might correspond to luminance or contrast, but might also correspond to speed or spatial frequency. For each condition, there is a list of permissable strengths. This collection of lists is called QStrengths. Often we refer not to a strength, but to an index into the list of strengths. One important difference between the two is that an index is always an integer, while a strength may be a real number. Since this is a frequent source of confusion, we emphasize this distinction between strength and index.

Each condition is also associated with a list of the log of the posterior probability density for threshold, evaluated at each strength in its corresponding list in QStrengths. The list of these lists is called QTables.

Also associated with each condition is a psychometric function, and a set of corresponding parameters. These are collected together in the lists QFunctions and QParameters. Note that each condition may have a different function and set of parameters.

The last data structure of interest is QSequence. This is a list of triples, each of the form {condition, strength, response}, that completely defines the history of a session.

These symbols are not created by the Quest software, but must be defined by the user. Nothing in the sofware assumes these particular names, though it may be a useful convention to adhere to them.

It is useful to define one further entity, QData, which is simply the collection of all of these data structures in a single list. As shown in the examples below, it is important to define this symbol with a delayed assignment, so that whenever it is referred to it in turn refers to the current states of its constituents. Here we show this delayed assignment.

QData := {QSequence, QStrengths, QTables, QFunctions, QParameters};

In general the user need not concern themselves with the contents of these data structures, so long as they follow the simple examples below. Sophisticated users may wish to directly manipulate the list contents.

Functions

QuestExperiment

This function makes no assumptions regarding the particular methods of stimulus generation or response collection. Both of these aspects are determined by a user-written function called GetResponse. The arguments to this function are a condition number and a strength. From these numbers, the function should present an appropriate stimulus with an appropriate strength, collect a response from the observer, and return that response (0 or 1) as the value of the function.

QuestExperiment::usage = "QuestExperiment[guesses, trials]: Conducts an experiment using the QUEST adaptive procedure. The user must specify a list of an initial estimates of threshold for each condition. The function will conduct trials trials for each condition. The function itself calls a function f[condition,strength] (where f is the value of the option QuestResponse) which presents a stimulus and collects a response, and which serves as the interface to the device and stimulus-dependent parts of the experiment. QuestExperiment returns a structure of the form {sequence,strengths,functions, parameters}, where sequence is the complete trial sequence, each trial specified by a triple {condition, strength, response}. strengths, functions, and parameters are all lists, with lengths equal to the number of conditions. Each element of strengths is a list of possible testing strengths. Each element of functions is an assumed psychometric function, and parameters are their associated parameters. If a response of -1 is received during the main trial loop, the loop is exited and the existing data are returned. 
Options:
QuestResponse->SimulatedObserver: function defining the simulated observer
QuestFunction->LogWeibullPF: assumed psychometric function
QuestParameters->{3.5,.5,.01}: assumed psychometric parameters
QuestMethod->\"Mean\": whether mode, median, or mean of the posterior probability function will be used as the testing point
QuestPlotShow->False:  whether a plot will be produced after each trial, which is useful for tutorial purposes. 
QuestSigma->100: standard deviation (in dB) of the normal prior probability density
QuestRange->{-60,0,2}: minimum, maximum and increment of the list of possible testing points
QuestSeed->Automatic: if a number, will be used as the random seed (determines order of presentation of conditions, order within forced-choice presentations, and behaviour of the simulated observer)
QuestScatter->0: 
TargetProbabilities->Automatic: can be set to a list of target probabilities, amongst which QuestExperiment will choose pseudorandomly; the automatic setting is equivalent to {QuestFunction[alpha,{alpha,#}&@@QuestParameters]}
DeltaCheckFreq->0: determines the frequency with which the largest strength (QuestRange[[2]]) will be presented
GammaCheckFreq->0: determines the frequency with which the smallest strength (QuestRange[[1]]) will be presented
SaveQuestMovie->False: whether to save the sequence of plots as the global variable QuestMovie.
Prior data returned from QuestExperiment can be used to initialize a new session by entering it in place of the guesses argument.";

?QuestExperiment

Clear[QuestExperiment]

Options[QuestExperiment] = {QuestFunction->LogWeibullPF, QuestParameters->{3.5,.5,.01}, QuestMethod->"Mean", QuestPlotShow->False, QuestSigma->100, QuestRange->{-60,0,2}, QuestSeed->Automatic, QuestResponse->SimulatedObserver,QuestScatter->0,TargetProbabilities->Automatic,DeltaCheckFreq->0,GammaCheckFreq->0,SaveQuestMovie->False};

QuestExperiment[guesses_, trials_, opts___Rule] :=
 Module[ {c,i=1,getResponse, plot, method, range, sigma, seed, pfunction, params, targetps,dcf,gcf,order, strength, strengths, response, sequence={}, tables, functions, parameters, data, nc, first,catch},
{getResponse, plot, method, range, sigma, seed, pfunction, params,targetps,dcf,gcf} ={QuestResponse, QuestPlotShow, QuestMethod, QuestRange, QuestSigma, QuestSeed,
QuestFunction, QuestParameters,TargetProbabilities,DeltaCheckFreq,GammaCheckFreq} /. {opts} /. Options[QuestExperiment];

If[NumberQ[seed],SeedRandom[seed]];

data := {sequence,strengths,tables,functions,parameters};

If[Depth[guesses] < 3,
	(
	nc = Length[guesses];
	first = Table[True,{nc}];
	{strengths,functions,parameters} = Transpose[Table[{Range @@ range,pfunction,params},{nc}]];
 	tables = MapThread[
    	LogGauss[#1,sigma,#2]&,{strengths,guesses}];
 	),
 	(
 	nc = Length[guesses[[2]]];
 	{sequence,strengths,tables,functions,parameters}=guesses;
 	first = Table[False,{nc}];
 	)];	
 	
	order = RandomSample[Flatten[ Table[c,{c,nc}
	 ,{If[ListQ[trials],trials[[c]],trials]}]]];

Catch[Do[
c=order[[i]];
strength = If[first[[c]]
,(first[[c]] = False;guesses[[c]])
,strengths[[c,NextIndex[tables[[c]],method,opts]]]];

If[ListQ[targetps],(Off[Solve::ifun];
strength=Solve[RandomChoice[targetps]==pfunction[dummy,({strength,##1}&)@@params],dummy][[1,1,2]];
On[Solve::ifun];
strength=First[Nearest[strengths[[c]],strength,1]])];

catch=RandomReal[];
If[catch<dcf,strength=Max[strengths[[c]]]
,If[catch<dcf+gcf,strength=Min[strengths[[c]]]]];

 response = getResponse[c,strength];
If[response==-1,Throw[data]];
{sequence,tables}=QuestUpdate[c,strength,response,data];
If[plot, Print@QuestPlot[data,c,opts]];
  ,{i,Length[order]}]];
data]

QuestExperiment[guesses_, trials_, opts___Rule] :=
 Module[ {c,i=1,getResponse, plot, method, range, sigma, seed, pfunction, params, targetps,dcf,gcf,order, strength, strengths, response, sequence={}, tables, functions, parameters, data, nc, first,catch,movieq,movie={},qp},
{getResponse, plot, method, range, sigma, seed, pfunction, params,targetps,dcf,gcf,movieq} ={QuestResponse, QuestPlotShow, QuestMethod, QuestRange, QuestSigma, QuestSeed,
QuestFunction, QuestParameters,TargetProbabilities,DeltaCheckFreq,GammaCheckFreq,SaveQuestMovie} /. {opts} /. Options[QuestExperiment];

If[movieq,QuestMovie={}];
If[NumberQ[seed],SeedRandom[seed]];

data := {sequence,strengths,tables,functions,parameters};

If[Depth[guesses] < 3,
	(
	nc = Length[guesses];
	first = Table[True,{nc}];
	{strengths,functions,parameters} = Transpose[Table[{Range @@ range,pfunction,params},{nc}]];
 	tables = MapThread[
    	LogGauss[#1,sigma,#2]&,{strengths,guesses}];
 	),
 	(
 	nc = Length[guesses[[2]]];
 	{sequence,strengths,tables,functions,parameters}=guesses;
 	first = Table[False,{nc}];
 	)];	
 	
	order = RandomSample[Flatten[ Table[c,{c,nc}
	 ,{If[ListQ[trials],trials[[c]],trials]}]]];

Catch[Do[
c=order[[i]];
strength = If[first[[c]]
,(first[[c]] = False;guesses[[c]])
,strengths[[c,NextIndex[tables[[c]],method,opts]]]];

If[ListQ[targetps],(Off[Solve::ifun];
strength=Solve[RandomChoice[targetps]==pfunction[dummy,({strength,##1}&)@@params],dummy][[1,1,2]];
On[Solve::ifun];
strength=First[Nearest[strengths[[c]],strength,1]])];

catch=RandomReal[];
If[catch<dcf,strength=Max[strengths[[c]]]
,If[catch<dcf+gcf,strength=Min[strengths[[c]]]]];

 response = getResponse[c,strength];
If[response==-1,Throw[data]];
{sequence,tables}=QuestUpdate[c,strength,response,data];
If[plot, Print@(qp=QuestPlot[data,c,opts])];
If[movieq, AppendTo[QuestMovie,qp]];
  ,{i,Length[order]}]];
data]

QuestUpdate

QuestUpdate::usage = "QuestUpdate[condition,strength,response,qdata]: This function is called after a trial of condition at strength with outcome response (0 or 1). It updates and returns the structure qdata, which is a complete record of the experiment. The structure of qdata is {QSequence, QStrengths, QTables, QFunctions, QParameters}. QSequence is a list of triples, each of the form {condition, strength, response} which describes the trial sequence in order of occurrence. QStrengths is a list of lists, one per condition, each specifying the available strengths. QTables is a list of lists, one per condition, each specifying the current un-normalized, log posterior probability of threshold at each strength. QFunctions is a list of function names, one per condition, each specifying the psychometric function used by QUEST. QParameters is a list of lists, one per condition, each specifying the parameters assigned to the corresponding psychometric function.";

QuestUpdate[condition_,strength_,response_
,{QSequence_,QStrengths_,QTables_,QFunctions_,QParameters_} ]:=
{Append[QSequence,{condition,strength,response}],
 MapAt[ Function[x, x + Check[Log[ If[response==1,#,1-#]&[
QFunctions[[condition]][strength ,Prepend[QParameters[[condition]],#]]& /@
 QStrengths[[condition]]]],-100]],QTables,condition]}

QuestPlot

QuestPlot::usage = "QuestPlot[data, condition]: Plots several summaries of the progress of a Quest session for one condition. QuestPlot[data] plots separate summaries for all conditions. Included on the same figure are 1) the normalized antilog of the Quest function, which is proportional to the posterior probability density, 2) the histogram of trial placements, 3) the sequence of trial placements and their individual outcomes (green for yes/correct, red for no/incorrect), and 4) the proportion correct, the best-fitting psychometric function, and the printed estimates of threshold, slope, and error. Options to ListPlot and PsychometricPlot can also be included. The argument data is the basic data structure maintained by Quest (see QuestUpdate) and returned by QuestExperiment. The various components of the plot may be toggled by means of the following options, shown with their default strengths: Fit->False, Density->True, Histogram->True, Trials->True.";

Options[QuestPlot] = {Fit->False, Density->True, Histogram->True, Trials->True};

QuestPlot[{QSequence_,QStrengths_,QTables_,QFunctions_,QParameters_},condition_Integer,opts___Rule]:=Module[
{showfit,histogram,density,trials,cSequence,trial,vscale,xrange,pts,f1,tab,f2,f3,f4,fit,gray},{showfit,histogram,density,trials}=
{Fit,Histogram,Density,Trials}/. {opts}/. Options[QuestPlot];cSequence=Cases[QSequence,{condition,__}];
trial=Length[cSequence];
vscale=(1/(Max[32,trial]));
xrange=MinMax[QStrengths[[condition]]]+0.5` {-1,1};
pts=MapIndexed[{#1[[2]],#2[[1]] vscale}&,cSequence];tab=({#1[[1]],vscale Plus@@#1[[{2,3}]]}&)/@SequenceToTable[cSequence][[condition]];
gray =GrayLevel[If[density,.85,1]];f1=ListLinePlot[Transpose[{QStrengths[[condition]],(E^((#1-Max[#1]&)[QTables[[condition]]]))}]
,Filling->0,PlotRange->All,PlotStyle->{gray,AbsoluteThickness[0]}
,FillingStyle->{gray}];
f2=If[histogram,BarChartABW[tab,.9],{}];
f3=If[trials,Graphics[{Line[pts],PointSize[0.025]
,Transpose[{(Hue[0.35 #1[[3]]]&)/@cSequence,Point/@pts}]}],{}];f4=If[!showfit,{},(fit=PsychometricFit[SequenceToTable[QSequence][[condition]],opts,PsychometricFunction->QFunctions[[condition]],PsychometricParameters->Prepend[QParameters[[condition]],Automatic]];If[NumberQ[fit[[3,2]]]
,PsychometricPlot[fit,PlotRange->{xrange,{0,1}},Sequence@@FilterRules[{opts},Options[PsychometricPlot]]],{}])];
Show[f1,f2,f3,f4,Sequence@@FilterRules[{opts},Options[Graphics]]
,Frame->True
,Axes->False
,FrameTicks->{Automatic ,Automatic,Automatic,{{vscale trial,trial}}}
,PlotLabel->"Condition "<>ToString[condition]<>" Trial "<>ToString[trial]
,FrameLabel->{"Strength","Probability",None,"Trials"}
,PlotRange->{xrange,{0,1.01}}
,PsychometricaStyles]]

QuestPlot[data_,opts___Rule] :=
 Table[QuestPlot[data,c,opts],{c,Length[data[[2]]]}]

BarChartABW[data_,width_] :=
Graphics[{Opacity[.5],Blue,EdgeForm[]
,Rectangle[{#[[1]]-width/2,0},{#[[1]]+width/2,#[[2]]}]& /@ data}]

QuestMean

QuestMean::usage = "QuestMean[QTable]: Given a QTable (a list of un-normalized, log posterior probabilities of threshold strength), QuestMean finds the index nearest to the approximate mean of the posterior density.";

QuestMean[qTable_] := Module[{pdf},
 pdf = Exp[qTable];
 pdf = pdf / (Plus @@ pdf);
 Round[Plus @@ (pdf Range[Length[pdf]])]]

QuestMedian

QuestMedian::usage = "QuestMedian[QTable]: Given a QTable (a list of un-normalized, log posterior probabilities of threshold strength), QuestMedian finds the index nearest to the approximate median of the posterior density.";

QuestMedian[qTable_] := Module[{pdf,half},
 pdf = Exp[qTable];
half = 0.5 ( Plus @@ pdf);
IndexMax[-Abs[Drop[FoldList[Plus,-half,pdf],1]]]]

QuestMode

QuestMode::usage = "QuestMode[QTable]: Given a QTable (a list of un-normalized, log posterior probabilities of threshold strength), QuestMode finds the index of the mode of the posterior density.";

QuestMode := IndexMax

NextIndex

Changed methods to strings 7/6/14 abw.

NextIndex::usage = "NextIndex[qTable_, method_]: Selects the next index for trial placement, based on the desired method (\"Mode\", \"Median\", or \"Mean\")in the Quest psychometric procedure.qTable is a list of log un-normalized posterior probabilities of threshold location.";

NextIndex[qTable_,method_,opts___]:=Module[{ni,si},
ni=Switch[method,
"Mode",QuestMode,
"Mean",QuestMean,
"Median",QuestMedian][qTable];si=Clip[ni+RandomInteger[(QuestScatter/. {opts} /. Options[QuestExperiment]) {-1,1}],{1,Length[Range@@(QuestRange/.{opts}/.Options[QuestExperiment])]}];si]

SeedRandom[1];
data=QuestExperiment[{-30},10,QuestPlotShow->True,QuestSeed->99];

SeedRandom[1];
data=QuestExperiment[{-30},10,QuestMethod->"Mode",QuestPlotShow->True,QuestSeed->99];

old

NextIndex[qTable_,method_,opts___]:=Module[{ni,si},ni=Switch[method,
mode,QuestMode,
mean,QuestMean,
median,QuestMedian][qTable];si=Clip[ni+RandomInteger[(QuestScatter/.{opts}/.Options[QuestExperiment]) {-1,1}],{1,Length[Range@@(QuestRange/.{opts}/.Options[QuestExperiment])]}];si]

LogGauss

LogGauss::usage = "LogGauss[strength,sigma,mean]: This function is used to set a prior probability density for each condition, which may be done by initializing the log likelihood list (QTable). It is the log of  a Gaussian (a parabola). The arguments are a strength, a standard deviation of the Gaussian, and a mean of the Gaussian.";

LogGauss[strength_,sigma_,mean_] :=-Log[sigma Sqrt[2. Pi] ] - ( 0.5 ((strength-mean)/sigma)^2)

SimulatedObserver

SimulatedObserver::usage = "SimulatedObserver[condition,strength]: Simulates a trial for condition at strength. It returns 1 or 0 for success or failure, respectively. By default, it obeys a LogWeibullPF psychometric function with parameters {-20,3.5,.5,.01,0.}.These may be changed via SetOptions and the option names PsychometricFunction and PsychometricParameters. ";

Options[SimulatedObserver] = {PsychometricFunction->LogWeibullPF, PsychometricParameters->{-20,4.,.5,.01}};

SimulatedObserver[condition_,strength_]:=If[(PsychometricFunction/. Options[SimulatedObserver])[strength,PsychometricParameters/. Options[SimulatedObserver]]>RandomReal[],1,0]

Tutorial

While the general approach of the Quest package is to provide a set of general functions from which to construct actual experiments, we realize the value of a fully developed example application. Accordingly we provide one high-level experimental program (QuestExperiment). Although such a program necessarily makes some limiting decisions regarding experimental structure, we have tried to retain generality where it was possible to do so.

The Quest package consists of two "layers" of software. At the lower level are a set of basic functions from which one may construct a wide variety of specific experimental applications. At the higher level is a single function, QuestExperiment, built from the lower level functions, which measures thresholds for a set of abstract stimuli. This function is independent of the particular stimuli or presentation technology, it merely manipulates the abstract quantities condition and strength. The condition is an integer index (starting at 1) that identifies a particular stimulus. The strength is a real number specifying the stimulus dimension that is varied in the experiment.

The tutorial below uses a simulated observer, so that no device-specific display hardware issues need be addressed.

A Simulated Experiment

Collecting data

We begin with an illustration of QuestExperiment. By default, QuestExperiment will assume a simulated observer. The default parameters of this observer are:

Options[SimulatedObserver]

These parameters describe the psychometric function and its parameters: threshold, slope, guessing parameter, and lapsing parameter (see Psychometrica.nb for further details).

We first run the example with one condition. The simulated observer has a true threshold of -20, but our guess is -30. We request 32 trials. We set a random seed so that this exact sequence can be repeated.

We request a plot after each trial. The elements of each plot are the ordered sequence of trials, showing strength and response (red = wrong, green = right), the trial placement histogram (blue bars), and the current posterior probability density function for the location of threshold (gray shape).

data=QuestExperiment[{-30},32,QuestPlotShow->True,QuestSeed->1,SaveQuestMovie->True]

Because QuestExperiment allows one to collect data for multiple conditions, the result is a list of data sets.

The last option requested that the sequence of plots be saved as the symbol QuestMovie. This is useful if we want to animate the plots as a movie.

ListAnimate[QuestMovie]

We can also export the plots as a movie, which we can do as follows.

Export["QuestMovie.gif",QuestMovie,"DisplayDurations"->.25]

Fitting  and plotting data

The data can be fit with a psychometric function using the function PsychometricFit. The output includes the raw data as tuples {strength,wrong,right}, the psychometric function being fit, the estimated parameters, and the error of fit.

fit = PsychometricFit[data]

Because PsychometricFit expects data for multiple conditions, the result is a list of fits.

We can plot the data, plus the fitted psychometric function, using the function PsychometricPlot.

PsychometricPlot[fit]

Because PsychometricPlot expects fits for multiple conditions, the result is a list of plots.

By default, PsychometricFit estimates only the threshold parameter. Here we estimate both threshold and slope. We wrap PsychometricPlot around the result to produce a graphical output.

PsychometricPlot[fit = PsychometricFit[data,FitParameters->{True,True}]]

The plot from PsychometricFit and PsychometricPlot can be embedded within the QuestPlot by setting the option Fit->True.

QuestPlot[data,Fit->True]

In fact, by setting this option permanently, we can get a fit after every trial. We set this option and re-do the simulation.

SetOptions[QuestPlot,Fit->True]

data=QuestExperiment[{-40},32,QuestPlotShow->True,QuestSeed->99];

By default, QuestPlot fits the same psychometric function and parameters used by Quest in the collection of the data, and preserved in the resulting data structure. The user may overide this by specifying options to PsychometricFit.

QuestPlot[data,Fit->True
,FitParameters->{True,True}
,PsychometricFunction->LogisticPF
,PsychometricParameters->{Automatic,.2,.5,.01}]

Verifying convergence and lack of bias

To verify that our method converges to the correct answer, given enough trials, we do a run of 1024 trials (omitting the plots!).

data2=QuestExperiment[{-30}, 1024, QuestSeed->1002];

QuestPlot[data2,1,Fit->True]

We see that the threshold is indeed close to the true value of -20.

Collecting data for more than one condition

In the next example, we use 2 conditions.

data3=QuestExperiment[{-10,-50}, 64, QuestSeed->101];

We can now use QuestPlot to plot each condition separately.

PsychometricPlot[PsychometricFit[data3]]

Or for the more complete plot.

QuestPlot[data3,Fit->True]

Options for plotting

Options for ListPlot can also be given to QuestPlot to customize the figure.

QuestPlot[data3,2,Fit->True,BaseStyle->{14,AbsoluteThickness[4],FontFamily->"Helvetica",FontWeight->Bold,FontSlant->Italic,FontColor->Blue}
,PlotStyle->{Red,Dashed,AbsoluteThickness[2],AbsolutePointSize[20]},Background->Yellow
,FrameLabel->None]

Changing QuestMethod

The QuestMethod option to QuestExperiment allows the user to change the underlying statistic used by Quest in selecting the next testing point. The default is “Mean”. Here we collect simulated data using methods “Mode” and “Median”.

dataMethods=QuestExperiment[{-30},32,QuestSeed->99,QuestMethod->#]& /@ {"Mean","Mode","Median"};

dataMethods

Options[PsychometricPlot]

Options[QuestPlot]

Column[Flatten[
QuestPlot[#,Histogram->False,Density->False,PsychErrorBars->False]& /@
  dataMethods]]

Comparison shows that the sequences generated by the various methods differ.

Initializing with prior data

Occasionally one may wish to continue data collection from where one left off with a previous run. This can be done by supplying the previous output of QuestExperiment as the "guesses" argument to a new evaluation of QuestExperiment, as in the following demonstration.

First we collect 8 trials for a simulated observer with a threshold of -20. We guess that the threshold is -30.

SetOptions[SimulatedObserver,PsychometricParameters->{-20.,3.5,0.5,0.01}]

Options[QuestExperiment]

data1=QuestExperiment[{-30},8,QuestSeed->99]

Now we decide to collect an additional 8 trials. We use the prior data ("data1") as the guesses argument.

data2=QuestExperiment[data1,8,QuestSeed->99]

Note that the returned data include the old data, as we see by looking at the number of trials

(Plus @@ data2[[1]])[[1]]

When this option is used, the QuestFunction and QuestParameters settings from the previous data set are used for the sceond set as well, overriding any settings in command line.

Using QuestScatter

If the user would like to estimate the slope of the psychometric function, it is better to scatter the trials about the current estimate of threshold, rather than only at threshold. This can be done with the QuestScatter parameter. This describes the half-width of a uniform distribution over index numbers, relative to the index returned by quest. In other words, if QuestScatter->3, and Quest would otherwise have placed the next trial at index 17, it will instead place it at 17 + RandomInteger[ 3 {-1,1}]. Here is a demo.

Options[QuestExperiment]

Options[SimulatedObserver]

Here is a run of 128 trials with QuestScatter->0 (the default).

QuestPlot[QuestExperiment[{-30},128,QuestSeed->99,QuestRange->{-40,0,1}],Fit->True,FitParameters->{True,True}]

Here is a run with QuestScatter->1. Note the  broader distribution of trials, especially later in the run.

QuestPlot[QuestExperiment[{-30},128,QuestSeed->99,
  QuestScatter->2],Fit->True,FitParameters->{True,True}]

Using TargetProbabilities

The option TargetProbabilities can be set to a list (possibly of length 1) of values of the psychometric function (probablities) near which the user would like to concentrate the trials.

One approach to estimating a psychometric function's slope (i.e. beta) is to concentrate trials at alpha ± 1/beta. However, before data are collected neither alpha nor beta are known. TargetProbabilities can be set to QFunction[alpha±1/beta,{alpha,beta,gamma,delta} and data can be collected with an arbitrary guess for beta. Fit the data, allowing beta to vary, and begin a new QuestExperiment, using the new estimate. Iteration of this technique yields a stable estimate of beta.

SetOptions[SimulatedObserver,PsychometricParameters->{-20.,2.,0.5,0.01}];

targetprobabilities=(NormalPF[mu+#sigma,{mu,1/sigma,.5,.01}]&/@{-1,1})

slopeData1=QuestExperiment[{-25},50,TargetProbabilities->targetprobabilities,QuestSeed->1];

PsychometricPlot[intermediateFit=PsychometricFit[slopeData1,FitParameters->{True,True}]]

slopeData2=QuestExperiment[{-25},50,TargetProbabilities->targetprobabilities,QuestParameters->Drop[intermediateFit[[1,3,1]],1],QuestSeed->1];

PsychometricFit[slopeData2,FitParameters->{True,True}]

A Real Experiment

In this example we constuct a simple psychophysical experiment using the built-in display capabilities of mathematica. Display properties are not calibrated, but the example is otherwise realistic.

The experiment we choose is letter identification as a function of contrast in the presense of noise. First we define a few parameters (which the reader can modify), and create some letter stimuli, and a noise stimulus.

imagesize=64;
fontsize=32;
noisecontrast=.25;
magnification=2;
duration=0.25;
SloanList = Characters["CDHKNORSVZ"];

letters = ImageData[Image[Graphics[Text[Style[#,FontFamily->"Helvetica",FontSize->fontsize,FontColor->GrayLevel[.5]
,Background->GrayLevel[0]],{0,0}],PlotRange->All,Background->GrayLevel[0],ImageSize->imagesize],Real,ColorSpace->"Grayscale"]]& /@ SloanList;
noise = RandomReal[.5{-1,1},imagesize{1,1}];

The letter graylevels are defined as extending from 0 to 1/2, so that when added to a background of 1/2 they will have a contrast of 1. The noise image is likewise defined as extending from -1/2 to 1/2. We can look at the letter images, and the noise image.

Image /@ (.5+letters)

Image @ (.5+noise)

Next we create a function to create a stimulus consisting of the addition of a backrgound of 1/2, a letter of some contrast, and noise of some contrast. Index selects one of the list of Sloan letters.

Stimulus[index_, lettercontrast_,noisecontrast_,magnification_:2] := Image[.5 + noisecontrast noise+lettercontrast letters[[index]]
,Magnification->magnification]

We try this

Stimulus[1, .25,.25,4]

Now we create a blank stimulus, in which the letter contrast is zero. This will be used between trials.

blank=Stimulus[1, 0,noisecontrast,magnification];

Next we create the function that is called by Quest whenever a trail is conducted. We include creation of the stimulus, playing an alert tone, presenting the stimulus, replacing it with a blank after a specified duration, collecting the response from the subject, providing feedback, and fnally returning the result (1 or 0).

Clear[ExampleResponse]

ExampleResponse[condition_,strength_] :=Block[
{response,index,stimulus,correct},
index = RandomInteger[{1,10}];
stimulus=Stimulus[index, dBInverse[strength],noisecontrast,magnification] ;
EmitSound[Sound[SoundNote[0,.25]]];
CreatePalette[stimulus,window,WindowMargins->Automatic,WindowTitle->None];
Pause[duration];
CreatePalette[blank,window,WindowMargins->Automatic,WindowTitle->None];
response=ChoiceDialog["Choose:",SloanList,WindowSize->{800,100},WindowMargins->{{Automatic,Automatic},{0,Automatic}}];correct=(response==SloanList[[index]]);
Speak[If[correct, "right","wrong"]];
Pause[1];
If[correct, 1,0]
]

Before we can try this out, we need to create the window within which the stimuli will appear. We fill it initially with the noise image at the specified contrast.

window=CreatePalette[blank,WindowMargins->Automatic,WindowTitle->None];

Now we can try the ExampleResponse function. You should hear a tone, see a letter, and see a response panel appear near the bottom of the screen. Select your response. You should hear speech feedback. (When you first evaluate ExampleResponse, window disappears, but response is accepted, and from then on display works fine. This is a bug in Mathematica.)

ExampleResponse[1,-12]

Now we are ready to conduct the experiment. We guess that threshold will be at -10 dB, and we decide to collect 32 trials. When you are ready, evaluate the following expression, and respond to each trial. Note also that QuestParameters has been set to reflect the 0.1 guessing rate in this experiment.

data=QuestExperiment[{-10},32,QuestRange->{-40,0,2},QuestResponse->ExampleResponse, QuestParameters->{3.5,.1,.01}]

When we are done, we close the stimulus window.

NotebookClose[window]

Then we fit the data. Note that PsychometricParameters has been set to reflect the 0.1 guessing rate in this experiment.

fit=PsychometricFit[data,PsychometricParameters->{Automatic,3.5,.1,.01}]

And plot the results.

PsychometricPlot[fit]

We can also ask for the more elaborate QuestPlot, which shows the sequence of trials (red and green points) and the distribution of trials (blue bars), as well as the log likelihood function.

QuestPlot[data,Fit->True]