'============================================================================
' G.H. George                   BIRTHDAY.BAS                     1997 09 10
' Program to simulate the probability of at least two people sharing a
' birthday in a room of 25 people.                 Last modified 2003 09 26
'============================================================================

' Procedures:
'   IntroScreen:    Present welcome message
'   Bubble:         Bubble sort array of birthdays
'   Table:          Display all birthdays in current simulation
'   Update:         Print current frequency of shared birthdays 
'   PressAnyKey:    Prompt user to press any key for next simulation
DECLARE SUB IntroScreen ()
DECLARE SUB Bubble (Array() AS INTEGER, Length AS INTEGER)
DECLARE SUB Table (Date() AS INTEGER, Success AS INTEGER)
DECLARE SUB Update (Success AS INTEGER, Simulation AS INTEGER)
DECLARE SUB PressAnyKey (Skip AS INTEGER)

' Global constants:
'   False:          logical false (= 0)
'   True:           logical true (= -1)

' Variables:
'   Date():         Array of birthdays of people in the room
'   Person:         Loop counter = current person
'   Simulation:     Loop counter = current simulation number
'   Skip:           Logical variable; if true then skip prompt
'   Success:        Number of simulations with shared birthdays

CONST False = 0, True = NOT False

DIM Date(0 TO 26) AS INTEGER
DIM Success AS INTEGER, Skip AS INTEGER
DIM Simulation AS INTEGER, Person AS INTEGER

RANDOMIZE TIMER
CALL IntroScreen
LET Success = 0
LET Skip = False
LET Date(0) = 0                    ' Allows first and last people to be
LET Date(26) = 0                   '  compared with both neighbours.

FOR Simulation = 1 TO 100

    FOR Person = 1 TO 25                           ' Assign random birthdays
        LET Date(Person) = 1 + INT(365 * RND)      '  to each person
    NEXT Person

    CALL Bubble(Date(), 25)
    CALL Table(Date(), Success)
    CALL Update(Success, Simulation)
    IF NOT Skip THEN CALL PressAnyKey(Skip)
NEXT Simulation

CALL PressAnyKey(Skip)             ' Hold final output on screen.
END

SUB Bubble (Array() AS INTEGER, Length AS INTEGER)
'============================================================================
'  Bubble sort routine to sort an  Array  of given  Length  into ascending
'   order.                                                 G.H. George, 1995
'============================================================================

'   Procedures:
'       <none>

'   Local variables:
'       Last:   Last element to compare in the current pass.
'     Sorted:   Logical variable, = True  if and only if the array is sorted.
'    Element:   Current element of  Array.

DIM Last AS INTEGER, Sorted AS INTEGER, Element AS INTEGER

LET Last = Length - 1

DO
    LET Sorted = True                  ' Array is sorted unless a swap occurs.
  
    FOR Element = 1 TO Last
      
        IF Array(Element) > Array(Element + 1) THEN
            SWAP Array(Element), Array(Element + 1)
            LET Sorted = False
        END IF

    NEXT Element
  
    LET Last = Last - 1
LOOP UNTIL Sorted

END SUB

SUB IntroScreen
'---------------------------------------------------------------------------
'  Print header and unchanging parts of the background of the page.
'---------------------------------------------------------------------------

' No procedures or local variables.

CLS
PRINT "100 simulations of the birthdays of 25 randomly chosen people, "
PRINT "to estimate  P[>=2 people in the room of 25 share a birthday]."
PRINT
PRINT
PRINT TAB(11); "# simulations"; TAB(30); "# simulations in which"
PRINT TAB(13); "completed";
PRINT TAB(28); "shared birthday(s) occur(s)    P[shared birthday]"
LOCATE 11, 1
PRINT "Birthdays in the current simulation:"
PRINT                                        ' Cursor now waiting on row 13.

END SUB

SUB PressAnyKey (Skip AS INTEGER)
'---------------------------------------------------------------------------
'  Pause until the user presses any key.
'---------------------------------------------------------------------------

' Procedures:
'   <none>

' Local Variable:
'   Reply$:     the key pressed by the user

LOCATE 25, 1
PRINT "Press any key to continue("; CHR$(34); "S"; CHR$(34);
PRINT " to skip this prompt in future): ";
LOCATE 8, 1

DO
    LET Reply$ = INKEY$
LOOP UNTIL Reply$ <> ""

IF UCASE$(Reply$) = "S" THEN LET Skip = True

END SUB

SUB Table (Date() AS INTEGER, Success AS INTEGER)
'---------------------------------------------------------------------------
'  Display all birthdays in current simulation.
'---------------------------------------------------------------------------

' Procedures:
'   <none>

' Local Variables:
'   Row:    loop counter = current row of table
'   Col:    loop counter = current column of table
'   Entry:  array subscript
'   Match:  logical variable = true iff >=2 pairs of dates are the same

LOCATE 13, 1
LET Match = False

FOR Row = 1 TO 5
    PRINT TAB(17);

    FOR Col = 1 TO 5
        LET Entry = 5 * (Row - 1) + Col

        IF Date(Entry) = Date(Entry - 1) OR Date(Entry) = Date(Entry + 1) THEN
            LET Match = True
            COLOR 12, 0         ' Red if birthday = either neighbour
        ELSE
            COLOR 7, 0          ' White otherwise
        END IF

        PRINT USING "###     "; Date(Entry);
    NEXT Col

    PRINT : PRINT
NEXT Row

IF Match THEN LET Success = Success + 1
COLOR 7, 0                      ' Restore to white on black

END SUB

SUB Update (Success AS INTEGER, Simulation AS INTEGER)
'---------------------------------------------------------------------------
'  Print current frequency of shared birthdays.
'---------------------------------------------------------------------------

' No procedures or local variables.

LOCATE 8, 16
PRINT USING "###"; Simulation;
LOCATE 8, 39
PRINT USING "###"; Success;
LOCATE 8, 65
PRINT USING "#.####"; CSNG(Success) / CSNG(Simulation)

END SUB