iso tank - プログラムな?話

漢数字を半角英数字に変換

<2019-09-22 修正あり>

洋々亭にて、様々なVBAコードが公開されている。(2回目)

前回に引き続き、漢数字を半角英数字に変換する関数(conv2num・subconv2num)を、拡張できるようにしつつパフォーマンス改善を試みた。「一億二千三百四十五万六千七百八十九」を「123456789」とか「123,456,789」とか「1億2345万6789」とかに変換する関数。

Option Explicit

Private Const KAN_NUM As String = "一二三四五六七八九"
Private Const KAN_DEC As String = "十百千"              '十進
Private Const KAN_MYR As String = "万億兆京垓"          '万進
Private Const KAN_COM As String = "、,"                '漢数字の桁区切り

'---------------------------------------------------------------------------------------------------
' 漢数字変換関数
' ◆機能の説明
'  ・漢数字(文字列型)を半角英数字の文字列に変換して返す。
' オプション
'   insertsMyriad      :Trueにすると変換結果に万進(漢字)を挿入する(例:13000→1万3000)
'                        insertsComma(カンマ挿入)と併用可
'   insertsComma       :Trueにすると変換結果にカンマを挿入する(例:13000→13,000)
'                        insertsMyriad(万進挿入)と併用可
' 注意:渡す文字列に漢数字以外の文字を含めないこと(旧字体等も不可)
'       ※漢数字以外の文字が含まれていた場合はすべて「0」に変換されるため正常な結果が返せない
' オリジナル:洋々亭 2010(conv2num関数)
'---------------------------------------------------------------------------------------------------
Private Function KanjiToNum(ByVal srcKanji As String, _
                            Optional ByRef insertsMyriad As Boolean = False, _
                            Optional ByRef insertsComma As Boolean = False) As String
    
    Dim queAsc As String    'キュー(半角英数に変換した文字列)
    Dim fmtStr As String    'フォーマット文字列
    Dim strLen As Long      '引数・変換後文字列の文字列長
    Dim bufLen As Long      'バッファサイズ(文字列長)
    Dim cnvFrom As Long     '変換・整形範囲(From)
    Dim cnvTo As Long       '変換・整形範囲(To)
    Dim ptr As Long         '変換後の文字列型変数内のポインタ
    Dim i As Long           'イテレータ
    
    Let strLen = Len(srcKanji)
    If strLen = 0 Then
        Exit Function
    End If
    
    '桁区切り除去フェーズ
    If srcKanji Like "*[" & KAN_COM & "]*" Then
        For i = 1 To Len(KAN_COM)
            Let srcKanji = Replace(srcKanji, Mid$(KAN_COM, i, 1), "")
        Next i
        Let strLen = Len(srcKanji)
    End If
    
    Let bufLen = (Len(KAN_MYR) + 1) * 4             'バッファサイズ=(定数の万進の文字数+1)×4
    If bufLen < strLen Then                         '引数の文字数の方が多ければそれをバッファサイズとする
        Let bufLen = strLen
    End If
    
    '漢数字変換フェーズ
    If srcKanji Like "*[" & KAN_MYR & "]*" Then     '万進(万・億・兆・京…)を含む漢数字の変換
        Let queAsc = String$(bufLen, vbNullChar)    'バッファ確保
        Let ptr = 1
        For i = Len(KAN_MYR) To 1 Step -1
            If srcKanji Like "*" & Mid$(KAN_MYR, i, 1) & "*" Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = CLng(InStr(cnvFrom, srcKanji, Mid$(KAN_MYR, i, 1)))  '万進より左の漢数字を抽出・変換
                If cnvFrom = 1 Then
                    Mid(queAsc, ptr) = KanToNum(Mid$(srcKanji, cnvFrom, cnvTo - cnvFrom), bufLen)
                    Let ptr = CLng(InStr(1, queAsc, vbNullChar))
                Else
                    Mid(queAsc, ptr) = Format$(KanToNum(Mid$(srcKanji, cnvFrom, cnvTo - cnvFrom), 4), "0000")
                    Let ptr = ptr + 4
                End If
            ElseIf cnvFrom > 0 Then                  '万進がなくとも変換済みの数字があれば万倍する
                Mid(queAsc, ptr) = "0000"
                Let ptr = ptr + 4
            End If
        Next i
        If strLen > cnvTo Then                      '未処理の漢数字をすべて変換(1万未満である前提)
            Mid(queAsc, ptr) = Format$(KanToNum(Mid$(srcKanji, cnvTo + 1), 4), "0000")
        Else                                        'すべて変換済みでも変換結果を万倍する
            Mid(queAsc, ptr) = "0000"
        End If
        Let queAsc = Left$(queAsc, ptr + 3)
    Else                                            '万進が使われていない場合は単純変換
        Let queAsc = KanToNum(srcKanji, bufLen)
    End If
    Let strLen = Len(queAsc)
    
    '英数字整形フェーズ
    If insertsMyriad And (strLen > 4) Then
        Let KanjiToNum = String$(bufLen + 10, vbNullChar)   'バッファ確保
        Let ptr = 1
        Let cnvTo = 0
        If insertsComma Then
            Let fmtStr = "#,##0"
        Else
            Let fmtStr = "0"
        End If
        For i = Len(KAN_MYR) To 1 Step -1           '大きい方から探索する(…→京→兆→億→万)
            If strLen > 4 * i Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = strLen - 4 * i
                If CLng(Mid$(queAsc, cnvFrom, cnvTo - cnvFrom + 1)) > 0 Then
                    Mid(KanjiToNum, ptr) = Format$(Mid$(queAsc, cnvFrom, cnvTo - cnvFrom + 1), fmtStr)
                    Let ptr = CLng(InStr(ptr, KanjiToNum, vbNullChar)) + 1
                    Mid(KanjiToNum, ptr - 1) = Mid$(KAN_MYR, i, 1)
                End If
            End If
        Next i
        If strLen > cnvTo Then                      '未処理の英数字をすべて整形
            If CLng(Mid$(queAsc, cnvTo + 1)) > 0 Then
                Mid(KanjiToNum, ptr) = Format$(Mid$(queAsc, cnvTo + 1), fmtStr)
                Let ptr = CLng(InStr(ptr, KanjiToNum, vbNullChar))
            End If
        End If
        Let KanjiToNum = Left$(KanjiToNum, ptr - 1)
    ElseIf insertsComma And (strLen > 3) Then
        Let KanjiToNum = Format$(queAsc, "#,##0")
    Else
        Let KanjiToNum = queAsc
    End If
