import data.nat.basic data.int.basic data.nat.modeq tactic.norm_num data.nat.prime
namespace nat

def mod_inv_aux : ℕ → ℕ → ℤ
| 0        p := 0
| (succ m) p := have (p%succ m)<succ m:=mod_lt p (succ_pos m),
(↑(gcd (succ m) p) - (mod_inv_aux (p%succ m) (succ m)*↑p))/↑(succ m)
def mod_inv : ℕ → ℕ → ℕ := λ m p, int.nat_abs (mod_inv_aux m p % (↑(p/gcd m p)))

theorem mod_inv_aux_bezout :∀ a b:ℕ,mod_inv_aux a b * ↑a +mod_inv_aux (b%a) a * ↑b = gcd a b:=begin
    assume m p,rw add_comm,apply gcd.induction m p,assume n,rw mod_zero,simp[mod_inv_aux],cases n with n,simp [mod_inv_aux],simp [mod_inv_aux],rw int.div_self,norm_num,
    rw [←int.coe_nat_zero,add_comm,int.coe_nat_add_one_out,int.coe_nat_eq_coe_nat_iff],exact dec_trivial,intros m1 p1,cases m1 with m1,intros,exfalso,revert a,exact dec_trivial,
    have: mod_inv_aux (succ m1) p1 = (↑(gcd (succ m1) p1) - mod_inv_aux (p1 % succ m1) (succ m1) * ↑p1) / ↑(succ m1):=by unfold mod_inv_aux,
    rw this,assume H H1,rw [eq_comm,←sub_eq_iff_eq_add] at H1,unfold gcd,
    rw[int.mod_def,mul_sub,←sub_add,eq_comm,←sub_eq_iff_eq_add,mul_comm _ (↑p1 / ↑(succ m1)),←mul_assoc,←sub_mul] at H1,rw ←H1,rw int.mul_div_cancel,rw [sub_mul,sub_eq_iff_eq_add] at H1,
    rw [sub_mul,H1],norm_num,rw[←int.coe_nat_zero,add_comm,int.coe_nat_add_one_out,int.coe_nat_eq_coe_nat_iff],exact dec_trivial,
end

theorem mod_inv_gcd :∀ m p:ℕ,p>0→ m * mod_inv m p ≡ gcd m p [MOD p]:=begin
    unfold mod_inv,assume m p Hp,rw modeq.modeq_iff_dvd,
    have H2:∀ x y:ℤ, x%y = x - y * (x/y) :=begin assume x y, rw[eq_comm,sub_eq_iff_eq_add,eq_comm],apply int.mod_add_div, end,
    rw [←mod_inv_aux_bezout,int.coe_nat_mul, ←int.abs_eq_nat_abs,abs_of_nonneg, H2,mul_sub],simp,rw [←add_assoc,←add_assoc,mul_comm (↑m),add_comm (mod_inv_aux m p * ↑m)],simp,
    have : p ∣ (p/gcd m p) * m:=begin cases exists_eq_mul_right_of_dvd (and.left(gcd_dvd m p)) with c Hc,
    have : p / gcd m p * m= p /gcd m p *gcd m p * c:=by rw[mul_assoc,←Hc],rw this,rw nat.div_mul_cancel (and.right(gcd_dvd m p)),simp,end,
    apply dvd_add,simp,rw ←int.coe_nat_dvd at this,rw [←mul_assoc,←int.coe_nat_mul,mul_comm m],apply dvd_mul_of_dvd_left this,
    apply int.mod_nonneg,cases exists_eq_mul_left_of_dvd (and.right(gcd_dvd m p)) with c Hc,have :p / gcd m p=c*gcd m p/gcd m p:= by rw ←Hc,rw this,rw nat.mul_div_cancel,intro,rw [←int.coe_nat_zero,int.coe_nat_eq_coe_nat_iff] at a,rw a at Hc,simp at Hc,rw Hc at Hp,revert Hp,exact dec_trivial,
    apply gcd_pos_of_pos_right m Hp,
end
theorem mod_inv_unique :∀ m n p:ℕ,p>0→ coprime m p→ (m * n ≡ 1 [MOD p] ↔ n ≡ mod_inv m p [MOD p]):=begin
    assume m n p Hp Hc,apply iff.intro,assume H,
    have H1:= modeq.modeq_mul (modeq.refl (mod_inv m p)) H,
    rw [←mul_assoc,mul_comm _ m] at H1,have H2:=modeq.trans (modeq.symm(modeq.modeq_mul (mod_inv_gcd m p Hp) (modeq.refl n))) H1,
    rw coprime.gcd_eq_one Hc at H2,simp at H2,exact H2,intro, have :=modeq.trans (modeq.modeq_mul (modeq.refl m) a) (mod_inv_gcd m p Hp),
    rw coprime.gcd_eq_one Hc at this,assumption,
end
theorem modeq_mul_cancel{ a b c p:ℕ}:p > 0 → coprime a p → (a * b ≡ a * c [MOD p] ↔ b ≡ c [MOD p]):=begin
    assume H0 Hco,apply iff.intro,assume H, have H1:=modeq.modeq_mul (modeq.refl (mod_inv a p)) H,rw[←mul_assoc,←mul_assoc] at H1,
    have Hb:=modeq.symm (modeq.modeq_mul (mod_inv_gcd a p H0) (modeq.refl b)),
    have Hc:=(modeq.modeq_mul (mod_inv_gcd a p H0) (modeq.refl c)),rw [coprime.gcd_eq_one Hco,one_mul,mul_comm a] at *,
    exact modeq.trans (modeq.trans Hb H1) Hc,exact modeq.modeq_mul (modeq.refl a),
end
theorem modeq_zero:∀ a b:ℕ, a ≡ b [MOD 0] ↔ a = b:=λ a b, by simp[modeq]
open list
theorem modeq_prod_list : ∀ (A B : list ℕ) (z:ℕ),(∀y:ℕ,countp (λ x,x ≡ y [MOD z]) A = countp (λ x,x ≡ y [MOD z]) B)→ prod A ≡ prod B [MOD z]:=begin
    intros A B z H,revert B,
    induction A with p A1 Hi,intros B H,
    simp,simp at H,cases B with b B,simp,exfalso, have:= H b,rw list.countp_cons_of_pos at this,
    have H:list.countp (λ (x : ℕ), x ≡ b [MOD z]) B + 1≥1:=le_add_left _ _,rw ←this at H,revert H,exact dec_trivial,
    apply modeq.refl,intros B H,have H1:= H p,rw list.countp_cons_of_pos at H1,have H2:0<list.countp (λ (x : ℕ), x ≡ p [MOD z]) A1 + 1:=le_add_left _ _,
    rw H1 at H2,rw list.countp_pos at H2,cases H2 with q Hq,cases Hq with Hq Hq1,
    have H2:(∀ (y : ℕ),
    list.countp (λ (x : ℕ), x ≡ y [MOD z]) A1 = list.countp (λ (x : ℕ), x ≡ y [MOD z]) (list.erase B q)):=begin
        intro y,have H2:= H y,have H3:=perm_erase Hq,have H4:=perm_countp (λ (x : ℕ), x ≡ y [MOD z]) H3,
        cases decidable.em (p ≡ y [MOD z]) with A A,rw countp_cons_of_pos at H2,rw[H4,countp_cons_of_pos] at H2,apply add_right_cancel H2,exact modeq.trans Hq1 A,assumption,
        rw list.countp_cons_of_neg at H2,rwa[H4,countp_cons_of_neg] at H2,intro,have H3:=modeq.symm Hq1,exact A (modeq.trans H3 a),assumption,
    end,have H3:=Hi(list.erase B q) H2,have H4:=prod_eq_of_perm (perm_erase Hq),rw [H4,prod_cons,prod_cons],exact modeq.modeq_mul (modeq.symm Hq1) H3,apply modeq.refl,
end
def Lb : ℕ → ℕ → list ℕ
| 0 b := list.nil
| (succ n) b := (b*succ n):: Lb n b

