about summary refs log tree commit diff
path: root/12/QG-2014/ballgame.lisp
diff options
context:
space:
mode:
Diffstat (limited to '12/QG-2014/ballgame.lisp')
-rw-r--r--12/QG-2014/ballgame.lisp49
1 files changed, 0 insertions, 49 deletions
diff --git a/12/QG-2014/ballgame.lisp b/12/QG-2014/ballgame.lisp
deleted file mode 100644
index 765d85c..0000000
--- a/12/QG-2014/ballgame.lisp
+++ /dev/null
@@ -1,49 +0,0 @@
-(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)))))))