(in-package #:cl-user) ;;; ;;; Init ;;; (eval-when (:compile-toplevel :load-toplevel :execute) ;; #+swank (declaim (optimize (speed 3) (safety 2))) #+swank (declaim (optimize (speed 0) (safety 3) (debug 3))) #-swank (declaim (optimize (speed 3) (safety 0) (debug 0))) #-swank (declaim (sb-ext:muffle-conditions sb-ext:compiler-note)) #-swank (sb-ext:disable-debugger)) ;;; ;;; Reader Macros ;;; (eval-when (:compile-toplevel :load-toplevel :execute) (set-dispatch-macro-character #\# #\f #'(lambda (stream c2 n) (declare (ignore c2 n)) (let ((form (read stream t nil t))) `(lambda (&optional %) (declare (ignorable %)) ,form)))) (set-dispatch-macro-character #\# #\> #'(lambda (stream c2 n) (declare (ignore c2 n)) (let ((form (read stream t nil t))) (declare (ignorable form)) #-swank nil #+swank (if (atom form) `(format *error-output* "~a => ~a~&" ',form ,form) `(format *error-output* "~a => ~a~&" ',form `(,,@form))))))) ;;; ;;; Libraries ;;; ;;; ;;; Macros ;;; (in-package #:cl-user) (defmacro awhen (test &body forms) `(let ((it ,test)) (when it ,@forms))) (defmacro while (test &body body) `(loop while ,test do (progn ,@body))) (defmacro eval-always (&body body) `(eval-when (:compile-toplevel :load-toplevel :execute) ,@body)) ;;; ;;; Body ;;; (in-package #:cl-user) (defmacro %expander-body (form cases) `(ecase ,form ,@(loop for (from . to) in cases collect `(,from ,to)))) (defmacro define-ecase-expander (name assoc-list) `(defmacro ,name (form) `(%expander-body ,form ,',assoc-list))) (eval-always (defconstant +planet-amount+ 100) (defconstant +station-amount+ 8) (defconstant +alpha+ 5)) (deftype coord () '(unsigned-byte 32)) (declaim (inline y x)) (defun make-coord (y x) #+swank (assert (<= 0 y 1000) () "y is out of range") #+swank (assert (<= 0 x 1000) () "x is out of range") (dpb y '#.(byte 16 16) x)) (defun y (c) (ldb (byte 16 16) c)) (defun x (c) (ldb (byte 16 0) c)) #+nil (y (make-coord 1000 0)) #+nil (x (make-coord 0 1000)) (defstruct (input (:conc-name in-)) (planets nil :type (simple-array coord (*)))) (defun read-input () (let ((n (read)) (m (read)) (planets (make-array +planet-amount+ :element-type 'coord))) (declare (ignore n m)) (dotimes (i +planet-amount+) (setf (aref planets i) (make-coord (read) (read)))) (make-input :planets planets))) (deftype stations () '(simple-array coord (*))) (deftype orders () "planetsはid0〜99, stationsはid100〜107 最初と最後はid0でないといけない" '(simple-array fixnum (*))) (defun make-station-coords (input) ;; TODO いい感じの場所に置く (declare (ignore input)) (let ((res (make-array +station-amount+ :element-type 'coord))) (dotimes (i +station-amount+) (setf (aref res i) (make-coord (random 1001) (random 1001)))) res)) (defun make-orders (input stations) ;; TODO ステーションを使う ;; TODO 各頂点間の距離を求めてTSPを解く (declare (ignore input stations)) (let* ((res (make-array (1+ +planet-amount+) :element-type 'fixnum))) (declare (orders res)) (loop for i below +planet-amount+ do (setf (aref res i) i)) (setf (aref res +planet-amount+) 0) res)) (defun print-ans (stations orders) (declare (orders orders) (stations stations)) ;; stations (sb-int:dovector (c stations) (format t "~a ~a~%" (y c) (x c))) (format t "~a ~%" (length orders)) ;; orders (sb-int:dovector (o orders) (multiple-value-bind (type id) (if (< o +planet-amount+) (values 1 o) (values 2 (- o +planet-amount+))) (format t "~a ~a~%" type (1+ id))))) (defun main () (let* ((input (read-input)) (stations (make-station-coords input)) (orders (make-orders input stations))) (print-ans stations orders))) #-swank (main) ;;; ;;; Debug ;;; ;; Raise error on warning at compile time #+(and sbcl (not swank)) (eval-when (:compile-toplevel) (when (or (plusp sb-c::*compiler-warning-count*) sb-c::*undefined-warnings*) (error "compiler-error-count:~a, undefined warnings:~a" sb-c::*compiler-warning-count* sb-c::*undefined-warnings*))) #+swank (defun run-sample (infile outfile &optional (out *standard-output*) (vis t)) (let ((args (append (list "tester.dll" "judge" "-i" infile "-o" outfile) (when vis (list "-v" "vis.png"))))) (with-open-file (*standard-input* infile :direction :input) (with-open-file (*standard-output* outfile :direction :output :if-exists :supersede) (main)) (sb-ext:run-program "dotnet" args :output out :search t :error *error-output*)))) #+swank (defun (infile outfile) (sb-ext:run-program "dotnet" (list "vis.dll" "judge" "-i" infile "-o" outfile) :output out :search t :error *error-output*))