theorem L3 :∀(A B:list ℕ)(p:ℕ),(∀a:ℕ,a∈A→∃(b:ℕ)(H:b∈B),b≡a[MOD p])→(∀b:ℕ,b∈B→∃(a:ℕ)(H:a∈A),a≡b[MOD p])→(∀a₁ a₂:ℕ,a₁∈A→a₂∈list.erase A a₁→¬a₁≡a₂[MOD p])→(∀b₁ b₂:ℕ,b₁∈B→b₂∈list.erase B b₁→¬b₁≡b₂[MOD p])→(∀y:ℕ,countp(λa,a≡y[MOD p])A=countp(λb,b≡y[MOD p])B):=begin
    assume A B p HA HB HA1 HB1 y,
    cases decidable.em(∃(b:ℕ)(H:b∈B),b≡y[MOD p]) with Hb Hb,
    apply exists.elim Hb, assume b1 Hb1, cases Hb1 with Hb1 Hb2,
    have Ha:= HB b1 Hb1,
    apply exists.elim Ha, assume a1 H,cases H with Ha1 Ha2,
    have Hb:= HA a1 Ha1,
    rw [perm_countp _ (perm_erase Hb1),perm_countp _ (perm_erase Ha1),countp_cons_of_pos,countp_cons_of_pos],
    cases decidable.em (0<countp (λ (a : ℕ), a ≡ y [MOD p]) (list.erase A a1)) with Ha4 Ha4,
    exfalso,rw countp_pos at Ha4,cases Ha4 with a₂ Ha₂,cases Ha₂ with ha₂ Ha₂,have:=HA1 a1 a₂ Ha1 ha₂,
    exact this (modeq.trans (modeq.trans Ha2 Hb2) (modeq.symm Ha₂)),
    cases decidable.em (0<countp (λ (b : ℕ), b ≡ y [MOD p]) (list.erase B b1)) with Hb4 Hb4,
    exfalso,rw countp_pos at Hb4,cases Hb4 with b₂ Hb₂,cases Hb₂ with hb₂ Hb₂,have:=HB1 b1 b₂ Hb1 hb₂,
    exact this (modeq.trans Hb2 (modeq.symm Hb₂)),
    rw [eq_zero_of_le_zero (le_of_not_gt Ha4),eq_zero_of_le_zero (le_of_not_gt Hb4)],assumption,exact modeq.trans Ha2 Hb2,

    cases decidable.em(∃(a:ℕ)(H:a∈A),a≡y[MOD p])with H2 H2,
    cases H2 with a1 HA1,cases HA1 with HA1 HA2,exfalso,
    cases (HA a1 HA1) with b1 Hb1,cases Hb1 with Hb1 Hb2,
    exact Hb (exists.intro b1 (exists.intro Hb1 (modeq.trans Hb2  HA2))),

    rw ←countp_pos at H2 Hb,
    have H1:= eq_zero_of_le_zero (le_of_not_gt Hb),have H2:=eq_zero_of_le_zero (le_of_not_gt H2),
    rw[H1, ←H2]
end
theorem modeq_mod_cancel:∀ a p:nat, a % p ≡ a [MOD p] :=begin
    assume a p,rw modeq.modeq_iff_dvd,rw [int.coe_nat_mod,int.mod_def],norm_num,
end
theorem mem_Lb :∀ k p b:ℕ,b>0→(k*b∈Lb (p-1) b↔k>0∧k<p):=begin
    assume k p b Hb,induction p with p1,simp [Lb],intro,exact dec_trivial,
    cases p1 with p2, simp[Lb],intro,apply le_of_lt_succ,apply succ_lt_succ,assumption,
    simp[Lb],apply iff.intro, assume H, cases H,rw[mul_comm,nat.mul_left_inj Hb] at H,rw H,apply and.intro,exact dec_trivial,exact lt_succ_self _,
    rw succ_sub_one at p_ih, simp [H] at p_ih, exact ⟨p_ih.left,lt_trans p_ih.right (lt_succ_self _)⟩,
    cases decidable.em (k<succ p2),intro,simp [a,h] at p_ih,simp[p_ih],intro,rw[mul_comm,nat.mul_left_inj Hb],have:=le_of_not_gt h,simp [le_antisymm (le_of_not_gt h) (le_of_succ_le_succ (succ_le_of_lt a.right))],
end
theorem Lb_dvd:∀ p b a:ℕ,a ∈ Lb (p-1) b→∃ k,k*b=a∧k>0∧k<p:=begin
    assume p b a,induction p with p1,simp [Lb],simp[Lb],cases p1 with p2,simp[Lb],simp[Lb],assume H,cases H,existsi succ p2,simp[H],rw mul_comm,exact ⟨rfl,dec_trivial,lt_succ_self (succ p2)⟩,
    rw succ_sub_one at p_ih,cases p_ih H,existsi w,exact ⟨h.left,h.right.left,lt_trans h.right.right (lt_succ_self (succ p2))⟩,
end
theorem L1Lb : ∀ p c:ℕ,c>0→ prime p → coprime c p→ (∀a:ℕ,a∈(Lb (p-1) 1)→∃(b:ℕ)(H:b∈(Lb (p-1) c)),b≡a[MOD p])∧(∀b:ℕ,b∈(Lb (p-1)c)→∃(a:ℕ)(H:a∈(Lb (p-1) 1)),a≡b[MOD p]):=begin
    assume p c Hc Hp Hco,have Hp0:=lt_trans (dec_trivial:0<1) (prime.gt_one Hp),apply and.intro,assume a Ha,have Hp0:=lt_trans (dec_trivial:0<1) (prime.gt_one Hp),
    existsi (a*mod_inv c p)%p*c,rw mem_Lb _ _ _ Hc,simp[mod_lt (a * mod_inv c p) Hp0],
    have H:=mod_inv_gcd c p Hp0,rw coprime.gcd_eq_one Hco at H,
    have H1:a * ( c*mod_inv c p ) ≡ a *1 [MOD p]:=modeq.modeq_mul (modeq.refl a) H,rw[mul_comm c,←mul_assoc,mul_one] at H1,
    have H4:=modeq_mod_cancel (a * mod_inv c p) p,
    have H2:=modeq.modeq_mul (modeq_mod_cancel (a * mod_inv c p) p) (modeq.refl c),
    have H3:=modeq.trans H2 H1,simp[H3],cases decidable.em(a * mod_inv c p % p = 0),exfalso,rw [←dvd_iff_mod_eq_zero,prime.dvd_mul Hp] at h,rw[←mul_one a,mem_Lb]at Ha,
    have:=mod_eq_of_lt Ha.right,rw dvd_iff_mod_eq_zero at h,rw this at h,simp[ne_of_gt Ha.left] at h,
    rw ←modeq.modeq_zero_iff at h,have :=modeq.symm(modeq.trans (modeq.symm(modeq.modeq_mul (modeq.refl c) h)) H), simp at this,rw modeq.modeq_zero_iff at this,exact prime.not_dvd_one Hp this,
    exact dec_trivial,cases a * mod_inv c p % p,revert h,simp,exact dec_trivial,
    assume a Ha,existsi a%p,rw [←mul_one (a%p),mem_Lb _ _ _ (dec_trivial:1>0)],simp,simp[mod_lt a Hp0,modeq_mod_cancel a p],
    cases decidable.em(a % p = 0),exfalso, rw[←dvd_iff_mod_eq_zero] at h,cases Lb_dvd _ _ _ Ha,rw [←h_1.left,prime.dvd_mul] at h,cases h,have:= mod_eq_of_lt h_1.right.right,rw dvd_iff_mod_eq_zero at h,rw h at this,rw ←this at h_1,exact (dec_trivial:¬0<0) h_1.right.left,
    have:= coprime.eq_one_of_dvd (coprime.symm Hco) h,rw this at Hp,revert Hp, simp[prime],exact dec_trivial,assumption,cases a%p,exfalso,revert h,exact dec_trivial,exact dec_trivial,
end

theorem Lb_ne: ∀ (p c k :nat), c>0→(k>0→k<p→count (k*c) (Lb (p-1) c) = 1)∧(k≥p→count (k*c) (Lb (p-1) c) = 0):=begin
    assume p c k Hc,induction p with p1 Hi,simp [Lb],intro,exact not_lt_zero k,cases p1 with p2,simp[Lb],intro,have:=succ_le_of_lt a,intro,exact not_lt_of_ge this a_1,
    have Hkp1:k<succ(succ p2) ↔k=succ p2 ∨ k<succ p2:=begin
        rw ←le_iff_eq_or_lt,rw ←succ_le_succ_iff,apply iff.intro,
        intro, apply succ_le_of_lt a,intro, apply lt_of_succ_le a,
    end, rw Hkp1,apply and.intro,
    assume Hk Hkp,clear Hkp1,cases Hkp,simp at Hi,rw ←Hkp at Hi,have:=Hi.right (le_refl k),simp [Lb],rw [←Hkp,mul_comm,count_cons_self,mul_comm,this],
    simp at Hi,simp[Lb],rw count_cons_of_ne,exact Hi.left Hk Hkp,rw mul_comm,rw ←mul_lt_mul_left Hc at Hkp,exact ne_of_lt Hkp,
    assume H,have:= Hi.right (ge_trans H (le_succ _)),simp[Lb],simp at this,rwa count_cons_of_ne,
    have:=lt_of_lt_of_le (lt_succ_self (succ p2)) H,rw ←mul_lt_mul_left Hc at this,rw mul_comm,apply ne.symm, exact ne_of_lt this,
end
theorem ladida:∀ c a b p:ℕ,coprime c p →a>0→a<p→b>0→b<p→p>0→(c*a ≡ c*b [MOD p] ↔ a = b):=begin
    assume c a b p Hco Ha0 Hap Hb0 Hbp Hp0,apply iff.intro,
    assume Hc,have:=@modeq_mul_cancel c b a p Hp0 Hco,have Hc1:=modeq.symm Hc,rw this at Hc1,clear Hc,
    simp[modeq] at Hc1,rw [mod_eq_of_lt Hap,mod_eq_of_lt Hbp] at Hc1,rw Hc1,intro,rw a_1,
