三次元ベクトルの内積と長さ

三次元ベクトルを扱っていると外積やら内積やら単位化やら必要に
なってきますよね？

自分だったらベクトルクラス作って、メソッドにそれらを実装します。
外積や内積や単位化は、ベクトルの為の関数なので、ベクトルクラスに
責任持ってもらうのが筋だと思いませんか？

ですが、訳あって関数で必要になりそうなので、切り出したのですが
今まで気が付きませんでした・・・。
内積と長さを求める関数です。

'三次元ベクトルの内積
'param: vec1_array(double)-ベクトル
'param: vec2_array(double)-ベクトル
'return: スカラー
Private Function dot_3d( _
        ByVal vec1 As Variant, _
        ByVal vec2 As Valiant) As Double

    dot_3d = _
        vec1(0) * vec2(0) + _
        vec1(1) * vec2(1) + _
        vec1(2) * vec2(2)

End Function


'三次元ベクトルの長さ
'param: vec_array(double)-ベクトル
'return: 長さ
Private Function get_length_3d( _
        ByVal vec As Variant) As Double

    get_length_3d = Sqr( _
        vec(0) * vec(0) + _
        vec(1) * vec(1) + _
        vec(2) * vec(2) _
    )

End Function

長さの計算の際に二乗で計算させると気が付きにくいのですが
長さの計算式って、自身同士の内積の平方根なんですね。
だからこんな風に関数を作っても良さそう。

'三次元ベクトルの長さ
'param: vec_array(double)-ベクトル
'return: 長さ
Private Function get_length_3d( _
        ByVal vec As Variant) As Double

    get_length_3d = Sqr( _
        dot_3d(vec, vec) _
    )

End Function

無関係だけど、外積はこちら

'三次元ベクトルの外積
'param: vec1_array(double)-ベクトル
'param: vec2_array(double)-ベクトル
'return: array(double)-ベクトル
Private Function cross_3d( _
        ByVal vec1 As Variant, _
        ByVal vec2 As Valiant) As Variant

    cross_3d = Array( _
        vec1(1) * vec2(2) - vec1(2) * vec2(1), _
        vec1(2) * vec2(0) - vec1(0) * vec2(2), _
        vec1(0) * vec2(1) - vec1(1) * vec2(0) _
    )

End Function

Ｘの成分を求める計算はお互いのＹＺの利用して・・・
って感じで不思議な事は印象に残ってます。
（計算式はいつまでたっても覚えない）

イナーシャの取得

イナーシャが欲しいのですが、ササっと検索してもProductばかり見つかったのですが
だったのですが、サーフェスで欲しいです。

結局、全部入りのサイトがありました。
Measuring Mass and Inertia | CATIA V5 Automation

消えてしまうと困るので、お借りする。
まず単位はこちら。

メートル法っぽいです。

で、
Product(Partも) : GetTechnologicalObject
Body(形状セットも) : SPAWorkbench.Inertias.Add
で、サーフェスは直接の方法が無い様なのですが、新規の形状セットに
突っ込んで、形状セットのイナーシャで大丈夫だよ　と
記載されている気がします。

そこで、好みな部分も有ってこんな感じにしてみました。

'イナーシャの取得
'''param:surf-対象サーフェス
'''return:array(Inertia, HybridBody) - 失敗:empty
private Function get_surf_inertia( _
    Byval surf As HybridShape) As variant

    set get_surf_inertia = empty

    If surf Is Nothing Then exit function

    dim pt As Part
    set pt = get_parent_of_T(surf, "Part")

    Dim objRef As Reference
    Set objRef = pt.CreateReferenceFromObject(surf)

    Dim intType As Integer
    intType = pt.HybridShapeFactory.GetGeometricalFeatureType(objRef)

    If intType = 5 Then exit function

    Dim geoSet As HybridBody
    Set geoSet = pt.HybridBodies.Add
    geoSet.Name = "Temp_ForInertiaMeasure"

    Dim objJoin As HybridShapeAssemble
    Set objJoin = pt.HybridShapeFactory.AddNewJoin(objRef, objRef)
    objJoin.RemoveElement 2
    pt.UpdateObject objJoin

    geoSet.AppendHybridShape objJoin

    On Error Resume Next

    Dim objSPAWorkbench As Workbench
    Set objSPAWorkbench = pt.Parent.GetWorkbench("SPAWorkbench")

    Dim objInertia As Inertia
    Set objInertia = objSPAWorkbench.Inertias.Add(geoSet)

    On Error GoTo 0

    if objInertia is nothing then exit function

    get_surf_inertia = array(objInertia, geoSet)

