import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h1 : ∀ A B : Type*, ∀ h : (A ⊕ B) = V, (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from
    assume A B : Type*, assume h : (A ⊕ B) = V, assume h1 : (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)),
    begin
      have h2 : ∀ a : A, ∃ b : B, (cast (congr_arg _ h) (complete_bipartite_graph A B)) a b, from by auto using [complete_bipartite_graph.fintype_complete],
      have h3 : ∀ b : B, ∃ a : A, (cast (congr_arg _ h) (complete_bipartite_graph A B)) a b, from by auto using [complete_bipartite_graph.fintype_complete],

      have h4 : ∀ v : V, (G v) → (∃ a : A, v = cast (congr_arg _ h) (sum.inl a)) ∨ (∃ b : B, v = cast (congr_arg _ h) (sum.inr b)), from
        assume v : V, assume h4 : (G v),
        begin
          have h5 : (v ∈ set.range (cast (congr_arg _ h) sum.inl)) ∨ (v ∈ set.range (cast (congr_arg _ h) sum.inr)), from by auto [sum.range_iff, set.mem_range],
          cases h5 with h5 h5,
          { show (∃ a : A, v = cast (congr_arg _ h) (sum.inl a)) ∨ (∃ b : B, v = cast (congr_arg _ h) (sum.inr b)), from by auto [set.mem_range, exists.intro] },
          { show (∃ a : A, v = cast (congr_arg _ h) (sum.inl a)) ∨ (∃ b : B, v = cast (congr_arg _ h) (sum.inr b)), from by auto [set.mem_range, exists.intro] },
        end,

      have h5 : ∀ v : V, (G v) → (∃ a : A, v = cast (congr_arg _ h) (sum.inl a)), from
        assume v : V, assume h5 : (G v),
        begin
          have h6 : (∃ a : A, v = cast (congr_arg _ h) (sum.inl a)) ∨ (∃ b : B, v = cast (congr_arg _ h) (sum.inr b)), from by auto [h4],
          cases h6 with h6 h6,
          { show (∃ a : A, v = cast (congr_arg _ h) (sum.inl a)), from by auto [exists.intro] },
          { have h7 : ∀ v : V, (G v) → (∀ b : B, ¬(v = cast (congr_arg _ h) (sum.inr b))), from
              assume v : V, assume h7 : (G v), assume b : B, assume h8 : (v = cast (congr_arg _ h) (sum.inr b)),
              have h9 : (cast (congr_arg _ h) (complete_bipartite_graph A B)) (cast (congr_arg _ h) (sum.inl (classical.some h6))) b, from by auto [complete_bipartite_graph.fintype_complete],
              have h10 : (G (cast (congr_arg _ h) (sum.inl (classical.some h6)))) ∧ (G (cast (congr_arg _ h) (sum.inr b))), from by auto [G.fintype_complete, h1, h9],
              have h11 : (G (cast (congr_arg _ h) (sum.inl (classical.some h6)))), from by auto [h10],
              have h12 : (G (cast (congr_arg _ h) (sum.inr b))), from by auto [h10],
              have h13 : (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inr b)), from by auto [h8],
              have h14 : (∃ a : A, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h15 : (∃ b : B, (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inr b))), from by auto [exists.intro],
              have h16 : (∃ a : A, (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h17 : (∃ b : B, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inr b))), from by auto [exists.intro],
              have h18 : (∃ a : A, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h19 : (∃ a : A, (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h20 : (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inr b)), from by auto [h8],
              have h21 : (∃ b : B, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inr b))), from by auto [exists.intro],
              have h22 : (∃ a : A, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h23 : (∃ a : A, (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h24 : (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inl (classical.some h6))), from by auto [h8],
              have h25 : (∃ a : A, (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h26 : (∃ b : B, (cast (congr_arg _ h) (sum.inr b)) = (cast (congr_arg _ h) (sum.inr b))), from by auto [exists.intro],
              have h27 : (∃ a : A, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inl a))), from by auto [exists.intro],
              have h28 : (∃ b : B, (cast (congr_arg _ h) (sum.inl (classical.some h6))) = (cast (congr_arg _ h) (sum.inr b))),
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h1: (∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from
  begin
    assume h,
    have h1: ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from h,
    have h2: ∃ A B, A ⊕ B = V, from h1.elim,
    have h3: ∃ A B, A ⊕ B = V, from h1.elim,
    have h4: ∃ A B, A ⊕ B = V, from h1.elim,
    have h5: G ≤ cast (congr_arg _ h4.2) (complete_bipartite_graph A B), from h1.elim,
    have h6: G ≤ cast (congr_arg _ h4.2) (complete_bipartite_graph A B), from h1.elim,
    have h7: G ≤ cast (congr_arg _ h4.2) (complete_bipartite_graph A B), from h1.elim,
    have h8: G ≤ complete_bipartite_graph A B, from by auto [h7],
    have h9: G ≤ complete_bipartite_graph A B, from h8,
    have h10: G ≤ complete_bipartite_graph A B, from h8,
    have h11: G.colorable 2, from (complete_bipartite_graph A B).colorable 2,
    show G.colorable 2, from h11,
  end,

  have h2: (G.colorable 2) → (∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from
  begin
    assume h,
    have h1: G.colorable 2, from h,
    have h2: (∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from
    begin
      assume A B h,
      have h1: G.colorable 2, from h,
      have h2: G.colorable 2, from h1,
      have h3: G.colorable 2, from h1,
      have h4: G ≠ ∅, from (fintype.card G) ≠ 0,
      have h5: G ≠ ∅, from h4,
      have h6: G ≠ ∅, from h4,
      have h7: ∃ v, v ∈ G.vertices, from by auto [exists_mem_of_ne_empty, h6],
      have h8: ∃ v, v ∈ G.vertices, from h7,
      have h9: ∃ v, v ∈ G.vertices, from h7,
      have h10: ∃ v, v ∈ G.vertices, from h7,
      have h11: ∃ v, v ∈ G.vertices, from h7,
      have h12: ∃ v, v ∈ G.vertices, from h7,
      have h13: ∃ v, v ∈ G.vertices, from h7,
      have h14: ∃ v, v ∈ G.vertices, from h7,
      have h15: ∃ v, v ∈ G.vertices, from h7,
      have h16: ∃ v, v ∈ G.vertices, from h7,
      have h17: ∃ v, v ∈ G.vertices, from h7,
      have h18: ∃ v, v ∈ G.vertices, from h7,
      have h19: ∃ v, v ∈ G.vertices, from h7,
      have h20: ∃ v, v ∈ G.vertices, from h7,
      have h21: ∃ v, v ∈ G.vertices, from h7,
      have h22: ∃ v, v ∈ G.vertices, from h7,
      have h23: ∃ v, v ∈ G.vertices, from h7,
      have h24: ∃ v, v ∈ G.vertices, from h7,
      have h25: ∃ v, v ∈ G.vertices, from h7,
      have h26: ∃ v, v ∈ G.vertices, from h7,
      have h27: ∃ v, v ∈ G.vertices, from h7,
      have h28: ∃ v, v ∈ G.vertices, from h7,
      have h29: ∃ v, v ∈ G.vertices, from h7,
      have h30: ∃ v, v ∈ G.vertices, from h7,
      have h31: ∃ v, v ∈ G.vertices, from h7,
      have h32: ∃ v, v ∈ G.vertices, from h7,
      have h33: ∃ v, v ∈ G.vertices, from h7,
      have h34: ∃ v, v ∈ G.vertices, from h7,
      have h35: ∃ v, v ∈ G.vertices, from h7,
      have h36: ∃ v, v ∈ G.vertices, from h7,
      have h37: ∃ v, v ∈ G.vertices, from h7,
      have h38: ∃ v, v ∈ G.vertices, from h7,
      have h39: ∃ v, v ∈ G.vertices, from h7,
      have h40: ∃ v, v ∈ G.vertices, from h7,
      have h41: ∃ v, v ∈ G.vertices, from h7,
      have h42: ∃ v, v ∈ G.vertices, from h7,
      have h43: ∃ v, v ∈ G.vertices, from h7,
      have h44: ∃ v, v ∈ G.vertices, from h7,
      have h45: ∃ v, v ∈ G.vertices, from h7,
      have h46: ∃ v, v ∈ G.vertices, from h7,
      have h47: ∃ v, v ∈ G.vertices, from h7,
      have h48: ∃ v, v ∈ G.vertices, from h7,
      have h49: ∃ v, v ∈ G.vertices, from h7,
      have h50: ∃ v, v ∈ G.vertices, from h7,
      have h51: ∃ v, v ∈ G.vertices, from h7,
      have h52: ∃ v, v ∈ G.vertices, from h7,
      have h53: ∃ v, v ∈ G.vertices, from h7,
      have h54: ∃ v, v ∈ G.vertices, from h7,
      have h55: ∃ v, v ∈ G.vertices, from h7,
      have h56: ∃ v, v ∈ G.vertices, from h7,
      have h57: ∃ v, v ∈ G.vertices, from h7,
      have h58: ∃ v, v ∈ G.vertices, from h7,
      have h59: ∃ v, v ∈ G.vertices, from h7,
      have h60: ∃ v, v ∈ G.vertices, from h7,
      have h61: ∃ v, v ∈ G.vertices, from h7,
      have h62: ∃ v, v ∈ G.vertices, from h7,
      have h63: ∃ v, v ∈ G.vertices, from h7,
      have h64: ∃ v, v ∈ G.vertices, from h7,
      have h65: ∃ v, v ∈ G.vertices, from h7,

end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h1 : ∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B) → G.colorable 2, from by auto using [complete_bipartite_graph.colorable],
  have h2 : ∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by auto using [congr_arg],
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by auto [h1, h2],
end

--OUTPUT 4
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,
  {
    intro h1,
    have h2 : ∀ v : V, ∃ c : fin 2, G.color_vertex v c, from by auto [h1],
    have h3 : ∀ v : V, ∃ c : ℕ, c ∈ {0,1} ∧ G.color_vertex v (c : fin 2), from by auto [h2],
    have h4 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ G.color_vertex v (1 : fin 2) ∨ c = 0 ∧ G.color_vertex v (0 : fin 2), from by auto [h3],
    have h5 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (G.color_vertex v 1) ∨ c = 0 ∧ (G.color_vertex v 0), from by auto [h4],
    have h6 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, G.adj v w → (G.color_vertex w 1)) ∨ c = 0 ∧ (∀ w : V, G.adj v w → (G.color_vertex w 0)), from by auto [h5],
    have h7 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, ¬G.adj v w ∨ (G.color_vertex w 1)) ∨ c = 0 ∧ (∀ w : V, ¬G.adj v w ∨ (G.color_vertex w 0)), from by auto [h6],
    have h8 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, ¬G.adj v w ∨ (G.color_vertex w 1 ∧ (G.color_vertex w 1 → w = v))) ∨ c = 0 ∧ (∀ w : V, ¬G.adj v w ∨ (G.color_vertex w 0 ∧ (G.color_vertex w 0 → w = v))), from by auto [h7],
    have h9 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, ¬G.adj v w ∨ (w = v)) ∨ c = 0 ∧ (∀ w : V, ¬G.adj v w ∨ (w = v)), from by auto [h8],
    have h10 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, ¬G.adj v w ∨ (w = v)) ∨ c = 0 ∧ (∀ w : V, ¬G.adj v w ∨ (w = v)), from by auto [h9],
    have h11 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, G.adj v w → (w = v)) ∨ c = 0 ∧ (∀ w : V, G.adj v w → (w = v)), from by auto [h10],
    have h12 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, G.adj v w → (v = w)) ∨ c = 0 ∧ (∀ w : V, G.adj v w → (v = w)), from by auto [h11],
    have h13 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, v = w ∨ ¬G.adj v w) ∨ c = 0 ∧ (∀ w : V, v = w ∨ ¬G.adj v w), from by auto [h12],
    have h14 : ∀ v : V, ∃ c : ℕ, c = 1 ∧ (∀ w : V, v = w ∨ ¬G.adj v w) ∨ c = 0 ∧ (∀ w : V, v = w ∨ ¬G.adj v w), from by auto [h13],

    have h15 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h14, exists_or_distrib, forall_and_distrib],
    have h16 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h15],
    have h17 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h16],
    have h18 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h17],
    have h19 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h18],
    have h20 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h19],
    have h21 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h20],
    have h22 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h21],
    have h23 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h22],
    have h24 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h23],
    have h25 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h24],
    have h26 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h25],
    have h27 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h26],
    have h28 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h27],
    have h29 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h28],
    have h30 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h29],
    have h31 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h30],
    have h32 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h31],
    have h33 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h32],
    have h34 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h33],
    have h35 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h34],
    have h36 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h35],
    have h37 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h36],
    have h38 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h37],
    have h39 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h38],
    have h40 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h39],
    have h41 : ∃ c : ℕ, ∀ v : V, c = 1 ∨ c = 0, from by auto [h40],
    have h42 : ∃ c : ℕ, ∀ v : V,
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h0 : 2 = 2, from rfl,
  have h1 : ∀ A B : Type*, A ⊕ B ≃ A × B, from by auto using [equiv.prod_congr_right],
  have h2 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h3 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h4 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h5 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h6 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h7 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h8 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h9 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h10 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h11 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h12 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h13 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h14 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h15 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h16 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h17 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h18 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h19 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h20 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h21 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h22 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h23 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h24 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h25 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h26 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h27 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h28 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h29 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h30 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h31 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h32 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h33 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h34 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h35 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h36 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h37 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h38 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h39 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h40 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h41 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h42 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h43 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h44 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h45 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h46 : ∀ A B : Type*, (A ⊕ B) ≃ (A × B), from by auto using [equiv.prod_congr_right],
  have h47 : ∀ A
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,

  assume h1 : G.colorable 2,

  show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from
  obtain (f : V → fin 2) (h2 : ∀ (v w : V), f v = f w → v.adj w = ff), from h1,

  let f' : V → bool := λ (v : V), f v = 0,
  let A : Type* := f' ⁻¹' {b : bool | b},
  let B : Type* := f' ⁻¹' {b : bool | ¬ b},

  have h3 : A ⊕ B = V, from by auto [subtype.ext_iff, set.subset.antisymm],

  have h4 : ∀ (v : V), v ∈ A → v.adj w = ff, from by auto [set.subset.elim, h2],
  have h5 : ∀ (v : V), v ∈ B → v.adj w = ff, from by auto [set.subset.elim, h2],

  have h6 : G ≤ cast (congr_arg _ h3) (complete_bipartite_graph A B), from by auto [subgraph.subgraph_iff, subtype.subtype_ext_iff, h4, h5],

  show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from ⟨A, B, h3, h6⟩,

  assume h1 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B),

  show G.colorable 2, from
  obtain (A B : Type*) (h2 : (A ⊕ B) = V) (h3 : G ≤ cast (congr_arg _ h2) (complete_bipartite_graph A B)), from h1,

  let f' : A ⊕ B → fin 2 := λ (v : A ⊕ B), ite (v.1 ∈ A) 0 1,
  let f : V → fin 2 := λ (v : V), f' v,

  have h4 : ∀ (v w : V), f v = f w → v.adj w = ff, from by auto [subtype.subtype_ext_iff, set.subset.elim, h3],

  show G.colorable 2, from ⟨f, h4⟩
