Imports NetOffice.ExcelApi.Enums
Imports NetOffice.ExcelApi
Imports ExcelDna.Integration


Public Module RiskGen
'
'    ' Test methods for Excel-DNA
'    Function TestRiskGen()
'        Return "Hello from the RiskGen Addin"
'    End Function
'
'    <ExcelCommand(MenuName:="RiskGen Test", MenuText:="Write the Excel Version")> _
'    Sub WriteTheVersion()
'        Dim ver As String
'        Dim rng As Range
'
'        ver = Application.Version ' Actually AddInMain.Application
'        rng = Application.Range("B3")
'
'        rng.Value = ver
'    End Sub

    ''''''''''''''''''''''''''''''''''''
    ' Start of ported RiskGen VBA code
    Sub Main()
        Dim i As Double
        Dim WatchAddress As Object
        Dim iters As Object
        Dim WatchResults As Object
        Dim ArrayWidth As Integer
        Dim ScrUpdate As Boolean
        Dim err As Object
        Dim x As Integer
        Dim fError As Boolean

        On Error GoTo Err1

        iters = GetIterations()
        If IsNumeric(iters) = False Then
            GoTo Err2
        Else
            iters = Round(iters, 0)
        End If

        ScrUpdate = ScreenUpdating()


        Application.ScreenUpdating = ScrUpdate

        fError = False
        WatchAddress = GetWatch(fError)
        If fError = True Then GoTo Err3

        ArrayWidth = UBound(WatchAddress)

        ReDim WatchResults(iters + 2, ArrayWidth)

        For i = LBound(WatchAddress) To UBound(WatchAddress)
            WatchResults(0, i) = WatchAddress(i)
        Next i

        WatchResults = GetWatchNames(WatchResults, ArrayWidth)


        For i = 3 To UBound(WatchResults)
            For x = 0 To ArrayWidth
                WatchResults(i, x) = Range(WatchResults(0, x)).Value
            Next x
            Application.Calculate()
            Application.StatusBar = "Iteration " & i - 2 & " of " & UBound(WatchResults) - 2
        Next i

        OutputData(WatchResults, ArrayWidth)
        GenerateHistogram(WatchResults, ArrayWidth)
        ArrangeMyCharts()

        Application.ScreenUpdating = True

        Application.StatusBar = False

        Exit Sub


Err1:
        err = MsgBox(prompt:="The script has encountered and error. Exiting script.", Buttons:=vbOK, Title:="Err1 Message")
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Exit Sub