End Function


'指定した型をParentから取得 - typenameで取得出来るもので
'''param:aoj-対象要素
'''param:T-目的の型名
'''return:AnyObject - 失敗:Nothing
private Function get_parent_of_T( _
    ByVal aoj As AnyObject, _
    ByVal T As String) _
    As AnyObject

    Dim aojName As String
    Dim parentName As String
    
    On Error Resume Next
        Set aoj = as_dispath(aoj)
        aojName = aoj.name
        parentName = aoj.Parent.name
    On Error GoTo 0

    If TypeName(aoj) = TypeName(aoj.Parent) And _
            aojName = parentName Then
        Set get_parent_of_T = Nothing
        Exit Function
    End If
    If TypeName(aoj) = T Then
        Set get_parent_of_T = aoj
    Else
        Set get_parent_of_T = get_parent_of_T(aoj.Parent, T)
    End If

End Function


'ディスパッチ
'''param:o-対象要素
'''param:T-目的の型名
'''return:CATBaseDispatch
Private Function as_dispath( _
    byval o As INFITF.CATBaseDispatch) As INFITF.CATBaseDispatch

    Set as_dispath = o

End Function

関数だけなので動かないですし、VSCodeで書いただけで動かしていないので
間違っている可能性が大。

VBE.CommandBars

こんなの知らなかった・・・。

'vba
Option Explicit

Sub commandBar_test()
    Dim vbe As Object
    Set vbe = Application.vbe
    
    'CommandBar
    Dim cBar As Object
    Set cBar = get_commandBar("Custom1")

    'CommandControl
    Dim myControl
    For Each myControl In cBar.Controls
        Call myControl.Delete
    Next
    
    Set myControl = cBar.Controls _
        .Add(Type:=msoControlComboBox, before:=1)
    With myControl
        .AddItem Text:="First Item", Index:=1
        .AddItem Text:="Second Item", Index:=2
        .DropDownLines = 3
        .DropDownWidth = 75
        .ListHeaderCount = 0
    End With
    
End Sub


'https://learn.microsoft.com/ja-jp/office/vba/api/office.commandbars
Private Function get_commandBar( _
    ByVal name As String) As Object

    Dim vbe As Object
    Set vbe = Application.vbe
    
    On Error Resume Next
    
    Dim cmdBar As Object
    Set cmdBar = vbe.CommandBars.Item(name)
    
    On Error GoTo 0
    
    If cmdBar Is Nothing Then
        Set cmdBar = vbe.CommandBars.Add( _
            name:=name, _
            Position:=msoBarFloating _
        )
    End If
    cmdBar.Visible = True
    
    Set get_commandBar = cmdBar
    
End Function

実行するとこんなのが表示されます。

久々にVBAで刺激を感じた・・・可能性が高まる。

VBAのリスト問題5

こちらの続きです。
VBAのリスト問題4 - C#ATIA

いよいよ先人の方々が作られたものを試す事にします。
githubで見ても、結構な数が公開されていますね。いかに他の方々も
悩まれているというか、不満に思っているかが分かります。

多すぎて、とても全ては試せませんね。
チラチラっと見た感じですが、中身はCollectionのものと配列のもの
がありました。・・・個人的にはCollectionの利用は考えないけど。

で、とりあえずこちらを試す事としました。
GitHub - nanbu/XArray: Array class for VBA
中は配列で、1クラスにまとまってますし、日本人の方だったので
親近感がありました。

もう一つは、過去に試した事があるariawaseです。
GitHub - vbaidiot/ariawase: Ariawase is free library for VBA cowboys.
・・・9年前かな？
一緒に公開されている "vbac.wsf" ばかりが目につきますが、
ariawaseは本当にすごいです。僕の知る限り、VBAのライブラリ
としては桁違いに高水準のものです。
但し、困るのはHelpらしきものが無いので、理解しきれない。

前回のものも含めてこんな感じでテストです。

vba

Option Explicit

Private sw_ As StopWatch

