結果

問題 No.179 塗り分け
コンテスト
ユーザー mikan-water
提出日時 2024-01-31 10:19:05
言語 Common Lisp
(sbcl 2.5.0)
結果
RE  
実行時間 -
コード長 3,205 bytes
コンパイル時間 1,387 ms
コンパイル使用メモリ 31,744 KB
実行使用メモリ 25,856 KB
最終ジャッジ日時 2024-09-28 10:21:17
合計ジャッジ時間 2,432 ms
ジャッジサーバーID
（参考情報） 		judge2 / judge1
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 2 RE * 4
other AC * 5 RE * 35
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 28 SEP 2024 10:21:13 AM):

; file: /home/judge/data/code/Main.lisp
; in: DEFUN COLOR
;     (LENGTH *BLACKS* (* *ROW* *COL*))
; 
; caught WARNING:
;   The function LENGTH is called with two arguments, but wants exactly one.

;     (CREATE-P-MOVS)
; 
; note: deleting unreachable code

;     (PRINC 'YES)
; 
; note: deleting unreachable code

;     (PRINC 'NO)
; 
; note: deleting unreachable code

; 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) (#:LOOP-ACROSS-VECTOR-0 S) (#:LOOP-ACROSS-INDEX-1 0))
;     (DECLARE (IGNORABLE #:LOOP-ACROSS-INDEX-1)
;              (TYPE FIXNUM #:LOOP-ACROSS-INDEX-1)
;              (IGNORABLE #:LOOP-ACROSS-VECTOR-0)
;              (TYPE VECTOR #:LOOP-ACROSS-VECTOR-0)
;              (IGNORABLE C))
;     (LET ((#:LOOP-ACROSS-LIMIT-2 (LENGTH #:LOOP-ACROSS-VECTOR-0)))
;       (TAGBODY
;        SB-LOOP::NEXT-LOOP
;         (WHEN (>= #:LOOP-ACROSS-INDEX-1 #:LOOP-ACROSS-LIMIT-2)
;           (GO SB-LOOP::END-LOOP))
;         (SB-LOOP::LOOP-DESETQ C
;                               (AREF #:LOOP-ACROSS-VECTOR-0
;                                     #:LOOP-ACROSS-INDEX-1))
;         (SB-LOOP::LOOP-DESETQ #:LOOP-ACROSS-INDEX-1 (1+ #:LOOP-ACROSS-INDEX-1))
;         (CONVERT-TO-INT C)
;         (GO SB-LOOP::NEX

ソースコード

diff # 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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
    ((or
       (oddp (length *blacks*))
       (> (length *blacks* (* *row* *col*))))
     (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