iso tank - プログラムな？話 2019年 08月

先日貼ったクイックソートのコードにもちょっとだけ使ってたが、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

Xor B

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 B

次。

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

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

Xor B

Xor C

次。

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

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

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

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

がそのまま結果となる。

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

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

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

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

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

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

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

'---------------------------------------------------------------------------------------------------
' 丸付き数字置換関数
' ◆機能の説明
'   ・「○３」形式の表記を「③」に変換する
'   ・一部文字列はUnicode文字に変換する
'   ・一定数を超える数字の場合は丸囲み数字が使用できないため、角かっこで囲む（○５１→[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("０１２３４５６７８９", 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文書など）に出力すること自体は可能なので、こういった書き方になった。もっとスマートな方法はないだろうか。