Sub Custom_Array_test()

    Dim count As Long
    count = 500000
 
    Set sw_ = New StopWatch
    
    'XArray
    sw_.start
    Debug.Print "-- xArray--"
    
    Call test_xarray(count)
    Call sw_.total("Total" & ":")

    'ariawase
    sw_.start
    Debug.Print "-- ariawase --"
    
    Call Ext.ArrRange(0, count)
    Call sw_.total("Total" & ":")
    
    'preserve一度で
    sw_.start
    Debug.Print "-- 一度で--"

    Call preserve_once(count)
    Call sw_.total("Total" & ":")

    sw_.start
    Debug.Print "-- 毎回 --"
    
    Call preserve_every_time(count)
    Call sw_.total("Total" & ":")

End Sub

Private Sub test_xarray( _
    ByVal count As Long)
    
    Dim xArr As Object
    Set xArr = New XArray
    
    Dim i As Long
    For i = 0 To count - 1
        Call xArr.Add(i)
    Next
    
End Sub

Private Sub preserve_once( _
    ByVal count As Long)
    
    Dim ary() As Long
    ReDim ary(count)
    
    Dim i As Long
    For i = 0 To count - 1
        ary(i) = i
    Next
    
End Sub

Private Sub preserve_every_time( _
    ByVal count As Long)
    
    Dim ary() As Long
    
    Dim i As Long
    For i = 0 To count - 1
        ReDim Preserve ary(i)
        ary(i) = i
    Next
    
End Sub

結果はこちら

-- xArray--
Total:7.953125s
-- ariawase --
Total:1.421875s
-- 一度で--
Total:0.0234375s
-- 毎回 --
Total:0.8125s

おっと意外。毎回ReDim Preserveの方が、ariawaseより
速いですね。でも、ariawaseはあの1行だけで済むんですよね。

VBAのリスト問題4

こちらの続きです。
VBAのリスト問題3 - C#ATIA
進みが悪い・・・。

続いて動的配列です。

Long型だけで比べるとこんな感じです。

**可変長配列**
Long 代入:0.0234375s
呼出:0.0234375s

**可変長配列 Preserve**
Long 代入:0.9375s
呼出:0.0234375s

呼び出しは誤差程度なのですが、代入には差があります。
まぁ当然だとは思います。

代入だけをこの様な感じで再度テストします。

'vba

Option Explicit

Private sw_ As StopWatch

Sub ReDim_Preserve_test()

    Dim count As Long
    count = 1000000
 
    '一度で
    Set sw_ = New StopWatch
    sw_.start
    Debug.Print "-- 一度で --"
    
    Call preserve_once(count)
    Call sw_.total("Total" & ":")

    '毎回
    Set sw_ = New StopWatch
    sw_.start
    Debug.Print "-- 毎回 --"
    
    Call preserve_every_time(count)
    Call sw_.total("Total" & ":")
    
End Sub

Private Sub preserve_every_time( _
    ByVal count As Long)
    
    Dim ary() As Long
    
    Dim i As Long
    For i = 0 To count - 1
        ReDim Preserve ary(i)
        ary(i) = i
        If i Mod 100000 = 0 Then
            Call sw_.split(CStr(i) & ":")
        End If
    Next
    
End Sub

Private Sub preserve_once( _
    ByVal count As Long)
    
    Dim ary() As Long
    ReDim ary(count)
    
    Dim i As Long
    For i = 0 To count - 1
        ary(i) = i
        If i Mod 100000 = 0 Then
            Call sw_.split(CStr(i) & ":")
        End If
    Next
    
End Sub

結果を見やすくするとこんな感じです。

最初に必要なサイズを確保した場合、書き出す意味が無いぐらい
速いですね・・・。
そこが目的では無く、毎回ReDim Preserveしている方は、
後半に向けて徐々に遅くなっています。
これは理由を知ってます。

配列の場合、メモリはコレクションの時と異なり連続した状態で確保されます。
その為、配列要素の1個のサイズが確定すれば、100個先だろうが1万個先だろうが
どこに目的の要素があるかが分かっている為、呼び出しも高速です。

ReDim Preserveが徐々に遅くなる原因は、こんな理由でしょう。
サイズが5個から6個になる場合、6個目は5個目の隣のメモリを確保する
訳ではないです。

まず、6個分のメモリを確保します。これがReDim。
続いて元の5個分の内容をコピーする。これがPreserve。

これを1個サイズを大きくする度に行っているので、
後半になればなるほど、コピーする量が多くなり遅くなる
のだと思っています。

・・・とは言え、コレクションより遥かに速い。

VBAのリスト問題3

こちらの続きです。
VBAのリスト問題2 - C#ATIA

あぁ配列試す前に、書くべきでした・・・・。
ところで、お気付きでしょうか?（何が?）

