From 2f674dc80f0382f1c3178f435714960734dc9d3c Mon Sep 17 00:00:00 2001 From: Nguyễn Gia Phong Date: Sat, 6 Jun 2020 21:33:13 +0700 Subject: Reorganize stuff from secondary school --- 12/QG-2014/ballgame.lisp | 49 ------------------------------------------------ 1 file changed, 49 deletions(-) delete mode 100644 12/QG-2014/ballgame.lisp (limited to '12/QG-2014/ballgame.lisp') 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))))))) -- cgit 1.4.1