diff options
author | Nguyễn Gia Phong <mcsinyx@disroot.org> | 2020-06-06 21:33:13 +0700 |
---|---|---|
committer | Nguyễn Gia Phong <mcsinyx@disroot.org> | 2020-06-06 21:33:13 +0700 |
commit | 2f674dc80f0382f1c3178f435714960734dc9d3c (patch) | |
tree | 2abba7e4ec72bd16f58f7375126144d3fd9f4bca /12/QG-2014/ballgame.lisp | |
parent | b2d80610db6beda38573890ed169815e495bc663 (diff) | |
download | cp-2f674dc80f0382f1c3178f435714960734dc9d3c.tar.gz |
Reorganize stuff from secondary school
Diffstat (limited to '12/QG-2014/ballgame.lisp')
-rw-r--r-- | 12/QG-2014/ballgame.lisp | 49 |
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))))))) |