Quest 6: Mentorship Matrix

  • 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·
    4 days ago

    In part 3 we can avoid thinking about the structure of the input string (left vs center vs right portions) and get the efficiency back by building up the counts of available mentors in each window position incrementally. The result is more code and takes a lot of space, but minimizes the number of irregular boundary cases.

    (ql:quickload :str)

(defun parse-line (line)
  (let ((result (make-hash-table :test #'equal)))
    (loop for n from 0 to (1- (length line))
          for c = (char line n)
          for old = (gethash c result)
          do (setf (gethash c result) (cons n old)))
    result))

(defun read-inputs (filename)
  (parse-line (car (uiop:read-file-lines filename))))

(defun pairs (pos-hash early-type late-type)
  (loop for early-index in (gethash early-type pos-hash)
        sum (length (remove-if #'(lambda (late-index) (< late-index early-index))
                               (gethash late-type pos-hash)))))

(defun main-1 (filename)
  (pairs (read-inputs filename) #\A #\a))

(defun main-2 (filename)
  (let ((pos-hash (read-inputs filename)))
    (reduce #'+
            (mapcar #'(lambda (type-pair) (apply #'pairs (cons pos-hash type-pair)))
                    '((#\A #\a) (#\B #\b) (#\C #\c))))))

(defun char-at (base-string pos)
  (char base-string (mod pos (length base-string))))

(defun type-window-counts (base-string copies radius type)
  (let* ((max-pos (* copies (length base-string)))
         (counts (make-array max-pos)))
    (setf (aref counts 0)
          (loop for i from 0 to radius
                sum (if (eql type (char-at base-string i)) 1 0)))
    (loop for i from 1 to (1- max-pos)
          do (let ((new-count
                     (+ (aref counts (1- i))
                        (if (and (< (+ i radius) max-pos)
                                 (eql type (char-at base-string (+ i radius))))
                            1 0)
                        (if (and (>= (- i (1+ radius)) 0)
                                 (eql type (char-at base-string (- i (1+ radius)))))
                            -1 0))))
               (setf (aref counts i) new-count)))
    counts))

(defun window-counts (base-string copies radius types)
  (mapcar #'(lambda (type)
              (cons type (type-window-counts base-string copies radius type)))
          types))

(defun count-pairs (base-string copies source-type target-type-window-counts)
  (let ((max-pos (* copies (length base-string))))
    (loop for i from 0 to (1- max-pos)
          sum (if (eql source-type (char-at base-string i))
                  (aref target-type-window-counts i) 0))))

(defun main-3 (filename)
  (let* ((base-string (car (uiop:read-file-lines filename)))
         (copies 1000)
         (radius 1000)
         (type-pairs '((#\a #\A) (#\b #\B) (#\c #\C)))
         (window-counts (window-counts base-string copies radius (mapcar #'cadr type-pairs))))
    (reduce #'+
            (mapcar #'(lambda (type-pair)
                        (count-pairs base-string copies (car type-pair)
                                     (cdr (assoc (cadr type-pair) window-counts))))
                    type-pairs))))