Submission #7688392


Source Code Expand

Copy
;; -*- coding: utf-8 -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:defconstant-eqx OPT
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0))
    #'equal)
  #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil nil t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
;; originally written by g000001 (See https://g000001.cddddr.org/1248011028)
(declaim (inline (setf nthcdr*)))
(defun (setf nthcdr*) (subst pos lst)
  (case pos
    (0 (if (null subst)
           lst
           (progn (rplaca lst (car subst))
                  (rplacd lst (cdr subst)))))
    (1 (rplacd lst subst))
    (otherwise
     (let ((suffix (nthcdr (1- pos) lst)))
       (when suffix
         (rplacd suffix subst))))))

(declaim (inline prefix!))
(defun prefix! (list end)
  (setf (nthcdr* end list) nil)
  list)

;; Should we do this with UNWIND-PROTECT?
(defmacro with-buffered-stdout (&body body)
  "Buffers all outputs to *STANDARD-OUTPUT* in BODY and flushes them to
*STANDARD-OUTPUT* after BODY has been done (without error). Note that only
BASE-CHAR is allowed."
  (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 (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  (declare #.OPT)
  (macrolet ((%read-byte ()
               `(the (unsigned-byte 8)
                     #+swank (char-code (read-char in nil #\Nul))
                     #-swank (sb-impl::ansi-stream-read-byte in nil #.(char-code #\Nul) nil))))
    (let* ((minus nil)
           (result (loop (let ((byte (%read-byte)))
                           (cond ((<= 48 byte 57)
                                  (return (- byte 48)))
                                 ((zerop byte) ; #\Nul
                                  (error "Read EOF or #\Nul."))
                                 ((= byte #.(char-code #\-))
                                  (setf minus t)))))))
      (declare ((integer 0 #.most-positive-fixnum) result))
      (loop
        (let* ((byte (%read-byte)))
          (if (<= 48 byte 57)
              (setq result (+ (- byte 48)
                              (* 10 (the (integer 0 #.(floor most-positive-fixnum 10)) result))))
              (return (if minus (- result) result))))))))

(defmacro dbg (&rest forms)
  #+swank
  (if (= (length forms) 1)
      `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
      `(format *error-output* "~A => ~A~%" ',forms `(,,@forms)))
  #-swank (declare (ignore forms)))

(defmacro define-int-types (&rest bits)
  `(progn
     ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))) bits)
     ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))) bits)))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64)

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

(defconstant +mod+ 1000000007)

;;;
;;; Body
;;;

;;; from SBCL's implementation of MERGE

(declaim (inline merge-lists*))
;;; Destructively merge LIST-1 with LIST-2 (given that they're already
;;; sorted w.r.t. PRED-FUN on KEY-FUN, giving output sorted the same
;;; way). In the resulting list, elements of LIST-1 are guaranteed to
;;; come before equal elements of LIST-2.
;;;
;;; Enqueues the values in the right order in HEAD's cdr, and returns
;;; the merged list.
(defun merge-lists* (head list1 list2 test key &aux (tail head))
  (declare (type cons head list1 list2)
           (type function test key)
           (optimize speed))
  (declare (dynamic-extent test key))
  (let ((key1 (funcall key (car list1)))
        (key2 (funcall key (car list2))))
    (macrolet ((merge-one (l1 k1 l2)
                 `(progn
                    (setf (cdr tail) ,l1
                          tail       ,l1)
                    (let ((rest (cdr ,l1)))
                      (cond (rest
                             (setf ,l1 rest
                                   ,k1 (funcall key (first rest))))
                            (t
                             (setf (cdr ,l1) ,l2)
                             (return (cdr head))))))))
      (loop
       (if (funcall test key2           ; this way, equivalent
                         key1)          ; values are first popped
           (merge-one list2 key2 list1) ; from list1
           (merge-one list1 key1 list2))))))

;;; Convenience wrapper for CL:MERGE
(declaim (inline merge-lists))
(defun merge-lists (list1 list2 test key)
  (cond ((null list1)
         list2)
        ((null list2)
         list1)
        (t
         (let ((head (cons nil nil)))
           (declare (dynamic-extent head))
           (merge-lists* head list1 list2 test key)))))

(declaim (inline zeta-subtransform!))
(defun zeta-subtransform! (vector &optional (plus #'+))
  (declare (vector vector))
  (let* ((n (length vector))
         ;; cardinality of the underlying set
         (card (- (integer-length n) 1)))
    (assert (= 1 (logcount n)))
    (dotimes (i card)
      (let ((mask (ash 1 i)))
        (dotimes (j n)
          (unless (zerop (logand j mask))
            (setf (aref vector j)
                  (funcall plus
                           (aref vector j)
                           (aref vector (logxor j mask))))))))
    vector))

(declaim (inline moebius-subtransform!))
(defun moebius-subtransform! (vector &optional (minus #'-))
  (declare (vector vector))
  (let* ((n (length vector))
         (card (- (integer-length n) 1)))
    (assert (= 1 (logcount n)))
    (dotimes (i card)
      (let ((mask (ash 1 i)))
        (dotimes (j n)
          (unless (zerop (logand j mask))
            (setf (aref vector j)
                  (funcall minus
                           (aref vector j)
                           (aref vector (logxor j mask))))))))
    vector))


;; 添え字集合∪添え字集合で大きいほう2つを残すという操作を⊕とすると、結合的かつ可換。
;; つまり、F(S) = ⊕_{T ⊆ S} f(T)を求めれば良いけど、fは何?
;; → f(T) = {T}か。
;; これでi∨j ⊆ K に対する最大値は求まる。
;; i∨j <= K ⇔ k∈[K]が存在してi∨j = k
;; ⇒ k∈[K]が存在してi∨j⊆k
;; 最後は逆も成り立つ。k∈[K]が与えられたとき、任意のl⊆kについてl∈Kだから

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (power (expt 2 n))
         (as (make-array power :element-type 'uint32))
         (dp (make-array power :element-type 'list)))
    (declare ((integer 1 18) n))
    (dotimes (i power)
      (setf (aref as i) (read-fixnum)
            (aref dp i) (list i)))
    (zeta-subtransform!
     dp
     (lambda (set1 set2)
       (let ((union (merge-lists (copy-list set1)
                                 (copy-list set2)
                                 #'>
                                 (lambda (x) (aref as x)))))
         (prefix! union 2))))
    (let ((res 0))
      (declare (uint32 res))
      (with-buffered-stdout
        (loop for x from 1 below power
              for (idx1 idx2) = (aref dp x)
              do (setf res (max res (+ (aref as idx1) (aref as idx2))))
                 (println res))))))

#-swank (main)

Submission Info

Submission Time
Task E - Or Plus Max
User sansaqua
Language Common Lisp (SBCL 1.1.14)
Score 700
Code Size 7885 Byte
Status
Exec Time 499 ms
Memory 89568 KB

Judge Result

Set Name Score / Max Score Test Cases
Sample 0 / 0 sample_01.txt, sample_02.txt, sample_03.txt
All 700 / 700 sample_01.txt, sample_02.txt, sample_03.txt, sample_01.txt, sample_02.txt, sample_03.txt, subtask_1_01.txt, subtask_1_02.txt, subtask_1_03.txt, subtask_1_04.txt, subtask_1_05.txt, subtask_1_06.txt, subtask_1_07.txt, subtask_1_08.txt, subtask_1_09.txt, subtask_1_10.txt, subtask_1_11.txt, subtask_1_12.txt, subtask_1_13.txt, subtask_1_14.txt, subtask_1_15.txt, subtask_1_16.txt, subtask_1_17.txt, subtask_1_18.txt, subtask_1_19.txt, subtask_1_20.txt, subtask_1_21.txt, subtask_1_22.txt, subtask_1_23.txt, subtask_1_24.txt, subtask_1_25.txt, subtask_1_26.txt, subtask_1_27.txt, subtask_1_28.txt, subtask_1_29.txt
Case Name Status Exec Time Memory
sample_01.txt 238 ms 28896 KB
sample_02.txt 83 ms 16864 KB
sample_03.txt 79 ms 16868 KB
subtask_1_01.txt 85 ms 16872 KB
subtask_1_02.txt 79 ms 16872 KB
subtask_1_03.txt 113 ms 33380 KB
subtask_1_04.txt 80 ms 16868 KB
subtask_1_05.txt 83 ms 16868 KB
subtask_1_06.txt 94 ms 21096 KB
subtask_1_07.txt 93 ms 21092 KB
subtask_1_08.txt 79 ms 16868 KB
subtask_1_09.txt 81 ms 16868 KB
subtask_1_10.txt 93 ms 25188 KB
subtask_1_11.txt 81 ms 16868 KB
subtask_1_12.txt 121 ms 35684 KB
subtask_1_13.txt 85 ms 16868 KB
subtask_1_14.txt 494 ms 89568 KB
subtask_1_15.txt 79 ms 16868 KB
subtask_1_16.txt 498 ms 89312 KB
subtask_1_17.txt 399 ms 87784 KB
subtask_1_18.txt 460 ms 89184 KB
subtask_1_19.txt 471 ms 89312 KB
subtask_1_20.txt 492 ms 89312 KB
subtask_1_21.txt 499 ms 89316 KB
subtask_1_22.txt 495 ms 89312 KB
subtask_1_23.txt 495 ms 89316 KB
subtask_1_24.txt 411 ms 87776 KB
subtask_1_25.txt 464 ms 89192 KB
subtask_1_26.txt 467 ms 89316 KB
subtask_1_27.txt 489 ms 89320 KB
subtask_1_28.txt 493 ms 89312 KB
subtask_1_29.txt 493 ms 89316 KB