AoC 2021, day 10

day10.lisp

(defun read-lines (path)      ;; read lines just try this out
  (with-open-file (stream path :direction :input :if-does-not-exist :error)
    (let ((res (make-array 0 :adjustable t
                             :fill-pointer 0
                             :element-type 'string)))
      (loop :for line := (read-line stream nil nil)
            :while line
            :do (vector-push-extend line res))
      res)))


(defun match (a)    ;; shame there's no better way of doing this
  (ecase a
    (#\) #\()
    (#\] #\[)
    (#\} #\{)
    (#\> #\<)))


(defun check-line (line)     ;; my naming sucks
  (let ((stack (make-array 0 :adjustable t :fill-pointer 0
                             :element-type 'character)))
    (loop :for ch :across line
          :do (if (member ch '(#\( #\[ #\{ #\<))
                  (vector-push-extend ch stack)
                  (let* ((match (match ch))
                         (l (length stack)))
                    (cond ((= 0 l)
                           (return ch))
                          ((char/= match (aref stack (- l 1)))
                           (return ch))
                          (t (vector-pop stack))))))))


(defun day10.1 (path)   ;; stupid part 1 solution
  (let ((lines (read-lines path)))
    (loop :for line :across lines
          :for corrupt := (check-line line)
          :sum (case corrupt
                 (#\) 3)
                 (#\] 57)
                 (#\} 1197)
                 (#\> 25137)
                 (otherwise 0)))))


(defun reverse-match (a)   ;; yeah I need this too
  (ecase a
    (#\( #\))
    (#\[ #\])
    (#\{ #\})
    (#\< #\>)))


(defun line-score (line)   ;; most likely this can be divided into 2 functions
  (let ((stack (make-array 0 :adjustable t :fill-pointer 0
                             :element-type 'character)))
    (loop :for ch :across line
          :do (if (member ch '(#\( #\[ #\{ #\<))
                  (vector-push-extend ch stack)
                  (let* ((match (match ch))
                         (l (length stack)))
                    (cond ((= 0 l)
                           (return-from line-score 0))
                          ((char/= match (aref stack (- l 1)))
                           (return-from line-score 0))
                          (t (vector-pop stack))))))
    (let ((filler (map 'string #'reverse-match (nreverse stack)))  ;; <- this is sooo dumb
          (sum 0))
      (loop :for ch :across filler
            :for score := (ecase ch
                            (#\) 1)
                            (#\] 2)
                            (#\} 3)
                            (#\> 4))
            :do (setf sum (+ score (* sum 5))))
      sum)))

;; This is median function implementation, taken from day 7
(declaim (inline fixnum-array-swap))
(defun fixnum-array-swap (array i j) ;; cool trick right
  (setf (aref array i) (logxor (aref array i) (aref array j))
        (aref array j) (logxor (aref array j) (aref array i))
        (aref array i) (logxor (aref array i) (aref array j))))

(defun partition (array from to) ;; this was VERY painful to get right
  (let* ((pivot (aref array (floor (+ from to) 2))))
    (loop :with i := from
          :with j := (- to 1)
          :do (loop  :while (< (aref array i) pivot)
                     :do (incf i))
          :do (loop :while (> (aref array j) pivot)
                    :do (decf j))
          :when (>= i j)
            :return (- j from)
          :do (fixnum-array-swap array i j)
          :when (= (aref array i) (aref array j))
            :do (incf i))))


(defun kth-order (k array from to) ;; p a i n
  (if (= 1 (- to from))
      (aref array from)
      (let ((mid (partition array from to)))
        (if (< k mid)
            (kth-order k array from (+ from mid))
            (kth-order (- k mid) array (+ from mid) to)))))


(defun median (array from to)  ;; actual median
  (kth-order (floor (- to from) 2) array from to))
;; There it is, a median


(defun day10.2 (path)  ;; collect scores, calc median
  (let ((lines (read-lines path))
        (scores (make-array 0 :adjustable t :fill-pointer 0 :element-type 'fixnum)))
    (loop :for line :across lines
          :for score := (line-score line)
          :unless (= 0 score)
            :do (vector-push-extend score scores))
    (median scores 0 (length scores))))




;;;;-------------------------Optimizations-------------------------


(defun day10.1-fast (path) ;; N O A L L O C
  (with-open-file (stream path :direction :input :if-does-not-exist :error)
    (flet ((score (ch)
             (ecase ch
               (#\) 3)
               (#\] 57)
               (#\} 1197)
               (#\> 25137))))
      (loop :while (peek-char t stream nil nil)
            :sum  (let ((stack (make-array 100 :adjustable t :fill-pointer 0
                                               :element-type 'character
                                               :initial-element #\())) ;; okay this allocates
                    (declare (dynamic-extent stack))                   ;; but on the stack
                    (loop :for ch := (read-char stream nil nil)        ;; so it doesn't count
                          :while ch                                    ;; haha
                          :until (char= ch #\Newline)
                          :do (if (member ch '(#\( #\[ #\{ #\<))
                                  (vector-push-extend ch stack)
                                  (let* ((match (match ch))
                                         (l (length stack)))
                                    (if (or (= 0 l) (char/= match (aref stack (- l 1))))
                                        (progn
                                          (loop :for toskip := (read-char stream nil nil)
                                                :until (char= #\Newline toskip))
                                          (return (score ch)))
                                        (vector-pop stack))))
                          :finally (return 0)))))))




(defun day10.2-fast (path) ;; behold (the idea is the same, to not allocate anything except stack and score vector)
  (declare (optimize (speed 3) (safety 0) (space 0)))   ;; go fast
  (with-open-file (stream path :direction :input :if-does-not-exist :error) ;; open file
    (flet ((score (ch) ;this is local function
             (ecase ch 
               (#\) 1)
               (#\] 2)
               (#\} 3)
               (#\> 4))))
     (let ((scores (make-array 10 :adjustable t :fill-pointer 0 :element-type 'fixnum)))
       (declare (dynamic-extent scores))  ;; allocate on stack
       (loop :while (peek-char t stream nil nil)  ;; while not eof basically
             :for score   ;; score will be bound the the result of this huge form
               := (let ((stack (make-array 100 :adjustable t :fill-pointer 0
                                               :element-type 'character
                                               :initial-element #\()))
                    (declare (dynamic-extent stack))  ;; stack on stack
                    (loop :for ch := (read-char stream nil nil)
                          :while ch
                          :until (char= ch #\Newline) ;; read char until newline
                          :do (if (member ch '(#\( #\[ #\{ #\<))
                                  (vector-push-extend ch stack)
                                  (let* ((match (match ch))
                                         (l (length stack)))
                                    (if (or (= 0 l) (char/= match (aref stack (- l 1))))  ;; if corrupted, whatever
                                        (progn                                            ;; need to skip to the end of the line
                                          (loop :for toskip := (read-char stream nil nil) ;; actually doing it
                                                :until (char= #\Newline toskip))
                                          (return 0))                                     ;; return 0, like in C
                                        (vector-pop stack))))
                          :finally (return   ;; this finally claus is here cuz we need to return from that loop block
                                     (loop :with sum :of-type fixnum := 0    ;; that's why I have a loop in a loop in a loop
                                           :for i :from (- (length stack) 1) :downto 0  ;; hard to understand I get it
                                           :for score := (score (reverse-match (aref stack i))) ;; <- btw calculating score here
                                           :do (setf sum (+ score (* sum 5)))  ;; this bullshit yes
                                           :finally (return sum)))))
             :unless (= 0 score) ;; ignore 0s
               :do (vector-push-extend score scores))
       (median scores 0 (length scores)))))) ;; median is used woohoo