Bijlage programmatuur

(1)

Bijlage programmatuur

Citation for published version (APA):

Schouten, G. (1988). Bijlage programmatuur. (IPO-Rapport; Vol. 644). Instituut voor Perceptie Onderzoek (IPO).

Document status and date: Gepubliceerd: 01/01/1988

Document Version:

Uitgevers PDF, ook bekend als Version of Record

Please check the document version of this publication:

• A submitted manuscript is the version of the article upon submission and before peer-review. There can be important differences between the submitted version and the official published version of record. People interested in the research are advised to contact the author for the final version of the publication, or visit the DOI to the publisher's website.

• The final author version and the galley proof are versions of the publication after peer review.

• The final published version features the final layout of the paper including the volume, issue and page numbers.

Link to publication

General rights

Copyright and moral rights for the publications made accessible in the public portal are retained by the authors and/or other copyright owners and it is a condition of accessing publications that users recognise and abide by the legal requirements associated with these rights. • Users may download and print one copy of any publication from the public portal for the purpose of private study or research. • You may not further distribute the material or use it for any profit-making activity or commercial gain

• You may freely distribute the URL identifying the publication in the public portal.

If the publication is distributed under the terms of Article 25fa of the Dutch Copyright Act, indicated by the “Taverne” license above, please follow below link for the End User Agreement:

www.tue.nl/taverne

Take down policy

If you believe that this document breaches copyright please contact us at:

openaccess@tue.nl

providing details and we will investigate your claim.

(2)

Instituut voor Perceptie 0nderzoek

Postbus 513 - 5600 MB

Eindhoven

Rapport no. 644

Bijlage Programmatuur

G. Schouten

(3)

Bijlage Programmatuur

Programma BESSELTPG.FOR

Datafile B40.RIN

Programma DISKTPG.FOR

Datafile D40.RIN

Programma EXPTPG.FOR

Datafile GERARD.LOG

Programma FITCTF .FOR

Programma FITMTF .FOR

(4)

Programma BESSELTPG.FOR

Dit programma genereert Besselvormige stimuli.

(5)

c Dit programma genereert Bessel functies van de eerste soort van c orde nul voor de TPG (Het aantal ringen tot de eerste nuldoorgang c van JO rnoet ingevoerd worden). Hierbij wordt gebruik gernaakt van c de NAGLIB routine S17AEF.

C

integer erno real*B x,JO

character*SO outfil write(6,20)

20 format(' Enter name outputfile ***.rin:') read(6,30) outfil

30 forrnat(a50)

open{SO,file-outfil,status='new') write{6,40)

40 format{' Enter number of samples to the first O of JO: ') read(S,*) b do i-1,384 x=2.4048255577/b*i JO=S17AEF{x,erno) JO•JO*l27 write(6,*) i,JO,erno write{S0,100) nint(JO) 100 format(' ' , i3) end do close(50) end

2.

(6)

Datafile B40.RIN

Voorbeeld van een Besselvormige stimulus ( eerste

nuldoorgang bij de 40e ring).

(7)

127 127 126 125 124 123 121 120 118 116 113 111 108 105 102 99 96 92 89 85 81 77 73 69 65 60 56 52 47 43 38 34 30 25 21 17 12 8 4 0 -4 -8 -11 -15 -18 -22 -25 -28 -31 -33 -36 -38 -40 -42 -44 -45 -47 -48 -49

-so

-51 -51 -51 -51 -51

-so

4-.

(8)

-49 -48 -47 -45 -44 -42 -40 -39 -37 -35 -32 -30 -28 -25 -23 -20 -18 -15 -13 -10 -7 -5 -2 0 3 6 8 11 13 15 17 20 22 24 25 27 29 30 32 33 34 35 36 37 37 38 38 38 38 38 38 37 37 36 35 35 34 32 31 30 28 27 25 24 22 20 18 16

fi.

(9)

14 12 10 8 6 4 2 0 -2 -4 -6 -8 -10 -12 -14 -16 -17 -19 -20 -22 -23 -25 -26 -27 -28 -29 -29 -30 -31 -31 -31 -32 -32 -32 -32 -31 -31 -30 -30 -29 -28 -27 -26 -25 -24 -23 -22 -20 -19 -17 -16 -14 -13 -11 -9 -7 -6 -4 -2 0 2 3 5 7 8 10 12 13

t.

(10)

15 16 17 19 20 21 22 23 24 25 26 26 27 27 27 28 28 28 28 27 27 27 26 26 25 24 23 23 22 21 19 18 17 16 14 13 11 10 8 7 5 4 2 1 -1 -3 -4 -6 -7 -9 -10 -11 -13 -14 -15 -17 -18 -19 -20 -21 -21 -22 -23 -23 -24 -24 -25 -25

f.

(11)

-25 -25 -25 -25 -25 -24 -24 -23 -23 -22 -21 -21 -20 -19 -18 -17 -16 -14 -13 -12 -11 -9 -8 -7 -5 -4 -2 -1 1 2 3 5 6 8 9 10 11 13 14 15 16 17 18 19 19 20 21 21 22 22 22 23 23 23 23 23 23 22 22 22 21 20 20 19 18 17 17 16

lJ.

(12)

15 14 12 11 10 9 8 6 5 4 2 1 0 -2 -3 -4 -5 -7 -8 -9 -10 -11 -12 -13 -14 -15 -16 -17 -18 -18 -19 -20 -20 -20 -21 -21 -21 -21 -21 -21 -21 -21 -20 -20

J.

(13)

Programma DISKTPG.FOR

Dit programma genereert schijfvormige stimuli.

(14)

c Dit programrna genereert 'schijven' (disks) voor de TPG.

c De radius van de disk (opgegeven in aantal ringen) moet ingevoerd

c worden.

integer b,d,i character*SO outfil write (6, 20)

20 format(' Enter name outputfile ***.rin:') read(6,30) outfil

30 format(a50)

open(SO,file-outfil,status='new') write(6,40)

40 format('$Enter radius of disk. ') read(S,*) b do i=l,b d•l27 write(6,*) i,d write(S0,50) d end do do i=b+l,384 daO write (6, *) i,d write(S0,50) d end do 50 format(' ',i3) close(SO) end

//.

(15)

Datafile D25.RIN

Voorbeeld van een schijfvormige stimulus (radius 25 ringen).

(16)

127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

11.

(17)

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

/If.

(18)

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

15'.

(19)

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

II.

(20)

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

(21)

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

1,.

(22)

Programma EXPTPG.PAS

Meetprogramma waarmee de drempelwaarde van een

referentie- en combinatiestimulus wordt gemeten.

(23)

Dit programma is het besturingsprogramma en resultaatverwerkingsprogramma voor de microprocessor (6809) van de Tyd Plaats Generator (TPG), die in de visuele groep van het IPO gebruikt wordt in een experimenteeropstelling. De besturing vindt plaats door een terminal die aan de microprocessor gekoppeld is. In het experiment wordt de drempelwaarde bepaald van een referentie- en combinatie stimulus; er wordt hierbij gebruik gemaakt van de 'two alternative forced choice' (TAFC) methode.

Gerard Schouten, mei '87. Copyright IPO. )

program exptpg(input,output,checkfile,framefile,personfile,ringfile); %include' [braak.pas.work)forsub.pas/nolist';

Hiermee is het mogelijk om 'plots' te maken met het DISSPLA pakket in een pascal programma. )

type

var

answer - packed array (1 . . 13) of char; coin• array (1 . . 1000) of integer; command• packed array (1 . . 10) of char; intensity - array (1 . . 5) of real; probability= array (1 .. 5) of real; string= packed array (1 . . 50) of char; watch= packed array (1 .. 11) of char; x coordinate array (1 . . 5) of real; y=coordinate = array (1 . . 5) of real; data: string; ti: watch; cm: char; t: integer; z: real; checkfile,framefile,personfile,ringfile: text; procedure piepl0;

{ Deze procedure laat 10 pieptoontjes achter elkaar horen. ) var i: integer;

begin

for i:=l to 10 do write(chr(7)) end;

procedure error_report(code: char);

Deze procedure schrijft aan de hand van zijn parameter 'code' de oorzaak van de fout die ontstaan is bij het overzenden van een com-mando naar de microprocessor op het scherm van de terminal.

Een foutmelding wordt tevens kenbaar gemaakt met behulp van een akoestisch signaal (10 pieptoontjes). Hiervoor wordt de procedure piepl0 aangeroepen. ) begin piepl0; writeln(' '); case code of 'l': writeln('Wrong command.');

'2' : writeln (' Checksum error.'); '3': writeln('Experiment cancelled.');

'4': writeln('Counter overflow.');

