Simple Simulation - Application Class Module


Option Explicit

'-----------------------------------------------------------------------------------------------
'This is the public function that is called by the .asp page.  It initializes the RDK,
'sets up an RDK model, runs a simulation, and generates results for display in the calling
'page.
'-----------------------------------------------------------------------------------------------
'
'PARAMETERS:
'All the parameters of this function must be declared as variants, due to the requirements of
'the VBScript code which calls this routine.
'1. outputDir - the destination directory in which all results will be written.
'2. showProgressGraph - a boolean, which determines if a progress graph is displayed.
'3. distMean - the mean of the normal distribution being simulated
'4. distStdDev - the standard deviation of the normal distribution being simulated
'5. distTruncMin - the optional minimum truncation limit of the distribution ("" for none)
'6. distTruncMax - the optional maximum truncation limit of the distribution ("" for none)
'-----------------------------------------------------------------------------------------------
'
'RETURN VALUE:
'A String.  Blank on success, or a descriptive error message on failure.
'-----------------------------------------------------------------------------------------------
'
Public Function Simulate(outputDir, showProgressGraph, distMean, distStdDev, distTruncMin, distTruncMax) As String
   Dim appEvents As New RDKEvents
   Dim errMsg$
                                                                                       
   'Initialize the RDK library, and the RDKEvents object:
   On Error Resume Next
   RDKApp.Init False
   If Err <> 0 Then errMsg = Err.Description: GoTo fail
   On Error GoTo 0
   With appEvents
      .Attach RDKApp
      .InitializeProgressGraph CBool(showProgressGraph), CStr(outputDir)
   End With
                     
   errMsg = SetupModel(distMean, distStdDev, distTruncMin, distTruncMax): If errMsg <> "" Then GoTo fail
   
   errMsg = RunSimulation(): If errMsg <> "" Then GoTo fail
   
   errMsg = GenerateResults(outputDir): If errMsg <> "" Then GoTo fail
                                 
fail:
   'If there was an error, return the error string, else return a blank string:
   If errMsg <> "" Then Simulate = errMsg
   
   'detach the event class module and release the RDK library
   On Error Resume Next
   appEvents.Detach
   RDKApp.Free
   On Error GoTo 0
End Function

'Setup the RDK Model.
'This routine validates the input parameters passed in to the model, and then defines an RDKOutput
'and RDKInput, based on the distribution parameters passed in.
'The return code of this function is a string, which is blank on success or an error description on failure.
Private Function SetupModel(distMean, distStdDev, distTruncMin, distTruncMax) As String
   Dim dist As New RDKDistribution
   Dim errMsg$
   
   'Check if the distribution parameters passed in are valid numeric values:
   If Not IsNumeric(distMean) Then errMsg = "Invalid distribution mean": GoTo fail
   If Not IsNumeric(distStdDev) Then errMsg = "Invalid distribution standard deviation": GoTo fail
   If Trim(distTruncMin) <> "" And Not IsNumeric(distTruncMin) Then errMsg = "Invalid truncation minimum": GoTo fail
   If Trim(distTruncMax) <> "" And Not IsNumeric(distTruncMax) Then errMsg = "Invalid truncation maximum": GoTo fail
      
   'Define a distribution object based on the distribution parameters passed in,
   'and make sure it is valid. An easy way to check if a distribution is valid
   'is to generate its median, and see if an error value is returned.
   With dist
      .DistType = RDKDistTypeNORMAL
      .Arg(1) = CDbl(distMean)
      .Arg(2) = CDbl(distStdDev)
      If distTruncMin <> "" Then .truncMin = CDbl(distTruncMin)
      If distTruncMax <> "" Then .truncMax = CDbl(distTruncMax)
   End With
   If dist.PToX(0.5) = RDKNoValue Then errMsg = "Invalid Function : " & dist.RiskFunction: GoTo fail
                  
   'Finally define the inputs and outputs in the model.
   'In this simple model, there is just one input and one output:
   With RDKApp
      .ClearModel
      .Inputs.Add "theInput", dist
      .Outputs.Add "Simple Simulation"
   End With
   
fail:
   SetupModel = errMsg
End Function

'Actually run the simulation.
'The return code of this function is a string, which is blank on success or an error description on failure:
Private Function RunSimulation() As String
   With RDKApp
      'For web applications, you should turn off the progress bar (which is on by default):
      .simSettings.DisplayProgressBar = False
                                    
      'Tell the RDK we want to run 1000 iterations:
      .simSettings.numIterations = 1000
      
      'Tell the RDK to run the simulatation, and return any error message to the caller:
      'The .Simulate call will pass control to the RDKX library, which will then call the Iteration
      'event (in the RDKEvents module) 1000 times, once for each iteration.  Only when the simulation
      'has completed, will the call to .Simulate return:
      On Error Resume Next
      .Simulate
      If Err <> 0 Then RunSimulation = Err.Description
      On Error GoTo 0
   End With
End Function

'Generate the simulation results:
'For this model, we just make a single histogram graph, ".\HISTOGRAM.JPG", which is suitable
'for display in a web page.
'The return code of this function is a string, which is blank on success or an error description on failure:
Private Function GenerateResults(outputDir) As String
   'Make a histogram of the output:
   With RDKApp.GraphDefaults
      .RevertToDefaultSettings
      .Destination = RDKJPGFile
      .DestinationFile = outputDir & "\histogram.jpg"
      .PictureHeight = 3500
      .PictureWidth = 4500
      .DisplayLegend = False
      .MainTitle = "Simple Simulation"
   End With
   On Error Resume Next
   RDKApp.Outputs(1).Results.Graph RDKResultCurveTypeHistogram
   If Err <> 0 Then GenerateResults = Err.Description
   On Error GoTo 0
End Function
VB Source Code Publisher R2