1.rkt 1.9 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. #lang racket
  2. (require "../lib/utils.rkt")
  3. (define lines
  4. (call-with-input-file "input"
  5. (λ (fp) (get-lines fp))))
  6. (set! lines (list->vector lines))
  7. (define (expand-rows lines)
  8. (let loop ((cur (vector->list lines)) (ret '()))
  9. (if (null? cur)
  10. (list->vector (reverse ret))
  11. (if (andmap (λ (c) (char=? c #\.)) (string->list (car cur)))
  12. (loop (cdr cur) (cons (car cur) (cons (car cur) ret)))
  13. (loop (cdr cur) (cons (car cur) ret))))))
  14. (define (transpose linesvec)
  15. (define lines (vector->list linesvec))
  16. (define width (string-length (vector-ref linesvec 0)))
  17. (define new-lines (make-vector width))
  18. (let loop ((i 0))
  19. (if (>= i width)
  20. new-lines
  21. (let ()
  22. (define char-list (map (λ (l) (string-ref l i)) lines))
  23. (vector-set! new-lines i (list->string char-list))
  24. (loop (+ i 1))))))
  25. (define universe
  26. (transpose (expand-rows (transpose (expand-rows lines)))))
  27. (define height (vector-length universe))
  28. (define width (string-length (vector-ref universe 0)))
  29. (define (get-galaxies universe)
  30. (define (char-at x y) (string-ref (vector-ref universe y) x))
  31. (let loop ((x 0) (y 0) (ret '()))
  32. (if (>= y height)
  33. (list->vector (reverse ret))
  34. (if (>= x width)
  35. (loop 0 (+ y 1) ret)
  36. (if (char=? #\# (char-at x y))
  37. (loop (+ x 1) y (cons (cons x y) ret))
  38. (loop (+ x 1) y ret))))))
  39. (define galaxies (get-galaxies universe))
  40. (define (gen-pairs n)
  41. (let loop ((i 0) (j 1) (ret '()))
  42. (if (>= i n)
  43. (reverse ret)
  44. (if (>= j n)
  45. (loop (+ 1 i) (+ 2 i) ret)
  46. (loop i (+ 1 j) (cons (cons i j) ret))))))
  47. (define (distance n1 n2)
  48. (define x1 (car (vector-ref galaxies n1)))
  49. (define x2 (car (vector-ref galaxies n2)))
  50. (define y1 (cdr (vector-ref galaxies n1)))
  51. (define y2 (cdr (vector-ref galaxies n2)))
  52. (+ (abs (- x1 x2)) (abs (- y1 y2))))
  53. (apply
  54. +
  55. (map (λ (x) (distance (car x) (cdr x)))
  56. (gen-pairs (vector-length galaxies))))