結果

問題 No.179 塗り分け
コンテスト
ユーザー mikan-water
提出日時 2024-01-31 10:16:19
言語 Common Lisp
(sbcl 2.6.3)
コンパイル:
sbclc _filename_
実行:
sbcl --script Main.fasl
結果
TLE  
実行時間 -
コード長 3,148 bytes
記録
記録タグの例:
初AC ショートコード 純ショートコード 純主流ショートコード 最速実行時間
コンパイル時間 353 ms
コンパイル使用メモリ 41,840 KB
実行使用メモリ 95,348 KB
最終ジャッジ日時 2026-04-15 01:55:53
合計ジャッジ時間 5,799 ms
ジャッジサーバーID
（参考情報） 		judge2_0 / judge1_1
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 6
other AC * 6 TLE * 1 -- * 33
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 15 APR 2026 01:55:41 AM):

; file: /home/judge/data/code/Main.lisp
; in: DEFUN CREATE-P-MOVS
;     (MAPCAR #'- B INITIAL-CELL)
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::INITIAL-CELL

;     (EQUAL INITIAL-CELL '(0 0))
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::INITIAL-CELL

;     (SETF INITIAL-CELL (CAR *BLACKS*))
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::INITIAL-CELL

; in: DEFUN CREATE-BLACKS
;     (SETF S (READ-LINE))
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::S

; in: DEFUN INPUT-ROW-COL
;     (LOOP FOR C ACROSS S
;           DO (CONVERT-TO-INT C)
;           FINALLY (PUSH (PARSE-INTEGER (COERCE (REVERSE *STACK*) 'STRING))
;                         *INTS*))
; ==>
;   (LET ((C NIL) (#:V0 S))
;     (DECLARE (IGNORABLE #:V0)
;              (TYPE VECTOR #:V0)
;              (IGNORABLE C))
;     (MULTIPLE-VALUE-BIND (#:D1 #:I2)
;         (SB-KERNEL:%DATA-VECTOR-AND-INDEX/KNOWN #:V0 0)
;       (LET ((#:LIM3 #))
;         (SB-C::%IN-BOUNDS-CONSTRAINT #:D1 #:LIM3)
;         (TAGBODY
;          SB-LOOP::NEXT-LOOP
;           (WHEN # #)
;           (SB-LOOP::LOOP-DESETQ C #)
;           (SB-LOOP::LOOP-DESETQ #:I2 #)
;           (CONVERT-TO-INT C)
;           (GO SB-LOOP::NEXT-LOOP)
;          SB-LOOP::END-LOOP
;           (PUSH # *INTS*)))))
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::S

;     (SETF S (READ-LINE))
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::S

; 
; caught WARNING:
;   2 more uses of undefined variable S
; 
; compilation unit finished
;   Undefined variables:
;     INITIAL-CELL S
;   caught 7 WARNING conditions

; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.033

ソースコード

diff #
raw source code 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Fix check-pmov
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; variables
; 2d-lists
(defparameter *row* 0)
(defparameter *col* 0)
(defparameter *map* nil)
(defparameter *p-movs* nil)
(defparameter *blacks* nil)
(defparameter *stack* nil)
(defparameter *ints* nil)
(defparameter *cells* nil)


; functions
(defun convert-to-int (c)
  (cond
    ((char= c #\ )
     (push (parse-integer
	     (coerce (reverse *stack*) 'string))
	   *ints*)
     (setf *stack* nil)
     )
    (t (push c *stack*))
    )
  )

(defun input-row-col ()
  (setf s (read-line))
  (loop for c across s
	do
	(convert-to-int c)
	finally
	(push (parse-integer
		(coerce (reverse *stack*) 'string))
	      *ints*)
	)
  (setf *ints* (reverse *ints*))
  (setf *row* (car *ints*))
  (setf *col* (cadr *ints*))
  )

(defun create-blacks ()
  ; Loop through the numbers the amount of
  ; times equal to the row.
  (loop for i from 0 to (1- *row*)
	do
	(setf s (read-line))
	(loop for c across s
	      for col from 0 to (1- (length s))
	      do
	      (if (equal #\# c)
		(push (list i col) *blacks*))
	      )
	)
  (setf *blacks* (reverse *blacks*))
  )

(defun create-p-movs ()
  (setf initial-cell (car *blacks*))
  (loop for b in *blacks*
	do
	(if (equal initial-cell '(0 0))
	  (setf *p-movs* *blacks*)
	  (push (mapcar #'- b initial-cell) *p-movs*)
	  )
	)
  ; Use the cdr of the list because
  ; the first element represents no move.
  (setf *p-movs* (cdr *p-movs*))
  )

(defun input ()
  (input-row-col)
  (create-blacks)
  )

; When a black cell exists at the place obtained
; by parallel translation,
; ERACE a present cell and the corresponding element from blacks.
; p-mov: (row column)
; now: (row column)
(defun b-check (p-mov now)
  (cond
    ; not black
    ((equal *cells*
	    (remove-if (lambda (l)
			 (equal l (mapcar #'+ p-mov now)))
		       *cells*))
     nil)
    ; now doesn't exist in blacks
    ((equal *cells*
	    (remove-if (lambda (l)
			 (equal l now))
		       *cells*))
     nil)
    (t
      ; erase now
     (setf *cells*
	   (remove-if (lambda (l)
			(equal l now))
		      *cells*))
     (setf *cells*
	   (remove-if (lambda (l)
			(equal l (mapcar #'+ p-mov now)))
		      *cells*))
     t)
    )
  )

(defun check-pmov (p-mov)
  ; Make a copy to use since
  ; the contents of the list will be changed.
  (setf *cells* *blacks*)
    (loop for now in *cells*
	  do
	  ; The current cell has already been erased.
	  (tagbody
	    (cond ((equal
		     *cells*
		     (remove-if (lambda (l) (equal l now))
				*cells*))
		   (go END))
		  )
	    (if (null (b-check p-mov now))
	      (return-from check-pmov nil))
	    (if (null *cells*)
	      (return-from check-pmov t))
	    END
	    )
	  )
  nil
  )

(defun color ()
  (input)
  ; initial check
  (cond
    ((oddp (length *blacks*))
     (princ 'NO)
     (return-from color))
    )

  (create-p-movs)

  ; Test by each p-mov
  (loop for p-mov in *p-movs*
        do
        (cond
          ((check-pmov p-mov)
           (princ 'YES)
           (return-from color)))
        )
  (princ 'NO)
  )

(defun n179 ()
  (color)
  )

(n179)
0