End Function

'---------------------------------------------------------------------------------------------------
' 漢数字(十進まで)変換関数
' ◆機能の説明
'  ・漢数字(文字列型)を数値型に変換して返す
' 前提:渡された文字列には、「〇~九・十・百・千」の漢数字しか含まれていない(万進・旧字体等も不可)
'       ※上記数字以外の文字が含まれていた場合はすべて「0」に変換されるため正常な結果が返せない
' オリジナル:洋々亭 2010(subconv2num関数)
'---------------------------------------------------------------------------------------------------
Private Function KanToNum(ByRef srcKanji As String, Optional ByVal bufLen As Long = 0) As String
    
    Dim srcLen As Long  '引数の文字列長
    Dim cnvFrom As Long '変換範囲(From)
    Dim cnvTo As Long   '変換範囲(To)
    Dim ptr As Long     '変換後の文字列型変数内のポインタ
    Dim i&, j&          'イテレータ(&はLong型の型宣言文字)
    
    Let srcLen = Len(srcKanji)
    If srcLen = 0 Then
        Exit Function
    End If
    If srcKanji Like "*[" & KAN_DEC & "]*" Then     '十進(十・百・千)の字を含む漢数字の変換
        If bufLen = 0 Then
            Let bufLen = (Len(KAN_MYR) + 1) * 4     'バッファサイズ=(定数の万進の文字数+1)×4
            If bufLen < srcLen Then                 '引数の文字数の方が多ければそれをバッファサイズとする
                Let bufLen = srcLen
            End If
        End If
        Let KanToNum = String$(bufLen, vbNullChar)  'バッファを確保
        For i = Len(KAN_DEC) To 1 Step -1           '千の位~十の位まで処理(一の位は処理しない)
            If srcKanji Like "*" & Mid$(KAN_DEC, i, 1) & "*" Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = CLng(InStr(srcKanji, Mid$(KAN_DEC, i, 1)))
                If cnvTo - cnvFrom > 0 Then          '十進の左の漢数字を抽出・変換(例:四五千→45)
                    For j = cnvFrom To cnvTo - 1     'InStr探索(一~九→1~9 それ以外→KAN_NUMにないので0)
                        Let ptr = ptr + 1
                        Mid(KanToNum, ptr) = CStr(InStr(KAN_NUM, Mid$(srcKanji, j, 1)))
                    Next j
                Else
                    Let ptr = ptr + 1
                    Mid(KanToNum, ptr) = "1"        '十進の左に漢数字がない場合は1(例:千→1)
                End If
            ElseIf cnvFrom > 0 Then
                Let ptr = ptr + 1
                Mid(KanToNum, ptr) = "0"            '十進がなくとも変換済みの数字があれば10倍する
            End If
        Next i
    Else
        Let bufLen = srcLen
        Let KanToNum = String$(bufLen, vbNullChar)  '十進を含まない文字列の場合は、文字数分のバッファを確保
    End If
    If srcLen > cnvTo Then                          '未処理の漢数字を変換
        Let cnvFrom = cnvTo + 1                      '(十進を含む文字列の一の位 or 十進を含まない文字列の全部)
        For i = cnvFrom To srcLen
            Let ptr = ptr + 1
            Mid(KanToNum, ptr) = CStr(InStr(KAN_NUM, Mid$(srcKanji, i, 1)))
        Next i
    ElseIf cnvFrom > 0 Then
        Let ptr = ptr + 1
        Mid(KanToNum, ptr) = "0"                    'すべて処理済みでも変換済みの数字があれば10倍する
    End If
    If bufLen > ptr Then
        Let KanToNum = Left$(KanToNum, ptr)         'バッファに余剰があれば切り捨てる
    End If
End Function

大きく異なる点は、モジュール内の定数や定数的に使用されている文字列を、複数の関数やプロシージャで使用することを想定してモジュールレベル定数にしたことや、カンマや読点で区切られている漢数字(たまにある)を一連の数値とみなす処理を挟んだこと。

ただし後者は、カンマや読点で区切られた複数の数値との見分けが困難な(例えば『一二三、四五六』が123と456なのか12万3,456なのか)シチュエーションが考えられるので、基本的には関数に漢数字を渡す前にふるい分けすることを期待している。

中身はかなり弄ったが、大きくはRegExpオブジェクトの使用をやめたり、京・兆・億・万で分かれていた処理をまとめたり。一番悩んだのが「なるべくコストのかからない処理方法」の模索。

元のconv2num関数による数字変換のプロセスは、万・億・兆・京で文字列を分割し、それぞれにsubconv2関数で英数字に変換。それらを結合して、引数numform・setcomにより変換後の文字列を整形、となっている(引数に万・億・兆・京が含まれている場合)。

