Attribute VB_Name = "AHSRates338"
Option Explicit
Private Service As Object
Private LastResult As String
Private Function Q(ByVal s As String) As String
    Q = Chr(34) & s & Chr(34)
End Function
Private Function JNum(ByVal v As Variant) As String
    If IsEmpty(v) Or IsError(v) Then Err.Raise 5, , "Missing or error input"
    If Not IsNumeric(v) Or VarType(v) = vbBoolean Then Err.Raise 5, , "Numeric input required"
    JNum = Replace(Trim$(Str$(CDbl(v))), ",", ".")
End Function
Private Function S(ByVal raw As String, ByVal key As String) As String
    Dim re As Object, matches As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = Chr(34) & key & Chr(34) & "\s*:\s*" & Chr(34) & "([^" & Chr(34) & "]*)" & Chr(34)
    Set matches = re.Execute(raw)
    If matches.Count = 0 Then Err.Raise 5, , "Response field missing: " & key
    S = matches(0).SubMatches(0)
End Function
Private Function N(ByVal raw As String, ByVal key As String) As Double
    Dim re As Object, matches As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = Chr(34) & key & Chr(34) & "\s*:\s*(-?[0-9]+(?:\.[0-9]+)?(?:[eE][+-]?[0-9]+)?)"
    Set matches = re.Execute(raw)
    If matches.Count = 0 Then Err.Raise 5, , "Numeric response field missing: " & key
    N = Val(matches(0).SubMatches(0))
End Function
Private Function SeriesJSON(ByVal sheet As String, ByVal col As Long, ByVal first As Long, ByVal last As Long) As String
    Dim i As Long, out As String
    out = "["
    For i = first To last
        If i > first Then out = out & ","
        out = out & JNum(ThisWorkbook.Worksheets(sheet).Cells(i, col).Value2)
    Next i
    SeriesJSON = out & "]"
