part-02.scm 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119
  1. (import
  2. (except (rnrs base) let-values map error)
  3. (only (guile)
  4. lambda* λ
  5. current-output-port)
  6. (fileio)
  7. (srfi srfi-1)
  8. ;; let-values
  9. (srfi srfi-11)
  10. ;; hash tables
  11. (srfi srfi-69)
  12. (ice-9 pretty-print))
  13. (define lines (get-lines-from-file "input"))
  14. (define num-rows (length lines))
  15. (define num-cols (string-length (first lines)))
  16. (define trees
  17. (let ([trees (make-array 0 num-rows num-cols)])
  18. (let iter-rows ([lines° lines] [row-ind 0])
  19. (cond
  20. [(null? lines°) trees]
  21. [else
  22. (let iter-cols ([numbers-line° (first lines°)]
  23. [col-ind 0])
  24. (unless (string-null? numbers-line°)
  25. (array-set! trees
  26. (string->number (substring numbers-line° 0 1))
  27. row-ind
  28. col-ind)
  29. (iter-cols (substring numbers-line° 1)
  30. (+ col-ind 1))))
  31. (iter-rows (drop lines° 1)
  32. (+ row-ind 1))]))))
  33. (define step-down
  34. (λ (row col)
  35. (values (+ row 1) col)))
  36. (define step-left
  37. (λ (row col)
  38. (values row (- col 1))))
  39. (define step-up
  40. (λ (row col)
  41. (values (- row 1) col)))
  42. (define step-right
  43. (λ (row col)
  44. (values row (+ col 1))))
  45. (define array-len-in-dim
  46. (λ (arr dim)
  47. (let* ([shape (array-shape arr)]
  48. [dim-min-max (list-ref shape dim)])
  49. (+ (- (second dim-min-max)
  50. (first dim-min-max))
  51. 1))))
  52. (define count-visible-trees-in-direction
  53. (λ (trees init-row-ind init-col-ind step)
  54. (let ([tree-height (array-ref trees init-row-ind init-col-ind)])
  55. ;; already step away 1 step towards the border
  56. (let-values ([(next-row-ind next-col-ind) (step init-row-ind init-col-ind)])
  57. (let iter ([row-ind° next-row-ind] [col-ind° next-col-ind] [counter 0])
  58. (cond
  59. [(array-in-bounds? trees row-ind° col-ind°)
  60. (if (>= (array-ref trees row-ind° col-ind°) tree-height)
  61. (+ counter 1)
  62. (let-values ([(next-row-ind next-col-ind) (step row-ind° col-ind°)])
  63. (iter next-row-ind
  64. next-col-ind
  65. (+ counter 1))))]
  66. [else counter]))))))
  67. (define directional-scores
  68. (λ (trees row-ind col-ind)
  69. (list (count-visible-trees-in-direction trees row-ind col-ind step-up)
  70. (count-visible-trees-in-direction trees row-ind col-ind step-right)
  71. (count-visible-trees-in-direction trees row-ind col-ind step-down)
  72. (count-visible-trees-in-direction trees row-ind col-ind step-left))))
  73. (define score
  74. (λ (trees row-ind col-ind)
  75. (apply *
  76. (filter (λ (s) (not (= s 0)))
  77. (directional-scores trees row-ind col-ind)))))
  78. (define calc-tree-visibility
  79. (λ (trees)
  80. (let* ([rows (array-len-in-dim trees 0)]
  81. [cols (array-len-in-dim trees 1)]
  82. [trees-score (make-array 0 rows cols)]
  83. [max-row-ind (- rows 1)]
  84. [max-col-ind (- cols 1)])
  85. (let iter-rows ([row-ind° 0])
  86. (cond
  87. [(<= row-ind° max-row-ind)
  88. (let iter-cols ([col-ind° 0])
  89. (cond
  90. [(<= col-ind° max-col-ind)
  91. (array-set! trees-score
  92. (score trees row-ind° col-ind°)
  93. row-ind°
  94. col-ind°)
  95. (iter-cols (+ col-ind° 1))]
  96. [else
  97. (iter-rows (+ row-ind° 1))]))]
  98. [else trees-score])))))
  99. (simple-format
  100. (current-output-port)
  101. "~a\n"
  102. (apply max
  103. (map (λ (row) (apply max row))
  104. (array->list (calc-tree-visibility trees)))))