summaryrefslogtreecommitdiff
path: root/Day14.lean
blob: bbaa616fffa69ed62318cb9d34bceadeb9435201 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
import «Common»

namespace Day14

------------------------------------------------------------------------------------

inductive Tile
| Space
| Cube
| Round
deriving Repr, BEq

instance : LawfulBEq Tile where
  rfl := λ{a}  by cases a <;> decide
  eq_of_beq := by intros a b; cases a <;> cases b <;> simp <;> decide

instance: ToString Tile where
toString := λ
| Tile.Space => "."
| Tile.Cube => "#"
| Tile.Round => "O"

structure ParseCharError where
unexpectedCharacter : Char

instance : ToString ParseCharError where
toString := λc  s!"Unexpected Character '{c.unexpectedCharacter}', expected '.', '#', or 'O'."

private def Tile.ofChar? : Char  Except ParseCharError Tile
| '.' => pure Tile.Space
| '#' => pure Tile.Cube
| 'O' => pure Tile.Round
| c => throw {unexpectedCharacter := c}

abbrev ControlPanel := Parsing.RectangularGrid Tile

abbrev ParseInputError := Parsing.RectangularGrid.ParseError ParseCharError

def parse : String  Except ParseInputError ControlPanel :=
  Parsing.RectangularGrid.ofSubstring Tile.ofChar?  String.toSubstring

------------------------------------------------------------------------------------

/-
there's probably a better way, but I'm too lazy, so I'll just move them row-by-row.
pseudocode
for(row)
  for(column)
    if(tile == Round)
      moveTileAsFarNorthAsPossible
-/

/-- Finds the northmost free space reachable from start. Does not look at start. -/
private def findNorthmostFreeTile {controlPanel : ControlPanel} (start : controlPanel.Coordinate) : controlPanel.Coordinate :=
  if start.y > 0,controlPanel.not_empty.right then
    let northNeighbour := { start with y := start.y - 1,Nat.lt_imp_pred_lt start.y.isLt }
    match controlPanel[northNeighbour] with
    | Tile.Space => findNorthmostFreeTile northNeighbour
    | Tile.Round | Tile.Cube => start
  else
    start
termination_by start.y

private def moveTileNorth {controlPanel : ControlPanel} (position : controlPanel.Coordinate) : ControlPanel :=
  match controlPanel[position] with
  | Tile.Space | Tile.Cube => controlPanel
  | Tile.Round =>
    let intermediate := controlPanel.set position Tile.Space
    let positionInIntermediate : intermediate.Coordinate := {x := position.x, y := position.y} -- how? well, I won't complain
    let northMost := findNorthmostFreeTile positionInIntermediate
    intermediate.set northMost Tile.Round

private theorem moveTileNorth_same_size {controlPanel : ControlPanel} (position : controlPanel.Coordinate) : (moveTileNorth position).width = controlPanel.width  (moveTileNorth position).height = controlPanel.height := by
  constructor
  all_goals
    unfold moveTileNorth
    match controlPanel[position] with
    | Tile.Space | Tile.Cube => trivial
    | Tile.Round =>
      simp only[Parsing.RectangularGrid.set_same_size]

/-
-- Old solution, without do-notation. Proven to terminate, but needs a lot more code...

/- had to move this to top level function to be able to prove stuff with it... "Declaration contains metavariables" -/
private def moveAllTilesNorth_handleColumns (cp : ControlPanel) (row : Fin cp.height) (column : Fin cp.width) : ControlPanel :=
    let intermediate := moveTileNorth {x := column, y := row : cp.Coordinate}
    let nextIndex := column.val + 1
    if h : nextIndex < intermediate.width then
      have h₁ : intermediate.height = cp.height := (moveTileNorth_same_size {x := column, y := row : cp.Coordinate}).right
      moveAllTilesNorth_handleColumns intermediate (h₁▸row) ⟨nextIndex,h⟩
    else
      intermediate
  termination_by cp.width - column
  decreasing_by
    have h₂ := (moveTileNorth_same_size { x := column, y := row }).left
    rw[h₂] at h ⊢
    exact Nat.sub_lt_of_gt (Nat.le_of_lt h) (Nat.lt_succ.mpr $ Nat.le_refl _)

