visualize.bas

Attribute VB_Name = "Visualize"
Option Explicit

' Excel plan step metrics
'
' Reads the active worksheet, where row 1 is a header row with columns:
'
'   - plan_title (a.k.a. project_title) (required data)
'   - task_title (required data)
'   - step_0_date (optional data)
'   - step_1_date (optional data)
'   - step_2_date (optional data)
'   - etc.
'   - failure_detection_date (optional data)
'   - failure_resolution_date (optional data)
'   - notes (freeform text) (optional data)
'
' For each plan title and task title, calculates the step intervals: the
' duration in calendar days between each consecutive pair of step dates,
' plus the duration from failure_detection_date to failure_resolution_date.
' A duration is "" if either of its dates is blank.
'
' Writes a TSV file with no header row, next to the workbook, with columns:
'
'   - plan_title (same content as input)
'   - task_title (same content as input)
'   - task_duration = duration from the earliest date set anywhere in the
'     row (any step date, failure_detection_date, or
'     failure_resolution_date) to the latest such date ("" when no date
'     is set at all)
'   - step_0_1_duration = duration from step_0_date to step_1_date
'   - step_1_2_duration = duration from step_1_date to step_2_date
'   - etc.
'   - failure_duration = duration from failure_detection_date
'     to failure_resolution_date
'   - task_bar_chart = a horizontal ascii bar visualizing task_duration:
'     one character per calendar day, built by walking the step intervals
'     in step order and rendering each known (non-blank) interval as that
'     many days of a character chosen by the interval's OWN 0-based index
'     among the step intervals (not by which other intervals in the row
'     are known): step_0_1 (index 0) is always ChrW(&H2584) (bottom half
'     block), step_1_2 (index 1) is always ChrW(&H2580) (top half block),
'     step_2_3 (index 2) is bottom-half again, and so on. Any days of
'     task_duration not accounted for by a known interval are appended as
'     one more run of the bottom-half character (index 0's character).
'     See BarChart() for the precise algorithm and the one case it cannot
'     verify against a test fixture (see the NOTE there).
'
' Trailing empty fields are trimmed from each output row.
'
' The file is written as UTF-8 (see Utf8Bytes) so that the bar chart's
' block characters, and any non-ASCII titles, survive on both Windows
' and Mac.
'
' Usage: copy/paste this module into the VBA editor (Alt+F11, or on Mac
' Fn+Option+F11), or import the file via File > Import File, then run the
' macro VisualizePlanStepMetrics while the sheet holding the data is
' active. The macro only reads the sheet; it never modifies cells.
'
' Specification: spec/index.md, with test fixtures under tests/. Three
' companion implementations of the same calculation exist:
' visualize-with-python (a Python package) and the plan-task-step Cargo
' project (a Rust program), both for use outside Excel on a TSV export,
' and formulas.txt (native Excel cell formulas, for use with no macro at
' all).

' The bar chart's two characters, chosen per step interval by its own
' 0-based index among the step intervals (see BarChart): even index ->
' bottom half block, odd index -> top half block. Named ODD/EVEN here for
' the 1-based loop counter i that BarChart() actually indexes with -
' i odd corresponds to index (i - 1) even, i.e. the same interval.
Private Const BAR_CHART_CHAR_ODD As Long = &H2584   ' bottom half block
Private Const BAR_CHART_CHAR_EVEN As Long = &H2580  ' top half block

