読者です 読者をやめる 読者になる 読者になる

voidもしくはboolを返す

書いているC++プログラムの一か所に出てきた既視感のある部分についての備忘録。

該当部分は次の4行。

    struct bool_proxy {
        explicit operator bool() const  { return true; }
        friend bool operator ,(bool b, const bool_proxy&)   { return b; }
    };

こういう使い方をする。

    template <typename F>
    void foo(F&& func, int begin, int end)
    {
        bool_proxy   bp;        // <--  これ(後から追加)
        for ( auto i = begin; i < end; ++i )
        {
            //  std::forward<F>(func)(i);    // <--  最初はこうだった
            if ( !(std::forward<F>(func)(i), bp) )
                    break;
        }
    }

//----------------------------------------------------------
    std::vector<int>  vec;

    auto void_expr = [&](int a)  {     //もともとあったファンクタ
        vec.push_back(a);
    };

    auto bool_expr = [&](int a)  {     //追加したファンクタ
        if ( a < 5 )    vec.push_back(a);
        return a < 5;
    };

    foo(void_expr, -99, 100);    // -99 ~ +99
    foo(bool_expr, -99, 100);    // -99 ~ +4

関数fooはループ中でコールバックfuncを呼び出すが、「最初はこうだった」とコメントアウトしている通り当初は無条件に呼び出すだけで、funcの戻り値もvoidだった。その後条件によってループをbreakしたいという要求が出てきたので、bool値を返すファンクタを作った(falseが返ってきたときbreak)。
しかし、

  • すべての場合にそういう条件をつけたい訳ではない
  • もともと使っていたファンクタの戻り値型をvoidからboolに直すのは面倒だ

そこでfoo<F>オーバーロードしよう思ったが、以下のようなことを考えてやりたくなくなった。

  • 一部分の挙動が違うだけのオーバーロード関数を作るのはイヤだ
  • 複数の異なる型のコールバックを受け取るときは組み合わせが多くなる
  • いろんなシグネチャパターンのコールバックに対応するとしたら面倒だ

voidな式はtrueと評価し、boolな式はそれ自体として評価する方法はないかと考えた結果、最初に示したbool_proxyのアイデアを思いついた。「イヤだ」と感じた3つの点は避けられたが、既視感があるようなないような、罠があるようなないような、もっと全然簡単な方法があるようなモヤモヤした状態のまま使っている。

とりあえずbool_proxyという名前がどこか間違っているような気がしてならない。

配列をQiita表に変換

Excelシートの選択範囲をVBAHaskellの関数を使ってQiitaの表形式に変換。
右の形式でクリップボードに転送して、ブラウザに直接貼り付けられるようにします。

f:id:mmYYmmdd:20170415111317p:plain

頻繁にやるなら関数化してもいいけど、とりあえずイミディエイトウィンドウだけで。

m = sheet2m(Selection)              ' 1.ワークシートから配列へ
m = subM(m, catV(0, a_rows(m)))     ' 2.先頭行を重複させる
Call fillRow(m, 1, "--:")           ' 3.2行目の要素はすべて "--:" に変更
m = mapF(p_str_cat("|"), m)         ' 4.各要素の頭に "|" を付ける
m = foldl1(p_str_cat, m, 2)         ' 5.各行を横に結合
m = mapF(p_str_cat(, "|"), m)       ' 6.最後に "|" を付ける
m2Clip transpose(m)                 ' 7.縦にしたものをクリップボード転送

各段階での配列の形の推移はこんな感じ。

f:id:mmYYmmdd:20170415114440p:plain

行数は減らしましょう。

m = sheet2m(Selection)
m2Clip transpose(mapF(p_str_cat(, "|"), foldl1(p_str_cat, mapF(p_str_cat("|"), fillRow_move(subM(m, catV(0, a_rows(m))), 1, "--:")), 2)))

place_fill 関数の追加(VBAHaskell)

VBAHaskellにplace_fill という関数を追加して Haskell_2_stdFun.bas モジュールに置いた。

1次元配列内の指定した複数の位置に関数もしくは定数値を適用して、その場所に値を埋めるものだ。 埋めたあと配列そのものをmoveして返す。

