Submission #6147085


Source Code Expand

;; -*- coding: utf-8 -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter OPT
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0)))
  #+swank (progn (ql:quickload '(:cl-debug-print :fiveam))
                 (shadow :run)
                 (use-package :fiveam))
  #-swank (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil (values) t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

;; BEGIN_INSERTED_CONTENTS
;; Scheme-style named let
(defmacro nlet (name args &body body)
  (labels ((ensure-list (x) (if (listp x) x (list x))))
    (let ((args (mapcar #'ensure-list args)))
      `(labels ((,name ,(mapcar #'car args) ,@body))
         (,name ,@(mapcar #'cadr args))))))

(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

(defun main ()
  (declare #.OPT (inline sort))
  (let* ((n (read))
         (m (read))
         (xs (make-array n :element-type 'uint32))
         (mod-table (make-array m :element-type 'list :initial-element nil))
         (res 0))
    (declare (uint32 res))
    (dotimes (i n) (setf (aref xs i) (read-fixnum)))
    (setf xs (sort xs #'<))
    (loop for x across xs
          do (push x (aref mod-table (mod x m))))
    (labels ((frob (list pairs rest)
               (cond ((null list)
                      (values pairs rest))
                     ((null (cdr list))
                      (frob (cdr list) pairs (cons (car list) rest)))
                     (t (let ((num1 (car list))
                              (num2 (cadr list)))
                          (declare (uint32 num1 num2))
                          (if (= num1 num2)
                              (frob (cddr list) (cons num1 (cons num2 pairs)) rest)
                              (frob (cdr list) pairs (cons (car list) rest))))))))
      (loop for rem from 1 below m
            while (< rem (- m rem))
            do (multiple-value-bind (pairs1 rest1) (frob (aref mod-table rem) nil nil)
                 (multiple-value-bind (pairs2 rest2) (frob (aref mod-table (- m rem)) nil nil)
                   (declare (list pairs1 rest1 pairs2 rest2))
                   ;; guarantees |rest1| <= |rest2|
                   (let ((minlen (min (length rest1) (length rest2))))
                     (when (> (length rest1) minlen)
                       (rotatef pairs1 pairs2)
                       (rotatef rest1 rest2))
                     (incf res minlen)
                     (setf rest2 (nthcdr minlen rest2))
                     (dolist (_ rest2)
                       (unless (null pairs1)
                         (incf res)
                         (pop pairs1)))
                     (incf res (floor (length pairs1) 2))
                     (incf res (floor (length pairs2) 2))))))
      (incf res (floor (length (aref mod-table 0)) 2))
      (when (evenp m)
        (incf res (floor (length (aref mod-table (floor m 2))) 2)))
      (println res))))

#-swank(main)

Submission Info

Submission Time
Task D - Pair Cards
User sansaqua
Language Common Lisp (SBCL 1.1.14)
Score 700
Code Size 4920 Byte
Status AC
Exec Time 145 ms
Memory 27240 KB

Judge Result

Set Name sample all
Score / Max Score 0 / 0 700 / 700
Status
AC × 2
AC × 34
Set Name Test Cases
sample sample-01.txt, sample-02.txt
all sample-01.txt, sample-02.txt, 01-01.txt, 01-02.txt, 01-03.txt, 01-04.txt, 01-05.txt, 01-06.txt, 01-07.txt, 01-08.txt, 01-09.txt, 01-10.txt, 01-11.txt, 01-12.txt, 01-13.txt, 01-14.txt, 01-15.txt, 01-16.txt, 01-17.txt, 01-18.txt, 01-19.txt, 01-20.txt, 01-21.txt, 01-22.txt, 01-23.txt, 01-24.txt, 01-25.txt, 01-26.txt, 01-27.txt, 01-28.txt, 01-29.txt, 01-30.txt, sample-01.txt, sample-02.txt
Case Name Status Exec Time Memory
01-01.txt AC 118 ms 23268 KB
01-02.txt AC 142 ms 25188 KB
01-03.txt AC 142 ms 25184 KB
01-04.txt AC 143 ms 25188 KB
01-05.txt AC 142 ms 25184 KB
01-06.txt AC 144 ms 27236 KB
01-07.txt AC 145 ms 27236 KB
01-08.txt AC 144 ms 27232 KB
01-09.txt AC 144 ms 27236 KB
01-10.txt AC 144 ms 27232 KB
01-11.txt AC 144 ms 27240 KB
01-12.txt AC 131 ms 27232 KB
01-13.txt AC 131 ms 27236 KB
01-14.txt AC 142 ms 25188 KB
01-15.txt AC 143 ms 25188 KB
01-16.txt AC 143 ms 27240 KB
01-17.txt AC 143 ms 27232 KB
01-18.txt AC 143 ms 27240 KB
01-19.txt AC 143 ms 27236 KB
01-20.txt AC 144 ms 27236 KB
01-21.txt AC 142 ms 25184 KB
01-22.txt AC 143 ms 25188 KB
01-23.txt AC 143 ms 27236 KB
01-24.txt AC 143 ms 27236 KB
01-25.txt AC 143 ms 27236 KB
01-26.txt AC 145 ms 27232 KB
01-27.txt AC 130 ms 25188 KB
01-28.txt AC 117 ms 23140 KB
01-29.txt AC 116 ms 23140 KB
01-30.txt AC 116 ms 23140 KB
sample-01.txt AC 115 ms 23136 KB
sample-02.txt AC 115 ms 23144 KB