KanjiToNum関数も、基本的なコンセプトはconv2num・subconv2numのそれをそのまま引き継いだ。ただ違うのは、conv2num関数では万・億・兆・京それぞれで変数を持っていたが、KanjiToNum関数ではすべて一つの変数に連結することにした。

つまり、例えば「三千五百億」は一度「350000000000」に直してから「350,000,000,000」なり「3500億」なり「3,500億」なりに整形する。この辺あまり効率が良くないとは思ったが、最大公約数的に考えて確実さを優先した。

で、その分、文字列操作処理をなるべく軽くすることにチャレンジした。それがMidステートメントを利用する方法。Mid関数ではない。Midステートメントはステートメントなので、基本的には行頭に書かれていなければならないし、Mid関数は関数なので基本的には式の右辺にあるべきもの。

可能な限り文字列型変数への代入を減らすことでパフォーマンスを改善できないかという試み。

もっと極端なことをやれば、関数内でいちいち結合している定数的な文字列('"*[" & KAN_MYR & "]*"'とか)を全部モジュールレベルで変数なり定数化してしまえばパフォーマンス向上は見込めるが、モジュールの宣言部があまりにもゴチャゴチャしすぎるのでやってない。あとクラス化やプロシージャ化も考えたが、コストが高くなったりメリットを潰してしまったりしたのでそれもやってない。

あと一応、垓より上の数にも対応できるようにはしている。が、一文字の数に限る。恒河沙とか阿僧祇とか不可思議とか無量大数とかには対応できない。それからVBEの仕様上、垓の上の'ジョ'をそのまま使えない(Shift_JISにない)のでひと工夫必要だと思う。

2019-09-19 一部修正

古いコードを貼り付けてしまっていたので新しいコードに差し替えた(一部ちょっと変わった)。あと、'ジョ'の漢字がバグったのでカタカナ表記に修正。

2019-09-22 一部修正

最終バージョンに更新・・・(たぶん)これが一番新しかったと思います。

(VBで)Ifを使わない関数が遅い原因を調べる

<2019-09-14 追記あり>

以前書いた3値の中央値をIfを使わずに求める方法で、少なくとも自分の環境のVBAではIfを使った方が速いと書いた。

が、原因がよくわからずモヤっとしていた。

試しにC++で同じように比較してみたところ、C++ではIfあり・なしで処理時間にそう大きな差はなかった。この違いは何なんだろうか?

試しにオンラインでアセンブリを確認できるサイトで、C++で書いたコードをアセンブリ言語にしてみた(Visual Studioのコンパイルのオプションでアセンブリを出力することもできたが、こちらのサイトでやった方がコードが見やすかった)。

int med(int a, int b, int c) {
    return a ^ b ^ c ^ (-(a < b) & (a ^ b)) ^ (-(b < c) & (b ^ c)) ^ (-(c < a) & (c ^ a));
}

        mov     edx, DWORD PTR _a$[esp-4]
        mov     eax, edx
        mov     ecx, DWORD PTR _c$[esp-4]
        push    esi
        mov     esi, DWORD PTR _b$[esp]
        xor     eax, esi
        push    edi
        xor     edi, edi
        cmp     edx, esi
        cmovl   edi, eax
        cmp     ecx, edx
        cmovl   edx, ecx
        xor     edi, edx
        cmp     esi, ecx
        cmovl   esi, ecx
        xor     edi, esi
        xor     edi, ecx
        mov     eax, edi
        pop     edi
        pop     esi
        ret     0

上記のコードは最適化を有効にしている(/O1)。アセンブリはあまり詳しくないが、'-(a < b) & (a ^ b)'的な部分の処理が以下のような感じで非常にシンプルになっている。

        mov     edx, DWORD PTR _a$[esp-4]
        mov     eax, edx
        mov     esi, DWORD PTR _b$[esp]
        xor     eax, esi
        cmp     edx, esi
        cmovl   edi, eax

先にa^bを計算してeaxレジスタに保存しておき(4行目)、a<bを評価し(5行目)真なら値をコピーする(6行目)。最適化を行わないと、以下のようになってしまう。

        mov     eax, DWORD PTR _a$[ebp]
        cmp     eax, DWORD PTR _b$[ebp]
        jge     SHORT $LN3@med
        mov     DWORD PTR tv68[ebp], 1
        jmp     SHORT $LN4@med
$LN3@med:
        mov     DWORD PTR tv68[ebp], 0
$LN4@med:
        mov     ecx, DWORD PTR _a$[ebp]
        xor     ecx, DWORD PTR _b$[ebp]
        mov     edx, DWORD PTR tv68[ebp]
        neg     edx
        and     ecx, edx

aとbを比較し(2行目)、a<bなら1(4行目まで)、a>=bなら0(7行目まで)を一旦格納してから符号を反転し(12行目)、a^b(10行目)の結果をand演算(13行目)している。&は論理積(and)のビット演算子だし-は符号を反転するので、これが本来的な動作ではある。

が、大小を比較して(cmp命令)フラグレジスタを見て1か0を格納し(jge命令mov命令jmp命令)符号反転(neg命令)したものをビット演算(and命令)する代わりに、大小を比較して(cmp命令)フラグレジスタを見て値をコピーするか何もしない(cmovl命令)ようにしても同じ結果が得られるし、この方がすっきりするしずっと速い。

まぁ、C++の方はこうなってた。最適化スゴイ。cmovlスゴイ。

さてVBだ。VBはオンラインでこう、中身・・・中間言語・・・MSIL、を見る、とかいうのがないので、Visual Studioに附属しているIL Dasmを使った。

Function Med(ByRef a As Long, ByRef b As Long, ByRef c As Long) As Long
    Return a Xor b Xor c Xor ((a < b) And (a Xor b)) Xor ((b < c) And (b Xor c)) Xor ((c < a) And (c Xor a))
