Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/util/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 ***;