Maintenance Policy - RDKEvents Class Module


Option Explicit


'A Windows API function, used to rename progress graphs.
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

'How long between updates of the progress graphs
Const PROGRESS_GRAPH_UPDATE_INTERVAL% = 25

'This variable allows use to receive events from the RDK library:
Dim WithEvents RDKApp As RDKApplication

'Variables that control the real-time progress graph:
Dim m_ShowProgressGraph As Boolean
Dim m_RealJPGFile As String
Dim m_TempJPGFile As String

'Model Parameters:
Dim m_PolicyDuration As Integer
Dim m_MachineReplacementCost As Double
Dim m_ProfitArray(1 To NUM_MACHINE_TYPES) As Double
Dim m_ProbMatrix(1 To NUM_MACHINE_TYPES, 1 To NUM_MACHINE_TYPES) As Double

'This function is used to "connect" an instance of this class module to the
'RDKX library, so it can receive RDKX events:
Public Sub Attach(x As RDKApplication)
   Set RDKApp = x
End Sub

'On shutdown of your application, call this function to "disconnect" the
'class module from the RDKX library:
Public Sub Detach()
   Set RDKApp = Nothing
End Sub

'This function initializes this module for the display of the live updating progress graph:
Public Sub InitializeProgressGraph(showProgressGraph As Boolean, outputDir As String)
   Dim i%
   
   m_ShowProgressGraph = showProgressGraph
      
   If showProgressGraph Then
      'save the names of the "temp" and "real" .jpg file destinations.
      'See the iteration event comments for more information...
      m_TempJPGFile = outputDir & "\temp.jpg"
      m_RealJPGFile = outputDir & "\prog.jpg"
      
      With RDKApp.GraphDefaults
         .RevertToDefaultSettings
         .Destination = RDKJPGFile
         .DestinationFile = m_TempJPGFile
         .PictureHeight = 5000
         .PictureWidth = 6000
         .DisplayMean = True
         .XAxis.Title = "Dollars"
      End With
   End If
End Sub

'This routine copies the variants passed in from the caller, into a set of module global variable
'which are accessed during a simulation:
Public Sub InitializeModelParameters(policyDuration, machineReplacementCost, profitArray, probMatrix)
   Dim i%
   Dim j%
   
   m_PolicyDuration = CInt(policyDuration)
   m_MachineReplacementCost = CDbl(machineReplacementCost)
   For i = 1 To NUM_MACHINE_TYPES
      m_ProfitArray(i) = profitArray(LBound(profitArray) + i - 1)
   Next i
   For i = 1 To NUM_MACHINE_TYPES
      For j = 1 To NUM_MACHINE_TYPES
         m_ProbMatrix(i, j) = probMatrix(LBound(probMatrix, 1) + i - 1, LBound(probMatrix, 2) + j - 1)
      Next j
   Next i
End Sub

'This is an RDKX event which is called each iteration of an RDK simulation.
'Each iteration, the entire model is recalculated by valling the CalculateAverageProfit
'function for each output.  Also, every PROGRESS_GRAPH_UPDATE_INTERVAL iterations,
'a progress graph is generated.
Private Sub RDKApp_Iteration(whichSim As Long, whichIter As Long, cancel As Boolean)
   Dim i%
   
   With RDKApp
      For i = 1 To NUM_POLICIES
         .Outputs(i) = CalculateAverageProfit(i)
      Next i
      
      'If necessary, update the progress graph:
      If m_ShowProgressGraph And (whichIter Mod PROGRESS_GRAPH_UPDATE_INTERVAL = 0) Then
         .GraphDefaults.MainTitle = "Simulating" & vbLf & whichIter & " Iterations"
         .Outputs(1).results.Graph RDKResultCurveTypeCumulativeAscending, .Outputs(2).results, .Outputs(3).results, .Outputs(4).results
         
         'To make sure the progress graph update smoothly on the web, the graph is written to
         'a "temp" .jpg file and then renamed to the "real" .jpg file that a web browser can
         'read.  This keeps us from accidentally writing to a file which the web server is in the
         'middle of delivering to a client.  We make use of the Windows API function "MoveFile"
         'to do this.  If the web server is in the middle of serving up the \prog.jpg file,
         'the MoveFile call will fail, and will not interrupt the web server.
         On Error Resume Next
         Kill m_RealJPGFile
         MoveFile m_TempJPGFile, m_RealJPGFile
         On Error GoTo 0
      End If
   End With
End Sub

'This function calculates the average profit corresponding to a given replacement policy,
'given all the defined model input parameters.
Private Function CalculateAverageProfit(replacementPolicy%) As Double
   Dim currentMachineType%
   Dim replaceMachineThreshold%
   Dim totalProfit#
   Dim x#(1 To NUM_MACHINE_TYPES)
   Dim p#(1 To NUM_MACHINE_TYPES)
   Dim i%
   Dim j%
   
   'we always start with an "excellent" machine at the beginning
   currentMachineType = 1
   
   'Based on the replacementPolicy, determine how bad a machine is allowed to get before it will be replaced:
   replaceMachineThreshold = (5 - replacementPolicy)
   
   For i = 1 To m_PolicyDuration
      'Determine, based on the current update policy, whether we will replace the machine
      'If we replace the machine, it becomes "excellent" again, but we must pay the replacement cost:
      If currentMachineType > replaceMachineThreshold Then
         currentMachineType = 1
         totalProfit = totalProfit - m_MachineReplacementCost
      End If
      
      'Add the appropraite profit for the given machine type to the running total:
      totalProfit = totalProfit + m_ProfitArray(currentMachineType)
                                       
      'Determine the new state of the machine for the next week. This is done by sampling
      'a RISKDiscrete function using on the appopriate probabilities in the probMatrix:
      For j = 1 To NUM_MACHINE_TYPES
         x(j) = j
         p(j) = m_ProbMatrix(currentMachineType, j)
      Next j
      currentMachineType = RISKDiscrete(x(), p())
   Next i
   
   CalculateAverageProfit = totalProfit / m_PolicyDuration
End Function
VB Source Code Publisher R2