SHARE
TWEET

Untitled

a guest Dec 11th, 2019 66 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (defpackage :aoc-10
  2.   (:use :cl))
  3.  
  4. (in-package :aoc-10)
  5.  
  6. (defun asteroids ()
  7.   (with-open-file (in #P"input10")
  8.     (loop for y from 0 while (listen in)
  9.        nconc (loop for x from 0
  10.                 for char = (read-char in nil 'eof)
  11.                 until (or (eq char #\newline)
  12.                           (eq char 'eof))
  13.                 when (eq char #\#)
  14.                 collect (cons x y)))))
  15.  
  16. (defun circular (lst)
  17.   (setf (cdr (last lst)) lst)
  18.   lst)
  19.  
  20. (defun angle-between (a b)
  21.   (let ((fpi (coerce pi 'single-float)))
  22.     (mod (+ (/ fpi 2) (atan (- (cdr b) (cdr a))
  23.                             (- (car b) (car a))))
  24.          (* fpi 2))))
  25.  
  26. (defun distance-between (a b)
  27.   (+ (abs (- (car a)
  28.              (car b)))
  29.      (abs (- (cdr a)
  30.              (cdr b)))))
  31.  
  32. (defun best-asteroid (asteroids)
  33.   (loop for asteroid in asteroids
  34.      with best-asteroid = nil
  35.      for detected = (length
  36.                      (remove-duplicates
  37.                       (loop for other in asteroids
  38.                          unless (equal asteroid other)
  39.                          collect (angle-between asteroid other))))
  40.      maximizing detected into most-detected
  41.      do (when (= detected most-detected)
  42.           (setq best-asteroid asteroid))
  43.      finally (return (values best-asteroid
  44.                              most-detected))))
  45.  
  46. (defun solve-challenge ()
  47.   (nth-value 1 (best-asteroid (asteroids))))
  48.  
  49. (defun group-consecutive (lst &optional (eq-test #'eq))
  50.   (nreverse (reduce (lambda (acc cur)
  51.                       (if (funcall eq-test cur (caar acc))
  52.                           (cons (cons cur (car acc)) (rest acc))
  53.                           (progn (setf (car acc) (nreverse (car acc)))
  54.                                  (cons (list cur) acc))))
  55.                     (rest lst)
  56.                     :initial-value (list (list (car lst))))))
  57.  
  58. (defun solve-challenge-2 ()
  59.   (destructuring-bind (x . y)
  60.       (loop
  61.          with asteroids = (asteroids)
  62.          with station = (best-asteroid asteroids)
  63.          with grouped = (group-consecutive
  64.                          (sort asteroids
  65.                                (lambda (a b)
  66.                                  (let ((angle-a (angle-between station a))
  67.                                        (angle-b (angle-between station b)))
  68.                                    (if (= angle-a angle-b)
  69.                                        (< (distance-between station a)
  70.                                           (distance-between station b))
  71.                                        (< angle-a angle-b)))))
  72.                          (lambda (a b)
  73.                            (= (angle-between station a)
  74.                               (angle-between station b))))
  75.          repeat 200 for group in (circular grouped)
  76.          for head = (pop group)
  77.          finally (return head))
  78.     (+ (* x 100) y)))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top