Public Sub VisualizePlanStepMetrics()
    ' The macro processes whichever sheet is active when it runs, so the
    ' user can keep data sheets and scratch sheets in one workbook.
    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Bound the scan: rightmost used header cell in row 1, and the last
    ' used row in column A (the plan_title column in practice; rows below
    ' the data are ignored either way because untitled rows are skipped).
    Dim lastCol As Long
    Dim lastRow As Long
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' --- Locate columns by header name -------------------------------
    ' Columns are matched by name, not position, so extra columns and any
    ' column order are fine. Matching is case-insensitive and ignores
    ' surrounding whitespace.
    Dim planCol As Long          ' plan_title / project_title
    Dim taskCol As Long          ' task_title
    Dim failDetectCol As Long    ' failure_detection_date (0 = absent)
    Dim failResolveCol As Long   ' failure_resolution_date (0 = absent)
    Dim stepCols() As Long       ' column index of each step_N_date
    Dim stepNums() As Long       ' the N of each step_N_date, for ordering
    Dim stepCount As Long
    ReDim stepCols(1 To lastCol)
    ReDim stepNums(1 To lastCol)

    Dim c As Long
    Dim header As String
    Dim numText As String
    For c = 1 To lastCol
        header = LCase$(Trim$(CStr(ws.Cells(1, c).Value)))
        If header = "plan_title" Or header = "project_title" Then
            ' The spec names the title column both ways: "project_title"
            ' in the input description, "plan_title" in the example -
            ' accept either.
            planCol = c
        ElseIf header = "task_title" Then
            taskCol = c
        ElseIf header = "failure_detection_date" Then
            failDetectCol = c
        ElseIf header = "failure_resolution_date" Then
            failResolveCol = c
        ElseIf header Like "step_*_date" Then
            ' Candidate step column: extract the text between "step_" and
            ' "_date" and require it to be a number. Names such as
            ' "step_one_date" are skipped rather than misinterpreted.
            numText = Mid$(header, Len("step_") + 1, Len(header) - Len("step_") - Len("_date"))
            If IsNumeric(numText) Then
                stepCount = stepCount + 1
                stepCols(stepCount) = c
                stepNums(stepCount) = CLng(numText)
            End If
        End If
    Next c

    ' The two title columns are the only required ones.
    If planCol = 0 Or taskCol = 0 Then
        MsgBox "Header row must contain plan_title (or project_title) and task_title.", vbExclamation, "Visualize"
        Exit Sub
    End If

    ' Sort step columns by step number (simple exchange sort - the list is
    ' tiny), so intervals are computed in step order even if the sheet's
    ' columns are arranged differently.
    Dim i As Long
    Dim j As Long
    Dim tmp As Long
    For i = 1 To stepCount - 1
        For j = i + 1 To stepCount
            If stepNums(j) < stepNums(i) Then
                tmp = stepNums(i): stepNums(i) = stepNums(j): stepNums(j) = tmp
                tmp = stepCols(i): stepCols(i) = stepCols(j): stepCols(j) = tmp
            End If
        Next j
    Next i

    ' --- Build the output lines --------------------------------------
    Dim lines As String
    Dim lineText As String
    Dim planTitle As String
    Dim taskTitle As String
    Dim rowCount As Long
    Dim r As Long
    Dim stepSerials() As Variant   ' this row's step date serials (Empty = blank)
    Dim intervalDays() As Variant  ' this row's step-to-step intervals (Empty = blank)
    Dim taskDuration As Variant    ' this row's task_duration, or Empty
    ReDim stepSerials(1 To stepCount)
    ReDim intervalDays(1 To stepCount)  ' index 1..stepCount-1 used

    For r = 2 To lastRow
        planTitle = Trim$(CStr(ws.Cells(r, planCol).Value))
        taskTitle = Trim$(CStr(ws.Cells(r, taskCol).Value))
        ' Skip fully-untitled rows, e.g. stray blank rows in the sheet.
        If planTitle <> "" Or taskTitle <> "" Then
            ' Read all of this row's step date serials once, up front -
            ' both task_duration and every interval need them.
            For i = 1 To stepCount
                stepSerials(i) = CellDateSerial(ws.Cells(r, stepCols(i)))
            Next i

            ' task_duration spans EVERY date set anywhere in the row -
            ' step dates and failure dates alike - from earliest to
            ' latest. This is why a task with no step dates but a
            ' recorded failure still gets a task_duration and a bar: the
            ' failure interval is itself the task's whole recorded
            ' lifecycle in that case.
            taskDuration = RowTaskDuration(ws, r, stepSerials, stepCount, failDetectCol, failResolveCol)

            ' One interval per consecutive pair of steps: 0-1, 1-2, ...
            ' A blank middle step blanks both intervals touching it;
            ' intervals are never bridged (step 0 to step 2 is not
            ' computed here - that bridging only happens inside
            ' task_duration, above).
            For i = 1 To stepCount - 1
                If IsEmpty(stepSerials(i)) Or IsEmpty(stepSerials(i + 1)) Then
                    intervalDays(i) = Empty
                Else
                    intervalDays(i) = stepSerials(i + 1) - stepSerials(i)
                End If
            Next i

            lineText = planTitle & vbTab & taskTitle
            lineText = lineText & vbTab & VariantOrBlank(taskDuration)
            For i = 1 To stepCount - 1
                lineText = lineText & vbTab & VariantOrBlank(intervalDays(i))
            Next i
            ' The failure interval is independent of the steps. When the
            ' sheet lacks the failure columns, emit the "" field anyway
            ' so the column layout matches the spec.
            If failDetectCol > 0 And failResolveCol > 0 Then
                lineText = lineText & vbTab & DurationDays(ws.Cells(r, failDetectCol), ws.Cells(r, failResolveCol))
            Else
                lineText = lineText & vbTab
            End If
            lineText = lineText & vbTab & BarChart(intervalDays, stepCount, taskDuration)

            ' Trim trailing empty fields: each row ends at its last
            ' non-empty field. The two title fields always remain (the
            ' loop can only remove tabs appended after them).
            Do While Right$(lineText, 1) = vbTab
                lineText = Left$(lineText, Len(lineText) - 1)
            Loop
            ' vbLf (not vbNewLine) so the file matches visualize-with-python's
            ' Unix-flavored output byte for byte on every platform.
            lines = lines & lineText & vbLf
            rowCount = rowCount + 1
        End If
    Next r

    ' --- Write the TSV file ------------------------------------------
    ' Default to "visualize-output.tsv" next to the workbook; an unsaved
    ' workbook has no folder, so prompt for a location instead.
    ' Application.PathSeparator keeps this working on Windows and Mac.
    Dim outPath As String
    If ws.Parent.Path <> "" Then
        outPath = ws.Parent.Path & Application.PathSeparator & "visualize-output.tsv"
    Else
        Dim chosen As Variant
        chosen = Application.GetSaveAsFilename( _
            InitialFileName:="visualize-output.tsv", _
            FileFilter:="Tab-separated values (*.tsv), *.tsv")
        ' GetSaveAsFilename returns False when the user cancels.
        If chosen = False Then Exit Sub
        outPath = CStr(chosen)
    End If

    ' Write in binary mode with manual UTF-8 encoding: Print # would
    ' write the system ANSI code page, mangling the block characters.
    ' Kill any previous run's file first - binary mode writes in place
    ' and would leave stale bytes if the new content is shorter.
    On Error Resume Next
    Kill outPath
    On Error GoTo 0
    Dim f As Integer
    f = FreeFile
    Open outPath For Binary Access Write As #f
    If Len(lines) > 0 Then
        Dim bytes() As Byte
        bytes = Utf8Bytes(lines)
        Put #f, , bytes
    End If
    Close #f

    MsgBox "Wrote " & rowCount & " row(s) to:" & vbNewLine & outPath, vbInformation, "Visualize"
