年齢を計算する関数

過去に実装した年齢計算プログラムのロジックが残念なことになっていましたので、考えを整理しました。
記事の最後に載せたプログラムのコメントにも書きましたが、ポイントは2つあります。

1. 基準日の年と生年の差
2. 基準日がその年の誕生日よりも前のときは1を減算する

2つ目の条件につきましては、生年月日の年を基準日の年と置き換え、年齢を求める日付と比較すれば判定できます。
「年齢を求める日付」はいい言葉が思いつきませんでした。いい言葉をご存知の方はコメントして頂けると助かります。
2015/8/31
NARITA Shoさんから「Excel 界隈では「基準日」という語が使われているみたいですね。」とのコメントを頂きました。ありがとうございました。

以下、xyzzy lispとC#での実装を記載します。
2015/9/2
C#での実装例を追加しました。

Lispでバケツソート

日経ソフトウェアの2014年6月号で、バケツソートが紹介されていました。
興味深かったので、Lispで実装してみました。

ソース

(defun backet-sort (v backet-count)
  "バケツソート"
  (let ((backet (array-to-backet v backet-count)))
    (backet-to-array backet (length v))))

(defun array-to-backet (arr backet-count)
  "配列からバケツを構成する"
  (let ((backet (make-array backet-count :initial-element 0)))
    (dotimes (i (length arr) backet)
      (let ((n (aref arr i)))
        (setf (aref backet n) (1+ (aref backet n)))))))

(defun backet-to-array (backet array-length)
  "バケツからソート済みの配列を構成する"
  (let ((arr (make-array array-length)))
    (loop with arr-index = 0
          for i below (length backet)
          when (< 0 (aref backet i))
          do (loop repeat (aref backet i)
                   do (setf (aref arr arr-index) i)
                      (setq arr-index (1+ arr-index))))
    arr))


(defun main ()
  "動作確認のための関数"
  (let ((l (loop with state = (make-random-state t)
                 repeat 10
                 collect (random 10 state))))
    (print (sort (make-array (length l) :initial-contents l) #'<))
    (print (backet-sort (make-array (length l) :initial-contents l) 10))))

(main)

なんとなく汚い感じがするのは、きっと自分の腕が未熟だからでしょう。

lispでiniファイルからalistをconsする

lispでiniファイルからalistをconsするプログラムを書きました。

サンプルのiniファイルはこのようになっています。

[Section1]
Key1=Value1
Key2=Value2

[Section2]
Key1=Value1

[Section3]

プログラム本体は以下のとおりです。

;; inifile.l
(defun read-lines (input)
  (loop as line = (read-line input nil nil)
        while line
        collect line))

(defun sectionp (line)
  (and (stringp line)
       (<= 2 (length line))
       (eq #\[ (char line 0))
       (eq #\] (char line (1- (length line))))))

(defun keyvaluep (line)
  (and (stringp line)
       (<= 3 (length line))
       (find #\= line)
       (< 0 (position #\= line))))

(defun strip-section (line)
  (if (not (sectionp line))
      line
    (subseq line 1 (1- (length line)))))

(defun split-keyvalue (line)
  (if (not (keyvaluep line))
      line
    (list (subseq line 0 (position #\= line))
          (subseq line (1+ (position #\= line))))))

(defun convert-to-alist (alist line)
  (cond ((sectionp line)
         (cons (list (strip-section line)) alist))
        ((keyvaluep line)
         (cons (append (car alist) (list (split-keyvalue line))) (cdr alist)))
        (t alist)))

(defun ini-assoc (section key alist)
  (car (last
        (assoc key
               (cdr (assoc section alist :test 'string-equal))
               :test 'string-equal))))


;; 以下実行部
(setf ini-alist (reduce 'convert-to-alist (read-lines *standard-input*)
                        :initial-value '()))
(format t "~A~%" ini-alist)
(format t "~A ~A = ~A~%" "Section2" "Key1"
        (ini-assoc "Section2" "Key1" ini-alist))
(format t "~A ~A = ~A~%" "SECTION1" "KEY2"
        (ini-assoc "SECTION1" "KEY2" ini-alist))

実行すると、以下のように出力します。

$ cat sample.ini | clisp inifile.l
((Section3) (Section2 (Key1 Value1)) (Section1 (Key1 Value1) (Key2 Value2)))
Section2 Key1 = Value1
SECTION1 KEY2 = Value2

工夫したところは、関数"ini-assoc"でstring-equalを使用し、大文字と小文字を区別し内容にしたところです。
alistで返すことが目標だったので、パフォーマンスはよくありません。
今までの書き方であれば、DictionaryやMapを更新しまくるプログラムを書いてました。reduceに渡す関数を実装するにあたり、「新しいリストを返す」という発想に辿り着くまで時間がかかりました。

Lispでxmlの実体参照変換

当ブログでは、プログラムをハイライト表示するときにSyntaxHighlighterを使用しています。
XMLを表示するときは、実体参照へ変換しなければいけません。
「普段使用しているエディタから変換できれば楽ちんだよね」と思い、xyzzy Lispで変換プログラムを書いてみました。

プログラム

; convert-xml
(defparameter *conversion-alist*
  '((#\< . "&lt;")
    (#\> . "&gt;")
    (#\& . "&amp;")
    (#\" . "&quot;")
    (#\' . "&apos;")))

(defun convert-xml ()
  (interactive "*")
  (let ((input-buffer (window-buffer (selected-window))))
    (with-output-to-temp-buffer ("*Converted*")
      (with-open-stream (s (make-buffer-stream input-buffer))
        (loop 
          (let ((c (read-char s nil)))
            (if c (format t "~A" (convert-char c *conversion-alist*))
              (return nil))))))))

(defun convert-char (c alist)
  (let ((conversion (assoc c alist)))
    (if conversion (cdr conversion)
      c)))

実行すると現在のバッファを読み込み、一時バッファへ変換後のxmlを表示します。
工夫したところは、変換の定義をalistにしたところです。

参考

• SyntaxHighlighter
• 文字実体参照（実体参照）