Route 477

■ [ruby] Rubyで「ナベアツカレンダー」を作ってみた (iCalendar gem)

前の日記で

■ [junk] 3の倍数と3の付く日だけ猛烈に開発して、5の倍数の日は一切PCに触りません

という開発スタイルはどうか。NDD(Nabeatsu Driven Development)。

メリハリのあるプログラミングライフをあなたに！

[20080512#p02より引用]

例えば、Googleカレンダーで「3の日」「5の日」を表示できたら、とても分かりやすそうですよね。 そんなわけで、RubyからiCal形式のファイル(*.ics)を作る方法を調べてみました。

iCalendar gemの使い方

RubyGemsの icalendar というライブラリを使うと、iCal形式のファイルを簡単に作れるようです。

例えば、イベントが1つだけ登録されたカレンダーを作るならこんな感じ。

  require 'rubygems' 
  require 'icalendar'
  require 'date' # Rubyの標準添付ライブラリ。Dateクラス、DateTimeクラスを提供する。

  cal = Icalendar::Calendar.new
  cal.event do
    dtstart       Date.new(2005, 04, 29)
    dtend         Date.new(2005, 04, 28)
    summary     "Meeting with the man."
    description "Have a long lunch meeting and decide nothing..."
    klass       "PRIVATE"
  end
  puts cal.to_ical

とても簡単ですね。:-) インストールはいつもの「gem install icalendar」で。

ナベアツカレンダーを作ろう

というわけで、「3の日」と「5の日」が登録されたカレンダーはこんな感じになりました。 だいたい週2〜3の割合で「3の日」が、週1〜2の割合で「5の日」があるみたいですね。 この微妙なランダム性がいい感じです。

作成に使ったスクリプトは以下です。

require 'rubygems'
require 'icalendar'
require 'date' 

# 新しいカレンダーを作る
cal = Icalendar::Calendar.new

# 今年。(とりあえず年末まであれば良いだろう)
y = Time.now.year

# 各月の、
(1..12).each do |m|
  # 各日について、
  (1..31).each do |d|
    # 有効な日付なら (つまり、2月31日みたいな存在しない日でなければ)
    if Date.valid_date?(y, m, d)
      # 5の倍数の日は
      if d % 5 == 0
        # 「5」という名前の終日イベントを登録
        cal.event do
          dtstart Date.new(y, m, d)      # その日
          dtend   Date.new(y, m, d) + 1  # 次の日
          summary "5"                    # イベントのタイトル
          description "5"                # イベントの説明
        end
      # そうでなくて、3の倍数か「3」がつく日は
      elsif d % 3 == 0 or /3/ =~ d.to_s
        # 「3」という名前のイベント(0時〜1時)を登録
        cal.event do
          dtstart DateTime.new(y, m, d, 0, 0)
          dtend   DateTime.new(y, m, d, 1, 0) 
          summary "3"
          description "3"
        end
      end
    end
  end
end

# iCal形式で出力
puts cal.to_ical

Googleカレンダーにも「ナベアツカレンダー」という名前で登録してみましたので、どうぞご利用ください。 よいナベアツライフを！

■ [scheme] R6RSからテストケースを抜き出したい (1)

r6rs.tar.gzにはtexファイルが含まれてるので、それの\begin{scheme}...\end{scheme} を抜き出せばいいんじゃね？

途中経過。

(bytevector-sint-ref b 0 (endianness little) 16)=> -3

(bytevector->u8-list b)=> (253 255 255 255 255 255 255 255
               255 255 255 255 255 255 255 255)

(bytevector-uint-set! b 0 (- (expt 2 128) 3)
                 (endianness big) 16)
(bytevector-uint-ref b 0 (endianness big) 16) =>
    #xfffffffffffffffffffffffffffffffd

問題点:

• &assertionとかどうしようかな
• undefined と unspecified はどうしよう？
  • 単にそのテストケースを無視することにする？
  • 無視しないとすると、#<undef>をどう表すか？ (define *the-undefined* (display)) とかか。
• expectedに「0もしくはNaN」とか書いてあったりするんだがw

何にせよ「; two return values」とか「; approximately」とか「; prints: error opening file」とかあるので、 多少は手作業で修正しないといかんかも。

抜きだしスクリプトは以下。

;;; extract test data from r6rs/documents/*.tex
(use file.util)
(use gauche.collection)

(define *re-scheme-block* #/\\begin\{scheme\}(.*?)\\end\{scheme\}/)

(define (test-case? str)
  (and (not (#/\\hyper/ str))
       (not (#/\\vari?\{.*\}/ str))
       )) ;(#/\\[lx]?ev/ str)))

(define (tex->scheme-source str)
  (regexp-replace-all* str #/\\[lx]?ev/ "=>"
                           #/\%\s*$/ ""
                           #/\\exception\{\\&(.*?)\}/ "&\\1"
                           #/\\sharpsign/ "#"
                           #/\\backwhack\{\}/ "\\"
                           #/\\schtrue(\{\})?/ "#t"
                           #/\\schfalse(\{\})?/ "#f"
                           #/\\sharpfoo\{(.)\}/ "#\\1"
                           #/\\(ide|textrm)\{(.*?)\}/ "\\2"
                           #/\\#/ "#"
                           #/\\_/ "_"
                           #/\\&/ "&"
                           #/\\unspecified/ "#<unspecified>"
                           #/\\theunspecified/ "#<undef>"))

(define (tex->test-data-list str)
  (let1 match (*re-scheme-block* str)
    (if (and match (test-case? (match 1)))
      (cons (tex->scheme-source (match 1))
            (tex->test-data-list (rxmatch-after match)))
      '())))

(define (extract-file path)
  (print ";;; ---- " path)
  (for-each print (tex->test-data-list (file->string path))))

(define (main args)
  (case (length args)
    ((1)
     (print "usage: extract-r6rs-test foo.tex"))
    (else 
     (for-each extract-file (cdr args)))))