end

--OUTPUT 7
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,
  {
    intro h,
    cases h with f hf,
    let A := (finset.image f (finset.filter (λ x, f x = (0 : ℕ)) (finset.univ))).to_set,
    let B := (finset.image f (finset.filter (λ x, f x = (1 : ℕ)) (finset.univ))).to_set,
    have h1 : G.V = A ∪ B,
    {
      apply set.ext,
      intro x,
      split,
      {
        intro h,
        cases h with h1 h2,
        cases h1,
        {
          have h3 : x ∈ (A : set V), from (finset.mem_image).mp h1,
          show x ∈ (A ∪ B), from set.mem_union_left (A ∪ B) (A : set V) h3,
        },
        {
          have h3 : x ∈ (B : set V), from (finset.mem_image).mp h1,
          show x ∈ (A ∪ B), from set.mem_union_right (A ∪ B) (B : set V) h3,
        },
      },
      {
        intro h,
        cases h with h1 h2,
        cases h1,
        {
          have h3 : x ∈ (A : set V), from h1,
          let a := x,
          have h4 : (a : V) ∈ (finset.univ : finset V), from set.mem_to_finset h3,
          have h5 : (a : V) ∈ (finset.filter (λ x, f x = (0 : ℕ)) (finset.univ : finset V)), from (finset.filter_mem).mp h4 h2,
          have h6 : (finset.mem_image).mpr h5 ∈ (finset.image f (finset.filter (λ x, f x = (0 : ℕ)) (finset.univ : finset V))), from h5,
          show x ∈ (A ∪ B), from set.mem_union_left (A ∪ B) (A : set V) h6,
        },
        {
          have h3 : x ∈ (B : set V), from h1,
          let b := x,
          have h4 : (b : V) ∈ (finset.univ : finset V), from set.mem_to_finset h3,
          have h5 : (b : V) ∈ (finset.filter (λ x, f x = (1 : ℕ)) (finset.univ : finset V)), from (finset.filter_mem).mp h4 h2,
          have h6 : (finset.mem_image).mpr h5 ∈ (finset.image f (finset.filter (λ x, f x = (1 : ℕ)) (finset.univ : finset V))), from h5,
          show x ∈ (A ∪ B), from set.mem_union_right (A ∪ B) (B : set V) h6,
        },
      },
    },
    have h2 : A ∩ B = ∅,
    {
      apply set.eq_empty_iff_forall_not_mem.mpr,
      intro x,
      intro h,
      cases h with h1 h2,
      let a := x,
      let b := x,
      have h3 : (a : V) ∈ (finset.univ : finset V), from set.mem_to_finset h1,
      have h4 : (a : V) ∈ (finset.filter (λ x, f x = (0 : ℕ)) (finset.univ : finset V)), from (finset.filter_mem).mp h3 h2.1,
      have h5 : (b : V) ∈ (finset.univ : finset V), from set.mem_to_finset h2.2,
      have h6 : (b : V) ∈ (finset.filter (λ x, f x = (1 : ℕ)) (finset.univ : finset V)), from (finset.filter_mem).mp h5 h2.2,
      have h7 : (finset.mem_image).mpr h4 ∈ (finset.image f (finset.filter (λ x, f x = (0 : ℕ)) (finset.univ : finset V))), from h4,
      have h8 : (finset.mem_image).mpr h6 ∈ (finset.image f (finset.filter (λ x, f x = (1 : ℕ)) (finset.univ : finset V))), from h6,
      have h9 : (a : V) = (b : V), from set.mem_of_mem_union_right (A : set V) (B : set V) h7 h8,
      have h10 : f a = f b, from congr_fun h9,
      show false, from h10.symm ▸ h2.2,
    },
    have h3 : G.E ⊆ (cartesian_product A B).to_set,
    {
      rintro ⟨x, y⟩ ⟨h4, h5⟩,
      split,
      {
        have h6 : x ∈ G.V, from hf.left,
        have h7 : y ∈ G.V, from hf.right,
        have h8 : x ∈ A ∪ B, from h1 x h6,
        have h9 : y ∈ A ∪ B, from h1 y h7,
        cases h8,
        {
          rw h8 at h9,
          have h10 : y ∈ B, from h9,
          rw ←h8 at h5,
          have h11 : y ∈ A, from h5,
          show y ∈ B ∧ x ∈ A, from ⟨h10, h11⟩
        },
        {
          cases h9,
          {
            rw h9 at h8,
            have h10 : x ∈ B, from h8,
            rw h9 at h5,
            have h11 : x ∈ A, from h5,
            show x ∈ B ∧ y ∈ A, from ⟨h10, h11⟩
          },
          {
            rw h8 at h9,
            rw h9 at h5,
            have h10 : x ∈ A, from h8,
            have h11 : y ∈ A, from h9,
            show x ∈ B ∧ y ∈ A, from ⟨h10, h11⟩
          }
        }
      },
      {
        show x ≠ y, from hf.right,
      }
    },
    have h4 : G.E = (cartesian_product A B).to_set, from set.subset.antisymm h3 (set.subset_univ _),
    let h5 := (set.eq_univ_iff_forall_mem).mp h4,
    have h6 : A ⊕ B = G.V, from set.ext h1,
    have h7 : (A ⊕ B) ≃ G.V, from set.equiv.ext _ h6.symm,
    have h8 : (A ⊕ B) ≃ G.V, from h7,
    have h9 : (A ⊕ B) ≃ G.V, from h8,
    have h10 : G ≤ cast (congr_arg _ h9) (complete_bipartite_graph A B), from
    begin
      unfold complete_bipartite_graph,
      unfold simple_graph,
      unfold graph.simple_graph,
      unfold graph.E,
      unfold graph.V,
      split,
      {
        rintros ⟨x, y⟩ h11
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
    split,
    {
        assume h1 : G.colorable 2,
        obtain ⟨c, hc⟩ := h1,
        obtain ⟨A, B, h⟩ := hc,
        use [A, B, h],
        convert simple_graph.cast_mono (congr_arg _ h) hc,
        rw simple_graph.cast_eq_iff_eq_domain,
        intro x,
        cases x,
        refl,
    },
    {
        rintros ⟨A, B, h⟩,
        rw ← h,
        use [sum.inl, sum.inr],
        convert simple_graph.cast_mono (congr_arg _ h) complete_bipartite_graph_colorable,
        rw simple_graph.cast_eq_iff_eq_domain,
        intro x,
        cases x,
        refl,
    }
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem  bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.punit
! leanprover-community/mathlib commit ab7b94ef22d18679460483c47458a58716eb47da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Logic

#print PUnit.subsingleton /-
theorem PUnit.subsingleton (a b : PUnit) : a = b :=
  PUnit.recOn a (PUnit.recOn b rfl)
#align punit_eq PUnit.subsingleton
-/

#print PUnit.eq_punit /-
theorem PUnit.eq_punit (a : PUnit) : a = PUnit.unit :=
  PUnit.subsingleton a PUnit.unit
#align punit_eq_star PUnit.eq_punit
-/

instance : Subsingleton PUnit :=
  Subsingleton.intro PUnit.subsingleton

instance : Inhabited PUnit :=
  ⟨PUnit.unit⟩

instance : DecidableEq PUnit := fun a b => isTrue (PUnit.subsingleton a b)


/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Std.Data.HashMap.Basic
import Std.Data.List.Lemmas
import Std.Data.Array.Lemmas
import Std.Tactic.ShowTerm

namespace Std.HashMap
namespace Imp

attribute [-simp] Bool.not_eq_true

namespace Bucket

@[ext] protected theorem ext : ∀ {b₁ b₂ : Bucket α β}, b₁.1.data = b₂.1.data → b₁ = b₂
  | ⟨⟨_⟩, _⟩, ⟨⟨_⟩, _⟩, rfl => rfl

theorem update_data (self : Bucket α β) (i d h) :
    (self.update i d h).1.data = self.1.data.set i.toNat d := rfl

@[simp] theorem update_size (self : Bucket α β) (i d h) :
    (self.update i d h).1.size = self.1.size := Array.size_uset ..

theorem exists_of_update (self : Bucket α β) (i d h) :
    ∃ l₁ l₂, self.1.data = l₁ ++ self.1[i] :: l₂ ∧ List.length l₁ = i.toNat ∧
      (self.update i d h).1.data = l₁ ++ d :: l₂ := by
  simp [Array.getElem_eq_data_get]; exact List.exists_of_set' h

theorem size_eq (data : Bucket α β) :
  size data = .sum (data.1.data.map (·.toList.length)) := rfl

theorem mk_size (h) : (mk n h : Bucket α β).size = 0 := by
  simp [Bucket.size_eq, Bucket.mk, mkArray]; clear h
  induction n <;> simp [*]

theorem WF.mk' [BEq α] [Hashable α] (h) : (Bucket.mk n h : Bucket α β).WF := by
  refine ⟨fun _ h => ?_, fun i h => ?_⟩
  · simp [Bucket.mk, empty', mkArray, List.mem_replicate] at h
    simp [h, List.Pairwise.nil]
  · simp [Bucket.mk, empty', mkArray, Array.getElem_eq_data_get, AssocList.All]

theorem WF.update [BEq α] [Hashable α] {buckets : Bucket α β} {i d h} (H : buckets.WF)
    (h₁ : ∀ [PartialEquivBEq α] [LawfulHashable α],
      (buckets.1[i].toList.Pairwise fun a b => ¬(a.1 == b.1)) →
      d.toList.Pairwise fun a b => ¬(a.1 == b.1))
    (h₂ : (buckets.1[i].All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i.toNat) →
      d.All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i.toNat) :
    (buckets.update i d h).WF := by
  refine ⟨fun l hl => ?_, fun i hi p hp => ?_⟩
  · exact match List.mem_or_eq_of_mem_set hl with
    | .inl hl => H.1 _ hl
    | .inr rfl => h₁ (H.1 _ (Array.getElem_mem_data ..))
  · revert hp; simp [update_data, Array.getElem_eq_data_get, List.get_set]
    split <;> intro hp
    · next eq => exact eq ▸ h₂ (H.2 _ _) _ hp
    · simp at hi; exact H.2 i hi _ hp

end Bucket

theorem reinsertAux_size [Hashable α] (data : Bucket α β) (a : α) (b : β) :
    (reinsertAux data a b).size = data.size.succ := by
  simp [Bucket.size_eq, reinsertAux]
  refine have ⟨l₁, l₂, h₁, _, eq⟩ := Bucket.exists_of_update ..; eq ▸ ?_
  simp [h₁, Nat.succ_add]; rfl

theorem reinsertAux_WF [BEq α] [Hashable α] {data : Bucket α β} {a : α} {b : β} (H : data.WF)
    (h₁ : ∀ [PartialEquivBEq α] [LawfulHashable α],
      haveI := mkIdx data.2 (hash a).toUSize
      (data.val[this.1]'this.2).All fun x _ => ¬(a == x)) :
    (reinsertAux data a b).WF :=
  H.update (.cons h₁) fun
    | _, _, .head .. => rfl
    | H, _, .tail _ h => H _ h

theorem expand_size [Hashable α] {buckets : Bucket α β} :
    (expand sz buckets).buckets.size = buckets.size := by
  rw [expand, go]
  · rw [Bucket.mk_size]; simp [Bucket.size]
  · intro.
where
  go (i source) (target : Bucket α β) (hs : ∀ j < i, source.data.getD j .nil = .nil) :
      (expand.go i source target).size =
        .sum (source.data.map (·.toList.length)) + target.size := by
    unfold expand.go; split
    · next H =>
      refine (go (i+1) _ _ fun j hj => ?a).trans ?b <;> simp
      · case a =>
        simp [List.getD_eq_get?, List.get?_set]; split
        · cases List.get? .. <;> rfl
        · next H => exact hs _ (Nat.lt_of_le_of_ne (Nat.le_of_lt_succ hj) (Ne.symm H))
      · case b =>
        refine have ⟨l₁, l₂, h₁, _, eq⟩ := List.exists_of_set' H; eq ▸ ?_
        simp [h₁, Bucket.size_eq]
        rw [Nat.add_assoc, Nat.add_assoc, Nat.add_assoc]; congr 1
        (conv => rhs; rw [Nat.add_left_comm]); congr 1
        rw [← Array.getElem_eq_data_get]
        have := @reinsertAux_size α β _; simp [Bucket.size] at this
        induction source[i].toList generalizing target <;> simp [*, Nat.succ_add]; rfl
    · next H =>
      rw [(_ : Nat.sum _ = 0), Nat.zero_add]
      rw [← (_ : source.data.map (fun _ => .nil) = source.data)]
      · simp; induction source.data <;> simp [*]
      refine List.ext_get (by simp) fun j h₁ h₂ => ?_
      simp
      have := (hs j (Nat.lt_of_lt_of_le h₂ (Nat.not_lt.1 H))).symm
      rwa [List.getD_eq_get?, List.get?_eq_get, Option.getD_some] at this
termination_by go i source _ _ => source.size - i

theorem expand_WF.foldl [BEq α] [Hashable α] (rank : α → Nat) {l : List (α × β)} {i : Nat}
    (hl₁ : ∀ [PartialEquivBEq α] [LawfulHashable α], l.Pairwise fun a b => ¬(a.1 == b.1))
    (hl₂ : ∀ x ∈ l, rank x.1 = i)
    {target : Bucket α β} (ht₁ : target.WF)
    (ht₂ : ∀ bucket ∈ target.1.data,
      bucket.All fun k _ => rank k ≤ i ∧
        ∀ [PartialEquivBEq α] [LawfulHashable α], ∀ x ∈ l, ¬(x.1 == k)) :
    (l.foldl (fun d x => reinsertAux d x.1 x.2) target).WF ∧
    ∀ bucket ∈ (l.foldl (fun d x => reinsertAux d x.1 x.2) target).1.data,
      bucket.All fun k _ => rank k ≤ i := by
  induction l generalizing target with
  | nil => exact ⟨ht₁, fun _ h₁ _ h₂ => (ht₂ _ h₁ _ h₂).1⟩
  | cons _ _ ih =>
    simp at hl₁ hl₂ ht₂
    refine ih hl₁.2 hl₂.2
      (reinsertAux_WF ht₁ fun _ h => (ht₂ _ (Array.getElem_mem_data ..) _ h).2.1)
      (fun _ h => ?_)
    simp [reinsertAux, Bucket.update] at h
    match List.mem_or_eq_of_mem_set h with
    | .inl h =>
      intro _ hf
      have ⟨h₁, h₂⟩ := ht₂ _ h _ hf
      exact ⟨h₁, h₂.2⟩
    | .inr h => subst h; intro
      | _, .head .. =>
        exact ⟨hl₂.1 ▸ Nat.le_refl _, fun _ h h' => hl₁.1 _ h (PartialEquivBEq.symm h')⟩
      | _, .tail _ h =>
        have ⟨h₁, h₂⟩ := ht₂ _ (Array.getElem_mem_data ..) _ h
        exact ⟨h₁, h₂.2⟩

theorem expand_WF [BEq α] [Hashable α] {buckets : Bucket α β} (H : buckets.WF) :
    (expand sz buckets).buckets.WF :=
  go _ H.1 H.2 ⟨.mk' _, fun _ _ _ _ => by simp_all [Bucket.mk, List.mem_replicate]⟩
where
  go (i) {source : Array (AssocList α β)}
      (hs₁ : ∀ [LawfulHashable α] [PartialEquivBEq α], ∀ bucket ∈ source.data,
        bucket.toList.Pairwise fun a b => ¬(a.1 == b.1))
      (hs₂ : ∀ (j : Nat) (h : j < source.size),
        source[j].All fun k _ => ((hash k).toUSize % source.size).toNat = j)
      {target : Bucket α β} (ht : target.WF ∧ ∀ bucket ∈ target.1.data,
        bucket.All fun k _ => ((hash k).toUSize % source.size).toNat < i) :
      (expand.go i source target).WF := by
    unfold expand.go; split
    · next H =>
      refine go (i+1) (fun _ hl => ?_) (fun i h => ?_) ?_
      · match List.mem_or_eq_of_mem_set hl with
        | .inl hl => exact hs₁ _ hl
        | .inr e => exact e ▸ .nil
      · simp [Array.getElem_eq_data_get, List.get_set]; split
        · intro.
        · exact hs₂ _ (by simp_all)
      · let rank (k : α) := ((hash k).toUSize % source.size).toNat
        have := expand_WF.foldl rank ?_ (hs₂ _ H) ht.1 (fun _ h₁ _ h₂ => ?_)
        · simp; exact ⟨this.1, fun _ h₁ _ h₂ => Nat.lt_succ_of_le (this.2 _ h₁ _ h₂)⟩
        · exact hs₁ _ (Array.getElem_mem_data ..)
        · have := ht.2 _ h₁ _ h₂
          refine ⟨Nat.le_of_lt this, fun _ h h' => Nat.ne_of_lt this ?_⟩
          exact LawfulHashable.hash_eq h' ▸ hs₂ _ H _ h
    · exact ht.1
termination_by go i source _ _ _ _ => source.size - i

theorem insert_size [BEq α] [Hashable α] {m : Imp α β} {k v}
    (h : m.size = m.buckets.size) :
    (insert m k v).size = (insert m k v).buckets.size := by
  dsimp [insert, cond]; split
  · unfold Bucket.size
    refine have ⟨_, _, h₁, _, eq⟩ := Bucket.exists_of_update ..; eq ▸ ?_
    simp [h, h₁, Bucket.size_eq]
  split
  · unfold Bucket.size
    refine have ⟨_, _, h₁, _, eq⟩ := Bucket.exists_of_update ..; eq ▸ ?_
    simp [h, h₁, Bucket.size_eq, Nat.succ_add]; rfl
  · rw [expand_size]; simp [h, expand, Bucket.size]
    refine have ⟨_, _, h₁, _, eq⟩ := Bucket.exists_of_update ..; eq ▸ ?_
    simp [h₁, Bucket.size_eq, Nat.succ_add]; rfl

private theorem mem_replaceF {l : List (α × β)} {x : α × β} {p : α × β → Bool} :
    x ∈ (l.replaceF fun a => bif p a then some (k, v) else none) → x.1 = k ∨ x ∈ l := by
  induction l with
  | nil => exact .inr
  | cons a l ih =>
    simp; generalize e : cond .. = z; revert e
    unfold cond; split <;> (intro h; subst h; simp)
    · intro
      | .inl eq => exact eq ▸ .inl rfl
      | .inr h => exact .inr (.inr h)
    · intro
      | .inl eq => exact .inr (.inl eq)
      | .inr h => exact (ih h).imp_right .inr

private theorem pairwise_replaceF [BEq α] [PartialEquivBEq α]
    {l : List (α × β)} {x : α × β} (hx₁ : x ∈ l) (hx₂ : x.fst == k)
    (H : l.Pairwise fun a b => ¬(a.fst == b.fst)) :
    (l.replaceF fun a => bif a.fst == k then some (k, v) else none)
      |>.Pairwise fun a b => ¬(a.fst == b.fst) := by
  induction hx₁ with
  | head => simp_all; exact (H.1 · · ∘ PartialEquivBEq.trans hx₂)
  | tail _ _ ih =>
    simp at H ⊢
    generalize e : cond .. = z; revert e
    unfold cond; split <;> (intro h; subst h; simp)
    · next e => exact ⟨(H.1 · · ∘ PartialEquivBEq.trans e), H.2⟩
    · next e =>
      refine ⟨fun a h => ?_, ih H.2⟩
      match mem_replaceF h with
      | .inl eq => exact eq ▸ ne_true_of_eq_false e
      | .inr h => exact H.1 a h

theorem insert_WF [BEq α] [Hashable α] {m : Imp α β} {k v}
    (h : m.buckets.WF) : (insert m k v).buckets.WF := by
  dsimp [insert, cond]; split
  · next h₁ =>
    simp at h₁; have ⟨x, hx₁, hx₂⟩ := h₁
    refine h.update (fun H => ?_) (fun H a h => ?_)
    · simp; exact pairwise_replaceF hx₁ hx₂ H
    · simp [AssocList.All] at H h ⊢
      match mem_replaceF h with
      | .inl rfl => rfl
      | .inr h => exact H _ h
  · next h₁ =>
    rw [Bool.eq_false_iff] at h₁; simp at h₁
    suffices _ by split <;> [exact this, refine expand_WF this]
    refine h.update (.cons ?_) (fun H a h => ?_)
    · exact fun a h h' => h₁ a h (PartialEquivBEq.symm h')
    · cases h with
      | head => rfl
      | tail _ h => exact H _ h

theorem erase_size [BEq α] [Hashable α] {m : Imp α β} {k}
    (h : m.size = m.buckets.size) :
    (erase m k).size = (erase m k).buckets.size := by
  dsimp [erase, cond]; split
  · next H =>
    simp [h, Bucket.size]
    refine have ⟨_, _, h₁, _, eq⟩ := Bucket.exists_of_update ..; eq ▸ ?_
    simp [h, h₁, Bucket.size_eq]
    rw [(_ : List.length _ = _ + 1), Nat.add_right_comm]; {rfl}
    clear h₁ eq
    simp [AssocList.contains_eq] at H
    have ⟨a, h₁, h₂⟩ := H
    refine have ⟨_, _, _, _, _, h, eq⟩ := List.exists_of_eraseP h₁ h₂; eq ▸ ?_
    simp [h]; rfl
  · exact h

theorem erase_WF [BEq α] [Hashable α] {m : Imp α β} {k}
    (h : m.buckets.WF) : (erase m k).buckets.WF := by
  dsimp [erase, cond]; split
  · refine h.update (fun H => ?_) (fun H a h => ?_) <;> simp at h ⊢
    · simp; exact H.sublist (List.eraseP_sublist _)
    · exact H _ (List.mem_of_mem_eraseP h)
  · exact h

theorem WF.out [BEq α] [Hashable α] {m : Imp α β} (h : m.WF) :
    m.size = m.buckets.size ∧ m.buckets.WF := by
  induction h with
  | mk h₁ h₂ => exact ⟨h₁, h₂⟩
  | @empty' _ h => exact ⟨(Bucket.mk_size h).symm, .mk' h⟩
  | insert _ ih => exact ⟨insert_size ih.1, insert_WF ih.2⟩
  | erase _ ih => exact ⟨erase_size ih.1, erase_WF ih.2⟩

theorem WF_iff [BEq α] [Hashable α] {m : Imp α β} :
    m.WF ↔ m.size = m.buckets.size ∧ m.buckets.WF :=
  ⟨(·.out), fun ⟨h₁, h₂⟩ => .mk h₁ h₂⟩

theorem WF.mapVal {α β γ} {f : α → β → γ} [BEq α] [Hashable α]
    {m : Imp α β} (H : WF m) : WF (mapVal f m) := by
  have ⟨h₁, h₂⟩ := H.out
  simp [Imp.mapVal, Bucket.mapVal, WF_iff, h₁]; refine ⟨?_, ?_, fun i h => ?_⟩
  · simp [Bucket.size]; congr; funext l; simp
  · simp only [Array.map_data, List.forall_mem_map_iff]
    simp [List.pairwise_map]
    exact fun _ => h₂.1 _
  · simp [AssocList.All] at h ⊢
    rintro a x hx rfl
    apply h₂.2 _ _ x hx

theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable α]
    {m : Imp α β} (H : WF m) : WF (filterMap f m) := by
  let g₁ (l : AssocList α β) := l.toList.filterMap (fun x => (f x.1 x.2).map (x.1, ·))
  have H1 (l n acc) : filterMap.go f acc l n =
      (((g₁ l).reverse ++ acc.toList).toAssocList, ⟨n.1 + (g₁ l).length⟩) := by
    induction l generalizing n acc with simp [filterMap.go, *]
    | cons a b l => match f a b with
      | none => rfl
      | some c => simp; rw [Nat.add_right_comm]; rfl
  let g l := (g₁ l).reverse.toAssocList
  let M := StateT (ULift Nat) Id
  have H2 (l : List (AssocList α β)) n :
      l.mapM (m := M) (filterMap.go f .nil) n =
      (l.map g, ⟨n.1 + .sum ((l.map g).map (·.toList.length))⟩) := by
    induction l generalizing n with
    | nil => rfl
    | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc]; rfl
  have H3 (l : List _) :
    (l.filterMap (fun (a, b) => (f a b).map (a, ·))).map (fun a => a.fst)
     |>.Sublist (l.map (·.1)) := by
    induction l with
    | nil => exact .slnil
    | cons a l ih =>
      simp; exact match f a.1 a.2 with
      | none => .cons _ ih
      | some b => .cons₂ _ ih
  suffices ∀ bk sz (h : 0 < bk.length),
    m.buckets.val.mapM (m := M) (filterMap.go f .nil) ⟨0⟩ = (⟨bk⟩, ⟨sz⟩) →
    WF ⟨sz, ⟨bk⟩, h⟩ from this _ _ _ rfl
  simp [Array.mapM_eq_mapM_data, bind, StateT.bind, H2]
  intro bk sz h e'; cases e'
  refine .mk (by simp [Bucket.size]) ⟨?_, fun i h => ?_⟩
  · simp only [List.forall_mem_map_iff, List.toAssocList_toList]
    refine fun l h => (List.pairwise_reverse.2 ?_).imp (mt PartialEquivBEq.symm)
    have := H.out.2.1 _ h
    rw [← List.pairwise_map (R := (¬ · == ·))] at this ⊢
    exact this.sublist (H3 l.toList)
  · simp [Array.getElem_eq_data_get] at h ⊢
    have := H.out.2.2 _ h; simp [AssocList.All] at this ⊢
    rintro _ _ h' _ _ rfl; exact this _ h'

end Imp

variable {_ : BEq α} {_ : Hashable α}

/-- Map a function over the values in the map. -/
@[inline] def mapVal (f : α → β → γ) (self : HashMap α β) : HashMap α γ :=
  ⟨self.1.mapVal f, self.2.mapVal⟩

/--
Applies `f` to each key-value pair `a, b` in the map. If it returns `some c` then
`a, c` is pushed into the new map; else the key is removed from the map.
-/
@[inline] def filterMap (f : α → β → Option γ) (self : HashMap α β) : HashMap α γ :=
  ⟨self.1.filterMap f, self.2.filterMap⟩

/-- Constructs a map with the set of all pairs `a, b` such that `f` returns true. -/
@[inline] def filter (f : α → β → Bool) (self : HashMap α β) : HashMap α β :=
  self.filterMap fun a b => bif f a b then some b else none


theorem proofOfFalse : False := Nat.zero_ne_one (Nat.mod_zero 1)


import .global
import ring_theory.ideals
import ring_theory.ideal_operations
universes  u

local notation `Ring` := CommRing.{u}
local notation `Set` :=  Type u

namespace ideal
lemma ideal_id (A : Ring) (I : ideal A) : ideal.map (𝟙 A)I = I :=
begin
  have g : set.image (𝟙 A) I = (I : set A),
    exact set.image_id ↑I,
    unfold ideal.map,
    rw g,
    exact ideal.span_eq I,
end
lemma ideal_comp (A B C : Ring)(I : ideal A) (f : A ⟶  B) (g : B ⟶  C)  :
  ideal.map (f ≫ g) I = ideal.map g (ideal.map f I) :=
le_antisymm
  (ideal.map_le_iff_le_comap.2 $ λ x hxI, ideal.mem_map_of_mem $ ideal.mem_map_of_mem hxI)
  (ideal.map_le_iff_le_comap.2 $ ideal.map_le_iff_le_comap.2 $ λ x hxI, ideal.mem_map_of_mem hxI)
end ideal


/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison
-/
import category_theory.monoidal.of_chosen_finite_products
import category_theory.limits.shapes.types

/-!
# The category of types is a symmetric monoidal category
-/

open category_theory
open category_theory.limits
open tactic

universes v u

namespace category_theory

instance types_monoidal : monoidal_category.{u} (Type u) :=
monoidal_of_chosen_finite_products (types.terminal_limit_cone) (types.binary_product_limit_cone)

instance types_symmetric : symmetric_category.{u} (Type u) :=
symmetric_of_chosen_finite_products (types.terminal_limit_cone) (types.binary_product_limit_cone)

@[simp] lemma tensor_apply {W X Y Z : Type u} (f : W ⟶ X) (g : Y ⟶ Z) (p : W ⊗ Y) :
  (f ⊗ g) p = (f p.1, g p.2) := rfl

@[simp] lemma left_unitor_hom_apply {X : Type u} {x : X} {p : punit} :
  ((λ_ X).hom : (𝟙_ (Type u)) ⊗ X → X) (p, x) = x := rfl
@[simp] lemma left_unitor_inv_apply {X : Type u} {x : X} :
  ((λ_ X).inv : X ⟶ (𝟙_ (Type u)) ⊗ X) x = (punit.star, x) := rfl

@[simp] lemma right_unitor_hom_apply {X : Type u} {x : X} {p : punit} :
  ((ρ_ X).hom : X ⊗ (𝟙_ (Type u)) → X) (x, p) = x := rfl
@[simp] lemma right_unitor_inv_apply {X : Type u} {x : X} :
  ((ρ_ X).inv : X ⟶ X ⊗ (𝟙_ (Type u))) x = (x, punit.star) := rfl

@[simp] lemma associator_hom_apply {X Y Z : Type u} {x : X} {y : Y} {z : Z} :
  ((α_ X Y Z).hom : (X ⊗ Y) ⊗ Z → X ⊗ (Y ⊗ Z)) ((x, y), z) = (x, (y, z)) := rfl
@[simp] lemma associator_inv_apply {X Y Z : Type u} {x : X} {y : Y} {z : Z} :
  ((α_ X Y Z).inv : X ⊗ (Y ⊗ Z) → (X ⊗ Y) ⊗ Z) (x, (y, z)) = ((x, y), z) := rfl

@[simp] lemma braiding_hom_apply {X Y : Type u} {x : X} {y : Y} :
  ((β_ X Y).hom : X ⊗ Y → Y ⊗ X) (x, y) = (y, x) := rfl
@[simp] lemma braiding_inv_apply {X Y : Type u} {x : X} {y : Y} :
  ((β_ X Y).inv : Y ⊗ X → X ⊗ Y) (y, x) = (x, y) := rfl

open opposite

open monoidal_category

/-- `(𝟙_ C ⟶ -)` is a lax monoidal functor to `Type`. -/
def coyoneda_tensor_unit (C : Type u) [category.{v} C] [monoidal_category C] :
  lax_monoidal_functor C (Type v) :=
{ ε := λ p, 𝟙 _,
  μ := λ X Y p, (λ_ (𝟙_ C)).inv ≫ (p.1 ⊗ p.2),
  μ_natural' := by tidy,
  associativity' := λ X Y Z, begin
    ext ⟨⟨f, g⟩, h⟩, dsimp at f g h,
    dsimp, simp only [iso.cancel_iso_inv_left, category.assoc],
    conv_lhs { rw [←category.id_comp h, tensor_comp, category.assoc, associator_naturality,
      ←category.assoc, unitors_inv_equal, triangle_assoc_comp_right_inv], },
    conv_rhs { rw [←category.id_comp f, tensor_comp], },
  end,
  left_unitality' := by tidy,
  right_unitality' := λ X, begin
    ext ⟨f, ⟨⟩⟩, dsimp at f,
    dsimp, simp only [category.assoc],
    rw [right_unitor_naturality, unitors_inv_equal, iso.inv_hom_id_assoc],
  end,
  ..coyoneda.obj (op (𝟙_ C)) }

end category_theory


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Kevin Buzzard
-/
import category_theory.preadditive.projective

/-!
# Injective objects and categories with enough injectives

An object `J` is injective iff every morphism into `J` can be obtained by extending a monomorphism.
-/

noncomputable theory

open category_theory
open category_theory.limits
open opposite

universes v v₁ v₂ u₁ u₂

namespace category_theory
variables {C : Type u₁} [category.{v₁} C]

/--
An object `J` is injective iff every morphism into `J` can be obtained by extending a monomorphism.
-/
class injective (J : C) : Prop :=
(factors : ∀ {X Y : C} (g : X ⟶ J) (f : X ⟶ Y) [mono f], ∃ h : Y ⟶ J, f ≫ h = g)

section
/--
An injective presentation of an object `X` consists of a monomorphism `f : X ⟶ J`
to some injective object `J`.
-/
@[nolint has_nonempty_instance]
structure injective_presentation (X : C) :=
(J : C)
(injective : injective J . tactic.apply_instance)
(f : X ⟶ J)
(mono : mono f . tactic.apply_instance)

attribute [instance] injective_presentation.injective injective_presentation.mono

variables (C)

/-- A category "has enough injectives" if every object has an injective presentation,
i.e. if for every object `X` there is an injective object `J` and a monomorphism `X ↪ J`. -/
class enough_injectives : Prop :=
(presentation : ∀ (X : C), nonempty (injective_presentation X))

end

namespace injective

/--
Let `J` be injective and `g` a morphism into `J`, then `g` can be factored through any monomorphism.
-/
def factor_thru {J X Y : C} [injective J] (g : X ⟶ J) (f : X ⟶ Y) [mono f] : Y ⟶ J :=
(injective.factors g f).some

@[simp] lemma comp_factor_thru {J X Y : C} [injective J] (g : X ⟶ J) (f : X ⟶ Y) [mono f] :
  f ≫ factor_thru g f = g :=
(injective.factors g f).some_spec

section
open_locale zero_object

instance zero_injective [has_zero_object C] [has_zero_morphisms C] : injective (0 : C) :=
{ factors := λ X Y g f mono, ⟨0, by ext⟩ }

end

lemma of_iso {P Q : C} (i : P ≅ Q) (hP : injective P) : injective Q :=
{ factors := λ X Y g f mono, begin
  obtain ⟨h, h_eq⟩ := @injective.factors C _ P _ _ _ (g ≫ i.inv) f mono,
  refine ⟨h ≫ i.hom, _⟩,
  rw [←category.assoc, h_eq, category.assoc, iso.inv_hom_id, category.comp_id],
end }

lemma iso_iff {P Q : C} (i : P ≅ Q) : injective P ↔ injective Q :=
⟨of_iso i, of_iso i.symm⟩

/-- The axiom of choice says that every nonempty type is an injective object in `Type`. -/
instance (X : Type u₁) [nonempty X] : injective X :=
{ factors := λ Y Z g f mono,
  ⟨λ z, by classical; exact
    if h : z ∈ set.range f
    then g (classical.some h)
    else nonempty.some infer_instance, begin
    ext y,
    change dite _ _ _ = _,
    split_ifs,
    { rw mono_iff_injective at mono,
      rw mono (classical.some_spec h) },
    { exact false.elim (h ⟨y, rfl⟩) },
  end⟩ }

instance Type.enough_injectives : enough_injectives (Type u₁) :=
{ presentation := λ X, nonempty.intro
  { J := with_bot X,
    injective := infer_instance,
    f := option.some,
    mono := by { rw [mono_iff_injective], exact option.some_injective X, } } }

instance {P Q : C} [has_binary_product P Q] [injective P] [injective Q] :
  injective (P ⨯ Q) :=
{ factors := λ X Y g f mono, begin
  resetI,
  use limits.prod.lift (factor_thru (g ≫ limits.prod.fst) f) (factor_thru (g ≫ limits.prod.snd) f),
  simp only [prod.comp_lift, comp_factor_thru],
  ext,
  { simp only [prod.lift_fst] },
  { simp only [prod.lift_snd] },
end }

instance {β : Type v} (c : β → C) [has_product c] [∀ b, injective (c b)] :
  injective (∏ c) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨pi.lift (λ b, factor_thru (g ≫ (pi.π c _)) f), _⟩,
  ext ⟨j⟩,
  simp only [category.assoc, limit.lift_π, fan.mk_π_app, comp_factor_thru],
end }

instance {P Q : C} [has_zero_morphisms C] [has_binary_biproduct P Q]
  [injective P] [injective Q] :
  injective (P ⊞ Q) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨biprod.lift (factor_thru (g ≫ biprod.fst) f) (factor_thru (g ≫ biprod.snd) f), _⟩,
  ext,
  { simp only [category.assoc, biprod.lift_fst, comp_factor_thru] },
  { simp only [category.assoc, biprod.lift_snd, comp_factor_thru] },
end }