end

theorem not_modeq_list:∀ p b:ℕ,coprime b p→p>0→b>0→(∀a₁ a₂:ℕ,a₁∈Lb (p-1) b→a₂∈list.erase (Lb (p-1) b) a₁→¬a₁≡a₂[MOD p]):=begin
    assume p b Hp Hp0 Hb a₁ a₂ Ha₁ Ha₂,have ha₁:=Lb_dvd _ _ _ Ha₁,have H1:=perm_count (perm_erase Ha₁) a₂,have H2:=iff.elim_right count_pos Ha₂,
    rw count_cons' at H1,have:=lt_of_lt_of_le H2 (le_add_right _ (ite (a₂ = a₁) 1 0)),rw ←H1 at this,rw count_pos at this,
    have ha₂:=Lb_dvd _ _ _ this,
    have :¬a₁=a₂:=begin
        cases ha₁ with k₁ Hk₁,cases ha₂ with k₂ Hk₂,rw ←Hk₁.left at Ha₁,rw ←Hk₂.left at Ha₂,clear H1,
        have hk₂:=(Lb_ne p b k₂ Hb).left Hk₂.right.left Hk₂.right.right,
        rw perm_count (perm_erase Ha₁) at hk₂,rw Hk₁.left at Ha₁ hk₂, rw Hk₂.left at hk₂ Ha₂,
        assume H,rw [←H,←count_pos] at Ha₂,rw [H,count_cons_self] at hk₂,have :=succ_inj hk₂,rw [H,this] at Ha₂,
        revert Ha₂,exact dec_trivial,
    end,
    cases ha₁ with k₁ Hk₁,cases ha₂ with k₂ Hk₂,rw [←Hk₁.left,←Hk₂.left],
    rw[mul_comm,mul_comm k₂,ladida b k₁ k₂ p Hp Hk₁.right.left Hk₁.right.right Hk₂.right.left Hk₂.right.right Hp0],
    rw [←Hk₁.left,←Hk₂.left] at this,intro,rw a at this,revert this,simp,
end
theorem fact_list :∀ p k:ℕ,p>0→prod (Lb p k)=k^p*fact p:=begin
    assume p k,induction p with p1,simp [(dec_trivial:¬0>0)],cases p1 with p2,simp[Lb],simp[Lb,fact,pow],simp[Lb,fact,pow] at p_ih,intro,
    have:=p_ih dec_trivial,rw this,cc,
end
theorem prime_not_dvd_fact : ∀ p k:ℕ,k<p → prime p→¬p∣fact k:=begin
    assume p k, induction k with k1,simp [fact,prime],intros,intro,rw a_3 at a_1,revert a_1,exact dec_trivial,
    assume H H1,simp[fact],assume H3,rw prime.dvd_mul H1 at H3,cases H3,
    rw [dvd_iff_mod_eq_zero] at H3,rw mod_eq_of_lt H at H3,revert H3,exact dec_trivial,
    exact k_ih (lt_trans (lt_succ_self _) H) H1 H3,
end

theorem fermats_little_theorem1 :∀ a p:ℕ,prime p→ coprime a p → a^(p-1) ≡ 1 [MOD p]:=begin
    assume b p Hp Hpc,have Hp1:(p-1)>0:=nat.sub_pos_of_lt (lt_of_lt_of_le (dec_trivial:1<2) Hp.left),
    have Hp0:p>0:=by unfold prime at Hp;exact lt_of_lt_of_le (dec_trivial:0<2) Hp.left,
    rw [←@modeq_mul_cancel (fact(p-1)) (b^(p-1)) 1 p Hp0,mul_comm,mul_comm (fact (p-1)),←fact_list _ _ Hp1],have:∀ p:ℕ, 1=1^p := begin assume p,induction p,simp,rw pow_succ,simp,assumption, end,
    have H:1 * fact (p - 1) = 1^(p-1) * fact(p-1):=by rw ←this,rw H, clear H this,rw ←fact_list _ _ Hp1,
    suffices: (∀y:ℕ,countp (λ x,x ≡ y [MOD p]) (Lb (p - 1) b) = countp (λ x,x ≡ y [MOD p]) (Lb (p - 1) 1)),
    exact modeq_prod_list (Lb (p - 1) b) (Lb (p - 1) 1) p this,revert b, assume c Hpc,
    suffices :(∀a:ℕ,a∈(Lb (p - 1) c)→∃(b:ℕ)(H:b∈(Lb (p - 1) 1)),b≡a[MOD p])∧(∀b:ℕ,b∈(Lb (p - 1) 1)→∃(a:ℕ)(H:a∈(Lb (p - 1) c)),a≡b[MOD p])∧(∀a₁ a₂:ℕ,a₁∈(Lb (p - 1) c)→a₂∈list.erase (Lb (p - 1) c) a₁→¬a₁≡a₂[MOD p])∧(∀b₁ b₂:ℕ,b₁∈(Lb (p - 1) 1)→b₂∈list.erase (Lb (p - 1) 1) b₁→¬b₁≡b₂[MOD p]),
    exact L3 (Lb (p - 1) c) (Lb (p - 1) 1) p this.left this.right.left this.right.right.left this.right.right.right,
    suffices Hc:c>0,rw ←and.assoc, apply and.intro,rw and.comm, exact(L1Lb p c Hc Hp Hpc),
    apply and.intro,exact not_modeq_list p c Hpc Hp0 Hc,
    have Hco:coprime 1 p:=begin apply coprime.symm,rw[prime.coprime_iff_not_dvd Hp],exact prime.not_dvd_one Hp, end, exact not_modeq_list p 1 Hco Hp0 (dec_trivial:1>0),
    cases c,have:=coprime.gcd_eq_one Hpc,exfalso,revert this,simp[gcd],unfold prime at Hp,intro,rw this at Hp,revert Hp,simp [(dec_trivial:¬1≥2)],exact dec_trivial,

    have Hp3:(p-1)<p:= nat.sub_lt_self (lt_trans (dec_trivial:0<1) (prime.gt_one Hp)) (dec_trivial:1>0), have:=prime_not_dvd_fact p (p-1) Hp3 Hp, rw ←prime.coprime_iff_not_dvd Hp at this, exact coprime.symm this,
end

theorem fermats_little_theorem : ∀ b p:ℕ,prime p→b^p ≡ b [MOD p]:=begin
    assume b p,cases decidable.em (p ∣ b) with A A,
    have H:∀x y z:ℕ, 1≤z→x ∣ y → y^z ≡ 0 [MOD x] :=begin
        intros x y z H H1,
        induction z with z1 Hi,exfalso,revert H,exact dec_trivial,
        cases z1 with z2,simp,rwa nat.modeq.modeq_zero_iff,
        rw nat.pow_succ,have H2:= Hi dec_trivial,rw nat.modeq.modeq_zero_iff at H2,
        rw nat.modeq.modeq_zero_iff, exact dvd_mul_of_dvd_left H2 _,
    end,intro H1,have :1≤ p:=by {unfold nat.prime at H1,exact le_trans (dec_trivial:1≤2) (and.left H1)},
    have := H p b p this A,rw ←modeq.modeq_zero_iff at A,have A:= modeq.symm A,exact modeq.trans this A,
    assume Hp,rw ←prime.coprime_iff_not_dvd Hp at A,have Hp0:p>0:=begin unfold prime at Hp, exact lt_of_lt_of_le (dec_trivial:0<2) (Hp.left) end,
    suffices :b^(p-1)≡ 1 [MOD p],have h:= modeq.modeq_mul this (modeq.refl b),rwa [one_mul,←pow_succ,←succ_sub,succ_sub_one ]at h,
    exact le_trans (dec_trivial:1≤2) (prime.ge_two Hp),apply fermats_little_theorem1 b p Hp (coprime.symm A),
end

end nat


import data.nat.prime
open nat

theorem infinitude_of_primes (n : ℕ) : ∃ (p : ℕ), prime p ∧ n ≤ p :=
-- For every natural number n,
-- there exists a number p, such that
-- n is less than or equal to p and p is prime

begin
  let m := n.factorial + 1,
  let p := min_fac m,
  use p,
  -- use the smallest prime factor of n! + 1.

  have p_is_prime : prime p := min_fac_prime (ne_of_gt (succ_lt_succ (factorial_pos n))),
  -- proof that p is prime

  split,
  -- break the "and" into two propositions

  begin
    -- proof that p is prime
    exact p_is_prime,
  end,

  begin
  -- proof that n is less than or equal to p

    by_contradiction h, push_neg at h,
    -- proof by contradiction
    -- suppose instead that p is less than n

    have p_dvd_n : p ∣ n.factorial := dvd_factorial (min_fac_pos _) (le_of_lt h),
    -- then p divides n!

    have p_dvd_one : p ∣ 1 := (nat.dvd_add_iff_right p_dvd_n).2 (min_fac_dvd _),
    -- because p divides n! and n! + 1, p divides 1

    exact p_is_prime.not_dvd_one p_dvd_one,
    -- but this is not possible
  end,
