about summary refs log tree commit diff
path: root/2ndary/12/QG-2014/ballgame.lisp
blob: 765d85cb44e30733c924a113a565f566e2f9ce15 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
(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)))))))