private theorem moveAllTilesNorth_handleColumns_same_height (cp : ControlPanel) (row : Fin cp.height) (column : Fin cp.width) : (moveAllTilesNorth_handleColumns cp row column).height = cp.height := by
  unfold moveAllTilesNorth_handleColumns
  simp
  have h₂ := (moveTileNorth_same_size { x := column, y := row }).right
  split
  case isFalse => exact h₂
  case isTrue =>
    have := moveAllTilesNorth_handleColumns_same_height (Day14.moveTileNorth { x := column, y := row }) (h₂ ▸ row) ⟨↑column + 1, by assumption⟩
    simp[h₂] at this
    assumption
  termination_by cp.width - column
  decreasing_by
    have h₂ := (moveTileNorth_same_size { x := column, y := row }).left
    rename_i h
    rw[h₂] at h ⊢
    exact Nat.sub_lt_of_gt (Nat.le_of_lt h) (Nat.lt_succ.mpr $ Nat.le_refl _)

private def moveAllTilesNorth (controlPanel : ControlPanel) : ControlPanel :=
  handleRows (controlPanel) ⟨0,controlPanel.not_empty.right⟩
where
  handleRows (cp : ControlPanel) (row : Fin cp.height) : ControlPanel :=
    let intermediate := moveAllTilesNorth_handleColumns cp row ⟨0,cp.not_empty.left⟩
    let nextIndex := row.val + 1
    if h : nextIndex < intermediate.height then
      handleRows intermediate ⟨nextIndex, h⟩
    else
      intermediate
    termination_by cp.height - row
    decreasing_by
      have h₁ : intermediate.height = cp.height :=
        moveAllTilesNorth_handleColumns_same_height cp row ⟨0,_⟩
      rw[h₁] at h ⊢
      exact Nat.sub_lt_of_gt (Nat.le_of_lt h) (Nat.lt_succ.mpr $ Nat.le_refl _)
-/

private def moveAllTilesNorth (controlPanel : ControlPanel) : ControlPanel := Id.run do
  let mut result : ((c : ControlPanel) ×' (c.width = controlPanel.width  c.height = controlPanel.height)) := controlPanel, rfl,rfl⟩⟩
  for hr :row in [:controlPanel.height] do
    for hc : column in [:controlPanel.width] do
      let x : Fin result.fst.width := Fin.cast result.snd.left.symm column,hc.upper
      let y : Fin result.fst.height := Fin.cast result.snd.right.symm row,hr.upper
      let coordinate : result.fst.Coordinate := {x, y}
      have : (moveTileNorth coordinate).width = controlPanel.width  (moveTileNorth coordinate).height = controlPanel.height :=
        (moveTileNorth_same_size coordinate).right.substr $ (moveTileNorth_same_size coordinate).left.substr result.snd
      result := moveTileNorth coordinate, this
  result.fst

private def weightOnNorthSupport (controlPanel : ControlPanel) : Nat := Id.run do
  let mut score := 0
  for hr :row in [:controlPanel.height] do
    for hc : column in [:controlPanel.width] do
      let coordinate := {x := column,hc.upper, y := row,hr.upper : controlPanel.Coordinate}
      if controlPanel[coordinate] == Tile.Round then
        score := score + (controlPanel.height - row)
  score

def part1 : (input : ControlPanel)  Nat := weightOnNorthSupport  moveAllTilesNorth

------------------------------------------------------------------------------------

open DayPart
instance : Parse 14, by simp (ι := ControlPanel) where
  parse := Except.mapError toString  parse

instance : Part 14,_⟩ Parts.One (ι := ControlPanel) (ρ := Nat) where
  run := some  part1

------------------------------------------------------------------------------------

private def testInput := "O....#....
O.OO#....#
.....##...
OO.#O....O
.O.....O#.
O.#..O.#.#
..O..#O..O
.......O..
#....###..
#OO..#...."

#eval parse testInput

#eval (weightOnNorthSupport  moveAllTilesNorth) <$> parse testInput