kozima の日記


GCJ Qualification Round submissions


たぶん cadr 向きなのでこちらで。

GCJ Qualification Round に submit したコードをそのまま並べておきます。解説でも書ければいいんですけどもね。

後ろの loop はほとんどテンプレートと化しています。

Problem A

(defun solve (n k)
  (zerop (mod (1+ k) (ash 1 n))))

(loop for i from 1 to (read) do
  (let ((n (read)) (k (read)))
    (format t "Case #~D: ~:[OFF~;ON~]~%" i (solve n k))))

Problem B

(defun solve (ts)
  (let ((t0 (abs (reduce #'gcd (delete 0 (mapcar #'- ts (cdr ts)))))))
    (loop for s in ts minimize (if (zerop (mod s t0)) 0 (- t0 (mod s t0))))))

(loop for i from 1 to (read) do
  (let ((ts (loop repeat (read) collect (read))))
    (format t "Case #~D: ~D~%" i (solve ts))))

Problem C (small)


(defun solve (r k n gs)
  (setf (cdr (last gs)) gs)
  (let ((a (make-array n :initial-element nil))
        (times 0) (euros 0) (index 0))
    (flet ((next ()
             (loop with imax = (+ index n)
               sum (car gs) into people
               while (and (<= people k) (< index imax))
               do (setf euros (+ euros (car gs))
                        gs (cdr gs)
                        index (1+ index)))
             (setf index (mod index n))
             ;; (format t "next ==> ~A ~A~%" euros index)
;;             (values euros (mod index n))))
      (dotimes (i r)
        ;; (format t "~A ~A ~A ~A~%~S~%" times euros index (car gs) a)
        (if (aref a index)
            (let* ((c (aref a index))
                   (t1 (car c))
                   (e1 (cdr c))
                   (k (floor (- r t1) (- times t1))))
              (setf times (+ t1 (* k (- times t1)))
                    euros (+ e1 (* k (- euros e1))))
              (dotimes (j (- r times))
;;                 (multiple-value-setq (euros index)
;;                   (next euros index)))
              (return-from solve euros))
            (setf (aref a index) (cons times euros)))
;;        (multiple-value-setq (euros index) (next euros index))
        (incf times))

(loop for i from 1 to (read) do
  (format t "Case #~D: ~D~%"
          (let* ((r (read)) (k (read)) (n (read))
                 (gs (loop repeat n collect (read))))
            (solve r k n gs))))

Problem C (large)

small より最適化されてるかというとぜんぜんそんなことはなくてむしろ遅い。でも少しきれい。

ついでに Scheme 風。あるいは Paul Graham 風?

(defun solve (r k n gs)
  (setf (cdr (last gs)) gs)
  (let ((h (make-hash-table :test 'eq)))
    (labels ((pop-gs () (pop gs))
             (peek-gs () (car gs))
             (next ()
               (loop for gcount from 1
                 for people = (pop gs) then (+ people (pop-gs))
                 as p-ahead = (+ people (peek-gs))
                 while (and (<= p-ahead k) (< gcount n))
                 finally (return people)))
             (do-shortcut (times euros t1 e1)
               (let* ((k (floor (- r t1) (- times t1)))
                      (t2 (+ t1 (* k (- times t1))))
                      (e2 (+ e1 (* k (- euros e1)))))
                 (calc-tail e2 (- r t2))))
             (calc-tail (euros remaining)
               (if (zerop remaining)
                   (let ((people (next)))
                     (calc-tail (+ euros people) (1- remaining)))))
             (doit (times euros)
               (let ((c (gethash gs h)))
                 (if c
                     (do-shortcut times euros (car c) (cdr c))
                       (setf (gethash gs h) (cons times euros))
                       (let ((people (next)))
                         (if (= (1+ times) r)
                             (+ euros people)
                             (doit (1+ times) (+ euros people)))))))))
      (doit 0 0))))

(loop for i from 1 to (read) do
  (format t "Case #~D: ~D~%"
          (let* ((r (read)) (k (read)) (n (read))
                 (gs (loop repeat n collect (read))))
            (solve r k n gs))))