' 配列の特定位置に関数/値を適用する(値を埋めてmoveして返す)
Function place_fill(ByRef vec As Variant, _               👈 対象配列
                    ByRef fun As Variant, _               👈  適用する関数または定数
                    ByRef indice As Variant, _            👈 インデックス
                    Optional ByRef souce As Variant       👈 ソース配列
                ) As Variant

これまでは配列全体を処理する関数がほとんどで、こういう関数はなかった。 関数にはインデックスまたはソース配列の各要素が代入され、模式的には for ( i ∈ indice ) vec(i) = fun(i) もしくは for ( i ∈ indice ) vec(i) = fun(source(i)) というループとなる。ただし fun が関数でなかった場合はそれ自身が値として代入される。「インデックスまたはソース配列」というのは、sourceが省略された場合はindex自身がソース配列となるという意味だ。また、sourcevec自身を代入することもできる。

基本的な使い方はこうだ。

' 長さ10の配列の(2, 5, 8)の位置に定数を置く
printM place_fill(repeat(0, 10), 1, Array(2,5,8))
  0  0  1  0  0  1  0  0  1  0

' 長さ10の配列の(2, 5, 8)の位置に文字列の一部分を置く
printM place_fill(repeat("-", 10), p_left("abcdefghijk"), Array(2,5,8))
  -  -  ab  -  -  abcde  -  -  abcdefgh  -



これでFizzBuzzを書くとこうなる。 あまり短くはならないが、素直なコードになる。

m = place_fill(iota(0,100), "Fizz", mapF(p_mult(3), iota(1, 33)))
m = place_fill(m, "Buzz", mapF(p_mult(5), iota(1, 20)))
m = place_fill(m, "FizzBuzz", mapF(p_mult(15), iota(1, 6)))
printM m, -100
  1  2  Fizz  4  Buzz  Fizz  7  8  Fizz  Buzz  11  Fizz  13  14  FizzBuzz  16  17  Fizz  19  Buzz  Fizz  22  23  Fizz  Buzz  26  Fizz  28  29  FizzBuzz  31  32  Fizz  34  Buzz  Fizz  37  38  Fizz  Buzz  41  Fizz  43  44  FizzBuzz  46  47  Fizz  49  Buzz  Fizz  52  53  Fizz  Buzz  56  Fizz  58  59  FizzBuzz  61  62  Fizz  64  Buzz  Fizz  67  68  Fizz  Buzz  71  Fizz  73  74  FizzBuzz  76  77  Fizz  79  Buzz  Fizz  82  83  Fizz  Buzz  86  Fizz  88  89  FizzBuzz  91  92  Fizz  94  Buzz  Fizz  97  98  Fizz  Buzz


misc_mathに実装した素数一覧を出力する関数と組み合わせるとこういう表示もできる。

printM place_fill(iota(0, 30), "☆", primeNumbers(30))
  0  1  ☆  ☆  468  9  101214  15  161820  21  2224  25  26  27  2830


☆の前後にその素数を付けて表示するためには、文字連結関数を引数にすればいい。

printM place_fill(iota(0,30), p_str_cat("☆"), primeNumbers(30))
  0  123  45  67  8  9  1011  1213  14  15  1617  1819  20  21  2223  24  25  26  27  2829  30

printM place_fill(iota(0,30), p_str_cat(, "☆"), primeNumbers(30))
  0  1  234  56  78  9  10  1112  1314  15  16  1718  1920  21  22  2324  25  26  27  28  2930


この関数の実装は以下の通り。

' 配列vecの指定位置に関数/値を適用する(値を埋めてmoveして返す)
Function place_fill(ByRef vec As Variant, _
                    ByRef fun As Variant, _
                    ByRef indice As Variant, _
                    Optional ByRef souce As Variant) As Variant
    Dim i As Long
    ' souceまたはindex(souce 省略時)を埋め込む
    If is_bindFun(fun) Then
        Dim tmp As Variant
        If IsMissing(souce) Then    ' = index
            tmp = mapF(fun, indice)
        Else
            tmp = mapF(fun, subV(souce, indice))
        End If
        For i = LBound(indice) To UBound(indice) Step 1
            Call swapVariant(vec(indice(i)), tmp(i))
        Next i
    Else    ' 単一の値を埋め込む
        For i = LBound(indice) To UBound(indice) Step 1
            Call assignVar(vec(indice(i)), fun)
        Next i
    End If
    Call swapVariant(place_fill, vec)