'5': writeln('dB out of range.');

'6': writeln('Illegal channel number.'); '7': writeln('Mode error.');

'8': writeln('Parameter error.') otherwise writeln('Unknown error.')

(24)

end end;

procedure sendbuffer(com: command; length: integer);

{ Een string voorafgegaan door cntrl b en afgesloten met lf er ('line feed carriage return') wordt naar de microprocessor gestuurd.

T

var cntrl b: char; i,kl,k2: integer; begin cntrl b:=chr(2); kl:•O;

for k2:=l to 175 do kl:•kl+l;{ vertraging; nodig voor goede communicatie. } write (cntrl b);

for i:•l to-length do write(com[i]);

writeln { afsluiten van een string (lf er).

end;

-procedure readbuffer(var code: char);

Na het overzenden van een commando geeft de microprocessor een melding. Deze procedure leest de melding {in de vorm van de karakter parameter 'code') van de microprocessor; code• '0' houdt in dat het commando goed is ontvangen; als code<> '0' wordt de procedure error_report aangeroepen. var kl,k2: integer;

begin kl:•O;

for k2:=l to 175 do kl:•kl+l; readln(code);

if code<>'O' then error report{code)

end;

-procedure rs;

{ 'Reset'. De procedures send.buffer en read.buffer worden aangeroepen. ) type command= packed array [l .. 10] of char;

var corn: command; code: char; length: integer; begin com[l] :=' r'; com[2] :=' s'; length:=2; sendbuffer(com,length); code:-'0'; readbuffer(code) end; procedure pp(cm: char);

Deze procedure opent de personfile; de naam van de personfile wordt de karakterstring die via de terminal wordt ingevoerd. )

type string= packed array [l .. 50] of char; var

name: string; i,j: integer; begin

for i:=l to 50 do narne[i] :=' ';

(25)

if cm•'y' then

begin

writeln(' ');

writeln('The name you enter becomes the name of a'); writeln('logfile: [name.log) in which all results are'); writeln('written.')

end;

writeln(' ');

write('Enter name of the subject: '); readln(name); i:•l; repeat i :ai+l until name[i]•' '; name[i] :•' .'; name [i+l] :-' l'; name[i+2J :-'o'; name[i+3] :•'g'; name[i+4) :=' ;';

open(file variable:•personfile,file name:=name,history:=new);

rewrite(personfile);

-writeln(personfile,' '); writeln(personfile,'Data.'); writeln(personfile,'•••••'); writeln(personfile,' ');

write(personfile,'Name of the subject: '); for j:-1 to i-2 do write(personfile,name[j]); writeln(personfile,name[i-1])

end;

procedure wr(com: command; length: integer); 'Write ringtable.'

Deze procedure zorgt voor het oversturen van een ringtabel (locationtable) naar de microprocessor.

De ringtabel bestaat uit 256 waarden (elke waarde 2 bytes!) in bereik van -127(hex 81) .. +127(hex 7f).

De tabel wordt in de volgende vorm overgestuurd: cntrl b - 64 bytes - lf er.

De procedures sendbuffer en readbuffer worden aangeroepen. label 01,02;

type table= packed array [1 .. 50] of char; var tpgfile: table; cntrl b,code: char; c,i,n~ringcheck: integer; begin cntrl b:=chr(2); 01:writeln(' ');

write('Enter filename of ringtable: '); readln(tpgfile);

if index(tpgfile,'rin')=O then goto 01;

open(file variable:•ringfile,file name:=tpgfile,history:=old,

error:~continue);

-if status(ringfile)<>O then goto 01;{ 'error opening file.' } reset(ringfile);

sendbuffer(com,length); code:='0';

readbuffer(code);

if code<>'O' then goto 02;

writeln(personfile,'Ringtable: ',tpgfile); n:=l;

ringcheck:=0; repeat

(26)

for i:=l to 32 do begin

readln(ringfile,c); ringcheck:•ringcheck+c;

c:=c+l27; ( nodig voor TPG besturing, bereik: 00 .. ff. } write(hex(c,2)) end; writeln (' '); n:•n+l until n>B; write(cntrl b); writeln(hex(ringcheck,2)); code:ca'0'; readbuffer(code); 02:close(ringfile) end;

procedure wf(com: command; length: integer); 'Write frametable.'

Deze procedure zorgt voor het oversturen van een frametabel (timetable) naar de microprocessor.

De frametabel bestaat uit 384 waarden (elke waarde 2 bytes!) in bereik van 0 .. 255(hex ff).

De frametabel wordt in de volgende vorm overgestuurd: cntrl b - 64 bytes - lf er.

De procedures sendbuffer en readbuffer worden aangeroepen. label 01,02;

type table= packed array [l .. 50] of char; var tpgfile: table; cntrl b,code: char; c,framecheck,i,n: integer; begin cntrl b:=chr(2); 01:writeTn(' ');

write('Enter filename of frametable: '); readln(tpgfile);

if index(tpgfile,'fra')=0 then goto 01;

open(file variable:=framefile,file name:=tpgfile,history:=old,

error:~continue);

-if status(framefile)<>0 then goto 01; reset(framefile);

readbuffer(code);

if code<>'0' then goto 02;

writeln(personfile,'Frametable: ',tpgfile); n:=l;

framecheck:=0; repeat

write (cntrl b); for i:=l to-32 do

begin readln(framefile,c); framecheck:=framecheck+c; write (hex (c, 2)) end; writeln(' '); n:=n+l until n>l2; write(cntrl b); writeln(hex(framecheck,2)); code:='0'; readbuffer(code);

.lJ.

(27)

02: close (frarn,3file) end;

procedure fd ( ,::om: command; length: integer) ;

'Set frame delay.' De procedures sendbuffer en readbuffer warden aangeroe-pen. } var code: char; k: integer; begin sendbuffer(com,length); code:-'0'; readbuffer(code); if code='O' then begin

k:=ord(com[6])-48;{ omzetten van karakter naar integer. } k:=k+lO*(ord(com[S])-48);

k:=k+l00*(ord(com[4])-48); k:=round(k/0.15);

writeln(personfile,'Frame delay: ',k:4,' msec.') end

end;

procedure fl(com: command; length: integer);

'Set frame length.' De procedures sendbuffer en readbuffer warden aangeroe-pen. } var code: char; k: integer; begin sendbuffer(com,length); code:='0'; readbuffer(code); if code='O' then end; begin k:=ord(com[6])-48; k:=k+lO*(ord(com[S])-48); k:=k+l00*(ord(com[4])-48); k:=round(k/0.15);

writeln(personfile,'Frame length: ',k:4,' msec.') end

procedure ru(com: command; length: integer);

'Rotate ringtable up.' De procedures sendbuffer en readbuffer warden aangeroepen. }

var code: char; begin

sendbuffer(com,length); code:='O';

readbuffer(code) end;

procedure rd(com: command; length: integer);

'Rotate ringtable down.' De procedures sendbuffer en readbuffer warden aangeroepen. }

(28)

var code: char; begin sendbuffer(com,length); code:='0'; readbuffer(code) end;

procedure db(com: command; length: integer);

'Set dB-value.' De procedures sendbuffer en readbuffer warden aangeroe-pen. }

var code: char; begin

sendbuffer(com,length); code:•'0';

procedure up(com: command; length: integer);

'Increase dB-setting.' De procedures sendbuffer en readbuffer worden aangeroepen. }

sendbuffer(com,length); code:-'0';

procedure down(com: command; length: integer);

'Decrease dB-setting.' De procedures sendbuffer en readbuffer worden aangeroepen. }

procedure go(com: command; length: integer);

'Start time function.' De procedures sendbuffer en readbuffer worden aangeroepen. }

procedure ws(com: command; length: integer);

'Wait for startbutton.' De procedures sendbuffer en readbuffer warden aangeroepen. }

(29)

begin

sendbuffer(corn,length); code:='0';

procedure sp(corn: command; length: integer);

{ 'Single puls.' De procedures sendbuffer en readbuffer warden aangeroepen. } var code: char;

begin

procedure rp(corn: command; length: integer);

'Repeat time function.' De procedures sendbuffer en readbuffer warden aangeroepen. }

sendbuffer(corn,length); code:•'0';

procedure on(corn: command; length: integer);

