IMPLEMENTATION MODULE STAT; (************************************************************************** Environnement : SOLARIS 2.3 Mcs. ------------- Programmeurs : ------------ Pierre L'Ecuyer, Michel Duclos, Nataly Giroux, Denis Alain, Gaetan Perron, Jean Belanger ***************************************************************************) FROM MYINOUT IMPORT WriteString, WriteLn, WriteInt, WriteCard; FROM RAND1 IMPORT InvStudentDist; FROM NUM IMPORT WriteLR, Sqrt; FROM SIM IMPORT TimeSimul; FROM Storage IMPORT ALLOCATE, DEALLOCATE; CONST LongName = 32; (* Long. max de la chaine de caracteres decrivant un bloc stat. *) MaxReal = 9.0E37; (* Valeur maximum d'un reel. *) TYPE Block = POINTER TO BlockStat; BlockStat = RECORD Descriptor : ARRAY [0..LongName-1] OF CHAR; (* Nom du bloc statistique. *) ValMax : LONGREAL; (* Valeur maximale compilee *) ValMin : LONGREAL; (* Valeur minimale compilee *) CASE KindB : BlockType OF Accumulate : TInit : LONGREAL; (* Temps de la derniere initialisation*) TPrec : LONGREAL; (* Temps de la derniere mise a jour *) ValPrec : LONGREAL; (* Valeur enregistree au temps *) (* precedent *) SumA : LONGREAL; (* Somme des valeurs compilees *) | Tally : NObservations : LONGCARD; (* Nombre d'observations a date *) SumSquares : LONGREAL; (* Somme des carres des valeurs *) (* compilees *) SumT : LONGREAL (* Somme des valeurs compilees *) END END; PROCEDURE Error (Number : CARDINAL); BEGIN WriteString ( '***** ERROR from module STAT : ***** ' ); WriteLn; CASE Number OF 1 : WriteString ("Trying to initialize a statistical block"); WriteString (" which has not been created yet.") | 2 : WriteString ("Trying to update a statistical block"); WriteString (" which has not been created yet.") | 3 : WriteString ("Asking information from a statistical block"); WriteString (" which has not been created yet.") END; WriteLn; WriteLn; HALT END Error; PROCEDURE Error1 ( Number : CARDINAL; X : Block ); BEGIN WriteString ( '***** ERROR from module STAT : ***** ' ); WriteLn; CASE Number OF 4 : WriteString ("Calling NumberObs for a stat. block of"); WriteString (" type Accumulate.") | 5 : WriteString ("Asking for the variance for a stat. block whose"); WriteString (" number of observations is < 2.") | 6 : WriteString ("Asking for the variance for a stat. block of type"); WriteString (" Accumulate.") | 7 : WriteString ("Asking for a confidence interval for a stat. block"); WriteString (" whose number of observations is < 2.") | 8 : WriteString ("Asking for a confidence interval for a stat. block"); WriteString (" of type Accumulate.") | 10 : WriteString ("Asking a report for a stat. block with no observ.") | 11 : WriteString ("Trying to create a block already created.") END; WriteLn; WriteString ("Block name : "); WriteString (X^.Descriptor); WriteLn; WriteLn; HALT END Error1; PROCEDURE Create ( VAR X : Block; Kind : BlockType; Name : ARRAY OF CHAR ); VAR n, i : INTEGER; BEGIN NEW (X); (* Creation du bloc Statistique *) WITH X^ DO n := HIGH (Name); IF n >= LongName THEN n := LongName - 1 END; FOR i := 0 TO n DO Descriptor [i] := Name [i] END; FOR i := n+1 TO LongName - 1 DO Descriptor [i] := ' ' END; KindB := Kind; IF KindB = Tally THEN Init (X) ELSE ValPrec := 0.0; (* En fonction de l'equation dans *) (* la procedure Update. *) ValMax := -MaxReal; (* Initialisation des parametres du *) ValMin := MaxReal ; (* block statistique sans appeler *) SumA := 0.0; (* la procedure Init. *) TInit := TimeSimul; TPrec := TimeSimul END END END Create; (******************************************************************************) PROCEDURE Init ( X : Block ); BEGIN IF X = NIL THEN Error (1) END; WITH X^ DO (* Initialisation du bloc statistique *) IF KindB = Tally THEN (* Bloc statistique de type tally *) ValMax := - MaxReal; ValMin := MaxReal; SumT := 0.0; SumSquares := 0.0; NObservations := 0 ELSE (* Bloc statistique de type accumulate*) ValMax := ValPrec; ValMin := ValPrec; SumA := 0.0; TInit := TimeSimul; TPrec := TimeSimul END END END Init; (******************************************************************************) PROCEDURE Update ( X : Block; V : LONGREAL ); BEGIN IF X = NIL THEN Error (2) END; WITH X^ DO IF V < ValMin THEN ValMin := V END;(* Verifier si la nouvelle entree *) IF V > ValMax THEN ValMax := V END;(* est maximale ou minimale *) IF KindB = Tally THEN (* Bloc statistique de type tally *) INC ( NObservations ); SumT := SumT + V; SumSquares := SumSquares + V * V ELSE (* Bloc statistique de type accumulate*) SumA := SumA + ValPrec * (TimeSimul - TPrec); ValPrec := V; TPrec := TimeSimul END END END Update; (******************************************************************************) PROCEDURE Report ( X : Block ); BEGIN IF X = NIL THEN Error (3) END; WITH X^ DO IF ValMin = MaxReal THEN Error1 (10, X); RETURN END; WriteLn; WriteString ('REPORT ON STATISTIC '); CASE KindB OF Accumulate: WriteString( '(Accumulate) : ' ); WriteString(Descriptor); WriteLn; WriteString( ' from time to time min max' ); WriteString( ' average' ); WriteLn; WriteLR (TInit, 10, 2, 2); WriteString( ' ' ); WriteLR (TimeSimul, 10, 2, 2); WriteString( ' ' ); WriteLR ( ValMin, 10, 3, 2 ); WriteString( ' ' ); WriteLR ( ValMax, 10, 3, 2); WriteString( ' ' ); WriteLR ( Average ( X ), 10, 3, 2 ); WriteLn | Tally: WriteString( '(Tally) : '); WriteString (Descriptor); WriteLn; WriteString( ' min max average' ); WriteString( ' standard dev. nb. Obs.' ); WriteLn; WriteString( ' ' ); WriteLR (ValMin, 10, 3, 2); WriteString( ' ' ); WriteLR (ValMax, 10, 3, 2 ); WriteString( ' ' ); WriteLR (Average ( X ), 10, 3, 2); WriteString( ' ' ); WriteLR (StandardDev ( X ), 10, 3, 2); WriteString( ' ' ); WriteCard (VAL (CARDINAL, NObservations), 7); WriteLn END END END Report; (******************************************************************************) PROCEDURE NumberObs ( X : Block ) : LONGCARD; BEGIN IF X = NIL THEN Error (3) END; WITH X^ DO IF KindB # Tally THEN Error1 (4, X) END; RETURN NObservations END END NumberObs; (******************************************************************************) PROCEDURE Minimum ( X : Block ) : LONGREAL; BEGIN IF X = NIL THEN Error (3) END; RETURN X^.ValMin END Minimum; (******************************************************************************) PROCEDURE Maximum ( X : Block ) : LONGREAL; BEGIN IF X = NIL THEN Error (3) END; RETURN X^.ValMax END Maximum; (******************************************************************************) PROCEDURE Sum ( X : Block ) : LONGREAL; BEGIN IF X = NIL THEN Error (3) END; WITH X^ DO IF KindB = Accumulate THEN (* Bloc statistique de type accumulate*) Update ( X, ValPrec); RETURN SumA ELSE (* Bloc statistique de type tally *) RETURN SumT END END END Sum; (******************************************************************************) PROCEDURE Average ( X : Block ) : LONGREAL; VAR Periode : LONGREAL; BEGIN IF X = NIL THEN Error (3) END; WITH X^ DO IF KindB = Tally THEN (* Bloc statistique de type tally *) IF NObservations # 0 THEN RETURN SumT / LFLOAT (NObservations) ELSE RETURN 0.0 END ELSE (* Bloc statistique de type accumulate*) Update (X, ValPrec); Periode := TimeSimul - TInit; IF Periode > 0.0 THEN RETURN SumA / Periode ELSE RETURN 0.0 END END END END Average; (******************************************************************************) PROCEDURE Variance ( X : Block ) : LONGREAL; VAR Tmp : LONGREAL ; BEGIN IF X = NIL THEN Error (3) END; WITH X^ DO IF KindB # Tally THEN Error1 (6, X) END; IF NObservations < 2 THEN Error1 (5, X) END; Tmp := (SumSquares - (SumT * SumT / LFLOAT (NObservations))) / LFLOAT (NObservations - 1); IF Tmp < 0.0 THEN (* Due aux erreurs numeriques *) RETURN 0.0 ELSE RETURN Tmp END END END Variance; (******************************************************************************) PROCEDURE StandardDev ( X : Block ) : LONGREAL; BEGIN RETURN Sqrt (Variance (X)) END StandardDev; (******************************************************************************) PROCEDURE ConfidenceInterval ( X : Block ; Level : LONGREAL ; VAR Center, Radius : LONGREAL ); VAR t : LONGREAL; (* Valeur de la table de Student pour *) (* n et un niveau de confiance donnes *) BEGIN IF X = NIL THEN Error (3) END; WITH X^ DO IF KindB # Tally THEN Error1 (8, X) END; IF NObservations < 2 THEN Error1 (7, X) END; Center := Average ( X ); t := InvStudentDist (X^.NObservations - 1, (Level + 1.0) / 2.0); Radius := t * StandardDev (X) / Sqrt (LFLOAT (X^.NObservations)) END END ConfidenceInterval; (******************************************************************************) PROCEDURE ReportConfidenceInterval ( X : Block ; Level : LONGREAL ); VAR Moy, Delta : LONGREAL; BEGIN ConfidenceInterval (X, Level, Moy, Delta); Report (X); WriteString ( ' ' ); WriteCard (TRUNC (100.0 * Level + 0.5 ), 3 ); WriteString ('% confidence interval for mean : (' ); WriteLR (Moy - Delta, 10, 3, 2); WriteString ( ', ' ); WriteLR (Moy + Delta, 10, 3, 2); WriteString (' )'); WriteLn END ReportConfidenceInterval; PROCEDURE Delete (VAR X : Block); BEGIN DISPOSE (X) END Delete; END STAT.