End Sub

' TSV field text for a Variant that is either Empty (blank) or a number:
' "" for Empty, else the number as a string.
Private Function VariantOrBlank(ByVal v As Variant) As String
    If IsEmpty(v) Then Exit Function
    VariantOrBlank = CStr(v)
End Function

' task_duration for one row: calendar days from the earliest date set
' anywhere in the row (any step date, or either failure date) to the
' latest such date. Returns the signed day count as a Long, or Empty when
' no date is set at all anywhere in the row.
Private Function RowTaskDuration(ByVal ws As Worksheet, ByVal r As Long, stepSerials() As Variant, ByVal stepCount As Long, ByVal failDetectCol As Long, ByVal failResolveCol As Long) As Variant
    Dim i As Long
    Dim serial As Variant
    Dim earliest As Variant
    Dim latest As Variant
    earliest = Empty
    latest = Empty

    For i = 1 To stepCount
        serial = stepSerials(i)
        If Not IsEmpty(serial) Then
            If IsEmpty(earliest) Or serial < earliest Then earliest = serial
            If IsEmpty(latest) Or serial > latest Then latest = serial
        End If
    Next i

    If failDetectCol > 0 Then
        serial = CellDateSerial(ws.Cells(r, failDetectCol))
        If Not IsEmpty(serial) Then
            If IsEmpty(earliest) Or serial < earliest Then earliest = serial
            If IsEmpty(latest) Or serial > latest Then latest = serial
        End If
    End If
    If failResolveCol > 0 Then
        serial = CellDateSerial(ws.Cells(r, failResolveCol))
        If Not IsEmpty(serial) Then
            If IsEmpty(earliest) Or serial < earliest Then earliest = serial
            If IsEmpty(latest) Or serial > latest Then latest = serial
        End If
    End If

    ' An exit with earliest Empty returns the default value, Empty.
    If Not IsEmpty(earliest) Then RowTaskDuration = latest - earliest