instance {β : Type v} (c : β → C) [has_zero_morphisms C] [has_biproduct c]
  [∀ b, injective (c b)] : injective (⨁ c) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨biproduct.lift (λ b, factor_thru (g ≫ biproduct.π _ _) f), _⟩,
  ext,
  simp only [category.assoc, biproduct.lift_π, comp_factor_thru],
end }

instance {P : Cᵒᵖ} [projective P] : injective (unop P) :=
{ factors := λ X Y g f mono, by exactI ⟨(@projective.factor_thru Cᵒᵖ _ P _ _ _ g.op f.op _).unop,
      quiver.hom.op_inj (by simp)⟩ }

instance {J : Cᵒᵖ} [injective J] : projective (unop J) :=
{ factors := λ E X f e he, by exactI ⟨(@factor_thru Cᵒᵖ _ J _ _ _ f.op e.op _).unop,
    quiver.hom.op_inj (by simp)⟩ }

instance {J : C} [injective J] : projective (op J) :=
{ factors := λ E X f e epi, by exactI ⟨(@factor_thru C _ J _ _ _ f.unop e.unop _).op,
    quiver.hom.unop_inj (by simp)⟩ }

instance {P : C} [projective P] : injective (op P) :=
{ factors := λ X Y g f mono, by exactI ⟨(@projective.factor_thru C _ P _ _ _ g.unop f.unop _).op,
    quiver.hom.unop_inj (by simp)⟩ }