end


import topology.constructions
import topology.subset_properties
import topology.maps

universes u v
variables {X : Type u} {Y : Type v} [topological_space X] [topological_space Y]

section cover
  /-- Structure representing a cover of `U` made up of open sets `sι` indexed by type `ι`. -/
  structure cover (U : set X) :=
  (ι      : Type u)
  (sι     : ι → set X)
  (hopen  : ∀ i, is_open (sι i))
  (hcover : U ⊆ ⋃ i, sι i)

  /-- For any point `x` in `U` and any cover `C` of `U`, there must exist some open set in `C` containing `x`. -/
  theorem cover.mem {U : set X} (C : cover U) {x : X} (hx : x ∈ U) : ∃ i : C.ι, x ∈ C.sι i :=
    set.mem_Union.mp $ C.hcover hx

  /-- A Prop stating that the cover `C` of `U` can cover `U` with the union of `sι i` for finitely many `i : ι`. -/
  def cover.has_finite_subcover {U : set X} (C : cover U) : Prop := ∃ t : finset C.ι, U ⊆ ⋃ i ∈ t, C.sι i

  /-- A cover with a finite subcover is compact. -/
  theorem is_compact_of_finite_subcover' {U : set X} (h : ∀ C : cover U, C.has_finite_subcover) : is_compact U :=
    is_compact_of_finite_subcover $ λ ι sι hopen hcover, h $ cover.mk ι sι hopen hcover

  /-- Any cover of a compact set has a finite subcover. -/
  theorem cover.has_finite_subcover_of_compact {U : set X} (hU : is_compact U) (C : cover U) :
    C.has_finite_subcover := hU.elim_finite_subcover C.sι C.hopen C.hcover

  /-- For a point `p` in the product space `X × Y` and a cover `C` of the set `U' ×ˢ V'`, this structure
    requires that `p` belong to the set `U ×ˢ V` for `U` and `V` open, with `U ×ˢ V` wholly contained in
    the open indexed by `j` in `C`.  -/
  structure rect {U' : set X} {V' : set Y} (C : cover (U' ×ˢ V')) (p : X × Y) :=
  (U  : set X)     (V  : set Y)
  (hU : is_open U) (hV : is_open V)
  (j  : C.ι)       (hj : U ×ˢ V ⊆ C.sι j)
  (hp : p ∈ U ×ˢ V)

  /-- Coercion to the product of open sets `U ×ˢ V` that define a rect. -/
  instance rect.to_set {U' : set X} {V' : set Y} (C : cover (U' ×ˢ V')) (p : X × Y) : has_coe (rect C p) (set (X × Y)) :=
    ⟨λ r, r.U ×ˢ r.V⟩

  /-- Proof that the product of open sets `U ×ˢ V` is open in the product toplogy. -/
  theorem rect.is_open {U' : set X} {V' : set Y} {C : cover (U' ×ˢ V')} {p : X × Y} (R : rect C p) :
    is_open (R : set (X × Y)) := is_open.prod R.hU R.hV

  /-- Function which, given any product `U × V` containing a point `p` and a cover `C`,
    produces a rect with respect to the point and cover. -/
  noncomputable def cover.rect {U : set X} {V : set Y} (C : cover (U ×ˢ V))
    {x : X} (hx : x ∈ U) {y : Y} (hy : y ∈ V) : rect C (x, y) :=
  begin
    have hp : (x, y) ∈ U ×ˢ V := ⟨hx, hy⟩,
    -- cannot use cases/rcases for non-Props, as the goal is not a Prop
    let j  := (C.mem hp).some,
    have   := is_open_prod_iff.mp (C.hopen j) x y (C.mem hp).some_spec,
    let U' := this.some,
    let V' := this.some_spec.some,
    rcases this.some_spec.some_spec with ⟨hU', hV', hx, hy, hj⟩,
    exact rect.mk U' V' hU' hV' j hj ⟨hx, hy⟩
  end
end cover

/-- The left projection out of `U ×ˢ V` is equal to `U`. -/
theorem prod_image_fst {X : Type*} {Y : Type*} (U : set X)  {V : set Y} (hV : V.nonempty) : prod.fst '' (U ×ˢ V) = U :=
begin
  ext x, exact ⟨λ ⟨p, hp, hx⟩, hx ▸ hp.1, λ hx, by
    { cases hV with y hy, exact ⟨(x, y), ⟨hx, hy⟩, rfl⟩ } ⟩
end

/-- The right projection out of `U ×ˢ V` is equal to `V`. -/
theorem prod_image_snd {X : Type*} {Y : Type*} {U : set X}  (hU : U.nonempty) (V : set Y) : prod.snd '' (U ×ˢ V) = V :=
begin
  ext y, exact ⟨λ ⟨p, hp, hy⟩, hy ▸ hp.2, λ hy, by
    { cases hU with x hx, exact ⟨(x, y), ⟨hx, hy⟩, rfl⟩ } ⟩
end

/-- A set is closed if and only if every point out side it has an open neighbourhood. -/
theorem is_closed_iff_outside_neighbourhoods {U : set X} : is_closed U ↔ ∀ x ∉ U,
  ∃ U' : set X, is_open U' ∧ x ∈ U' ∧ U ∩ U' = ∅ :=
begin
  rw [is_closed_iff_nhds], split,
  { intros h x hx,
    have := mt (h x) hx, simp only [not_forall] at this,
    rcases this with ⟨U₁, hU₁, hUU₁⟩,
    rcases mem_nhds_iff.mp hU₁ with ⟨U₂, hU₂U₁, hU₂, hxU₂⟩,
    exact ⟨U₂, hU₂, hxU₂, set.ext $ λ y, ⟨λ ⟨hyU, hyU₂⟩, hUU₁ ⟨y, hU₂U₁ hyU₂, hyU⟩, false.elim⟩⟩ },
  { intros h x h', by_contra hx,
    rcases h x hx with ⟨U', hU', hxU', hUU'⟩,
    rw [set.inter_comm] at hUU',
    exact absurd hUU' (h' U' (hU'.mem_nhds hxU')).ne_empty }
end

/-- A set in the subtype (subset) topology of `U` is open if and only if it is the intersection
  of an open set(in the topology of `X`) with `U`. -/
theorem is_open_subtype {U : set X} {S : set U} : is_open S ↔ ∃ T : set X, is_open T ∧
  ∀ x : U, x ∈ S ↔ x.1 ∈ T :=
begin
  rw [is_open_induced_iff],
  have : ∀ T : set X, (coe ⁻¹' T = S) ↔ ∀ x : U, x ∈ S ↔ x.1 ∈ T,
  { intros, split,
    { intros h _, rw [←h], refl },
    { intro h, ext x, rw [h x], refl } },
  exact ⟨λ ⟨T, h₁, h₂⟩, ⟨T, h₁, (this T).mp h₂⟩, λ ⟨T, h₁, h₂⟩, ⟨T, h₁, (this T).mpr h₂⟩⟩
end

/-- A set `U` is compact if and only if every collection of closed sets satisfying the
  finite intersection property, i.e. the intersection of finitely many such sets is nonempty,
  the intersection of all of these sets is also nonempty. -/
theorem is_compact_iff_finite_intersection_property {U : set X} : is_compact U ↔
  ∀ (ι : Type u) (sι : ι → set X), (∀ i, is_closed (sι i)) → (∀ t : finset ι, (U ∩ ⋂ i ∈ t, sι i).nonempty) →
    (U ∩ ⋂ i, sι i).nonempty :=
begin
  rw [is_compact_iff_finite_subfamily_closed], split,
  { intros h ι sι hclosed,
    have := mt (h sι hclosed),
    simp only [not_exists, ←ne.def, set.ne_empty_iff_nonempty] at this,
    exact this },
  { intros h ι sι hclosed,
    rw [←not_imp_not],
    simp only [not_exists, ←ne.def, set.ne_empty_iff_nonempty],
    exact h ι sι hclosed }
end

/-- Intersection over finite indicies reverses subsets. -/
theorem finset_intersection_subset {α : Type*} {ι : Type*} {f : ι → set α} {s t : finset ι}
  (h : s ⊆ t) : (⋂ i ∈ t, f i) ⊆ (⋂ i ∈ s, f i) :=
begin
  intro, simp only [set.mem_Inter₂], exact (λ h' i hi, h' i (h hi))
end


import data.real.basic algebra.field_power
import algebra.pi_instances
import algebra.module
import ring_theory.algebra

-- Question 2a
structure quaternion : Type :=
(re : ℝ) (i : ℝ) (j : ℝ) (k : ℝ)

notation `ℍ` := quaternion

namespace quaternion

@[simp] theorem eta : ∀ p : ℍ, quaternion.mk p.re p.i p.j p.k = p
| ⟨a, b, c, d⟩ := rfl

@[extensionality] theorem ext : ∀ {p q : ℍ}, p.re = q.re → p.i = q.i → p.j = q.j → p.k = q.k → p = q
| ⟨pr, pi, pj, pk⟩ ⟨_, _, _, _⟩ rfl rfl rfl rfl := rfl

theorem ext_iff {p q : ℍ} : p = q ↔ p.re = q.re ∧ p.i = q.i ∧ p.j = q.j ∧ p.k = q.k :=
⟨λ H, by simp [H], by {rintros ⟨a, ⟨b, ⟨c, d⟩⟩⟩, apply ext; assumption}⟩

def of_real (r : ℝ) : ℍ := ⟨r, 0, 0, 0⟩
instance : has_coe ℝ ℍ := ⟨of_real⟩
@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma of_real_re (r : ℝ) : (r : ℍ).re = r := rfl
@[simp] lemma of_real_i (r : ℝ) : (r : ℍ).i = 0 := rfl
@[simp] lemma of_real_j (r : ℝ) : (r : ℍ).j = 0 := rfl
@[simp] lemma of_real_k (r : ℝ) : (r : ℍ).k = 0 := rfl

@[simp] theorem of_real_inj {z w : ℝ} : (z : ℍ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

instance : has_zero ℍ := ⟨(0 : ℝ)⟩
instance : inhabited ℍ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℍ).re = 0 := rfl
@[simp] lemma zero_i : (0 : ℍ).i = 0 := rfl
@[simp] lemma zero_j : (0 : ℍ).j = 0 := rfl
@[simp] lemma zero_k : (0 : ℍ).k = 0 := rfl
@[simp] lemma of_real_zero : ((0 : ℝ) : ℍ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℍ) = 0 ↔ z = 0 := of_real_inj
@[simp] theorem of_real_ne_zero {z : ℝ} : (z : ℍ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℍ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℍ).re = 1 := rfl
@[simp] lemma one_i : (1 : ℍ).i = 0 := rfl
@[simp] lemma one_j : (1 : ℍ).j = 0 := rfl
@[simp] lemma one_k : (1 : ℍ).k = 0 := rfl
@[simp] lemma of_real_one : ((1 : ℝ) : ℍ) = 1 := rfl

def I : ℍ := ⟨0, 1, 0, 0⟩
def J : ℍ := ⟨0, 0, 1, 0⟩
def K : ℍ := ⟨0, 0, 0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_i : I.i = 1 := rfl
@[simp] lemma I_j : I.j = 0 := rfl
@[simp] lemma I_k : I.k = 0 := rfl

@[simp] lemma J_re : J.re = 0 := rfl
@[simp] lemma J_i : J.i = 0 := rfl
@[simp] lemma J_j : J.j = 1 := rfl
@[simp] lemma J_k : J.k = 0 := rfl

@[simp] lemma K_re : K.re = 0 := rfl
@[simp] lemma K_i : K.i = 0 := rfl
@[simp] lemma K_j : K.j = 0 := rfl
@[simp] lemma K_k : K.k = 1 := rfl

instance : has_add ℍ := ⟨λ z w, ⟨z.re + w.re, z.i + w.i, z.j + w.j, z.k + w.k⟩⟩

@[simp] lemma add_re (z w : ℍ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_i (z w : ℍ) : (z + w).i = z.i + w.i := rfl
@[simp] lemma add_j (z w : ℍ) : (z + w).j = z.j + w.j := rfl
@[simp] lemma add_k (z w : ℍ) : (z + w).k = z.k + w.k := rfl
@[simp] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℍ) = r + s := ext_iff.2 $ by simp

@[simp] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℍ) = bit0 r := ext_iff.2 $ by simp [bit0]
@[simp] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℍ) = bit1 r := ext_iff.2 $ by simp [bit1]

