import number_theory.padics.padic_integers

--OUTPUT 1
theorem padic_unit {p : ℕ} (hp: p.prime) {x : ℕ} (hx : gcd x p = 1) : (padic_int p) x = 1 :=
begin
  obtain ⟨y, hy⟩ : ∃ (y : ℕ), p * y = x, from (hp.not_dvd_iff_coprime).mp hx,
  have h1 : (padic_int p) x = (padic_int p) (p * y), from by obviously,
  have h2 : (padic_int p) (p * y) = (padic_int p) p + (padic_int p) y, from by obviously,
  have h3 : (padic_int p) p + (padic_int p) y = (padic_int p) p + 0, from by obviously,
  have h4 : ∀ x : ℕ, (padic_int p) x = 0 → x = 0, from by {
    assume x : ℕ,
    assume h : (padic_int p) x = 0,
    by_contradiction hnot : x ≠ 0,
    have h5 : (padic_int p) x = (padic_int p) x + 0, from by obviously,
    have h6 : (padic_int p) x = (padic_int p) x + (padic_int p) 0, from by obviously,
    have h7 : p ∣ x, from by {
      apply (padic_int.eq_pow_iff_dvd).mpr,
      exact eq.trans (eq.symm h5) (eq.trans h6 h3),
    },
    have h8 : p ∣ 0, from by {
      have h9 : (padic_int p) 0 = 0, from by obviously,
      have h10 : (padic_int p) 0 = (padic_int p) x + (padic_int p) 0, from by obviously,
      rw ← h9 at h10,
      rw h5 at h10,
      have h11 : (padic_int p) x + 0 = (padic_int p) x + (padic_int p) x, from by obviously,
      have h12 : (padic_int p) x = (padic_int p) x + (padic_int p) x, from by {
        have h13 : (padic_int p) x + 0 = (padic_int p) x, from by obviously,
        have h14 : (padic_int p) x = (padic_int p) x + 0, from by obviously,
        exact eq.trans (eq.symm h14) h13,
      },
      exact eq.trans h10 h12,
    },
    have h9 : p = 0, from by {
      have h10 : p ≠ 0, from by obviously,
      have h11 : p ∣ 0, from h8,
      exact (nat.dvd_zero_iff).mp h11 h10,
    },
    exact absurd h9 dec_trivial,
  },
  have h5 : (padic_int p) p = 0, from h4 p (nat.eq_zero_of_mul_eq_zero (by obviously)),
  have h6 : p = 0, from h4 p h5,
  exact absurd h6 dec_trivial,
end

--OUTPUT 2
theorem p_adic_unit (p n : ℕ) : p.prime → coprime n p →
  ∃ a, (a : ℤ/p) = n :=
begin
  assume hprime hcoprime,
  have h0 : n < p, from nat.lt_of_le_of_ne (prime.not_dvd_one hprime) (by rw coprime_iff_not_dvd at hcoprime; assumption),
  have h1 : (n : ℤ/p) = n, from rat.cast_zero_iff.mpr h0,
  use (n : ℤ/p),
  exact h1,
end

--OUTPUT 3
theorem padic_units (x : ℤ) (p : ℕ) (hp : prime p) : coprime x p → ∃ (y : ℤ), y * x = 1 :=
begin
    assume hcoprime,
    cases exists_eq_mul_left_of_dvd (dvd_mul_of_dvd_left (not_coprime.eq_one_and_dvd.right hcoprime)) with y hy,
    rw ←hy at hcoprime,
    have hpdvd : p ∣ x := by {
        have h : p ∣ (p * y), from hp.dvd_mul_of_dvd_left hcoprime,
        exact dvd_trans hcoprime h
    },
    have hpnorm : (∀ (n : ℕ), n ≤ norm_nat p → ∀ (y : ℕ) (z : ℤ), (z % (p ^ n)) = y → y < p ^ n) := padic_int.norm_nat_eq_pow_nat_dvd hp,
    have hnorm : norm_nat p < p ^ 1 := by {
      apply hpnorm 1, apply le_refl,
      apply mod_mod_cancel,
    },
    have hp1 : p = 1 := by {
        revert hnorm, revert hp, have h : ∀ (p : ℕ), prime p → p = 1 → p < p ^ 1, intro p, exact
        begin
            intros hp hpeq,
            have hprime : prime (p ^ 1) := pow_prime hp,
            have hh : (p * 1) < 1 := by {rw ←hpeq, exact mul_lt_mul_of_pos_right hp.pos hnorm},
            have hh1 : (p ^ 1) < (p ^ 1) := by {rw ←hpeq, exact mul_lt_mul_of_pos_right hnorm.symm (pow_pos hp.pos zero_lt_one)},
            apply ne_of_lt (lt_of_mul_lt_mul_left hh1 hh),
            exact pow_ne_zero (nat.pos_of_ne_zero hprime.ne_one) one,
        end,
        apply h p hp,
    },
    have hz : z ≠ 0 := by {
        intro hzeq,
        rw [hzeq, nat.zero_mod, nat.zero_pow] at hcoprime,
        have h1 : 1 * (1 : ℤ) = x, from hcoprime,
        exact nat.prime.eq_one_of_dvd hp (eq.symm (nat.coe_dvd_iff_mod_eq_zero.mpr (ne_of_lt hnorm))).symm,
    },
    have hz1 : z = 1, from eq_one_of_mul_eq_one_right hz,
    existsi 1,
    rw ←hy,
    rw ←hz1,
    show y * 1 = (1 : ℤ), by apply mul_one,
end

--OUTPUT 4
theorem p_adic_units (p : ℕ) (hp : prime p) (x : ℕ) (hx : nat.coprime x p) : is_unit (int.nat_abs x : ℤp) :=
begin
  typify! (int.nat_abs x : ℤp),
  cases hx,
  --Assuming that $x$ is not a unit of $\mathbb{Z}_p$
  assume : ¬is_unit(int.nat_abs x : ℤp),
  --Since $x$ is not a unit of $\mathbb{Z}_p$, we know that $\Vert x \Vert \neq 1$
  have h_not_unit : (int.nat_abs x : ℤp)^2 ≠ 1, from
    ne_of_not_is_unit this,
  have h_norm : (int.nat_abs x : ℤp)^2 = (int.norm (int.nat_abs x)) * ((int.nat_abs x): ℤp), from
    int.norm_pow hp 2 (int.nat_abs x),
  have h_norm_2 : (int.nat_abs x : ℤp)^2 = (nat.gcd (int.nat_abs x) p : ℤp), from
    int.norm_eq_gcd_of_prime hp (int.nat_abs x),
  have h_norm_3 : (int.nat_abs x : ℤp)^2 = p, from
    eq.trans (eq.symm h_norm_2) hx_right,
  have h_gcd : ((int.nat_abs x): ℤp)^2 ≠ p, from
    funext (int.nat_abs x) h_norm_3 h_not_unit,
  have h_gcd_2 : ((int.nat_abs x): ℤp)^2 ≠ (p : ℤp), from
    funext (int.nat_abs x) h_norm_3 h_not_unit,
  have h_ne_1 : (int.norm (int.nat_abs x)) ≠ 1, from
    funext (int.nat_abs x) h_norm_3 h_not_unit,
  have h_lt : (int.norm (int.nat_abs x)) < 1, from
    not_le_of_lt (int.norm_lt hp (int.nat_abs x)) (int.norm_le hp (int.nat_abs x)),
  have h_ge : (int.norm (int.nat_abs x)) ≥ 0, from
    pow_nonneg (int.norm_nonneg hp (int.nat_abs x)) zero_le_one,
  have h_lt_2: (int.norm (int.nat_abs x)) = 0, from
    zero_eq_one_or_lt_of_le h_ge h_lt,
  have h_eq : (int.norm (int.nat_abs x)) = p, from
    eq.trans (eq.symm h_norm_2) hx_right,
  have h_eq_2 : (int.norm (int.nat_abs x)) = (p : ℤp), from
    eq.trans (eq.symm h_norm_2) hx_right,
  have h_dvd_p : p ∣ int.nat_abs x, from
    nat.prime.dvd_of_not_coprime hp hx,

  --Since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$
  have h_lt_lt : (int.norm (int.nat_abs x)) < 1, from
    ne_of_gt (int.norm_lt hp (int.nat_abs x)) h_ne_1,
  have h_lt_lt_2 : (int.norm (int.nat_abs x)) = 0, from
    zero_eq_one_or_lt_of_le (pow_nonneg (int.norm_nonneg hp (int.nat_abs x)) zero_le_one) h_lt_lt,

  --Thus $\Vert x \Vert = p$
  have h_norm : (int.norm (int.nat_abs x)) = p, from
    eq.trans (eq.symm h_norm_2) hx_right,
  have h_norm_2 : (int.norm (int.nat_abs x)) = (p : ℤp), from
    eq.trans (eq.symm h_norm_2) hx_right,

  --Thus $p \vert x$
  have h_dvd_p : p ∣ int.nat_abs x, from
    nat.prime.dvd_of_not_coprime hp hx,

  --A contradiction
  have h_contradiction : ¬(int.norm (int.nat_abs x)) = p, from
    nat.prime.not_dvd_one hp,
  have h_contradiction : ¬(int.norm (int.nat_abs x)) = (p : ℤp), from
    nat.prime.not_dvd_one hp,
  show false, from absurd (eq.trans (eq.symm h_norm_2) hx_right) (nat.prime.not_dvd_one hp),
end

--OUTPUT 5
theorem p_adic_units {p : ℕ} (hp : p.prime) {x : ℕ} (hx : gcd x p = 1) : x ∈ units (ℤ/p) :=
by {intro, simp, rw nat.cast_eq_zero_iff,exact pos_of_dvd_of_ne_one (hp.pos) (ne_of_gcd_ne_one_left hx)}

#check p_adic_units

end

--OUTPUT 6
theorem p_adic_units {p : ℕ} (prime_p : prime p) (x : ℕ) : coprime p x → is_unit (p_adic_int.norm p x) →
  is_unit (p_adic_int.of_nat p x) := sorry

/--`theorem`
Subgroup of Group is Closed Under Inverse
Let $\struct {G, \circ}$ be a group.
Let $H \subseteq G$ be a subgroup of $G$.
Then $H$ is closed under inversion.
`proof`
Let $H \subseteq G$ be a subgroup of $G$.

Then by definition, $H$ is a group and $H \subseteq G$.

Thus, $\forall x \in H$, $x$ has an inverse $x^{-1} \in G$.

From $H$ is a subgroup of $G$ and $x^{-1} \in G$, $x^{-1} \in H$.

Thus $H$ is closed under inversion.
{{qed}}
-/
theorem subgroup_inverse_closed {G : Type*} [group G] {H : set G} (hH : is_subgroup H) : ∀ {x : G}, x ∈ H → x⁻¹ ∈ H :=
begin
  assume (x : G) (hx : x ∈ H),

  have h1 : is_group H, from subgroup.is_group hH,
  have h2 : x⁻¹ ∈ G, from group.inv_mem x h1.1,
  have h3 : x⁻¹ ∈ H, from hH.1 (group.inv_mem x h1.1),
  show x⁻¹ ∈ H, from h3,
end

--OUTPUT 7
theorem units_in_p_adic_are_coprime (p x : ℕ) (hp_prime : prime p) (hx_nprime : nat.gcd p x = 1) : nat.units (padic_int.of_nat p x) :=
begin
  have hne : ∀ x : ℕ, (nat.units x) = ¬(x = 0), from
    assume x : ℕ,
    begin
      cases x,
      unfold units,
      unfold nat.units,
      simp,
      unfold units,
      unfold nat.units,
      simp,
    end,

  have hp_dvd_x : p ∣ (x), from (assume hp_dn_x : ¬(p ∣ x), by {
    simp at hx_nprime,
    have h_nunits : ¬((padic_int.of_nat p x).val = 0), from by {simpa},
    have h_units : (padic_int.of_nat p x).val = 0, from by {rw hne, assumption}, contradiction,
  }),

  have hp_ne_0 : p ≠ 0, from by {
    intro hp_0,
    simp at hp_dvd_x,
    have h_units : (padic_int.of_nat p x).val = 0, from by {rw [(eq_comm p 0),hp_0], simp},
    have h_nunits : ¬((padic_int.of_nat p x).val = 0), from by {simpa},
    contradiction,
  },

  have hp_ne_1 : p ≠ 1, from by {
    intro hp_1,
    rw [hp_1] at hp_dvd_x,
    have h_units : (padic_int.of_nat p x).val = 0, from by {rw [(eq_comm p 1),hp_1], simp},
    have h_nunits : ¬((padic_int.of_nat p x).val = 0), from by {simpa},
    contradiction,
  },

  have hpa1 : padic_int.norm (padic_int.of_nat p x) = 1, from by {
    simp,
    have h_non_units : (padic_int.of_nat p x).val = 0, from by {
      simp at hp_dvd_x,
      rw [hp_ne_0] at hp_dvd_x,
      rw [hp_ne_1] at hp_dvd_x,
      have h_dvd_1 : (padic_int.of_nat p x).val ∣ 1, from by {
        have hx_dvd_k : ∃ (k : ℕ), x = k*p, from by {use 1, exact hp_dvd_x},
        cases hx_dvd_k with k hk,
        have hmx_dvd_k : ∃ (k : ℕ), -x = k*p, from by {use -1, exact eq.symm hp_dvd_x},
        cases hmx_dvd_k with m hm,
        have hk_ne_0 : k ≠ 0, from by {
          intro hk_0,
          rw [hk_0] at hk,
          simp at hk,
          have hx_0 : x = 0, from by {rw [mul_zero] at hk, simpa},
          have hx_1 : x = 1, from by simp at hx_nprime,
          rw [hx_0,hx_1] at hx_nprime,
          simp at hx_nprime,
          contradiction,
        },
        rw [prime.dvd_iff_mod_eq_zero hp_prime hk_ne_0] at hp_dvd_x,
        have hx_non_div_p : ¬(x ∣ p), from by {
          intro hx_dvd_p,
          rw [prime.dvd_iff_mod_eq_zero hp_prime hx_nprime] at hx_dvd_p,
          have hp_0 : p = 0, from by {rw [mod_eq_zero hx_dvd_p], simp,},
          contradiction,
        },
        have hk_non_div_p : ¬(k ∣ p), from by {
          intro hk_dvd_p,
          have hx_dvd_p : x ∣ p, from by {exact dvd_mul_left x k,},
          exact hx_non_div_p hx_dvd_p,
        },
        have hm_ne_0 : m ≠ 0, from by {
          intro hm_0,
          rw [hm_0] at hm,
          simp at hm,
          have hx_0 : x = 0, from by {rw [mul_zero] at hm, simpa,},
          have hx_1 : x = 1, from by {simp at hx_nprime,},
          rw [hx_0,hx_1] at hx_nprime,
          contradiction,
        },
        rw [prime.dvd_iff_mod_eq_zero hp_prime hm_ne_0] at hp_dvd_x,
        have hm_non_div_p : ¬(m ∣ p), from by {
          intro hm_dvd_p,
          have hx_dvd_p : x ∣ p, from by {exact dvd_mul_left x m,},
          exact hx_non_div_p hx_dvd_p,
        },
        simp at hp_dvd_x,
        rw [(mod_eq_zero hp_dvd_x)] at hp_dvd_x,
        have hm_0 : m = 0, from by simp at hp_dvd_x,
        have hk_0 : k = 0, from by simp at hp_dvd_x,
        have hx_0 : x = 0, from by simp [hm_0,hk_0,mul_zero],
        have hx_1 : x = 1, from by simp at hx_nprime,
        rw [hx_0,hx_1] at hx_nprime,
        simp at hx_nprime,
        contradiction,
      },
      have hval_1 : (padic_int.of_nat p x).val = 1, from by simp,
      have h_units : (padic_int.of_nat p x).val = 0, from by {rw [h_dvd_1], simp,},
      have h_nunits : ¬((padic_int.of_nat p x).val = 0), from by simpa,
      contradiction,
    },
    rw [h_non_units],
    simp,
  },
  simp at hpa1,
  exact hpa1,
