VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CDS_Factorizator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ========= Module for floating point value groupings ===============
' Shared module version: 20210412
' Tested in: TestVisio
' Depends on:
' Required reference: Scripting

' Note: elements should be comparable
Option Explicit

Private gap_ As Double
Private values_ As Scripting.Dictionary
Private factors_ As Scripting.Dictionary

Public Function Init(dDividerGap As Double)
  gap_ = dDividerGap
  Set factors_ = New Scripting.Dictionary
  Set values_ = New Scripting.Dictionary
End Function

Public Property Get Values() As Scripting.Dictionary
  Set Values = values_
End Property

Public Function Insert(vNewItem As Variant, dValue As Double) As Boolean
  Insert = Not values_.Exists(vNewItem)
  If Not Insert Then _
    Exit Function

  values_(vNewItem) = dValue
  factors_(vNewItem) = vNewItem
  If values_.Count = 1 Then _
    Exit Function
  
  Dim vItem As Variant
  For Each vItem In values_
    If vItem = vNewItem Then _
      GoTo NEXT_ITEM
    If VBA.Abs(values_(vItem) - dValue) > gap_ Then _
      GoTo NEXT_ITEM
    
    If FactorValueFor(vItem) >= FactorValueFor(vNewItem) Then
      Call MergeFactors(factors_(vNewItem), factors_(vItem))
    Else
      Call MergeFactors(factors_(vItem), factors_(vNewItem))
    End If
NEXT_ITEM:
  Next vItem
End Function

Public Function FactorFor(vItem As Variant) As Variant
  If values_.Exists(vItem) Then _
    FactorFor = factors_(vItem)
End Function

Public Function FactorValueFor(vItem As Variant) As Double
  If values_.Exists(vItem) Then _
    FactorValueFor = values_(factors_(vItem))
End Function

' =====
Private Function MergeFactors(vOld As Variant, vNew As Variant)
  Dim vItem As Variant
  For Each vItem In factors_
    If factors_(vItem) = vOld Then _
      factors_(vItem) = vNew
  Next vItem
End Function