Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50504/mulalg.cdc
There are 2 other files named mulalg.cdc in the archive. Click here to see a list.
MULTREG
"BEGIN" "COMMENT" AUTHOR : MARTEN VAN GELDEREN,
VERSION : ALGOL 60, CYBER 73-28, DATE 760621,
COPYRIGHT : FOUNDATION MATHEMATICAL CENTRE, AMSTERDAM.
TITLE : INPUT SYSTEM FOR MULTIPLE LINEAR REGRESSION ANALYSIS;
"INTEGER" STOCK, LASTSYMBOL, LASTNAME, LASTPAGE, FREEPAGE, REPEATS,
PAGELENGTH, CHAINEND, WORDSIZE, BYTESIZE, WORDFULL, WORDSHIFT,
SYSTEM, TYPE, SHIFT, CARDWIDTH, PAPERWIDTH, STANDARD, PERMANENT,
MAXPAGE, MAXSYM, MAXNUM, LEFTMAXNUM, RIGHTMAXNUM, STACKMAX,
MAXNAME, MAXORDERS, MAXCON, SUBMAXCON, MAXOPT, I, LEFTSIZE,
RIGHTSIZE1, MODELSIZE, INPUTSIZE, OPTIONSIZE, DATASIZE,
MODELORDERS, INPUTORDERS, RUNNUMBER, STACKPOINTER, LISTPOINTER,
TERMPOINTER, RESPOINTER, LEFTPOINTER, RIGHTPOINTER, RESCOUNTER,
TERMCOUNTER, CONCOUNTER, NAMECOUNTER, ORDERCOUNTER, REPCOUNTER,
LEFTCOUNTER, RIGHTCOUNTER, STCK, ADD, SUBT, MUL, DIV, IDI, TTP,
NEG, EQL, RES, REP, DEP, TEST, INIT, FRS, FLS, TCV, TAV, RAV,
SAV, LAV, RET, JMP, FIX, SKP, FUN, BLANK, ZERO, CHA, SKIPSIGN,
PLUS, MINUS, MULSIGN, DIVSIGN, TTPSIGN, IDISIGN, OPEN, CLOSE,
EQUAL, COMMA, POINT, LOWTEN, SUB, BUS, QUOTE, SMALLER, GREATER;
"REAL" PRECISION, MAXREAL, REPEATSUM, REPEATSQUARES, REPEATROOT;
"BOOLEAN" SYSTEMLASTSYMBOL, RETURN, ERROR, DECLARED, THREE, FIVE;
PAGELENGTH:= 128; MAXPAGE:= 32768 // PAGELENGTH - 1;
MAXSYM:= MAXNUM:= LEFTMAXNUM:= RIGHTMAXNUM:= PAGELENGTH;
CHAINEND:= -6; MAXOPT:= 8; BYTESIZE:= 6; WORDSIZE:= 48;
WORDFULL:= 2 ** (WORDSIZE - BYTESIZE); WORDSHIFT:= 2 ** BYTESIZE;
PRECISION:= 2 ** (-47); MAXREAL:= (2**47-1) * 2**1022 + 2**1069;
SYSPARAM(63, 5, CARDWIDTH); SYSPARAM(64, 5, PAPERWIDTH);
STCK:= TCV:= 1; ADD:= TAV:= 2; SUBT:= RAV:= 3; MUL:= SAV:= 4;
DIV:= LAV:= 5; IDI:= RET:= 6; TTP:= JMP:= 7; NEG:= FIX:= 8;
EQL:= SKP:= 9; RES:= FUN:= 10; REP:= 11; DEP:= 12; TEST:= 13;
INIT:= 14; FRS:= 15; FLS:= 16; BLANK:= 0; CHA:= 1; ZERO:= 27;
PLUS:= 37; MINUS:= 38; OPEN:= 41; CLOSE:= 42; EQUAL:= 44;
MULSIGN:= 39; DIVSIGN:= 40; TTPSIGN:= 3939; IDISIGN:= 4040;
COMMA:= 46; POINT:= 47; LOWTEN:= 48; SUB:= 49; BUS:= 50;
QUOTE:= 52; SMALLER:= 58; GREATER:= 59; SKIPSIGN:= WORDSHIFT;
"BEGIN" "INTEGER" "ARRAY" SYMBOLLIST[1:MAXSYM],
PAGETABLE[CHAINEND:MAXPAGE];
"REAL" "ARRAY" DATALIST, COLUMN[1:MAXNUM];
"BOOLEAN" "ARRAY" OPTION WANTED[1:MAXOPT];
"BOOLEAN" "PROCEDURE" SYSTEMSYMBOL(SYM);
"VALUE" SYM; "INTEGER" SYM; SYSTEMLASTSYMBOL:=
SYSTEMSYMBOL:= SYM = 1315 "OR" SYM = 0914 "OR" SYM = 1516
"OR" SYM = 0401 "OR" SYM = 1821 "OR" SYM = 0524;
"BOOLEAN" "PROCEDURE" DIGITLASTSYMBOL;
DIGITLASTSYMBOL:= ZERO <= LASTSYMBOL "AND" LASTSYMBOL <= ZERO + 9;
"BOOLEAN" "PROCEDURE" LETTERLASTSYMBOL;
LETTERLASTSYMBOL:= CHA <= LASTSYMBOL "AND" LASTSYMBOL <= CHA + 25;
"BOOLEAN" "PROCEDURE" NUMBERLASTSYMBOL;
NUMBERLASTSYMBOL:= DIGITLASTSYMBOL
"OR" LASTSYMBOL = PLUS "OR" LASTSYMBOL = MINUS
"OR" LASTSYMBOL = POINT "OR" LASTSYMBOL = LOWTEN;
"INTEGER" "PROCEDURE" READPOS;
"BEGIN" "INTEGER" R; SYSPARAM(63,1,R); READPOS:= R "END";
"INTEGER" "PROCEDURE" PRINTPOS;
"BEGIN" "INTEGER" P; SYSPARAM(64,1,P); PRINTPOS:= P "END";
"INTEGER" "PROCEDURE" LINENUMBER;
"BEGIN" "INTEGER" L; SYSPARAM(64,3,L); LINENUMBER:= L "END";
"PROCEDURE" TABULATE(N); "VALUE" N; "INTEGER" N; SYSPARAM(64,2,N);
"PROCEDURE" PAGEWIDTH(N); "VALUE" N; "INTEGER" N; SYSPARAM(64,6,N);
"INTEGER" "PROCEDURE" RESYM;
"BEGIN" "INTEGER" SYM;
INPUT(63,"("A")",SYM); RESYM:= SYM / WORDFULL
"END";
"PROCEDURE" PRSYM(SYM); "VALUE" SYM; "INTEGER" SYM;
"IF" 0 <= SYM "AND" SYM < WORDSHIFT "THEN"
OUTPUT(64,"("A")",WORDFULL * SYM) "ELSE" OUTPUT(64,"(""("?")"")");
"INTEGER" "PROCEDURE" READSYMBOL;
"BEGIN" "INTEGER" SYM1, SYM2;
SYSTEMLASTSYMBOL:= "FALSE"; SYM1:= RESYM;
"IF" SYM1 = QUOTE "THEN"
"BEGIN" SYM1:= RESYM; "IF" SYM1 "NOTEQUAL" QUOTE "THEN"
"BEGIN" SYM2:= RESYM; "IF" SYM2 "NOTEQUAL" QUOTE "THEN"
"BEGIN" SYM1:= SYM1 * 100 + SYM2;
"FOR" SYM2:= RESYM "WHILE" SYM2 "NOTEQUAL" QUOTE "DO"
"END" "ELSE" SYM1:= SKIPSIGN
"END" "ELSE" SYM1:= SKIPSIGN;
"IF" "NOT" SYSTEMSYMBOL(SYM1) "THEN" SYM1:= READSYMBOL
"END"; READSYMBOL:= LASTSYMBOL:= SYM1
"END";
"REAL" "PROCEDURE" READNUMBER;
"BEGIN" "FOR" I:= LASTSYMBOL "WHILE"
"NOT" (NUMBERLASTSYMBOL "OR" SYSTEMLASTSYMBOL) "DO" READSYMBOL;
READNUMBER:=
"IF" SYSTEMLASTSYMBOL "THEN" LISTPOINTER "ELSE" READ(READSYMBOL)
"END";
"PROCEDURE" READLIST(LIST, MAX, READSYMNUM, ENTRY, SIZE);
"VALUE" MAX, ENTRY; "ARRAY" LIST; "INTEGER" MAX, ENTRY, SIZE;
"REAL" "PROCEDURE" READSYMNUM;
"BEGIN" LISTPOINTER:= 1; LASTPAGE:= ENTRY; SIZE:= 0;
RETURN CHAIN(PAGETABLE[ENTRY]); SYSTEMLASTSYMBOL:= "FALSE";
NEXT: LIST[LISTPOINTER]:= READSYMNUM;
"IF" SYSTEMLASTSYMBOL "THEN" "GOTO" EXIT;
LISTPOINTER:= LISTPOINTER + 1; "IF" LISTPOINTER > MAX "THEN"
"BEGIN" PAGE TO ECS(LIST, LASTPAGE); LISTPOINTER:= 1;
SIZE:= SIZE + MAX
"END"; "GOTO" NEXT;
EXIT: PAGE TO ECS(LIST, LASTPAGE); PAGETABLE[LASTPAGE]:= CHAINEND;
SIZE:= SIZE + LISTPOINTER - 1
"END";
"REAL" "PROCEDURE" READ(EXPRESSION);
"INTEGER" "PROCEDURE" EXPRESSION;
"BEGIN" "INTEGER" NUMSIGN, EXPSIGN, DECEXP, EXPVAL; "REAL" NUMVAL;
NUMSIGN:= EXPSIGN:= 1; DECEXP:= EXPVAL:= 0; NUMVAL:= 0;
"IF" NUMBERLASTSYMBOL "THEN" "GOTO" SGN;
NUM: "IF" EXPRESSION = BLANK "THEN" "GOTO" NUM;
SGN: "IF" LASTSYMBOL = PLUS "THEN" "GOTO" NUM
"ELSE" "IF" LASTSYMBOL = MINUS "THEN"
"BEGIN" NUMSIGN:= - NUMSIGN; "GOTO" NUM "END";
"IF" LASTSYMBOL = LOWTEN "THEN" NUMVAL:= 1;
INT: "IF" LASTSYMBOL = POINT "THEN" "GOTO" DEC;
"IF" LASTSYMBOL = LOWTEN "THEN" "GOTO" TEN;
"IF" "NOT" DIGITLASTSYMBOL "THEN" "GOTO" EXIT;
NUMVAL:= NUMVAL * 10 + LASTSYMBOL - ZERO;
"IF" EXPRESSION = BLANK "THEN" EXPRESSION; "GOTO" INT;
DEC: "IF" EXPRESSION = BLANK "THEN" EXPRESSION;
"IF" LASTSYMBOL = LOWTEN "THEN" "GOTO" TEN;
"IF" "NOT" DIGITLASTSYMBOL "THEN" "GOTO" EXIT;
NUMVAL:= NUMVAL * 10 + LASTSYMBOL - ZERO;
DECEXP:= DECEXP - 1; "GOTO" DEC;
TEN: "IF" EXPRESSION = BLANK "THEN" "GOTO" TEN;
"IF" LASTSYMBOL = PLUS "THEN" "GOTO" TEN
"ELSE" "IF" LASTSYMBOL = MINUS "THEN"
"BEGIN" EXPSIGN:= - EXPSIGN; "GOTO" TEN "END";
EXP: "IF" "NOT" DIGITLASTSYMBOL "THEN" "GOTO" EXIT;
EXPVAL:= EXPVAL * 10 + LASTSYMBOL - ZERO;
"IF" EXPRESSION = BLANK "THEN" EXPRESSION; "GOTO" EXP;
EXIT: READ:= NUMSIGN * NUMVAL * 10 ** (DECEXP + EXPSIGN * EXPVAL)
"END";
"PROCEDURE" PRINTWORD(WORD); "VALUE" WORD; "INTEGER" WORD;
"BEGIN" "INTEGER" P, SYM;
"FOR" P:= WORDFULL, P // WORDSHIFT "WHILE" P > 0 "DO"
"BEGIN" SYM:= WORD // P; "IF" SYM > 0 "THEN" PRSYM(SYM);
WORD:= WORD - P * SYM
"END"
"END";
"INTEGER" "PROCEDURE" NEXTPAGE;
"IF" FREEPAGE <= MAXPAGE "THEN"
"BEGIN" NEXTPAGE:= FREEPAGE; FREEPAGE:= PAGETABLE[FREEPAGE] "END"
"ELSE"
"BEGIN" OUTPUT(64,"("6/,"("ECS SPACE EXHAUSTED")",
6/,"("ALL INFORMATION IS LOST")",*")"); "GOTO" START
"END";
"PROCEDURE" RETURN PAGE(PAGE); "VALUE" PAGE; "INTEGER" PAGE;
"IF" PAGE > CHAINEND "THEN"
"BEGIN" "IF" RETURN "THEN"
"BEGIN" PAGETABLE[PAGE]:= FREEPAGE; FREEPAGE:= PAGE "END"
"END" "ELSE"
"BEGIN" OUTPUT(64,"("6/,"("READ OUTSIDE ECS SPACE")",
6/,"("CHECK REPLICATIONS FOR DEP.VAR. IN INPUT STATEMENT")"")");
"GOTO" END OF JOB
"END";
"PROCEDURE" RETURN CHAIN(ENTRY); "INTEGER" ENTRY;
"BEGIN" "INTEGER" P, Q; P:= ENTRY;
"IF" P "NOTEQUAL" CHAINEND "THEN"
"BEGIN" "FOR" Q:= PAGETABLE[P]
"WHILE" Q "NOTEQUAL" CHAINEND "DO" P:= Q;
PAGETABLE[P]:= FREEPAGE; FREEPAGE:= ENTRY; ENTRY:= CHAINEND
"END"
"END";
"PROCEDURE" PAGE TO ECS(LIST, LASTPAGE);
"ARRAY" LIST; "INTEGER" LASTPAGE;
"BEGIN" "INTEGER" PAGE;
PAGE:= NEXTPAGE; WRITE ECS(PAGELENGTH * PAGE, LIST, START);
PAGETABLE[LASTPAGE]:= LASTPAGE:= PAGE
"END";
"PROCEDURE" PAGE FROM ECS(LIST, LASTPAGE);
"ARRAY" LIST; "INTEGER" LASTPAGE;
"BEGIN" "INTEGER" PAGE;
PAGE:= LASTPAGE:= PAGETABLE[LASTPAGE];
RETURN PAGE(PAGE); READ ECS(PAGELENGTH * PAGE, LIST, START);
"END";
"PROCEDURE" COLUMN TO ECS(LIST, COL, LASTPAGE);
"VALUE" COL; "ARRAY" LIST; "INTEGER" COL, LASTPAGE;
"BEGIN" "INTEGER" I, PAGE;
"FOR" I:= 1 "STEP" 1 "UNTIL" MAXNUM "DO" COLUMN[I]:= LIST[I,COL];
PAGE:= NEXTPAGE; WRITE ECS(PAGELENGTH * PAGE, COLUMN, START);
PAGETABLE[PAGE]:= LASTPAGE; LASTPAGE:= PAGE
"END";
"PROCEDURE" COLUMN FROM ECS(LIST, COL, LASTPAGE);
"VALUE" COL; "ARRAY" LIST; "INTEGER" COL, LASTPAGE;
"BEGIN" "INTEGER" I, PAGE;
PAGE:= LASTPAGE; LASTPAGE:= PAGETABLE[PAGE];
RETURN PAGE(PAGE); READ ECS(PAGELENGTH * PAGE, COLUMN, START);
"FOR" I:= 1 "STEP" 1 "UNTIL" MAXNUM "DO" LIST[I,COL]:= COLUMN[I]
"END";
"PROCEDURE" BLOCK TO ECS(LIST, LASTPAGE, LOW, UPP);
"VALUE" LOW, UPP; "ARRAY" LIST, LASTPAGE; "INTEGER" LOW, UPP;
"BEGIN" "INTEGER" I;
"FOR" I:= LOW "STEP" 1 "UNTIL" UPP "DO"
COLUMN TO ECS(LIST, I, LASTPAGE[I])
"END";
"PROCEDURE" BLOCK FROM ECS(LIST, LASTPAGE, LOW, UPP);
"VALUE" LOW, UPP; "ARRAY" LIST, LASTPAGE; "INTEGER" LOW, UPP;
"BEGIN" "INTEGER" I;
"FOR" I:= LOW "STEP" 1 "UNTIL" UPP "DO"
COLUMN FROM ECS(LIST, I, LASTPAGE[I])
"END";
"PROCEDURE" GET FIRST PAGE(LIST, ENTRY);
"VALUE" ENTRY; "ARRAY" LIST; "INTEGER" ENTRY;
"BEGIN" LASTPAGE:= ENTRY; PAGE FROM ECS(LIST, LASTPAGE);
LISTPOINTER:= 1
"END";
"PROCEDURE" ERRORMESSAGE(N); "VALUE" N; "INTEGER" N;
"BEGIN" "INTEGER" SYM; ERROR:= "TRUE";
OUTPUT(64,"("//,"("ERROR NUMBER:")",B3D11B")", N);
"IF" LASTSYMBOL > SKIPSIGN "THEN"
"BEGIN" SYM:= LASTSYMBOL // 100;
PRSYM(SYM); PRSYM(LASTSYMBOL - SYM * 100)
"END" "ELSE" PRSYM(LASTSYMBOL);
TABULATE(40); PRINTWORD(LASTNAME); OUTPUT(64,"("//")")
"END";
"PROCEDURE" ERROR ONE(N, P); "VALUE" N, P; "INTEGER" N; "REAL" P;
"BEGIN" ERROR:= "TRUE";
OUTPUT(64,"("//,"("ERROR NUMBER:")",B3D,11ZD,//")", N, P);
"IF" N < 100 "THEN"
"BEGIN" SYSTEM:= SYSTEM + 1;
OUTPUT(64,"("4/,"("JOB IS RERUN")",*")"); "GOTO" RUN
"END"
"END";
START: LASTSYMBOL:= BLANK; FREEPAGE:= 0; SYSTEM:= 1; RUNNUMBER:= 0;
MODELSIZE:= INPUTSIZE:= DATASIZE:= OPTIONSIZE:= 0;
"FOR" I:= 1 "STEP" 1 "UNTIL" MAXOPT "DO" OPTION WANTED[I]:= "FALSE";
"FOR" I:= CHAINEND "STEP" 1 "UNTIL" -1 "DO" PAGETABLE[I]:= CHAINEND;
"FOR" I:= 0 "STEP" 1 "UNTIL" MAXPAGE "DO" PAGETABLE[I]:= I + 1;
JOB: PAGEWIDTH(CARDWIDTH + 1); TABULATE(READPOS);
"FOR" I:= READSYMBOL "WHILE" "NOT" SYSTEMLASTSYMBOL "DO" PRSYM(I);
PAGEWIDTH(PAPERWIDTH);
STATEMENT:
"IF" LASTSYMBOL = 1315 "THEN"
READLIST(SYMBOLLIST, MAXSYM, READSYMBOL, -1, MODELSIZE) "ELSE"
"IF" LASTSYMBOL = 0914 "THEN"
READLIST(SYMBOLLIST, MAXSYM, READSYMBOL, -2, INPUTSIZE) "ELSE"
"IF" LASTSYMBOL = 1516 "THEN"
READLIST(SYMBOLLIST, MAXSYM, READSYMBOL, -3, OPTIONSIZE) "ELSE"
"IF" LASTSYMBOL = 0401 "THEN"
"BEGIN" READSYMBOL;
READLIST(DATALIST, MAXNUM, READNUMBER, -4, DATASIZE)
"END" "ELSE"
"IF" LASTSYMBOL = 1821 "THEN" "GOTO" RUN "ELSE"
"IF" LASTSYMBOL = 0524 "THEN" "GOTO" EXIT; "GOTO" STATEMENT;
RUN: RUNNUMBER:= RUNNUMBER + 1;
"IF" MODELSIZE = 0 "OR" INPUTSIZE = 0 "THEN"
"BEGIN" "IF" MODELSIZE = 0 "THEN"
OUTPUT(64,"("6/,"("NO MODEL GIVEN")"")");
"IF" INPUTSIZE = 0 "THEN"
OUTPUT(64,"("6/,"("NO INPUT GIVEN")"")");
"GOTO" END OF JOB
"END";
MAXNAME:= MAXORDERS:= PAGELENGTH * SYSTEM *
((MODELSIZE + INPUTSIZE) // (PAGELENGTH * 8) + 1);
STACKMAX:= MAXNAME // 2; MAXCON:= MAXNAME // 4;
LEFTMAXNUM:= RIGHTMAXNUM:= PAGELENGTH;
ERROR:= RETURN:= "FALSE";
"BEGIN" "REAL" "ARRAY" STACK[1:STACKMAX], CONSTANTLIST[1:MAXCON];
"INTEGER" "ARRAY" NAMELIST[1:MAXNAME], ORDERLIST[1:MAXORDERS];
"INTEGER" "PROCEDURE" NEXTLISTSYMBOL;
"BEGIN" "IF" LISTPOINTER > MAXSYM "THEN"
"BEGIN" PAGE FROM ECS(SYMBOLLIST, LASTPAGE);
LISTPOINTER:= 1
"END";
NEXTLISTSYMBOL:= SYMBOLLIST[LISTPOINTER];
LISTPOINTER:= LISTPOINTER + 1
"END";
"INTEGER" "PROCEDURE" NEXTSYMBOL;
"BEGIN" "INTEGER" SYM;
SYM:= "IF" STOCK >= 0 "THEN" STOCK "ELSE" NEXTLISTSYMBOL;
"FOR" SYM:= SYM "WHILE" SYM = BLANK "DO" SYM:= NEXTLISTSYMBOL;
STOCK:= - 1;
"IF" SYM = MULSIGN "OR" SYM = DIVSIGN "THEN"
"BEGIN" STOCK:= NEXTLISTSYMBOL; "IF" STOCK = SYM "THEN"
"BEGIN" SYM:= SYM * 100 + STOCK; STOCK:= - SYM "END"
"END";
NEXTSYMBOL:= LASTSYMBOL:= SYM
"END";
"REAL" "PROCEDURE" NEXTNUMBER;
"BEGIN" "IF" LISTPOINTER > MAXNUM "THEN"
"BEGIN" PAGE FROM ECS(DATALIST, LASTPAGE);
LISTPOINTER:= 1
"END";
NEXTNUMBER:= DATALIST[LISTPOINTER];
LISTPOINTER:= LISTPOINTER + 1
"END";
"INTEGER" "PROCEDURE" SIGNED NUMBER;
"BEGIN" "INTEGER" I, PREVSYMBOL;
"REAL" NUMBER;
"INTEGER" "PROCEDURE" CHECKSYMBOL;
"BEGIN" CHECKSYMBOL:= NEXTSYMBOL;
"IF" "NOT" DIGITLASTSYMBOL "THEN"
"BEGIN" "IF" PREVSYMBOL = POINT "THEN" ERRORMESSAGE(100)
"ELSE" "IF" PREVSYMBOL = LOWTEN "AND"
"NOT" (LASTSYMBOL = PLUS "OR" LASTSYMBOL = MINUS)
"THEN" ERRORMESSAGE(101)
"END";
PREVSYMBOL:= LASTSYMBOL
"END";
PREVSYMBOL:= LASTSYMBOL; NUMBER:= READ(CHECKSYMBOL);
"FOR" I:= 1 "STEP" 1 "UNTIL" CONCOUNTER "DO"
"IF" CONSTANTLIST[I] = NUMBER "THEN" "GOTO" EXIT;
I:= CONCOUNTER:= CONCOUNTER + 1;
"IF" I > SUBMAXCON "THEN" ERROR ONE(10, CONCOUNTER);
CONSTANTLIST[I]:= NUMBER;
EXIT: SIGNED NUMBER:= I
"END";
"INTEGER" "PROCEDURE" IDENTIFIER;
"BEGIN" "INTEGER" I, J, WORD, NLP, LOW, UPP, LENGTH;
DECLARED:= "FALSE"; WORD:= LASTSYMBOL;
NLP:= UPP:= NAMELIST[NAMECOUNTER + 1];
"FOR" I:= NEXTSYMBOL "WHILE"
DIGITLASTSYMBOL "OR" LETTERLASTSYMBOL "DO"
"BEGIN" "IF" WORD > WORDFULL "THEN"
"BEGIN" NAMELIST[NLP]:= WORD; NLP:= NLP-1; WORD:= 0 "END";
WORD:= WORD * WORDSHIFT + LASTSYMBOL
"END";
NAMELIST[NLP]:= WORD; NLP:= NLP - 1;
"IF" NLP <= NAMECOUNTER + 1 "THEN" ERROR ONE(20, NAMECOUNTER);
"FOR" I:= NAMECOUNTER "STEP" -1 "UNTIL" 1 "DO"
"BEGIN" LOW:= UPP; UPP:= NAMELIST[I]; LENGTH:= UPP - LOW;
"FOR" J:= 1 "STEP" 1 "UNTIL" LENGTH "DO"
"IF" NAMELIST[LOW+J] ^= NAMELIST[NLP+J] "THEN" "GOTO" NEXT;
"IF" LENGTH = NAMELIST[NAMECOUNTER + 1] - NLP "THEN"
"BEGIN" DECLARED:= "TRUE"; "GOTO" EXIT "END"; NEXT:
"END";
I:= NAMECOUNTER:= NAMECOUNTER + 1;
NAMELIST[NAMECOUNTER + 1]:= NLP;
EXIT: IDENTIFIER:= I; LASTNAME:= NAMELIST[NAMELIST[I]]
"END";
"PROCEDURE" LOAD(ORDER, ADDRESS);
"VALUE" ORDER, ADDRESS; "INTEGER" ORDER, ADDRESS;
"IF" ORDERCOUNTER <= MAXORDERS "THEN"
"BEGIN" ORDERLIST[ORDERCOUNTER]:= ADDRESS * 100 + ORDER;
ORDERCOUNTER:= ORDERCOUNTER + 1
"END" "ELSE" ERROR ONE(30, ORDERCOUNTER);
"PROCEDURE" MODEL STATEMENT;
"BEGIN" LOAD(TEST, 0); LOAD(FLS, 0); TYPE:= 2;
LEFT HAND PART; LOAD(RET, 2); LOAD(DEP, 0);
"IF" LASTSYMBOL = PLUS "THEN" NEXTSYMBOL; TYPE:= 1;
RIGHT HAND PART; LOAD(RET, 1)
"END";
"PROCEDURE" LEFT HAND PART;
"BEGIN" SIMPLE ARITHEXP; LOAD(REP, 0);
"IF" LASTSYMBOL = EQUAL "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(110)
"END";
"PROCEDURE" RIGHT HAND PART;
"BEGIN" TERM; LOAD(RES, 0); RESCOUNTER:= RESCOUNTER + 1;
"IF" LASTSYMBOL = PLUS "THEN"
"BEGIN" NEXTSYMBOL; RIGHT HAND PART "END"
"END";
"PROCEDURE" SIMPLE ARITHEXP;
"BEGIN" "IF" LASTSYMBOL = MINUS "THEN"
"BEGIN" NEXTSYMBOL; TERM; LOAD(NEG, 0) "END" "ELSE"
"BEGIN" "IF" LASTSYMBOL = PLUS "THEN" NEXTSYMBOL; TERM "END";
NEXT TERM
"END";
"PROCEDURE" NEXT TERM;
"IF" LASTSYMBOL = PLUS "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL; TERM; LOAD(ADD, 0);
NEXT TERM
"END" "ELSE"
"IF" LASTSYMBOL = MINUS "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL; TERM; LOAD(SUBT, 0);
NEXT TERM
"END";
"PROCEDURE" TERM; "BEGIN" FACTOR; NEXT FACTOR "END";
"PROCEDURE" NEXT FACTOR;
"IF" LASTSYMBOL = MULSIGN "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL; FACTOR; LOAD(MUL, 0);
NEXT FACTOR
"END" "ELSE"
"IF" LASTSYMBOL = DIVSIGN "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL; FACTOR; LOAD(DIV, 0);
NEXT FACTOR
"END" "ELSE"
"IF" LASTSYMBOL = IDISIGN "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL; FACTOR; LOAD(IDI, 0);
NEXT FACTOR
"END";
"PROCEDURE" FACTOR; "BEGIN" PRIMARY; NEXT PRIMARY "END";
"PROCEDURE" NEXT PRIMARY;
"IF" LASTSYMBOL = TTPSIGN "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL; PRIMARY; LOAD(TTP, 0);
NEXT PRIMARY
"END";
"PROCEDURE" PRIMARY;
"IF" LASTSYMBOL = OPEN "THEN"
"BEGIN" NEXTSYMBOL; SIMPLE ARITHEXP;
"IF" LASTSYMBOL = CLOSE "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(111)
"END" "ELSE"
"IF" LETTERLASTSYMBOL "THEN" ARITHNAME(IDENTIFIER) "ELSE"
"IF" NUMBERLASTSYMBOL "THEN" LOAD(TCV, SIGNED NUMBER)
"ELSE" ERRORMESSAGE(112);
"PROCEDURE" ARITHNAME(N); "VALUE" N; "INTEGER" N;
"IF" N <= STANDARD "THEN" FUNCTION DESIGNATOR(N) "ELSE"
"IF" N <= PERMANENT "THEN" ERRORMESSAGE(113) "ELSE"
"IF" TYPE = 6 "THEN"
"BEGIN" "IF" "IF" DECLARED "THEN" STACK[N] = 6 "ELSE" "FALSE"
"THEN" LOAD(TAV, N) "ELSE" ERRORMESSAGE(114)
"END" "ELSE" "BEGIN" LOAD(TAV, N); STACK[N]:= TYPE "END";
"PROCEDURE" FUNCTION DESIGNATOR(N); "VALUE" N; "INTEGER" N;
"BEGIN" "INTEGER" P; P:= 0; "IF" LASTSYMBOL = OPEN "THEN"
"BEGIN" NEXTSYMBOL; P:= PARAMETER LIST "END";
"IF" P = STACK[N] "THEN" LOAD(FUN, N) "ELSE" ERRORMESSAGE(115)
"END";
"INTEGER" "PROCEDURE" PARAMETER LIST;
"BEGIN" SIMPLE ARITHEXP; "IF" LASTSYMBOL = COMMA "THEN"
"BEGIN" LOAD(STCK, 0); NEXTSYMBOL;
PARAMETER LIST:= PARAMETER LIST + 1
"END" "ELSE"
"BEGIN" "IF" LASTSYMBOL = CLOSE "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(116); PARAMETER LIST:= 1
"END"
"END";
"PROCEDURE" INPUT STATEMENT;
"BEGIN" PART; "IF" LASTSYMBOL = COMMA "THEN"
"BEGIN" NEXTSYMBOL; INPUT STATEMENT "END"
"END";
"PROCEDURE" PART;
"IF" LASTSYMBOL = SMALLER "THEN"
"BEGIN" TYPE:= 6; NEXTSYMBOL; SIMPLE ARITHEXP;
"IF" LASTSYMBOL = GREATER "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(120); CONTROL
"END" "ELSE"
"IF" LETTERLASTSYMBOL "THEN" INPUTNAME(IDENTIFIER) "ELSE"
"IF" NUMBERLASTSYMBOL "THEN"
"BEGIN" LOAD(TCV, SIGNED NUMBER); CONTROL "END" "ELSE"
"BEGIN" LOAD(TCV, 1); LOAD(STCK, 0); DESCRIPTION "END";
"PROCEDURE" INPUTNAME(N); "VALUE" N; "INTEGER" N;
"IF" DECLARED "THEN"
"BEGIN" "IF" N > PERMANENT "AND" STACK[N] = 6 "THEN"
"BEGIN" LOAD(TAV, N); CONTROL "END" "ELSE" ERRORMESSAGE(121)
"END" "ELSE" "BEGIN" LOAD(SAV, N); STACK[N]:= 6 "END";
"PROCEDURE" CONTROL;
"IF" LASTSYMBOL = MULSIGN "THEN"
"BEGIN" "INTEGER" M; M:= ORDERCOUNTER;
LOAD(0,0); LOAD(STCK,0); NEXTSYMBOL; DESCRIPTION;
ORDERLIST[M]:= ORDERCOUNTER * 100 + JMP
"END" "ELSE" LOAD(EQL,0);
"PROCEDURE" DESCRIPTION;
"BEGIN" "INTEGER" M; M:= ORDERCOUNTER;
"IF" LASTSYMBOL = OPEN "THEN"
"BEGIN" NEXTSYMBOL; INPUT STATEMENT;
"IF" LASTSYMBOL = CLOSE "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(122); LOAD(RET, M)
"END" "ELSE"
"IF" LASTSYMBOL = SUB "THEN"
"BEGIN" THREE:= FIVE:= "FALSE";
NEXTSYMBOL; VARIABLE LIST;
"IF" LASTSYMBOL = BUS "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(123); MIXED(M)
"END" "ELSE" ERRORMESSAGE(124)
"END";
"PROCEDURE" VARIABLE LIST;
"BEGIN" VARIABLE; "IF" LASTSYMBOL = COMMA "THEN"
"BEGIN" NEXTSYMBOL; VARIABLE LIST "END"
"END";
"PROCEDURE" VARIABLE;
"IF" LETTERLASTSYMBOL "THEN"
"BEGIN" "INTEGER" N; N:= IDENTIFIER;
"IF" DECLARED "THEN"
"BEGIN" "INTEGER" TYPE; TYPE:= STACK[N];
"IF" N <= STANDARD "THEN" ERRORMESSAGE(125) "ELSE"
"IF" N <= PERMANENT "THEN" ERRORMESSAGE(126) "ELSE"
"IF" TYPE = 1 "OR" TYPE = 3 "THEN"
"BEGIN" LOAD(RAV, N); STACK[N]:= 3; THREE:= "TRUE";
"IF" TYPE = 1 "THEN" RIGHTCOUNTER:= RIGHTCOUNTER + 1
"END" "ELSE"
"IF" TYPE = 2 "OR" TYPE = 5 "THEN"
"BEGIN" LOAD(LAV, N); STACK[N]:= 5; FIVE:= "TRUE";
"IF" TYPE = 2 "THEN" LEFTCOUNTER:= LEFTCOUNTER + 1
"END" "ELSE" "IF" TYPE = 4 "THEN" LOAD(SAV, N)
"ELSE" ERRORMESSAGE(127)
"END" "ELSE" "BEGIN" LOAD(SAV, N); STACK[N]:= 4 "END"
"END" "ELSE" ERRORMESSAGE(128);
"PROCEDURE" MIXED(M); "VALUE" M; "INTEGER" M;
"IF" THREE "THEN"
"BEGIN" "IF" FIVE "THEN" LOAD(FIX, M); LOAD(RET, M) "END" "ELSE"
"BEGIN" "IF" FIVE "THEN" "BEGIN" LOAD(RET, M); LOAD(FIX, M) "END"
"ELSE" SKIP(M)
"END";
"PROCEDURE" SKIP(M); "VALUE" M; "INTEGER" M;
"BEGIN" "INTEGER" SC; SC:= ORDERCOUNTER - M;
ORDERCOUNTER:= M - 1; LOAD(SKP, SC)
"END";
"PROCEDURE" OPTION STATEMENT;
"BEGIN" "INTEGER" I;
"FOR" I:= 1 "STEP" 1 "UNTIL" MAXOPT "DO"
OPTION WANTED[I]:= "FALSE";
"IF" SYSTEMSYMBOL(LASTSYMBOL) "THEN" OPTIONSIZE:= 0
"ELSE" OPTION LIST
"END";
"PROCEDURE" OPTION LIST;
"BEGIN" OPTION; "IF" LASTSYMBOL = COMMA "THEN"
"BEGIN" NEXTSYMBOL; OPTION LIST "END"
"END";
"PROCEDURE" OPTION;
"BEGIN" "INTEGER" N;
"IF" LETTERLASTSYMBOL "THEN" N:= STACK[IDENTIFIER] "ELSE"
"IF" NUMBERLASTSYMBOL "THEN" N:= CONSTANTLIST[SIGNED NUMBER]
"ELSE" ERRORMESSAGE(130);
"IF" 1 <= N "AND" N <= MAXOPT "THEN" OPTION WANTED[N]:= "TRUE"
"ELSE" ERRORMESSAGE(131);
"IF" OPTION WANTED[7] "AND" LASTSYMBOL = OPEN "THEN"
"BEGIN" NEXTSYMBOL; SUBMODEL LIST;
"IF" LASTSYMBOL = CLOSE "THEN" NEXTSYMBOL
"ELSE" ERRORMESSAGE(132)
"END"
"END";
"PROCEDURE" SUBMODEL LIST;
"BEGIN" "INTEGER" N;
"IF" NUMBERLASTSYMBOL "THEN" N:= CONSTANTLIST[SIGNED NUMBER]
"ELSE" ERRORMESSAGE(133);
"IF" 0 <= N "AND" N < RESCOUNTER - 1 "THEN"
"BEGIN" CONSTANTLIST[SUBMAXCON]:= N; SUBMAXCON:= SUBMAXCON - 1
"END" "ELSE" ERRORMESSAGE(134);
"IF" LASTSYMBOL = COMMA "THEN"
"BEGIN" NEXTSYMBOL; SUBMODEL LIST "END"
"END";
"REAL" "PROCEDURE" READFILE;
"BEGIN" "REAL" NUMBER; EOF(65, END);
INREAL(65, NUMBER); READFILE:= NUMBER; "GOTO" EXIT;
END: READFILE:= LISTPOINTER; SYSTEMLASTSYMBOL:= "TRUE"; EXIT:
"END";
"PROCEDURE" PRINT SYMBOLLIST(ENTRY, SIZE);
"VALUE" ENTRY, SIZE; "INTEGER" ENTRY, SIZE;
"BEGIN" "INTEGER" I;
GET FIRST PAGE(SYMBOLLIST, ENTRY); PAGEWIDTH(CARDWIDTH + 1);
"FOR" I:= 1 "STEP" 1 "UNTIL" SIZE "DO" PRSYM(NEXTLISTSYMBOL);
PAGEWIDTH(PAPERWIDTH); GET FIRST PAGE(SYMBOLLIST, ENTRY)
"END";
"PROCEDURE" PRINT DATALIST;
"BEGIN" "INTEGER" I; OUTPUT(64,"("6/,
"(""DATA"")",//")"); GET FIRST PAGE(DATALIST, -4);
"FOR" I:= 1 "STEP" 1 "UNTIL" DATASIZE "DO"
OUTPUT(64,"("-6Z.3DB")",NEXTNUMBER)
"END";
"PROCEDURE" PREPARE;
"BEGIN" "IF" RIGHTCOUNTER = 0 "THEN" ERROR ONE(150, 1);
"IF" OPTION WANTED[5] "THEN"
READLIST(DATALIST, MAXNUM, READFILE, -4, DATASIZE);
"IF" DATASIZE = 0 "OR" ERROR "THEN"
"BEGIN" "IF" OPTION WANTED[5] "THEN"
OUTPUT(64,"("6/,"("ONE DATA RECORD SKIPPED")"")");
"IF" DATASIZE = 0 "THEN"
OUTPUT(64,"("6/,"("NO DATA (RECORD) GIVEN")"")");
"GOTO" END OF JOB
"END"; "IF" OPTION WANTED[8] "THEN" PRINT DATALIST;
"IF" LEFTCOUNTER = 0 "THEN"
"BEGIN" LEFTCOUNTER:= LEFTMAXNUM:= ORDERCOUNTER:= 1;
LOAD(TCV, 1); LOAD(INIT, 0)
"END";
TERMCOUNTER:= RESCOUNTER - 1; REPCOUNTER:= RESCOUNTER + 1
"END";
"PROCEDURE" TRANSLATE(HEADING, ENTRY, SIZE, STATEMENT, ORDERS);
"VALUE" ENTRY, SIZE; "INTEGER" ENTRY, SIZE, ORDERS;
"STRING" HEADING; "PROCEDURE" STATEMENT;
"IF" SIZE "NOTEQUAL" 0 "THEN"
"BEGIN" OUTPUT(64,"("6/,N")",HEADING); PRINT SYMBOLLIST(ENTRY,SIZE);
STOCK:= - 1; NEXTSYMBOL; STATEMENT; ORDERS:= ORDERCOUNTER - 1;
"IF" "NOT" SYSTEMSYMBOL(LASTSYMBOL) "THEN" ERRORMESSAGE(140)
"END";
"INTEGER" "PROCEDURE" NAMELISTSYMBOL;
"BEGIN" "INTEGER" SYM; STRING ELEMENT(
"("ABS,1 SIGN,1 SQRT,1 SIN,1 COS,1 ARCTAN,1
LN,1 EXP,1 ENTIER,1 MIN,2 MAX,2 ARCSIN,1 ,
TRANSFORMED DATA MATRIX,1 CORRELATION MATRIX,2
RESIDUAL ANALYSIS,3 NO REGRESSION ANALYSIS,4
INPUT DATA FROM FILE,5 OUTPUT DATA TO FILE,6
PROCESS SUBMODELS,7 PRINT DATALIST,8 ; ")",
LISTPOINTER + SHIFT,
"("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789,; ")", SYM);
"IF" SYM = 39 "THEN" SYM:= BLANK;
SYSTEMLASTSYMBOL:= SYM = 38; NAMELISTSYMBOL:= SYM
"END";
"PROCEDURE" INITIALIZE TABLES;
"BEGIN" "INTEGER" I;
NAMELIST[1]:= MAXNAME; NAMECOUNTER:= 0; LASTNAME:= BLANK;
"IF" RUNNUMBER = 1 "THEN"
READLIST(SYMBOLLIST, MAXSYM, NAMELISTSYMBOL, CHAINEND+1, SHIFT);
GET FIRST PAGE(SYMBOLLIST, CHAINEND+1); STOCK:= - 1;
"FOR" I:= NEXTSYMBOL "WHILE" I "NOTEQUAL" 37 "DO"
STACK[IDENTIFIER]:= NEXTSYMBOL - ZERO; STANDARD:= NAMECOUNTER;
"FOR" I:= NEXTSYMBOL "WHILE" I "NOTEQUAL" 38 "DO"
STACK[IDENTIFIER]:= NEXTSYMBOL - ZERO; PERMANENT:= NAMECOUNTER;
ORDERCOUNTER:= CONCOUNTER:= RESCOUNTER:= 1; SUBMAXCON:= MAXCON;
LEFTCOUNTER:= RIGHTCOUNTER:= 0; CONSTANTLIST[1]:= 1
"END";
INITIALIZE TABLES;
TRANSLATE("(""MODEL"")",
-1, MODELSIZE, MODEL STATEMENT, MODELORDERS);
TRANSLATE("(""INPUT"")",
-2, INPUTSIZE, INPUT STATEMENT, INPUTORDERS);
TRANSLATE("(""OPTIONS"")",
-3, OPTIONSIZE, OPTION STATEMENT, ORDERCOUNTER);
PREPARE;
"BEGIN" "INTEGER" "ARRAY" PARREF[1:TERMCOUNTER],
RESPAGE[1:REPCOUNTER];
"REAL" "ARRAY" RESSUM, RESSQUARES, RESMIN, RESMAX[1:RESCOUNTER],
RESULTLIST[1:MAXNUM,1:REPCOUNTER];
"BEGIN" "INTEGER" "ARRAY"
LEFTVALREF, LEFTROW, LEFTPAGE, LEFTDEPTH[1:LEFTCOUNTER],
RIGHTVALREF, RIGHTROW, RIGHTPAGE, RIGHTSIZE[1:RIGHTCOUNTER];
"REAL" "ARRAY" LEFT DATA[1:LEFTMAXNUM,1:LEFTCOUNTER],
RIGHT DATA[1:RIGHTMAXNUM,1:RIGHTCOUNTER];
"PROCEDURE" ERROR TWO(N, P, Q);
"VALUE" N, P, Q; "INTEGER" N; "REAL" P, Q;
"BEGIN" OUTPUT(64,
"("//,"("ERROR NUMBER:")",B3D,2(-10Z.5D)")", N, P, Q);
PRINT DATALIST; ENDRUN; "GOTO" END OF JOB
"END";
"PROCEDURE" CHECK MODEL;
"BEGIN" "INTEGER" I, PC, TC, RC, LC, ORDER, ADDRESS,
LASTORDER, NEXTORDER; "BOOLEAN" CONSTANT;
PC:= TC:= RC:= LC:= 0; CONSTANT:= "FALSE";
"FOR" I:= 3 "STEP" 1 "UNTIL" MODELORDERS "DO"
"BEGIN" ORDER:= ORDERLIST[I]; "IF" ORDER > 100 "THEN"
"BEGIN" ADDRESS:= ORDER // 100;
"IF" ORDER - ADDRESS * 100 ^= TAV "THEN" "GOTO" EXIT;
TYPE:= STACK[ADDRESS]; "IF" TYPE = 1 "THEN"
"BEGIN" PARREF[TC]:= ADDRESS; PC:= PC + 1;
NEXTORDER:= ORDERLIST[I + 1];
"IF" LASTORDER = RES "AND" NEXTORDER = RES "THEN"
CONSTANT:= "TRUE";
"IF" LASTORDER = RES "EQUIV" NEXTORDER = MUL "THEN"
ERROR ONE(151, TC)
"END" "ELSE" "IF" TYPE = 2 "THEN" ERROR ONE(152, TC)
"END" "ELSE" "IF" ORDER = RES "THEN"
"BEGIN" "IF" LASTORDER "NOTEQUAL" MUL "THEN"
"BEGIN" "IF" CONSTANT "THEN" CONSTANT:= "FALSE"
"ELSE" ERROR ONE(153, TC)
"END"; "IF" PC > 1 "THEN" ERROR ONE(154, TC)
"ELSE" "IF" PC = 0 "THEN" ERROR ONE(155, TC);
PC:= 0; TC:= TC + 1
"END" "ELSE" "IF" ORDER = DEP "THEN"
"BEGIN" ORDER:= RES; TC:= 1 "END"; EXIT: LASTORDER:= ORDER
"END"; "IF" ERROR "THEN" "GOTO" END OF JOB;
"FOR" I:= PERMANENT + 1 "STEP" 1 "UNTIL" NAMECOUNTER "DO"
"BEGIN" TYPE:= STACK[I]; "IF" TYPE = 3 "THEN"
"BEGIN" RC:= RC + 1; RIGHTVALREF[RC]:= I;
STACK[I]:= RC
"END" "ELSE" "IF" TYPE = 5 "THEN"
"BEGIN" LC:= LC + 1; LEFTVALREF[LC]:= I;
STACK[I]:= LC
"END"
"END"; GET FIRST PAGE(DATALIST, -4);
STACKPOINTER:= NAMECOUNTER + 1; ORDERCOUNTER:= MODELORDERS + 1
"END";
"PROCEDURE" CHECK INPUT;
"BEGIN" "INTEGER" I; "REAL" F, CHECK;
"IF" NEXTNUMBER "NOTEQUAL" LISTPOINTER - 1 "THEN"
OUTPUT(64,"("6/,"("NOT ALL DATA IS READ (MESSAGE)")"")");
F:= LEFTROW[1];
"FOR" I:= 2 "STEP" 1 "UNTIL" LEFTCOUNTER "DO"
"BEGIN" CHECK:= LEFTROW[I];
"IF" F "NOTEQUAL" CHECK "THEN" ERROR TWO(210, F, CHECK)
"END";
F:= RIGHTSIZE[1];
"FOR" I:= 2 "STEP" 1 "UNTIL" RIGHTCOUNTER "DO"
"BEGIN" CHECK:= RIGHTSIZE[I];
"IF" F "NOTEQUAL" CHECK "THEN" ERROR TWO(211, F, CHECK)
"END";
STACK[STACKPOINTER]:= F; RIGHTSIZE1:= F; LEFTSIZE:= 0;
STACKPOINTER:= STACKPOINTER + 1; RESPOINTER:= 0;
LEFTPOINTER:= LEFTROW[1] - 1; RIGHTPOINTER:= RIGHTROW[1] - 1;
ORDERCOUNTER:= 1; RETURN:= "TRUE"
"END";
"PROCEDURE" EXECUTE(ORDERS); "VALUE" ORDERS; "INTEGER" ORDERS;
"BEGIN" "INTEGER" I, J, ORDER, ADDRESS, ROW, COL;
"REAL" F, G, CHECK;
"SWITCH" MACRO:= STCK, ADD, SUBT, MUL, DIV, IDI, TTP, NEG,
EQL, RES, REP, DEP, TEST, INIT, FRS, FLS;
"SWITCH" MACRO2:= TCV, TAV, RAV, SAV, LAV,
RET, JMP, FIX, SKP, FUN;
NEXT: ORDER:= ORDERLIST[ORDERCOUNTER];
ORDERCOUNTER:= ORDERCOUNTER + 1; ADDRESS:= ORDER // 100;
"GOTO" "IF" ORDER < 100 "THEN" MACRO[ORDER]
"ELSE" MACRO2[ORDER - ADDRESS * 100];
STCK: "IF" STACKPOINTER > STACKMAX "THEN"
"BEGIN" ENDRUN; ERROR ONE(40, STACKPOINTER) "END";
STACK[STACKPOINTER]:= F;
STACKPOINTER:= STACKPOINTER + 1; "GOTO" EXIT;
ADD: STACKPOINTER:= STACKPOINTER - 1;
F:= STACK[STACKPOINTER] + F; "GOTO" EXIT;
SUBT: STACKPOINTER:= STACKPOINTER - 1;
F:= STACK[STACKPOINTER] - F; "GOTO" EXIT;
MUL: STACKPOINTER:= STACKPOINTER - 1;
F:= STACK[STACKPOINTER] * F; "GOTO" EXIT;
DIV: STACKPOINTER:= STACKPOINTER - 1;
"IF" F = 0 "THEN" ERROR TWO(200, TERMPOINTER, RESPOINTER);
F:= STACK[STACKPOINTER] / F; "GOTO" EXIT;
IDI: STACKPOINTER:= STACKPOINTER - 1; I:= F;
"IF" I = 0 "THEN" ERROR TWO(201, TERMPOINTER, RESPOINTER);
J:= STACK[STACKPOINTER]; F:= J // I; "GOTO" EXIT;
TTP: STACKPOINTER:= STACKPOINTER - 1; I:= F;
G:= STACK[STACKPOINTER];
"IF" G = 0 "AND" F <= 0 "THEN" ERROR TWO(202, F, RESPOINTER);
"IF" G < 0 "AND" F ^= I "THEN" ERROR TWO(203, G, RESPOINTER);
F:= "IF" I = F "THEN" G ** I "ELSE" G ** F; "GOTO" EXIT;
NEG: F:= - F; "GOTO" EXIT;
EQL: CHECK:= NEXTNUMBER; "IF" ABS(F - CHECK) > PRECISION
"THEN" ERROR TWO(212, F, CHECK); "GOTO" EXIT;
RES: RESULTLIST[RESPOINTER,TERMPOINTER]:= F * REPEATROOT;
"IF" F < RESMIN[TERMPOINTER] "THEN" RESMIN[TERMPOINTER]:= F;
"IF" F > RESMAX[TERMPOINTER] "THEN" RESMAX[TERMPOINTER]:= F;
RESSUM[TERMPOINTER]:= RESSUM[TERMPOINTER] + F * REPEATS;
RESSQUARES[TERMPOINTER]:= RESSQUARES[TERMPOINTER] +
F * F * REPEATS; TERMPOINTER:= TERMPOINTER + 1; "GOTO" EXIT;
REP: REPEATSUM:= REPEATSUM + F;
"IF" F < RESMIN[RESCOUNTER] "THEN" RESMIN[RESCOUNTER]:= F;
"IF" F > RESMAX[RESCOUNTER] "THEN" RESMAX[RESCOUNTER]:= F;
REPEATSQUARES:= REPEATSQUARES + F * F; "GOTO" EXIT;
DEP: RESULTLIST[RESPOINTER,RESCOUNTER]:= REPEATSUM / REPEATROOT;
RESSUM[RESCOUNTER]:= RESSUM[RESCOUNTER] + REPEATSUM;
RESSQUARES[RESCOUNTER]:= RESSQUARES[RESCOUNTER] +
REPEATSQUARES; TERMPOINTER:= 1; "GOTO" EXIT;
TEST: "IF" LEFTPOINTER < 1 "THEN"
"BEGIN" BLOCK FROM ECS(LEFT DATA, LEFTPAGE, 1, LEFTCOUNTER);
LEFTPOINTER:= MAXNUM
"END";
F:= LEFT DATA[LEFTPOINTER,1];
"FOR" I:= 2 "STEP" 1 "UNTIL" LEFTCOUNTER "DO"
"BEGIN" CHECK:= LEFT DATA[LEFTPOINTER,I];
"IF" F "NOTEQUAL" CHECK "THEN" ERROR TWO(213, F, CHECK)
"END"; LEFTPOINTER:= LEFTPOINTER - 1;
INIT: "IF" RESPOINTER >= MAXNUM "THEN"
"BEGIN" BLOCK TO ECS(RESULTLIST, RESPAGE, 1, REPCOUNTER);
RESPOINTER:= 1
"END" "ELSE" RESPOINTER:= RESPOINTER + 1;
STACK[STACKPOINTER]:= F; REPEATS:= F; REPEATROOT:= SQRT(F);
STACKPOINTER:= STACKPOINTER + 1; REPEATSUM:= REPEATSQUARES:= 0;
LEFTSIZE:= LEFTSIZE + REPEATS;
RESULTLIST[RESPOINTER,REPCOUNTER]:= REPEATROOT;
FRS: "IF" RIGHTPOINTER < 1 "THEN"
"BEGIN" BLOCK FROM ECS(RIGHT DATA, RIGHTPAGE, 1, RIGHTCOUNTER);
RIGHTPOINTER:= MAXNUM
"END"; "FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTCOUNTER "DO"
STACK[RIGHTVALREF[I]]:= RIGHT DATA[RIGHTPOINTER,I];
RIGHTPOINTER:= RIGHTPOINTER - 1; "GOTO" EXIT;
FLS: "IF" LEFTPOINTER < 1 "THEN"
"BEGIN" BLOCK FROM ECS(LEFT DATA, LEFTPAGE, 1, LEFTCOUNTER);
LEFTPOINTER:= MAXNUM
"END"; "FOR" I:= 1 "STEP" 1 "UNTIL" LEFTCOUNTER "DO"
STACK[LEFTVALREF[I]]:= LEFT DATA[LEFTPOINTER,I];
LEFTPOINTER:= LEFTPOINTER - 1; "GOTO" EXIT;
TCV: F:= CONSTANTLIST[ADDRESS]; "GOTO" EXIT;
TAV: F:= STACK[ADDRESS]; "GOTO" EXIT;
RAV: COL:= STACK[ADDRESS]; RIGHTSIZE[COL]:= RIGHTSIZE[COL] + 1;
ROW:= RIGHTROW[COL]; "IF" ROW > MAXNUM "THEN"
"BEGIN" COLUMN TO ECS(RIGHT DATA, COL, RIGHTPAGE[COL]);
ROW:= 1
"END"; RIGHT DATA[ROW, COL]:= NEXTNUMBER;
RIGHTROW[COL]:= ROW + 1; "GOTO" EXIT;
SAV: STACK[ADDRESS]:= NEXTNUMBER; "GOTO" EXIT;
LAV: COL:= STACK[ADDRESS]; LEFTDEPTH[COL]:= LEFTDEPTH[COL] + 1;
ROW:= LEFTROW[COL]; "IF" ROW > MAXNUM "THEN"
"BEGIN" COLUMN TO ECS(LEFT DATA, COL, LEFTPAGE[COL]);
ROW:= 1
"END"; LEFT DATA[ROW, COL]:= NEXTNUMBER;
LEFTROW[COL]:= ROW + 1; "GOTO" EXIT;
RET: F:= STACK[STACKPOINTER - 1] - 1; "IF" F > PRECISION "THEN"
"BEGIN" STACK[STACKPOINTER - 1]:= F; ORDERCOUNTER:= ADDRESS
"END" "ELSE" STACKPOINTER:= STACKPOINTER - 1; "GOTO" EXIT;
JMP: "IF" ENTIER(F) < F "THEN" ERROR TWO(214, F, RESPOINTER);
"IF" F < PRECISION "THEN" ORDERCOUNTER:= ADDRESS; "GOTO" EXIT;
FIX: "FOR" I:= ADDRESS "STEP" 1 "UNTIL" ORDERCOUNTER - 2 "DO"
"BEGIN" ORDER:= ORDERLIST[I]; ADDRESS:= ORDER // 100;
"IF" ORDER - ADDRESS * 100 = 5 "THEN"
"BEGIN" COL:= STACK[ADDRESS]; ROW:= LEFTROW[COL];
"IF" ROW > MAXNUM "THEN"
"BEGIN" COLUMN TO ECS(LEFT DATA, COL, LEFTPAGE[COL]);
ROW:= 1
"END"; LEFT DATA[ROW,COL]:= LEFTDEPTH[COL];
LEFTDEPTH[COL]:= 0; LEFTROW[COL]:= ROW + 1
"END"
"END"; "GOTO" EXIT;
SKP: LISTPOINTER:= LISTPOINTER + ADDRESS * F;
"IF" LISTPOINTER <= MAXNUM "THEN" "GOTO" EXIT;
J:= LISTPOINTER // MAXNUM;
"FOR" I:= 1 "STEP" 1 "UNTIL" J - 1 "DO" LASTPAGE:=
PAGETABLE[LASTPAGE]; PAGE FROM ECS(DATALIST, LASTPAGE);
LISTPOINTER:= LISTPOINTER - J * MAXNUM; "GOTO" EXIT;
FUN: "BEGIN" "SWITCH" FUNCTION:= FABS, FSIGN, FSQRT, FSIN, FCOS,
FARCT, FLN, FEXP, FENT, FMIN, FMAX, FARCS;
"GOTO" FUNCTION[ADDRESS];
FABS: F:= ABS(F); "GOTO" EXIT;
FSIGN: F:= SIGN(F); "GOTO" EXIT;
FSQRT: "IF" F < 0 "THEN" ERROR TWO(204, F, RESPOINTER);
F:= SQRT(F); "GOTO" EXIT;
FSIN: F:= SIN(F); "GOTO" EXIT;
FCOS: F:= COS(F); "GOTO" EXIT;
FARCT: F:= ARCTAN(F); "GOTO" EXIT;
FLN: "IF" F <= 0 "THEN" ERROR TWO(205, F, RESPOINTER);
F:= LN(F); "GOTO" EXIT;
FEXP: F:= EXP(F); "GOTO" EXIT;
FENT: F:= ENTIER(F); "GOTO" EXIT;
FMIN: STACKPOINTER:= STACKPOINTER - 1;
G:= STACK[STACKPOINTER];
"IF" F > G "THEN" F:= G; "GOTO" EXIT;
FMAX: STACKPOINTER:= STACKPOINTER - 1;
G:= STACK[STACKPOINTER];
"IF" F < G "THEN" F:= G; "GOTO" EXIT;
FARCS: "IF" ABS(F) > 1 "THEN" ERROR TWO(206, F, RESPOINTER);
F:= ARCTAN(F / SQRT(1 - F * F))
"END";
EXIT: "IF" ORDERCOUNTER <= ORDERS "THEN" "GOTO" NEXT
"END";
"PROCEDURE" ENDRUN;
"BEGIN" "INTEGER" I;
"FOR" I:= 1 "STEP" 1 "UNTIL" REPCOUNTER "DO"
RETURN CHAIN (RESPAGE[I]);
"FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTCOUNTER "DO"
RETURN CHAIN (RIGHTPAGE[I]);
"FOR" I:= 1 "STEP" 1 "UNTIL" LEFTCOUNTER "DO"
RETURN CHAIN (LEFTPAGE[I])
"END";
"PROCEDURE" INITIALIZE BUFFERS;
"BEGIN" "INTEGER" I;
"FOR" I:= 1 "STEP" 1 "UNTIL" LEFTCOUNTER "DO"
"BEGIN" LEFTROW[I]:= 1; LEFTDEPTH[I]:= 0;
LEFTPAGE[I]:= CHAINEND
"END";
"FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTCOUNTER "DO"
"BEGIN" RIGHTROW[I]:= 1; RIGHTSIZE[I]:= 0;
RIGHTPAGE[I]:= CHAINEND
"END";
"FOR" I:= 1 "STEP" 1 "UNTIL" RESCOUNTER "DO"
"BEGIN" RESSUM[I]:= RESSQUARES[I]:= 0;
RESMIN[I]:= MAXREAL; RESMAX[I]:= - MAXREAL;
RESPAGE[I]:= CHAINEND
"END"; RESPAGE[REPCOUNTER]:= CHAINEND
"END";
INITIALIZE BUFFERS;
CHECK MODEL; EXECUTE(INPUTORDERS);
CHECK INPUT; EXECUTE(MODELORDERS)
"END" INPUT SYSTEM;
"BEGIN" "COMMENT" MULTIPLE LINEAR REGRESSION ANALYSIS;
"INTEGER" I, J, PJ, LOW, UPP, MAX, PAGENR, PARTNR, MINTERM,
DFTOTAL, DFREG, DFRES, DFLACK, DFERROR, DFRED, SAVEDF,
SAVEPOINTER, CONSTTERM, SUBMODEL, NOTPROCESSED, SUBPOINTER;
"REAL" CORRELATION, OBSERVATION, FITTEDVALUE, RESIDUAL, STUDRES,
RESIDUALSUM, STANDDEV, STANDRES, SQRTMSRES, SAVESS, SAVEMS,
SSTOTAL, SSMEAN, SSREG, SSRES, SSLACK, SSERROR, SSRED, FRPAR,
MSREG, MSRES, MSLACK, MSERROR, MSRED, FRREG, FRLACK, FRRED,
EXPLAINED, ADJUSTED, RESSUMJ, RESDEVJ, DATAJJ;
"BOOLEAN" CONSTANT, MORECONSTANTS, DEPVARCONSTANT, SUBSELECTION;
"INTEGER" "ARRAY" SAVEPAGE[1:REPCOUNTER], PIV[1:TERMCOUNTER];
"REAL" "ARRAY" DATA[1:RIGHTSIZE1,1:REPCOUNTER],
DEPVAR[1:RIGHTSIZE1], RESPROD[1:RESCOUNTER],
AID[1:TERMCOUNTER], AUX[2:5];
"PROCEDURE" PRINTNAME(N); "VALUE" N; "INTEGER" N;
"IF" N = RESCOUNTER "THEN" OUTPUT(64,"(""("DEP.VAR.")"")")
"ELSE" PRINTWORD(NAMELIST[NAMELIST[PARREF[N]]]);
"PROCEDURE" HEADING;
"BEGIN" "INTEGER" J; TABULATE(12);
"FOR" J:= LOW "STEP" 1 "UNTIL" UPP "DO"
"BEGIN" PRINTNAME(J); TABULATE(PRINTPOS // 12 * 12 + 12) "END";
OUTPUT(64,"("/")")
"END";
"PROCEDURE" NEWPART(TEXT); "STRING" TEXT;
"BEGIN" "IF" LINENUMBER > 49 - RESCOUNTER + LOW "THEN"
OUTPUT(64,"("*")") "ELSE" OUTPUT(64,"("4/")");
OUTPUT(64,"("/,"("CORRELATION MATRIX OF THE ")",N")",TEXT);
"IF" TERMCOUNTER > 10 "AND" RESCOUNTER > 10 "THEN"
"BEGIN" PARTNR:= PARTNR + 1;
OUTPUT(64,"(""(" - PART")",ZZD")",PARTNR)
"END"; OUTPUT(64,"("/,35("("=")"),//")"); HEADING
"END";
"PROCEDURE" NEWPAGE1;
"BEGIN" OUTPUT(64,"("*,"("TRANSFORMED DATA MATRIX")"")");
"IF" RIGHTSIZE1 > 50 "OR" RESCOUNTER > 10 "THEN"
"BEGIN" PAGENR:= PAGENR + 1;
OUTPUT(64,"(""(" - PAGE")",ZZD")",PAGENR)
"END";
OUTPUT(64,"("/,23("("=")"),//,"("OBS.NO.")"")"); HEADING
"END";
"PROCEDURE" NEWPAGE2;
"BEGIN" OUTPUT(64,"("*,"("RESIDUAL ANALYSIS")"")");
"IF" RIGHTSIZE1 > 50 "THEN"
"BEGIN" PAGENR:= PAGENR + 1;
OUTPUT(64,"(""(" - PAGE")",ZZD")",PAGENR)
"END"; OUTPUT(64,"("/,17("("=")"),
/,94B,"("STANDARDIZED")",9B,"("STUDENTIZED")",
/,"("OBS.NO. OBSERVATION FITTED VALUE")",
4B,"("STANDARD DEVIATION")",3(10B,"("RESIDUAL ")"),/")")
"END";
"REAL" "PROCEDURE" PHI(X); "VALUE" X; "REAL" X;
"BEGIN" "REAL" Y, Z, W; Y:= ABS(X) / 2;
"IF" Y >= 3 "THEN" Z:= 1 "ELSE" "IF" Y < 1 "THEN"
"BEGIN" W:= Y * Y;
Z:= (((((((( 0.000124818987 * W
- 0.001075204047) * W + 0.005198775019) * W
- 0.019198292004) * W + 0.059054035642) * W
- 0.151968751364) * W + 0.319152932694) * W
- 0.531923007300) * W + 0.797884560593) * Y * 2
"END" "ELSE"
"BEGIN" Y:= Y - 2;
Z:= ((((((((((((( - 0.000045255659 * Y
+ 0.000152529290) * Y - 0.000019538132) * Y
- 0.000676904986) * Y + 0.001390604284) * Y
- 0.000794620820) * Y - 0.002034254874) * Y
+ 0.006549791214) * Y - 0.010557625006) * Y
+ 0.011630447319) * Y - 0.009279453341) * Y
+ 0.005353579108) * Y - 0.002141268741) * Y
+ 0.000535310849) * Y + 0.999936657524
"END";
PHI:= "IF" X > 0 "THEN" (Z + 1) / 2 "ELSE" (1 - Z) / 2
"END";
"REAL" "PROCEDURE" FISHER(X, DF1, DF2);
"VALUE" X, DF1, DF2; "REAL" X; "INTEGER" DF1, DF2;
"IF" DF1 > 1000 "AND" DF2 > 1000 "THEN"
FISHER:= PHI((X ** (1/3) * (1 - 2/DF2/9) + 2/DF1/9 - 1) /
SQRT(X ** (2/3) * 2/DF2/9 + 2/DF1/9)) "ELSE"
"BEGIN" "INTEGER" A, B, I, J; "REAL" W, Y, Z, ZK, D, P;
A:= DF1 // 2 * 2 - DF1 + 2; B:= DF2 // 2 * 2 - DF2 + 2;
W:= X * DF1 / DF2; Z:= 1 / (1 + W);
"IF" A = 1 "THEN"
"BEGIN" "IF" B = 1 "THEN"
"BEGIN" P:= SQRT(W); Y:= 0.318309886184;
D:= Y * Z / P; P:= ARCTAN(P) * 2 * Y
"END" "ELSE"
"BEGIN" P:= SQRT(W * Z); D:= 0.5 * P * Z / W "END"
"END" "ELSE"
"IF" B = 1 "THEN"
"BEGIN" P:= SQRT(Z); D:= 0.5 * Z * P; P:= 1 - P "END"
"ELSE" "BEGIN" D:= Z * Z; P:= W * Z "END";
Y:= 2 * W / Z;
"IF" A = 1 "THEN"
"BEGIN" "FOR" J:= B + 2 "STEP" 2 "UNTIL" DF2 "DO"
"BEGIN" D:= (A / (J - 2) + 1) * D * Z;
P:= D * Y / (J - 1) + P
"END"
"END" "ELSE"
"BEGIN" ZK:= Z ** ((DF2 - 1) // 2); D:= D * ZK * DF2 / B;
P:= P * ZK + W * Z * (ZK - 1) / (Z - 1)
"END";
Y:= W * Z; Z:= 2 / Z; B:= DF2 - 2;
"FOR" I:= A + 2 "STEP" 2 "UNTIL" DF1 "DO"
"BEGIN" J:= I + B; D:= Y * D * J / (I - 2);
P:= P - Z * D / J
"END";
FISHER:= "IF" P < 0 "THEN" 0 "ELSE" "IF" P > 1 "THEN" 1 "ELSE" P
"END";
"REAL" "PROCEDURE" VECVEC(L, U, S, A, B); "CODE" 34010;
"REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011;
"REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012;
"REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "CODE" 34013;
"REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014;
"PROCEDURE" LSQORTDEC(A, N, M, AUX, AID, PIV); "CODE" 34134;
"PROCEDURE" LSQSOL(A, N, M, AID, PIV, B); "CODE" 34131;
"PROCEDURE" LSQINV(A, M, AID, PIV); "CODE" 34136;
"PROCEDURE" ENDRUN;
"BEGIN" "INTEGER" I; "IF" "NOT" RETURN "THEN"
"FOR" I:= 1 "STEP" 1 "UNTIL" REPCOUNTER "DO"
RETURN CHAIN(SAVEPAGE[I])
"END";
"PROCEDURE" NEXT RESULTLIST BLOCK;
"BEGIN" BLOCK FROM ECS(RESULTLIST, RESPAGE, 1, TERMCOUNTER);
BLOCK FROM ECS(RESULTLIST, RESPAGE, RESCOUNTER, REPCOUNTER)
"END";
"PROCEDURE" RESTORE RESULTLIST;
"BEGIN" "FOR" J:= 1 "STEP" 1 "UNTIL" REPCOUNTER "DO"
RESPAGE[J]:= SAVEPAGE[J]; RESPOINTER:= SAVEPOINTER;
NEXT RESULTLIST BLOCK
"END";
"IF" OPTION WANTED[3] "OR" OPTION WANTED[7] "THEN"
"BEGIN" "FOR" J:= 1 "STEP" 1 "UNTIL" REPCOUNTER "DO"
SAVEPAGE[J]:= RESPAGE[J]; SAVEPOINTER:= RESPOINTER;
BLOCK TO ECS(RESULTLIST, SAVEPAGE, 1, REPCOUNTER);
RETURN:= "FALSE"
"END"; SUBMODEL:= NOTPROCESSED:= 0;
SUBPOINTER:= MAXCON + 1; SUBSELECTION:= SUBMAXCON < MAXCON;
PROCESS SUBMODEL:
"FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTSIZE1 "DO"
"BEGIN" "IF" RESPOINTER < 1 "THEN"
"BEGIN" NEXT RESULTLIST BLOCK; RESPOINTER:= MAXNUM "END";
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER, REPCOUNTER "DO"
DATA[I,J]:= RESULTLIST[RESPOINTER,J]; J:= RESCOUNTER;
DATA[I,J]:= DEPVAR[I]:= RESULTLIST[RESPOINTER,J];
RESPOINTER:= RESPOINTER - 1
"END";
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER, RESCOUNTER "DO"
RESPROD[J]:= TAMVEC(1, RIGHTSIZE1, J, DATA, DEPVAR);
"IF" OPTION WANTED[1] "AND" SUBMODEL = 0 "THEN"
"BEGIN" "IF" OPTION WANTED[6] "THEN"
"BEGIN" OUTPUT(66,"("N")", RIGHTSIZE1, RESCOUNTER);
"FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTSIZE1 "DO"
"BEGIN" REPEATROOT:= DATA[I,REPCOUNTER];
"FOR" J:= 1 "STEP" 1 "UNTIL" RESCOUNTER "DO"
OUTREAL(66, DATA[I,J] / REPEATROOT)
"END"
"END";
PAGENR:= 0; UPP:= 0;
"FOR" LOW:= UPP + 1 "WHILE" UPP < RESCOUNTER "DO"
"BEGIN" UPP:= "IF" RESCOUNTER - LOW > 9 "THEN" LOW + 9
"ELSE" RESCOUNTER; NEWPAGE1;
"FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTSIZE1 "DO"
"BEGIN" OUTPUT(64,"("/,-4ZD2B")",I);
REPEATROOT:= DATA[I,REPCOUNTER];
"FOR" J:= LOW "STEP" 1 "UNTIL" UPP "DO"
OUTPUT(64,"("-7Z.3D")",DATA[I,J] / REPEATROOT);
"IF" I//10*10 = I "AND" I < RIGHTSIZE1 "THEN"
"BEGIN" "IF" I//50*50 = I "THEN"
NEWPAGE1 "ELSE" OUTPUT(64,"("/")")
"END"
"END"
"END"
"END";
OUTPUT(64,"("*,"("CONTROL INFORMATION")"")");
"IF" SUBMODEL > 0 "THEN"
OUTPUT(64,"(""(" - SUBMODEL")",ZZD")", SUBMODEL);
OUTPUT(64,"("/,19("("=")"),//,"("TRANSFORMED VARIABLE")",
/,"("DENOTED BY PARAMETER MEAN")",
12B,"("STANDARD DEVIATION")",16B,
"("MINIMUM")",18B,"("MAXIMUM")",/")");
CONSTANT:= MORECONSTANTS:= DEPVARCONSTANT:= "FALSE"; CONSTTERM:= 0;
"FOR" J:= TERMCOUNTER + 1 "STEP" 1 "UNTIL" RESCOUNTER - 1 "DO"
"BEGIN" OUTPUT(64,"("/,B")"); PRINTNAME(J); TABULATE(13);
OUTPUT(64,"(""("OMITTED")"")")
"END"; "IF" SUBMODEL > 0 "THEN" OUTPUT(64,"("/")");
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER, RESCOUNTER "DO"
"BEGIN" OUTPUT(64,"("/,B")"); PRINTNAME(J); TABULATE(10);
STANDDEV:= SQRT((RESSQUARES[J] -
RESSUM[J] ** 2 / LEFTSIZE) / (LEFTSIZE - 1));
OUTPUT(64,"("2(-17Z.6DB),2(-16Z.6DB)")",
RESSUM[J] / LEFTSIZE, STANDDEV, RESMIN[J], RESMAX[J]);
"IF" STANDDEV < PRECISION "THEN"
"BEGIN" MORECONSTANTS:= CONSTANT; CONSTANT:= "TRUE";
DEPVARCONSTANT:= J = RESCOUNTER; CONSTTERM:= J
"END"
"END"; MINTERM:= "IF" CONSTTERM = 1 "THEN" 2 "ELSE" 1;
"IF" OPTION WANTED[2] "AND" SUBMODEL = 0 "THEN"
"BEGIN" "REAL" "ARRAY" RESDEV[1:RESCOUNTER],
CORREL[1:(RESCOUNTER + 1) * RESCOUNTER // 2];
"FOR" J:= 1 "STEP" 1 "UNTIL" RESCOUNTER "DO"
"BEGIN" RESSUMJ:= RESSUM[J]; RESDEVJ:= RESDEV[J]:=
SQRT(RESSQUARES[J] * LEFTSIZE - RESSUMJ * RESSUMJ);
PJ:= (J - 1) * J // 2; CORREL[PJ + J]:= 1;
"FOR" I:= J - 1 "STEP" - 1 "UNTIL" 1 "DO"
CORREL[PJ + I]:= "IF" RESDEV[I] * RESDEVJ < PRECISION
"THEN" 2 "ELSE" (TAMMAT(1, RIGHTSIZE1, I, J, DATA, DATA)
* LEFTSIZE - RESSUM[I] * RESSUMJ) / (RESDEV[I] * RESDEVJ)
"END";
"IF" OPTION WANTED[6] "THEN"
"BEGIN" OUTREAL(66, RESCOUNTER); OUTARRAY(66, CORREL) "END";
PARTNR:= 0; UPP:= 0;
"FOR" LOW:= UPP + 1 "WHILE" UPP < RESCOUNTER "DO"
"BEGIN" UPP:= "IF" RESCOUNTER - LOW > 9 "THEN" LOW + 9
"ELSE" RESCOUNTER; NEWPART("("VARIABLES")");
"FOR" J:= LOW "STEP" 1 "UNTIL" RESCOUNTER "DO"
"BEGIN" OUTPUT(64,"("/,B")"); PRINTNAME(J); TABULATE(10);
PJ:= (J - 1) * J // 2;
MAX:= "IF" J < UPP "THEN" J "ELSE" UPP;
"FOR" I:= LOW "STEP" 1 "UNTIL" MAX "DO"
"BEGIN" CORRELATION:= CORREL[PJ + I];
"IF" ABS(CORRELATION) < 1.0000005 "THEN"
OUTPUT(64,"("-2Z.6D2B")",CORRELATION) "ELSE"
OUTPUT(64,"(""(" * ")"")")
"END"
"END"
"END"
"END";
"IF" OPTION WANTED[4] "OR" MORECONSTANTS "OR" DEPVARCONSTANT
"OR" RIGHTSIZE1 <= TERMCOUNTER "THEN"
"BEGIN" OUTPUT(64,"("5/,"("NO REGRESSION ANALYSIS")"")");
"IF" OPTION WANTED[4] "THEN" OUTPUT(64,"(""(" BY OPTION")"")");
"IF" MORECONSTANTS "THEN" OUTPUT(64,"("//,
"("THERE ARE SEVERAL CONSTANT TERMS IN THE MODEL")"")");
"IF" DEPVARCONSTANT "THEN" OUTPUT(64,"("//,
"("THE DEPENDENT VARIABLE IN THE MODEL IS CONSTANT")"")");
"IF" RIGHTSIZE1 <= TERMCOUNTER "THEN" OUTPUT(64,"("//,
"("THE NUMBER OF RESPONDENTS IS LESS THAN ")",
"("OR EQUAL TO THE NUMBER OF TERMS IN THE MODEL")"")");
ENDRUN; "GOTO" END OF JOB
"END";
AUX[2]:= PRECISION;
LSQORTDEC(DATA, RIGHTSIZE1, TERMCOUNTER, AUX, AID, PIV);
"IF" AUX[3] < TERMCOUNTER "THEN"
"BEGIN" OUTPUT(64,"("5/,"("NO REGRESSION ANALYSIS")",//,
"("THE RANK OF THE DESIGN MATRIX IS")",ZDB,
"("LESS THAN THE NUMBER OF TERMS IN THE MODEL")"")",
TERMCOUNTER - AUX[3]); ENDRUN; "GOTO" END OF JOB
"END" "ELSE"
"BEGIN" LSQSOL(DATA, RIGHTSIZE1, TERMCOUNTER, AID, PIV, DEPVAR);
LSQINV(DATA, TERMCOUNTER, AID, PIV)
"END";
DFTOTAL:= LEFTSIZE; SSTOTAL:= RESSQUARES[RESCOUNTER];
DFREG:= TERMCOUNTER; SSREG:= VECVEC(1,TERMCOUNTER,0,DEPVAR,RESPROD);
DFRES:= DFTOTAL - DFREG; SSRES:= SSTOTAL - SSREG;
SSMEAN:= RESSUM[RESCOUNTER] ** 2 / DFTOTAL; "IF" CONSTANT "THEN"
"BEGIN" DFREG:= DFREG - 1; SSREG:= SSREG - SSMEAN "END";
MSREG:= SSREG / DFREG; MSRES:= SSRES / DFRES; FRREG:= MSREG / MSRES;
DFERROR:= DFTOTAL - RIGHTSIZE1; "IF" DFERROR > 0 "THEN"
"BEGIN" SSERROR:= SSTOTAL - RESPROD[RESCOUNTER];
DFLACK:= DFRES - DFERROR; SSLACK:= SSRES - SSERROR;
MSLACK:= SSLACK / DFLACK; MSERROR:= SSERROR / DFERROR;
FRLACK:= MSLACK / MSERROR
"END"; EXPLAINED:= 1 - SSRES / (SSTOTAL - SSMEAN);
ADJUSTED:= 1 - SSRES / (SSTOTAL - SSMEAN) * (DFTOTAL - 1) / DFRES;
"IF" ADJUSTED >= 0 "THEN"
OUTPUT(64,"("6/,"("MULTIPLE CORRELATION COEFFICIENT")",-4Z.6D,
4B,"("(ADJUSTED")",-3Z.6D,"(")")",/,32("("=")")")",
SQRT(EXPLAINED), SQRT(ADJUSTED));
OUTPUT(64,"("6/,"("PROPORTION OF VARIATION EXPLAINED")",-3Z.6D,
4B,"("(ADJUSTED")",-3Z.6D,"(")")",/,33("("=")")")",
EXPLAINED, ADJUSTED);
OUTPUT(64,"("6/,"("STANDARD DEVIATION OF THE ERROR TERM")",
-13Z.6D,/,36("("=")")")", SQRT(MSRES));
"IF" "NOT" CONSTANT "THEN" OUTPUT(64,"("6/,
"("THERE IS NO CONSTANT TERM IN THIS (SUB)MODEL (MESSAGE)")"")");
OUTPUT(64,"("*,"("REGRESSION PARAMETERS")",/,21("("=")"),
/,100B,"("RIGHT TAIL")",/,"("PARAMETER")",16B,
"("ESTIMATE")",12B,"("STANDARD DEVIATION")",
14B,"("F - RATIO")",14B,"("PROBABILITY")"")");
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER "DO"
"BEGIN" OUTPUT(64,"("//,B")"); PRINTNAME(J); TABULATE(10);
STANDDEV:= SQRT(DATA[J,J] * MSRES);
FRPAR:= DEPVAR[J] ** 2 / DATA[J,J] / MSRES;
OUTPUT(64,"("2(-11Z.12DB),2(-16Z.6DB)")",
DEPVAR[J], STANDDEV, FRPAR, 1 - FISHER(FRPAR,1,DFRES))
"END";
"IF" OPTION WANTED[6] "AND" SUBMODEL = 0 "AND"
(OPTION WANTED[2] "OR" OPTION WANTED[3]) "THEN"
OUTREAL(66, MAXCON - SUBMAXCON + 1);
"IF" OPTION WANTED[2] "AND" (SUBMODEL = 0 "OR" SUBSELECTION) "THEN"
"BEGIN" "IF" OPTION WANTED[6] "THEN"
"BEGIN" OUTREAL(66, TERMCOUNTER);
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER "DO"
"FOR" I:= 1 "STEP" 1 "UNTIL" J "DO" OUTREAL(66, DATA[I,J])
"END";
PARTNR:= 0; UPP:= 0;
"FOR" LOW:= UPP + 1 "WHILE" UPP < TERMCOUNTER "DO"
"BEGIN" UPP:= "IF" TERMCOUNTER - LOW > 9 "THEN" LOW + 9
"ELSE" TERMCOUNTER; NEWPART("("ESTIMATES")");
"FOR" J:= LOW "STEP" 1 "UNTIL" TERMCOUNTER "DO"
"BEGIN" OUTPUT(64,"("/,B")"); PRINTNAME(J); TABULATE(10);
DATAJJ:= DATA[J,J];
MAX:= "IF" J < UPP "THEN" J "ELSE" UPP;
"FOR" I:= LOW "STEP" 1 "UNTIL" MAX "DO"
OUTPUT(64,"("-2Z.6D2B")",
DATA[I,J] / SQRT(DATA[I,I] * DATAJJ))
"END"
"END"
"END";
"IF" LINENUMBER > 35 "THEN"
OUTPUT(64,"("*")") "ELSE" OUTPUT(64,"("4/")");
OUTPUT(64,"("/,"("ANALYSIS OF VARIANCE TABLE")",
/,26("("=")"),/,100B,"("RIGHT TAIL")",
/,"("SOURCE")",19B,"("DF SUM OF SQUARES")",10B,
"("MEAN SQUARE F - RATIO")",10B,
"("PROBABILITY")",//,111("("-")"),/,
/,"("TOTAL (UNCORRECTED) ")",-4ZDB,-12Z.6DB")",
DFTOTAL, SSTOTAL);
"IF" CONSTANT "THEN"
OUTPUT(64,"("/,"("MEAN ")",-4ZDB,-12Z.6DB,
/,"("TOTAL (CORRECTED) ")",-4ZDB,-12Z.6DB")",
1, SSMEAN, DFTOTAL-1, SSTOTAL-SSMEAN);
OUTPUT(64,"("/,"("REGRESSION ")",-4ZDB,4(-12Z.6DB),
/,"("RESIDUAL ")",-4ZDB,2(-12Z.6DB),/,
/,111("("-")"),/")",
DFREG,SSREG,MSREG,FRREG,1-FISHER(FRREG,DFREG,DFRES),
DFRES,SSRES,MSRES);
"IF" DFERROR > 0 "THEN"
OUTPUT(64,"("/,"(" LACK OF FIT ")",-4ZDB,4(-12Z.6DB),
/,"(" PURE ERROR ")",-4ZDB,2(-12Z.6DB),/,
/,111("("-")"),/")",
DFLACK,SSLACK,MSLACK,FRLACK,1-FISHER(FRLACK,DFLACK,DFERROR),
DFERROR,SSERROR,MSERROR);
"IF" OPTION WANTED[7] "THEN"
"BEGIN" "IF" SUBMODEL = 0 "THEN"
"BEGIN" SAVEDF:= DFRES; SAVESS:= SSRES; SAVEMS:= MSRES "END"
"ELSE"
"BEGIN" "IF" LINENUMBER > 55 "THEN" OUTPUT(64,"("*")");
DFRED:= DFRES - SAVEDF; SSRED:= SSRES - SAVESS;
MSRED:= SSRED / DFRED; FRRED:= MSRED / SAVEMS;
OUTPUT(64,"("/,"(" REDUCTION")",11B,-4ZDB,4(-12Z.6DB),/,
/,111("("-")"),/")",
DFRED,SSRED,MSRED,FRRED,1-FISHER(FRRED,DFRED,SAVEDF))
"END"
"END";
OUTPUT(64,"("//,"("REGRESSION NULL HYPOTHESIS : ")"")");
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER "DO"
"BEGIN" "IF" J "NOTEQUAL" CONSTTERM "THEN"
"BEGIN" PRINTNAME(J); OUTPUT(64,"(""(" = ")"")") "END";
"IF" J//8*8=J "AND" J<TERMCOUNTER "THEN" OUTPUT(64,"("/,30B")")
"END"; OUTPUT(64,"(""("0")"")"); "IF" SUBMODEL > 0 "THEN"
OUTPUT(64,"(""(" (IN THE REDUCED MODEL)")"")");
"IF" OPTION WANTED[7] "AND" SUBMODEL > 0 "THEN"
"BEGIN" OUTPUT(64,"("//,"(" REDUCTION NULL HYPOTHESIS : ")"")");
"FOR" J:= TERMCOUNTER + 1 "STEP" 1 "UNTIL" RESCOUNTER - 1 "DO"
"BEGIN" PRINTNAME(J); OUTPUT(64,"(""(" = ")"")");
I:= J - TERMCOUNTER; "IF" I//8*8 = I
"AND" J < RESCOUNTER - 1 "THEN" OUTPUT(64,"("/,30B")")
"END"; OUTPUT(64,"(""("0 (IN THE ORIGINAL MODEL)")"")")
"END";
"IF" OPTION WANTED[3] "AND" (SUBMODEL = 0 "OR" SUBSELECTION) "THEN"
"BEGIN" RESTORE RESULTLIST; RESIDUALSUM:= 0; PAGENR:= 0; NEWPAGE2;
SQRTMSRES:= SQRT(MSRES*(RIGHTSIZE1-TERMCOUNTER)/RIGHTSIZE1);
"FOR" I:= 2 "STEP" 1 "UNTIL" TERMCOUNTER "DO"
"FOR" J:= I - 1 "STEP" - 1 "UNTIL" 1 "DO" DATA[I,J]:= DATA[J,I];
"IF" OPTION WANTED[6] "THEN" OUTREAL(66, RIGHTSIZE1);
"FOR" I:= 1 "STEP" 1 "UNTIL" RIGHTSIZE1 "DO"
"BEGIN" "IF" RESPOINTER < 1 "THEN"
"BEGIN" NEXT RESULTLIST BLOCK; RESPOINTER:= MAXNUM "END";
REPEATROOT:= RESULTLIST[RESPOINTER,REPCOUNTER];
OBSERVATION:= RESULTLIST[RESPOINTER,RESCOUNTER]/REPEATROOT;
FITTEDVALUE:= MATVEC(1, TERMCOUNTER,
RESPOINTER, RESULTLIST, DEPVAR) / REPEATROOT;
"FOR" J:= 1 "STEP" 1 "UNTIL" TERMCOUNTER "DO"
RESPROD[J]:= MATMAT(1, TERMCOUNTER,
RESPOINTER, J, RESULTLIST, DATA);
STANDDEV:= SQRT(MATVEC(1, TERMCOUNTER,
RESPOINTER, RESULTLIST, RESPROD) * MSRES) / REPEATROOT;
RESIDUAL:= OBSERVATION - FITTEDVALUE;
STANDRES:= RESIDUAL / SQRTMSRES;
STUDRES:= RESIDUAL / SQRT(ABS(MSRES - STANDDEV*STANDDEV));
RESIDUALSUM:= RESIDUALSUM + RESIDUAL*REPEATROOT*REPEATROOT;
RESPOINTER:= RESPOINTER - 1;
OUTPUT(64,"("/,-4ZD,6(-12Z.6D)")", I,
OBSERVATION,FITTEDVALUE,STANDDEV,RESIDUAL,STANDRES,STUDRES);
"IF" I//10*10 = I "AND" I < RIGHTSIZE1 "THEN"
"BEGIN" "IF" I//50*50 = I "THEN"
NEWPAGE2 "ELSE" OUTPUT(64,"("/")")
"END";
"IF" OPTION WANTED[6] "THEN" OUTPUT(66,"("N")",
OBSERVATION,FITTEDVALUE,STANDDEV,RESIDUAL,STANDRES,STUDRES)
"END"; OUTPUT(64,
"("//,56B,"("SUM OF RESIDUALS")",-6Z.6D")",RESIDUALSUM)
"END";
"IF" OPTION WANTED[7] "THEN"
"BEGIN" "IF" "NOT" SUBSELECTION "THEN"
"BEGIN" SUBMODEL:= SUBMODEL + 1;
TERMCOUNTER:= TERMCOUNTER - 1;
"IF" TERMCOUNTER >= MINTERM "THEN"
"BEGIN" RESTORE RESULTLIST; "GOTO" PROCESS SUBMODEL "END"
"ELSE" NOTPROCESSED:= MINTERM - 1
"END" "ELSE"
"FOR" SUBPOINTER:= SUBPOINTER - 1
"WHILE" SUBMAXCON < SUBPOINTER "DO"
"BEGIN" SUBMODEL:= CONSTANTLIST[SUBPOINTER];
TERMCOUNTER:= RESCOUNTER - 1 - SUBMODEL;
"IF" TERMCOUNTER >= MINTERM "THEN"
"BEGIN" RESTORE RESULTLIST; "GOTO" PROCESS SUBMODEL "END"
"ELSE" NOTPROCESSED:= NOTPROCESSED + 1
"END"
"END";
"IF" NOTPROCESSED > 0 "THEN"
OUTPUT(64,"("6/,"("SUBMODELS WITH AS ONLY INDEPENDENT VARIABLE ")",
"("A CONSTANT TERM, ARE NOT PROCESSED (MESSAGE)")",
6/,"("NUMBER OF SUBMODELS NOT PROCESSED :")",ZZD")",
NOTPROCESSED);
"IF" OPTION WANTED[6] "AND"
(OPTION WANTED[1] "OR" OPTION WANTED[2] "OR" OPTION WANTED[3])
"THEN" "BEGIN" OUTPUT(66,"("/")"); BACKSPACE(66) "END";
ENDRUN
"END" "END" "END";
END OF JOB: OUTPUT(64,"("6/,"("END OF JOB")",*")"); "GOTO" JOB
"END";
EXIT: OUTPUT(64,"("6/,"("END OF USERS PROGRAM")",
6/,"("NUMBER OF RUNS :")",ZZD,
6/,"("END OF MULTREG")"")",RUNNUMBER)
"END"
MULTREG