end

--OUTPUT 8
theorem p_adic_units (p : ℕ) (x : ℕ) (h : gcd p x = 1) (hp : prime p) :
norm x = 1 :=
begin
  sorry,
end

--OUTPUT 9
theorem p_adic_units (p : ℕ) (hp : prime p) (x : ℕ) (hx : (gcd x p) = 1) : (∀ y : ℕ, x*y = 1 → y = 0) :=
begin
    assume y : ℕ,
    assume h : x*y = 1,
    have h1 : ∀ n : ℕ, n ∣ x → n ∣ y → n ∣ 1, from sorry,
    have h2 : ∀ n : ℕ, n ∣ p → n ∣ x → n ∣ 1, from sorry,
    have h3 : ∀ n : ℕ, n ∣ p → n ∣ y → n ∣ 1, from sorry,
    have h4 : ∀ q : ℕ, q ∣ p → q ∣ y → q ∣ 1, from sorry,
    have h5 : p ∣ y, from sorry,
    have h6 : ¬p ∣ y, from sorry,
    exact sorry,
end

--OUTPUT 10
theorem p_adic_units (p : nat) (Hp : p.prime) (x : ℕ) (Hx : x.coprime p) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  have : (x : ℤ_[p]).norm ≠ 1, from by {
    intro H,
    have : x.gcd p = 1, from by {
      have : x.gcd p = (x : ℤ_[p]).norm, by {
        rw nat.gcd_eq_nat_cast_norm_mul (x : ℤ_[p]).val,
        ring, },
      rw H,
      refl, },
    show false, from Hx ⟨this, rfl⟩, },
  have Hdist : x.gcd p ≠ 1, from by {
    have := @eq.refl _ ((x : ℤ_[p]).norm),
    rw ←nat.norm_eq_nat_cast_val at this,
    intro H,
    exact this ((x : ℤ_[p]).val.gcd p) H ‹(x : ℤ_[p]).norm ≠ 1›, },
  show (x : ℤ_[p]) ∈ units ℤ_[p], from by {
    apply units.intro,
    rw ←nat.cast_one,
    exact nat.eq_one_of_prime_pow_one Hp (x : ℤ_[p]).val,
  },
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`
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 data.real.basic
import data.real.nnreal

theorem exo:
  let P (a b c N: nnreal) := N = (a^2+b^2)/(c^2+a*b)+(b^2+c^2)/(a^2+b*c)+(c^2+a^2)/(b^2+c*a) in
  (forall a b c N, P a b c N ->  N >= 3) /\ (exists a b c N, P a b c N /\ N = 3)
:=
  sorry


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johan Commelin, Bhavik Mehta
-/
import category_theory.natural_isomorphism

/-!
# Comma categories

A comma category is a construction in category theory, which builds a category out of two functors
with a common codomain. Specifically, for functors `L : A ⥤ T` and `R : B ⥤ T`, an object in
`comma L R` is a morphism `hom : L.obj left ⟶ R.obj right` for some objects `left : A` and
`right : B`, and a morphism in `comma L R` between `hom : L.obj left ⟶ R.obj right` and
`hom' : L.obj left' ⟶ R.obj right'` is a commutative square

```
L.obj left   ⟶   L.obj left'
      |               |
  hom |               | hom'
      ↓               ↓
R.obj right  ⟶   R.obj right',
```

where the top and bottom morphism come from morphisms `left ⟶ left'` and `right ⟶ right'`,
respectively.

## Main definitions

* `comma L R`: the comma category of the functors `L` and `R`.
* `over X`: the over category of the object `X` (developed in `over.lean`).
* `under X`: the under category of the object `X` (also developed in `over.lean`).
* `arrow T`: the arrow category of the category `T` (developed in `arrow.lean`).

## References

* <https://ncatlab.org/nlab/show/comma+category>

## Tags

comma, slice, coslice, over, under, arrow
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃
variables {A : Type u₁} [category.{v₁} A]
variables {B : Type u₂} [category.{v₂} B]
variables {T : Type u₃} [category.{v₃} T]

/-- The objects of the comma category are triples of an object `left : A`, an object
   `right : B` and a morphism `hom : L.obj left ⟶ R.obj right`.  -/
structure comma (L : A ⥤ T) (R : B ⥤ T) : Type (max u₁ u₂ v₃) :=
(left : A . obviously)
(right : B . obviously)
(hom : L.obj left ⟶ R.obj right)

-- Satisfying the inhabited linter
instance comma.inhabited [inhabited T] : inhabited (comma (𝟭 T) (𝟭 T)) :=
{ default :=
  { left := default T,
    right := default T,
    hom := 𝟙 (default T) } }

variables {L : A ⥤ T} {R : B ⥤ T}

/-- A morphism between two objects in the comma category is a commutative square connecting the
    morphisms coming from the two objects using morphisms in the image of the functors `L` and `R`.
