Hatena::Groupcadr

kozima の日記

2012-04-30

*read-default-float-format*

19:26

GCJ 2012 A-large で失敗したので忘れないようメモ。

浮動小数点数を read するときは精度が *read-default-float-format* の値で決まります。デフォルトが single-float だったりするので(処理系による?),気をつけないと精度が足りない場合があります。

clisp で "0.123456" を read して 1000000 回足し算してみたらこうなりました。

CL-USER> (dolist (x '(short-float single-float double-float long-float))
           (let ((*read-default-float-format* x)) 
             (format t "~A~%" (let ((x (read-from-string "0.123456"))) (loop repeat 1000000 sum x)))))
16384.0
124511.13
123456.00000097719
123455.99999999887794
NIL

double 以上でないと不安な感じです。

ついでに SBCL での実行結果。

* (dolist (x '(short-float single-float double-float long-float))
           (let ((*read-default-float-format* x)) 
             (format t "~A~%" (let ((x (read-from-string "0.123456"))) (loop repeat 1000000 sum x)))))
124511.13
124511.13
123456.00000097719
123456.00000097719
NIL

似たような感じですね。SBCL の short と long はそれぞれ single, double と同じみたいです。

2011-11-25

パズル解いてみた

17:41

http://d.hatena.ne.jp/lkozima/20111125/1322209841 の実装というか,適当にコード書いて確認しました的な。

どう書く?.org で似たような問題を見たことはあって,似たような解法も見たことがあって,そのときにはわかったようなわからないような感じだったけど,やってみたら少し感覚がつかめたのかもしれない。

;; p ::= !A | !B | KA p | KB p | not p
(defun satisfies (w m n p)
  (cond ((eql p '!A)
         (= 1 (loop for (i . j) in w count (= (* i j) (* m n)))))
        ((eql p '!B)
         (= 1 (loop for (i . j) in w count (= (+ i j) (+ m n)))))
        (t
         (ecase (car p)
           (KA (loop for (i . j) in w
                  always (or (/= (* i j) (* m n))
                             (satisfies w i j (cadr p)))))
           (KB (loop for (i . j) in w
                  always (or (/= (+ i j) (+ m n))
                             (satisfies w i j (cadr p)))))
           (not (not (satisfies w m n (cadr p))))))))

(defun filter (w p)
  (remove-if-not (lambda (x) (satisfies w (car x) (cdr x) p)) w))

;; m + n < 14 なら mn < 49 だから,48 まででよい気がする
(let* ((w0 (loop for m from 2 to 48 nconc
               (loop for n from m to (/ 48 m) collect (cons m n))))
       (w1 (filter w0 '(KB (not !A))))
       (w2 (filter w1 '(not !A)))
       ;; ここは論理式で書けてない
       (w3 (remove-if-not (lambda (x) (< (+ (car x) (cdr x)) 14)) w2))
       (w4 (filter w3 '!A))
       (w5 (filter w4 '!B)))
  w5)

2011-06-10

数値がいくつかの値のどれかのとき/どれでもないときに何かする

| 21:56

この間,気付いたこと。

(find x'(1 3 5 7)) ; x が 1, 3, 5, 7 のどれか
(/= x 1 3 5 7) ; x が 1, 3, 5, 7 のどれでもない

ということは

(format t"~@[found~]"(find x'(1 3 5 7)))
(format t"~:[~;found~]"(/= x 1 3 5 7))

は同じ出力。

2011-05-30

Ejection

| 22:20

わりと頑張ったのでまとめてみたくなった。

ソース: http://golf.shinh.org/reveal.rb?Ejection/kozima_1306751250&l

ループの result-form にループが入ってて読みづらくなっていますが,単に #n# を使うためです。一つの式にまとめないと参照できないのです。

平らにして,ラベルも展開してみる。

;; 入力の読み込み
(set 'a (loop while (listen) collect (read-line)))
;; 縦方向へ eject したやつを一行出力する関数
(defun f `z
  (dotimes '(length a)
    (format (< .`(count z (nth .'(apply 'map 'list 'list a)))) "~V,0T~A" .'z))
  (fresh-line))
;; 上
(dotimes (i 4) (f (- 3 i) #\U))
;; 右
(doseq (l a)
  (doseq (c l) (princ (if (eq c #\#) c " ")))
  (format t "~V@{R~}
" (count #\R l) t))
;; 下
(dotimes '3 (f .'#\D))

f は読みにくいですが二引数関数 (sys::backquote と z) で,第一引数が # で囲まれた箱から何行離れているか (0-origin),第二引数に向き (U または D) を受け取ります。

dotimes が気持ちとしては入力の各列にわたるループで,format に渡される第一引数が,eject されたときにその行の quote 列目に出てくる人の有無となります。それがあった場合には,現在の列までインデント (~V,0T) してから eject した文字を出力 (~A) します。

第一引数の中身ですが,まず (apply 'map 'list 'list a) で行と列を反転しています。で,その quote 番目を取り出しているので,要するに quote 列目を縦に拾っていったリストが nth の戻り値です。この中に z が何個現れるかを数え,結果が箱からの距離 (sys::backquote) より大きかったら,その行まで出てくると判定できます。

あと fresh-line はなんで terpri にしないのという感じですが,出力がなにもなかったときに改行が入ってしまうと困るのでしかたなく。

右に eject する部分がわりと冗長な気がするんですが,出て行った文字を空白で置き換える必要があるのでこれくらいになるみたいです。

たぶんそれほど新しいテクニックは出てきてないと思うんですが,今回は ~V,0T がうまく使えたかな,という気がします。単純に「埋まらないところは空白」にしておく方法もなくはなくて,こんなふうにもできます。

(defun f (x z)
  (format t "~A~&"
          (string-right-trim " " (apply 'map 'string
                                        (lambda (&rest l) (if (< x (count z l)) z #\ ))
                                        a))))

map を外側へもってきて,中で処理して string で返しておいて string-right-trim を使う。fresh-line も ~& で済んでしまってスマートな感じなんですが,こっちのほうが少し長くなるみたいです。

2011-04-25

auto compression

| 00:35

削れる空白やコメントを削除するコマンド。たいていのコードは限界まで縮められると思います。

バイト数と Statistics を表示する機能を追加して,ついでに gist に置きました。

なんか引数の渡し方が変なところがあるのに書いた後で気付いた。