/-= Chapter 5: Tactics =-/

/- Entering tactic mode -/
namespace enter_tactic_mode

theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  exact hp
  apply And.intro
  exact hq
  exact hp

#print test

theorem test₂ (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro hp
  exact And.intro hq hp

#print test₂

theorem test₃ (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro hp; exact And.intro hq hp

theorem test₄ (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  case left =>
    exact hp
  case right =>
    apply And.intro
    case left => exact hq
    case right => exact hp

theorem test₅ (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  case right =>
    apply And.intro
    case left => exact hq
    case right => exact hp
  case left =>
    exact hp

theorem test₆ (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  · exact hp
  · apply And.intro
    · exact hq
    · exact hp

end enter_tactic_mode

/- Basic tactics -/
namespace basic_tactics

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  · intro h
    apply h.right.elim
    · intro hq
      apply Or.inl
      apply And.intro
      · exact h.left
      · exact hq
    · intro hr
      apply Or.inr
      apply And.intro
      · exact h.left
      · exact hr
  · intro h
    apply h.elim
    · intro hpq
      apply And.intro
      · exact hpq.left
      · apply Or.inl
        exact hpq.right
    · intro hpr
      apply And.intro
      · exact hpr.left
      · apply Or.inr
        exact hpr.right

example (α : Type) : α → α := by
  intro a
  exact a

example (α : Type) : ∀ x : α, x = x := by
  intro x
  exact Eq.refl x

example : ∀ a b c : Nat, a = b → a = c → c = b := by
  intro a b c h₁ h₂
  exact Eq.trans (Eq.symm h₂) h₁

example (α : Type) (p q : α → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro ⟨w, hpw, hqw⟩
  exact ⟨w, hqw, hpw⟩

example (α : Type) (p q : α → Prop) : (∃ x, p x ∨ q x) → ∃ x, q x ∨ p x := by
  intro
    | ⟨w, Or.inl h⟩ => exact ⟨w, Or.inr h⟩
    | ⟨w, Or.inr h⟩ => exact ⟨w, Or.inl h⟩

example (x y z w : Nat) (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w := by
  apply Eq.trans h₁
  apply Eq.trans h₂
  assumption

example (x y z w : Nat) (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w := by
  apply Eq.trans
  assumption
  apply Eq.trans
  assumption
  assumption

example : ∀ a b c : Nat, a = b → a = c → c = b := by
  intros
  apply Eq.trans
  apply Eq.symm
  assumption
  assumption

example : ∀ a b c : Nat, a = b → a = c → c = b := by unhygienic
  intros
  apply Eq.trans
  apply Eq.symm
  exact a_2
  exact a_1

example : ∀ a b c d : Nat, a = b → a = d → a = c → c = b := by
  intros
  rename_i h₁ _ h₂
  apply Eq.trans
  apply Eq.symm
  exact h₂
  exact h₁

example (y : Nat) : (λ x : Nat => 0) y = 0 := by rfl

example : ∀ a b c : Nat, a = b → a = c → c = b := by
  intros
  apply Eq.trans
  apply Eq.symm
  repeat assumption

example (x : Nat) : x = x := by
  revert x
  -- goal is ∀ (x : Nat), x = x
  intro y
  -- goal is y : Nat ⊢ y = y
  rfl

example (x y : Nat) (h : x = y) : y = x := by
  revert h
  -- goal is x y : Nat ⊢ x = y → y = x
  intro h₁
  -- goal is x y : Nat, h₁ : x = y ⊢ y = x
  apply Eq.symm
  assumption

example (x y : Nat) (h : x = y) : y = x := by
  revert x
  -- goal is y : Nat ⊢ ∀ (x : Nat), x = y → y = x
  intros
  apply Eq.symm
  assumption

example (x y : Nat) (h : x = y) : y = x := by
  revert x y
  -- goal is ⊢ ∀ (x y : Nat), x = y → y = x
  intros
  apply Eq.symm
  assumption

example : 3 = 3 := by
  generalize 3 = x
  -- goal is x : Nat ⊢ x = x
  revert x
  -- goal is ⊢ ∀ (x : Nat), x = x
  intro y
  -- goal is y : Nat ⊢ y = y
  rfl

/-
example : 2 + 3 = 5 := by
  generalize 3 = x
  -- goal is x : Nat ⊢ 2 + x = 5
  admit
-/

example : 2 + 3 = 5 := by
  generalize h : 3 = x
  -- goal is x : Nat, h : 3 = x ⊢ 2 + x = 5
  rw [← h]

end basic_tactics

/- More tactics -/
namespace more_tactics

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h with
  | inl hp => apply Or.inr; exact hp
  | inr hq => apply Or.inl; exact hq

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h with
  | inr hq => apply Or.inl; exact hq
  | inl hp => apply Or.inr; exact hp

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h
  apply Or.inr
  assumption
  apply Or.inl
  assumption

example (p : Prop) : p ∨ p → p := by
  intro h
  cases h
  repeat assumption

example (p : Prop) : p ∨ p → p := by
  intro h
  cases h <;> assumption

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h
  · apply Or.inr
    assumption
  · apply Or.inl
    assumption

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h
  case inr h =>
    apply Or.inl
    assumption
  case inl =>
    apply Or.inr
    assumption

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h
  case inr h =>
    apply Or.inl
    assumption
  · apply Or.inr
    assumption

example (p q : Prop) : p ∧ q → q ∧ p := by
  intro h
  cases h with
  | intro hp hq => constructor; exact hq; exact hp

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  constructor
  · intro h
    cases h with
    | intro hp hqr =>
      cases hqr
      · apply Or.inl; constructor <;> assumption
      · apply Or.inr; constructor <;> assumption
  · intro h
    cases h with
    | inl hpq =>
      cases hpq with
      | intro hp hq => constructor; exact hp; apply Or.inl; exact hq
    | inr hpr =>
      cases hpr with
      | intro hp hr => constructor; exact hp; apply Or.inr; exact hr

example (p q : Nat → Prop) : (∃ x, p x) → (∃ x, p x ∨ q x) := by
  intro h
  cases h with
  | intro x px => constructor; apply Or.inl; exact px

example (p q : Nat → Prop) : (∃ x, p x) → (∃ x, p x ∨ q x) := by
  intro h
  cases h with
  | intro x px => exists x; apply Or.inl; exact px

example (p q : Nat → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro h
  cases h with
  | intro x hpq =>
    cases hpq with
    | intro hp hq =>
      exists x
      constructor <;> assumption

def swap_pair : α × β → β × α := by
  intro p
  cases p
  constructor <;> assumption

def swap_sum : Sum α β → Sum β α := by
  intro p
  cases p
  · apply Sum.inr; assumption
  . apply Sum.inl; assumption

example
    (P : Nat → Prop) (h₀ : P 0) (h₁ : ∀ n, P (Nat.succ n)) (m : Nat) : P m := by
  cases m with
  | zero => exact h₀
  | succ m' => exact h₁ m'

example (p q : Prop) : p ∧ ¬p → q := by
  intro h
  cases h
  contradiction

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  constructor
  · intro h
    match h with
    | ⟨_, Or.inl _⟩ => apply Or.inl; constructor <;> assumption
    | ⟨_, Or.inr _⟩ => apply Or.inr; constructor <;> assumption
  · intro h
    match h with
    | Or.inl ⟨hp, hq⟩ => constructor; exact hp; apply Or.inl; exact hq
    | Or.inr ⟨hp, hr⟩ => constructor; exact hp; apply Or.inr; exact hr

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  constructor
  · intro
    | ⟨hp, Or.inl hq⟩ => apply Or.inl; constructor <;> assumption
    | ⟨hp, Or.inr hr⟩ => apply Or.inr; constructor <;> assumption
  · intro
    | Or.inl ⟨hp, hq⟩ => constructor; assumption; apply Or.inl; assumption
    | Or.inr ⟨hp, hr⟩ => constructor; assumption; apply Or.inr; assumption

end more_tactics

/- Structuring tactic proofs -/
namespace structuring_tactic_proofs

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := by
  intro h
  exact
    have hp : p := h.left
    have hqr : q ∨ r := h.right
    show (p ∧ q) ∨ (p ∧ r) by
      cases hqr with
      | inl hq => exact Or.inl ⟨hp, hq⟩
      | inr hr => exact Or.inr ⟨hp, hr⟩

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  · intro h
    cases h.right with
    | inl hq => exact Or.inl ⟨h.left, hq⟩
    | inr hr => exact Or.inr ⟨h.left, hr⟩
  · intro h
    cases h with
    | inl hpq => exact ⟨hpq.left, Or.inl hpq.right⟩
    | inr hpr => exact ⟨hpr.left, Or.inr hpr.right⟩

-- My own attempt at making this look nice
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  constructor
  · intro
    | ⟨hp, Or.inl hq⟩ => exact Or.inl ⟨hp, hq⟩
    | ⟨hp, Or.inr hr⟩ => exact Or.inr ⟨hp, hr⟩
  · intro
    | Or.inl ⟨hp, hq⟩ => exact ⟨hp, Or.inl hq⟩
    | Or.inr ⟨hp, hr⟩ => exact ⟨hp, Or.inr hr⟩

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  · intro h
    cases h.right with
    | inl hq =>
      show (p ∧ q) ∨ (p ∧ r)
      exact Or.inl ⟨h.left, hq⟩
    | inr hr =>
      show (p ∧ q) ∨ (p ∧ r)
      exact Or.inr ⟨h.left, hr⟩
  · intro h
    cases h with
    | inl hpq =>
      show p ∧ (q ∨ r)
      exact ⟨hpq.left, Or.inl hpq.right⟩
    | inr hpr =>
      show p ∧ (q ∨ r)
      exact ⟨hpr.left, Or.inr hpr.right⟩

-- Updating my clean version above with show
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  constructor
  · show p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r)
    intro
    | ⟨hp, Or.inl hq⟩ => exact Or.inl ⟨hp, hq⟩
    | ⟨hp, Or.inr hr⟩ => exact Or.inr ⟨hp, hr⟩
  · show (p ∧ q) ∨ (p ∧ r) → p ∧ (q ∨ r)
    intro
    | Or.inl ⟨hp, hq⟩ => exact ⟨hp, Or.inl hq⟩
    | Or.inr ⟨hp, hr⟩ => exact ⟨hp, Or.inr hr⟩

example (n : Nat) : n + 1 = Nat.succ n := by
  show Nat.succ n = Nat.succ n
  rfl

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := by
  intro ⟨hp, hqr⟩
  show (p ∧ q) ∨ (p ∧ r)
  cases hqr with
  | inl hq =>
    have hpq : p ∧ q := And.intro hp hq
    apply Or.inl
    exact hpq
  | inr hr =>
    have hpr : p ∧ r := And.intro hp hr
    apply Or.inr
    exact hpr

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := by
  intro ⟨hp, hqr⟩
  show (p ∧ q) ∨ (p ∧ r)
  cases hqr with
  | inl hq =>
    have : p ∧ q := And.intro hp hq
    apply Or.inl
    exact this
  | inr hr =>
    have : p ∧ r := And.intro hp hr
    apply Or.inr
    exact this

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := by
  intro ⟨hp, hqr⟩
  show (p ∧ q) ∨ (p ∧ r)
  cases hqr with
  | inl hq =>
    have := And.intro hp hq
    apply Or.inl; exact this
  | inr hr =>
    have := And.intro hp hr
    apply Or.inr; exact this

example : ∃ x, x + 2 = 8 := by
  let a : Nat := 3 * 2
  exists a
  rfl

-- My own version, more explicitly showing the evaluation
example : ∃ x, x + 2 = 8 := by
  let a := 3 * 2
  exists a
  show 3 * 2 + 2 = 8
  show 8 = 8
  rfl

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  { intro h;
    cases h.right;
    { show (p ∧ q) ∨ (p ∧ r);
      exact Or.inl ⟨h.left, ‹q›⟩ }
    { show (p ∧ q) ∨ (p ∧ r);
      exact Or.inr ⟨h.left, ‹r›⟩ } }
  { intro h;
    cases h;
    { show p ∧ (q ∨ r);
      rename_i hpq;
      exact ⟨hpq.left, Or.inl hpq.right⟩ }
    { show p ∧ (q ∨ r);
      rename_i hpr;
      exact ⟨hpr.left, Or.inr hpr.right⟩ } }

end structuring_tactic_proofs

/- Tactic combinators -/
namespace tactic_combinators

example (p q : Prop) (hp : p) : p ∨ q :=
  by apply Or.inl; assumption

example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
  by constructor <;> assumption

example (p q : Prop) (hp : p) : p ∨ q := by
  first | apply Or.inl; assumption | apply Or.inr; assumption

example (p q : Prop) (hq : q) : p ∨ q := by
  first | apply Or.inl; assumption | apply Or.inr; assumption

example (p q r : Prop) (hp : p) : p ∨ q ∨ r := by
  repeat (first | apply Or.inl; assumption | apply Or.inr | assumption)

example (p q r : Prop) (hq : q) : p ∨ q ∨ r := by
  repeat (first | apply Or.inl; assumption | apply Or.inr | assumption)

example (p q r : Prop) (hr : r) : p ∨ q ∨ r := by
  repeat (first | apply Or.inl; assumption | apply Or.inr | assumption)

example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r := by
  constructor <;> (try constructor) <;> assumption

example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r := by
  constructor
  all_goals (try constructor)
  all_goals assumption

example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r := by
  constructor
  any_goals constructor
  any_goals assumption

example
    (p q r : Prop) (hp : p) (hq : q) (hr : r)
    : p ∧ ((p ∧ q) ∧ r) ∧ (q ∧ r ∧ p) := by
  repeat (any_goals constructor)
  all_goals assumption

example
    (p q r : Prop) (hp : p) (hq : q) (hr : r)
    : p ∧ ((p ∧ q) ∧ r) ∧ (q ∧ r ∧ p) := by
  repeat (any_goals (first | constructor | assumption))

end tactic_combinators

/- Rewriting -/
namespace rewriting

example (f : Nat → Nat) (k : Nat) (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 := by
  rw [h₂] -- replace k with 0
  rw [h₁] -- replace f 0 with 0

example
    (x y : Nat) (p : Nat → Prop) (q : Prop)
    (h : q → x = y) (h' : p y) (hq : q)
    : p x := by
  rw [h hq]; assumption

example (f : Nat → Nat) (k : Nat) (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 := by
  rw [h₂, h₁]

example (f : Nat → Nat) (a b : Nat) (h₁ : a = b) (h₂ : f a = 0) : f b = 0 := by
  rw [←h₁, h₂]

example (a b c : Nat) : a + b + c = a + c + b := by
  rw [Nat.add_assoc, Nat.add_comm b, ←Nat.add_assoc]

example (a b c : Nat) : a + b + c = a + c + b := by
  rw [Nat.add_assoc, Nat.add_assoc, Nat.add_comm b]

example (a b c : Nat) : a + b + c = a + c + b := by
  rw [Nat.add_assoc, Nat.add_assoc, Nat.add_comm _ b]

example (f : Nat → Nat) (a : Nat) (h : a + 0 = 0) : f a = f 0 := by
  rw [Nat.add_zero] at h
  rw [h]

def Tuple (α : Type) (n : Nat) :=
  { as : List α // as.length = n }

example (n : Nat) (h : n = 0) (t : Tuple α n) : Tuple α 0 := by
  rw [h] at t
  exact t

end rewriting

/- Using the simplifier -/
namespace using_the_simplifier

example
    (x y z : Nat) (p : Nat → Prop) (h : p (x * y))
    : (x + 0) * (0 + y * 1 + z * 0) = x * y := by
  simp

example
    (x y z : Nat) (p : Nat → Prop) (h : p (x * y))
    : p ((x + 0) * (0 + y * 1 + z * 0)) := by
  simp; assumption

open List

example
    (xs : List Nat) : reverse (xs ++ [1, 2, 3]) = [3, 2, 1] ++ reverse xs := by
  simp

example
    (xs ys : List α) : length (reverse (xs ++ ys)) = length xs + length ys := by
  simp [Nat.add_comm]

example
    (x y z : Nat) (p : Nat → Prop) (h : p ((x + 0) * (0 + y * 1 + z * 0)))
    : p (x * y) := by
  simp at h; assumption

attribute [local simp] Nat.mul_comm Nat.mul_assoc Nat.mul_left_comm
attribute [local simp] Nat.add_assoc Nat.add_comm Nat.add_left_comm

example
    (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x))
    : p (x * w * z + y * x) := by
  simp at *; assumption

example
    (x y z : Nat) (p : Nat → Prop) (h₁ : p (1 * x + y)) (h₂ : p (x * z * 1))
    : p (y + 0 + x) ∧ p (z * x) := by
  simp at *; constructor <;> assumption

example
    (w x y z : Nat) (p : Nat → Prop)
    : x * y + z * w * x = x * w * z + y * x := by
  simp

example
    (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x))
    : p (x * w * z + y * x) := by
  simp; simp at h; assumption

def f (m n : Nat) : Nat :=
  m + n + m

example {m n : Nat} (h : n = 1) (h' : 0 = m) : (f m n) = n := by
  simp [←h', f]

example (f : Nat → Nat) (k : Nat) (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 := by
  simp [h₁, h₂]

example (f : Nat → Nat) (k : Nat) (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 := by
  simp [*]

example
    (u w x y z : Nat) (h₁ : x = y + z) (h₂ : w = u + x) : w = z + y + u := by
  simp [*]

example (p q : Prop) (hp : p) : p ∧ q ↔ q := by
  simp [*]

example (p q : Prop) (hp : p) : p ∨ q := by
  simp [*]

example (p q r : Prop) (hp : p) (hq : q) : p ∧ (q ∨ r) := by
  simp [*]

example
    (u w x x' y y' z : Nat) (p : Nat → Prop) (h₁ : x + 0 = x') (h₂ : y + 0 = y')
    : x + y + 0 = x' + y' := by
  simp at *
  simp [*]

def mk_symm (xs : List α) :=
  xs ++ xs.reverse

theorem reverse_mk_symm (xs : List α) : (mk_symm xs).reverse = mk_symm xs := by
  simp [mk_symm]

example
    (xs ys : List Nat)
    : (xs ++ mk_symm ys).reverse = mk_symm ys ++ xs.reverse := by
  simp [reverse_mk_symm]

example
    (xs ys : List Nat) (p : List Nat → Prop) (h : p (xs ++ mk_symm ys).reverse)
    : p (mk_symm ys ++ xs.reverse) := by
  simp [reverse_mk_symm] at h; assumption

namespace simp_annotation

@[simp]
theorem reverse_mk_symm (xs : List α) : (mk_symm xs).reverse = mk_symm xs := by
  simp [mk_symm]

-- Alternatively:
-- attribute [simp] reverse_mk_symm

example
    (xs ys : List Nat)
    : (xs ++ mk_symm ys).reverse = mk_symm ys ++ xs.reverse := by
  simp

-- Alternatively:
-- attribute [simp] reverse_mk_symm

example
    (xs ys : List Nat) (p : List Nat → Prop) (h : p (xs ++ mk_symm ys).reverse)
    : p (mk_symm ys ++ xs.reverse) := by
  simp at h; assumption

example
    (xs ys : List Nat) (p : List Nat → Prop) (h : p (xs ++ mk_symm ys).reverse)
    : p ((mk_symm ys).reverse ++ xs.reverse) := by
  simp [-reverse_mk_symm] at h; assumption

example
    (xs ys : List Nat) (p : List Nat → Prop) (h : p (xs ++ mk_symm ys).reverse)
    : p ((mk_symm ys).reverse ++ xs.reverse) := by
  simp only [List.reverse_append] at h; assumption

end simp_annotation

namespace local_simp_annotation

theorem reverse_mk_symm (xs : List α) : (mk_symm xs).reverse = mk_symm xs := by
  simp [mk_symm]

section local_simp
attribute [local simp] reverse_mk_symm

example
    (xs ys : List Nat)
    : (xs ++ mk_symm ys).reverse = mk_symm ys ++ xs.reverse := by
  simp
end local_simp

example
    (xs ys : List Nat) (p : List Nat → Prop) (h : p (xs ++ mk_symm ys).reverse)
    : p (mk_symm ys ++ xs.reverse) := by
  -- This simp shouldn't work but I think the other defs in the file apply
  simp at h; assumption

end local_simp_annotation

end using_the_simplifier

/- Extensible tactics -/
namespace extensible_tactics

-- Define a new tactic notation
syntax "triv" : tactic

macro_rules
  | `(tactic| triv) => `(tactic| assumption)

example (h : p) : p := by
  triv

-- You cannot prove the following theorem using `triv`
-- example (x : α) : x = x := by
--  triv

-- Let's extend `triv`. The tactic interpreter tries all
-- possible macro extensions for `triv` until one succeeds
macro_rules
  | `(tactic| triv) => `(tactic| rfl)

example (x : α) : x = x := by
  triv

example (x : α) (h : p) : x = x ∧ p := by
  apply And.intro <;> triv

-- We now add a (recursive) extension
macro_rules | `(tactic| triv) => `(tactic| apply And.intro <;> triv)

example (x : α) (h : p) : x = x ∧ p := by
  triv

end extensible_tactics

/- Exercises -/
namespace ex_1

namespace ch3_exs

variable (p q r s : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by
  apply Iff.intro
  · show p ∧ q → q ∧ p
    intro ⟨hp, hq⟩
    exact ⟨hq, hp⟩
  · show q ∧ p → p ∧ q
    intro ⟨hq, hp⟩
    exact ⟨hp, hq⟩

example : p ∧ q ↔ q ∧ p := by
  constructor <;> intros <;> simp [*]

example : p ∨ q ↔ q ∨ p := by
  apply Iff.intro
  · show p ∨ q → q ∨ p
    intro
    | Or.inl hp => exact Or.inr hp
    | Or.inr hq => exact Or.inl hq
  · show q ∨ p → p ∨ q
    intro
    | Or.inl hq => exact Or.inr hq
    | Or.inr hp => exact Or.inl hp

example : p ∨ q ↔ q ∨ p := by
  constructor <;> intros h <;> cases h <;> simp [*]

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  apply Iff.intro
  · show (p ∧ q) ∧ r → p ∧ (q ∧ r)
    intro ⟨⟨hp, hq⟩, hr⟩
    exact ⟨hp, ⟨hq, hr⟩⟩
  · show p ∧ (q ∧ r) → (p ∧ q) ∧ r
    intro ⟨hp, ⟨hq, hr⟩⟩
    exact ⟨⟨hp, hq⟩, hr⟩

example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  constructor <;> intros <;> simp [*]

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by
  apply Iff.intro
  · show (p ∨ q) ∨ r → p ∨ (q ∨ r)
    intro
    | Or.inl (Or.inl hp) => exact Or.inl hp
    | Or.inl (Or.inr hq) => exact Or.inr (Or.inl hq)
    | Or.inr hr => exact Or.inr (Or.inr hr)
  · show p ∨ (q ∨ r) → (p ∨ q) ∨ r
    intro
    | Or.inl hp => exact Or.inl (Or.inl hp)
    | Or.inr (Or.inl hq) => exact Or.inl (Or.inr hq)
    | Or.inr (Or.inr hr) => exact Or.inr hr

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by
  constructor <;> intro
  repeat (first | rename_i h; cases h | simp [*])

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  · show p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r)
    intro
    | ⟨hp, Or.inl hq⟩ => exact Or.inl ⟨hp, hq⟩
    | ⟨hp, Or.inr hr⟩ => exact Or.inr ⟨hp, hr⟩
  · show (p ∧ q) ∨ (p ∧ r) → p ∧ (q ∨ r)
    intro
    | Or.inl ⟨hp, hq⟩ => exact ⟨hp, Or.inl hq⟩
    | Or.inr ⟨hp, hr⟩ => exact ⟨hp, Or.inr hr⟩

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  constructor <;> intro h; simp [*]; cases h <;> simp [*]

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by
  apply Iff.intro
  · show p ∨ (q ∧ r) → (p ∨ q) ∧ (p ∨ r)
    intro
    | Or.inl hp => exact ⟨Or.inl hp, Or.inl hp⟩
    | Or.inr ⟨hq, hr⟩ => exact ⟨Or.inr hq, Or.inr hr⟩
  · show (p ∨ q) ∧ (p ∨ r) → p ∨ (q ∧ r)
    intro
    | ⟨Or.inl hp, _⟩ => exact Or.inl hp
    | ⟨_, Or.inl hp⟩ => exact Or.inl hp
    | ⟨Or.inr hq, Or.inr hr⟩ => exact Or.inr ⟨hq, hr⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by
  constructor <;> intro h <;> cases h <;> simp [*]
  rename_i hpq hpr; cases hpq <;> simp [*]

-- other properties
example : (p → q → r) ↔ (p ∧ q → r) := by
  apply Iff.intro
  · show (p → q → r) → (p ∧ q → r)
    intro f
    intro ⟨hp, hq⟩
    show r
    exact f hp hq
  · show (p ∧ q → r) → (p → q → r)
    intros f hp hq
    show r
    exact f ⟨hp, hq⟩

example : (p → q → r) ↔ (p ∧ q → r) := by
  constructor <;> intros <;> simp [*]

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by
  apply Iff.intro
  · show ((p ∨ q) → r) → (p → r) ∧ (q → r)
    intro (_ : p ∨ q → r)
    apply And.intro
    · show p → r
      intro (_ : p)
      exact ‹p ∨ q → r› (Or.inl ‹p›)
    · show q → r
      intro (_ : q)
      exact ‹p ∨ q → r› (Or.inr ‹q›)
  · show (p → r) ∧ (q → r) → ((p ∨ q) → r)
    intro ⟨(_ : p → r), (_ : q → r)⟩
    intro
    | Or.inl (_ : p) => exact ‹p → r› ‹p›
    | Or.inr (_ : q) => exact ‹q → r› ‹q›

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by
  constructor <;> intros
  · constructor <;> intros <;> simp [*]
  · rename_i h; cases h <;> simp [*]

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by
  apply Iff.intro
  · show ¬(p ∨ q) → ¬p ∧ ¬q
    intro (_ : ¬(p ∨ q))
    apply And.intro
    · show ¬p
      intro (_ : p)
      show False
      exact ‹¬(p ∨ q)› (Or.inl ‹p›)
    · show ¬q
      intro (_ : q)
      show False
      exact ‹¬(p ∨ q)› (Or.inr ‹q›)
  · show ¬p ∧ ¬q → ¬(p ∨ q)
    intro ⟨(_ : ¬p), (_ : ¬q)⟩
    intro
    | Or.inl (_ : p) => exact ‹¬p› ‹p›
    | Or.inr (_ : q) => exact ‹¬q› ‹q›

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by
  constructor <;> intros h
  · constructor <;> intro <;> simp [*] at *
  · intro hpq; cases hpq <;> simp [*] at *

example : ¬p ∨ ¬q → ¬(p ∧ q) := by
  intro
  | Or.inl (_ : ¬p) =>
    intro ⟨(_ : p), _⟩; contradiction
  | Or.inr (_ : ¬q) =>
    intro ⟨_, (_ : q)⟩; contradiction

example : ¬p ∨ ¬q → ¬(p ∧ q) := by
  intro h; cases h <;> simp [*]

example : ¬(p ∧ ¬p) := by
  intro ⟨(_ : p), (_ : ¬p)⟩
  show False
  exact ‹¬ p› ‹p›

example : ¬(p ∧ ¬p) := by
  intro ⟨_, _⟩; contradiction

example : p ∧ ¬q → ¬(p → q) := by
  intro ⟨(_ : p), (_ : ¬q)⟩
  intro (_ : p → q)
  show False
  exact ‹¬q› (‹p → q› ‹p›)

example : p ∧ ¬q → ¬(p → q) := by
  intro ⟨_, _⟩; intro; simp [*] at *

example : ¬p → p → q := by
  intro (_ : ¬p) (_ : p)
  show q
  exact False.elim (‹¬p› ‹p›)

example : ¬p → p → q := by
  intros; contradiction

example : (¬p ∨ q) → (p → q) := by
  intro (_ : ¬p ∨ q) (_ : p)
  show q
  match ‹¬p ∨ q› with
  | Or.inl (_ : ¬p) => exact False.elim (‹¬p› ‹p›)
  | Or.inr (_ : q) => exact ‹q›

example : (¬p ∨ q) → (p → q) := by
  intros; simp [*] at *; assumption

example : p ∨ False ↔ p := by
  apply Iff.intro
  · show p ∨ False → p
    intro
    | Or.inl (_ : p) => exact ‹p›
  · show p → p ∨ False
    intro (_ : p)
    exact Or.inl ‹p›

example : p ∨ False ↔ p := by
  simp [*] at *

example : p ∧ False ↔ False := by
  apply Iff.intro
  · show p ∧ False → False
    intro ⟨_, (_ : False)⟩
    exact ‹False›
  · show False → p ∧ False
    intro (_ : False)
    exact False.elim ‹False›

example : p ∧ False ↔ False := by
  apply Iff.intro
  · show p ∧ False → False
    intro ⟨_, (_ : False)⟩
    cases ‹False›
  · show False → p ∧ False
    intro (_ : False)
    cases ‹False›

example : p ∧ False ↔ False := by
  simp

example : (p → q) → (¬q → ¬p) := by
  intro (_ : p → q) (_ : ¬q) (_ : p)
  show False
  exact ‹¬q› (‹p → q› ‹p›)

example : (p → q) → (¬q → ¬p) := by
  repeat intro; simp [*] at *

namespace using_classical
open Classical

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by
  intro (_ : p → r ∨ s)
  show (p → r) ∨ (p → s)
  match em r with
  | Or.inl (_ : r) =>
    apply Or.inl
    show p → r
    exact λ _ => ‹r›
  | Or.inr (_ : ¬r) =>
    apply Or.inr
    show p → s
    intro (_ : p)
    match ‹p → r ∨ s› ‹p› with
    | Or.inl (_ : r) =>
      show s
      exact False.elim (‹¬r› ‹r›)
    | Or.inr (_ : s) =>
      show s
      exact ‹s›

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by
  intro; cases em r
  · simp [*]
  · apply Or.inr; intro; cases ‹p → r ∨ s› ‹p›
    · contradiction
    · assumption

example : ¬(p ∧ q) → ¬p ∨ ¬q := by
  intro (_ : ¬(p ∧ q))
  show ¬p ∨ ¬q
  match em p with
  | Or.inr (_ : ¬p) =>
    apply Or.inl
    show ¬p
    exact ‹¬p›
  | Or.inl (_ : p) =>
    apply Or.inr
    show ¬q
    intro (_ : q)
    exact ‹¬(p ∧ q)› ⟨‹p›, ‹q›⟩

example : ¬(p ∧ q) → ¬p ∨ ¬q := by
  intro; cases em p
  · apply Or.inr; intro; simp [*] at *
  · simp [*]

example : ¬(p → q) → p ∧ ¬q := by
  intro (_ : ¬(p → q))
  apply And.intro
  · show p
    apply byContradiction
    intro (_ : ¬p)
    show False
    have : p → q := by
      intro (_ : p)
      exact False.elim (‹¬p› ‹p›)
    exact ‹¬(p → q)› ‹p → q›
  · show ¬q
    intro (_ : q)
    show False
    have : p → q := λ _ => ‹q›
    exact ‹¬(p → q)› ‹p → q›

example : ¬(p → q) → p ∧ ¬q := by
  intro; constructor
  · apply byContradiction; intro; simp [*] at *
  · intro; simp [*] at *

example : (p → q) → ¬p ∨ q := by
  intro (_ : p → q)
  show ¬p ∨ q
  match em p with
  | Or.inl (_ : p) => exact Or.inr (‹p → q› ‹p›)
  | Or.inr (_ : ¬p) => exact Or.inl ‹¬p›

example : (p → q) → ¬p ∨ q := by
  intro (_ : p → q)
  show ¬p ∨ q
  match em p with
  | Or.inl (_ : p) =>
    apply Or.inr
    show q
    exact ‹p → q› ‹p›
  | Or.inr (_ : ¬p) =>
    apply Or.inl
    show ¬p
    exact ‹¬p›

example : (p → q) → ¬p ∨ q := by
  intro; cases em p <;> simp [*]

example : (¬q → ¬p) → (p → q) := by
  intro (_: ¬q → ¬p) (_ : p)
  show q
  apply byContradiction
  intro (_ : ¬q)
  show False
  exact ‹¬q → ¬p› ‹¬q› ‹p›

example : (¬q → ¬p) → (p → q) := by
  intros; apply byContradiction; intro; simp [*] at *

example : p ∨ ¬p := by
  exact em p

example : ((p → q) → p) → p := by
  intro (_ : (p → q) → p)
  show p
  apply byContradiction
  intro (_ : ¬p)
  show False
  apply ‹¬p›
  apply ‹(p → q) → p›
  show p → q
  intro (_ : p)
  exact False.elim (‹¬p› ‹p›)

example : ((p → q) → p) → p := by
  intro; apply byContradiction; intro; simp [*] at *

end using_classical

example : ¬(p ↔ ¬p) := by
  intro ⟨(_ : p → ¬p), (_ : ¬p → p)⟩
  have : ¬p := λ (_ : p) => ‹p → ¬p› ‹p› ‹p›
  show False
  exact ‹¬p› (‹¬p → p› ‹¬p›)

example : ¬(p ↔ ¬p) := by
  intro ⟨_, _⟩
  have : ¬p := by intro; simp [*] at *
  simp [*] at *

end ch3_exs

namespace ch4_ex1

variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := by
  apply Iff.intro
  · show (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x)
    intro (_ : ∀ x, p x ∧ q x)
    apply And.intro
    · show ∀ x, p x
      intro x
      exact (‹∀ x, p x ∧ q x› x).left
    · show ∀ x, q x
      intro x
      exact (‹∀ x, p x ∧ q x› x).right
  · show (∀ x, p x) ∧ (∀ x, q x) → (∀ x, p x ∧ q x)
    intro ⟨(_ : ∀ x, p x), (_ : ∀ x, q x)⟩ x
    apply And.intro
    · show p x
      exact ‹∀ x, p x› x
    · show q x
      exact ‹∀ x, q x› x

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := by
  constructor <;> intros <;> simp [*]

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := by
  intro (_ : ∀ x, p x → q x) (_ : ∀ x, p x) x
  show q x
  have : p x := ‹∀ x, p x› x
  have : q x := ‹∀ x, p x → q x› x ‹p x›
  exact this

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := by
  intros; simp [*]

example : (∀ x, p x) ∨ (∀ x, q x) → (∀ x, p x ∨ q x) := by
  intro (_ : (∀ x, p x) ∨ (∀ x, q x)) x
  show p x ∨ q x
  match ‹(∀ x, p x) ∨ (∀ x, q x)› with
  | Or.inl (_ : ∀ x, p x) =>
    apply Or.inl
    show p x
    exact ‹∀ x, p x› x
  | Or.inr (_ : ∀ x, q x) =>
    apply Or.inr
    show q x
    exact ‹∀ x, q x› x

example : (∀ x, p x) ∨ (∀ x, q x) → (∀ x, p x ∨ q x) := by
  intro h x; cases h <;> simp [*] at *

end ch4_ex1

namespace ch4_ex2

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : α → ((∀ x : α, r) ↔ r) := by
  intro (a : α)
  apply Iff.intro
  · show (∀ x : α, r) → r
    intro (_ : ∀ x : α, r)
    exact ‹∀ x : α, r› a
  · show r → (∀ x : α, r)
    intro (_ : r) x
    exact ‹r›

example : α → ((∀ x : α, r) ↔ r) := by
  intro a; constructor
  · intro h; exact h a
  · intros; simp [*]

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := by
  apply Iff.intro
  · intro (_ : ∀ x, p x ∨ r)
    show (∀ x, p x) ∨ r
    match Classical.em r with
    | Or.inl (_ : r) =>
      apply Or.inr
      show r
      exact ‹r›
    | Or.inr (_ : ¬r) =>
      apply Or.inl
      intro x
      show p x
      match ‹∀ x, p x ∨ r› x with
      | Or.inl (_ : p x) => exact ‹p x›
      | Or.inr (_ : r) => exact False.elim (‹¬r› ‹r›)
  · intro (_ : (∀ x, p x) ∨ r) x
    show p x ∨ r
    match ‹(∀ x, p x) ∨ r› with
    | Or.inl (_ : ∀ x, p x) =>
      apply Or.inl
      show p x
      exact ‹∀ x, p x› x
    | Or.inr (_ : r) =>
      apply Or.inr
      show r
      exact ‹r›

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := by
  constructor <;> intro h
  · cases Classical.em r <;> intros
    · simp [*]
    · apply Or.inl; intro x; cases h x <;> simp [*] at *
  · intros; cases h <;> simp [*]

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := by
  apply Iff.intro
  · intro (_ : ∀ x, r → p x) (_ : r) x
    show p x
    exact ‹∀ x, r → p x› x ‹r›
  · intro (_ : r → ∀ x, p x) x (_ : r)
    show p x
    exact ‹r → ∀ x, p x› ‹r› x

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := by
  constructor <;> intros <;> simp [*]

end ch4_ex2

namespace ch4_ex3

variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False := by
  let bsh : Prop := shaves barber barber -- "barber shaves himself"
  have ⟨(_ : bsh → ¬bsh), (_ : ¬bsh → bsh)⟩ := h barber
  have : ¬bsh := λ (_ : bsh) => ‹bsh → ¬bsh› ‹bsh› ‹bsh›
  show False
  exact ‹¬bsh› (‹¬bsh → bsh› ‹¬bsh›)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False := by
  let bsh : Prop := shaves barber barber -- "barber shaves himself"
  have ⟨(_ : bsh → ¬bsh), (_ : ¬bsh → bsh)⟩ := h barber
  show False
  have : ¬bsh := by
    intro (_ : bsh)
    show False
    have : ¬bsh := ‹bsh → ¬bsh› ‹bsh›
    contradiction
  have : bsh := ‹¬bsh → bsh› ‹¬bsh›
  contradiction

end ch4_ex3

namespace ch4_ex5

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : (∃ x : α, r) → r := by
  intro ⟨x, (_ : r)⟩
  exact ‹r›

example : (∃ x : α, r) → r := by
  intro h; cases h; assumption

example (a : α) : r → (∃ x : α, r) := by
  intro (_ : r)
  exists a
  exact ‹r›

example (a : α) : r → (∃ x : α, r) := by
  intro; constructor <;> assumption

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by
  apply Iff.intro
  · intro ⟨x, ⟨(_ : p x), (_ : r)⟩⟩
    show (∃ x, p x) ∧ r
    exact ⟨⟨x, ‹p x›⟩, ‹r›⟩
  · intro ⟨⟨x, (_ : p x)⟩, (_ : r)⟩
    show ∃ x, p x ∧ r
    exact ⟨x, ⟨‹p x›, ‹r›⟩⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by
  constructor
  · intro ⟨_, ⟨_, _⟩⟩; (constructor <;> try constructor); repeat assumption
  · intro ⟨⟨_, _⟩, _⟩; repeat constructor; repeat assumption

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := by
  apply Iff.intro
  · intro ⟨x, (_ : p x ∨ q x)⟩
    show (∃ x, p x) ∨ (∃ x, q x)
    match ‹p x ∨ q x› with
    | Or.inl (_ : p x) => exact Or.inl ⟨x, ‹p x›⟩
    | Or.inr (_ : q x) => exact Or.inr ⟨x, ‹q x›⟩
  · intro (_ : (∃ x, p x) ∨ (∃ x, q x))
    show ∃ x, p x ∨ q x
    match ‹(∃ x, p x) ∨ (∃ x, q x)› with
    | Or.inl ⟨x, (_ : p x)⟩ => exact ⟨x, Or.inl ‹p x›⟩
    | Or.inr ⟨x, (_ : q x)⟩ => exact ⟨x, Or.inr ‹q x›⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := by
  apply Iff.intro
  · intro ⟨x, (_ : p x ∨ q x)⟩
    show (∃ x, p x) ∨ (∃ x, q x)
    match ‹p x ∨ q x› with
    | Or.inl (_ : p x) => apply Or.inl; exists x; exact ‹p x›
    | Or.inr (_ : q x) => apply Or.inr; exists x; exact ‹q x›
  · intro (_ : (∃ x, p x) ∨ (∃ x, q x))
    show ∃ x, p x ∨ q x
    match ‹(∃ x, p x) ∨ (∃ x, q x)› with
    | Or.inl ⟨x, (_ : p x)⟩ => exists x; apply Or.inl; exact ‹p x›
    | Or.inr ⟨x, (_ : q x)⟩ => exists x; apply Or.inr; exact ‹q x›

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := by
  constructor
  · intro h ; cases h; rename_i h; cases h
    · apply Or.inl; constructor; assumption
    · apply Or.inr; constructor; assumption
  · intro h; cases h <;> rename_i h <;> cases h
    · constructor; apply Or.inl; assumption
    · constructor; apply Or.inr; assumption

-- Not bothering with short proofs after this point
-- They aren't so easy to do with existentials

example : (∀ x, p x) ↔ ¬∃ x, ¬ p x := by
  apply Iff.intro
  · intro (_ : ∀ x, p x) ⟨x, (_ : ¬ p x)⟩
    show False
    exact ‹¬ p x› (‹∀ x, p x› x)
  · intro (_ : ¬∃ x, ¬ p x) x
    show p x
    apply Classical.byContradiction
    intro (_ : ¬ p x)
    show False
    exact ‹¬∃ x, ¬ p x› ⟨x, ‹¬ p x›⟩

example : (∃ x, p x) ↔ ¬∀ x, ¬ p x := by
  apply Iff.intro
  · intro ⟨x, (_ : p x)⟩ (_ : ∀ x, ¬ p x)
    show False
    exact ‹∀ x, ¬ p x› x ‹p x›
  · intro (_ : ¬∀ x, ¬ p x)
    show ∃ x, p x
    apply Classical.byContradiction
    intro (_ : ¬∃ x, p x)
    show False
    apply ‹¬∀ x, ¬ p x›
    intro x (_ : p x)
    show False
    apply ‹¬∃ x, p x›
    exact ⟨x, ‹p x›⟩

example : (∃ x, p x) ↔ ¬∀ x, ¬ p x := by
  apply Iff.intro
  · intro ⟨x, (_ : p x)⟩ (_ : ∀ x, ¬ p x)
    show False
    exact ‹∀ x, ¬ p x› x ‹p x›
  · intro (_ : ¬∀ x, ¬ p x)
    show ∃ x, p x
    apply Classical.byContradiction
    intro (_ : ¬∃ x, p x)
    show False
    have : ∀ x, ¬ p x := by
      intro x (_ : p x)
      show False
      exact ‹¬∃ x, p x› ⟨x, ‹p x›⟩
    exact ‹¬∀ x, ¬ p x› ‹∀ x, ¬ p x›

example : (¬∃ x, p x) ↔ (∀ x, ¬ p x) := by
  apply Iff.intro
  · intro (_ : ¬∃ x, p x) x (_ : p x)
    show False
    apply ‹¬∃ x, p x›
    exact ⟨x, ‹p x›⟩
  · intro (_ : ∀ x, ¬ p x) ⟨x, (_ : p x)⟩
    show False
    apply ‹∀ x, ¬ p x› x
    exact ‹p x›

example : (¬∀ x, p x) ↔ (∃ x, ¬ p x) := by
  apply Iff.intro
  · intro (_ : ¬∀ x, p x)
    show ∃ x, ¬ p x
    apply Classical.byContradiction
    intro (_ : ¬∃ x, ¬ p x)
    show False
    apply ‹¬∀ x, p x›
    intro x
    show p x
    apply Classical.byContradiction
    intro (_ : ¬ p x)
    show False
    apply ‹¬∃ x, ¬ p x›
    exact ⟨x, ‹¬ p x›⟩
  · intro ⟨x, (_ : ¬ p x)⟩ (_ : ∀ x, p x)
    show False
    apply ‹¬ p x›
    exact ‹∀ x, p x› x

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := by
  apply Iff.intro
  · intro (_ : ∀ x, p x → r) ⟨x, (_ : p x)⟩
    show r
    exact ‹∀ x, p x → r› x ‹p x›
  · intro (_ : (∃ x, p x) → r) x (_ : p x)
    show r
    exact ‹(∃ x, p x) → r› ⟨x, ‹p x›⟩

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := by
  apply Iff.intro
  · intro ⟨x, (_ : p x → r)⟩ (_ : ∀ x, p x)
    show r
    exact ‹p x → r› (‹∀ x, p x› x)
  · intro (_ : (∀ x, p x) → r)
    show ∃ x, p x → r
    apply Classical.byContradiction
    intro (_ : ¬∃ x, p x → r)
    show False
    have : r := by
      apply ‹(∀ x, p x) → r›
      intro x
      show p x
      apply Classical.byContradiction
      intro (_ : ¬ p x)
      show False
      apply ‹¬∃ x, p x → r›
      exists x
      intro (_ : p x)
      show r
      exact absurd ‹p x› ‹¬ p x›
    apply ‹¬∃ x, p x → r›
    exact ⟨a, λ (_ : p a) => ‹r›⟩

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := by
  apply Iff.intro
  · intro ⟨x, (_ : r → p x)⟩ (_ : r)
    show ∃ x, p x
    exact ⟨x, ‹r → p x› ‹r›⟩
  · intro (_ : r → ∃ x, p x)
    show ∃ x, r → p x
    apply Classical.byContradiction
    intro (_ : ¬∃ x, r → p x)
    have : r := by
      apply Classical.byContradiction
      intro (_ : ¬r)
      show False
      apply ‹¬∃ x, r → p x›
      exists a
      intro (_ : r)
      show p a
      exact absurd ‹r› ‹¬r›
    have ⟨x, (_ : p x)⟩ := ‹r → ∃ x, p x› ‹r›
    show False
    apply ‹¬∃ x, r → p x›
    exists x
    intro (_ : r)
    exact ‹p x›

end ch4_ex5

end ex_1

namespace ex_2

example (p q r : Prop) (hp : p) : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) := by
  simp [*]

example (p q r : Prop) (hp : p) : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) := by
  repeat (first | assumption | apply Or.inl; assumption | apply Or.inr | constructor)

end ex_2


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot

! This file was ported from Lean 3 source module topology.algebra.group.compact
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Group.Basic
import Mathbin.Topology.CompactOpen
import Mathbin.Topology.Sets.Compacts

/-!
# Additional results on topological groups

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

Two results on topological groups that have been separated out as they require more substantial
imports developing either positive compacts or the compact open topology.

-/

open Classical Set Filter TopologicalSpace Function

open Classical Topology Filter Pointwise

universe u v w x

variable {α : Type u} {β : Type v} {G : Type w} {H : Type x}

section

/-! Some results about an open set containing the product of two sets in a topological group. -/

variable [TopologicalSpace G] [Group G] [TopologicalGroup G]

#print TopologicalSpace.PositiveCompacts.locallyCompactSpace_of_Group /-
/-- Every separated topological group in which there exists a compact set with nonempty interior
is locally compact. -/
@[to_additive
      "Every separated topological group in which there exists a compact set with nonempty\ninterior is locally compact."]
theorem TopologicalSpace.PositiveCompacts.locallyCompactSpace_of_Group [T2Space G]
    (K : PositiveCompacts G) : LocallyCompactSpace G :=
  by
  refine' locally_compact_of_compact_nhds fun x => _
  obtain ⟨y, hy⟩ := K.interior_nonempty
  let F := Homeomorph.mulLeft (x * y⁻¹)
  refine' ⟨F '' K, _, K.is_compact.image F.continuous⟩
  suffices F.symm ⁻¹' K ∈ 𝓝 x by
    convert this
    apply Equiv.image_eq_preimage
  apply ContinuousAt.preimage_mem_nhds F.symm.continuous.continuous_at
  have : F.symm x = y := by simp [F, Homeomorph.mulLeft_symm]
  rw [this]
  exact mem_interior_iff_mem_nhds.1 hy
#align topological_space.positive_compacts.locally_compact_space_of_group TopologicalSpace.PositiveCompacts.locallyCompactSpace_of_Group
#align topological_space.positive_compacts.locally_compact_space_of_add_group TopologicalSpace.PositiveCompacts.locallyCompactSpace_of_AddGroup
-/

end

section Quotient

variable [Group G] [TopologicalSpace G] [TopologicalGroup G] {Γ : Subgroup G}

#print QuotientGroup.continuousSMul /-
@[to_additive]
instance QuotientGroup.continuousSMul [LocallyCompactSpace G] : ContinuousSMul G (G ⧸ Γ)
    where continuous_smul :=
    by
    let F : G × G ⧸ Γ → G ⧸ Γ := fun p => p.1 • p.2
    change Continuous F
    have H : Continuous (F ∘ fun p : G × G => (p.1, QuotientGroup.mk p.2)) :=
      by
      change Continuous fun p : G × G => QuotientGroup.mk (p.1 * p.2)
      refine' continuous_coinduced_rng.comp continuous_mul
    exact QuotientMap.continuous_lift_prod_right quotientMap_quotient_mk' H
#align quotient_group.has_continuous_smul QuotientGroup.continuousSMul
#align quotient_add_group.has_continuous_vadd QuotientAddGroup.continuousVAdd
-/

end Quotient


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudriashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.convex.basic
import Mathlib.analysis.normed_space.finite_dimension
import Mathlib.topology.path_connected
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Topological and metric properties of convex sets

We prove the following facts:

* `convex.interior` : interior of a convex set is convex;
* `convex.closure` : closure of a convex set is convex;
* `set.finite.compact_convex_hull` : convex hull of a finite set is compact;
* `set.finite.is_closed_convex_hull` : convex hull of a finite set is closed;
* `convex_on_dist` : distance to a fixed point is convex on any convex set;
* `convex_hull_ediam`, `convex_hull_diam` : convex hull of a set has the same (e)metric diameter
  as the original set;
* `bounded_convex_hull` : convex hull of a set is bounded if and only if the original set
  is bounded.
* `bounded_std_simplex`, `is_closed_std_simplex`, `compact_std_simplex`: topological properties
  of the standard simplex;
-/

theorem real.convex_iff_is_preconnected {s : set ℝ} : convex s ↔ is_preconnected s :=
  iff.trans real.convex_iff_ord_connected (iff.symm is_preconnected_iff_ord_connected)

theorem is_preconnected.convex {s : set ℝ} : is_preconnected s → convex s :=
  iff.mpr real.convex_iff_is_preconnected

/-! ### Standard simplex -/

/-- Every vector in `std_simplex ι` has `max`-norm at most `1`. -/
theorem std_simplex_subset_closed_ball {ι : Type u_1} [fintype ι] :
    std_simplex ι ⊆ metric.closed_ball 0 1 :=
  sorry

/-- `std_simplex ι` is bounded. -/
theorem bounded_std_simplex (ι : Type u_1) [fintype ι] : metric.bounded (std_simplex ι) :=
  iff.mpr (metric.bounded_iff_subset_ball 0) (Exists.intro 1 std_simplex_subset_closed_ball)

/-- `std_simplex ι` is closed. -/
theorem is_closed_std_simplex (ι : Type u_1) [fintype ι] : is_closed (std_simplex ι) := sorry

/-- `std_simplex ι` is compact. -/
theorem compact_std_simplex (ι : Type u_1) [fintype ι] : is_compact (std_simplex ι) :=
  iff.mpr metric.compact_iff_closed_bounded
    { left := is_closed_std_simplex ι, right := bounded_std_simplex ι }

/-! ### Topological vector space -/

/-- In a topological vector space, the interior of a convex set is convex. -/
theorem convex.interior {E : Type u_2} [add_comm_group E] [vector_space ℝ E] [topological_space E]
    [topological_add_group E] [topological_vector_space ℝ E] {s : set E} (hs : convex s) :
    convex (interior s) :=
  sorry

/-- In a topological vector space, the closure of a convex set is convex. -/
theorem convex.closure {E : Type u_2} [add_comm_group E] [vector_space ℝ E] [topological_space E]
    [topological_add_group E] [topological_vector_space ℝ E] {s : set E} (hs : convex s) :
    convex (closure s) :=
  sorry

/-- Convex hull of a finite set is compact. -/
theorem set.finite.compact_convex_hull {E : Type u_2} [add_comm_group E] [vector_space ℝ E]
    [topological_space E] [topological_add_group E] [topological_vector_space ℝ E] {s : set E}
    (hs : set.finite s) : is_compact (convex_hull s) :=
  sorry

/-- Convex hull of a finite set is closed. -/
theorem set.finite.is_closed_convex_hull {E : Type u_2} [add_comm_group E] [vector_space ℝ E]
    [topological_space E] [topological_add_group E] [topological_vector_space ℝ E] [t2_space E]
    {s : set E} (hs : set.finite s) : is_closed (convex_hull s) :=
  is_compact.is_closed (set.finite.compact_convex_hull hs)

/-! ### Normed vector space -/

theorem convex_on_dist {E : Type u_2} [normed_group E] [normed_space ℝ E] (z : E) (s : set E)
    (hs : convex s) : convex_on s fun (z' : E) => dist z' z :=
  sorry

theorem convex_ball {E : Type u_2} [normed_group E] [normed_space ℝ E] (a : E) (r : ℝ) :
    convex (metric.ball a r) :=
  sorry

theorem convex_closed_ball {E : Type u_2} [normed_group E] [normed_space ℝ E] (a : E) (r : ℝ) :
    convex (metric.closed_ball a r) :=
  sorry

/-- Given a point `x` in the convex hull of `s` and a point `y`, there exists a point
of `s` at distance at least `dist x y` from `y`. -/
theorem convex_hull_exists_dist_ge {E : Type u_2} [normed_group E] [normed_space ℝ E] {s : set E}
    {x : E} (hx : x ∈ convex_hull s) (y : E) : ∃ (x' : E), ∃ (H : x' ∈ s), dist x y ≤ dist x' y :=
  convex_on.exists_ge_of_mem_convex_hull (convex_on_dist y (convex_hull s) (convex_convex_hull s))
    hx

/-- Given a point `x` in the convex hull of `s` and a point `y` in the convex hull of `t`,
there exist points `x' ∈ s` and `y' ∈ t` at distance at least `dist x y`. -/
theorem convex_hull_exists_dist_ge2 {E : Type u_2} [normed_group E] [normed_space ℝ E] {s : set E}
    {t : set E} {x : E} {y : E} (hx : x ∈ convex_hull s) (hy : y ∈ convex_hull t) :
    ∃ (x' : E), ∃ (H : x' ∈ s), ∃ (y' : E), ∃ (H : y' ∈ t), dist x y ≤ dist x' y' :=
  sorry

/-- Emetric diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] theorem convex_hull_ediam {E : Type u_2} [normed_group E] [normed_space ℝ E] (s : set E) :
    emetric.diam (convex_hull s) = emetric.diam s :=
  sorry

/-- Diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] theorem convex_hull_diam {E : Type u_2} [normed_group E] [normed_space ℝ E] (s : set E) :
    metric.diam (convex_hull s) = metric.diam s :=
  sorry

/-- Convex hull of `s` is bounded if and only if `s` is bounded. -/
@[simp] theorem bounded_convex_hull {E : Type u_2} [normed_group E] [normed_space ℝ E] {s : set E} :
    metric.bounded (convex_hull s) ↔ metric.bounded s :=
  sorry

theorem convex.is_path_connected {E : Type u_2} [normed_group E] [normed_space ℝ E] {s : set E}
    (hconv : convex s) (hne : set.nonempty s) : is_path_connected s :=
  sorry

protected instance normed_space.path_connected {E : Type u_2} [normed_group E] [normed_space ℝ E] :
    path_connected_space E :=
  iff.mpr path_connected_space_iff_univ
    (convex.is_path_connected convex_univ (Exists.intro 0 trivial))

protected instance normed_space.loc_path_connected {E : Type u_2} [normed_group E]
    [normed_space ℝ E] : loc_path_connected_space E :=
  loc_path_connected_of_bases (fun (x : E) => metric.nhds_basis_ball)
    fun (x : E) (r : ℝ) (r_pos : 0 < r) =>
      convex.is_path_connected (convex_ball x r)
        (eq.mpr
          (id
            (propext
              ((fun {α : Type u_2} [_inst_1 : metric_space α] {x : α} {ε : ℝ} (h : 0 < ε) =>
                  iff_true_intro (metric.nonempty_ball h))
                (iff.mpr (iff_true_intro r_pos) True.intro))))
          trivial)

end Mathlib


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import dirichlet_character.teichmuller_character
import zmod.chinese_remainder_units

/-!
# A factor of conductor
This file explains why we need the hypothesis `d ∣ χ.conductor`,
for a Dirichlet character `χ` of level `d * p^m`, for a natural `d` coprime to the odd prime `p`.
It also contains several properties regarding the conductor and multiplication, and provides
a useful framework to translate `change_level` for equal levels, using `cast_heq`.

## Main theorems
 * `exists_mul_of_dvd`
 * `cast_change_level`
 * `eq_mul_primitive_of_coprime`
 * `dvd_mul_of_dvd_conductor`

## Tags
Dirichlet character, conductor
-/

namespace dirichlet_character
open dirichlet_character

lemma mul_eq_mul {S : Type*} [comm_monoid_with_zero S] {n : ℕ} (χ ψ : dirichlet_character S n) {a : ℕ}
  (ha : is_unit (a : zmod n)) :
  asso_dirichlet_character (χ.mul ψ) a = asso_dirichlet_character (χ * ψ) a :=
begin
  rw mul_def,
  have lcm_eq_self : lcm n n = n := nat.lcm_self n,
  have h1 := classical.some_spec (conductor.factors_through (change_level (dvd_lcm_left n n) χ * change_level
    (dvd_lcm_right n n) ψ)).ind_char,
  have h2 := congr_arg asso_dirichlet_character h1,
  rw monoid_hom.ext_iff at h2, specialize h2 a,
  have h : is_unit (a : zmod (lcm n n)),
  { convert ha, }, -- lcm_eq_self ▸ ha does not work
  rw [change_level.asso_dirichlet_character_eq' _ _ h,
    zmod.cast_nat_cast (conductor.dvd_lev ((change_level (dvd_lcm_left n n) χ *
    change_level (dvd_lcm_right n n) ψ)))] at h2,
  delta asso_primitive_character,
  rw [←h2, asso_dirichlet_character_mul, asso_dirichlet_character_mul, monoid_hom.mul_apply,
    monoid_hom.mul_apply, change_level.asso_dirichlet_character_eq' _ _ h,
    change_level.asso_dirichlet_character_eq' _ _ h, zmod.cast_nat_cast (dvd_lcm_left n n) a],
  any_goals { refine zmod.char_p _, },
end

variables (S : Type*) [comm_monoid_with_zero S]
open zmod

lemma eq_mul_of_coprime_lev {m n : ℕ} (χ : dirichlet_character S (m * n)) (hcop : m.coprime n) :
  ∃ (χ₁ : dirichlet_character S m) (χ₂ : dirichlet_character S n),
  ∀ x : ℕ, asso_dirichlet_character χ x =
  asso_dirichlet_character χ₁ x * asso_dirichlet_character χ₂ x :=
begin
--  have h : d.coprime (p^n) := nat.coprime.pow_right n hd,
  refine ⟨monoid_hom.comp χ ((units.map (zmod.chinese_remainder hcop).symm.to_monoid_hom).comp
    (monoid_hom.comp (mul_equiv.to_monoid_hom (@mul_equiv.prod_units (zmod m) (zmod n) _ _).symm)
    (monoid_hom.prod (monoid_hom.id _) 1))),
    monoid_hom.comp χ ((units.map (zmod.chinese_remainder hcop).symm.to_monoid_hom).comp
    (monoid_hom.comp (mul_equiv.to_monoid_hom (@mul_equiv.prod_units (zmod m) (zmod n) _ _).symm)
    (monoid_hom.prod 1 (monoid_hom.id _)))), λ x, _⟩,
  { by_cases h' : is_unit (x : zmod (m * n)),
    { rw asso_dirichlet_character_eq_char' _ h',
      have h1 : is_unit (x : zmod m) := zmod.is_unit_of_is_unit_mul _ h',
      have h2 : is_unit (x : zmod n) := zmod.is_unit_of_is_unit_mul' _ h',
      rw asso_dirichlet_character_eq_char' _ h1,
      rw asso_dirichlet_character_eq_char' _ h2,
      simp,
      rw ← units.coe_mul, simp_rw [← mul_equiv.coe_to_monoid_hom, ← monoid_hom.map_mul,
        prod.mul_def, mul_one, one_mul],
      congr, rw units.ext_iff, rw is_unit.unit_spec, rw units.coe_map,
      rw mul_equiv.coe_to_monoid_hom,
      rw chinese_remainder_comp_prod_units S χ hcop h1 h2, },
    { rw asso_dirichlet_character_eq_zero _ h',
      -- make this a separate lemma
      have : ¬ is_unit (x : zmod m) ∨ ¬ is_unit (x : zmod n) := zmod.not_is_unit_of_not_is_unit_mul h',
      cases this,
      { rw asso_dirichlet_character_eq_zero _ this, rw zero_mul, },
      { rw asso_dirichlet_character_eq_zero _ this, rw mul_zero, }, }, },
end

lemma eq_mul_of_coprime_lev' {m n : ℕ} [fact (0 < m * n)] (χ : dirichlet_character S (m * n)) (hcop : m.coprime n) :
  ∃ (χ₁ : dirichlet_character S m) (χ₂ : dirichlet_character S n),
  χ = change_level (dvd_mul_right m n) χ₁ * change_level (dvd_mul_left n m) χ₂ :=
begin
  obtain ⟨χ₁, χ₂, h⟩ := eq_mul_of_coprime_lev S χ hcop,
  refine ⟨χ₁, χ₂, _⟩,
  rw asso_dirichlet_character_eq_iff,
  ext, rw asso_dirichlet_character_mul,
  rw monoid_hom.mul_apply, specialize h (x.val),
  simp_rw zmod.nat_cast_val at h, simp_rw zmod.cast_id at h,
  rw h,
  by_cases h' : is_unit x,
  { rw change_level.asso_dirichlet_character_eq' _ (dvd_mul_right m n) h',
    rw change_level.asso_dirichlet_character_eq' _ (dvd_mul_left n m) h', },
  { have : ¬ is_unit (x : zmod m) ∨ ¬ is_unit (x : zmod n) := zmod.not_is_unit_of_not_is_unit_mul' x h',
    cases this,
    any_goals { rw asso_dirichlet_character_eq_zero _ h', rw zero_mul,
      rw asso_dirichlet_character_eq_zero _ h' at h, rw h.symm, }, },
end

lemma mul_change_level_eq_of_coprime {m n : ℕ} (hd : m.coprime n) {χ χ' : dirichlet_character S m}
  {ψ ψ' : dirichlet_character S n}
  (h : change_level (dvd_mul_right m n) χ * change_level (dvd_mul_left n m) ψ =
    change_level (dvd_mul_right m n) χ' * change_level (dvd_mul_left n m) ψ') : χ = χ' ∧ ψ = ψ' :=
begin
  split,
  { ext, rw monoid_hom.ext_iff at h, simp_rw monoid_hom.mul_apply at h,
    simp_rw units.ext_iff at h, simp_rw change_level_def at h,
    specialize h ((units.chinese_remainder hd).symm (x, 1)),
    simp_rw monoid_hom.comp_apply at h, simp_rw units.coe_mul at h,
    rw ← asso_dirichlet_character_eq_char χ at h, rw ← asso_dirichlet_character_eq_char χ' at h,
    rw ← asso_dirichlet_character_eq_char ψ at h, rw ← asso_dirichlet_character_eq_char ψ' at h,
    simp_rw [units.coe_map, ring_hom.coe_monoid_hom, zmod.cast_hom_apply] at h,
    rw units.chinese_remainder_symm_apply_fst' at h,
    rw units.chinese_remainder_symm_apply_snd' at h,
    simp_rw asso_dirichlet_character_eq_char at h, simp_rw monoid_hom.map_one at h,
    rw units.coe_one at h, simp_rw mul_one at h, rw h, },
  { ext, rw monoid_hom.ext_iff at h, simp_rw monoid_hom.mul_apply at h,
    simp_rw units.ext_iff at h, simp_rw change_level_def at h,
    specialize h ((units.chinese_remainder hd).symm (1, x)),
    simp_rw monoid_hom.comp_apply at h, simp_rw units.coe_mul at h,
    rw ← asso_dirichlet_character_eq_char χ at h, rw ← asso_dirichlet_character_eq_char χ' at h,
    rw ← asso_dirichlet_character_eq_char ψ at h, rw ← asso_dirichlet_character_eq_char ψ' at h,
    simp_rw [units.coe_map, ring_hom.coe_monoid_hom, zmod.cast_hom_apply] at h,
    rw units.chinese_remainder_symm_apply_fst' at h,
    rw units.chinese_remainder_symm_apply_snd' at h,
    simp_rw asso_dirichlet_character_eq_char at h, simp_rw monoid_hom.map_one at h,
    rw units.coe_one at h, simp_rw one_mul at h, rw h, },
end

lemma lev_eq_of_primitive {m n : ℕ} [fact (0 < n)] (h : m ∣ n) {χ : dirichlet_character S n}
  {χ' : dirichlet_character S m} (hχ : χ.is_primitive) (h_change : change_level h χ' = χ) : m = n :=
begin
  by_contra h',
  rw is_primitive_def at hχ,
  have m_lt_n := lt_of_le_of_ne (nat.le_of_dvd (fact.out _) h) h',
  rw ← hχ at m_lt_n,
  have ft : χ.factors_through m := ⟨h, χ', h_change.symm⟩,
  rw ← mem_conductor_set_iff at ft,
  have := cInf_le' ft,
  apply not_le_of_gt m_lt_n this,
end

lemma dirichlet_character_eq_of_eq {a b : ℕ} (h : a = b) :
  dirichlet_character S a = dirichlet_character S b :=
begin
  subst h,
end

lemma exists_mul_of_dvd {m n : ℕ} (h : m.coprime n) (χ : dirichlet_character S m) (ψ : dirichlet_character S n) :
  ∃ (x y : ℕ), x ∣ m ∧ y ∣ n ∧ (χ.mul ψ).conductor = x * y :=
begin
  rw (is_primitive_def _).1 (is_primitive.mul χ ψ),
  have : lcm m n = m * n,
  { rw [lcm_eq_nat_lcm, nat.coprime.lcm_eq_mul h], },
  have req : (change_level (dvd_lcm_left m n) χ * change_level (dvd_lcm_right m n) ψ).conductor ∣ m * n,
  { rw ← this, apply conductor.dvd_lev, },
  obtain ⟨x', hx', y', hy', h''⟩ := exists_dvd_and_dvd_of_dvd_mul req,
  rw h'',
  refine ⟨x', y', hx', hy', rfl⟩,
end

lemma eq_asso_primitive_character_change_level {m n : ℕ} (h : m ∣ n) (χ : dirichlet_character S m) :
  change_level h χ = change_level (dvd_trans (conductor.dvd_lev _) h) χ.asso_primitive_character :=
begin
  rw asso_primitive_character,
  conv_lhs { rw factors_through.spec χ (mem_conductor_set_factors_through _ (conductor.mem_conductor_set _)), },
  rw ← change_level.dvd,
end

lemma cast_change_level {n a b : ℕ} {S : Type*} [comm_monoid_with_zero S]
  (χ : dirichlet_character S n) (h1 : n ∣ a) (h2 : n ∣ b) (h : a = b) :
  cast (congr_arg (dirichlet_character S) h) (change_level h1 χ) = change_level h2 χ :=
by { subst h, rw cast_eq_iff_heq, }

lemma change_level_cast {n a b : ℕ} {S : Type*} [comm_monoid_with_zero S]
  (χ : dirichlet_character S a) (h1 : a ∣ n) (h : a = b) :
  change_level (show b ∣ n, from by {rw ← h, apply h1,}) (cast (congr_arg (dirichlet_character S) h) χ) =
  change_level h1 χ :=
by { subst h, congr', }

lemma change_level_heq {a b : ℕ} {S : Type*} [comm_monoid_with_zero S]
  (χ : dirichlet_character S a) (h : a = b) : change_level (show a ∣ b, from by {rw h}) χ == χ :=
heq.trans (cast_eq_iff_heq.1 (cast_change_level χ (dvd_refl a) (show a ∣ b, from by {rw h}) h)).symm (heq_of_eq (change_level.self _))

variables (p : ℕ) [fact p.prime] (d : ℕ) [fact (0 < d)] (R : Type*) [normed_comm_ring R] [algebra ℚ_[p] R] (m : ℕ) [fact (0 < m)] (χ : dirichlet_character R (d * p^m))
lemma mul_conductor_eq_mul_conductor (n : ℕ) :
  (χ.mul (teichmuller_character_mod_p' p R ^ n)).conductor =
  (χ * change_level (dvd_mul_of_dvd_right (dvd_pow_self p (nat.ne_zero_of_lt' 0)) d) (teichmuller_character_mod_p' p R ^ n)).conductor :=
begin
  rw (is_primitive_def _).1 (is_primitive.mul _ _),
  have : lcm (d * p^m) p = d * p^m := helper_4 m,
  have h2 : d * p^m ∣ lcm (d * p^m) p, { rw this, },
  rw change_level.dvd (teichmuller_character_mod_p' p R ^ n) (dvd_mul_of_dvd_right (dvd_pow_self p (nat.ne_zero_of_lt' 0)) d) h2,
  rw ←monoid_hom.map_mul, congr',
  apply change_level_heq _ this.symm,
end

lemma exists_mul_of_dvd' (n : ℕ) (hd : d.coprime p) :
  ∃ (x y : ℕ), x ∣ d ∧ y ∣ p^m ∧ (χ.mul (teichmuller_character_mod_p' p R ^ n)).conductor = x * y :=
begin
  simp_rw mul_conductor_eq_mul_conductor p d R m χ n,
  obtain ⟨χ₁, χ₂, h⟩ := eq_mul_of_coprime_lev' R χ (nat.coprime.pow_right m hd),
  rw h, rw mul_assoc, -- delta teichmuller_character_mod_p_change_level,
  --rw pow_change_level,
  have hm : m ≠ 0,
  { apply ne_zero_of_lt (fact.out _), exact 0, apply_instance, apply_instance, },
  rw change_level.dvd _ (dvd_pow_self p hm) (dvd_mul_left (p^m) d), rw ← monoid_hom.map_mul,
  obtain ⟨x, y, hx, hy, h'⟩ := exists_mul_of_dvd R (nat.coprime.pow_right m hd) χ₁
    (χ₂ * change_level (dvd_pow_self p hm) ((((units.map ((algebra_map ℚ_[p] R).comp padic_int.coe.ring_hom).to_monoid_hom).comp
    (teichmuller_character_mod_p p) : dirichlet_character _ p)⁻¹)^n : dirichlet_character _ _)),
  refine ⟨x, y, hx, hy, _⟩,
  rw ← h',
  rw (is_primitive_def _).1 (is_primitive.mul _ _),
  have : d * p^m = lcm d (p^m),
  { rw [lcm_eq_nat_lcm, nat.coprime.lcm_eq_mul (nat.coprime.pow_right _ hd)], },
  rw change_level.dvd χ₁ (dvd_lcm_left d (p^m)) _,
  rw change_level.dvd _ (dvd_lcm_right d (p^m)) _,
  any_goals { rw this, },
  rw ←monoid_hom.map_mul,
  congr',
  apply change_level_heq _ this.symm,
end

lemma eq_of_mul_eq_mul_of_coprime_of_dvd {x y m n : ℕ} (hcop : m.coprime n) (hx : x ∣ m) (hy : y ∣ n) (h : x * y = m * n) :
  x = m ∧ y = n :=
begin
  -- make a separate lemma
  have p1 : m ∣ x,
  { have : m ∣ x * y := dvd_trans (dvd_mul_right m n) (h.symm ▸ dvd_rfl),
    apply (nat.coprime.dvd_mul_right _).1 this,
    -- easier way to do this?
    cases hy with k hy, rw hy at hcop,
    rw nat.coprime_mul_iff_right at hcop,
    apply hcop.1, },
  -- repeat of above
  have p2 : n ∣ y,
  { have : n ∣ x * y := dvd_trans (dvd_mul_left n m) (h.symm ▸ dvd_rfl),
    apply (nat.coprime.dvd_mul_left _).1 this,
    -- easier way to do this?
    cases hx with k hx, rw hx at hcop,
    rw nat.coprime_mul_iff_left at hcop,
    apply hcop.1.symm, },
  refine ⟨nat.dvd_antisymm hx p1, nat.dvd_antisymm hy p2⟩,
end

lemma eq_mul_primitive_of_coprime {m n : ℕ} [fact (0 < m * n)]
  (χ : dirichlet_character S (m * n)) (hχ : χ.is_primitive) (hcop : m.coprime n) :
  ∃ (χ₁ : dirichlet_character S m) (χ₂ : dirichlet_character S n),
  χ₁.is_primitive ∧ χ₂.is_primitive ∧
  χ = change_level (dvd_mul_right m n) χ₁ * change_level (dvd_mul_left n m) χ₂ :=
begin
  obtain ⟨χ₁, χ₂, h⟩ := eq_mul_of_coprime_lev' S χ hcop,
  simp_rw ← and_assoc,
  refine ⟨χ₁, χ₂, _, h⟩,
  rw eq_asso_primitive_character_change_level at h,
  rw eq_asso_primitive_character_change_level S _ χ₂ at h,
  have p1 : χ₁.conductor * χ₂.conductor ∣ m * n := mul_dvd_mul (conductor.dvd_lev _) (conductor.dvd_lev _),
  rw change_level.dvd χ₁.asso_primitive_character (dvd_mul_right _ _) p1 at h,
  rw change_level.dvd _ (dvd_mul_left _ _) p1 at h,
  rw ← monoid_hom.map_mul at h,
  have p2 := lev_eq_of_primitive S _ hχ h.symm,
  rw is_primitive_def, rw is_primitive_def,
  apply eq_of_mul_eq_mul_of_coprime_of_dvd hcop (conductor.dvd_lev _) (conductor.dvd_lev _) p2,
end

lemma eq_mul_of_coprime_of_dvd_conductor {m n : ℕ} [fact (0 < m * n)]
  (χ : dirichlet_character S (m * n)) (hχ : m ∣ χ.conductor) (hcop : m.coprime n) :
  ∃ (χ₁ : dirichlet_character S m) (χ₂ : dirichlet_character S n),
  χ₁.is_primitive ∧ χ = change_level (dvd_mul_right m n) χ₁ * change_level (dvd_mul_left n m) χ₂ :=
begin
  obtain ⟨χ₁, χ₂, h⟩ := eq_mul_of_coprime_lev' S χ hcop,
  refine ⟨χ₁, χ₂, _, h⟩,
  cases hχ with k hk,
  set η' := cast (dirichlet_character_eq_of_eq S hk) χ.asso_primitive_character with hη',
  have mpos : 0 < m,
  { have : 0 < m * n := fact_iff.1 infer_instance,
    simp only [canonically_ordered_comm_semiring.mul_pos] at this,
    apply this.1, },
  haveI : fact (0 < m * k),
  { by_cases k = 0,
    { rw h at hk, rw mul_zero at hk, rw conductor.eq_zero_iff_level_eq_zero at hk, rw hk at *,
      simp only [eq_self_iff_true, not_lt_zero'] at *, exfalso, apply fact_iff.1, apply _inst_7, },
    { apply fact_iff.2, apply mul_pos _ (nat.pos_of_ne_zero h),
      have : 0 < m * n := fact_iff.1 infer_instance,
      simp only [canonically_ordered_comm_semiring.mul_pos] at this,
      apply this.1, }, },
  have dv : k ∣ n,
  { have : m * k ∣ m * n := hk ▸ (conductor.dvd_lev χ),
    apply (nat.mul_dvd_mul_iff_left mpos).1 this, },
  have hcop' : m.coprime k := nat.coprime.coprime_dvd_right dv hcop,
  obtain ⟨χ₁', χ₂', h'⟩ := eq_mul_primitive_of_coprime S η' _ hcop',
  { have p1 : change_level (mul_dvd_mul_left m dv) η' = χ,
    { rw hη', conv_rhs { rw ← change_level.self χ, rw eq_asso_primitive_character_change_level, },
      rw change_level_cast _ _ hk, },
    rw h at p1, rw h'.2.2 at p1, rw monoid_hom.map_mul at p1,
    rw ← change_level.dvd at p1, rw ← change_level.dvd at p1,
    rw change_level.dvd χ₂' dv (dvd_mul_left n m) at p1,
    have req := mul_change_level_eq_of_coprime S hcop p1,
    rw ← req.1, apply h'.1, },
  rw hη', rw is_primitive_def,
  conv_rhs { rw ← hk, rw ← asso_primitive_conductor_eq, },
  symmetry, congr',
  apply heq.symm,
  apply cast_heq,
end

lemma dvd_mul_of_dvd_conductor (n : ℕ) (hd : d.coprime p) (hχ : d ∣ χ.conductor) :
  d ∣ (χ.mul (teichmuller_character_mod_p' p R ^ n)).conductor :=
begin
  have hm : m ≠ 0,
  { apply ne_zero_of_lt (fact.out _), exact 0, apply_instance, apply_instance, },
  obtain ⟨χ₁, χ₂, hχ₁, h⟩ := eq_mul_of_coprime_of_dvd_conductor R χ hχ
    (nat.coprime.pow_right m hd),
  set ψ := (χ₂ * change_level (dvd_pow_self p hm) ((((units.map ((algebra_map ℚ_[p] R).comp padic_int.coe.ring_hom).to_monoid_hom).comp
    (teichmuller_character_mod_p p) : dirichlet_character _ p)⁻¹)^n : dirichlet_character _ _)),
  { obtain ⟨x, y, hx, hy, h'⟩ := exists_mul_of_dvd' p d R m χ n hd,
    rw h', apply dvd_mul_of_dvd_left,
    rw h at h',
    rw mul_conductor_eq_mul_conductor at h',
    --delta teichmuller_character_mod_p_change_level at h',
    --rw pow_change_level at h',
    rw change_level.dvd _ (dvd_pow_self p hm) (dvd_mul_left (p^m) d) at h',
    rw mul_assoc at h', rw ← monoid_hom.map_mul at h',
    have h'' : (χ₁.mul ψ).conductor = x * y,
    { rw ← h', rw (is_primitive_def _).1 (is_primitive.mul _ _),
      have : lcm d (p^m) = d * p^m,
      { rw lcm_eq_nat_lcm, rw nat.coprime.lcm_eq_mul (nat.coprime.pow_right _ hd), },
      rw change_level.dvd χ₁ (dvd_mul_right _ _) _,
      rw change_level.dvd ψ (dvd_mul_left _ _) _,
      any_goals { rw this },
      rw ← monoid_hom.map_mul,
      congr',
      apply change_level_heq _ this.symm, },
    rw (is_primitive_def _).1 (is_primitive.mul _ _) at h'',
    set η := cast (dirichlet_character_eq_of_eq R h'') (χ₁.mul ψ) with hη',
    haveI : fact (0 < x * y),
    { apply fact_iff.2, by_contra hzero,
      have eq_zero : x * y = 0 := nat.eq_zero_of_not_pos hzero,
      rw eq_zero at h', rw conductor.eq_zero_iff_level_eq_zero at h',
      apply nat.ne_zero_of_lt' 0 h', },
    obtain ⟨χ₁', ψ₁', hη⟩ := eq_mul_of_coprime_lev' R η
      (nat.coprime_of_dvd_of_coprime (nat.coprime.pow_right m hd) hx hy),
    have : change_level (mul_dvd_mul hx hy) η = change_level (dvd_mul_right d (p^m)) χ₁ *
      change_level (dvd_mul_left (p^m) d) ψ,
    { have : change_level (dvd_trans (conductor.dvd_lev _) (nat.lcm_dvd_mul _ _)) (χ₁.mul ψ) =
        change_level (dvd_mul_right d (p^m)) χ₁ * change_level (dvd_mul_left (p^m) d) ψ,
      { rw dirichlet_character.mul, rw ← eq_asso_primitive_character_change_level, rw monoid_hom.map_mul,
        rw ← change_level.dvd, rw ← change_level.dvd, },
      rw [← this, hη', change_level_cast _ _ h''], },
    rw hη at this, rw monoid_hom.map_mul at this,
    rw ← change_level.dvd at this, rw ← change_level.dvd at this,
    rw change_level.dvd _ hx (dvd_mul_right d (p^m)) at this,
    rw change_level.dvd _ hy (dvd_mul_left (p^m) d) at this,
    have req := mul_change_level_eq_of_coprime R (nat.coprime.pow_right m hd) this,
    have := lev_eq_of_primitive R hx hχ₁ req.1,
    rw this, },
end

lemma mul_conductor_comm {m n : ℕ} (χ : dirichlet_character S m) (ψ : dirichlet_character S n) :
  (χ.mul ψ).conductor = (ψ.mul χ).conductor :=
begin
  -- another way to do this using equiv more generally, using lev
  simp_rw (is_primitive_def _).1 (is_primitive.mul _ _),
  rw mul_comm (change_level _ χ) _,
  have : lcm m n = lcm n m := lcm_comm _ _,
  --make separate lemma
  rw change_level.dvd ψ (dvd_lcm_left n m) _,
  rw change_level.dvd χ (dvd_lcm_right n m) _,
  any_goals { rw this },
  rw ←monoid_hom.map_mul,
  congr' 3,
  apply change_level_heq _ this.symm,
end
end dirichlet_character


lemma one_add_le_self (x : mynat) : x ≤ 1 + x :=
begin
-- rw le_iff_exists_add,
use 1,
rw add_comm,
end


abbrev Var := Nat

structure Env (α : Type u) where
  ofInt : Int → α
  add : α → α → α
  mul : α → α → α
  sub : α → α → α
  add_comm  : ∀ a b, add a b = add b a
  add_assoc : ∀ a b c, add (add a b) c = add a (add b c)
  add_zero  : ∀ a, add a (ofInt 0) = a
  mul_comm  : ∀ a b, mul a b = mul b a
  mul_assoc : ∀ a b c, mul (mul a b) c = mul a (mul b c)
  mul_one   : ∀ a, mul a (ofInt 1) = a
  mul_zero  : ∀ a, mul a (ofInt 0) = ofInt 0
  sub_def   : ∀ a b, sub a b = add a (mul (ofInt (-1)) b)
  left_dist : ∀ a b c, mul a (add b c) = add (mul a b) (mul a c)
  ofInt_add : ∀ k₁ k₂, ofInt (k₁ + k₂) = add (ofInt k₁) (ofInt k₂)
  ofInt_mul : ∀ k₁ k₂, ofInt (k₁ * k₂) = mul (ofInt k₁) (ofInt k₂)

theorem Env.zero_add (env : Env α) (a : α) : env.add (env.ofInt 0) a = a := by
  rw [add_comm, add_zero]

theorem Env.add_left_comm (env : Env α) (a b c : α) : env.add a (env.add b c) = env.add b (env.add a c) := by
  rw [← add_assoc, add_comm _ a b, add_assoc]

theorem Env.one_mul (env : Env α) (a : α) : env.mul (env.ofInt 1) a = a := by
  rw [mul_comm, mul_one]

theorem Env.zero_mul (env : Env α) (a : α) : env.mul (env.ofInt 0) a = env.ofInt 0 := by
  rw [mul_comm, mul_zero]

theorem Env.mul_left_comm (env : Env α) (a b c : α) : env.mul a (env.mul b c) = env.mul b (env.mul a c) := by
  rw [← mul_assoc, mul_comm _ a b, mul_assoc]

theorem Env.right_dist (env : Env α) (a b c : α) : env.mul (env.add a b) c = env.add (env.mul a c) (env.mul b c) := by
  rw [mul_comm, left_dist, mul_comm, mul_comm _ b c]

def hugeFuel := 100000000 -- any big number should work

structure Context (α : Type u) extends Env α where
  map : List α

def Var.denote (ctx : Context α) (v : Var) : α :=
  go ctx.map v (ctx.ofInt 0)
where
  go : List α → Nat → α → α
   | [],    i,   d  => d
   | a::as, 0,   d  => a
   | _::as, i+1, d  => go as i d

inductive Expr where
  | num (i : Nat)
  | var (v : Var)
  | add (a b : Expr)
  | mul (a b : Expr)
  | sub (a b : Expr)
  deriving Inhabited

def Expr.denote (ctx : Context α) : Expr → α
  | num n   => ctx.ofInt n
  | var v   => v.denote ctx
  | add a b => ctx.add (a.denote ctx) (b.denote ctx)
  | mul a b => ctx.mul (a.denote ctx) (b.denote ctx)
  | sub a b => ctx.sub (a.denote ctx) (b.denote ctx)

abbrev Mon := List Var

def Mon.denote (ctx : Context α) : Mon → α
  | [] => ctx.ofInt 1
  | v::vs => ctx.mul (v.denote ctx) (denote ctx vs)

def Mon.mul (m₁ m₂ : Mon) : Mon :=
  go hugeFuel m₁ m₂
where
  go (fuel : Nat) (m₁ m₂ : Mon) : Mon :=
    match fuel with
    | 0 => m₁ ++ m₂
    | fuel + 1 =>
      match m₁, m₂ with
      | m₁, [] => m₁
      | [], m₂ => m₂
      | v₁ :: m₁, v₂ :: m₂ =>
        bif Nat.blt v₁ v₂ then
          v₁ :: go fuel m₁ (v₂ :: m₂)
        else bif Nat.blt v₂ v₁ then
          v₂ :: go fuel (v₁ :: m₁) m₂
        else
          v₁ :: v₂ :: go fuel m₁ m₂

abbrev Poly := List (Int × Mon)

def Poly.denote (ctx : Context α) : Poly → α
  | [] => ctx.ofInt 0
  | (k, m) :: p => ctx.add (ctx.mul (ctx.ofInt k) (m.denote ctx)) (denote ctx p)

def Poly.add (p₁ p₂ : Poly) : Poly :=
  go hugeFuel p₁ p₂
where
  go (fuel : Nat) (p₁ p₂ : Poly) : Poly :=
    match fuel with
    | 0 => p₁ ++ p₂
    | fuel + 1 =>
      match p₁, p₂ with
      | p₁, [] => p₁
      | [], p₂ => p₂
      | (k₁, m₁) :: p₁, (k₂, m₂) :: p₂ =>
        bif m₁ < m₂ then
          (k₁, m₁) :: go fuel p₁ ((k₂, m₂) :: p₂)
        else bif m₂ < m₁ then
          (k₂, m₂) :: go fuel ((k₁, m₁) :: p₁) p₂
        else bif k₁ + k₂ == 0 then
          go fuel p₁ p₂
        else
          (k₁ + k₂, m₁) :: go fuel p₁ p₂

def Poly.insertSorted (k : Int) (m : Mon) (p : Poly) : Poly :=
  match p with
  | [] => [(k, m)]
  | (k', m') :: p => bif m < m' then (k, m) :: (k', m') :: p else (k', m') :: insertSorted k m p

def Poly.mulMon (p : Poly) (k : Int) (m : Mon) : Poly :=
  go p []
where
  go (p : Poly) (acc : Poly) : Poly :=
    match p with
    | [] => acc
    | (k', m') :: p => go p (acc.insertSorted (k*k') (m.mul m'))

def Poly.mul (p₁ : Poly) (p₂ : Poly) : Poly :=
  go p₁ []
where
  go (p₁ : Poly) (acc : Poly) : Poly :=
    match p₁ with
    | [] => acc
    | (k, m) :: p₁ => go p₁ (acc.add (p₂.mulMon k m))

def Poly.neg (p : Poly) : Poly :=
  match p with
  | [] => []
  | (k, v) :: p => ((-1)*k, v) :: neg p

def Expr.toPoly : Expr → Poly
  | num k   => bif k == 0 then [] else [(k, [])]
  | var v   => [(1, [v])]
  | add a b => a.toPoly.add b.toPoly
  | mul a b => a.toPoly.mul b.toPoly
  | sub a b => a.toPoly.add b.toPoly.neg
open Env

theorem Mon.append_denote (ctx : Context α) (m₁ m₂ : Mon) : (m₁ ++ m₂).denote ctx = ctx.mul (m₁.denote ctx) (m₂.denote ctx) := by
  match m₁ with
  | [] => simp! [one_mul]
  | v :: m₁ => simp! [append_denote ctx m₁ m₂, mul_assoc]

theorem Mon.mul_denote (ctx : Context α) (m₁ m₂ : Mon) : (m₁.mul m₂).denote ctx = ctx.mul (m₁.denote ctx) (m₂.denote ctx) :=
  go hugeFuel m₁ m₂
where
  go (fuel : Nat) (m₁ m₂ : Mon) : (Mon.mul.go fuel m₁ m₂).denote ctx = ctx.mul (m₁.denote ctx) (m₂.denote ctx) := by
    induction fuel generalizing m₁ m₂ with
    | zero => simp! [append_denote]
    | succ _ ih =>
      simp!
      split <;> simp!
      next => simp! [mul_one]
      next => simp! [one_mul]
      next v₁ m₁ v₂ m₂ =>
        by_cases hlt : Nat.blt v₁ v₂ <;> simp! [hlt, mul_assoc, ih]
        by_cases hgt : Nat.blt v₂ v₁ <;> simp! [hgt, mul_assoc, mul_comm, mul_left_comm, ih]

theorem Poly.append_denote (ctx : Context α) (p₁ p₂ : Poly) : (p₁ ++ p₂).denote ctx = ctx.add (p₁.denote ctx) (p₂.denote ctx) := by
  match p₁ with
  | [] => simp! [zero_add]
  | v :: p₁ => simp! [append_denote _ p₁ p₂, add_assoc]

theorem Poly.add_denote (ctx : Context α) (p₁ p₂ : Poly) : (p₁.add p₂).denote ctx = ctx.add (p₁.denote ctx) (p₂.denote ctx) :=
  go hugeFuel p₁ p₂
where
  go (fuel : Nat) (p₁ p₂ : Poly) : (Poly.add.go fuel p₁ p₂).denote ctx = ctx.add (p₁.denote ctx) (p₂.denote ctx) := by
    induction fuel generalizing p₁ p₂ with
    | zero => simp! [append_denote]
    | succ _ ih =>
      simp!
      split <;> simp!
      next => simp! [add_zero]
      next => simp! [zero_add]
      next k₁ m₁ p₁ k₂ m₂ p₂ =>
        by_cases hlt : m₁ < m₂ <;> simp! [hlt, add_assoc, ih]
        by_cases hgt : m₂ < m₁ <;> simp! [hgt, add_assoc, add_comm, add_left_comm, ih]
        have : m₁ = m₂ := List.le_antisymm hgt hlt
        subst m₂
        by_cases heq : k₁ + k₂ == 0 <;> simp! [heq, ih]
        · rw [← add_assoc, ← right_dist, ← ofInt_add, eq_of_beq heq, zero_mul, zero_add]
        · simp [right_dist, left_dist, add_assoc, add_comm, add_left_comm, ofInt_add]

theorem Poly.denote_insertSorted (ctx : Context α) (k : Int) (m : Mon) (p : Poly) : (p.insertSorted k m).denote ctx = ctx.add (p.denote ctx) (ctx.mul (ctx.ofInt k) (m.denote ctx)) := by
  match p with
  | [] => simp! [add_zero, zero_add]
  | (k', m') :: p =>
    by_cases h : m < m' <;> simp! [h, denote_insertSorted ctx k m p, add_assoc, add_comm, add_left_comm]

theorem Poly.mulMon_denote (ctx : Context α) (p : Poly) (k : Int) (m : Mon) : (p.mulMon k m).denote ctx = ctx.mul (p.denote ctx) (ctx.mul (ctx.ofInt k) (m.denote ctx)) := by
  simp [mulMon, go]; simp! [zero_add]
where
  go (p : Poly) (acc : Poly) : (mulMon.go k m p acc).denote ctx = ctx.add (acc.denote ctx) (ctx.mul (p.denote ctx) (ctx.mul (ctx.ofInt k) (m.denote ctx))) := by
   match p with
   | [] => simp! [zero_mul, add_zero]
   | (k', m') :: p =>
     simp! [go p, ofInt_mul, left_dist, denote_insertSorted, Mon.mul_denote, mul_assoc, mul_comm, mul_left_comm, add_assoc]

theorem Poly.mul_denote (ctx : Context α) (p₁ p₂ : Poly) : (p₁.mul p₂).denote ctx = ctx.mul (p₁.denote ctx) (p₂.denote ctx) := by
  simp [mul, go]; simp! [zero_add]
where
  go (p₁ : Poly) (acc : Poly) : (mul.go p₂ p₁ acc).denote ctx = ctx.add (acc.denote ctx) (ctx.mul (p₁.denote ctx) (p₂.denote ctx)) := by
    match p₁ with
    | [] => simp! [zero_mul, add_zero]
    | (k, m) :: p₁ =>
      simp! [go p₁, right_dist, add_denote, mulMon_denote,
             add_assoc, add_comm, add_left_comm,
             mul_assoc, mul_comm, mul_left_comm]

theorem Poly.neg_denote (ctx : Context α) (p : Poly) : p.neg.denote ctx = ctx.mul (ctx.ofInt (-1)) (p.denote ctx) := by
  match p with
  | [] => simp! [mul_zero]
  | (k, m) :: p => simp! [left_dist, ofInt_mul, neg_denote ctx p, mul_assoc, mul_comm, mul_left_comm]

theorem Expr.toPoly_denote (ctx : Context α) (e : Expr) : e.toPoly.denote ctx = e.denote ctx := by
  induction e with
  | num k =>
    simp!; by_cases h : k == 0 <;> simp! [*]
    · simp [eq_of_beq h]; rfl
    · simp [mul_one, add_zero]
  | var v => simp! [mul_one, one_mul, add_zero]
  | add a b => simp! [Poly.add_denote, *]
  | mul a b => simp! [Poly.mul_denote, *]
  | sub a b => simp! [Poly.add_denote, *, sub_def, Poly.neg_denote, mul_one, mul_comm]

theorem Expr.eq_of_toPoly_eq (ctx : Context α) (a b : Expr) (h : a.toPoly == b.toPoly) : a.denote ctx = b.denote ctx := by
  have h := congrArg (Poly.denote ctx) (eq_of_beq h)
  simp [toPoly_denote] at h
  assumption

def ex1 : Expr := .mul (.add (.var 0) (.var 1)) (.add (.add (.var 0) (.var 1)) (.num 1))
def ex2 : Expr := .add (.mul (.var 0) (.add (.add (.num 1) (.var 1)) (.var 0)))
                       (.mul (.add (.add (.var 1) (.num 1)) (.var 0)) (.var 1))

#eval Expr.toPoly ex1
#eval Expr.toPoly ex2


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_400
  (x : ℝ)
  (h₀ : 5 + 500 / 100 * 10 = 110 / 100 * x) :
  x = 50 :=
begin
  linarith,
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.fiber_bundle.is_homeomorphic_trivial_bundle
! leanprover-community/mathlib commit be2c24f56783935652cefffb4bfca7e4b25d167e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Homeomorph

/-!
# Maps equivariantly-homeomorphic to projection in a product

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file contains the definition `is_homeomorphic_trivial_fiber_bundle F p`, a Prop saying that a
map `p : Z → B` between topological spaces is a "trivial fiber bundle" in the sense that there
exists a homeomorphism `h : Z ≃ₜ B × F` such that `proj x = (h x).1`.  This is an abstraction which
is occasionally convenient in showing that a map is open, a quotient map, etc.

This material was formerly linked to the main definition of fiber bundles, but after a series of
refactors, there is no longer a direct connection.
-/

variable {B : Type _} (F : Type _) {Z : Type _} [TopologicalSpace B] [TopologicalSpace F]
  [TopologicalSpace Z]

#print IsHomeomorphicTrivialFiberBundle /-
/-- A trivial fiber bundle with fiber `F` over a base `B` is a space `Z`
projecting on `B` for which there exists a homeomorphism to `B × F` that sends `proj`
to `prod.fst`. -/
def IsHomeomorphicTrivialFiberBundle (proj : Z → B) : Prop :=
  ∃ e : Z ≃ₜ B × F, ∀ x, (e x).1 = proj x
#align is_homeomorphic_trivial_fiber_bundle IsHomeomorphicTrivialFiberBundle
-/

namespace IsHomeomorphicTrivialFiberBundle

variable {F} {proj : Z → B}

/- warning: is_homeomorphic_trivial_fiber_bundle.proj_eq -> IsHomeomorphicTrivialFiberBundle.proj_eq is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} {F : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u3} Z] {proj : Z -> B}, (IsHomeomorphicTrivialFiberBundle.{u1, u2, u3} B F Z _inst_1 _inst_2 _inst_3 proj) -> (Exists.{max (succ u3) (succ (max u1 u2))} (Homeomorph.{u3, max u1 u2} Z (Prod.{u1, u2} B F) _inst_3 (Prod.topologicalSpace.{u1, u2} B F _inst_1 _inst_2)) (fun (e : Homeomorph.{u3, max u1 u2} Z (Prod.{u1, u2} B F) _inst_3 (Prod.topologicalSpace.{u1, u2} B F _inst_1 _inst_2)) => Eq.{max (succ u3) (succ u1)} (Z -> B) proj (Function.comp.{succ u3, max (succ u1) (succ u2), succ u1} Z (Prod.{u1, u2} B F) B (Prod.fst.{u1, u2} B F) (coeFn.{max (succ u3) (succ (max u1 u2)), max (succ u3) (succ (max u1 u2))} (Homeomorph.{u3, max u1 u2} Z (Prod.{u1, u2} B F) _inst_3 (Prod.topologicalSpace.{u1, u2} B F _inst_1 _inst_2)) (fun (_x : Homeomorph.{u3, max u1 u2} Z (Prod.{u1, u2} B F) _inst_3 (Prod.topologicalSpace.{u1, u2} B F _inst_1 _inst_2)) => Z -> (Prod.{u1, u2} B F)) (Homeomorph.hasCoeToFun.{u3, max u1 u2} Z (Prod.{u1, u2} B F) _inst_3 (Prod.topologicalSpace.{u1, u2} B F _inst_1 _inst_2)) e))))
but is expected to have type
  forall {B : Type.{u3}} {F : Type.{u2}} {Z : Type.{u1}} [_inst_1 : TopologicalSpace.{u3} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u1} Z] {proj : Z -> B}, (IsHomeomorphicTrivialFiberBundle.{u3, u2, u1} B F Z _inst_1 _inst_2 _inst_3 proj) -> (Exists.{max (max (succ u3) (succ u2)) (succ u1)} (Homeomorph.{u1, max u2 u3} Z (Prod.{u3, u2} B F) _inst_3 (instTopologicalSpaceProd.{u3, u2} B F _inst_1 _inst_2)) (fun (e : Homeomorph.{u1, max u2 u3} Z (Prod.{u3, u2} B F) _inst_3 (instTopologicalSpaceProd.{u3, u2} B F _inst_1 _inst_2)) => Eq.{max (succ u3) (succ u1)} (Z -> B) proj (Function.comp.{succ u1, max (succ u2) (succ u3), succ u3} Z (Prod.{u3, u2} B F) B (Prod.fst.{u3, u2} B F) (FunLike.coe.{max (succ u1) (succ (max u3 u2)), succ u1, succ (max u3 u2)} (Homeomorph.{u1, max u3 u2} Z (Prod.{u3, u2} B F) _inst_3 (instTopologicalSpaceProd.{u3, u2} B F _inst_1 _inst_2)) Z (fun (_x : Z) => Prod.{u3, u2} B F) (EmbeddingLike.toFunLike.{max (succ u1) (succ (max u3 u2)), succ u1, succ (max u3 u2)} (Homeomorph.{u1, max u3 u2} Z (Prod.{u3, u2} B F) _inst_3 (instTopologicalSpaceProd.{u3, u2} B F _inst_1 _inst_2)) Z (Prod.{u3, u2} B F) (EquivLike.toEmbeddingLike.{max (succ u1) (succ (max u3 u2)), succ u1, succ (max u3 u2)} (Homeomorph.{u1, max u3 u2} Z (Prod.{u3, u2} B F) _inst_3 (instTopologicalSpaceProd.{u3, u2} B F _inst_1 _inst_2)) Z (Prod.{u3, u2} B F) (Homeomorph.instEquivLikeHomeomorph.{u1, max u3 u2} Z (Prod.{u3, u2} B F) _inst_3 (instTopologicalSpaceProd.{u3, u2} B F _inst_1 _inst_2)))) e))))
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle.proj_eq IsHomeomorphicTrivialFiberBundle.proj_eqₓ'. -/
protected theorem proj_eq (h : IsHomeomorphicTrivialFiberBundle F proj) :
    ∃ e : Z ≃ₜ B × F, proj = Prod.fst ∘ e :=
  ⟨h.some, (funext h.choose_spec).symm⟩
#align is_homeomorphic_trivial_fiber_bundle.proj_eq IsHomeomorphicTrivialFiberBundle.proj_eq

/- warning: is_homeomorphic_trivial_fiber_bundle.surjective_proj -> IsHomeomorphicTrivialFiberBundle.surjective_proj is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} {F : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u3} Z] {proj : Z -> B} [_inst_4 : Nonempty.{succ u2} F], (IsHomeomorphicTrivialFiberBundle.{u1, u2, u3} B F Z _inst_1 _inst_2 _inst_3 proj) -> (Function.Surjective.{succ u3, succ u1} Z B proj)
but is expected to have type
  forall {B : Type.{u2}} {F : Type.{u3}} {Z : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} B] [_inst_2 : TopologicalSpace.{u3} F] [_inst_3 : TopologicalSpace.{u1} Z] {proj : Z -> B} [_inst_4 : Nonempty.{succ u3} F], (IsHomeomorphicTrivialFiberBundle.{u2, u3, u1} B F Z _inst_1 _inst_2 _inst_3 proj) -> (Function.Surjective.{succ u1, succ u2} Z B proj)
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle.surjective_proj IsHomeomorphicTrivialFiberBundle.surjective_projₓ'. -/
/-- The projection from a trivial fiber bundle to its base is surjective. -/
protected theorem surjective_proj [Nonempty F] (h : IsHomeomorphicTrivialFiberBundle F proj) :
    Function.Surjective proj := by
  obtain ⟨e, rfl⟩ := h.proj_eq
  exact prod.fst_surjective.comp e.surjective
#align is_homeomorphic_trivial_fiber_bundle.surjective_proj IsHomeomorphicTrivialFiberBundle.surjective_proj

/- warning: is_homeomorphic_trivial_fiber_bundle.continuous_proj -> IsHomeomorphicTrivialFiberBundle.continuous_proj is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} {F : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u3} Z] {proj : Z -> B}, (IsHomeomorphicTrivialFiberBundle.{u1, u2, u3} B F Z _inst_1 _inst_2 _inst_3 proj) -> (Continuous.{u3, u1} Z B _inst_3 _inst_1 proj)
but is expected to have type
  forall {B : Type.{u3}} {F : Type.{u2}} {Z : Type.{u1}} [_inst_1 : TopologicalSpace.{u3} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u1} Z] {proj : Z -> B}, (IsHomeomorphicTrivialFiberBundle.{u3, u2, u1} B F Z _inst_1 _inst_2 _inst_3 proj) -> (Continuous.{u1, u3} Z B _inst_3 _inst_1 proj)
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle.continuous_proj IsHomeomorphicTrivialFiberBundle.continuous_projₓ'. -/
/-- The projection from a trivial fiber bundle to its base is continuous. -/
protected theorem continuous_proj (h : IsHomeomorphicTrivialFiberBundle F proj) : Continuous proj :=
  by
  obtain ⟨e, rfl⟩ := h.proj_eq
  exact continuous_fst.comp e.continuous
#align is_homeomorphic_trivial_fiber_bundle.continuous_proj IsHomeomorphicTrivialFiberBundle.continuous_proj

/- warning: is_homeomorphic_trivial_fiber_bundle.is_open_map_proj -> IsHomeomorphicTrivialFiberBundle.isOpenMap_proj is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} {F : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u3} Z] {proj : Z -> B}, (IsHomeomorphicTrivialFiberBundle.{u1, u2, u3} B F Z _inst_1 _inst_2 _inst_3 proj) -> (IsOpenMap.{u3, u1} Z B _inst_3 _inst_1 proj)
but is expected to have type
  forall {B : Type.{u3}} {F : Type.{u2}} {Z : Type.{u1}} [_inst_1 : TopologicalSpace.{u3} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u1} Z] {proj : Z -> B}, (IsHomeomorphicTrivialFiberBundle.{u3, u2, u1} B F Z _inst_1 _inst_2 _inst_3 proj) -> (IsOpenMap.{u1, u3} Z B _inst_3 _inst_1 proj)
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle.is_open_map_proj IsHomeomorphicTrivialFiberBundle.isOpenMap_projₓ'. -/
/-- The projection from a trivial fiber bundle to its base is open. -/
protected theorem isOpenMap_proj (h : IsHomeomorphicTrivialFiberBundle F proj) : IsOpenMap proj :=
  by
  obtain ⟨e, rfl⟩ := h.proj_eq
  exact is_open_map_fst.comp e.is_open_map
#align is_homeomorphic_trivial_fiber_bundle.is_open_map_proj IsHomeomorphicTrivialFiberBundle.isOpenMap_proj

/- warning: is_homeomorphic_trivial_fiber_bundle.quotient_map_proj -> IsHomeomorphicTrivialFiberBundle.quotientMap_proj is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} {F : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F] [_inst_3 : TopologicalSpace.{u3} Z] {proj : Z -> B} [_inst_4 : Nonempty.{succ u2} F], (IsHomeomorphicTrivialFiberBundle.{u1, u2, u3} B F Z _inst_1 _inst_2 _inst_3 proj) -> (QuotientMap.{u3, u1} Z B _inst_3 _inst_1 proj)
but is expected to have type
  forall {B : Type.{u2}} {F : Type.{u3}} {Z : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} B] [_inst_2 : TopologicalSpace.{u3} F] [_inst_3 : TopologicalSpace.{u1} Z] {proj : Z -> B} [_inst_4 : Nonempty.{succ u3} F], (IsHomeomorphicTrivialFiberBundle.{u2, u3, u1} B F Z _inst_1 _inst_2 _inst_3 proj) -> (QuotientMap.{u1, u2} Z B _inst_3 _inst_1 proj)
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle.quotient_map_proj IsHomeomorphicTrivialFiberBundle.quotientMap_projₓ'. -/
/-- The projection from a trivial fiber bundle to its base is open. -/
protected theorem quotientMap_proj [Nonempty F] (h : IsHomeomorphicTrivialFiberBundle F proj) :
    QuotientMap proj :=
  h.isOpenMap_proj.to_quotientMap h.continuous_proj h.surjective_proj
#align is_homeomorphic_trivial_fiber_bundle.quotient_map_proj IsHomeomorphicTrivialFiberBundle.quotientMap_proj

end IsHomeomorphicTrivialFiberBundle

/- warning: is_homeomorphic_trivial_fiber_bundle_fst -> isHomeomorphicTrivialFiberBundle_fst is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} (F : Type.{u2}) [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F], IsHomeomorphicTrivialFiberBundle.{u1, u2, max u1 u2} B F (Prod.{u1, u2} B F) _inst_1 _inst_2 (Prod.topologicalSpace.{u1, u2} B F _inst_1 _inst_2) (Prod.fst.{u1, u2} B F)
but is expected to have type
  forall {B : Type.{u2}} (F : Type.{u1}) [_inst_1 : TopologicalSpace.{u2} B] [_inst_2 : TopologicalSpace.{u1} F], IsHomeomorphicTrivialFiberBundle.{u2, u1, max u2 u1} B F (Prod.{u2, u1} B F) _inst_1 _inst_2 (instTopologicalSpaceProd.{u2, u1} B F _inst_1 _inst_2) (Prod.fst.{u2, u1} B F)
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle_fst isHomeomorphicTrivialFiberBundle_fstₓ'. -/
/-- The first projection in a product is a trivial fiber bundle. -/
theorem isHomeomorphicTrivialFiberBundle_fst :
    IsHomeomorphicTrivialFiberBundle F (Prod.fst : B × F → B) :=
  ⟨Homeomorph.refl _, fun x => rfl⟩
#align is_homeomorphic_trivial_fiber_bundle_fst isHomeomorphicTrivialFiberBundle_fst

/- warning: is_homeomorphic_trivial_fiber_bundle_snd -> isHomeomorphicTrivialFiberBundle_snd is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u1}} (F : Type.{u2}) [_inst_1 : TopologicalSpace.{u1} B] [_inst_2 : TopologicalSpace.{u2} F], IsHomeomorphicTrivialFiberBundle.{u1, u2, max u2 u1} B F (Prod.{u2, u1} F B) _inst_1 _inst_2 (Prod.topologicalSpace.{u2, u1} F B _inst_2 _inst_1) (Prod.snd.{u2, u1} F B)
but is expected to have type
  forall {B : Type.{u2}} (F : Type.{u1}) [_inst_1 : TopologicalSpace.{u2} B] [_inst_2 : TopologicalSpace.{u1} F], IsHomeomorphicTrivialFiberBundle.{u2, u1, max u2 u1} B F (Prod.{u1, u2} F B) _inst_1 _inst_2 (instTopologicalSpaceProd.{u1, u2} F B _inst_2 _inst_1) (Prod.snd.{u1, u2} F B)
Case conversion may be inaccurate. Consider using '#align is_homeomorphic_trivial_fiber_bundle_snd isHomeomorphicTrivialFiberBundle_sndₓ'. -/
/-- The second projection in a product is a trivial fiber bundle. -/
theorem isHomeomorphicTrivialFiberBundle_snd :
    IsHomeomorphicTrivialFiberBundle F (Prod.snd : F × B → B) :=
  ⟨Homeomorph.prodComm _ _, fun x => rfl⟩
#align is_homeomorphic_trivial_fiber_bundle_snd isHomeomorphicTrivialFiberBundle_snd