End Function
Public Sub RunAHS338()
    On Error GoTo Failed
    Dim market As String, swap As String, exercise As String, berm As String, pricer As String
    Dim raw As String, surface As String, body As String, out As String, i As Long
    Dim w As Worksheet, m As Worksheet, tr As Worksheet, result As Worksheet
    Set w = ThisWorkbook.Worksheets("Market")
    Set m = ThisWorkbook.Worksheets("Model")
    Set tr = ThisWorkbook.Worksheets("Trade")
    Set result = ThisWorkbook.Worksheets("Results")
    ' One instance retained for the full object lifecycle.
    If Service Is Nothing Then Set Service = CreateObject("AHS.Rates338")
    If Not IsDate(w.Range("B5").Value) Then Err.Raise 5, , "Market!B5: date required"
    raw = Service.CreateMarket("{""valuation_date"":" & Q(Format$(w.Range("B5").Value, "yyyy-mm-dd")) & ",""currency"":" & Q(CStr(w.Range("B6").Value)) & "}")
    market = S(raw, "id")
    body = "{""market_id"":" & Q(market) & ",""curve"":{""times"":" & SeriesJSON("Curves", 1, 6, 13) & ",""discount_factors"":" & SeriesJSON("Curves", 3, 6, 13) & ",""interpolation"":" & Q(CStr(w.Range("B7").Value)) & "}}"
    market = S(Service.AddCurve(body), "id")
    surface = "["
    For i = 6 To 8
        If i > 6 Then surface = surface & ","
        surface = surface & "[" & JNum(ThisWorkbook.Worksheets("Volatility").Cells(i, 2).Value2) & "," & JNum(ThisWorkbook.Worksheets("Volatility").Cells(i, 3).Value2) & "," & JNum(ThisWorkbook.Worksheets("Volatility").Cells(i, 4).Value2) & "]"
    Next i
    surface = surface & "]"
    body = "{""market_id"":" & Q(market) & ",""surface"":{""quote_convention"":""normal_decimal_sqrt_year"",""expiries"":" & SeriesJSON("Volatility", 1, 6, 8) & ",""tenors":[" & JNum(ThisWorkbook.Worksheets("Volatility").Range("B5").Value2) & "," & JNum(ThisWorkbook.Worksheets("Volatility").Range("C5").Value2) & "," & JNum(ThisWorkbook.Worksheets("Volatility").Range("D5").Value2) & "],""values"":" & surface & "}}"
    market = S(Service.AddVolatilitySurface(body), "id")
    market = S(Service.SetModelParameters("{""market_id"":" & Q(market) & ",""a"":" & JNum(m.Range("B5").Value2) & ",""sigma"":" & JNum(m.Range("B6").Value2) & "}"), "id")
    body = "{""notional"":" & JNum(tr.Range("B5").Value2) & ",""start"":" & JNum(tr.Range("B6").Value2) & ",""fixed_rate"":" & JNum(tr.Range("B7").Value2) & ",""direction"":" & JNum(tr.Range("B8").Value2) & ",""payment_times"":" & SeriesJSON("Trade", 1, 12, 16) & "}"
    swap = S(Service.CreateSwap(body), "id")
    exercise = S(Service.CreateExerciseSchedule("{""times"":" & SeriesJSON("Exercise", 1, 6, 10) & "}"), "id")
    berm = S(Service.CreateBermudanSwaption("{""swap_id"":" & Q(swap) & ",""exercise_id"":" & Q(exercise) & "}"), "id")
    pricer = S(Service.CreatePricer("{""market_id"":" & Q(market) & ",""trade_id"":" & Q(berm) & ",""steps"":" & JNum(m.Range("B7").Value2) & "}"), "id")
    raw = Service.RunValuation("{""pricer_id"":" & Q(pricer) & "}")
    LastResult = S(raw, "result_id")
    result.Range("B5").Value2 = N(raw, "price")
    result.Range("B7").Value2 = LastResult
    result.Range("B8").Value = Now
    result.Range("B9").Value2 = "COM calculation completed on this Windows session"
    raw = Service.ComputeSensitivities("{""pricer_id"":" & Q(pricer) & ",""bump"":" & JNum(m.Range("B8").Value2) & "}")
    ThisWorkbook.Worksheets("Sensitivities").Range("B5").Value2 = N(raw, "up")
    ThisWorkbook.Worksheets("Sensitivities").Range("B6").Value2 = N(raw, "down")
    ThisWorkbook.Worksheets("Sensitivities").Range("B7").Value2 = N(raw, "central_change")
    For i = 5 To 7
        raw = Service.RunScenario("{""pricer_id"":" & Q(pricer) & ",""parallel_shift"":" & JNum(ThisWorkbook.Worksheets("Scenarios").Cells(i, 1).Value2) & "}")
        ThisWorkbook.Worksheets("Scenarios").Cells(i, 2).Value2 = N(raw, "price")
    Next i
    raw = Service.GetDiagnostics("{""pricer_id"":" & Q(pricer) & "}")
    ThisWorkbook.Worksheets("Diagnostics").Range("B5").Value2 = N(raw, "curve_fit_max_abs")
    ThisWorkbook.Worksheets("Diagnostics").Range("A10").Value2 = raw
    Application.Calculate
    Exit Sub
Failed:
    ThisWorkbook.Worksheets("Results").Range("B5").ClearContents
    ThisWorkbook.Worksheets("Results").Range("B9").Value2 = "Error: " & Err.Description
    MsgBox Err.Description, vbExclamation, "AHS Rates338"
End Sub
Public Sub ExportAHS338()
    On Error GoTo Failed
    If Service Is Nothing Or Len(LastResult) = 0 Then Err.Raise 5, , "RunAHS338 must succeed first"
    ' ExportCSV is a COM convenience wrapper over ExportResults.csv.
    Dim raw As String, stream As Object, destination As Variant
    raw = Service.ExportCSV(LastResult)
    destination = Application.GetSaveAsFilename("AHS-Rates338-export.csv", "CSV (*.csv), *.csv")
    If VarType(destination) = vbBoolean Then Exit Sub
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2
    stream.Charset = "utf-8"
    stream.Open
    stream.WriteText raw
    stream.SaveToFile CStr(destination), 2
    stream.Close
    Exit Sub
Failed:
    MsgBox Err.Description, vbExclamation, "AHS Export"
End Sub