End Function

' Render one row's task_bar_chart string.
'
' intervalDays(1 To stepCount - 1) holds this row's step-to-step interval
' lengths in step order, each Empty or a Long (see the caller); slot i
' holds the interval at 0-based index (i - 1) among the step intervals -
' i=1 is step_0_1 (index 0), i=2 is step_1_2 (index 1), and so on.
' taskDuration is this row's overall span in days, or Empty.
'
' Walks the known (non-Empty) intervals in step order, rendering each as
' that many characters of a character chosen by the interval's OWN index
' - not by how many known intervals came before it in this row: an even
' index (step_0_1, step_2_3, ...) always renders the bottom-half-block
' character, an odd index (step_1_2, step_3_4, ...) always renders the
' top-half-block character. A row whose only known interval is step_1_2
' therefore renders top-half-block, even though a row where step_0_1 is
' also known renders step_0_1 as bottom-half-block first - confirmed
' against tests/basics/expect.tsv (compare its Plan C row, only step_0_1
' known, all bottom-half-block, against its Plan E row, only step_1_2
' known, all top-half-block).
'
' Because taskDuration's span can extend beyond what the known intervals
' cover - a missing middle step breaks the telescoping sum, or the span
' reaches into a failure date - whatever of taskDuration is left over
' (taskDuration minus the sum of known intervals) is appended as one
' final run of the bottom-half-block character (index 0's character).
'
' NOTE: no test fixture exercises a row with BOTH a known interval AND a
' leftover run in the same bar (every fixture row is either fully
' telescoping - known intervals sum exactly to taskDuration, leftover 0 -
' or has no known intervals at all, where the leftover-is-bottom-half-
' block rule is directly confirmed). Re-check against real data of that
' mixed shape if it matters for your use.
'
' Returns "" when taskDuration is Empty or not positive. A negative
' individual interval (reversed dates) or a negative leftover contributes
' zero characters rather than raising, since a negative repeat count is
' meaningless for a bar chart; the numeric duration fields still show the
' true (possibly negative) value.
Private Function BarChart(intervalDays() As Variant, ByVal stepCount As Long, ByVal taskDuration As Variant) As String
    If IsEmpty(taskDuration) Then Exit Function
    If taskDuration <= 0 Then Exit Function

    Dim result As String
    Dim knownSum As Long
    Dim i As Long
    Dim days As Variant
    Dim code As Long

    For i = 1 To stepCount - 1
        days = intervalDays(i)
        If Not IsEmpty(days) Then
            If (i Mod 2) = 1 Then code = BAR_CHART_CHAR_ODD Else code = BAR_CHART_CHAR_EVEN
            If days > 0 Then result = result & String$(CLng(days), ChrW(code))
            knownSum = knownSum + days
        End If
    Next i

    Dim leftover As Long
    leftover = taskDuration - knownSum
    If leftover > 0 Then
        result = result & String$(leftover, ChrW(BAR_CHART_CHAR_ODD))  ' index 0
    End If

    BarChart = result