コレクションの結果（やる度に結果は変わります）のLong型を
扱ったものですが、

**コレクション-キー無し**
Long 代入:0.0390625s
呼出:24.4453125s

**コレクション-キー付き**
Long 代入:0.890625s
呼出:0.3671875s

キー無しは代入に比べ、呼び出しが非常に遅いのですが、
キー付きは呼び出しの方が、代入より速いです。
逆転しています。

ここからは想像です！
何処かにメモリ確保の仕方とかの説明があれば良いのですが、
見つけられませんでした。（きっと何処かには有ると思います)

僕の中ではキー無しの場合は、こんな感じのイメージを持っています。

んーセンス無いな。　まばらに描いているのはメモリ上のアチコチに
散らばっているイメージです。
各Itemは、データの中身（本当は中身のアドレスだと思う）と次の
インデックスがセットになって情報を持っているような気がします。

キー付きの場合は、こんなイメージです。

各データはバラバラに配置されているのですが、キーについては
別の所に連続しておいてあるような気がします。

では確認。

こんな感じでサンプルを作りました。
もう、小出しでは無くドバっと。

'vba

Option Explicit

Private sw_ As StopWatch

Sub collection_key_test()

    Dim Count As Long
    Count = 30000
    
    'コレクション作成
    Dim lst As Collection
    Set lst = create_collection(Count, False)
    
    'キー無し
    Set sw_ = New StopWatch
    sw_.start
    Debug.Print "--キー無し--"
    
    Call non_key_test(lst)
    Call sw_.total("Total" & ":")

    'コレクション作成
    Set lst = create_collection(Count, True)

    'キー付き
    sw_.start
    Debug.Print "--キー付き--"
    
    Call use_key_test(lst)
    Call sw_.total("Total" & ":")
    
End Sub


Private Sub use_key_test( _
    ByVal lst As Collection)
    
    Dim i As Long, v As Long
    For i = 0 To lst.Count - 1
        v = lst.Item(CStr(i))
        If i Mod 1000 = 0 Then
            Call sw_.split(CStr(i) & ":")
        End If
    Next
    
End Sub


Private Sub non_key_test( _
    ByVal lst As Collection)
    
    Dim i As Long, v As Long
    For i = 1 To lst.Count
        v = lst(i)
        If i Mod 1000 = 0 Then
            Call sw_.split(CStr(i) & ":")
        End If
    Next
    
End Sub

それぞれ30000回Forを行い、1000回毎に時間を書き出します。

比較しやすいように、した結果がこちらです。

キー付きは最初から最後まで、ほぼ一定の時間で読み出せていますが、
キー無しは後半になる程、遅くなっています。
(For Eachも最初から最後まで、ほぼ一定でした)

この結果からすると、上で示した画像のイメージに近い事が分かります。
つまり30000個目にアクセスする為には、29999個目まで辿らないと
30000個目を見つける事が出来ない　と言う事です。

じゃぁ試しに、step -1でforしたらどうなるのか？
non_key_test関数のみを書き換えます。

Private Sub non_key_test( _
    ByVal lst As Collection)
    
    Dim i As Long, v As Long
'    For i = 1 To lst.Count
    For i = lst.Count To 1 Step -1
        v = lst(i)
        If i Mod 1000 = 0 Then
            Call sw_.split(CStr(i) & ":")
        End If
    Next
    
End Sub

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

--キー無し--
30000:0.014892578125s
29000:0.656005859375s
28000:0.630126953125s
27000:0.629150390625s
26000:0.590087890625s
25000:0.56396484375s
・・・
6000:0.14111328125s
5000:0.113037109375s
4000:0.090087890625s
3000:0.06884765625s
2000:0.049072265625s
1000:0.030029296875s
Total:10.10498046875s

Forの後半は、前半より早くなってきています。
恐らくイメージ通りです。

じゃ、For EachがIndexが大きくなっても、遅くならないのか？

Forの場合、ここでListの要素が代入されています。

lstにとって、インデックス "i" が幾つが来るのかが分かっていない
のだろうと思います。

それに対しFor Eachは、ここで直接中身が取り出されています。

その為、次の要素が何かが分かっているような気がします。
（それは、イテレータだと思う）

・・・眠い。

VBAのリスト問題2

こちらの続きです。
VBAのリスト問題1 - C#ATIA

続いては固定長配列です。もう、やらなくてもこれが一番速いのが
分かっているのですが、指標的な意味合いです。