lemma injective_iff_projective_op {J : C} : injective J ↔ projective (op J) :=
⟨λ h, by exactI infer_instance, λ h, show injective (unop (op J)), by exactI infer_instance⟩

lemma projective_iff_injective_op {P : C} : projective P ↔ injective (op P) :=
⟨λ h, by exactI infer_instance, λ h, show projective (unop (op P)), by exactI infer_instance⟩

lemma injective_iff_preserves_epimorphisms_yoneda_obj (J : C) :
  injective J ↔ (yoneda.obj J).preserves_epimorphisms :=
begin
  rw [injective_iff_projective_op, projective.projective_iff_preserves_epimorphisms_coyoneda_obj],
  exact functor.preserves_epimorphisms.iso_iff (coyoneda.obj_op_op _)
end

section adjunction
open category_theory.functor

variables {D : Type u₂} [category.{v₂} D]
variables {L : C ⥤ D} {R : D ⥤ C} [preserves_monomorphisms L]

lemma injective_of_adjoint (adj : L ⊣ R) (J : D) [injective J] : injective $ R.obj J :=
⟨λ A A' g f im, by exactI ⟨adj.hom_equiv _ _ (factor_thru ((adj.hom_equiv A J).symm g) (L.map f)),
 (adj.hom_equiv _ _).symm.injective (by simp)⟩⟩

