(in-package :cl-user) (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *opt* #+swank '(optimize (speed 3) (safety 2)) #-swank '(optimize (speed 3) (safety 0) (debug 0))) #+swank (ql:quickload '(:cl-debug-print :fiveam :cp/util) :silent t) #+swank (use-package :cp/util :cl-user) #-swank (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))) #+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader) (macrolet ((def (b) `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b)) (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b)))) (define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(def ,b)) bits)))) (define-int-types 2 4 7 8 15 16 31 32 62 63 64)) (defconstant +mod+ 1000000007) (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))) (declaim (inline println)) (defun println (obj &optional (stream *standard-output*)) (let ((*read-default-float-format* 'double-float)) (prog1 (princ obj stream) (terpri stream)))) ;; BEGIN_INSERTED_CONTENTS (defpackage :cp/bit-basher (:use :cl) (:export #:bit-not! #:bit-fill! #:bit-count #:bit-lshift #:bit-rshift #:bit-shift)) (in-package :cp/bit-basher) ;;; ;;; Complement to the bitwise operations in ANSI CL ;;; (eval-when (:compile-toplevel :load-toplevel :execute) (assert (= sb-vm:n-word-bits 64))) ;; KLUDGE: a variant of DPB that handles a 64-bit word efficiently (defmacro u64-dpb (new spec int) (destructuring-bind (byte s p) spec (assert (eql 'byte byte)) (let ((size (gensym)) (posn (gensym)) (mask (gensym))) `(let* ((,size ,s) (,posn ,p) (,mask (ldb (byte ,size 0) -1))) (logior (the (unsigned-byte 64) (ash (logand ,new ,mask) ,posn)) (the (unsigned-byte 64) (logand ,int (lognot (ash ,mask ,posn))))))))) (defconstant +most-positive-word+ (ldb (byte 64 0) -1)) (defun bit-not! (sb-vector &optional (start 0) end) "Destructively flips the bits in the range [START, END)." (declare (optimize (speed 3)) (simple-bit-vector sb-vector) ((mod #.array-total-size-limit) start) ((or null (mod #.array-total-size-limit)) end)) (setq end (or end (length sb-vector))) (assert (<= start end (length sb-vector))) (multiple-value-bind (start/64 start%64) (floor start 64) (multiple-value-bind (end/64 end%64) (floor end 64) (declare (optimize (safety 0))) (if (= start/64 end/64) (setf (sb-kernel:%vector-raw-bits sb-vector start/64) (u64-dpb (ldb (byte (- end%64 start%64) start%64) (logxor +most-positive-word+ (sb-kernel:%vector-raw-bits sb-vector start/64))) (byte (- end%64 start%64) start%64) (sb-kernel:%vector-raw-bits sb-vector start/64))) (progn (setf (sb-kernel:%vector-raw-bits sb-vector start/64) (dpb (sb-kernel:%vector-raw-bits sb-vector start/64) (byte start%64 0) (logxor +most-positive-word+ (sb-kernel:%vector-raw-bits sb-vector start/64)))) (loop for i from (+ 1 start/64) below end/64 do (setf (sb-kernel:%vector-raw-bits sb-vector i) (logxor +most-positive-word+ (sb-kernel:%vector-raw-bits sb-vector i)))) (unless (zerop end%64) (setf (sb-kernel:%vector-raw-bits sb-vector end/64) (dpb (logxor +most-positive-word+ (sb-kernel:%vector-raw-bits sb-vector end/64)) (byte end%64 0) (sb-kernel:%vector-raw-bits sb-vector end/64)))))))) sb-vector) (declaim (ftype (function * (values simple-bit-vector &optional)) bit-fill!)) (defun bit-fill! (sb-vector bit &optional (start 0) end) "Destructively sets the bits in the range [START, END) to BIT." (declare (optimize (speed 3)) (simple-bit-vector sb-vector) (bit bit) ((mod #.array-total-size-limit) start) ((or null (mod #.array-total-size-limit)) end)) (setq end (or end (length sb-vector))) (assert (<= start end (length sb-vector))) (let ((mask (if (zerop bit) 0 +most-positive-word+))) (multiple-value-bind (start/64 start%64) (floor start 64) (multiple-value-bind (end/64 end%64) (floor end 64) (if (= start/64 end/64) (setf (sb-kernel:%vector-raw-bits sb-vector start/64) (u64-dpb (ldb (byte (- end%64 start%64) 0) mask) (byte (- end%64 start%64) start%64) (sb-kernel:%vector-raw-bits sb-vector start/64))) (progn (setf (sb-kernel:%vector-raw-bits sb-vector start/64) (u64-dpb (sb-kernel:%vector-raw-bits sb-vector start/64) (byte start%64 0) mask)) (loop for i from (+ 1 start/64) below end/64 do (setf (sb-kernel:%vector-raw-bits sb-vector i) mask)) (unless (zerop end%64) (setf (sb-kernel:%vector-raw-bits sb-vector end/64) (dpb mask (byte end%64 0) (sb-kernel:%vector-raw-bits sb-vector end/64))))))))) sb-vector) ;; (count 1 simple-bit-vector) is sufficiently fast on SBCL when handling whole ;; vector. If START or END are specified, however, it is slow as the ;; deftransform for COUNT doesn't work. See ;; https://github.com/sbcl/sbcl/blob/cd7af0d5b15e98e21ace8ef164e0f39019e5ed4b/src/compiler/generic/vm-tran.lisp#L484-L527 (defun bit-count (sb-vector &optional (start 0) end) "Counts 1's in the range [START, END)." (declare (optimize (speed 3)) (simple-bit-vector sb-vector) ((mod #.array-total-size-limit) start) ((or null (mod #.array-total-size-limit)) end)) (setq end (or end (length sb-vector))) (assert (<= start end (length sb-vector))) (multiple-value-bind (start/64 start%64) (floor start 64) (multiple-value-bind (end/64 end%64) (floor end 64) (declare (optimize (safety 0))) (if (= start/64 end/64) (logcount (ldb (byte (- end%64 start%64) start%64) (sb-kernel:%vector-raw-bits sb-vector start/64))) (let ((result 0)) (declare ((mod #.array-total-size-limit) result)) (incf result (logcount (ldb (byte (- 64 start%64) start%64) (sb-kernel:%vector-raw-bits sb-vector start/64)))) (loop for i from (+ 1 start/64) below end/64 do (incf result (logcount (sb-kernel:%vector-raw-bits sb-vector i)))) (unless (zerop end%64) (incf result (logcount (ldb (byte end%64 0) (sb-kernel:%vector-raw-bits sb-vector end/64))))) result))))) (declaim (ftype (function * (values simple-bit-vector &optional)) bit-lshift)) (defun bit-lshift (bit-vector delta &optional result-vector end) "Left-shifts BIT-VECTOR by DELTA bits and fills the new bits with zero. The behaviour is the same as the bit-wise operations in ANSI CL: The result is copied to RESULT-VECTOR; if it is T, BIT-VECTOR is destructively modified; if it is NIL, a new bit-vector of the same length is created. If END is specified, this function shifts only the range [0, END) of BIT-VECTOR and copies it to the range [0, END+DELTA) of RESULT-VECTOR. Note that here `left' means the direction from a smaller index to a larger one, i.e. (bit-lshift #*1011000 2) |-> #*0010110" (declare (optimize (speed 3)) (simple-bit-vector bit-vector) ((or null (eql t) simple-bit-vector) result-vector) ((mod #.array-total-size-limit) delta) ((or null (mod #.array-total-size-limit)) end)) (setq result-vector (etypecase result-vector (null (make-array (length bit-vector) :element-type 'bit :initial-element 0)) ((eql t) bit-vector) (simple-bit-vector result-vector))) (setq end (or end (length bit-vector))) (assert (<= end (length bit-vector))) (replace result-vector bit-vector :start1 (min (length result-vector) delta) :start2 0 :end2 end) (bit-fill! result-vector 0 0 (min delta (length result-vector)))) (declaim (ftype (function * (values simple-bit-vector &optional)) bit-rshift)) (defun bit-rshift (bit-vector delta &optional result-vector) "Right-shifts BIT-VECTOR by DELTA bits and fills the new bits with zero. The behaviour is the same as the bit-wise operations in ANSI CL: The result is copied to RESULT-VECTOR; if it is T, BIT-VECTOR is destructively modified; if it is NIL, a new bit-vector of the same length is created. Note that here `right' means the direction from a larger index to a smaller one, i.e. (bit-rshift #*1011000 2) |-> #*1100000" (declare (optimize (speed 3)) (simple-bit-vector bit-vector) ((or null (eql t) simple-bit-vector) result-vector) ((mod #.array-total-size-limit) delta)) (setq result-vector (etypecase result-vector (null (make-array (length bit-vector) :element-type 'bit :initial-element 0)) ((eql t) bit-vector) (simple-bit-vector result-vector))) (replace result-vector bit-vector :start2 (min delta (length bit-vector))) (bit-fill! result-vector 0 (min (max 0 (- (length bit-vector) delta)) (length result-vector)))) ;; not tested (declaim (ftype (function * (values simple-bit-vector &optional)) bit-shift)) (defun bit-shift (bit-vector delta &optional result-vector) (declare (optimize (speed 3)) (simple-bit-vector bit-vector) ((or null (eql t) simple-bit-vector) result-vector) ((integer #.(- array-total-size-limit) #.array-total-size-limit) delta)) (if (>= delta 0) (bit-lshift bit-vector delta result-vector) (bit-rshift bit-vector (- delta) result-vector))) ;; (defun bit-rotate (bit-vector delta &optional result-vector) ;; (declare (optimize (speed 3)) ;; ((mod #.array-total-size-limit) delta) ;; (simple-bit-vector bit-vector) ;; ((or null simple-bit-vector) result-vector)) ;; (assert (not (eql bit-vector result-vector))) ;; (let* ((end (length bit-vector)) ;; (result-vector (or result-vector (make-array end :element-type 'bit))) ;; (delta (mod delta end))) ;; :unfinished)) ;; BEGIN_USE_PACKAGE (eval-when (:compile-toplevel :load-toplevel :execute) (use-package :cp/bit-basher :cl-user)) (in-package :cl-user) ;;; ;;; Body ;;; (defun main () (let* ((n (read)) (dp (make-array 10001 :element-type 'bit :initial-element 0)) (new-dp (make-array 10001 :element-type 'bit :initial-element 0)) (sum 0)) (setf (aref dp 0) 1) (dotimes (_ n) (let ((w (read))) (incf sum w) (bit-lshift dp w new-dp) (bit-ior dp new-dp t))) (write-line (if (and (evenp sum) (= 1 (aref dp (ash sum -1)))) "possible" "impossible")))) #-swank (main) ;;; ;;; Test and benchmark ;;; #+swank (progn (defparameter *lisp-file-pathname* (uiop:current-lisp-file-pathname)) (setq *default-pathname-defaults* (uiop:pathname-directory-pathname *lisp-file-pathname*)) (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *lisp-file-pathname*)) (defparameter *problem-url* "https://yukicoder.me/problems/no/4")) #+swank (defun gen-dat () (uiop:with-output-file (out *dat-pathname* :if-exists :supersede) (format out ""))) #+swank (defun bench (&optional (out (make-broadcast-stream))) (time (run *dat-pathname* out))) #-swank (eval-when (:compile-toplevel) (when (or (> sb-c::*compiler-warning-count* 0) sb-c::*undefined-warnings*) (error "count: ~D, undefined warnings: ~A" sb-c::*compiler-warning-count* sb-c::*undefined-warnings*))) ;; To run: (5am:run! :sample) #+swank (5am:test :sample (5am:is (equal "possible " (run "3 1 2 3 " nil))) (5am:is (equal "impossible " (run "5 1 2 3 4 5 " nil))) (5am:is (equal "impossible " (run "15 62 8 90 2 24 62 38 64 76 60 30 76 80 74 72 " nil))))