Private Sub test3( _
    ByVal Count As Long)

    Dim ary(50000) As Long
    
    Dim i As Long
    For i = 0 To Count - 1
        ary(i) = i
    Next
    
    sw_.split "Long 代入:"
    
    Dim x As Long
    For i = 0 To UBound(ary)
        x = ary(i)
    Next

    sw_.split "呼出:"

    
    sw_.split "--:"
    Dim objAry(50000) As myObj
    Dim obj As myObj
    Set obj = New myObj
    
    For i = 0 To Count
        Set objAry(i) = obj
    Next
    
    sw_.split "Object 代入:"
    
    For i = 0 To UBound(ary)
        Set obj = objAry(i)
    Next
    
    sw_.split "呼出:"

End Sub

結果はこちら。

**固定長配列**
Long 代入:0.0078125s
呼出:0s
--:0s
Object 代入:0.0078125s
呼出:0.0078125s
**終了** :0.046875s

2倍とか3倍とかでは無く、2桁ぐらい違いますね。
但し、コードを書く時点で必要最大サイズが分かる場面はほぼ無く、
不必要なサイズの配列用意するのも、ちょっと違うような
気もしてます。正直な所、使い道としては無いですよね。

続いては動的配列です。使用する場面の多さから、これを”配列”と
呼びたいところです。

Private Sub test4( _
    ByVal Count As Long)

    Dim ary() As Long
    ReDim ary(Count)
    
    Dim i As Long
    For i = 0 To Count - 1
        ary(i) = i
    Next
    
    sw_.split "Long 代入:"
    
    Dim x As Long
    For i = 0 To UBound(ary)
        x = ary(i)
    Next

    sw_.split "呼出:"

    
    sw_.split "--:"
    Dim objAry() As myObj
    ReDim objAry(Count)
    
    Dim obj As myObj
    Set obj = New myObj
    
    For i = 0 To Count
        Set objAry(i) = obj
    Next
    
    sw_.split "Object 代入:"
    
    For i = 0 To UBound(ary)
        Set obj = objAry(i)
    Next
    
    sw_.split "呼出:"

End Sub

結果の一例です。

**可変長配列**
Long 代入:0.015625s
呼出:0.0078125s
--:0s
Object 代入:0s
呼出:0.015625s
**終了** :0.0390625s

ちょっと驚いたのは、オブジェクトの代入が固定長配列より
速かった事です。何でだろう？

次は同じ動的配列なのですが、最初にサイズが決められない
ような状態の場合、単なるReDimでは無く、ReDim Preserveで
サイズを大きくする方法があります。
このPreserveを使った極端な例として、代入を行う直前に
1個づつサイズを広げ代入するようにしたものです。

Private Sub test5( _
    ByVal Count As Long)

    Dim ary() As Long
    
    Dim i As Long
    For i = 0 To Count - 1
        ReDim Preserve ary(i)
        ary(i) = i
    Next
    
    sw_.split "Long 代入:"
    
    Dim x As Long
    For i = 0 To UBound(ary)
        x = ary(i)
    Next

    sw_.split "呼出:"

    
    sw_.split "--:"
    Dim objAry() As myObj
    
    Dim obj As myObj
    Set obj = New myObj
    
    For i = 0 To Count
        ReDim Preserve objAry(i)
        Set objAry(i) = obj
    Next
    
    sw_.split "Object 代入:"
    
    For i = 0 To UBound(objAry)
        Set obj = objAry(i)
    Next
    
    sw_.split "呼出:"

End Sub

結果の一例です。

**可変長配列 Preserve**
Long 代入:0.03125s
呼出:0s
--:0s
Object 代入:0.0390625s
呼出:0.015625s
**終了** :0.109375s

思ったより、差が出なかった・・・。
ループさせる回数が少ないからだろうと思います。

と言う事で、動的配列の2種類を50000->500000に
増やした結果の一例がこちら。

**可変長配列**
Long 代入:0.0234375s
呼出:0.0234375s
--:0s
Object 代入:0.046875s
呼出:0.0546875s
**終了** :0.1640625s

**可変長配列 Preserve**
Long 代入:0.9375s
呼出:0.0234375s
--:0s
Object 代入:0.890625s
呼出:0.046875s
**終了** :1.9296875s

呼び出しについては、まぁ同じ処理なので誤差です。
代入については結構な差が付きました。
理由が分かっているのですが、他を試した際に書こうかな？と
思ってます。