1
0
Fork 0
cp/2ndary/12/QG-2014/ballgame.lisp

50 lines
2.2 KiB
Common Lisp

(defun normalize-line (line)
(if (or (and (= (first line) 0) (< (second line) 0))
(< (first line) 0))
(mapcar #'- line)
line))
(defun make-line (x1 x2 y1 y2)
(let* ((a (- y2 y1))
(b (- x1 x2))
(c (+ (* a x1) (* b y1)))
(g (gcd a b c)))
(normalize-line (mapcar (lambda (x) (/ x g)) (list a b c)))))
(defun extract-result (first-pair second-pair)
(let ((triple (union first-pair second-pair)))
(if (= (length triple) 3)
(format nil "~a~a~a" (first triple) (second triple) (third triple))
(format nil "~{~a ~}~a" first-pair (first second-pair)))))
(with-open-file (instream "BALLGAME.INP")
(let ((n (read instream)))
(labels ((read-blues (m result)
(if (<= m n)
(let* ((x (read instream)) (y (read instream)))
(read-blues (1+ m) (cons (list m x y) result)))
result)))
(let ((blues (read-blues 1 '()))
(lines (make-hash-table :test 'equal)))
(labels ((process-reds (m)
(if (<= m n)
(let* ((x (read instream))
(y (read instream))
(result
(dolist (blue blues nil)
(let* ((line (make-line x (second blue)
y (third blue)))
(this-pair (list (first blue) (+ m n)))
(that-pair (gethash line lines)))
(if (null that-pair)
(setf (gethash line lines) this-pair)
(return (extract-result this-pair
that-pair)))))))
(cond (result)
(t (process-reds (1+ m)))))
"-1")))
(with-open-file (outstream "BALLGAME.OUT" :direction :output
:if-exists :supersede)
(princ (process-reds 1) outstream)
(fresh-line outstream)))))))