-- Inspired by Patrick Massot
-- This approach differs from that of Patrick's by using continuity instead of boundedness. As with Caratheodory, this hides norms and epsilon-deltas as much as possible.
-- Boundedness and continuity for linear operators are equivalent on the most common spaces of study, but may diverge on other spaces.
-- continuity also provides more general proofs than norm arguments.
-- admittedly, with the more powerful norm_num, the gap between the two approaches is smaller. I still believe continuous is the right way forward. It still replicates less work than boundedness
-- TODO: Lean still doesn't have pointwise continuity(!). We want that to make proofs more general. It's pretty simple to do.
-- TODO: continuous at 0/arbitrary point => continuous everywhere
-- see http://matrixeditions.com/FA.Chap3.1-4.pdf (among others)
-- TODO: copy module.lean and linear_map_module.lean

import algebra.field
import tactic.norm_num
import analysis.topology.continuity
import .norm
import order.complete_lattice

open lattice

noncomputable theory
local attribute [instance] classical.prop_decidable

local notation f `→_{`:50 a `}`:0 b := filter.tendsto f (nhds a) (nhds b)

universes u v w x
variables {k : Type u}
variables {E : Type v}
variables {F : Type w}
variables {G : Type x}

structure is_continuous_linear_map' {k : Type u} {E : Type v} {F : Type w} [normed_field k] [normed_space k E] [normed_space k F] (L : E → F) extends is_linear_map L : Prop :=
(continuous : continuous L)

-- def is_continuous_linear_map' (L : E → F) := (is_linear_map L) ∧ (continuous L)

-- ways to combine is_continuous_linear_map' proofs
namespace is_continuous_linear_map'
variables [normed_field k] [normed_space k E] [normed_space k F] [normed_space k G]
variable {L : E → F}
include k

lemma zero : is_continuous_linear_map' (λ (x:E), (0:F)) :=
⟨is_linear_map.map_zero, continuous_const⟩

lemma id : is_continuous_linear_map' (id : E → E) :=
⟨is_linear_map.id, continuous_id⟩

-- Remark: smul and add should follow immediately from the fact that normed vectors spaces are topological vector spaces