End Function

  IL_0000:  ldarg.0
  IL_0001:  ldind.i8
  IL_0002:  ldarg.1
  IL_0003:  ldind.i8
  IL_0004:  xor
  IL_0005:  ldarg.2
  IL_0006:  ldind.i8
  IL_0007:  xor
  IL_0008:  ldarg.0
  IL_0009:  ldind.i8
  IL_000a:  ldarg.1
  IL_000b:  ldind.i8
  IL_000c:  clt
  IL_000e:  ldc.i4.0
  IL_000f:  cgt.un
  IL_0011:  neg
  IL_0012:  conv.i8
  IL_0013:  ldarg.0
  IL_0014:  ldind.i8
  IL_0015:  ldarg.1
  IL_0016:  ldind.i8
  IL_0017:  xor
  IL_0018:  and
  IL_0019:  xor
  IL_001a:  ldarg.1
  IL_001b:  ldind.i8
  IL_001c:  ldarg.2
  IL_001d:  ldind.i8
  IL_001e:  clt
  IL_0020:  ldc.i4.0
  IL_0021:  cgt.un
  IL_0023:  neg
  IL_0024:  conv.i8
  IL_0025:  ldarg.1
  IL_0026:  ldind.i8
  IL_0027:  ldarg.2
  IL_0028:  ldind.i8
  IL_0029:  xor
  IL_002a:  and
  IL_002b:  xor
  IL_002c:  ldarg.2
  IL_002d:  ldind.i8
  IL_002e:  ldarg.0
  IL_002f:  ldind.i8
  IL_0030:  clt
  IL_0032:  ldc.i4.0
  IL_0033:  cgt.un
  IL_0035:  neg
  IL_0036:  conv.i8
  IL_0037:  ldarg.2
  IL_0038:  ldind.i8
  IL_0039:  ldarg.0
  IL_003a:  ldind.i8
  IL_003b:  xor
  IL_003c:  and
  IL_003d:  xor
  IL_003e:  ret

このMSILとかCILとかいうのはさっぱりだったが、ldargで引数のアドレスをスタックにpushして、ldind.i~でスタックに積まれたアドレスをi~に応じてint32やint64の数値に置き換えているらしい。ようは命令がすべてスタック上で行われるスタックマシンというやつらしい。

コードを読み解いていくと、どうもスタックというものは一つしかないらしく、絶えずldarg・ldindで引数をスタックに積み込んでは命令を実行してpopされ、またldarg・ldindでスタックに積み・・・ということを繰り返しているように思える。

jmpのような飛ぶ系の命令は使われていないようだが、スタック上を線形に(というのだろうか)行ったり来たりしているように見える。

8行目(IL_0007)まではa Xor b Xor cを実行していて、9行目から24行目(IL_0019)までが'Xor ((a < b) And (a Xor b))'の処理。以降、16行ずつbとc、cとaの処理。

何をしているのかというと、ようは2つの値をスタックにpushして(ldarg.0~2ldind.i8)大小を比較して1か0をpushして(clt)、なぜか比較結果と0(ldc.i4.0)を比較して1か0をpushして(cgt.un)、符号を反転して(neg)int64に変換して(conv.i8)、もう一度2つの値をスタックにpushして(ldarg・ldind.i8)、2つの値をxorした値を0か-1とandして、その値とあらかじめスタックしていた a Xor b Xor c の値をxorしている。

これをあと2回繰り返している。ようするに最適化していないC++のアセンブリのコードとロジック的にほぼ同じことをやっているようだ。jmp系の命令がない点や比較を2回繰り返している点や、64ビット整数への変換が噛んでいるという違いはあるが。ちなみにLongを全部Integerにしてやってみたが、int64へのコンバートがなくなっただけで処理はほとんど同じだった。

ちなみにIfを使った場合はだいたい以下のような感じになる。

Function Med(ByRef a As Long, ByRef b As Long, ByRef c As Long) As Long
    If a < c Then
        If b < a Then
            Return a
        ElseIf B < c Then
            Return b
        Else
            Return c
        End If
    ElseIf a < b Then
        Return a
    ElseIf c < b Then
        Return b
    Else
        Return c
    End If
End Function

  IL_0000:  ldarg.0
  IL_0001:  ldind.i8
  IL_0002:  ldarg.2
  IL_0003:  ldind.i8
  IL_0004:  bge.s      IL_0021
  IL_0006:  ldarg.1
  IL_0007:  ldind.i8
  IL_0008:  ldarg.0
  IL_0009:  ldind.i8
  IL_000a:  bge.s      IL_0011
  IL_000c:  ldarg.0
  IL_000d:  ldind.i8
  IL_000e:  stloc.0
  IL_000f:  br.s       IL_003a
  IL_0011:  ldarg.1
  IL_0012:  ldind.i8
  IL_0013:  ldarg.2
  IL_0014:  ldind.i8
  IL_0015:  bge.s      IL_001c
  IL_0017:  ldarg.1
  IL_0018:  ldind.i8
  IL_0019:  stloc.0
  IL_001a:  br.s       IL_003a
  IL_001c:  ldarg.2
  IL_001d:  ldind.i8
  IL_001e:  stloc.0
  IL_001f:  br.s       IL_003a
  IL_0021:  ldarg.0
  IL_0022:  ldind.i8
  IL_0023:  ldarg.1
  IL_0024:  ldind.i8
  IL_0025:  bge.s      IL_002c
  IL_0027:  ldarg.0
  IL_0028:  ldind.i8
  IL_0029:  stloc.0
  IL_002a:  br.s       IL_003a
  IL_002c:  ldarg.2
  IL_002d:  ldind.i8
  IL_002e:  ldarg.1
  IL_002f:  ldind.i8
  IL_0030:  bge.s      IL_0037
  IL_0032:  ldarg.1
  IL_0033:  ldind.i8
  IL_0034:  stloc.0
  IL_0035:  br.s       IL_003a
  IL_0037:  ldarg.2
  IL_0038:  ldind.i8
  IL_0039:  stloc.0
  IL_003a:  ldloc.0
  IL_003b:  ret