end adjunction

section enough_injectives
variable [enough_injectives C]

/--
`injective.under X` provides an arbitrarily chosen injective object equipped with
an monomorphism `injective.ι : X ⟶ injective.under X`.
-/
def under (X : C) : C :=
(enough_injectives.presentation X).some.J

instance injective_under (X : C) : injective (under X) :=
(enough_injectives.presentation X).some.injective

/--
The monomorphism `injective.ι : X ⟶ injective.under X`
from the arbitrarily chosen injective object under `X`.
-/
def ι (X : C) : X ⟶ under X :=
(enough_injectives.presentation X).some.f

instance ι_mono (X : C) : mono (ι X) :=
(enough_injectives.presentation X).some.mono

section
variables [has_zero_morphisms C] {X Y : C} (f : X ⟶ Y) [has_cokernel f]

/--
When `C` has enough injectives, the object `injective.syzygies f` is
an arbitrarily chosen injective object under `cokernel f`.
-/
@[derive injective]
def syzygies : C := under (cokernel f)

/--
When `C` has enough injective,
`injective.d f : Y ⟶ syzygies f` is the composition
`cokernel.π f ≫ ι (cokernel f)`.

(When `C` is abelian, we have `exact f (injective.d f)`.)
-/
abbreviation d : Y ⟶ syzygies f :=
cokernel.π f ≫ ι (cokernel f)

