advent-of-code-2022/day-09/part-01.scm

(import
 (except (rnrs base) let-values map error)
 (only (guile)
       lambda* λ
       current-output-port)
 (fileio)
 (srfi srfi-1)
 ;; let-values
 (srfi srfi-11)
 ;; hash tables
 (srfi srfi-69)
 (ice-9 pretty-print))


(define array-len-in-dim
  (λ (arr dim)
    (let* ([shape (array-shape arr)]
           [dim-min-max (list-ref shape dim)])
      (+ (- (second dim-min-max)
            (first dim-min-max))
         1))))

(define distances
  (list->array
   2
   '(((-2 . -2) (-2 . -1) (-2 . 0) (-2 . 1) (-2 . 2))
     ((-1 . -2) (-1 . -1) (-1 . 0) (-1 . 1) (-1 . 2))
     (( 0 . -2) ( 0 . -1) ( 0 . 0) ( 0 . 1) ( 0 . 2))
     (( 1 . -2) ( 1 . -1) ( 1 . 0) ( 1 . 1) ( 1 . 2))
     (( 2 . -2) ( 2 . -1) ( 2 . 0) ( 2 . 1) ( 2 . 2)))))

(define tail-moves
  (list->array
   2
   '(((-1 . -1) (-1 . -1) (-1 . 0) (-1 . 1) (-1 . 1))
     ((-1 . -1) ( 0 .  0) ( 0 . 0) ( 0 . 0) (-1 . 1))
     (( 0 . -1) ( 0 .  0) ( 0 . 0) ( 0 . 0) ( 0 . 1))
     (( 1 . -1) ( 0 .  0) ( 0 . 0) ( 0 . 0) ( 1 . 1))
     (( 1 . -1) ( 1 . -1) ( 1 . 0) ( 1 . 1) ( 1 . 1)))))

(define arrays->hash-table
  (lambda* (keys-arr vals-arrs #:optional (equal-func equal?))
    (let ([rows (array-len-in-dim keys-arr 0)]
          [cols (array-len-in-dim keys-arr 1)]
          [table (make-hash-table equal-func)])
      (let iter-rows ([row-ind 0])
        (let iter-cols ([col-ind 0])
          (cond
           [(< row-ind rows)
            (cond
             [(< col-ind cols)
              (hash-table-set! table
                               (array-ref keys-arr row-ind col-ind)
                               (array-ref vals-arrs row-ind col-ind))
              (iter-cols (+ col-ind 1))]
             [else (iter-rows (+ row-ind 1))])]
           [else table]))))))

(define distances-tail-move-table
  (arrays->hash-table distances tail-moves))

(define move-up
  (λ (coords)
    (cons (- (car coords) 1)
          (cdr coords))))

(define move-down
  (λ (coords)
    (cons (+ (car coords) 1)
          (cdr coords))))

(define move-left
  (λ (coords)
    (cons (car coords)
          (- (cdr coords) 1))))

(define move-right
  (λ (coords)
    (cons (car coords)
          (+ (cdr coords) 1))))

(define move-str-move-table
  (alist->hash-table
   `(("U" . ,move-up)
     ("D" . ,move-down)
     ("L" . ,move-left)
     ("R" . ,move-right))))

(define update-coords
  (λ (coords diff-coords)
    (cons (+ (car coords)
             (car diff-coords))
          (+ (cdr coords)
             (cdr diff-coords)))))

(define coords-diff
  (λ (coords1 coords2)
    (cons (- (car coords1)
             (car coords2))
          (- (cdr coords1)
             (cdr coords2)))))

(define lines (get-lines-from-file "input"))

(define line->moves
  (λ (line)
    (let* ([parts (string-split line #\space)]
           [direction (first parts)]
           [times (string->number (second parts))])
      (let iter ([counter 0])
        (cond
         [(< counter times)
          (cons (hash-table-ref move-str-move-table direction)
                (iter (+ counter 1)))]
         [else '()])))))

(define flatten
  (λ (lst)
    (cond [(null? lst) '()]
          [(pair? lst)
           (append (flatten (car lst))
                   (flatten (cdr lst)))]
          [else
           (list lst)])))

(define moves (flatten (map line->moves lines)))

(define debug-peek
  (lambda* (sth #:optional (message ""))
    (let ([as-string
           (call-with-output-string
             (λ (port)
               (simple-format port "~a" sth)))])
      (simple-format (current-output-port)
                     "~a~a\n"
                     message
                     as-string)
      sth)))

(define tail-visited-table
  (let ([init-coords (cons 0 0)]
        [visited-table (make-hash-table equal?)])
    ;; Do not forget, that the tail is at the initial
    ;; coordinates initially.
    (hash-table-set! visited-table init-coords 1)
    (let iter ([moves° moves]
               ;; Assume that head anf tail both start at
               ;; (0,0).
               [tail-coords (cons 0 0)]
               [head-coords (cons 0 0)])
      (cond
       ;; No more moves? -> Return the table of visited
       ;; coordinates.
       [(null? moves°) visited-table]
       ;; Otherwise process the next move.
       [else
        (let* ([move (debug-peek (first moves°) "move:")]
               [updated-head-coords
                (debug-peek (move head-coords) "updated head:")]
               [head-tail-distance
                (debug-peek (coords-diff updated-head-coords tail-coords)
                            "distance:")]
               [updated-tail-coords
                (debug-peek
                 (update-coords tail-coords
                                (debug-peek
                                 (hash-table-ref distances-tail-move-table
                                                 head-tail-distance)
                                 "tail move:"))
                 "updated tail:")])
          (hash-table-update! visited-table
                              updated-tail-coords
                              (λ (old-count)
                                (+ old-count 1))
                              (λ () 1))
          (iter (drop moves° 1)
                updated-tail-coords
                updated-head-coords))]))))

(define sum
  (λ (lst)
    (apply + lst)))

(simple-format (current-output-port)
               "~a\n"
               (sum
                (map (λ (val) (if (> val 0) 1 0))
                     (hash-table-values tail-visited-table))))