-- this seems harder than its bounded counterpart (which is admittedly nontrivial)
lemma smul (c : k) (H : is_continuous_linear_map' L) : is_continuous_linear_map' (λ e, c•L e) := sorry

lemma neg (H : is_continuous_linear_map' L) :
is_continuous_linear_map' (λ e, -L e) :=
begin
  rcases H with ⟨lin, cont⟩,
  split,
  { exact is_linear_map.map_neg lin },
  { exact continuous_neg cont }
end

lemma add {L : E → F} {M : E → F} (HL : is_continuous_linear_map' L) (HM : is_continuous_linear_map' M) :
is_continuous_linear_map' (λ e, L e + M e) :=
begin
  rcases HL with ⟨lin_L, cont_L⟩,
  rcases HM with ⟨lin_M , cont_M⟩,
  split,
  { exact is_linear_map.map_add lin_L lin_M },
  { exact continuous_add cont_L cont_M }
end

lemma sub {L : E → F} {M : E → F} (HL : is_continuous_linear_map' L) (HM : is_continuous_linear_map' M) :
is_continuous_linear_map' (λ e, L e - M e) := add HL (neg HM)

lemma comp {L : E → F} {M : F → G} (HL : is_continuous_linear_map' L) (HM  : is_continuous_linear_map' M) : is_continuous_linear_map' (M ∘ L) :=
begin
rcases HL with ⟨lin_L, cont_L⟩,
rcases HM with ⟨lin_M, cont_M⟩,
split,
{ exact is_linear_map.comp lin_M lin_L },
{ exact continuous.comp cont_L cont_M }
end

end is_continuous_linear_map'

-- some holdover code about bounded linear maps. it will eventually be useful, but not currently used, because is_continuous_linear_map' is better

structure is_bounded_linear_map {k : Type u} {E : Type v} {F : Type w} [normed_field k] [normed_space k E] [normed_space k F] (L : E → F) extends is_linear_map L : Prop :=
(bounded : ∃ M > 0, ∀ x : E, ∥L x∥ ≤ M * ∥x∥)

namespace is_bounded_linear_map
variables [normed_field k] [normed_space k E] [normed_space k F] [normed_space k G]
include k

lemma continuous {L : E → F} (H : is_bounded_linear_map L) : continuous L :=
begin
  rcases H with ⟨lin, M, Mpos, ineq⟩,
  apply continuous_iff_tendsto.2,
  intro x,
  apply tendsto_iff_norm_tendsto_zero.2,
  replace ineq := λ e, calc ∥L e - L x∥ = ∥L (e - x)∥ : by rw [←(lin.sub e x)]
  ... ≤ M*∥e-x∥ : ineq (e-x),
  have lim1 : (λ (x:E), M) →_{x} M := tendsto_const_nhds,

  have lim2 : (λ e, e-x) →_{x} 0 :=
  begin
    have limId := continuous_iff_tendsto.1 continuous_id x,
    have limx : (λ (e : E), -x) →_{x} -x := tendsto_const_nhds,
    have := tendsto_add limId limx,
    simp at this,
    simpa using this,
  end,
  replace lim2 := filter.tendsto.comp lim2 lim_norm_zero,
  apply squeeze_zero,
  { simp[norm_nonneg] },
  { exact ineq },
  { simpa using tendsto_mul lim1 lim2 }
end

-- not sure why this fails now
lemma lim_zero_bounded_linear_map {L : E → F} (H : is_bounded_linear_map L) : (L →_{0} 0) :=
by simpa [H.left.zero] using continuous_iff_tendsto.1 H.continuous 0

end is_bounded_linear_map

-- Next lemma is stated for real normed space but it would work as soon as the base field is an extension of ℝ
lemma bounded_continuous_linear_map {E : Type*} [normed_space ℝ E] {F : Type*}  [normed_space ℝ F] {L : E → F}
(h : is_continuous_linear_map' L) : is_bounded_linear_map L :=
begin
  rcases h with ⟨lin, cont⟩,
  split,
  assumption,
  replace cont := continuous_of_metric.1 cont 1 (by norm_num),
  swap, exact 0,
  rw[lin.zero] at cont,
  rcases cont with ⟨δ, δ_pos, H⟩,
  revert H,
  repeat { conv in (_ < _ ) { rw norm_dist } },
  intro H,
  existsi (δ/2)⁻¹,
  have half_δ_pos := half_pos δ_pos,
  split,
  exact (inv_pos half_δ_pos),
  intro x,
  by_cases h : x = 0,
  { simp [h, lin.zero] }, -- case x = 0
  { -- case x ≠ 0
    have norm_x_pos : ∥x∥ > 0 := norm_pos_iff.2 h,
    have norm_x : ∥x∥ ≠ 0 := mt norm_zero_iff_zero.1 h,

    let p := ∥x∥*(δ/2)⁻¹,
    have p_pos : p > 0 := mul_pos norm_x_pos (inv_pos $ half_δ_pos),
    have p0 := ne_of_gt p_pos,

    let q := (δ/2)*∥x∥⁻¹,
    have q_pos : q > 0 := div_pos half_δ_pos norm_x_pos,
    have q0 := ne_of_gt q_pos,

    have triv := calc
     p*q = ∥x∥*((δ/2)⁻¹*(δ/2))*∥x∥⁻¹ : by simp[mul_assoc]
     ... = 1 : by simp [(inv_mul_cancel $ ne_of_gt half_δ_pos), mul_inv_cancel norm_x],

    have norm_calc := calc ∥q•x∥ = abs(q)*∥x∥ : by {rw norm_smul, refl}
    ... = q*∥x∥ : by rw [abs_of_nonneg $ le_of_lt q_pos]
    ... = δ/2 :  by simp [mul_assoc, inv_mul_cancel norm_x]
    ... < δ : half_lt_self δ_pos,

    exact calc
    ∥L x∥ = ∥L (1•x)∥: by simp
    ... = ∥L ((p*q)•x) ∥ : by {rw [←triv] }
    ... = ∥L (p•q•x) ∥ : by rw mul_smul
    ... = ∥p•L (q•x) ∥ : by rw lin.smul
    ... = abs(p)*∥L (q•x) ∥ : by { rw norm_smul, refl}
    ... = p*∥L (q•x) ∥ : by rw [abs_of_nonneg $ le_of_lt $ p_pos]
    ... ≤ p*1 : le_of_lt $ mul_lt_mul_of_pos_left (H norm_calc) p_pos
    ... = p : by simp
    ... = (δ/2)⁻¹*∥x∥ : by simp[mul_comm] }
end

/- Continuous Linear Maps -/

-- the following approach is based off that of poly in number_theory/dioph.lean, which also packages together functions with their proofs

-- for now, k is implicit
def clm {k : Type*} (E : Type*) (F : Type*) [normed_field k] [normed_space k E] [normed_space k F] := { L : E → F // is_continuous_linear_map' L }

-- TODO: I think clm should be a structure/class (what's the difference?) that extends linear_map (which isn't a structure/class...) and continuous (which also isn't a structure/class). perhaps it should just be coercible instead

namespace clm
variables [normed_field k] [normed_space k E] [normed_space k F] [normed_space k G]
include k

-- TODO: how to get multiplication notation?
-- we can treat a clm as a function
instance : has_coe_to_fun (clm E F) := ⟨_, λ L, L.1⟩

-- treat clm application as "multiplication" and give it the right space
-- Need it to be tupled so continuity makes sense naturally (could also use the approach in topological_structures.lean)
-- TODO: this feels really bad. The notation is always exposed. Need to find a better way
def clm_app_pair (p : (clm E F) × E) := p.1 p.2
local notation L `⬝`:70 v := clm_app_pair ⟨L, v⟩
@[simp] theorem clm_app_pair_eval (L : clm E F) (v) : (L⬝v) = L v := rfl

-- proof data
-- isc is short for is_clm
def isc (L : clm E F) : is_continuous_linear_map' L := L.2

-- functional extensionality
def ext {L M : clm E F} (e : ∀ v, L⬝v = M⬝v) : L = M :=
subtype.eq (funext e)

-- construct isc given function that is extensionally equal
def subst (L : clm E F) (M : E → F) (e : ∀ v, L⬝v = M v) : clm E F :=
-- TODO: I don't know how the proof part works
⟨M, by rw ← (funext e : coe_fn L = M); exact L.isc⟩
-- TODO: this rewrite rule doesn't typecheck!! (it was taken directly from poly unless I messed that up)
-- @[simp] theorem subst_eval (L M e v) : subst L M e v = M v := rfl

-- composition
-- TODO: this should probably be an instance
def clm_comp : clm E F → clm F G → clm E G := λ L M, ⟨λ v, M (L v), is_continuous_linear_map'.comp L.2 M.2⟩
local notation M `∘` L := clm_comp L M

-- each of the identities and operations comes with an instance that tells Lean what it is and a simplification lemma that gives Lean a hint about how to "evaluate" it

-- zero map
def zero : clm E F := ⟨λ v, 0, is_continuous_linear_map'.zero⟩
instance : has_zero (clm E F) := ⟨clm.zero⟩
@[simp] theorem zero_eval (v) : (0 : clm E F)⬝v = 0 := rfl

-- identity map
-- TODO: not sure if this is necessary or even desirable
def one : clm E E := ⟨λ v, v, is_continuous_linear_map'.id⟩
instance : has_one (clm E E) := ⟨clm.one⟩
@[simp] theorem one_eval (v) : (1 : clm E E)⬝v = v := rfl

def add : clm E F → clm E F → clm E F := λ L M, ⟨L + M, is_continuous_linear_map'.add L.isc M.isc⟩
instance : has_add (clm E F) := ⟨clm.add⟩
@[simp] theorem add_eval : Π (L M : clm E F) v, (L + M)⬝v = L⬝v + M⬝v
| ⟨L, pL⟩ ⟨M, pM⟩ v := rfl

def neg : clm E F → clm E F := λ L, ⟨λ v, -(L⬝v), is_continuous_linear_map'.neg L.isc⟩
instance : has_neg (clm E F) := ⟨clm.neg⟩

def sub : clm E F → clm E F → clm E F := λ L M, L + (-M)
instance : has_sub (clm E F) := ⟨clm.sub⟩
@[simp] theorem sub_eval : Π (L M : clm E F) v, (L - M)⬝v = L⬝v - M⬝v
| ⟨L, pL⟩ ⟨M, pM⟩ v := rfl

-- TODO: this proof doesn't work even though it does for poly
-- possibly b/c neg and sub are defined differently?
-- TODO: this feels weird being disconnected from neg
@[simp] theorem neg_eval (L : clm E F) (v) : (-L)⬝v = -(L⬝v) := sorry
-- show (0 - L) v = _, by simp

def smul : k → clm E F → clm E F := λ c L, ⟨λ v, c•(L⬝v), is_continuous_linear_map'.smul c L.isc⟩
instance : has_scalar k (clm E F) := ⟨clm.smul⟩
-- TODO: prove it
@[simp] theorem smul_eval : Π c (L : clm E F) v, (c•L)⬝v = c•(L⬝v) := sorry

-- need these instances up here to prove stuff about the op norm
-- TODO: go straight to module?
instance : add_comm_group (clm E F) := by refine
{
  add := (+),
  zero := 0,
  neg := has_neg.neg,
  ..
};
{ intros; exact ext (λ v, by simp) }

-- TODO: use refine
instance : module k (clm E F) :=
{
  smul := (•),

  smul_add := by intros; exact ext (λ v, by simp [smul_add]),
  add_smul := by intros; exact ext (λ v, by simp [add_smul]),
  mul_smul := by intros; exact ext (λ v, by simp [mul_smul]),
  one_smul := by intros; exact ext (λ v, by simp [one_smul]),
}

/- Operator Norm -/

-- TODO: this might be better in a different section, but we'll keep it here for now

-- TODO: leverage boundedness proof above to show that Inf has a value
-- TODO: big ops should make this easier to define (I think)
def op_norm : clm E F → ℝ := λ L, Inf { M : ℝ | M ≥ 0 ∧ ∀ v : E, ∥L⬝v∥ ≤ M * ∥v∥ }
-- TODO: implement has_norm
-- instance : has_norm (clm E F) := ⟨clm.op_norm⟩

-- an alternate version that allows for easier proofs
theorem op_norm_alt : ∀ L : clm E F, op_norm L = Sup { c : ℝ | ∃ v, ∥v∥ ≤ 1 ∧ ∥L⬝v∥ = c } := sorry

theorem op_norm_inhabited {L : clm E F} : (0:ℝ) ∈ { c : ℝ | ∃ v, ∥v∥ ≤ 1 ∧ ∥L⬝v∥ = c } :=
begin
existsi (0:E),
split,
simp [zero_le_one],
apply norm_zero_iff_zero.2,
-- follows from L being a linear map
end

-- TODO: uglier than it should be
theorem op_norm_nonneg {L : clm E F} : op_norm L ≥ 0 :=
begin
unfold op_norm ge,
apply real.lb_le_Inf,
-- bounded
{
  simp,
  have : is_bounded_linear_map L,
  begin
  -- TODO: I think what's going wrong here is I should have a companion proof that clms and blms are isomorphic
    -- exact bounded_continuous_linear_map L.isc,
    admit
  end,
  rcases this with ⟨linear, M, M_pos, M_bound⟩,
  existsi _,
  split,
  apply le_of_lt,
  assumption,
  assumption
},
{
  intro,
  simp,
  intros,
  assumption
}
end

theorem op_norm_zero_iff_zero {L : clm E F} : op_norm L = 0 ↔ L = 0 :=
begin
split,
{
  rw [op_norm_alt],
  admit
},
admit
end

theorem op_norm_pos_homo : ∀ c (L : clm E F), op_norm (c•L) = ∥c∥ * op_norm L := sorry

theorem op_norm_triangle : ∀ (L M : clm E F), op_norm (L + M) ≤ op_norm L + op_norm M :=
begin
intros,
simp [op_norm_alt],
admit
end

-- TODO: is there a way to get the auto-induced metric from a norm without doing any work? Don't do this for now

def op_dist : clm E F → clm E F → ℝ := λ L M, op_norm (L - M)

theorem op_dist_self : ∀ x : clm E F, op_dist x x = 0 :=
begin
intros,
unfold op_dist,
apply op_norm_zero_iff_zero.2,
simp [add_left_neg]
end

theorem op_dist_eq_of_dist_eq_zero : ∀ (x y : clm E F), op_dist x y = 0 → x = y :=
begin
unfold op_dist,
intros x y h,
apply sub_eq_zero.1,
apply op_norm_zero_iff_zero.1,
assumption
end
-- TODO: clm is an instance of normed_space

theorem op_dist_comm : ∀ (x y : clm E F), op_dist x y = op_dist y x :=
begin
intros,
simp [op_dist, op_norm],
congr,
funext,
admit,
-- the propositions are the same by the pos_homo for the underlying norm
end

theorem op_dist_triangle : ∀ (x y z : clm E F), op_dist x z ≤ op_dist x y + op_dist y z :=
begin
intros,
unfold op_dist,
calc
op_norm (x - z) = op_norm ((x - y) + (y - z)) : by simp
            ... ≤ op_norm (x - y) + op_norm (y - z) : by apply op_norm_triangle
end

/- Continuous Linear Maps form a normed vector space. -/

-- This is crucial for differentiation.

-- TODO: solve
instance : metric_space (clm E F) :=
{
  dist := op_dist,

  dist_self := op_dist_self,
  eq_of_dist_eq_zero := op_dist_eq_of_dist_eq_zero,
  dist_comm := op_dist_comm,
  dist_triangle := op_dist_triangle
}

instance : normed_space k (clm E F) :=
{
  norm := op_norm,

  dist_eq := by intros; refl,
  norm_smul := op_norm_pos_homo
}

end clm


import group_theory.quotient_group
import category_theory.isomorphism_classes
import algebra.category.Group
import .subgroup

open subgroup

@[to_additive is_simple_add]
def is_simple (G : Type*) [group G] : Prop :=
∀ (N : subgroup G), N.normal → N = ⊥ ∨ N = ⊤

variables {G H : Type*} [group G] [group H]

@[simp, to_additive is_simple_add_coe_AddGroup]
lemma is_simple_coe_Group : is_simple ↥(Group.of G) ↔ is_simple G := by refl

@[simp, to_additive not_is_simple_add]
lemma not_is_simple : ¬ is_simple G ↔ ∃ (N : subgroup G), N.normal ∧ N ≠ ⊥ ∧ N ≠ ⊤ :=
by { dsimp [is_simple], push_neg }

@[to_additive is_simple_add_of_surjetion]
lemma is_simple_of_surjection (hG : is_simple G) (f : G →* H) (hf : function.surjective f) :
  is_simple H :=
λ N hN, begin
  cases hG (N.comap f) (normal.comap hN f),
  { left, rw [← map_bot f, ← h, map_comap_eq hf] },
  right, rw ← comap_top f at h, rw [← map_comap_eq hf ⊤, ← h, map_comap_eq hf],
end

@[to_additive add_equiv_is_simple_add_iff]
lemma mul_equiv_is_simple_iff (h : G ≃* H) : is_simple G ↔ is_simple H :=
⟨λ hG, is_simple_of_surjection hG h.to_monoid_hom h.right_inv.surjective,
  λ hH, is_simple_of_surjection hH h.symm.to_monoid_hom h.symm.right_inv.surjective⟩

open category_theory

@[simp, to_additive is_simple_add_class]
def is_simple_class (C : isomorphism_classes.obj (Cat.of Group)) : Prop :=
quotient.lift_on' C (λ (G : Group), is_simple G)
  (λ G H ⟨h⟩, eq_iff_iff.mpr $ mul_equiv_is_simple_iff (iso.Group_iso_to_mul_equiv h))

@[to_additive is_simple_add_quotient_eq]
def is_simple_quotient_eq {N M : subgroup G} [N.normal] [M.normal] (h : N = M) :
  is_simple (quotient_group.quotient N) = is_simple (quotient_group.quotient M) :=
by unfreezingI { subst h }


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

open_locale nat rat real big_operators topological_space

theorem induction_nfactltnexpnm1ngt3
  (n : ℕ)
  (h₀ : 3 ≤ n) :
  nat.factorial n < n^(n - 1) :=
begin
  induction h₀ with k h₀ IH,
  { norm_num },
  {
    have k_ge_one : 1 ≤ k := le_trans dec_trivial h₀,
    calc k.succ.factorial = k.succ * k.factorial : rfl
                      ... < k.succ * k ^ (k-1) : (mul_lt_mul_left (nat.succ_pos k)).mpr IH
                      ... ≤ k.succ * (k.succ) ^ (k-1): nat.mul_le_mul_left _ $ nat.pow_le_pow_of_le_left (nat.le_succ k) (k-1)
                      ... = k.succ ^ (k-1 + 1): by rw ← (pow_succ k.succ (k-1))
                      ... = k.succ ^ k: by rw nat.sub_add_cancel k_ge_one,
  }
end


import .love02_backward_proofs_exercise_sheet

/-! # LoVe Homework 2: Backward Proofs

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1 (4 points): Connectives and Quantifiers

1.1 (3 points). Complete the following proofs using basic tactics such as
`intro`, `apply`, and `exact`. -/

lemma B (a b c : Prop) :
  (a → b) → (c → a) → c → b :=
begin
  intros hab hca hc,
  apply hab,
  apply hca,
  exact hc,
end

lemma S (a b c : Prop) :
  (a → b → c) → (a → b) → a → c :=
begin
  intros h hab ha,
  apply h,
  { apply ha, },
  { apply hab,
    apply ha,
  }
end

lemma more_nonsense (a b c d : Prop) :
  ((a → b) → c → d) → c → b → d :=
begin
  intros h hc hb,
  apply h,
  intros ha, exact hb,
  exact hc,
end

lemma even_more_nonsense (a b c : Prop) :
  (a → b) → (a → c) → a → b → c :=
begin
  intros hab hac ha hb,
  apply hac,
  exact ha,
end

/-! 1.2 (1 point). Prove the following lemma using basic tactics. -/

lemma weak_peirce (a b : Prop) :
  ((((a → b) → a) → a) → b) → b :=
begin
  intros h, apply h,
  intros g, apply g,
  intros f, apply h,
  intros g', apply f,
end

/-! ## Question 2 (5 points): Logical Connectives

2.1 (1 point). Prove the following property about double negation using basic
tactics.

Hints:

* Keep in mind that `¬ a` is the same as `a → false`. You can start by
  invoking `rw not_def` four times if this helps you.

* You will need to apply the elimination rule for `false` at a key point in the
  proof. -/

lemma herman (a : Prop) :
  ¬¬ (¬¬ a → a) :=
sorry

/-! 2.2 (2 points). Prove the missing link in our chain of classical axiom
implications.

Hints:

* One way to find the definitions of `double_negation` and `excluded_middle`
  quickly is to

  1. hold the Control (on Linux and Windows) or Command (on macOS) key pressed;
  2. move the cursor to the identifier `double_negation` or `excluded_middle`;
  3. click the identifier.

* You can use `rw double_negation` to unfold the definition of
  `double_negation`, and similarly for the other definitions.

* You will need to apply the double negation hypothesis for `a ∨ ¬ a`. You will
  also need the left and right introduction rules for `∨` at some point. -/

#check double_negation
#check excluded_middle

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

/-! 2.3 (2 points). We have proved three of the six possible implications between
`excluded_middle`, `peirce`, and `double_negation`. State and prove the
three missing implications, exploiting the three theorems we already have. -/

#check peirce_of_em
#check dn_of_peirce
#check em_of_dn

/-! 2.3 (2 points). We have proved three of the six possible implications
between `excluded_middle`, `peirce`, and `double_negation`. State and prove the
three missing implications, exploiting the three theorems we already have. -/

#check peirce_of_em
#check dn_of_peirce
#check em_of_dn

-- enter your solution here

end backward_proofs

end LoVe


--------------------------------
-- *Quantifiers and Equality* --
--------------------------------

------------------------------
-- The Universal Quantifier --
------------------------------
variable (α : Type) (r : α → α → Prop)

variable (refl_r : ∀ x, r x x)
variable (symm_r : ∀ {x y}, r x y → r y x)
variable (trans_r : ∀ {x y z}, r x y → r y z → r x z)

example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) : r a d :=
  trans_r (trans_r hab (symm_r hcb)) hcd

universe u

-- Equality --
#check @Eq.refl.{u}
#check @Eq.symm.{u}
#check @Eq.trans.{u}

variable (α β : Type)

example (f : α → β) (a : α) : (fun x => f x) a = f a := rfl
example (a : α) (b : α) : (a, b).1 = a := rfl
example : 2 + 3 = 5 := rfl

example (α : Type) (a b : α) (p : α → Prop)
        (h1 : a = b) (h2 : p a) : p b :=
  h1 ▸ h2

variable (α : Type)
variable (a b : α)
variable (f g : α → Nat)
variable (h₁ : a = b)
variable (h₂ : f = g)

#check @congrArg
#check @congrFun
#check @congr

example : f a = f b := congrArg f h₁
example : f a = g a := congrFun h₂ a
example : f a = g b := congr h₂ h₁

example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  have h1 : (x + y) * (x + y) = (x + y) * x + (x + y) * y :=
    Nat.mul_add (x + y) x y
  have h2 : (x + y) * (x + y) = x * x + y * x + (x * y + y * y) :=
    (Nat.add_mul x y x) ▸ (Nat.add_mul x y y) ▸ h1
  h2.trans (Nat.add_assoc (x * x + y * x) (x * y) (y * y)).symm

variable (a b c d e : Nat)
variable (h1 : a = b)
variable (h2 : b = c + 1)
variable (h3 : c = d)
variable (h4 : e = 1 + d)

theorem T : a = e :=
  by simp [h1, h2, h3, Nat.add_comm, h4]

-- Calculational Proofs --
#check @Nat.succ_le_succ

example (a b c d : Nat) (h1 : a = b) (h2 : b ≤ c) (h3 : c + 1 < d) : a < d :=
  calc
    a = b     := h1
    _ < b + 1 := Nat.lt_succ_self b
    _ ≤ c + 1 := Nat.succ_le_succ h2
    _ < d     := h3

example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  calc
    (x + y) * (x + y) = (x + y) * x + (x + y) * y  := by rw [Nat.mul_add]
        _ = x * x + y * x + (x + y) * y            := by rw [Nat.add_mul]
        _ = x * x + y * x + (x * y + y * y)        := by rw [Nat.add_mul]
        _ = x * x + y * x + x * y + y * y          := by rw [←Nat.add_assoc]

-- ← rewrite in the opposite direction
example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  by rw[Nat.mul_add, Nat.add_mul, Nat.add_mul, ←Nat.add_assoc]

-- The Existential Quantifier --
#check @Nat.zero_lt_succ
#check @Exists.intro

example : ∃ x : Nat, x > 0 :=
  have h : 1 > 0 := Nat.zero_lt_succ 0
  Exists.intro 1 h

example (x : Nat) (h : x > 0) : ∃ y, y < x :=
  Exists.intro 0 h

example (x y z : Nat) (hxy : x < y) (hyz : y < z) : ∃ w, x < w ∧ w < z :=
  Exists.intro y (And.intro hxy hyz)

/- We can use the anonymous constructor notation *⟨t, h⟩* for
Exists.intro t h, when the type is clear from the context. -/

example : ∃ x : Nat, x > 0 :=
  have h : 1 > 0 := Nat.zero_lt_succ 0
  ⟨1, h⟩

example (x : Nat) (h : x > 0) : ∃ y, y < x := ⟨0, h⟩

example (x y z : Nat) (hxy : x < y) (hyz : y < z) : ∃ w, x < w ∧ w < z :=
  ⟨y, hxy, hyz⟩

/- Note that Exists.intro has implicit arguments: Lean has to infer the
predicate p : α → Prop in the conclusion ∃ x, p x. This is not a trivial affair.
For example, if we have have hg : g 0 0 = 0 and write Exists.intro 0 hg,
there are many possible values for the predicate p, corresponding to the
theorems ∃ x, g x x = x, ∃ x, g x x = 0, ∃ x, g x 0 = x, etc.
Lean uses the context to infer which one is appropriate. This is illustrated
in the following example, in which we set the option pp.explicit to true to
ask Lean's pretty-printer to show the implicit arguments.-/

variable (g : Nat → Nat → Nat)
variable (hg : g 0 0 = 0)

theorem gex1 : ∃ x, g x x = x := ⟨0, hg⟩
theorem gex2 : ∃ x, g x 0 = x := ⟨0, hg⟩
theorem gex3 : ∃ x, g 0 0 = x := ⟨0, hg⟩
theorem gex4 : ∃ x, g x x = 0 := ⟨0, hg⟩

set_option pp.explicit true  -- display implicit arguments
#print gex1
#print gex2
#print gex3
#print gex4

/-
We can view Exists.intro as an information-hiding operation, since it hides the
witness to the body of the assertion. The existential elimination rule,
*Exists.elim*, performs the opposite operation. It allows us to prove a
proposition q from ∃ x : α, p x, by showing that q follows from p w for an
arbitrary value w. Roughly speaking, since we know there is an x satisfying p x,
we can give it a name, say, w. If q does not mention w, then showing that q
follows from p w is tantamount to showing the q follows from the existence
of any such x. Here is an example:
-/

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

#check @Exists.elim
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  Exists.elim h
  (
    fun w =>
    fun hw : p w ∧ q w =>
    show ∃ x, q x ∧ p x from Exists.intro w (And.intro hw.right hw.left)
  )

/-
It may be helpful to compare the exists-elimination rule to the or-elimination
rule: the assertion ∃ x : α, p x can be thought of as a big disjunction of the
propositions p a, as a ranges over all the elements of α. Note that the anonymous
constructor notation *⟨w, hw.right, hw.left⟩* abbreviates a nested constructor
application; we could equally well have written *⟨w, ⟨hw.right, hw.left⟩⟩*.
-/

/-
Lean provides a more convenient way to eliminate from an existential quantifier
with the *match expression*:
-/

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

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with
  | ⟨w, hw⟩ => ⟨w, hw.right, hw.left⟩

-- We can annotate the types used in the match for greater clarity:
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with
  | ⟨(w : α), (hw : p w ∧ q w)⟩ => ⟨w, hw.right, hw.left⟩

-- We can even use the match statement to decompose the conjunction at the same time:
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with
  | ⟨w, hwl, hwr⟩ => ⟨w, hwr, hwl⟩

-- Lean also provides a pattern-matching let expression:
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  let ⟨w, hwl, hwr⟩ := h
  ⟨w, hwr, hwl⟩

/- This is essentially just alternative notation for the match construct above.
Lean will even allow us to use an implicit match in the fun expression: -/
example : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
  fun ⟨w, hpw, hqw⟩ => ⟨w, hqw, hpw⟩

/- In the following example, we define even a as ∃ b, a = 2 * b, and then we
show that the sum of two even numbers is an even number. -/

def is_even (a : Nat) := ∃ b, a = 2 * b

theorem even_plus_even (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  Exists.elim h1
  (
    fun w1 =>
    fun hw1 : a = 2 * w1 =>
    Exists.elim h2
    (
      fun w2 =>
      fun hw2 : b = 2 * w2 =>
      Exists.intro (w1 + w2)
      (
        calc
          a + b = 2 * w1 + 2 * w2 := by rw[hw1, hw2]
          _ = 2 * (w1 + w2) := by rw[Nat.mul_add]
      )
    )
  )

/-
Using the various gadgets described in this chapter ---
*the match statement*, *anonymous constructors*, and the *rewrite tactic*,
we can write this proof concisely as follows:
-/

theorem even_plus_even' (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  match h1, h2 with
  | ⟨w1, hw1⟩, ⟨w2, hw2⟩ => ⟨w1 + w2, by rw[hw1, hw2, Nat.mul_add]⟩

/-
Just as the constructive "or" is stronger than the classical "or," so, too, is the
constructive "exists" stronger than the classical "exists". For example, the following
implication requires classical reasoning because, from a constructive standpoint,
knowing that it is not the case that every x satisfies ¬ p is not the same as having
a particular x that satisfies p -/

open Classical
variable (p : α → Prop)

example (h : ¬ ∀ x, ¬ p x) : ∃ x, p x :=
  byContradiction
  (
    fun h1 : ¬ ∃ x, p x =>
    have h2 : ∀ x, ¬ p x :=
      fun x =>
      fun h3 : p x =>
      have h4 : ∃ x, p x :=  ⟨x, h3⟩
      show False from h1 h4
    show False from h h2)

/-
What follows are some common identities involving the existential quantifier.
In the exercises below, we encourage you to prove as many as you can. We also leave it
to you to determine which are nonconstructive, and hence require some form of
classical reasoning.-/

open Classical

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

example : (∃ x : α, r) → r := fun ⟨x, r⟩ => r
example (a : α) : r → (∃ x : α, r) := fun pr : r => ⟨a, pr⟩
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  Iff.intro
  (fun ⟨x, pxr⟩ => ⟨⟨x, And.left pxr⟩, And.right pxr⟩)
  (
    fun h₀ : (∃ x, p x) ∧ r =>
    match And.left h₀ with
    | ⟨x, px⟩ => Exists.intro x (And.intro px (And.right h₀))
  )

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  Iff.intro
  (
    fun ⟨x, hpq⟩ =>
    Or.elim hpq
      (fun hp : p x => Or.inl (Exists.intro x hp))
      (fun hq : q x => Or.inr (Exists.intro x hq))
  )
  (
    fun h₀ : (∃ x, p x) ∨ (∃ x, q x) =>
    Or.elim h₀
      (fun ⟨x, px⟩ => ⟨x, Or.inl px⟩)
      (fun ⟨x, qx⟩ => ⟨x, Or.inr qx⟩)
  )

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  Iff.intro
    (fun ⟨b, (hb : p b → r)⟩ =>
     fun h2 : ∀ x, p x =>
     show r from  hb (h2 b))
    (fun h1 : (∀ x, p x) → r =>
     show ∃ x, p x → r from
       byCases
         (fun hap : ∀ x, p x => ⟨a, λ h' => h1 hap⟩)
         (fun hnap : ¬ ∀ x, p x =>
          byContradiction
            (fun hnex : ¬ ∃ x, p x → r =>
              have hap : ∀ x, p x :=
                fun x =>
                byContradiction
                  (fun hnp : ¬ p x =>
                    have hex : ∃ x, p x → r := ⟨x, (fun hp => absurd hp hnp)⟩
                    show False from hnex hex)
              show False from hnap hap)))

-- theorem dne {p : Prop} (h : ¬¬p) : p :=
--   Or.elim (em p)
--     (fun hp : p => hp)
--     (fun hnp : ¬p => absurd hnp h)

theorem dne {p : Prop} (h : ¬¬p) : p :=
  Or.elim (em p)
    (fun hp : p => hp)
    (fun hnp : ¬p => absurd hnp h)

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  Iff.intro
  (
    fun ⟨x, h₀⟩ =>
    byContradiction
    (
      fun h₁ : ¬ ¬ ∀ x, ¬ p x =>
      have h₂ : ∀ x, ¬ p x := dne h₁
      show False from absurd h₀ (h₂ x)
    )
  )
  (
    fun h₀ : ¬ (∀ x, ¬ p x) =>
    byContradiction
    (
      fun h₁ : ¬ ∃ x, p x =>
      have h₂ : ∀ x, ¬ p x :=
        fun x =>
        fun h₃ : p x =>
        have h₄ : ∃ x, p x := ⟨x, h₃⟩
        show False from h₁ h₄
      show False from h₀ h₂
    )
  )

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := sorry
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := sorry
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := sorry

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := sorry

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := sorry


import tactic
/-!

# About Quotients

There are two ways to define new objets in maths:
 - The first way is tosay what they are
 - The second way is to say what they do

Example 1 the natural numbers ℕ
Definition via "what they are"
  0 = ∅
  1 = {0}
  2 = {0, 1}
  3 = {0, 1, 2}
  [...]

Theorem is that induction works

Def in Lean:
Inductive nat
| zero : nat
| succ :  nat -> nat

0 is a natural
the succesor of a natural is a natural
*done*
to do something for all n ∈ ℕ suffices to:
 * do it for 0
 * if done for n can do for succ n

-/

 #check ℕ
 #print ℕ

 /-!
 ## Product

 if X, Y are sets (or types)
 X ⨯ Y is a set (type)
 (x, y) where x ∈ X, y ∈ Y
 which is not equal to {x, y} because order matters

 So what is this

 FACT
 (x₁, y₁) = (x₂, y₂) ↔ x₁ = x₂ ∧ y₁ = y₂

 ## Quotients

 Lets do Tensor products
 If V and W are vector spaces over ℝ then there exist another vector space V ⊕⨯ W
 ∃ linear map

## Actually Quotients

Set-up: X is a set/type
~ : equivalence relation on X
i.e. if a,b ∈ X a ~ b is a proposition
and it is reflecive symetric and transitive

2500 y ago
Euclid lists axio;s he'll use:
 and says that equality is an equivalence relation

 e.g. colours of shapes is an eq
 e.g. take property that you care from the object and that all of these need to be equal

 f : X → Y, define a relation ~ on X by a ~ b ↔ f(a) = f(b)
 THM: that's an eq relation

Converse:
Say X is a thing and ~ is an equivalence relation on X
Q: Can I get a Y and f : X → Y such that x₁ ~ x₂ ↔ f(x₁) = f(x₂)

A: Yes! [x]~ = Y the set of equivalence classes

ℤ/12ℤ is a set of sets of equivalence relations
= {{-12, 0, 12, ...}, { -11, 1, 11, ...}, ...}

The lie X set ~ equiv relation then the quotient X/~ (called Y earlier) ***is*** the set of equivalence classes.

Another example
X = set of red & yellow & green & blue plastic shapes
~ is "same colour"

What I want : Y & f : X → Y s.t. a ~b ↔ f(a) = f(b)
"UG model"
  Y = {{a red triangle, a red square}, {2 blue triangles, blue pentagone},  ...}

Another model is:
Y = {red, yellox, green, blue}, f = "colour"

  We care about what they do and not what they are

  ### Quotients in Lean
  You can't ask what they are, only ask what they **do**

 -/

-- Let X be a type
variable (X : Type)
#check @quotient X

#check setoid

#check equivalence

-- Let R be an equivalence relation on X
variables (R : X → (X → Prop)) (h : equivalence R)

def s : setoid X := { r := R,
  iseqv := h }

  -- how does Lean make the set Y such that f:X→Y is a surjection
  -- and f(x₁) = f(x₂) ↔ R(x₁,x₂)

  def Y := @quotient X (s X R h)

  #check Y X R h

-- Let's do a concrete example
--- equiavalence relation on the integeres
-- type by \ then | = ∣
def C (a b : ℤ) : Prop := 12 ∣ (a - b)

lemma C_is_equiv : equivalence C :=
begin
  split,
  {sorry},
  {split, {sorry}, {sorry}}
end

--instance t : setoid ℤ := { r := C,
def t : setoid ℤ := { r := C,
  iseqv := C_is_equiv }
attribute [instance] t

def clock := quotient t

  -- we don't know what it is
  -- It is "the quotient of the integers by the equivalence realation C"
    -- Does it do what it is supposed to do????

#check quotient.mk

def f : ℤ → clock := quotient.mk

example (a : ℤ) : f a = ⟦a⟧ :=
begin
  refl,
end

example (a b : ℤ) : C a b ↔ a ≈ b :=
begin
  refl,
end

example : f 1 = f 13 :=
begin
  -- quotient.sound says a ~ b → f a = f b
  --let h := quotient.sound,
  apply quotient.sound,
  change C 1 13,
  change (12 : ℤ) ∣ 1 - 13,
  norm_num,
end

#check quotient.eq

example (a b : ℤ) : ⟦a⟧ = ⟦b⟧ ↔ a ≈ b :=
begin
  exact quotient.eq,
end

-- surjective_quot_mk from the mathlib

-- What does it mean to be "well-defined"
-- For nagation we need
-- a ~ b ⇒ -a ~ -b

/-!
For ℤ/12 → X

Fact to give g : ℤ/12ℤ → X
need two ingredients
1: g⁀ : ℤ → X
2: proof that a ~ b then g⁀(a) = g⁀(b)
-/

example (Z : Type) (gtilde : ℤ → Z)
  (h : ∀ a b : ℤ, a ≈ b → gtilde a = gtilde b)
  : clock → Z :=
  quotient.lift gtilde h


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.fin.vec_notation

/-!
# Monotone finite sequences

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

In this file we prove `simp` lemmas that allow to simplify propositions like `monotone ![a, b, c]`.
-/

open set fin matrix function
variables {α : Type*}

lemma lift_fun_vec_cons {n : ℕ} (r : α → α → Prop) [is_trans α r] {f : fin (n + 1) → α} {a : α} :
  ((<) ⇒ r) (vec_cons a f) (vec_cons a f) ↔ r a (f 0) ∧ ((<) ⇒ r) f f :=
by simp only [lift_fun_iff_succ r, forall_fin_succ, cons_val_succ, cons_val_zero, ← succ_cast_succ,
  cast_succ_zero]

variables [preorder α] {n : ℕ} {f : fin (n + 1) → α} {a : α}

@[simp] lemma strict_mono_vec_cons : strict_mono (vec_cons a f) ↔ a < f 0 ∧ strict_mono f :=
lift_fun_vec_cons (<)

@[simp] lemma monotone_vec_cons : monotone (vec_cons a f) ↔ a ≤ f 0 ∧ monotone f :=
by simpa only [monotone_iff_forall_lt] using @lift_fun_vec_cons α n (≤) _ f a

@[simp] lemma strict_anti_vec_cons : strict_anti (vec_cons a f) ↔ f 0 < a ∧ strict_anti f :=
lift_fun_vec_cons (>)

@[simp] lemma antitone_vec_cons : antitone (vec_cons a f) ↔ f 0 ≤ a ∧ antitone f :=
@monotone_vec_cons αᵒᵈ _ _ _ _

lemma strict_mono.vec_cons (hf : strict_mono f) (ha : a < f 0) :
  strict_mono (vec_cons a f) :=
strict_mono_vec_cons.2 ⟨ha, hf⟩

lemma strict_anti.vec_cons (hf : strict_anti f) (ha : f 0 < a) :
  strict_anti (vec_cons a f) :=
strict_anti_vec_cons.2 ⟨ha, hf⟩

lemma monotone.vec_cons (hf : monotone f) (ha : a ≤ f 0) :
  monotone (vec_cons a f) :=
monotone_vec_cons.2 ⟨ha, hf⟩

lemma antitone.vec_cons (hf : antitone f) (ha : f 0 ≤ a) :
  antitone (vec_cons a f) :=
antitone_vec_cons.2 ⟨ha, hf⟩

example : monotone ![1, 2, 2, 3] := by simp [subsingleton.monotone]


/-
Copyright (c) 2021 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca
-/

import ring_theory.trace
import ring_theory.norm
import number_theory.number_field

/-!
# Discriminant of a family of vectors

Given an `A`-algebra `B` and `b`, an `ι`-indexed family of elements of `B`, we define the
*discriminant* of `b` as the determinant of the matrix whose `(i j)`-th element is the trace of
`b i * b j`.

## Main definition

* `algebra.discr A b` : the discriminant of `b : ι → B`.

## Main results

* `algebra.discr_zero_of_not_linear_independent` : if `b` is not linear independent, then
  `algebra.discr A b = 0`.
* `algebra.discr_of_matrix_vec_mul` and `discr_of_matrix_mul_vec` : formulas relating
  `algebra.discr A ι b` with `algebra.discr A ((P.map (algebra_map A B)).vec_mul b)` and
  `algebra.discr A ((P.map (algebra_map A B)).mul_vec b)`.
* `algebra.discr_not_zero_of_basis` : over a field, if `b` is a basis, then
  `algebra.discr K b ≠ 0`.
* `algebra.discr_eq_det_embeddings_matrix_reindex_pow_two` : if `L/K` is a field extension and
  `b : ι → L`, then `discr K b` is the square of the determinant of the matrix whose `(i, j)`
  coefficient is `σⱼ (b i)`, where `σⱼ : L →ₐ[K] E` is the embedding in an algebraically closed
  field `E` corresponding to `j : ι` via a bijection `e : ι ≃ (L →ₐ[K] E)`.
* `algebra.discr_of_power_basis_eq_prod` : the discriminant of a power basis.
* `discr_is_integral` : if `K` and `L` are fields and `is_scalar_tower R K L`, is `b : ι → L`
  satisfies ` ∀ i, is_integral R (b i)`, then `is_integral R (discr K b)`.
* `discr_mul_is_integral_mem_adjoin` : let `K` be the fraction field of an integrally closed domain
  `R` and let `L` be a finite separable extension of `K`. Let `B : power_basis K L` be such that
  `is_integral R B.gen`. Then for all, `z : L` we have
  `(discr K B.basis) • z ∈ adjoin R ({B.gen} : set L)`.

## Implementation details

Our definition works for any `A`-algebra `B`, but note that if `B` is not free as an `A`-module,
then `trace A B = 0` by definition, so `discr A b = 0` for any `b`.
-/

universes u v w z

open_locale matrix big_operators

open matrix finite_dimensional fintype polynomial finset intermediate_field

namespace algebra

variables (A : Type u) {B : Type v} (C : Type z) {ι : Type w}
variables [comm_ring A] [comm_ring B] [algebra A B] [comm_ring C] [algebra A C]

section discr

/-- Given an `A`-algebra `B` and `b`, an `ι`-indexed family of elements of `B`, we define
`discr A ι b` as the determinant of `trace_matrix A ι b`. -/
noncomputable
def discr (A : Type u) {B : Type v} [comm_ring A] [comm_ring B] [algebra A B] [fintype ι]
  (b : ι → B) := by { classical, exact (trace_matrix A b).det }

lemma discr_def [decidable_eq ι] [fintype ι] (b : ι → B) :
  discr A b = (trace_matrix A b).det := by convert rfl

variables {ι' : Type*} [fintype ι'] [fintype ι]

section basic

@[simp] lemma discr_reindex (b : basis ι A B) (f : ι ≃ ι') :
  discr A (b ∘ ⇑(f.symm)) = discr A b :=
begin
  classical,
  rw [← basis.coe_reindex, discr_def, trace_matrix_reindex, det_reindex_self, ← discr_def]
end

/-- If `b` is not linear independent, then `algebra.discr A b = 0`. -/
lemma discr_zero_of_not_linear_independent [is_domain A] {b : ι → B}
  (hli : ¬linear_independent A b) : discr A b = 0 :=
begin
  classical,
  obtain ⟨g, hg, i, hi⟩ := fintype.not_linear_independent_iff.1 hli,
  have : (trace_matrix A b).mul_vec g = 0,
  { ext i,
    have : ∀ j, (trace A B) (b i * b j) * g j = (trace A B) (((g j) • (b j)) * b i),
    { intro j, simp [mul_comm], },
    simp only [mul_vec, dot_product, trace_matrix, pi.zero_apply, trace_form_apply,
      λ j, this j, ← linear_map.map_sum, ← sum_mul, hg, zero_mul, linear_map.map_zero] },
  by_contra h,
  rw discr_def at h,
  simpa [matrix.eq_zero_of_mul_vec_eq_zero h this] using hi,
end

variable {A}

/-- Relation between `algebra.discr A ι b` and
`algebra.discr A ((P.map (algebra_map A B)).vec_mul b)`. -/
lemma discr_of_matrix_vec_mul [decidable_eq ι] (b : ι → B) (P : matrix ι ι A) :
  discr A ((P.map (algebra_map A B)).vec_mul b) = P.det ^ 2 * discr A b :=
by rw [discr_def, trace_matrix_of_matrix_vec_mul, det_mul, det_mul, det_transpose, mul_comm,
    ← mul_assoc, discr_def, pow_two]

/-- Relation between `algebra.discr A ι b` and
`algebra.discr A ((P.map (algebra_map A B)).mul_vec b)`. -/
lemma discr_of_matrix_mul_vec [decidable_eq ι] (b : ι → B) (P : matrix ι ι A) :
  discr A ((P.map (algebra_map A B)).mul_vec b) = P.det ^ 2 * discr A b :=
by rw [discr_def, trace_matrix_of_matrix_mul_vec, det_mul, det_mul, det_transpose,
  mul_comm, ← mul_assoc, discr_def, pow_two]

end basic

section field

variables (K : Type u) {L : Type v} (E : Type z) [field K] [field L] [field E]
variables [algebra K L] [algebra K E]
variables [module.finite K L]  [is_alg_closed E]

/-- Over a field, if `b` is a basis, then `algebra.discr K b ≠ 0`. -/
lemma discr_not_zero_of_basis [is_separable K L] (b : basis ι K L) : discr K b ≠ 0 :=
begin
  by_cases h : nonempty ι,
  { classical,
    have := span_eq_top_of_linear_independent_of_card_eq_finrank b.linear_independent
      (finrank_eq_card_basis b).symm,
    rw [discr_def, trace_matrix_def],
    simp_rw [← basis.mk_apply b.linear_independent this],
    rw [← trace_matrix_def, trace_matrix_of_basis, ← bilin_form.nondegenerate_iff_det_ne_zero],
    exact trace_form_nondegenerate _ _  },
  letI := not_nonempty_iff.1 h,
  simp [discr],
end

/-- Over a field, if `b` is a basis, then `algebra.discr K b` is a unit. -/
lemma discr_is_unit_of_basis [is_separable K L] (b : basis ι K L) : is_unit (discr K b) :=
is_unit.mk0 _ (discr_not_zero_of_basis _ _)

variables (b : ι → L) (pb : power_basis K L)

/-- If `L/K` is a field extension and `b : ι → L`, then `discr K b` is the square of the
determinant of the matrix whose `(i, j)` coefficient is `σⱼ (b i)`, where `σⱼ : L →ₐ[K] E` is the
embedding in an algebraically closed field `E` corresponding to `j : ι` via a bijection
`e : ι ≃ (L →ₐ[K] E)`. -/
lemma discr_eq_det_embeddings_matrix_reindex_pow_two [decidable_eq ι] [is_separable K L]
  (e : ι ≃ (L →ₐ[K] E)) : algebra_map K E (discr K b) =
  (embeddings_matrix_reindex K E b e).det ^ 2 :=
by rw [discr_def, ring_hom.map_det, ring_hom.map_matrix_apply,
    trace_matrix_eq_embeddings_matrix_reindex_mul_trans, det_mul, det_transpose, pow_two]

/-- The discriminant of a power basis. -/
lemma discr_power_basis_eq_prod (e : fin pb.dim ≃ (L →ₐ[K] E)) [is_separable K L] :
  algebra_map K E (discr K pb.basis) =
  ∏ i : fin pb.dim, ∏ j in finset.univ.filter (λ j, i < j), (e j pb.gen- (e i pb.gen)) ^ 2 :=
begin
  rw [discr_eq_det_embeddings_matrix_reindex_pow_two K E pb.basis e,
    embeddings_matrix_reindex_eq_vandermonde, det_transpose, det_vandermonde, ← prod_pow],
  congr, ext i,
  rw [← prod_pow]
end

/-- A variation of `of_power_basis_eq_prod`. -/
lemma discr_power_basis_eq_prod' [is_separable K L] (e : fin pb.dim ≃ (L →ₐ[K] E)) :
  algebra_map K E (discr K pb.basis) =
  ∏ i : fin pb.dim, ∏ j in finset.univ.filter (λ j, i < j),
  -((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))) :=
begin
  rw [discr_power_basis_eq_prod _ _ _ e],
  congr, ext i, congr, ext j,
  ring
end

local notation `n` := finrank K L

/-- A variation of `of_power_basis_eq_prod`. -/
lemma discr_power_basis_eq_prod'' [is_separable K L] (e : fin pb.dim ≃ (L →ₐ[K] E)) :
  algebra_map K E (discr K pb.basis) =
  (-1) ^ (n * (n - 1) / 2) * ∏ i : fin pb.dim, ∏ j in finset.univ.filter (λ j, i < j),
  ((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))) :=
begin
  rw [discr_power_basis_eq_prod' _ _ _ e],
  simp_rw [λ i j, neg_eq_neg_one_mul ((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))),
    prod_mul_distrib],
  congr,
  simp only [prod_pow_eq_pow_sum, prod_const],
  congr,
  simp_rw [fin.card_filter_lt],
  apply (@nat.cast_inj ℚ _ _ _ _ _).1,
  rw [nat.cast_sum],
  have : ∀ (x : fin pb.dim), (↑x + 1) ≤ pb.dim := by simp [nat.succ_le_iff, fin.is_lt],
  simp_rw [nat.sub_sub],
  simp only [nat.cast_sub, this, finset.card_fin, nsmul_eq_mul, sum_const, sum_sub_distrib,
    nat.cast_add, nat.cast_one, sum_add_distrib, mul_one],
  rw [← nat.cast_sum, ← @finset.sum_range ℕ _ pb.dim (λ i, i), sum_range_id ],
  have hn : n = pb.dim,
  { rw [← alg_hom.card K L E, ← fintype.card_fin pb.dim],
    exact card_congr (equiv.symm e) },
  have h₂ : 2 ∣ (pb.dim * (pb.dim - 1)) := even_iff_two_dvd.1 (nat.even_mul_self_pred _),
  have hne : ((2 : ℕ) : ℚ) ≠ 0 := by simp,
  have hle : 1 ≤ pb.dim,
  { rw [← hn, nat.one_le_iff_ne_zero, ← zero_lt_iff, finite_dimensional.finrank_pos_iff],
    apply_instance },
  rw [hn, nat.cast_dvd h₂ hne, nat.cast_mul, nat.cast_sub hle],
  field_simp,
  ring,
end

/-- Formula for the discriminant of a power basis using the norm of the field extension. -/
lemma discr_power_basis_eq_norm [is_separable K L] : discr K pb.basis =
  (-1) ^ (n * (n - 1) / 2) * (norm K (aeval pb.gen (minpoly K pb.gen).derivative)) :=
begin
  let E := algebraic_closure L,
  letI := λ (a b : E), classical.prop_decidable (eq a b),

  have e : fin pb.dim ≃ (L →ₐ[K] E),
  { refine equiv_of_card_eq _,
    rw [fintype.card_fin, alg_hom.card],
    exact (power_basis.finrank pb).symm },
  have hnodup : (map (algebra_map K E) (minpoly K pb.gen)).roots.nodup :=
    nodup_roots (separable.map (is_separable.separable K pb.gen)),
  have hroots : ∀ σ : L →ₐ[K] E, σ pb.gen ∈ (map (algebra_map K E) (minpoly K pb.gen)).roots,
  { intro σ,
    rw [mem_roots, is_root.def, eval_map, ← aeval_def, aeval_alg_hom_apply],
    repeat { simp [minpoly.ne_zero (is_separable.is_integral K pb.gen)] } },

  apply (algebra_map K E).injective,
  rw [ring_hom.map_mul, ring_hom.map_pow, ring_hom.map_neg, ring_hom.map_one,
    discr_power_basis_eq_prod'' _ _ _ e],
  congr,
  rw [norm_eq_prod_embeddings, fin.prod_filter_lt_mul_neg_eq_prod_off_diag],
  conv_rhs { congr, skip, funext,
    rw [← aeval_alg_hom_apply, aeval_root_derivative_of_splits (minpoly.monic
      (is_separable.is_integral K pb.gen)) (is_alg_closed.splits_codomain _) (hroots σ),
      ← finset.prod_mk _ (hnodup.erase _)] },
  rw [prod_sigma', prod_sigma'],
  refine prod_bij (λ i hi, ⟨e i.2, e i.1 pb.gen⟩) (λ i hi, _) (λ i hi, by simp at hi)
    (λ i j hi hj hij, _) (λ σ hσ, _),
  { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma],
    rw [multiset.mem_erase_of_ne (λ h, _)],
    { exact hroots _ },
    { simp only [true_and, mem_filter, mem_univ, ne.def, mem_sigma] at hi,
      refine hi (equiv.injective e (equiv.injective (power_basis.lift_equiv pb) _)),
      rw [← power_basis.lift_equiv_apply_coe, ← power_basis.lift_equiv_apply_coe] at h,
      exact subtype.eq h } },
  { simp only [equiv.apply_eq_iff_eq, heq_iff_eq] at hij,
    have h := hij.2,
    rw [← power_basis.lift_equiv_apply_coe, ← power_basis.lift_equiv_apply_coe] at h,
    refine sigma.eq (equiv.injective e (equiv.injective _ (subtype.eq h))) (by simp [hij.1]) },
  { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma] at hσ,
    simp only [sigma.exists, true_and, exists_prop, mem_filter, mem_univ, ne.def, mem_sigma],
    refine ⟨e.symm (power_basis.lift pb σ.2 _), e.symm σ.1, ⟨λ h, _, sigma.eq _ _⟩⟩,
    { rw [aeval_def, eval₂_eq_eval_map, ← is_root.def, ← mem_roots],
      { exact multiset.erase_subset _ _ hσ },
      { simp [minpoly.ne_zero (is_separable.is_integral K pb.gen)] } },
    { replace h := alg_hom.congr_fun (equiv.injective _ h) pb.gen,
      rw [power_basis.lift_gen] at h,
      rw [← h] at hσ,
      exact hnodup.not_mem_erase hσ },
    all_goals { simp } }
end

section integral

variables {R : Type z} [comm_ring R] [algebra R K] [algebra R L] [is_scalar_tower R K L]

local notation `is_integral` := _root_.is_integral

/-- If `K` and `L` are fields and `is_scalar_tower R K L`, and `b : ι → L` satisfies
` ∀ i, is_integral R (b i)`, then `is_integral R (discr K b)`. -/
lemma discr_is_integral {b : ι → L} (h : ∀ i, is_integral R (b i)) :
  is_integral R (discr K b) :=
begin
  classical,
  rw [discr_def],
  exact is_integral.det (λ i j, is_integral_trace (is_integral_mul (h i) (h j)))
end

/-- If `b` and `b'` are `ℚ`-bases of a number field `K` such that
`∀ i j, is_integral ℤ (b.to_matrix b' i j)` and `∀ i j, is_integral ℤ (b'.to_matrix b i j)` then
`discr ℚ b = discr ℚ b'`. -/
lemma discr_eq_discr_of_to_matrix_coeff_is_integral [number_field K] {b : basis ι ℚ K}
  {b' : basis ι' ℚ K} (h : ∀ i j, is_integral ℤ (b.to_matrix b' i j))
  (h' : ∀ i j, is_integral ℤ (b'.to_matrix b i j)) :
  discr ℚ b = discr ℚ b' :=
begin
  replace h' : ∀ i j, is_integral ℤ (b'.to_matrix ((b.reindex (b.index_equiv b'))) i j),
  { intros i j,
    convert h' i ((b.index_equiv b').symm j),
    simpa },
  classical,
  rw [← (b.reindex (b.index_equiv b')).to_matrix_map_vec_mul b', discr_of_matrix_vec_mul,
    ← one_mul (discr ℚ b), basis.coe_reindex, discr_reindex],
  congr,
  have hint : is_integral ℤ (((b.reindex (b.index_equiv b')).to_matrix b').det) :=
    is_integral.det (λ i j, h _ _),
  obtain ⟨r, hr⟩ := is_integrally_closed.is_integral_iff.1 hint,
  have hunit : is_unit r,
  { have : is_integral ℤ ((b'.to_matrix (b.reindex (b.index_equiv b'))).det) :=
      is_integral.det (λ i j, h' _ _),
    obtain ⟨r', hr'⟩ := is_integrally_closed.is_integral_iff.1 this,
    refine is_unit_iff_exists_inv.2 ⟨r', _⟩,
    suffices : algebra_map ℤ ℚ (r * r') = 1,
    { rw [← ring_hom.map_one (algebra_map ℤ ℚ)] at this,
      exact (is_fraction_ring.injective ℤ ℚ) this },
    rw [ring_hom.map_mul, hr, hr', ← det_mul, basis.to_matrix_mul_to_matrix_flip, det_one] },
  rw [← ring_hom.map_one (algebra_map ℤ ℚ), ← hr],
  cases int.is_unit_iff.1 hunit with hp hm,
  { simp [hp] },
  { simp [hm] }
end

/-- Let `K` be the fraction field of an integrally closed domain `R` and let `L` be a finite
separable extension of `K`. Let `B : power_basis K L` be such that `is_integral R B.gen`.
Then for all, `z : L` that are integral over `R`, we have
`(discr K B.basis) • z ∈ adjoin R ({B.gen} : set L)`. -/
lemma discr_mul_is_integral_mem_adjoin [is_domain R] [is_separable K L] [is_integrally_closed R]
  [is_fraction_ring R K] {B : power_basis K L} (hint : is_integral R B.gen) {z : L}
  (hz : is_integral R z) : (discr K B.basis) • z ∈ adjoin R ({B.gen} : set L) :=
begin
  have hinv : is_unit (trace_matrix K B.basis).det :=
    by simpa [← discr_def] using discr_is_unit_of_basis _ B.basis,

  have H : (trace_matrix K B.basis).det • (trace_matrix K B.basis).mul_vec (B.basis.equiv_fun z) =
    (trace_matrix K B.basis).det • (λ i, trace K L (z * B.basis i)),
  { congr, exact trace_matrix_of_basis_mul_vec _ _ },
  have cramer := mul_vec_cramer (trace_matrix K B.basis) (λ i, trace K L (z * B.basis i)),

  suffices : ∀ i, ((trace_matrix K B.basis).det • (B.basis.equiv_fun z)) i ∈ (⊥ : subalgebra R K),
  { rw [← B.basis.sum_repr z, finset.smul_sum],
    refine subalgebra.sum_mem _ (λ i hi, _),
    replace this := this i,
    rw [← discr_def, pi.smul_apply, mem_bot] at this,
    obtain ⟨r, hr⟩ := this,
    rw [basis.equiv_fun_apply] at hr,
    rw [← smul_assoc, ← hr, algebra_map_smul],
    refine subalgebra.smul_mem _ _ _,
    rw [B.basis_eq_pow i],
    refine subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton _)) _},
  intro i,
  rw [← H, ← mul_vec_smul] at cramer,
  replace cramer := congr_arg (mul_vec (trace_matrix K B.basis)⁻¹) cramer,
  rw [mul_vec_mul_vec, nonsing_inv_mul _ hinv, mul_vec_mul_vec, nonsing_inv_mul _ hinv,
    one_mul_vec, one_mul_vec] at cramer,
  rw [← congr_fun cramer i, cramer_apply, det_apply],
  refine subalgebra.sum_mem _ (λ σ _, subalgebra.zsmul_mem _ (subalgebra.prod_mem _ (λ j _, _)) _),
  by_cases hji : j = i,
  { simp only [update_column_apply, hji, eq_self_iff_true, power_basis.coe_basis],
    exact mem_bot.2 (is_integrally_closed.is_integral_iff.1 $ is_integral_trace $
      is_integral_mul hz $ is_integral.pow hint _) },
  { simp only [update_column_apply, hji, power_basis.coe_basis],
    exact mem_bot.2 (is_integrally_closed.is_integral_iff.1 $ is_integral_trace
      $ is_integral_mul (is_integral.pow hint _) (is_integral.pow hint _)) }
end

end integral

end field

end discr

end algebra


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Johannes Hölzl
-/
import dynamics.fixed_points.basic
import topology.separation

/-!
# Topological properties of fixed points

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

Currently this file contains two lemmas:

- `is_fixed_pt_of_tendsto_iterate`: if `f^n(x) → y` and `f` is continuous at `y`, then `f y = y`;
- `is_closed_fixed_points`: the set of fixed points of a continuous map is a closed set.

## TODO

fixed points, iterates
-/

variables {α : Type*} [topological_space α] [t2_space α] {f : α → α}

open function filter
open_locale topology

/-- If the iterates `f^[n] x` converge to `y` and `f` is continuous at `y`,
then `y` is a fixed point for `f`. -/
lemma is_fixed_pt_of_tendsto_iterate {x y : α} (hy : tendsto (λ n, f^[n] x) at_top (𝓝 y))
  (hf : continuous_at f y) :
  is_fixed_pt f y :=
begin
  refine tendsto_nhds_unique ((tendsto_add_at_top_iff_nat 1).1 _) hy,
  simp only [iterate_succ' f],
  exact hf.tendsto.comp hy
end

/-- The set of fixed points of a continuous map is a closed set. -/
lemma is_closed_fixed_points (hf : continuous f) : is_closed (fixed_points f) :=
is_closed_eq hf continuous_id


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang, Yury G. Kudryashov
-/
import topology.constructions

/-!
# Inseparable points

In this file we require two relations on a topological space: `specializes` (notation : `x ⤳ y`) and
`inseparable`, then prove some basic lemmas about these relations.

## Main definitions

* `specializes` : `specializes x y` (`x ⤳ y`) means that `x` specializes to `y`, i.e.
  `y` is in the closure of `x`.

* `specialization_preorder` : specialization gives a preorder on a topological space. In case of a
  T₀ space, this preorder is a partial order, see `specialization_order`.

* `inseparable x y` means that two points can't be separated by an open set.
-/

open_locale topological_space
open set

variables {X Y : Type*} [topological_space X] [topological_space Y] {x y z : X}

/-- `x` specializes to `y` if `y` is in the closure of `x`. The notation used is `x ⤳ y`. -/
def specializes (x y : X) : Prop := y ∈ closure ({x} : set X)

infix ` ⤳ `:300 := specializes

lemma specializes_def (x y : X) : x ⤳ y ↔ y ∈ closure ({x} : set X) := iff.rfl

lemma specializes_iff_closure_subset : x ⤳ y ↔ closure ({y} : set X) ⊆ closure ({x} : set X) :=
is_closed_closure.mem_iff_closure_subset

lemma specializes_rfl : x ⤳ x := subset_closure (mem_singleton x)

lemma specializes_refl (x : X) : x ⤳ x := specializes_rfl

lemma specializes.trans : x ⤳ y → y ⤳ z → x ⤳ z :=
by { simp_rw specializes_iff_closure_subset, exact λ a b, b.trans a }

lemma specializes_iff_forall_closed :
  x ⤳ y ↔ ∀ (Z : set X) (h : is_closed Z), x ∈ Z → y ∈ Z :=
begin
  split,
  { intros h Z hZ,
    rw [hZ.mem_iff_closure_subset, hZ.mem_iff_closure_subset],
    exact (specializes_iff_closure_subset.mp h).trans },
  { intro h, exact h _ is_closed_closure (subset_closure $ set.mem_singleton x) }
end

lemma specializes_iff_forall_open :
  x ⤳ y ↔ ∀ (U : set X) (h : is_open U), y ∈ U → x ∈ U :=
begin
  rw specializes_iff_forall_closed,
  exact ⟨λ h U hU, not_imp_not.mp (h _ (is_closed_compl_iff.mpr hU)),
    λ h U hU, not_imp_not.mp (h _ (is_open_compl_iff.mpr hU))⟩,
end

lemma specializes.map (h : x ⤳ y) {f : X → Y} (hf : continuous f) : f x ⤳ f y :=
begin
  rw [specializes_def, ← set.image_singleton],
  exact image_closure_subset_closure_image hf ⟨_, h, rfl⟩,
end

section specialize_order

variable (X)

/-- Specialization forms a preorder on the topological space. -/
def specialization_preorder : preorder X :=
{ le := λ x y, y ⤳ x,
  le_refl := λ x, specializes_refl x,
  le_trans := λ _ _ _ h₁ h₂, specializes.trans h₂ h₁ }

local attribute [instance] specialization_preorder

variable {X}

lemma specialization_order.monotone_of_continuous (f : X → Y) (hf : continuous f) : monotone f :=
λ x y h, specializes.map h hf

end specialize_order

/-- Two points are topologically inseparable if no open set separates them. -/
def inseparable (x y : X) : Prop := ∀ (U : set X) (hU : is_open U), x ∈ U ↔ y ∈ U

lemma inseparable_iff_nhds_eq : inseparable x y ↔ 𝓝 x = 𝓝 y :=
⟨λ h, by simp only [nhds_def', h _] { contextual := tt },
  λ h U hU, by simp only [← hU.mem_nhds_iff, h]⟩

alias inseparable_iff_nhds_eq ↔ inseparable.nhds_eq _

lemma inseparable.map {f : X → Y} (h : inseparable x y) (hf : continuous f) :
  inseparable (f x) (f y) :=
λ U hU, h (f ⁻¹' U) (hU.preimage hf)

lemma inseparable_iff_closed :
  inseparable x y ↔ ∀ (U : set X) (hU : is_closed U), x ∈ U ↔ y ∈ U :=
⟨λ h U hU, not_iff_not.mp (h _ hU.1), λ h U hU, not_iff_not.mp (h _ (is_closed_compl_iff.mpr hU))⟩

lemma inseparable_iff_closure (x y : X) :
  inseparable x y ↔ x ∈ closure ({y} : set X) ∧ y ∈ closure ({x} : set X) :=
begin
  rw inseparable_iff_closed,
  exact ⟨λ h, ⟨(h _ is_closed_closure).mpr (subset_closure $ set.mem_singleton y),
      (h _ is_closed_closure).mp (subset_closure $ set.mem_singleton x)⟩,
    λ h U hU, ⟨λ hx, (is_closed.closure_subset_iff hU).mpr (set.singleton_subset_iff.mpr hx) h.2,
      λ hy, (is_closed.closure_subset_iff hU).mpr (set.singleton_subset_iff.mpr hy) h.1⟩⟩
end

lemma inseparable_iff_specializes_and (x y : X) :
  inseparable x y ↔ x ⤳ y ∧ y ⤳ x :=
(inseparable_iff_closure x y).trans (and_comm _ _)

lemma subtype_inseparable_iff {U : set X} (x y : U) :
  inseparable x y ↔ inseparable (x : X) y :=
by { simp_rw [inseparable_iff_closure, closure_subtype, image_singleton] }


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import measure_theory.integration
import topology.metric_space.basic
import topology.instances.real
import topology.instances.ennreal
import topology.instances.nnreal
import topology.algebra.infinite_sum
import portmanteau_definitions

noncomputable theory
open set
open filter
open order
open_locale topological_space ennreal big_operators

namespace portmanteau

section portmanteau_comeonlean_lemmas

lemma bdd_ennval_of_le_cst' {α : Type*} {f : α → ennreal} {c : nnreal} (h : f ≤ (λ a , c)) :
  bdd_ennval f := by { use c , exact h , }

lemma bdd_ennval_of_le_cst {α : Type*} {f : α → ennreal} {c : ennreal} (h : f ≤ (λ a , c)) (hc : c ≠ ⊤) :
  bdd_ennval f :=
begin
  use c.to_nnreal ,
  intros a ,
  have key := h a ,
  rwa ← ennreal.coe_to_nnreal hc at key ,
end

lemma ennreal_eq_top_of_forall_nnreal_ge (z : ennreal) : (∀ (x : nnreal) , ennreal.of_real x ≤ z) → z = ⊤ :=
begin
  contrapose ,
  intros hz ,
  push_neg ,
  have key := ennreal.lt_iff_exists_nnreal_btwn.mp (lt_top_iff_ne_top.mpr hz) ,
  cases key with x hx ,
  use x ,
  simp only [hx.1, ennreal.of_real_coe_nnreal] ,
end

lemma ennreal_eq_top_of_forall_real_ge (z : ennreal) : (∀ (x : ℝ) , ennreal.of_real x ≤ z) → z = ⊤ :=
begin
  intros h ,
  apply ennreal_eq_top_of_forall_nnreal_ge ,
  intros x' ,
  exact h x' ,
end

lemma ennreal_eq_top_of_forall_nat_ge (z : ennreal) : (∀ (n : ℕ) , coe n ≤ z) → z = ⊤ :=
begin
  intro h,
  suffices : (∀ (x : nnreal) , ennreal.of_real x ≤ z) ,
  { exact ennreal_eq_top_of_forall_nnreal_ge z this , } ,
  intros x ,
  have ex : ∃ (n : ℕ) , x ≤ n := exists_nat_ge x ,
  cases ex with n hn ,
  apply le_trans (ennreal.of_real_le_of_real hn) ,
  simp only [h n, nnreal.coe_nat_cast, ennreal.of_real_coe_nat] ,
end

lemma sum_infinitely_many_ones_ennreal : ∑' (i : ℕ), (1:ennreal) = ⊤ :=
begin
  apply ennreal_eq_top_of_forall_nat_ge ,
  intros n ,
  have ones_summable : summable (λ (n : ℕ) , (1:ennreal)) := ennreal.summable ,
  have key := sum_le_tsum (finset.range n) (by tidy) ones_summable ,
  have eq : ∑ i in (finset.range n) , (1 : ennreal) = n ,
  { simp only [finset.sum_const, finset.card_range, nat.smul_one_eq_coe] , } ,
  rwa eq at key ,
end

lemma sum_infinitely_many_pos_const_ennreal' (a : nnreal) (a_pos : 0 < a) : ∑' (i : ℕ), (a:ennreal) = ⊤ :=
begin
  apply ennreal_eq_top_of_forall_nnreal_ge ,
  intros b ,
  have ex' : ∃ (n : ℕ) , b/a ≤ n := exists_nat_ge _ ,
  have ex : ∃ (n : ℕ) , b ≤ n * a ,
  { cases ex' with m hm ,
    use m ,
    have key := mul_le_mul_right' hm a ,
    have cancancel : b / a * a = b , -- Hide in a corner.
    { rw [div_mul_eq_mul_div a b a , mul_comm , mul_div_right_comm a b a , div_self (ne_of_gt a_pos)] ,
      exact one_mul _ , } ,
    rwa cancancel at key , } ,
  cases ex with n hn ,
  have hn' := ennreal.coe_mono hn ,
  have eq₀ : ((a * n : nnreal) : ennreal) = (a : ennreal)*( n: ennreal) := by simp only [ennreal.coe_nat, ennreal.coe_mul],
  nth_rewrite 1 mul_comm at eq₀ ,
  have eq : ∑ i in (finset.range n) , (a : ennreal) = n * a ,
  { simp only [finset.sum_const, nsmul_eq_mul, finset.card_range] , } ,
  rw ← eq at eq₀ ,
  rw mul_comm at eq₀ , -- Hide in another corner.
  rw eq₀ at hn' ,
  have const_summable : summable (λ (n : ℕ) , (a:ennreal)) := ennreal.summable ,
  have key := sum_le_tsum (finset.range n) (by tidy) const_summable ,
  have eq₁ : ennreal.of_real b = (b:ennreal) := ennreal.of_real_coe_nnreal ,
  rw eq₁ ,
  exact le_trans hn' key ,
end

lemma sum_infinitely_many_pos_const_ennreal (a : ennreal) (a_pos : 0 < a) : ∑' (i : ℕ), (a:ennreal) = ⊤ :=
begin
  by_cases a_top : a = ⊤ ,
  { rw a_top ,
    exact ennreal.tsum_top , } ,
  { have eq : ( a.to_nnreal : ennreal) = a := ennreal.coe_to_nnreal a_top ,
    have a_pos' : 0 < a.to_nnreal := with_top.coe_lt_iff.mp a_pos (ennreal.to_nnreal a) (eq.symm) ,
    have key := sum_infinitely_many_pos_const_ennreal' a.to_nnreal a_pos' ,
    rwa eq at key , } ,
end

lemma add_le_add_ennreal {a₁ b₁ a₂ b₂ : ennreal} (ha : a₁ ≤ a₂) (hb : b₁ ≤ b₂) :
  a₁ + b₁ ≤ a₂ + b₂ := add_le_add ha hb

lemma le_self_add_ennreal (a b : ennreal) : a ≤ a + b :=
begin
  suffices : a + 0 ≤ a + b ,
  { simpa [this] , } ,
  apply add_le_add_ennreal _ _ ,
  { have a_eq_a : a = a := by refl ,
    exact le_of_eq a_eq_a , } ,
  simp only [zero_le, ennreal.bot_eq_zero] ,
end

lemma self_sub_le_self_sub_ennreal (a b₁ b₂ : ennreal) (hb : b₂ ≤ b₁) : a - b₁ ≤ a - b₂ :=
begin
  have a_eq_a : a = a := by refl ,
  apply ennreal.sub_le_sub (le_of_eq a_eq_a) hb ,
end

lemma le_of_self_sub_le_self_sub_ennreal (a b₁ b₂ : ennreal) (a_ne_top : a ≠ ⊤) (hb₁ : b₁ ≤ a) (hb₂ : b₂ ≤ a)
  (hb : a - b₁ ≤ a - b₂) : b₂ ≤ b₁ :=
begin
  have eq₁ : a - (a-b₁) = b₁ := ennreal.sub_sub_cancel (lt_top_iff_ne_top.mpr a_ne_top) hb₁ ,
  have eq₂ : a - (a-b₂) = b₂ := ennreal.sub_sub_cancel (lt_top_iff_ne_top.mpr a_ne_top) hb₂ ,
  rw [← eq₁ , ← eq₂] ,
  apply self_sub_le_self_sub_ennreal a (a-b₂) (a-b₁) hb ,
end

lemma sub_larger_ennreal (a b : ennreal) (hab : a ≤ b) : a - b = 0 :=
begin
  exact ennreal.sub_eq_zero_iff_le.mpr hab ,
end

lemma fin_pos_nnreal_of_fin_pos_ennreal
  (ε : ennreal) (ε_pos : 0 < ε) (ε_fin : ε ≠ ⊤) :
    0 < ε.to_nnreal :=
begin
  set ε' := ε.to_nnreal with hε' ,
  have eq : ennreal.of_nnreal_hom ε' = ε := ennreal.coe_to_nnreal ε_fin ,
  by_contra contra ,
  simp only [not_lt, le_zero_iff] at contra ,
  rw contra at eq ,
  simp only [ennreal.coe_of_nnreal_hom, ennreal.coe_zero] at eq,
  rw ←eq at ε_pos ,
  have key := ne_of_lt ε_pos ,
  contradiction ,
end

lemma ennreal_lt_top_iff_ne_top (z : ennreal) :
  z < ⊤ ↔ z ≠ ⊤
    := lt_top_iff_ne_top

lemma ennreal_lt_top_of_ne_top (z : ennreal) (hz : z < ⊤) : z ≠ ⊤
    := (ennreal_lt_top_iff_ne_top z).mp hz

lemma ennreal_ne_top_of_lt_top (z : ennreal) (hz : z ≠ ⊤) : z < ⊤
    := (ennreal_lt_top_iff_ne_top z).mpr hz

lemma lt_add_pos_ennreal (z ε : ennreal) (hz : z ≠ ⊤) (ε_pos : 0 < ε) :
  z < z + ε :=
begin
  by_cases ε_fin : ε = ⊤ ,
  { simp only [ε_fin, ennreal.add_top] ,
    exact lt_top_iff_ne_top.mpr hz , } ,
  have key := ((@ennreal.add_lt_add_iff_left z) ε 0 ( (ennreal_lt_top_iff_ne_top z).mpr hz)).mpr ε_pos,
  simp only [add_zero] at key ,
  exact key ,
end

lemma nbhd_top_ennreal' (U : set ennreal) (hU : U ∈ 𝓝 ∞) :
  ∃ (a : nnreal) , Ioi (a : ℝ≥0∞) ⊆ U :=
begin
  have ns := ennreal.nhds_top' ,
  rw ns at hU ,
  rw mem_infi_iff' at hU ,
  rcases hU with ⟨ I , ⟨ I_fin , ⟨v , ⟨ V_supset_Ioi , inter_V_subset_U ⟩ ⟩ ⟩ ⟩ ,
  have ex_ub : ∃ (b : nnreal) , ∀ i ∈ I , i ≤ b
    := exists_upper_bound_image I (λ (b : nnreal), b) I_fin , -- don't go to plain sight!
  cases ex_ub with b hb ,
  use b ,
  intros x hx ,
  rw mem_Ioi at hx,
  have key : x ∈ ⋂ (i ∈ I) , (v i) ,
  { rw mem_bInter_iff ,
    intros i hi ,
    have key := V_supset_Ioi i hi ,
    rw mem_principal_sets at key ,
    exact key (lt_of_le_of_lt (ennreal.coe_mono (hb i hi)) hx) , } ,
  exact inter_V_subset_U key ,
end

lemma nbhd_top_ennreal (U : set ennreal) (hU : U ∈ 𝓝 ∞) :
  ∃ (a < ⊤) , Ioi (a : ℝ≥0∞) ⊆ U :=
begin
  have key := nbhd_top_ennreal' U hU ,
  cases key with a' ha' ,
  use a' ,
  exact ⟨ ennreal.coe_lt_top , ha' ⟩ ,
end

lemma continuous_const_sub_nnreal (a : nnreal) :
  continuous (λ (x : nnreal) , a-x ) :=
begin
  set sub := (λ (p : nnreal × nnreal) , p.1 - p.2) with h_sub ,
  set to_pair := (λ (x : nnreal) , (⟨a,x⟩ : nnreal × nnreal)) with h_to_pair ,
  have cont_to_pair : continuous to_pair
    := @continuous.prod_mk nnreal nnreal nnreal _ _ _ (λ x , a) (λ x , x) (continuous_const) (continuous_id') ,
  have eq : sub ∘ to_pair = (λ (x : nnreal) , a-x ) := by refl , -- hide in corners
  rw ← eq ,
  exact continuous.comp continuous_sub cont_to_pair ,
end

-- Why could I not find (a symmetric version of) this?
lemma equality_of_restrictions {γ δ : Type*} [topological_space γ] {f g : γ → δ} {G : set γ} {x₀ : γ} (hfg : ∀ (x ∈ G) , f x = g x) (hx₀ : x₀ ∈ G) :
  map f (𝓝[G] x₀) ≤ map g (𝓝[G] x₀) :=
begin
  intros V hV ,
  rcases hV with ⟨ U , hU_nhd , ⟨ T , ⟨ hT_princ , hUT ⟩ ⟩  ⟩ ,
  use U ,
  split ,
  { exact hU_nhd , } ,
  use G ,
  split ,
  { exact mem_principal_self G , } ,
  intros y hy ,
  have y_in_G : y ∈ G := mem_of_mem_inter_right hy ,
  rw mem_preimage ,
  rw (hfg y (mem_of_mem_inter_right hy)) ,
  have y_in_bigger : y ∈ U ∩ T := inter_subset_inter_right U hT_princ hy ,
  exact hUT y_in_bigger ,
end

lemma sub_ennreal_nnreal_continuous_on_ne_top :
  continuous_on (λ p : ennreal × nnreal, p.1 - p.2) { p : ennreal × nnreal | p.1 ≠ ⊤ } :=
begin
  set proj : ennreal × nnreal → nnreal × nnreal := λ p , ⟨ennreal.to_nnreal(p.1), p.2⟩ with h_proj ,
  have proj_cont : continuous_on proj { p : ennreal × nnreal | p.1 ≠ ⊤ } ,
  { have id_cont : continuous_on (λ (z : nnreal) , z) univ := continuous_on_id ,
    have eq_fun : proj = prod.map ennreal.to_nnreal (λ (z : nnreal) , z) := by refl ,
    have eq_set : { p : ennreal × nnreal | p.1 ≠ ⊤ } = { z : ennreal | z ≠ ⊤ }.prod (univ : set nnreal) := by tidy ,
    rw [eq_fun, eq_set] ,
    exact continuous_on.prod_map ennreal.continuous_on_to_nnreal id_cont , } ,
  set sub := (λ p : nnreal × nnreal, p.1 - p.2) with h_sub ,
  have eq : ∀ p ∈ { p : ennreal × nnreal | p.1 ≠ ⊤ } , (λ p : ennreal × nnreal, p.1 - p.2) p = (coe ∘ sub ∘ proj) p ,
  { intros p hp ,
    rw [h_proj , h_sub] ,
    dsimp ,
    simp only [mem_set_of_eq, ne.def] at hp ,
    have coes : p.fst = (p.fst.to_nnreal : ennreal) ,
    { simp only [hp, ne.def, not_false_iff, ennreal.coe_to_nnreal] , } ,
    nth_rewrite 0 coes ,
    apply ennreal.coe_sub.symm , } ,
  suffices : continuous_on (coe ∘ sub ∘ proj) { p : ennreal × nnreal | p.1 ≠ ⊤ } ,
  { exact (continuous_on_congr (eq_on.symm eq)).mp this , } ,
  have cont := continuous.comp_continuous_on continuous_sub proj_cont ,
  apply continuous.comp_continuous_on (ennreal.continuous_coe) cont ,
end

lemma sub_sum_nnreal (a b c : nnreal) : a - (b + c) = a - b - c :=
begin
  have lhs : a - (b + c) = (a.val - b.val - c.val).to_nnreal , --nnreal.of_real (a.val - b.val - c.val) ,
  { rw nnreal.sub_def ,
    apply congr_arg ,
    cases c,
    cases b,
    cases a,
    dsimp at * ,
    ring , } ,
  have rhs : a - b - c = (a.val - b.val - c.val).to_nnreal , -- nnreal.of_real (a.val - b.val - c.val) ,
  { by_cases hab : b ≤ a ,
    { have hab' : b.val ≤ a.val := hab ,
      have hab'' : 0 ≤ a.val - b.val := by linarith ,
      have a_sub_b_val : (a-b).val = a.val - b.val ,
      { have mx : max (a.val - b.val) 0 = a.val - b.val := max_eq_left hab'' ,
        rw nnreal.sub_def ,
        unfold real.to_nnreal ,
        simp_rw mx ,
        exact mx , } ,
      set d := a-b with hd ,
      rw ←a_sub_b_val ,
      rw nnreal.sub_def ,
      apply congr_arg ,
      refl , } ,
    { simp only [not_le] at hab ,
      have le : a ≤ b := le_of_lt hab , -- Such reasoning,
      have le' : a.val ≤ b.val := le , -- obviously, is the
      have le'' : a.val - b.val ≤ 0 := by linarith , -- very
      have c_nn : 0 ≤ c.val := c.prop , -- heart of the asserted
      have le''' : a.val - b.val - c.val ≤ 0 := by linarith , -- fact.
      have mx : max (a.val - b.val - c.val) 0 = 0 := max_eq_right le''' ,
      have a_sub_b : a - b = 0 := nnreal.sub_eq_zero le ,
      have z_sub_c : 0 - c = 0 := le_zero_iff.mp (nnreal.sub_le_self) ,
      rw [a_sub_b , z_sub_c] ,
      unfold real.to_nnreal ,
      simp_rw mx ,
      refl , } ,
  } ,
  rw [lhs, rhs] ,
end

lemma sub_sum_ennreal (a b c : ennreal) : a - (b + c) = a - b - c :=
begin
  by_cases fin : b < ∞ ∧ c < ∞ ,
  { have b_eq : (b.to_nnreal : ennreal) = b := ennreal.coe_to_nnreal (ennreal.lt_top_iff_ne_top.mp fin.left) ,
    have c_eq : (c.to_nnreal : ennreal) = c := ennreal.coe_to_nnreal (ennreal.lt_top_iff_ne_top.mp fin.right) ,
    rw [←b_eq, ←c_eq] ,
    set ι := (coe : nnreal → ennreal) with hι ,
    set b' := b.to_nnreal with hb' ,
    set c' := c.to_nnreal with hc' ,
    have eq₂ : ι (b'+c') = ι b' + ι c' := @ennreal.coe_add b' c' ,
    have sum_fin : b + c < ⊤
      := by simp only [fin.left, fin.right, ennreal.add_lt_top, and_self] ,
    by_cases a_top : a = ⊤ ,
    { rw a_top ,
      have sum_ne_top := ennreal.lt_top_iff_ne_top.mp sum_fin ,
      have lhs : ⊤ - ι (b'+c') = ⊤ := ennreal.top_sub_coe , -- to a corner
      have rhs₁ : ⊤-(ι b') = ⊤ := ennreal.top_sub_coe ,
      have rhs₂ : ⊤-(ι c') = ⊤ := ennreal.top_sub_coe ,
      rw [rhs₁ , rhs₂ , ←eq₂ , lhs] , } ,
    { have a_eq : (a.to_nnreal : ennreal) = a := ennreal.coe_to_nnreal a_top ,
      rw [←a_eq] ,
      set a' := a.to_nnreal with ha' ,
      have key := sub_sum_nnreal a.to_nnreal b.to_nnreal c.to_nnreal ,
      have key' := congr_arg (coe : nnreal → ennreal) key , -- quickly, to another corner
      have eq₁ : ι (a' - (b'+c')) = (ι a') - (ι (b'+c')) := @ennreal.coe_sub (b'+c') a' ,
      have eq₃ : ι (a' - b' - c') = (ι (a' - b')) - (ι (c')) := @ennreal.coe_sub c' (a'-b') ,
      have eq₄ : ι (a' - b') = (ι a') - (ι b') := @ennreal.coe_sub b' a' ,
      rwa [←eq₂, ←eq₄, ←eq₁, ←eq₃] , } ,
  } ,
  { rw not_and_distrib at fin , -- hide
    cases fin with not_fin not_fin ; simp only [not_lt, top_le_iff] at not_fin ,
    { rw [not_fin , ennreal.top_add] ,
      simp only [ennreal.sub_infty, ennreal.zero_sub] , } ,
    { rw [not_fin , ennreal.add_top] ,
      simp only [ennreal.sub_infty, ennreal.zero_sub] , } ,
  } ,
end

lemma continuous_sub_ennreal_nnreal :
  continuous (λ p : ennreal × nnreal, p.1 - p.2) :=
begin
  apply continuous_iff_continuous_at.mpr ,
  intros p ,
  by_cases fst_top : p.fst = ⊤ ,
  { intros V hV ,
    simp_rw fst_top at hV ,
    simp only [ennreal.top_sub_coe] at hV ,
    have V_super := nbhd_top_ennreal' V hV ,
    cases V_super with v hv ,
    set U := set.prod (Ioi (p.2 + v + 1 : ennreal)) (Iio (p.2 + 1)) with hU ,
    have lt₁ : (⊤ : ℝ≥0∞) ∈ (Ioi (p.2 + v + 1 : ennreal)) ,
    { simp only [true_and, ennreal.coe_lt_top, mem_Ioi, ennreal.add_lt_top] ,
      exact dec_trivial , } ,
    have nbhd₁ : Ioi (p.2+v+1 : ennreal) ∈ 𝓝 p.1,
    { rw fst_top ,
      --exact is_open.mem_nhds (is_open_Ioi) lt₁ ,
      exact Ioi_mem_nhds lt₁ , } ,
    have nbhd₂ : Iio (p.2+1) ∈ 𝓝 p.2 := is_open.mem_nhds (is_open_Iio) (by simp only [mem_Iio, lt_add_iff_pos_right, zero_lt_one]) ,
      --:= mem_nhds_sets (is_open_Iio) (by simp only [mem_Iio, lt_add_iff_pos_right, zero_lt_one]) ,
    have nbhd := prod_is_open.mem_nhds nbhd₁ nbhd₂ ,
      --: set.prod (Ioi (p.2 + v + 1 : ennreal)) (Iio (p.2 + 1)) ∈ 𝓝 p
      --:= by sorry , -- the above works in another version of mathlib
    rw [←hU , prod.mk.eta] at nbhd , --works in another version of mathlib
    --have nbhd : U ∈ 𝓝 p := by sorry , -- again, use the above in a fresh mathlib
    set f := (λ p : ennreal × nnreal, p.1 - p.2) with hf ,
    have ss : U ⊆ f⁻¹' V ,
    { rintros q ⟨ hq₁ , hq₂⟩ ,
      simp only [mem_Ioi] at hq₁ ,
      simp only [mem_Iio] at hq₂ ,
      have hq₂' : (q.snd : ennreal) < p.snd + 1 := ennreal.coe_lt_coe.mpr hq₂ ,
      have hq₁' : (p.snd : ennreal) + 1 < q.fst - v ,
      { have le : (v : ennreal) ≤ q.fst ,
        { apply le_of_lt _ ,
          calc (v : ennreal) ≤ (v : ennreal) + (1 + p.snd) : le_self_add_ennreal _ _
          ... = (p.snd : ennreal) + v + 1                  : by ring
          ... < q.fst                                      : hq₁ , } ,
        have eq : q.fst - v + v = q.fst := ennreal.sub_add_cancel_of_le le ,
        have eq' : (p.snd : ennreal) + 1 + v = (p.snd : ennreal) + v + 1 := by ring ,
        rw [←eq , ←eq'] at hq₁ ,
        exact (ennreal.add_lt_add_iff_right (@ennreal.coe_lt_top v)).mp hq₁ , } ,
      have gt : (v : ennreal) < f q ,
      { rw hf ,
        dsimp ,
        have lt := lt_trans hq₂' hq₁' ,
        have lt' := ennreal.zero_lt_sub_iff_lt.mpr lt ,
        have rw₀ : q.fst - v - q.snd = q.fst - q.snd - v ,
        { rw [←(sub_sum_ennreal _ _ _) , ←(sub_sum_ennreal _ _ _) , add_comm ] , } ,
        rw rw₀ at lt' ,
        apply ennreal.zero_lt_sub_iff_lt.mp lt' ,
      } ,
      exact hv gt , } ,
    apply (𝓝 p).sets_of_superset nbhd ss , } ,
  { intros V hV ,
    dsimp at hV ,
    have key := sub_ennreal_nnreal_continuous_on_ne_top p fst_top hV ,
    rcases key with ⟨ U , U_nbhd , ⟨ T , ⟨ hT , hUT ⟩ ⟩ ⟩ ,
    set S := { p : ennreal × nnreal | p.1 ≠ ⊤ } with hS ,
    rw mem_principal_sets at hT ,
    have S_prod : S = {z : ennreal | z ≠ ⊤}.prod (univ : set nnreal) ,
    { ext q ,
      simp only [and_true, mem_univ, mem_set_of_eq, mem_prod] , } ,
    have nbhd₁ : {z : ennreal | z ≠ ⊤} ∈ 𝓝 p.fst := is_open.mem_nhds (is_open_ne) (fst_top) , -- mem_nhds_sets (is_open_ne) (fst_top) ,
    have nbhd₂ : (univ : set nnreal) ∈ 𝓝 p.snd := is_open.mem_nhds (is_open_univ) (mem_univ _) ,
    have S_nbhd : {z : ennreal | z ≠ ⊤}.prod (univ : set nnreal) ∈ 𝓝 (⟨p.1, p.2⟩ : ennreal × nnreal)
      := prod_is_open.mem_nhds nbhd₁ nbhd₂ , -- prod_mem_nhds_sets nbhd₁ nbhd₂ ,
    rw [←S_prod , prod.mk.eta] at S_nbhd ,
    have US_nbhd : U ∩ S ∈ 𝓝 p := (𝓝 p).inter_sets U_nbhd S_nbhd ,
    have US_ss_UT : U ∩ S ⊆ U ∩ T := inter_subset_inter_right U hT ,
    have UT_nbhd : U ∩ T ∈ 𝓝 p := (𝓝 p).sets_of_superset US_nbhd US_ss_UT ,
    apply (𝓝 p).sets_of_superset UT_nbhd hUT , } ,
end

-- Remark:
-- This is not even the right generality for the continuity of
-- subtraction on a subset of `ennreal × ennreal`. I guess we
-- have continuity on the complement of the singleton `{⟨∞,∞⟩}`.
-- With that, a few of the subsequent corner-hidings would simplify.
-- But I had surprisingly hard time working with ennreals and
-- subtraction, so I gave up and just aimed at a sorry-free (TM)
-- exercise...
lemma continuous_sub_ennreal_ennreal_snd_ne_top :
  continuous_on (λ p : ennreal × ennreal, p.1 - p.2) { p : ennreal × ennreal | p.snd ≠ ∞} :=
begin
  have g_cont := continuous_sub_ennreal_nnreal ,
  set g := (λ p : ennreal × nnreal, p.1 - p.2) with hg ,
  set f := (λ p : ennreal × ennreal, p.1 - p.2) with hf ,
  set φ := (λ p : ennreal × ennreal, ( ⟨p.1 , (p.2).to_nnreal ⟩ : ennreal × nnreal ) ) with hφ ,
  set S := { p : ennreal × ennreal | p.snd ≠ ∞} with hS ,
  have φ_cont : continuous_on φ S ,
  { have key₁' : continuous (λ (z : ennreal) , z ) := continuous_id' ,
    have key₁ : continuous_on (λ (z : ennreal) , z ) univ := continuous.continuous_on key₁' ,
    have key₂ := ennreal.continuous_on_to_nnreal ,
    have φ_prod_map : φ = prod.map (λ (z : ennreal) , z ) ennreal.to_nnreal := by refl ,
    have S_prod_set : S = (univ : set ennreal).prod {w : ennreal | w ≠ ∞},
    { simp only [eq_self_iff_true] at hS ,
      ext p,
      cases p,
      dsimp ,
      simp only [true_and, mem_univ] , } ,
    rw [φ_prod_map , S_prod_set] ,
    exact continuous_on.prod_map key₁ key₂ , } ,
  have comp_cont : continuous_on (g ∘ φ) S := continuous.comp_continuous_on g_cont φ_cont ,
  have agree : ∀ p ∈ S , f p = (g ∘ φ) p ,
  { intros p hpS ,
    rw [hf , hg , hφ ] ,
    simp only [function.comp_app] ,
    rw ennreal.coe_to_nnreal hpS , } ,
  have pfun_eq : pfun.res f S = pfun.res (g ∘ φ) S ,
  { ext ,
    rw pfun.mem_res ,
    rw pfun.mem_res ,
    split ,
    { rintros ⟨ hx , val ⟩ ,
      rw agree x hx at val ,
      exact ⟨ hx , val ⟩ , } ,
    { rintros ⟨ hx , val ⟩ ,
      rw ← agree x hx at val ,
      exact ⟨ hx , val ⟩ , } ,
  } ,
  intros p hp ,
  rw continuous_within_at_iff_ptendsto_res ,
  rw [pfun_eq , agree p hp] ,
  rw ← continuous_within_at_iff_ptendsto_res ,
  exact comp_cont p hp ,
end

-- Remark: This should get an easier proof from the right
-- continuity result of subtraction on ennreals.
lemma continuous_on_const_sub_ennreal (a : ennreal) (a_ne_top : a ≠ ⊤) :
  continuous_on (λ (x : ennreal) , a-x ) {z : ennreal | z ≠ ⊤} :=
begin
  set f := (λ (x : ennreal) , a-x ) with hf ,
  set S := { z : ennreal | z ≠ ⊤ } with hS ,
  have cont_cast : continuous_on ennreal.to_nnreal S := ennreal.continuous_on_to_nnreal ,
  set f₀ := (λ (x : nnreal) , a.to_nnreal-x ) with hf₀ ,
  have cont_f₀ : continuous f₀ := continuous_const_sub_nnreal (ennreal.to_nnreal a) ,
  have cont_f₀' : continuous_on f₀ univ := continuous.continuous_on cont_f₀ ,
  have cont_comp' := continuous_on.comp cont_f₀' cont_cast (by simp only [preimage_univ, subset_univ]) ,
  have cont_comp := continuous.comp_continuous_on ennreal.continuous_coe cont_comp' ,
  have eq₀ : ( ∀ (z ∈ S) , f z = (coe ∘ f₀ ∘ ennreal.to_nnreal) z ) ,
  { intros z hz ,
    rw [hf , hf₀] ,
    dsimp ,
    have a_eq := ennreal.coe_to_nnreal a_ne_top ,
    have z_eq := ennreal.coe_to_nnreal hz ,
    rw [←a_eq , ←z_eq] ,
    apply ennreal.coe_sub.symm , } ,
  intros z hzS V hV ,
  have hV' := hV ,
  rw (eq₀ z hzS) at hV' ,
  specialize cont_comp z hzS hV' ,
  have key := equality_of_restrictions eq₀ hzS ,
  exact key cont_comp ,
end

-- Remark: This also should get an easier proof from the right
-- continuity result of subtraction on ennreals.
lemma continuous_const_sub_ennreal (a : ennreal) (a_ne_top : a ≠ ⊤) :
  continuous (λ (x : ennreal) , a-x ) :=
begin
  set f := (λ (x : ennreal) , a-x ) with hf ,
  apply continuous_iff_continuous_at.mpr ,
  intros x ,
  by_cases hx : x = ⊤ ,
  { rw hx ,
    have mem_Ioi : ⊤ ∈ Ioi a := ennreal.lt_top_iff_ne_top.mpr a_ne_top ,
    have open_Ioi : is_open (Ioi a) := is_open_Ioi ,
    have nhd_Ioi : Ioi a ∈ 𝓝 ⊤ := is_open.mem_nhds open_Ioi mem_Ioi , --mem_nhds_sets open_Ioi mem_Ioi ,
    intros V hV ,
    have val_at_top : f ⊤ = 0 := by simp only [ennreal.sub_eq_zero_iff_le, le_top] ,
    rw val_at_top at hV ,
    have mem_V : (0 : ennreal) ∈ V ,
    { exact mem_of_mem_nhds hV , } ,
    have ss_preim : Ioi a ⊆ f⁻¹' V ,
    { intros z hz ,
      have val : f z = 0 := ennreal.sub_eq_zero_iff_le.mpr (le_of_lt hz) ,
      rwa ← val at mem_V , } ,
    exact (𝓝 ⊤).sets_of_superset nhd_Ioi ss_preim , } ,
  { set S := { z : ennreal | z ≠ ⊤ } with hS ,
    have nbhd : S ∈ (𝓝 x) ,
    { have opn : is_open S := is_open_ne ,
      --exact mem_nhds_sets opn good ,
      exact is_open.mem_nhds opn hx , } ,
    suffices : continuous_on f S ,
    { intros V hV ,
      have key := this x hx hV ,
      rcases key with ⟨ U , U_nhd , ⟨ T , hT , hUT⟩ ⟩ ,
      rw mem_principal_sets at hT ,
      have T_nbhd : T ∈ (𝓝 x) := (𝓝 x).sets_of_superset nbhd hT ,
      have nbhd₀ : U ∩ T ∈ (𝓝 x) := inter_mem_sets U_nhd T_nbhd ,
      rw mem_map ,
      apply (𝓝 x).sets_of_superset nbhd₀ hUT , } ,
    exact continuous_on_const_sub_ennreal a a_ne_top , } ,
end

lemma lim_enn_of_lim_R {s : ℕ → ℝ} {l : ℝ} (hlim : tendsto s at_top (𝓝 l)) :
  tendsto (ennreal.of_real ∘ s) at_top (𝓝 (ennreal.of_real l))
    := ennreal.tendsto_of_real hlim

lemma nnreal_nbhd_finite_ennreal (x : ennreal) :
  x ≠ ⊤ → { z : ennreal | z ≠ ⊤ } ∈ 𝓝 x :=
begin
  intros hx ,
  have op : is_open { z : ennreal | z ≠ ⊤ } := is_open_ne ,
  --TODO: depending on mathlib version, one of the following works...
  --exact mem_nhds_sets op hx ,
  exact is_open.mem_nhds op hx ,
end

lemma ennreal_to_nnreal_continuous_on_nnreal :
  continuous_on ennreal.to_nnreal { z : ennreal | z ≠ ⊤ } :=
begin
  exact ennreal.continuous_on_to_nnreal ,
end

lemma ennreal_to_real_continuous_on_nnreal :
  continuous_on ennreal.to_real { z : ennreal | z ≠ ⊤ } :=
begin
  have eq : ennreal.to_real = nnreal.to_real_hom ∘ ennreal.to_nnreal := by refl ,
  rw eq ,
  intros z hz ,
  have cont_at_nnreal
    := continuous_on.continuous_at ennreal.continuous_on_to_nnreal (nnreal_nbhd_finite_ennreal z hz),
  apply @tendsto.comp _ _ _ _ _ _ (𝓝 (ennreal.to_nnreal z)) _ ,
  { simp only [nnreal.coe_to_real_hom, nnreal.tendsto_coe] ,
    intros U hU ,
    assumption , } ,
  { exact tendsto_inf_left cont_at_nnreal , } ,
end

lemma ennreal_ne_top_of_le_nnreal {c : nnreal} {x : ennreal} (h_le : x ≤ c) : x ≠ ⊤ :=
begin
  by_contra contra ,
  rw not_not at contra ,
  rw contra at h_le ,
  simp only [ennreal.not_top_le_coe] at h_le ,
  exact h_le ,
end

lemma finval_of_bdd_ennval {α : Type*} {f : α → ennreal} :
  bdd_ennval f → ∀ (a : α) , f(a) ≠ ⊤ :=
begin
  intros f_bdd a ,
  cases f_bdd with c hc ,
  exact ennreal_ne_top_of_le_nnreal (hc a) ,
end

lemma bdd_Rval_add {α : Type*} {f g : α → ℝ}
  (f_bdd : bdd_Rval f) (g_bdd : bdd_Rval g) : bdd_Rval (f+g) :=
begin
  cases f_bdd with c hc ,
  cases g_bdd with d hd ,
  use (c+d) ,
  intros x ,
  apply le_trans (abs_add (f(x)) (g(x))) (add_le_add (hc x) (hd x)) ,
end

lemma bdd_ennval_add {α : Type*} {f g : α → ennreal}
  (f_bdd : bdd_ennval f) (g_bdd : bdd_ennval g) : bdd_ennval (f+g) :=
begin
  cases f_bdd with c hc ,
  cases g_bdd with d hd ,
  use (c+d) ,
  intros x ,
  exact add_le_add (hc x) (hd x) ,
end

lemma bdd_ennval_of_le_bdd_ennval {α : Type*} {f g : α → ennreal}
  (hfg : f ≤ g) (g_bdd : bdd_ennval g) : bdd_ennval f :=
begin
  cases g_bdd with c hc ,
  use c ,
  intros x ,
  exact le_trans (hfg x) (hc x) ,
end

lemma bdd_ennval_of_bdd_Rval {α : Type*} {f : α → ℝ}
  (f_bdd : bdd_Rval f) : bdd_ennval (ennreal.of_real ∘ f) :=
begin
  cases f_bdd with c hc ,
  use (c.to_nnreal) ,
  intros x ,
  apply ennreal.coe_mono ,
  apply real.to_nnreal_mono (le_trans (le_abs_self (f(x))) (hc x)) ,
end

lemma lim_R_of_lim_enn (s : ℕ → ennreal) (l : ennreal)
  (hlim : tendsto s at_top (𝓝 l)) (hfin : l ≠ ⊤) :
    tendsto (ennreal.to_real ∘ s) at_top (𝓝 (ennreal.to_real l)) :=
begin
  have cont_at : continuous_at ennreal.to_real l
    := continuous_on.continuous_at ennreal_to_real_continuous_on_nnreal (nnreal_nbhd_finite_ennreal l hfin) ,
  exact tendsto.comp cont_at hlim ,
end

lemma cont_R_of_cont_bdd_enn {α : Type*} [topological_space α]
  (f : α → ennreal) (f_cont : continuous f) (f_bdd : bdd_ennval f) :
    continuous (ennreal.to_real ∘ f) :=
begin
  apply continuous_iff_continuous_at.mpr ,
  intros a ,
  set x := f(a) with hx ,
  have x_fin : x ≠ ⊤ := finval_of_bdd_ennval f_bdd a ,
  have cont_at₁ := continuous_iff_continuous_at.mp f_cont a ,
  have cont_at₂ : continuous_at ennreal.to_real x
    := continuous_on.continuous_at ennreal_to_real_continuous_on_nnreal (nnreal_nbhd_finite_ennreal x x_fin) ,
  exact @continuous_at.comp α ennreal ℝ _ _ _ ennreal.to_real f a cont_at₂ cont_at₁ ,
end

lemma cont_enn_of_cont_R {α : Type*} [topological_space α] (f : α → ℝ) (f_cont : continuous f) :
  continuous (ennreal.of_real ∘ f)
    := continuous.comp (ennreal.continuous_of_real) f_cont

lemma le_of_forall_pos_le_add_nnreal (a b : nnreal) :
  (∀ (ε : nnreal) , (ε > 0) → (a ≤ b + ε)) → a ≤ b :=
begin
  exact nnreal.le_of_forall_pos_le_add ,
end

lemma tendsto_of_ev_same {α β : Type*} {Fα : filter α} {Fβ : filter β}
  (f g : α → β) (h_ev_eq : ∃ (S : set α) , S ∈ Fα.sets ∧
    ∀ x , x ∈ S → f(x) = g(x) ) :
      tendsto f Fα Fβ → tendsto g Fα Fβ :=
begin
  intro tends_f ,
  cases h_ev_eq with S hS ,
  intros T hT ,
  have key := Fα.inter_sets hS.1 (tends_f hT),
  have eq_fg : S ∩ f⁻¹' T = S ∩ g⁻¹' T ,
  { ext x ,
    simp only [mem_inter_eq, mem_preimage, and.congr_right_iff] ,
    intro hxS ,
    rwa hS.2 x , } ,
  rw eq_fg at key ,
  exact Fα.sets_of_superset key (set.inter_subset_right _ _ ) ,
end

lemma lim_R_of_ev_same (x y : ℕ → ℝ)
  (hevsame : ∃ (m : ℕ), ∀ (k : ℕ) , k ≥ m → x(k) = y(k))
  (hlim : tendsto x at_top (𝓝 0)) :
    tendsto y at_top (𝓝 0) :=
begin
  apply tendsto_of_ev_same x y ,
  { cases hevsame with m hm ,
    set S := { k : ℕ | k ≥ m } ,
    have mem : S ∈ at_top.sets := mem_at_top m ,
    use [ S , mem ] ,
    exact hm , } ,
  exact hlim ,
end

lemma lim_enn_of_ev_same (x y : ℕ → ennreal)
  (hevsame : ∃ (m : ℕ), ∀ (k : ℕ) , k ≥ m → x(k) = y(k))
  (hlim : tendsto x at_top (𝓝 0)) :
    tendsto y at_top (𝓝 0) :=
begin
  apply tendsto_of_ev_same x y ,
  { cases hevsame with m hm ,
    set S := { k : ℕ | k ≥ m } ,
    have mem : S ∈ at_top.sets := mem_at_top m ,
    use [ S , mem ] ,
    exact hm , } ,
  exact hlim ,
end

lemma of_real_lt_of_lt_to_real {x : ℝ} {z : ennreal} (x_lt_z : x < z.to_real) (x_nn : 0 ≤ x) :
  ennreal.of_real(x) < z :=
begin
  by_cases z_top : z = ⊤ ,
  { rw z_top ,
    exact lt_top_iff_ne_top.mpr (@ennreal.of_real_ne_top x) , } ,
  { have le : ennreal.of_real x ≤ z := ennreal.of_real_le_of_le_to_real (le_of_lt x_lt_z) ,
    have neq : ennreal.of_real x ≠ z ,
    { by_contra con ,
      push_neg at con ,
      rw ←con at x_lt_z ,
      rw (ennreal.to_real_of_real x_nn) at x_lt_z ,
      linarith , } ,
    exact (ne.le_iff_lt neq).mp le , } ,
end

lemma of_real_mono : monotone ennreal.of_real :=
begin
  intros x y hxy ,
  exact ennreal.of_real_le_of_real hxy ,
end

lemma of_real_lt_of_lt {x y : ℝ} (x_nn : 0 ≤ x) (x_lt_y : x < y) :
  ennreal.of_real x < ennreal.of_real y :=
begin
  have ne : ennreal.of_real x ≠ ennreal.of_real y ,
  { intros h ,
    have rw_x : (ennreal.of_real x).to_real = x := ennreal.to_real_of_real x_nn ,
    have rw_y : (ennreal.of_real y).to_real = y := ennreal.to_real_of_real (le_of_lt (lt_of_le_of_lt x_nn x_lt_y)) ,
    have eq : (ennreal.of_real x).to_real = (ennreal.of_real y).to_real := congr_arg ennreal.to_real h ,
    rw [rw_x , rw_y] at eq ,
    apply ne_of_lt x_lt_y ,
    rwa eq at x_lt_y , } ,
  have le : ennreal.of_real x ≤ ennreal.of_real y := of_real_mono (le_of_lt x_lt_y) ,
  exact (ne.le_iff_lt).mp le ,
end

lemma of_real_lt_of_real {x y : ℝ} (hxy : ennreal.of_real x < ennreal.of_real y) : x < y :=
begin
  have x_ne_top : ennreal.of_real x ≠ ⊤ := ennreal.of_real_ne_top ,
  have y_gt' : 0 < ennreal.of_real y := pos_of_gt hxy ,
  have y_gt : 0 < y := ennreal.of_real_pos.mp y_gt' ,
  by_contra x_too_large ,
  simp only [not_lt] at x_too_large ,
  have x_ge := ennreal.of_real_le_of_real x_too_large ,
  exact not_lt.mpr (le_refl (ennreal.of_real x)) (lt_of_lt_of_le hxy x_ge) ,
end

end portmanteau_comeonlean_lemmas

end portmanteau


/- Yair Gueta : 208624908 : t4
    Exercise 4
-/
import data.int.basic

variable  U : Type
variables R : U → U → Prop

-- Question 9:
example : (∃ x, ∀ y, R x y) → ∀ y, ∃ x, R x y :=
begin
  intro,
  cases a with x,
  intro,
  existsi x, exact a_h y
end

-- Question 10:
theorem foo {A : Type} {a b c : A} : a = b → c = b → a = c :=
begin
  intros, exact a_1.trans a_2.symm,
end

-- notice that you can now use foo as a rule. The curly braces mean that
-- you do not have to give A, a, b, or c

section
  variable A : Type
  variables a b c : A

  example (h1 : a = b) (h2 : c = b) : a = c :=
  foo h1 h2
end

section
  variable {A : Type}
  variables {a b c : A}

  -- replace the sorry with a proof, using foo and rfl, without using eq.symm.
  theorem my_symm (h : b = a) : a = b :=
  by exact foo (eq.refl a) h

  -- now use foo and my_symm to prove transitivity
  theorem my_trans (h1 : a = b) (h2 : b = c) : a = c :=
  by exact foo h1 (my_symm h2)
end

-- Question 11:
-- these are the axioms for a commutative ring

#check @add_assoc
#check @add_comm
#check @add_zero
#check @zero_add
#check @mul_assoc
#check @mul_comm
#check @mul_one
#check @one_mul
#check @left_distrib
#check @right_distrib
#check @add_left_neg
#check @add_right_neg
#check @sub_eq_add_neg

variables x y z : int

theorem t1 : x - x = 0 :=
calc
x - x = x + -x : by rw sub_eq_add_neg
    ... = 0      : by rw add_right_neg

theorem t2 (h : x + y = x + z) : y = z :=
calc
y     = 0 + y        : by rw zero_add
    ... = (-x + x) + y : by rw add_left_neg
    ... = -x + (x + y) : by rw add_assoc
    ... = -x + (x + z) : by rw h
    ... = (-x + x) + z : by rw add_assoc
    ... = 0 + z        : by rw add_left_neg
    ... = z            : by rw zero_add

theorem t3 (h : x + y = z + y) : x = z :=
calc
x     = x + 0        : by rw add_zero
    ... = x + (y + -y) : by rw ← add_right_neg
    ... = (x + y) + -y : by rw add_assoc
    ... = (z + y) + -y : by rw h
    ... = z + (y + -y) : by rw add_assoc
    ... = z + 0        : by rw add_right_neg
    ... = z            : by rw add_zero

theorem t4 (h : x + y = 0) : x = -y :=
calc
x     = x + 0        : by rw add_zero
    ... = x + (y + -y) : by rw add_right_neg
    ... = (x + y) + -y : by rw add_assoc
    ... = 0 + -y       : by rw h
    ... = -y           : by rw zero_add

theorem t5 : x * 0 = 0 :=
have h1 : x * 0 + x * 0 = x * 0 + 0, from
calc
    x * 0 + x * 0 = x * (0 + 0) : by rw mul_add
            ... = x * 0       : by rw add_zero
            ... = x * 0 + 0   : by rw add_zero,
show x * 0 = 0, from t2 _ _ _ h1

theorem t6 : x * (-y) = -(x * y) :=
have h1 : x * (-y) + x * y = 0, from
calc
    x * (-y) + x * y = x * (-y + y) : by rw mul_add
                ... = x * 0        : by rw add_left_neg
                ... = 0            : by rw t5 x,
show x * (-y) = -(x * y), from t4 _ _ h1

theorem t7 : x + x = 2 * x :=
calc
x + x = 1 * x + 1 * x : by rw one_mul
    ... = (1 + 1) * x   : by rw add_mul
    ... = 2 * x         : rfl


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers
import solutions.section02reals.sheet5 -- import a bunch of previous stuff

/-

# Harder questions

Here are some harder questions. Don't feel like you have
to do them. We've seen enough techniques to be able to do
all of these, but the truth is that we've seen a ton of stuff
in this course already, so probably you're not on top of all of
it yet, and furthermore we have not seen
some techniques which will enable you to cut corners. If you
want to become a real Lean expert then see how many of these
you can do. I will go through them all in a solutions video,
so if you like you can try some of them and then watch me
solving them.

Good luck!
-/

/-- If `a(n)` tends to `t` then `37 * a(n)` tends to `37 * t`-/
theorem tends_to_thirtyseven_mul (a : ℕ → ℝ) (t : ℝ) (h : tends_to a t) :
  tends_to (λ n, 37 * a n) (37 * t) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `c` is a positive constant then
`c * a(n)` tends to `c * t`. -/
theorem tends_to_pos_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tends_to a t)
  {c : ℝ} (hc : 0 < c) : tends_to (λ n, c * a n) (c * t) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `c` is a negative constant then
`c * a(n)` tends to `c * t`. -/
theorem tends_to_neg_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tends_to a t)
  {c : ℝ} (hc : c < 0) : tends_to (λ n, c * a n) (c * t) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `c` is a constant then `c * a(n)` tends
to `c * t`. -/
theorem tends_to_const_mul {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tends_to a t) :
  tends_to (λ n, c * a n) (c * t) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `c` is a constant then `a(n) * c` tends
to `t * c`. -/
theorem tends_to_mul_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tends_to a t) :
  tends_to (λ n, a n * c) (t * c) :=
begin
  sorry
end

-- another proof of this result, showcasing some tactics
-- which I've not covered yet.
theorem tends_to_neg' {a : ℕ → ℝ} {t : ℝ} (ha : tends_to a t) :
  tends_to (λ n, - a n) (-t) :=
begin
  convert tends_to_const_mul (-1) ha, -- read about the `convert` tactic in the course notes!
  { ext, simp }, -- ext is a generic extensionality tactic. Here it's being
                 -- used to deduce that two functions are the same if they take
                 -- the same values everywhere
  { simp },
end

/-- If `a(n)-b(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)` tends to `t + u`. -/
theorem tends_to_of_tends_to_sub {a b : ℕ → ℝ} {t u : ℝ}
  (h1 : tends_to (λ n, a n - b n) t) (h2 : tends_to b u) :
  tends_to a (t+u) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` then `a(n)-t` tends to `0`. -/
theorem tends_to_sub_lim {a : ℕ → ℝ} {t : ℝ}
  (h : tends_to a t) : tends_to (λ n, a n - t) 0 :=
begin
  sorry,
end

/-- If `a(n)` and `b(n)` both tend to zero, then their product tends
to zero. -/
theorem tends_to_zero_mul_tends_to_zero
  {a b : ℕ → ℝ} (ha : tends_to a 0) (hb : tends_to b 0) :
  tends_to (λ n, a n * b n) 0 :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)*b(n)` tends to `t*u`. -/
theorem tends_to_mul (a b : ℕ → ℝ) (t u : ℝ) (ha : tends_to a t)
  (hb : tends_to b u) : tends_to (λ n, a n * b n) (t * u) :=
begin
  sorry,
end

-- something we never used!
/-- A sequence has at most one limit. -/
theorem tends_to_unique (a : ℕ → ℝ) (s t : ℝ)
  (hs : tends_to a s) (ht : tends_to a t) : s = t :=
begin
  sorry,
end


import data.nat.basic
import data.nat.prime
import number_theory.padics.padic_norm

theorem padic_norm_primes {p q: ℕ} [p_prime: fact (nat.prime p)] [q_prime: fact (nat.prime q)]
  (neq: p ≠ q): padic_norm p q = 1 :=
begin
  have p: padic_val_rat p q = 0,
  exact_mod_cast @padic_val_nat_primes p q p_prime q_prime neq,
  simp [padic_norm, p, q_prime.1, nat.prime.ne_zero _],
end


set_option profiler true

open polynomial

example (R : Type) [comm_ring R] (x : R) :
  (1 + x^2 + x^4 + x^6) * (1 + x) = 1+x+x^2+x^3+x^4+x^5+x^6+x^7 :=
by ring -- 5 seconds

example (R : Type) [comm_ring R] :
  (1 + X^2 + X^4 + X^6 : polynomial R) * (1 + X) = 1+X+X^2+X^3+X^4+X^5+X^6+X^7 :=
by ring -- 18 seconds


/-
Copyright (c) 2023 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import order.bounded_lattice

/-- Preorder semantics for Aristotle's assertoric syllogisms.
The set-theoretic semantics and first-order logic semantics are orthodox
semantics, based on sets of individuals. Now we present a heterodox semantics.
Terms are regarded to be primitives. They form a meet semi-lattice with bot.
See, for instance, Andrade-Lotero (2012, pp. 402-403).
-/

variable {α : Type}
variables [semilattice_inf_bot α] {A B C : α}
-- *** how can I stipulate that these variables are not the bottom element of α?

/-- semantics of the `a` relation -/
def universal_affirmative (A : α) (B: α) : Prop :=   A ⊓ B = B
infixr ` a ` : 80 := universal_affirmative

/-- semantics of the `e` relation -/
def universal_negative (A : α) (B: α) : Prop :=   A ⊓ B = ⊥
infixr ` e ` : 80 := universal_negative

/-- semantics of the `i` relation -/
def particular_affirmative (A: α) (B: α) : Prop :=   A ⊓ B ≠ ⊥
infixr ` i ` : 80 := particular_affirmative

/-- semantics of the `o` relation -/
def particular_negative (A: α) (B: α) : Prop :=   A ⊓ B ≠ B
infixr ` o ` : 80 := particular_negative

/-- semantics of contradictory: contradictory is defined as negation -/
def c (p : Prop) : Prop := ¬ p

/--   We prove the soundness of the axiom system DR -/

lemma Barbara₁ : A a B → B a C → A a C :=
begin
intros hab hbc,
rw universal_affirmative at *,
finish
end

lemma Celarent₁ : A e B → B a C → A e C :=
begin
intros h1 h2,
simp [universal_affirmative, universal_negative] at *,
have h3 : A ⊓ C ≤ A ⊓ B, by apply inf_le_inf_left; assumption,
--have h4 : A ⊓ C ≤ ⊥, by finish,
finish,
end

lemma e_conv : A e B → B e A :=
begin
intro h1,
rw universal_negative at *,
rw inf_comm at h1,
assumption
end

lemma a_conv : B ≠ ⊥ →  A a B → B i A :=
begin
intros h1 h2 h3,
rw universal_affirmative at h2,
rw inf_comm at h3,
have h4 : B = ⊥, from eq.trans (eq.symm h2) h3,
show false, from h1 h4
end

lemma contr {p r : Prop} : (c r → c p) → p → r :=
begin
intros h1,
contrapose!,
assumption
end

/-- we can also prove the contradictories axioms  -/

lemma contr_a : c (A a B) = A o B := by simp [c, particular_negative, universal_affirmative]

lemma contr_e : c (A e B) = A i B := by simp [c, particular_affirmative, universal_negative]

lemma contr_i : c (A i B) = A e B := by simp [c, particular_affirmative, universal_negative]

lemma contr_o : c (A o B) = A a B := by simp [c, particular_negative, universal_affirmative]

/--  it is, of course, also possible to prove the redundant axioms  -/

lemma Darii₁ : A a B → B i C → A i C :=
begin
intros h1 h2,
simp [particular_affirmative, universal_affirmative] at *,
by_contra h3,
have h4 : B ⊓ C ≤ A ⊓ C, by apply inf_le_inf_right; assumption,
have h5 : B ⊓ C = ⊥, by exact eq_bot_mono h4 h3,
show false, from h2 h5
end

lemma Ferio₁ : A e B → B i C → A o C :=
begin
  intros h1 h2,
  simp [particular_affirmative, universal_negative] at h1 h2,
  rw [particular_negative, ne],
  by_contra h3,
  rw inf_comm at h1,
  have h4 : B ⊓ C = ⊥, by calc B ⊓ C
      = B ⊓ (A ⊓ C) : by rw h3
  ... = (B ⊓ A) ⊓ C : by rw inf_assoc
  ... = ⊥ ⊓ C : by rw h1
  ... = ⊥ : by exact bot_inf_eq,
show false, from h2 h4
end

lemma i_conv : A i B → B i A :=
begin
intros h1,
simp [particular_affirmative] at *,
rw [inf_comm],
assumption
end

#lint