{ 'Channel on.' De procedures sendbuffer en readbuffer warden aangeroepen. var code: char;

begin

procedure off(corn: command; length: integer);

{ 'Channel off.' De procedures sendbuffer en readbuffer warden aangeroepen. var code: char;

begin

sendbuffer(corn,length); code:='O';

procedure ch(corn: command; length: integer);

'Channel selection.' De procedures sendbuffer en readbuffer woLden aangeroe-pen. }

var code: char; begin sendbuffer(corn,length); code:='0'; readbuffer(code); if code='O' then

(30)

begin writeln(personfile,' '); writeln(personfile,'Channel ',com[4],' :'); writeln(personfile) end end; procedure display_menu;

{ Alle mogelijke commando's met een korte beschrijving worden op het scherm getoJnd. )

begin

writeln(' ');

writeln('Write ringtable to TPG: WR'); writeln('Write frametable to TPG: WF');

writeln('A1just frame delay (in msec): FD 0000 .. 6660'); writeln('A1just frame length (in msec): FL 0007 .. 2560'); writeln('RJtate ringtable up (t rings): RU 000 .. 255'); writeln('Rotate ringtable down

(I

rings): RD 000 .. 255'); writeln('Adjust dB-value: DB 000 .. 096');

writeln('Increase dB-setting: UP 000 .. 096'); writeln('Decrease dB-setting: DO 000 .. 096'); writeln('Start time function: GO');

writeln('Wait for startbutton: WS'); writeln('Single puls mode: SP'); writeln('Repeat mode: RP'); writeln('Channel on: ON'); writeln('Channel off: OF');

writeln('Select channel: CH 1 .. 3'); writeln('Display menu of commands: HE'); writeln('Show settings of channels: SI'); writeln('Quit: QU')

end;

procedure si(com: command; length: integer); 'Show channel settings.'

Met dit commando kan de instelling van een bepaald kanaal opgevraagd worden. Format van de ontvangen buffer: A B CCC DDD EEE FF GG H<CR> A: current channel number

B: ringtabel number CCC: frame delay DDD: frame length EEE: dB-value FF: mode (sp,rp,on,of) GG: trigger (go,ws) H: received status.

De procedures sendbuffer en error_report worden aangeroepen. ) type si_buffer = packed array (1 .. 23] of char;

var info: si buffer; code: char; k: integer; begin sendbuffer(com,length); readln(info); if info[23]<>'0' then begin code:=info[23]; error report(code) end -else begin writeln(' ');

.t;.

(31)

writeln('Channel number: ',info[l]); k:=ord(info(7])-48;

k:=k+l0*(ord(info[6))-48); k:=k+lOO*(ord(info(SJ)-48); k:=round(k/0.15);

writeln('Frame delay: ',k:4,' msec.'); k:•ord(info[ll))-48;

k:•k+lO*(ord(info(lOJ)-48); k:•k+lOO*(ord(info[9])-48); k:-round(k/0.15);

writeln('Frame length: ',k:4,' msec.'); k:=ord(info[lS])-48; k:=k+l0*(ord(info[l4))-48); k:•k+l00*(ord(info[l3))-48); k:=round(k*0.375); writeln('dB value: ',k:3,' dB.'); writeln('Mode: ',info[l7],info[l8]); writeln('Trigger: ',info(20],info[21]) end end;

procedure check value(com: command; char beg,char mid,char end: char; length: integer; var err: boolean); - -

-{ Deze procedure wordt gebruikt om een ingevoerd commando bij de procedure set_stimuli_conditions te controleren op een juiste parameter. )

begin

if. com[3]<>' ' then err:•true; if length-4

then begin

if not (com[4] in ['O' .. '9')) then err:=true; if com[4J>char_beg then err:=true

end; if length=S then

begin

if not (com[4J in ['0' .. '9']) then err:=true; if not (com[S] in ['0' .. '9']) then err:=true; if com[4]>char_beg then err:=true;

if com(4J=char beg then

end;

begin

if com[S]>char_mid then err:=true end if length=6 then end; begin end

if not (com[4] in ('0' .. '9']) then err:=true; if not (com[5] in ['0' .. '9']) then err:=true; if not (com[6] in ['0' .. '9')) then err:=true; if com[4]>char_beg then err:=true;

if com[4J=char beg

then

-begin

end

if com(SJ>char mid then err:=true; if com[S]=char-mid

then begin

if com[6]>char_end then err:=true; end

(32)

Deze procedure verricht een scala handelingen zodat tijdens

het experiment de juiste stimuli warden aangeboden. Bij aanroep ver-schijnt op het scherm een lijst van commando's die de proefleider kan gebruiken. De procedure least welk commando ingevoerd is en verricht de daarbij behorende opdracht (een fout ingevoerd commando wordt niet uitgevoerd; er verschijnt een foutmelding op het scherm). De procedure is opgebouwd als een lus. De commando's overschrijven elkaar. De lus kan warden verlaten met het commando QU (quit).

De procedures wr, wf, fd, fl, ru, rd, db, up, down, go, ws, sp, rp, on, of, eh, display menu, si, error report en check value kunnen

aange-roepen warden. } -

-type

var

command - packed array (1 .. 10) of char;

two_char_string - packed array (1 .. 2) of char; corn: command;

s: two char string; err,set tpg: boolean; code: char; i,k,length: integer; begin display menu; set tpg:~true;

whiTe set tpg-true do begin

-err:-false;

for i:=l to 10 do com[i) :=' '; writeln(' ');

write('Enter command: '); readln (corn);

length:=10;

while ((com[length]=' ') and (length>l)) do length:=length-1; if com[l) in ['a' .. 'z') then com[l):=chr(ord(com[l))-32);

( omzetten naar hoofdletters. }

if com[2) in ['a' .. 'z') then com[2) :=chr(ord(com[2))-32); s I l) : =corn I l) ; s I 2 I : ~corn I 2 I ; if s-' WR' then begin i f length<>2 then err:=true else begin end end; if s='WF' then begin com[l) :='w'; com[2) :=' r'; corn I 3 I : =' ' ; corn I 4 I : =' l' ; length:=4; wr(com,length) i f length<>2 then err:=true else begin end end; if s='FD' com[l) :='w'; com[2) :=' f'; wf(com,length)

(33)

then begin

if length<>? then err:=true; if com[3)<>' ' then err:=true;

if not (com[4) in ['0' .. '9')) then err:=true; if not (com[S] in ['0' .. '9']) thenerr:=true; if not (com[6) in ['0' .. '9')) then err:=true; if not (com[7) in ['0' .. '9')) then err:•true; k:=ord(com[7))-48; k:=k+10*(ord(com[6))-48); k:•k+l00*(ord(com[S))-48); k:•k+1000*(ord(com[4])-48); k:•round(k*0.15); if ( (k>999) or err) then err:•true else begin end end; if s='FL' then begin com[l) :=' f'; com[2):='d'; com[4] :=chr(48+(k div 100)); k:=k mod 100; com[S] :=chr (48+ (k div 10)); k:=k mod 10; com[6) :=chr(48+k);

{ omzetten van integer naar karakter. I

length:=6;

check value(com,'9','9' ,'9' ,length,err); if not err then fd(com,length)

if length<>? then err:=true; if com[3)<>' ' then err:=true;

if not (com[4) in ['0' .. '9']) then err:-true; if not (com[S) in ['0' .. '9']) then err:~true; if not (com[6) in ['0' .. '9')) then err:•true; if not (com[7) in ['0' .. '9')) then err:-true; k:=ord(com[7))-48; k:=k+l0*(ord(com[6))-48); k:=k+l00*(ord(com[S))-48); k:=k+1000*(ord(com[4))-48); k:=round(k*0.15); if ((k>384) or err) then err:=true else begin end end; if s='RU' then begin com[l) :=' f'; com(2] :=' 1'; com[4) :=chr(48+(k div 100)); k:=k mod 100; com[S) :=chr(48+(k div 10)); k:=k mod 10; com[6] :=chr(48+k); length:=6;

check value(com,'3' ,'8' ,'4' ,length,err); if not err then fl(com,length)

if ( (length<>6) or (com[3) <>' ')) then err:=true else begin corn[!):=' r';

3o

(34)

com[2] :•'u';

check value(com,'2','5' ,'5',length,err); if not err then ru(com,length)

end end; if s='RD' then begin if ((length<>6) or (com[3)<>' ')) then err:-true else begin end end; if s=' DB' then begin com[lJ :='r'; com[2) :•'d';

check value(com,'2' ,'5' ,'5',length,err); if not err then rd(com,length)

if length<>6 then err:•true; if com[3]<>' ' then err:•true;

if com[4]<>'0' then err:•true;

if not (com(5) in ['0' .. '9')) then err:•true; if not (com[6] in ['0' .. '9']) then err:•true; k:=ord(com(6])-48; k:=k+lO*(ord(com[SJ)-48); k:=round(k/0.375); if ((k>255) or err) then err:=true else begin com[l]:"''d'; com(2] :•'b'; end e .. ,d; if S'E'UP' then bo:gin com[4] :=chr(48+(k div 100)); k:•k mod 100; com[5] :=chr(48+(k div 10)); k:=k mod 10; com[6] :=chr(48+k);

check value(com,'2' ,'5' ,'5' ,length,err); if not err then db(com,length)

if length<>6 then err:=true; if com[3]<>' ' then err:=true; if com[4]<>'0' then err:=true;

if not (com(5] in ['0' .. '9')) thenerr:=true; if not (com[6] in ['0' .. '9']) then err:==true; k:=ord(com[6])-48; k:=k+lO*(ord(com[SJ)-48); k:=round(k/0.375); if ((k>255) or err) then err:=true else begin com[l] :='u'; com[2] :•'p'; com[4] :=chr(48+(k div 100)); k:=k mod 100; com[5] :=chr(48+(k div 10)); k:=k mod 10; com[6] :=chr(48+k);

check value(com,'2' ,'5','S',length,err); if not err then up(com,length)

(35)

end end; if s='DO'

then begin

if length<>6 then err:=true; if com[3]<>' ' then err:•true; if com[4J<>'0' then err:•true;

if not (com(5] in [' 0' .. ' 9' J) then err:-true; if not (com[6J in ['0' .. '9' ]) then err:•true; k:•ord(com[6])-48; k:=k+l0*(ord(com[5))-48); k:•round(k/0.375); if ( (k>255) or err) then err:=true else begin com[l):='d'; com[2) :='o'; end end; if s='GO' then begin com[4] :cchr(48+(k div 100)); k:=-k mod 100; com[SJ :•chr(48+(k div 10)); k:•k mod 10; com[6J :•chr(48+k);

check value(com,'2','5' ,'S' ,length,err); if not err then down(com,length)

if length<>2 then err:•true else begin end end; if s='WS' then begin com[l] :=-'g'; com(2]:•'o'; go(com,length) if length<>2 then err:=true else begin end end; if s='SP' then begin com[l] :='w'; com[2] :='s'; ws (corn, length) if length<>2 then err:=true else begin end end; if s='RP' then begin corn [ 1) : =' s' ; corn [ 2) : =' p' ; sp(com,length) if length<>2

(36)

then err:=true else begin end end; if s='ON' then begin com(l] :=' r'; com(2J

:='

p'; rp(com,length) if length<>2 then err:•true else begin com[lJ :='o'; com(2] :-'n'; on{com,length) end end; if sc'OF' then begin if length<>2 then err:-true else begin end end; if s=' CH' then begin com[l) :='o'; com[2):='f'; off(com,length) if {(length<>4) or (com[3]<>' ')) then err:ctrue else begin end end; if s='HE' then begin corn [ 1] : =' c' ; com[2] :='h';

check value{com,'3' ,'O' ,'0' ,length,err); if not err then ch(com,length)

if length<>2 then err:=true else display_menu end; if s='SI' then begin if length<>2 then err:•true else begin end end; if s•'QU' then begin com(l) :='s'; com[2J :=' i ' ; si(com,length)

if length<>2 then err:=true else set_tpg:=false end;

if {{s<>'WR') and {s<>'WF') and {s<>'FD') and (s<>'FL') and (s<>'RU')

(37)

and (s<>'RD') and (s<>'DB') and (s<>'UP') and (s<>'DO') and (s<>'GO') and (s<>'WS') and (s<>'SP') and (s<>'RP') and (s<>'ON') and (s<>'OF') and (s<>'CH') and (s<>'HE') and (s<>'SI') and

(s<>'QU')) then begin code: .. ' l ' ; error report(code) end; -if err then begin code:•'8'; error report(code) end -end end; procedure single_puls;

{ 'Single puls.' De procedures sendbuffer en readbuffer worden aangeroepen. ) type command• packed array (1 .. 10) of char;

var corn: command; code: char; !,length: integer; begin l:•0; repeat corn[l):•'s'; corn [ 2 J : •' p' ; length:•2; sendbuffer(corn,length); code:•'0'; readbuffer(code); 1:-1+1 until ( (code•' 0') or (1>4}) end; procedure channel_off;

( 'Channel off.' De procedures sendbuffer en readbuffer worden aangeroepen. ) type command• packed array [l .. 10) of char;

var corn: command; code: char; !,length: integer; begin l:•O; repeat corn[l) :='o'; com(2] :=' f'; length:-2; sendbuffer(com,length}; code:='0'; readbuffer(code); 1: .. 1+1 until ((code•'0') or (1>4)) end; procedure ch_l;

'Select channel l.' De procedures sendbuffer en readbuffer worden aange-roepen. )

(38)

type command• packed array [l .. 10] of char; var corn: command; code: char; l,length: integer; begin l:•0; repeat corn [ 1) : •' c' ; corn[2) :•'h'; corn[3] :•' '; corn[4) :•' l'; length:•4; sendbuffer(corn,length); code:•'0'; readbuffer(code); 1 :•l+l until ((code•'O') or (1>4)) end; procedure ch_2;

{ 'Select channel 2.' De procedures sendbuffer en readbuffer worden aange-roepen. }

type command - packed array [1 .. 10] of char; var corn: command; code: char; l,length: integer; begin 1 :=0; repeat corn ( l J : .. ' c' ; com[2] :•'h'; corn[3]:•' '; corn[4]:-'2'; length: .. 4; sendbuffer(com,length); code:•' O'; readbuffer(code); l:•l+l until ((code•'O') or (1>4)) end; procedure eh 3;

{ 'Select channel 3.' De procedures sendbuffer en readbuffer worden aange-roepen. }

type command• packed array [l .. 10] of char; var corn: command; code: char; l,length: integer; begin l:-0; repeat com[l]:•'c'; corn[2] :•'h'; com[3]:--' '; corn [ 4 J : ,., 3' ; length:-4; sendbuffer(corn,length);

JS.

(39)

code:='0'; readbuffer(code); l:•l+l until ((code•'0') or (1>4)) end; procedure ch_comb;

Deze procedure zet kanaal 1 en 2 in de 'single puls' mode en schakelt kanaal 3 uit. Dit gebeurt met behulp van de procedures eh 1, ch_2, ch_3,

channel_off, single_puls. } -begin eh l; single_puls; eh 2; single_puls; eh 3; channel off end; -procedure ch_ref;

Deze procedure zet kanaal 3 in de 'single puls' mode en de kanalen 1 en 2

uit. Dit gebeurt met behulp van de procedures ch_l, ch_2, ch_3, channel_off, single_puls. } begin eh l; channel_off; eh 2; channel off; eh 3; -single_puls end;

procedure send(db_value: real);

Met behulp van deze procedure wordt een in het programma berekende/opge-geven dB-waarde omgezet naar digitale codering en vervolgens naar de micro-processor gestuurd. De procedure db wordt aangeroepen. }

type command• packed array [l .. 10] of char; var corn: command; k,length: integer; begin k:•round(db value/0.375); if k>255 then k:•255; com[l]:='d'; corn [ 21 : .. , b' ; com[3] :•' '; com[4J :•chr(48+(k div 100)); k:•k mod 100; com[5]:•chr(48+(k div 10)); k:•k mod 10; com[6] :-chr(48+k); length:•6; db(com,length) end;

procedure sc(var ans: answer); 'Send answer counters to VAX..'

Deze procedure leest de antwoorden die de proefpersoon heeft gegeven. Verder is in deze procedure een lus ingebouwd om de conununicatie met de microprocessor te verbeteren.

(40)

Format van de ontvangen buffer: AAA BBB CCC E<CR>

AAA: 'interval l' antwoorden (bij TAFC taak) / ja (-gezien) antwoorden (bij ja/nee taak)

BBB: 'interval 2' antwoorden (bij TAFC taak) / nee (-niet gezien) antwoorden (bij ja/nee taak)

CCC: aantal rnaal gestart E: status nummer.

De procedures sendbuffer en error_report worden aangeroepen. ) type command• packed array [1 .. 10] of char;

var corn: command; code: char; kl,k2,l,length: integer; begin l:•0; repeat corn[l]:•'s'; corn[2] :='c'; length:z2; sendbuffer(corn,length); kl:-0; for k2:-l to 175 do kl:=kl+l; readln(ans); l:•l+l until ((ans[l3)-'0') or (1>4)); if ans[l3]<>'0' then begin end end; code:=ans[l3]; error report(code);

writein('Error in "send answer counters to VAX."');

writeln(checkfile,'error')

procedure exp(interval: integer; var ans: answer);

Deze procedure geeft de microprocessor het commando orn de volgende aanbieding te tonen; bij deja/nee taak (interval• 0) wordt de respons van de proefpersoon naar de terminal gestuurd, bij de TAFC rnethode

(interval= 1 of interval= 2) wordt de respons van de proefpersoon alleen na interval 2 naar de terminal gestuurd (na interval 1 wordt de respons genegeerd!) De procedures sendbuffer, readbuffer en sc (indien inter-val<> 1) worden aangeroepen. }

type command• packed array [1 .. 10) of char;

var corn: command; code: char; l,length: integer; begin 1:-0; repeat corn[l) :='e'; corn[2) :='x'; corn [ 3 J : •' ' ; corn [ 4) : - ' 0' ; corn[5) :•'0'; corn [ 6 J : •' l' ; length:•6; sendbuffer(corn,length); code:•'0'; readbuffer(code); l:=l+l until ((code-'0') or (1>4));

3?.

(41)

if interval<>l then sc(ans) end;

procedure run_comb(db_value,z: real; var j,n: integer);

Deze procedure verzorgt een aanbieding van het ja/nee experiment van de combinatie stimulus. De procedures ch_l, ch_2, send en exp worden aange-roepen. }

type answer - packed array (1 .. 13] of char; var

ans: answer;

i,interval: integer;

db.,..Perturbation,db_probe: real;

function mth$alogl0(\ref z: real) :real;extern; begin

interval:•O;

for i:-1 to 13 do ans[i]:•' '; eh l; dbyrobe:•(-20)*mth$alogl0(1/(z+l))+db_value; send ( db _probe) ; eh 2; if-z•O then db_perturbation:•96.0

else db perturbation:•(-20)*mth$alogl0(z/(z+l))+db value;

send(dbyerturbation); -exp(interval,ans); if ans[3]•'1' then j :•j+l else begin if ans[7]•'1' then n:•n+l end; writeln(checkfile,' ',ans,' j • ',j:2,' n • ',n:2) end;

procedure run_ref(db_value: real; var j,n: integer);

{ Deze procedure verzorgt een aanbieding van het ja/nee experiment van de referentie stimulus. De procedures ch_3, send en exp warden aangeroepen. type answer= packed array [1 .. 13] of char;

var

ans: answer;

i,interval: integer; begin

interval:-=0;

for i:•l to 13 do ans[i] :•' '; eh 3; send(db value); exp(interval,ans); if ans[3]='1' then j :•j+l else begin if ans[7]•'1' then n:=n+l end; writeln(checkfile,' ',ans,' j • ',j:2,' n • ',n:2) end; procedure piep2;

( Deze procedure laat 2 pieptoontjes achter elkaar horen. } var i: integer;

(42)

begin

for i:ml to 2 do write(chr(7)) end;

procedure random(var g: coin);

Deze procedure vult een array met 1000 plaatsen waarin random 'enen' en 'nullen' staan; er wordt hierbij gebruik gemaakt van de NAGLIB routine g05dyf. }

var i: integer;

function g05dyf(ml,m2: integer) :integer;fortran; begin

for i:•l to 1000 do g[i] :•g05dyf(0,l) end;

procedure piepl;

( Deze procedure laat een pieptoontje horen. } begin

write(chr(7)) end;

procedure wait;

Met behulp van deze procedure kan de proefleider de volgende sectie (trial) van de TAFC methode vrijgeven door lf_cr; hiervoor wordt de procedure piepl gebruikt. }

begin piepl;

writeln(' ');

write('next trial:');

readln { readln kan pas uitgevoerd nadat het lf_cr commando gegeven is. end;

procedure meetcyclusl(gl: coin; c i , r i: integer; db comb,db ref,z: real; var cl_pl,cl_p2,c2_pl,c2_p2,rlyl,rl_p2,r2_pl,r2_p2,tl: integer);

Deze procedure laat achtereenvolgens de referentie- en de combinatie-stimulus zien (TAFC methode). Als de referentie-stimulus aangeboden wordt is het bijbehorende interval leeg; als de combinatie-stimulus aangeboden wordt, wordt in het bijbehorende interval alleen de storing (perturbation)

aangeboden. De procedures wait, eh comb, eh ref, eh 1, eh 2, eh 3, send en

exp worden -:1.angeroepen. } - - - -

-label 01,02;

type answer• packed array (1 .. 13] of char; var

ans: answer;

db...,Perturb3tion,db_probe,nihil: real; function mth$3logl0(%ref z: real) :real;extern; begin

nihil:=96.J;

for i:=l to 13 do ans[i] :-' ' ; 01:tl:-tl+l; if tl>l000 then tl:•l; wait; case gl [tl] of 0: begin eh r,-af; ch-3; send ( nihil) ;

.l_'IJ

(43)

-1: interval:•!; exp(interval,ans); eh 3; send (db ref); intervaT:•2; exp(interval,ans); if ans[7]•'1' then r2_p2:•r2_p2+1 else begin if ans(3]•'1' then r2_pl:•r2_pl+l end; write(checkfile,' 2-- ');

for i:•1 to 7 do write(checkfile,ans[i]);

writeln(checkfil~,' r2_p2[',r_i:1,'] • ',r2_p2:2, ' r2_pl[',r_i:1,'] • ',r2_pl:2) end; begin end eh ref; ch-3; send (db ref); intervaI: •l; exp(interval,ans); eh 3; send (nihil) ; interval:•2; exp(interval,ans); if ans[3)•'1' then rl_pl:•rl_pl+l else begin if ans(7]•'1' then rl_p2:•rl_p2+1 end; write(checkfile,' 1-- ');

for i:•l to 7 do write(checkfile,ans[i));

writeln(checkfile,' rl_pl[',r i:1,') • ',rl_pl:2, ' rl_p2[',r_i:1,') ... ',rl_pI:2) otherwise goto 01 end; 02:tl:=tl+l; if tl>lOOO then tl:-1; wait; case gl[tl) of 0: begin db_probe:•(-20)*mth$alog10(1/(z+l))+db comb; if z-0 -then db_perturbation:=96.0 else db_perturbation:•(-20)*mth$alog10(z/(z+l))+db_comb; eh comb; ch-1; send (nihil); eh 2; ~end(db_perturbation); 1.ntervaI:-1; exp(interval,ans); eh 1; send (db_probe); eh 2; seQd(db_perturbation); intervaT: ... 2; exp(interval,ans); if ans[7J--'1' then c2_p2:•c2_p2+1 else begin

1-o.

(44)

1:

if ans[3)•'1' then c2_pl:•c2_pl+l end;

write (checkfile,' 2-- ');

for i:•l to 7 do write(checkfile,ans[i]);

writeln(checkfile,' c2_p2[',c i:l,'J • ',c2_p2:2, ' c2_pl[',c_i:l,'J - ',c2_pT:2) end; begin db_probe:•(-20)•mth$alogl0(1/(z+l))+db comb; if z•O -then db_perturbation:•96.0 else db_perturbation:•(-20)•mth$alogl0(z/(z+l))+db_comb; eh comb; ch-1; send (db_probe); eh 2; send(db_perturbation); intervaI:•l; exp(interval,ans); eh l; send (nihil); eh 2; send(db_perturbation); intervaI:•2; exp(interval,ans); if ans(3J-'l' then cl_pl:•cl_pl+l else begin if ans[7)•'1' then cl_p2:•cl_p2+1 end; write(checkfile,' 1-- ');

for i:=l to 7 do write(checkfile,ans[i));

writeln(checkfile,' cl_pl(' ,c i:l,') • ',cl_pl:2, ' cl_p2[',c_i:l,') - ',cl_p'2":2) end otherwise end goto 02 end;

procedure meetcyclus2(gl: coin; c i,r i: integer; db comb,db ref,z: real; var cl_pl,cl_p2,c2_pl,c2_p2,rlyl,rl_p2,r2_pl,r2_p2,tl: integer);

Deze procedure laat achtereenvolgens de combinatie- en de referentie-stimulus zien (TAFC methode). Als de referentie-stimulus aangeboden wordt is het

bijbehorende interval leeg; als de combinatie-stimulus aangeboden wordt, wordt in het bijbehorende interval alleen de storing (perturbation)

aangeboden. De procedures wait, eh comb, eh ref, eh 1, eh 2, eh 3, send en

exp worden aangeroepen. } - - - -

-label 01,02;

type answer• packed array (1 .. 13) of char; var

ans: answer;

db..,..Perturbation,db_probe,nihil: real; function mth$alogl0(%ref z: real) :real;extern; begin

for i:•l to 13 do ans[i):•' '; nihil:•96.0; 01 : tl : •t 1 + 1; if tl>l000 then tl:•l; wait; case gl[tl] of 0: begin

(45)

1: db_probe:•(-20)*mth$alogl0(1/(z+l))+db comb; if z•0 -then db_perturbation:•96.0 else db_perturbation:•(-20)*mth$alogl0(z/(z+l))+db_comb; eh comb; ch-1; send (nihil) ; eh 2; send(db_perturbation); interval":•!; exp(interval,ans); eh l ; send(db_probe); eh 2; send(db_perturbation); intervar:-2; exp(interval,ans); if ans(7]•'1' then e2_p2:•e2_p2+1 else begin

if ans[3)•'1' then c2_pl:•e2_pl+l end;

write(checkfile,' 2-- ');

for i:•l to 7 do write(checkfile,ans(i]);

writeln(eheckfile,' c2_p2(',e i:l,'] • ',c2_p2:2, ' c2_pl[',c_i:1,'J = ',c2_pI:2) end; begin db_probe:•(-20)*mth$alogl0(1/(z+l))+db comb; if z•0 -then db_perturbation:=96.0 else db_perturbation:•(-20)*mth$alogl0(z/(z+l))+db_comb; eh comb; ch-1; send(db_probe); eh 2; send(db_perturbation); intervaI:•l; exp(interval,ans); eh l; send(nihil); eh 2; send(db_perturbation); interval:=2; exp(interval,ans); if ans[3Ja'l' then cl_pl:•el_pl+l else J::egin if ans(7J-'1' then cl_p2:=cl_p2+1 end; write (eheckfile,' 1-- '); end

for i:•l to 7 do write(checkfile,ans[i]);

writeln(checkfile,' cl_pl[',c i:1,'J - ',cl pl:2, ' el_p2(' ,c_i:1,' J "' ',cl_p'Z:2) -otherwise goto 01 end; 02:tl:•tl+l; if tl>l0O0 then tl:•l; wait; case gl(tl] of 0: begin eh tef; ch=3;

(46)

1: send (nihil); interval: -1; exp(interval,ans); eh 3; send(db ref); intervaI:-2; exp(interval,ans); if ans[7)•'1' then r2_p2:-r2_p2+1 else begin if ans[3]-'l' then r2_pl:-r2_pl+l end; write(checkfile,' 2-- ');

for i:-1 to 7 do write(checkfile,ans[i]);

writeln(checkfile,' r2_p2[',r_i:1,'] • ',r2_p2:2, ' r2_pl[',r_i:1,'] • ',r2_pl:2) end; begin end eh ref; ch-3; send(db ref); intervaI :-1; exp(interval,ans); eh 3; send (nihil); interval:=2; exp(interval,ans); if ans[3]•'1' then rl_pl:•rl_pl+l else begin if ans[7)•'1' then rl_p2:=rl_p2+1 end; write(checkfile,' 1-- ');

for i:-1 to 7 do write(checkfile,ans[i]);

writeln(checkfile,' rl_pl[',r i:1,'] - ',rl_pl:2, ' rl_p2[',r_i:1,'] - ',rl_p°2":2)

otherwise goto 02 end

end;

procedure plot(x: intensity; y: probability; db: x_coordinate; rc,n: integer; hc,th: real);

{ Deze procedure maakt een plot van de gemeten psychometrische kromme. } var

11,12,xl,yl: array[l .. 100) of real; i,j,x_st,x_end: integer; begin comprs; if db[l)<-5.0 then x st:=0 else begin x st:-round(db[l)-5); while (x st rem 5)<>0 do x st:sx st-1 end; -if db[5)>-90.0 then x end:•95 else begin x end:=round(db[5]+5);

(47)

end; j :""0;

for i:-x st to x end do begin-j:•j+l; xl[j):•i; yl [ j] :•he* (xl [ j) -th) +0. S; 11 [ j J :

-o.

2; 12[j):•0.8 end; units ('CM'); page(27.0,18.0); grace(0.0); height(0.5); mixalf('INSTRU'); xname('d.B-value$',100); yname('detection probability$',100); xticks(S); yticks(S); intaxs; area2d(20.0,10.0); simplx; graf(x st,5.0,x end,0.0,0.5,1.0);

if re-~ then messag('reference stimulus$' ,100,0.0,12.0) else messag('combination stimulus$' ,100,0.0,12.0); height(0.3); marker(lS); curve(x,y,n,-1); curve(xl,yl,j,0); dash; vector(l0.0,12.15,12.0,12.15,0); messag('upper limit$' ,100,12.5,12.0); curve(xl,12,j,0); chndot; vector(l0.0,11.15,12.0,11.15,0); messag('S0(Ml0)X(MX) threshold$',100,12.5,11.0); if ((th>x st) and (th<x end)) then - -begin rlvec(x st,0.5,th,0.5,0); rlvec(th,0.S,th,0.0,1201) end; dot; vector(l0.0,10.15,12.0,10.15,0); messag('lower limit$' ,100,12.5,10.0); curve(xl,11,j,0); endpl(0); donepl end;

procedure linear regression(db comb,db ref: x coordinate; p comb,p ref: y_coordinate;-var hc_comb,hc_ref,th=comb,th_ref: real); -

-Deze procedure berekent uit de ingevoerde meetpunten (d.B,p) van de referentie-en de combinatie stimulus de hellingskonstante van de psychometrische kromme en de drempelwaarde van zowel referentie- als combinatie stimulus met de lineaire regressie methode; met behulp van de procedure plot worden de meetpunten geplot. )

type

var

intensity• array (1 .. 5) of real; probability - array (1 .. SJ of real; x comb,x ref: intensity;

y-comb,y-ref: probability; i;n comb;n ref,rc: integer;

(48)

begin rc:•O; n ref:=O;

for i:•l to 5 do begin

if ((p ref[i]>aQ.2) and (p_ref[i]<•0.8)) then

-end;

begin

n ref:•n ref+!;

x-ref[n ref] :•db ref[i]; y-ref[n-ref] :-p ref[i] end - - -if n ref>•2 then-begin sumx:=0.0; sumy:•0.0; sumxx:•0.0; sumxy:•0.0;

for i:•l ton ref do begin

sumx:•sumx+x ref[i]; sumy:•sumy+y-ref[i];

sumxx:•sumxx+x ref[i]*x ref[i]; sumxy:•sumxy+x-ref[i]•y-ref[i] end; - -hc_ref:•(n_ref*sumxy-sumx*sumy)/(n_ref*sumxx-sumx•sumx); b ref:•(sumxx•sumy-sumx*sumxy)/(n ref*sumxx-sumx•sumx); if he ref<>O -then begin

th ref:•(0.5-b ref)/hc ref; wrTteln(personfile,' ');

writeln(personfile,'Reference stimulus:'); writeln (personfile,' ');

writeln(personfile,'The slope of the psychometric function is'); writeln(personfile,'calculated out o f ' ,n ref:l,' points.');

writeln(personfile,' ');

-writeln(personfile,'Slope: ',he ref:6:4,' per dB');

writeln(personfile,'50% detection threshold: ',th ref:6:3);

writeln(' ');

-writeln('Reference stimulus:'); writeln(' ');

writeln('The slope of the psychometric function is'); writeln('calculated out o f ' ,n ref:l,' points.');

writeln (' ');

-writeln('Slope: ',he ref:6:4,' per dB');

writeln('SO% detection threshold: ',th ref:6:3); plot(x ref,y ref,db ref,rc,n ref,hc re1,th ref)

end - - - -else begin writeln (personfile,' '); writeln(personfile,'Reference stimulus:'); writeln(personfile,' ');

writeln(personfile,'The slope of the psychometric function is'); writeln(personfile,'calculated out o f ' ,n ref:l,' points.');

-writeln(personfile,'Slope: ',hc_ref:6:4,' per dB'); writeln (personfile,' ');

writeln(personfile,'Note: It is not possible to calculate the');

writeln(personfile,'50% detection threshold.'); writeln (' ');

writeln('Reference stimulus:'); writeln(' ');

(49)

writeln('calculated out of ',n ref:l,' points.');

writeln(' ');

-writeln('Slope: ',he ref:6:4,' per dB'); writeln(' ');

-writeln('Note: It is not possible to calculate the'); writeln('S0\ detection threshold.');

plot(x ref,y ref,db ref,rc,n ref,hc ref,10000)

end - - - - -end else begin writeln(personfile,' '); writeln(personfile,'Reference stimulus:'); writeln(personfile,' ');

writeln(personfile,'It is not possible to apply linear regression'); writeln(personfile,'to these results (< 2 points have a detection'); writeln(personfile,'probability between 0.2 and 0.8) .');

writeln(' ');

writeln('Reference stimulus:'); writeln (' ');

writeln('It is not possible to apply linear regression'); writeln('to these results (< 2 points have a detection'); writeln('probability between 0.2 and 0,8) .')

end; rc:•l; n comb:•0; for i:"'l to 5 do

begin

if ((p comb(i]>•0.2) and (p_comb[i]<=0.8)) then

-end;

begin

n comb:•n comb+l;

x-comb[n comb] :•db comb[i); y-comb[n-comb] :-p comb[iJ end - - -if n comb>a2 then-begin sumx:=0.0; sumy:=0.0; sumxx:•0.0; sumxy:=0.0;

for i:=l ton comb do begin

sumx:•sumx+x comb[i]; sumy:-sumy+y-comb[i];

sumxx:=sumxx+x comb[i]*x comb[iJ; sumxy:=sumxy+x-comb[i)*y-comb[iJ

end; -

-he comb:=(n comb*sumxy-sumx*sumy)/(n comb*sumxx-sumx*sumx); b comb:= (sumxx*sumy-sum.x*sumxy) / (n comb*sum.':.:~-sumx*sum;:);

ir he comb<>O

then -begin

th comb:•(0.5-b comb)/hc comb; wrTteln(personfile,'

');-writeln(personfile,'Combination stimulus:'); writeln(personfile,' ');

writeln(personfile,'The slope of the psychometric function is'); writeln(personfile,'calculated out of' ,n comb:l,' points.');

-writeln(personfile,'Slope: ',he comb:6:4,' per dB');

writeln(personfile,'50\ detection threshold: ',th_comb:6:3); writeln(' ');

writeln('Combination stimulus:'); writeln(' ');

writeln('The slope of the psychometric function is');

(50)

writeln('calculated out of ',n comb:l,' points.');

writeln(' ');

-writeln('Slope: ',he comb:6:4,' per dB');

writeln('50\ detection threshold: ',th comb:6:3); plot(x comb,y comb,db comb,rc,n comb,hc comb,th comb)

end - - - -else begin writeln(personfile,' '); writeln(personfile,'Combination stimulus:'); writeln(personfile,' ');

writeln(personfile,'The slope of the psychometric function is'); writeln(personfile,'calculated out of' ,n comb:1,' points.');

-writeln(personfile,'Slope: ',he comb:6:4,' per dB'); writeln(personfile,' ');

-writeln(personfile,'Note: It is not possible to calculate the'); writeln(personfile,'50\ detection threshold.');

writeln(' ');

writeln('Combination stimulus:');

writeln(' ');

writeln('The slope of the psychometric function is'); writeln('calculated out o f ' ,n comb:1,' points.');

writeln(' ');

-writeln('Slope: ',he comb:6:4,' per dB'); writeln(' ');

-writeln('Note: It is not possible to calculate the'); writeln('50\ detection threshold.');

plot(x comb,y comb,db comb,rc,n comb,hc comb,10000)

end - - - - -end else begin writeln(personfile,' '); writeln(personfile,'Combination stimulus:'); writeln(personfile,' ');

writeln(personfile,'It is not possible to apply linear regression'); writeln(personfile,'to these results (< 2 points have a detection'); writeln(personfile,'probability between 0.2 and 0.8) .');

writeln (' ');

writeln('Combination stimulus:'); writeln(' ');

writeln('It is not possible to apply linear regression'); writeln('to these results (< 2 points have a detection'); writeln('probability between 0.2 and 0.8) .')

end end;

procedure psychometric_function(cm: char; z: real);

In deze procedure wordt de psychometrische kromme van zowel referentie- als combinatie stimulus gemeten. De procedure is bestaat uit 4 delen.

I) In het eerste gedeelte wordt het dB-interval van de referentie stimulus bepaalt waarbij voor de detectie kans p geldt: 0.2 < p < 0.8.

Dit gebeurt met een ja/nee taak. Uit dit interval worden 5 equidistante dB-waarden genomen; de ondergrens van het interval wordt gelijkgesteld aan de eerste dB-waarde, de bovengrens van het interval wordt gelijkge-steld aan de vijfde dB-waarde.

II) Het tweede gedeelte verloopt analoog, maar dan met de combinatie stimulus.

III) In het derde gedeelte worden van de 5 dB-waarden van de referentie- en combinatie stimulus de scores bepaald. Dit gebeurt met een TAFC methode. IV) De scores, in principe liggend in het interval [0.5, 1), worden volgens

(51)

kansen p, liggend in het interval [0, 1). Vervolgens wordt met lineaire regressie de hellingskonstante van de psychometrische kromme en de drempelwaarde (p • 0.5) van zowel referentie- als combinatie stimulus bepaald.

De procedures eh comb, eh ref, run comb, run ref, error report, piep2, random, meetcyclusl, meetcyclus2 en linear_regression worden aangeroepen. label

0l,ll,12,13,14,15,16,17,21,31,32,33,34,35,36,37,41,51,52,53,54,55,56,57,58, 59,60,61,62,63,64,65,66,67,68,69,70,81;

type

var

coin a array [l .. 1000] of integer;

x coordinate - array [l .. 5] of real; y=coordinate • array [l .. 5] of real; gl,g2: coin;

db comb,db ref: x coordinate; p comb,p ref: y coordinate;

cI_pl,cly2,c2___pl,c2_p2,rl_pl,rl_p2,r2_pl,r2_p2: array [l .. 5) of integer; stop: boolean;

code,q,u: char;

i,j,l,n,r,tl,t2: integer;

a,b,c,d,db value,dp,e,hc comb,hc ref,th comb,th ref: real; function g05dyf(ml,m2: integer) :integer;fortran;

-begin

81: writeln (personfile,' ');

writeln(personfile,'Results psychometric function.');

writeln(personfile,'--- ---•• --•••••••');

writeln(' ');

writeln('Results psychometric function.'); writeln(personfile,' ');

writeln(personfile,'Part I:');

writeln(personfile,'---- --');

writeln(personfile,'dB-values of the reference stimulus.'); writeln (' ');

writeln('Part I: dB-values of the reference stimulus.'); 01:ch ref;

if-cm='y' then

begin

writeln(' ');

writeln('l: You have no a priori knowledge of the dB-interval;'); writeln(' start values of the iteration process: 0 dB and 96 dB.'); writeln('2: You can enter the limits of the dB-interval, which'); writeln(' serve as start values of the iteration process.'); writeln('3: You can enter 5 successive dB-values (>• 3 must have'); writeln(' a detection probability between 0.2 and 0.8) .');

end; writeln(' '); write('Enter 1/2/3: '); readln(q); case q of , l ' : begin writeln(personfile,' '); writeln(personfile,'Choice l.');

writeln(checkfile,'Psychometric function, part I, choice l.'); writeln (personfile,' '); writeln(personfile,'Lower limit: 0.000 dB'); writeln(personfile,'Upper limit: 96.000 dB'); a:•0; e:=-96; writeln (personfile,' ');

writeln(personfile,'Search for dB-value which has a detection'); writeln(personfile,'probability between 0.3 and 0.7; 5 presen-'); writeln(personfile,'tations.');

(52)

writeln(' ');

writeln('Search for dB-value which has a detection'); writeln('probability between 0.3 and 0.7; 5 presen-'); writeln('tations.');

writeln(personfile,' '); writeln(' ');

stop:•false;

while ((stop•false) and ((e-a)>6)) do begin

c:•0.375*round((a+e)/2/0.375); db value:•c;

j: ;;o;

n:•0;

for i:•l to 5 do run_ref(db_value,j,n); dp:•j/(j+n);

writeln(personfile,c:6:3,' dB detection probability: ',dp:4:2); writeln(c:6:3,' dB detection probability: ',dp:4:2);

i f dp>0.7 then a:•c else

begin

if dp<0.3 then e:=c else stop:•true end end; c:•0.375*round((a+e)/2/0.375); if (c-a)<3 then begin

if c>•3 then a:•c-3 else a:•0 end;

if (e-c)<3 then

begin

if c<•93 then e:•c+3 else e:•96 end;

writeln(' ');

writeln (personfile,' '); writeln(' ');

stop:•false;

while ((stop•false) and ((e-a)>l.5)) do begin

j :~O;

n:-0;

for i:•l to 10 do run_ref(db_value,j,n); dp:-j/(j+n);

if dp>0. 7 then a:•c else

begin

if dp<0.3 then e:~c else stop:~true end end; b:-0.375*round((a+c)/2/0.375); i f (c-b)<•4.5 then begin if c>•4.5 then b:•c-4.5 else b:•0

(53)

end;

writeln(personfile,'Determine lower limit, detection probability'); writeln(personfile,'less than 0.8; 10 presentations.');

writeln(' ');

writeln('Determine lower limit, detection probability'); writeln('less than 0.8; 10 presentations.');

writeln(personfile,' '); writ-eln(' ');

stop:•false;

whil= ((stop=false) and ((c-b)>0.75)) do begin

db value:•b;

j :;;0;

n:•O;

writeln(personfile,b:6:3,' dB detection probability: ',dp:4:2); writeln(b:6:3,' dB detection probability: ',dp:4:2);

if dp>•0.8 then begin a:•b; b:•0.375*round((a+c)/2/0.375) end else stop:•true end; d:•0.375*round((e+c)/2/0.375); if (d-c)<•4.5 then begin

if c<•91.5 then d:•c+4.5 else d:a96 end;

writeln(personfile,'Determine upper limit, detection probability'); writeln(personfile,'more than 0.2; 10 presentations.');

writeln(' ');

writeln('Determine upper limit, detection probability'); writeln('more than 0.2; 10 presentations.');

stop:=false;

while ((stop=false) and ((d-c)>0.75)) do begin

db value:•d;

j: ;;o;

n:•0;

for i:=l to 10 do run_ref(db_value,j,n); dp:=j/(j+n);

writeln(personfile,d:6:3,' dB dPtectinn prnh~hili~y: •,~p:4:J);

writeln(d:6:3,' dB detection probability: ',dp:4:2J;

if dp<-0. 2 then begin e:=d; d:=0.375*round((e+c)/2/0.375) end

else stop: .. true end; db ref[l] :•b; db-ref[2) :•0.375*round((3*b+d)/4/0.375); db-ref[3) :•0.375*round((b+d)/2/0.375); db-ref[4) :•0.375*round((b+3*d)/4/0.375); db-ref[SJ :•d; wrTteln(personfile,' ');

writeln(personfile,'dB-values of the reference stimulus:'); writeln(personfile,' ');

for l:•l to 5 do writeln(personfile,db_ref[l] :6:3,' dB');

(54)

writeln (' ');

writeln('dB-values of the reference stimulus:'); writeln(' ');

for 1:-1 to 5 do writeln(db_ref[l) :6:3,' dB'); repeat

writeln(' ');

writeln('Do you want to repeat this?'); write('Enter y/n: ');

readln(u)

until ( (u-' y') or (u•' n')); if u•'y' then goto 01 end;

I 2 I ; begin

writeln(personfile,'Choice 2.');

writeln(checkfile,'Fsychometric function, part I, choice 2.'); writeln(' ');

writeln('Enter the lower and upper limit of the dB-interval so that:'); writeln('i) upper limit - lower limit>- 9 dB.');

11:writeln(' ');

write('Enter lower limit: '); readln(a);

if ((a<O) or (a>87)) then begin code:•'5'; error report(code); goto 11 end; 12:writeln(' ');

write('Enter upper limit: '); readln (e);

if ((e<(a+9)) or (e>96)) then begin code:•'5'; error report(code); goto 12 end; a:=0.375*round(a/0.375); e:•0.375*round(e/0.375); writeln(personfile,' ');

writeln(personfile,'Lower limit: ',a:6:3,' dB'); writeln(personfile,'Upper limit: ',e:6:3,' dB'); writeln(personfile,' ');

writeln (' ');

stop:•false;

while ((stop•false) and ((e-a)>6)) do begin

j: ;;o;

n:=0;

for i:•l to 5 do run ref(db value,j,n);

dp:•j/(j+n); -

-writeln(personfile,c:6:3,' dB detection probability: ',dp:4:2); writeln(c:6:3,' dB detection probability: ',dp:4:2);

if dp>O. 7 then a:•c else

begin

(55)

if dp<0.3 then e:-c else stop:•true end end; c:•0.375*round((a+e)/2/0.375); if (c-a)<3 then begin

if c>•3 then a:•c-3 else a:•O end;

if (e-c)<3 then

begin

if c<•93 then e:•c+3 else e:•96 end;

writeln(' ');

stop:•false;

while ((stop•false) and ((e-a)>l.5)) do begin

j: ;;o;

n:=-0;

for i:•l to 10 do run_ref(db_value,j,n); dp:=j/(j+n);

i f dp>0.7 then a:•c else

begin

if dp<0.3 then e:•c else stop:•true end end; b:=0.375*round((a+c)/2/0.375); i f (c-b)<•4.5 then begin

if c>-4.5 then b:•c-4.5 else b:•O end;

writeln(personfile,'Determine lower limit, detection probability'); writeln(personfile,'less than 0.8; 10 presentations.');

writeln(' ');

writeln('Determine lower limit, detection probability'); writeln('less than 0.8; 10 presentations.');

stop:afalse;

while ((stop=false) and ((c-b)>0.75)) do begin

db value:•b;

j : ;;o; n: ..

o;

writeln(personfile,b:6:3,' dB detection probability: ',dp:4:2); writeln(b:6:3,' dB detection probability: ',dp:4:2);

if dp>•0.8 then

(56)

begin a:•b; b:•0.375*round((a+c)/2/0.375) end else stop:•true end; d:•0.375*round((e+c)/2/0.375); if (d-c)<•4.5 then begin if c<•91.5 then d:•c+4.5 else d:•96 end; writeln(personfile,' ');

writeln(personfile,'Determine upper limit, detection probability'); writeln(personfile,'more than 0.2; 10 presentations.');

writeln(' ');

writeln('Determine upper limit, detection probability'); writeln('more than 0.2; 10 presentations.');

writeln (' ' ) ;

stop:•false;

while ((stop•false) and ((d-c)>0.75)) do begin

db value:•d;

j:

=o;

n:-0;

writeln(personfile,d:6:3,' dB detection probability: ',dp:4:2); writeln(d:6:3,' dB detection probability: ',dp:4:2);

if dp<•0.2 then begin e: •d; d:•0.375*round((e+c)/2/0.375) end else stop:•true end; db ref[l] :-b; db-ref[2] :•0.375*round((3*b+d)/4/0.375); db-ref[3] :•0.375*round((b+d)/2/0.375); db-ref[4] :•0.375*round((b+3*d)/4/0.375); db-ref[SJ :-d; wrTteln(personfile,' ');

writeln(personfile,'dB-values of the reference stimulus:'); writeln(personfile,' ');

for l:•l to 5 do writeln(personfile,db ref[l] :6:3,' dB');

writeln(' ');

-writeln('dB-values of the reference stimulus:'); writeln(' ');

for l:•l to 5 do writeln(db_ref[l] :6:3,' dB'); repeat

writeln(' ');

writeln('Do you want to repeat this?'); write('Enter y/n: ');

readln(u)

until ( (u•' y') or (u•' n')); if u•'y' then goto 01

end; I 3 I :

begin

writeln(personfile,'Choice 3.');

writeln(checkfile,'Psychometric function, part I, choice 3.'); writeln(' ');

writeln('Enter the 5 dB-values so that:');

writeln('i) 0 <• dB(l) < dB(2) < dB(3) < dB(4) < dB(5) <• 96.'); writeln('ii) dB(i+l) - dB(i) >• 0,75.');

(57)

13:writeln(' ');

write(' Enter dB (1): '); readln(a);

if ( (a<0) or (a>93)) then begin code:•'5'; error report(code); goto I3 end; 14:writeln(' '); write('Enter dB(2): '); readln(b); if ((b<(a+0.75)) or (b>93.75)) then begin code:•'5'; error report(code); goto

I4

end; 15:writeln(' '); write('Enter dB(3): '); readln(c); if ((c<(b+0.75)) or (c>94.5)) then begin code:•'5'; error report(code); goto Is end; 16:writeln(' '); write('Enter dB(4): ' ) ; readln(d); if ((d<(c+0.75)) or (d>95.25)) then begin code:•'5'; error report(code); goto I6 end; 17:writeln(' '); write('Enter dB(S): '); readln(e);

if ((e<(d+0.75)) or (a>96)) then begin code:='5'; error report(code); goto 17 end; db ref[l) :-0.375*round(a/0.375); db-ref[2) :•0.375*round(b/0.375); db-ref[3) :-0.375*round(c/0.375); db-ref[4) :=0.375*round(d/0.375); db-ref[S] :=0.375*round(e/0.375); wrTteln(personfile,' ');

writeln(personfile,'dB-values of the reference stimulus:'); writaln (personfile,' ');

for l:=1 to 5 do writeln(personfile,db ref[l) :6:3,' dB');

writaln(' ');

-writaln('dB-values of the reference stimulus:'); writaln (' '); for l:=1 to 5 do writeln(db_ref[l) :6:3,' dB'); end otherwise begin code:•'1'; end end; error report(code); goto 01 piep2; writeln(personfile,' ');