• 0 Posts
  • 3 Comments
Joined 1 year ago
cake
Cake day: June 18th, 2023

  • Lisp

    Could probably just write points right to the results instead of to an intermediate list, but it runs instantly, so my motivation to do so was low.

    Code
    (defun p1-process-line (line)
       (to-symbols line 'advt2024-d8))
      
    (defun count-results (results)
      (loop for i from 0 below (array-total-size results)
            count (row-major-aref results i)))
    
    (defun place-annode (pos results)
      (let ((x (first pos)) (y (second pos)))
        (when (in-map results x y) 
          (setf (aref results y x) t))))
    
    (defun create-annodes-p1 (x1 y1 x2 y2)
      (let ((delta-x (- x2 x1)) (delta-y (- y2 y1)))
        (list (list (- x1 delta-x) (- y1 delta-y)) (list (+ x2 delta-x) (+ y2 delta-y)))))
    
    (defun place-annodes (positions results create-annodes)
      (when positions
         (loop with a = (car positions)
               with x1 = (first a)
               with y1 = (second a)
               for b in (cdr positions)
               for ans = (funcall create-annodes x1 y1 (first b) (second b))
               do (dolist (a ans) (place-annode a results)))
         (place-annodes (cdr positions) results create-annodes)))
    
    (defun place-all-annodes (xmits map &optional (create-annodes #'create-annodes-p1))
      (let ((results (make-array (array-dimensions map) :element-type 'boolean :initial-element nil)))
        (loop for k being the hash-key of xmits
              do (place-annodes (gethash k xmits) results create-annodes))
        results))
    
    (defun find-transmitters (map)
      "look throught the map and record where the transmitters are in a hash map"
      (let ((h (make-hash-table)))
        (destructuring-bind (rows cols) (array-dimensions map)
          (loop for j from 0 below rows
                do (loop for i from 0 below cols
                         for v = (aref map j i)
                         unless (eql v '|.|)
                           do (push (list i j) (gethash v h))
                         )))
        h))
    
    (defun run-p1 (file) 
      (let* ((map (list-to-2d-array (read-file file #'p1-process-line))))
        (count-results (place-all-annodes (find-transmitters map) map))
        ))
    
    (defun create-annodes-2 (x1 y1 x2 y2 map)
      (destructuring-bind (rows cols) (array-dimensions map)
        (let* ((m (/ (- y2 y1) (- x2 x1) ))
               (b (- y2 (* m x2))))
          (loop for x from 0 below cols
                for y = (+ b (* x m))
                for r = (nth-value 1 (floor y))
                when (and (= r 0) (>= y 0) (< y rows))
                  collect (list x y)))))
    
    (defun run-p2 (file) 
      (let* ((map (list-to-2d-array (read-file file #'p1-process-line))))
        (count-results (place-all-annodes (find-transmitters map) map
                                          (lambda (x1 y1 x2 y2)
                                            (create-annodes-2 x1 y1 x2 y2 map))))))
    
    

  • Lisp

    Could probably go much faster if I kept track of calculations to not repeat, but 4 seconds for part 2 on my old laptop is good enough for me. Also, not really a big change from part 1 to part 2.

    Part 1 and 2
    
    (defstruct calibration result inputs)
    
    (defun p1-process-line (line)
      (let ((parts (str:words line)))
        (make-calibration :result (parse-integer (car parts) :junk-allowed t)
                          :inputs (mapcar #'parse-integer (cdr parts)))))
    
    (defun apply-opperators (c opps)
      (let ((accum (car (calibration-inputs c))))
      (loop for o in opps
            for v in (cdr (calibration-inputs c))
            until (> accum (calibration-result c))
            if (eql o 'ADD)
              do (setf accum (+ accum v))
            else if (eql o 'MUL)
              do (setf accum (* accum v))
            else
              do (setf accum (+ v (* accum (expt 10 (1+ (floor (log v 10)))))))
            finally (return accum)
            )))
    
    (defun generate-operators (item-count)
      (labels ((g-rec (c results)
                 (if (< c 1)
                     results
                     (g-rec (1- c) (loop for r in results
                                         collect (cons 'ADD r)
                                         collect (cons 'MUL r))))))
        (g-rec (1- item-count) '((ADD) (MUL)))))
    
    (defun generate-ops-hash (c gen-ops)
      (let ((h (make-hash-table)))
        (dotimes (x c)
          (setf (gethash (+ 2 x) h) (funcall gen-ops (+ 1 x))))
        h))
    
    (defun validate-calibration (c ops-h)
      (let ((r (calibration-result c))
            (ops (gethash (length (calibration-inputs c)) ops-h)))
        (loop for o in ops
              for v = (apply-opperators c o)
              when (= v r)
                return t)))
    
    (defun run-p1 (file) 
      (let ((calibrations  (read-file file #'p1-process-line))
            (ops (generate-ops-hash 13 #'generate-operators)))
        (loop for c in calibrations
              when (validate-calibration c ops)
                sum (calibration-result c))))
    
    (defun generate-operators-p2 (item-count)
      (labels ((g-rec (c results)
                 (if (< c 1)
                     results
                     (g-rec (1- c) (loop for r in results
                                         collect (cons 'ADD r)
                                         collect (cons 'MUL r)
                                         collect (cons 'CAT r))))))
        (g-rec (1- item-count) '((ADD) (MUL) (CAT)))))
    
    (defun run-p2 (file) 
      (let ((calibrations  (read-file file #'p1-process-line))
            (ops (generate-ops-hash 13 #'generate-operators-p2)))
        (loop for c in calibrations
              when (validate-calibration c ops)
                sum (calibration-result c))))