-/
@[ext] structure comma_morphism (X Y : comma L R) :=
(left : X.left ⟶ Y.left . obviously)
(right : X.right ⟶ Y.right . obviously)
(w' : L.map left ≫ Y.hom = X.hom ≫ R.map right . obviously)

-- Satisfying the inhabited linter
instance comma_morphism.inhabited [inhabited (comma L R)] :
  inhabited (comma_morphism (default (comma L R)) (default (comma L R))) :=
{ default :=
  { left := 𝟙 _,
    right := 𝟙 _ } }

restate_axiom comma_morphism.w'
attribute [simp, reassoc] comma_morphism.w

instance comma_category : category (comma L R) :=
{ hom := comma_morphism,
  id := λ X,
  { left := 𝟙 X.left,
    right := 𝟙 X.right },
  comp := λ X Y Z f g,
  { left := f.left ≫ g.left,
    right := f.right ≫ g.right } }

namespace comma

section
variables {X Y Z : comma L R} {f : X ⟶ Y} {g : Y ⟶ Z}

@[simp] lemma id_left  : ((𝟙 X) : comma_morphism X X).left = 𝟙 X.left := rfl
@[simp] lemma id_right : ((𝟙 X) : comma_morphism X X).right = 𝟙 X.right := rfl
@[simp] lemma comp_left  : (f ≫ g).left  = f.left ≫ g.left   := rfl
@[simp] lemma comp_right : (f ≫ g).right = f.right ≫ g.right := rfl

end

variables (L) (R)

/-- The functor sending an object `X` in the comma category to `X.left`. -/
@[simps]
def fst : comma L R ⥤ A :=
{ obj := λ X, X.left,
  map := λ _ _ f, f.left }

/-- The functor sending an object `X` in the comma category to `X.right`. -/
@[simps]
def snd : comma L R ⥤ B :=
{ obj := λ X, X.right,
  map := λ _ _ f, f.right }

/-- We can interpret the commutative square constituting a morphism in the comma category as a
    natural transformation between the functors `fst ⋙ L` and `snd ⋙ R` from the comma category
    to `T`, where the components are given by the morphism that constitutes an object of the comma
    category. -/
@[simps]
def nat_trans : fst L R ⋙ L ⟶ snd L R ⋙ R :=
{ app := λ X, X.hom }

section
variables {L₁ L₂ L₃ : A ⥤ T} {R₁ R₂ R₃ : B ⥤ T}

/--
Construct an isomorphism in the comma category given isomorphisms of the objects whose forward
directions give a commutative square.
-/
@[simps]
def iso_mk {X Y : comma L₁ R₁} (l : X.left ≅ Y.left) (r : X.right ≅ Y.right)
  (h : L₁.map l.hom ≫ Y.hom = X.hom ≫ R₁.map r.hom) : X ≅ Y :=
{ hom := { left := l.hom, right := r.hom },
  inv :=
  { left := l.inv,
    right := r.inv,
    w' := begin
      rw [←L₁.map_iso_inv l, iso.inv_comp_eq, L₁.map_iso_hom, reassoc_of h, ← R₁.map_comp],
      simp
    end, } }

/-- A natural transformation `L₁ ⟶ L₂` induces a functor `comma L₂ R ⥤ comma L₁ R`. -/
@[simps]
def map_left (l : L₁ ⟶ L₂) : comma L₂ R ⥤ comma L₁ R :=
{ obj := λ X,
  { left  := X.left,
    right := X.right,
    hom   := l.app X.left ≫ X.hom },
  map := λ X Y f,
  { left  := f.left,
    right := f.right } }

/-- The functor `comma L R ⥤ comma L R` induced by the identity natural transformation on `L` is
    naturally isomorphic to the identity functor. -/
@[simps]
def map_left_id : map_left R (𝟙 L) ≅ 𝟭 _ :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

/-- The functor `comma L₁ R ⥤ comma L₃ R` induced by the composition of two natural transformations
    `l : L₁ ⟶ L₂` and `l' : L₂ ⟶ L₃` is naturally isomorphic to the composition of the two functors
    induced by these natural transformations. -/
@[simps]
def map_left_comp (l : L₁ ⟶ L₂) (l' : L₂ ⟶ L₃) :
  (map_left R (l ≫ l')) ≅ (map_left R l') ⋙ (map_left R l) :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

/-- A natural transformation `R₁ ⟶ R₂` induces a functor `comma L R₁ ⥤ comma L R₂`. -/
@[simps]
def map_right (r : R₁ ⟶ R₂) : comma L R₁ ⥤ comma L R₂ :=
{ obj := λ X,
  { left  := X.left,
    right := X.right,
    hom   := X.hom ≫ r.app X.right },
  map := λ X Y f,
  { left  := f.left,
    right := f.right } }

/-- The functor `comma L R ⥤ comma L R` induced by the identity natural transformation on `R` is
    naturally isomorphic to the identity functor. -/
@[simps]
def map_right_id : map_right L (𝟙 R) ≅ 𝟭 _ :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

/-- The functor `comma L R₁ ⥤ comma L R₃` induced by the composition of the natural transformations
    `r : R₁ ⟶ R₂` and `r' : R₂ ⟶ R₃` is naturally isomorphic to the composition of the functors
    induced by these natural transformations. -/
@[simps]
def map_right_comp (r : R₁ ⟶ R₂) (r' : R₂ ⟶ R₃) :
  (map_right L (r ≫ r')) ≅ (map_right L r) ⋙ (map_right L r') :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

end

end comma

end category_theory


import data.real.basic

lemma mp (p q : Prop) :
  p → (p → q) → q :=
λ hp hpq, hpq hp


/-
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

The real numbers ℝ.

They are constructed as the topological completion of ℚ. With the following steps:
(1) prove that ℚ forms a uniform space.
(2) subtraction and addition are uniform continuous functions in this space
(3) for multiplication and inverse this only holds on bounded subsets
(4) ℝ is defined as separated Cauchy filters over ℚ (the separation requires a quotient construction)
(5) extend the uniform continuous functions along the completion
(6) proof field properties using the principle of extension of identities

TODO

generalizations:
* topological groups & rings
* order topologies
* Archimedean fields

-/
import logic.function analysis.metric_space

noncomputable theory
open classical set lattice filter topological_space
local attribute [instance] prop_decidable

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

instance : metric_space ℚ :=
metric_space.induced coe rat.cast_injective real.metric_space

theorem rat.dist_eq (x y : ℚ) : dist x y = abs (x - y) := rfl

instance : metric_space ℤ :=
begin
  letI M := metric_space.induced coe int.cast_injective real.metric_space,
  refine @metric_space.replace_uniformity _ int.uniform_space M
    (le_antisymm refl_le_uniformity $ λ r ru,
      mem_uniformity_dist.2 ⟨1, zero_lt_one, λ a b h,
      mem_principal_sets.1 ru $ dist_le_zero.1 (_ : (abs (a - b) : ℝ) ≤ 0)⟩),
  simpa using (@int.cast_le ℝ _ _ 0).2 (int.lt_add_one_iff.1 $
    (@int.cast_lt ℝ _ (abs (a - b)) 1).1 $ by simpa using h)
end

theorem uniform_continuous_of_rat : uniform_continuous (coe : ℚ → ℝ) :=
uniform_continuous_comap

theorem uniform_embedding_of_rat : uniform_embedding (coe : ℚ → ℝ) :=
metric_space.induced_uniform_embedding _ _ _

theorem dense_embedding_of_rat : dense_embedding (coe : ℚ → ℝ) :=
uniform_embedding_of_rat.dense_embedding $
λ x, mem_closure_iff_nhds.2 $ λ t ht,
let ⟨ε,ε0, hε⟩ := mem_nhds_iff_metric.1 ht in
let ⟨q, h⟩ := exists_rat_near x ε0 in
ne_empty_iff_exists_mem.2 ⟨_, hε (mem_ball'.2 h), q, rfl⟩

theorem embedding_of_rat : embedding (coe : ℚ → ℝ) := dense_embedding_of_rat.embedding

theorem continuous_of_rat : continuous (coe : ℚ → ℝ) := uniform_continuous_of_rat.continuous

theorem real.uniform_continuous_add : uniform_continuous (λp : ℝ × ℝ, p.1 + p.2) :=
uniform_continuous_of_metric.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abs ε0 in
⟨δ, δ0, λ a b h, let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ h₁ h₂⟩

-- TODO(Mario): Find a way to use rat_add_continuous_lemma
theorem rat.uniform_continuous_add : uniform_continuous (λp : ℚ × ℚ, p.1 + p.2) :=
uniform_embedding_of_rat.uniform_continuous_iff.2 $ by simp [(∘)]; exact
((uniform_continuous_fst.comp uniform_continuous_of_rat).prod_mk
  (uniform_continuous_snd.comp uniform_continuous_of_rat)).comp real.uniform_continuous_add

theorem real.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℝ _) :=
uniform_continuous_of_metric.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [real.dist_eq] using h⟩

theorem rat.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℚ _) :=
uniform_continuous_of_metric.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [rat.dist_eq] using h⟩

instance : uniform_add_group ℝ :=
uniform_add_group.mk' real.uniform_continuous_add real.uniform_continuous_neg

instance : uniform_add_group ℚ :=
uniform_add_group.mk' rat.uniform_continuous_add rat.uniform_continuous_neg

instance : topological_add_group ℝ := by apply_instance
instance : topological_add_group ℚ := by apply_instance

instance : orderable_topology ℚ :=
induced_orderable_topology _ (λ x y, rat.cast_lt) (@exists_rat_btwn _ _ _)

lemma real.is_topological_basis_Ioo_rat :
  @is_topological_basis ℝ _ (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
is_topological_basis_of_open_of_nhds
  (by simp [is_open_Ioo] {contextual:=tt})
  (assume a v hav hv,
    let ⟨l, u, hl, hu, h⟩ := (mem_nhds_unbounded (no_top _) (no_bot _)).mp (mem_nhds_sets hv hav),
        ⟨q, hlq, hqa⟩ := exists_rat_btwn hl,
        ⟨p, hap, hpu⟩ := exists_rat_btwn hu in
    ⟨Ioo q p,
      by simp; exact ⟨q, p, rat.cast_lt.1 $ lt_trans hqa hap, rfl⟩,
      ⟨hqa, hap⟩, assume a' ⟨hqa', ha'p⟩, h _ (lt_trans hlq hqa') (lt_trans ha'p hpu)⟩)

instance : second_countable_topology ℝ :=
⟨⟨(⋃(a b : ℚ) (h : a < b), {Ioo a b}),
  by simp [countable_Union, countable_Union_Prop],
  real.is_topological_basis_Ioo_rat.2.2⟩⟩

/- TODO(Mario): Prove that these are uniform isomorphisms instead of uniform embeddings
lemma uniform_embedding_add_rat {r : ℚ} : uniform_embedding (λp:ℚ, p + r) :=
_

lemma uniform_embedding_mul_rat {q : ℚ} (hq : q ≠ 0) : uniform_embedding ((*) q) :=
_ -/

lemma real.uniform_continuous_inv (s : set ℝ) {r : ℝ} (r0 : 0 < r) (H : ∀ x ∈ s, r ≤ abs x) :
  uniform_continuous (λp:s, p.1⁻¹) :=
uniform_continuous_of_metric.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_inv_continuous_lemma abs ε0 r0 in
⟨δ, δ0, λ a b h, Hδ (H _ a.2) (H _ b.2) h⟩

lemma real.uniform_continuous_abs : uniform_continuous (abs : ℝ → ℝ) :=
uniform_continuous_of_metric.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b, lt_of_le_of_lt (abs_abs_sub_abs_le_abs_sub _ _)⟩

lemma real.continuous_abs : continuous (abs : ℝ → ℝ) :=
real.uniform_continuous_abs.continuous

lemma rat.uniform_continuous_abs : uniform_continuous (abs : ℚ → ℚ) :=
uniform_continuous_of_metric.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b h, lt_of_le_of_lt
    (by simpa [rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩

lemma rat.continuous_abs : continuous (abs : ℚ → ℚ) :=
rat.uniform_continuous_abs.continuous

lemma real.tendsto_inv {r : ℝ} (r0 : r ≠ 0) : tendsto (λq, q⁻¹) (nhds r) (nhds r⁻¹) :=
by rw ← abs_pos_iff at r0; exact
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_inv {x | abs r / 2 < abs x} (half_pos r0) (λ x h, le_of_lt h))
  (mem_nhds_sets (real.continuous_abs _ $ is_open_lt' (abs r / 2)) (half_lt_self r0))

lemma real.continuous_inv' : continuous (λa:{r:ℝ // r ≠ 0}, a.val⁻¹) :=
continuous_iff_tendsto.mpr $ assume ⟨r, hr⟩,
  (continuous_iff_tendsto.mp continuous_subtype_val _).comp (real.tendsto_inv hr)

lemma real.continuous_inv [topological_space α] {f : α → ℝ} (h : ∀a, f a ≠ 0) (hf : continuous f) :
  continuous (λa, (f a)⁻¹) :=
show continuous ((has_inv.inv ∘ @subtype.val ℝ (λr, r ≠ 0)) ∘ λa, ⟨f a, h a⟩),
  from (continuous_subtype_mk _ hf).comp real.continuous_inv'

lemma real.uniform_continuous_mul_const {x : ℝ} : uniform_continuous ((*) x) :=
uniform_continuous_of_metric.2 $ λ ε ε0, begin
  cases no_top (abs x) with y xy,
  have y0 := lt_of_le_of_lt (abs_nonneg _) xy,
  refine ⟨_, div_pos ε0 y0, λ a b h, _⟩,
  rw [real.dist_eq, ← mul_sub, abs_mul, ← mul_div_cancel' ε (ne_of_gt y0)],
  exact mul_lt_mul' (le_of_lt xy) h (abs_nonneg _) y0
end

lemma real.uniform_continuous_mul (s : set (ℝ × ℝ))
  {r₁ r₂ : ℝ} (r₁0 : 0 < r₁) (r₂0 : 0 < r₂)
  (H : ∀ x ∈ s, abs (x : ℝ × ℝ).1 < r₁ ∧ abs x.2 < r₂) :
  uniform_continuous (λp:s, p.1.1 * p.1.2) :=
uniform_continuous_of_metric.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abs ε0 r₁0 r₂0 in
⟨δ, δ0, λ a b h,
  let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ (H _ a.2).1 (H _ b.2).2 h₁ h₂⟩

lemma real.continuous_mul : continuous (λp : ℝ × ℝ, p.1 * p.2) :=
continuous_iff_tendsto.2 $ λ ⟨a₁, a₂⟩,
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_mul
    ({x | abs x < abs a₁ + 1}.prod {x | abs x < abs a₂ + 1})
    (lt_of_le_of_lt (abs_nonneg _) (lt_add_one _))
    (lt_of_le_of_lt (abs_nonneg _) (lt_add_one _))
    (λ x, id))
  (mem_nhds_sets
    (is_open_prod
      (real.continuous_abs _ $ is_open_gt' _)
      (real.continuous_abs _ $ is_open_gt' _))
    ⟨lt_add_one (abs a₁), lt_add_one (abs a₂)⟩)

instance : topological_ring ℝ :=
{ continuous_mul := real.continuous_mul, ..real.topological_add_group }

instance : topological_semiring ℝ := by apply_instance

lemma rat.continuous_mul : continuous (λp : ℚ × ℚ, p.1 * p.2) :=
embedding_of_rat.continuous_iff.2 $ by simp [(∘)]; exact
((continuous_fst.comp continuous_of_rat).prod_mk
  (continuous_snd.comp continuous_of_rat)).comp real.continuous_mul

instance : topological_ring ℚ :=
{ continuous_mul := rat.continuous_mul, ..rat.topological_add_group }

theorem real.ball_eq_Ioo (x ε : ℝ) : ball x ε = Ioo (x - ε) (x + ε) :=
set.ext $ λ y, by rw [mem_ball, real.dist_eq,
  abs_sub_lt_iff, sub_lt_iff_lt_add', and_comm, sub_lt]; refl

theorem real.Ioo_eq_ball (x y : ℝ) : Ioo x y = ball ((x + y) / 2) ((y - x) / 2) :=
by rw [real.ball_eq_Ioo, ← sub_div, add_comm, ← sub_add,
  add_sub_cancel', add_self_div_two, ← add_div,
  add_assoc, add_sub_cancel'_right, add_self_div_two]

lemma real.totally_bounded_Ioo (a b : ℝ) : totally_bounded (Ioo a b) :=
totally_bounded_of_metric.2 $ λ ε ε0, begin
  rcases exists_nat_gt ((b - a) / ε) with ⟨n, ba⟩,
  rw [div_lt_iff' ε0, sub_lt_iff_lt_add'] at ba,
  let s := (λ i:ℕ, a + ε * i) '' {i:ℕ | i < n},
  refine ⟨s, finite_image _ ⟨set.fintype_lt_nat _⟩, λ x h, _⟩,
  rcases h with ⟨ax, xb⟩,
  let i : ℕ := ⌊(x - a) / ε⌋.to_nat,
  have : (i : ℤ) = ⌊(x - a) / ε⌋ :=
    int.to_nat_of_nonneg (floor_nonneg.2 $ le_of_lt (div_pos (sub_pos.2 ax) ε0)),
  simp, refine ⟨_, ⟨i, _, rfl⟩, _⟩,
  { rw [← int.coe_nat_lt, this],
    refine int.cast_lt.1 (lt_of_le_of_lt (floor_le _) _),
    rw [int.cast_coe_nat, div_lt_iff' ε0, sub_lt_iff_lt_add'],
    exact lt_trans xb ba },
  { rw [real.dist_eq, ← int.cast_coe_nat, this, abs_of_nonneg,
        ← sub_sub, sub_lt_iff_lt_add'],
    { have := lt_floor_add_one ((x - a) / ε),
      rwa [div_lt_iff' ε0, mul_add, mul_one] at this },
    { have := floor_le ((x - a) / ε),
      rwa [ge, sub_nonneg, ← le_sub_iff_add_le', ← le_div_iff' ε0] } }
end

lemma real.totally_bounded_ball (x ε : ℝ) : totally_bounded (ball x ε) :=
by rw real.ball_eq_Ioo; apply real.totally_bounded_Ioo

lemma real.totally_bounded_Ico (a b : ℝ) : totally_bounded (Ico a b) :=
let ⟨c, ac⟩ := no_bot a in totally_bounded_subset
  (by exact λ x ⟨h₁, h₂⟩, ⟨lt_of_lt_of_le ac h₁, h₂⟩)
  (real.totally_bounded_Ioo c b)

lemma real.totally_bounded_Icc (a b : ℝ) : totally_bounded (Icc a b) :=
let ⟨c, bc⟩ := no_top b in totally_bounded_subset
  (by exact λ x ⟨h₁, h₂⟩, ⟨h₁, lt_of_le_of_lt h₂ bc⟩)
  (real.totally_bounded_Ico a c)

lemma rat.totally_bounded_Icc (a b : ℚ) : totally_bounded (Icc a b) :=
begin
  have := totally_bounded_preimage uniform_embedding_of_rat (real.totally_bounded_Icc a b),
  rwa (set.ext (λ q, _) : Icc _ _ = _), simp
end

-- TODO(Mario): Generalize to first-countable uniform spaces?
instance : complete_space ℝ :=
⟨λ f cf, begin
  have := (cauchy_of_metric.1 cf).2,
  let S : ∀ ε:{ε:ℝ//ε>0}, {t : f.sets // ∀ x y ∈ t.1, dist x y < ε} :=
    λ ε, classical.choice
      (let ⟨t, tf, h⟩ := (cauchy_of_metric.1 cf).2 ε ε.2 in ⟨⟨⟨t, tf⟩, h⟩⟩),
  let g : ℕ → {ε:ℝ//ε>0} := λ n,
    ⟨n.to_pnat'⁻¹, inv_pos (nat.cast_pos.2 n.to_pnat'.pos)⟩,
  have hg : ∀ ε > 0, ∃ n, ∀ j ≥ n, (g j : ℝ) < ε,
  { intros ε ε0,
    cases exists_nat_gt ε⁻¹ with n hn,
    refine ⟨n, λ j nj, _⟩,
    have hj := lt_of_lt_of_le hn (nat.cast_le.2 nj),
    have j0 := lt_trans (inv_pos ε0) hj,
    have jε := (inv_lt j0 ε0).2 hj,
    rwa ← pnat.to_pnat'_coe (nat.cast_pos.1 j0) at jε },
  let F : ∀ n : ℕ, {t : f.sets // ∀ x y ∈ t.1, dist x y < g n},
  { refine λ n, ⟨⟨_, Inter_mem_sets (finite_le_nat n) (λ i _, (S (g i)).1.2)⟩, _⟩,
    have : (⋂ i ∈ {i : ℕ | i ≤ n}, (S (g i)).1.1) ⊆ S (g n) :=
      bInter_subset_of_mem (le_refl n),
    exact λ x y xs ys, (S (g n)).2 _ _ (this xs) (this ys) },
  let G : ∀ n : ℕ, F n,
  { refine λ n, classical.choice _,
    cases inhabited_of_mem_sets cf.1 (F n).1.2 with x xS,
    exact ⟨⟨x, xS⟩⟩ },
  let c : cau_seq ℝ abs,
  { refine ⟨λ n, G n, λ ε ε0, _⟩,
    cases hg _ ε0 with n hn,
    refine ⟨n, λ j jn, _⟩,
    have : (F j).1.1 ⊆ (F n) :=
      bInter_subset_bInter_left (λ i h, @le_trans _ _ i n j h jn),
    exact lt_trans ((F n).2 _ _ (this (G j).2) (G n).2) (hn _ $ le_refl _) },
  refine ⟨real.lim c, λ s h, _⟩,
  rcases mem_nhds_iff_metric.1 h with ⟨ε, ε0, hε⟩,
  cases exists_forall_ge_and (hg _ $ half_pos ε0)
    (real.equiv_lim c _ $ half_pos ε0) with n hn,
  cases hn _ (le_refl _) with h₁ h₂,
  refine sets_of_superset _ (F n).1.2 (subset.trans _ $
    subset.trans (ball_half_subset (G n) h₂) hε),
  exact λ x h, lt_trans ((F n).2 x (G n) h (G n).2) h₁
end⟩

-- TODO(Mario): This proof has nothing to do with reals
theorem real.Cauchy_eq {f g : Cauchy ℝ} :
  lim f.1 = lim g.1 ↔ (f, g) ∈ separation_rel (Cauchy ℝ) :=
begin
  split,
  { intros e s hs,
    rcases Cauchy.mem_uniformity'.1 hs with ⟨t, tu, ts⟩,
    apply ts,
    rcases comp_mem_uniformity_sets tu with ⟨d, du, dt⟩,
    refine mem_prod_iff.2
      ⟨_, le_nhds_lim_of_cauchy f.2 (mem_nhds_right (lim f.1) du),
       _, le_nhds_lim_of_cauchy g.2 (mem_nhds_left (lim g.1) du), λ x h, _⟩,
    cases x with a b, cases h with h₁ h₂,
    rw ← e at h₂,
    exact dt ⟨_, h₁, h₂⟩ },
  { intros H,
    refine separated_def.1 (by apply_instance) _ _ (λ t tu, _),
    rcases mem_uniformity_is_closed tu with ⟨d, du, dc, dt⟩,
    refine H {p | (lim p.1.1, lim p.2.1) ∈ t}
      (Cauchy.mem_uniformity'.2 ⟨d, du, λ f g h, _⟩),
    rcases mem_prod_iff.1 h with ⟨x, xf, y, yg, h⟩,
    have limc : ∀ (f : Cauchy ℝ) (x ∈ f.1.sets), lim f.1 ∈ closure x,
    { intros f x xf,
      rw closure_eq_nhds,
      exact neq_bot_of_le_neq_bot f.2.1
        (le_inf (le_nhds_lim_of_cauchy f.2) (le_principal_iff.2 xf)) },
    have := (closure_subset_iff_subset_of_is_closed dc).2 h,
    rw closure_prod_eq at this,
    refine dt (this ⟨_, _⟩); dsimp; apply limc; assumption }
end

lemma tendsto_of_nat_at_top_at_top : tendsto (coe : ℕ → ℝ) at_top at_top :=
tendsto_infi.2 $ assume r, tendsto_principal.2 $
let ⟨n, hn⟩ := exists_nat_gt r in
mem_at_top_sets.2 ⟨n, λ m h, le_trans (le_of_lt hn) (nat.cast_le.2 h)⟩

section

lemma closure_of_rat_image_lt {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q < x}) = {r | ↑q ≤ r} :=
subset.antisymm
  ((closure_subset_iff_subset_of_is_closed (is_closed_ge' _)).2
    (image_subset_iff.2 $ λ p h, le_of_lt $ (@rat.cast_lt ℝ _ _ _).2 h)) $
λ x hx, mem_closure_iff_nhds.2 $ λ t ht,
let ⟨ε, ε0, hε⟩ := mem_nhds_iff_metric.1 ht in
let ⟨p, h₁, h₂⟩ := exists_rat_btwn ((lt_add_iff_pos_right x).2 ε0) in
ne_empty_iff_exists_mem.2 ⟨_, hε (show abs _ < _,
    by rwa [abs_of_nonneg (le_of_lt $ sub_pos.2 h₁), sub_lt_iff_lt_add']),
  p, rat.cast_lt.1 (@lt_of_le_of_lt ℝ _ _ _ _ hx h₁), rfl⟩

/- TODO(Mario): Put these back only if needed later
lemma closure_of_rat_image_le_eq {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q ≤ x}) = {r | ↑q ≤ r} :=
_

lemma closure_of_rat_image_le_le_eq {a b : ℚ} (hab : a ≤ b) :
  closure (of_rat '' {q:ℚ | a ≤ q ∧ q ≤ b}) = {r:ℝ | of_rat a ≤ r ∧ r ≤ of_rat b} :=
_-/

lemma compact_Icc {a b : ℝ} : compact (Icc a b) :=
compact_of_totally_bounded_is_closed
  (real.totally_bounded_Icc a b)
  (is_closed_inter (is_closed_ge' a) (is_closed_le' b))

end


import order.lattice

meta def infs_and_sups :=
`[refl <|>
  {apply inf_le_of_left_le, infs_and_sups} <|>
  {apply inf_le_of_right_le, infs_and_sups} <|>
  {apply le_sup_of_le_left, infs_and_sups} <|>
 {apply le_sup_of_le_right, infs_and_sups}]

meta def tactic.interactive.lattice :=
`[try { apply le_antisymm };
        repeat { apply le_inf <|>
                 apply sup_le };
        infs_and_sups]

variables {L : Type*} [lattice L] {a b c x y z : L}

example : a ⊔ (b ⊓ c) ≤ (a ⊔ b) ⊓ (a ⊔ c) :=
by lattice

example : a ⊔ (a ⊓ b) = a :=
by lattice

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
by lattice

example : x ⊓ y = y ⊓ x :=
by lattice

-- 2ª solución
-- ===========

meta def tactic.interactive.lattice2 :=
`[solve_by_elim
  [le_antisymm,
   le_inf,
   sup_le,
   le_refl,
   inf_le_of_left_le,
   inf_le_of_right_le,
   le_sup_of_le_left,
   le_sup_of_le_right]
  {max_depth := 30}]

example : a ⊔ (b ⊓ c) ≤ (a ⊔ b) ⊓ (a ⊔ c) :=
by lattice2

example : a ⊔ (a ⊓ b) = a :=
by lattice2

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
by lattice2

example : x ⊓ y = y ⊓ x :=
by lattice2


import data.rat.basic

theorem USAJMO_Problem_4_2015 (f : ℚ -> ℚ):
(∀ x y z t : ℚ,
((∃ d : ℚ, (y = x + d ∧ z = x + 2*d ∧ t = x + 3*d)) ∧
f(x)+f(t) = f(y) + f(z))) →

∃ k C : ℚ, ∀ b : ℚ, f(b) = k*b + C

:= sorry


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import group_theory.submonoid.inverses
import ring_theory.finiteness
import ring_theory.localization.basic
import tactic.ring_exp

/-!
# Submonoid of inverses

## Main definitions

 * `is_localization.inv_submonoid M S` is the submonoid of `S = M⁻¹R` consisting of inverses of
   each element `x ∈ M`

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

variables {R : Type*} [comm_ring R] (M : submonoid R) (S : Type*) [comm_ring S]
variables [algebra R S] {P : Type*} [comm_ring P]

open function
open_locale big_operators

namespace is_localization

section inv_submonoid

variables (M S)

/-- The submonoid of `S = M⁻¹R` consisting of `{ 1 / x | x ∈ M }`. -/
def inv_submonoid : submonoid S := (M.map (algebra_map R S : R →* S)).left_inv

variable [is_localization M S]

lemma submonoid_map_le_is_unit : M.map (algebra_map R S : R →* S) ≤ is_unit.submonoid S :=
by { rintros _ ⟨a, ha, rfl⟩, exact is_localization.map_units S ⟨_, ha⟩ }

/-- There is an equivalence of monoids between the image of `M` and `inv_submonoid`. -/
noncomputable
abbreviation equiv_inv_submonoid : M.map (algebra_map R S : R →* S) ≃* inv_submonoid M S :=
((M.map (algebra_map R S : R →* S)).left_inv_equiv (submonoid_map_le_is_unit M S)).symm

/-- There is a canonical map from `M` to `inv_submonoid` sending `x` to `1 / x`. -/
noncomputable
def to_inv_submonoid : M →* inv_submonoid M S :=
(equiv_inv_submonoid M S).to_monoid_hom.comp ((algebra_map R S : R →* S).submonoid_map M)

lemma to_inv_submonoid_surjective : function.surjective (to_inv_submonoid M S) :=
function.surjective.comp (equiv.surjective _) (monoid_hom.submonoid_map_surjective _ _)

@[simp]
lemma to_inv_submonoid_mul (m : M) : (to_inv_submonoid M S m : S) * (algebra_map R S m) = 1 :=
submonoid.left_inv_equiv_symm_mul _ _ _

@[simp]
lemma mul_to_inv_submonoid (m : M) : (algebra_map R S m) * (to_inv_submonoid M S m : S) = 1 :=
submonoid.mul_left_inv_equiv_symm _ _ ⟨_, _⟩

@[simp]
lemma smul_to_inv_submonoid (m : M) : m • (to_inv_submonoid M S m : S) = 1 :=
by { convert mul_to_inv_submonoid M S m, rw ← algebra.smul_def, refl }

variables {S}

lemma surj' (z : S) : ∃ (r : R) (m : M), z = r • to_inv_submonoid M S m :=
begin
  rcases is_localization.surj M z with ⟨⟨r, m⟩, e : z * _ = algebra_map R S r⟩,
  refine ⟨r, m, _⟩,
  rw [algebra.smul_def, ← e, mul_assoc],
  simp,
end

lemma to_inv_submonoid_eq_mk' (x : M) :
  (to_inv_submonoid M S x : S) = mk' S 1 x :=
by { rw ← (is_localization.map_units S x).mul_left_inj, simp }

lemma mem_inv_submonoid_iff_exists_mk' (x : S) :
  x ∈ inv_submonoid M S ↔ ∃ m : M, mk' S 1 m = x :=
begin
  simp_rw ← to_inv_submonoid_eq_mk',
  exact ⟨λ h, ⟨_, congr_arg subtype.val (to_inv_submonoid_surjective M S ⟨x, h⟩).some_spec⟩,
    λ h, h.some_spec ▸ (to_inv_submonoid M S h.some).prop⟩
end

variables (S)

lemma span_inv_submonoid : submodule.span R (inv_submonoid M S : set S) = ⊤ :=
begin
  rw eq_top_iff,
  rintros x -,
  rcases is_localization.surj' M x with ⟨r, m, rfl⟩,
  exact submodule.smul_mem _ _ (submodule.subset_span (to_inv_submonoid M S m).prop),
end

lemma finite_type_of_monoid_fg [monoid.fg M] : algebra.finite_type R S :=
begin
  have := monoid.fg_of_surjective _ (to_inv_submonoid_surjective M S),
  rw monoid.fg_iff_submonoid_fg at this,
  rcases this with ⟨s, hs⟩,
  refine ⟨⟨s, _⟩⟩,
  rw eq_top_iff,
  rintro x -,
  change x ∈ ((algebra.adjoin R _ : subalgebra R S).to_submodule : set S),
  rw [algebra.adjoin_eq_span, hs, span_inv_submonoid],
  trivial
end

end inv_submonoid

end is_localization


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.defs.equiv

/-!
# Distribution Semantics of Bind

This file gives various lemmas for probability outcomes of the computation `oa >>= ob`.
-/

namespace oracle_comp

open oracle_spec
open_locale big_operators ennreal

variables {α β γ : Type} {spec spec' : oracle_spec}

section bind_eq_iff

variables (oa : oracle_comp spec α) (ob : α → oracle_comp spec β)

lemma bind_dist_equiv_iff  (ob' : oracle_comp spec' β) :
  (oa >>= ob) ≃ₚ ob' ↔ ∀ y, ∑' (x : α), ⁅= x | oa⁆ * ⁅= y | ob x⁆ = ⁅= y | ob'⁆ :=
by simp only [dist_equiv.ext_iff, eval_dist_bind_apply_eq_tsum]

lemma eval_dist_bind_eq_iff (p : pmf β) :
  ⁅oa >>= ob⁆ = p ↔ ∀ y, ∑' (x : α), ⁅= x | oa⁆ * ⁅= y | ob x⁆ = p y :=
by simp only [eval_dist.ext_iff, eval_dist_bind_apply_eq_tsum]

lemma eval_dist_bind_apply_eq_iff (y : β) (r : ℝ≥0∞) :
  ⁅= y | oa >>= ob⁆ = r ↔ ∑' (x : α), ⁅= x | oa⁆ * ⁅= y | ob x⁆ = r :=
by rw [eval_dist_bind_apply_eq_tsum]

lemma prob_event_bind_eq_iff (e : set β) (r : ℝ≥0∞) :
  ⁅e | oa >>= ob⁆ = r ↔ ∑' (x : α), ⁅= x | oa⁆ * ⁅e | ob x⁆ = r :=
by rw [prob_event_bind_eq_tsum]

end bind_eq_iff

section bind_eq_zero_iff

variables (oa : oracle_comp spec α) (ob : α → oracle_comp spec β)

-- TODO!: Making something like this a simp lemma requires a special "eval_dist" simp class
@[simp] lemma eval_dist_bind_apply_eq_zero_iff (y : β) :
  ⁅= y | oa >>= ob⁆ = 0 ↔ ∀ x ∈ oa.support, y ∉ (ob x).support :=
by simp_rw [pmf.apply_eq_zero_iff, support_eval_dist, support_bind, set.mem_Union, not_exists]

@[simp] lemma prob_event_bind_eq_zero_iff (e : set β) :
  ⁅e | oa >>= ob⁆ = 0 ↔ ∀ x ∈ oa.support, disjoint (ob x).support e :=
by simp only [prob_event_eq_zero_iff_disjoint_support, support_bind, set.disjoint_Union_left]

end bind_eq_zero_iff

section bind_eq_one_iff

variables (oa : oracle_comp spec α) (ob : α → oracle_comp spec β)

@[simp] lemma eval_dist_bind_apply_eq_one_iff (y : β) :
  ⁅= y | oa >>= ob⁆ = 1 ↔ ∀ x ∈ oa.support, (ob x).support ⊆ {y} :=
by simp only [eval_dist_bind, pmf.bind_apply_eq_one_iff, support_eval_dist]

@[simp] lemma prob_event_bind_eq_one_iff (e : set β) :
  ⁅e | oa >>= ob⁆ = 1 ↔ ∀ x ∈ oa.support, (ob x).support ⊆ e :=
by simp only [prob_event_eq_one_iff_support_subset, support_bind, set.Union_subset_iff]

end bind_eq_one_iff

section fin_support

lemma eval_dist_bind_apply_eq_sum_fin_support (oa : oracle_comp spec α)
  (ob : α → oracle_comp spec β) (y : β) [oa.decidable] :
  ⁅= y | oa >>= ob⁆ = ∑ x in oa.fin_support, ⁅= x | oa⁆* ⁅= y | ob x⁆ :=
(eval_dist_bind_apply_eq_tsum oa ob y).trans (tsum_eq_sum $ λ a ha,
  by rw [(eval_dist_eq_zero_iff' oa a).2 ha, zero_mul])

-- lemma prob_event_bind_eq_sum_fin_support (oa : oracle_comp spec α)
--   (ob : α → oracle_comp spec β) (e : set β) [oa.decidable] :
--   ⁅e | oa >>= ob⁆ = ∑ x in oa.fin_support, ⁅= x | oa⁆ * ⁅e | ob x⁆ :=
-- begin
--   sorry
-- end

end fin_support

/-- If two computations `oa` and `oa'` are distributionally equivalent to each other,
and computations `ob` and `ob'` are equivalent for any input that is an output of `oa`,
then the sequential computations `oa >>= ob` and `oa' >>= ob'` are equivalent. -/
lemma bind_dist_equiv_bind_of_dist_equiv {oa : oracle_comp spec α} {ob : α → oracle_comp spec β}
  {oa' : oracle_comp spec' α} {ob' : α → oracle_comp spec' β} (ha : oa ≃ₚ oa')
  (hb : ∀ x ∈ oa.support, ob x ≃ₚ ob' x) : (oa >>= ob) ≃ₚ (oa' >>= ob') :=
begin
  refine dist_equiv.ext (λ y, _),
  simp only [eval_dist_bind_apply_eq_tsum],
  refine tsum_congr (λ x, _),
  by_cases hx : x ∈ oa.support,
  { rw [ha.eval_dist_eq, (hb x hx).eval_dist_eq] },
  { simp only [zero_mul, eval_dist_eq_zero hx,
      eval_dist_eq_zero (ha.support_eq ▸ hx : x ∉ oa'.support)] }
end

lemma bind_dist_equiv_bind_of_dist_equiv_left (oa : oracle_comp spec α)
  (ob : α → oracle_comp spec β) (oa' : oracle_comp spec α) (h : oa ≃ₚ oa') :
  (oa >>= ob) ≃ₚ (oa' >>= ob) :=
bind_dist_equiv_bind_of_dist_equiv h (λ _ _, rfl)

lemma bind_dist_equiv_bind_of_dist_equiv_right (oa : oracle_comp spec α)
  (ob : α → oracle_comp spec β) (ob' : α → oracle_comp spec β)
  (h' : ∀ x ∈ oa.support, ob x ≃ₚ ob' x) : (oa >>= ob) ≃ₚ (oa >>= ob') :=
bind_dist_equiv_bind_of_dist_equiv rfl h'

end oracle_comp


/-
Copyright (c) 2019 Tim Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Tim Baanen.

Solve equations in commutative (semi)rings with exponents.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.norm_num
import Mathlib.control.traversable.basic
import Mathlib.PostPort

universes l u u_1

namespace Mathlib

/-!
# `ring_exp` tactic

A tactic for solving equations in commutative (semi)rings,
where the exponents can also contain variables.

More precisely, expressions of the following form are supported:
- constants (non-negative integers)
- variables
- coefficients (any rational number, embedded into the (semi)ring)
- addition of expressions
- multiplication of expressions
- exponentiation of expressions (the exponent must have type `ℕ`)
- subtraction and negation of expressions (if the base is a full ring)

The motivating example is proving `2 * 2^n * b = b * 2^(n+1)`,
something that the `ring` tactic cannot do, but `ring_exp` can.

## Implementation notes

The basic approach to prove equalities is to normalise both sides and check for equality.
The normalisation is guided by building a value in the type `ex` at the meta level,
together with a proof (at the base level) that the original value is equal to
the normalised version.
The normalised version and normalisation proofs are also stored in the `ex` type.

The outline of the file:
- Define an inductive family of types `ex`, parametrised over `ex_type`,
  which can represent expressions with `+`, `*`, `^` and rational numerals.
  The parametrisation over `ex_type` ensures that associativity and distributivity are applied,
  by restricting which kinds of subexpressions appear as arguments to the various operators.
- Represent addition, multiplication and exponentiation in the `ex` type,
  thus allowing us to map expressions to `ex` (the `eval` function drives this).
  We apply associativity and distributivity of the operators here (helped by `ex_type`)
  and commutativity as well (by sorting the subterms; unfortunately not helped by anything).
  Any expression not of the above formats is treated as an atom (the same as a variable).

There are some details we glossed over which make the plan more complicated:
- The order on atoms is not initially obvious.
  We construct a list containing them in order of initial appearance in the expression,
  then use the index into the list as a key to order on.
- In the tactic, a normalized expression `ps : ex` lives in the meta-world,
  but the normalization proofs live in the real world.
  Thus, we cannot directly say `ps.orig = ps.pretty` anywhere,
  but we have to carefully construct the proof when we compute `ps`.
  This was a major source of bugs in development!
- For `pow`, the exponent must be a natural number, while the base can be any semiring `α`.
  We swap out operations for the base ring `α` with those for the exponent ring `ℕ`
  as soon as we deal with exponents.
  This is accomplished by the `in_exponent` function and is relatively painless since
  we work in a `reader` monad.
- The normalized form of an expression is the one that is useful for the tactic,
  but not as nice to read. To remedy this, the user-facing normalization calls `ex.simp`.

## Caveats and future work

Subtraction cancels out identical terms, but division does not.
That is: `a - a = 0 := by ring_exp` solves the goal,
but `a / a := 1 by ring_exp` doesn't.
Note that `0 / 0` is generally defined to be `0`,
so division cancelling out is not true in general.

Multiplication of powers can be simplified a little bit further:
`2 ^ n * 2 ^ n = 4 ^ n := by ring_exp` could be implemented
in a similar way that `2 * a + 2 * a = 4 * a := by ring_exp` already works.
This feature wasn't needed yet, so it's not implemented yet.

## Tags

ring, semiring, exponent, power
-/

-- The base ring `α` will have a universe level `u`.

-- We do not introduce `α` as a variable yet,

-- in order to make it explicit or implicit as required.

namespace tactic.ring_exp

/--
The `atom` structure is used to represent atomic expressions:
those which `ring_exp` cannot parse any further.

For instance, `a + (a % b)` has `a` and `(a % b)` as atoms.
The `ring_exp_eq` tactic does not normalize the subexpressions in atoms,
but `ring_exp` does if `ring_exp_eq` was not sufficient.

Atoms in fact represent equivalence classes of expressions,
modulo definitional equality.
The field `index : ℕ` should be a unique number for each class,
while `value : expr` contains a representative of this class.
The function `resolve_atom` determines the appropriate atom
for a given expression.
-/
namespace atom

/--
The `eq` operation on `atom`s works modulo definitional equality,
ignoring their `value`s.
The invariants on `atom` ensure indices are unique per value.
Thus, `eq` indicates equality as long as the `atom`s come from the same context.
-/
/--
We order `atom`s on the order of appearance in the main expression.
-/
end atom

/-!
### `expression` section

In this section, we define the `ex` type and its basic operations.

First, we introduce the supporting types `coeff`, `ex_type` and `ex_info`.
For understanding the code, it's easier to check out `ex` itself first,
then refer back to the supporting types.

The arithmetic operations on `ex` need additional definitions,
so they are defined in a later section.
-/

/--
Coefficients in the expression are stored in a wrapper structure,
allowing for easier modification of the data structures.
The modifications might be caching of the result of `expr.of_rat`,
or using a different meta representation of numerals.
-/
structure coeff
where
  value : ℚ

/-- The values in `ex_type` are used as parameters to `ex` to control the expression's structure. -/
inductive ex_type
where
| base : ex_type
| sum : ex_type
| prod : ex_type
| exp : ex_type

/--
Each `ex` stores information for its normalization proof.

The `orig` expression is the expression that was passed to `eval`.

The `pretty` expression is the normalised form that the `ex` represents.
(I didn't call this something like `norm`, because there are already
too many things called `norm` in mathematics!)

The field `proof` contains an optional proof term of type `%%orig = %%pretty`.
The value `none` for the proof indicates that everything reduces to reflexivity.
(Which saves space in quite a lot of cases.)
-/
/--
The `ex` type is an abstract representation of an expression with `+`, `*` and `^`.
Those operators are mapped to the `sum`, `prod` and `exp` constructors respectively.

The `zero` constructor is the base case for `ex sum`, e.g. `1 + 2` is represented
by (something along the lines of) `sum 1 (sum 2 zero)`.

The `coeff` constructor is the base case for `ex prod`, and is used for numerals.
The code maintains the invariant that the coefficient is never `0`.

The `var` constructor is the base case for `ex exp`, and is used for atoms.

The `sum_b` constructor allows for addition in the base of an exponentiation;
it serves a similar purpose as the parentheses in `(a + b)^c`.
The code maintains the invariant that the argument to `sum_b` is not `zero`
or `sum _ zero`.

All of the constructors contain an `ex_info` field,
used to carry around (arguments to) proof terms.

While the `ex_type` parameter enforces some simplification invariants,
the following ones must be manually maintained at the risk of insufficient power:
- the argument to `coeff` must be nonzero (to ensure `0 = 0 * 1`)
- the argument to `sum_b` must be of the form `sum a (sum b bs)` (to ensure `(a + 0)^n = a^n`)
- normalisation proofs of subexpressions must be `refl ps.pretty`
- if we replace `sum` with `cons` and `zero` with `nil`, the resulting list is sorted
  according to the `lt` relation defined further down; similarly for `prod` and `coeff`
  (to ensure `a + b = b + a`).

The first two invariants could be encoded in a subtype of `ex`,
but aren't (yet) to spare some implementation burden.
The other invariants cannot be encoded because we need the `tactic` monad to check them.
(For example, the correct equality check of `expr` is `is_def_eq : expr → expr → tactic unit`.)
-/
/--
Return the proof information associated to the `ex`.
-/
/--
Return the original, non-normalized version of this `ex`.

Note that arguments to another `ex` are always "pre-normalized":
their `orig` and `pretty` are equal, and their `proof` is reflexivity.
-/
/--
Return the normalized version of this `ex`.
-/
/--
Return the normalisation proof of the given expression.
If the proof is `refl`, we give `none` instead,
which helps to control the size of proof terms.
To get an actual term, use `ex.proof_term`,
or use `mk_proof` with the correct set of arguments.
-/
/--
Update the `orig` and `proof` fields of the `ex_info`.
Intended for use in `ex.set_info`.
-/
/--
Update the `ex_info` of the given expression.

We use this to combine intermediate normalisation proofs.
Since `pretty` only depends on the subexpressions,
which do not change, we do not set `pretty`.
-/
protected instance coeff_has_repr : has_repr coeff :=
  has_repr.mk fun (x : coeff) => repr (coeff.value x)

/-- Convert an `ex` to a `string`. -/
/--
Equality test for expressions.

Since equivalence of `atom`s is not the same as equality,
we cannot make a true `(=)` operator for `ex` either.
-/
/--
The ordering on expressions.

As for `ex.eq`, this is a linear order only in one context.
-/
/-!
### `operations` section

This section defines the operations (on `ex`) that use tactics.
They live in the `ring_exp_m` monad,
which adds a cache and a list of encountered atoms to the `tactic` monad.

Throughout this section, we will be constructing proof terms.
The lemmas used in the construction are all defined over a commutative semiring α.
-/

/--
Stores the information needed in the `eval` function and its dependencies,
so they can (re)construct expressions.

The `eval_info` structure stores this information for one type,
and the `context` combines the two types, one for bases and one for exponents.
-/
-- Cache the instances for optimization and consistency

-- Optional instances (only required for (-) and (/) respectively)

-- Cache common constants.

/--
The `context` contains the full set of information needed for the `eval` function.

This structure has two copies of `eval_info`:
one is for the base (typically some semiring `α`) and another for the exponent (always `ℕ`).
When evaluating an exponent, we put `info_e` in `info_b`.
-/
/--
The `ring_exp_m` monad is used instead of `tactic` to store the context.
-/
/--
Access the instance cache.
-/
/--
Lift an operation in the `tactic` monad to the `ring_exp_m` monad.

This operation will not access the cache.
-/
/--
Change the context of the given computation,
so that expressions are evaluated in the exponent ring,
instead of the base ring.
-/
/--
Specialized version of `mk_app` where the first two arguments are `{α}` `[some_class α]`.
Should be faster because it can use the cached instances.
-/
/--
Specialized version of `mk_app` where the first two arguments are `{α}` `[comm_semiring α]`.
Should be faster because it can use the cached instances.
 -/
/--
Specialized version of `mk_app ``has_add.add`.
Should be faster because it can use the cached instances.
-/
/--
Specialized version of `mk_app ``has_mul.mul`.
Should be faster because it can use the cached instances.
-/
/--
Specialized version of `mk_app ``has_pow.pow`.
Should be faster because it can use the cached instances.
-/
/-- Construct a normalization proof term or return the cached one. -/
/-- Construct a normalization proof term or return the cached one. -/
/--
If all `ex_info` have trivial proofs, return a trivial proof.
Otherwise, construct all proof terms.

Useful in applications where trivial proofs combine to another trivial proof,
most importantly to pass to `mk_proof_or_refl`.
-/
/--
Use the proof terms as arguments to the given lemma.
If the lemma could reduce to reflexivity, consider using `mk_proof_or_refl.`
-/
/--
Use the proof terms as arguments to the given lemma.
Often, we construct a proof term using congruence where reflexivity suffices.
To solve this, the following function tries to get away with reflexivity.
-/
/-- A shortcut for adding the original terms of two expressions. -/
/-- A shortcut for multiplying the original terms of two expressions. -/
/-- A shortcut for exponentiating the original terms of two expressions. -/
/-- Congruence lemma for constructing `ex.sum`. -/
theorem sum_congr {α : Type u} [comm_semiring α] {p : α} {p' : α} {ps : α} {ps' : α} : p = p' → ps = ps' → p + ps = p' + ps' := sorry

/-- Congruence lemma for constructing `ex.prod`. -/
theorem prod_congr {α : Type u} [comm_semiring α] {p : α} {p' : α} {ps : α} {ps' : α} : p = p' → ps = ps' → p * ps = p' * ps' := sorry

/-- Congruence lemma for constructing `ex.exp`. -/
theorem exp_congr {α : Type u} [comm_semiring α] {p : α} {p' : α} {ps : ℕ} {ps' : ℕ} : p = p' → ps = ps' → p ^ ps = p' ^ ps' := sorry

/-- Constructs `ex.zero` with the correct arguments. -/
/-- Constructs `ex.sum` with the correct arguments. -/
/--
Constructs `ex.coeff` with the correct arguments.

There are more efficient constructors for specific numerals:
if `x = 0`, you should use `ex_zero`; if `x = 1`, use `ex_one`.
-/
/--
Constructs `ex.coeff 1` with the correct arguments.
This is a special case for optimization purposes.
-/
/-- Constructs `ex.prod` with the correct arguments. -/
/-- Constructs `ex.var` with the correct arguments. -/
/-- Constructs `ex.sum_b` with the correct arguments. -/
/-- Constructs `ex.exp` with the correct arguments. -/
theorem base_to_exp_pf {α : Type u} [comm_semiring α] {p : α} {p' : α} : p = p' → p = p' ^ 1 := sorry

/-- Conversion from `ex base` to `ex exp`. -/
theorem exp_to_prod_pf {α : Type u} [comm_semiring α] {p : α} {p' : α} : p = p' → p = p' * 1 := sorry

/-- Conversion from `ex exp` to `ex prod`. -/
theorem prod_to_sum_pf {α : Type u} [comm_semiring α] {p : α} {p' : α} : p = p' → p = p' + 0 := sorry

/-- Conversion from `ex prod` to `ex sum`. -/
/--
theorem atom_to_sum_pf {α : Type u} [comm_semiring α] (p : α) : p = p ^ 1 * 1 + 0 := sorry

A more efficient conversion from `atom` to `ex sum`.

The result should be the same as `ex_var p >>= base_to_exp >>= exp_to_prod >>= prod_to_sum`,
except we need to calculate less intermediate steps.
-/
/--
Compute the sum of two coefficients.
Note that the result might not be a valid expression:
if `p = -q`, then the result should be `ex.zero : ex sum` instead.
The caller must detect when this happens!

The returned value is of the form `ex.coeff _ (p + q)`,
with the proof of `expr.of_rat p + expr.of_rat q = expr.of_rat (p + q)`.
-/
theorem mul_coeff_pf_one_mul {α : Type u} [comm_semiring α] (q : α) : 1 * q = q :=
  one_mul q

theorem mul_coeff_pf_mul_one {α : Type u} [comm_semiring α] (p : α) : p * 1 = p :=
  mul_one p

/--
Compute the product of two coefficients.

The returned value is of the form `ex.coeff _ (p * q)`,
with the proof of `expr.of_rat p * expr.of_rat q = expr.of_rat (p * q)`.
-/
/-! ### `rewrite` section

In this section we deal with rewriting terms to fit in the basic grammar of `eval`.
For example, `nat.succ n` is rewritten to `n + 1` before it is evaluated further.
-/

/-- Given a proof that the expressions `ps_o` and `ps'.orig` are equal,
show that `ps_o` and `ps'.pretty` are equal.

Useful to deal with aliases in `eval`. For instance, `nat.succ p` can be handled
as an alias of `p + 1` as follows:
```
| ps_o@`(nat.succ %%p_o) := do
  ps' ← eval `(%%p_o + 1),
  pf ← lift $ mk_app ``nat.succ_eq_add_one [p_o],
  rewrite ps_o ps' pf
```
-/
/--
Represents the way in which two products are equal except coefficient.

This type is used in the function `add_overlap`.
In order to deal with equations of the form `a * 2 + a = 3 * a`,
the `add` function will add up overlapping products,
turning `a * 2 + a` into `a * 3`.
We need to distinguish `a * 2 + a` from `a * 2 + b` in order to do this,
and the `overlap` type carries the information on how it overlaps.

The case `none` corresponds to non-overlapping products, e.g. `a * 2 + b`;
the case `nonzero` to overlapping products adding to non-zero, e.g. `a * 2 + a`
(the `ex prod` field will then look like `a * 3` with a proof that `a * 2 + a = a * 3`);
the case `zero` to overlapping products adding to zero, e.g. `a * 2 + a * -2`.
We distinguish those two cases because in the second, the whole product reduces to `0`.

A potential extension to the tactic would also do this for the base of exponents,
e.g. to show `2^n * 2^n = 4^n`.
-/
theorem add_overlap_pf {α : Type u} [comm_semiring α] {ps : α} {qs : α} {pq : α} (p : α) : ps + qs = pq → p * ps + p * qs = p * pq :=
  fun (pq_pf : ps + qs = pq) =>
    Eq.trans (symm (mul_add p ps qs))
      (eq.mpr (id (Eq._oldrec (Eq.refl (p * (ps + qs) = p * pq)) pq_pf)) (Eq.refl (p * pq)))

theorem add_overlap_pf_zero {α : Type u} [comm_semiring α] {ps : α} {qs : α} (p : α) : ps + qs = 0 → p * ps + p * qs = 0 := sorry

/--
Given arguments `ps`, `qs` of the form `ps' * x` and `ps' * y` respectively
return `ps + qs = ps' * (x + y)` (with `x` and `y` arbitrary coefficients).
For other arguments, return `overlap.none`.
-/
theorem add_pf_z_sum {α : Type u} [comm_semiring α] {ps : α} {qs : α} {qs' : α} : ps = 0 → qs = qs' → ps + qs = qs' := sorry

theorem add_pf_sum_z {α : Type u} [comm_semiring α] {ps : α} {ps' : α} {qs : α} : ps = ps' → qs = 0 → ps + qs = ps' := sorry

theorem add_pf_sum_overlap {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {qqs : α} {q : α} {qs : α} {pq : α} {pqs : α} : pps = p + ps → qqs = q + qs → p + q = pq → ps + qs = pqs → pps + qqs = pq + pqs := sorry

theorem add_pf_sum_overlap_zero {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {qqs : α} {q : α} {qs : α} {pqs : α} : pps = p + ps → qqs = q + qs → p + q = 0 → ps + qs = pqs → pps + qqs = pqs := sorry

theorem add_pf_sum_lt {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {qqs : α} {pqs : α} : pps = p + ps → ps + qqs = pqs → pps + qqs = p + pqs := sorry

theorem add_pf_sum_gt {α : Type u} [comm_semiring α] {pps : α} {qqs : α} {q : α} {qs : α} {pqs : α} : qqs = q + qs → pps + qs = pqs → pps + qqs = q + pqs := sorry

/--
Add two expressions.

* `0 + qs = 0`
* `ps + 0 = 0`
* `ps * x + ps * y = ps * (x + y)` (for `x`, `y` coefficients; uses `add_overlap`)
* `(p + ps) + (q + qs) = p + (ps + (q + qs))` (if `p.lt q`)
* `(p + ps) + (q + qs) = q + ((p + ps) + qs)` (if not `p.lt q`)
-/
theorem mul_pf_c_c {α : Type u} [comm_semiring α] {ps : α} {ps' : α} {qs : α} {qs' : α} {pq : α} : ps = ps' → qs = qs' → ps' * qs' = pq → ps * qs = pq := sorry

theorem mul_pf_c_prod {α : Type u} [comm_semiring α] {ps : α} {qqs : α} {q : α} {qs : α} {pqs : α} : qqs = q * qs → ps * qs = pqs → ps * qqs = q * pqs := sorry

theorem mul_pf_prod_c {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {qs : α} {pqs : α} : pps = p * ps → ps * qs = pqs → pps * qs = p * pqs := sorry

theorem mul_pp_pf_overlap {α : Type u} [comm_semiring α] {pps : α} {p_b : α} {ps : α} {qqs : α} {qs : α} {psqs : α} {p_e : ℕ} {q_e : ℕ} : pps = p_b ^ p_e * ps → qqs = p_b ^ q_e * qs → p_b ^ (p_e + q_e) * (ps * qs) = psqs → pps * qqs = psqs := sorry

theorem mul_pp_pf_prod_lt {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {qqs : α} {pqs : α} : pps = p * ps → ps * qqs = pqs → pps * qqs = p * pqs := sorry

theorem mul_pp_pf_prod_gt {α : Type u} [comm_semiring α] {pps : α} {qqs : α} {q : α} {qs : α} {pqs : α} : qqs = q * qs → pps * qs = pqs → pps * qqs = q * pqs := sorry

/--
Multiply two expressions.

* `x * y = (x * y)` (for `x`, `y` coefficients)
* `x * (q * qs) = q * (qs * x)` (for `x` coefficient)
* `(p * ps) * y = p * (ps * y)` (for `y` coefficient)
* `(p_b^p_e * ps) * (p_b^q_e * qs) = p_b^(p_e + q_e) * (ps * qs)`
    (if `p_e` and `q_e` are identical except coefficient)
* `(p * ps) * (q * qs) = p * (ps * (q * qs))` (if `p.lt q`)
* `(p * ps) * (q * qs) = q * ((p * ps) * qs)` (if not `p.lt q`)
-/
theorem mul_p_pf_zero {α : Type u} [comm_semiring α] {ps : α} {qs : α} : ps = 0 → ps * qs = 0 :=
  fun (ps_pf : ps = 0) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (ps * qs = 0)) ps_pf))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * qs = 0)) (zero_mul qs))) (Eq.refl 0))

theorem mul_p_pf_sum {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {qs : α} {ppsqs : α} : pps = p + ps → p * qs + ps * qs = ppsqs → pps * qs = ppsqs := sorry

/--
Multiply two expressions.

* `0 * qs = 0`
* `(p + ps) * qs = (p * qs) + (ps * qs)`
-/
theorem mul_pf_zero {α : Type u} [comm_semiring α] {ps : α} {qs : α} : qs = 0 → ps * qs = 0 :=
  fun (qs_pf : qs = 0) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (ps * qs = 0)) qs_pf))
      (eq.mpr (id (Eq._oldrec (Eq.refl (ps * 0 = 0)) (mul_zero ps))) (Eq.refl 0))

theorem mul_pf_sum {α : Type u} [comm_semiring α] {ps : α} {qqs : α} {q : α} {qs : α} {psqqs : α} : qqs = q + qs → ps * q + ps * qs = psqqs → ps * qqs = psqqs := sorry

/--
Multiply two expressions.

* `ps * 0 = 0`
* `ps * (q + qs) = (ps * q) + (ps * qs)`
-/
theorem pow_e_pf_exp {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : ℕ} {qs : ℕ} {psqs : ℕ} : pps = p ^ ps → ps * qs = psqs → pps ^ qs = p ^ psqs := sorry

/--
Compute the exponentiation of two coefficients.

The returned value is of the form `ex.coeff _ (p ^ q)`,
with the proof of `expr.of_rat p ^ expr.of_rat q = expr.of_rat (p ^ q)`.
-/
/--
Exponentiate two expressions.

* `(p ^ ps) ^ qs = p ^ (ps * qs)`
-/
theorem pow_pp_pf_one {α : Type u} [comm_semiring α] {ps : α} {qs : ℕ} : ps = 1 → ps ^ qs = 1 :=
  fun (ps_pf : ps = 1) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (ps ^ qs = 1)) ps_pf))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 ^ qs = 1)) (one_pow qs))) (Eq.refl 1))

theorem pow_pf_c_c {α : Type u} [comm_semiring α] {ps : α} {ps' : α} {pq : α} {qs : ℕ} {qs' : ℕ} : ps = ps' → qs = qs' → ps' ^ qs' = pq → ps ^ qs = pq := sorry

theorem pow_pp_pf_c {α : Type u} [comm_semiring α] {ps : α} {ps' : α} {pqs : α} {qs : ℕ} {qs' : ℕ} : ps = ps' → qs = qs' → ps' ^ qs' = pqs → ps ^ qs = pqs * 1 := sorry

theorem pow_pp_pf_prod {α : Type u} [comm_semiring α] {pps : α} {p : α} {ps : α} {pqs : α} {psqs : α} {qs : ℕ} : pps = p * ps → p ^ qs = pqs → ps ^ qs = psqs → pps ^ qs = pqs * psqs := sorry

/--
Exponentiate two expressions.

* `1 ^ qs = 1`
* `x ^ qs = x ^ qs` (for `x` coefficient)
* `(p * ps) ^ qs = p ^ qs + ps ^ qs`
-/
theorem pow_p_pf_one {α : Type u} [comm_semiring α] {ps : α} {ps' : α} {qs : ℕ} : ps = ps' → qs = 1 → ps ^ qs = ps' := sorry

theorem pow_p_pf_zero {α : Type u} [comm_semiring α] {ps : α} {qs : ℕ} {qs' : ℕ} : ps = 0 → qs = Nat.succ qs' → ps ^ qs = 0 := sorry

theorem pow_p_pf_succ {α : Type u} [comm_semiring α] {ps : α} {pqqs : α} {qs : ℕ} {qs' : ℕ} : qs = Nat.succ qs' → ps * ps ^ qs' = pqqs → ps ^ qs = pqqs := sorry

theorem pow_p_pf_singleton {α : Type u} [comm_semiring α] {pps : α} {p : α} {pqs : α} {qs : ℕ} : pps = p + 0 → p ^ qs = pqs → pps ^ qs = pqs := sorry

theorem pow_p_pf_cons {α : Type u} [comm_semiring α] {ps : α} {ps' : α} {qs : ℕ} {qs' : ℕ} : ps = ps' → qs = qs' → ps ^ qs = ps' ^ qs' := sorry

/--
Exponentiate two expressions.

* `ps ^ 1 = ps`
* `0 ^ qs = 0` (note that this is handled *after* `ps ^ 0 = 1`)
* `(p + 0) ^ qs = p ^ qs`
* `ps ^ (qs + 1) = ps * ps ^ qs` (note that this is handled *after* `p + 0 ^ qs = p ^ qs`)
* `ps ^ qs = ps ^ qs` (otherwise)
-/
theorem pow_pf_zero {α : Type u} [comm_semiring α] {ps : α} {qs : ℕ} : qs = 0 → ps ^ qs = 1 :=
  fun (qs_pf : qs = 0) =>
    Eq.trans (eq.mpr (id (Eq._oldrec (Eq.refl (ps ^ qs = ps ^ 0)) qs_pf)) (Eq.refl (ps ^ 0))) (pow_zero ps)

theorem pow_pf_sum {α : Type u} [comm_semiring α] {ps : α} {psqqs : α} {qqs : ℕ} {q : ℕ} {qs : ℕ} : qqs = q + qs → ps ^ q * ps ^ qs = psqqs → ps ^ qqs = psqqs := sorry

/--
Exponentiate two expressions.

* `ps ^ 0 = 1`
* `ps ^ (q + qs) = ps ^ q * ps ^ qs`
-/
theorem simple_pf_sum_zero {α : Type u} [comm_semiring α] {p : α} {p' : α} : p = p' → p + 0 = p' := sorry

theorem simple_pf_prod_one {α : Type u} [comm_semiring α] {p : α} {p' : α} : p = p' → p * 1 = p' := sorry

theorem simple_pf_prod_neg_one {α : Type u_1} [ring α] {p : α} {p' : α} : p = p' → p * -1 = -p' := sorry

theorem simple_pf_var_one {α : Type u} [comm_semiring α] (p : α) : p ^ 1 = p := sorry

theorem simple_pf_exp_one {α : Type u} [comm_semiring α] {p : α} {p' : α} : p = p' → p ^ 1 = p' := sorry

/--
Give a simpler, more human-readable representation of the normalized expression.

Normalized expressions might have the form `a^1 * 1 + 0`,
since the dummy operations reduce special cases in pattern-matching.
Humans prefer to read `a` instead.
This tactic gets rid of the dummy additions, multiplications and exponentiations.
-/
/--
Performs a lookup of the atom `a` in the list of known atoms,
or allocates a new one.

If `a` is not definitionally equal to any of the list's entries,
a new atom is appended to the list and returned.
The index of this atom is kept track of in the second inductive argument.

This function is mostly useful in `resolve_atom`,
which updates the state with the new list of atoms.
-/
/--
Convert the expression to an atom:
either look up a definitionally equal atom,
or allocate it as a new atom.

You probably want to use `eval_base` if `eval` doesn't work
instead of directly calling `resolve_atom`,
since `eval_base` can also handle numerals.
-/
/--
Treat the expression atomically: as a coefficient or atom.

Handles cases where `eval` cannot treat the expression as a known operation
because it is just a number or single variable.
-/
theorem negate_pf {α : Type u_1} [ring α] {ps : α} {ps' : α} : -1 * ps = ps' → -ps = ps' := sorry

/--
Negate an expression by multiplying with `-1`.

Only works if there is a `ring` instance; otherwise it will `fail`.
-/
theorem inverse_pf {α : Type u_1} [division_ring α] {ps : α} {ps_u : α} {ps_p : α} {e' : α} {e'' : α} : ps = ps_u → ps_u = ps_p → ps_p⁻¹ = e' → e' = e'' → ps⁻¹ = e'' := sorry

/--
Invert an expression by simplifying, applying `has_inv.inv` and treating the result as an atom.

Only works if there is a `division_ring` instance; otherwise it will `fail`.
-/
theorem sub_pf {α : Type u_1} [ring α] {ps : α} {qs : α} {psqs : α} (h : ps + -qs = psqs) : ps - qs = psqs :=
  eq.mpr (id (Eq._oldrec (Eq.refl (ps - qs = psqs)) (sub_eq_add_neg ps qs))) h

theorem div_pf {α : Type u_1} [division_ring α] {ps : α} {qs : α} {psqs : α} (h : ps * (qs⁻¹) = psqs) : ps / qs = psqs :=
  eq.mpr (id (Eq._oldrec (Eq.refl (ps / qs = psqs)) (div_eq_mul_inv ps qs))) h

/-!
### `wiring` section

This section deals with going from `expr` to `ex` and back.

The main attraction is `eval`, which uses `add`, `mul`, etc.
to calculate an `ex` from a given `expr`.
Other functions use `ex`es to produce `expr`s together with a proof,
or produce the context to run `ring_exp_m` from an `expr`.
-/

/--
Compute a normalized form (of type `ex`) from an expression (of type `expr`).

This is the main driver of the `ring_exp` tactic,
calling out to `add`, `mul`, `pow`, etc. to parse the `expr`.
-/
/--
Run `eval` on the expression and return the result together with normalization proof.

See also `eval_simple` if you want something that behaves like `norm_num`.
-/
/--
Run `eval` on the expression and simplify the result.

Returns a simplified normalized expression, together with an equality proof.

See also `eval_with_proof` if you just want to check the equality of two expressions.
-/
/-- Compute the `eval_info` for a given type `α`. -/
/-- Use `e` to build the context for running `mx`. -/
/-- Repeatedly apply `eval_simple` on (sub)expressions. -/
end tactic.ring_exp

namespace tactic.interactive

/--
Tactic for solving equations of *commutative* (semi)rings,
allowing variables in the exponent.
This version of `ring_exp` fails if the target is not an equality.

The variant `ring_exp_eq!` will use a more aggressive reducibility setting
to determine equality of atoms.
-/
/--
Tactic for evaluating expressions in *commutative* (semi)rings, allowing for variables in the
exponent.

This tactic extends `ring`: it should solve every goal that `ring` can solve.
Additionally, it knows how to evaluate expressions with complicated exponents
(where `ring` only understands constant exponents).
The variants `ring_exp!` and `ring_exp_eq!` use a more aggessive reducibility setting to determine
equality of atoms.

For example:
```lean
example (n : ℕ) (m : ℤ) : 2^(n+1) * m = 2 * 2^n * m := by ring_exp
example (a b : ℤ) (n : ℕ) : (a + b)^(n + 2) = (a^2 + b^2 + a * b + b * a) * (a + b)^n := by ring_exp
example (x y : ℕ) : x + id y = y + id x := by ring_exp!
```
-/


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.fin2
import tactic.localized

/-!
# Alternate definition of `vector` in terms of `fin2`

This file provides a locale `vector3` which overrides `[a, b, c]` notation to create `vector3` not
`list`.

The `::` notation is overloaded by this file to mean `vector3.cons`.
-/

open fin2 nat

universes u
variables {α : Type*} {m n : ℕ}

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) : Type u := fin2 n → α

instance [inhabited α] : inhabited (vector3 α n) := pi.inhabited _

namespace vector3

/-- The empty vector -/
@[pattern] def nil : vector3 α 0.

/-- The vector cons operation -/
@[pattern] def cons (a : α) (v : vector3 α n) : vector3 α (succ n) :=
λ i, by { refine i.cases' _ _, exact a, exact v }

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
localized "notation `[` l:(foldr `, ` (h t, vector3.cons h t) vector3.nil `]`) := l" in vector3
notation a :: b := cons a b

@[simp] lemma cons_fz (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
@[simp] lemma cons_fs (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl

/-- Get the `i`th element of a vector -/
@[reducible] def nth (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
@[reducible] def of_fn (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head (v : vector3 α (succ n)) : α := v fz

/-- Get the tail of a nonempty vector. -/
def tail (v : vector3 α (succ n)) : vector3 α n := λ i, v (fs i)

lemma eq_nil (v : vector3 α 0) : v = [] := funext $ λ i, match i with end

lemma cons_head_tail (v : vector3 α (succ n)) : head v :: tail v = v :=
funext $ λ i, fin2.cases' rfl (λ _, rfl) i

/-- Eliminator for an empty vector. -/
def nil_elim {C : vector3 α 0 → Sort u} (H : C []) (v : vector3 α 0) : C v :=
by rw eq_nil v; apply H

/-- Recursion principle for a nonempty vector. -/
def cons_elim {C : vector3 α (succ n) → Sort u} (H : Π (a : α) (t : vector3 α n), C (a :: t))
  (v : vector3 α (succ n)) : C v :=
by rw ← (cons_head_tail v); apply H

@[simp] lemma cons_elim_cons {C H a t} : @cons_elim α n C H (a :: t) = H a t := rfl

/-- Recursion principle with the vector as first argument. -/
@[elab_as_eliminator]
protected def rec_on {C : Π {n}, vector3 α n → Sort u} {n} (v : vector3 α n)
  (H0 : C [])
  (Hs : Π {n} (a) (w : vector3 α n), C w → C (a :: w)) : C v :=
nat.rec_on n
  (λ v, v.nil_elim H0)
  (λ n IH v, v.cons_elim (λ a t, Hs _ _ (IH _))) v

@[simp] lemma rec_on_nil {C H0 Hs} : @vector3.rec_on α @C 0 [] H0 @Hs = H0 := rfl

@[simp] lemma rec_on_cons {C H0 Hs n a v} :
  @vector3.rec_on α @C (succ n) (a :: v) H0 @Hs = Hs a v (@vector3.rec_on α @C n v H0 @Hs) :=
rfl

/-- Append two vectors -/
def append (v : vector3 α m) (w : vector3 α n) : vector3 α (n+m) :=
nat.rec_on m (λ _, w) (λ m IH v, v.cons_elim $ λ a t, @fin2.cases' (n+m) (λ _, α) a (IH t)) v

local infix ` +-+ `:65 := vector3.append

@[simp] lemma append_nil (w : vector3 α n) : [] +-+ w = w := rfl

@[simp] lemma append_cons (a : α) (v : vector3 α m) (w : vector3 α n) :
  (a :: v) +-+ w = a :: (v +-+ w) := rfl

@[simp] lemma append_left : ∀ {m} (i : fin2 m) (v : vector3 α m) {n} (w : vector3 α n),
  (v +-+ w) (left n i) = v i
| ._ (@fz m)   v n w := v.cons_elim (λ a t, by simp [*, left])
| ._ (@fs m i) v n w := v.cons_elim (λ a t, by simp [*, left])

@[simp] lemma append_add : ∀ {m} (v : vector3 α m) {n} (w : vector3 α n) (i : fin2 n),
  (v +-+ w) (add i m) = w i
| 0        v n w i := rfl
| (succ m) v n w i := v.cons_elim (λ a t, by simp [*, add])

/-- Insert `a` into `v` at index `i`. -/
def insert (a : α) (v : vector3 α n) (i : fin2 (succ n)) : vector3 α (succ n) :=
λ j, (a :: v) (insert_perm i j)

@[simp] lemma insert_fz (a : α) (v : vector3 α n) : insert a v fz = a :: v :=
by refine funext (λ j, j.cases' _ _); intros; refl

@[simp] lemma insert_fs (a : α) (b : α) (v : vector3 α n) (i : fin2 (succ n)) :
  insert a (b :: v) (fs i) = b :: insert a v i :=
funext $ λ j, by
{ refine j.cases' _ (λ j, _); simp [insert, insert_perm],
  refine fin2.cases' _ _ (insert_perm i j); simp [insert_perm] }

lemma append_insert (a : α) (t : vector3 α m) (v : vector3 α n) (i : fin2 (succ n))
  (e : succ n + m = succ (n + m)) :
  insert a (t +-+ v) (eq.rec_on e (i.add m)) = eq.rec_on e (t +-+ insert a v i) :=
begin
  refine vector3.rec_on t (λ e, _) (λ k b t IH e, _) e, refl,
  have e' := succ_add n k,
  change insert a (b :: (t +-+ v)) (eq.rec_on (congr_arg succ e') (fs (add i k)))
    = eq.rec_on (congr_arg succ e') (b :: (t +-+ insert a v i)),
  rw ← (eq.drec_on e' rfl : fs (eq.rec_on e' (i.add k) : fin2 (succ (n + k))) = eq.rec_on
    (congr_arg succ e') (fs (i.add k))),
  simp, rw IH, exact eq.drec_on e' rfl
end

end vector3

section vector3
open vector3
open_locale vector3

/-- "Curried" exists, i.e. `∃ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def vector_ex : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∃x : α, vector_ex k (λ v, f (x :: v))

/-- "Curried" forall, i.e. `∀ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def vector_all : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∀ x : α, vector_all k (λ v, f (x :: v))

lemma exists_vector_zero (f : vector3 α 0 → Prop) : Exists f ↔ f [] :=
⟨λ ⟨v, fv⟩, by rw ← (eq_nil v); exact fv, λ f0, ⟨[], f0⟩⟩

lemma exists_vector_succ (f : vector3 α (succ n) → Prop) : Exists f ↔ ∃x v, f (x :: v) :=
⟨λ ⟨v, fv⟩, ⟨_, _, by rw cons_head_tail v; exact fv⟩, λ ⟨x, v, fxv⟩, ⟨_, fxv⟩⟩

lemma vector_ex_iff_exists : ∀ {n} (f : vector3 α n → Prop), vector_ex n f ↔ Exists f
| 0        f := (exists_vector_zero f).symm
| (succ n) f := iff.trans (exists_congr (λ x, vector_ex_iff_exists _)) (exists_vector_succ f).symm

lemma vector_all_iff_forall : ∀ {n} (f : vector3 α n → Prop), vector_all n f ↔ ∀ v, f v
| 0        f := ⟨λ f0 v, v.nil_elim f0, λ al, al []⟩
| (succ n) f := (forall_congr (λ x, vector_all_iff_forall (λ v, f (x :: v)))).trans
  ⟨λ al v, v.cons_elim al, λ al x v, al (x :: v)⟩

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp (p : α → Prop) (v : vector3 α n) : Prop :=
vector3.rec_on v true (λ n a v IH, @vector3.rec_on _ (λ n v, Prop) _ v (p a) (λ n b v' _, p a ∧ IH))

@[simp] lemma vector_allp_nil (p : α → Prop) : vector_allp p [] = true := rfl
@[simp] lemma vector_allp_singleton (p : α → Prop) (x : α) : vector_allp p [x] = p x := rfl
@[simp] lemma vector_allp_cons (p : α → Prop) (x : α) (v : vector3 α n) :
  vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
vector3.rec_on v (and_true _).symm (λ n a v IH, iff.rfl)

lemma vector_allp_iff_forall (p : α → Prop) (v : vector3 α n) : vector_allp p v ↔ ∀ i, p (v i) :=
begin
  refine v.rec_on _ _,
  { exact ⟨λ _, fin2.elim0, λ _, trivial⟩ },
  { simp, refine λ n a v IH, (and_congr_right (λ _, IH)).trans
      ⟨λ ⟨pa, h⟩ i, by {refine i.cases' _ _, exacts [pa, h]}, λ h, ⟨_, λ i, _⟩⟩,
    { have h0 := h fz, simp at h0, exact h0 },
    { have hs := h (fs i), simp at hs, exact hs } }
end

lemma vector_allp.imp {p q : α → Prop} (h : ∀ x, p x → q x) {v : vector3 α n}
  (al : vector_allp p v) : vector_allp q v :=
(vector_allp_iff_forall _ _).2 (λ i, h _ $ (vector_allp_iff_forall _ _).1 al _)

end vector3


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module data.finset.sum
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Sum
import Mathlib.Data.Finset.Card

/-!
# Disjoint sum of finsets

This file defines the disjoint sum of two finsets as `Finset (α ⊕ β)`. Beware not to confuse with
the `Finset.sum` operation which computes the additive sum.

## Main declarations

* `Finset.disjSum`: `s.disjSum t` is the disjoint sum of `s` and `t`.
-/

open Function Multiset Sum

namespace Finset

variable {α β : Type _} (s : Finset α) (t : Finset β)

/-- Disjoint sum of finsets. -/
def disjSum : Finset (Sum α β) :=
  ⟨s.1.disjSum t.1, s.2.disjSum t.2⟩
#align finset.disj_sum Finset.disjSum

@[simp]
theorem val_disjSum : (s.disjSum t).1 = s.1.disjSum t.1 :=
  rfl
#align finset.val_disj_sum Finset.val_disjSum

@[simp]
theorem empty_disjSum : (∅ : Finset α).disjSum t = t.map Embedding.inr :=
  val_inj.1 <| Multiset.zero_disjSum _
#align finset.empty_disj_sum Finset.empty_disjSum

@[simp]
theorem disjSum_empty : s.disjSum (∅ : Finset β) = s.map Embedding.inl :=
  val_inj.1 <| Multiset.disjSum_zero _
#align finset.disj_sum_empty Finset.disjSum_empty

@[simp]
theorem card_disjSum : (s.disjSum t).card = s.card + t.card :=
  Multiset.card_disjSum _ _
#align finset.card_disj_sum Finset.card_disjSum

theorem disjoint_map_inl_map_inr : Disjoint (s.map Embedding.inl) (t.map Embedding.inr) :=
  by
  simp_rw [disjoint_left, mem_map]
  rintro x ⟨a, _, rfl⟩ ⟨b, _, ⟨⟩⟩
#align finset.disjoint_map_inl_map_inr Finset.disjoint_map_inl_map_inr

@[simp]
theorem map_inl_disjUnion_map_inr :
    (s.map Embedding.inl).disjUnion (t.map Embedding.inr) (disjoint_map_inl_map_inr _ _) =
      s.disjSum t :=
  rfl
#align finset.map_inl_disj_union_map_inr Finset.map_inl_disjUnion_map_inr

variable {s t} {s₁ s₂ : Finset α} {t₁ t₂ : Finset β} {a : α} {b : β} {x : Sum α β}

theorem mem_disjSum : x ∈ s.disjSum t ↔ (∃ a, a ∈ s ∧ inl a = x) ∨ ∃ b, b ∈ t ∧ inr b = x :=
  Multiset.mem_disjSum
#align finset.mem_disj_sum Finset.mem_disjSum

@[simp]
theorem inl_mem_disjSum : inl a ∈ s.disjSum t ↔ a ∈ s :=
  Multiset.inl_mem_disjSum
#align finset.inl_mem_disj_sum Finset.inl_mem_disjSum

@[simp]
theorem inr_mem_disjSum : inr b ∈ s.disjSum t ↔ b ∈ t :=
  Multiset.inr_mem_disjSum
#align finset.inr_mem_disj_sum Finset.inr_mem_disjSum

theorem disjSum_mono_left (t : Finset β) : Monotone fun s : Finset α => s.disjSum t :=
  fun _ _ hs => disjSum_mono hs Subset.rfl
#align finset.disj_sum_mono_left Finset.disjSum_mono_left

theorem disjSum_mono_right (s : Finset α) : Monotone (s.disjSum : Finset β → Finset (Sum α β)) :=
  fun _ _ => disjSum_mono Subset.rfl
#align finset.disj_sum_mono_right Finset.disjSum_mono_right

theorem disjSum_ssubset_disjSum_of_ssubset_of_subset (hs : s₁ ⊂ s₂) (ht : t₁ ⊆ t₂) :
    s₁.disjSum t₁ ⊂ s₂.disjSum t₂ :=
  val_lt_iff.1 <| disjSum_lt_disjSum_of_lt_of_le (val_lt_iff.2 hs) (val_le_iff.2 ht)
#align finset.disj_sum_ssubset_disj_sum_of_ssubset_of_subset Finset.disjSum_ssubset_disjSum_of_ssubset_of_subset

theorem disjSum_ssubset_disjSum_of_subset_of_ssubset (hs : s₁ ⊆ s₂) (ht : t₁ ⊂ t₂) :
    s₁.disjSum t₁ ⊂ s₂.disjSum t₂ :=
  val_lt_iff.1 <| disjSum_lt_disjSum_of_le_of_lt (val_le_iff.2 hs) (val_lt_iff.2 ht)
#align finset.disj_sum_ssubset_disj_sum_of_subset_of_ssubset Finset.disjSum_ssubset_disjSum_of_subset_of_ssubset

theorem disjSum_strictMono_left (t : Finset β) : StrictMono fun s : Finset α => s.disjSum t :=
  fun _ _ hs => disjSum_ssubset_disjSum_of_ssubset_of_subset hs Subset.rfl
#align finset.disj_sum_strict_mono_left Finset.disjSum_strictMono_left

theorem disj_sum_strictMono_right (s : Finset α) :
    StrictMono (s.disjSum : Finset β → Finset (Sum α β)) := fun _ _ =>
  disjSum_ssubset_disjSum_of_subset_of_ssubset Subset.rfl
#align finset.disj_sum_strict_mono_right Finset.disj_sum_strictMono_right

end Finset


import Automation
open tactic

def ℙ := Prop
class Same (φ: Type) := (same: φ → φ → ℙ)
notation x `≡` y := Same.same x y
instance Same_arrow (α β: Type) [Same β]: Same (α → β) := Same.mk (λ f₁ f₂, ∀ x, f₁ x ≡ f₂ x)
instance Same_proposition: Same ℙ := Same.mk (λ p q, p ↔ q)

notation α `~` β := α → β → ℙ
def identity {α}: α ~ α := λ x y, x = y
def compose {α β γ}
  : (α ~ β) → (β ~ γ) → (α ~ γ)
  := λ r₁ r₂, λ x z, ∃ y, (r₁ x y ∧ r₂ y z)
local notation r₂ `∘` r₁ := compose r₁ r₂

theorem has_left_identity (α β: Type): ∀ (r: α ~ β), identity ∘ r ≡ r :=
begin
  intros, unfold identity, unfold compose,
  dsimp {md := transparency.instances},
  crush,
end

theorem has_right_identity (α β: Type): ∀ (r: α ~ β), r ∘ identity ≡ r :=
begin
  intros, unfold identity, unfold compose,
  dsimp {md := transparency.instances},
  crush,
end

theorem has_identity (α β: Type): ∀ (r: α ~ β), (identity ∘ r ≡ r) ∧ (r ∘ identity ≡ r) :=
begin
  intros, unfold identity, unfold compose,
  dsimp {md := transparency.instances},
  crush,
end

theorem exists_identity (α β: Type): ∀ (r: α ~ β), ∃ (ε: ∀ (type: Type), type ~ type), (ε β ∘ r ≡ r) ∧ (r ∘ ε α ≡ r) :=
begin
  intros, unfold compose,
  dsimp {md := transparency.instances},
  existsi (λ τ x y, x = y), crush,
end

theorem compose_is_associative (α β γ δ: Type)
  : ∀ (r₁: α ~ β) (r₂: β ~ γ) (r₃: γ ~ δ)
  , (r₃ ∘ r₂) ∘ r₁ ≡ r₃ ∘ (r₂ ∘ r₁) :=
begin
  intros, unfold compose,
  dsimp {md := transparency.instances},
  crush,
end


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

namespace Mathlib

namespace tactic

/-- Apply the function `f` given by `e : pexpr` to the local hypothesis `hyp`, which must either be
of the form `a = b` or `a ≤ b`, replacing the type of `hyp` with `f a = f b` or `f a ≤ f b`. If
`hyp` names an inequality then a new goal `monotone f` is created, unless the name of a proof of
this fact is passed as the optional argument `mono_lem`, or the `mono` tactic can prove it.
-/
namespace interactive

/--
Apply a function to some local assumptions which are either equalities
or inequalities. For instance, if the context contains `h : a = b` and
some function `f` then `apply_fun f at h` turns `h` into
`h : f a = f b`. When the assumption is an inequality `h : a ≤ b`, a side
goal `monotone f` is created, unless this condition is provided using
`apply_fun f at h using P` where `P : monotone f`, or the `mono` tactic
can prove it.

Typical usage is:
```lean
open function

example (X Y Z : Type) (f : X → Y) (g : Y → Z) (H : injective $ g ∘ f) :
  injective f :=
begin
  intros x x' h,
  apply_fun g at h,
  exact H h
end
```
 -/
end Mathlib