bge.sとかbr.sとかいうのがjmp系の命令。ジャンプはするが、処理命令数は最小16~最大21程度に抑えられる。Ifを使わずに計算している方は57。

これはつまり、演算や比較が生じる毎に何度もpushするような処理は遅くなる、ということだろうか。C++は複数の汎用レジスタに値を置けるが、VBはそれができない、ということだろうか。

なんというかこう、なんでcltとcgt.unで2回比較を繰り返しているのかとか、3つしかない引数を何度も何度もpushしているところはなんとかならないのかとか、見るからに一つのスタックだけでやりくりしているように思えるが本当にそうなのかとか、もうちょっとなんとかならないのかと思うところがある。

が、ひとえに自分のスキル・知識が足りてないのが一番の原因ということに行き着いた。現時点では「VBでは条件分岐の有無より演算や比較の回数をとにかく減らした方が効率がいい」ということかなと整理している。ゆくゆくはこういったアセンブリやILといったものを元にしてコードを最適化できるようになりたい。

2019/09/14 追記

よくよく調べてみたら、コンパイルしてMSIL(CIL)が出力されるのはVB.NETだけであって、「VBAが出力するPコードとやらもMSIL(CIL)なんでしょ?」と思ってたらどうやら違ったらしい。死にたい。割と。

「じゃあVBAが出力するPコードとやらはどんなコードなのよ?」と思い調べてみたが、なぜか知らないがかなり情報が少ない。

かろうじて見つけたP-Code Disassemblerなるツールで、Pコードをダンプできるらしいのでやってみた。

Option Explicit

Function Med(ByRef a As Long, ByRef b As Long, ByRef c As Long) As Long
    Let Med = a Xor b Xor c Xor ((a < b) And (a Xor b)) Xor ((b < c) And (b Xor c)) Xor ((c < a) And (c Xor a))
End Function

Line #0:
        Option  (Explicit)
Line #1:
Line #2:
        FuncDefn (Function Med(ByRef a As Long) As Long)
Line #3:
        Let 
        Ld a 
        Ld B 
        Xor 
        Ld c 
        Xor 
        Ld a 
        Ld B 
        Lt 
        Paren 
        Ld a 
        Ld B 
        Xor 
        Paren 
        And 
        Paren 
        Xor 
        Ld B 
        Ld c 
        Lt 
        Paren 
        Ld B 
        Ld c 
        Xor 
        Paren 
        And 
        Paren 
        Xor 
        Ld c 
        Ld a 
        Lt 
        Paren 
        Ld c 
        Ld a 
        Xor 
        Paren 
        And 
        Paren 
        Xor 
        St Med 
Line #4:
        EndFunc 

このPコードとやらのリファレンスというものがなぜか見つからないので、正直これが正しいのかはわからないが、やっていることはなんとなく想像がつく。LdはLoad、Stは後続の名前の変数へのSet、Letはまんま代入のステートメント、Ltは比較(Less Than)して-1か0をセット、Parenは括弧だから演算の優先順位?・・・うん、ILDasmで見たのとあんま変わらんわこれ。

要はVB.NETにせよVBAにせよ、根本的にはスタックベースで動作している、ということかな・・・っておもいました。

で、そうなるとやはり同じ値を何度も参照するような処理を減らす方がパフォーマンスを改善できる、ということになるか。

とりあえず9つあるParenは3つに減らせるものの、Paren自体は命令の順序を入れ替えてるだけで何のコストも発生していないように思われる(Parenを削っても普通に処理の順序を読み解くことができる→おそらくParen自体は何の命令も発していない)。

研鑽を積もう。

3値の中央値をIfを使わずに求める

先日貼ったクイックソートのコードにもちょっとだけ使ってたが、XOR(排他的論理和)を利用して色々と面白いことができる。

有名なのはXOR交換アルゴリズムだが、これは二つの変数に格納されている値を交換するとき、一時変数を介すことなくXORだけで二つの変数の値を交換してしまえるという手法。VBAで記述すると以下のようになる。

A = A Xor B
B = A Xor B 'Aの値が代入される
A = A Xor B 'Bの値が代入される

なぜこうなるのか? 2行目を数式にすると、

(A Xor B) Xor B = A

である。XORは括弧の有無や括弧の位置を変えても計算結果は変わらない(結合法則)。なので、

B Xor B Xor A = A

でも同じである。XORは排他的論理和(2値がどちらも真または偽の場合は偽、それ以外は真)であるので、同じ値をXORすると0になる。よって、

(B Xor B) Xor A = A
0 Xor A = A
A = A

