advent-of-code-2022/day-04/part-02-improved.scm

(import
 (except (rnrs base) let-values map)
 (only (guile)
       lambda* λ
       string-split)
 (fileio)
 (srfi srfi-1))


(define-syntax ->
  (syntax-rules ()
    ;; first expression is left unchanged
    [(-> expr) expr]
    ;; take from the back, wrap other calls
    [(-> expr* ... (op args* ...))
     (op args* ... (-> expr* ...))]
    ;; make parens unnecessary in trivial case of no further arguments
    [(-> expr* ... op)
     (op (-> expr* ...))]))


(define-syntax define-mapped
  (syntax-rules ()
    [(_ name body-expr)
     (define name
       (λ (arg)
         (map (λ (one)
                (body-expr one))
              arg)))]))


(define make-range
  (λ (a b)
    (cons a b)))

(define string-range->range
  (λ (str-range)
    (let ([parts (string-split str-range #\-)])
      (make-range (string->number (car parts))
                  (string->number (car (cdr parts)))))))

(define range-start
  (λ (range)
    (car range)))

(define range-end
  (λ (range)
    (cdr range)))

(define in-range?
  (λ (num range)
    (and (>= num (range-start range))
         (<= num (range-end range)))))

(define ranges-overlap?
  (λ (range1 range2)
    (or (in-range? (range-start range1) range2)
        (in-range? (range-end range1) range2)
        (in-range? (range-start range2) range1)
        (in-range? (range-end range2) range1))))

(define-mapped split
  (λ (line) (string-split line #\,)))

(define-mapped ranges
  (λ (range-strs)
    (cons (string-range->range (car range-strs))
          (string-range->range (cadr range-strs)))))

(define-mapped matches
  (λ (range-pair)
    (let ([range1 (car range-pair)]
          [range2 (cdr range-pair)])
      (ranges-overlap? range1 range2))))

(define count
  (λ (flags)
    (fold (λ (flag acc)
            (+ acc (if flag 1 0)))
          0
          flags)))


(-> (get-lines-from-file "input")
    split
    ranges
    matches
    count)