Submission #5787152

---

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 (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Unfinished. Use fft-recursive.lisp instead.
;;;

(deftype fft-float () 'double-float)

(declaim (inline power2-p))
(defun power2-p (x)
  "Checks if X is a power of 2."
  (zerop (logand x (- x 1))))

(declaim (inline general-dft!))
(defun general-dft! (f sign)
  (declare ((array (complex fft-float) (*)) f)
           ((integer -1 1) sign))
  (prog1 f
    (let* ((n (length f))
           (theta (* sign (/ (coerce (* 2 pi) 'fft-float) n))))
      (declare (fft-float theta))
      (assert (power2-p n))
      (do ((m n (ash m -1)))
          ((= m 1))
        (declare ((integer 0 #.most-positive-fixnum) m))
        (let ((mh (ash m -1)))
          (declare ((integer 0 #.most-positive-fixnum) mh))
          (dotimes (i mh)
            (let ((w (cis (* i theta))))
              (do ((j i (+ j m)))
                  ((>= j n))
                (declare ((integer 0 #.most-positive-fixnum) j))
                (let* ((k (+ j mh))
                       (xt (- (aref f j) (aref f k))))
                  (declare ((integer 0 #.most-positive-fixnum) k))
                  (incf (aref f j) (aref f k))
                  (setf (aref f k) (* w xt))))))
          (setq theta (* theta 2))))
      (let ((i 0))
        (declare ((integer 0 #.most-positive-fixnum) i))
        (loop for j from 1 below (- n 1)
              do (loop for k of-type (integer 0 #.most-positive-fixnum)
                          = (ash n -1) then (ash k -1)
                       while (> k (setq i (logxor i k))))
                 (when (< j i)
                   (rotatef (aref f i) (aref f j))))))))

(declaim (inline dft!))
(defun dft! (f)
  (if (zerop (length f))
      f
      (general-dft! f 1)))

(declaim (inline inverse-dft!))
(defun inverse-dft! (f)
  (declare ((array (complex fft-float) (*)) f))
  (if (zerop (length f))
      f
      (let* ((n (length f))
             (/n (/ (coerce n 'fft-float))))
        (general-dft! f -1)
        (dotimes (i n f)
          (setf (aref f i) (* (aref f i) /n))))))

(declaim (inline convolute!))
(defun convolute! (g h)
  (declare ((array (complex fft-float) (*)) g h))
  (assert (and (power2-p (length g))
               (power2-p (length h))
               (= (length g) (length h))))
  (let ((n (length g)))
    (dft! g)
    (dft! h)
    (let ((f (make-array n :element-type '(complex fft-float))))
      (dotimes (i n)
        (setf (aref f i) (* (aref g i) (aref h i))))
      (inverse-dft! f))))

(defmacro with-output-buffer (&body body)
  "Buffers all outputs to *STANDARD-OUTPUT* and flushes them to
*STANDARD-OUTPUT* at the end. 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
                                  ;; (return-from read-fixnum 0)
                                  (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) (the fixnum (* result 10))))
              (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)

(defmacro 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)
  (let* ((n (read))
         (length (sb-int:power-of-two-ceiling (+ n n 1)))
         (as (make-array length :element-type '(complex double-float) :initial-element #c(0d0 0d0)))
         (bs (make-array length :element-type '(complex double-float) :initial-element #c(0d0 0d0))))
    (declare (uint32 n))
    (loop for i from 1 to n
          do (setf (aref as i) (coerce (read-fixnum) '(complex double-float))
                   (aref bs i) (coerce (read-fixnum) '(complex double-float))))
    (let ((res (convolute! as bs)))
      (declare ((simple-array (complex double-float) (*)) res))
      (with-output-buffer
        (loop for i from 1 to (* 2 n)
              do (println (round (the (double-float -4.6d18 4.6d18)
                                      (realpart (aref res i))))))))))

#-swank(main)

Submission Info

Judge Result