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 value, which determines if a progress graph is displayed.
'3. currentPrice
'4. putExercisePrice
'5. putDuration
'6. riskFreeRate
'7. actualGrowthRate
'8. volatility
'9. putPrice
'-----------------------------------------------------------------------------------------------
'
'RETURN VALUE:
'A String. Blank on success, or a descriptive error message on failure.
'-----------------------------------------------------------------------------------------------
'
Public Function Simulate(outputDir, showProgressGraph, currentPrice, putExercisePrice, putDuration, riskFreeRate, actualGrowthRate, volatility, putPrice) 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(currentPrice, putExercisePrice, putDuration, riskFreeRate, actualGrowthRate, volatility, putPrice, appEvents): 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 to the model, and then passes them along to the RDKEvent module.
'It also defines an RDKInput and two RDKOutputs.
'The return code of this function is a string, which is blank on success or an error description on failure.
Private Function SetupModel(currentPrice, putExercisePrice, putDuration, riskFreeRate, activeGrowthRate, volatility, putPrice, appEvents As RDKEvents) As String
Dim dist As New RDKDistribution
Dim errMsg$
'Check if the input parameters passed in are valid numeric values:
If Not IsNumeric(currentPrice) Then errMsg = "Invalid current price": GoTo fail
If CDbl(currentPrice) <= 0 Then errMsg = "Current price must be greater than zero": GoTo fail
If Not IsNumeric(putExercisePrice) Then errMsg = "Invalid put exercise price": GoTo fail
If CDbl(putExercisePrice) <= 0 Then errMsg = "Put exercise price must be greater than zero": GoTo fail
If Not IsNumeric(putDuration) Then errMsg = "Invalid put duration": GoTo fail
If CDbl(putDuration) <= 0 Then errMsg = "Put duration must be greater than zero": GoTo fail
If Not IsNumeric(riskFreeRate) Then errMsg = "Invalid risk free rate": GoTo fail
If CDbl(riskFreeRate) <= 0 Then errMsg = "Risk free rate must be greater than zero": GoTo fail
If Not IsNumeric(activeGrowthRate) Then errMsg = "Invalid active growth rate": GoTo fail
If CDbl(activeGrowthRate) <= 0 Then errMsg = "Active growth rate must be greater than zero": GoTo fail
If Not IsNumeric(volatility) Then errMsg = "Invalid volatility": GoTo fail
If CDbl(volatility) < 0 Then errMsg = "Volatility must be positive": GoTo fail
If Not IsNumeric(putPrice) Then errMsg = "Invalid put price": GoTo fail
If CDbl(putPrice) <= 0 Then errMsg = "Put price must be greater than zero": GoTo fail
'Pass validated model parameters to the RDKEvent module, where they will be used during the simulation:
appEvents.InitializeModelParameters currentPrice, putExercisePrice, putDuration, riskFreeRate, activeGrowthRate, volatility, putPrice
'Finally define the inputs and outputs in the model.
With RDKApp
.ClearModel
.Inputs.Add "Sample", "Normal(0,1)"
.Outputs.Add "Without Put"
.Outputs.Add "With Put"
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, three files are generated in the output directory:
'1. .\HISTOGRAM.JPG : A histogram graph comparing the the two outputs
'1. .\CUMULATIVE.JPG : A cumulative graph comparing the the two outputs
'2. .\STATISTICS.JPG : A table of results the two outputs formatted in HTML.
'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
Dim errMsg$
Dim woPutStats As RDKStatistics
Dim withPutStats As RDKStatistics
Dim fileNum%
'Make a histogram comparison graph:
With RDKApp.GraphDefaults
.RevertToDefaultSettings
.Destination = RDKJPGFile
.DestinationFile = outputDir & "\histogram.jpg"
.PictureHeight = 4500
.PictureWidth = 5500
.MainTitle = "Percent Return"
.DisplayMean = True
.Curves(1).CurveStyle = RDKCurveStyleLine
End With
On Error Resume Next
RDKApp.Outputs(1).Results.Graph RDKResultCurveTypeHistogram, RDKApp.Outputs(2).Results
'Make a cumulative comparison graph:
With RDKApp.GraphDefaults
.DestinationFile = outputDir & "\cumulative.jpg"
.YAxis.Title = "Cumulative Probability"
End With
RDKApp.Outputs(1).Results.Graph RDKResultCurveTypeCumulativeAscending, RDKApp.Outputs(2).Results
'Generate statistics for output into a .html file:
On Error Resume Next
Kill outputDir & "\statistics.html"
Err = 0
fileNum = FreeFile()
Open outputDir & "\statistics.html" For Binary As fileNum
If Err <> 0 Then errMsg = "Could write output output statistics file.": fileNum = 0: GoTo fail
On Error GoTo 0
woPutStats = RDKApp.Outputs(1).Results.Statistics
withPutStats = RDKApp.Outputs(2).Results.Statistics
Put fileNum, , "<TABLE><tr><td width = 120 align=left><strong>Statistics</strong></td><td width=120 align=left><strong>% Return <br> Without Put</strong></td><td width=120 align=left><strong>% Return<br>With Put</strong></td></tr>"
Put fileNum, , HTMLTableRow("Minimum", woPutStats.Minimum, withPutStats.Minimum)
Put fileNum, , HTMLTableRow("Maximum", woPutStats.Maximum, withPutStats.Maximum)
Put fileNum, , HTMLTableRow("Mean", woPutStats.mean, withPutStats.mean)
Put fileNum, , HTMLTableRow("Std Dev", woPutStats.StdDeviation, withPutStats.StdDeviation)
Put fileNum, , HTMLTableRow("Skewness", woPutStats.Skewness, withPutStats.Skewness)
Put fileNum, , HTMLTableRow("Kurtosis", woPutStats.Kurtosis, withPutStats.Kurtosis)
Put fileNum, , HTMLTableRow("Mode", woPutStats.mode, withPutStats.mode)
Put fileNum, , HTMLTableRow("5%", woPutStats.percentiles(1), withPutStats.percentiles(1))
Put fileNum, , HTMLTableRow("95%", woPutStats.percentiles(19), withPutStats.percentiles(19))
Put fileNum, , "</TABLE>"
fail:
If fileNum <> 0 Then Close fileNum
If errMsg <> "" Then GenerateResults = errMsg
End Function
Private Function HTMLTableRow$(statName$, col1Value#, col2Value#)
HTMLTableRow = "<tr><td><Strong><SPAN class=subheader_black>" & statName & "</SPAN></Strong></td>" & _
"<td>" & Format(col1Value, "0.0000") & "</td>" & _
"<td>" & Format(col2Value, "0.0000") & "</td>" & _
"</tr>"
End Function
VB Source Code
Publisher R2© Palisade Corporation, eDecisionTools.com, 2001