提出 #5710387

---

ソースコード 拡げる

;; -*- 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
(defun f2-solve-linear-system! (matrix vector)
  "Returns the row echelon form of MATRIX by gaussian elimination.

This function destructively modifies MATRIX."
  (declare #.OPT
           ((simple-array bit (* *)) matrix)
           (simple-bit-vector vector))
  (destructuring-bind (m n) (array-dimensions matrix)
    (declare ((integer 0 #.most-positive-fixnum) m n))
    (multiple-value-bind (n/64 rem) (floor n 64)
      (assert (zerop rem))
      (let* ((storage (array-storage-vector matrix))
             (rank 0))
        (declare (fixnum rank))
        (dotimes (target-col n)
          (let* ((pivot-row (do ((i rank (+ 1 i)))
                                ((= i m) -1)
                              (unless (zerop (aref matrix i target-col))
                                (return i)))))
            (when (>= pivot-row 0)
              (let ((pivot-row/64 (floor (array-row-major-index matrix pivot-row 0) 64))
                    (rank-row/64 (floor (array-row-major-index matrix rank 0) 64)))
                ;; swap rows
                (rotatef (aref vector rank) (aref vector pivot-row))
                (loop for k from 0 below n/64
                      do (rotatef (sb-kernel:%vector-raw-bits storage (+ rank-row/64 k))
                                  (sb-kernel:%vector-raw-bits storage (+ pivot-row/64 k))))
                (dotimes (i m)
                  (unless (or (= i rank) (zerop (aref matrix i target-col)))
                    (setf (aref vector i) (logxor (aref vector i) (aref vector rank)))
                    (loop with base/64 = (floor (array-row-major-index matrix i 0) 64)
                          for k below n/64
                          do (setf (sb-kernel:%vector-raw-bits storage (+ base/64 k))
                                   (logxor (sb-kernel:%vector-raw-bits storage (+ base/64 k))
                                           (sb-kernel:%vector-raw-bits storage (+ rank-row/64 k))))))))
              (incf rank))))
        (if (loop for i from rank below m
                  always (zerop (aref vector i)))
            (values vector rank)
            (values nil rank))))))

(declaim (ftype (function * (values (integer 0 9) &optional)) read-digit))
(defun read-digit (&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))))
    (loop (let ((byte (%read-byte)))
            (cond ((<= 48 byte 57)
                   (return (- byte 48)))
                  ((zerop byte)  ; #\Nul
                   (error "Read EOF or #\Nul.")))))))

;;
;; Matrix multiplication over semiring
;;
(sb-c:defknown popcnt ((unsigned-byte 64)) (integer 0 64)
    (sb-c:foldable sb-c:flushable sb-c:movable)
  :overwrite-fndb-silently t)

(sb-c:defknown popcnt ((unsigned-byte 64)) (integer 0 64)
    (sb-c:foldable sb-c:flushable sb-c:movable)
  :overwrite-fndb-silently t)

(sb-vm::define-vop (popcnt)
  (:policy :fast-safe)
  (:translate popcnt)
  (:args (x :scs (sb-vm::unsigned-reg) :target r))
  (:arg-types sb-vm::unsigned-num)
  (:results (r :scs (sb-vm::unsigned-reg)))
  (:result-types sb-vm::unsigned-num)
  (:generator 3
              (unless (sb-vm::location= r x)
                (sb-vm::inst xor r r))
              (sb-vm::inst popcnt r x)))

(sb-vm::define-vop (popcnt/fx)
  (:policy :fast-safe)
  (:translate popcnt)
  (:args (x :scs (sb-vm::unsigned-reg) :target r))
  (:arg-types sb-vm::positive-fixnum)
  (:results (r :scs (sb-vm::unsigned-reg)))
  (:result-types sb-vm::unsigned-num)
  (:generator 2
              (unless (sb-vm::location= r x)
                (sb-vm::inst xor r r))
              (sb-vm::inst popcnt r x)))

(defun popcnt (x)
  (popcnt x))

(defun f2-gemm (a b)
  "Calculates A*B on GF(2)"
  (declare #.OPT ((simple-array bit (* *)) a b))
  (let* ((tb (make-array (list (array-dimension b 1) (array-dimension b 0))
                         :element-type 'bit))
         (c (make-array (list (array-dimension a 0) (array-dimension b 1))
                        :element-type 'bit))
         (a-width (array-dimension a 1))
         (b-width (array-dimension b 1))
         (a-storage (array-storage-vector a))
         (tb-storage (array-storage-vector tb)))
    (multiple-value-bind (length/64 rem) (floor a-width 64)
      (assert (zerop rem))
      (dotimes (row a-width)
        (dotimes (col b-width)
          (setf (aref tb row col) (aref b col row))))
      (dotimes (row (array-dimension a 0))
        (dotimes (col (array-dimension b 1))
          (let ((res 0)
                (a-index (floor (array-row-major-index a row 0) 64))
                (tb-index (floor (array-row-major-index tb col 0) 64)))
            (declare ((unsigned-byte 64) res))
            (dotimes (k length/64)
              (setf res
                    (logxor res
                            (ldb (byte 1 0)
                                 (popcnt (logand (sb-kernel:%vector-raw-bits a-storage (+ k a-index))
                                                 (sb-kernel:%vector-raw-bits tb-storage (+ k tb-index))))))))
            (setf (aref c row col) res)))))
    c))

;;
;; Calculate a^n in O(log(n)) time on any monoids
;;

(declaim (inline power))
(defun power (base exponent op identity)
  "OP := binary operation (on a monoid)
IDENTITY := identity element w.r.t. OP"
  (declare ((integer 0 #.most-positive-fixnum) exponent)
           (function op))
  (labels ((recur (x p)
             (declare ((integer 0 #.most-positive-fixnum) p))
             (cond ((zerop p) identity)
                   ((evenp p) (recur (funcall op x x) (ash p -1)))
                   (t (nth-value 0 (funcall op x (recur x (- p 1))))))))
    (recur base exponent)))

;; Body

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (n-prime (* 64 (ceiling n 64)))
         (adj (make-array (list n-prime n-prime) :element-type 'bit :initial-element 0))
         (vs (make-array n-prime :element-type 'bit :initial-element 0))
         (iden (make-array (list n-prime n-prime) :element-type 'bit :initial-element 0)))
    (declare ((unsigned-byte 16) n))
    (dotimes (i n)
      (dotimes (j n)
        (when (= 1 (read-digit))
          (setf (aref adj i j) 1))))
    (dotimes (i n)
      (setf (aref vs i) (read-digit)))
    (dotimes (i n-prime) (setf (aref iden i i) 1))
    (let* ((exponent (read))
           (mat (power adj exponent #'f2-gemm iden)))
      (declare ((simple-array bit (* *)) mat))
      (multiple-value-bind (result rank) (f2-solve-linear-system! mat vs)
        (declare ((unsigned-byte 16) rank))
        (cond ((null result)
               (write-line "none"))
              ((< rank n)
               (write-line "ambiguous"))
              (t (loop with init = t
                       for i below n
                       do (if init
                              (setq init nil)
                              (write-char #\ ))
                          (princ (aref (the simple-bit-vector result) i)))
                 (terpri)))))))

#-swank(main)

提出情報

ジャッジ結果