1. 問題
個の都市と 本の無向道路があり、各都市 には長さ の文字列 で休日の曜日が与えられます。
高橋君は曜日 の昼に任意の都市から始め、毎晩「同じ都市に留まる」か「隣接都市へ移動」できます。
各日の昼にいる都市が、その曜日で休日になるように、無限に移動を続けられるか判定します。
個のテストケースそれぞれについて、可能なら `Yes`、不可能なら `No` を出力します。
2. コード（WA11）
;; (make-edges 4 '(1 2 1 4 2 4 2 3))
;;=> #(NIL (4 2) (3 4 1) (2) (2 1))
(defun make-edges (N lst)
(let* ((ary (make-array (1+ N) :element-type 'list
:initial-element nil)))
(loop for (u v) on lst by #'cddr
while v
do
(push v (aref ary u))
(push u (aref ary v)))
ary))
;; (edges->nodes *e* 2) ;=> (3 4 1)
(defun edges->nodes (edges n)
(aref edges n))
;; (make-holidays 4 3 '("xxo" "xox" "oxo" "oxx")) ;=>
;; #2A((NIL NIL NIL NIL)
;; (NIL NIL NIL T)
;; (NIL NIL T NIL)
;; (NIL T NIL T)
;; (NIL T NIL NIL))
(defun make-holidays (N W lines)
(let* ((ary2d (make-array (list (1+ N) (1+ W))
:element-type 'boolean
:initial-element nil)))
(loop for city from 1 to N
for line in lines
do (loop for day from 1 to W
for ch across line
do (setf (aref ary2d city day)
(eql ch #\o))))
ary2d))
;; (defparameter *e* (make-edges 4 '(1 2 1 4 2 4 2 3)))
;; (defparameter *h*
;; (make-holidays 4 3 '("xxo" "xox" "oxo" "oxx")))
(defun cycle (x cycle)
(1+ (mod (1- x) cycle)))
;; (next-holiday-cities 3 2 3 *e* *h*) ;=> (3 1)
;; (next-holiday-cities 3 2 4 *e* *h*) ;=> (3 4)
;; (next-holiday-cities 3 1 2 *e* *h*) ;=> (2)
(defun next-holiday-cities (W current-city next-day edges holidays)
(loop for city in (cons current-city
(edges->nodes edges current-city))
when (aref holidays city (cycle next-day W))
collect city))
;; (holiday-cities 4 3 1 *h*) ;=> (3 4)
(defun holiday-cities (N W day holidays)
(loop for city from 1 to N
when (aref holidays city (cycle day W))
collect city))
;; (next-cities 3 '(1 2 3 4) 2 *e* *h*) ;=> (2)
;; (next-cities 3 '(2) 3 *e* *h*) ;=> (3 1)
;; (next-cities 3 '(3 1) 4 *e* *h*) ;=> (4)
;; (next-cities 3 nil 4 *e* *h*) ;=> NIL
(defun next-cities (W cities next-day edges holidays)
(loop for city in cities
append (next-holiday-cities
W city next-day edges holidays) into result
finally (return (remove-duplicates result))))
;; (endless-holiday-p 4 3 *e* *h*) ;=> T
(defun endless-holiday-p (N W edges holidays)
(loop for day from 2 to (1+ W)
with current-cities = (holiday-cities N W 1 holidays)
while current-cities
do (setf current-cities
(next-cities
W current-cities day edges holidays))
finally (return (consp current-cities))))
(defun print-yesno (c)
(declare (type boolean c))
(princ (if c "Yes" "No")))
(defun main ()
(let* ((times (read)))
(loop repeat times
for N = (read)
for M = (read)
for edge-list = (loop repeat (* M 2)
collect (read))
for W = (read)
for lines = (loop repeat N
collect (read-line))
for edges = (make-edges N edge-list)
for holidays = (make-holidays N W lines)
do (print-yesno (endless-holiday-p
N W edges holidays))
(terpri))))
#-swank(main)Code language: Lisp (lisp)
2.1. 開始時の都市に戻れないときがある？（TLE14）
一巡したときに、開始時の都市に戻れないと、最終的にどん詰まりになることがあることに気づきました。
(defun endless-holiday-p (N W edges holidays)
(labels ((rec (start-cities)
(loop for day from 2 to (1+ W)
with current-cities = start-cities
while current-cities
do (setf current-cities
(next-cities
W current-cities day edges holidays))
finally (return
(cond ((null current-cities) nil)
((equal start-cities current-cities) t)
(t (rec current-cities)))))))
(rec (holiday-cities N W 1 holidays))))Code language: JavaScript (javascript)しかし、どうも振動してループしてしまうことがあるようです。
2.2. ループをチェックした（TLE1）
そこで、スタート地点ごとに1週間後に移動可能な都市を求めて、それグラフにすることにしました。
そして、そのグラフ上にループ構造があれば、いつまでも休日を続けていけます。
;; (next-week-cities 4 3 *e* *h* 1) ;=> (3 4)
(defun next-week-cities (N W edges holidays city)
(declare (ignore N))
(loop for day from 2 to (1+ W)
with current-cities = (list city)
while current-cities
do (setf current-cities
(next-cities
W current-cities day edges holidays))
finally (return current-cities)))
;; (week-edges 4 3 *e* *h*) ;=> #(NIL NIL NIL (4 3) (4 3))
(defun week-edges (N W edges holidays)
(let* ((start-cities (holiday-cities N W 1 holidays))
(ary (make-array (1+ N) :element-type 'list
:initial-element nil)))
(loop for ca in start-cities
do (loop for cb in (next-week-cities N W edges holidays ca)
do (push cb (aref ary ca)))
finally (return ary))))
Code language: Lisp (lisp)グラフにループ構造があるかは、DFSで途中の場所 :now を見つけたら判定できます。
;; (has-cycle-p 4 #(NIL NIL NIL (4 3) (4 3))) ;=> T
;; (has-cycle-p 4 #(NIL NIL NIL (4) (1))) ;=> NIL
(defun has-cycle-p (N edges)
(let* ((state (make-array (1+ N) :initial-element :before)))
(labels ((visit (v)
(case (aref state v)
(:now t)
(:done nil)
(t (setf (aref state v) :now)
(let ((found-cycle (some #'visit (aref edges v))))
(setf (aref state v) :done)
found-cycle)))))
(loop for i from 1 to N
thereis (visit i)))))
Code language: PHP (php)ループが見つからなかったノードは、:done にして再計算から除外します。
ここまですれば、判定そのものはシンプルです。
(defun endless-holiday-p/graph (N W edges holidays)
(has-cycle-p N (week-edges N W edges holidays)))結果は、TLE 1。
惜しいです。
一つだけ、異様にメモリを消費して、時間もオーバーしているので、何か見落としがあって処理がループしているかも。
;; (defparameter *e* (make-edges 4 '(1 2 1 4 2 4 2 3)))
;; (defparameter *h* (make-holidays 4 3 '("xxo" "xox" "oxo" "oxx")))
;; (make-edges 4 '(1 2 1 4 2 4 2 3))
;;=> #(NIL (4 2) (3 4 1) (2) (2 1))
(defun make-edges (N lst)
(let* ((ary (make-array (1+ N) :element-type 'list
:initial-element nil)))
(loop for (u v) on lst by #'cddr
while v
do
(push v (aref ary u))
(push u (aref ary v)))
ary))
;; (edges->nodes *e* 2) ;=> (3 4 1)
(defun edges->nodes (edges n)
(aref edges n))
;; (make-holidays 4 3 '("xxo" "xox" "oxo" "oxx")) ;=>
;; #2A((NIL NIL NIL NIL)
;; (NIL NIL NIL T)
;; (NIL NIL T NIL)
;; (NIL T NIL T)
;; (NIL T NIL NIL))
(defun make-holidays (N W lines)
(let* ((ary2d (make-array (list (1+ N) (1+ W))
:element-type 'boolean
:initial-element nil)))
(loop for city from 1 to N
for line in lines
do (loop for day from 1 to W
for ch across line
do (setf (aref ary2d city day)
(eql ch #\o))))
ary2d))
(defun cycle (x cycle)
(1+ (mod (1- x) cycle)))
;; (next-holiday-cities 3 2 3 *e* *h*) ;=> (3 1)
;; (next-holiday-cities 3 2 4 *e* *h*) ;=> (3 4)
;; (next-holiday-cities 3 1 2 *e* *h*) ;=> (2)
(defun next-holiday-cities (W current-city next-day edges holidays)
(loop for city in (cons current-city
(edges->nodes edges current-city))
when (aref holidays city (cycle next-day W))
collect city))
;; (holiday-cities 4 3 1 *h*) ;=> (3 4)
(defun holiday-cities (N W day holidays)
(loop for city from 1 to N
when (aref holidays city (cycle day W))
collect city))
;; (next-cities 3 '(1 2 3 4) 2 *e* *h*) ;=> (2)
;; (next-cities 3 '(2) 3 *e* *h*) ;=> (3 1)
;; (next-cities 3 '(3 1) 4 *e* *h*) ;=> (4)
;; (next-cities 3 nil 4 *e* *h*) ;=> NIL
(defun next-cities (W cities next-day edges holidays)
(loop for city in cities
append (next-holiday-cities
W city next-day edges holidays) into result
finally (return (remove-duplicates result))))
;; (next-week-cities 4 3 *e* *h* 1) ;=> (3 4)
(defun next-week-cities (N W edges holidays city)
(declare (ignore N))
(loop for day from 2 to (1+ W)
with current-cities = (list city)
while current-cities
do (setf current-cities
(next-cities
W current-cities day edges holidays))
finally (return current-cities)))
;; (week-edges 4 3 *e* *h*) ;=> #(NIL NIL NIL (4 3) (4 3))
(defun week-edges (N W edges holidays)
(let* ((start-cities (holiday-cities N W 1 holidays))
(ary (make-array (1+ N) :element-type 'list
:initial-element nil)))
(loop for ca in start-cities
do (loop for cb in (next-week-cities N W edges holidays ca)
do (push cb (aref ary ca)))
finally (return ary))))
;; (has-cycle-p 4 #(NIL NIL NIL (4 3) (4 3))) ;=> T
;; (has-cycle-p 4 #(NIL NIL NIL (4) (1))) ;=> NIL
(defun has-cycle-p (N edges)
(let* ((state (make-array (1+ N) :initial-element :before)))
(labels ((visit (v)
(case (aref state v)
(:now t)
(:done nil)
(t (setf (aref state v) :now)
(let ((found-cycle (some #'visit (aref edges v))))
(setf (aref state v) :done)
found-cycle)))))
(loop for i from 1 to N
thereis (visit i)))))
(defun endless-holiday-p/graph (N W edges holidays)
(has-cycle-p N (week-edges N W edges holidays)))
(defun print-yesno (c)
(declare (type boolean c))
(princ (if c "Yes" "No")))
(defun main ()
(let* ((times (read)))
(loop repeat times
for N = (read)
for M = (read)
for edge-list = (loop repeat (* M 2)
collect (read))
for W = (read)
for lines = (loop repeat N
collect (read-line))
for edges = (make-edges N edge-list)
for holidays = (make-holidays N W lines)
do (print-yesno (endless-holiday-p/graph
N W edges holidays))
(terpri))))
#-swank(main)
Code language: Lisp (lisp)