Find file
Fetching contributors…
Cannot retrieve contributors at this time
78 lines (74 sloc) 2.63 KB
(defstruct node
(cycle-id nil)
(visitedp nil)
(cycle-length nil)
(cycle-entry-point nil)
(steps-before nil)
(max-upstream-a 0)
(max-upstream-b 0))
(defun C (basename)
(with-open-file (file (format nil "" basename))
(with-open-file (output (format nil "~A.out" basename)
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(let ((ncases (read file)))
(dotimes (k ncases)
(let ((nkids (read file)))
(let ((bff (make-array (list nkids))))
(dotimes (i nkids)
(setf (aref bff i)
(make-node :id i :bff (1- (read file)))))
(format output "Case #~D: ~A~%" (1+ k)
(bff-max-circle-length bff)))))))))
(defun bff-max-circle-length (bff)
(let ((biggest-cycle 0)
(couples '()))
(dotimes (k (length bff))
(let ((start (aref bff k)))
(do* ((next start (aref bff (node-bff next)))
(return-path '()))
((node-visitedp next) ;cycle detected
(let ((cycle-id (or (node-cycle-id next) next)))
(cond ((not (node-cycle-id next))
;; we were the first to discover this cycle!
;; need to mark it.
(let ((split (1+ (position next return-path))))
(assert split)
(let ((cycle-length (1+ (position next return-path))))
(when (= cycle-length 2) (push cycle-id couples))
(setq biggest-cycle (max cycle-length biggest-cycle))
(dotimes (k split)
(let ((node (pop return-path)))
(setf (node-cycle-id node) cycle-id)
(setf (node-cycle-length node) cycle-length)
(setf (node-steps-before node) 0)))))))
(let ((k (+ 1 (node-steps-before next)))
(entry-point (or (node-cycle-entry-point next) next)))
(dolist (node return-path)
(setf (node-cycle-id node) cycle-id)
(setf (node-cycle-entry-point node) entry-point)
(setf (node-steps-before node) k)
(incf k)))))
(setf (node-visitedp next) t)
(push next return-path))))
(dotimes (k (length bff))
(let ((here (aref bff k)))
(let ((cycle (node-cycle-id here))
(steps-before (node-steps-before here)))
(assert cycle)
(when (and (> steps-before 0)
(= (node-cycle-length cycle) 2))
(if (eq (node-cycle-entry-point here) cycle)
(when (> steps-before (node-max-upstream-a cycle))
(setf (node-max-upstream-a cycle) steps-before))
(when (> steps-before (node-max-upstream-b cycle))
(setf (node-max-upstream-b cycle) steps-before)))))))
(let ((xc-size 0)) ;total size of "extended couples"
(dolist (cycle couples)
(incf xc-size (+ (node-max-upstream-a cycle)
(node-max-upstream-b cycle)
(max biggest-cycle xc-size))))