Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/report.sim
There is 1 other file named report.sim in the archive. Click here to see a list.
00010 OPTIONS(/E);
00020 SIMULATION CLASS REPORT;
00030 BEGIN
00040 COMMENT------------- R E P O R T F A C I L I T I E S --------
00050 *
00060 * THIS CLASS CONTAINS THE DATA COLLECTING MECHANISMS
00070 * AND PRINTING ROUTINES. THE DEFINITIONS ARE:
00080 *
00090 * ACCUMULATE COUNT DIST HISTOGRAM TALLY
00100 *
00110 * ACCUMULATE COLLECTS TIME DEPENDENT DATA
00120 *
00130 * COUNT IS USED TO COUNT INCIDENCES ONLY
00140 *
00150 *
00160 * HISTOGRAM COLLECTS DATA IN HISTOGRAM FORM AND PRINTS THE
00170 * END RESULT AS A PICTURE
00180 *
00190 * TALLY COLLECTS TIME INDEPENDENT DATA
00200 *
00210 * ATTRIBUTES SHARED BY THESE DEFINITIONS :
00220 * RESET NOTE TIME AND RESET TO ZERO
00230 * UPDATE(V) RECORD NEW ENTRY V
00240 * REPORT PRINT CURRENT STATUS
00250 *
00260 * THESE CLASSES ARE PREFIXED BY 'TAB' WHICH CONTAINS
00270 * COMMON VARIABLES AND THE PARAMETER 'TITLE' WHICH NAMES
00280 * THE PARTICULAR OBJECT.
00290 * EVERY OBJECT OF A CLASS INNER TO TAB IS PUT INTO A 'REPORTQ'
00300 * BEHIND THE SCENES - HENCE THE PREFIX TO TAB OF 'LINK'.
00310 * THESE REPORTQS ARE SYSTEM DEFINED AND ARE CALLED
00320 *
00330 * ACCUMQ COUNTQ DIST(+EMP)Q HISTOQ TALLYQ
00340 *
00350 * ON A CALL 'REPORT', THE CURRENT STATUSES OF ALL THESE REPORTQS
00360 * ARE WRITTEN OUT.
00370 *
00380 * THE SET OF PREDEFINED DATA COLLECTION FACILITIES
00390 * IS EACH PREFIXED BY TAB ( AND HENCE LINK )
00400 *
00410 * LINK ENABLES THE SYSTEM TO QUEUE OBJECTS OF CLASSES
00420 * INNER TO TAB FOR AUTOMATIC REPORT GENERATION.
00430 *
00440 * TAB DEFINES THE COMMON CORE
00450 * TITLE USER SUPPLIED DESCRIPTIVE TEXT
00460 * N NO. OF ENTRIES
00470 * RESETAT TIME WHEN INITIATED , OR LAST RESET
00480 *
00490 *------------------------- T A B ----------------------------;
00500
00510 LINK CLASS TAB(TITLE); VALUE TITLE; TEXT TITLE;
00520 VIRTUAL : PROCEDURE RESET, REPORT;
00530 BEGIN INTEGER N; REAL RESETAT;
00540
00550 PROCEDURE ZYQWRITETRN;
00560 BEGIN ZYQT := TITLE;
00570 IF RESETAT < 99999.9999 THEN
00580 ZYQR.PUTFIX(RESETAT, 4) ELSE ZYQR.PUTREAL(RESETAT, 5);
00590 ZYQN.PUTINT(N);
00600 SYSOUT.SETPOS(30);
00610 END***ZYQREPORT TITLE, RESETAT AND READINGS***;
00620
00630 PROCEDURE SHORTPRINT;
00640 BEGIN
00650 OUTTEXT(TITLE);
00660 END***SHORTPRINT***;
00670
00680 IF TITLE.LENGTH > 12 THEN TITLE :- TITLE.SUB(1, 12);
00690 RESETAT := TIME;
00700 END*** TAB ***;
00710
00720
00730 COMMENT-------------------- T A L L Y -----------------------;
00740
00750 TAB CLASS TALLY;
00760 BEGIN COMMENT
00770 *
00780 * VARIABLES:
00790 * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER)
00800 * .N NUMBER OF INCIDENCES
00810 * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION
00820 * SUM SUM OF SAMPLE VALUES
00830 * SUMSQ SUM OF SQUARES OF SAMPLE VALUES
00840 * (VARIANCE)( N*SUMSQ - SUM*SUM)/(N*(N-1))
00850 * (SIGMA) SQRT(VARIANCE)
00860 * MIN LEAST SAMPLE VALUE
00870 * MAX LARGEST SAMPLE VALUE
00880 *
00890 * PROCEDURES :
00900 * RESET RESETS N, SUM, SUMSQ, MIN, MAX TO ZERO
00910 * COPIES TIME INTO RESETAT
00920 *
00930 * UPDATE(V) ADDS 1 TO N
00940 * ADDS V TO SUM
00950 * ADDS V*V TO SUMSQ
00960 * MAX BECOMES MAXIMUM (MAX,V)
00970 * MIN BECOMES MINIMUM (MIN,V)
00980 *
00990 * REPORT PRINTS ON ONE LINE:
01000 * TITLE / RESET / OBS / AV / EST.ST.DEV / MIN / MAX
01010 * ;
01020
01030 REAL SUM, SUMSQ, MIN, MAX;
01040
01050 PROCEDURE RESET;
01060 BEGIN N := 0;
01070 SUM := SUMSQ := MIN := MAX := 0.0;
01080 RESETAT := TIME;
01090 END***RESET***;
01100
01110 PROCEDURE UPDATE(V); REAL V;
01120 BEGIN N := N + 1;
01130 SUM := SUM + V;
01140 SUMSQ := SUMSQ + V**2;
01150 IF N = 1 THEN MIN := MAX := V ELSE
01160 IF V < MIN THEN MIN := V ELSE
01170 IF V > MAX THEN MAX := V;
01180 END*** UPDATE ***;
01190
01200 PROCEDURE REPORT;
01210 BEGIN ZYQWRITETRN;
01220 IF N = 0 THEN OUTTEXT(MINUSES40) ELSE
01230 BEGIN PRINTREAL(SUM/N);
01240 IF N = 1 THEN OUTTEXT(MINUSES10) ELSE
01250 PRINTREAL(SQRT(ABS(N*SUMSQ - SUM**2)/(N*(N-1))));
01260 PRINTREAL(MIN);
01270 PRINTREAL(MAX);
01280 END;
01290 OUTIMAGE;
01300 END***REPORT***;
01310
01320 INTO(TALLYQ);
01330 END*** TALLY ***;
01340
01350
01360 COMMENT------------------ C O U N T -------------------------;
01370
01380 TAB CLASS COUNT;
01390 BEGIN COMMENT
01400 *
01410 * VARIABLES :
01420 * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER)
01430 * .N NUMBER OF INCIDENCES
01440 * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION
01450 *
01460 * PROCEDURES :
01470 * RESET RESETS N TO ZERO
01480 * COPIES TIME INTO RESETAT
01490 *
01500 * UPDATE(V) ADDS V TO N
01510 *
01520 * REPORT PRINTS ON ONE LINE:
01530 * TITLE/RESET/READINGS
01540 * ;
01550
01560 PROCEDURE RESET;
01570 BEGIN N := 0;
01580 RESETAT := TIME;
01590 END***RESET***;
01600
01610 PROCEDURE UPDATE(V); INTEGER V;
01620 BEGIN
01630 N := N + V;
01640 END***UPDATE***;
01650
01660 PROCEDURE REPORT;
01670 BEGIN ZYQWRITETRN;
01680 OUTIMAGE;
01690 END***REPORT***;
01700
01710 INTO(COUNTQ);
01720 END***COUNT***;
01730
01740
01750 COMMENT-------------------- A C C U M U L A T E -------------;
01760
01770 TAB CLASS ACCUMULATE;
01780 BEGIN COMMENT
01790 *
01800 * VARIABLES : **** TIME WEIGHTED ****
01810 * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER)
01820 * .N NUMBER OF INCIDENCES
01830 * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION
01840 * SUMT TIME WEIGHTED SUM
01850 * SUMSQT TIME WEIGHTED SUM OF SQUARES
01860 * (MEAN) SUM / TIMESPAN=( LAST UPDATE TIME - RESETAT )
01870 * (SIGMA) SQRT( SUMSQT / TIMESPAN - MEAN**2)
01880 * MIN LEAST SAMPLE VALUE
01890 * MAX LARGEST SAMPLE VALUE
01900 * LASTTIME TIME OF LAST UPDATE
01910 * LASTV LAST UPDATE VALUE
01920 *
01930 * PROCEDURES :
01940 * RESET RESETS N, SUM, SUMSQT, MIN, MAX TO ZERO
01950 * COPIES TIME INTO RESETAT, LASTTIME
01960 *
01970 * UPDATE(V) ADDS 1 TO N
01980 * ADDS V*SPAN TO SUMT
01990 * ADDS V*V*SPAN TO SUMSQT
02000 * MIN BECOMES MINIMUM( MIN, V)
02010 * MAX BECOMES MAXIMUM( MAX, V)
02020 * COPIES TIME INTO LASTTIME
02030 *
02040 * REPORT PRINTS ON ONE LINE:
02050 * TITLE/RESET/OBS/AVERAGE/EST.ST.DEV./MIN/MAX
02060 * ;
02070
02080 REAL SUMT, SUMSQT, MIN, MAX, LASTTIME, LASTV;
02090
02100 PROCEDURE RESET;
02110 BEGIN N := 0;
02120 SUMT := SUMSQT := 0.0; MIN := MAX := LASTV;
02130 LASTTIME := RESETAT := TIME;
02140 END***RESET***;
02150
02160 PROCEDURE UPDATE(V); REAL V;
02170 BEGIN REAL NOW, SPAN;
02180 N := N + 1;
02190 NOW := TIME;
02200 SPAN := NOW - LASTTIME;
02210 LASTTIME := NOW;
02220 SUMT := SUMT + LASTV*SPAN;
02230 SUMSQT := SUMSQT + LASTV**2*SPAN;
02240 LASTV := V;
02250 IF N = 1 THEN MIN := MAX := V ELSE
02260 IF V < MIN THEN MIN := V ELSE
02270 IF V > MAX THEN MAX := V;
02280 END*** UPDATE ***;
02290
02300 PROCEDURE REPORT;
02310 BEGIN REAL SPAN, AVG, T;
02320 ZYQWRITETRN;
02330 IF N = 0 THEN OUTTEXT(MINUSES40) ELSE
02340 BEGIN T := TIME;
02350 SPAN :=T-RESETAT; T :=T-LASTTIME;
02360 IF ABS(SPAN) < 0.0001 THEN OUTTEXT(MINUSES20) ELSE
02370 BEGIN AVG := (SUMT+LASTV*T)/SPAN;
02380 PRINTREAL(AVG);
02390 PRINTREAL(SQRT(ABS((SUMSQT+LASTV**2*T)/SPAN - AVG**2)));
02400 END;
02410 PRINTREAL(MIN);
02420 PRINTREAL(MAX);
02430 END;
02440 OUTIMAGE;
02450 END***REPORT***;
02460
02470 LASTTIME := RESETAT;
02480 INTO(ACCUMQ);
02490 END***ACCUMULATE***;
02500
02510
02520 COMMENT-------------------- H I S T O G R A M ---------------;
02530
02540 TAB CLASS HISTOGRAM(LOWER, UPPER, NCELLS); REAL LOWER, UPPER;
02550 INTEGER NCELLS;
02560 BEGIN COMMENT
02570 *
02580 * VARIABLES:
02590 *
02600 * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER)
02610 * .N NUMBER OF INCIDENCES
02620 * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION
02630 * LOWER LOWER LIMIT OF THE VARIABLE RANGE
02640 * UPPER UPPER LIMIT OF THE VARIABLE RANGE
02650 * NCELLS NUMBER OF CELLS IN THIS RANGE
02660 * WIDTH CELL WIDTH ( = ( UPPER - LOWER)/NCELLS )
02670 * TABLE ARRAY TO HOLD THE INCIDENCES. VALUES IN RANGE
02680 * GO IN CELLS 1, 2, ...., N.
02690 * UNDERFLOW VALUES GO IN CELL 0.
02700 * OVERFLOW VALUES GO IN CELL LIMIT = NCELLS+1
02710 * LIMIT NCELLS + 1.
02720 * MYT TO ACCUMULATE SUM , SUMSQ OF READINGS
02730 *
02740 * PROCEDURES:
02750 * RESET SETS N TO ZERO
02760 * COPIES TIME INTO RESETAT.
02770 * RESETS MYT
02780 *
02790 * UPDATE(V) ADDS 1 TO N
02800 * ADDS 1 TO THE APPROPRIATE TABLE CELL.
02810 * CALLS MYT.UPDATE(V)
02820 *
02830 * REPORT DRAWS A PICTURE OF THE HISTOGRAM.
02840 * CALLS MYT.REPORT
02850 * ;
02860
02870 INTEGER ARRAY TABLE(0 : NCELLS + 1 );
02880 REF(TALLY)MYT;
02890 INTEGER LIMIT;
02900 REAL WIDTH;
02910
02920 PROCEDURE RESET;
02930 BEGIN INTEGER K;
02940 N := 0;
02950 FOR K := 0 STEP 1 UNTIL LIMIT DO
02960 TABLE(K) := 0;
02970 RESETAT := TIME;
02980 MYT.RESET;
02990 END*** RESET ***;
03000
03010 PROCEDURE UPDATE(V); REAL V;
03020 BEGIN INTEGER CELL;
03030 N := N + 1;
03040 MYT.UPDATE(V);
03050 V := V - LOWER;
03060 IF V < 0.0 THEN CELL := 0 ELSE
03070 BEGIN CELL := ENTIER(V / WIDTH) + 1;
03080 IF CELL > LIMIT THEN CELL := LIMIT;
03090 END;
03100 TABLE(CELL) := TABLE(CELL) + 1;
03110 END*** UPDATE ***;
03120
03130 PROCEDURE REPORT;
03140 BEGIN TEXT T;
03150 INTEGER I, NEXT, A;
03160 REAL R, F, SCALE, SUM, FREQ;
03170
03180 INTEGER PROCEDURE MAXIMUMELEMENT;
03190 BEGIN INTEGER K, J;
03200 IF N > 0 THEN
03210 BEGIN K := TABLE(0);
03220 FOR J := 1 STEP 1 UNTIL LIMIT DO
03230 IF TABLE(J) > K THEN K := TABLE(J);
03240 MAXIMUMELEMENT := K;
03250 END;
03260 END*** MAXIMUM ELEMENT ***;
03270
03280 A := 39;
03290 SYSOUT.SETPOS(28);
03300 OUTTEXT("S U M M A R Y"); OUTIMAGE;
03310 OUTIMAGE;
03320 OUTTEXT(HEADINGRTN);
03330 OUTTEXT(TALLYHEADING); OUTIMAGE;
03340 MYT.REPORT;
03350 EJECT(LINE+2);
03360 OUTIMAGE;
03370 IF N = 0 THEN OUTTEXT("*** NO ENTRIES RECORDED ***") ELSE
03380 BEGIN SCALE := 30 / MAXIMUMELEMENT;
03390 OUTLINE("CELL/LOWER LIM/ N/ FREQ/ CUM %");
03400 SYSOUT.SETPOS(A); OUTCHAR('I'); OUTLINE(MINUSES30);
03410 F := 1/N;
03420 R := LOWER - WIDTH;
03430 FOR I := 0 STEP 1 UNTIL LIMIT DO
03440 BEGIN OUTINT(I, 4);
03450 IF I=0 THEN OUTTEXT(" -INFINITY") ELSE PRINTREAL(R);
03460 NEXT := TABLE(I); OUTINT(NEXT,6);
03470 FREQ := NEXT*F; OUTFIX(FREQ, 2, 8);
03480 SUM := SUM + FREQ*100; OUTFIX(SUM , 2, 8);
03490 IF NEXT = 0 THEN T :- NOTEXT ELSE
03500 BEGIN T :- STARS.SUB(1, SCALE*NEXT);
03510 IF T == NOTEXT THEN T :- ZYQDOT;
03520 END;
03530 SYSOUT.SETPOS(A); OUTCHAR('I'); OUTLINE(T);
03540 R := R + WIDTH;
03550 END;
03560 SYSOUT.SETPOS(A); OUTCHAR('I'); OUTLINE(MINUSES30);
03570 END;
03580 EJECT(LINE+2); OUTIMAGE;
03590 END***REPORT***;
03600
03610 WIDTH := (UPPER - LOWER)/NCELLS ;
03620 LIMIT := NCELLS + 1;
03630 MYT :- NEW TALLY(TITLE);
03640 COMMENT*** NOW REMOVE ITS NOTICE FROM TALLYQ;
03650 MYT.OUT;
03660 INTO(HISTOQ);
03670 END***HISTOGRAM***;
03680
03690 COMMENT----------SEED GENERATOR----------;
03700
03710 INTEGER ZYQSEED, ZYQMODULO;
03720
03730 INTEGER PROCEDURE ZYQNEXTSEED;
03740 BEGIN INTEGER K;
03750 FOR K := 7, 13, 15, 27 DO
03760 BEGIN ZYQSEED := ZYQSEED*K;
03770 IF ZYQSEED > ZYQMODULO THEN
03780 ZYQSEED := ZYQSEED - ZYQSEED//ZYQMODULO*ZYQMODULO;
03790 END;
03800 ZYQNEXTSEED := ZYQSEED;
03810 END***ZYQNEXTSEED***;
03820
03830
03840 COMMENT-------------D I S T R I B U T I O N S----------------
03850 *
03860 * THIS SECTION HAS THE DEFINITIONS OF THE SAMPLING MECHANISMS
03870 * DEFINED IN DEMOS. THESE DEFINITIONS ARE:
03880 *
03890 * DIST
03900 *
03910 * RDIST IDIST BDIST
03920 *
03930 * RDIST =
03940 * CONSTANTDIST EMPIRICALDIST NEGEXPDIST NORMALDIST UNIFORMDIST
03950 * ERLANGDIST
03960 *
03970 * IDIST =
03980 * RANDINTDIST POISSONDIST
03990 *
04000 * BDIST =
04010 * DRAWDIST
04020 *
04030 * CONSTANTDIST EVERY SAMPLE RETURNS THE SAME VALUE.
04040 *
04050 * EMPIRICALDIST DEFINES A CUMULATIVE PROBABILITY FUNCTION
04060 * SUPPLIED AS A PAIR OF TABLES BY THE USER.
04070 *
04080 * THE REST ARE BUILT UPON SIMULA'S DRAWING PROCEDURES IN THE
04090 * OBVIOUS WAY. BY BUILDING AN OBJECT WE MAKE A DRAWING BY A CALL
04100 * 'OBJ'.SAMPLE AND NEED NOT PASS OVER ANY PARAMETERS. FURTHER,
04110 * THE OBJECT NAME CAN BE RELEVANT, E.G. ARRIVALS.SAMPLE.
04120 * ;
04130
04140 TAB CLASS DIST; VIRTUAL:PROCEDURE REPORT;
04150 BEGIN INTEGER U, USTART, TYPE;
04160
04170 PROCEDURE RESET;
04180 BEGIN N := 0;
04190 RESETAT := TIME;
04200 END***RESET***;
04210
04220 REAL PROCEDURE ZYQSAMPLE;
04230 BEGIN INTEGER K;
04240 FOR K := 32, 32, 8 DO
04250 BEGIN U := K*U;
04260 IF U > ZYQMODULO THEN U := U - U//ZYQMODULO*ZYQMODULO;
04270 END;
04280 ZYQSAMPLE := U/ZYQMODULO;
04290 N := N+1;
04300 END***ZYQSAMPLE***;
04310
04320 PROCEDURE ZYQFAIL(T1,T2,X,Y); VALUE T1,T2; TEXT T1,T2; REAL X,Y;
04330 BEGIN SWITCH CASE := NORMALL,UNIFORML,ERLANGL,RANDINTL,NEGEXPL;
04340 OUTTEXT("**ERROR IN CREATION OF ");
04350 OUTTEXT(DISTTYPE(TYPE));
04360 OUTTEXT("DIST '");
04370 OUTTEXT(TITLE);
04380 OUTTEXT("'.");
04390 OUTIMAGE;
04400 OUTTEXT(ZYQREASON); OUTTEXT(T1); OUTIMAGE;
04410 OUTTEXT(ZYQRECVRY); OUTTEXT(T2);
04420 GOTO CASE(TYPE);
04430 NORMALL:
04440 ERLANGL:
04450 NEGEXPL: PRINTREAL(X);
04460 GOTO JOIN;
04470 UNIFORML: PRINTREAL(X);
04480 OUTTEXT(", B =");
04490 PRINTREAL(Y);
04500 GOTO JOIN;
04510 RANDINTL: OUTINT(THIS DIST QUA RANDINT.A, 10);
04520 OUTTEXT(", B =");
04530 OUTINT(THIS DIST QUA RANDINT.B, 10);
04540
04550 JOIN: OUTIMAGE; OUTIMAGE;
04560 END***ZYQFAIL***;
04570
04580 PROCEDURE REPORT;
04590 BEGIN SWITCH CASE := NORMALL, UNIFORML, ERLANGL, RANDINTL,
04600 NEGEXPL, POISSONL, DRAWL , CONSTANTL;
04610 ZYQWRITETRN;
04620 OUTCHAR(' ');
04630 OUTTEXT(DISTTYPE(TYPE));
04640 SYSOUT.SETPOS(40);
04650 GOTO CASE(TYPE);
04660 GOTO SKIPALL;
04670 NORMALL: PRINTREAL(THIS DIST QUA NORMAL.A);
04680 PRINTREAL(THIS DIST QUA NORMAL.B);
04690 GOTO EXIT;
04700 UNIFORML: PRINTREAL(THIS DIST QUA UNIFORM.A);
04710 PRINTREAL(THIS DIST QUA UNIFORM.B);
04720 GOTO EXIT;
04730 ERLANGL: PRINTREAL(THIS DIST QUA ERLANG.A);
04740 PRINTREAL(THIS DIST QUA ERLANG.B);
04750 GOTO EXIT;
04760 RANDINTL: OUTINT(THIS DIST QUA RANDINT.A, 10);
04770 OUTINT(THIS DIST QUA RANDINT.B, 10);
04780 GOTO EXIT;
04790 NEGEXPL: PRINTREAL(THIS DIST QUA NEGEXP.A);
04800 GOTO SKIP;
04810 POISSONL: PRINTREAL(THIS DIST QUA POISSON.A);
04820 GOTO SKIP;
04830 DRAWL: PRINTREAL(THIS DIST QUA DRAW.A);
04840 GOTO SKIP;
04850 CONSTANTL: PRINTREAL(THIS DIST QUA CONSTANT.A);
04860 GOTO SKIPALL;
04870 SKIP: SYSOUT.SETPOS(60);
04880 EXIT: OUTINT(USTART, 10);
04890 SKIPALL: OUTIMAGE;
04900 END***REPORT***;
04910
04920 U := USTART := ZYQNEXTSEED;
04930 RESETAT := TIME;
04940 IF THIS DIST IN EMPIRICAL THEN INTO(EMPQ) ELSE INTO(DISTQ);
04950 END***DIST***;
04960
04970 COMMENT--------------------R D I S T S--------------------;
04980
04990 DIST CLASS RDIST; VIRTUAL: REAL PROCEDURE SAMPLE;;
05000
05010 RDIST CLASS CONSTANT(A); REAL A;
05020 BEGIN
05030 REAL PROCEDURE SAMPLE;
05040 BEGIN N := N+1;
05050 SAMPLE := A;
05060 END***SAMPLE***;
05070 TYPE := 8;
05080 END***CONSTANT***;
05090
05100 RDIST CLASS NORMAL(A, B); REAL A, B;
05110 BEGIN REAL ZYQU, ZYQV; BOOLEAN ZYQFIRST;
05120 REAL PROCEDURE SAMPLE;
05125 BEGIN REAL Z;
05130 IF ZYQFIRST THEN
05140 BEGIN ZYQFIRST := FALSE;
05150 Z := ZYQU*COS(ZYQV);
05160 N := N+1;
05170 END ELSE
05180 BEGIN ZYQFIRST := TRUE;
05190 ZYQU := SQRT(-2.0*LN(ZYQSAMPLE));
05200 ZYQV := 6.28318530717959*ZYQSAMPLE;
05210 Z := ZYQU*SIN(ZYQV);
05220 N := N-1;
05230 END;
05235 SAMPLE := Z*B+A;
05240 END***SAMPLE***;
05250 TYPE := 1;
05260 IF B < 0.0 THEN
05270 BEGIN B := -B;
05280 ZYQFAIL("ST.DEV.'B' < 0.0.","ABS VALUE TAKEN.B IS NOW",B,0.0);
05290 END;
05300 END***NORMAL***;
05310
05320 RDIST CLASS NEGEXP(A); REAL A;
05330 BEGIN
05340 REAL PROCEDURE SAMPLE;
05350 BEGIN
05360 SAMPLE := -LN(ZYQSAMPLE)/A;
05370 END***SAMPLE***;
05380 TYPE := 5;
05390 IF A <= 0.0 THEN
05400 BEGIN A := IF A < 0.0 THEN -A ELSE 0.001;
05410 ZYQFAIL("NON-POS.VALUE FOR 'A'(=1/MEAN).","A RESET TO",A,0.0);
05420 END;
05430 END***NEGEXP***;
05440
05450 RDIST CLASS UNIFORM(A, B); REAL A, B;
05460 BEGIN REAL SPAN;
05470 REAL PROCEDURE SAMPLE;
05480 BEGIN
05490 SAMPLE := SPAN*ZYQSAMPLE + A;
05500 END***SAMPLE***;
05510 TYPE := 2;
05520 IF A > B THEN
05530 BEGIN REAL Q;
05540 Q := A; A := B; B := Q;
05550 ZYQFAIL("LOWER BND.'A'>UPPER BND.'B'.","BNDS SWAPPED.NOW A=",A,B);
05560 END;
05570 SPAN := B-A;
05580 END***UNIFORM***;
05590
05600 RDIST CLASS ERLANG(A, B); REAL A, B;
05610 BEGIN REAL ZYQAB; INTEGER ZYQC;
05620 REAL PROCEDURE SAMPLE;
05630 BEGIN INTEGER K, M; REAL SUM;
05640 M := N;
05650 FOR K := 1 STEP 1 UNTIL ZYQC DO
05660 SUM := SUM + ZYQSAMPLE;
05670 N := M;
05680 SAMPLE := (SUM + (B-ZYQC)*ZYQSAMPLE)*ZYQAB;
05690 END***SAMPLE***;
05700 TYPE := 3;
05710 IF A <= 0.0 THEN
05720 BEGIN A := IF A <= 0.0 THEN -A ELSE 0.01;
05730 ZYQFAIL("'A'(=1/MEAN) <= 0.0.","A RESET TO",A,0.0);
05740 END;
05750 IF B <= 0.0 THEN
05760 BEGIN B := IF B <= 0.0 THEN -B ELSE 0.0001;
05770 ZYQFAIL("'B'(=ERLANG ST. DEV.) <= 0.0."," B RESET TO",B,0.0);
05780 END;
05790 ZYQC := ENTIER(B); ZYQAB := 1/(A*B);
05800 END***ERLANG***;
05810
05820 RDIST CLASS EMPIRICAL(SIZE); INTEGER SIZE;
05830 BEGIN REAL ARRAY P, X(1 : SIZE);
05840
05850 REAL PROCEDURE SAMPLE;
05860 BEGIN REAL D, Q; INTEGER K;
05870 Q := ZYQSAMPLE;
05880 FOR K := 2 STEP 1 UNTIL N DO
05890 IF(IF P(K-1)<=Q THEN Q<=P(K) ELSE FALSE)THEN GOTO L;
05900 L:D := P(K)-P(K-1);
05910 SAMPLE := IF D = 0.0 THEN X(K-1) ELSE
05920 X(K-1) + (X(K)-X(K-1))*(Q-P(K-1))/D;
05930 END***SAMPLE***;
05940
05950 PROCEDURE REPORT;
05960 BEGIN INTEGER K;
05970 OUTTEXT(HEADINGRTN); OUTTEXT("/ U START"); OUTIMAGE;
05980 ZYQWRITETRN;
05990 OUTINT(USTART, 11);
06000 OUTIMAGE; OUTIMAGE;
06010 OUTTEXT(" K/ DIST. X(K)/ PROB. P(K)");
06020 OUTIMAGE;
06030 FOR K := 1 STEP 1 UNTIL SIZE DO
06040 BEGIN OUTINT(K, 3);
06050 OUTFIX(X(K), 5, 13);
06060 OUTFIX(P(K), 5, 13);
06070 OUTIMAGE;
06080 END;
06090 EJECT(LINE+2);
06100 OUTIMAGE;
06110 END***REPORT***;
06120
06130 PROCEDURE READ;
06140 BEGIN BOOLEAN GOOD, FIRST; INTEGER K, L;
06150 REAL A, B;
06160
06170 PROCEDURE WARNING(W,R,F,C);VALUE W,C;TEXT W,C;REAL R;BOOLEAN F;
06180 BEGIN
06190 IF GOOD THEN
06200 BEGIN GOOD := FALSE;
06210 SYSOUT.SETPOS(11);
06220 OUTTEXT("**READ FAULT(S) IN EMPIRICALDIST '");
06230 OUTTEXT(TITLE);
06240 OUTTEXT("'.");
06250 OUTIMAGE;
06260 END;
06270 IF FIRST THEN
06280 BEGIN FIRST := FALSE;
06290 OUTIMAGE;
06300 OUTTEXT("**INPUTS : K ="); OUTINT(K, 4);
06310 OUTTEXT(", DIST(K) ="); PRINTREAL(A);
06320 OUTTEXT(", PROB(K) ="); PRINTREAL(B);
06330 OUTIMAGE;
06340 OUTTEXT(ZYQRECVRY);
06350 END;
06360 SYSOUT.SETPOS(14);
06370 OUTTEXT(W);
06380 IF F THEN OUTFIX(R, 6, 10) ELSE PRINTREAL(R);
06390 OUTTEXT(C); OUTCHAR('.');
06400 OUTIMAGE;
06410 END***WARNING***;
06420
06430 K := 1;
06440 GOOD := FIRST := TRUE;
06450 X(1) := A := INREAL; B := INREAL;
06460 IF ABS(B) > 0.0001 THEN
06470 WARNING("P(1) IS NOT ZERO. P(1) =>",0.0,TRUE," (FIRST PROB)");
06480 FOR K := 2 STEP 1 UNTIL SIZE DO
06490 BEGIN FIRST := TRUE;
06500 X(K) := A := INREAL; P(K) := B := INREAL;
06510 IF A <= X(K-1) THEN
06520 BEGIN X(K) := X(K-1)+0.001;
06530 WARNING("X(K) <= X(K-1). X(K) =>",X(K),FALSE," (=X(K-1)+)");
06540 END;
06550 IF B < 0.0 THEN
06560 BEGIN P(K) := P(K-1);
06570 WARNING("P(K) < 0.0. P(K) =>",P(K),TRUE," (=P(K-1))");
06580 END ELSE
06590 IF B > 1.0 THEN
06600 BEGIN P(K) := 1.0;
06610 WARNING("P(K) > 1.0. P(K) =>",P(K),TRUE," (=P(K-1))");
06620 END ELSE
06630 IF B < P(K-1) THEN
06640 BEGIN P(K) := P(K-1);
06650 WARNING("P(K) < P(K-1). P(K) =>",P(K),TRUE," (=P(K-1))");
06660 END;
06670 END;
06680 IF ABS(P(SIZE)-1.0) > 0.0001 THEN
06690 WARNING("P(K) IS NOT 1.0. P(K) =>",1.0,TRUE," (LAST PROB.)");
06700 P(SIZE) := 1.0;
06710 IF NOT GOOD THEN
06720 BEGIN OUTTEXT(MINUSES62);
06730 OUTIMAGE; OUTIMAGE;
06740 END;
06750 END***READ***;
06760
06770 TYPE := 9;
06780 READ;
06790 END***EMPIRICAL***;
06800
06810 COMMENT--------------------I D I S T S--------------------;
06820
06830 DIST CLASS IDIST; VIRTUAL: INTEGER PROCEDURE SAMPLE;;
06840
06850 IDIST CLASS RANDINT(A, B); INTEGER A, B;
06860 BEGIN REAL SPAN;
06870 INTEGER PROCEDURE SAMPLE;
06880 BEGIN
06890 SAMPLE := ENTIER(SPAN*ZYQSAMPLE) + A;
06900 END***SAMPLE***;
06910 TYPE := 4;
06920 IF A > B THEN
06930 BEGIN INTEGER Q;
06940 Q := A; A := B; B := Q;
06950 ZYQFAIL("LOWER BND.'A'>UPPER BND.'B'.","BNDS SWAPPED.NOW A=",A,B);
06960 END;
06970 SPAN := B-A+1;
06980 END***RANDINT***;
06990
07000 IDIST CLASS POISSON(A); REAL A;
07010 BEGIN
07020 INTEGER PROCEDURE SAMPLE;
07030 BEGIN INTEGER M; REAL P, Q;
07040 P := EXP(-A);
07050 Q := 1.0;
07060 L: Q := Q*ZYQSAMPLE;
07070 IF Q >= P THEN
07080 BEGIN M := M+1; GOTO L; END;
07090 SAMPLE := M;
07100 N := N-M;
07110 END***SAMPLE***;
07120 TYPE := 6;
07130 END***POISSON***;
07140
07150 COMMENT--------------------B D I S T S--------------------;
07160
07170 DIST CLASS BDIST; VIRTUAL: BOOLEAN PROCEDURE SAMPLE;;
07180
07190 BDIST CLASS DRAW(A); REAL A;
07200 BEGIN
07210 BOOLEAN PROCEDURE SAMPLE;
07220 BEGIN
07230 SAMPLE := A > ZYQSAMPLE;
07240 END***SAMPLE***;
07250 TYPE := 7;
07260 END***DRAW***;
07270
07280 COMMENT-------------READDIST-----------------------------------;
07290
07300 PROCEDURE READDIST(D, TITLE); NAME D; VALUE TITLE;
07310 REF(DIST)D; TEXT TITLE;
07320 BEGIN TEXT F, REST;
07330 INTEGER P, IMLENGTH1, L, K, TYPE;
07340
07350 PROCEDURE FAIL(D, EOF); BOOLEAN D, EOF;
07360 BEGIN OUTTEXT("**ERROR IN READING DIST WITH TITLE = '");
07370 OUTTEXT(TITLE);
07380 OUTTEXT("'.");
07390 OUTIMAGE;
07400 OUTTEXT("**NO MATCH FOUND WHEN SCANNING INPUT FILE FOR ");
07410 IF D THEN OUTTEXT("DIST TYPE") ELSE OUTTEXT("TITLE");
07420 OUTCHAR('.');
07430 OUTIMAGE;
07440 OUTTEXT(ZYQREASON);
07450 IF EOF THEN OUTTEXT("END OF INPUT FILE MARKER HIT.") ELSE
07460 BEGIN OUTTEXT("REST OF CURRENT INPUT IMAGE READS:");
07470 OUTIMAGE;
07480 OUTTEXT(REST);
07490 END;
07500 OUTIMAGE;
07510 OUTIMAGE;
07520 BOX("SERIOUS ERROR : PROGRAM DELIBERATELY ABORTED.");
07530 P := 0; P := 1/P;
07540 END***FAIL***;
07550
07560 COMMENT***CHECKTITLE***;
07570 IMLENGTH1 := SYSIN.LENGTH + 1;
07580 IF LASTITEM THEN FAIL(FALSE, TRUE);
07590 L := TITLE.LENGTH;
07600 P := SYSIN.POS;
07610 REST :- SYSIN.IMAGE.SUB(P, IMLENGTH1 - P);
07620 IF REST.LENGTH >= L THEN F :- REST.SUB(1, L);
07630 IF F NE TITLE THEN FAIL(FALSE,FALSE);
07640 SYSIN.SETPOS(P + L);
07650
07660 COMMENT***GET DIST TYPE***;
07670 IF LASTITEM THEN FAIL(TRUE, TRUE);
07680 P := SYSIN.POS;
07690 REST :- SYSIN.IMAGE.SUB(P, IMLENGTH1 - P);
07700 L := REST.LENGTH;
07710 FOR K := 6, 7, 6, 7, 6, 7, 4, 8, 9 DO
07720 BEGIN TYPE := TYPE + 1;
07730 IF K <= L THEN
07740 BEGIN IF DISTTYPE(TYPE) = REST.SUB(1, K) THEN GOTO FOUND;
07750 END;
07760 END;
07770 FAIL(TRUE, FALSE);
07780 FOUND: SYSIN.SETPOS(P + K);
07790 IF TYPE = 1 THEN D :- NEW NORMAL(TITLE, INREAL, INREAL ) ELSE
07800 IF TYPE = 2 THEN D :- NEW UNIFORM(TITLE, INREAL, INREAL) ELSE
07810 IF TYPE = 3 THEN D :- NEW ERLANG(TITLE, INREAL, INREAL ) ELSE
07820 IF TYPE = 4 THEN D :- NEW RANDINT(TITLE, ININT, ININT) ELSE
07830 IF TYPE = 5 THEN D :- NEW NEGEXP(TITLE, INREAL) ELSE
07840 IF TYPE = 6 THEN D :- NEW POISSON(TITLE, INREAL) ELSE
07850 IF TYPE = 7 THEN D :- NEW DRAW(TITLE, INREAL) ELSE
07860 IF TYPE = 8 THEN D :- NEW CONSTANT(TITLE, INREAL) ELSE
07870 IF TYPE = 9 THEN D :- NEW EMPIRICAL(TITLE, ININT) ELSE
07880 ;
07890 END***READ***;
07900
07910 TEXT ARRAY DISTTYPE(1 : 9);
07920
07930
07940 COMMENT-------------------- REPORTQ -------------------------;
07950
07960 HEAD CLASS REPORTQ(H, L1, L2); VALUE H; TEXT H, L1, L2;
07970 BEGIN COMMENT
07980 *
07990 * EVERY CREATED TAB IS PUT INTO A REPORTQ IN THE ORDER
08000 * OF THE TABS CREATIONS. THERE THEY CAN ALL BE REPORTED TOGETHER
08010 * ON A CALL 'REPORT' , OR ALL RESET TO THE NULL STATE BY A CALL
08020 * 'RESET'.
08030 *
08040 * VARIABLES :
08050 * AS CLASS HEAD
08060 *
08070 * PROCEDURES:
08080 * RESET RESETS EACH AND EVERY REPRESENTED TAB
08090 *
08100 * REPORT REPORTS EACH AND EVERY TAB AS ABOVE
08110 * ;
08120
08130 PROCEDURE REPORT;
08140 BEGIN REF(TAB)T;
08150 INTEGER P, L;
08160 L := H.LENGTH; P := (70-L)//2;
08170 SYSOUT.SETPOS(P); OUTTEXT(H);
08180 OUTIMAGE;
08190 SYSOUT.SETPOS(P); OUTTEXT(STARS.SUB(1, L));
08200 OUTIMAGE; OUTIMAGE;
08210 IF L1 =/= NOTEXT THEN OUTTEXT(L1);
08220 IF L2 =/= NOTEXT THEN OUTTEXT(L2);
08230 OUTIMAGE;
08240 T :- FIRST;
08250 WHILE T =/= NONE DO
08260 BEGIN T.REPORT;
08270 T :- T.SUC;
08280 END;
08290 END***SNAP***;
08300
08310 PROCEDURE RESET;
08320 BEGIN REF(TAB)T;
08330 T :- FIRST;
08340 WHILE T =/= NONE DO
08350 BEGIN T.RESET;
08360 T :- T.SUC;
08370 END;
08380 END***RESET***;
08390
08400 END***REPORTQ***;
08410
08420
08430 COMMENT-------------------- REPORTING AIDS -----------------;
08440
08450 PROCEDURE OUTLINE(T); NAME T; TEXT T;
08460 BEGIN
08470 OUTTEXT(T); OUTIMAGE;
08480 END***OUTLINE***;
08490
08500 PROCEDURE CLOCKTIME;
08510 BEGIN SYSOUT.SETPOS(23);
08520 OUTTEXT("CLOCK TIME = ");
08530 PRINTREAL(TIME);
08540 OUTIMAGE;
08550 END***CLOCK TIME***;
08560
08570
08580 PROCEDURE FRAMELINE;
08590 BEGIN OUTCHAR('*');
08600 SYSOUT.SETPOS(69);
08610 OUTCHAR('*');
08620 OUTIMAGE;
08630 END***FRAMELINE***;
08640
08650
08660 PROCEDURE BOX(T); VALUE T; TEXT T;
08670 BEGIN TEXT S;
08690 S :- STARS.SUB(1, 69);
08700 OUTTEXT(S); OUTIMAGE;
08710 FRAMELINE;
08720 OUTCHAR('*');
08730 SYSOUT.SETPOS((69 - T.LENGTH)//2);
08740 OUTTEXT(T);
08750 SYSOUT.SETPOS(69);
08760 OUTCHAR('*');
08770 OUTIMAGE;
08780 FRAMELINE;
08790 OUTTEXT(S); OUTIMAGE;
08800 OUTIMAGE;
08810 END***BOX***;
08820
08830
08840 TEXT PROCEDURE EDIT(T, K); VALUE T; TEXT T; INTEGER K;
08850 BEGIN INTEGER M; TEXT S;
08860 T :- T.STRIP; M := T.LENGTH + 2;
08870 EDIT :- S :- BLANKS(M);
08880 S := T;
08890 IF K < 0 THEN K := -K;
08900 IF K > 99 THEN K := K//100;
08910 S.SUB(M-1, 2).PUTINT(K);
08920 END***EDIT***;
08930
08940
08950 PROCEDURE PRINTREAL(X); REAL X;
08960 IF X > 0.0 THEN
08970 BEGIN
08980 IF X > 99999.999 OR X < 0.1 THEN OUTREAL(X, 4, 10)
08990 ELSE OUTFIX (X, 3, 10);
09000 END ELSE
09010 IF X = 0.0 THEN OUTFIX(X, 3, 10) ELSE
09020 BEGIN
09030 IF X < -9999.999 OR X > -0.1 THEN OUTREAL(X, 3, 10)
09040 ELSE OUTFIX (X, 3, 10);
09050 END***PRINTREAL***;
09060
09070
09080 COMMENT--REDEFINITION OF CURRENT, CANCEL, PASSIVATE, AND HOLD--
09090 *
09100 * IN ORDER TO REDEFINE CURRENT TO HAVE THE DEEPER QUALIFICATION
09110 * 'ENTITY' RATHER THAN 'PROCESS', WE FIRST HAVE TO RENAME IT
09120 * AT A HIGHER LEVEL AS HERE. TO GET WHAT WE WANT, WE RENAME
09130 * 'FIRSTINSQS' AS 'CURRENT' IN THE NEXT LEVEL.
09140 * WE CANNOT REPORT 'THIS SIMULATION.CURRENT' AS SUCH A USE OF
09150 * 'THIS' IS FORBIDDEN BY THE COMMON BASE.
09160 * WE REDEFINE 'HOLD' HERE SO THAT WE CAN USE NAME AGAIN AT
09170 * THE DEMOS LEVEL WITH A TRACE OPTION INCORPORATED. SAME WITH
09180 * 'CANCEL'.
09190 * ;
09200
09210 PROCEDURE ZYQHOLD(T); REAL T;
09220 HOLD(T);
09230
09240 PROCEDURE ZYQCANCEL(E); REF(PROCESS)E;
09250 CANCEL(E);
09260
09270 REF(PROCESS)PROCEDURE ZYQCURRENT;
09280 ZYQCURRENT :- CURRENT;
09290
09300 PROCEDURE ZYQPASSIVATE;
09310 PASSIVATE;
09320
09330
09340 COMMENT--------LOCAL VARIABLES AND THEIR INITIALISATIONS ----;
09350
09360 REF(REPORTQ)EMPQ, TALLYQ, ACCUMQ, HISTOQ, COUNTQ, DISTQ;
09370 TEXT TALLYHEADING, ACCUMHEADING, DISTHEADING;
09380 TEXT HEADINGRTN,STARS,MINUSES10,MINUSES20,MINUSES40,MINUSES30,
09390 MINUSES62,MINUSES,ZYQT,ZYQR,ZYQN,ZYQDOT,ZYQREASON,ZYQRECVRY;
09400
09410 HEADINGRTN :-COPY("TITLE /RESET TIME/ OBS");
09420 ACCUMHEADING:-COPY("/ AVERAGE/EST.ST.DV/ MINIMUM/ MAXIMUM");
09430 DISTHEADING :-COPY("/TYPE / A/ B/ SEED");
09440 TALLYHEADING:-ACCUMHEADING;
09450
09460 DISTTYPE(1):-COPY("NORMAL"); DISTTYPE(2):-COPY("UNIFORM");
09470 DISTTYPE(3):-COPY("ERLANG"); DISTTYPE(4):-COPY("RANDINT");
09480 DISTTYPE(5):-COPY("NEGEXP"); DISTTYPE(6):-COPY("POISSON");
09490 DISTTYPE(7):-COPY("DRAW"); DISTTYPE(8):-COPY("CONSTANT");
09500 DISTTYPE(9):-COPY("EMPIRICAL");
09510 ACCUMQ :- NEW REPORTQ("A C C U M U L A T E S",
09520 HEADINGRTN, ACCUMHEADING);
09530 COUNTQ :- NEW REPORTQ("C O U N T S", HEADINGRTN, NOTEXT);
09540 DISTQ :- NEW REPORTQ("D I S T R I B U T I O N S",
09550 HEADINGRTN, DISTHEADING );
09560 EMPQ :- NEW REPORTQ("E M P I R I C A L S", NOTEXT, NOTEXT);
09570 HISTOQ :- NEW REPORTQ("H I S T O G R A M S", NOTEXT, NOTEXT);
09580 TALLYQ :- NEW REPORTQ("T A L L I E S",HEADINGRTN,TALLYHEADING);
09590
09600 STARS :- BLANKS(69);
09610 WHILE STARS.MORE DO
09620 STARS.PUTCHAR('*');
09630
09640 MINUSES :- BLANKS(69);
09650 WHILE MINUSES.MORE DO
09660 MINUSES.PUTCHAR('-');
09670 MINUSES10 :- MINUSES.SUB(1, 10);
09680 MINUSES20 :- MINUSES.SUB(1, 20);
09690 MINUSES30 :- MINUSES.SUB(1, 30);
09700 MINUSES40 :- MINUSES.SUB(1, 40);
09710 MINUSES62 :- MINUSES.SUB(1, 62);
09720 ZYQDOT :- COPY(".");
09730 ZYQT :- SYSOUT.IMAGE.SUB( 1, 12);
09740 ZYQR :- SYSOUT.IMAGE.SUB(14, 10);
09750 ZYQN :- SYSOUT.IMAGE.SUB(24, 6);
09760 ZYQREASON :- COPY("**REASON : ");
09770 ZYQRECVRY :- COPY("**RECOVERY : ");
09780 ZYQMODULO := 67099547; ZYQSEED := 907;
09790 END*** REPORTING FACILITIES IN SIMON ***;