end

end enough_injectives

instance [enough_injectives C] : enough_projectives Cᵒᵖ :=
⟨λ X, ⟨⟨_, infer_instance, (injective.ι (unop X)).op, infer_instance⟩⟩⟩

instance [enough_projectives C] : enough_injectives Cᵒᵖ :=
⟨λ X, ⟨⟨_, infer_instance, (projective.π (unop X)).op, infer_instance⟩⟩⟩

lemma enough_projectives_of_enough_injectives_op [enough_injectives Cᵒᵖ] : enough_projectives C :=
⟨λ X, ⟨⟨_, infer_instance, (injective.ι (op X)).unop, infer_instance⟩⟩⟩

lemma enough_injectives_of_enough_projectives_op [enough_projectives Cᵒᵖ] : enough_injectives C :=
⟨λ X, ⟨⟨_, infer_instance, (projective.π (op X)).unop, infer_instance⟩⟩⟩

open injective

section
variables [has_zero_morphisms C] [has_images Cᵒᵖ] [has_equalizers Cᵒᵖ]

/--
Given a pair of exact morphism `f : Q ⟶ R` and `g : R ⟶ S` and a map `h : R ⟶ J` to an injective
object `J` such that `f ≫ h = 0`, then `g` descents to a map `S ⟶ J`. See below:

```
Q --- f --> R --- g --> S
            |
            | h
            v
            J
```
-/
def exact.desc {J Q R S : C} [injective J] (h : R ⟶ J) (f : Q ⟶ R) (g : R ⟶ S)
  (hgf : exact g.op f.op) (w : f ≫ h = 0)  : S ⟶ J :=
(exact.lift h.op g.op f.op hgf (congr_arg quiver.hom.op w)).unop

@[simp] lemma exact.comp_desc {J Q R S : C} [injective J] (h : R ⟶ J) (f : Q ⟶ R) (g : R ⟶ S)
  (hgf : exact g.op f.op) (w : f ≫ h = 0) : g ≫ exact.desc h f g hgf w = h :=
by convert congr_arg quiver.hom.unop
  (exact.lift_comp h.op g.op f.op hgf (congr_arg quiver.hom.op w))

end

end injective
namespace adjunction

variables {D : Type*} [category D] {F : C ⥤ D} {G : D ⥤ C}

lemma map_injective (adj : F ⊣ G) [F.preserves_monomorphisms] (I : D) (hI : injective I) :
  injective (G.obj I) :=
⟨λ X Y f g, begin
  introI,
  rcases hI.factors (F.map f ≫ adj.counit.app _) (F.map g),
  use adj.unit.app Y ≫ G.map w,
  rw [←unit_naturality_assoc, ←G.map_comp, h],
  simp,
end⟩

lemma injective_of_map_injective (adj : F ⊣ G) [full G] [faithful G] (I : D)
  (hI : injective (G.obj I)) : injective I :=
⟨λ X Y f g, begin
  introI,
  haveI := adj.right_adjoint_preserves_limits,
  rcases hI.factors (G.map f) (G.map g),
  use inv (adj.counit.app _) ≫ F.map w ≫ adj.counit.app _,
  refine faithful.map_injective G _,
  simpa
end⟩

/-- Given an adjunction `F ⊣ G` such that `F` preserves monos, `G` maps an injective presentation
of `X` to an injective presentation of `G(X)`. -/
def map_injective_presentation (adj : F ⊣ G) [F.preserves_monomorphisms] (X : D)
  (I : injective_presentation X) : injective_presentation (G.obj X) :=
{ J := G.obj I.J,
  injective := adj.map_injective _ I.injective,
  f := G.map I.f,
  mono := by haveI := adj.right_adjoint_preserves_limits; apply_instance }

end adjunction
namespace equivalence

variables {D : Type*} [category D] (F : C ≌ D)

/-- Given an equivalence of categories `F`, an injective presentation of `F(X)` induces an
injective presentation of `X.` -/
def injective_presentation_of_map_injective_presentation
  (X : C) (I : injective_presentation (F.functor.obj X)) : injective_presentation X :=
{ J := F.inverse.obj I.J,
  injective := adjunction.map_injective F.to_adjunction I.J I.injective,
  f := F.unit.app _ ≫ F.inverse.map I.f,
  mono := mono_comp _ _ }

lemma enough_injectives_iff (F : C ≌ D) :
  enough_injectives C ↔ enough_injectives D :=
begin
  split,
  all_goals { intro H, constructor, intro X, constructor },
  { exact F.symm.injective_presentation_of_map_injective_presentation _
      (nonempty.some (H.presentation (F.inverse.obj X))) },
  { exact F.injective_presentation_of_map_injective_presentation X
      (nonempty.some (H.presentation (F.functor.obj X))) },
end

end equivalence
end category_theory


import LTS.defs property_catalogue.LTL.patterns tactic proof_data

open tactic

variable {M : LTS}
variable {α : Type}

namespace absent
namespace globally

lemma by_partition_before_after {π : path M} (P S : formula M) :
    (sat (exist.globally S) π ) → (sat (absent.before P S) π) → (sat (absent.after P S) π) → (sat (absent.globally P) π) :=
begin
    intros H1 H2 H3,
    rw absent.globally, rw sat,
    rw exist.globally at H1, rw sat at H1,
    rw absent.before at H2, iterate 3 {rw sat at H2},
    rw absent.after at H3, iterate 3 {rw sat at H3},
    simp at *,
    cases H1 with k H1,
    intro i,
    replace H2 := H2 k,
    replace H2 := H2 H1,
    cases H2 with w H2,
    have EM : (i < w) ∨ ¬ (i < w), from em (i<w),
    cases EM,
    apply H2.2,
    assumption,
    simp at EM,
    replace H3 := H3 w,
    cases H2 with L R,
    replace H3 := H3 L,
    have : ∃ j, i = w + j, from le_iff_exists_add.mp EM,
    cases this with j H4, rw H4,
    replace H3 := H3 j,
    rw path.drop_drop at H3,
    assumption,
end

meta def solve_by_partition (tok1 tok2 : expr) (ps : property_proof_data α ): tactic (property_proof_data α) :=
do
  tactic.interactive.apply ``(by_partition_before_after %%tok1 %%tok2),
  return ps
-- t1 ← tok1.log_format, t2 ← tok2.log_format,
--  s.log $ "apply by_partition_before_aft" ++ t1 ++ t2 ++ "\n"

meta def solve (tok : expr) (ps : property_proof_data α) : list expr → tactic (property_proof_data α)
| [] :=  return ps
| (h::t) :=
   do typ ← infer_type h,
   match typ with
   | `(sat (absent.before %%tok %%new) %%path):=
   do {ps ←  solve_by_partition tok new ps, return ps }<|> solve t
   | `(sat (absent.after %%tok %%new) %%path) :=
   do {ps ← solve_by_partition tok new ps, return ps }<|> solve t
   | _ := do solve t
   end

end globally

namespace between

theorem absent_between_response {M : LTS} {p : path M} { B I C : formula M} ( A : formula M) :
(sat (responds.globally  (C) (A) ) p) ∧
(sat (absent.between (B) (C) (A)) p) ∧
(sat (absent.between (B) (A) (I)) p)→ (sat (absent.between (B) (C) (I)) p) :=
begin rintros ⟨ H1, H2, H3⟩,
intro i,
replace H1 := H1 i,
intro Hcond, cases Hcond with L R,
replace H1 := H1 L,
rw absent.between at H2,
have : ((p.drop i) ⊨ (C &  ◆A)), by {rw sat, split,assumption,assumption},
replace H2 := H2 (i) this,
cases H1 with w Hw,
cases R with k Hk,
clear this,
cases H2 with z Hz,
cases Hz with z1 z2,
have : k < z ∨ ¬ (k < z), from or_not,
cases this,
use k,
split, assumption,
intros j Hj,
have fact : j < z, by omega,
replace z2 := z2 j fact, assumption,
simp at this,
have EM : z = k ∨ z < k, by omega,
clear this,
cases EM, use k,
split, assumption, rw ← EM, assumption,
replace H3 := H3 (i+z),
rw ← path.drop_drop at H3,
have help : (((p.drop i).drop z) ⊨ ◆(I)), by {use (k-z),
rw path.drop_drop, rw path.drop_drop,have : i + (z + (k - z)) = i+k, by omega, rw this, rw ← path.drop_drop, assumption,},
have : ( ((p.drop i).drop z) ⊨  (A &  ◆I)), by {rw sat, split, assumption, assumption,},
clear help, replace H3 := H3 this,
cases H3 with t Ht,
clear this,
cases Ht with Ht Ht',
rw path.drop_drop at *,
use (z+t),split,
assumption,
intros j Hj,
have : j < z ∨ ¬ (j < z), from or_not,
cases this, replace z2 := z2 j this,
assumption,
simp at this,
have EM' : z = j ∨ z < j, by omega,
cases EM', rw EM' at Hj,
replace Ht' := Ht' 0 _,
rw path.drop_drop at Ht',
rw← EM',
simp at Ht', rw path.drop_drop,assumption,
omega,
clear this,
replace Ht' := Ht' (j-z),
rw path.drop_drop at Ht',
have : (i + z + (j - z)) = (i + j), by omega,
rw this at Ht',
rw path.drop_drop,
 apply Ht', omega,
