1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

VBAHaskellの紹介 その23(ジャグ配列をフラットな配列に展開する再帰)

Last updated at Posted at 2015-08-20

(2016/3/7)
この関数はHaskell_6_iterator.bas の廃止と vh_stdvec.cls の追加に伴い、実装を書き換えた。ほとんど形を変えずに同じ機能が実現できた。


VBAは前方宣言なしで関数を呼べるため、少し奇妙に見える再帰呼び出しができる。

例題

ジャグ配列、たとえば Array(1, Array(2, Array(3, Array(4, Array(5), 6))), 7) をフラットな配列Array(1, 2, 3, 4, 5, 6, 7) に展開する。

方針

次のような関数curiouslyRecursive を作る。

  1. 出力用の配列(実際にはイテレータ1) を受け取り、その末尾に対象配列の各要素を順に追記していく。要素自身が配列である時は再帰的に処理する。
  2. 上記の繰り返し処理は畳み込み関数foldlで表現する。accumulatorは出力用配列。
  3. この関数自体をfoldlの引数に渡して再帰する

コード

' 少しだけ奇妙な再帰
Function curiouslyRecursive(ByRef it As Variant, ByRef x As Variant) As Variant
    If IsArray(x) Then  ' 配列の場合
        curiouslyRecursive = foldl(p_curiouslyRecursive, it, x)  ' ← ここ
    Else  ' 単一変数の場合
        curiouslyRecursive = iterator_push_ex(it, x)     ' 単純に末尾に追加
    End If
End Function

    ' この関数を関数ポインタ化したもの
    Function p_curiouslyRecursive(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_curiouslyRecursive = make_funPointer(AddressOf curiouslyRecursive, firstParam, secondParam)
    End Function

' テスト関数
Sub curiouslyRecursiveTest()
    Dim arr As Variant
    arr = Array(1, Array(2, Array(3, Array(4, Array(5), 6))), 7) ' ジャグ配列
    Dim ret As Variant: ret = Array()    ' 結果出力用配列
    Dim it As Variant:  it = make_iterator(ret)
    it = curiouslyRecursive(it, arr)
    ret = release_iterator(it)
    ReDim Preserve ret(0 To iterator_pos(it))
    printS ret  ' サイズ表示
    printM ret  ' 配列の内容表示
End Sub

**「ここ」**とコメントした箇所で、自分自身をfoldlの引数に渡している。配列ではない単一の変数に到達するまで再帰的に呼び出され、単一変数になったらそれを末尾に追加することになる。

(イテレータに新規に導入した関数)
配列の末尾に追記するときはサイズを拡張しなければならないので、イテレータに処理効率を考慮した新しい関数iterator_push_exを追加した。イテレータが指す位置が配列のUBoundを超えていたらサイズを2倍にする。

' 範囲拡張しながらiterator_push
Function iterator_push_ex(ByRef it As Variant, ByRef x As Variant) As Variant
    Dim m As Long: m = max_fun(it(1), 2 * UBound(it(0)) - LBound(it(0)) + 1)
    If UBound(it(0)) < it(1) Then
        Dim tmp As Variant
        swapVariant tmp, it(0)
        ReDim Preserve tmp(LBound(tmp) To m)
        swapVariant tmp, it(0)
    End If
    iterator_push_ex = iterator_push(it, x)
End Function

モジュール

イテレータ → Haskell_6_iterator.bas
テストコード → test_module.bas


VBAHaskellの紹介 その22(イテレータ)
VBAHaskellの紹介 その1(最初はmapF)

  1. VBAHaskellの紹介 その22(イテレータ)

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?