結果

問題 No.1077 Noelちゃんと星々4
ユーザー EnderedEndered
提出日時 2020-06-12 22:25:39
言語 Common Lisp
(sbcl 2.3.8)
結果
TLE  
実行時間 -
コード長 5,530 bytes
コンパイル時間 1,325 ms
コンパイル使用メモリ 42,844 KB
実行使用メモリ 64,756 KB
最終ジャッジ日時 2023-09-06 10:42:14
合計ジャッジ時間 5,203 ms
ジャッジサーバーID
(参考情報)
judge14 / judge11
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 47 ms
64,756 KB
testcase_01 AC 63 ms
49,560 KB
testcase_02 TLE -
testcase_03 -- -
testcase_04 -- -
testcase_05 -- -
testcase_06 -- -
testcase_07 -- -
testcase_08 -- -
testcase_09 -- -
testcase_10 -- -
testcase_11 -- -
testcase_12 -- -
testcase_13 -- -
testcase_14 -- -
testcase_15 -- -
testcase_16 -- -
testcase_17 -- -
testcase_18 -- -
testcase_19 -- -
testcase_20 -- -
testcase_21 -- -
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 06 SEP 2023 10:42:07 AM):
; processing (UNLESS (MEMBER :CHILD-SBCL ...) ...)
; processing (DEFMACRO DPLINE ...)
; processing (DEFMACRO DPHASH ...)
; processing (DEFUN SPLIT ...)
; processing (DEFMACRO COLLECT-TIMES ...)
; processing (DEFUN READ-TIMES ...)
; processing (DEFMACRO AIF ...)
; processing (DEFMACRO AWHEN ...)
; processing (DEFUN COMULATIVE ...)
; processing (DEFUN BINARY-SEARCH ...)
; processing (DEFUN ARITHMETIC-MEAN ...)
; processing (DEFVAR +MOD+ ...)
; processing (DEFUN RANGE-0-N ...)
; processing (DEFUN RANGE-1-N ...)
; processing (DEFUN RANGE-A-B ...)
; processing (DEFUN MAP-0-N ...)
; processing (DEFUN MAP-1-N ...)
; processing (DEFUN MAP-A-B ...)
; processing (DEFUN READ-STRING ...)
; processing (DEFUN MERGE-SORT ...)
; processing (DEFUN GROUP ...)
; processing (DEFUN NEARBY ...)
; processing (DEFUN MAIN ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN MAIN
;     (DEFUN MAIN (N LST)
;       (DPHASH FUNC
;           (LAST LST)
;         (IF LST
;             (MIN
;              (IF #
;                  #
;                  #)
;              (+ # #))
;             0))
;       (FUNC 0 LST))
; --> PROGN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA 
; ==>
;   #'(SB-INT:NAMED-LAMBDA MAIN
;         (N LST)
;       (DECLARE (SB-C::TOP-LEVEL-FORM))
;       (BLOCK MAIN
;         (DPHASH FUNC
;             (LAST LST)
;           (IF LST
;               (MIN # #)
;               0))
;         (FUNC 0 LST)))
; 
; caught STYLE-WARNING:
;   The variable N is defined but never used.

; processing (LET (#) ...); 
; compilation unit finished
;   caught 1 STYLE-WARNING condition


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

ソースコード

diff #

#-swank
(unless (member :child-sbcl *features*)
  "I refered from https://competitive12.blogspot.com/2020/03/common-lisp.html thank you!"
  (quit
   :unix-status
   (process-exit-code
    (run-program *runtime-pathname*
                 `("--control-stack-size" "256MB"
                   "--noinform" "--disable-ldb" "--lose-on-corruption" "--end-runtime-options"
                   "--eval" "(push :child-sbcl *features*)"
                   "--script" ,(namestring *load-pathname*))
                 :output t :error t :input t))))
(defmacro dpline (name args memo-size &body body)
  (let ((memo (gensym)))
    `(let ((,memo (make-array ,memo-size :initial-element nil)))
       (defun ,name ,args
         (or (aref ,memo ,@args)
             (setf (aref ,memo ,@args)
                   ,@body))))))

(defmacro dphash (name args &body expr)
  `(let ((table (make-hash-table :test #'equal)))
     (defun  ,name ,args 
       (or (gethash (list ,@args) table)
           (setf (gethash (list ,@args) table)
                 (progn 
                   ,@expr))))))

(defun split (x str)
  (let ((pos (search x str))
        (size (length x)))
    (if pos
        (cons (subseq str 0 pos)
              (split x (subseq str (+ pos size))))
        (list str))))

(defmacro collect-times (time body)
  `(loop repeat ,time collect ,body))

(defun read-times (time)
  (collect-times time (read)))

(defmacro aif (expr then else)
  `(let ((it ,expr))
     (if it ,then ,else)))

(defmacro awhen (expr &rest then)
  `(aif ,expr (progn ,@then) nil))

(defun comulative (function list &key base)
  (if base
      (comulative function (cons base list))
      (do ((lst (cdr list) (cdr lst))
           (acc (list (car list))))
          ((null lst) (reverse acc))
        (push (funcall function (car acc) (car lst)) acc))))

(defun binary-search (function left right
                      &optional
                        (eps 1)
                        (average-function (lambda (x y) (ash (+ x y) -1))))
  (if (<= (abs (- left right)) eps)
      right
      (let ((mid (funcall average-function left right)))
        (if (funcall function mid)
            (binary-search function left mid eps average-function)
            (binary-search function mid right eps average-function)))))

(defun arithmetic-mean (&rest body)
  (/ (apply #'+ body) (length body)))

(defvar +MOD+ (+ (expt 10 9) 7))

(defun range-0-n (n &optional (step 1))
  (loop for i from 0 below n by step collect i))

(defun range-1-n (n &optional (step 1))
  (loop for i from 1 below n by step collect i))

(defun range-a-b (a b &optional (step 1))
  (loop for i from a below b by step collect i))

(defun map-0-n (function n &optional (step 1))
  (mapcar function (range-0-n n step)))

(defun map-1-n (function n &optional (step 1))
  (mapcar function (range-1-n n step)))

(defun map-a-b (function a b &optional (step 1))
  (mapcar function (range-a-b a b step)))

(defun read-string (&optional (stream *standard-input*))
  (labels ((is-empty (x)
             (or (char= x #\space) (char= x #\newline))))
    (loop for char = (read-char stream)
          with result
          when (and result (is-empty char))
            do (return (concatenate 'string (nreverse result)))
          when (null (is-empty char))
            do (push char result))))

(defun merge-sort (lst &optional (compare #'<))
  (let ((turn 0))
    (labels ((merge-list (a b a-length b-length)
               (cond ((zerop a-length) b)
                     ((zerop b-length) a)
                     ((funcall compare (car b) (car a))
                      (incf turn a-length)
                      (cons (car b)
                            (merge-list a (cdr b) a-length (1- b-length))))
                     (t
                      (cons (car a)
                            (merge-list (cdr a) b (1- a-length) b-length)))))
             (f (lst length)
               (if (= length 1)
                   lst
                   (let ((mid (ash length -1)))
                     (merge-list (f (subseq lst 0 mid) mid)
                                 (f (subseq lst mid) (- length mid))
                                 mid
                                 (- length mid))))))
      (values (f lst (length lst)) turn))))

(defun group (lst &optional (test #'eql) (key nil))
  (let ((table (make-hash-table :test test)))
    (mapc (lambda (x)
            (push x (gethash (if key (funcall key x) x) table)))
          lst)
    (loop for value being each hash-value in table
          collect value)))

(defun nearby (&rest args)
  (let ((current (subseq args 0 (ash (length args) -1)))
        (validator (subseq args (ash (length args) -1)))
        (res nil))
    (labels ((check ()
               (every (lambda (x y) (and (<= 0 x) (< x y)))
                      current validator))
             (f (lst)
               (unless lst (return-from f))
               (let ((x (car lst)))
                 (setf (car lst) (1+ x))
                 (when (check) (push (copy-list current) res))
                 (setf (car lst) (1- x))
                 (when (check) (push (copy-list current) res))
                 (setf (car lst) x))
               (f (cdr lst))))
      (f current)
      res)))

(defun main (n lst)
  (dphash func (last lst)
    (if lst
        (min
         (if (< last 10000) (func (1+ last) lst) (expt 10 10))
         (+ (abs (- last (car lst))) (func last (cdr lst))))
        0))
  (func 0 lst))

#-swank
(let ((n (read)))
  (format t "~a~&" (main n (read-times n))))

0