End Function

github.com

http://home.b07.itscom.net/m-yamada/VBA/

Collectionのソート

t-homさんの記事 thom.hateblo.jp に言及されていた以下の記事にコメントを書きました。 kantoku.hatenablog.com

「コレクションのソートが面白そうなので考えてみたい。」という趣旨のコメントで、一応作ってはみたのですが、Collectionを使ったことがなかったこともあって満足できるものは出来ませんでした。なんというか、キーの扱いをどうしていいかわかりません。

・ソートロジックを新たに書かず、Collectionから配列に出力して配列をソート。
・その配列からソート済みCollectionを生成する。つまり元のCollectionはそのまま。
・全体的にVBAHaskellの既存機能を使う。

こういう方針なので気合がまったく入っていません。 メリットといえば、VBAHaskellで実現している「任意の比較ロジックを与えられる」くらいです。


まずはコレクションから1次元配列を生成する関数。
工夫した点はコレクションのItem(インデックス)メソッドが要素のコピーを出力するようなので、代入ではなくswapVariantを使っていることくらいです。
これによって要素がオブジェクト型かそうでないかによる条件分岐は不要になります。

' コレクションから1次元配列を作成
Function collection2vec(ByVal c As Collection) As Variant
    Dim vec As Variant
    vec = makeM(c.count)
    Dim i As Long
    For i = 1 To c.count Step 1
        swapVariant vec(i - 1), c.Item(i)
    Next i
    swapVariant collection2vec, vec
End Function


次に1次元配列からコレクションを生成する関数。
第1引数は対象配列、第2引数にはオプショナルで順序を指定する配列です。なければ対象配列をそのままの順序で、あれば指定された順序で要素を取っていってコレクションにAddします。
配列を実際にソートしなくても、ソートインデックスを与えれれればソート済みコレクションが作れるので効率的です。

' 1次元配列からコレクションを作成
Function vec2collection(ByRef v As Variant, Optional ByRef ord As Variant) As Collection
    Set vec2collection = New Collection
    Dim i As Long
    With vec2collection
        If IsMissing(ord) Then
            For i = LBound(v) To UBound(v) Step 1
                .Add v(i)
            Next i
        Else
            For i = LBound(ord) To UBound(ord) Step 1
                .Add v(ord(i))
            Next i
        End If
    End With
End Function


ソート済コレクションを生成する関数。
第2引数に比較関数が指定できます。オプショナル引数となっており、なければ昇順ソート。 上で定義した関数vec2collectionを使っています。

' コレクションの要素をソート
Function collectionSort(ByVal c As Collection, Optional ByRef comp As Variant) As Collection
    Dim v As Variant, si As Variant
    v = collection2vec(c)
    If IsMissing(comp) Then
        si = sortIndex(v)
    Else
        si = sortIndex_pred(v, comp)
    End If
    Set collectionSort = vec2collection(v, si)
End Function


ついでにコレクションをインディエイトウィンドウに表示するプロシージャ。
オブジェクト型や配列は考慮していますが、EmptyやNullの処理は省略。

' コレクションの要素を表示
Sub showCollection(ByVal c As Collection, Optional ByRef z As Variant)
    For Each z In c
        If IsObject(z) Then
            Debug.Print " " & TypeName(z) & " ";
        ElseIf IsArray(z) Then
            Debug.Print " [ ] ";
        Else
            Debug.Print z;
        End If
    Next z
    Debug.Print
End Sub


最後にテスト関数です。
数を並び替えて可能な最大数を返すという問題で、ここではランダムな 17 個の整数を使っています。
たとえば "3", "82", "525" という3つの数の場合は、"825253"が正解となります。一見、文字列としての大小関係で降順に並べて結合すればいいように思えますが、コメントにあるように "9" と "991" では "9" < "991" が成り立つにもかかわらず、"9919" < "9991" なのでその方法ではだめです。
どうすればいいかというと、ふたつの数字列abを実際に並べてみてabbaのどちらが大きいかを確かめるだけです。
VBAの文法で書くと、CLng(x & y) > CLng(y & x)のようになりますが、VBAHaskell の関数オブジェクトとして表現するとコード中のcompになります。

