2018-01-14

リストの作成

こんなツイートをしたが、どう書くかというのは示してなかったので(iPhone上からだったので)、せっかくだしブログのネタにしようという話。



リストの生成方法にはいくつか方法があるが、今回は有名どころを二つ書いておく。
cons + reverse
cons + reverseはまぁよく使われるパターンで、この名前で呼べば大体どんなものかの想像がつくくらいだ(と思う)。ツイートで言及しているQiita記事にある手続きfをこのパターンで書き直してみた。
(define (f/cons+reverse init n)
  (let loop ((i 0) (r init))
    (if (< i n)
        (loop (+ i 1) (cons (tent_func (car r)) r))
        (reverse r))))
nthが何をしているものなのかよくわからなかったが、おそらく(nth -1 L)はリストの最終要素を取り出すものと予想。(そのように実装して元の手続きを動かしたらそれっぽい値返したし。)
これだとappendがなくなるので、O(n^2)がO(n)になる。一時リストの生成が嫌ならreverse!を使えば生成されるリストもたかだか一個になる。
doで以下のように書くこともできる。
(define (f/cons+reverse init n)
  (do ((i 0 (+ i 1)) (r init (cons (tent_func (car r)) r)))
      ((= i n) (reverse r))))
どちらがいいかは好み次第。
ちなみに、reverseがないので保留と言われた(記憶、Twitter上で見つからん)のだが、reverseはこんな風に書ける。
(define (reverse l)
  (do ((l l (cdr l)) (r '() (cons (car l) r)))
      ((null? l) r)))
RnRS準拠の処理系なら絶対持ってるはずだが、自作の処理系だったという可能性も踏まえてみる。 (積極的に無駄な処理をするコードを直していくスタイル)

unfold
Schemeの標準にはないが、SRFI-1 (R7RS-large)にはunfold という手続きがある。これを使うと上記は以下のように書ける。
(define (f/unfold init n)
  (unfold (lambda (x) (< (car x) 0))
          cdr
          (lambda (x) (cons (- (car x) 1) (tent_func (cdr x))))
          (cons n init)))
こっちは多少メモリ効率が悪い(シードの生成に必ずペアを作ってる)し、unfoldの使用方法が多少変則的な感はある。

ループ内で(append result (list ...))みたいなコードを見つけたら積極的に書き換えていきたいところである。

2018-01-08

日付と時間 その2

前回の続き

Shiroさんの案では calendar 自体が (y, m, d, H, M, S) の組を持つというもので、SRFI-19 の date は (y, m, d, H, M, S) + timezone というもの。っで、 calendar の種類は複数あって、例えばグレゴリアン歴の2018年1月8日は D = (2018, 1, 8, 0, 0, 0)だけど、これと同等のユリウス暦は2017年12月26日 D = (2017, 12, 26, 0, 0, 0)になる。更に、それぞれの calendar が時間の演算を持つというもの。例えば calendar A では一日が30時間だとすると、その calendar における日付B+1日というのは Gregorian calendar では1日と6時間を足したことになるが、この差異を calendar がよしなにしてくれるというもの。(意図を正しく理解していれば)

個人的には非常に可搬性が高く、火星に行っても火星用の calendar を作成すれば使えるいいアイデアだと思うんだけど、地球上でプログラムをするのであれば、RFC3339で定義されている時間で概ね事足りると思ったりもする。(まぁ、宇宙開拓史みたいなゲームを作って火星のカレンダーが必要だみたいなのはあるかもしれんが、レアケースと割りきってもいいよね?)

そうするとこんな感じで簡略化するとよくね?という気にもなる。
日付 D = (y, m, d, H, M, S)
カレンダー C
タイムゾーン TZ
として、日付Dは常にRFC3339で表現できるものとする。日付の演算はデフォルトでは以下のようにできる:
D+1d = (y, m, d+1, H, M, S) = (y, m, d, H + 24, M, S) = ...
カレンダーCは例えばユリウス通日等の計算や、そのカレンダー上での一日を日付D上に加算するのに使ったりするこんな感じ。
(calendar:days->date calendar:julian 0) ;; -> D(-4714 11 24 12 0 0)
タイムゾーンTZはまぁ、普通にタイムゾーンで、SRFI-19の date は D+TZ になる。

目を凝らすと日付Dは (y, m, d, H, M, S) + RFC3339 と言えなくもなく、デフォルトの演算は calendar Crfc3339 によって提供されるものとも言えるので、多少の利便性だけとも言えなくもない。じゃあ、最初からそうすればよくね?という気もしてきた。う〜ん。

2018-01-04

日付と時間

日付や時間はプログラムを書く上で鬼門になりがちなものである。例えば、2018年1月4日11時10分と言った時に、この時間は常に同じ時間を指すだろうか?答えはNoである。例えばオランダと日本では別々の時間になる。同一時刻を指すようにするにはタイムゾーンの指定が必要になる。

Schemeには日付と時間を扱うSRFIがある。SRFI-19である。多くの場合はこのSRFIで事足りるのだが、局所時間を扱う際にこまることがある。例えば上記の日付をタイムゾーンを気にせず表せない。
;; これはエラー
(make-date 0 0 10 11 4 1 2018 #f)
;; これは常にUTC
(make-date 0 0 10 11 4 1 2018 0)
;; これだと常にUTC+1:00、夏時間どうする?
(make-date 0 0 10 11 4 1 2018 3600)
とりあえず全ての日付はUTC+0にして扱うという手もあるのだが、バッチ処理を日付が変わるときに行うというようなことが面倒になる。また、このSRFIには日付のみ、時間のみを扱う術がない。例えば11時15分という時間と(make-date 0 0 15 11 0 0 0 0)は等価か?あるいは2018年1月4日は(make-date 0 0 0 0 4 1 2018 0)と等価であるかということである。答えはケースバイケースであるとは思うが、多くの場合はNoではないだろうか?

Javaは1.8からjava.timeというパッケージが導入された。これは上記のようなジレンマを解決してくれそうな雰囲気がある(使ったことないので未確認)。Sagittariusにもこれと似たようなものを入れるべきかなぁと考えている。こんな感じでの階層だろうか?
+-------+   +-------+
| date  |   | time  |
+---+---+   +---+---+
    |           |
    +-----+-----+ 
          |
    +-----+-----+   +-------------+
    | date-time |   | zone-offset |
    +-----+-----+   +------+------+
          |                |
          +-------+--------+
                  |
       +----------+----------+
       | offsetted-date-time | <-- SRFI-19 dateと等価
       +---------------------+
時間が常にローカル時間かというのはわからないので、offsetted-timeみたいなのもあっていいかもしれない。timeだと名前が被るから別名にする必要も有りそうだが。

ちょっと考える必要があるが、割と早めに導入したい気持ちもある。

追記
Shiroさんのアイデア


これを使ってSRFI-19を実装するとすると、Calendarは3つ必要になりそう。(たぶん)Gregorian、JulianとModified Julian。内Julian calendarとModified Julian calendarは要らんかもしれんが、あると綺麗っぽい。これを踏まえると以下のようにするといいだろうか?
                  +------------+
                  |  timezone  |
                  +------------+
                  | - Offset   |
                  +------+-----+
+------------+           |
|    date    |           |
+------------+           |
| - timezone |<>---------+                  +------------+
| - calendar |<>------------+               | date-tuple |
+------------+              |               +------------+
                 +----------+----------+    | -(Y,M,D)   |
                 |      calendar       |    +-----+------+
                 +---------------------+          |
                 | - YMD: date-tuple   |<>--------+
                 | - HmS: time-tuple   |<>--------+
                 +---------------------+          |
                                            +-----+------+
                                            | time-tuple |
                                            +------------+
                                            | -(H,m,S)   |
                                            +------------+
calendarは演算手続きの集合にして、こうした方がいいだろうか?
+--------------+                                  +------------+ +------------+
|   calendar   |                                  | date-tuple | | time-tuple |
+--------------+                                  +------------+ +------------+
| - operations |                                  | - (Y,M,D)  | | - (H,m,S)  |
+------+-------+                                  +------+-----+ +------+-----+
       |                                                 |              |
       |             +-------------------+               |              |
       |             |     local-date    |               |              |
       |             +-------------------+               |              |
       |             | - YMD: date-tuple |<>-------------+              |
       +-----------<>| - calender        |                              |
       |             +-------------------+                              |
       |                                                                |
       |             +-------------------+                              |
       |             |     local-time    |                              |
       |             +-------------------+                              |
       |             | - HmS: time-tuple |<>----------------------------+
       +-----------<>| - calendar        |
                     +-------------------+
                              :
                            so on
                              :
どっちもしっくりこない感じがするなぁ。もう少し考える必要がありそうだ。

2018-01-02

謹賀新年

年末年始を病院で過ごしていたのでいわゆる「今年を振り返って」みたいなのが書けなかった。(僕自身が病気ではないです、後は察してください)

昨年はいろいろあって、一年が長かったのか短かったのかよく分からない状態である。少なくとも去年の1月に何をしていたのかは全く思い出せない。引っ越しがあったのでそれに記憶の大部分を取られている気もする。

今年の抱負と目標:
  • ジムに週二で通う
    • 割と毎年言ってるなぁ
  • Scheme関連のブログ記事を週一で書く
    • 習慣にすればなんとか行けるかなぁ
    • 最悪「Sagittariusの中身」とか書きだせば…
  • 今作ってるWebアプリを公開する
    • モチベーションが落ち気味なので宣言しておけば嫌でもやるだろう
あんまり関係ないけど、転職も考えていたりする。完全リモートワークOKならオランダ国外でも問題ないです。

2017-12-17

95%の人は満足するけど残りの5%は不満を持ち得るシステムの5%に入ってしまった件

表題が示す通りなんだけど、そんな境遇に陥った。

今の会社に入って1年半たつのだが、買収があったりして給与システムの大幅な見直しみたいなのがあった。今までは、なんとなく評価された人が昇給されたりボーナスがあったりみたいな超おおざっぱな感じだったんだけど(特に決められたルールがなかった)、スケール制(ランク制?)みたいなのが導入されたり、固定値のボーナス(オランダ的には13ヵ月目ともいう)が導入されたりしてきた。

これだけ見ると改善があって、透明性が増したからいいじゃんなんだけど、導入されたシステムには頭打ち もあって、あるランクで最高額に到達したら昇給が発生しないのである。この状態で昇給するにはランクアップするしかない。僕はこの状態であるという通知を受けた。一応満額まで数パーセントあるように見えるが、微妙な曖昧性があるので、満額と言われてもおかしくない状態。

っで、現状ではランクアップの方法は不明かつシニアエンジニアとして雇われているので、この職責上でこの上ってなんになるんだろう的なのもある。

周りの反応を見るに、この状況にある被雇用者は本当に少数っぽくて、ちょっと話を聞いていただけだと、普通評価でも毎年3~4%の昇給が望めると喜んでいる人の方が多いくらいだった。いままで昇給のルールすらなかったのだから気持ちは分かるが…

このシステムが導入される際に一応プレゼンがあったんだけど、そこで言われたのが、「頭打ちになった際にはランクアップするために別のポジションに着く必要があるが、社内にそのポジションがなかったら社外で探すしかない」という旨の言葉だったりする。こういう状況の人間が発生することは分かっていたうえでのこの発言+特に救済(現状の職責より1ランク高いものを割り当てておくとか)をしなかったのは潔いなと思う反面、いま開発者が去るだけで入ってこない状況を軽めに見てるのかなぁとも思ったり。(もしくは僕は穀潰しとみなされているか、それはそれで悲しいが…)

今週のどこかで昇給についての面接があるらしいので、ランクアップの可能性があるのかないのか聞かないとなぁ。可能性0ならしょうがない、次の職場をまじめに探すかねぇ。

2017-11-24

プログラミング言語Schemeの学び方

これに触発されてみた。
調簡易なHTTPサーバーをR7RS+SRFIで作ってSchemeを学ぼうという話。スライド145にある項目をとりあえず列挙
  • Socketの扱い
  • 正規表現
  • リソースの開放
  • 並行処理
  • 文字列の扱い
【Socketの扱い】
Scheme標準にはないのでSRFI-106を使う。サーバーSocketはこう作る。
(define server-socket (make-server-socket "8080"))
そして、こんな風に待ち受ける。
(let loop ()
  (let ((socket (socket-accept server-socket)))
    (loop))
特に何もしないソケットがリークしまくるサーバーの出来上がり。

【正規表現】
Scheme標準にはないのでSRFI-115を使う。HTTPリクエストの最初の一行をパースする正規表現はこんな感じで書ける。
(define first-line
  '(: "GET" (+ space)
      (-> path (: "/" (+ ascii))) (+ space)
      "HTTP/" (: num "." num)))
こんな感じで使う
(cond ((regexp-matches first-line line) =>
       (lambda (m)
         (let ((path (regexp-match-submatch m 'path)))
           ;; get the content of the path
           ))))
サブマッチに名前は付ける必要はないが、あるとわかりやすい。

【リソースの開放】
Schemeに便利な汎用リソース開放構文というのはないので、都度用途に合わせて作ったり標準にあるものを用いる。例えば、ポートの開放はclose-portを使い、call-with-portを使えば、正常処理後にはポートを閉じてくれる。Socketの開放はsocket-shutodownsocket-closeを用いる。
サーバをであれば、以下のようなものが便利に使えなくもない。
(define (finish)
  (close-port in)
  (close-port out)
  (socket-shutdown socket *shut-rdwr*)
  (socket-close socket))
inoutはソケットポートである。

【並行処理】
Scheme標準にはないのでSRFI-18を使う。SRFI-18はプリミティブなスレッドとミューテックスしか提供しないので、高度なものが必要であれば自分で作る必要がある。
投げっぱなしスレッドは以下のように作れる。
(thread-start! (make-thread (lambda () (handle-request socket))))
処理系によってはスレッドの作成は高価な場合があるので、可能であればスレッドプール等は作っておきたいところ。R6RS処理系かつSRFI-18をサポートしているのであれば、拙作の(util concurrent)が使える。

【文字列の扱い】
スライドにあるような便利なものはない。連結したければstring-append等を使う必要がある。文字列操作は高価な場合があるので(例:参照にO(n)かかる)、使える場面ではポートを使いたいところ。

さて、上記全てを踏まえて非常に簡易なGETリクエストのみに対応したHTTPサーバは以下になる。R7RSではバイナリポートと文字ポートは分かれていて、処理系によっては厳しく分けてあつかう(特にR6RS/R7RSな処理系、Sagittariusなど)ので、I/Oの部分がどうしても煩雑になる。例えば、出力の際には文字列を一旦バイナリに変換している。

(import (scheme base)
        (scheme write)
        (scheme file)
        (srfi 18)
        (srfi 106)
        (srfi 115))

;; Assume all ASCII
(define (read-binary-line in)
  (let ((out (open-output-string)))
    (let loop ((b (read-u8 in)))
      (case b
        ((#x0d)
         (case (peek-u8 in)
           ((#x0a) (read-u8 in) (get-output-string out))
           (else (write-char (integer->char b) out) (loop (read-u8 in)))))
        (else (write-char (integer->char b) out) (loop (read-u8 in)))))))

(define (handle-request socket)
  (define in (socket-input-port socket))
  (define out (socket-output-port socket))
  (define first-line
    '(: "GET" (+ space)
        (-> path (: "/" (+ ascii))) (+ space)
        "HTTP/" (: num "." num)))
  (define (finish)
    (close-port in)
    (close-port out)
    (socket-shutdown socket *shut-rdwr*)
    (socket-close socket))
  (define (http-error status e)
    (define message (string->utf8 "Not okay"))
    (report-error e)
    (write-bytevector (string->utf8 "HTTP/1.1 ") out)
    (write-bytevector (string->utf8 (number->string status)) out)
    ;; laziness...
    (write-bytevector (string->utf8 " BOO\r\n") out)
    (write-bytevector (string->utf8 "Content-Type: text/plain\r\n") out)
    (write-bytevector (string->utf8 "Content-Length: ") out)
    (write-bytevector (string->utf8
                       (number->string (bytevector-length message))) out)
    (write-bytevector (string->utf8 "\r\n\r\n") out)
    (write-bytevector message out)
    (finish))
    
  (guard (e (else (http-error 500 e)))
    (let ((line (read-binary-line in)))
      (cond ((regexp-matches first-line line) =>
             (lambda (m)
               (let ((path (regexp-match-submatch m 'path))
                     (bout (open-output-bytevector)))
                 (guard (e (else (http-error 404 e)))
                   (let ((file (string-append "." path)))
                     (call-with-port (open-binary-input-file file)
                       (lambda (in)
                         (define buf (make-bytevector 1024))
                         (let loop ((n (read-bytevector! buf in)))
                           (write-bytevector buf bout 0 n)
                           (when (= n 1024)
                             (loop (read-bytevector! buf in))))))))
                 (write-bytevector (string->utf8 "HTTP/1.1 200 OK\r\n") out)
                 (write-bytevector (string->utf8 "Content-Type: text/plain\r\n") out)
                 (let ((bv (get-output-bytevector bout)))
                   (write-bytevector (string->utf8 "Content-Length: ") out)
                   (write-bytevector (string->utf8
                                          (number->string
                                           (bytevector-length bv))) out)
                   (write-bytevector (string->utf8 "\r\n\r\n") out)
                   (write-bytevector bv out)
                   (finish)))))
            (else (http-error 403 #f))))))

(define server-socket (make-server-socket "8080"))

(display "Starting server on port 8080") (newline)
(let loop ()
  (let ((socket (socket-accept server-socket)))
    (thread-start! (make-thread (lambda () (handle-request socket))))
    (loop))
もう少し簡単に書きたいと思ったら、Sagittariusに付属している(net server)を使うか、拙作Paellaを使うと簡単にHTTPサーバが書ける。後者はサーバというよりはWebアプリが簡単に書けると言うべきか。

2017-11-08

スレッドの軽量化

Sagittariusはスレッドの作成が重い。理由は至って簡単でスレッド毎にVMを複製するからである。あまり気にするほどスレッドを使っていなかったのだが、最近(というか昨日)Paellaに非同期的なのを入れた際にこれはまずいと思いだした。何がまずいかというと、Paellaに入れた非同期構造は、サーバーからソケットの管理を外した後にスレッドを作ってその中でリクエストを処理するというものだからだ。つまり、スレッドの作成の重さがそのままボトルネックになる。

スレッドの生成で最も重いのはVMスタックを割り当てる部分だと大まかにあたりをつけてはいた。ついでに、VMスタックをCスタック上におければよくね?とも考えてはいた。ずっと思っていただけで実行には移さなかったのだが、ここに来てちと重要になりそうなのでえいや!っと試してみることにした。

スレッド=VMということはスレッドの寿命=VMの寿命でもあるので、開始時にスレッドのスタックからVMスタックを割り付ければ問題ないはず。ということでそんな感じのコードを書いて適当なベンチマークを行ってみた。以下はベンチマークのコード

(import (rnrs) (srfi :1) (srfi :18) (time))

(define data (iota 10000))

(let ((threads
       (time (map (lambda (i)
                    (thread-start! (make-thread (lambda () i)))) data))))
  (assert (equal? data (map thread-join! threads))))
スレッドの生成時間のみを測りたいので、こんなに単純。っで以下が結果(環境 Ubuntu 16.04 64bit Intel® Core™ i7-6820HQ CPU @ 2.70GHz × 8):
元のコード
$ sash thread-bench.scm

;;  (map (lambda (i) (thread-start! (make-thread (lambda () i)))) data)
;;  2.626753 real    3.012000 user    0.256000 sys
改良版
$ ./build/sagittarius -Dbuild thread-bench.scm

;;  (map (lambda (i) (thread-start! (make-thread (lambda () i)))) data)
;;  0.239091 real    0.120000 user    0.224000 sys
ちょっと出来過ぎな感じもするが、効果はありっぽい。まぁ、生成数をひとけた減らすと3倍程度の改善になるので、メモリの圧迫が減っただけとも言える(それが目的なのではあるが)。