エクセルのワークシートをスクロールさせる

VBAで、ワークシートに処理結果をたくさん出力するプログラムを作っているとする。

現在表示されている領域の外にデータが出力された場合、普通はプログラムが終了するまで待って、手動でワークシートをスクロールしなければならない。これでは面倒だから、ちゃんとリアルタイムで追いかけて確認したい。つまり、表示領域外にデータを出力した場合には、自動的にワークシートがスクロールし、最新のデータに追従して欲しい。

こうした動作は、VisibleRange, ScrollRow, ScrollColumn等を使って実現できる。

サンプルコード

' Sleepを使うためのおまじない
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'------------------------------------------------------------
' 指定されたセルに文字列を出力。
' 表示範囲外のセルに出力した場合は、スクロールさせる。
'------------------------------------------------------------
Sub printAndScroll(row, col, str)
    Cells(row, col) = str   '出力
    'シートのスクロール
    With ActiveWindow
        '行方向にスクロール（マイナス2で微調整している）
        If row > (.VisibleRange.Rows(1).row + .VisibleRange.Rows.Count - 2) Then
            .ScrollRow = .ScrollRow + 1
        End If
        '列方向にスクロール（マイナス2で微調整している）
        If col > (.VisibleRange.Columns.Columns(1).Column + .VisibleRange.Columns.Count - 2) Then
            .ScrollColumn = .ScrollColumn + 1
        End If
    End With
End Sub

'------------------------------------------------------------
' サンプルmain
'------------------------------------------------------------
Sub main()
    '右下に向かってテキトーな文字を出力
    For i = 1 To 50
        Call printAndScroll(i, i, "(" & i & ", " & i & ")")
        Sleep 100   '動作確認のためスリープ
    Next
End Sub

サンプルの動作

参考

• Office TANAKA - Excel VBA Tips[ワークシートをスクロールする]

Emacs Lisp で Lake Counting

深さ優先探索アルゴリズム（depth-first search, DFS）の基本的な例題として、"Lake Counting"（湖あるいは水たまり数え上げ問題？）と呼ばれる問題がある。問題の内容は他の文献に書いてあるので、ここでは Emacs Lisp で解いた例を記録しておく。

コード

vector型（いわゆる配列）は使わない方針。つまり、配列にデータを読み込んで添字でアクセスするのではなく、Emacsのバッファに記述されている文字列をそのまま処理する。したがって、"point"関連の組み込み関数を多用している。また、8近傍の要素を表す一時的なデータも、配列ではなくリストにしている。

(defun lake-count (b e)
  "入力となるリージョンを選択した状態で M-x lake-count を実行すると、答えをミニバッファに出力する。"
  (interactive "r")
  (save-excursion
    (let ((cnt 0)
          (first-line (line-number-at-pos b)) ;リージョンの先頭行番号を記録しておく
          (last-line (line-number-at-pos e))) ;リージョンの最終行番号を 〃
      (loop for p from b to e do
            (goto-char p)
            (sit-for 0.1) ;カーソルの動きを観察するため一瞬停止
            (when (eq ?W (char-after p))
              (dfs)
              (incf cnt) ))
      (message "%d" cnt))))             ;結果出力