' コレクションソートのテスト
Sub test_collectionSort()
    Dim c As New Collection
    Dim i As Long
    For i = 1 To 15 Step 1
        c.Add uniform_int_dist(0, 0, 999)
    Next i
    c.Add 991
    c.Add 9
    ' "9" < "991" であるが "9919" < "9991" であることに注意
    Debug.Print "ランダム列:"
    showCollection c
    Dim comp As Variant
    ' 比較関数はこれ ↓
    comp = p_greater(p_CLng(p_str_cat(yield_1, yield_2)), p_CLng(p_str_cat(yield_2, yield_1)))
    Dim c2 As Collection
    Set c2 = collectionSort(c, comp)
    Debug.Print "最大数:"
    showCollection c2
    Set c2 = Nothing
    Set c = Nothing
End Sub


結果はこうなりました。

ランダム列:
 522  338  807  404  993  713  349  426  911  829  38  951  551  159  511  991  9 
最大数:
 9  993  991  951  911  829  807  713  551  522  511  426  404  38  349  338  159 

最大数は999399195191182980771355152251142640438349338159だとわかります。


追記

t-homさんから「シェイプのTopでソートする場合どうするのか」という旨の質問があったので追記。
この場合、上の例にあったように in-place で比較関数をつくるのは無理なので、外側に関数を追加することになります。方法としては2通り考えれます。

・シェイプのTopを取る関数を作って、p_less 関数と合成する。
・直接シェイプのTopで比較する関数を作る。

ネタとしてはシート上に四角形をいくつか置いて、これらをTop値でソートします。

f:id:mmYYmmdd:20170103191432p:plain


最初の方法で、まずはシェイプのTopを取る関数をVBAHaskellの作法通りに作ります。

Function get_shapeTop(ByRef a As Variant, Optional ByRef dummy As Variant) As Variant
    get_shapeTop = a.Top