instance : has_neg ℍ := ⟨λ z, ⟨-z.re, -z.i, -z.j, -z.k⟩⟩

@[simp] lemma neg_re (z : ℍ) : (-z).re = -z.re := rfl
@[simp] lemma neg_i (z : ℍ) : (-z).i = -z.i := rfl
@[simp] lemma neg_j (z : ℍ) : (-z).j = -z.j := rfl
@[simp] lemma neg_k (z : ℍ) : (-z).k = -z.k := rfl
@[simp] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℍ) = -r := ext_iff.2 $ by simp

instance : has_mul ℍ := ⟨λ p q, ⟨p.re*q.re - p.i*q.i - p.j*q.j - p.k*q.k,
                                 p.re*q.i + p.i*q.re + p.j*q.k - p.k*q.j,
                                 p.re*q.j - p.i*q.k + p.j*q.re + p.k*q.i,
                                 p.re*q.k + p.i*q.j - p.j*q.i + p.k*q.re⟩⟩

@[simp] lemma mul_re (p q : ℍ) : (p*q).re = p.re*q.re - p.i*q.i - p.j*q.j - p.k*q.k := rfl
@[simp] lemma mul_i (p q : ℍ) : (p*q).i = p.re*q.i + p.i*q.re + p.j*q.k - p.k*q.j := rfl
@[simp] lemma mul_j (p q : ℍ) : (p*q).j = p.re*q.j - p.i*q.k + p.j*q.re + p.k*q.i := rfl
@[simp] lemma mul_k (p q : ℍ) : (p*q).k = p.re*q.k + p.i*q.j - p.j*q.i + p.k*q.re := rfl
@[simp] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℍ) = r * s := ext_iff.2 $ by simp
@[simp] lemma mul_comm_re (r : ℝ) (p : ℍ) : (r : ℍ) * p = p * r :=
by ext; {dsimp, simp [mul_comm]}

@[simp] lemma I_mul_I : I * I = -1 := ext_iff.2 $ by simp
@[simp] lemma J_mul_J : J * J = -1 := ext_iff.2 $ by simp
@[simp] lemma K_mul_K : K * K = -1 := ext_iff.2 $ by simp

lemma one_ne_zero : (1 : ℍ) ≠ 0 := by simp [ext_iff]
lemma I_ne_zero : (I : ℍ) ≠ 0 := mt (congr_arg i) zero_ne_one.symm
lemma J_ne_zero : (J : ℍ) ≠ 0 := mt (congr_arg j) zero_ne_one.symm
lemma K_ne_zero : (K : ℍ) ≠ 0 := mt (congr_arg k) zero_ne_one.symm

lemma mk_eq_add_mul_I_add_mul_J_add_mul_K (a b c d : ℝ) :
quaternion.mk a b c d = a + b * I + c * J + d * K :=
ext_iff.2 $ by simp

@[simp] lemma re_add_i_add_j_add_k (z : ℍ) : (z.re : ℍ) + z.i * I + z.j * J + z.k * K = z :=
ext_iff.2 $ by simp

def real_prod_equiv : ℍ ≃ (ℝ × ℝ × ℝ × ℝ) :=
{ to_fun := λ z, ⟨z.re, z.i, z.j, z.k⟩,
  inv_fun := λ p, ⟨p.1, p.2.1, p.2.2.1, p.2.2.2⟩,
  left_inv := λ ⟨a, b, c, d⟩, rfl,
  right_inv := λ ⟨a, b, c, d⟩, rfl }

@[simp] theorem real_prod_equiv_apply (z : ℍ) : real_prod_equiv z = (z.re, z.i, z.j, z.k) := rfl

-- Question 2d
def conj (z : ℍ) : ℍ := ⟨z.re, -z.i, -z.j, -z.k⟩

@[simp] lemma conj_re (z : ℍ) : (conj z).re = z.re := rfl
@[simp] lemma conj_i (z : ℍ) : (conj z).i = -z.i := rfl
@[simp] lemma conj_j (z : ℍ) : (conj z).j = -z.j := rfl
@[simp] lemma conj_k (z : ℍ) : (conj z).k = -z.k := rfl
@[simp] lemma conj_of_real (r : ℝ) : conj r = r := ext_iff.2 $ by simp [conj]