end

theorem foo {M : LTS} {P Q R : formula M} {x : path M} : (x ⊨ R ⇒ (P W Q)) ↔ (x ⊨ R ⇒ (P U Q)) ∨ (x ⊨ R ⇒ ◾ P) :=
begin
split,
intro H,
rw sat at H,
rw sat.weak_until at H,
rw imp_or_distrib at H,
cases H,
right, assumption,
left, assumption,
intro H,
rw sat,
rw sat.weak_until,
cases H,
intro Hr, replace H := H Hr,
right, assumption,
intro Hr, replace H := H Hr,left, assumption,
end

theorem absent_after_between_response {M : LTS} {p : path M} { B I C : formula M} ( A : formula M) :
(sat (responds.globally  (C) (A) ) p) ∧
(sat (absent.between (B) (C) (A)) p) ∧
(sat (absent.after_until (B) (A) (I)) p)→ (sat (absent.after_until (B) (C) (I)) p) :=
begin
  rintros ⟨H1, H2, H3⟩,
  rw after_until,
  intro i,
  rw foo,
  left,
  apply absent_between_response A,split,assumption,
  split,assumption,
  clear H2, clear H1,clear i,
  rw after_until at H3,
  rw between,
  intros i H,
  replace H3 := H3 i H,
  cases H with L R,
  cases H3,
  cases R with w Hw, use w, split, assumption,
  intros i _,
  replace H3 := H3 i, assumption, assumption,
end

meta def solve_by_absent_between_response (A : expr) (ps : property_proof_data α): tactic (property_proof_data α) :=
do
  tactic.interactive.apply ``(absent_between_response %%A),
  repeat1 (applyc `and.intro), `[repeat {assumption}],
  return ps

meta def solve  (ps : property_proof_data α) : list expr → tactic (property_proof_data α)
| [] :=  return ps
| (h::t) :=
   do typ ← infer_type h,
   match typ with
   | `(sat (responds.globally %%C %%A) _):=
    do {ps ← solve_by_absent_between_response A ps, return ps} <|> solve t
   | _ := do solve t
   end

end between

namespace after_until

theorem from_absent_between_response {M : LTS} {p : path M} { B I C : formula M} ( A : formula M) :
(sat (responds.globally  (C) (A) ) p) ∧
(sat (absent.between (B) (C) (A)) p) ∧
(sat (absent.after_until (B) (A) (I)) p)→ (sat (absent.after_until (B) (C) (I)) p) :=
begin
  rintros ⟨H1, H2, H3⟩,
  rw after_until,
  intro i,
  rw between.foo,
  left,
  apply between.absent_between_response A,split,assumption,
  split,assumption,
  clear H2, clear H1,clear i,
  rw after_until at H3,
  rw between,
  intros i H,
  replace H3 := H3 i H,
  cases H with L R,
  cases H3,
  cases R with w Hw, use w, split, assumption,
  intros i _,
  replace H3 := H3 i, assumption, assumption,
end

meta def solve_by_absent_between_response (A : expr) (ps : property_proof_data α): tactic (property_proof_data α) :=
do
  tactic.interactive.apply ``(from_absent_between_response %%A),
  ps ← ps.log "apply absent.after_until.from_absent_between_response",
  let ps := {used := ps.used ++ ["apply absent.after_until.from_absent_between_response"], ..ps},
  repeat1 (applyc `and.intro), `[repeat {assumption}],
  ps ← ps.log "match_premises",
  return {used := ps.used ++ ["match_premises"], ..ps}

meta def solve  (ps : property_proof_data α) : list expr → tactic (property_proof_data α)
| [] :=  return ps
| (h::t) :=
   do typ ← infer_type h,
   match typ with
   | `(sat (responds.globally %%C %%A) _):=
     do {ps ← solve_by_absent_between_response A ps, return ps} <|> solve t
   | _ := do solve t
   end

end after_until

end absent


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.bool.basic
import Mathlib.Lean3Lib.init.meta.default

universes u

namespace Mathlib

@[simp] theorem cond_a_a {α : Type u} (b : Bool) (a : α) : cond b a a = a := sorry

@[simp] theorem band_self (b : Bool) : b && b = b := sorry

@[simp] theorem band_tt (b : Bool) : b && tt = b := sorry

@[simp] theorem band_ff (b : Bool) : b && false = false := sorry

@[simp] theorem tt_band (b : Bool) : tt && b = b := sorry

@[simp] theorem ff_band (b : Bool) : false && b = false := sorry

@[simp] theorem bor_self (b : Bool) : b || b = b := sorry

@[simp] theorem bor_tt (b : Bool) : b || tt = tt := sorry

@[simp] theorem bor_ff (b : Bool) : b || false = b := sorry

@[simp] theorem tt_bor (b : Bool) : tt || b = tt := sorry

@[simp] theorem ff_bor (b : Bool) : false || b = b := sorry

@[simp] theorem bxor_self (b : Bool) : bxor b b = false := sorry

@[simp] theorem bxor_tt (b : Bool) : bxor b tt = bnot b := sorry

@[simp] theorem bxor_ff (b : Bool) : bxor b false = b := sorry

@[simp] theorem tt_bxor (b : Bool) : bxor tt b = bnot b := sorry

@[simp] theorem ff_bxor (b : Bool) : bxor false b = b := sorry

@[simp] theorem bnot_bnot (b : Bool) : bnot (bnot b) = b := sorry

@[simp] theorem tt_eq_ff_eq_false : ¬tt = false :=
  id fun (ᾰ : tt = false) => bool.no_confusion ᾰ

@[simp] theorem ff_eq_tt_eq_false : ¬false = tt :=
  id fun (ᾰ : false = tt) => bool.no_confusion ᾰ

@[simp] theorem eq_ff_eq_not_eq_tt (b : Bool) : (¬b = tt) = (b = false) := sorry

@[simp] theorem eq_tt_eq_not_eq_ff (b : Bool) : (¬b = false) = (b = tt) := sorry

theorem eq_ff_of_not_eq_tt {b : Bool} : ¬b = tt → b = false :=
  eq.mp (eq_ff_eq_not_eq_tt b)

theorem eq_tt_of_not_eq_ff {b : Bool} : ¬b = false → b = tt :=
  eq.mp (eq_tt_eq_not_eq_ff b)

@[simp] theorem band_eq_true_eq_eq_tt_and_eq_tt (a : Bool) (b : Bool) : a && b = tt = (a = tt ∧ b = tt) := sorry

@[simp] theorem bor_eq_true_eq_eq_tt_or_eq_tt (a : Bool) (b : Bool) : a || b = tt = (a = tt ∨ b = tt) := sorry

@[simp] theorem bnot_eq_true_eq_eq_ff (a : Bool) : bnot a = tt = (a = false) := sorry

@[simp] theorem band_eq_false_eq_eq_ff_or_eq_ff (a : Bool) (b : Bool) : a && b = false = (a = false ∨ b = false) := sorry

@[simp] theorem bor_eq_false_eq_eq_ff_and_eq_ff (a : Bool) (b : Bool) : a || b = false = (a = false ∧ b = false) := sorry

@[simp] theorem bnot_eq_ff_eq_eq_tt (a : Bool) : bnot a = false = (a = tt) := sorry

@[simp] theorem coe_ff : ↑false = False := sorry

@[simp] theorem coe_tt : ↑tt = True := sorry

@[simp] theorem coe_sort_ff : ↥false = False := sorry

@[simp] theorem coe_sort_tt : ↥tt = True := sorry

@[simp] theorem to_bool_iff (p : Prop) [d : Decidable p] : to_bool p = tt ↔ p := sorry

theorem to_bool_true {p : Prop} [Decidable p] : p → ↥(to_bool p) :=
  iff.mpr (to_bool_iff p)

theorem to_bool_tt {p : Prop} [Decidable p] : p → to_bool p = tt :=
  to_bool_true

theorem of_to_bool_true {p : Prop} [Decidable p] : ↥(to_bool p) → p :=
  iff.mp (to_bool_iff p)

theorem bool_iff_false {b : Bool} : ¬↥b ↔ b = false :=
  bool.cases_on b (of_as_true trivial) (of_as_true trivial)

theorem bool_eq_false {b : Bool} : ¬↥b → b = false :=
  iff.mp bool_iff_false

@[simp] theorem to_bool_ff_iff (p : Prop) [Decidable p] : to_bool p = false ↔ ¬p :=
  iff.trans (iff.symm bool_iff_false) (not_congr (to_bool_iff p))

theorem to_bool_ff {p : Prop} [Decidable p] : ¬p → to_bool p = false :=
  iff.mpr (to_bool_ff_iff p)

theorem of_to_bool_ff {p : Prop} [Decidable p] : to_bool p = false → ¬p :=
  iff.mp (to_bool_ff_iff p)

theorem to_bool_congr {p : Prop} {q : Prop} [Decidable p] [Decidable q] (h : p ↔ q) : to_bool p = to_bool q := sorry

@[simp] theorem bor_coe_iff (a : Bool) (b : Bool) : ↥(a || b) ↔ ↥a ∨ ↥b :=
  bool.cases_on a (bool.cases_on b (of_as_true trivial) (of_as_true trivial))
    (bool.cases_on b (of_as_true trivial) (of_as_true trivial))

@[simp] theorem band_coe_iff (a : Bool) (b : Bool) : ↥(a && b) ↔ ↥a ∧ ↥b :=
  bool.cases_on a (bool.cases_on b (of_as_true trivial) (of_as_true trivial))
    (bool.cases_on b (of_as_true trivial) (of_as_true trivial))

@[simp] theorem bxor_coe_iff (a : Bool) (b : Bool) : ↥(bxor a b) ↔ xor ↥a ↥b :=
  bool.cases_on a (bool.cases_on b (of_as_true trivial) (of_as_true trivial))
    (bool.cases_on b (of_as_true trivial) (of_as_true trivial))

@[simp] theorem ite_eq_tt_distrib (c : Prop) [Decidable c] (a : Bool) (b : Bool) : ite c a b = tt = ite c (a = tt) (b = tt) := sorry

