[From Bruce Abbott (950122.2045 EST)]
Below are two programs: 3CV1.PAS and PCTAN.PAS, both adapted from Bill P.'s
original THREECV1 program. I hope you find them useful and relatively bug
free (yeah, sure; well, one can always hope). If anyone needs the necessary
TPU source files (posted over the last month or so on CSG-L), please enquire
via private post to me or Bill Powers. 3VC1 presents a compensatory
tracking demonstration and saves the 3600 row X 4 variable data matrix to a
DOS text file. PCTAN accepts that data file as input and provides a PCT
analysis of the data. The data file can also be imported into statistical
packages, spreadsheets, etc. for analysis as an ASCII text file.
Program 3CV1; { VERSION OF 950122 }
{ A PROGRAM FOR TESTING METHODS OF ANALYSIS
required: setparam.pas revision of 941220; mouse unit
Horizontal mouse movements affect three cursors next to three stationary
target lines. The paricipant picks one cursor and holds it next to its
target line throughout a 1-minute experimental run. The handle (mouse)
position and the three cursor positions are recorded for analysis after
the run.
The user is invited to write an analysis program to go where the dummy
procedure "analyze" is, according to whatever way it is thought that a
conventional psychological analyst would do it.
When the program starts, the first disturbance is shown on the screen.
Pressing the space bar generates a new pattern, pressing escape accepts
that pattern and goes on to the next of three disturbances. After the
third disturbance pattern is accepted, the program pauses (to allow
the participant to select which variable to control). When a key is
struck, the one-minute run starts with a run-in time (not recorded)
of 2 seconds to allow gaining control. MAXDATA data points are recorded.
The three disturbances are stored in arrays of MAXDATA integers on the
heap, dist1[], dist2[], and dist3[]. The mouse position is also stored
in an array on the heap, handle[]. Entries are accessed as distn^[i] or
handle^[i] for i from 1 to MAXDATA.
The three cursor positions and the mouse position for MAXDATA rows are
written to a DOS text file called PCTDATA.XXX, where XXX is a three-digit
number. The program checks to see whether PCTDATA.000 exists; if so it
increments the extension by 1 and checks again. This continues until an
unused filename is found, and the data are then saved under that name.
This scheme permits up to 1000 unique datafiles to be created in a single
directory.
The first row of each data file contains the positions of the three
targets (red lines) and the initial mouse position. Subsequent rows
contain the three cursor positions and mouse position.
Program adapted by B. Abbott from THREECV1 created by Bill Powers.
}
Uses Dos,Crt,Graph,grUtils,mouse;
{Note: use version of frameplt of 941220 or later}
const
left = 203; right = 205; up = 200; down = 208; PgUp = 201; PgDn =
209;
Ins = 210; Del = 211; EndKey = 207; Home = 199; EscKey = 27; Cr = 13;
f1 = 187; f2 = 188; f3 = 189; f4 = 190; f5 = 191;
f6 = 192; f7 = 193; f8 = 194; f9 = 195; f10 = 196;
MAXDATA = 3600;
type datalist = array[1..MAXDATA] of integer;
listptr = ^datalist;
dataarray = array[1..3] of datalist;
dataptr = ^dataarray;
var i,j,maxx,maxy: integer;
slow,d1,d2,d3: real;
maxcolor: word;
dist: dataptr;
mc,c: dataptr;
mh,handle: listptr;
ref: array[1..3] of integer;
ch: char;
k: real;
st,num: string[80];
procedure InitScreen;
begin
ClrScr;
InitGraphics;
MaxX := GetMaxX; MaxY := GetMaxY;
maxColor := getmaxcolor;
end;
procedure labelscreen;
begin
setcolor(white);
outtextxy(0,0,'KEEP ONE WHITE CURSOR AT RED TARGET POSITION');
outtextxy(0,20,' PRESS SPACE TO START RUN');
end;
procedure InitDist(d: listptr; n: integer);
var i,j,max: integer;
avg,tmp: real;
begin
{ repeat}
clearviewport;
{ outtextxy(0,0,'PRESS SPACE FOR NEW PATTERN, ESC KEY TO ACCEPT');
case n of
1: outtextxy(0,20,'FIRST DISTURBANCE');
2: outtextxy(0,20,'SECOND DISTURBANCE');
3: outtextxy(0,20,'THIRD DISTURBANCE');
end;}
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);
d^[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;
{ for j := 1 to 3600 do
putpixel(j div 6,maxy div 2 - d^[j] div 2,white);
ch := readkey;
until ch = chr(EscKey); }
end;
var oldc: array[1..3] of integer;
procedure drawcursor(c,n,init: integer);
begin
if init = 0 then
line(oldc[n], maxy div 2 - 60 + 25*(n - 1),
oldc[n], maxy div 2 - 45 + 25*(n - 1));
oldc[n] := c + maxx div 2;
line(oldc[n], maxy div 2 - 60 + 25*(n - 1),
oldc[n], maxy div 2 - 45 + 25*(n - 1));
end;
procedure drawtargets;
begin
setcolor(lightred);
for i := 1 to 3 do
begin
ref[i] := maxx div 2;
line(maxx div 2, maxy div 2 - 60 + 25*(i - 1),
maxx div 2, maxy div 2 - 45 + 25*(i - 1));
end;
setcolor(white);
end;
procedure Practice;
var h,k,i: integer;
begin
readmouse;
for k := 1 to 3 do drawcursor(mousex + dist^[k,121],k,1);
repeat
readmouse;
h := mousex;
retrace;
for k := 1 to 3 do
begin
drawcursor(mousex + dist^[k,121],k,0);
end;
if keypressed then ch := readkey;
until ch = ' ';
end;
procedure RunExpt;
var h,k,i: integer;
begin
for j := -120 to MAXDATA-1 do { 2-sec run-in period }
begin
i := abs(j) + 1;
readmouse;
h := mousex;
handle^[i] := h;
retrace;
for k := 1 to 3 do
begin
drawcursor(mousex + dist^[k,i],k,0);
c^[k,i] := oldc[k];
end;
if keypressed then break;
end;
if keypressed then ch := readkey;
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[11];
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 := 'PCTDATA.' + 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 j := 1 to 3 do write(DataFile, ref[j]:4);
writeln(Datafile, handle^[1]:5);
for I := 1 to MAXDATA do
begin
for j := 1 to 3 do write(DataFile, c^[j,i]:4);
writeln(DataFile, handle^[i]:5);
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
ClrScr;
if not initmouse then
begin
gotoxy(20,10);
writeln('MOUSE NOT INSTALLED. EXITING');
delay(2000);
exit;
end;
new(dist);
new(c);
new(mh);
new(mc);
new(handle);
Randomize;
slow := 0.005; { rapidity of disturbance, smaller = slower }
InitScreen;
for i := 1 to 3 do InitDist(@dist^[i],i);
clearviewport;
labelscreen;
setwritemode(XORPUT);
drawtargets;
Practice;
RunExpt;
clearviewport;
RestoreCrtMode;
closegraph;
SaveData;
dispose(handle);
dispose(mc);
dispose(mh);
dispose(c);
dispose(dist);
repeat
ch := readkey;
until ch = #27;
end.
···
*****************************************************************
program PCTan; { VERSON OF 950122 }
{
Applies PCT analysis to text data file written by 3CV1 compensatory
tracking program. Adapted by B. Abbott from original PCTMODEL analysis
written by Bill Powers.
USAGE: You can start the program from the DOS prompt by typing either
PCTAN by itself (in which case you will be prompted for a data
filename) or with filename (e.g., PCTAN PCTDATA.001), in which
case you will not be prompted for a filename.
}
uses
DOS, CRT, graph, grutils;
const
MAXDATA = 3600;
type datalist = array[1..MAXDATA] of integer;
listptr = ^datalist;
dataarray = array[1..3] of datalist;
dataptr = ^dataarray;
var i,j,maxx,maxy,npoints,iter: integer;
slow,d1,d2,d3,k,
sx,sy,ssx,ssy,sxy,xbar,ybar,
sigx,sigy,correl,regress,
cursor,h,e,temp,sumsq,savesum: real;
maxcolor: word;
dist: dataptr;
mc,c: dataptr;
mh,handle: listptr;
r: array[1..3] of integer;
ch: char;
st,num: string[80];
done, DataRead: boolean;
procedure InitScreen;
begin
ClrScr;
InitGraphics;
MaxX := GetMaxX; MaxY := GetMaxY;
maxColor := getmaxcolor;
end;
function FileExists(Filename: PathStr): Boolean;
var
TextFile: Text;
begin
{$I-}
Assign(TextFile, Filename);
Reset(TextFile);
Close(TextFile);
{$I+}
FileExists := (IOResult = 0);
end;
procedure ReadData(var FileRead: boolean);
var
Filename: Pathstr;
DataFile: Text;
i, j, result: integer;
begin
Filename := ParamStr(1);
if Filename = '' then
repeat
gotoXY(1, 5); Write('Enter Data Filename or type QUIT to exit: ');
Readln(Filename);
until Filename <> '';
for i := 1 to length(Filename) do
Filename[i] := upcase(filename[i]);
if Filename = 'QUIT' then
begin
FileRead := False;
writeln('QUIT: No files read or written');
Exit;
end;
gotoXY(1, 6); write('Filename = ', Filename);
if FileExists(Filename) then
begin
i := 0;
{$I-}
Assign(DataFile, Filename);
Reset(DataFile);
Result := IOResult;
{$I+}
if Result = 0 then
begin
gotoXY(1, 7); write('Reading ',Filename);
if (NOT EOF(DataFile)) then
Readln(DataFile, r[1], r[2], r[3], handle^[1]);
while (NOT EOF(DataFile)) do
begin
inc(i);
Readln(DataFile, c^[1,i], c^[2,i], c^[3,i], handle^[i]);
dist^[1,i] := c^[1,i] - r[1] - handle^[i];
dist^[2,i] := c^[2,i] - r[2] - handle^[i];
dist^[3,i] := c^[3,i] - r[3] - handle^[i];
gotoXY(1, 8); write(i:5, ' data points read');
end;
Close(DataFile);
FileRead := true;
if i > MAXDATA then NPoints := MAXDATA else NPoints := i;
end
else
begin
FileRead := false;
gotoXY(1, 8); write('Unable to read data file...');
end;
end
else
begin
FileRead := false;
gotoXY(1, 8); write('Unable to find ', Filename);
end;
end;
procedure getmeans;
var
i, j: integer;
mean: array[1..3] of real;
begin
for i := 1 to 3 do
begin
sx := 0;
for j := 1 to NPoints do sx := sx + c^[i,j];
mean[i] := sx/NPoints;
end;
writeln;
writeln('Refs = ', r[1]:6, r[2]:8, r[3]:8);
writeln('Means = ', mean[1]:8:1, mean[2]:8:1, mean[3]:8:1);
writeln;
end;
procedure correlation(x,y:listptr; n: word);
var i: integer;
begin
sx := 0.0; sy := 0.0; ssx := 0.0; ssy := 0.0; sxy := 0.0;
for i :=1 to n do
begin
sx := sx + x^[i];
sy := sy + y^[i];
end;
xbar := sx/n;
ybar := sy/n;
for i :=1 to n do
begin
ssx := ssx + (x^[i] - xbar) * (x^[i] - xbar);
ssy := ssy + (y^[i] - ybar) * (y^[i] - ybar);
sxy := sxy + (x^[i] - xbar) * (y^[i] - ybar);
end;
sigx := sqrt(ssx/n);
sigy := sqrt(ssy/n);
correl := sxy/(n*sigx*sigy);
regress := correl*sigy/sigx;
end;
function modelrun(n: integer): real;
var newsumsq,h: real;
i: integer;
begin
h := handle^[1];
newsumsq := 0.0;
for i := 1 to NPoints do
begin
cursor := h + dist^[n,i];
mc^[n,i] := round(cursor);
h := h - k*cursor;
mh^[i] := round(h);
temp := 1.0*handle^[i] - h;
newsumsq := newsumsq + temp*temp;
end;
modelrun := newsumsq;
end;
function fitmodel(n: integer): real;
var i: integer;
delta: real;
begin
k := 1.00; iter := 0;
sumsq := 1e30;
done := false;
delta := -k/2.0;
repeat
gotoxy(1,14); write('k = ', k:10:6, ' delta = ', delta:10:6);
savesum := sumsq;
sumsq := modelrun(n);
if sumsq > savesum then
begin
delta := -delta/2.0;
done := abs(delta) < 0.001;
end;
if not done then
begin
if (k+delta <= 0) then delta := delta/2.0
else if (k+delta > 1.0) then delta := -delta/2.0;
k := k + delta;
end;
iter := iter + 1;
until done or (iter >= 100);
h := handle^[1];
sumsq := modelrun(n);
fitmodel := sqrt(sumsq/NPoints);
writeln;
end;
procedure PCTmodel;
var i,imin: integer;
cor: array[1..3] of real;
cmin,rms: real;
begin
restorecrtmode;
clrscr;
gotoxy(0,10);
writeln(
'The handle affects all three cursors equally. Therefore the Test will');
writeln(
'look for the cursor that is least affected -- the one that correlates');
writeln(
'the lowest with the handle position is probably the controlled quantity.');
writeln;
GetMeans;
cmin := 1.00;
for i := 1 to 3 do
begin
correlation(handle,@c^[i],NPoints);
cor[i] := correl;
end;
for i := 1 to 3 do
begin
if abs(cor[i]) < abs(cmin) then
begin
cmin := cor[i];
imin := i;
end;
end;
case imin of
1: write('TOP');
2: write('MIDDLE');
3: write('BOTTOM');
end;
writeln(' Cursor was controlled. H-C correlation = ',cmin:7:4);
write(' Other correlations were: ');
for i := 1 to 3 do
if i <> imin then
write(' ',cor[i]:7:4);
writeln;
writeln; writeln(
'Next step: fit model with integrating output function to data.');
writeln;
rms := fitmodel(imin);
writeln;
writeln('Value of k: ',k:7:4,' RMS prediction error, pixels: ',rms:3:2);
writeln; writeln(
'Final step: Use value of k to run model and compare model handle');
writeln(
'position with real handle position.');
writeln;
write('Enter value of k from a previous run? Y/N: ');
ch := readkey; writeln(ch);
if (ch = 'Y') or (ch = 'y') then
begin
write(' Enter value: '); readln(k);
end;
writeln;
write('Fitting model to data, please wait...');
sumsq := modelrun(imin);
rms := sqrt(sumsq/NPoints);
setgraphmode(graphmode);
setcolor(lightred);
outtextxy(0,0,'REAL SUBJECT''S HANDLE');
setcolor(lightgreen);
outtextxy(0,20,'MODEL SUBJECT''S HANDLE');
setcolor(lightgray);
outtextxy(0,40,'NEGATIVE OF DISTURBANCE');
for i := 1 to NPoints do
begin
putpixel(i div 6,maxy div 2 - handle^[i],lightred);
putpixel(i div 6,maxy div 2 - mh^[i],lightgreen);
putpixel(i div 6,maxy div 2 + dist^[imin,i], lightgray);
putpixel(i div 6,maxy div 2,white);
end;
correlation(handle,mh,NPoints);
str(correl:7:4,num);
setcolor(white);
outtextxy(0,60,'Correlation = ' + num);
str(rms:4:1,num);
outtextxy(0,75,'RMS difference, pixels = ' + num);
str(k:5:3,num);
outtextxy(0,90,'Integration factor k = ' + num);
outtextxy(10, maxy-50, 'Press Esc key to end...');
repeat ch := readkey until ch = #27;
end;
begin
InitScreen;
restoreCRTmode;
TextBackground(black);
TextColor(lightgray);
ClrScr;
gotoXY(24, 1); write('PCT ANALYSIS of TRACKING DATA');
new(dist);
new(c);
new(mh);
new(mc);
new(handle);
ReadData(DataRead);
if DataRead then
PCTModel;
RestoreCrtMode;
closegraph;
dispose(handle);
dispose(mc);
dispose(mh);
dispose(c);
dispose(dist);
writeln;
end.