End Function

' Duration in calendar days from cellA's date to cellB's date, as a
' string: "0" for same-day pairs, a negative number when cellB precedes
' cellA (useful for spotting data entry mistakes), or "" when either
' cell is blank or is not something Excel recognizes as a date.
Private Function DurationDays(ByVal cellA As Range, ByVal cellB As Range) As String
    Dim a As Variant
    Dim b As Variant
    a = CellDateSerial(cellA)
    b = CellDateSerial(cellB)
    ' Empty means the cell is blank or is not a date; either way the
    ' duration is the function's default value, "".
    If IsEmpty(a) Or IsEmpty(b) Then Exit Function
    DurationDays = CStr(b - a)
End Function

' The calendar day serial number of a cell's date, as a Long, or Empty
' when the cell is blank or is not something Excel recognizes as a date.
' Excel dates are day-count serial numbers with any time-of-day as the
' fraction; Int() drops the fraction so that differences between two
' serials are whole calendar days.
Private Function CellDateSerial(ByVal cell As Range) As Variant
    Dim v As Variant
    v = cell.Value
    ' Blank check: covers Empty cells and cells holding only whitespace.
    ' An exit here returns the function's default value, Empty.
    If Trim$(CStr(v)) = "" Then Exit Function
    ' Non-dates (freeform text, error values) also count as blank.
    If Not IsDate(v) Then Exit Function
    CellDateSerial = CLng(Int(CDbl(CDate(v))))
End Function

' Encode a VBA string (UTF-16 internally) as UTF-8 bytes, with no
' external dependencies: ADODB.Stream would do this on Windows but does
' not exist in Mac Excel. Handles all Basic Multilingual Plane
' characters, which covers both bar chart characters and ordinary titles;
' astral characters (surrogate pairs, e.g. most emoji) are written as
' two 3-byte sequences rather than combined - harmless for this data.
' The input must be non-empty (a zero-length array can't be built in
' VBA); the caller guards.
Private Function Utf8Bytes(ByVal s As String) As Byte()
    Dim out() As Byte
    ' Worst case is 3 bytes per UTF-16 code unit.
    ReDim out(0 To Len(s) * 3 - 1)
    Dim n As Long       ' bytes written so far
    Dim i As Long
    Dim code As Long
    For i = 1 To Len(s)
        ' AscW can return a negative value for code points >= &H8000;
        ' mask to the unsigned 16-bit code unit.
        code = AscW(Mid$(s, i, 1)) And &HFFFF&
        If code < &H80& Then
            ' 1-byte sequence: plain ASCII, including tab and linefeed.
            out(n) = code
            n = n + 1
        ElseIf code < &H800& Then
            ' 2-byte sequence: 110xxxxx 10xxxxxx.
            out(n) = &HC0& Or (code \ &H40&)
            out(n + 1) = &H80& Or (code And &H3F&)
            n = n + 2
        Else
            ' 3-byte sequence: 1110xxxx 10xxxxxx 10xxxxxx.
            ' This is the path both bar chart characters take.
            out(n) = &HE0& Or (code \ &H1000&)
            out(n + 1) = &H80& Or ((code \ &H40&) And &H3F&)
            out(n + 2) = &H80& Or (code And &H3F&)
            n = n + 3
        End If
    Next i
    ReDim Preserve out(0 To n - 1)
    Utf8Bytes = out
End Function