@[simp] lemma conj_zero : conj 0 = 0 := ext_iff.2 $ by simp [conj]
@[simp] lemma conj_one : conj 1 = 1 := ext_iff.2 $ by simp
@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp
@[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp
@[simp] lemma conj_J : conj J = -J := ext_iff.2 $ by simp
@[simp] lemma conj_neg_J : conj (-J) = J := ext_iff.2 $ by simp
@[simp] lemma conj_K : conj K = -K := ext_iff.2 $ by simp
@[simp] lemma conj_neg_K : conj (-K) = K := ext_iff.2 $ by simp

@[simp] lemma conj_add (z w : ℍ) : conj (z + w) = conj z + conj w :=
ext_iff.2 $ by simp

@[simp] lemma conj_neg (z : ℍ) : conj (-z) = -conj z := rfl

@[simp] lemma conj_mul (p q : ℍ) : conj (p * q) = conj q * conj p := by simp [ext_iff, mul_comm, add_comm]

@[simp] lemma conj_conj (z : ℍ) : conj (conj z) = z :=
ext_iff.2 $ by simp

lemma conj_bijective : function.bijective conj :=
⟨function.injective_of_has_left_inverse ⟨conj, conj_conj⟩,
 function.surjective_of_has_right_inverse ⟨conj, conj_conj⟩⟩

lemma conj_inj {z w : ℍ} : conj z = conj w ↔ z = w :=
conj_bijective.1.eq_iff

@[simp] lemma conj_eq_zero {z : ℍ} : conj z = 0 ↔ z = 0 :=
by simpa using @conj_inj z 0

@[simp] lemma eq_conj_iff_real (z : ℍ) : conj z = z ↔ ∃ r : ℝ, z = r :=
begin
    split,
    intros h,
    use z.re,
    simp [ext_iff] at h,
    rcases h with ⟨hi, ⟨hj, hk⟩⟩,
    ext,
    refl,
    repeat {apply eq_zero_of_neg_eq, assumption},
    intros h,
    cases h with r h,
    simp only [ext_iff] at h,
    rcases h with ⟨hre, ⟨hi, ⟨hj, hk⟩⟩⟩,
    ext,
    refl,
    repeat {simp, try {rw hi}, try {rw hj}, try {rw hk}, simp},
end

def norm_sq (z : ℍ) : ℝ := z.re * z.re + z.i * z.i + z.j * z.j + z.k * z.k

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := by simp [norm_sq]
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := by simp [norm_sq]
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]
@[simp] lemma norm_sq_J : norm_sq J = 1 := by simp [norm_sq]
@[simp] lemma norm_sq_K : norm_sq K = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℍ) : 0 ≤ norm_sq z :=
add_nonneg ( add_nonneg ( add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)) (mul_self_nonneg _)) (mul_self_nonneg _)

lemma zero_of_sum_squares_zero {a b c d : ℝ} : a*a + b*b + c*c + d*d = 0 → a = 0 ∧ b = 0 ∧ c = 0 ∧ d = 0 :=
begin
    intros h,
    have ha : a*a ≥ 0, by apply mul_self_nonneg,
    have hb : b*b ≥ 0, by apply mul_self_nonneg,
    have hc : c*c ≥ 0, by apply mul_self_nonneg,
    have hd : d*d ≥ 0, by apply mul_self_nonneg,
    have hcd : c*c + d*d ≥ 0, by exact add_nonneg hc hd,
    have hbcd : b*b + (c*c + d*d) ≥ 0, by exact add_nonneg hb hcd,
    rw ←add_assoc at hbcd,
    have w₁ := (add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg ha hbcd).1,
    have h₁ : a*a + b*b + c*c + d*d = a*a +(b*b + c*c + d*d), by ring,
    rw ←h₁ at w₁,
    have w₂ := w₁ h,
    cases w₂,
    have h₂ : b*b + c*c + d*d = b*b +(c*c + d*d), by ring,
    have w₃ := (add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg hb hcd).1,
    rw ←h₂ at w₃,
    have w₄ := w₃ w₂_right,
    cases w₄,
    have w₅ := (add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg hc hd).1 w₄_right,
    cases w₅,
    repeat {split},
    exact eq_zero_of_mul_self_eq_zero w₂_left,
    exact eq_zero_of_mul_self_eq_zero w₄_left,
    exact eq_zero_of_mul_self_eq_zero w₅_left,
    exact eq_zero_of_mul_self_eq_zero w₅_right,
end

@[simp] lemma norm_sq_eq_zero {z : ℍ} : norm_sq z = 0 ↔ z = 0 :=
begin
    split,
    intros h,
    dsimp [norm_sq] at h,
    have w : z.re = 0 ∧ z.i = 0 ∧ z.j = 0 ∧ z.k = 0, by exact zero_of_sum_squares_zero h,
    rcases w with ⟨wre, ⟨wi, ⟨wj, wk⟩⟩⟩,
    ext,
    repeat {assumption},
    intros h,
    dsimp [norm_sq],
    simp only [ext_iff] at h,
    rcases h with ⟨hre, ⟨hi, ⟨hj, hk⟩⟩⟩,
    rw [hre, hi, hj, hk],
    simp,
end

@[simp] lemma norm_sq_pos {z : ℍ} : 0 < norm_sq z ↔ z ≠ 0 :=
by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [norm_sq_nonneg]