である(Aと0をXORした場合はそのままAが返る)。つまり、 A XOR B の結果(仮にA'とする)をもう一度BとXORすることでAを求めることができ、同様にA'をAとXORすればBが求められる。XORは非常に面白い性質を持っている。

ちなみに、XOR交換は3値以上でも成り立つ。要は複数の値を全てXORした結果に対し、ある一値以外のすべての値をXORしてやれば、その一値が求められる。

A = A Xor B Xor C Xor D Xor E Xor F
B = A Xor B Xor C Xor D Xor E Xor F 'Aの値が代入される(A Xor B Xor C Xor D Xor E Xor F Xor B Xor C Xor D Xor E Xor F と等価)
C = A Xor B Xor C Xor D Xor E Xor F 'Bの値が代入される(A Xor B Xor C Xor D Xor E Xor F Xor A Xor C Xor D Xor E Xor F と等価)
D = A Xor B Xor C Xor D Xor E Xor F 'Cの値が代入される(A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor D Xor E Xor F と等価)
E = A Xor B Xor C Xor D Xor E Xor F 'Dの値が代入される(A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor C Xor E Xor F と等価)
F = A Xor B Xor C Xor D Xor E Xor F 'Eの値が代入される(A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor C Xor D Xor F と等価)
A = A Xor B Xor C Xor D Xor E Xor F 'Fの値が代入される(A Xor B Xor C Xor D Xor E Xor F Xor A Xor B Xor C Xor D Xor E と等価)

で。ふと、XOR交換以外にも色々と応用が利くんじゃないか? と思った。具体的には条件分岐の代用とか。探したところ、研究員の津田氏のブログにて条件分岐を使わずにmax/min関数を実現する方法というものが公開されていた。以下引用。

int max(int a, int b) {
    return a ^ ((a ^ b) & -(a < b));
}

これをVBAで書くとこうなる。

Public Function max(ByRef a As Long, ByRef b As Long) As Long
    Let max = a Xor ((a Xor b) And (a < b))
End Function

このC言語の例では比較演算の真値が1となるため正負反転を行っているが、VBでは真値が-1となる(偽はいずれも0)ので、正負の反転は必要ない。要は、a < b が成立するなら a Xor ((a Xor b) And -1) = b、成立しなければ a Xor ((a Xor b) And 0) = a となり、ちゃんとmax関数としての機能を果たしている。ちなみに-1は全てのビット列が1、つまり0が裏返った値なので、A And -1 = Aとなる。

なおmin関数は、このmax関数のコードの不等号を反転するか、あるいは最初のaをbにするだけでいい。

Public Function min(ByRef a As Long, ByRef b As Long) As Long
    Let min = b Xor ((a Xor b) And (a < b))
End Function

ちなみに先のブログによれば、不等号の部分は条件分岐になっていない(アセンブラコード上では分岐命令を使用していない)、とのこと。ただしあくまでもC言語での話なので、VBでどうなってるかは不明。分岐命令を使っているとしたら動作は遅くなるかもしれない。

まぁ、最初の予想に反してXORだけで条件分岐の代わりをすることは難しいが、他の演算と組み合わせて条件分岐の代わりになる、ということは分かった。

で、これを応用すれば3値の中央値(median)を求めることも可能なんじゃないか? と思い立った。要は偶数回出現した値は消えて奇数回出現した値は残るんだから、以下の計算で中央値が求められるはずだ。

A Xor B Xor C Xor max(A, B, C) Xor min(A, B, C) = median

A・B・C・最大値・最小値の5つをXORすることで、最大値と最小値はそれぞれ2回(偶数回)、中央値は1回(奇数回)だけ演算することになり、中央値のみが残る。早速やってみる。

Public Function med(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Dim tmpMax&, tmpMin&
    Let tmpMax = A Xor ((A Xor B) And (A < B))
    Let tmpMin = A Xor ((A Xor B) And (A > B))
    Let med = A Xor B Xor C Xor _
              (C Xor ((C Xor tmpMax) And (C < tmpMax))) Xor _
              (C Xor ((C Xor tmpMin) And (C > tmpMin)))
End Function

できた。

これでもちゃんと動くが、冗長すぎる。もうちょっとスマートにしたい。どうすればいいか考えていたところ、C を2回続けてXORしている部分の外側の方のXor C は、演算の優先順位を下げても演算結果に影響しないことに気付いた(結合法則)。

    Let med = A Xor B Xor C Xor _
              C Xor ((C Xor tmpMax) And (C < tmpMax)) Xor _
              C Xor ((C Xor tmpMin) And (C > tmpMin))

上記のように左端の方のXor C を括弧の外に出しても演算結果は変わらない。すると、同じ優先順位の層で C が何度もXORされていることになる。XORは可換(XOR以外の演算と結合しない箇所であれば位置を交換しても結果が同じ)なので、

    Let med = A Xor B Xor C Xor C Xor C Xor _
              ((C Xor tmpMax) And (C < tmpMax)) Xor _
              ((C Xor tmpMin) And (C > tmpMin))

としても演算結果は同じである。ところで先に述べたとおり、同じ値を奇数回XORすると元の値に戻る。なので Xor C を3回も繰り返す必要はない。1回で十分である。

    Let med = A Xor B Xor C Xor _
              ((C Xor tmpMax) And (C < tmpMax)) Xor _
              ((C Xor tmpMin) And (C > tmpMin))

A・B・C・3値の最大値・3値の最小値をXORするはずだったのに、2行目と3行目の内容が変わってしまった。それでも演算結果は変わらない。どういうことか。

2行目は「C < max(A, B) の場合は (C Xor max(A, B)) を XORする」、3行目は「C > min(A, B) の場合は (C Xor min(A, B)) を XORする」、ということだ。

A < B < C と仮定してみると、2行目は C < B が偽となり0、3行目は C > A が真となり1行目の結果に A Xor C をXORし、最終的に B が返る。

逆に A > B > C と仮定すると、2行目は C < A が真で A Xor C、3行目は C > B が偽となり0。結果はやはりB。

では B < A < C の場合は? A Xor B Xor C Xor 0 Xor B Xor C で結果はA。B < C < A だと A Xor B Xor C Xor A Xor C Xor B Xor C で結果はC。

この時、なにか閃いた。これはたぶんなんかこういうことだ! と走り書きしたメモが以下。

'たぶんなんかこういうやつ。
If A < B Then
    'A Xor B
    If B < C Then
        'B Xor C
    ElseIf C < A Then
        'C Xor A
    End If
ElseIf B < C Then
    'B Xor C
    If C < A Then
        'C Xor A
    End If
ElseIf C < A Then
    'C Xor A
End If

'以下に置き換えられるはず。
If A < B Then
    'A Xor B
End If
If B < C Then
    'B Xor C
End If
If C < A Then
    'C Xor A
End If

たぶんなんかこういうやつ。で、できたのが以下のコード。

Public Function med3(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Let med3 = A Xor B Xor C Xor ((A Xor B) And (A < B)) Xor ((B Xor C) And (B < C)) Xor ((C Xor A) And (C < A))
End Function

何をやっているかというと、A XOR B XOR C の演算結果に対し、A < B のときは A と B、B < C のときは B と C、C < A のときは C と A をそれぞれXORしている。

こうすると3値の中央値を求めるために最大値・最小値を求める必要がないため、計算量も減ったし一時変数も不要になった。ダラダラした条件分岐を使う必要もない。キモチイイ!

ただし、

'Ifを使わずに中央値を求める関数
Public Function med3(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Let med3 = A Xor B Xor C Xor ((A Xor B) And (A < B)) Xor ((B Xor C) And (B < C)) Xor ((C Xor A) And (C < A))
End Function

'Ifを使って中央値を求める関数
Public Function medIF(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    If A < C Then
        If B < A Then
            Let medIF = A
        ElseIf B < C Then
            Let medIF = B
        Else
            Let medIF = C
        End If
    ElseIf A < B Then
        Let medIF = A
    ElseIf C < B Then
        Let medIF = B
    Else
        Let medIF = C
    End If
End Function

'乱数発生器
Private Function RandomLong(ByRef minVal As Long, ByRef maxVal As Long, Optional ByRef doRandomize As Boolean = True) As Long
    If doRandomize Then
        Randomize
    End If
    Let RandomLong = Int(Rnd * (maxVal - minVal + 1)) + minVal
End Function

'速度検証
Sub SpeedTestMed()
    Dim A As Long
    Dim B As Long
    Dim C As Long
    Dim M As Long
    Dim i As Long
    Dim loopCnt As Long
    Dim pTime As Single
    Let A = RandomLong(1, 200000000)
    Let B = RandomLong(1, 200000000)
    Let C = RandomLong(1, 200000000)
    Let loopCnt = 5000000
    Let pTime = Timer
    For i = 1 To loopCnt
        Let M = medIF(A, B, C)
    Next i
    Debug.Print "medIF:" & Timer - pTime    'medIF:0.4296875
    Let pTime = Timer
    For i = 1 To loopCnt
        Let M = med3(A, B, C)
    Next i
    Debug.Print "med3: " & Timer - pTime    'med3: 0.4453125
End Sub

少なくとも自分の環境のVBAでは、普通にIfで条件分岐した方が速い。

2019/08/26 追記

Public Function med3(ByRef A As Long, ByRef B As Long, ByRef C As Long) As Long
    Let med3 = A Xor B Xor C Xor ((A < B) And (A Xor B)) Xor ((B < C) And (B Xor C)) Xor ((C < A) And (C Xor A))
End Function

以前書いたコードとAndの前後が入れ替わっているが、結果には影響しない。左から読んで「『A < B』なら『A Xor B』」と読めるので、自分はこの順番の方が好き。

なぜこの数式で中央値が求められるのか、少し掘り下げてみる。XORについてはベン図を使うとわかりやすい。A < B < C と仮定し数式を左から順に読み解くと、

A

A

Xor B

Xor B

Xor C

Xor C

Xor ((A < B) And (A Xor B))

の(A < B)は今回の仮定では真(-1)であり、

Xor ((-1) And (A Xor B))
= Xor (A Xor B)
= Xor A Xor B

となるので、Xor A と Xor B に分解してそれぞれ評価してみる。

Xor A

Xor A

Xor B

Xor B

次。

Xor ((B < C) And (B Xor C))

これも(B < C)は真(-1)なので、上と同様にXor B と Xor C に分解。

Xor B

Xor B

Xor C

Xor C

次。

((C < A) And (C Xor A))

の(C < A)は偽(0)なので、

Xor ((0) And (C Xor A))
= Xor (0)
= Xor 0

0をXORしても値は変わらないので、

A < B < C の場合の中央値

がそのまま結果となる。

他のパターンでも同様に求めることができる。

また、3値のうち2値が同値だった場合はその2値の方が返るようになっている。

3値とも同値だった場合は、もちろんその値が中央値となる。

丸付き数字から丸囲み数字(丸数字)に変換

洋々亭にて、様々なVBAコードが公開されている。

この中に含まれている、丸付き数字(「○2」など)を丸囲み数字(「②」など)に変換する関数を、⓪~㊿まで対応できるように改造した。

ちなみになんでこんな関数が必要かというと、一部の法令(児童福祉法など)は、項番号の代わりに丸数字を使用していることがあるが、丸数字は機種依存文字(環境依存文字)なので正しく表示されないコンピュータが存在する恐れがあり、e-Govでは「○2」としている。これを本来意図するところの丸数字に置き換えるため。

現在ではほとんどの機種(環境)で丸数字が表示できるようになっており、これを一括変換したいという要望があったので、洋々亭のコードを拝借し、かつ範囲を広げた。

'---------------------------------------------------------------------------------------------------
' 丸付き数字置換関数
' ◆機能の説明
'   ・「○3」形式の表記を「③」に変換する
'   ・一部文字列はUnicode文字に変換する
'   ・一定数を超える数字の場合は丸囲み数字が使用できないため、角かっこで囲む(○51→[51])
'   ※項番号を上記の方法で表記している法令があるための対処(児童福祉法等)。
' オリジナル:洋々亭 2006
'---------------------------------------------------------------------------------------------------
Private Function ToCircledNum(ByRef srcStr As String) As String
    
    Dim srcLen As Long      '引数の文字列長(○を含む)
    Dim tmpAsc As String    '引数から○を除去し半角英数に変換した文字列
    Dim chrNum As Long      '変換後の数字
    Dim i As Long           'イテレータ
    
    'まず全角数字を半角数字に置き換え、次に半角数字を丸数字に置き換える。
    Let srcLen = Len(srcStr)
    If srcLen < 2 Then
        Exit Function
    End If
    Let tmpAsc = String$(srcLen - 1, vbNullChar)
    For i = 2 To srcLen
        Mid(tmpAsc, i - 1, 1) = Mid$("0123456789", CLng(InStr("0123456789", Mid$(srcStr, i, 1))), 1)
    Next i
    Let chrNum = CLng(tmpAsc)
    Select Case chrNum
    Case Is < 0                                 '0未満は非対応([]で括る)
        Let ToCircledNum = "[" & tmpAsc & "]"
    Case 0                                      '丸0  = U+24EA( 9450) chrNum=0のためそのまま
        Let ToCircledNum = ChrW(9450)
    Case Is < 21                                '1~20は普通に丸囲み数字が使用できる
        Let ToCircledNum = Mid$("①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳", chrNum, 1)
    Case Is < 36                                '丸21 = U+3251(12881) 21から始まるため 12881 - 21 = 12860
        Let ToCircledNum = ChrW(12860 + chrNum)
    Case Is < 51                                '丸36 = U+32B1(12977) 36から始まるため 12977 - 36 = 12941
        Let ToCircledNum = ChrW(12941 + chrNum)
    Case Else                                   '51以上も非対応([]で括る)
        Let ToCircledNum = "[" & tmpAsc & "]"
    End Select
End Function

「引数には丸記号+全角英数字の組み合わせの文字列しか来ない」という前提で作ってる関数なので、呼び出し前に正規表現やLikeマッチングでのふるい落としが必要。簡単な判定は19行目でやってるけど(引数が1文字以下なら何も返さず終了)。

やってることは洋々亭のmarumoji関数と一緒。まず全角英数字を半角英数字に置き換え(22~25行目)、整数型に変換(26行目)。あとはSelect Case文で0未満と50超は対応する丸数字がないため[]で括る、⓪と㉑~㊿はChrW関数で文字コードから文字を取得。①~⑳は文字を並べてMid関数で対応する数字の位置に該当する文字を取得。

①~⑳もChr関数を使えば取得できるが、文字を並べてMid関数で取得した方がちょっとだけ早い。

Public Sub SpeedTest()
    Dim testNums(2000000) As Long
    Dim dummyStr As String
    Dim procTime As Single
    Dim i As Long
    For i = LBound(testNums) To UBound(testNums)
        Let testNums(i) = RandomLong(1, 20)
    Next i
    Let procTime = Timer
    For i = LBound(testNums) To UBound(testNums)
        Let dummyStr = Mid$("①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳", testNums(i), 1)
    Next i
    Debug.Print "Test1: " & Timer - procTime        'Test1: 0.140625
    Let procTime = Timer
    For i = LBound(testNums) To UBound(testNums)
        Let dummyStr = Chr(34623 + testNums(i))
    Next i
    Debug.Print "Test2: " & Timer - procTime        'Test2: 0.171875
End Sub

Private Function RandomLong(ByRef minVal As Long, ByRef maxVal As Long, Optional ByRef doRandomize As Boolean = True) As Long
    If doRandomize Then
        Randomize
    End If
    Let RandomLong = Int(Rnd * (maxVal - minVal + 1)) + minVal
End Function

⓪~㊿を全部並べてMid関数で取得した方が分かりやすいしできるならそうしたいんだけど、VBAは内部的にUnicode文字を使用しているものの、VBEはUnicode文字をサポートしていない

ChrW関数などを使用してUnicode文字をサポートしている出力先(例えばWord文書など)に出力すること自体は可能なので、こういった書き方になった。もっとスマートな方法はないだろうか。

Pythonいじり

なんだか暇なので、レスポンスヘッダ表示装置を国際化ドメイン名に対応させてみた。

作るにあたって色んな国際化ドメイン名を調べてみたけど、中国とか台湾とかやたら多いのな。

あと下記はhttplibライブラリの例外クラスの引数のメモ。どこにも書いてなかったからさ。

httplib.InvalidURL
引数の持つプロパティ:message
httplib.NotConnected
引数の持つプロパティ:message
httplib.UnknownProtocol
引数の持つプロパティ:message, version
httplib.IllegalKeywordArgument
※なぜかraiseしただけでInternalServerErrorになるなーと思ったらPython 2.6.2にはない例外だった。
SourceForge参照。
httplib.UnknownTransferEncoding
引数の持つプロパティ:message
httplib.UnimplementedFileMode
引数の持つプロパティ:message
httplib.IncompleteRead
引数の持つプロパティ:message, expected, partial
httplib.CannotSendRequest
引数の持つプロパティ:message
httplib.CannotSendHeader
引数の持つプロパティ:message
httplib.ResponseNotReady
引数の持つプロパティ:message
httplib.ImproperConnectionState
CannotSendRequest、CannotSendHeader、ResponseNotReadyの親クラス。
引数の持つプロパティ:message
httplib.BadStatusLine
引数の持つプロパティ:message, line
httplib.HTTPException
httplib下の例外クラスすべての祖。
引数の持つプロパティ:message