配列でベクトル演算

ちょっと先を考えてのテストです。

VBAでベクトルを扱いたいのですが、それっぽいクラスが
無いんですよね・・。
他の言語の場合、手っ取り早くやりたい場合は複素数を使って
計算させているようなのですが、生憎VBAには無いです。

クラスを作るべきとは重々感じているのですが、ちょっとした
計算だけなので、こんな感じの値を2つ持った配列を、
二次元ベクトルとして代用します。（危険な事は知ってます・・・）

array(Xの値,Yの値)

で、それなりの関数を作りました。全て非破壊です。

'vba ベクトル2Dテスト

Option Explicit


Sub CATMain()

    'ベクトル扱いして配列か確認
    dump_msg "---"
    dump_msg is_vecter2d(Array(1, 0, 1)), "Array(1, 0, 1):"
    dump_msg is_vecter2d(Array(1)), "Array(1):"
    dump_msg is_vecter2d(Array(1, "a")), "Array(1, a):"
    dump_msg is_vecter2d(Array(1, 0)), "Array(1, 0):"

    '和
    dump_msg "---"
    Dim v1, v2, s1
    v1 = Array(1, 2)
    v2 = Array(3, 4)
    s1 = Array(1, "a")

    dump_array vec2_add(s1, v1), "vec2_add(s1, v1):"
    dump_array vec2_add(v1, v2), "vec2_add(v1, v2):"

    '差
    dump_msg "---"
    dump_array vec2_diff(s1, v1), "vec2_diff(s1, v1):"
    dump_array vec2_diff(v1, v2), "vec2_diff(v1, v2):"

    '単位ベクトル
    dump_msg "---"
    dump_array vec2_normalize(s1), "vec2_normalize(s1):"
    dump_array vec2_normalize(Array(0, 0)), "vec2_normalize(zero):"
    dump_array vec2_normalize(v1), "vec2_normalize(v1):"

    'スカラー倍
    dump_msg "---"
    dump_array vec2_scaleBy(s1, 2), "vec2_scaleBy(s1,2):"
    dump_array vec2_scaleBy(v1, "a"), "vec2_scaleBy(v1,a):"
    dump_array vec2_scaleBy(v1, 2), "vec2_scaleBy(v1,2):"
    
    '内積
    dump_msg "---"
    Dim axisX, axisY, v3
    axisX = Array(1, 0)
    axisY = Array(0, 1)
    v3 = Array(1, 1)

    dump_msg vec2_dot(v1, s1), "vec2_dot(v1,s1) こいつは正しくない->:"
    dump_msg vec2_dot(v1, v2), "vec2_dot(v1,v2):"
    dump_msg vec2_dot(axisX, axisY), "vec2_dot(axisX, axisY):"
    dump_msg vec2_dot(axisX, axisX), "vec2_dot(axisX, axisX):"
    dump_msg vec2_dot(axisX, v3), "vec2_dot(axisX, v3):"
    
    '外積
    dump_msg "---"
    dump_msg vec2_cross(v1, s1), "vec2_cross(v1,s1) こいつは正しくない->:"
    dump_msg vec2_cross(v1, v2), "vec2_cross(v1,v2):"
    dump_msg vec2_cross(axisX, axisY), "vec2_cross(axisX, axisY):"
    dump_msg vec2_cross(axisX, axisX), "vec2_cross(axisX, axisX):"
    dump_msg vec2_cross(axisX, v3), "vec2_cross(axisX, v3):"

End Sub

'外積
Function vec2_cross( _
    ByVal v1 As Variant, _
    ByVal v2 As Variant) _
    As Double

    If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then
        vec2_cross = Empty
        Exit Function
    End If

    vec2_cross = v1(0) * v2(0) - v1(1) * v2(1)

End Function


'内積
Function vec2_dot( _
    ByVal v1 As Variant, _
    ByVal v2 As Variant) _
    As Double

    If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then
        vec2_dot = Empty
        Exit Function
    End If

    vec2_dot = v1(0) * v2(0) + v1(1) * v2(1)