@[simp] lemma norm_sq_neg (z : ℍ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℍ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_mul (z w : ℍ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
by dsimp [norm_sq]; ring

lemma norm_sq_add (z w : ℍ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

-- Question 2e
theorem mul_conj (z : ℍ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm]

-- Question 2e
-- I did both because, in general, quaternion multiplication does not commute
theorem mul_conj' (z : ℍ) : conj z * z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm]

theorem mul_conj_is_re (z : ℍ) : ∃ (r : ℝ), (r : ℍ) = z * conj z :=
by {use norm_sq z, rw mul_conj}

theorem mul_conj'_is_re (z : ℍ) : ∃ (r : ℝ), (r : ℍ) = conj z * z :=
by {use norm_sq z, rw mul_conj'}

theorem add_conj (z : ℍ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

lemma add_assoc (a b c : ℍ) : a + b + c = a + (b + c) :=
by {ext, repeat {simp}}

lemma add_comm (a b : ℍ) : a + b = b + a :=
by {ext, repeat {simp}}

lemma add_left_neg (a : ℍ) : -a + a = 0 :=
by {ext, repeat {simp}}

lemma zero_add (a : ℍ) : 0 + a = a :=
by {ext, repeat {simp}}

lemma add_zero (a : ℍ) : a + 0 = a :=
by {rw add_comm, exact zero_add a}

instance : add_comm_group ℍ :=
{add_assoc := add_assoc, zero_add := zero_add,
 add_zero := add_zero, add_left_neg := add_left_neg, add_comm := add_comm, ..}

lemma mul_assoc (a b c : ℍ) : a * b * c = a * (b * c) :=
by {ext; {simp, ring}}

lemma one_mul (a : ℍ) : 1 * a = a :=
by {ext; {simp}}

lemma mul_one (a : ℍ) : a * 1 = a :=
by {ext; {simp}}

lemma left_distrib (a b c : ℍ) : a * (b + c) = a * b + a * c :=
by {ext; {simp, ring}}

lemma right_distrib (a b c : ℍ) : (a + b) * c = a * c + b * c :=
by {ext; {simp, ring}}

-- Question 2b
-- Previous lemmas were written explicitly to make ring instance compile faster
instance : ring ℍ :=
{mul := (*), mul_assoc := mul_assoc, one := 1, one_mul := one_mul,
    mul_one := mul_one, left_distrib := left_distrib, right_distrib := right_distrib, .. (by apply_instance : add_comm_group ℍ)}
.

@[simp] lemma sub_re (z w : ℍ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_i (z w : ℍ) : (z - w).i = z.i - w.i := rfl
@[simp] lemma sub_j (z w : ℍ) : (z - w).j = z.j - w.j := rfl
@[simp] lemma sub_k (z w : ℍ) : (z - w).k = z.k - w.k := rfl
@[simp] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℍ) = r - s := ext_iff.2 $ by simp
@[simp] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℍ) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : ℍ) : z - conj z = (2 * z.i : ℝ) * I + (2 * z.j : ℝ) * J + (2 * z.k : ℝ) * K:=
ext_iff.2 $ by simp [two_mul]

lemma norm_sq_sub (z w : ℍ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by rw [sub_eq_add_neg, norm_sq_add]; simp [-mul_re]

noncomputable instance : has_inv ℍ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℍ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℍ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_i (z : ℍ) : (z⁻¹).i = -z.i / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_j (z : ℍ) : (z⁻¹).j = -z.j / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_k (z : ℍ) : (z⁻¹).k = -z.k / norm_sq z := by simp [inv_def, division_def]

@[simp] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℍ) = r⁻¹ :=
ext_iff.2 $ begin
  simp,
  by_cases r = 0, {simp [h]},
  rw [← div_div_eq_div_mul, div_self h, one_div_eq_inv]
end

protected lemma inv_zero : (0⁻¹ : ℍ) = 0 :=
by rw [← of_real_zero, ← of_real_inv, inv_zero]

theorem mul_inv_cancel (z : ℍ) (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

theorem inv_mul_cancel (z : ℍ) (h : z ≠ 0) : z⁻¹ * z = 1 :=
by rw [inv_def, ← mul_comm_re, mul_assoc, mul_conj', ← of_real_mul,
inv_mul_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

instance re.is_add_group_hom : is_add_group_hom quaternion.re :=
by refine_struct {..}; simp

instance i.is_add_group_hom : is_add_group_hom quaternion.i :=
by refine_struct {..}; simp

instance j.is_add_group_hom : is_add_group_hom quaternion.j :=
by refine_struct {..}; simp

instance k.is_add_group_hom : is_add_group_hom quaternion.k :=
by refine_struct {..}; simp

instance of_real.is_ring_hom : is_ring_hom (coe : ℝ → ℍ) :=
by {constructor, refl, apply of_real_mul, apply of_real_add}

def smul : ℝ → ℍ → ℍ := λ r z, of_real r * z

infix `•` := smul

instance : has_scalar ℝ ℍ := {smul := smul}

lemma add_smul (r s : ℝ) (z : ℍ) : (r + s) • z = r • z + s • z :=
by {dsimp [(•)], ext; {simp, ring}}

lemma zero_smul (z : ℍ) : 0 • z = 0 :=
by {dsimp [(•)], ext; simp}

lemma one_smul (z : ℍ) : 1 • z = z :=
by {dsimp [(•)], simp}

lemma mul_smul (r s : ℝ) (z : ℍ) : (r * s) • z = r • (s • z) :=
by {dsimp [(•)], ext; {rw [of_real_mul, mul_assoc]}}

lemma smul_add (r : ℝ) (z w : ℍ) : r • (z + w) = r • z + r • w :=
by {dsimp [(•)], ext; {simp, ring}}

lemma smul_zero (r : ℝ) : r • 0 = 0 :=
by {dsimp [(•)], simp}

instance : semimodule ℝ ℍ :=
{add_smul := add_smul, zero_smul := zero_smul, one_smul := one_smul,
    mul_smul := mul_smul, smul_add := smul_add, smul_zero := smul_zero, ..}

instance : module ℝ ℍ := by constructor

lemma smul_def' (r : ℝ) (z : ℍ) : r • z = of_real r * z :=
begin
    dsimp [(•)],
    simp,
end

-- Question 2c
instance : algebra ℝ ℍ :=
{to_fun := of_real, commutes' := by simp, smul_def' := smul_def', hom := of_real.is_ring_hom}

-- Question 2g
noncomputable instance : division_ring ℍ :=
{inv := has_inv.inv, zero_ne_one := one_ne_zero.symm, mul_inv_cancel := mul_inv_cancel,
    inv_mul_cancel := inv_mul_cancel, .. (by apply_instance : ring ℍ)}
.

end quaternion


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

! This file was ported from Lean 3 source module analysis.convex.exposed
! leanprover-community/mathlib commit 48024901a8e2a462363650c50d62248a77cbcab3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Extreme
import Mathbin.Analysis.Convex.Function
import Mathbin.Topology.Algebra.Module.Basic
import Mathbin.Topology.Order.Basic

/-!
# Exposed sets

This file defines exposed sets and exposed points for sets in a real vector space.

An exposed subset of `A` is a subset of `A` that is the set of all maximal points of a functional
(a continuous linear map `E → 𝕜`) over `A`. By convention, `∅` is an exposed subset of all sets.
This allows for better functoriality of the definition (the intersection of two exposed subsets is
exposed, faces of a polytope form a bounded lattice).
This is an analytic notion of "being on the side of". It is stronger than being extreme (see
`is_exposed.is_extreme`), but weaker (for exposed points) than being a vertex.

An exposed set of `A` is sometimes called a "face of `A`", but we decided to reserve this
terminology to the more specific notion of a face of a polytope (sometimes hopefully soon out
on mathlib!).

## Main declarations

* `is_exposed 𝕜 A B`: States that `B` is an exposed set of `A` (in the literature, `A` is often
  implicit).
* `is_exposed.is_extreme`: An exposed set is also extreme.

## References

See chapter 8 of [Barry Simon, *Convexity*][simon2011]

## TODO

Define intrinsic frontier/interior and prove the lemmas related to exposed sets and points.

Generalise to Locally Convex Topological Vector Spaces™

More not-yet-PRed stuff is available on the branch `sperner_again`.
-/

open Classical Affine BigOperators

open Set

section PreorderSemiring

variable (𝕜 : Type _) {E : Type _} [TopologicalSpace 𝕜] [Semiring 𝕜] [Preorder 𝕜] [AddCommMonoid E]
  [TopologicalSpace E] [Module 𝕜 E] {A B : Set E}

/-- A set `B` is exposed with respect to `A` iff it maximizes some functional over `A` (and contains
all points maximizing it). Written `is_exposed 𝕜 A B`. -/
def IsExposed (A B : Set E) : Prop :=
  B.Nonempty → ∃ l : E →L[𝕜] 𝕜, B = { x ∈ A | ∀ y ∈ A, l y ≤ l x }
#align is_exposed IsExposed

end PreorderSemiring

section OrderedRing

variable {𝕜 : Type _} {E : Type _} [TopologicalSpace 𝕜] [OrderedRing 𝕜] [AddCommMonoid E]
  [TopologicalSpace E] [Module 𝕜 E] {l : E →L[𝕜] 𝕜} {A B C : Set E} {X : Finset E} {x : E}

/-- A useful way to build exposed sets from intersecting `A` with halfspaces (modelled by an
inequality with a functional). -/
def ContinuousLinearMap.toExposed (l : E →L[𝕜] 𝕜) (A : Set E) : Set E :=
  { x ∈ A | ∀ y ∈ A, l y ≤ l x }
#align continuous_linear_map.to_exposed ContinuousLinearMap.toExposed

theorem ContinuousLinearMap.toExposed.isExposed : IsExposed 𝕜 A (l.toExposed A) := fun h => ⟨l, rfl⟩
#align continuous_linear_map.to_exposed.is_exposed ContinuousLinearMap.toExposed.isExposed

theorem isExposed_empty : IsExposed 𝕜 A ∅ := fun ⟨x, hx⟩ =>
  by
  exfalso
  exact hx
#align is_exposed_empty isExposed_empty

namespace IsExposed

protected theorem subset (hAB : IsExposed 𝕜 A B) : B ⊆ A :=
  by
  rintro x hx
  obtain ⟨_, rfl⟩ := hAB ⟨x, hx⟩
  exact hx.1
#align is_exposed.subset IsExposed.subset

@[refl]
protected theorem refl (A : Set E) : IsExposed 𝕜 A A := fun ⟨w, hw⟩ =>
  ⟨0, Subset.antisymm (fun x hx => ⟨hx, fun y hy => le_refl 0⟩) fun x hx => hx.1⟩
#align is_exposed.refl IsExposed.refl

protected theorem antisymm (hB : IsExposed 𝕜 A B) (hA : IsExposed 𝕜 B A) : A = B :=
  hA.Subset.antisymm hB.Subset
#align is_exposed.antisymm IsExposed.antisymm

/- `is_exposed` is *not* transitive: Consider a (topologically) open cube with vertices
`A₀₀₀, ..., A₁₁₁` and add to it the triangle `A₀₀₀A₀₀₁A₀₁₀`. Then `A₀₀₁A₀₁₀` is an exposed subset
of `A₀₀₀A₀₀₁A₀₁₀` which is an exposed subset of the cube, but `A₀₀₁A₀₁₀` is not itself an exposed
subset of the cube. -/
protected theorem mono (hC : IsExposed 𝕜 A C) (hBA : B ⊆ A) (hCB : C ⊆ B) : IsExposed 𝕜 B C :=
  by
  rintro ⟨w, hw⟩
  obtain ⟨l, rfl⟩ := hC ⟨w, hw⟩
  exact
    ⟨l,
      subset.antisymm (fun x hx => ⟨hCB hx, fun y hy => hx.2 y (hBA hy)⟩) fun x hx =>
        ⟨hBA hx.1, fun y hy => (hw.2 y hy).trans (hx.2 w (hCB hw))⟩⟩
#align is_exposed.mono IsExposed.mono

/-- If `B` is a nonempty exposed subset of `A`, then `B` is the intersection of `A` with some closed
halfspace. The converse is *not* true. It would require that the corresponding open halfspace
doesn't intersect `A`. -/
theorem eq_inter_halfspace' {A B : Set E} (hAB : IsExposed 𝕜 A B) (hB : B.Nonempty) :
    ∃ l : E →L[𝕜] 𝕜, ∃ a, B = { x ∈ A | a ≤ l x } :=
  by
  obtain ⟨l, rfl⟩ := hAB hB
  obtain ⟨w, hw⟩ := hB
  exact
    ⟨l, l w,
      subset.antisymm (fun x hx => ⟨hx.1, hx.2 w hw.1⟩) fun x hx =>
        ⟨hx.1, fun y hy => (hw.2 y hy).trans hx.2⟩⟩
#align is_exposed.eq_inter_halfspace' IsExposed.eq_inter_halfspace'

/-- For nontrivial `𝕜`, if `B` is an exposed subset of `A`, then `B` is the intersection of `A` with
some closed halfspace. The converse is *not* true. It would require that the corresponding open
halfspace doesn't intersect `A`. -/
theorem eq_inter_halfspace [Nontrivial 𝕜] {A B : Set E} (hAB : IsExposed 𝕜 A B) :
    ∃ l : E →L[𝕜] 𝕜, ∃ a, B = { x ∈ A | a ≤ l x } :=
  by
  obtain rfl | hB := B.eq_empty_or_nonempty
  · refine' ⟨0, 1, _⟩
    rw [eq_comm, eq_empty_iff_forall_not_mem]
    rintro x ⟨-, h⟩
    rw [ContinuousLinearMap.zero_apply] at h
    have : ¬(1 : 𝕜) ≤ 0 := not_le_of_lt zero_lt_one
    contradiction
  exact hAB.eq_inter_halfspace' hB
#align is_exposed.eq_inter_halfspace IsExposed.eq_inter_halfspace

protected theorem inter [ContinuousAdd 𝕜] {A B C : Set E} (hB : IsExposed 𝕜 A B)
    (hC : IsExposed 𝕜 A C) : IsExposed 𝕜 A (B ∩ C) :=
  by
  rintro ⟨w, hwB, hwC⟩
  obtain ⟨l₁, rfl⟩ := hB ⟨w, hwB⟩
  obtain ⟨l₂, rfl⟩ := hC ⟨w, hwC⟩
  refine' ⟨l₁ + l₂, subset.antisymm _ _⟩
  · rintro x ⟨⟨hxA, hxB⟩, ⟨-, hxC⟩⟩
    exact ⟨hxA, fun z hz => add_le_add (hxB z hz) (hxC z hz)⟩
  rintro x ⟨hxA, hx⟩
  refine' ⟨⟨hxA, fun y hy => _⟩, hxA, fun y hy => _⟩
  ·
    exact
      (add_le_add_iff_right (l₂ x)).1 ((add_le_add (hwB.2 y hy) (hwC.2 x hxA)).trans (hx w hwB.1))
  ·
    exact
      (add_le_add_iff_left (l₁ x)).1 (le_trans (add_le_add (hwB.2 x hxA) (hwC.2 y hy)) (hx w hwB.1))
#align is_exposed.inter IsExposed.inter

theorem interₛ [ContinuousAdd 𝕜] {F : Finset (Set E)} (hF : F.Nonempty)
    (hAF : ∀ B ∈ F, IsExposed 𝕜 A B) : IsExposed 𝕜 A (⋂₀ F) :=
  by
  revert hF F
  refine' Finset.induction _ _
  · rintro h
    exfalso
    exact not_nonempty_empty h
  rintro C F _ hF _ hCF
  rw [Finset.coe_insert, sInter_insert]
  obtain rfl | hFnemp := F.eq_empty_or_nonempty
  · rw [Finset.coe_empty, sInter_empty, inter_univ]
    exact hCF C (Finset.mem_singleton_self C)
  exact
    (hCF C (Finset.mem_insert_self C F)).inter
      (hF hFnemp fun B hB => hCF B (Finset.mem_insert_of_mem hB))
#align is_exposed.sInter IsExposed.interₛ

theorem inter_left (hC : IsExposed 𝕜 A C) (hCB : C ⊆ B) : IsExposed 𝕜 (A ∩ B) C :=
  by
  rintro ⟨w, hw⟩
  obtain ⟨l, rfl⟩ := hC ⟨w, hw⟩
  exact
    ⟨l,
      subset.antisymm (fun x hx => ⟨⟨hx.1, hCB hx⟩, fun y hy => hx.2 y hy.1⟩)
        fun x ⟨⟨hxC, _⟩, hx⟩ => ⟨hxC, fun y hy => (hw.2 y hy).trans (hx w ⟨hC.subset hw, hCB hw⟩)⟩⟩
#align is_exposed.inter_left IsExposed.inter_left

theorem inter_right (hC : IsExposed 𝕜 B C) (hCA : C ⊆ A) : IsExposed 𝕜 (A ∩ B) C :=
  by
  rw [inter_comm]
  exact hC.inter_left hCA
#align is_exposed.inter_right IsExposed.inter_right

protected theorem isClosed [OrderClosedTopology 𝕜] {A B : Set E} (hAB : IsExposed 𝕜 A B)
    (hA : IsClosed A) : IsClosed B :=
  by
  obtain rfl | hB := B.eq_empty_or_nonempty
  · simp
  obtain ⟨l, a, rfl⟩ := hAB.eq_inter_halfspace' hB
  exact hA.is_closed_le continuousOn_const l.continuous.continuous_on
#align is_exposed.is_closed IsExposed.isClosed

protected theorem isCompact [OrderClosedTopology 𝕜] [T2Space E] {A B : Set E}
    (hAB : IsExposed 𝕜 A B) (hA : IsCompact A) : IsCompact B :=
  isCompact_of_isClosed_subset hA (hAB.IsClosed hA.IsClosed) hAB.Subset
#align is_exposed.is_compact IsExposed.isCompact

end IsExposed

variable (𝕜)

/-- A point is exposed with respect to `A` iff there exists an hyperplane whose intersection with
`A` is exactly that point. -/
def Set.exposedPoints (A : Set E) : Set E :=
  { x ∈ A | ∃ l : E →L[𝕜] 𝕜, ∀ y ∈ A, l y ≤ l x ∧ (l x ≤ l y → y = x) }
#align set.exposed_points Set.exposedPoints

variable {𝕜}

theorem exposed_point_def :
    x ∈ A.exposedPoints 𝕜 ↔ x ∈ A ∧ ∃ l : E →L[𝕜] 𝕜, ∀ y ∈ A, l y ≤ l x ∧ (l x ≤ l y → y = x) :=
  Iff.rfl
#align exposed_point_def exposed_point_def

theorem exposedPoints_subset : A.exposedPoints 𝕜 ⊆ A := fun x hx => hx.1
#align exposed_points_subset exposedPoints_subset

@[simp]
theorem exposedPoints_empty : (∅ : Set E).exposedPoints 𝕜 = ∅ :=
  subset_empty_iff.1 exposedPoints_subset
#align exposed_points_empty exposedPoints_empty

/-- Exposed points exactly correspond to exposed singletons. -/
theorem mem_exposedPoints_iff_exposed_singleton : x ∈ A.exposedPoints 𝕜 ↔ IsExposed 𝕜 A {x} :=
  by
  use fun ⟨hxA, l, hl⟩ h =>
    ⟨l,
      Eq.symm <|
        eq_singleton_iff_unique_mem.2
          ⟨⟨hxA, fun y hy => (hl y hy).1⟩, fun z hz => (hl z hz.1).2 (hz.2 x hxA)⟩⟩
  rintro h
  obtain ⟨l, hl⟩ := h ⟨x, mem_singleton _⟩
  rw [eq_comm, eq_singleton_iff_unique_mem] at hl
  exact
    ⟨hl.1.1, l, fun y hy =>
      ⟨hl.1.2 y hy, fun hxy => hl.2 y ⟨hy, fun z hz => (hl.1.2 z hz).trans hxy⟩⟩⟩
#align mem_exposed_points_iff_exposed_singleton mem_exposedPoints_iff_exposed_singleton

end OrderedRing

section LinearOrderedRing

variable {𝕜 : Type _} {E : Type _} [TopologicalSpace 𝕜] [LinearOrderedRing 𝕜] [AddCommMonoid E]
  [TopologicalSpace E] [Module 𝕜 E] {A B C : Set E}

namespace IsExposed

protected theorem convex (hAB : IsExposed 𝕜 A B) (hA : Convex 𝕜 A) : Convex 𝕜 B :=
  by
  obtain rfl | hB := B.eq_empty_or_nonempty
  · exact convex_empty
  obtain ⟨l, rfl⟩ := hAB hB
  exact fun x₁ hx₁ x₂ hx₂ a b ha hb hab =>
    ⟨hA hx₁.1 hx₂.1 ha hb hab, fun y hy =>
      ((l.to_linear_map.concave_on convex_univ).convex_ge _ ⟨mem_univ _, hx₁.2 y hy⟩
          ⟨mem_univ _, hx₂.2 y hy⟩ ha hb hab).2⟩
#align is_exposed.convex IsExposed.convex

protected theorem isExtreme (hAB : IsExposed 𝕜 A B) : IsExtreme 𝕜 A B :=
  by
  refine' ⟨hAB.subset, fun x₁ hx₁A x₂ hx₂A x hxB hx => _⟩
  obtain ⟨l, rfl⟩ := hAB ⟨x, hxB⟩
  have hl : ConvexOn 𝕜 univ l := l.to_linear_map.convex_on convex_univ
  have hlx₁ := hxB.2 x₁ hx₁A
  have hlx₂ := hxB.2 x₂ hx₂A
  refine' ⟨⟨hx₁A, fun y hy => _⟩, ⟨hx₂A, fun y hy => _⟩⟩
  · have := @ConvexOn.le_left_of_right_le 𝕜 E 𝕜 _ _ _
    rw [hlx₁.antisymm (hl.le_left_of_right_le (mem_univ _) (mem_univ _) hx hlx₂)]
    exact hxB.2 y hy
  · rw [hlx₂.antisymm (hl.le_right_of_left_le (mem_univ _) (mem_univ _) hx hlx₁)]
    exact hxB.2 y hy
#align is_exposed.is_extreme IsExposed.isExtreme

end IsExposed

theorem exposedPoints_subset_extremePoints : A.exposedPoints 𝕜 ⊆ A.extremePoints 𝕜 := fun x hx =>
  mem_extremePoints_iff_extreme_singleton.2 (mem_exposedPoints_iff_exposed_singleton.1 hx).IsExtreme
#align exposed_points_subset_extreme_points exposedPoints_subset_extremePoints

end LinearOrderedRing