Submission #6595485


Source Code Expand

Copy
#-swank
(unless (member :child-sbcl *features*)
  (quit
   :unix-status
   (process-exit-code
    (run-program *runtime-pathname*
                 `("--control-stack-size" "64MB"
                   "--noinform" "--disable-ldb" "--lose-on-corruption" "--end-runtime-options"
                   "--eval" "(push :child-sbcl *features*)"
                   "--script" ,(namestring *load-pathname*))
                 :output t :error t :input t))))
;; -*- 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 (ql:quickload '(:cl-debug-print :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)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Rolling hash (32-bit)
;;; Use 62-bit version instead. I leave it just for my reference.
;;;

(defstruct (rhash (:constructor %make-rhash (modulus base cumul powers)))
  (modulus 4294967291 :type (unsigned-byte 32))
  (base 2095716802 :type (unsigned-byte 32))
  (cumul nil :type (simple-array (unsigned-byte 32) (*)))
  (powers nil :type (simple-array (unsigned-byte 32) (*))))

(declaim (inline make-rhash))
(defun make-rhash (vector modulus &key (key #'char-code) base)
  "Returns the table of rolling-hash of VECTOR modulo MODULUS. KEY is applied to
  each element of VECTOR prior to computing the hash value.

MODULUS := unsigned 32-bit prime number
BASE := 1 | 2 | ... | MODULUS - 1
KEY := function returning FIXNUM"
  (declare (vector vector)
           ((unsigned-byte 32) modulus)
           ((or null (unsigned-byte 32)) base)
           (function key))
  (assert (sb-int:positive-primep modulus))
  (let* ((base (or base (+ 1 (random (- modulus 1)))))
         (size (length vector))
         (cumul (make-array (+ 1 size) :element-type '(unsigned-byte 32)))
         (powers (make-array (+ 1 size) :element-type '(unsigned-byte 32))))
    (assert (<= 1 base (- modulus 1)))
    (setf (aref powers 0) 1)
    (dotimes (i size)
      (setf (aref powers (+ i 1))
            (mod (* (aref powers i) base) modulus))
      (let ((sum (+ (mod (* (aref cumul i) base) modulus)
                    (mod (the fixnum (funcall key (aref vector i))) modulus))))
        (setf (aref cumul (+ i 1))
              (if (> sum modulus)
                  (- sum modulus)
                  sum))))
    (%make-rhash modulus base cumul powers)))

(declaim (inline rhash-query)
         (ftype (function * (values (unsigned-byte 32) &optional)) rhash-query))
(defun rhash-query (rhash l r)
  "Returns the hash value of the interval [L, R)."
  (declare ((integer 0 #.most-positive-fixnum) l r))
  (let ((cumul (rhash-cumul rhash))
        (powers (rhash-powers rhash))
        (modulus (rhash-modulus rhash)))
    (let ((res (+ (aref cumul r)
                  (- modulus (mod (* (aref cumul l) (aref powers (- r l))) modulus)))))
      (if (> res modulus)
          (- res modulus)
          res))))

(declaim (ftype (function * (values (unsigned-byte 32) &optional)) rhash-vector-hash)
         (inline rhash-vector-hash))
(defun rhash-vector-hash (rhash vector &key (key #'char-code))
  "Returns the hash code of VECTOR w.r.t. the moduli and bases of RHASH."
  (declare (vector vector))
  (let* ((mod (rhash-modulus rhash))
         (base (rhash-base rhash))
         (size (length vector))
         (result 0))
    (declare ((unsigned-byte 32) result))
    (dotimes (i size)
      ;; (2^32-1) * (2^32-1) + (2^32-1) < 2^64
      (setq result (mod (+ (* base result)
                           (the (unsigned-byte 32)
                                (mod (the fixnum (funcall key (aref vector i))) mod)))
                        mod)))
    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 forest-p (vec)
  (declare (vector vec))
  (let* ((n (length vec))
         (visited (make-array n :element-type 'bit :initial-element 0))
         (dp (make-array n :element-type 'int32 :initial-element -1))
         (res 0))
    (declare ((integer 0 #.most-positive-fixnum) res))
    (labels ((recur (pos)
               (dbg pos)
               (if (= -1 (aref dp pos))
                   (if (= 1 (aref visited pos))
                       (return-from forest-p nil)
                       (setf (aref visited pos) 1
                             (aref dp pos)
                             (if (= -1 (aref vec pos))
                                 0
                                 (+ 1 (recur (aref vec pos))))))
                   (aref dp pos))))
      (dotimes (i n)
        (when (zerop (aref visited i))
          (setf res (max res (recur i)))))
      res)))

(defun main ()
  (let* ((ss (coerce (the (simple-array character (*)) (read-line)) 'simple-base-string))
         (ts (coerce (the (simple-array character (*)) (read-line)) 'simple-base-string))
         (slen (length ss))
         (tlen (length ts))
         (snum (ceiling (+ slen tlen) slen))
         (total-len (* snum slen))
         (ex-ss (make-string total-len :element-type 'base-char)))
    (declare (uint31 slen tlen snum))
    #>snum
    (dotimes (i slen)
      (dotimes (lap snum)
        (setf (aref ex-ss (+ i (* lap slen)))
              (aref ss i))))
    (let* ((rhash (make-rhash ex-ss 4294967291 :base 2095716802))
           (tvalue (rhash-vector-hash rhash ts))
           (graph (make-array slen :element-type 'int32 :initial-element -1)))
      (dotimes (pos slen)
        (when (= tvalue (rhash-query rhash pos (+ pos tlen)))
          (setf (aref graph pos) (mod (+ pos tlen) slen))))
      (println (or (forest-p graph) -1)))))

#-swank (main)

Submission Info

Submission Time
Task F - Strings of Eternity
User sansaqua
Language Common Lisp (SBCL 1.1.14)
Score 0
Code Size 6677 Byte
Status
Exec Time 2112 ms
Memory 166204 KB

Judge Result

Set Name Score / Max Score Test Cases
Sample 0 / 0 a01, a02, a03
All 0 / 600 a01, a02, a03, b04, b05, b06, b07, b08, b09, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24, b25, b26, b27, b28, b29, b30, b31, b32, b33, b34, b35, b36, b37, b38, b39, b40, b41, b42, b43, b44, b45, b46, b47, b48, b49, b50, b51, b52, b53, b54, b55, b56, b57, b58, b59, b60, b61, b62, b63, b64, b65, b66, b67, b68, b69, b70
Case Name Status Exec Time Memory
a01 164 ms 32056 KB
a02 162 ms 31800 KB
a03 162 ms 31800 KB
b04 164 ms 31800 KB
b05 163 ms 31796 KB
b06 166 ms 31800 KB
b07 163 ms 31800 KB
b08 163 ms 31800 KB
b09 163 ms 31796 KB
b10 162 ms 31800 KB
b11 162 ms 31800 KB
b12 313 ms 56372 KB
b13 2112 ms 166196 KB
b14 2112 ms 164148 KB
b15 235 ms 42040 KB
b16 2112 ms 166200 KB
b17 316 ms 56376 KB
b18 317 ms 56380 KB
b19 2112 ms 166204 KB
b20 327 ms 56376 KB
b21 337 ms 62520 KB
b22 338 ms 62520 KB
b23 341 ms 107572 KB
b24 276 ms 78908 KB
b25 317 ms 56372 KB
b26 272 ms 74808 KB
b27 336 ms 62520 KB
b28 338 ms 93236 KB
b29 327 ms 66616 KB
b30 334 ms 62516 KB
b31 333 ms 62520 KB
b32 317 ms 56376 KB
b33 311 ms 56376 KB
b34 318 ms 56372 KB
b35 335 ms 62520 KB
b36 289 ms 54328 KB
b37 319 ms 56376 KB
b38 321 ms 56380 KB
b39 336 ms 62520 KB
b40 317 ms 56376 KB
b41 320 ms 56380 KB
b42 334 ms 62520 KB
b43 330 ms 70716 KB
b44 317 ms 56376 KB
b45 337 ms 62520 KB
b46 339 ms 62524 KB
b47 313 ms 60472 KB
b48 295 ms 54328 KB
b49 319 ms 56376 KB
b50 319 ms 56380 KB
b51 327 ms 64572 KB
b52 318 ms 56380 KB
b53 336 ms 62520 KB
b54 318 ms 56376 KB
b55 309 ms 56376 KB
b56 263 ms 52276 KB
b57 262 ms 50232 KB
b58 185 ms 37940 KB
b59 164 ms 33852 KB
b60 195 ms 37948 KB
b61 171 ms 33844 KB
b62 178 ms 35900 KB
b63 265 ms 52280 KB
b64 316 ms 56380 KB
b65 317 ms 56376 KB
b66 334 ms 62516 KB
b67 335 ms 62520 KB
b68 317 ms 56372 KB
b69 317 ms 56380 KB
b70 334 ms 62520 KB