2011/05/15

change-class が便利

CL-Gtk2 を触ってみたらとてもよかったので、エディタを使ってみている。

GtkSourceBuffer で編集対象をあつかうただが、オープンしたファイル名なども一緒に GtkSourceBuffer に持っていてほしい。

そこで change-class してみた。

GtkSourceBuffer は CL-Gtk2 では source-buffer クラスになっている。 source-buffer クラスを継承して欲しいスロットを持ったクラスを作る。 source-buffer のインスタンスができたところで、その作ったクラスに change-class する。

(defclass* buffer (source-buffer)
((view)
(name nil)
(file nil)
(yank "AAAA")
(digit-argument nil :accessor nil)
(external-format :utf-8))
(:metaclass gobject-class))

(change-class (make-instance 'source-buffer)
'buffer
:name "command buffer")

動的プロキシとかデリゲートとか意味ないな (特異メソッドはまた違う話しか) 。

MOP なら動的にスーパークラスを追加する手もあるかもしれない。

あっ、make-instance したのを change-class するのはひどい例だった。

2011/05/08

Google Code Jam Qualification Round 2011

参加した。

もちろん使用言語は Common Lisp

A Bot Trust

オレンジが仕事している間もブル一は仕事できる。まずは、 O の仕事と B の仕事をグルーピングしよう。 loop で書きかけたら、何だか書きにくい。再帰で書く。

あ、だめだ。 B 1 B 2 と連続していたら、O が仕事している間にできるのは、 B 1 の分だけだ。 (setf prev-sec 0) が必要。

ボタンを押す分を足すの忘れてる。 1+ 追加。

2ヵ所で (if (eq curr-robot 'o) とか判定してるのきたないな。。。ま、いいか。

うん、動いた。よさそう。

入力は、リーダがあってよかった。

Small も Larg もかわらないね。

;;;; Google Code Jam
;;;; Qualification Round 2011
;;;; A Bot Trust
;;;; Common Lisp
;;;; 46min


(defun grouping (x &optional acc last-color)
(if (null x)
(mapcar #'nreverse (nreverse acc))
(let ((color (car x))
(button (cadr x)))
(if (eq color last-color)
(push button (car acc))
(push (list button) acc))
(grouping (cddr x) acc color))))

(defun compute (seq)
(loop with o-pos = 1
with b-pos = 1
for prev-sec = 0 then curr-sec
for curr-robot = 'o then (if (eq curr-robot 'o) 'b 'o)
for xs in seq
for curr-sec = (loop for x in xs
sum (prog1
(max 1 (- (1+ (abs (- x (if (eq curr-robot 'o) o-pos b-pos))))
prev-sec))
(setf prev-sec 0)
(if (eq curr-robot 'o)
(setf o-pos x)
(setf b-pos x))))
sum curr-sec))


(compute (grouping '(O 2 B 1 B 2 O 4)))
;;=> 6
(compute (grouping '(O 5 O 8 B 100)))
;;=> 100
(compute (grouping '(B 2 B 1)))
;;=> 4



(defun read-input ()
(loop repeat (read)
collect (loop repeat (read)
append (list (read) (read))) ))


(defun main ()
(loop for x in (read-input)
for i from 1
do (format t "Case #~d: ~d~%" i (compute (grouping x)))))

(defun main-with-file (input-file)
(let ((input-file (make-pathname :name (pathname-name input-file)
:type (pathname-type input-file)
:defaults "~/letter/lisp/try/google-code-jam/2011/a/qualification-round/")))
(with-open-file (*standard-input* input-file)
(with-open-file (*standard-output* (make-pathname :defaults input-file :type "out")
:direction :output :if-exists :supersede)
(main)))))

;;(main-with-file "A-small-attempt0.in")

(main-with-file "A-large.in")

B Magicka

えっと、、、複雑だな。

愚直にとけばいいのか。Q F が来たら T になる。あ、Q が残っちゃってる。 (setf acc (cons combine acc)) じゃなって (setf acc (cons combine (cdr acc))) だ。

愚直にといて Large でも問題ないみたい。

;;;; Google Code Jam
;;;; Qualification Round 2011
;;;; B Magicka
;;;; Common Lisp
;;;; 70min

(declaim (optimize (debug 3) (safety 3)))

(defun compute-combine (a b combines)
(and a
(loop for (x y z) in combines
if (or (and (eq x a) (eq y b))
(and (eq x b) (eq y a)))
do (return-from compute-combine z))
nil))

(defun opposed-p (acc opposds)
(loop for (x y) in opposds
thereis (and (member x acc)
(member y acc))))

(defun compute (combines opposeds invokes)
(loop with acc = nil
for x in invokes
for combine = (compute-combine (car acc) x combines)
if combine
do (setf acc (cons combine (cdr acc)))
else
do (push x acc)
end
if (opposed-p acc opposeds)
do (setf acc nil)
end
finally (return (nreverse acc))))

(compute '() '() '(e a))
;;=> (E A)
(compute '((q r i)) '() '(r r q r))
;;=> (R I R)
(compute '((q f t)) '((q f)) '(f a q f d f q))
;;=> (F D T)
(compute '((e e z)) '((q e)) '(q e e e e r a))
;;=> (Z E R A)
(compute '() '((q w)) '(q w))
;;=> NIL


(defun str->sym (str)
(loop for c across (string-upcase str)
collect (intern (string c))))

(defun read-input ()
(loop repeat (read)
collect (list #1=(loop repeat (read)
collect (str->sym (read)))
#1#
(progn (read) (str->sym (read))))))


(defun main ()
(loop for x in (read-input)
for i from 1
do (format t "Case #~d: [~{~a~^, ~}]~%" i (apply #'compute x))))

(defun main-with-file (input-file)
(let ((input-file (make-pathname :name (pathname-name input-file)
:type (pathname-type input-file)
:defaults "~/letter/lisp/try/google-code-jam/2011/a/qualification-round/")))
(with-open-file (*standard-input* input-file)
(with-open-file (*standard-output* (make-pathname :defaults input-file :type "out")
:direction :output :if-exists :supersede)
(main)))))

;;(main-with-file "B-small-attempt0.in")

(main-with-file "B-large.in")

C Candy Splitting

これは logxor か。 2進にして縦にならべてみる。

001
010
011
100
101

NO になるのは、ある bit で 1 が奇数個の場合。各 bit 毎に 1 の数をかぞえればいいのか。一番大きな bit は integer-length でとれる。

いや、単に全部を logxor して 0 じゃなければ NO なんだ。 (not (zerop (apply #'logxor list)))

さて、どうやって分けるか。総当たりだときっと large でだめだよな。

うぅん、わかんない。先に D を見てみよう。と、D を見てみたが D もわからないので、また C に戻る。

もう一度2進で縦に並べたものをながめる。あれ、どこど分けてもいいんじゃないのか。どこで分けても xor で綺麗になる。本当か? 本当っぽいな。これはひどい Patrick があまりにもかわいそうだろう。

何も考えず総当たりでやっても、全部一回目で当たりだから問題なかったんだ。

;;;; Google Code Jam
;;;; Qualification Round 2011
;;;; C Candy Splitting
;;;; Common Lisp
;;;; 2.5h

#|
5 + 4 = 1
7 + 9 = 14
50 + 10 = 56

#b0101 #b100 #b0001
(logxor #b0101 #b100)
;;=> 1
#b0001
(logxor #b0111 #b1001)
;;=> 14
#b1110
(logxor #b110010 #b1010)
;;=> 56
#b111000



1 2 3 4 5 Case #1: NO

001
010
011
100
101


3 5 6 Case #2: 11

011
101
110

(logxor 5 6)
;;=> 3

011
101
110
100
100

|#


(defun no-p (list)
(not (zerop (apply #'logxor list))))

(defun compute (list)
(unless (no-p list)
(let ((sorted (sort list #'<)))
(apply #'+ (cdr sorted)))))

(compute '(1 2 3 4 5))
;;=> NIL
(compute ' (5 3 6))
;;=> 11

(defun read-input ()
(loop repeat (read)
collect (loop repeat (read)
collect (read))))


(defun main ()
(loop for x in (read-input)
for i from 1
do (format t "Case #~d: ~:[NO~;~:*~d~]~%" i (compute x))))



(defun main-with-file (input-file)
(let ((input-file (make-pathname :name (pathname-name input-file)
:type (pathname-type input-file)
:defaults "~/letter/lisp/try/google-code-jam/2011/a/qualification-round/")))
(with-open-file (*standard-input* input-file)
(with-open-file (*standard-output* (make-pathname :defaults input-file :type "out")
:direction :output :if-exists :supersede)
(main)))))

;;(main-with-file "C-small-attempt0.in")

(main-with-file "C-large.in")

D GoroSort

確率か。苦手だ。勉強が必要だなと思っているところ。

10 の -6 乗の精度って普通に float してもだめなんだ。 (float 1/3 0d0) と書くのか。

Goro の最適な戦略は何だろう。 Sample #3 の説明には 2 個ずつソートすると書いてある。全部まとめてソートした方がはやくないのか。

2 つずつのソートがベストだと仮定してやってみると Small で失敗。

3 1 2 のソートで考えてみよう。 2 つずつより 3 つまとめての方がはやいように思えるんだけど。。。いくら考えてもわからん。

Large の N は最大 1000 なんで、何か簡単に求める方法があるはず。。。

仕方ないシミュレートしてみよう。シミュレートの方法は入力のリストをそのソート済みのものと 1 要素ずつ比較して、一致しないものだけ collect して新しいリストを作る。できた新しいリストをシャッフルして、あとは空になるまで繰り返す。これで試めしてみると 2 1 4 3 を 2 つずつソートするのと全部まとめてソートするのでステップ数はかわらない。他にも色々試めしてみると、初期状態でソート済の位置にないものの個数がそのまま答えになっているっぽい。そんなものなのか。さっぱり理解できない。 Small やってみたら。通った。ならあってるんだろうと Large を提出。

;;;; Google Code Jam
;;;; Qualification Round 2011
;;;; D GoroSort
;;;; Common Lisp
;;;; 30min 13:00-


#|
(float 1/3 0d0)
;;=> 0.3333333333333333d0



(3 1 2)
---
a (1 2 3) 1/6
b (1 3 2) 1/2 * 1/2
b (2 1 3)
b (3 2 1)
c (2 3 1)
c (3 1 2)

N=3
(+ 1/6 1/12 1/12 1/12)
;;=> 5/12
(float (/ 1 5/12))
;;=> 2.4
|#


(defun shuffle (list)
(let ((list (copy-list list)))
(loop for len = (length list)
while list
collect (let ((n (nth (random len) list)))
(setf list (delete n list))
n))))

(defun count-sort-step (list sorted &optional (n 0))
(loop for a in list
for b in sorted
if (/= a b)
collect a into new-list
and collect b into new-sorted
finally (return
(if (null new-list)
n
(count-sort-step (shuffle new-list) new-sorted (1+ n))))))

#|

(simulate 1 2 3)
;;=> 0.0d0
(simulate 1 3 2)
;;=> 2.019098090190981d0
(simulate 3 1 2)
;;=> 2.996900309969003d0

(simulate 2 1 4 3)
;;=> 4.000099990001d0
(simulate 4 3 2 1)
;;=> 3.9836016398360163d0
(simulate 1 3 4 2)
;;=> 3.014898510148985d0
(simulate 1 4 3 2)
;;=> 2.0125987401259873d0


(simulate 1 2 3 4 5)
;;=> 0.0d0
(simulate 1 2 3 5 4)
;;=> 1.996000399960004d0
(simulate 1 3 2 5 4)
;;=> 3.978102189781022d0
(simulate 3 1 5 2 4)
;;=> 5.012198780121988d0

(simulate 3 1 5 2 6 4)
;;=> 6.052394760523947d0

(simulate 10 1 2 3 4 5 6 7 8 9)
;;=> 9.93890610938906d0




(4 3 2 1) 24
----
a (1 2 3 4) 1 1/24
b (1 2 4 3) 6 (* 6/24 1/2)
b (1 3 2 4)
b (1 4 3 2)
b (4 2 3 1)
b (3 2 1 4)
b (2 1 3 4)
c (1 3 4 2) 8 (* 8/24 5/12)
c (1 4 2 3)
c (3 2 4 1)
c (4 2 1 3)
c (4 1 3 2)
c (2 4 3 1)
c (2 3 1 4)
c (3 1 2 4)
d (2 1 4 3) 9
d (2 3 4 1)
d (2 4 1 3)
d (3 1 4 2)
d (3 4 1 2)
d (3 4 2 1)
d (4 1 2 3)
d (4 3 1 2)
d (4 3 2 1)

(+ 1/24 (* 6/24 1/2) (* 8/24 5/12))
;;=> 11/36
(float (/ 11/36))
;;=> 3.2727273


(2 1 4 3) => 4.000000
----
(2 1)
--
(1 2) 1/2
(2 1) 1/2

|#



(defun product (n &optional (acc 1))
(if (zerop n)
acc
(product (1- n)
(* n acc))))

#+(or)
(defun compute (array)
(loop with sorted = (sort (copy-seq array) #'<)
for x across array
for i from 0
if (= x (aref sorted i))
count 1 into ok
if (and (not (= x (aref sorted i)))
(let ((pos (position x sorted :start (1+ i))))
(and pos
(= (aref sorted i) (aref array pos)))))
count 1 into swap
finally (return (values (+ (* 2 swap)
(* 2 (max 0 (- (length array) ok (* swap 2) 1))))
(list :ok ok :swap swap :rest (- (length array) ok (* swap 2)))))))



(defun compute (array)
(loop with sorted = (sort (copy-seq array) #'<)
for a across array
for b across sorted
if (/= a b)
count 1))

#|
(compute #(3))
;;=> 0
;;=> 0
;; (:OK 1 :SWAP 0 :REST 0)
(compute #(2 4 1 3))
;;=> 4
;;=> 6
;; (:OK 0 :SWAP 0 :REST 4)
(compute #(2 1 4 3))
;;=> 4
;;=> 4
;; (:OK 0 :SWAP 2 :REST 0)
(compute #(2 1))
;;=> 2
;;=> 2
;; (:OK 0 :SWAP 1 :REST 0)
(compute #(1 3 2))
;;=> 2
;;=> 2
;; (:OK 1 :SWAP 1 :REST 0)
(compute #(3 1 2))
;;=> 3
;;=> 4
;; (:OK 0 :SWAP 0 :REST 3)

|#


(defun read-input ()
(loop repeat (read)
collect (coerce (loop repeat (read)
collect (read))
'vector)))


(defun main ()
(loop for x in (read-input)
for i from 1
do (format t "Case #~d: ~,6f~%" i (float (compute x) 1d0))))


(defun main-with-file (input-file)
(let ((input-file (make-pathname :name (pathname-name input-file)
:type (pathname-type input-file)
:defaults "~/letter/lisp/try/google-code-jam/2011/a/qualification-round/")))
(with-open-file (*standard-input* input-file)
(with-open-file (*standard-output* (make-pathname :defaults input-file :type "out")
:direction :output :if-exists :supersede)
(main)))))

;;(main-with-file "D-small-attempt2.in")

(main-with-file "D-large.in")

おわってから

ぐちゃぐちゃなものをぐちゃぐちゃなまま書ける loop は便利。入力もリーダのおかげで (read) するだけ。動かしながら書ける。 Common Lisp でよかったw

D は srot しなくてよかったのね。 n 個がランダムにおさまるなら、 (loop repeat n sum (/ 1 n)) なんで 1 になるのか。朝おきてトイレで納得した。 Case #3 の説明は罠だよ。

Code Jam 2011 Statistics に統計情報がある。 C++ って人気あるんだ。続いて Java, Python, C#, C, Ruby みたい。 Common Lisp は "Lisp" になっているようだけど、26 人が使っている。 Common Lisp はこういうのにはとても向いてると思うんだけどなぁ。

http://www.go-hero.net/jam/11/lang/Lisp で他の人のコードを見ると、みんなきれいなコードを提出してるのね。

あれ、D の simulate の定義消しちゃってた。確しかこんなんだったような。

(defun simulate (&rest list)
(loop with n = 10000
repeat n
sum (count-sort-step list (sort (copy-list list) #'<)) into total
finally (return (float (/ total n) 1d0))))

うん、おもしろかった。