#681924 (Common Lisp) No.1617 Palindrome Removal

• 問題: No.1617 Palindrome Removal
• ユーザー: linuxmetel
• 提出日時: 2021-07-22 22:33:02
• 言語: Common Lisp (sbcl 2.5.0)
• 結果: WA
• 実行時間: -
• コード長: 6,019 bytes
• コンパイル時間: 273 ms
• コンパイル使用メモリ: 50,600 KB
• 実行使用メモリ: 51,776 KB
• 最終ジャッジ日時: 2024-07-17 18:45:10
• 合計ジャッジ時間: 2,111 ms
• ジャッジサーバーID （参考情報）: judge2 / judge3

ファイルパターン	結果
sample	AC * 4
other	AC * 18 WA * 2

コンパイルメッセージ

; compiling file "/home/judge/data/code/Main.lisp" (written 17 JUL 2024 06:45:06 PM):

; file: /home/judge/data/code/Main.lisp
; in: DEFUN MODPOW
;     (ZEROP CL-KYOPRO::N)
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a SINGLE-FLOAT.
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a DOUBLE-FLOAT.
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; 
; note: unable to open code because: The operands might not be the same type.

;     (= CL-KYOPRO::N 1)
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a SINGLE-FLOAT.
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a DOUBLE-FLOAT.
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; 
; note: unable to open code because: The operands might not be the same type.

;     (MOD CL-KYOPRO::A MOD)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a REAL, not a SINGLE-FLOAT.
;   The second argument is a REAL, not a (OR SINGLE-FLOAT INTEGER).
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a REAL, not a DOUBLE-FLOAT.
;   The second argument is a REAL, not a (OR FLOAT INTEGER).
; 
; note: unable to
;   optimize

ソースコード

(defpackage :cl-kyopro
  (:use :cl)
  (:shadow :read))

(in-package :cl-kyopro)

(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 ,(cl:read s nil nil t))))
  #+sbcl (dolist (f '(:popcnt :sse4)) (pushnew f sb-c:*backend-subfeatures*))
  (setq *random-state* (make-random-state t)))
#-swank (eval-when (:compile-toplevel)
          (setq *break-on-signals* '(and warning (not style-warning))))
;#+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))

(defmacro dbg (&rest forms)
  (declare (ignorable forms))
  #+swank (if (= (length forms) 1)
              `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
              `(format *error-output* "~A => ~A~%" ',forms `(,,@forms))))

(locally
    (declaim (optimize (speed 3) (debug 0) (safety 0)))
  
  (declaim (inline println))
  (defun println (obj &optional (stream *standard-output*))
    (let ((*read-default-float-format*
            (if (typep obj 'double-float) 'double-float *read-default-float-format*)))
      (prog1 (princ obj stream) (terpri stream))))

  ;; Read

  ; cl:read は文字列をシンボルにしてしまうので、文字列として読み込める版 大文字と小文字の区別もする
  ; それ以外は普通の read と同じ動作

  (let ((rt (copy-readtable *readtable*)))
    (setf (readtable-case rt) :preserve) 
    (defun read ()
      (let* ((*readtable* rt)
             (r (cl:read)))
        (cond ((symbolp r) (string r)) 
              (t r)))))

  ;;rep-collect

  ; n 回 body をして collect します。
  ; 10 回 read して list にまとめる等
  (defmacro rep-collect (n body)
    `(loop :repeat ,n 
           :collect ,body))


  ;;def-read!

  ; read してグローバル変数を定義します
  ; (def-read! *a* *b* *c*)
  ; (defvar *a* (read)) (defvar *b* (read)) (defvar *c* (read))
  (defmacro def-read! (&rest args)
    `(progn
       ,@(loop :for i :in args
               :collect `(defparameter ,i (read)))))

  ;;inf, -inf

  ; inf, -inf です (おそらく実装依存で SBCL では動く)
  (defconstant  inf cl-user::double-float-positive-infinity)
  (defconstant -inf cl-user::double-float-negative-infinity)

  ;;modpow
  (defun modpow (a n mod)
    (cond ((zerop n) 1)
          ((= n 1) (mod a mod))
          ((oddp n) (mod (* a (modpow a (1- n) mod)) mod))
          (t (mod (expt (modpow a (/ n 2) mod) 2) mod))))


  ;;prime?

  (defun prime? (x)
    (and (/= 1 x)
         (reduce #'(lambda (&optional (p t) (q t)) (and p q))
                 (loop :for i :from 2 :to (isqrt x)
                       :collect (/= 0 (mod x i))))))

  ;;read-n

  (declaim (inline read-n))
  (defun read-n (n &optional (type 'vector))
    (let ((seq (make-sequence type n)))
      (loop :for i :below n
            :do (setf (elt seq i) (read)))
      seq))
  

  ;;range
  (defun range (start end &optional (step 1))
    (let ((vec (make-array (1+ (floor (- (1- end) start) step)))))
      (loop :for i :from start :to (1- end) :by step
            :for j :from 0
            :do (setf (aref vec j) i))
      vec))

  ;;indexd-mapcar
  (defun indexed-mapcar (function &rest lists)
    (apply #'mapcar function (concatenate 'list (range 0 (length (car lists)))) lists))

  ;;indexd-map
  (defun indexed-map (result-type function &rest seqs)
    (apply #'map result-type function (range 0 (length (car seqs))) seqs))


  ;;extgcd

  ;(gcd(a, b) x y) ただし、 ax + by = gcd(a, b)

  (defun extgcd (a b)
    (if (zerop b)
        (list a 1 0)
        (destructuring-bind (d y x) (extgcd b (rem a b))
          (list d x (- y (* (floor a b) x))))))

  #|
  [ax + by = c (ただし、 gcd(a, b) | c ) の一般解]
  d = c / gcd(a, b)
  a' = a / gcd(a, b)
  b' = b / gcd(a, b)
  とする
  また、 extgcd によりもとめられた一つの解を x', y' とする。

  任意の整数 t について
  (x, y) = ((t・b' + x'), (-t・a' + y'))
  |#

  ;;euc
  ; 存在しない場合は -1
  (defun euc (a m)
    (if (= 1 (gcd a m))
        (let ((d (extgcd a m)))
          (mod (second d) m))
        -1))


  ;;binary-search

  #|
  目標の値を y (lower <= y <= upper) だとする
  f(x) は
  y < x  のとき  2
  y <= x のとき  1
  y == x のとき  0
  y >= x のとき -1
  y > x  のとき -2
  をかえす関数
  |#

  (defun binary-search (f lower upper)
    (loop :with x = (+ lower (floor (- upper lower) 2))
          :do (when (= lower upper)
                (return lower))            
              (case (funcall f x)
                ( 2 (setq upper (1- x)
                          x (+ lower (floor (- upper lower) 2))))
                ( 1 (setq upper x
                          x (+ lower (floor (- upper lower) 2))))
                ( 0 (return x))
                (-1 (setq lower x
                          x (+ lower (ceiling (- upper lower) 2))))
                (-2 (setq lower (1+ x)
                          x (+ lower (ceiling (- upper lower) 2)))))))

  (defun main ()
    (let ((s (read-line)))
      (println
       (if (equal s (reverse s))
           (if (reduce #'(lambda (p q) (and p q)) (map 'vector #'(lambda (x) (equal (aref s 0) x)) s))
               (if (evenp (length s))
                   0
                   -1)
               (max -1 (- (length s) 2)))
           (length s))))))

(main)