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))))
うん、おもしろかった。
0 件のコメント:
コメントを投稿