04-08-amidakuji/day4.clj

   1 (ns day4
   2     (:require [clojure.string :as str]))
   3
   4 (defstruct link :height :left :right)
   5
   6 ; (def network (str/split-lines (slurp "../04-small.txt")))
   7 (def network (str/split-lines (slurp "../04-lines.txt")))
   8
   9 (defn parse-link [l, h]
  10     (let [endss (rest (str/split l #"\D+"))
  11           ends (map #(Integer/parseInt %) endss)]
  12         (struct-map link
  13             :height h
  14             :left (first ends)
  15             :right (second ends))))
  16
  17 (defn parse-network [links]
  18     (map-indexed
  19         (fn [i l] (parse-link l i))
  20         links))
  21
  22 (def parsed-network
  23     (parse-network network))
  24
  25
  26 (def initial
  27     (str/split "abcdefghijklmnopqrstuvwxyz" #""))
  28
  29 (defn apply-link [items link]
  30     (let [li (get link :left)
  31           ri (get link :right)
  32           le (nth items li)
  33           re (nth items ri)
  34           pre (subvec items 0 li)
  35           mid (subvec items (inc li) ri)
  36           suf (subvec items (inc ri))]
  37     (into [] (concat pre (vector re) mid (vector le) suf))))
  38
  39 (defn follow [items links]
  40     (reduce apply-link items links))
  41
  42
  43 (defn lane-count [links]
  44     (inc (apply max (map (fn [l] (get l :right)) links))))
  45
  46 (defn initial-heights [links]
  47     (vec (replicate (lane-count links) -1)))
  48
  49 (defn pack-one [lane-heights link]
  50     (let
  51         [li (get link :left)
  52          ri (get link :right)
  53          new-height (inc (max (nth lane-heights li)
  54                               (nth lane-heights ri)))]
  55         (assoc lane-heights li new-height ri new-height)))
  56
  57 (defn pack [lane-heights links]
  58     (reduce pack-one lane-heights links))
  59
  60
  61 (spit "day4.out" (prn-str
  62     (str/join (follow initial parsed-network))))
  63
  64 (spit "day4.out" (prn-str
  65     (apply max
  66         (pack
  67             (initial-heights parsed-network)
  68             parsed-network)))
  69     :append true)
  70