結果

問題 No.1491 銀将
コンテスト
ユーザー motoshira
提出日時 2021-04-30 22:06:26
言語 Common Lisp
(sbcl 2.5.0)
結果
AC  
実行時間 11 ms / 1,000 ms
コード長 8,632 bytes
コンパイル時間 1,588 ms
コンパイル使用メモリ 52,400 KB
実行使用メモリ 23,680 KB
最終ジャッジ日時 2024-07-19 01:31:44
合計ジャッジ時間 2,482 ms
ジャッジサーバーID
（参考情報） 		judge5 / judge3
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 3
other AC * 16
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 19 JUL 2024 01:31:41 AM):

; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.138

ソースコード

diff # 

(in-package :cl-user)

;;------------------------------Preferences------------------------------

(eval-when (:compile-toplevel :load-toplevel :execute)
  #+swank (declaim (optimize (speed 3) (safety 2)))
  #-swank (declaim (optimize (speed 3) (safety 0) (debug 0)))
  #+swank (load "~/Dropbox/Code/atcoder/ac-tools/act.lisp")
  #+swank (ql:quickload :prove)
  #-swank (declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
  #-swank (sb-ext:disable-debugger)
  (pushnew :inline-generic-funcion *features*))

#-swank
(eval-when (:compile-toplevel :load-toplevel)
  (defparameter *eval-last* nil))

