Sunday, January 15, 2012

A Multi-option choice task

Recently, a user was interested in creating a similarity judgment task where the participant would see one color shade, and then be presented with six color shades--the correct one plus five similar foils, and have to choose the proper target.  This basic type of task can probably be considered a "Match to sample" task that goes back at least to Skinner and the behaviorists.  It was useful to them because you could train a rat to do the task.  It is also useful because it can help us understand perceptual or memory spaces, as well as help to understand and mitigate the impact of guessing.  That is, as you increase the number of options, the correct-by-chance rate decreases toward 0.  If you give only two options, you can get around 50% correct by closing your eyes; if you give 100 options, you'd only get the correct response 1% of the time.


I want to generalize the task a little bit, using arbitrary shapes (like the circles shown on the left),  and take advantage of some layout functions that are available in PEBL.  So to start, let's make a function that will simply take a set of graphical objects.  They might be shapes, labels, images, and so on, and it shouldn't matter to the function what they actually are.  The simplest way to do this is to pass in two arguments, the 'correct' option and the foils, as well as the window object we want to place them on.  Presenting the stimulus is fairly simple, which I'll do below



define MultiOptionChoice(target,foils,win)
{

   AddObject(target, win)
   Move(target, gVideoWidth/2,gVideoheight/2)
   Draw()
   Wait(1000)  ##Present the stimulus for 1 sec
   Hide(target)
   Draw()

}


Now, we need to do a few things: 1.  Arrange the stimuli on the screen, being careful to put the correct option in a random position; 2. collect the response via mouse; and 3. return the response.

The first task will take a few steps.  We can easily merge the target into the object list with the Append function, but when we shuffle them, we want to be able to be able to easily tell whether it is correct.  So, let me make two lists. Order will keep track of the original order, and we will specify order index 1 as the correct target.

   order <- Sequence(1,Length(foils)+1,1)
   stim <- Merge([target],foils)

 Now usually, to mix up the order of a set of objects, we use the Shuffle command.  But that won't work too well here, because we want to shuffle both order and stim.  There are a number of ways we can shuffle them both in the same order though, and since the task is very simple computationally, it doesn't really matter too much how.  One way is to create a shuffled key list of the numbers, and sort the other lists by that key list:

  shuffledorder <- Shuffle(order)  ##A random set of numbers 1..N+1
  neworder <- SortBy(order, shuffledorder)
  newstim <- SortBy(stim,shuffledorder)

You should recognize that neworder will turn out exactly like shuffledorder, but you can adapt this for other stimulus labels (that are maybe named or numbered)




Now, we need to add the foil/target list to the window. I've written a few layout functions that will do this automatically for various other tasks, and although they haven't been added to PEBL yet, here is one of them.  It takes an argument the min and max x and y position for the gridpoints, the number wide and tall of the elements, and whether the layout should be horizontal or vertical.


 define LayoutGrid(xmin,xmax,ymin,ymax, tall, wide, horvert)
 {
     xskip <- (xmax-xmin)/(wide+1)
     yskip <- (ymax-ymin)/(tall+1)

     pts <- []

     if(horvert == 1)
      {
        x <- xmin+xskip
       loop(i,Sequence(1,wide,1))
        { 
          y <- ymin+yskip
         loop(j,Sequence(1,tall,1))
          {
             pts <- Append(pts, [x,y])
             y <- y + yskip
          }
          x <- x + xskip
        }
      } else {
       y <- ymin+yskip
       loop(i,Sequence(1,tall,1))
        { 
          x <- xmin+xskip
         loop(j,Sequence(1,wide,1))
          {

             pts <- Append(pts, [x,y])
             x <- x + xskip
             y <- y + yskip       
          }

     }}

   return pts
  }



This is fine, but we should also have a way of deciding what the gridding should be like.  That is, if we want to layout 4 objects, should it be a 1x4 grid or a 2x2 grid, or something else?  This can probably be computed automatically using smart reasoning about golden ratios and such, but for us, let's just pick the layout we think would be best for, let say 1 to 15 items.  Any more than 15 and we can do something more automatic.  So I'll first create a list that specified the rows and columns we want for 1...15, then either select the correct one, or choose a grid size based on the square root of the number of things we want to layout, with the restriction that if rows and columns differ, make rows be larger than columns.