(defun dfs ()
  "補助関数。現在のポイントを文字.に置換する。8近傍に文字Wがあれば再帰的に適用する。"
  (let* ((cline (line-number-at-pos))
         (ccol (current-column))
         (poslist `((,(1- cline) ,(1- ccol)) ;8近傍を表す(行,列)のリスト
                    (,(1- cline) ,ccol)
                    (,(1- cline) ,(1+ ccol))
                    (,cline ,(1- ccol))
                    (,cline ,(1+ ccol))
                    (,(1+ cline) ,(1- ccol))
                    (,(1+ cline) ,ccol)
                    (,(1+ cline) ,(1+ ccol)) )))
    (delete-char 1) ; この2行で W を . に置換
    (insert ?.)     ; 〃
    (setf poslist
          (remove-if  ;リージョンの外に出る要素をリストから消す
           (lambda (pos)
             (or (< (first pos) first-line);上にはみ出す場合
                 (> (first pos) last-line) ;下にはみ出す場合
                 (< (second pos) 0)))      ;左にはみ出す場合
           poslist))
    (mapcar (lambda (pos) ;8近傍の各要素に対してラムダ式を適用
              (goto-line(first pos))
              (move-to-column (second pos)) ;近傍にポイントを移動
              (sit-for 0.1)  ;カーソルの動きを観察するため一瞬停止
              (if (eq ?W (char-after))  ;Wなら再帰的に呼び出す
                  (dfs)))
            poslist)))

使用している組み込み関数／マクロ

詳細はEmacs上でdescribe-functionを行えば出てくるので、列挙だけしておく。

• let
• let*
• loop
• when
• incf
• eq
• sit-for
• insert
• delete-char
• mapcar
• remove-if
• char-after
• goto-line
• move-to-column
• mapcar
• save-excursion
• goto-char
• first
• second

よいか悪いかは別として、C言語などで書く場合と比べると、たくさんの語彙を駆使したプログラムになってしまう（バッククォートとか、カンマまで使っている…）。

実行＆結果

1. *scratch*バッファなどで、"W"と"."を使った水たまりのASCIIアートを描く。
2. 先頭の行をC-SPCでマークして、カーソルを最後の行まで移動。全体を選択状態にする。
3. M-x lake-count を実行する。
4. 最終的にすべての"W"が"."に置換され、ミニバッファに水たまりの数が表示される。

W........WW.
.WWW.....WWW
....WW...WW.
.........WW.
.........W..
..W......W..
.W.W.....WW.
W.W.W.....W.
.W.W......W.
..W.......W.

上記の入力の場合、正解は 3。動画も作ってみたが、全画面表示にしないと見えない。

参考

• Amazon.co.jp： プログラミングコンテストチャレンジブック: 秋葉 拓哉, 岩田 陽一, 北川 宜稔: 本
• 2386 -- Lake Counting
• 深さ優先探索 - Wikipedia
• 連結 8連結、8近傍などの用語

Emacs Lisp で最大公約数など

最大公約数（greatest common divisor）を求めるアルゴリズムをEmacs Lisp で作成してみただけ。

前提として、引数 a と b は自然数で a > b を満たす。

1. 除数を減じながら公約数かどうか調べる方法

まずは、工夫も法則もない素朴な方法。小さい数 b を初期値として a と b を割り切れるか試す。割り切れなければ 1減らしてリトライする流れ。

(defun my-gcd (a b &optional div)    ; やむを得ず optional引数を使う
  (if (null div) (setq div b))
  (cond
   ((zerop div) 1)
   ((every (lambda (n) (zerop (% n div))) (list a b)) div)
   (t (my-gcd a b (1- div))) ))
=> my-gcd

;;; テスト
(my-gcd 156 65)
=> 13        ;正解。

性能というか、関数の呼出し回数も調べてみる。

(my-call-count my-gcd 156 65)
=> 53

156 と 65 の場合は53回だった。なお、呼び出し回数の計測には以前書いたマクロを使っている。

2. ユークリッドの互除法

「昔はアルゴリズムといえば互除法そのものを意味した」というくらい、歴史的に特別なアルゴリズム（吉田武「オイラーの贈り物」より）。

(defun my-gcd (a b)
  (if (zerop (% a b))
      b
    (my-gcd b (% a b)) ))
=> my-gcd

;;; テスト
(my-gcd 156 65)
=> 13        ;正解。

;;; 呼び出し回数を調べる
(my-call-count my-gcd 156 65)
=> 3        ;たった3回で済んでいる。

発展その1：最小公倍数

最大公約数と最小公倍数（least common multiple）のあいだには、「与えられた二数の積 = 最大公約数 × 最小公倍数」の関係が成り立つ。この関係から、最大公約数が求まればただちに最小公倍数も得られる。

(defun my-lcm (a b)
  "最小公倍数を求める"
  (/ (* a b) (my-gcd a b)))
=> my-lcm

;;; テスト
(my-lcm 156 65)
=> 780

発展その2：ディオファントス方程式

整数係数の方程式「ax + by = d」のことをディオファントス方程式（Diophantine equation）と呼び、d が a と b の最大公約数の倍数になっている場合、すなわち 「d = k × gcd(a, b)」である場合に解をもつ。

したがって、最大公約数を求める関数を応用して、ある数 a, b, d から成るディオファントス方程式の解の有無を調べることができる。

(defun my-solvablep (a b d)
  "a, b, d  から成る方程式 ax + by = d が解をもつ場合に t を返す"
  (zerop (% d (my-gcd a b))))
=> my-lcm

;;; テスト
(my-solvablep 156 65 13)
=> t
(my-solvablep 156 65 14)
=> nil

参考

• Amazon.co.jp： オイラーの贈物―人類の至宝eiπ=-1を学ぶ (ちくま学芸文庫): 吉田 武: 本
• 『最大公約数の求め方』

Emacsでadviceにより再帰呼び出し回数を調べる

Emacsの*scratch*バッファで、何らかの再帰的関数を書いたとする。適当なテストデータをその関数に与えて、実際に何回呼び出されるかを知りたい場合にどうするか、という話。

1. 組み込みの trace-function を使う

Emacsにはtrace-functionというコマンドが用意されており、関数のトレースというかコールグラフのようなものを表示できる。以下の例に示すように、実引数と戻り値も表示される。

;;; 再帰的関数の例（フィボナッチ数を「素朴に」求める）
(defun my-fib (n)
  "Return the nth fibonacci number."
  (if (<= n 2)
      1
    (+ (my-fib (- n 1)) (my-fib (- n 2)))))
=> my-fib

;;上で定義した再帰的関数に trace-fucntion を適用
(trace-function 'my-fib)
=> my-fib

;;; テストしてみる
(my-fib 4)   ;; 4番目のフィボナッチ数
=> 3

;;; trace-function の結果（*trace-output* というバッファに出力される）
1 -> my-fib: n=4      ;; 実引数 n=4
| 2 -> my-fib: n=3
| | 3 -> my-fib: n=2
| | 3 <- my-fib: 1    ;; 戻り値 1
| | 3 -> my-fib: n=1
| | 3 <- my-fib: 1
| 2 <- my-fib: 2
| 2 -> my-fib: n=2
| 2 <- my-fib: 1
1 <- my-fib: 3

このグラフを見ても一瞬では把握できないが、たとえばリージョンを選択して M-x count-matches -> my-fib を実行すると呼出し回数 = 5 だと分かる。

2. advice（アドヴァイス、アドバイス）を利用する

Emacsの"advice"という機能を利用すると、もっと直接的に目的を達成できる。

adviceとは既存の関数定義を変更することなしに独自の処理を追加する機能で、「アスペクト指向」と関連づけて紹介されることもあるためEmacsと縁がない分野にもadviceという用語を知っている人はいる。

なお、adviceに関連する概念は"pieces of advice"や"class", "name", "position", "flag"などたくさんあるので、ここでは省略（Elisp の info の "17 Advising Emacs Lisp Functions" に書いてある）。

概要

• (my-call-count my-fib 4) の形で実行すると、my-fibの呼び出し回数である 5 が得られるようにする。
• my-call-count は既存の関数 my-fib に呼び出し回数を数えるadviceを追加し、(my-fib 4) を実行し、数えた結果を返す。
• 環境や既存の関数に影響が無いようにする（advice は使った後に消す、トップレベルの変数を使わない、シンボルを衝突させない、など）

my-call-countのコードと実行例

;;; 関数を実行して、呼び出し回数を表示するマクロ
(defmacro my-call-count (proc &rest args)
  (let ((ad-name (gensym))) ;任意のシンボルを作っておく（piece of advice の名前にする）
    `(let ((*my-call-cnt* 0))           ;カウンタ用の変数。もし重複してもシャドウされる。
       (defadvice ,proc   ;再帰的関数（proc）に piece of advice を追加
         (before ,ad-name first activate) ;最初から有効な"before-advice"とする
         "increment function call counter: *my-call-cnt*." ;これはコメント
         (incf *my-call-cnt*))                             ;インクリメントするだけ
       (,proc ,@args)                   ;piece of adviceを追加したので、再帰的関数を実行
       (ad-remove-advice ',proc 'before ',ad-name) ;実行が終わったので、追加した piece of advice を削除
       (ad-update ',proc)        ;削除したので関数をコンパイルし直す
       *my-call-cnt*)))
=> *my-call-cnt*

;;; マクロ展開形の確認（gensymの値、カンマ、カンマアットのあたりをチェック）
(macroexpand '(my-call-count my-fib 4))
=> (let ((*my-call-cnt* 0))
  (defadvice my-fib
    (before G48320 first activate)
    "increment function call counter: *my-call-cnt*."
    (incf *my-call-cnt*))
  (my-fib 4)
  (ad-remove-advice (quote my-fib) (quote before) (quote G48320))
  *my-call-cnt*)

;;; 実行してみる
(my-call-count my-fib 4)
=> 5           ;OK

;;; マクロ内で追加した piece-of-advice が削除されているかも確認
(ad-is-advised 'my-fib)
=> nil         ;ad-is-adviced の結果が nil ならOK

;;; しつこいけれど、変数名が重複しても大丈夫か確認
(defvar *my-call-cnt* 10)    ;トップレベルで変数に10をセット
=> *my-call-cnt*
(my-call-count my-fib 4)     ;マクロ実行
=> 5
*my-call-cnt*                ;トップレベルで評価し直してみる
=> 10                        ;10のままなのでOK
  

参考

• Defining Advice - GNU Emacs Lisp Reference Manual
• アスペクト指向ソフトウェア開発とそのツール
• SICP reading #4 [1.2.2] 再帰的/反復的プロセス 再帰の再理解 | sw@mac
• lib.store.yahoo.net/lib/paulgraham/onlisp.lisp 上で作ったマクロは、この本の中の awhile2 に構造が似ている（たぶん）

Emacs Lisp でクイックソート

仕事に疲れたら、人生に疲れたら、素数を数えたり、基礎的なアルゴリズムを復習したり、単純な計算問題を手で解いたりしてみるといい（線形代数の行列演算とか）。

その一環で今日はクイックソートをEmacs Lisp で作成。

(lexical-let*)というマクロで思い通りのクロージャが作れるので、それほど煩雑にはならない。

ついでに、リストだけでなく、Vector 型に対応したものも作ってみた。

また、テストデータの作成ですこしだけ loopマクロを使った。

;; ふつうのクイックソート（リストを昇順ソート）
;; ピボットを左端の要素とする方式
(defun qsort (lat)
  (if (null lat) nil
    (lexical-let* ((piv (car lat))
                   (right (cdr lat))
                   (fn (lambda (a) (< a piv))) )
      (append (qsort (remove-if-not fn right))
              (list piv)
              (qsort (remove-if fn right)) ))))
=> qsort


;; Vectorを昇順ソート（"elt", "vconcat", "subset"などの組み込み関数を利用）
;; ピボットを中央の要素とする方式
(defun vqsort (v)
  (cond
   ((zerop (length v)) nil)
   ((= 1 (length v)) v)
   (t (lexical-let* ((m (/ (length v) 2))
                     (piv (elt v m))
                     (v2 (vconcat (subseq v 0 m) (subseq v (1+ m))))
                     (fn (lambda (a) (< a piv))))
        (vconcat (vqsort (remove-if-not fn v2))
                         (vector piv)
                         (vqsort (remove-if fn v2))) ))))
=> vqsort


;; 実行してみる（リストのソート）
;; (loop ...)は 30 から 1 までの数を要素とするリストを生成
(qsort
 (loop for i from 30 downto 1 append (list i)) )
=> (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30)


;; 実行してみる（vectorのソート）
;; (loop ...)は 30 から 1 までの数を要素とするvectorを生成
(vqsort 
 (loop for i from 30 downto 1
       with v
       do (setf v  (vconcat v (vector i)))
       finally (return  v) ))
=> [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30]

結果を見る限り、正しくできたと思われる。

参考

• Sequences Arrays Vectors - GNU Emacs Lisp Reference Manual
• LOOP for Black Belts

Emacs Lisp でシーザー暗号

暗号に関する本を読むと、たいていは「シーザー暗号 - Wikipedia」が紹介されている。

鍵そのものと暗号化アルゴリズムを分けて考えるという現代的な（？）性質は満たしているが、容易に解読できるので実用性がない、という位置づけで。

簡単なので簡単にプログラムが作れる。Emacsの *scratch*バッファでやってみるのも簡単。

仕様

• 与えられた文字列を暗号化する。
• 文字列はアスキー文字のみ。
• 小文字は大文字に変換する。
• A-Z以外の文字（スペースやピリオドなど）はそのまま。
• 鍵（下の例で言うと仮引数の key）の値は正でも負でもいい。
• 鍵の値が0や26、-26なら変化なし。

コード

3つの関数に分けた。

;; 入力の正規化のようなことを行ってから暗号化。すなわち、
;; 文字列を大文字に変換し、鍵を 0 から 25 までの値に変換する。
(defun my-caesar (str key)
  (my-caesar-string
   (upcase str)
   ((lambda (n) (while (< n 0) (incf n 26)) (mod n 26)) key) ))

;; 文字列を暗号化する
(defun my-caesar-string (str key)
  (if (< (length str) 1)
      ""
    (concat
     (my-caesar-string1 (substring str 0 1) key)
     (my-caesar-string (substring str 1) key))))

;; 文字を暗号化する（厳密には「文字」ではなく、文字列長が1の文字列）
(defun my-caesar-string1 (c key)
  (if (string-match "[a-zA-Z]" c)
      (char-to-string (+ ?A (mod (+ key (- (string-to-char c) ?A)) 26)))
    c))

関係ないが、組み込み関数の名前が長くてつらい（string-to-charやsubstringなど）。

テスト

その1. アトム

(my-caesar "foo bar baz!" 27)
=> "GPP CBS CBA!"

その2. リスト

(mapcar (lambda (str) (my-caesar str -1))
        '("foo bar baz!" "hoge fuga piyo."))
=> ("ENN AZQ AZY!" "GNFD ETFZ OHXN.")

参考

• シーザー暗号 - Wikipedia
• Strings and Characters - GNU Emacs Lisp Reference Manual