" & aggTag & "" & strFreq & "" & _
"
" & FormatNumber(aggLoss/1000000,2,,,true) & "M" & _
"
" & FormatNumber(freqMean,3) & "" & FormatNumber(freqVM,3) & "" & _
"
" & strSev & "" & FormatNumber(sevLayer,0,,,true) & "" & _
"
" & FormatNumber(sevAttach,0,,,true) & ""
else
Describe = "
" & aggTag & "" & strFreq & "" & _
"" & FormatNumber(aggLoss,0,,,true) & "" & _
"" & FormatNumber(freqMean,3) & "" & FormatNumber(freqVM,3) & "" & _
"" & strSev & "" & FormatNumber(sevLayer,0,,,true) & "" & _
"" & FormatNumber(sevAttach,0,,,true) & ""
end if
End Function
End Class
''--------------------------------------------------------------------------------------------------------------
'' Gets numerical arguments out of a text box
'' strIn = input text from box
'' nMatchOut = number of rows in match
'' matchOut = array (redimmed here) with the numbers
'' direction = how to interpret input, 0 = column, 1 = n x 2 matrix of Complex numbers in FFT format
''
Sub GetArgs(strIn, nMatchOut, matchOut, direction)
dim obRe, strRegExp, obMatch, n, mm
dim log2
nMatchOut = 0
on error resume next
set obRe = New RegExp
if err.number <> 0 then
msgbox "exiting " & err.description
exit sub
end if
obRe.global = true
obRe.ignorecase = true
strRegExp = "[\-\+]*[\.]*[0-9]+[\.]*[0-9]*[Eed]*[\-\+]*[0-9]*"
obRe.Pattern = strRegExp
set obMatch = obRe.Execute(strIn) '' now contains all the matches
nMatchOut = obMatch.count
'' XXXX need to assure power of two inputs
'' or 2 + power of two if fft format
log2 = log(nMatchOut-direction*2)/log(2)
if log2 - CLng(log2) > 0.000001 then
'' this is not a power of two
nMatchOut = 2 ^ ((CLng(log2) + 1)) '' round up
if g_debug then
msgbox "Input size " & obMatch.Count & " rounded up to " & nMatchOut
end if
end if
if direction = 0 then
'' getting a real vector
'' need to assure padding??
Redim matchOut(nMatchOut-1) '' zero based!
on error resume next
'' this requires the updated version of RegExp
'for n = 0 to obMatch.Count - 1
' matchOut(n) = 0
' matchOut(n) = CDbl(obMatch(n))
'next
'' so we use the old method instead, viz:
n = 0
for each mm in obMatch
matchOut(n) = 0
matchOut(n) = CDbl(mm.value)
n = n + 1
next
' padding if necessary
for n = obMatch.Count to nMatchOut - 1
matchOut(n) = 0
next
else
'' getting an imaginary vector n*2
nMatchOut = CInt((nMatchOut-1)/2)+1
Redim matchOut(nMatchOut-1,1) '' zero based!
dim m
m = 0
n = 0
for each mm in obMatch
if m mod 2 = 0 then
matchOut(n,0) = 0
matchOut(n,0) = CDbl(mm.value)
else
matchOut(n,1) = 0
matchOut(n,1) = CDbl(mm.value)
n = n + 1
end if
m = m + 1
next
end if
on error goto 0
set obMatch = Nothing
Set obRe = Nothing
End Sub
''
'' Gets numerical arguments out of a text box
'' strIn = input text from box
'' nMatchOut = number of rows in match
'' matchOut = array (redimmed here) with the numbers
'' direction = how to interpret input, 0 = column, 1 = n x 2 matrix of Complex numbers in FFT format
''
Sub GetTrg(strIn, nyrs, matchOut)
dim obRe, strRegExp, obMatch, n, m, ct, nMatches, mm
set obRe = New RegExp
obRe.global = true
obRe.ignorecase = true
strRegExp = "[\-\+]*[\.]*[0-9]+[\.]*[0-9]*[Eed]*[\-\+]*[0-9]*"
obRe.Pattern = strRegExp
set obMatch = obRe.Execute(strIn) '' now contains all the matches
nMatches = obMatch.count
if nMatches <> nyrs * (nyrs + 1)/2 then
msgbox "INPUT ERROR"
exit sub
end if
Redim matchOut(nyrs-1, nyrs-1) '' zero based!
on error resume next
ct = 0
'' again, this requires the newer version of vbscript:
' for n = 0 to nyrs-1
' for m = 0 to nyrs-1-n
' matchOut(n,m) = 0
' matchOut(n,m) = CDbl(obMatch(ct))
' ct = ct + 1
' next
' next
'' so we have to hack to this:
n = 0
m = 0
for each mm in obMatch
matchOut(n,m) = 0
matchOut(n,m) = CDbl(mm.value)
m = m + 1
if m > nyrs - 1 - n then
m = 0
n = n + 1
if n > nyrs - 1 then
exit for
end if
end if
next
on error goto 0
set obMatch = Nothing
Set obRe = Nothing
End Sub
' Plain "get args" type function: input text string of numbers in SevText, output number in nSev and array
' in sevDist
'
Sub GetSample(SevText, nSev, sevDist)
'' read in a sample from SevText, dim sevDist and put values in there, set nSev = number of values read
dim obRe, strRegExp, obMatch, n, mm
dim log2
set obRe = New RegExp
obRe.global = true
obRe.ignorecase = true
strRegExp = "[\-\+]*[\.]*[0-9]+[\.]*[0-9]*[Eed]*[\-\+]*[0-9]*"
obRe.Pattern = strRegExp
set obMatch = obRe.Execute(SevText) '' now contains all the matches
nSev = obMatch.count
Redim sevDist(nSev-1) '' zero based!
'' on error resume next
' for n = 0 to nSev - 1
' sevDist(n) = CDbl(obMatch(n))
' next
n = 0
for each mm in obMatch
sevDist(n) = CDbl(mm.value)
n = n + 1
next
set obMatch = Nothing
Set obRe = Nothing
End Sub
Sub GetDensity(SevText, nSev, sevDist)
'' read in an (x, px) density from SevText
'' dim sevDist and put values in there in (x1,...,xn, px1,...,pxn) order
'' set nSev = number of values read (ie full length of vector)
dim obRe, strRegExp, obMatch, n, mm
dim xsize
set obRe = New RegExp
obRe.global = true
obRe.ignorecase = true
strRegExp = "[\-\+]*[\.]*[0-9]+[\.]*[0-9]*[Eed]*[\-\+]*[0-9]*"
obRe.Pattern = strRegExp
set obMatch = obRe.Execute(SevText) '' now contains all the matches
nSev = obMatch.count
if nSev mod 2 <> 0 then
msgbox "Input error, vector must be an even length...attempting to pad"
nSev = nSev + 1
end if
xsize = nSev / 2
Redim sevDist(nSev-1) '' zero based!
' for n = 0 to xsize - 1
' sevDist(n) = CDbl(obMatch(2*n))
' sevDist(n + xsize) = CDbl(obMatch(2*n + 1))
' next
n = 0
for each mm in obMatch
if n mod 2 = 0 then
sevDist(n/2) = CDbl(mm.value)
else
sevDist((n-1)/2 + xsize) = CDbl(mm.value)
end if
n = n + 1
next
nSev = xsize '' return the length of the distribution
set obMatch = Nothing
Set obRe = Nothing
End Sub
'-------------------------------------------------------------------------
' FormatChart
' Chart as an x-y line graph
'
' In:
' cht WCChart reference
' sTitle Chart title
' sXAxis X Axis title
' sYAxis Y Axis title
' sYNumFmt Y axis number format
' fftDist Computed distribution
' actualDist Exactly computed distribution for comparison (??optional)
'
Sub FormatChart(cht, num, unit, sTitle, sYAxis, sXAxis, sYNumFmt, fftDist) '' , actualDist)
FormatChartEx cht, num, unit, sTitle, sYAxis, sXAxis, sYNumFmt, fftDist, false, "", ""
End Sub
Sub FormatChartEx(cht, num, unit, sTitle, sYAxis, sXAxis, sYNumFmt, fftDist, blLegend, caption, serColor)
' Local Variables
Dim ax 'Temp WCAxis object
Dim fnt 'Temp OWCFont object
Dim c 'Constants object
Dim maxX
Dim xs(), nn
Redim xs(num-1)
xs(0) = 0
For nn = 1 To num-1
xs(nn) = xs(nn-1) + unit
Next
maxX = xs(num-1)
Dim white, green
white = RGB(255,255,255)
green = RGB(0,255,0)
set c = cht.Parent.Constants
' outside of the chart (ax control)
With cht
.Border.Color = white ' green
.Border.Weight = 1
' around the plotted piece
.PlotArea.Border.Color = white '' around the plot area
.PlotArea.Interior.Color = white '' inside the graph
.HasLegend = blLegend
End With
if blLegend then
With cht.Legend
.Border.Color = white
.Interior.Color = white
.Position = c.chLegendPositionBottom
.Font.Name = "Georgia"
End With
end if
'' chart title
cht.HasTitle = True
cht.Title.Caption = sTitle
set fnt = cht.Title.Font
fnt.Name = "Georgia"
fnt.Size = 12
fnt.Bold = True
' Set the series caption (the text that appears in the legend).
Dim series '' As Wm_chtseries
Set series = cht.SeriesCollection.Add
With series
if blLegend then
.Caption = caption
end if
.Type = c.chChartTypeScatterLine
.SetData c.chDimYValues, c.chDataLiteral, fftDist
.SetData c.chDimXValues, c.chDataLiteral, xs
.Line.Weight = 1
if serColor <> "" then
.Line.Color = serColor
end if
End With
'' x axis
With cht.Axes(1)
.HasMajorGridlines = False
.MinorTickMarks = c.chTickMarkOutside
.HasTitle = True
.Scaling.Maximum = maxX
.Scaling.Minimum = 0
set fnt = .Title.Font
fnt.Name = "Georgia"
fnt.Size = 8
if maxX > 1000000 then
.NumberFormat = "#,##0,,"
sXAxis =sXAxis & " (Millions)"
elseif maxX > 1000 then
.NumberFormat = "#,##0"
sXAxis =sXAxis
end if
.Title.Caption = sXAxis
End With
'' y axis
With cht.Axes(0)
.HasMajorGridlines = False
.HasTitle = True
.Title.Caption = sYAxis
'' XXXX should be careful with this
.Scaling.Minimum = 0
set fnt = .Title.Font
fnt.Name = "Georgia"
fnt.Size = 8
.NumberFormat = sYNumFmt
End With
End Sub 'FormatChart()
'-------------------------------------------------------------------------
'
'
' Purpose: Change the format of a series in a chart to lollipops (freq dists)
'
' In: series = series to change
'
' Out:
'
Sub ChangeToLollipops(series)
ChangeToLollipopsEx series, true
End Sub
Sub ChangeToLollipopsEx(series, bubbles)
Dim c 'Constants object
Set c = series.Parent.Parent.Constants
Dim er ' As WCErrorBars
Set er = series.ErrorBarsCollection.Add
With series
.Line.Color = "white"
if bubbles then
.Marker.Style = c.chMarkerStyleCircle
end if
End With
With er
.Direction = c.chErrorBarDirectionY
.Include = c.chErrorBarIncludeMinusValues
.Type = c.chErrorBarTypePercent
.Amount = 1
.EndStyle = c.chEndStyleNone
.Line.Color = "green"
.Line.Weight = 1
End With
End Sub
Sub AddLine(cht, xs, ys, strCaption, serColor, series)
'' series is an in/out, incase you want to do anything with it
Dim c
Set c = cht.Parent.Constants
Set series = cht.SeriesCollection.Add
With series
.Caption = strCaption
.Type = c.chChartTypeScatterLine
.SetData c.chDimYValues, c.chDataLiteral, ys
.SetData c.chDimXValues, c.chDataLiteral, xs
.Line.Weight = 1
if serColor <> "" then
.Line.Color = serColor
end if
End With
End Sub
Sub SetUpChart(cht, blLegend)
' Local Variables
Dim ax 'Temp WCAxis object
Dim fnt 'Temp OWCFont object
Dim c 'Constants object
Dim maxX
Dim white, green
white = RGB(255,255,255)
green = RGB(0,255,0)
set c = cht.Parent.Constants
' outside of the chart (ax control)
With cht
.Border.Color = white ' green
.Border.Weight = 1
' around the plotted piece
.PlotArea.Border.Color = white '' around the plot area
.PlotArea.Interior.Color = white '' inside the graph
.HasLegend = blLegend
End With
With cht.Legend
.Border.Color = white
.Interior.Color = white
.Position = c.chLegendPositionBottom
.Font.Name = "Georgia"
End With
'' chart title
cht.HasTitle = True
set fnt = cht.Title.Font
fnt.Name = "Georgia"
fnt.Size = 12
fnt.Bold = True
End Sub
Sub FormatAxes(cht, maxX, sXAxis, sYAxis, sYNumFmt)
'' maxX = largest value on x axis
'' sXAxis = axis title
'' sYAxis = y axis title
'' sYNumFmt = format for y axis
Dim c, fnt
Set c = cht.Parent.Constants
'' x axis
With cht.Axes(1)
.HasMajorGridlines = False
.MinorTickMarks = c.chTickMarkOutside
.HasTitle = True
.Scaling.Maximum = maxX
.Scaling.Minimum = 0
set fnt = .Title.Font
fnt.Name = "Georgia"
fnt.Size = 8
if maxX > 2000000 then
.NumberFormat = "#,##0,,"
sXAxis =sXAxis & " (Millions)"
elseif maxX > 1000 then
.NumberFormat = "#,##0"
sXAxis =sXAxis
end if
.Title.Caption = sXAxis
End With
'' y axis
With cht.Axes(0)
.HasMajorGridlines = False
.HasTitle = True
.Title.Caption = sYAxis
set fnt = .Title.Font
fnt.Name = "Georgia"
fnt.Size = 8
.NumberFormat = sYNumFmt
End With
End Sub
' Format percentage error
'
'
Function getError(x, y)
if x = 0 then
getError = "NA"
else
getError = FormatPercent(y/x-1,4)
end if
End Function
'
' For bivariate distributions, to make it clearer where the prob lives
'
'
Function smFormatNumber(n, p)
if n = 0 then
smFormatNumber = "."
elseif n < 10^(-p) then
smFormatNumber = "+"
else
smFormatNumber = FormatNumber(n,p)
end if
End Function
' Simple distributions, for use in populating text boxes for examples
'
'
'
Function Uniform(n, m)
'' 1/n for n, m in total
Dim i, st
for i = 0 to n-1
st = st & 1/n & vbcr
next
for i = n to m-1
st = st & "0" & vbcr
next
Uniform = st
End Function
' String of distribution 1 with certainty, m long
'
'
Function One(m)
Dim i, st
st = "0" & vbcr & "1" & vbcr
for i = 2 to m-1
st = st & "0" & vbcr
next
One = st
End Function
' String of distribution 2 with certainty, m long
'
'
Function Two(m)
Dim i, st
st = "0" & vbcr & "0" & vbcr & "1" & vbcr
for i = 3 to m-1
st = st & "0" & vbcr
next
Two = st
End Function
' String of all zeros m long
'
'
Function Zero(m)
Dim i, st
for i = 0 to m-1
st = st & "0" & vbcr
next
Zero = st
End Function
Sub DisplayStats(st, what, momOut)
if what = "agg" Or what = "all" then
st = st & "
Adding stats here...
"
end if
End Sub
'-------------------------------------------------------------------------
' Info out of the curve listing
'
'
Function WriteCurves()
dim n, st
dim paramFile, xx
set paramFile = xx.ParamFile
WriteCurves = ""
for n = 16 to paramFile.Count '' start past the fpps!!
WriteCurves = WriteCurves & "
" & paramFile.Name(n) & ""
next
paramFile.Close
End Function
' Generate Neg Bin sample from mean and vm
'
'
Sub GenerateNBValues(n, m, vm, st)
dim r, p, i
redim st(n)
p = 1/vm
r = m / (vm-1)
st(0) = p^r
for i = 1 to n
st(i) = st(i-1) * (1-p) * (r+i-1) / i
next
End Sub
' Generate PIG sample from mean and vm
'
'
Sub GeneratePIGValues(n, m, vm, st)
dim b, i, x, m2
b = vm-1
redim st(n)
x = 1 + 2 * b
m2 = m * m / x
st(0) = exp(-(m/b*(Sqr(x)-1)))
st(1) = m / Sqr(x) * st(0)
for i = 2 to n
st(i) = st(i-1) * 2 * b / x * (1-3/i/2) + m2 / i / (i-1) * st(i-2)
next
End Sub
' Lookup table for contour plot in simpleBivDist
' Note: the argument is ignored at the moment, it is 64
'
Function MakeLookupTable(numColors)
MakeLookupTable = Array("00008F", _
"00009F", "0000AF", "0000BF", "0000CF", "0000DF", "0000EF", _
"0000FF", "000FFF", "001FFF", "002FFF", "003FFF", "004FFF", _
"005FFF", "006FFF", "007FFF", "008FFF", "009FFF", "00AFFF", _
"00BFFF", "00CFFF", "00DFFF", "00EFFF", "00FFFF", "0FFFFF", _
"1FFFEF", "2FFFDF", "3FFFCF", "4FFFBF", "5FFFAF", "6FFF9F", _
"7FFF8F", "8FFF7F", "9FFF6F", "AFFF5F", "BFFF4F", "CFFF3F", _
"DFFF2F", "EFFF1F", "FFFF0F", "FFFF00", "FFEF00", "FFDF00", _
"FFCF00", "FFBF00", "FFAF00", "FF9F00", "FF8F00", "FF7F00", _
"FF6F00", "FF5F00", "FF4F00", "FF3F00", "FF2F00", "FF1F00", _
"FF0F00", "FF0000", "EF0000", "DF0000", "CF0000", "BF0000", _
"AF0000", "9F0000", "8F0000")
End Function
Function GoodSeriesColor(n)
Dim cols
cols = Array(RGB(255,0,0), RGB(0,255,0), RGB(0,0,255), RGB(255,0,255), RGB(155,100,100), RGB(0,100,200), RGB(55,150,150))
GoodSeriesColor = cols(n mod 7)
End Function
Sub ConverMCVSkewToParams(prms)
dim mean, sd, skew, eta, temp1
mean = prms(0)
sd = prms(1) * prms(0)
skew = prms(2)
temp1 = (sqr(skew*skew+4)/2.0+skew/2.0)^0.3333333333333333333333
eta = temp1 - 1/temp1
prms(1) = sqr(log(1+eta*eta))
prms(2) = prms(1) - 1/eta * sd
prms(0) = log(mean - prms(2)) - prms(1)*prms(1)/2.0
End Sub
Sub NormalizeChart(cspace, strAx)
'' per OWC book page 87: normalize axes of all charts in the space
dim cht, ax, nMax, nAx
if strAx = "x" then
nAx = 1
else
nAx = 0
end if
nMax = 0
for each cht in cspace.Charts
Set ax = cht.Axes(nAx)
if ax.Scaling.Maximum > nMax then
nMax = ax.Scaling.Maximum
end if
next
for each cht in cspace.Charts
Set ax = cht.Axes(nAx)
ax.Scaling.Maximum = nMax
' ax.Scaling.Type = 1
next
End Sub
Sub NormalizeChartEx(cspace, strAx, oe)
'' per OWC book page 87: normalize axes of all charts in the space
dim cht, ax, nMax, nAx, i
if strAx = "x" then
nAx = 1
else
nAx = 0
end if
nMax = 0
for i = 0 to cspace.Charts.count - 1
if i mod 2 = oe then
set cht = cspace.Charts(i)
Set ax = cht.Axes(nAx)
if ax.Scaling.Maximum > nMax then
nMax = ax.Scaling.Maximum
end if
end if
next
for i = 0 to cspace.Charts.count - 1
if i mod 2 = oe then
set cht = cspace.Charts(i)
Set ax = cht.Axes(nAx)
ax.Scaling.Maximum = nMax
' ax.Scaling.Type = 1
end if
next
End Sub
Function NiceStats(st)
NiceStats = "" & FormatNumber(st(0), 0,,,true) & " | " & FormatNumber(st(1), 3) & _
" | " & FormatNumber(st(2), 3) & " | "
End Function