define GetGrid(items)
{
   grids <- [[1,1],  #1 item
             [1,2],  # 2 items
             [1,3],  # 3 items
             [2,2] , #4 item
             [2,3],  #5 items
             [2,3],  #6 items
             [2,4],  #7 items
             [2,4],  #8 items
             [3,3],  #9 items
             [3,4],  #10 items
             [3,4],  #11 items
             [3,4],  #12 items
             [3,5],  #13 items
             [3,5],  #14 items
             [3,5]]  #15 items

   if(items <=15)
   {

     ret <- Nth(grids,items)

   } else {

     base <- Round(Sqrt(items))
    if((base-1)*base >=items)
     {
      ret <- [base-1,base]
     } elseif(base*base >= items)
     {
        ret <- [base, base]
     } elseif(base*(base+1)>=items)
     {
       ret <- [base, base+1]
     } else
     {
       ret <- [base+1,base+1]
     }
   }
  return ret
}
 


Now, the code to determine the layout might look like this:

  grid <- GetGrid(Length(newstim))
  layout <-  LayoutGrid(100, gVideoWidth-100, 100, gVideoheight-100,
            First(grid), Second(grid), 1)

  tmp <- Transpose([newstim,layout])
  loop(i,tmp)
  {
    AddObject(First(i),win)
    xy <- Second(i)
   Move(First(i),First(xy),Second(xy))
  }
  Draw()






Now, we need to get the response.  This is a very simple one-liner, using WaitForClickOnTarget.  We give it the list of targets, and the list of elements to provide as the response.  Also, capture the timing of this.  We know the response is correct if they chose 1.



  time0 <- GetTime()
  resp <- WaitForClickOnTarget(newstim, neworder)
  time1 <- GetTime()




When the response is collected, it will tell us which element of the original list was chosen, and we just need to return that.


The complete function appears at the bottom of the page.  But to finish, we first need to create some stimuli to display. How about circles of different sizes?  The great thing about the general function is that we could give it a list of any graphical object--text, images, shapes, etc., and it will do fine, as long as they are a reasonable size.



 define Start(p)
{

   win <- MakeWindow()


   ##Make a bunch of circles of different sizes.
 

   minR <- 10
   maxR <- 50
   i <- minR
  stim <- []
   while(i <= maxR)
   {
     stimulus <- Circle(0,0,i,MakeColor("black"),1)
     stim <- Append(stim,stimulus)
     i <- i + 1
   }

  stim <- Shuffle(stim)
  MultiOptionChoice(First(stim),SubList(stim,2,4),win)

  stim <- Shuffle(stim)
  MultiOptionChoice(First(stim),SubList(stim,2,8),win)

  stim <- Shuffle(stim)
  MultiOptionChoice(First(stim),SubList(stim,2,15),win)

  stim <- Shuffle(stim)
  MultiOptionChoice(First(stim),SubList(stim,2,24),win)

}

And here is how it looks, for each of the four trials during the choice part of the test.  Notice that the 24-alternative task has some overlap.  That shouldn't impact much, but we could make the screen larger or the margins smaller to avoid this if we needed to.








Here is the full function, combining all the elements discussed above:



define MultiOptionChoice(target,foils,win)

{

   AddObject(target, win)
   Move(target, gVideoWidth/2,gVideoheight/2)
   Draw()
   Wait(1000)  ##Present the stimulus for 1 sec
   Draw()



   order <- Sequence(1,Length(foils)+1,1)
   stim <- Merge([target],foils)
   shuffledorder <- Shuffle(order)  ##A random set of numbers 1..N+1
   neworder <- SortBy(order, shuffledorder)
   newstim <- SortBy(stim,shuffledorder)
  
  grid <- GetGrid(Length(newstim))
  layout <-  LayoutGrid(100, gVideoWidth-100, 100, gVideoheight-100,
                        First(grid), Second(grid), 1)

  ##make it the right length
  layout <- SubList(layout, 1, Length(newstim))

  tmp <- Transpose([newstim,layout])
  loop(i,tmp)
  {
    AddObject(First(i),win)
    xy <- Second(i)
    Move(First(i),First(xy),Second(xy))
  }
  Draw()

  time0 <- GetTime()
  resp <- WaitForClickOnTarget(newstim, neworder)
  time1 <- GetTime()


  ##Remove the stimuli

  loop(i,newstim)
  {
    RemoveObject(i, win)
  }
  ##Get the chosen object.
  chosen <- Nth(stim,resp)
  ##Score whether it is correct.
  corr <- resp == 1

  return [resp,corr, (time1-time0), chosen.x, chosen.y]

}

No comments: