'============================================================================
'   G.H. George                                       Created   1992 FEB 27
'                               HYP-TEST.BAS          Modified  1998 APR 30
'   An illustration of hypothesis tests, especially type I errors.
'============================================================================

'   Procedures:
'       Title:  print the header on the output screen
'    Interval:  print rejection region boundaries and the sample mean
'      Update:  print an update of the number and proportion of rejections
'     Summary:  print a summary of incorrect rejections of null hypothesis
DECLARE SUB Title ()
DECLARE SUB Update (Simulation AS INTEGER, Rejects AS INTEGER)
DECLARE SUB Interval (Rejects AS INTEGER)
DECLARE SUB Summary (Rejects AS INTEGER)
DECLARE SUB ClearBox (Left AS INTEGER, Right AS INTEGER, Top AS INTEGER, Bottom AS INTEGER)
DECLARE SUB Number (xBar!)

'   Global constants:
'       False:  logical false (= 0)
'        True:  logical true (= -1)
DEFINT F, T
CONST False = 0, True = NOT False

'   Variables:
'  Simulation:  loop counter = # simulations so far
'     Rejects:  number of sample means that fall in the rejection region
DIM Rejects AS INTEGER, Simulation AS INTEGER

SCREEN 0: WIDTH 80: COLOR 7, 0: CLS
RANDOMIZE TIMER
CALL Title
LET Rejects = 0

FOR Simulation = 1 TO 100
    CALL Interval(Rejects)
    CALL Update(Simulation, Rejects)
NEXT Simulation

CALL Summary(Rejects)

END

DEFSNG F, T
SUB ClearBox (Left AS INTEGER, Right AS INTEGER, Top AS INTEGER, Bottom AS INTEGER)
'----------------------------------------------------------------------------
'   Clear all text from a rectangle on screen:
'    from Left to Right and from Top to Bottom.
'----------------------------------------------------------------------------

'   Procedures:
'       <none>

'   Parameters:
'    Left, Right:   vertical boundaries (col) of the rectangle to be cleared.
'    Top, Bottom:   horizontal boundaries (row)

'   Local variables:
'       Valid:  logical variable = true iff the boundaries are sensible.
'    ThisLine:  loop counter = current row number on screen

DIM Valid AS INTEGER, ThisLine AS INTEGER

' Check for invalid boundaries.

LET Valid = True
IF Left < 1 OR Right > 79 THEN LET Valid = False
IF Top < 1 OR Bottom > 24 THEN LET Valid = False
IF Left > Right OR Top > Bottom THEN LET Valid = False

' Clear text from any valid rectangle by overwriting with spaces.

IF Valid THEN
    LOCATE Top, Left
   
    FOR ThisLine = Top TO Bottom
        LOCATE ThisLine, Left
        PRINT STRING$(Right - Left + 1, 32)
    NEXT ThisLine

END IF

END SUB

SUB Interval (Rejects AS INTEGER)
'----------------------------------------------------------------------------
'   Prints the rejection region boundaries and the location of the
'   sample mean (box if in bounds, * if outside).
'----------------------------------------------------------------------------

'   Procedures:
'       Number:   returns a sample mean xBar .

'   Parameters:
'      Rejects:   number of sample means that fall in the rejection region

'   Local variables:
'         xBar:   sample mean (from a simulation of a random sample)

CALL Number(xBar)                   ' <--  fetch a random number N(30,5^2)

' Boundaries and centre line of rejection region (two tailed):
LOCATE , 20
PRINT CHR$(179); TAB(30); CHR$(124); TAB(40); CHR$(179);
LOCATE , CINT(xBar)

IF xBar < 20 OR xBar > 40 THEN      ' Sample mean in rejection region [error]
    COLOR 12, 0                     ' Bright red on black
    PRINT "*"
    LET Rejects = Rejects + 1
ELSE                                ' Sample mean OK [no error]
    COLOR 2, 0                      ' Green on black
    PRINT CHR$(178)                 ' Half-hatching block
END IF

COLOR 7, 0

END SUB

