Guest User

Untitled

a guest
Dec 11th, 2019
74
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