Quest 8: The Art of Connection

  • 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
    link
    fedilink
    arrow-up
    2
    ·
    9 days ago

    Common Lisp’s loop macro has a pretty crazy list of features. New ones in this solution are for x on xs, which binds the iteration variable x to successive tails (instead of elements) of xs, and maximize, which is an alternative accumulator to sum. There’s nothing interesting about the solution itself though – simple brute-force enumeration.

    (ql:quickload :str)
    
    (defun parse-line (line)
      (mapcar #'parse-integer (str:split "," line)))
    
    (defun read-inputs (filename)
      (let ((input-lines (uiop:read-file-lines filename)))
        (parse-line (car input-lines))))
    
    (defun pairs (ns)
      (loop for tail on ns
            if (not (null (cdr tail)))
              collect (cons (car tail) (cadr tail))))
    
    (defun through-center? (nails segment)
      (destructuring-bind (x . y) segment
        (= (mod (- x y) nails) (/ nails 2))))
    
    (defun main-1 (filename)
      (let ((positions (read-inputs filename)))
        (loop for segment in (pairs positions)
              sum (if (through-center? 32 segment) 1 0))))
    
    (defun crosses? (seg1 seg2)
      "When everything is normalized to 1..nails indices, seg1 crosses seg2 iff one of seg2's
      endpoints lies strictly between the endpoints of seg1, and the other one of seg2's endpoints
      lies strictly below or above the endpoints of seg1."
      (destructuring-bind (x1 . y1) seg1
        (destructuring-bind (x2 . y2) seg2
          (let ((big1 (max x1 y1))
                (small1 (min x1 y1)))
            (or (and (< small1 x2 big1)
                     (or (< y2 small1) (> y2 big1)))
                (and (or (< x2 small1) (> x2 big1))
                     (< small1 y2 big1)))))))
    
    (defun main-2 (filename)
      (let ((positions (read-inputs filename)))
        (loop for seg-list on (pairs positions)
              sum (loop for seg2 in (cdr seg-list)
                        sum (if (crosses? (car seg-list) seg2) 1 0)))))
    
    (defun score (threads seg)
      (loop for thread in threads
            sum (if (crosses? thread seg) 1 0)))
    
    (defun main-3 (filename)
      (let* ((positions (read-inputs filename))
             (threads (pairs positions))
             (nails 256))
        (loop for x1 from 1 to nails
              maximize (loop for y1 from (1+ x1) to nails
                             maximize (score threads (cons x1 y1))))))