End Function


'スカラー倍
Function vec2_scaleBy( _
    ByVal v As Variant, _
    ByVal ratio As Variant) _
    As Variant

    If Not is_vecter2d(v) Then
        vec2_scaleBy = Empty
        Exit Function
    End If
    
    If Not IsNumeric(ratio) Then
        vec2_scaleBy = Empty
        Exit Function
    End If

    Dim length As Double
    length = Sqr(v(0) * v(0) + v(1) * v(0))

    vec2_scaleBy = Array(v(0) * ratio, v(1) * ratio)

End Function


'単位ベクトル化
Function vec2_normalize( _
    ByVal v As Variant) _
    As Variant

    If Not is_vecter2d(v) Then
        vec2_normalize = Empty
        Exit Function
    End If

    Dim length As Double
    length = Sqr(v(0) * v(0) + v(1) * v(0))
    
    If length <= 0 Then
        vec2_normalize = Empty
        Exit Function
    End If

    vec2_normalize = Array(v(0) / length, v(1) / length)

End Function


'差
Function vec2_diff( _
    ByVal v1 As Variant, _
    ByVal v2 As Variant) _
    As Variant

    If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then
        vec2_diff = Empty
        Exit Function
    End If

    vec2_diff = Array(v1(0) - v2(0), v1(1) - v2(1))

End Function


'和
Function vec2_add( _
    ByVal v1 As Variant, _
    ByVal v2 As Variant) _
    As Variant

    If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then
        vec2_add = Empty
        Exit Function
    End If
    
    vec2_add = Array(v1(0) + v2(0), v1(1) + v2(1))

End Function


'ベクトル2Dとして扱える配列か?
Private Function is_vecter2d( _
    v As Variant) _
    As Boolean

    Select Case True
        Case Not IsArray(v)
            is_vecter2d = False
        Case UBound(v) <> 1
            is_vecter2d = False
        Case Not IsNumeric(v(0))
            is_vecter2d = False
        Case Not IsNumeric(v(1))
            is_vecter2d = False
        Case Else
            is_vecter2d = True
    End Select

End Function


'配列のダンプ
Private Sub dump_array( _
    ByVal ary As Variant, _
    Optional msg As String)
    
    Select Case True
        Case IsEmpty(ary)
            Debug.Print msg & "** err ** - empty"
        Case Not IsArray(ary)
            Debug.Print msg & "** err ** - not array"
        Case Else
            Debug.Print msg & Join(ary, ",")
    End Select
    
End Sub


'メッセージのダンプ
Private Sub dump_msg( _
    ByVal s As String, _
    Optional msg As String)

    Debug.Print msg & s

End Sub

実行結果はこんな感じです。

---
Array(1, 0, 1):False
Array(1):False
Array(1, a):False
Array(1, 0):True
---
vec2_add(s1, v1):** err ** - empty
vec2_add(v1, v2):4,6
---
vec2_diff(s1, v1):** err ** - empty
vec2_diff(v1, v2):-2,-2
---
vec2_normalize(s1):** err ** - empty
vec2_normalize(zero):** err ** - empty
vec2_normalize(v1):0.577350269189626,1.15470053837925
---
vec2_scaleBy(s1,2):** err ** - empty
vec2_scaleBy(v1,a):** err ** - empty
vec2_scaleBy(v1,2):2,4
---
vec2_dot(v1,s1) こいつは正しくない->:0
vec2_dot(v1,v2):11
vec2_dot(axisX, axisY):0
vec2_dot(axisX, axisX):1
vec2_dot(axisX, v3):1
---
vec2_cross(v1,s1) こいつは正しくない->:0
vec2_cross(v1,v2):-5
vec2_cross(axisX, axisY):0
vec2_cross(axisX, axisX):1
vec2_cross(axisX, v3):1

内外積に自信がない（今の所、使い道が思い付かない）