Visual Basic Version, Listing




Option Explicit
Global TN1  As String  'Team's name, 1st place team
Global TN2  As String  'Team's name, 2nd place team
Global GL1  As Integer 'Games Left to play, 1st place team
Global GL2  As Integer 'Games Left to play, 2nd place team
Global GE   As Integer 'Games to play each other
Global GA   As Double  'Games 1st place team is ahead. 0, 0.5, ...
Global GA2  As Long    'Twice games ahead = 2 * GA, 0, 1, ...
Global MNT1 As Long    'Magic Number to tie for 1st place team
Global MNW1 As Long    'Magic Number to win for 1st place team
Global MNT2 As Long    'Magic Number to tie for 2nd place team
Global MNW2 As Long    'Magic Number to win for 2nd place team
Global P    As Double  'Probability that 1st place team beats 2nd place team
Global Q    As Double  'Probability that 2nd place team beats 1st place team
Global GAEr As Integer 'True if GA value not possible
Global GEEr As Integer 'True if GE value not possible
Global PEr As Integer 'True if Overflow while computing P
Global Namee$
Global Version$
Global Author$
Global Address$
Global Hint1$
Global Hint2$

Sub ComputeProb () 'Compute probability using a bivariate binomial
		   'distribution as a model
  Dim I As Integer
  Dim J As Integer
  Dim a As Double
  Dim B As Double
  Dim Msg, NL

  NL = Chr(10)    ' Define newline.
  On Error GoTo ErrorHandler  'Set up error handler.
  PEr = False
  'If MNT1 < 0 Then MNT1 = 0
  ReDim E(0 To GE) As Double  'Binomial coefficients, games to play each other
  ReDim S(0 To GE) As Double  'Running sum of 2 * E[I]
  If MNT1 >= 0 Then
    ReDim F(0 To MNT1) As Double 'B. C., games not played with each other
    ReDim G(0 To MNT1) As Double 'Sum of 2 * E[I] for 2nd place team win, E[I] for tie
  Else
    ReDim F(0 To 0) As Double
    ReDim G(0 To 0) As Double
  End If

  a = GL1 + GL2 - GE - GE 'A = not played with each other games
  B = 1
  F(0) = 1
  For I = 1 To MNT1 'Compute binomial coefficients
    F(I) = F(I - 1) * a / B
    a = a - 1
    B = B + 1
  Next I
  a = GE
  B = 1
  E(0) = 1
  S(0) = 2
  For I = 1 To GE 'Compute binomial coefficients
    E(I) = E(I - 1) * a / B
    a = a - 1
    B = B + 1
    S(I) = S(I - 1) + 2 * E(I)
  Next I
  For I = 0 To MNT1 'Compute G[I]
    J = Int((MNT1 - I) / 2)
    If J <= GE Then
      G(I) = S(J)
      If (J + J) = (MNT1 - I) Then G(I) = G(I) - E(J) Else 'Adjust for tie
    Else
      G(I) = S(GE)
    End If
  Next I
  Q = 0
  For I = 0 To MNT1 'Compute probability that 2nd place team beats 1st place team
    Q = Q + F(I) * G(I)
  Next I
  a = GL1 + GL2 - GE + 1
  B = Exp(a * Log(2#))  '2 ** Flips (natural log)
  Q = Q / B
  P = 1 - Q
  Exit Sub    ' Exit before entering error handler

ErrorHandler:
  Msg = """" & Error(Err) & """"
  Msg = Msg & NL & NL
  Msg = Msg & "Input numbers are too large!"
  MsgBox Msg  ' Display message.
  P = 0: Q = 0: PEr = True: Exit Sub
End Sub

Sub ExpandCase () 'Compute related data
  Dim I As Long

  GA2 = CLng(2 * GA) 'Round
  I = GL1 + GL2 - GA2
  MNT1 = Int(I / 2): MNW1 = MNT1 + 1
  MNT2 = GL1 + GL2 - MNT1: MNW2 = MNT2 + 1
  I = GL1 + GL2 + GA2
  If (I Mod 2 = 1) Then 'if I is odd
    GAEr = True
  Else
    GAEr = False
  End If
End Sub

Return to Baseball Pennant Race Odds
Return to Harry's Home Page


This page accessed times since October 20, 2004.
Page created by: hjsmithh@sbcglobal.net
Changes last made on Saturday, 14-May-05 12:42:47 PDT

1