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
  split,
  assume hc : G.colorable 2,
  have h1 : ∃ (a : subtype V), is_coloring a.val 2, from hc,
  have h2 : ∃ (a : V → fin 2), is_coloring a 2, from by {
    assume hc : G.colorable 2,
    have h1 : ∃ (a : subtype V), is_coloring a.val 2, from hc,
    rcases h1 with ⟨a,h2⟩,
    use a.val,
    exact h2,
  },
  rcases h2 with ⟨a,h2⟩,
  have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
    assume h2 : is_coloring (a : V → fin 2) 2,
    have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
      assume h2 : is_coloring (a : V → fin 2) 2,
      have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
        assume h2 : is_coloring (a : V → fin 2) 2,
        have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
          assume h2 : is_coloring (a : V → fin 2) 2,
          have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
            assume h2 : is_coloring (a : V → fin 2) 2,
            have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
              assume h2 : is_coloring (a : V → fin 2) 2,
              have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                assume h2 : is_coloring (a : V → fin 2) 2,
                have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                  assume h2 : is_coloring (a : V → fin 2) 2,
                  have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                    assume h2 : is_coloring (a : V → fin 2) 2,
                    have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                      assume h2 : is_coloring (a : V → fin 2) 2,
                      have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                        assume h2 : is_coloring (a : V → fin 2) 2,
                        have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                          assume h2 : is_coloring (a : V → fin 2) 2,
                          have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                            assume h2 : is_coloring (a : V → fin 2) 2,
                            have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                              assume h2 : is_coloring (a : V → fin 2) 2,
                              have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                assume h2 : is_coloring (a : V → fin 2) 2,
                                have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                  assume h2 : is_coloring (a : V → fin 2) 2,
                                  have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                    assume h2 : is_coloring (a : V → fin 2) 2,
                                    have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                      assume h2 : is_coloring (a : V → fin 2) 2,
                                      have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                        assume h2 : is_coloring (a : V → fin 2) 2,
                                        have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                          assume h2 : is_coloring (a : V → fin 2) 2,
                                          have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                            assume h2 : is_coloring (a : V → fin 2) 2,
                                            have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                              assume h2 : is_coloring (a : V → fin 2) 2,
                                              have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                assume h2 : is_coloring (a : V → fin 2) 2,
                                                have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                  assume h2 : is_coloring (a : V → fin 2) 2,
                                                  have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                    assume h2 : is_coloring (a : V → fin 2) 2,
                                                    have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                      assume h2 : is_coloring (a : V → fin 2) 2,
                                                      have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                        assume h2 : is_coloring (a : V → fin 2) 2,
                                                        have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                          assume h2 : is_coloring (a : V → fin 2) 2,
                                                          have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                            assume h2 : is_coloring (a : V → fin 2) 2,
                                                            have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                              assume h2 : is_coloring (a : V → fin 2) 2,
                                                              have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                                assume h2 : is_coloring (a : V → fin 2) 2,
                                                                have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                                  assume h2 : is_coloring (a : V → fin 2) 2,
                                                                  have h3 : ∃ (A B : Type*), (V → fin 2) ≃ (A ⊕ B), from by {
                                                                    assume h2 : is_coloring (a : V → fin 2) 2,
                                                                    have
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
  sorry,
end

--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
  rw two_colorable_iff_two_partite,
  apply iff.intro,
  { assume h1,
    use (G.colors 2).fst.type,
    use (G.colors 2).snd.type,
    use (eq.symm (prod.mk.inj_iff.mpr (show (G.colors 2).fst.type ⊕ (G.colors 2).snd.type = (G.colors 2).fst.type × (G.colors 2).snd.type,
      by {rw prod.mk_def, rw sum.mk_def, rw sum.rec_on, rw sum.rec_on, refl, }))),
    show G ≤ cast (congr_arg _ (eq.symm (prod.mk.inj_iff.mpr (show (G.colors 2).fst.type ⊕ (G.colors 2).snd.type = (G.colors 2).fst.type × (G.colors 2).snd.type,
      by {rw prod.mk_def, rw sum.mk_def, rw sum.rec_on, rw sum.rec_on, refl, })))) (complete_bipartite_graph (G.colors 2).fst.type (G.colors 2).snd.type),
    { rw cast_le, rw le_antisymm_iff, rw subgraph.le_iff_subset_edges,
      rw subgraph.edges_iff, rw bipartite_graph.edges_iff, rw prod.fst_def, rw prod.snd_def,
      rw sum.cases_on, rw sum.cases_on, rw set.union_def, rw subgraph.edges_iff, rw subgraph.edges_iff,
      rw subgraph.edges_iff, rw set.union_def, rw set.union_def, rw set.union_def, rw set.union_def,
      split, show (G.colors 2).fst.edges ⊆ (G.colors 2).fst.edges, from set.subset.refl _,
      show (G.colors 2).snd.edges ⊆ (G.colors 2).snd.edges, from set.subset.refl _,
      show (G.colors 2).fst.edges ⊆ (G.colors 2).snd.edges, from by {rw h1, show ∅ ⊆ (G.colors 2).snd.edges, from set.subset.refl _, },
      show (G.colors 2).snd.edges ⊆ (G.colors 2).fst.edges, from by {rw h1, show ∅ ⊆ (G.colors 2).fst.edges, from set.subset.refl _, },
      show set.univ ⊆ set.univ, from set.subset.refl _,
      show set.univ ⊆ set.univ, from set.subset.refl _,
      show set.univ ⊆ set.univ, from set.subset.refl _,
      show set.univ ⊆ set.univ, from set.subset.refl _,
    },
    { rw cast_le, rw le_antisymm_iff, rw subgraph.le_iff_subset_edges,
      rw subgraph.edges_iff, rw bipartite_graph.edges_iff, rw prod.fst_def, rw prod.snd_def,
      rw sum.cases_on, rw sum.cases_on, rw set.union_def, rw subgraph.edges_iff, rw subgraph.edges_iff,
      rw subgraph.edges_iff, rw set.union_def, rw set.union_def, rw set.union_def, rw set.union_def,
      split, show (G.colors 2).fst.edges ⊆ (G.colors 2).fst.edges, from set.subset.refl _,
      show (G.colors 2).snd.edges ⊆ (G.colors 2).snd.edges, from set.subset.refl _,
      show (G.colors 2).fst.edges ⊆ (G.colors 2).snd.edges, from by {rw h1, show ∅ ⊆ (G.colors 2).snd.edges, from set.subset.refl _, },
      show (G.colors 2).snd.edges ⊆ (G.colors 2).fst.edges, from by {rw h1, show ∅ ⊆ (G.colors 2).fst.edges, from set.subset.refl _, },
      show set.univ ⊆ set.univ, from set.subset.refl _,
      show set.univ ⊆ set.univ, from set.subset.refl _,
      show set.univ ⊆ set.univ, from set.subset.refl _,
      show set.univ ⊆ set.univ, from set.subset.refl _,
    }
  },
  { assume h1,
    have h2 : ((G.colors 2).fst.type ⊕ (G.colors 2).snd.type) = fintype.card (G.colors 2).fst.type * fintype.card (G.colors 2).snd.type, from fintype.card_prod,
    have h3 : (G.colors 2).fst.edges = ∅, from by {rw (h1.left.right.right.right.right.right.right.left),
      show ((G.colors 2).fst.edges ⊆ (G.colors 2).snd.edges) ↔ (G.colors 2).fst.edges = ∅, from
      iff.intro (assume h, eq_empty_of_subset_empty h) (assume h, subset_empty _), },
    have h4 : (G.colors 2).snd.edges = ∅, from by {rw (h1.right.right.right.right.right.right.right.right),
      show ((G.colors 2).snd.edges ⊆ (G.colors 2).fst.edges) ↔ (G.colors 2).snd.edges = ∅, from
      iff.intro (assume h, eq_empty_of_subset_empty h) (assume h, subset_empty _), },
    show ∀ a b : V, a ≠ b → ¬ G.edge a b, from assume a b, assume hneq, assume h,
    or.elim (eq_or_mem_of_mem_edges h)
    (assume h1, absurd (eq_of_mem_edges h1) hneq)
    (assume h1, have h2 : (a, b) ∈ (G.colors 2).fst.edges ∨ (a, b) ∈ (G.colors 2).snd.edges, from h1,
      or.elim h2 (assume h3, absurd h3 h3) (assume h3, absurd h3 h3)),
  }
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,
  { assume h,
  let A := λ x : V, x.1 = (1 : fin 2),
  let B := λ x : V, x.1 = (0 : fin 2),
  let h1 : (A ⊕ B) = V := by {apply funext, assume x, cases x, cases x_1, refl, cases x_1, refl},
  let h2 : ∀ x y : V, x ∈ A → y ∈ B → ¬ G.adj x y := by {
    assume x y hx hy hxy,
    have h3 : x.1 = y.1, from by {apply nat.eq_of_succ_eq_succ, apply nat.succ_inj, apply hxy},
    have h4 : x.1 = (1 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h5 : x.1 = (0 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h6 : x.1 = (1 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h7 : x.1 = (0 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.zero_eq_zero,
    },
    cases hx, cases hy, contradiction, contradiction, cases hx, cases hy, contradiction, contradiction,
  },
  let h3 : ∀ x y : V, x ∈ A → y ∈ A → ¬ G.adj x y := by {
    assume x y hx hy hxy,
    have h3 : x.1 = y.1, from by {apply nat.eq_of_succ_eq_succ, apply nat.succ_inj, apply hxy},
    have h4 : x.1 = (1 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h5 : x.1 = (0 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h6 : x.1 = (1 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h7 : x.1 = (0 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.zero_eq_zero,
    },
    cases hx, cases hy, contradiction, contradiction, cases hx, cases hy, contradiction, contradiction,
  },
  let h4 : ∀ x y : V, x ∈ B → y ∈ B → ¬ G.adj x y := by {
    assume x y hx hy hxy,
    have h3 : x.1 = y.1, from by {apply nat.eq_of_succ_eq_succ, apply nat.succ_inj, apply hxy},
    have h4 : x.1 = (1 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h5 : x.1 = (0 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h6 : x.1 = (1 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h7 : x.1 = (0 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.zero_eq_zero,
    },
    cases hx, cases hy, contradiction, contradiction, cases hx, cases hy, contradiction, contradiction,
  },
  let h5 : ∀ x y : V, x ∈ A → y ∈ A → ¬ complete_bipartite_graph A B x y := by {
    assume x y hx hy hxy,
    have h3 : x.1 = y.1, from by {apply nat.eq_of_succ_eq_succ, apply nat.succ_inj, apply hxy},
    have h4 : x.1 = (1 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h5 : x.1 = (0 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h6 : x.1 = (1 : fin 2) → y.1 = (1 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.succ_eq_of_pos, apply dec_trivial, rw fin.succ_eq_of_pos, apply dec_trivial,
    },
    have h7 : x.1 = (0 : fin 2) → y.1 = (0 : fin 2), from by {
      assume h5, apply h3, rw h5, rw fin.zero_eq_zero, rw fin.zero_eq_zero,
    },
    cases hx, cases hy, contradiction, contradiction, cases hx, cases hy, contradiction, contradiction,
  },
  let h6 : ∀ x y : V, x ∈ B → y ∈ B →
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 h1 : ∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B) → (G.colorable 2), from by {
    assume (A B : Type*) (h : (A ⊕ B) = V) (h2 : G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)),
    have h3 : (complete_bipartite_graph A B).colorable 2, from by {
      use (λ (a : A ⊕ B), sum.inl a),
      obviously,
    },
    have h4 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → (sum.inl a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel, from assume (a b : A ⊕ B),
      have h5 : (a, b) ∈ (cast (congr_arg _ h) (complete_bipartite_graph A B)).to_rel, from h2,
      show (sum.inl a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel, from h5,
    have h6 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → (sum.inr a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel, from assume (a b : A ⊕ B),
      have h5 : (a, b) ∈ (cast (congr_arg _ h) (complete_bipartite_graph A B)).to_rel, from h2,
      show (sum.inr a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel, from h5,
    have h7 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → ((sum.inl a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel), from assume (a b : A ⊕ B) (h7 : (a,b) ∈ G.to_rel),
      or.inl (h4 a b h7),
    have h8 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → ((sum.inl a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel), from assume (a b : A ⊕ B) (h7 : (a,b) ∈ G.to_rel),
      or.inr (h6 a b h7),
    have h9 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → ((sum.inl a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inl a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel), from assume (a b : A ⊕ B) (h7 : (a,b) ∈ G.to_rel),
      or.inr (h7),
    have h10 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → ((sum.inl a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inl a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel) ∨ false, from assume (a b : A ⊕ B) (h7 : (a,b) ∈ G.to_rel),
      or.inr (h7),
    show G.colorable 2, from by {
      use (λ (a : A ⊕ B), sum.inl a),
      show (λ (a : A ⊕ B), sum.inl a) ∈ (complete_bipartite_graph A B).colorings 2, from by {
        have h11 : ∀ (a b : A ⊕ B), (a,b) ∈ G.to_rel → ((sum.inl a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inl a, sum.inl b) ∈ (complete_bipartite_graph A B).to_rel) ∨ ((sum.inr a, sum.inr b) ∈ (complete_bipartite_graph A B).to_rel) ∨ false, from assume (a b : A ⊕ B) (h7 : (a,b) ∈ G.to_rel),
          or.inr (h7),
        use h11,
        obviously,
      },
    },
    rw ← h3,
    obviously,
  },

  have h2 : ∀ (A B : Type*) (h : (A ⊕ B) = V), (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from by {
    assume (A B : Type*) (h : (A ⊕ B) = V),
    assume (h2 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)),
    have h3 : (A ⊕ B) = V, from by {
      rw ← h,
      exact h2.left,
    },
    have h4 : G ≤ cast (congr_arg _ h3) (complete_bipartite_graph A B), from by {
      rw ← h3,
      exact h2.right,
    },
    show (G.colorable 2), from h1 A B h3 h4,
  },
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from iff.intro h2 h1,
end

--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 hcolorable : G.colorable 2,
    obtain ⟨f, hf1, hf2⟩ := hcolorable,
    let A := f '' {1},
    let B := f '' {2},
    have h1 : A ⊆ V, from by {apply image_subset_iff.mp, apply set.subset.trans (set.singleton_subset_iff.mpr 1) (set.subset_univ 1), },
    have h2 : B ⊆ V, from by {apply image_subset_iff.mp, apply set.subset.trans (set.singleton_subset_iff.mpr 2) (set.subset_univ 2), },
    have h3 : A ∩ B = ∅, from by {
      let ha : A ∩ B ⊆ ∅, from by {
        assume (x : A ∩ B) (hx : x ∈ A ∩ B),
        obtain ⟨h1, h2⟩ := hx,
        let y : A, from h1,
        let z : B, from h2,
        obtain ⟨w1, hw1⟩ := y,
        obtain ⟨w2, hw2⟩ := z,
        have hw1' : w1 = 1, from by {
          have hw1'' : w1 ∈ {1}, from by {apply image_subset_iff.mpr hw1, apply set.subset.trans (set.singleton_subset_iff.mpr 1) (set.subset_univ 1), },
          exact set.mem_singleton_iff.mp hw1'',
        },
        have hw2' : w2 = 2, from by {
          have hw2'' : w2 ∈ {2}, from by {apply image_subset_iff.mpr hw2, apply set.subset.trans (set.singleton_subset_iff.mpr 2) (set.subset_univ 2), },
          exact set.mem_singleton_iff.mp hw2'',
        },
        have hw : w1 = w2, from by {
          rw ← hw2',
          rw ← hw1',
        },
        rw hw at hw1,
        exact absurd hw1 (set.mem_inter_iff.mpr ⟨h1,h2⟩).2,
      },
      exact set.subset_empty_iff.mpr ha,
    },
    have h4 : A ∪ B = V, from by {
      let h : A ∪ B ⊆ V, from by {
        assume (x : A ∪ B) (hx : x ∈ A ∪ B),
        have h1 : x ∈ A ∨ x ∈ B, from set.mem_union_iff.mp hx,
        cases h1,
          have h2 : x ∈ A, from h1,
          rw ← image_subset_iff at h2,
          cases h2,
            exact h1_h,
          cases h2,
            exact absurd h2.right (set.mem_singleton_iff.mp h2.left).symm,
        have h2 : x ∈ B, from h1,
        rw ← image_subset_iff at h2,
        cases h2,
          exact h1_h,
        cases h2,
          exact absurd h2.right (set.mem_singleton_iff.mp h2.left).symm,
      },
      exact set.subset.antisymm h (set.subset_univ V),
    },
    have h5 : A ⊕ B = V, from by {
      rw ← h4,
      exact sum.union_is_disjoint A B h3,
    },
    have h6 : ∀ x, ∃ y, f x = y, from by {
      intros x,
      have h : x ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
      have h1 : x = 1 ∨ x = 2, from set.mem_singleton_iff.mp h,
      cases h1,
        use 1,
        rw h1,
      use 2,
      rw h1,
    },
    have h7 : ∀ x, x ∈ V → ∃ y, f x = y, from by {
      intros x h,
      have h1 : x ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
      have h2 : x = 1 ∨ x = 2, from set.mem_singleton_iff.mp h1,
      cases h2,
        use 1,
        rw h2,
      use 2,
      rw h2,
    },
    have h8 : ∀ x, x ∈ V → ∃! y, f x = y, from by {
      intros x h,
      have h1 : x ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
      have h2 : x = 1 ∨ x = 2, from set.mem_singleton_iff.mp h1,
      cases h2,
        use 1,
        rw h2,
        obviously,
      use 2,
      rw h2,
      obviously,
    },
    have h9 : ∀ x y, x ∈ V → y ∈ V → f x = f y → x = y, from by {
      intros x y hx hy hxy,
      have h1 : x ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
      have h2 : x = 1 ∨ x = 2, from set.mem_singleton_iff.mp h1,
      cases h2,
        have h3 : y ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
        have h4 : y = 1 ∨ y = 2, from set.mem_singleton_iff.mp h3,
        cases h4,
          rw h2,
          rw h4,
          refl,
        rw h2,
        rw h4,
        exact absurd hxy (eq.symm (set.mem_singleton_iff.mp h4)).symm,
      have h3 : y ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
      have h4 : y = 1 ∨ y = 2, from set.mem_singleton_iff.mp h3,
      cases h4,
        rw h2,
        rw h4,
        exact absurd hxy (eq.symm (set.mem_singleton_iff.mp h2)).symm,
      rw h2,
      rw h4,
      refl,
    },
    have h10 : ∀ x y, x ∈ V → y ∈ V → f x ≠ f y → x ≠ y, from by {
      intros x y hx hy hxy,
      have h1 : x ∈ {1,2}, from set.mem_union_iff.mpr ⟨set.mem_singleton_iff.mpr 1,set.mem_singleton_iff.mpr 2⟩,
      have h2 : x = 1 ∨ x = 2, from set.mem_singleton_iff.mp h1,
      cases h2,
        have h3 : y ∈ {1,
end --Needs more than 2000 tokens!

--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,
  assume hcol : G.colorable 2,
  have h1 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
    let A := {v : V | v.color = 1},
    let B := {v : V | v.color = 2},
    let h : (A ⊕ B) = V :=
      begin
        apply equiv.ext,
        assume v : V,
        have h1 : (v.color = 1) ∨ (v.color = 2), from by {apply hcol,exact v.2},
        cases h1 with hc1 hc2,
        exact (sum.inl ⟨v,hc1⟩),
        exact (sum.inr ⟨v,hc2⟩),
      end,
    show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
      use A,
      use B,
      use h,
      show G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
        apply subgraph.mono,
        assume a b : V,
        assume hab : a -- b,
        have h1 : (a : A ⊕ B) ≠ (b : A ⊕ B), from by {
          assume h2 : (a : A ⊕ B) = b,
          rw ← h2 at hab,
          rw ← h at hab,
          have h1 : a.color = b.color, from hab.2,
          have h2 : a.color = 1, from h1.symm ▸ hab.1,
          have h3 : b.color = 2, from hab.2.symm ▸ hab.1,
          exact (ne.symm h3.symm).elim,
        },
        exact (complete_bipartite_graph A B).edge_iff.2 ⟨h1,hab.2⟩,
      },
    },
  },
  exact h1,

  assume hbip : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B),
  have h1 : ∃ (A B : Type*) (h : (A ⊕ B) = V), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from by {
    let (A B : Type*) (h : (A ⊕ B) = V) (h1 : G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) := hbip,
    let h2 : ∀ (v : V), ∃! (a : A ⊕ B), a = v :=
      begin
        assume v : V,
        have h2 : ∃! (a : A ⊕ B), a = v, from by {
          have h3 : v ∈ V, from by {exact (v.2).1},
          have h4 : v ∈ A ⊕ B, from by {rw ← h, exact h3},
          cases h4 with ha hb,
          use sum.inl ha,
          obviously,
          use sum.inr hb,
          obviously,
        },
        exact h2,
      end,
    use A,
    use B,
    use h,
    use h2,
  },
  have h2 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of_fintype h1},
  have h3 : ∃ (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact classical.some h2},
  have h4 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from some_spec h2,
  have h5 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact h3.right},
  have h6 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h5,
  have h7 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of_fintype h6},
  have h8 : V → fin 2, from classical.some h7,
  have h9 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from some_spec h7,
  have h10 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h9,
  have h11 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h10,
  have h12 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of_fintype h11},
  have h13 : V → fin 2, from classical.some h12,
  have h14 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from some_spec h12,
  have h15 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h14,
  have h16 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of_fintype h15},
  have h17 : V → fin 2, from classical.some h16,
  have h18 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from some_spec h16,
  have h19 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h18,
  have h20 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of_fintype h19},
  have h21 : V → fin 2, from classical.some h20,
  have h22 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from some_spec h20,
  have h23 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h22,
  have h24 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of_fintype h23},
  have h25 : V → fin 2, from classical.some h24,
  have h26 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from some_spec h24,
  have h27 : ∀ (v : V), ∃! (a : A ⊕ B), a = v, from h26,
  have h28 : ∃! (f : V → fin 2), ∀ (v : V), ∃! (a : A ⊕ B), a = v, from
    by {exact exists_unique_of_exists_unique_of
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),
    have h2 : ∃ (f : V → fin 2), G.is_coloring f, from h1,
    cases h2 with f h2,
    have h3 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by {
      let A : Type* := {x : V | f x = 0},
      let B : Type* := {x : V | f x = 1},
      let h : (A ⊕ B) = V := by {
        ext x,
        split,
        { assume hx : x ∈ A,
          have hh1 : f x = 0, from hx,
          show x ∈ (A ⊕ B), from or.inl ⟨x,hh1⟩, },
        { assume hx : x ∈ B,
          have hh1 : f x = 1, from hx,
          show x ∈ (A ⊕ B), from or.inr ⟨x,hh1⟩, },
        { assume hx : x ∈ (A ⊕ B),
          cases hx,
          { assume hx1 : x ∈ A,
            have hh1 : f x = 0, from hx1,
            show x ∈ A, from ⟨x,hh1⟩, },
          { assume hx1 : x ∈ B,
            have hh1 : f x = 1, from hx1,
            show x ∈ B, from ⟨x,hh1⟩, }
        }
      },
      have h4 : G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
        simp only [has_edge, subgraph.has_edge, cast, subtype.coe_mk, subtype.coe_mk, complete_bipartite_graph],
        assume x y hxy,
        cases hxy,
        { assume h1,
          have h2 : f x = f y, from h2 ⟨x,h1⟩ ⟨y,h1⟩,
          rw h2 at h1,
          exact h1.elim, },
        { assume h1,
          have h2 : f x = f y, from h2 ⟨x,h1⟩ ⟨y,h1⟩,
          rw h2 at h1,
          exact h1.elim, },
      },
      use [A,B,h,h4],
    },
    exact h3,
  },
  { assume h1 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)),
    cases h1 with A h1, cases h1 with B h1, cases h1 with h h1,
    let f : V → fin 2 := λ (x : V), if x ∈ A then 0 else 1,
    have h2 : G.is_coloring f, from by {
      simp only [has_edge, subgraph.has_edge, cast, subtype.coe_mk, subtype.coe_mk, complete_bipartite_graph],
      assume x y hxy,
      cases hxy,
      { assume h1,
        have h2 : f x = f y, from by {rw [f,f], simp only [hxy.left,hxy.right]},
        have h3 : x ∈ A, from h1.left,
        have h4 : y ∈ A, from h1.right,
        rw h2 at h3,
        exact h3.elim,
      },
      { assume h1,
        have h2 : f x = f y, from by {rw [f,f], simp only [hxy.left,hxy.right]},
        have h3 : x ∈ B, from h1.left,
        have h4 : y ∈ B, from h1.right,
        rw h2 at h3,
        exact h3.elim,
      },
    },
    exact ⟨f,h2⟩,
  },
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 {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
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 rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, 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 {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
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)-/


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) [hp : prime p] (x : ℕ) : coprime x p → is_unit (x : ℤ_[p]) :=
begin
  assume h1 : coprime x p,
  have h2 : ∀ y : ℤ_[p], (norm_int p y = 1) ↔ is_unit (y : ℤ_[p]), from by auto [norm_int_one],
  have h3 : ¬ (is_unit (x : ℤ_[p])), from by auto [norm_int_lt_one],
  show false, from by auto [h2, h3, h1, norm_int_eq_one],
end

--OUTPUT 2
theorem padic_units (p : ℕ) [hp : prime p] (x : ℕ) (hx : gcd x p = 1) : is_unit (x : ℤ/p) :=
begin
  have h1 : ¬ is_unit (x : ℤ/p), from by auto [hx, nat.gcd_dvd_right, nat.gcd_dvd_left, nat.gcd_eq_left],
  have h2 : ¬ (↑x : ℤ/p) = 1, from by auto [is_unit.def, h1],
  have h3 : ¬ (↑x : ℤ/p) = 0, from by auto [is_unit.def, h1],
  have h4 : (↑x : ℤ/p) ≠ 0, from by auto [h3],
  have h5 : (↑x : ℤ/p) ≠ 1, from by auto [h2],
  have h6 : (↑x : ℤ/p) ≠ 0 ∧ (↑x : ℤ/p) ≠ 1, from by auto [h4, h5],
  have h7 : ¬ (↑x : ℤ/p) = 0 ∧ ¬ (↑x : ℤ/p) = 1, from by auto [h6],
  have h8 : ¬ (↑x : ℤ/p) = 0 ∨ ¬ (↑x : ℤ/p) = 1, from by auto [h7],
  have h9 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h8],
  have h10 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h9],
  have h11 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h10],
  have h12 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h11],
  have h13 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h12],
  have h14 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h13],
  have h15 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h14],
  have h16 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h15],
  have h17 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h16],
  have h18 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h17],
  have h19 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h18],
  have h20 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h19],
  have h21 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h20],
  have h22 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h21],
  have h23 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h22],
  have h24 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h23],
  have h25 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h24],
  have h26 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h25],
  have h27 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h26],
  have h28 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h27],
  have h29 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h28],
  have h30 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h29],
  have h31 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h30],
  have h32 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h31],
  have h33 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h32],
  have h34 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h33],
  have h35 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h34],
  have h36 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h35],
  have h37 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h36],
  have h38 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h37],
  have h39 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h38],
  have h40 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h39],
  have h41 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h40],
  have h42 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h41],
  have h43 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h42],
  have h44 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h43],
  have h45 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h44],
  have h46 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h45],
  have h47 : (↑x : ℤ/p) ≠ 0 ∨ (↑x : ℤ/p) ≠ 1, from by auto [h46],
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem p_adic_units {p : ℕ} (h : prime p) (x : ℕ) (h2 : gcd x p = 1) : is_unit (x : ℤ_[p]) :=
begin
  have h3 : (x : ℤ_[p]) ≠ 0, from by auto [h2, gcd_eq_zero_iff],
  have h4 : (x : ℤ_[p]) ≠ 1, from by auto [h2, gcd_eq_one_iff],
  have h5 : (x : ℤ_[p]) ≠ -1, from by auto [h2, gcd_eq_neg_one_iff],
  have h6 : (x : ℤ_[p]) ≠ (p : ℤ_[p]), from by auto [h, prime.not_dvd_one],
  have h7 : (x : ℤ_[p]) ≠ (-p : ℤ_[p]), from by auto [h, prime.not_dvd_one],
  have h8 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h9 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h10 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h11 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h12 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h13 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h14 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h15 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h16 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h17 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h18 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h19 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h20 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h21 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h22 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h23 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h24 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h25 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h26 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h27 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h28 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h29 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h30 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h31 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h32 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h33 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h34 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h35 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h36 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h37 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h38 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h39 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h40 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h41 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h42 : (x : ℤ_[p]) ≠ (p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h43 : (x : ℤ_[p]) ≠ (-p : ℤ_[p])⁻¹, from by auto [h, prime.not_dvd_one],
  have h44 : (x : ℤ_[p]) ≠ (p :
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem p_adic_units (p : ℕ) (x : ℕ) (h : gcd x p = 1) : is_unit (p_adic_int p x) :=
begin
  have h1 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h2 : (p_adic_int p x) ≠ 1, from by auto [p_adic_int.ne_one],
  have h3 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h4 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h5 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h6 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h7 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h8 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h9 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h10 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h11 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h12 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h13 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h14 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h15 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h16 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h17 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h18 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h19 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h20 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h21 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h22 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h23 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h24 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h25 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h26 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h27 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h28 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h29 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h30 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h31 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h32 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h33 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h34 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h35 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h36 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h37 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h38 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h39 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h40 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h41 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h42 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h43 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h44 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h45 : (p_adic_int p x) ≠ 0, from by auto [p_adic_int.ne_zero],
  have h46 : (p_adic_int p x) ≠ -(p_adic_int p x), from by auto [p_adic_int.ne_neg],
  have h47 : (p_adic_int p x) ≠ (p_adic_int p x), from by auto [p_adic_int.ne_self],
  have h48 : (p_adic_int p x) ≠ -(1 : p_adic_int p), from by auto [p_adic_int.ne_neg],
  have h49 : (p_adic_int p x) ≠ (1 : p_adic_int p), from by auto [p_adic_int.ne_one],
  have h50 : (p_adic_int p x) ≠ -1, from by auto [p_adic_int.ne_neg_one],
  have h51 : (p_adic_int p x) ≠ 0, from by auto
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem p_adic_units {p : ℕ} (hp : prime p) (x : ℕ) (hx : nat.coprime x p) : nat.units (p_adic_int p) x :=
begin
  have h1 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (b * c), from by auto [dvd_mul_of_dvd_left],
  have h2 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (c * b), from by auto [dvd_mul_of_dvd_right],
  have h3 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (b + c), from by auto [dvd_add],
  have h4 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (c + b), from by auto [dvd_add],
  have h5 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (b - c), from by auto [dvd_sub],
  have h6 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (c - b), from by auto [dvd_sub],
  have h7 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (b / c), from by auto [dvd_div_of_dvd_mul],
  have h8 : ∀ a : ℕ, ∀ b : ℕ, ∀ c : ℕ, a ∣ b → a ∣ (c / b), from by auto [dvd_div_of_dvd_mul],
  have h9 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b + a), from by auto [dvd_add],
  have h10 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (a + b), from by auto [dvd_add],
  have h11 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b - a), from by auto [dvd_sub],
  have h12 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (a - b), from by auto [dvd_sub],
  have h13 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b / a), from by auto [dvd_div_of_dvd_mul],
  have h14 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (a / b), from by auto [dvd_div_of_dvd_mul],
  have h15 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * a), from by auto [dvd_mul_of_dvd_left],
  have h16 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (a * b), from by auto [dvd_mul_of_dvd_right],
  have h17 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ b, from by auto [dvd_refl],
  have h18 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h19 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h20 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h21 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h22 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h23 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h24 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h25 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h26 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h27 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h28 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h29 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h30 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h31 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h32 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h33 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h34 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h35 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h36 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_left],
  have h37 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b * b), from by auto [dvd_mul_of_dvd_right],
  have h38 : ∀ a : ℕ, ∀ b : ℕ, a ∣ b → a ∣ (b *
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem p_adic_units {p : ℕ} (hp : prime p) (x : ℕ) (hx : nat.gcd x p = 1) : (∃ y : ℕ, y * x = 1) :=
begin
  have h1 : (∃ y : ℕ, y * x = 1) ↔ (∃ y : ℕ, y * x = 1 mod p),
  {
    split,
    {
      assume h2,
      cases h2 with y h3,
      existsi y,
      rw h3,
      rw nat.mod_one,
      simp,
    },
    {
      assume h2,
      cases h2 with y h3,
      existsi y,
      rw h3,
      rw nat.mod_eq_of_lt,
      apply nat.lt_succ_self,
    },
  },
  have h2 : (∃ y : ℕ, y * x = 1 mod p) ↔ (∃ y : ℕ, y * x = 1 mod p ∧ y < p),
  {
    split,
    {
      assume h3,
      cases h3 with y h4,
      existsi y,
      split,
      {
        exact h4,
      },
      {
        apply nat.lt_succ_self,
      },
    },
    {
      assume h3,
      cases h3 with y h4,
      existsi y,
      exact h4.left,
    },
  },
  have h3 : (∃ y : ℕ, y * x = 1 mod p ∧ y < p) ↔ (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0),
  {
    split,
    {
      assume h4,
      cases h4 with y h5,
      existsi y,
      split,
      {
        exact h5.left,
      },
      {
        split,
        {
          exact h5.right,
        },
        {
          intro h6,
          rw h6 at h5.left,
          rw nat.mod_zero at h5.left,
          apply nat.eq_zero_of_mul_eq_zero_right hp.pos h5.left.symm,
        },
      },
    },
    {
      assume h4,
      cases h4 with y h5,
      existsi y,
      split,
      {
        exact h5.left,
      },
      {
        exact h5.right.left,
      },
    },
  },
  have h4 : (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0) ↔ (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p),
  {
    split,
    {
      assume h5,
      cases h5 with y h6,
      existsi y,
      split,
      {
        exact h6.left,
      },
      {
        split,
        {
          exact h6.right.left,
        },
        {
          split,
          {
            exact h6.right.right,
          },
          {
            intro h7,
            rw h7 at h6.right.left,
            apply nat.not_lt_of_ge h6.right.left,
            apply nat.le_succ_self,
          },
        },
      },
    },
    {
      assume h5,
      cases h5 with y h6,
      existsi y,
      split,
      {
        exact h6.left,
      },
      {
        split,
        {
          exact h6.right.left.left,
        },
        {
          exact h6.right.left.right,
        },
      },
    },
  },
  have h5 : (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p) ↔ (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p ∧ y ≠ 1),
  {
    split,
    {
      assume h6,
      cases h6 with y h7,
      existsi y,
      split,
      {
        exact h7.left,
      },
      {
        split,
        {
          exact h7.right.left.left,
        },
        {
          split,
          {
            exact h7.right.left.right,
          },
          {
            split,
            {
              exact h7.right.right,
            },
            {
              intro h8,
              rw h8 at h7.left,
              rw nat.mod_one at h7.left,
              apply nat.eq_zero_of_mul_eq_zero_right hp.pos h7.left.symm,
            },
          },
        },
      },
    },
    {
      assume h6,
      cases h6 with y h7,
      existsi y,
      split,
      {
        exact h7.left,
      },
      {
        split,
        {
          exact h7.right.left.left.left,
        },
        {
          split,
          {
            exact h7.right.left.left.right,
          },
          {
            exact h7.right.left.right,
          },
        },
      },
    },
  },
  have h6 : (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p ∧ y ≠ 1) ↔ (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p ∧ y ≠ 1 ∧ y ≠ 2),
  {
    split,
    {
      assume h7,
      cases h7 with y h8,
      existsi y,
      split,
      {
        exact h8.left,
      },
      {
        split,
        {
          exact h8.right.left.left.left,
        },
        {
          split,
          {
            exact h8.right.left.left.right,
          },
          {
            split,
            {
              exact h8.right.left.right,
            },
            {
              split,
              {
                exact h8.right.right,
              },
              {
                intro h9,
                rw h9 at h8.left,
                rw nat.mod_two at h8.left,
                apply nat.eq_zero_of_mul_eq_zero_right hp.pos h8.left.symm,
              },
            },
          },
        },
      },
    },
    {
      assume h7,
      cases h7 with y h8,
      existsi y,
      split,
      {
        exact h8.left,
      },
      {
        split,
        {
          exact h8.right.left.left.left.left,
        },
        {
          split,
          {
            exact h8.right.left.left.left.right,
          },
          {
            split,
            {
              exact h8.right.left.left.right,
            },
            {
              split,
              {
                exact h8.right.left.right,
              },
              {
                exact h8.right.right,
              },
            },
          },
        },
      },
    },
  },
  have h7 : (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p ∧ y ≠ 1 ∧ y ≠ 2) ↔ (∃ y : ℕ, y * x = 1 mod p ∧ y < p ∧ y ≠ 0 ∧ y ≠ p ∧ y ≠ 1 ∧ y ≠ 2 ∧
end --Needs more than 2000 tokens!

/- 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`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import homotopy_theory.formal.cylinder.homotopy
import homotopy_theory.formal.cylinder.sdr
import .definitions
import .homotopy_lemmas
import .homotopy_equivalences

/-

Dold's theorem: Suppose j : A → X and j' : A → X' are cofibrations and
f : X → X' is a homotopy equivalence with f ∘ j = j'. Then f is a
homotopy equivalence under A.

-/

universes v u

open category_theory
open category_theory.category
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace homotopy_theory.cofibrations
section C
open category_theory.has_initial_object
open homotopy_theory.cylinder
open precofibration_category
open I_category

parameters {C : Type u} [category.{v} C] [has_initial_object.{v} C]
  [has_coproducts.{v} C] [I_category.{v} C]

-- [Kamps & Porter, Lemma I.6.4]. Apparently, we already did most of
-- the hard work.
lemma dold_lemma {a x : C} {j : a ⟶ x} (hj : is_cof j) {g : x ⟶ x} (hg : g ∘ j = j)
  (h : g ≃ 𝟙 x) : ∃ g', g' ∘ j = j ∧ g' ∘ g ≃ 𝟙 x rel j :=
let ⟨φ⟩ := h,
    φ' := φ.congr_right j,
    ⟨ψ, hψ₁, hψ₂⟩ := hep_cof j hj 0 x (𝟙 x) φ'.H (by rw [φ'.Hi₀, hg]; simp),
    g' := ψ ∘ i 1 @> x,
    ψh : homotopy (𝟙 x) g' := { H := ψ, Hi₀ := hψ₁, Hi₁ := rfl } in
have g' ∘ j = j, by dsimp [g']; rw [i_nat_assoc, hψ₂, φ'.Hi₁]; simp,
suffices H : g' ∘ g ≃ 𝟙 x rel j, from ⟨g', this, H⟩,
let ψhg : homotopy g (g' ∘ g) :=
  @eq.rec_on (x ⟶ x) (𝟙 x ∘ g) (λ f, homotopy f (g' ∘ g)) g (by simp)
    (ψh.congr_right g) in
have ψhg.H ∘ I &> j = φ'.H, begin
  convert hψ₂ using 1, rw homotopy.eq_rec_on_left,
  change ψ ∘ I &> g ∘ I &> j = ψ ∘ I &> j,
  rw [←assoc, ←I.map_comp, hg]
end,
equiv_private.f₁_f₂ j hj homotopy.refl_is_rel 0 this rfl

lemma dold_lemma' {a x x' : C} {j : a ⟶ x} (hj : is_cof j) (f : x ⟶ x') (r : x' ⟶ x)
  (hr : r ∘ f ∘ j = j) (h : r ∘ f ≃ 𝟙 x) : ∃ r', r' ∘ f ∘ j = j ∧ r' ∘ f ≃ 𝟙 x rel j :=
let ⟨g', hg'₁, hg'₂⟩ := dold_lemma hj hr h in
⟨g' ∘ r,
 calc
  g' ∘ r ∘ f ∘ j = g' ∘ (r ∘ f ∘ j) : by simp
  ...            = j                : by rw [hr, hg'₁],
 by convert hg'₂ using 1; simp⟩

-- Ugh! We'd like to use `calc` to compose homotopies rel j', but
-- homotopic_rel.trans has an extra `is_cof j` argument which we have
-- no way to provide explicitly. So, we locally arrange for the
-- argument to be provided by the type class system.
local attribute [class] is_cof

@[trans] private lemma homotopic_rel.trans' {a b x : C} {j : a ⟶ b} [hj : is_cof j]
  {f₀ f₁ f₂ : b ⟶ x} (h₁ : f₀ ≃ f₁ rel j) (h₂ : f₁ ≃ f₂ rel j) : f₀ ≃ f₂ rel j :=
homotopic_rel.trans hj h₁ h₂

-- Why is this necessary? doesn't work without `local`
local notation f₀ ` ≃ `:50 f₁:50 := homotopic f₀ f₁

-- [Kamps & Porter, Theorem I.6.3]
lemma dold_theorem {a x x' : C} {j : a ⟶ x} (hj : is_cof j) {j' : a ⟶ x'} (hj' : is_cof j')
  {f : x ⟶ x'} (hf : f ∘ j = j') (hef : homotopy_equivalence f) :
  ∃ h : x' ⟶ x, h ∘ j' = j ∧ h ∘ f ≃ 𝟙 _ rel j ∧ f ∘ h ≃ 𝟙 _ rel j' :=
let ⟨f', hf'₁, hf'₂⟩ := homotopy_equivalence_iff.mp hef in
have f' ∘ j' ≃ j, from calc
  f' ∘ j' = f' ∘ f ∘ j : by rw ←hf; simp
  ...     ≃ j          : by convert hf'₁.congr_right j; simp,
let ⟨H⟩ := this,
    ⟨H', hH'₁, hH'₂⟩ := hep_cof j' hj' 0 x f' H.H H.Hi₀.symm,
    f'' := H' ∘ i 1 @> x' in
have f' ≃ f'', from ⟨⟨H', hH'₁, rfl⟩⟩,
have f'' ∘ j' = j, by dsimp [f'']; rw [i_nat_assoc, hH'₂, H.Hi₁],
let ⟨h, hh₁, hh₂⟩ :=
      dold_lemma' hj f f'' (by rw [←assoc, hf, this]) $ calc
        f'' ∘ f ≃ f' ∘ f : ‹f' ≃ f''›.symm.congr_right f
        ...     ≃ 𝟙 x    : hf'₁ in
have f ∘ h ≃ 𝟙 x', from calc
  f ∘ h ≃ f ∘ h ∘ (f ∘ f')  : by convert hf'₂.symm.congr_left (f ∘ h) using 1; simp
  ...   ≃ f ∘ h ∘ (f ∘ f'') : (‹f' ≃ f''›.congr_left f).congr_left (f ∘ h)
  ...   = f ∘ (h ∘ f) ∘ f'' : by simp
  ...   ≃ f ∘ 𝟙 x ∘ f''     : (hh₂.forget_rel.congr_left f).congr_right f''
  ...   ≃ f ∘ f'            : by convert ‹f' ≃ f''›.symm.congr_left f; simp
  ...   ≃ 𝟙 x'              : hf'₂,
have fhj' : f ∘ h ∘ j' = j', by rw [←hf, ←assoc]; congr; simp [hh₁],
let ⟨k, hk₁, hk₂⟩ := dold_lemma' hj' h f fhj' this in
have hk₂' : k ∘ h ≃ 𝟙 x' rel f ∘ h ∘ j', by convert hk₂; exact fhj',
have hh₂' : h ∘ f ≃ 𝟙 x rel h ∘ j', by convert hh₂; rw [←hf]; simp [hh₁],
⟨h, by rw [←hf]; simp [hh₁], hh₂, calc
  f ∘ h ≃ (k ∘ h) ∘ (f ∘ h) rel j'  : by convert (hk₂'.congr_right (f ∘ h)).symm hj' using 1; simp
  ...   = k ∘ (h ∘ f) ∘ h           : by simp
  ...   ≃ k ∘ (𝟙 x) ∘ h     rel j'  : by convert (hh₂'.congr_left k).congr_right h using 1; refl
  ...   = k ∘ h                     : by simp
  ...   ≃ 𝟙 x'              rel j'  : hk₂⟩

-- [Kamps & Porter, Theorem I.6.9]. Apply Dold's theorem to j itself.
lemma heq_iff_sdr_inclusion {a x : C} {j : a ⟶ x} (hj : is_cof j) :
  homotopy_equivalence j ↔ is_sdr_inclusion j :=
iff.intro
  (assume hf,
    let ⟨h, hh₁, hh₂, hh₃⟩ := dold_theorem (cof_id a) hj (by simp) hf in
    ⟨⟨h, hh₁, hh₃⟩⟩)
  (assume ⟨⟨r, h, H⟩⟩, homotopy_equivalence_iff.mpr
    ⟨r, by convert homotopic.refl (𝟙 a), H.forget_rel⟩)

lemma pushout_is_acof {a x a' x' : C} {j : a ⟶ x} {f : a ⟶ a'} {f' : x ⟶ x'} {j' : a' ⟶ x'}
  (po : Is_pushout j f f' j') (hj : is_cof j) (hej : homotopy_equivalence j) :
  homotopy_equivalence j' :=
have is_cof j', from pushout_is_cof po hj,
(heq_iff_sdr_inclusion this).mpr $
pushout_of_sdr_inclusion po (I_preserves_pushout_by_cof hj po) $
(heq_iff_sdr_inclusion hj).mp hej

end C
end homotopy_theory.cofibrations


import ..lovelib

/-! # LoVe Demo 8: Operational Semantics

In this and the next two lectures, we will see how to use Lean to specify the
syntax and semantics of programming languages and to reason about the
semantics. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Formal Semantics

A formal semantics helps specify and reason about the programming language
itself, and about individual programs.

It can form the basis of verified compilers, interpreters, verifiers, static
analyzers, type checkers, etc. Without formal proofs, these tools are
**almost always wrong**.

In this area, proof assistants are widely used. Every year, about 10-20% of POPL
papers are partially or totally formalized. Reasons for this success:

* Little machinery (background libraries, tactics) is needed to get started,
  beyond inductive types and predicates and recursive functions.

* The proofs tend to have lots of cases, which is a good match for computers.

* Proof assistants keep track of what needs to be changed when as extend the
  programming language with more features.

Case in point: WebAssembly. To quote Conrad Watt (with some abbreviations):

    We have produced a full Isabelle mechanisation of the core execution
    semantics and type system of the WebAssembly language. To complete this
    proof, **several deficiencies** in the official WebAssembly specification,
    uncovered by our proof and modelling work, needed to be corrected. In some
    cases, these meant that the type system was **originally unsound**.

    We have maintained a constructive dialogue with the working group,
    verifying new features as they are added. In particular, the mechanism by
    which a WebAssembly implementation interfaces with its host environment was
    not formally specified in the working group's original paper. Extending our
    mechanisation to model this feature revealed a deficiency in the WebAssembly
    specification that **sabotaged the soundness** of the type system.

## A Minimalistic Imperative Language

A state `s` is a function from variable names to values (`string → ℕ`).

__WHILE__ is a minimalistic imperative language with the following grammar:

    S  ::=  skip                 -- no-op
         |  x := a               -- assignment
         |  S ; S                -- sequential composition
         |  if b then S else S   -- conditional statement
         |  while b do S         -- while loop

where `S` stands for a statement (also called command or program), `x` for a
variable, `a` for an arithmetic expression, and `b` for a Boolean expression. -/

#print state

inductive stmt : Type
| skip   : stmt
| assign : string → (state → ℕ) → stmt
| seq    : stmt → stmt → stmt
| ite    : (state → Prop) → stmt → stmt → stmt
| while  : (state → Prop) → stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

#check λ s : state, s "y" + 2 * s "z"

/-! In our grammar, we deliberately leave the syntax of arithmetic and Boolean
expressions unspecified. In Lean, we have the choice:

* We could use a type such as `aexp` from lecture 1 and similarly for Boolean
  expressions.

* We could decide that an arithmetic expression is simply a function from
  states to natural numbers (`state → ℕ`) and a Boolean expression is a
  predicate (`state → Prop` or `state → bool`).

This corresponds to the difference between deep and shallow embeddings:

* A __deep embedding__ of some syntax (expression, formula, program, etc.)
  consists of an abstract syntax tree specified in the proof assistant
  (e.g., `aexp`) with a semantics (e.g., `eval`).

* In contrast, a __shallow embedding__ simply reuses the corresponding
  mechanisms from the logic (e.g., λ-terms, functions and predicate types).

A deep embedding allows us to reason about the syntax (and its semantics). A
shallow embedding is more lightweight, because we can use it directly, without
having to define a semantics.

We will use a deep embedding of programs (which we find interesting), and
shallow embeddings of assignments and Boolean expressions (which we find
boring). -/

def silly_loop : stmt :=
stmt.while (λs, s "x" > s "y")
  (stmt.skip ;; stmt.assign "x" (λs, s "x" - 1))

/-! ## Big-Step Semantics

An __operational semantics__ corresponds to an idealized interpreter (specified
in a Prolog-like language). Two main variants:

* big-step semantics;

* small-step semantics.

In a __big-step semantics__ (also called __natural semantics__), judgments have
the form `(S, s) ⟹ t`:

    Starting in a state `s`, executing `S` terminates in the state `t`.

Example:

    `(x := x + y; y := 0, [x ↦ 3, y ↦ 5]) ⟹ [x ↦ 8, y ↦ 0]`

Derivation rules:

    ——————————————— Skip
    (skip, s) ⟹ s

    ——————————————————————————— Asn
    (x := a, s) ⟹ s[x ↦ s(a)]

    (S, s) ⟹ t   (T, t) ⟹ u
    ——————————————————————————— Seq
    (S; T, s) ⟹ u

    (S, s) ⟹ t
    ————————————————————————————— If-True   if s(b) is true
    (if b then S else T, s) ⟹ t

    (T, s) ⟹ t
    ————————————————————————————— If-False   if s(b) is false
    (if b then S else T, s) ⟹ t

    (S, s) ⟹ t   (while b do S, t) ⟹ u
    —————————————————————————————————————— While-True   if s(b) is true
    (while b do S, s) ⟹ u

    ————————————————————————— While-False   if s(b) is false
    (while b do S, s) ⟹ s

Above, `s(e)` denotes the value of expression `e` in state `s`.

In Lean, the judgment corresponds to an inductive predicate, and the derivation
rules correspond to the predicate's introduction rules. Using an inductive
predicate as opposed to a recursive function allows us to cope with
nontermination (e.g., a diverging `while`) and nondeterminism (e.g.,
multithreading). -/

inductive big_step : stmt × state → state → Prop
| skip {s} :
  big_step (stmt.skip, s) s
| assign {x a s} :
  big_step (stmt.assign x a, s) (s{x ↦ a s})
| seq {S T s t u} (hS : big_step (S, s) t)
    (hT : big_step (T, t) u) :
  big_step (S ;; T, s) u
| ite_true {b : state → Prop} {S T s t} (hcond : b s)
    (hbody : big_step (S, s) t) :
  big_step (stmt.ite b S T, s) t
| ite_false {b : state → Prop} {S T s t} (hcond : ¬ b s)
    (hbody : big_step (T, s) t) :
  big_step (stmt.ite b S T, s) t
| while_true {b : state → Prop} {S s t u} (hcond : b s)
    (hbody : big_step (S, s) t)
    (hrest : big_step (stmt.while b S, t) u) :
  big_step (stmt.while b S, s) u
| while_false {b : state → Prop} {S s} (hcond : ¬ b s) :
  big_step (stmt.while b S, s) s

infix ` ⟹ ` : 110 := big_step

lemma silly_loop_from_1_big_step :
  (silly_loop, (λ_, 0){"x" ↦ 1}) ⟹ (λ_, 0) :=
begin
  rw silly_loop,
  apply big_step.while_true,
  { simp },
  { apply big_step.seq,
    { apply big_step.skip },
    { apply big_step.assign } },
  { simp,
    apply big_step.while_false,
    linarith }
end

/-! ## Properties of the Big-Step Semantics

Equipped with a big-step semantics, we can

* prove properties of the programming language, such as **equivalence proofs**
  between programs and **determinism**;

* reason about **concrete programs**, proving theorems relating final states `t`
  with initial states `s`. -/

lemma big_step_deterministic {S s l r} (hl : (S, s) ⟹ l)
    (hr : (S, s) ⟹ r) :
  l = r :=
begin
  induction' hl,
  case skip {
    cases' hr,
    refl },
  case assign {
    cases' hr,
    refl },
  case seq : S T s t l hS hT ihS ihT {
    cases' hr with _ _ _ _ _ _ _ t' _ hS' hT',
    cases' ihS hS',
    cases' ihT hT',
    refl },
  case ite_true : b S T s t hb hS ih {
    cases' hr,
    { apply ih hr },
    { cc } },
  case ite_false : b S T s t hb hT ih {
    cases' hr,
    { cc },
    { apply ih hr } },
  case while_true : b S s t u hb hS hw ihS ihw {
    cases' hr,
    { cases' ihS hr,
      cases' ihw hr_1,
      refl },
    { cc } },
  case while_false {
    cases' hr,
    { cc },
    { refl } }
end

lemma big_step_terminates {S s} :
  ∃t, (S, s) ⟹ t :=
sorry   -- unprovable

lemma big_step_doesnt_terminate {S s t} :
  ¬ (stmt.while (λ_, true) S, s) ⟹ t :=
begin
  intro hw,
  induction' hw,
  case while_true {
    assumption },
  case while_false {
    cc }
end

/-! We can define inversion rules about the big-step semantics: -/

@[simp] lemma big_step_skip_iff {s t} :
  (stmt.skip, s) ⟹ t ↔ t = s :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    refl },
  { intro h,
    rw h,
    exact big_step.skip }
end

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    refl },
  { intro h,
    rw h,
    exact big_step.assign }
end

@[simp] lemma big_step_seq_iff {S T s t} :
  (S ;; T, s) ⟹ t ↔ (∃u, (S, s) ⟹ u ∧ (T, u) ⟹ t) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    apply exists.intro,
    apply and.intro; assumption },
  { intro h,
    cases' h,
    cases' h,
    apply big_step.seq; assumption }
end

@[simp] lemma big_step_ite_iff {b S T s t} :
  (stmt.ite b S T, s) ⟹ t ↔
  (b s ∧ (S, s) ⟹ t) ∨ (¬ b s ∧ (T, s) ⟹ t) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h; cases' h,
    { apply big_step.ite_true; assumption },
    { apply big_step.ite_false; assumption } }
end

lemma big_step_while_iff {b S s u} :
  (stmt.while b S, s) ⟹ u ↔
  (∃t, b s ∧ (S, s) ⟹ t ∧ (stmt.while b S, t) ⟹ u)
  ∨ (¬ b s ∧ u = s) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      apply exists.intro t,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h,
    case inl {
      cases' h with t h,
      cases' h with hb h,
      cases' h with hS hwhile,
      exact big_step.while_true hb hS hwhile },
    case inr {
      cases' h with hb hus,
      rw hus,
      exact big_step.while_false hb } }
end

lemma big_step_while_true_iff {b : state → Prop} {S s u}
    (hcond : b s) :
  (stmt.while b S, s) ⟹ u ↔
  (∃t, (S, s) ⟹ t ∧ (stmt.while b S, t) ⟹ u) :=
by rw big_step_while_iff; simp [hcond]

@[simp] lemma big_step_while_false_iff {b : state → Prop}
    {S s t} (hcond : ¬ b s) :
  (stmt.while b S, s) ⟹ t ↔ t = s :=
by rw big_step_while_iff; simp [hcond]

/-! ## Small-Step Semantics

A big-step semantics

* does not let us reason about intermediate states;

* does not let us express nontermination or interleaving (for multithreading).

__Small-step semantics__ (also called __structural operational semantics__)
solve the above issues.

A judgment has the form `(S, s) ⇒ (T, t)`:

    Starting in a state `s`, executing one step of `S` leaves us in the
    state `t`, with the program `T` remaining to be executed.

An execution is a finite or infinite chain `(S₀, s₀) ⇒ (S₁, s₁) ⇒ …`.

A pair `(S, s)` is called a __configuration__. It is __final__ if no transition
of the form `(S, s) ⇒ _` is possible.

Example:

      `(x := x + y; y := 0, [x ↦ 3, y ↦ 5])`
    `⇒ (skip; y := 0,       [x ↦ 8, y ↦ 5])`
    `⇒ (y := 0,             [x ↦ 8, y ↦ 5])`
    `⇒ (skip,               [x ↦ 8, y ↦ 0])`

Derivation rules:

    ————————————————————————————————— Asn
    (x := a, s) ⇒ (skip, s[x ↦ s(a)])

    (S, s) ⇒ (S', s')
    ———-————————————————————— Seq-Step
    (S ; T, s) ⇒ (S' ; T, s')

    —————————————————————— Seq-Skip
    (skip ; S, s) ⇒ (S, s)

    ———————————————————————————————— If-True   if s(b) is true
    (if b then S else T, s) ⇒ (S, s)

    ———————————————————————————————— If-False   if s(b) is false
    (if b then S else T, s) ⇒ (T, s)

    ——————————————————————————————————————————————————————————————— While
    (while b do S, s) ⇒ (if b then (S ; while b do S) else skip, s)

There is no rule for `skip` (why?). -/

inductive small_step : stmt × state → stmt × state → Prop
| assign {x a s} :
  small_step (stmt.assign x a, s) (stmt.skip, s{x ↦ a s})
| seq_step {S S' T s s'} (hS : small_step (S, s) (S', s')) :
  small_step (S ;; T, s) (S' ;; T, s')
| seq_skip {T s} :
  small_step (stmt.skip ;; T, s) (T, s)
| ite_true {b : state → Prop} {S T s} (hcond : b s) :
  small_step (stmt.ite b S T, s) (S, s)
| ite_false {b : state → Prop} {S T s} (hcond : ¬ b s) :
  small_step (stmt.ite b S T, s) (T, s)
| while {b : state → Prop} {S s} :
  small_step (stmt.while b S, s)
    (stmt.ite b (S ;; stmt.while b S) stmt.skip, s)

infixr ` ⇒ ` := small_step
infixr ` ⇒* ` : 100 := star small_step

lemma silly_loop_from_1_small_step :
  (silly_loop, (λ_, 0){"x" ↦ 1}) ⇒*
  (stmt.skip, ((λ_, 0) : state)) :=
begin
  rw silly_loop,
  apply star.head,
  { apply small_step.while },
  { apply star.head,
    { apply small_step.ite_true,
      simp },
    { apply star.head,
      { apply small_step.seq_step,
        apply small_step.seq_skip },
      { apply star.head,
        { apply small_step.seq_step,
          apply small_step.assign },
        { apply star.head,
          { apply small_step.seq_skip },
          { apply star.head,
            { apply small_step.while },
            { apply star.head,
              { apply small_step.ite_false,
                simp },
              { simp } } } } } } }
end

/-! Equipped with a small-step semantics, we can **define** a big-step
semantics:

    `(S, s) ⟹ t` if and only if `(S, s) ⇒* (skip, t)`

where `r*` denotes the reflexive transitive closure of a relation `r`.

Alternatively, if we have already defined a big-step semantics, we can **prove**
the above equivalence theorem to validate our definitions.

The main disadvantage of small-step semantics is that we now have two relations,
`⇒` and `⇒*`, and reasoning tends to be more complicated.

## Properties of the Small-Step Semantics

We can prove that a configuration `(S, s)` is final if and only if `S = skip`.
This ensures that we have not forgotten a derivation rule. -/

lemma small_step_final (S s) :
  (¬ ∃T t, (S, s) ⇒ (T, t)) ↔ S = stmt.skip :=
begin
  induction' S,
  case skip {
    simp,
    intros T t hstep,
    cases' hstep },
  case assign : x a {
    simp,
    apply exists.intro stmt.skip,
    apply exists.intro (s{x ↦ a s}),
    exact small_step.assign },
  case seq : S T ihS ihT {
    simp,
    cases' classical.em (S = stmt.skip),
    case inl {
      rw h,
      apply exists.intro T,
      apply exists.intro s,
      exact small_step.seq_skip },
    case inr {
      simp [h, auto.not_forall_eq, auto.not_not_eq] at ihS,
      cases' ihS s with S' hS',
      cases' hS' with s' hs',
      apply exists.intro (S' ;; T),
      apply exists.intro s',
      exact small_step.seq_step hs' } },
  case ite : b S T ihS ihT {
    simp,
    cases' classical.em (b s),
    case inl {
      apply exists.intro S,
      apply exists.intro s,
      exact small_step.ite_true h },
    case inr {
      apply exists.intro T,
      apply exists.intro s,
      exact small_step.ite_false h } },
  case while : b S ih {
    simp,
    apply exists.intro (stmt.ite b (S ;; stmt.while b S) stmt.skip),
    apply exists.intro s,
    exact small_step.while }
end

lemma small_step_deterministic {S s Ll Rr}
    (hl : (S, s) ⇒ Ll) (hr : (S, s) ⇒ Rr) :
  Ll = Rr :=
begin
  induction' hl,
  case assign : x a s {
    cases' hr,
    refl },
  case seq_step : S S₁ T s s₁ hS₁ ih {
    cases' hr,
    case seq_step : S S₂ _ _ s₂ hS₂ {
      have hSs₁₂ := ih hS₂,
      cc },
    case seq_skip {
      cases' hS₁ } },
  case seq_skip : T s {
    cases' hr,
    case seq_step {
      cases' hr },
    case seq_skip {
      refl } },
  case ite_true : b S T s hcond {
    cases' hr,
    case ite_true {
      refl },
    case ite_false {
      cc } },
  case ite_false : b S T s hcond {
    cases' hr,
    case ite_true {
      cc },
    case ite_false {
      refl } },
  case while : b S s {
    cases' hr,
    refl }
end

/-! We can define inversion rules also about the small-step semantics. Here are
three examples: -/

lemma small_step_skip {S s t} :
  ¬ ((stmt.skip, s) ⇒ (S, t)) :=
by intro h; cases' h

@[simp] lemma small_step_seq_iff {S T s Ut} :
  (S ;; T, s) ⇒ Ut ↔
  (∃S' t, (S, s) ⇒ (S', t) ∧ Ut = (S' ;; T, t))
  ∨ (S = stmt.skip ∧ Ut = (T, s)) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      apply exists.intro S',
      apply exists.intro s',
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h,
    { cases' h,
      cases' h,
      cases' h,
      rw right,
      apply small_step.seq_step,
      assumption },
    { cases' h,
      rw left,
      rw right,
      apply small_step.seq_skip } }
end

@[simp] lemma small_step_ite_iff {b S T s Us} :
  (stmt.ite b S T, s) ⇒ Us ↔
  (b s ∧ Us = (S, s)) ∨ (¬ b s ∧ Us = (T, s)) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h,
    { cases' h,
      rw right,
      apply small_step.ite_true,
      assumption },
    { cases' h,
      rw right,
      apply small_step.ite_false,
      assumption } }
end

/-! ### Equivalence of the Big-Step and the Small-Step Semantics (**optional**)

A more important result is the connection between the big-step and the
small-step semantics:

    `(S, s) ⟹ t ↔ (S, s) ⇒* (stmt.skip, t)`

Its proof, given below, is beyond the scope of this course. -/

lemma star_small_step_seq {S T s u}
    (h : (S, s) ⇒* (stmt.skip, u)) :
  (S ;; T, s) ⇒* (stmt.skip ;; T, u) :=
begin
  apply star.lift (λSs, (prod.fst Ss ;; T, prod.snd Ss)) _ h,
  intros Ss Ss' h,
  cases' Ss,
  cases' Ss',
  apply small_step.seq_step,
  assumption
end

lemma star_small_step_of_big_step {S s t} (h : (S, s) ⟹ t) :
  (S, s) ⇒* (stmt.skip, t) :=
begin
  induction' h,
  case skip {
    refl },
  case assign {
    exact star.single small_step.assign },
  case seq : S T s t u hS hT ihS ihT {
    transitivity,
    exact star_small_step_seq ihS,
    apply star.head small_step.seq_skip ihT },
  case ite_true : b S T s t hs hst ih {
    exact star.head (small_step.ite_true hs) ih },
  case ite_false : b S T s t hs hst ih {
    exact star.head (small_step.ite_false hs) ih },
  case while_true : b S s t u hb hS hw ihS ihw {
    exact (star.head small_step.while
      (star.head (small_step.ite_true hb)
         (star.trans (star_small_step_seq ihS)
            (star.head small_step.seq_skip ihw)))) },
  case while_false : b S s hb {
    exact star.tail (star.single small_step.while)
      (small_step.ite_false hb) }
end

lemma big_step_of_small_step_of_big_step {S₀ S₁ s₀ s₁ s₂}
  (h₁ : (S₀, s₀) ⇒ (S₁, s₁)) :
  (S₁, s₁) ⟹ s₂ → (S₀, s₀) ⟹ s₂ :=
begin
  induction' h₁;
    simp [*, big_step_while_true_iff] {contextual := tt},
  case seq_step {
    intros u hS' hT,
    apply exists.intro u,
    exact and.intro (ih hS') hT }
end

lemma big_step_of_star_small_step {S s t} :
  (S, s) ⇒* (stmt.skip, t) → (S, s) ⟹ t :=
begin
  generalize hSs : (S, s) = Ss,
  intro h,
  induction h
      using LoVe.rtc.star.head_induction_on
      with _ S's' h h' ih
      generalizing S s;
    cases' hSs,
  { exact big_step.skip },
  { cases' S's' with S' s',
    apply big_step_of_small_step_of_big_step h,
    apply ih,
    refl }
end

lemma big_step_iff_star_small_step {S s t} :
  (S, s) ⟹ t ↔ (S, s) ⇒* (stmt.skip, t) :=
iff.intro star_small_step_of_big_step
  big_step_of_star_small_step

/-! ## Parallelism (**optional**) -/

/--
a proof of `par_step i (Ss, t) (Ss', t')` represents:
"
  Let `Ss` be a list of WHILE programs that we wish to execute in parallel.
  If we evaluate one step of the `i`th program in `Ss` while in state `t`,
  we reach state `t'`, with the list of programs `Ss'` remaining to execute."
-/
inductive par_step :
    nat → list stmt × state → list stmt × state → Prop
| intro {Ss Ss' S S' s s' i}
    (hi : i < list.length Ss)
    (hS : S = list.nth_le Ss i hi)
    (hs : (S, s) ⇒ (S', s'))
    (hS' : Ss' = list.update_nth Ss i S') :
  par_step i (Ss, s) (Ss', s')

lemma par_step_diamond {i j Ss Ts Ts' s t t'}
    (hi : i < list.length Ss)
    (hj : j < list.length Ss)
    (hij : i ≠ j)
    (hT : par_step i (Ss, s) (Ts, t))
    (hT' : par_step j (Ss, s) (Ts', t')) :
  ∃u Us, par_step j (Ts, t) (Us, u) ∧
    par_step i (Ts', t') (Us, u) :=
sorry

/--
`stmt.W S` returns the set of variables written to by a thread `S`.
-/
def stmt.W : stmt → set string
| stmt.skip         := ∅
| (stmt.assign x _) := {x}
| (stmt.seq S T)    := stmt.W S ∪ stmt.W T
| (stmt.ite _ S T)  := stmt.W S ∪ stmt.W T
| (stmt.while _ S)  := stmt.W S

/--
`exp.R f` returns the set of variables read by an arithmetic or boolean expression `f`.
-/
def exp.R {α : Type} (f : state → α) : set string :=
{x | ∃ s n, f (s{x ↦ n}) ≠ f s}

/--
`stmt.R S` returns the set of variables read by a thread `S`.
-/
def stmt.R : stmt → set string
| stmt.skip         := ∅
| (stmt.assign _ a) := exp.R a
| (stmt.seq S T)    := stmt.R S ∪ stmt.R T
| (stmt.ite b S T)  := exp.R b ∪ stmt.R S ∪ stmt.R T
| (stmt.while b S)  := exp.R b ∪ stmt.R S

/--
`stmt.V S` returns the set of variables written to or read by a thread `S`.
-/
def stmt.V : stmt → set string
| S := stmt.W S ∪ stmt.R S

lemma par_step_diamond_VW_disjoint {i j Ss Ts Ts' s t t'}
    (hiS : i < list.length Ss)
    (hjT : j < list.length Ts)
    (hij : i ≠ j)
    (hT : par_step i (Ss, s) (Ts, t))
    (hT' : par_step j (Ss, s) (Ts', t'))
    (hWV : stmt.W (list.nth_le Ss i hiS)
       ∩ stmt.V (list.nth_le Ts j hjT) = ∅)
    (hVW : stmt.V (list.nth_le Ss i hiS)
       ∩ stmt.W (list.nth_le Ts j hjT) = ∅) :
  ∃u Us, par_step j (Ts, t) (Us, u) ∧
    par_step i (Ts', t') (Us, u) :=
sorry   -- this should be provable

end LoVe