(eval-when (:compile-toplevel :load-toplevel)
  (set-dispatch-macro-character
   #\# #\e #'(lambda (s c n)
               (declare (ignore c n))
               (let ((form (read s)))
                 #+swank form
                 #-swank
                 `(eval-when (:compile-toplevel :load-toplevel)
                    (pushnew ',form *eval-last* :test #'equal))))))

;;---------------------------------Body---------------------------------

#e
(defparameter *dx-dy*
  '((-1 1)
    (0 1)
    (1 1)
    (-1 -1)
    (1 -1)))

#e
(defun main ()
  (let ((n (read)))
    (println (if (zerop n)
                 1
                 (+ 6
                    (* 4 n (1- n))
                    (* 4 (1- n)))))))



;;---------------------------------Utils---------------------------------

(defmacro m-labels (((fn-name args &body fn-body)) &body body)
  (let ((val (gensym))
        (memo (gensym)))
    `(let ((,memo (make-hash-table :test #'equal)))
       (labels ((,fn-name ,args
                  (let ((,val (gethash (list  ,@args) ,memo)))
                    (when ,val (return-from ,fn-name ,val))
                    (setf (gethash (list ,@args) ,memo)
                          (progn
                            ,@fn-body)))))
         ,@body))))


;; Queue

(defstruct queue
  (front nil :type list)
  (rear nil :type list))

(defmethod queue-empty-p ((q queue))
  (and (null (queue-front q))
       (null (queue-rear q))))

(defmethod queue-pop ((q queue))
  (when (queue-empty-p q)
    (error "queue is empty"))
  (when (null (queue-front q))
    (setf (queue-front q) (reverse (queue-rear q))
          (queue-rear q) nil))
  (pop (queue-front q)))

(defmethod queue-push (item (q queue))
  (push item (queue-rear q)))



(defconstant +inf+ #.(ash 1 60))

(defmacro define-int-types (&rest ints)
  `(progn
     ,@(mapcar (lambda (int) `(deftype ,(intern (format nil "UINT~a" int)) () '(unsigned-byte ,int))) ints)
     ,@(mapcar (lambda (int) `(deftype ,(intern (format nil "INT~a" int)) () '(signed-byte ,int))) ints)))

(define-int-types 2 4 8 16 30 31 32 60 62 64 120)

(defmacro dbg (&rest forms)
  #-swank (declare (ignore forms))
  #+swank `(format *error-output* "~a => ~a~&" ',forms `(,,@forms)))

(defmacro do-rep (count &body body) `(loop repeat ,count do ,@body))

(defmacro nlet (name binds &body body)
  `(labels ((,name (,@(mapcar #'first binds))
              ,@body))
     (,name ,@(mapcar #'second binds))))

(defmacro dotimes! ((var count &optional (index-origin 0) (unroll 10)) &body body)
  #+swank (declare (ignorable unroll))
  #+swank `(loop for ,var from ,index-origin below (+ ,count ,index-origin)
                 do ,@body)
  #-swank
  (sb-int:with-unique-names (cnt q r)
    `(multiple-value-bind (,q ,r) (truncate ,count ,unroll)
       (declare (fixnum ,q ,r))
       (do ((,cnt 0 (the fixnum (1+ ,cnt))) (,var ,index-origin))
           ((>= ,cnt ,q) (loop repeat ,r do (progn ,@body (setf (the fixnum ,var) (the fixnum (1+ ,var))))))
         (declare (fixnum ,cnt ,var))
         ,@(loop repeat unroll append `(,@body (setf (the fixnum ,var) (the fixnum (1+ ,var)))))))))

(declaim (ftype (function (sequence) simple-base-string) unwrap))
(defun unwrap (sequence)
  ;; e.g. (unwrap (list 1 2 3 4 5)) => "1 2 3 4 5"
  (let ((*standard-output* (make-string-output-stream :element-type 'base-char)))
    (let ((init nil))
      (declare (boolean init))
      (map nil
           (lambda (x)
             (when init
               (princ #\space))
             (setq init t)
             (princ x))
           sequence))
    (coerce (get-output-stream-string *standard-output*) 'simple-base-string)))

(defmacro with-buffered-stdout (&body body)
  ;; Quoted from: https://competitive12.blogspot.com/2020/03/common-lisp.html
  (let ((out (gensym)))
    `(let ((,out (make-string-output-stream :element-type 'base-char)))
       (let ((*standard-output* ,out))
         ,@body)
       (write-string (get-output-stream-string ,out)))))

(declaim (inline read-fixnum read-nums println))
(defun read-fixnum (&optional (in *standard-input*))
  ;; Ref: https://competitive12.blogspot.com/2020/03/common-lisp.html
  ;;        partially modified
  (declare (inline read-byte))
  (flet ((%read-byte ()
           (the fixnum #+swank (char-code (read-char in nil #\Nul))
                       #-swank (read-byte in nil #.(char-code #\Nul))))
         (%byte->num (b)
           (the fixnum (- b #.(char-code #\0))))
         (%digit-p (byte)
           (declare (fixnum byte))
           (<= #.(char-code #\0) byte #.(char-code #\9))))
    (declare (inline %read-byte %byte->num %digit-p))
    (let ((minus nil)
          (res 0))
      (declare (boolean minus) (fixnum res))
      (loop for byte of-type fixnum = (%read-byte)
            do (cond
                 ((%digit-p byte)
                  (setf res (%byte->num byte))
                  (return))
                 ((= byte #.(char-code #\Nul))
                  (error "EOF"))
                 ((= byte #.(char-code #\-))
                  (setf minus t))))
      (loop for byte of-type fixnum = (%read-byte)
            do (cond
                 ((%digit-p byte)
                  (setf res (the fixnum (+ (* res 10) (%byte->num byte)))))
                 (t (return))))
      (the fixnum (if minus (- res) res)))))

(defun read-nums (count &optional (element-type '(simple-array fixnum (*))))
  (declare (fixnum count))
  (coerce (loop repeat count collect (read)) element-type))

(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 obj
      (princ obj stream)
      (terpri stream))))

(defun read-base-char (&optional (in *standard-input*) (eof #\Newline))
  (declare (inline read-byte)
           #-swank (sb-kernel:ansi-stream in)
           (base-char eof))
  #+swank (coerce (read-char in nil eof) 'base-char)
  #-swank
  (the base-char (code-char (the (integer 0 127) (read-byte in nil (char-code eof))))))

(defmacro read-line! (simple-base-string &optional (in *standard-input*) (term #\Newline))
  "Read characters and DESTRUCTIVELY fill SIMPLE-BASE-STRING with them."
  (let ((n (gensym))
        (c (gensym))
        (i (gensym)))
    `(locally (declare (inline read-base-char))
       (let ((,n (length ,simple-base-string)))
         (declare (fixnum ,n))
         (loop for ,c of-type base-char = (read-base-char ,in #\Newline)
               with ,i of-type fixnum = 0
               until (char= ,c ,term)
               do (unless (< ,i ,n)
                    (error "Reached the end of ~a." ',simple-base-string))
                  (setf (schar ,simple-base-string ,i)
                        ,c)
                  (incf ,i))))))

(defun split (string &optional (separator #\space))
  (declare (base-string string)
           (base-char separator))
  (let ((pos (position separator string)))
    (if pos
        (cons (subseq string 0 pos)
              (split (subseq string (1+ pos))
                     separator))
        (list string))))

(defmacro -> (init &rest forms)
  `(block nil
     ,(reduce (lambda (xs ys)
                (cond
                  ((atom ys) `(,ys ,xs))
                  ((eq 'as-> (first ys)) `(let ((,(second ys) ,xs))
                                            ,@(nthcdr 2 ys)))
                  ((find :@ ys) (subst xs :@ ys))
                  (t `(,(first ys) ,xs ,@(rest ys)))))
              forms :initial-value init)))

(defmacro ->> (init &rest forms)
  `(block nil
     ,(reduce (lambda (xs ys)
                (cond
                  ((atom ys) `(,ys ,xs))
                  ((find :@ ys) (subst xs :@ ys))
                  (t `(,@ys ,xs))))
              forms :initial-value init)))

(define-modify-macro maxf (var) max)
(define-modify-macro minf (var) min)


#-swank
(macrolet ((%expand ()
             `(eval-when (:compile-toplevel :load-toplevel)
                (declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
                ,@(reverse *eval-last*))))
  (%expand))

#-swank (main)
0