SUB Number (xBar)
'----------------------------------------------------------------------------
'   Returns a sample mean xBar (from a simulation of a random sample)
'    which is from a normal distribution, mean 30, standard deviation 5.
'----------------------------------------------------------------------------

'   Procedures:
'       <none>

'   Parameters:
'        xBar:   the sample mean.

'   Local variables:
'         Sum:   sum of 300 values of the RND function
'           i:   loop counter
'           x:   current value of the pseudorandom number RND (uniform 0,1)
DIM Sum AS DOUBLE, i AS INTEGER

LET Sum = 0

FOR i = 1 TO 300           ' <--   making use of X ~ U(0,1)
    LET x = RND            '       -> sum(X) ~ N(n/2, n/12).   With n = 300,
    LET Sum = Sum + x      '       sum(X) ~ N(150, 25),   (Cent.limit thm.)
NEXT i

LET xBar = Sum - 120       '       and we require  XBar ~ N(30,5^2).

END SUB

SUB Summary (Rejects AS INTEGER)
'----------------------------------------------------------------------------
'   Print a summary of the number of times the sample mean fell (incorrectly)
'    in the rejection region.
'----------------------------------------------------------------------------

'   Procedures:
'      ClearBox:  clears text from a rectangular area of the screen

'   Parameters:
'       Rejects:  number of sample means that fall in the rejection region

'   Local variables:
'       <none>

CALL ClearBox(45, 79, 12, 16)
COLOR 7, 0                              ' White on black
LOCATE 12, 45
PRINT "In 100 samples the test of"
LOCATE 13, 45                           ' 230 = mu, 216 = not equals
PRINT "   Ho: "; CHR$(230); "=30 vs. Ha: "; CHR$(230); CHR$(216); "30"
LOCATE 14, 45
PRINT "resulted in rejection of Ho "
LOCATE 15, 45
PRINT "incorrectly (type I error) "
LOCATE 16, 45
COLOR 15, 0                             ' Bright white on black
PRINT "      on"; Rejects; "occasions."
LOCATE 18, 45
PRINT "Rejection level was set at"
LOCATE 19, 52
PRINT CHR$(224); " = 0.0500 ."           ' 224 = alpha
COLOR 7, 0                              ' White on black

END SUB

SUB Title
'----------------------------------------------------------------------------
'   Print a header on the screen.
'----------------------------------------------------------------------------

'   No procedures, parameters or local variables.

COLOR 7, 0                             ' White on black
LOCATE 1, 10
PRINT "Simulation for Hypothesis Testing (";
PRINT "Ho: "; CHR$(230); "=30 vs. Ha: "; CHR$(230); CHR$(216); "30,";
PRINT CHR$(229); "=5)"            ' 230 = mu, 216 = not equals, 229 = sigma
PRINT TAB(30); CHR$(230)

END SUB

SUB Update (Simulation AS INTEGER, Rejects AS INTEGER)
'----------------------------------------------------------------------------
'   Print an update on screen of the number of confidence intervals so far
'    that have failed to contain the population mean.
'----------------------------------------------------------------------------

'   Procedures:
'      ClearBox:   Clear all text from a rectangle on screen

'   Parameters:
'  Simulation:  # simulations so far
'     Rejects:  number of sample means that fall in the rejection region

'   Local variables:
'    ThisLine:  row number on screen for this simulation
DIM ThisLine AS INTEGER

CALL Title
CALL ClearBox(50, 78, 4, 7)
COLOR 7, 0
LOCATE 4, 50: PRINT "   # samples: ";
PRINT USING "###"; Simulation
LOCATE 5, 50: PRINT "# rejections: ";
PRINT USING "###"; Rejects
COLOR 15, 0                             ' Bright white on black
LOCATE 7, 50: PRINT "P(type I) "; CHR$(247);      ' 247 = approx equals
PRINT USING " #.####"; (Rejects / Simulation)
COLOR 7, 0                              ' White on black

LET ThisLine = Simulation MOD 20 + 3
IF (ThisLine - 3) MOD 20 = 0 THEN SLEEP 1
IF Simulation < 100 THEN CALL ClearBox(1, 55, ThisLine, ThisLine)
LOCATE ThisLine, 1

END SUB