@[simp] theorem ite_eq_ff_distrib (c : Prop) [Decidable c] (a : Bool) (b : Bool) : ite c a b = false = ite c (a = false) (b = false) := sorry


def f1 (xs : Option (Array Nat)) : Nat :=
  match xs with
  | some #[x, y] => x
  | _ => 0

def f2 (xs : Option (Array Nat)) : Nat :=
  match xs with
  | some #[0, y]   => y
  | some #[x+1, y] => x
  | _              => 0

theorem ex1 : f2 (some #[0, 2]) = 2  := rfl
theorem ex2 : f2 (some #[10, 2]) = 9 := rfl

def f3 (xs : Option (Array (Array Nat))) : Nat :=
  match xs with
  | some #[#[0], #[x]]    => x
  | some #[#[x+1], #[y]]  => x
  | _                     => 0

theorem ex3 : f3 (some #[#[10], #[5]]) = 9 := rfl
theorem ex4 : f3 (some #[#[0], #[5]])  = 5 := rfl
theorem ex5 : f3 (some #[#[0], #[5], #[4]]) = 0 := rfl

#check match some #[1, 2] with
  | some #[x, y] => x
  | _ => 0


/-
 Description : Basic utilities for islanders formalization.
 Copyright   : (c) Daniel Selsam, 2018
 License     : GPL-3
-/

def reduce_or : list Prop → Prop
| [] := false
| [p] := p
| (p::ps) := p ∨ reduce_or ps

lemma sub_one_lt {n : ℕ} (h : n ≥ 1) : n - 1 < n := sorry
lemma one_add_one_eq_2 : (1 : ℕ) + 1 = 2 := rfl


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

notation, basic datatypes and type classes
-/
prelude
import Init.Core

@[simp] theorem eq_self (a : α) : (a = a) = True :=
  propext <| Iff.intro (fun _ => trivial) (fun _ => rfl)

theorem of_eq_true (h : p = True) : p :=
  h ▸ trivial

theorem eq_true (h : p) : p = True :=
  propext <| Iff.intro (fun _ => trivial) (fun _ => h)

theorem eq_false (h : ¬ p) : p = False :=
  propext <| Iff.intro (fun h' => absurd h' h) (fun h' => False.elim h')

theorem eq_false' (h : p → False) : p = False :=
  propext <| Iff.intro (fun h' => absurd h' h) (fun h' => False.elim h')

theorem eq_true_of_decide {p : Prop} {s : Decidable p} (h : decide p = true) : p = True :=
  propext <| Iff.intro (fun h => trivial) (fun _ => of_decide_eq_true h)

theorem eq_false_of_decide {p : Prop} {s : Decidable p} (h : decide p = false) : p = False :=
  propext <| Iff.intro (fun h' => absurd h' (of_decide_eq_false h)) (fun h => False.elim h)

theorem implies_congr {p₁ p₂ : Sort u} {q₁ q₂ : Sort v} (h₁ : p₁ = p₂) (h₂ : q₁ = q₂) : (p₁ → q₁) = (p₂ → q₂) :=
  h₁ ▸ h₂ ▸ rfl

theorem implies_congr_ctx {p₁ p₂ q₁ q₂ : Prop} (h₁ : p₁ = p₂) (h₂ : p₂ → q₁ = q₂) : (p₁ → q₁) = (p₂ → q₂) :=
  propext <| Iff.intro
    (fun h hp₂ =>
      have : p₁ := h₁ ▸ hp₂
      have : q₁ := h this
      h₂ hp₂ ▸ this)
    (fun h hp₁ =>
      have hp₂ : p₂ := h₁ ▸ hp₁
      have : q₂ := h hp₂
      h₂ hp₂ ▸ this)

theorem forall_congr {α : Sort u} {p q : α → Prop} (h : ∀ a, (p a = q a)) : (∀ a, p a) = (∀ a, q a) :=
  have : p = q := funext h
  this ▸ rfl

theorem let_congr {α : Sort u} {β : Sort v} {a a' : α} {b b' : α → β} (h₁ : a = a') (h₂ : ∀ x, b x = b' x) :
        (let x := a; b x) = (let x := a'; b' x) := by
  subst h₁
  have : b = b' := funext h₂
  subst this
  rfl

theorem let_val_congr {α : Sort u} {β : Sort v} {a a' : α} (b : α → β) (h : a = a') :
        (let x := a; b x) = (let x := a'; b x) := by
  subst h
  rfl

theorem let_body_congr {α : Sort u} {β : α → Sort v} {b b' : (a : α) → β a} (a : α) (h : ∀ x, b x = b' x) :
        (let x := a; b x) = (let x := a; b' x) := by
  have : b = b' := funext h
  subst this
  rfl

@[congr]
theorem ite_congr {x y u v : α} {s : Decidable b} [Decidable c] (h₁ : b = c) (h₂ : c → x = u) (h₃ : ¬ c → y = v) : ite b x y = ite c u v := by
  cases Decidable.em c with
  | inl h => rw [if_pos h]; subst b; rw[if_pos h]; exact h₂ h
  | inr h => rw [if_neg h]; subst b; rw[if_neg h]; exact h₃ h

theorem Eq.mpr_prop {p q : Prop} (h₁ : p = q) (h₂ : q) : p :=
  h₁ ▸ h₂

theorem Eq.mpr_not {p q : Prop} (h₁ : p = q) (h₂ : ¬q) : ¬p :=
  h₁ ▸ h₂

@[congr]
theorem dite_congr {s : Decidable b} [Decidable c]
        {x : b → α} {u : c → α} {y : ¬b → α} {v : ¬c → α}
        (h₁ : b = c)
        (h₂ : (h : c)  → x (Eq.mpr_prop h₁ h) = u h)
        (h₃ : (h : ¬c) → y (Eq.mpr_not h₁ h)  = v h)
        : dite b x y = dite c u v := by
  cases Decidable.em c with
  | inl h => rw [dif_pos h]; subst b; rw [dif_pos h]; exact h₂ h
  | inr h => rw [dif_neg h]; subst b; rw [dif_neg h]; exact h₃ h

@[simp] theorem ne_eq (a b : α) : (a ≠ b) = Not (a = b) := rfl
@[simp] theorem ite_true (a b : α) : (if True then a else b) = a := rfl
@[simp] theorem ite_false (a b : α) : (if False then a else b) = b := rfl
@[simp] theorem dite_true {α : Sort u} {t : True → α} {e : ¬ True → α} : (dite True t e) = t True.intro := rfl
@[simp] theorem dite_false {α : Sort u} {t : False → α} {e : ¬ False → α} : (dite False t e) = e not_false := rfl
@[simp] theorem and_self (p : Prop) : (p ∧ p) = p := propext <| Iff.intro (fun h => h.1) (fun h => ⟨h, h⟩)
@[simp] theorem and_true (p : Prop) : (p ∧ True) = p := propext <| Iff.intro (fun h => h.1) (fun h => ⟨h, trivial⟩)
@[simp] theorem true_and (p : Prop) : (True ∧ p) = p := propext <| Iff.intro (fun h => h.2) (fun h => ⟨trivial, h⟩)
@[simp] theorem and_false (p : Prop) : (p ∧ False) = False := propext <| Iff.intro (fun h => h.2) (fun h => False.elim h)
@[simp] theorem false_and (p : Prop) : (False ∧ p) = False := propext <| Iff.intro (fun h => h.1) (fun h => False.elim h)
@[simp] theorem or_self (p : Prop) : (p ∨ p) = p := propext <| Iff.intro (fun | Or.inl h => h | Or.inr h => h) (fun h => Or.inl h)
@[simp] theorem or_true (p : Prop) : (p ∨ True) = True := propext <| Iff.intro (fun h => trivial) (fun h => Or.inr trivial)
@[simp] theorem true_or (p : Prop) : (True ∨ p) = True := propext <| Iff.intro (fun h => trivial) (fun h => Or.inl trivial)
@[simp] theorem or_false (p : Prop) : (p ∨ False) = p := propext <| Iff.intro (fun | Or.inl h => h | Or.inr h => False.elim h) (fun h => Or.inl h)
@[simp] theorem false_or (p : Prop) : (False ∨ p) = p := propext <| Iff.intro (fun | Or.inr h => h | Or.inl h => False.elim h) (fun h => Or.inr h)
@[simp] theorem iff_self (p : Prop) : (p ↔ p) = True := propext <| Iff.intro (fun h => trivial) (fun _ => Iff.intro id id)
@[simp] theorem iff_true (p : Prop) : (p ↔ True) = p := propext <| Iff.intro (fun h => h.mpr trivial) (fun h => Iff.intro (fun _ => trivial) (fun _ => h))
@[simp] theorem true_iff (p : Prop) : (True ↔ p) = p := propext <| Iff.intro (fun h => h.mp trivial) (fun h => Iff.intro (fun _ => h) (fun _ => trivial))
@[simp] theorem iff_false (p : Prop) : (p ↔ False) = ¬p := propext <| Iff.intro (fun h hp => h.mp hp) (fun h => Iff.intro h False.elim)
@[simp] theorem false_iff (p : Prop) : (False ↔ p) = ¬p := propext <| Iff.intro (fun h hp => h.mpr hp) (fun h => Iff.intro False.elim h)
@[simp] theorem false_implies (p : Prop) : (False → p) = True := propext <| Iff.intro (fun _ => trivial) (by intros; trivial)
@[simp] theorem implies_true (α : Sort u) : (α → True) = True := propext <| Iff.intro (fun _ => trivial) (by intros; trivial)
@[simp] theorem true_implies (p : Prop) : (True → p) = p := propext <| Iff.intro (fun h => h trivial) (by intros; trivial)

@[simp] theorem Bool.or_false (b : Bool) : (b || false) = b  := by cases b <;> rfl
@[simp] theorem Bool.or_true (b : Bool) : (b || true) = true := by cases b <;> rfl
@[simp] theorem Bool.false_or (b : Bool) : (false || b) = b  := by cases b <;> rfl
@[simp] theorem Bool.true_or (b : Bool) : (true || b) = true := by cases b <;> rfl
@[simp] theorem Bool.or_self (b : Bool) : (b || b) = b       := by cases b <;> rfl

@[simp] theorem Bool.and_false (b : Bool) : (b && false) = false := by cases b <;> rfl
@[simp] theorem Bool.and_true (b : Bool) : (b && true) = b       := by cases b <;> rfl
@[simp] theorem Bool.false_and (b : Bool) : (false && b) = false := by cases b <;> rfl
@[simp] theorem Bool.true_and (b : Bool) : (true && b) = b       := by cases b <;> rfl
@[simp] theorem Bool.and_self (b : Bool) : (b && b) = b          := by cases b <;> rfl