End Function
    Function p_get_shapeTop(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_get_shapeTop = make_funPointer(AddressOf get_shapeTop, firstParam, secondParam)
    End Function


これを使ったソートのテストは以下の通りです。

' コレクションソートのテスト2
Sub test_collectionSort2()
    Debug.Print "コレクションソートのテスト2"
    Debug.Print "比較関数は p_less(p_get_shapeTop, p_get_shapeTop)"
    Dim c As Collection: Set c = New Collection
    Dim i As Long
    For i = 1 To activesheet.Shapes.count Step 1
        c.Add ActiveSheet.Shapes(i)
    Next i
    Debug.Print "Shape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c))
    Dim comp As Variant
    ' 比較関数はこれ ↓
    comp = p_less(p_get_shapeTop, p_get_shapeTop)
    Dim c2 As Collection
    Set c2 = collectionSort(c, comp)
    Debug.Print "ソート後のShape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c2))
    Set c2 = Nothing
    Set c = Nothing
End Sub


これを走らせるとイミディエイトウィンドウに以下のように出るので、正しくソートされています。

コレクションソートのテスト2
比較関数は p_less(p_get_shapeTop, p_get_shapeTop)
Shape.Top
  72  14.25  78.75  7.5  92.25  14.25  129  158.25  132.75  119.25  175.5  211.5  226.5  185.25
ソート後のShape.Top
  7.5  14.25  14.25  72  78.75  92.25  119.25  129  132.75  158.25  175.5  185.25  211.5  226.5


次に直接シェイプのTopで比較する関数でやってみます。
比較関数は見たままです。

Function comp_shapeTop(ByRef a As Variant, ByRef b As Variant) As Variant
    comp_shapeTop = IIf(a.Top < b.Top, 1, 0)
End Function
    Function p_comp_shapeTop(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_comp_shapeTop = make_funPointer(AddressOf comp_shapeTop, firstParam, secondParam)
    End Function


これを使ったソートのテストは以下の通りです。

' コレクションソートのテスト3
Sub test_collectionSort3()
    Debug.Print "コレクションソートのテスト3"
    Debug.Print "比較関数は p_comp_shapeTop"
    Dim c As Collection: Set c = New Collection
    Dim i As Long
    For i = 1 To activesheet.Shapes.count Step 1
        c.Add ActiveSheet.Shapes(i)
    Next i
    Debug.Print "Shape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c))
    Dim c2 As Collection
    Set c2 = collectionSort(c, p_comp_shapeTop)
    Debug.Print "ソート後のShape.Top"
    printM mapF(p_get_shapeTop, collection2vec(c2))
    Set c2 = Nothing
    Set c = Nothing
End Sub


これを走らせると同じ結果になります。

コレクションソートのテスト3
比較関数は p_comp_shapeTop
Shape.Top
  72  14.25  78.75  7.5  92.25  14.25  129  158.25  132.75  119.25  175.5  211.5  226.5  185.25
ソート後のShape.Top
  7.5  14.25  14.25  72  78.75  92.25  119.25  129  132.75  158.25  175.5  185.25  211.5  226.5


どちらがいいかというと、
・シェイプのTopを取る関数を作って、p_less 関数と合成する。
だと思います。この関数を作っておけば、他と組み合わせていろいろできるのに対して、Topを比較する関数は単一目的だからです。

SQL Server メモ

SQL Server Express に日経平均株価ヒストリカルデータテーブルをCREATEして、データをINSERTしたときのメモ。
VBAHaskellとvb_ODBC.clsを使用。

1.データの準備

日経平均株価 日足 時系列データ CSVダウンロードから各年のCSVファイルをダウンロードしておく。

2.ファイルを全部つなげた配列を作る

m = catVs(getTextFile("H:\download\indices_I101_1d_2007.csv"), _
          getTextFile("H:\download\indices_I101_1d_2008.csv"), _
          getTextFile("H:\download\indices_I101_1d_2009.csv"), _
          getTextFile("H:\download\indices_I101_1d_2010.csv"), _
          getTextFile("H:\download\indices_I101_1d_2011.csv"), _
          getTextFile("H:\download\indices_I101_1d_2012.csv"), _
          getTextFile("H:\download\indices_I101_1d_2013.csv"), _
          getTextFile("H:\download\indices_I101_1d_2014.csv"), _
          getTextFile("H:\download\indices_I101_1d_2015.csv"), _
          getTextFile("H:\download\indices_I101_1d_2016.csv"))


中身はこんな感じ。
各ファイルにヘッダがついていて、末尾には空白行がある。

printM_ m, 4
日付,始値,高値,安値,終値
2007-12-28,15413.37,15413.37,15240.96,15307.78
2007-12-27,15616.41,15628.31,15535.51,15564.69
2007-12-26,15613.96,15653.54,15559.47,15653.54
printM_  m, -4
2016-01-06,18410.57,18469.38,18064.30,18191.32
2016-01-05,18398.76,18547.38,18327.52,18374.00
2016-01-04,18818.58,18951.12,18394.43,18450.98

3.日付でソートする

各行の先頭10文字を抽出して < で比較する。

si = sortIndex_pred(m, p_less(p_left(,10), p_left(,10)))
permutate m, si


ソート後の状態を見てみる。

printM_  m, 11










2007-01-04,17322.50,17379.46,17315.75,17353.66
printM_  m,-11
2016-12-22,19396.85,19427.67,19327.51,19427.67
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値
日付,始値,高値,安値,終値

空白行が先頭に、ヘッダ行が末尾に集まっている。

4.データの整形

空白行(先頭10行)とヘッダ行(末尾10行)を削除し、各項目をカンマで区切る。

m = tailN(headN(m, -10), -10)
m = mapF(p_Split(, ","), m)

printS m
[Dim1]: 0 -> 2443  : Total Size = 2444

printM_ m,4
  2007-01-04  17322.50  17379.46  17315.75  17353.66
  2007-01-05  17315.53  17327.13  17011.09  17091.58
  2007-01-09  17018.89  17261.02  16983.97  17237.76
  2007-01-10  17192.41  17199.41  16847.57  16942.40

5.ODBCオブジェクトを作ってSQL Serverに接続

set oo = new vb_ODBC
?oo.connect(oo.sqlServer_expr("***-PC\SQLEXPRESS", "sampleDB01"))
True


6.テーブルCREATE

oo.exec "CREATE TABLE NK225 (" & _
                     "MDATE date," & _
                    " OPEN_P numeric(8,2)," & _
                    " HIGH_P numeric(8,2)," & _
                    " LOW_P numeric(8,2)," & _
                    " CLOSE_P numeric(8,2)" & _
                    ");"

7.INSERT文を作る

s = oo.insert_expr_("NK225", Array("MDATE","OPEN_P","HIGH_P","LOW_P","CLOSE_P"), m)
printS s
[Dim1]: 0 -> 2443  : Total Size = 2444
printM_ S,3
INSERT INTO NK225 (MDATE,OPEN_P,HIGH_P,LOW_P,CLOSE_P) VALUES('2007-01-04',17322.50,17379.46,17315.75,17353.66);
INSERT INTO NK225 (MDATE,OPEN_P,HIGH_P,LOW_P,CLOSE_P) VALUES('2007-01-05',17315.53,17327.13,17011.09,17091.58);
INSERT INTO NK225 (MDATE,OPEN_P,HIGH_P,LOW_P,CLOSE_P) VALUES('2007-01-09',17018.89,17261.02,16983.97,17237.76);

8.INSERT文を実行

oo.exec s

9.結果を確認

m1 = oo.select_flat("select * from NK225 order by MDATE").get_data
printS m1
[Dim1]: 0 -> 2443  [Dim2]: 0 -> 4  : Total Size = 12220
printM  m1,5
  2007/01/04   17322.5  17379.46  17315.75  17353.66
  2007/01/05  17315.53  17327.13  17011.09  17091.58
  2007/01/09  17018.89  17261.02  16983.97  17237.76
  2007/01/10  17192.41  17199.41  16847.57   16942.4
  2007/01/11  16958.57  17057.44  16758.46  16838.16
printM  m1,-5
  2016/12/16  19438.39  19439.97  19360.36  19401.15
  2016/12/19  19345.84  19399.26  19307.14   19391.6
  2016/12/20  19367.84   19511.2  19356.81  19494.53
  2016/12/21  19547.28   19592.9  19375.19  19444.49
  2016/12/22  19396.85  19427.67  19327.51  19427.67

h = oo.get_header
printM h
  MDATE    TYPE_DATE
  OPEN_P   NUMERIC  
  HIGH_P   NUMERIC  
  LOW_P    NUMERIC  
  CLOSE_P  NUMERIC  

VBAHaskellの改修まとめ

最近VBAHaskellにいくつか変更をしたのでまとめの記事を書きます。

    VBAHaskell全関数リファレンス → VBAHaskell_reference

1. API関数self_zipWithを追加しました

次のようなシグネチャの関数をHaskell_0_declare.basの一番下に追加しました。

' 1次元配列の離れた要素間で2項操作を適用する
Declare PtrSafe Function self_zipWith Lib "mapM.dll" ( _
                                ByRef pCallback As Variant, _
                            ByRef vec As Variant, _
                      ByVal shift As Long) As Variant

名前から想像できると思いますが、2つの配列の要素間に関数を適用する zipWith と同じようなことを、一つの配列の中で行うものです。
3番目の引数shiftに与えた数値が「いくつ要素をずらしながら処理を適用するのか」を表し、正負どちらの方向にずらしても1周して戻ってきます。

たとえば 関数fと 配列a(a(0)~a(9)の範囲とします)を引数にするさい、
self_zipWith(f, a, 1)とすると
f(a(0), a(1)), f(a(1), a(2)), f(a(2), a(3)), ... , f(a(8), a(9)), f(a(9), a(0))
が、
self_zipWith(f, a, -1)とすると
f(a(0), a(9)), f(a(1), a(0)), f(a(2), a(1)), ... , f(a(8), a(7)), f(a(9), a(8))
が戻り値になります。

printM self_zipWith(p_plus, iota(1, 10), 5)
  7  9  11  13  15  7  9  11  13  15

元の配列は変更されません。
次の項目である関数get_uniqueや以前からあった関数adjacent_opの効率を高めるためにこれを作りました。

2. get_unique 関数を追加しました

misc_utility.bas に、1次元配列の重複した要素を削除する関数get_uniqueを追加しました。

Public Function get_unique(ByRef vec As Variant, _
                           Optional ByRef comp As Variant) As Variant

第2引数compは等値条件を表します。隣どうしの要素をcompで比較した結果が1になるものを「重複」と判定します。離れた場所にある要素は比較しないので、完全に重複を削除するためにはソート済であることが前提になります。
第2引数を省略するとp_equalを使った場合と同じになります。元の配列は変更されません。

a = uniform_int_dist(20, 5, 15)       ' [5, 15]の範囲のランダム整数を20個生成
permutate a, sortIndex(a)             ' 昇順ソート
printM a
  7  7  8  8  9  10  10  10  10  10  11  11  12  14  14  14  15  15  15  15
printM get_unique(a)
  7  8  9  10  11  12  14  15
' ↑ 重複要素が削除されている

2次元以上の場合は以下のようにジャグ配列にする必要があります。

a = zip(uniform_int_dist(20, 5, 7), uniform_int_dist(20, 101, 103))    ' ジャグ配列
permutate a, sortIndex_pred(a, p_less_dic)                             ' 辞書順に昇順ソート
printM_  a
  5  101
  5  101
  5  101
  5  102
  5  103
  5  103
  6  101
  6  101
  6  101
  6  102
  6  102
  6  102
  6  103
  7  101
  7  102
  7  102
  7  103
  7  103
  7  103
  7  103
printM_  get_unique(a, p_equal_dic)
  5  101
  5  102
  5  103
  6  101
  6  102
  6  103
  7  101
  7  102
  7  103

3. その他の変更

  • equal_dic (=) 関数とnotEqual_dic (<>)関数を追加しました。
    dic は dictional の略で、辞書式比較のことを示します。二つの1次元配列の要素を順に見ていって等値かそうでないかを返します。列に対する大小関係を判定する関数less_dic (<),less_equal_dic (<=),greater_dic (>),greater_equal_dic (>=)はもともと存在していましたが、この2つを新たに追加しました。
    Haskell_5_sort.bas

  • p_not関数とp_imply関数を追加しました。
    p_notはいわゆる論理Not、p_implyは「AならばB」の「ならば」に相当するものです。いずれも関数オブジェクトのみです。
    「AならばB」は not A と B のいずれかが真の時に成り立つ命題です。
    misc_utility.bas

  • p_Trim関数を追加しました。
    VBA組み込みのTrim, LTrim, RTrim関数をひとまとめにしたもので、第2引数0または省略時1-1がそれぞれに対応します。
    misc_utility.bas

printM_  mapF(p_str_cat(p_str_cat("0"), "1"), mapF(p_Trim, Array("  AB C  ", "  EFGH  ", "  WXYZ  ")))
0AB C1
0EFGH1
0WXYZ1
  • A_overlap_B 関数を追加しました。
    1次元配列として表された集合AとBに対して、共通部分と非共通部分を示すフラグを出力します。
Function A_overlap_B(ByRef a As Variant, _
                     ByRef b As Variant, _
                     Optional ByRef comp As Variant) As Variant

第3引数のcompは大小関係を表す述語で、それぞれの集合はそれによってソート済みという前提です。

a = uniform_int_dist(20, 0, 20)     '  0から20までの正数乱数(20個)
b = uniform_int_dist(20, 10, 30)    ' 10から30までの正数乱数(20個)
permutate a, sortIndex(a)         ' a をソート
permutate b, sortIndex(b)         ' b をソート

x = A_overlap_B(a, b)      ' 第3引数省略時は p_less が使われる

printM catR(a, x(0))       ' x(0) はAの各要素がBに属しているかのフラグ
  0  1  3  4  8  8  9  10  11  11  11  13  14  15  17  17  17  18  19  20
  0  0  0  0  0  0  0   1   0   0   0   1   0   1   1   1   1   1   0   1
printM catR(b, x(1))       ' x(1) はBの各要素がAに属しているかのフラグ
  10  12  13  13  15  15  17  17  17  18  18  20  20  21  24  25  25  26  27  29
   1   0   1   1   1   1   1   1   1   1   1   1   1   0   0   0   0   0   0   0

misc_utility.bas

clone ⇒ swap ⇒ edit ⇒ swap

VBAHaskellのC++APIにふたつの関数を追加した。VBAのクラスインスタンスを操作する時のイディオムである swapclone を実装するのに使う。
(今回もHaskell的な要素はまったくありません。)

以下ではswap は自身の属性と他のオブジェクトの属性をまるごと入れ替える操作、clone は自身と同じ属性を持つコピーオブジェクトを生成する操作のことを意味する。

自身を元にして新しいオブジェクトを返す関数 new_obj を作る
・ クラス名は myClass
・ 属性を変更するためのPrivateなeditメソッドがある
・ edit は失敗する可能性もあり、その場合は Nothing を返すことにする
・ 関数呼び出し後、Me には副作用がないようにしたい

これをclone ⇒ swap ⇒ edit ⇒ swapのパターンを用いて実装した例がこちら。swapとcloneは上記APIを使って実装したものと想定している。(冗長にMe.をつけている)

Public Function new_obj() As myClass
    Set new_obj = Me.clone    ' クローンオブジェクトの生成
    Call Me.swap(new_obj)     ' swapでクローンと自分自身を入れ替える
    Dim result As Boolean
    result = Me.edit          ' 自分自身を edit する
    Call Me.swap(new_obj)     ' 2度目のswap。Meは元に戻る
    If result = False Then Set new_obj = Nothing
End Function

この関数から返るのは clone.edit 相当のオブジェクトだが、ここでの edit は Me に対する操作なので Private宣言されていても問題なく呼び出すことができる。途中でオブジェクトの内部状態が壊れてしまった時も2度目のswapによってMeは問題なく現状復帰できる。こういう使い方をするという前提があれば editメソッドは正常系のロジックに専念し、失敗した場合は単にFalseを返せばよくなるので記述がシンプルになる。

他のオブジェクトを受け取ってMeと相互作用する関数を作る
これも同じことで、対象のオブジェクトとMeをswapをすることによってMeに対する操作に置き換えることができる。

Public Function compare(ByVal other As myClass) As ***
    Call Me.swap(other)       ' swapで対象オブジェクトと自分自身を入れ替える
    (ここでotherの属性をMeの属性として取得して何か計算する)
    Call Me.swap(other)       ' 
    Meの属性とotherの属性とを比較した結果を返す
End Function

受け取った他のオブジェクトに副作用を及ぼすことをしないのであればcloneを作る必要はないが、副作用があるならcloneを作っておきcloneとswapすることによって元に戻すことができる。swapとcloneのイディオムによって、クラス内でしか使用しないPrivateメソッドをあえてPublic化する必要は減ると思う。


APIとして追加したcopy_valueMemberとcopy_objectMemberのシグネチャは以下の通り。

// VBAのクラスオブジェクトの特定のメンバ(オブジェクト型以外)を同一クラスの他のオブジェクトにコピーする
VARIANT_BOOL __stdcall copy_valueMember(IDispatch* me, VARIANT* mbr, IDispatch* target, __int32 dir);

// VBAのクラスオブジェクトのオブジェクト型のメンバを同一クラスの他のオブジェクトにコピーする
VARIANT_BOOL __stdcall copy_objectMember(IDispatch* me, IDispatch** pmbr, IDispatch* target, __int32 dir, VARIANT* method);

この関数は新しいファイル classMemberCopy.cpp を追加して入れた。

  • VBA側でswapとcloneを実装する例がこちら。Declare文は個別の.clsモジュールに宣言し、IDispatch の部分を個別に対象のクラス型に変える必要がある。
' 自分のクラスが "myClass"
' メンバとして "memberClass" のインスタンスを持つ

Private Declare PtrSafe Function copy_valueMember Lib "mapM.dll" _
                                        (ByVal source As myClass, _
                                    ByRef mem As Variant, _
                                ByVal target As myClass, _
                            ByVal direc As Long) As Boolean

Private Declare PtrSafe Function copy_objectMember Lib "mapM.dll" _
                                        (ByVal source As myClass, _
                                    ByRef pmem As memberClass, _
                                ByVal target As myClass, _
                            ByVal direc As Long, _
                        Optional ByRef nm As Variant) As Boolean

Private myValue  As Long
Private myObject As memberClass

' 他のオブジェクトと属性の交換
Private Sub swap(ByVal other As myClass)
    Call copy_valueMember(Me, myValue, other, 0)
    Call copy_objectMember(Me, myObject, other, 0)
End Sub

' 自身のcloneを生成
Private Function clone() As myClass
    Set clone = New myClass
    Call copy_valueMember(Me, myValue, clone, 1)
    Call copy_objectMember(Me, myObject, clone, 1, "clone")
End Function

メンバとして複数のクラスを持つ場合は、copy_objectMember のシノニムを宣言すればいい。