Quest 5: Fishbone Order

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL

Link to participate: https://everybody.codes/

  • ystael@beehaw.org
    2·
    5 days ago

    Does anybody miss old-school Lisp mutable data structures where you’re kinda a functional language but you still have to worry about the difference between values and object identity? I’m not sure anybody does, but this is a retrocomputing house.

    (ql:quickload :str)

(defun parse-line (line)
  (let* ((id-and-nums (str:split ":" line))
         (id (parse-integer (car id-and-nums)))
         (nums (mapcar #'parse-integer (str:split "," (cadr id-and-nums)))))
    (cons id nums)))

(defun read-inputs (filename)
  (mapcar #'parse-line (uiop:read-file-lines filename)))

(defun fishbone-push (fb n)
  (if (null fb)
      (list (vector nil n nil))
      (let ((rib (car fb)))
        (cond ((and (null (aref rib 0))
                    (< n (aref rib 1)))
               (setf (aref rib 0) n)
               fb)
              ((and (null (aref rib 2))
                    (> n (aref rib 1)))
               (setf (aref rib 2) n)
               fb)
              ((null (cdr fb))
               (nconc fb (fishbone-push (cdr fb) n)))
              (t
               (fishbone-push (cdr fb) n)
               fb)))))

(defun make-fishbone (ns)
  (reduce #'fishbone-push ns :initial-value nil))

(defun quality (ns)
  (let ((fb (make-fishbone ns)))
    (parse-integer (apply #'str:concat
                          (mapcar #'(lambda (rib) (write-to-string (aref rib 1)))
                                  fb)))))

(defun main-1 (filename)
  (quality (cdar (read-inputs filename))))

(defun main-2 (filename)
  (let ((qualities (mapcar #'quality (mapcar #'cdr (read-inputs filename)))))
    (- (apply #'max qualities) (apply #'min qualities))))

(defun complex-quality (idx ns)
  (let* ((fb (make-fishbone ns))
         (quality
           (parse-integer (apply #'str:concat
                                 (mapcar #'(lambda (rib) (write-to-string (aref rib 1)))
                                         fb))))
         (rib-qualities
           (mapcar #'(lambda (rib)
                       (parse-integer
                        (apply #'str:concat
                               (mapcar #'write-to-string
                                       (remove-if #'null (coerce rib 'list))))))
                   fb)))
    (list (cons :quality quality)
          (cons :rib-qualities rib-qualities)
          (cons :index idx))))

(defun list> (ns1 ns2)
  (cond ((null ns1) nil)
        ((null ns2) t)
        ((> (car ns1) (car ns2)) t)
        ((< (car ns1) (car ns2)) nil)
        (t (list> (cdr ns1) (cdr ns2)))))

(defun cq> (cq1 cq2)
  (let ((q1 (cdr (assoc :quality cq1)))
        (q2 (cdr (assoc :quality cq2))))
    (cond ((> q1 q2) t)
          ((< q1 q2) nil)
          (t
           (let ((rq1 (cdr (assoc :rib-qualities cq1)))
                 (rq2 (cdr (assoc :rib-qualities cq2))))
             (cond ((list> rq1 rq2) t)
                   ((list> rq2 rq1) nil)
                   (t
                    (> (cdr (assoc :index cq1))
                       (cdr (assoc :index cq2))))))))))

(defun checksum (idxs)
  (loop for idx in idxs
        for n from 1 to (length idxs)
        sum (* idx n)))

(defun main-3 (filename)
  (let ((inputs (read-inputs filename))
        (sword-qualities (make-hash-table)))
    (loop for idx-ns in inputs
          do (setf (gethash (car idx-ns) sword-qualities)
                   (complex-quality (car idx-ns) (cdr idx-ns))))
    (let ((sorted-idxs
            (sort (mapcar #'car inputs)
                  #'(lambda (idx1 idx2)
                      (cq> (gethash idx1 sword-qualities)
                           (gethash idx2 sword-qualities))))))
      (checksum sorted-idxs))))