Err2:
        err = MsgBox(prompt:="Non-numeric entry in iterations input box.  Exiting script.", Buttons:=vbOK, Title:="Err2 Message")
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Exit Sub
Err3:
        err = MsgBox(prompt:="No watch cells have been set. Exiting script.", Buttons:=vbOK, Title:="Err3 Message")
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Exit Sub

    End Sub

    Function GetWatch(ByRef fError As Boolean) As Object
        Dim c As Range
        Dim i As Integer
        Dim WatchAddress As Object
        Dim err As Object

        'determine the size of the watch array
        i = GetWatchCount()

        If i < 0 Then
            fError = True
            Exit Function
        End If


        ReDim WatchAddress(i)

        i = 0
        'search through used range in worksheet to determine cell addresses to watch
        For Each c In ActiveSheet.UsedRange
            If InStr(c.Formula, "WatchOutPut") Then
                WatchAddress(i) = c.get_Address(Nothing, Nothing, XlReferenceStyle.xlA1)
                i = i + 1
            End If
        Next c

        GetWatch = WatchAddress

    End Function


    Function GetWatchCount()
        'returns the size of array to fill with addresses

        Dim c As Range
        Dim i As Integer

        'search through used range in worksheet to determine cell addresses to count for array size
        For Each c In ActiveSheet.UsedRange
            If InStr(c.Formula, "WatchOutPut") Then
                i = i + 1
            End If
        Next c

        GetWatchCount = i - 1

    End Function

    'Function WatchOutPut() As Integer
    '    'dummy function for getting watch cell addresses
    '    'WatchOutPut = 0
    'End Function

    Function GetIterations()
        'determine # of iterations to run or cancel sub
        GetIterations = InputBox(prompt:="How many iterations would you like to run?", Title:="Enter Iterations")
    End Function

    Function GetWatchNames(ByRef WatchResults As Object, ByRef ArrayWidth As Integer)
        'picks some names to enter for cell references to make the output more understandable (often will be odd depending on spreadsheet setup)
        Dim i As Integer
        For i = 0 To ArrayWidth
            WatchResults(1, i) = Range(WatchResults(0, i)).get_End(xlUp).Value
            WatchResults(2, i) = Range(WatchResults(0, i)).get_End(xlToLeft).Value
        Next i

        GetWatchNames = WatchResults
    End Function

    Sub OutputData(ByRef WatchResults As Object, ByVal ArrayWidth As Integer)
        Application.Worksheets.Add()
        Range("a3", Range("a3").get_Offset(UBound(WatchResults), ArrayWidth)).Value = WatchResults
    End Sub

    Function ScreenUpdating()

        If MsgBox(prompt:="Turn off screen updating? Select ""Yes"" for much better performance.  Progress can be viewed in the bottom left status bar.", Buttons:=vbYesNo, Title:="Screen Updating On/Off") = vbYes Then
            ScreenUpdating = False
        Else
            ScreenUpdating = True
        End If

    End Function


    'Function RiskGenDiscrete(x As Range)
    '    Dim Discrete As Variant
    '    Application.Volatile
    '    Discrete = x.Value
    '    RiskGenDiscrete = Discrete(WorksheetFunction.RandBetween(LBound(Discrete), UBound(Discrete)), 1)
    'End Function
    '
    'Function RiskGenNormal(mean As Double, stdev As Double)
    '    Application.Volatile
    '    RiskGenNormal = Application.WorksheetFunction.Norm_Inv(Rnd(), mean, stdev)
    'End Function

    Sub GenerateHistogram(ByVal WatchResults As Object, ByVal ArrayWidth As Integer)
        Dim min, max, x, binSize, optBinNum, cBinSize, c, i, HistAdv As Double
        Dim OptBin As Object

        'optimal bin algo is wrong, not sure why

        'Pick Spot to drop first bin
        'need to fix for only 1 watch

        If Range("b3").Value = "" Then
            Range("d3").Activate()
        Else
            Range("a3").get_End(xlToRight).get_Offset(0, 2).Select()
        End If

        HistAdv = 0
        For i = 0 To ArrayWidth
            HistAdv = HistAdv + 1
            Application.StatusBar = "Creating histogram " & HistAdv & " of " & ArrayWidth + 1
            cBinSize = 0
            min = WatchResults(3, i)
            max = min

            'min and max of each array column for histogram bin optimization
            For x = 3 To UBound(WatchResults)
                If WatchResults(x, i) < min Then min = WatchResults(x, i)
                If WatchResults(x, i) > max Then max = WatchResults(x, i)
            Next x

            optBinNum = Application.WorksheetFunction.Min(Round((UBound(WatchResults)) ^ (1 / 2), 0), 100)

            binSize = (max - min) / optBinNum
            cBinSize = min + binSize

            'create new array for each binning process
            ReDim OptBin(optBinNum - 1, 1)

            For c = LBound(OptBin) To UBound(OptBin)
                OptBin(c, 0) = cBinSize
                cBinSize = cBinSize + binSize
            Next c

            'bin data
            For x = 3 To UBound(WatchResults)
                For c = LBound(OptBin) To UBound(OptBin)
                    If WatchResults(x, i) <= OptBin(c, 0) Then
                        OptBin(c, 1) = OptBin(c, 1) + 1
                        Exit For
                    End If
                Next c
            Next x

            ActiveCell.get_Offset(-1, 1).Value = WatchResults(0, i) & " " & WatchResults(1, i) & " " & WatchResults(2, i)
            Range(ActiveCell, ActiveCell.get_Offset(UBound(OptBin), 1)).Value = OptBin

            'throw some charts in
            ChartIt()

        Next i


        Application.StatusBar = False

    End Sub

    Private Sub ArrangeMyCharts()
        Dim iChart As Long
        Dim nCharts As Long
        Dim dTop As Double
        Dim dLeft As Double
        Dim dHeight As Double
        Dim dWidth As Double
        Dim nColumns As Long
        dTop = 0 ' top of first row of charts
        dLeft = 0 ' left of first column of charts
        dHeight = 200 ' height of all charts
        dWidth = 325 ' width of all charts
        nColumns = 3 ' number of columns of charts
        nCharts = DirectCast(ActiveSheet.ChartObjects, Object).Count
        For iChart = 1 To nCharts
            With DirectCast(ActiveSheet.ChartObjects(iChart), Object)
                .Height = dHeight
                .Width = dWidth
                .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
                .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
            End With
        Next
    End Sub

    Sub ChartIt()
        Range(ActiveCell, ActiveCell.get_End(xlDown)).NumberFormat = "0.00"
        With DirectCast(ActiveSheet.ChartObjects, Object).Add(Left:=100, Width:=375, Top:=75, Height:=225)
            .Chart.SetSourceData(Source:=ActiveSheet.get_Range(ActiveCell.get_Offset(-1, 0), ActiveCell.get_End(xlDown).get_Offset(0, 1)))
            .Chart.SeriesCollection(1).Select()
        End With

        DirectCast(ActiveChart.ChartGroups(1), Object).GapWidth = 0
        With Selection.Format.Line
            .Visible = msoTrue
            .Weight = 0.75
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0
        End With
        ActiveChart.Legend.Select()
        Selection.Delete()

        ActiveChart.ChartTitle.Select()
        With Selection.Format.TextFrame2.TextRange.Font
            .BaselineOffset = 0
            .Size = 12
        End With
        ActiveCell.get_Offset(0, 2).Select()
    End Sub

End Module
