vba【超高速！二次元配列のNon Recursive Merge Sort（Stable Sort）・一次元配列版も】
vbaで2次元配列をマージソートをする必要があり、海外のサイトなどもいろいろ調べてみたんだけど、2次元配列のマージソートのソースを公開しているページを見つけられなかったので書いてみました。
ソートのプログラムの実装の必要性について
ネットで二次元配列のソートについて調べると「ワークシートに値を張り付けてエクセルの標準の機能でソートすればいい」という意見をよく目にしますが、それでは対処できないケースもあります。
例えば、二次元配列にRangeやクラスのインスタンス等のオブジェクト型の変数を入れている場合。
また例えば、データが多すぎてエクセルに張り付けられる上限を超える場合。
残念ながらシートにインスタンスは張り付けられないし、数百万行のデータをシートに張り付けることは不可能です。
これらの問題を解決するために、この記事を書きました。
なぜマージソートである必要があるか
ソートには大きく分けて、安定ソートと不安定ソートの2種類があります。
以下の記事が参考になります。
安定なソート | アルゴリズムとデータ構造 | Aizu Online Judge
要は、エクセルのオートフィルタで2列以上昇順に並び替えるような操作（複数キーでのソート）を、2次元配列に対してプログラムで行いたい場合は、安定ソートが必要になります。
不安定ソートの代表格は誰もが知ってるクイックソート。
並び替えてはくれるけど、同値があった場合、前の並び順は無視されますので、2次元配列の2列に対してソートをかけたとしたら、1回目に実行したソートは意味がなくなります。
一方、安定ソートの代表格はタイトルにあるマージソートやバブルソート。
同値があった場合でも、前の並び順が維持されているので、2次元配列の2列に対してソートをかけたとしたら、1回目に実行したソートの並び順を維持したまま、2回目のソートがかけられます。
特徴としては、安定ソートの方が遅く、メモリもたくさん食うけど、前の並び順を生かしたままソートしてくれるので、使える場面が不安定ソートよりずっと多いです。
計算量を考えても安定ソートでかつクイックソートと同じ計算量(O(n log n))で実行できるマージソートは非常にいろんなところで活躍しています。
今回2次元配列の安定ソートがどうしても必要になったので、有名どころで一番高速なマージソートをvba版で実装してみました。
非再起ループ
再起ループの中で今回のソート関数が使用される想定のため、さらにそこで再起のマージソートを行うと、スタックメモリが枯渇するケースがあったので、非再起ループにしました。
高速化のための参照渡し
配列の値渡しは、非常にオーバーヘッドが大きいです。
なにせ呼び出された関数側では渡された配列と同等のメモリ領域をコピーしますので、その処理はコンピュータにかなりの負荷を掛けます。
マージソートを実装してみたけど思ったように速度が出ないと書いてあるサイトも結構あるのですが、こういったメモリへの読み書きへの配慮がかけているためです。
基本的にはクイックソートと同程度の速度がでるはずです。
速度が出なければ処理方法に何らかの問題があります。
余談ですがredimも同様にオーバーヘッドが大きいので極力使うべきではないです。
ループの中で配列を1要素分増やす度にRedim Preserveしていては、元々の配列に割り当てられたメモリ領域のとなりのメモリ領域が空いていればそのまま今のポインタを移動させずにメモリ拡張できるのですが、空いていなかった場合はもっと大きな領域にポインタを移動させ、メモリ内容もコピーする必要がありますので当然重くなります。
一方、参照渡しであれば、配列の先頭ポインタを渡すだけなので、配列が使用しているメモリ領域をコピーすることもなく、高速に呼び出された関数側が渡された配列にアクセスできます。
あらかじめ作業用の大きな配列を確保しておき参照渡しで渡しておけば、配列のメモリを割り当ててはガベージコレクタで消されるといった無駄な負荷をPCにかけることなく処理できます。
ソース
それなりに長ったらしいのですが
Private Sub merge_sort2(ByRef arr As Variant, ByVal col As Long) Dim irekae As Variant Dim indexer As Variant Dim tmp1() As Variant Dim tmp2() As Variant Dim i As Long ReDim irekae(LBound(arr, 1) To UBound(arr, 1)) ReDim indexer(LBound(arr, 1) To UBound(arr, 1)) ReDim tmp1(LBound(arr, 1) To UBound(arr, 1)) ReDim tmp2(LBound(arr, 1) To UBound(arr, 1)) For i = LBound(arr, 1) To UBound(arr, 1) Step 2 If i + 1 > UBound(arr, 1) Then irekae(i) = arr(i, col) indexer(i) = i Exit For End If If arr(i + 1, col) < arr(i, col) Then irekae(i) = arr(i + 1, col) irekae(i + 1) = arr(i, col) indexer(i) = i + 1 indexer(i + 1) = i Else irekae(i) = arr(i, col) irekae(i + 1) = arr(i + 1, col) indexer(i) = i indexer(i + 1) = i + 1 End If Next Dim st1 As Long Dim en1 As Long Dim st2 As Long Dim en2 As Long Dim n As Long i = 1 Do While i * 2 <= UBound(arr, 1) i = i * 2 n = 0 Do While en2 + i - 1 < UBound(arr, 1) n = n + 1 st1 = i * 2 * (n - 1) + LBound(arr, 1) en1 = i * 2 * (n - 1) + i - 1 + LBound(arr, 1) st2 = en1 + 1 en2 = IIf(st2 + i - 1 >= UBound(arr, 1), UBound(arr, 1), st2 + i - 1) Call merge2(irekae, indexer, tmp1, tmp2, st1, en1, st2, en2) Loop en2 = 0 Loop Dim ret As Variant ReDim ret(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2)) For i = LBound(arr, 1) To UBound(arr, 1) For n = LBound(arr, 2) To UBound(arr, 2) If IsObject(arr(indexer(i), n)) Then Set ret(i, n) = arr(indexer(i), n) Else ret(i, n) = arr(indexer(i), n) End If Next Next arr = ret End Sub Private Sub merge2(ByRef irekae As Variant, _ ByRef indexer As Variant, _ ByRef tmpArr() As Variant, _ ByRef tmpIndexer() As Variant, _ ByVal st1 As Long, _ ByVal en1 As Long, _ ByVal st2 As Long, _ ByVal en2 As Long) Dim j As Long Dim n As Long Dim i As Long For i = st1 To en2 tmpArr(i) = irekae(i) tmpIndexer(i) = indexer(i) Next j = st1 n = st2 Do While (j < en1 + 1 Or n < en2 + 1) If n >= en2 + 1 Then irekae(j + n - st2) = tmpArr(j) indexer(j + n - st2) = tmpIndexer(j) j = j + 1 ElseIf j < en1 + 1 And tmpArr(j) <= tmpArr(n) Then irekae(j + n - st2) = tmpArr(j) indexer(j + n - st2) = tmpIndexer(j) j = j + 1 Else irekae(j + n - st2) = tmpArr(n) indexer(j + n - st2) = tmpIndexer(n) n = n + 1 End If Loop End Sub
こんな呼び出しかたができます。
Dim a As Variant Range("A1:B1048576").Select a = Selection.Value Call merge_sort2(a, 2) 'aの二次元配列に対して、2列目をキーにして並べ替えを行う。
実行結果（クイックソートとの比較）
エクセルいっぱいの104万行×2列程度の要素数で、クイックソートでは平均約8秒のものが、今回作ったマージソートでは平均9秒でした。
メモリ量はクイックソート実行時のおよそ3倍程度に収まりました。
ちなみにマージソートとの比較検証用のクイックソートは下記サイトのものを使わせていただきました。
excel-ubara.com
安定ソートでそれだけの速度が出せたのだから、非常に満足いくものになりました。
ついでに一次元配列版は以下になります。
Private Sub merge_sort(ByRef arr As Variant) Dim irekae As Variant Dim i As Long ReDim irekae(LBound(arr) To UBound(arr)) Dim tmp1() As Variant ReDim tmp1(LBound(arr, 1) To UBound(arr, 1)) For i = LBound(arr) To UBound(arr) Step 2 If i + 1 > UBound(arr) Then irekae(i) = arr(i) Exit For End If If arr(i + 1) < arr(i) Then irekae(i) = arr(i + 1) irekae(i + 1) = arr(i) Else irekae(i) = arr(i) irekae(i + 1) = arr(i + 1) End If Next Dim st1 As Long Dim en1 As Long Dim st2 As Long Dim en2 As Long Dim n As Long i = 1 Do While i * 2 <= UBound(arr) i = i * 2 n = 0 Do While en2 + i - 1 < UBound(arr) n = n + 1 st1 = i * 2 * (n - 1) + LBound(arr) en1 = i * 2 * (n - 1) + i - 1 + LBound(arr) st2 = en1 + 1 en2 = IIf(st2 + i - 1 >= UBound(arr), UBound(arr), st2 + i - 1) Call merge(irekae, tmp1, st1, en1, st2, en2) Loop en2 = 0 Loop arr = irekae End Sub Private Sub merge(ByRef irekae As Variant, _ ByRef tmpArr() As Variant, _ ByVal st1 As Long, _ ByVal en1 As Long, _ ByVal st2 As Long, _ ByVal en2 As Long) Dim j As Long Dim n As Long Dim i As Long For i = st1 To en2 tmpArr(i) = irekae(i) Next j = st1 n = st2 Do While (j < en1 + 1 Or n < en2 + 1) If n >= en2 + 1 Then irekae(j + n - st2) = tmpArr(j) j = j + 1 ElseIf j < en1 + 1 And tmpArr(j) <= tmpArr(n) Then irekae(j + n - st2) = tmpArr(j) j = j + 1 Else irekae(j + n - st2) = tmpArr(n) n = n + 1 End If Loop End Sub
こちらは104万要素をソートした場合、クイックソートが約3秒なのに比べて、上記マージソートが約4.5秒でした。
クイックソートにはかなわないけど、安定ソートとして十分な性能が出ているとおもいます。
マージソートを一次元配列で使用するケースはあまりないと思いますが参考までに…。
--
2017/9/6追記
降順ソートの要望がコメントにありましたので追記します。
不等号を数カ所反対にしただけなのですが、コピペで使えるよう丸っと載せます。
Private Sub merge_sort2_desc(ByRef Arr As Variant, ByVal Col As Long) Dim irekae As Variant Dim indexer As Variant Dim tmp1() As Variant Dim tmp2() As Variant Dim i As Long ReDim irekae(LBound(Arr, 1) To UBound(Arr, 1)) ReDim indexer(LBound(Arr, 1) To UBound(Arr, 1)) ReDim tmp1(LBound(Arr, 1) To UBound(Arr, 1)) ReDim tmp2(LBound(Arr, 1) To UBound(Arr, 1)) For i = LBound(Arr, 1) To UBound(Arr, 1) Step 2 If i + 1 > UBound(Arr, 1) Then irekae(i) = Arr(i, Col) indexer(i) = i Exit For End If If Arr(i + 1, Col) > Arr(i, Col) Then irekae(i) = Arr(i + 1, Col) irekae(i + 1) = Arr(i, Col) indexer(i) = i + 1 indexer(i + 1) = i Else irekae(i) = Arr(i, Col) irekae(i + 1) = Arr(i + 1, Col) indexer(i) = i indexer(i + 1) = i + 1 End If Next Dim st1 As Long Dim en1 As Long Dim st2 As Long Dim en2 As Long Dim n As Long i = 1 Do While i * 2 <= UBound(Arr, 1) i = i * 2 n = 0 Do While en2 + i - 1 < UBound(Arr, 1) n = n + 1 st1 = i * 2 * (n - 1) + LBound(Arr, 1) en1 = i * 2 * (n - 1) + i - 1 + LBound(Arr, 1) st2 = en1 + 1 en2 = IIf(st2 + i - 1 >= UBound(Arr, 1), UBound(Arr, 1), st2 + i - 1) Call merge2desc(irekae, indexer, tmp1, tmp2, st1, en1, st2, en2) Loop en2 = 0 Loop Dim ret As Variant ReDim ret(LBound(Arr, 1) To UBound(Arr, 1), LBound(Arr, 2) To UBound(Arr, 2)) For i = LBound(arr, 1) To UBound(arr, 1) For n = LBound(arr, 2) To UBound(arr, 2) If IsObject(arr(indexer(i), n)) Then Set ret(i, n) = arr(indexer(i), n) Else ret(i, n) = arr(indexer(i), n) End If Next Next Arr = ret End Sub Private Sub merge2desc(ByRef irekae As Variant, _ ByRef indexer As Variant, _ ByRef tmpArr() As Variant, _ ByRef tmpIndexer() As Variant, _ ByVal st1 As Long, _ ByVal en1 As Long, _ ByVal st2 As Long, _ ByVal en2 As Long) Dim j As Long Dim n As Long Dim i As Long For i = st1 To en2 tmpArr(i) = irekae(i) tmpIndexer(i) = indexer(i) Next j = st1 n = st2 Do While (j < en1 + 1 Or n < en2 + 1) If n >= en2 + 1 Then irekae(j + n - st2) = tmpArr(j) indexer(j + n - st2) = tmpIndexer(j) j = j + 1 ElseIf j < en1 + 1 And tmpArr(j) >= tmpArr(n) Then irekae(j + n - st2) = tmpArr(j) indexer(j + n - st2) = tmpIndexer(j) j = j + 1 Else irekae(j + n - st2) = tmpArr(n) indexer(j + n - st2) = tmpIndexer(n) n = n + 1 End If Loop End Sub
Bitnami-Redmine【SSLの設定方法】
本日Bitnami-Redmineをインストールし、sslを設定しようとしたところ、何やらエラーしたのでそれを解決したメモ
環境は以下の通り
OS:Linux Centos7
Redmine:3.3.1-0
これってだいぶ昔にもはまったことがあり、解決するのに苦労した記憶があった。
またしてもはまってしまったが、redmineがバージョン2.5系のころ解決して、その時の方法と同じだったので記録に残す。
結論から言うと、
/opt/redmine-3.3.1-0/apache2/conf/httpd.conf
の設定は何も変えず、以下のsslの設定ファイルを書き換えるだけである。
/opt/redmine-3.3.1-0/apache2/conf/bitnami/bitnami.conf
ネットで調べると、
/opt/redmine-3.3.1-0/apache2/conf/httpd.conf
を編集して
Include conf/extra/httpd-ssl.conf
のコメントアウトを外したのち
/opt/redmine-3.3.1-0/apache2/conf/extra/httpd-ssl.conf
を編集して証明書パスを登録するという記事をよく見るがbitnami版をインストールするとこれではエラーする。
なぜかというと、すでに
/opt/redmine-3.3.1-0/apache2/conf/httpd.conf
で
/opt/redmine-3.3.1-0/apache2/conf/bitnami/bitnami.conf
がIncludeされて実行されているので証明書ファイルが読み込まれていて、さらに
/opt/redmine-3.3.1-0/apache2/conf/extra/httpd-ssl.conf
を読み込もうとするから、「もうすでに読み込んでるよ」とエラーしてアパッチが立ち上がってくれない。
(98)Address already in use: AH00072: make_sock: could not bind to address [::]:443
と怒られてしまう。
しかしなんで調べてもあまり情報が出てないんだろう。
結構調べたけど見つからなかったので、昔自力で解決したような気がする。
あ、自分で記事にして記録しておけば良かったのか。。。
select2【colorboxのモーダルウィンドウでselect2化したセレクトボックスがおかしくなる】
jqueryのcolorboxはライセンスもMITで非常に人気のあるプラグインです。
またselect2も同じくMITライセンスで非常に高機能なUIを提供してくれるいいプラグインです。
モーダルウィンドウをcolorboxで表示して、その中でプルダウンをselect2化したときに、ほとんどのブラウザで動かなくなると思います。
なかなか情報探すのに苦労しましたが、わかってしまえば結構簡単に解決できたので、メモを残します。
環境
・クライアントPC:windows 10
・ブラウザ：IE11、Edge、Firefox、chrome
・サーバ:centos7、apache2.4
・jquery:1.10.2
・colorbox:1.6.4
・select2:4.0.3
以下サンプルです。colorboxのパスは適当に読み替えてください。
select2を実行するときに、
<!DOCTYPE html> <html> <head> <meta charset="UTF-8"> <title>colorbox and select2</title> <script src="//ajax.googleapis.com/ajax/libs/jquery/1.10.2/jquery.min.js"></script> <link rel="stylesheet" type="text/css" href="colorbox/colorbox-master/example3/colorbox.css"/> <script type="text/javascript" src="colorbox/colorbox-master/jquery.colorbox.js"></script> <link href="//cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/css/select2.min.css" rel="stylesheet" /> <script src="//cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/js/select2.min.js"></script> <script type="text/javascript"> $(function(){ var $colorboxArea = $("div.colorboxArea"); $(":button.open_cb").colorbox({ inline : true, href : $colorboxArea, innerWidth : "80%", innerHeight : "80%" }); $("select.target").select2({ dropdownParent: $(".colorboxArea") }); }); </script> <style type="text/css"> /*IEは以下のように書かないとwidthが0になる*/ .select2{ min-width:200px; } </style> </head> <body> <input type="button" class="open_cb" value="show modal window!"> <div style="display:none;"> <div class="colorboxArea"> <select class="target"> <option value="1">aaa</option> <option value="2">bbb</option> </select> </div> </div> </body> </html>
といったようにdropdownParentプロパティを指定します。
値は、colorboxの領域を指定します。
PHPMailer【isHTML(false)にしてもtext/htmlで送信されてしまう】
あまりwebで検索しても情報が出てこなかったので備忘として残します。
PHPMailerを利用してSMTPサーバにつないでメール送信を行うケースは多いと思います。
でも、ちゃんと理解して使わないと、思った通りのメールが遅れないという事態になるので注意が必要です。
PHPMailerでメールを自動で送信する機能を搭載したシステムを作り運用しているのですが、ある日受信者からメールがおかしいといわれました。。。
調べてみると、text/plainで送る設定になっているはずなのに、メールのソース（ヘッダ）を見てみるとbodyがtext/htmlになっていたのです。
isHTML(false)としているのに。。。
なんでかなと思ってPHPMailer本体のphpのソースを見てみたところ、AltBodyプロパティにテキストが代入されていると、なんとisHTMLの設定は無視して強制text/htmlになってしまうようでした。
考えてみりゃそりゃそうだ、AltBodyは、text/htmlがクライアントの都合で使用できない場合に、text/plainの形式で送るメッセージを指定するところだった。
つまりtext/htmlで送信することを前提にしている。
なのでAltBodyがあるときはtext/htmlに強制的になってしまうという作りだった。
PHPMailer作者は良かれと思ってそうしてくれてるんだろうなあ。。。
ということで、AltBodyに代入している行をコメントアウトして、解決しました。
Excel【VBAでCopyメソッドやPasteメソッド、PasteSpecialメソッドがやたら遅い】
下記は、何も悪いことはしていない、何の変哲もないVBAのスクリプトだが、
こんなのの実行に30秒程度かかるなんて信じられるだろうか。
Sub test() Dim i As Integer Dim ra As Range Dim myra As Range Set myra = Range("A1:K1") myra.Value = 1 For Each ra In myra i = i + 1 ra.Copy ra.Offset(i) Next ra End Sub
環境はWindows7(64bit)、Excel2013(64bit)、RAM:24G、Core i7である。
不思議なことに上記コードが一瞬で終わる人（PC）もいる。
なんでPCスペックは申し分ないのに、こんなに時間がかかるんだろうと思って、調査開始。
2016年3月ぐらいから急にvbaのPaste処理の実行が重くなりだした。
その時たまたま更新プログラムをインストールしたのでそれが原因かと思った。
一旦エクセルの重くなりそうな処理をすべてオフにして、セキュリティもがばがばにして、PC自体パフォーマンス優先にして、ウイルス対策ソフトを停止したり、不要なファイルを削除したりした。
こんだけやっても、遅いまま。。。
さらにofficeをセーフモードで立ち上げてみても変わらず、PCをセーフモードで立ち上げたら今度はofficeのアプリケーションが起動できず、お手上げ状態。
あと考えられるのはクリップボードを経由するので、エクセルとは別のプロセスが悪さしてんだろうなと思って、msconfigを立ち上げて、スタートアップの不要そうなプログラムのチェックを外した。
再起動をかけ、マクロを実行すると、嘘のような速さ。
30秒かかっていた処理が一瞬で終わった！
一つ一つチェック外しては再起動をかけてを繰り返して調べていくと、なんとDropBoxが原因でした。。。
私のPC以外にも同様の現象に遭遇している人がいたので、その人のDropBoxもmsconfigのスタートアップでOFFにしたところ、見事現象が直りました。
さすがにこれは、原因なかなか気づかないや。まさかDropboxとは。。。
更新プログラムが影響していたのかどうかまでは不明。
perl【CentOS6でText::MeCabを使う】
いつもcpanからText::MeCabのインストールでエラーが出て苦しんでいるので、備忘録としてまとめます。
まず環境
作業ディレクトリはどこでもいいです。
まずmecabのインストール
wget http://mecab.googlecode.com/files/mecab-0.996.tar.gz tar xvzf mecab-0.996.tar.gz cd mecab-0.996 ./configure make make check sudo make install
mecab辞書のインストール
wget http://mecab.googlecode.com/files/mecab-ipadic-2.7.0-20070801.tar.gz tar xvzf mecab-ipadic-2.7.0-20070801.tar.gz cd mecab-ipadic-2.7.0-20070801 ./configure --with-charset=utf8 make sudo make install
PerlはCentOSをインストールした際にデフォルトで入ってくるバージョンが5.10.1だったのですが、この古いバージョンではText::MeCabはインストールできないのでバージョンを上げます。
いくつか方法はあると思いますが、perlbrewというのが簡単そうだったので、これを使います。
[https://www.seeds-std.co.jp/seedsblog/611.html:title]
ユーザーごとにperlの実行環境を切り替えられるのは便利です。
インストール
curl -kL http://install.perlbrew.pl | bash
perlbrewのpathを通す
echo "source ~/perl5/perlbrew/etc/bashrc" >> ~/.bashrc source ~/perl5/perlbrew/etc/bashrc
利用可能なバージョン一覧
perlbrew available
5.16.3をインストール
perlbrew install 5.16.3
5.16.3に切り替え
perlbrew switch 5.16.3
バージョンおよびパス確認
$ perl -v This is perl 5, version 16, subversion 3 (v5.16.3) built for x86_64-linux (with 1 registered patch, see perl -V for more detail) Copyright 1987-2012, Larry Wall Perl may be copied only under the terms of either the Artistic License or the GNU General Public License, which may be found in the Perl 5 source kit. Complete documentation for Perl, including FAQ lists, should be found on this system using "man perl" or "perldoc perl". If you have access to the Internet, point your browser at http://www.perl.org/, the Perl Home Page. $ which perl ~/perl5/perlbrew/perls/perl-5.16.3/bin/perl
次にcpanからText::MeCabをインストールしますが、その前にmecabのライブラリへのパスを
/etc/ld.so.conf.d/
に追記し、Text::MeCabをインストールします。
$ sudo su # echo "/usr/local/lib" >> /etc/ld.so.conf.d/local.conf # ldconfig # exit $ cpan install Text::MeCab
インストールの途中
Encoding of your mecab dictionary? (shift_jis, euc-jp, utf-8) [euc-jp]
と聞かれるので、utf-8を指定します。
これで入ると思います。
テストを実行してみます。
text.plをどこかに作成
#! /home/akutsu/perl5/perlbrew/perls/perl-5.16.3/bin/perl use strict; use warnings; use Text::MeCab; my $m = Text::MeCab->new(); my $s = "すもももももももものうち。"; my $n = $m->parse($s); my $t = ""; while ($t = $n->next){ printf("%s\t%s\t%d\n", $n->surface, $n->feature, $n->cost ); $n = $t; }
$ perl text.pl すもも 名詞,一般,*,*,*,*,すもも,スモモ,スモモ 7263 も 助詞,係助詞,*,*,*,*,も,モ,モ 7774 もも 名詞,一般,*,*,*,*,もも,モモ,モモ 15010 も 助詞,係助詞,*,*,*,*,も,モ,モ 15521 もも 名詞,一般,*,*,*,*,もも,モモ,モモ 22757 の 助詞,連体化,*,*,*,*,の,ノ,ノ 23131 うち 名詞,非自立,副詞可能,*,*,*,うち,ウチ,ウチ 23729 。 記号,句点,*,*,*,*,。,。,。 22725
