SDTEST3.PAS

[From Bruce Abbott (950307.1500 EST)]

Bill Powers (950306.1210 MST)

Below is another version of the discriminative stimulus experiment, built
on Bruce Abbott's program SDTEST1. This is SDTEST2p. The final letter
indicates it is Powers' version, in case someone else is working on an
SDTEST2.

In the middle of the cursor a number is shown, indicating the absolute
average error between the cursor position and whichever target is red. The
object is to keep the number as small as possible.

Maybe it's just me, but I found it almost impossible to keep my eye on that
number attached to the cursor. It might work better to use a point-score
instead which increases at some rate when the participant is keeping the
cursor within some range of the current target, and providing an auditory
beep for each point.

I've created a somewhat different task using this strategy. The participant
sees two targets on the screen and a single cursor. Points can be earned by
keeping the cursor aligned with the currently active target, as indicated by
the cursor color (If acquisition of the discriminated operant is to be
tested, the participant would not be told how to earn points or what the
relationship between cursor color and active target is.) Points are awarded
AT RANDOM while the cursor is being kept within point-range of the active
target.

The task is analogous to a two-key discrimination task in which pecks to the
left key are rewarded on a variable ratio schedule when the keys are green
and on the right key (same schedule) when the keys are red.

Data are recorded to an ASCII file for subsequent analysis by the program of
your choice.

Regards,

Bruce

ยทยทยท

-----------------------------------------------------------------
program SDtest3;

{ Program to investigate the role of the discriminative stimulus. The
  participant's task is earn points by keeping a cursor (green or red
  vertical line) aligned between one of two sets of white vertical lines
  (targets), accomplished by moving the mouse left and right. When the
  cursor is green, the LEFT target is the active target. When the cursor
  is red, the RIGHT target is the active target. The cursor color changes
  at random times throughout the procedure. Data (disturbance, mouse,
  and active target values each 1/60 second) are written in three columns
  to an ASCII text file called SDDATA.XXX, where XXX is a unique 3-digit
  number.

  Written by Bruce Abbott
                     Psychological Sciences
             Indiana University - Purdue University
                    Fort Wayne, IN 46805-1499
                         (219) 481-6399
                   abbott@cvax.ipfw.indiana.edu
}

uses
  CRT, DOS, Graph, GrUtils, Mouse;

const
  MAXDATA = 3600;

type
  datalist = array[1..MAXDATA] of integer;
  dataptr = ^datalist;

var
  h, d, state: dataptr;
  MaxX, MaxY, c, Oldc, CursColor, SD, score,
  T1L, T1R, T2L, T2R: integer;
  slow: real;
  ch: char;

procedure InitHeapVars;
begin
  new(h);
  new(state);
  new(d);
end;

procedure DisposeHeapVars;
begin
  dispose(d);
  dispose(state);
  dispose(h);
end;

procedure InitScreen;
begin
  ClrScr;
  InitGraphics;
  MaxX := GetMaxX; MaxY := GetMaxY;
  ClearViewPort;
  outtextXY(MaxX div 2 - 110, 20, 'DISCRIMINATED OPERANT STUDY');
  rectangle(20, 40, MaxX-20, 160);
  SetColor(lightgreen);
  outtextXY(50, 60,
  'You can earn points by keeping the cursor aligned with one of the two');
  outtextXY(50, 80,
  'sets of white target marks. You move the cursor by using the mouse.');
  outtextXY(50, 100,
  'At any given moment, the correct target on which to align the cursor');
  outtextXY(50, 120,
  '(and thus earn points) may change. Try to earn as many points as');
  outtextXY(50, 140,
  'possible. To start the experimental run, press the SPACE BAR...');
  outtextXY(MaxX div 2 - 20, MaxY div 2 - 60, 'POINTS');
  SetWriteMode(XORPUT);
  setfillstyle(0,0);
  T1L := MaxX div 3 - 5;
  T1R := MaxX div 3 + 5;
  T2L := 2*MaxX div 3 - 5;
  T2R := 2*MaxX div 3 + 5;
end;

procedure DrawTarget;
begin
  SetColor(White);
  line(MaxX div 3, MaxY div 2 - 35, MaxX div 3, MaxY div 2 - 20);
  line(MaxX div 3, MaxY div 2 + 35, MaxX div 3, MaxY div 2 + 20);
  line(2*MaxX div 3, MaxY div 2 - 35, 2*MaxX div 3, MaxY div 2 - 20);
  line(2*MaxX div 3, MaxY div 2 + 35, 2*MaxX div 3, MaxY div 2 + 20);
end;

procedure InitParams;
begin
  Slow := 0.005;
  SD := 1;
  CursColor := LightGreen;
end;

procedure InitDist(dist: dataptr);
var
  i: integer;
  d1, d2, d3, avg, max, tmp : real;
begin
  d1 := 0.0; d2 := 0.0; d3 := 0.0;
  for i := 1 to MAXDATA do
    begin
      d1 := random * 10000.0 - 5000.0;
      d2 := d2 + slow*(d1 - d2);
      d3 := d3 + slow*(d2 - d3);
      dist^[i] := round(d3);
  end;
  avg := 0.0;
  for i := 1 to MAXDATA do avg := avg + d^[i];
  avg := avg/MAXDATA;
  for i := 1 to MAXDATA do d^[i] := d^[i] - round(avg);
  max := 0;
  for i := 1 to MAXDATA do if abs(d^[i]) > max then max := abs(d^[i]);
  for i := 1 to MAXDATA do { normalize to max of 120 }
   begin
    tmp := 120.0/max;
    d^[i] := round(d^[i]*tmp);
   end;
end;

procedure DrawCursor(c, init: integer);
begin
  SetColor(CursColor);
  if init = 0 then
    line(oldc, maxy div 2 - 20, oldc, maxy div 2 + 20);
  oldc := c + maxx div 2;
  line(oldc, maxy div 2 - 20, oldc, maxy div 2 + 20);
end;

procedure Beep;
begin
  sound(2000);
  delay(50);
  nosound;
end;

function Reward: boolean;
begin
  if random < 0.025 then Reward := true else Reward := false;
end;

procedure UpDateScore(var Score: integer);
var NumStr: string[3];
begin
  SetColor(White);
  inc(Score);
  Str(Score:3, NumStr);
  Bar(maxx div 2 - 16, maxy div 2 - 38,
      maxx div 2 + 8, maxy div 2 - 46);
  OuttextXY(maxx div 2 - 15, maxy div 2 - 45, numstr);
  Beep;
end;

procedure Practice;
var handle, cursor: integer;
begin
  readmouse;
  handle := mousex;
  drawcursor(handle + d^[121], 1);
  repeat
    readmouse;
    handle := mousex;
    retrace;
    cursor := handle + d^[121];
    drawcursor(cursor, 0);
    if keypressed then ch := readkey;
  until ch = ' ';
  beep;
end;

procedure RunExpt;
var i, j, x, handle, cursor,
  count, switchcount: integer;
begin
  setViewPort(0, 0, MaxX, 165, clipoff);
  ClearViewPort;
  SetViewPort(0, 0, MaxX, MaxY, clipoff);
  count := 0;
  score := 0;
  randomize;
  SD := 1;
  switchcount := random(480)+120;
  for j := -120 to MAXDATA-1 do { 2-sec run-in period }
    begin
      i := abs(j) + 1;
      readmouse;
      handle := mousex;
      retrace;
      cursor := handle + d^[i];
      h^[i] := handle;
      state^[i] := SD;
      drawcursor(cursor, 0);
      x := cursor + MaxX div 2;
      Case SD of
        1: begin
             if (x > T1L) and (x < T1R)
               then if reward then UpdateScore(Score);
           end;
        2: begin
             if (x > T2L) and (x < T2R)
               then if reward then UpdateScore(Score);
           end;
        end;
      if (count >= switchcount) then
      begin
        count := 0;
        case SD of
          1: begin
               SD := 2;
               CursColor := LightRed;
             end;
          2: begin
               SD := 1;
               CursColor := LightGreen;
             end;
          end;
        SetWriteMode(CopyPut);
        DrawCursor(cursor, 0);
        SetWriteMode(XORPut);
      end;
      inc(count);
    end;
end;

function FileExists(Filename: PathStr): Boolean;
var
  TextFile: Text;
begin
{$I-}
  Assign(TextFile, Filename);
  Reset(TextFile);
  Close(TextFile);
{$I+}
  FileExists := (IOResult = 0);
end;

procedure SaveData;
var
  I, Num: Word;
  Result: Integer;
  DataFile: Text;
  Filename: String[12];
  ID: String[3];
  Stop: Boolean;
begin
  Stop := False;
  Num := 0;
  repeat
    Str(Num:3, ID);
    for i := 1 to 2 do
      if ID[i] = ' ' then ID[i] := '0';
    Filename := 'SDDATA.' + ID;
    if (FileExists(Filename)) then
      begin
        if Num = 999 then Stop := True else inc(Num);
      end
    else Stop := True;
  until (Stop);
{$I-}
  Assign(DataFile, Filename); { assumes current drive/directory }
  Rewrite(DataFile);
{$I+}
  Writeln('Writing data to disk as ', Filename, ' ....');
  if IOResult <> 0 then
    Writeln('ERROR: Unable to open data file.')
  else
    begin
      for I := 1 to MAXDATA do
      begin
        writeln(DataFile, h^[i]:5, d^[i]:5, state^[i]:3);
      end;
      Writeln('Data successfully written to disk.');
      Writeln;
      Writeln(
        'Please record your data filename (indicated above), then press');
      Writeln(' the ESCape key to end this program...');
    end;
  Close(DataFile);
end;

begin
  InitScreen;
  DrawTarget;
  InitHeapVars;
  InitParams;
  InitDist(d);
  Practice;
  RunExpt;
  RestoreCRTMode;
  SaveData;
  DisposeHeapVars;
  CloseGraph;
  repeat
    ch := readkey;
  until ch = #27;
end.