/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import algebra.group.units
import algebra.ring.basic

/-!
# Invertible elements

This file defines a typeclass `invertible a` for elements `a` with a two-sided
multiplicative inverse.

The intent of the typeclass is to provide a way to write e.g. `⅟2` in a ring
like `ℤ[1/2]` where some inverses exist but there is no general `⁻¹` operator;
or to specify that a field has characteristic `≠ 2`.
It is the `Type`-valued analogue to the `Prop`-valued `is_unit`.

For constructions of the invertible element given a characteristic, see
`algebra/char_p/invertible` and other lemmas in that file.

## Notation

 * `⅟a` is `invertible.inv_of a`, the inverse of `a`

## Implementation notes

The `invertible` class lives in `Type`, not `Prop`, to make computation easier.
If multiplication is associative, `invertible` is a subsingleton anyway.

The `simp` normal form tries to normalize `⅟a` to `a ⁻¹`. Otherwise, it pushes
`⅟` inside the expression as much as possible.

Since `invertible a` is not a `Prop` (but it is a `subsingleton`), we have to be careful about
coherence issues: we should avoid having multiple non-defeq instances for `invertible a` in the
same context.  This file plays it safe and uses `def` rather than `instance` for most definitions,
users can choose which instances to use at the point of use.

For example, here's how you can use an `invertible 1` instance:
```lean
variables {α : Type*} [monoid α]

def something_that_needs_inverses (x : α) [invertible x] := sorry

section
local attribute [instance] invertible_one
def something_one := something_that_needs_inverses 1
end
```

## Tags

invertible, inverse element, inv_of, a half, one half, a third, one third, ½, ⅓

-/

universes u

variables {α : Type u}

/-- `invertible a` gives a two-sided multiplicative inverse of `a`. -/
class invertible [has_mul α] [has_one α] (a : α) : Type u :=
(inv_of : α) (inv_of_mul_self : inv_of * a = 1) (mul_inv_of_self : a * inv_of = 1)

-- This notation has the same precedence as `has_inv.inv`.
notation `⅟`:1034 := invertible.inv_of

@[simp]
lemma inv_of_mul_self [has_mul α] [has_one α] (a : α) [invertible a] : ⅟a * a = 1 :=
invertible.inv_of_mul_self

@[simp]
lemma mul_inv_of_self [has_mul α] [has_one α] (a : α) [invertible a] : a * ⅟a = 1 :=
invertible.mul_inv_of_self

@[simp]
lemma inv_of_mul_self_assoc [monoid α] (a b : α) [invertible a] : ⅟a * (a * b) = b :=
by rw [←mul_assoc, inv_of_mul_self, one_mul]

@[simp]
lemma mul_inv_of_self_assoc [monoid α] (a b : α) [invertible a] : a * (⅟a * b) = b :=
by rw [←mul_assoc, mul_inv_of_self, one_mul]

@[simp]
lemma mul_inv_of_mul_self_cancel [monoid α] (a b : α) [invertible b] : a * ⅟b * b = a :=
by simp [mul_assoc]

@[simp]
lemma mul_mul_inv_of_self_cancel [monoid α] (a b : α) [invertible b] : a * b * ⅟b = a :=
by simp [mul_assoc]

lemma inv_of_eq_right_inv [monoid α] {a b : α} [invertible a] (hac : a * b = 1) : ⅟a = b :=
left_inv_eq_right_inv (inv_of_mul_self _) hac

lemma inv_of_eq_left_inv [monoid α] {a b : α} [invertible a] (hac : b * a = 1) : ⅟a = b :=
(left_inv_eq_right_inv hac (mul_inv_of_self _)).symm

lemma invertible_unique {α : Type u} [monoid α] (a b : α) (h : a = b)
  [invertible a] [invertible b] :
  ⅟a = ⅟b :=
by { apply inv_of_eq_right_inv, rw [h, mul_inv_of_self], }

instance [monoid α] (a : α) : subsingleton (invertible a) :=
⟨ λ ⟨b, hba, hab⟩ ⟨c, hca, hac⟩, by { congr, exact left_inv_eq_right_inv hba hac } ⟩

/-- If `r` is invertible and `s = r`, then `s` is invertible. -/
def invertible.copy [monoid α] {r : α} (hr : invertible r) (s : α) (hs : s = r) : invertible s :=
{ inv_of := ⅟r,
  inv_of_mul_self := by rw [hs, inv_of_mul_self],
  mul_inv_of_self := by rw [hs, mul_inv_of_self] }

/-- An `invertible` element is a unit. -/
@[simps]
def unit_of_invertible [monoid α] (a : α) [invertible a] : units α :=
{ val     := a,
  inv     := ⅟a,
  val_inv := by simp,
  inv_val := by simp, }

lemma is_unit_of_invertible [monoid α] (a : α) [invertible a] : is_unit a :=
⟨unit_of_invertible a, rfl⟩

/-- Units are invertible in their associated monoid. -/
def units.invertible [monoid α] (u : units α) : invertible (u : α) :=
{ inv_of := ↑(u⁻¹), inv_of_mul_self := u.inv_mul, mul_inv_of_self := u.mul_inv }

@[simp] lemma inv_of_units [monoid α] (u : units α) [invertible (u : α)] : ⅟(u : α) = ↑(u⁻¹) :=
inv_of_eq_right_inv u.mul_inv

lemma is_unit.nonempty_invertible [monoid α] {a : α} (h : is_unit a) : nonempty (invertible a) :=
let ⟨x, hx⟩ := h in ⟨x.invertible.copy _ hx.symm⟩

/-- Convert `is_unit` to `invertible` using `classical.choice`.

Prefer `casesI h.nonempty_invertible` over `letI := h.invertible` if you want to avoid choice. -/
noncomputable def is_unit.invertible [monoid α] {a : α} (h : is_unit a) : invertible a :=
classical.choice h.nonempty_invertible

@[simp]
lemma nonempty_invertible_iff_is_unit [monoid α] (a : α) :
  nonempty (invertible a) ↔ is_unit a :=
⟨nonempty.rec $ @is_unit_of_invertible _ _ _, is_unit.nonempty_invertible⟩

/-- Each element of a group is invertible. -/
def invertible_of_group [group α] (a : α) : invertible a :=
⟨a⁻¹, inv_mul_self a, mul_inv_self a⟩

@[simp] lemma inv_of_eq_group_inv [group α] (a : α) [invertible a] : ⅟a = a⁻¹ :=
inv_of_eq_right_inv (mul_inv_self a)

/-- `1` is the inverse of itself -/
def invertible_one [monoid α] : invertible (1 : α) :=
⟨1, mul_one _, one_mul _⟩

@[simp] lemma inv_of_one [monoid α] [invertible (1 : α)] : ⅟(1 : α) = 1 :=
inv_of_eq_right_inv (mul_one _)

/-- `-⅟a` is the inverse of `-a` -/
def invertible_neg [ring α] (a : α) [invertible a] : invertible (-a) :=
⟨ -⅟a, by simp, by simp ⟩

@[simp] lemma inv_of_neg [ring α] (a : α) [invertible a] [invertible (-a)] : ⅟(-a) = -⅟a :=
inv_of_eq_right_inv (by simp)

@[simp] lemma one_sub_inv_of_two [ring α] [invertible (2:α)] : 1 - (⅟2:α) = ⅟2 :=
(is_unit_of_invertible (2:α)).mul_right_inj.1 $
  by rw [mul_sub, mul_inv_of_self, mul_one, bit0, add_sub_cancel]

/-- `a` is the inverse of `⅟a`. -/
instance invertible_inv_of [has_one α] [has_mul α] {a : α} [invertible a] : invertible (⅟a) :=
⟨ a, mul_inv_of_self a, inv_of_mul_self a ⟩

@[simp] lemma inv_of_inv_of [monoid α] {a : α} [invertible a] [invertible (⅟a)] :
  ⅟(⅟a) = a :=
inv_of_eq_right_inv (inv_of_mul_self _)

/-- `⅟b * ⅟a` is the inverse of `a * b` -/
def invertible_mul [monoid α] (a b : α) [invertible a] [invertible b] : invertible (a * b) :=
⟨ ⅟b * ⅟a, by simp [←mul_assoc], by simp [←mul_assoc] ⟩

@[simp]
lemma inv_of_mul [monoid α] (a b : α) [invertible a] [invertible b] [invertible (a * b)] :
  ⅟(a * b) = ⅟b * ⅟a :=
inv_of_eq_right_inv (by simp [←mul_assoc])

theorem commute.inv_of_right [monoid α] {a b : α} [invertible b] (h : commute a b) :
  commute a (⅟b) :=
calc a * (⅟b) = (⅟b) * (b * a * (⅟b)) : by simp [mul_assoc]
... = (⅟b) * (a * b * ((⅟b))) : by rw h.eq
... = (⅟b) * a : by simp [mul_assoc]

theorem commute.inv_of_left [monoid α] {a b : α} [invertible b] (h : commute b a) :
  commute (⅟b) a :=
calc (⅟b) * a = (⅟b) * (a * b * (⅟b)) : by simp [mul_assoc]
... = (⅟b) * (b * a * (⅟b)) : by rw h.eq
... = a * (⅟b) : by simp [mul_assoc]

lemma commute_inv_of {M : Type*} [has_one M] [has_mul M] (m : M) [invertible m] :
  commute m (⅟m) :=
calc m * ⅟m = 1       : mul_inv_of_self m
        ... = ⅟ m * m : (inv_of_mul_self m).symm

section monoid_with_zero
variable [monoid_with_zero α]

/-- A variant of `ring.inverse_unit`. -/
@[simp] lemma ring.inverse_invertible (x : α) [invertible x] : ring.inverse x = ⅟x :=
ring.inverse_unit (unit_of_invertible _)

end monoid_with_zero

section group_with_zero

variable [group_with_zero α]

lemma nonzero_of_invertible (a : α) [invertible a] : a ≠ 0 :=
λ ha, zero_ne_one $ calc   0 = ⅟a * a : by simp [ha]
                         ... = 1 : inv_of_mul_self a

/-- `a⁻¹` is an inverse of `a` if `a ≠ 0` -/
def invertible_of_nonzero {a : α} (h : a ≠ 0) : invertible a :=
⟨ a⁻¹, inv_mul_cancel h, mul_inv_cancel h ⟩

@[simp] lemma inv_of_eq_inv (a : α) [invertible a] : ⅟a = a⁻¹ :=
inv_of_eq_right_inv (mul_inv_cancel (nonzero_of_invertible a))

@[simp] lemma inv_mul_cancel_of_invertible (a : α) [invertible a] : a⁻¹ * a = 1 :=
inv_mul_cancel (nonzero_of_invertible a)

@[simp] lemma mul_inv_cancel_of_invertible (a : α) [invertible a] : a * a⁻¹ = 1 :=
mul_inv_cancel (nonzero_of_invertible a)

@[simp] lemma div_mul_cancel_of_invertible (a b : α) [invertible b] : a / b * b = a :=
div_mul_cancel a (nonzero_of_invertible b)

@[simp] lemma mul_div_cancel_of_invertible (a b : α) [invertible b] : a * b / b = a :=
mul_div_cancel a (nonzero_of_invertible b)

@[simp] lemma div_self_of_invertible (a : α) [invertible a] : a / a = 1 :=
div_self (nonzero_of_invertible a)

/-- `b / a` is the inverse of `a / b` -/
def invertible_div (a b : α) [invertible a] [invertible b] : invertible (a / b) :=
⟨b / a, by simp [←mul_div_assoc], by simp [←mul_div_assoc]⟩

@[simp] lemma inv_of_div (a b : α) [invertible a] [invertible b] [invertible (a / b)] :
  ⅟(a / b) = b / a :=
inv_of_eq_right_inv (by simp [←mul_div_assoc])

/-- `a` is the inverse of `a⁻¹` -/
def invertible_inv {a : α} [invertible a] : invertible (a⁻¹) :=
⟨ a, by simp, by simp ⟩

end group_with_zero

/--
Monoid homs preserve invertibility.
-/
def invertible.map {R : Type*} {S : Type*} [monoid R] [monoid S] (f : R →* S)
  (r : R) [invertible r] :
  invertible (f r) :=
{ inv_of := f (⅟r),
  inv_of_mul_self := by rw [← f.map_mul, inv_of_mul_self, f.map_one],
  mul_inv_of_self := by rw [← f.map_mul, mul_inv_of_self, f.map_one] }


-- ==================== Syntax ====================

def loc := string

inductive aexp : Type
| Lookup : loc -> aexp
| Int : int -> aexp
| Plus : aexp -> aexp -> aexp
| Minus : aexp -> aexp -> aexp
| Times : aexp -> aexp -> aexp

inductive bexp : Type
| Bool : bool -> bexp
| Equal : aexp -> aexp -> bexp
| Less : aexp -> aexp -> bexp
| Greater : aexp -> aexp -> bexp

inductive cmd : Type
| Assign : loc -> aexp -> cmd
| IfThenElse  : bexp -> cmd -> cmd -> cmd
| Seq : cmd -> cmd -> cmd
| Skip : cmd
| WhileDo : bexp -> cmd -> cmd

-- ================== Example 'fact.imp' in LEAN notation. ==================

def fact : cmd :=
  cmd.Seq
    (cmd.Seq
      (cmd.Assign "n" (aexp.Int 10))
      (cmd.Assign "fact" (aexp.Int 10)) )
    (cmd.WhileDo
      (bexp.Greater
        (aexp.Lookup "n")
        (aexp.Int 0) )
      (cmd.Seq
        (cmd.Assign "fact"
          (aexp.Times (aexp.Lookup "fact") (aexp.Lookup "n")) )
        (cmd.Assign "n"
          (aexp.Minus (aexp.Lookup "n") (aexp.Int 1)) ) ) )

-- ==================== Environment ====================

inductive env : Type
| Nil : env
| Cons : loc -> int -> env -> env

inductive lookup : loc -> env -> int -> Prop
| Find {loc i E} :
    lookup loc (env.Cons loc i E) i
| Search {loc loc' i' E' i} :
    loc≠loc' -> lookup loc E' i ->
    lookup loc (env.Cons loc' i' E') i

-- ==================== Operational Semantics ====================

inductive aeval : env -> aexp -> int -> Prop
| Lookup {E loc i} :
    lookup loc E i ->
    aeval E (aexp.Lookup loc) i
| Int {E i} :
    aeval E (aexp.Int i) i
| Plus {E a1 a2 i1 i2} :
    aeval E a1 i1 -> aeval E a2 i2 ->
    aeval E (aexp.Plus a1 a2) (i1 + i2)
| Minus {E a1 a2 i1 i2} :
    aeval E a1 i1 -> aeval E a2 i2 ->
    aeval E (aexp.Minus a1 a2) (i1 - i2)
| Times {E a1 a2 i1 i2} :
    aeval E a1 i1 -> aeval E a2 i2 ->
    aeval E (aexp.Times a1 a2) (i1 * i2)

-- Lean works best with '<' and '≤' so we use them to encode '>' and '≥'.
inductive beval : env -> bexp -> bool -> Prop
| Bool {E b} :
    beval E (bexp.Bool b) b
| Equal_t {E a1 a2 i1 i2}:
    aeval E a1 i1 -> aeval E a2 i2 -> i1 = i2 ->
    beval E (bexp.Equal a1 a2) true
| Equal_f {E a1 a2 i1 i2}:
    aeval E a1 i1 -> aeval E a2 i2 -> i1 ≠ i2 ->
    beval E (bexp.Equal a1 a2) false
| Less_t {E a1 a2 i1 i2}:
    aeval E a1 i1 -> aeval E a2 i2 -> i1 < i2 ->
    beval E (bexp.Less a1 a2) true
| Less_f {E a1 a2 i1 i2}:
    aeval E a1 i1 -> aeval E a2 i2 -> ¬ i1 < i2 ->
    beval E (bexp.Less a1 a2) false
| Greater_t {E a1 a2 i1 i2}:
    aeval E a1 i1 -> aeval E a2 i2 -> ¬ i1 ≤ i2 ->
    beval E (bexp.Greater a1 a2) true
| Greater_f {E a1 a2 i1 i2}:
    aeval E a1 i1 -> aeval E a2 i2 -> i1 ≤ i2 ->
    beval E (bexp.Greater a1 a2) false

inductive ceval : env -> cmd -> env -> Prop
| Assign {loc a i E} :
    aeval E a i ->
    ceval E (cmd.Assign loc a) (env.Cons loc i E)
| IfThenElse_t {E b c1 c2 M'} :
    beval E b true -> ceval E c1 M' ->
    ceval E (cmd.IfThenElse b c1 c2) M'
| IfThenElse_f {E b c1 c2 E'} :
    beval E b false -> ceval E c2 E' ->
    ceval E (cmd.IfThenElse b c1 c2) E'
| Seq {E c1 E' c2 E''} :
    ceval E c1 E' -> ceval E' c2 E'' ->
    ceval E (cmd.Seq c1 c2) E''
| Skip {E} :
    ceval E cmd.Skip E
| WhileDo_t {E b c E' E''} :
    beval E b true -> ceval E c E' ->
    ceval E' (cmd.WhileDo b c) E'' ->
    ceval E (cmd.WhileDo b c) E''
| WhileDo_f {E b c} :
    beval E b false ->
    ceval E (cmd.WhileDo b c) E

-- ==================== Safety ====================

-- Contains all the names of already assigned locations.
inductive locs : Type
| Nil : locs
| Cons : loc -> locs -> locs

inductive loc_safe : loc -> locs -> Prop
| Find {loc L} :
    loc_safe loc (locs.Cons loc L)
| Search {loc loc' L} :
    loc'≠loc -> loc_safe loc L ->
    loc_safe loc (locs.Cons loc' L)

inductive asafe : locs -> aexp -> Prop
| Lookup {L loc}:
    loc_safe loc L -> asafe L (aexp.Lookup loc)
| Int {L i}:
    asafe L (aexp.Int i)
| Plus {L a1 a2} :
    asafe L a1 -> asafe L a2 ->
    asafe L (aexp.Plus a1 a2)
| Minus {L a1 a2} :
    asafe L a1 -> asafe L a2 ->
    asafe L (aexp.Minus a1 a2)
| Times {L a1 a2} :
    asafe L a1 -> asafe L a2 ->
    asafe L (aexp.Times a1 a2)

inductive bsafe : locs -> bexp -> Prop
| Bool {L b} :
    bsafe L (bexp.Bool b)
| Equal {L a1 a2} :
    asafe L a1 -> asafe L a2 ->
    bsafe L (bexp.Equal a1 a2)
| Less {L a1 a2} :
    asafe L a1 -> asafe L a2 ->
    bsafe L (bexp.Less a1 a2)
| Greater {L a1 a2} :
    asafe L a1 -> asafe L a2 ->
    bsafe L (bexp.Greater a1 a2)

inductive csafe : locs -> cmd -> locs -> Prop
| Assign {L loc a} :
    asafe L a ->
    csafe L (cmd.Assign loc a) (locs.Cons loc L)
-- | IfThenElse {L b c1 c2} :
--     bsafe L b -> csafe L c1 L' -> csafe L c2 L'' ->
-- Note: This part requires a definition of locs intersection.
| Seq {L c1 L' c2 L''} :
    csafe L c1 L' -> csafe L' c2 L'' ->
    csafe L (cmd.Seq c1 c2) L''
| Skip {L} :
    csafe L cmd.Skip L
| WhileDo {L b c L'} :
    bsafe L b -> csafe L c L' ->
    csafe L (cmd.WhileDo b c) L'

-- ==================== Auxiliary safety for lookup ====================

-- Proves that the given environment maps all the required locations.
inductive env_maps : env -> locs -> Prop
| Nil {E} :
    env_maps E locs.Nil
| Cons {loc E L} :
    env_maps E L -> (∃i, lookup loc E i) ->
    env_maps E (locs.Cons loc L)

-- Increasing the environment does not break its safety.
theorem env_maps_weaken {E L loc i}:
  env_maps E L -> env_maps (env.Cons loc i E) L
:=
begin
  intro es, induction es with E' loc' E' L' maps finds ih,
  apply env_maps.Nil,
  apply env_maps.Cons, assumption,
  -- we compare the the strings to know which lookup result is correct
  cases string.has_decidable_eq loc' loc with neq eq,
  { cases finds with i', existsi i',
    apply lookup.Search, assumption, assumption, },
  existsi i, subst eq, apply lookup.Find,
end

-- If the location is safe in the same specification as the environment
-- then we are guaranteed to look up a value
theorem safe_lookup {L E loc}:
  loc_safe loc L -> env_maps E L -> ∃ (i:int), lookup loc E i
:=
begin
  intros sloc es,
  induction es with E' loc' E' L' maps finds ih,
  { cases sloc, },
  cases sloc, assumption, apply ih, assumption,
end

-- ==================== Safety theorems ====================

theorem asafety {L E a}:
  asafe L a -> env_maps E L -> ∃ (i:int), aeval E a i
:=
begin
  intros s es,
  induction s,
  case asafe.Lookup
    { cases safe_lookup s_a es,
      existsi w, apply aeval.Lookup, assumption, },
  case asafe.Int
    { existsi s_i, apply aeval.Int, },
  case asafe.Plus
    { cases s_ih_a es with i1,
      cases s_ih_a_1 es with i2,
      existsi (i1+i2), apply aeval.Plus,
      assumption, assumption },
  case asafe.Minus
    { cases s_ih_a es with i1,
      cases s_ih_a_1 es with i2,
      existsi (i1-i2), apply aeval.Minus,
      assumption, assumption },
  case asafe.Times
    { cases s_ih_a es with i1,
      cases s_ih_a_1 es with i2,
      existsi (i1*i2), apply aeval.Times,
      assumption, assumption },
end

theorem bsafety {L E b}:
  bsafe L b -> env_maps E L -> ∃ (v:bool), beval E b v
:=
begin
  intros s es,
  induction s,
  case bsafe.Bool
    { existsi s_b, apply beval.Bool, },
  case bsafe.Equal
    { cases asafety s_a es with i1,
      cases asafety s_a_1 es with i2,
      cases int.decidable_eq i1 i2 with neq eq,
      -- i1 ≠ i2
      { existsi (false:bool), apply beval.Equal_f,
        assumption, assumption, assumption,},
      -- i1 = i2
      { existsi (true:bool), apply beval.Equal_t,
        assumption, assumption, assumption,}, },
  case bsafe.Less
    { cases asafety s_a es with i1,
      cases asafety s_a_1 es with i2,
      cases int.decidable_lt i1 i2 with neq eq,
      -- i1 ≰ i2
      { existsi (false:bool), apply beval.Less_f,
        assumption, assumption, assumption,},
      -- i1 < i2
      { existsi (true:bool), apply beval.Less_t,
        assumption, assumption, assumption,}, },
  case bsafe.Greater
    { cases asafety s_a es with i1,
      cases asafety s_a_1 es with i2,
      cases int.decidable_le i1 i2 with neq eq,
      -- i > i2
      { existsi (true:bool), apply beval.Greater_t,
        assumption, assumption, assumption,},
      -- i ≱ i2
      { existsi (false:bool), apply beval.Greater_f,
        assumption, assumption, assumption,}, },
end

theorem csafety {L L' E c }:
  csafe L c L' -> env_maps E L -> ∃ (E':env), ceval E c E' ∧ env_maps E' L'
:=
begin
  intros s, revert E,
  induction s; intros E es,
  case csafe.Assign
    { cases asafety s_a_1 es with i,
      existsi (env.Cons s_loc i E),
      constructor,
      { apply ceval.Assign, assumption, },
      apply env_maps.Cons,
      { apply env_maps_weaken, assumption, },
      existsi i, apply lookup.Find, },
  case csafe.Seq
    { cases (s_ih_a es) with E',
      destruct h, intros c1s es',
      cases (s_ih_a_1 es') with E'',
      destruct h_1, intros c2s es'',
      existsi E'', constructor,
      { apply ceval.Seq, assumption, assumption, },
      assumption, },
  case csafe.Skip
    { existsi E, constructor, apply ceval.Skip, assumption, },
  case csafe.WhileDo
    {
      -- this part can't really be done in big step semantics
      cases (s_ih es) with E',
      destruct h, intros csafe es',
      cases bsafety s_a es,
      cases w,
      { existsi E, constructor,
        apply ceval.WhileDo_f,
        assumption, sorry, },
      { existsi E', constructor,
        apply ceval.WhileDo_t,
        assumption, assumption,
        sorry, sorry, }
      },
end


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import measure_theory.function.continuous_map_dense
import measure_theory.function.l2_space
import measure_theory.measure.haar
import analysis.complex.circle
import topology.metric_space.emetric_paracompact
import topology.continuous_function.stone_weierstrass

/-!

# Fourier analysis on the circle

This file contains basic technical results for a development of Fourier series.

## Main definitions

* `haar_circle`, Haar measure on the circle, normalized to have total measure `1`
* instances `measure_space`, `is_probability_measure` for the circle with respect to this measure
* for `n : ℤ`, `fourier n` is the monomial `λ z, z ^ n`, bundled as a continuous map from `circle`
  to `ℂ`
* for `n : ℤ` and `p : ℝ≥0∞`, `fourier_Lp p n` is an abbreviation for the monomial `fourier n`
  considered as an element of the Lᵖ-space `Lp ℂ p haar_circle`, via the embedding
  `continuous_map.to_Lp`

## Main statements

The theorem `span_fourier_closure_eq_top` states that the span of the monomials `fourier n` is
dense in `C(circle, ℂ)`, i.e. that its `submodule.topological_closure` is `⊤`.  This follows from
the Stone-Weierstrass theorem after checking that it is a subalgebra, closed under conjugation, and
separates points.

The theorem `span_fourier_Lp_closure_eq_top` states that for `1 ≤ p < ∞` the span of the monomials
`fourier_Lp` is dense in `Lp ℂ p haar_circle`, i.e. that its `submodule.topological_closure` is
`⊤`.  This follows from the previous theorem using general theory on approximation of Lᵖ functions
by continuous functions.

The theorem `orthonormal_fourier` states that the monomials `fourier_Lp 2 n` form an orthonormal
set (in the L² space of the circle).

By definition, a Hilbert basis for an inner product space is an orthonormal set whose span is
dense.  Thus, the last two results together establish that the functions `fourier_Lp 2 n` form a
Hilbert basis for L².

## TODO

Once mathlib has general theory showing that a Hilbert basis of an inner product space induces a
unitary equivalence with L², the results in this file will give Fourier series applications such
as Parseval's formula.

-/

noncomputable theory
open_locale ennreal complex_conjugate
open topological_space continuous_map measure_theory measure_theory.measure algebra submodule set

local attribute [instance] fact_one_le_two_ennreal

/-! ### Choice of measure on the circle -/

section haar_circle
/-! We make the circle into a measure space, using the Haar measure normalized to have total
measure 1. -/

instance : measurable_space circle := borel circle
instance : borel_space circle := ⟨rfl⟩

/-- Haar measure on the circle, normalized to have total measure 1. -/
def haar_circle : measure circle := haar_measure positive_compacts_univ

instance : is_probability_measure haar_circle := ⟨haar_measure_self⟩

instance : measure_space circle :=
{ volume := haar_circle,
  .. circle.measurable_space }

end haar_circle

/-! ### Monomials on the circle -/

section fourier

/-- The family of monomials `λ z, z ^ n`, parametrized by `n : ℤ` and considered as bundled
continuous maps from `circle` to `ℂ`. -/
@[simps] def fourier (n : ℤ) : C(circle, ℂ) :=
{ to_fun := λ z, z ^ n,
  continuous_to_fun := continuous_subtype_coe.zpow n $ λ z, or.inl (nonzero_of_mem_circle z) }

@[simp] lemma fourier_zero {z : circle} : fourier 0 z = 1 := rfl

@[simp] lemma fourier_neg {n : ℤ} {z : circle} : fourier (-n) z = conj (fourier n z) :=
by simp [← coe_inv_circle_eq_conj z]

@[simp] lemma fourier_add {m n : ℤ} {z : circle} :
  fourier (m + n) z = (fourier m z) * (fourier n z) :=
by simp [zpow_add₀ (nonzero_of_mem_circle z)]

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ`; equivalently, polynomials in
`z` and `conj z`. -/
def fourier_subalgebra : subalgebra ℂ C(circle, ℂ) := algebra.adjoin ℂ (range fourier)

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is in fact the linear span of
these functions. -/
lemma fourier_subalgebra_coe : fourier_subalgebra.to_submodule = span ℂ (range fourier) :=
begin
  apply adjoin_eq_span_of_subset,
  refine subset.trans _ submodule.subset_span,
  intros x hx,
  apply submonoid.closure_induction hx (λ _, id) ⟨0, rfl⟩,
  rintros _ _ ⟨m, rfl⟩ ⟨n, rfl⟩,
  refine ⟨m + n, _⟩,
  ext1 z,
  exact fourier_add,
end

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` separates points. -/
lemma fourier_subalgebra_separates_points : fourier_subalgebra.separates_points :=
begin
  intros x y hxy,
  refine ⟨_, ⟨fourier 1, _, rfl⟩, _⟩,
  { exact subset_adjoin ⟨1, rfl⟩ },
  { simp [hxy] }
end

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is invariant under complex
conjugation. -/
lemma fourier_subalgebra_conj_invariant :
  conj_invariant_subalgebra (fourier_subalgebra.restrict_scalars ℝ) :=
begin
  rintros _ ⟨f, hf, rfl⟩,
  change _ ∈ fourier_subalgebra,
  change _ ∈ fourier_subalgebra at hf,
  apply adjoin_induction hf,
  { rintros _ ⟨n, rfl⟩,
    suffices : fourier (-n) ∈ fourier_subalgebra,
    { convert this,
      ext1,
      simp },
    exact subset_adjoin ⟨-n, rfl⟩ },
  { intros c,
    exact fourier_subalgebra.algebra_map_mem (conj c) },
  { intros f g hf hg,
    convert fourier_subalgebra.add_mem hf hg,
    exact alg_hom.map_add _ f g, },
  { intros f g hf hg,
    convert fourier_subalgebra.mul_mem hf hg,
    exact alg_hom.map_mul _ f g, }
end

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is dense. -/
lemma fourier_subalgebra_closure_eq_top : fourier_subalgebra.topological_closure = ⊤ :=
continuous_map.subalgebra_complex_topological_closure_eq_top_of_separates_points
  fourier_subalgebra
  fourier_subalgebra_separates_points
  fourier_subalgebra_conj_invariant

/-- The linear span of the monomials `z ^ n` is dense in `C(circle, ℂ)`. -/
lemma span_fourier_closure_eq_top : (span ℂ (range fourier)).topological_closure = ⊤ :=
begin
  rw ← fourier_subalgebra_coe,
  exact congr_arg subalgebra.to_submodule fourier_subalgebra_closure_eq_top,
end

/-- The family of monomials `λ z, z ^ n`, parametrized by `n : ℤ` and considered as elements of
the `Lp` space of functions on `circle` taking values in `ℂ`. -/
abbreviation fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) : Lp ℂ p haar_circle :=
to_Lp p haar_circle ℂ (fourier n)

/-- For each `1 ≤ p < ∞`, the linear span of the monomials `z ^ n` is dense in
`Lp ℂ p haar_circle`. -/
lemma span_fourier_Lp_closure_eq_top {p : ℝ≥0∞} [fact (1 ≤ p)] (hp : p ≠ ∞) :
  (span ℂ (range (fourier_Lp p))).topological_closure = ⊤ :=
begin
  convert (continuous_map.to_Lp_dense_range ℂ hp haar_circle ℂ).topological_closure_map_submodule
    span_fourier_closure_eq_top,
  rw [map_span, range_comp],
  simp
end

/-- For `n ≠ 0`, a rotation by `n⁻¹ * real.pi` negates the monomial `z ^ n`. -/
lemma fourier_add_half_inv_index {n : ℤ} (hn : n ≠ 0) (z : circle) :
  fourier n ((exp_map_circle (n⁻¹ * real.pi) * z)) = - fourier n z :=
begin
  have : ↑n * ((↑n)⁻¹ * ↑real.pi * complex.I) = ↑real.pi * complex.I,
  { have : (n:ℂ) ≠ 0 := by exact_mod_cast hn,
    field_simp,
    ring },
  simp [mul_zpow₀, ← complex.exp_int_mul, complex.exp_pi_mul_I, this]
end

/-- The monomials `z ^ n` are an orthonormal set with respect to Haar measure on the circle. -/
lemma orthonormal_fourier : orthonormal ℂ (fourier_Lp 2) :=
begin
  rw orthonormal_iff_ite,
  intros i j,
  rw continuous_map.inner_to_Lp haar_circle (fourier i) (fourier j),
  split_ifs,
  { simp [h, is_probability_measure.measure_univ, ← fourier_neg, ← fourier_add, -fourier_to_fun] },
  simp only [← fourier_add, ← fourier_neg],
  have hij : -i + j ≠ 0,
  { rw add_comm,
    exact sub_ne_zero.mpr (ne.symm h) },
  exact integral_zero_of_mul_left_eq_neg (is_mul_left_invariant_haar_measure _)
    (fourier_add_half_inv_index hij)
end

end fourier


import Aesop

variable [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)]

@[aesop safe constructors]
inductive Sorted : List α → Prop where
  | nil : Sorted []
  | single : Sorted [x]
  | cons_cons : x ≤ x' → Sorted (x' :: xs) → Sorted (x :: x' :: xs)

@[simp] def insertInOrder (a : α) : List α → List α
  | [] => [a]
  | x :: xs =>
    if a ≤ x then
      a :: x :: xs
    else
      x :: insertInOrder a xs

@[simp] def insertionSort : List α → List α
  | []      => []
  | x :: xs => insertInOrder x (insertionSort xs)

variable (antisymm : ∀ {x y : α}, ¬ (x ≤ y) → y ≤ x)

theorem sorted_insertInOrder {xs : List α} (h : Sorted xs) : Sorted (insertInOrder x xs) := by
  induction h <;> aesop

theorem sorted_insertionSort {xs : List α} : Sorted (insertionSort xs) := by
  induction xs <;> aesop (add safe sorted_insertInOrder)

inductive Perm : List α → List α → Prop where
  | nil : Perm [] []
  | cons : Perm xs xs' → Perm (x :: xs) (x :: xs')
  | swap : Perm (x :: y :: xs) (y :: x :: xs)
  | trans : Perm xs ys → Perm ys zs → Perm xs zs

attribute [aesop safe] Perm.nil
attribute [aesop unsafe] Perm.cons
attribute [aesop unsafe] Perm.swap
attribute [aesop unsafe] Perm.trans

theorem Perm.symm : Perm xs ys → Perm ys xs := by
  intro h
  induction h <;> aesop

@[aesop safe]
theorem perm_insertInOrder {xs : List α} : Perm (x :: xs) (insertInOrder x xs) := by
  induction xs <;> aesop

theorem perm_insertionSort {xs : List α} : Perm xs (insertionSort xs) := by
  induction xs with
  | nil => aesop
  | cons x xs =>
    cases xs with
    | nil => aesop
    | cons x' xs =>
      apply Perm.trans (ys := x :: insertInOrder x' xs)
      · exact Perm.cons perm_insertInOrder
      · apply Perm.trans (ys := x :: insertionSort (x' :: xs))
        · aesop (add safe Perm.cons, unsafe [cases List, Perm.symm])
        · aesop

def IsSortingAlgorithm (f : List α → List α) := ∀ xs, Perm xs (f xs) ∧ Sorted (f xs)

theorem isSortingAlgorithm_insertionSort : IsSortingAlgorithm (insertionSort (α := α)) :=
  fun _xs => ⟨perm_insertionSort, sorted_insertionSort @antisymm⟩


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

! This file was ported from Lean 3 source module linear_algebra.matrix.mv_polynomial
! leanprover-community/mathlib commit bdcb7310db0fbc0e55dc1897bea76448733b7810
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.Determinant
import Mathbin.Data.MvPolynomial.Basic
import Mathbin.Data.MvPolynomial.CommRing

/-!
# Matrices of multivariate polynomials

In this file, we prove results about matrices over an mv_polynomial ring.
In particular, we provide `matrix.mv_polynomial_X` which associates every entry of a matrix with a
unique variable.

## Tags

matrix determinant, multivariate polynomial
-/

variable {m n R S : Type _}

namespace Matrix

variable (m n R)

/-- The matrix with variable `X (i,j)` at location `(i,j)`. -/
@[simp]
noncomputable def mvPolynomialX [CommSemiring R] : Matrix m n (MvPolynomial (m × n) R)
  | i, j => MvPolynomial.X (i, j)
#align matrix.mv_polynomial_X Matrix.mvPolynomialX

variable {m n R S}

/-- Any matrix `A` can be expressed as the evaluation of `matrix.mv_polynomial_X`.

This is of particular use when `mv_polynomial (m × n) R` is an integral domain but `S` is
not, as if the `mv_polynomial.eval₂` can be pulled to the outside of a goal, it can be solved in
under cancellative assumptions. -/
theorem mvPolynomialX_map_eval₂ [CommSemiring R] [CommSemiring S] (f : R →+* S) (A : Matrix m n S) :
    (mvPolynomialX m n R).map (MvPolynomial.eval₂ f fun p : m × n => A p.1 p.2) = A :=
  ext fun i j => MvPolynomial.eval₂_X _ (fun p : m × n => A p.1 p.2) (i, j)
#align matrix.mv_polynomial_X_map_eval₂ Matrix.mvPolynomialX_map_eval₂

/-- A variant of `matrix.mv_polynomial_X_map_eval₂` with a bundled `ring_hom` on the LHS. -/
theorem mvPolynomialX_mapMatrix_eval [Fintype m] [DecidableEq m] [CommSemiring R]
    (A : Matrix m m R) :
    (MvPolynomial.eval fun p : m × m => A p.1 p.2).mapMatrix (mvPolynomialX m m R) = A :=
  mvPolynomialX_map_eval₂ _ A
#align matrix.mv_polynomial_X_map_matrix_eval Matrix.mvPolynomialX_mapMatrix_eval

variable (R)

/-- A variant of `matrix.mv_polynomial_X_map_eval₂` with a bundled `alg_hom` on the LHS. -/
theorem mvPolynomialX_mapMatrix_aeval [Fintype m] [DecidableEq m] [CommSemiring R] [CommSemiring S]
    [Algebra R S] (A : Matrix m m S) :
    (MvPolynomial.aeval fun p : m × m => A p.1 p.2).mapMatrix (mvPolynomialX m m R) = A :=
  mvPolynomialX_map_eval₂ _ A
#align matrix.mv_polynomial_X_map_matrix_aeval Matrix.mvPolynomialX_mapMatrix_aeval

variable (m R)

/-- In a nontrivial ring, `matrix.mv_polynomial_X m m R` has non-zero determinant. -/
theorem det_mvPolynomialX_ne_zero [DecidableEq m] [Fintype m] [CommRing R] [Nontrivial R] :
    det (mvPolynomialX m m R) ≠ 0 := by
  intro h_det
  have := congr_arg Matrix.det (mv_polynomial_X_map_matrix_eval (1 : Matrix m m R))
  rw [det_one, ← RingHom.map_det, h_det, RingHom.map_zero] at this
  exact zero_ne_one this
#align matrix.det_mv_polynomial_X_ne_zero Matrix.det_mvPolynomialX_ne_zero

end Matrix


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

! This file was ported from Lean 3 source module data.bool.count
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Parity
import Mathbin.Data.List.Chain

/-!
# List of booleans

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

In this file we prove lemmas about the number of `ff`s and `tt`s in a list of booleans. First we
prove that the number of `ff`s plus the number of `tt` equals the length of the list. Then we prove
that in a list with alternating `tt`s and `ff`s, the number of `tt`s differs from the number of
`ff`s by at most one. We provide several versions of these statements.
-/

namespace List

#print List.count_not_add_count /-
@[simp]
theorem count_not_add_count (l : List Bool) (b : Bool) : count (!b) l + count b l = length l := by
  simp only [length_eq_countp_add_countp (Eq (!b)), Bool.not_not_eq, count]
#align list.count_bnot_add_count List.count_not_add_count
-/

#print List.count_add_count_not /-
@[simp]
theorem count_add_count_not (l : List Bool) (b : Bool) : count b l + count (!b) l = length l := by
  rw [add_comm, count_bnot_add_count]
#align list.count_add_count_bnot List.count_add_count_not
-/

#print List.count_false_add_count_true /-
@[simp]
theorem count_false_add_count_true (l : List Bool) : count false l + count true l = length l :=
  count_not_add_count l true
#align list.count_ff_add_count_tt List.count_false_add_count_true
-/

#print List.count_true_add_count_false /-
@[simp]
theorem count_true_add_count_false (l : List Bool) : count true l + count false l = length l :=
  count_not_add_count l false
#align list.count_tt_add_count_ff List.count_true_add_count_false
-/

#print List.Chain.count_not /-
theorem Chain.count_not :
    ∀ {b : Bool} {l : List Bool}, Chain (· ≠ ·) b l → count (!b) l = count b l + length l % 2
  | b, [], h => rfl
  | b, x :: l, h =>
    by
    obtain rfl : b = !x := Bool.eq_not_iff.2 (rel_of_chain_cons h)
    rw [Bool.not_not, count_cons_self, count_cons_of_ne x.bnot_ne_self,
      chain.count_bnot (chain_of_chain_cons h), length, add_assoc, Nat.mod_two_add_succ_mod_two]
#align list.chain.count_bnot List.Chain.count_not
-/

namespace Chain'

variable {l : List Bool}

#print List.Chain'.count_not_eq_count /-
theorem count_not_eq_count (hl : Chain' (· ≠ ·) l) (h2 : Even (length l)) (b : Bool) :
    count (!b) l = count b l := by
  cases' l with x l
  · rfl
  rw [length_cons, Nat.even_add_one, Nat.not_even_iff] at h2
  suffices count (!x) (x :: l) = count x (x :: l) by
    cases b <;> cases x <;> try exact this <;> exact this.symm
  rw [count_cons_of_ne x.bnot_ne_self, hl.count_bnot, h2, count_cons_self]
#align list.chain'.count_bnot_eq_count List.Chain'.count_not_eq_count
-/

#print List.Chain'.count_false_eq_count_true /-
theorem count_false_eq_count_true (hl : Chain' (· ≠ ·) l) (h2 : Even (length l)) :
    count false l = count true l :=
  hl.count_not_eq_count h2 true
#align list.chain'.count_ff_eq_count_tt List.Chain'.count_false_eq_count_true
-/

#print List.Chain'.count_not_le_count_add_one /-
theorem count_not_le_count_add_one (hl : Chain' (· ≠ ·) l) (b : Bool) :
    count (!b) l ≤ count b l + 1 := by
  cases' l with x l
  · exact zero_le _
  obtain rfl | rfl : b = x ∨ b = !x := by simp only [Bool.eq_not_iff, em]
  · rw [count_cons_of_ne b.bnot_ne_self, count_cons_self, hl.count_bnot, add_assoc]
    exact add_le_add_left (Nat.mod_lt _ two_pos).le _
  · rw [Bool.not_not, count_cons_self, count_cons_of_ne x.bnot_ne_self, hl.count_bnot]
    exact add_le_add_right (le_add_right le_rfl) _
#align list.chain'.count_bnot_le_count_add_one List.Chain'.count_not_le_count_add_one
-/

#print List.Chain'.count_false_le_count_true_add_one /-
theorem count_false_le_count_true_add_one (hl : Chain' (· ≠ ·) l) :
    count false l ≤ count true l + 1 :=
  hl.count_not_le_count_add_one true
#align list.chain'.count_ff_le_count_tt_add_one List.Chain'.count_false_le_count_true_add_one
-/

#print List.Chain'.count_true_le_count_false_add_one /-
theorem count_true_le_count_false_add_one (hl : Chain' (· ≠ ·) l) :
    count true l ≤ count false l + 1 :=
  hl.count_not_le_count_add_one false
#align list.chain'.count_tt_le_count_ff_add_one List.Chain'.count_true_le_count_false_add_one
-/

#print List.Chain'.two_mul_count_bool_of_even /-
theorem two_mul_count_bool_of_even (hl : Chain' (· ≠ ·) l) (h2 : Even (length l)) (b : Bool) :
    2 * count b l = length l := by
  rw [← count_bnot_add_count l b, hl.count_bnot_eq_count h2, two_mul]
#align list.chain'.two_mul_count_bool_of_even List.Chain'.two_mul_count_bool_of_even
-/

#print List.Chain'.two_mul_count_bool_eq_ite /-
theorem two_mul_count_bool_eq_ite (hl : Chain' (· ≠ ·) l) (b : Bool) :
    2 * count b l =
      if Even (length l) then length l else if b ∈ l.head? then length l + 1 else length l - 1 :=
  by
  by_cases h2 : Even (length l)
  · rw [if_pos h2, hl.two_mul_count_bool_of_even h2]
  · cases' l with x l
    · exact (h2 even_zero).elim
    simp only [if_neg h2, count_cons', mul_add, head', Option.mem_some_iff, @eq_comm _ x]
    rw [length_cons, Nat.even_add_one, Classical.not_not] at h2
    replace hl : l.chain' (· ≠ ·) := hl.tail
    rw [hl.two_mul_count_bool_of_even h2]
    split_ifs <;> simp
#align list.chain'.two_mul_count_bool_eq_ite List.Chain'.two_mul_count_bool_eq_ite
-/

#print List.Chain'.length_sub_one_le_two_mul_count_bool /-
theorem length_sub_one_le_two_mul_count_bool (hl : Chain' (· ≠ ·) l) (b : Bool) :
    length l - 1 ≤ 2 * count b l :=
  by
  rw [hl.two_mul_count_bool_eq_ite]
  split_ifs <;> simp [le_tsub_add, Nat.le_succ_of_le]
#align list.chain'.length_sub_one_le_two_mul_count_bool List.Chain'.length_sub_one_le_two_mul_count_bool
-/

#print List.Chain'.length_div_two_le_count_bool /-
theorem length_div_two_le_count_bool (hl : Chain' (· ≠ ·) l) (b : Bool) :
    length l / 2 ≤ count b l :=
  by
  rw [Nat.div_le_iff_le_mul_add_pred two_pos, ← tsub_le_iff_right]
  exact length_sub_one_le_two_mul_count_bool hl b
#align list.chain'.length_div_two_le_count_bool List.Chain'.length_div_two_le_count_bool
-/

#print List.Chain'.two_mul_count_bool_le_length_add_one /-
theorem two_mul_count_bool_le_length_add_one (hl : Chain' (· ≠ ·) l) (b : Bool) :
    2 * count b l ≤ length l + 1 :=
  by
  rw [hl.two_mul_count_bool_eq_ite]
  split_ifs <;> simp [Nat.le_succ_of_le]
#align list.chain'.two_mul_count_bool_le_length_add_one List.Chain'.two_mul_count_bool_le_length_add_one
-/

end Chain'

end List


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson

! This file was ported from Lean 3 source module analysis.special_functions.trigonometric.inverse
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Basic
import Mathbin.Topology.Algebra.Order.ProjIcc

/-!
# Inverse trigonometric functions.

See also `analysis.special_functions.trigonometric.arctan` for the inverse tan function.
(This is delayed as it is easier to set up after developing complex trigonometric functions.)

Basic inequalities on trigonometric functions.
-/

noncomputable section

open Classical Topology Filter

open Set Filter

open Real

namespace Real

/-- Inverse of the `sin` function, returns values in the range `-π / 2 ≤ arcsin x ≤ π / 2`.
It defaults to `-π / 2` on `(-∞, -1)` and to `π / 2` to `(1, ∞)`. -/
@[pp_nodot]
noncomputable def arcsin : ℝ → ℝ :=
  coe ∘ IccExtend (neg_le_self zero_le_one) sinOrderIso.symm
#align real.arcsin Real.arcsin

theorem arcsin_mem_Icc (x : ℝ) : arcsin x ∈ Icc (-(π / 2)) (π / 2) :=
  Subtype.coe_prop _
#align real.arcsin_mem_Icc Real.arcsin_mem_Icc

@[simp]
theorem range_arcsin : range arcsin = Icc (-(π / 2)) (π / 2) :=
  by
  rw [arcsin, range_comp coe]
  simp [Icc]
#align real.range_arcsin Real.range_arcsin

theorem arcsin_le_pi_div_two (x : ℝ) : arcsin x ≤ π / 2 :=
  (arcsin_mem_Icc x).2
#align real.arcsin_le_pi_div_two Real.arcsin_le_pi_div_two

theorem neg_pi_div_two_le_arcsin (x : ℝ) : -(π / 2) ≤ arcsin x :=
  (arcsin_mem_Icc x).1
#align real.neg_pi_div_two_le_arcsin Real.neg_pi_div_two_le_arcsin

theorem arcsin_projIcc (x : ℝ) : arcsin (projIcc (-1) 1 (neg_le_self zero_le_one) x) = arcsin x :=
  by rw [arcsin, Function.comp_apply, Icc_extend_coe, Function.comp_apply, Icc_extend]
#align real.arcsin_proj_Icc Real.arcsin_projIcc

theorem sin_arcsin' {x : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) : sin (arcsin x) = x := by
  simpa [arcsin, Icc_extend_of_mem _ _ hx, -OrderIso.apply_symm_apply] using
    Subtype.ext_iff.1 (sin_order_iso.apply_symm_apply ⟨x, hx⟩)
#align real.sin_arcsin' Real.sin_arcsin'

theorem sin_arcsin {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : sin (arcsin x) = x :=
  sin_arcsin' ⟨hx₁, hx₂⟩
#align real.sin_arcsin Real.sin_arcsin

theorem arcsin_sin' {x : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) : arcsin (sin x) = x :=
  injOn_sin (arcsin_mem_Icc _) hx <| by rw [sin_arcsin (neg_one_le_sin _) (sin_le_one _)]
#align real.arcsin_sin' Real.arcsin_sin'

theorem arcsin_sin {x : ℝ} (hx₁ : -(π / 2) ≤ x) (hx₂ : x ≤ π / 2) : arcsin (sin x) = x :=
  arcsin_sin' ⟨hx₁, hx₂⟩
#align real.arcsin_sin Real.arcsin_sin

theorem strictMonoOn_arcsin : StrictMonoOn arcsin (Icc (-1) 1) :=
  (Subtype.strictMono_coe _).comp_strictMonoOn <|
    sinOrderIso.symm.StrictMono.strictMonoOn_IccExtend _
#align real.strict_mono_on_arcsin Real.strictMonoOn_arcsin

theorem monotone_arcsin : Monotone arcsin :=
  (Subtype.mono_coe _).comp <| sinOrderIso.symm.Monotone.IccExtend _
#align real.monotone_arcsin Real.monotone_arcsin

theorem injOn_arcsin : InjOn arcsin (Icc (-1) 1) :=
  strictMonoOn_arcsin.InjOn
#align real.inj_on_arcsin Real.injOn_arcsin

theorem arcsin_inj {x y : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) (hy₁ : -1 ≤ y) (hy₂ : y ≤ 1) :
    arcsin x = arcsin y ↔ x = y :=
  injOn_arcsin.eq_iff ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩
#align real.arcsin_inj Real.arcsin_inj

@[continuity]
theorem continuous_arcsin : Continuous arcsin :=
  continuous_subtype_val.comp sinOrderIso.symm.Continuous.Icc_extend'
#align real.continuous_arcsin Real.continuous_arcsin

theorem continuousAt_arcsin {x : ℝ} : ContinuousAt arcsin x :=
  continuous_arcsin.ContinuousAt
#align real.continuous_at_arcsin Real.continuousAt_arcsin

theorem arcsin_eq_of_sin_eq {x y : ℝ} (h₁ : sin x = y) (h₂ : x ∈ Icc (-(π / 2)) (π / 2)) :
    arcsin y = x := by
  subst y
  exact inj_on_sin (arcsin_mem_Icc _) h₂ (sin_arcsin' (sin_mem_Icc x))
#align real.arcsin_eq_of_sin_eq Real.arcsin_eq_of_sin_eq

@[simp]
theorem arcsin_zero : arcsin 0 = 0 :=
  arcsin_eq_of_sin_eq sin_zero ⟨neg_nonpos.2 pi_div_two_pos.le, pi_div_two_pos.le⟩
#align real.arcsin_zero Real.arcsin_zero

@[simp]
theorem arcsin_one : arcsin 1 = π / 2 :=
  arcsin_eq_of_sin_eq sin_pi_div_two <| right_mem_Icc.2 (neg_le_self pi_div_two_pos.le)
#align real.arcsin_one Real.arcsin_one

theorem arcsin_of_one_le {x : ℝ} (hx : 1 ≤ x) : arcsin x = π / 2 := by
  rw [← arcsin_proj_Icc, proj_Icc_of_right_le _ hx, Subtype.coe_mk, arcsin_one]
#align real.arcsin_of_one_le Real.arcsin_of_one_le

theorem arcsin_neg_one : arcsin (-1) = -(π / 2) :=
  arcsin_eq_of_sin_eq (by rw [sin_neg, sin_pi_div_two]) <|
    left_mem_Icc.2 (neg_le_self pi_div_two_pos.le)
#align real.arcsin_neg_one Real.arcsin_neg_one

theorem arcsin_of_le_neg_one {x : ℝ} (hx : x ≤ -1) : arcsin x = -(π / 2) := by
  rw [← arcsin_proj_Icc, proj_Icc_of_le_left _ hx, Subtype.coe_mk, arcsin_neg_one]
#align real.arcsin_of_le_neg_one Real.arcsin_of_le_neg_one

@[simp]
theorem arcsin_neg (x : ℝ) : arcsin (-x) = -arcsin x :=
  by
  cases' le_total x (-1) with hx₁ hx₁
  · rw [arcsin_of_le_neg_one hx₁, neg_neg, arcsin_of_one_le (le_neg.2 hx₁)]
  cases' le_total 1 x with hx₂ hx₂
  · rw [arcsin_of_one_le hx₂, arcsin_of_le_neg_one (neg_le_neg hx₂)]
  refine' arcsin_eq_of_sin_eq _ _
  · rw [sin_neg, sin_arcsin hx₁ hx₂]
  · exact ⟨neg_le_neg (arcsin_le_pi_div_two _), neg_le.2 (neg_pi_div_two_le_arcsin _)⟩
#align real.arcsin_neg Real.arcsin_neg

theorem arcsin_le_iff_le_sin {x y : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) (hy : y ∈ Icc (-(π / 2)) (π / 2)) :
    arcsin x ≤ y ↔ x ≤ sin y := by
  rw [← arcsin_sin' hy, strict_mono_on_arcsin.le_iff_le hx (sin_mem_Icc _), arcsin_sin' hy]
#align real.arcsin_le_iff_le_sin Real.arcsin_le_iff_le_sin

theorem arcsin_le_iff_le_sin' {x y : ℝ} (hy : y ∈ Ico (-(π / 2)) (π / 2)) :
    arcsin x ≤ y ↔ x ≤ sin y := by
  cases' le_total x (-1) with hx₁ hx₁
  · simp [arcsin_of_le_neg_one hx₁, hy.1, hx₁.trans (neg_one_le_sin _)]
  cases' lt_or_le 1 x with hx₂ hx₂
  · simp [arcsin_of_one_le hx₂.le, hy.2.not_le, (sin_le_one y).trans_lt hx₂]
  exact arcsin_le_iff_le_sin ⟨hx₁, hx₂⟩ (mem_Icc_of_Ico hy)
#align real.arcsin_le_iff_le_sin' Real.arcsin_le_iff_le_sin'

theorem le_arcsin_iff_sin_le {x y : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) (hy : y ∈ Icc (-1 : ℝ) 1) :
    x ≤ arcsin y ↔ sin x ≤ y := by
  rw [← neg_le_neg_iff, ← arcsin_neg,
    arcsin_le_iff_le_sin ⟨neg_le_neg hy.2, neg_le.2 hy.1⟩ ⟨neg_le_neg hx.2, neg_le.2 hx.1⟩, sin_neg,
    neg_le_neg_iff]
#align real.le_arcsin_iff_sin_le Real.le_arcsin_iff_sin_le

theorem le_arcsin_iff_sin_le' {x y : ℝ} (hx : x ∈ Ioc (-(π / 2)) (π / 2)) :
    x ≤ arcsin y ↔ sin x ≤ y := by
  rw [← neg_le_neg_iff, ← arcsin_neg, arcsin_le_iff_le_sin' ⟨neg_le_neg hx.2, neg_lt.2 hx.1⟩,
    sin_neg, neg_le_neg_iff]
#align real.le_arcsin_iff_sin_le' Real.le_arcsin_iff_sin_le'

theorem arcsin_lt_iff_lt_sin {x y : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) (hy : y ∈ Icc (-(π / 2)) (π / 2)) :
    arcsin x < y ↔ x < sin y :=
  not_le.symm.trans <| (not_congr <| le_arcsin_iff_sin_le hy hx).trans not_le
#align real.arcsin_lt_iff_lt_sin Real.arcsin_lt_iff_lt_sin

theorem arcsin_lt_iff_lt_sin' {x y : ℝ} (hy : y ∈ Ioc (-(π / 2)) (π / 2)) :
    arcsin x < y ↔ x < sin y :=
  not_le.symm.trans <| (not_congr <| le_arcsin_iff_sin_le' hy).trans not_le
#align real.arcsin_lt_iff_lt_sin' Real.arcsin_lt_iff_lt_sin'

theorem lt_arcsin_iff_sin_lt {x y : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) (hy : y ∈ Icc (-1 : ℝ) 1) :
    x < arcsin y ↔ sin x < y :=
  not_le.symm.trans <| (not_congr <| arcsin_le_iff_le_sin hy hx).trans not_le
#align real.lt_arcsin_iff_sin_lt Real.lt_arcsin_iff_sin_lt

theorem lt_arcsin_iff_sin_lt' {x y : ℝ} (hx : x ∈ Ico (-(π / 2)) (π / 2)) :
    x < arcsin y ↔ sin x < y :=
  not_le.symm.trans <| (not_congr <| arcsin_le_iff_le_sin' hx).trans not_le
#align real.lt_arcsin_iff_sin_lt' Real.lt_arcsin_iff_sin_lt'

theorem arcsin_eq_iff_eq_sin {x y : ℝ} (hy : y ∈ Ioo (-(π / 2)) (π / 2)) :
    arcsin x = y ↔ x = sin y := by
  simp only [le_antisymm_iff, arcsin_le_iff_le_sin' (mem_Ico_of_Ioo hy),
    le_arcsin_iff_sin_le' (mem_Ioc_of_Ioo hy)]
#align real.arcsin_eq_iff_eq_sin Real.arcsin_eq_iff_eq_sin

@[simp]
theorem arcsin_nonneg {x : ℝ} : 0 ≤ arcsin x ↔ 0 ≤ x :=
  (le_arcsin_iff_sin_le' ⟨neg_lt_zero.2 pi_div_two_pos, pi_div_two_pos.le⟩).trans <| by
    rw [sin_zero]
#align real.arcsin_nonneg Real.arcsin_nonneg

@[simp]
theorem arcsin_nonpos {x : ℝ} : arcsin x ≤ 0 ↔ x ≤ 0 :=
  neg_nonneg.symm.trans <| arcsin_neg x ▸ arcsin_nonneg.trans neg_nonneg
#align real.arcsin_nonpos Real.arcsin_nonpos

@[simp]
theorem arcsin_eq_zero_iff {x : ℝ} : arcsin x = 0 ↔ x = 0 := by simp [le_antisymm_iff]
#align real.arcsin_eq_zero_iff Real.arcsin_eq_zero_iff

@[simp]
theorem zero_eq_arcsin_iff {x} : 0 = arcsin x ↔ x = 0 :=
  eq_comm.trans arcsin_eq_zero_iff
#align real.zero_eq_arcsin_iff Real.zero_eq_arcsin_iff

@[simp]
theorem arcsin_pos {x : ℝ} : 0 < arcsin x ↔ 0 < x :=
  lt_iff_lt_of_le_iff_le arcsin_nonpos
#align real.arcsin_pos Real.arcsin_pos

@[simp]
theorem arcsin_lt_zero {x : ℝ} : arcsin x < 0 ↔ x < 0 :=
  lt_iff_lt_of_le_iff_le arcsin_nonneg
#align real.arcsin_lt_zero Real.arcsin_lt_zero

@[simp]
theorem arcsin_lt_pi_div_two {x : ℝ} : arcsin x < π / 2 ↔ x < 1 :=
  (arcsin_lt_iff_lt_sin' (right_mem_Ioc.2 <| neg_lt_self pi_div_two_pos)).trans <| by
    rw [sin_pi_div_two]
#align real.arcsin_lt_pi_div_two Real.arcsin_lt_pi_div_two

@[simp]
theorem neg_pi_div_two_lt_arcsin {x : ℝ} : -(π / 2) < arcsin x ↔ -1 < x :=
  (lt_arcsin_iff_sin_lt' <| left_mem_Ico.2 <| neg_lt_self pi_div_two_pos).trans <| by
    rw [sin_neg, sin_pi_div_two]
#align real.neg_pi_div_two_lt_arcsin Real.neg_pi_div_two_lt_arcsin

@[simp]
theorem arcsin_eq_pi_div_two {x : ℝ} : arcsin x = π / 2 ↔ 1 ≤ x :=
  ⟨fun h => not_lt.1 fun h' => (arcsin_lt_pi_div_two.2 h').Ne h, arcsin_of_one_le⟩
#align real.arcsin_eq_pi_div_two Real.arcsin_eq_pi_div_two

@[simp]
theorem pi_div_two_eq_arcsin {x} : π / 2 = arcsin x ↔ 1 ≤ x :=
  eq_comm.trans arcsin_eq_pi_div_two
#align real.pi_div_two_eq_arcsin Real.pi_div_two_eq_arcsin

@[simp]
theorem pi_div_two_le_arcsin {x} : π / 2 ≤ arcsin x ↔ 1 ≤ x :=
  (arcsin_le_pi_div_two x).le_iff_eq.trans pi_div_two_eq_arcsin
#align real.pi_div_two_le_arcsin Real.pi_div_two_le_arcsin

@[simp]
theorem arcsin_eq_neg_pi_div_two {x : ℝ} : arcsin x = -(π / 2) ↔ x ≤ -1 :=
  ⟨fun h => not_lt.1 fun h' => (neg_pi_div_two_lt_arcsin.2 h').ne' h, arcsin_of_le_neg_one⟩
#align real.arcsin_eq_neg_pi_div_two Real.arcsin_eq_neg_pi_div_two

@[simp]
theorem neg_pi_div_two_eq_arcsin {x} : -(π / 2) = arcsin x ↔ x ≤ -1 :=
  eq_comm.trans arcsin_eq_neg_pi_div_two
#align real.neg_pi_div_two_eq_arcsin Real.neg_pi_div_two_eq_arcsin

@[simp]
theorem arcsin_le_neg_pi_div_two {x} : arcsin x ≤ -(π / 2) ↔ x ≤ -1 :=
  (neg_pi_div_two_le_arcsin x).le_iff_eq.trans arcsin_eq_neg_pi_div_two
#align real.arcsin_le_neg_pi_div_two Real.arcsin_le_neg_pi_div_two

@[simp]
theorem pi_div_four_le_arcsin {x} : π / 4 ≤ arcsin x ↔ sqrt 2 / 2 ≤ x :=
  by
  rw [← sin_pi_div_four, le_arcsin_iff_sin_le']
  have := pi_pos
  constructor <;> linarith
#align real.pi_div_four_le_arcsin Real.pi_div_four_le_arcsin

theorem mapsTo_sin_Ioo : MapsTo sin (Ioo (-(π / 2)) (π / 2)) (Ioo (-1) 1) := fun x h => by
  rwa [mem_Ioo, ← arcsin_lt_pi_div_two, ← neg_pi_div_two_lt_arcsin, arcsin_sin h.1.le h.2.le]
#align real.maps_to_sin_Ioo Real.mapsTo_sin_Ioo

/-- `real.sin` as a `local_homeomorph` between `(-π / 2, π / 2)` and `(-1, 1)`. -/
@[simp]
def sinLocalHomeomorph : LocalHomeomorph ℝ ℝ
    where
  toFun := sin
  invFun := arcsin
  source := Ioo (-(π / 2)) (π / 2)
  target := Ioo (-1) 1
  map_source' := mapsTo_sin_Ioo
  map_target' y hy := ⟨neg_pi_div_two_lt_arcsin.2 hy.1, arcsin_lt_pi_div_two.2 hy.2⟩
  left_inv' x hx := arcsin_sin hx.1.le hx.2.le
  right_inv' y hy := sin_arcsin hy.1.le hy.2.le
  open_source := isOpen_Ioo
  open_target := isOpen_Ioo
  continuous_toFun := continuous_sin.ContinuousOn
  continuous_invFun := continuous_arcsin.ContinuousOn
#align real.sin_local_homeomorph Real.sinLocalHomeomorph

theorem cos_arcsin_nonneg (x : ℝ) : 0 ≤ cos (arcsin x) :=
  cos_nonneg_of_mem_Icc ⟨neg_pi_div_two_le_arcsin _, arcsin_le_pi_div_two _⟩
#align real.cos_arcsin_nonneg Real.cos_arcsin_nonneg

-- The junk values for `arcsin` and `sqrt` make this true even outside `[-1, 1]`.
theorem cos_arcsin (x : ℝ) : cos (arcsin x) = sqrt (1 - x ^ 2) :=
  by
  by_cases hx₁ : -1 ≤ x; swap
  · rw [not_le] at hx₁
    rw [arcsin_of_le_neg_one hx₁.le, cos_neg, cos_pi_div_two, sqrt_eq_zero_of_nonpos]
    nlinarith
  by_cases hx₂ : x ≤ 1; swap
  · rw [not_le] at hx₂
    rw [arcsin_of_one_le hx₂.le, cos_pi_div_two, sqrt_eq_zero_of_nonpos]
    nlinarith
  have : sin (arcsin x) ^ 2 + cos (arcsin x) ^ 2 = 1 := sin_sq_add_cos_sq (arcsin x)
  rw [← eq_sub_iff_add_eq', ← sqrt_inj (sq_nonneg _) (sub_nonneg.2 (sin_sq_le_one (arcsin x))), sq,
    sqrt_mul_self (cos_arcsin_nonneg _)] at this
  rw [this, sin_arcsin hx₁ hx₂]
#align real.cos_arcsin Real.cos_arcsin

-- The junk values for `arcsin` and `sqrt` make this true even outside `[-1, 1]`.
theorem tan_arcsin (x : ℝ) : tan (arcsin x) = x / sqrt (1 - x ^ 2) :=
  by
  rw [tan_eq_sin_div_cos, cos_arcsin]
  by_cases hx₁ : -1 ≤ x; swap
  · have h : sqrt (1 - x ^ 2) = 0 := sqrt_eq_zero_of_nonpos (by nlinarith)
    rw [h]
    simp
  by_cases hx₂ : x ≤ 1; swap
  · have h : sqrt (1 - x ^ 2) = 0 := sqrt_eq_zero_of_nonpos (by nlinarith)
    rw [h]
    simp
  rw [sin_arcsin hx₁ hx₂]
#align real.tan_arcsin Real.tan_arcsin

/-- Inverse of the `cos` function, returns values in the range `0 ≤ arccos x` and `arccos x ≤ π`.
  It defaults to `π` on `(-∞, -1)` and to `0` to `(1, ∞)`. -/
@[pp_nodot]
noncomputable def arccos (x : ℝ) : ℝ :=
  π / 2 - arcsin x
#align real.arccos Real.arccos

theorem arccos_eq_pi_div_two_sub_arcsin (x : ℝ) : arccos x = π / 2 - arcsin x :=
  rfl
#align real.arccos_eq_pi_div_two_sub_arcsin Real.arccos_eq_pi_div_two_sub_arcsin

theorem arcsin_eq_pi_div_two_sub_arccos (x : ℝ) : arcsin x = π / 2 - arccos x := by simp [arccos]
#align real.arcsin_eq_pi_div_two_sub_arccos Real.arcsin_eq_pi_div_two_sub_arccos

theorem arccos_le_pi (x : ℝ) : arccos x ≤ π := by
  unfold arccos <;> linarith [neg_pi_div_two_le_arcsin x]
#align real.arccos_le_pi Real.arccos_le_pi

theorem arccos_nonneg (x : ℝ) : 0 ≤ arccos x := by
  unfold arccos <;> linarith [arcsin_le_pi_div_two x]
#align real.arccos_nonneg Real.arccos_nonneg

@[simp]
theorem arccos_pos {x : ℝ} : 0 < arccos x ↔ x < 1 := by simp [arccos]
#align real.arccos_pos Real.arccos_pos

theorem cos_arccos {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : cos (arccos x) = x := by
  rw [arccos, cos_pi_div_two_sub, sin_arcsin hx₁ hx₂]
#align real.cos_arccos Real.cos_arccos

theorem arccos_cos {x : ℝ} (hx₁ : 0 ≤ x) (hx₂ : x ≤ π) : arccos (cos x) = x := by
  rw [arccos, ← sin_pi_div_two_sub, arcsin_sin] <;> simp [sub_eq_add_neg] <;> linarith
#align real.arccos_cos Real.arccos_cos

theorem strictAntiOn_arccos : StrictAntiOn arccos (Icc (-1) 1) := fun x hx y hy h =>
  sub_lt_sub_left (strictMonoOn_arcsin hx hy h) _
#align real.strict_anti_on_arccos Real.strictAntiOn_arccos

theorem arccos_injOn : InjOn arccos (Icc (-1) 1) :=
  strictAntiOn_arccos.InjOn
#align real.arccos_inj_on Real.arccos_injOn

theorem arccos_inj {x y : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) (hy₁ : -1 ≤ y) (hy₂ : y ≤ 1) :
    arccos x = arccos y ↔ x = y :=
  arccos_injOn.eq_iff ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩
#align real.arccos_inj Real.arccos_inj

@[simp]
theorem arccos_zero : arccos 0 = π / 2 := by simp [arccos]
#align real.arccos_zero Real.arccos_zero

@[simp]
theorem arccos_one : arccos 1 = 0 := by simp [arccos]
#align real.arccos_one Real.arccos_one

@[simp]
theorem arccos_neg_one : arccos (-1) = π := by simp [arccos, add_halves]
#align real.arccos_neg_one Real.arccos_neg_one

@[simp]
theorem arccos_eq_zero {x} : arccos x = 0 ↔ 1 ≤ x := by simp [arccos, sub_eq_zero]
#align real.arccos_eq_zero Real.arccos_eq_zero

@[simp]
theorem arccos_eq_pi_div_two {x} : arccos x = π / 2 ↔ x = 0 := by simp [arccos]
#align real.arccos_eq_pi_div_two Real.arccos_eq_pi_div_two

@[simp]
theorem arccos_eq_pi {x} : arccos x = π ↔ x ≤ -1 := by
  rw [arccos, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add', div_two_sub_self, neg_pi_div_two_eq_arcsin]
#align real.arccos_eq_pi Real.arccos_eq_pi

theorem arccos_neg (x : ℝ) : arccos (-x) = π - arccos x := by
  rw [← add_halves π, arccos, arcsin_neg, arccos, add_sub_assoc, sub_sub_self, sub_neg_eq_add]
#align real.arccos_neg Real.arccos_neg

theorem arccos_of_one_le {x : ℝ} (hx : 1 ≤ x) : arccos x = 0 := by
  rw [arccos, arcsin_of_one_le hx, sub_self]
#align real.arccos_of_one_le Real.arccos_of_one_le

theorem arccos_of_le_neg_one {x : ℝ} (hx : x ≤ -1) : arccos x = π := by
  rw [arccos, arcsin_of_le_neg_one hx, sub_neg_eq_add, add_halves']
#align real.arccos_of_le_neg_one Real.arccos_of_le_neg_one

-- The junk values for `arccos` and `sqrt` make this true even outside `[-1, 1]`.
theorem sin_arccos (x : ℝ) : sin (arccos x) = sqrt (1 - x ^ 2) :=
  by
  by_cases hx₁ : -1 ≤ x; swap
  · rw [not_le] at hx₁
    rw [arccos_of_le_neg_one hx₁.le, sin_pi, sqrt_eq_zero_of_nonpos]
    nlinarith
  by_cases hx₂ : x ≤ 1; swap
  · rw [not_le] at hx₂
    rw [arccos_of_one_le hx₂.le, sin_zero, sqrt_eq_zero_of_nonpos]
    nlinarith
  rw [arccos_eq_pi_div_two_sub_arcsin, sin_pi_div_two_sub, cos_arcsin]
#align real.sin_arccos Real.sin_arccos

@[simp]
theorem arccos_le_pi_div_two {x} : arccos x ≤ π / 2 ↔ 0 ≤ x := by simp [arccos]
#align real.arccos_le_pi_div_two Real.arccos_le_pi_div_two

@[simp]
theorem arccos_lt_pi_div_two {x : ℝ} : arccos x < π / 2 ↔ 0 < x := by simp [arccos]
#align real.arccos_lt_pi_div_two Real.arccos_lt_pi_div_two

@[simp]
theorem arccos_le_pi_div_four {x} : arccos x ≤ π / 4 ↔ sqrt 2 / 2 ≤ x :=
  by
  rw [arccos, ← pi_div_four_le_arcsin]
  constructor <;>
    · intro
      linarith
#align real.arccos_le_pi_div_four Real.arccos_le_pi_div_four

@[continuity]
theorem continuous_arccos : Continuous arccos :=
  continuous_const.sub continuous_arcsin
#align real.continuous_arccos Real.continuous_arccos

-- The junk values for `arccos` and `sqrt` make this true even outside `[-1, 1]`.
theorem tan_arccos (x : ℝ) : tan (arccos x) = sqrt (1 - x ^ 2) / x := by
  rw [arccos, tan_pi_div_two_sub, tan_arcsin, inv_div]
#align real.tan_arccos Real.tan_arccos

-- The junk values for `arccos` and `sqrt` make this true even for `1 < x`.
theorem arccos_eq_arcsin {x : ℝ} (h : 0 ≤ x) : arccos x = arcsin (sqrt (1 - x ^ 2)) :=
  (arcsin_eq_of_sin_eq (sin_arccos _)
      ⟨(Left.neg_nonpos_iff.2 (div_nonneg pi_pos.le (by norm_num))).trans (arccos_nonneg _),
        arccos_le_pi_div_two.2 h⟩).symm
#align real.arccos_eq_arcsin Real.arccos_eq_arcsin

-- The junk values for `arcsin` and `sqrt` make this true even for `1 < x`.
theorem arcsin_eq_arccos {x : ℝ} (h : 0 ≤ x) : arcsin x = arccos (sqrt (1 - x ^ 2)) :=
  by
  rw [eq_comm, ← cos_arcsin]
  exact
    arccos_cos (arcsin_nonneg.2 h)
      ((arcsin_le_pi_div_two _).trans (div_le_self pi_pos.le one_le_two))
#align real.arcsin_eq_arccos Real.arcsin_eq_arccos

end Real


import data.real.basic

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

variables {s : ℕ → ℝ} {a : ℝ}

-- BEGIN
theorem exists_abs_le_of_converges_to (cs : converges_to s a) :
  ∃ N b, ∀ n, N ≤ n → abs (s n) < b :=
begin
  cases cs 1 zero_lt_one with N h,
  use [N, abs a + 1],
  intros n hn,
  specialize h n hn,
  have t := abs_sub_abs_le_abs_sub (s n) a,
  have t' := lt_of_le_of_lt t h,
  exact sub_lt_iff_lt_add'.mp t',
end
-- END


import tactic

/-- The equivalence relation on ℕ² such that equivalence classes are ℤ -/
def nat2.R (a b : ℕ × ℕ) : Prop :=
a.1 + b.2 = b.1 + a.2
-- here a and b are pairs, so a = (a.1, a.2) etc.

-- introduce ≈ (type with `\~~`) notation for this relation
instance : has_equiv (ℕ × ℕ) := ⟨nat2.R⟩

-- let's prove some lemmas about this binary relation
namespace nat2.R
#check quotient.lift_on
-- The following lemma is true by definition, but it's useful to
-- have it around so you can rewrite with it
@[simp] lemma equiv_def {i j k l : ℕ} : (i, j) ≈ (k, l) ↔ i + l = k + j :=
begin
  refl
end

-- try rewriting `equiv_def`
lemma practice : (3, 5) ≈ (4, 6) :=
begin
  change 3 + 6 = 4 + 5,
  refl,
end

-- Now let's prove that this binary relation is an equivalence relation
lemma reflexive : ∀ x : ℕ × ℕ, x ≈ x :=
begin
  rintro ⟨i, j⟩,
  rw equiv_def,
end

lemma symmetric : ∀ x y : ℕ × ℕ, (x ≈ y) → (y ≈ x) :=
begin
  -- here are a couple of tricks
  rintro ⟨i, j⟩ ⟨k, l⟩ h,
  -- type `⊢` with `\|-`
  rw equiv_def at h ⊢,
  rw h,
end

lemma transitive : ∀ x y z : ℕ × ℕ, (x ≈ y) → (y ≈ z) → (x ≈ z) :=
begin
  -- this is a little trickier
  -- recall `add_right_inj` says `a + b = c + b → a = c`
  rintro ⟨i, j⟩ ⟨k, l⟩ ⟨m, n⟩ hxy hyz,
  rw equiv_def at hxy hyz ⊢,
  rw ← add_left_inj (k+l),
  calc (i+n)+(k+l)=(i+l)+(k+n) : by ring
  ... = (k+j)+(m+l) : by rw [hxy, hyz]
  ... = (m+j)+(k+l) : by ring
end

-- This line tells Lean that the binary relation is an equivalence
-- relation and hence we can take the "quotient", i.e. the
-- type of equivalence classes
instance setoid : setoid (ℕ × ℕ) :=
{ r := nat2.R,
  iseqv := ⟨reflexive, symmetric, transitive⟩ }

-- end of lemmas about the binary relation
end nat2.R

-- ...but we're still going to be using them
open nat2.R

/-- The integers are the equivalence classes of the equivalence relation
 we just defined on ℕ²  -/
def myint := quotient nat2.R.setoid

-- let's make some definitions, and prove some theorems, about integers
namespace myint

-- The first goal is to get a good interface for addition.
-- To do this we need to define a+b, and -a, and 0. Let's do
-- them in reverse order.

/-! ## zero -/

def zero := ⟦(0,0)⟧

instance : has_zero myint := ⟨myint.zero⟩

lemma zero_def : (0 : myint) = ⟦(0, 0)⟧ :=
begin
  refl
end

/-! ## negation (additive inverse) -/

-- First we define an "auxiliary" map from ℕ² to ℤ
-- sending (a,b) to the equivalence class of (b,a).

def neg_aux (x : ℕ × ℕ) : myint := ⟦(x.2, x.1)⟧

-- true by definition
lemma neg_aux_def (i j : ℕ) : neg_aux (i, j) = ⟦(j, i)⟧ := rfl

/-! ### Well-definedness

OK now here's the concrete problem. We would like to define
a negation map `ℤ → ℤ` sending `z` to `-z`. We want to do this in
the following way: Say `z ∈ ℤ`. Choose `a=(i,j) ∈ ℕ²` representing `z`
(i.e. such that `cl(i,j) = ⟦(i,j)⟧ = z`)
Now apply `neg_aux` to `a`, and define `-z` to be the result.

The problem with this is that what if `b` is a different
element of the equivalence class? Then we also want `-z` to be `neg_aux b`.

Indeed, in Lean this construction is called `quotient.lift`, and
if you uncomment the below code
-/

--def neg : myint → myint :=
--quotient.lift neg_aux _

/-
you'll see an error, and if you put your cursor on the error you'll
see that Lean wants a proof that if two elements `a` and `b` are in the
same equivalence class, then `neg_aux a = neg_aux b`. So let's prove this now.
-/

-- negation on the integers, defined via neg_aux, is well-defined.
lemma neg_aux_lemma : ∀ x y : ℕ × ℕ, x ≈ y → neg_aux x = neg_aux y :=
begin
  rintro ⟨i,j⟩ ⟨k,l⟩ h,
  rw [neg_aux_def, neg_aux_def],
  -- ⊢ ⟦(j, i)⟧ = ⟦(l, k)⟧
  -- next step: if ⟦a⟧=⟦b⟧ then a ≈ b
  apply quotient.sound,
  -- ⊢ (j, i) ≈ (l, k)
  rw equiv_def at h ⊢,
  rw add_comm,
  rw ← h,
  apply add_comm,
end

/-- Negation on on the integers. The function sending `z` to `-z`. -/
def neg : myint → myint :=
quotient.lift neg_aux neg_aux_lemma

-- notation for negation
instance : has_neg myint := ⟨neg⟩

-- this is true by definition
lemma neg_def (i j : ℕ) : (-⟦(i, j)⟧ : myint) = ⟦(j, i)⟧ :=
begin
  refl
end

/-!  ## addition

Our final construction: we want to define addition on `myint`.
Here we have the same problem. Say z₁ and z₂ are integers.
Choose elements a₁=(i,j) and a₂=(k,l) in ℕ². We want to define
z₁ + z₂ to be ⟦(i+k,j+l)⟧, the equivalence class of a₁ + a₂.
Let's make this definition now.

-/

/-- An auxiliary function taking two elements of ℕ² and returning
the equivalence class of their sum. -/
def add_aux (x y : ℕ × ℕ) : myint := ⟦(x.1 + y.1, x.2 + y.2)⟧

-- true by definition, but useful for rewriting
lemma add_aux_def (i j k l : ℕ) : add_aux (i, j) (k, l) = ⟦(i + k, j + l)⟧ :=
begin
  refl
end

/-

We want the definition of addition to look like the below.
Uncomment it to see the problem.

-/

--def add : myint → myint → myint :=
--quotient.lift₂ add_aux _

/-
We had better check that choosing different elements in the same
equivalence class gives the same definition.

-/

lemma add_aux_lemma : ∀ x₁ x₂ y₁ y₂ : ℕ × ℕ,
(x₁ ≈ y₁) → (x₂ ≈ y₂) → add_aux x₁ x₂ = add_aux y₁ y₂ :=
begin
  rintro ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩ ⟨g, h⟩ h1 h2,
  rw add_aux_def,
  rw add_aux_def,
  apply quotient.sound,
  rw equiv_def at *,
  rw (show (a+c)+(f+h) = (a+f)+(c+h), by ring),
  rw [h1, h2],
  ring,
end

-- Now this is checked, we can define addition.

/-- Addition on the integers -/
def add : myint → myint → myint :=
quotient.lift₂ add_aux add_aux_lemma

-- notation for addition
instance : has_add myint := ⟨add⟩

-- true by definition
lemma add_def (i j k l : ℕ) :
  (⟦(i, j)⟧ + ⟦(k, l)⟧ : myint) = ⟦(i + k, j + l)⟧ :=
begin
  refl
end

/-
The four fundamental facts about addition on the integes are:
1) associativity
2) commutativity
3) zero is an additive identity
4) negation is an additive inverse.

Let's prove these now.

-/

lemma zero_add (x : myint) : 0 + x = x :=
begin
  apply quotient.induction_on x,
  rintro ⟨a, b⟩,
  rw zero_def,
  rw add_def,
  apply quotient.sound,
  rw equiv_def,
  ring,
end

lemma add_zero (x : myint) : x + 0 = x :=
begin
  apply quotient.induction_on x,
  rintro ⟨a, b⟩,
  rw zero_def,
  rw add_def,
  apply quotient.sound,
  rw equiv_def,
  ring,
end

lemma add_left_neg (x : myint) : -x + x = 0 :=
begin
  apply quotient.induction_on x,
  rintro ⟨a, b⟩,
  rw zero_def,
  rw neg_def,
  rw add_def,
  apply quotient.sound,
  rw equiv_def,
  ring,
end

lemma add_comm (x y : myint) : x + y = y + x :=
begin
  apply quotient.induction_on₂ x y,
  rintro ⟨a, b⟩ ⟨c, d⟩,
  rw [add_def, add_def],
  apply quotient.sound,
  rw equiv_def,
  ring,
end

lemma add_assoc (x y z : myint) : (x + y) + z = x + (y + z) :=
begin
  apply quotient.induction_on₃ x y z,
  rintro ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩,
  simp [add_def],
  ring,
end

-- We just proved that the integers are a commutative group under addition!

instance : add_comm_group myint :=
{ add := (+),
  add_assoc := add_assoc,
  zero := 0,
  zero_add := zero_add,
  add_zero := add_zero,
  neg := has_neg.neg,
  add_left_neg := add_left_neg,
  add_comm := add_comm }

-- woohoo!

/-! ## multiplication

What's left to define is 1 and multiplication (note that we don't need multiplicative
inverses -- if a is a non-zero integer then a⁻¹ is typially not an integer)

-/

def mul_aux (x y : ℕ × ℕ) : myint := ⟦(x.1*y.1+x.2*y.2, x.1*y.2+x.2*y.1)⟧

lemma mul_aux_def (i j k l : ℕ) : mul_aux (i, j) (k, l) = ⟦(i*k+j*l, i*l+j*k)⟧ :=
begin
  refl
end

-- Boss level.
-- Dr. Lawn: "We leave the similar verification for multiplication as an exercise."

-- This is what we need to check for multiplication to "descend" (or "lift" as Lean
-- calls it) to a well-defined function on the quotient.
lemma mul_aux_lemma : ∀ x₁ x₂ y₁ y₂ : ℕ × ℕ,
(x₁ ≈ y₁) → (x₂ ≈ y₂) → mul_aux x₁ x₂ = mul_aux y₁ y₂ :=
begin
  rintro ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩ ⟨g, h⟩ h1 h2,
  simp only [mul_aux_def],
  apply quotient.sound,
  rw equiv_def at *,
  -- a calc proof would be nicer. Can I get away with rewriting h1 and h2
  -- fewer times?
  rw ← add_left_inj (a * h),
  have h3 : a * c + b * d + (e * h + f * g) + a * h = a * (c + h) + b*d+e*h+f*g,
    ring,
  rw h3,
  rw h2,
  have h4 : a * (g + d) + b * d + e * h + f * g = (a+f)*g+a*d+b*d+e*h,
    ring,
  rw h4,
  rw h1,
  clear h3, clear h4,
  rw (show (e + b) * g + a * d + b * d + e * h = e*g+a*d+b*(g+d)+e*h, by ring),
  rw ← h2,
  rw (show e * g + a * d + b * (c + h) + e * h = e * g + a * d + b * c + (e+b) * h, by ring),
  rw ← h1,
  ring,
end

-- definition of multiplication
def mul : myint → myint → myint :=
quotient.lift₂ mul_aux mul_aux_lemma

instance : has_mul myint := ⟨mul⟩

lemma mul_def (i j k l : ℕ) : (⟦(i, j)⟧ * ⟦(k, l)⟧ : myint) = ⟦(i*k+j*l, i*l+j*k)⟧ :=
begin
  refl
end

lemma mul_assoc (x y z : myint) : (x * y) * z = x * (y * z) :=
begin
  apply quotient.induction_on₃ x y z,
  rintro ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩,
  simp [mul_def],
  ring,
end

def one : myint := ⟦(37, 36)⟧

instance : has_one myint := ⟨myint.one⟩

-- true by definition
lemma one_def : (1 : myint) = ⟦(37, 36)⟧ :=
begin
  refl
end

lemma one_mul (x : myint) : 1 * x = x :=
begin
  apply quotient.induction_on x,
  rintro ⟨i, j⟩,
  simp [one_def, mul_def],
  ring,
end

lemma mul_one (x : myint) : x * 1 = x :=
begin
  apply quotient.induction_on x,
  rintro ⟨i, j⟩,
  simp [one_def, mul_def],
  ring,
end

lemma mul_comm (x y : myint) : x * y = y * x :=
begin
  apply quotient.induction_on₂ x y,
  rintro ⟨i, j⟩ ⟨k, l⟩,
  simp [mul_def],
  ring,
end

lemma mul_add (x y z : myint) : x * (y + z) = x * y + x * z :=
begin
  apply quotient.induction_on₃ x y z,
  rintro ⟨i, j⟩ ⟨k, l⟩ ⟨m, n⟩,
  simp [add_def, mul_def],
  ring,
end

lemma add_mul (x y z : myint) : (x + y) * z = x * z + y * z :=
begin
  apply quotient.induction_on₃ x y z,
  rintro ⟨i, j⟩ ⟨k, l⟩ ⟨m, n⟩,
  simp [add_def, mul_def],
  ring,
end

-- The integers are a commutative ring
-- (that is, they satisfy the axioms we just proved)
instance : comm_ring myint :=
{ mul := (*),
  mul_assoc := mul_assoc,
  one := 1,
  one_mul := one_mul,
  mul_one := mul_one,
  left_distrib := mul_add,
  right_distrib := add_mul,
  mul_comm := mul_comm,
  ..myint.add_comm_group }

end myint


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

! This file was ported from Lean 3 source module algebra.algebra.spectrum
! leanprover-community/mathlib commit 11dcb6b59dc9cc74e053b7ca8569bf6df4ac0f1e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Star.Pointwise
import Mathbin.Algebra.Star.Subalgebra
import Mathbin.FieldTheory.IsAlgClosed.Basic
import Mathbin.Tactic.NoncommRing

/-!
# Spectrum of an element in an algebra
This file develops the basic theory of the spectrum of an element of an algebra.
This theory will serve as the foundation for spectral theory in Banach algebras.

## Main definitions

* `resolvent_set a : set R`: the resolvent set of an element `a : A` where
  `A` is an  `R`-algebra.
* `spectrum a : set R`: the spectrum of an element `a : A` where
  `A` is an  `R`-algebra.
* `resolvent : R → A`: the resolvent function is `λ r, ring.inverse (↑ₐr - a)`, and hence
  when `r ∈ resolvent R A`, it is actually the inverse of the unit `(↑ₐr - a)`.

## Main statements

* `spectrum.unit_smul_eq_smul` and `spectrum.smul_eq_smul`: units in the scalar ring commute
  (multiplication) with the spectrum, and over a field even `0` commutes with the spectrum.
* `spectrum.left_add_coset_eq`: elements of the scalar ring commute (addition) with the spectrum.
* `spectrum.unit_mem_mul_iff_mem_swap_mul` and `spectrum.preimage_units_mul_eq_swap_mul`: the
  units (of `R`) in `σ (a*b)` coincide with those in `σ (b*a)`.
* `spectrum.scalar_eq`: in a nontrivial algebra over a field, the spectrum of a scalar is
  a singleton.
* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`,
  `spectrum.map_polynomial_aeval_of_nonempty`: variations on the spectral mapping theorem.

## Notations

* `σ a` : `spectrum R a` of `a : A`
-/

open Set

open Pointwise

universe u v

section Defs

variable (R : Type u) {A : Type v}

variable [CommSemiring R] [Ring A] [Algebra R A]

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap R A

-- definition and basic properties
/-- Given a commutative ring `R` and an `R`-algebra `A`, the *resolvent set* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is a unit of the
algebra `A`.  -/
def resolventSet (a : A) : Set R :=
  { r : R | IsUnit (↑ₐ r - a) }
#align resolvent_set resolventSet

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *spectrum* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is not a unit of the
algebra `A`.

The spectrum is simply the complement of the resolvent set.  -/
def spectrum (a : A) : Set R :=
  resolventSet R aᶜ
#align spectrum spectrum

variable {R}

/-- Given an `a : A` where `A` is an `R`-algebra, the *resolvent* is
    a map `R → A` which sends `r : R` to `(algebra_map R A r - a)⁻¹` when
    `r ∈ resolvent R A` and `0` when `r ∈ spectrum R A`. -/
noncomputable def resolvent (a : A) (r : R) : A :=
  Ring.inverse (↑ₐ r - a)
#align resolvent resolvent

/-- The unit `1 - r⁻¹ • a` constructed from `r • 1 - a` when the latter is a unit. -/
@[simps]
noncomputable def IsUnit.subInvSmul {r : Rˣ} {s : R} {a : A} (h : IsUnit <| r • ↑ₐ s - a) : Aˣ
    where
  val := ↑ₐ s - r⁻¹ • a
  inv := r • ↑h.Unit⁻¹
  val_inv := by rw [mul_smul_comm, ← smul_mul_assoc, smul_sub, smul_inv_smul, h.mul_coe_inv]
  inv_val := by rw [smul_mul_assoc, ← mul_smul_comm, smul_sub, smul_inv_smul, h.coe_inv_mul]
#align is_unit.sub_inv_smul IsUnit.subInvSmul

end Defs

namespace spectrum

open Polynomial

section ScalarSemiring

variable {R : Type u} {A : Type v}

variable [CommSemiring R] [Ring A] [Algebra R A]

-- mathport name: exprσ
local notation "σ" => spectrum R

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap R A

theorem mem_iff {r : R} {a : A} : r ∈ σ a ↔ ¬IsUnit (↑ₐ r - a) :=
  Iff.rfl
#align spectrum.mem_iff spectrum.mem_iff

theorem not_mem_iff {r : R} {a : A} : r ∉ σ a ↔ IsUnit (↑ₐ r - a) :=
  by
  apply not_iff_not.mp
  simp [Set.not_not_mem, mem_iff]
#align spectrum.not_mem_iff spectrum.not_mem_iff

variable (R)

theorem zero_mem_iff {a : A} : (0 : R) ∈ σ a ↔ ¬IsUnit a := by
  rw [mem_iff, map_zero, zero_sub, IsUnit.neg_iff]
#align spectrum.zero_mem_iff spectrum.zero_mem_iff

theorem zero_not_mem_iff {a : A} : (0 : R) ∉ σ a ↔ IsUnit a := by
  rw [zero_mem_iff, Classical.not_not]
#align spectrum.zero_not_mem_iff spectrum.zero_not_mem_iff

variable {R}

theorem mem_resolventSet_of_left_right_inverse {r : R} {a b c : A} (h₁ : (↑ₐ r - a) * b = 1)
    (h₂ : c * (↑ₐ r - a) = 1) : r ∈ resolventSet R a :=
  Units.isUnit ⟨↑ₐ r - a, b, h₁, by rwa [← left_inv_eq_right_inv h₂ h₁]⟩
#align spectrum.mem_resolvent_set_of_left_right_inverse spectrum.mem_resolventSet_of_left_right_inverse

theorem mem_resolventSet_iff {r : R} {a : A} : r ∈ resolventSet R a ↔ IsUnit (↑ₐ r - a) :=
  Iff.rfl
#align spectrum.mem_resolvent_set_iff spectrum.mem_resolventSet_iff

@[simp]
theorem resolventSet_of_subsingleton [Subsingleton A] (a : A) : resolventSet R a = Set.univ := by
  simp_rw [resolventSet, Subsingleton.elim (algebraMap R A _ - a) 1, isUnit_one, Set.setOf_true]
#align spectrum.resolvent_set_of_subsingleton spectrum.resolventSet_of_subsingleton

@[simp]
theorem of_subsingleton [Subsingleton A] (a : A) : spectrum R a = ∅ := by
  rw [spectrum, resolvent_set_of_subsingleton, Set.compl_univ]
#align spectrum.of_subsingleton spectrum.of_subsingleton

theorem resolvent_eq {a : A} {r : R} (h : r ∈ resolventSet R a) : resolvent a r = ↑h.Unit⁻¹ :=
  Ring.inverse_unit h.Unit
#align spectrum.resolvent_eq spectrum.resolvent_eq

theorem units_smul_resolvent {r : Rˣ} {s : R} {a : A} :
    r • resolvent a (s : R) = resolvent (r⁻¹ • a) (r⁻¹ • s : R) :=
  by
  by_cases h : s ∈ spectrum R a
  · rw [mem_iff] at h
    simp only [resolvent, Algebra.algebraMap_eq_smul_one] at *
    rw [smul_assoc, ← smul_sub]
    have h' : ¬IsUnit (r⁻¹ • (s • 1 - a)) := fun hu =>
      h (by simpa only [smul_inv_smul] using IsUnit.smul r hu)
    simp only [Ring.inverse_non_unit _ h, Ring.inverse_non_unit _ h', smul_zero]
  · simp only [resolvent]
    have h' : IsUnit (r • algebraMap R A (r⁻¹ • s) - a) := by
      simpa [Algebra.algebraMap_eq_smul_one, smul_assoc] using not_mem_iff.mp h
    rw [← h'.coe_sub_inv_smul, ← (not_mem_iff.mp h).unit_spec, Ring.inverse_unit, Ring.inverse_unit,
      h'.coe_inv_sub_inv_smul]
    simp only [Algebra.algebraMap_eq_smul_one, smul_assoc, smul_inv_smul]
#align spectrum.units_smul_resolvent spectrum.units_smul_resolvent

theorem units_smul_resolvent_self {r : Rˣ} {a : A} :
    r • resolvent a (r : R) = resolvent (r⁻¹ • a) (1 : R) := by
  simpa only [Units.smul_def, Algebra.id.smul_eq_mul, Units.inv_mul] using
    @units_smul_resolvent _ _ _ _ _ r r a
#align spectrum.units_smul_resolvent_self spectrum.units_smul_resolvent_self

/-- The resolvent is a unit when the argument is in the resolvent set. -/
theorem isUnit_resolvent {r : R} {a : A} : r ∈ resolventSet R a ↔ IsUnit (resolvent a r) :=
  isUnit_ring_inverse.symm
#align spectrum.is_unit_resolvent spectrum.isUnit_resolvent

theorem inv_mem_resolventSet {r : Rˣ} {a : Aˣ} (h : (r : R) ∈ resolventSet R (a : A)) :
    (↑r⁻¹ : R) ∈ resolventSet R (↑a⁻¹ : A) :=
  by
  rw [mem_resolvent_set_iff, Algebra.algebraMap_eq_smul_one, ← Units.smul_def] at h⊢
  rw [IsUnit.smul_sub_iff_sub_inv_smul, inv_inv, IsUnit.sub_iff]
  have h₁ : (a : A) * (r • (↑a⁻¹ : A) - 1) = r • 1 - a := by
    rw [mul_sub, mul_smul_comm, a.mul_inv, mul_one]
  have h₂ : (r • (↑a⁻¹ : A) - 1) * a = r • 1 - a := by
    rw [sub_mul, smul_mul_assoc, a.inv_mul, one_mul]
  have hcomm : Commute (a : A) (r • (↑a⁻¹ : A) - 1) := by rwa [← h₂] at h₁
  exact (hcomm.is_unit_mul_iff.mp (h₁.symm ▸ h)).2
#align spectrum.inv_mem_resolvent_set spectrum.inv_mem_resolventSet

theorem inv_mem_iff {r : Rˣ} {a : Aˣ} : (r : R) ∈ σ (a : A) ↔ (↑r⁻¹ : R) ∈ σ (↑a⁻¹ : A) :=
  not_iff_not.2 <| ⟨inv_mem_resolventSet, inv_mem_resolventSet⟩
#align spectrum.inv_mem_iff spectrum.inv_mem_iff

theorem zero_mem_resolventSet_of_unit (a : Aˣ) : 0 ∈ resolventSet R (a : A) := by
  simpa only [mem_resolvent_set_iff, ← not_mem_iff, zero_not_mem_iff] using a.is_unit
#align spectrum.zero_mem_resolvent_set_of_unit spectrum.zero_mem_resolventSet_of_unit

theorem ne_zero_of_mem_of_unit {a : Aˣ} {r : R} (hr : r ∈ σ (a : A)) : r ≠ 0 := fun hn =>
  (hn ▸ hr) (zero_mem_resolventSet_of_unit a)
#align spectrum.ne_zero_of_mem_of_unit spectrum.ne_zero_of_mem_of_unit

theorem add_mem_iff {a : A} {r s : R} : r + s ∈ σ a ↔ r ∈ σ (-↑ₐ s + a) := by
  simp only [mem_iff, sub_neg_eq_add, ← sub_sub, map_add]
#align spectrum.add_mem_iff spectrum.add_mem_iff

theorem add_mem_add_iff {a : A} {r s : R} : r + s ∈ σ (↑ₐ s + a) ↔ r ∈ σ a := by
  rw [add_mem_iff, neg_add_cancel_left]
#align spectrum.add_mem_add_iff spectrum.add_mem_add_iff

theorem smul_mem_smul_iff {a : A} {s : R} {r : Rˣ} : r • s ∈ σ (r • a) ↔ s ∈ σ a := by
  simp only [mem_iff, not_iff_not, Algebra.algebraMap_eq_smul_one, smul_assoc, ← smul_sub,
    isUnit_smul_iff]
#align spectrum.smul_mem_smul_iff spectrum.smul_mem_smul_iff

open Polynomial

theorem unit_smul_eq_smul (a : A) (r : Rˣ) : σ (r • a) = r • σ a :=
  by
  ext
  have x_eq : x = r • r⁻¹ • x := by simp
  nth_rw 1 [x_eq]
  rw [smul_mem_smul_iff]
  constructor
  · exact fun h => ⟨r⁻¹ • x, ⟨h, by simp⟩⟩
  · rintro ⟨_, _, x'_eq⟩
    simpa [← x'_eq]
#align spectrum.unit_smul_eq_smul spectrum.unit_smul_eq_smul

-- `r ∈ σ(a*b) ↔ r ∈ σ(b*a)` for any `r : Rˣ`
theorem unit_mem_mul_iff_mem_swap_mul {a b : A} {r : Rˣ} : ↑r ∈ σ (a * b) ↔ ↑r ∈ σ (b * a) :=
  by
  have h₁ : ∀ x y : A, IsUnit (1 - x * y) → IsUnit (1 - y * x) :=
    by
    refine' fun x y h => ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, _, _⟩, rfl⟩
    calc
      (1 - y * x) * (1 + y * (IsUnit.unit h).inv * x) =
          1 - y * x + y * ((1 - x * y) * h.unit.inv) * x :=
        by noncomm_ring
      _ = 1 := by simp only [Units.inv_eq_val_inv, IsUnit.mul_val_inv, mul_one, sub_add_cancel]

    calc
      (1 + y * (IsUnit.unit h).inv * x) * (1 - y * x) =
          1 - y * x + y * (h.unit.inv * (1 - x * y)) * x :=
        by noncomm_ring
      _ = 1 := by simp only [Units.inv_eq_val_inv, IsUnit.val_inv_mul, mul_one, sub_add_cancel]

  simpa only [mem_iff, not_iff_not, Algebra.algebraMap_eq_smul_one, ← Units.smul_def,
    IsUnit.smul_sub_iff_sub_inv_smul, ← smul_mul_assoc, ← mul_smul_comm r⁻¹ b a] using
    Iff.intro (h₁ (r⁻¹ • a) b) (h₁ b (r⁻¹ • a))
#align spectrum.unit_mem_mul_iff_mem_swap_mul spectrum.unit_mem_mul_iff_mem_swap_mul

theorem preimage_units_mul_eq_swap_mul {a b : A} :
    (coe : Rˣ → R) ⁻¹' σ (a * b) = coe ⁻¹' σ (b * a) :=
  Set.ext fun _ => unit_mem_mul_iff_mem_swap_mul
#align spectrum.preimage_units_mul_eq_swap_mul spectrum.preimage_units_mul_eq_swap_mul

section Star

variable [InvolutiveStar R] [StarRing A] [StarModule R A]

theorem star_mem_resolventSet_iff {r : R} {a : A} :
    star r ∈ resolventSet R a ↔ r ∈ resolventSet R (star a) := by
  refine' ⟨fun h => _, fun h => _⟩ <;>
    simpa only [mem_resolvent_set_iff, Algebra.algebraMap_eq_smul_one, star_sub, star_smul,
      star_star, star_one] using IsUnit.star h
#align spectrum.star_mem_resolvent_set_iff spectrum.star_mem_resolventSet_iff

protected theorem map_star (a : A) : σ (star a) = star (σ a) :=
  by
  ext
  simpa only [Set.mem_star, mem_iff, not_iff_not] using star_mem_resolvent_set_iff.symm
#align spectrum.map_star spectrum.map_star

end Star

end ScalarSemiring

section ScalarRing

variable {R : Type u} {A : Type v}

variable [CommRing R] [Ring A] [Algebra R A]

-- mathport name: exprσ
local notation "σ" => spectrum R

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap R A

-- it would be nice to state this for `subalgebra_class`, but we don't have such a thing yet
theorem subset_subalgebra {S : Subalgebra R A} (a : S) : spectrum R (a : A) ⊆ spectrum R a :=
  compl_subset_compl.2 fun _ => IsUnit.map S.val
#align spectrum.subset_subalgebra spectrum.subset_subalgebra

-- this is why it would be nice if `subset_subalgebra` was registered for `subalgebra_class`.
theorem subset_starSubalgebra [StarRing R] [StarRing A] [StarModule R A] {S : StarSubalgebra R A}
    (a : S) : spectrum R (a : A) ⊆ spectrum R a :=
  compl_subset_compl.2 fun _ => IsUnit.map S.Subtype
#align spectrum.subset_star_subalgebra spectrum.subset_starSubalgebra

theorem singleton_add_eq (a : A) (r : R) : {r} + σ a = σ (↑ₐ r + a) :=
  ext fun x => by
    rw [singleton_add, image_add_left, mem_preimage, add_comm, add_mem_iff, map_neg, neg_neg]
#align spectrum.singleton_add_eq spectrum.singleton_add_eq

theorem add_singleton_eq (a : A) (r : R) : σ a + {r} = σ (a + ↑ₐ r) :=
  add_comm {r} (σ a) ▸ add_comm (algebraMap R A r) a ▸ singleton_add_eq a r
#align spectrum.add_singleton_eq spectrum.add_singleton_eq

theorem vadd_eq (a : A) (r : R) : r +ᵥ σ a = σ (↑ₐ r + a) :=
  singleton_add.symm.trans <| singleton_add_eq a r
#align spectrum.vadd_eq spectrum.vadd_eq

theorem neg_eq (a : A) : -σ a = σ (-a) :=
  Set.ext fun x => by
    simp only [mem_neg, mem_iff, map_neg, ← neg_add', IsUnit.neg_iff, sub_neg_eq_add]
#align spectrum.neg_eq spectrum.neg_eq

theorem singleton_sub_eq (a : A) (r : R) : {r} - σ a = σ (↑ₐ r - a) := by
  rw [sub_eq_add_neg, neg_eq, singleton_add_eq, sub_eq_add_neg]
#align spectrum.singleton_sub_eq spectrum.singleton_sub_eq

theorem sub_singleton_eq (a : A) (r : R) : σ a - {r} = σ (a - ↑ₐ r) := by
  simpa only [neg_sub, neg_eq] using congr_arg Neg.neg (singleton_sub_eq a r)
#align spectrum.sub_singleton_eq spectrum.sub_singleton_eq

open Polynomial

theorem exists_mem_of_not_isUnit_aeval_prod [IsDomain R] {p : R[X]} {a : A} (hp : p ≠ 0)
    (h : ¬IsUnit (aeval a (Multiset.map (fun x : R => X - C x) p.roots).Prod)) :
    ∃ k : R, k ∈ σ a ∧ eval k p = 0 :=
  by
  rw [← Multiset.prod_toList, AlgHom.map_list_prod] at h
  replace h := mt List.prod_isUnit h
  simp only [not_forall, exists_prop, aeval_C, Multiset.mem_toList, List.mem_map, aeval_X,
    exists_exists_and_eq_and, Multiset.mem_map, AlgHom.map_sub] at h
  rcases h with ⟨r, r_mem, r_nu⟩
  exact ⟨r, by rwa [mem_iff, ← IsUnit.sub_iff], by rwa [← is_root.def, ← mem_roots hp]⟩
#align spectrum.exists_mem_of_not_is_unit_aeval_prod spectrum.exists_mem_of_not_isUnit_aeval_prod

end ScalarRing

section ScalarField

variable {𝕜 : Type u} {A : Type v}

variable [Field 𝕜] [Ring A] [Algebra 𝕜 A]

-- mathport name: exprσ
local notation "σ" => spectrum 𝕜

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap 𝕜 A

/-- Without the assumption `nontrivial A`, then `0 : A` would be invertible. -/
@[simp]
theorem zero_eq [Nontrivial A] : σ (0 : A) = {0} :=
  by
  refine' Set.Subset.antisymm _ (by simp [Algebra.algebraMap_eq_smul_one, mem_iff])
  rw [spectrum, Set.compl_subset_comm]
  intro k hk
  rw [Set.mem_compl_singleton_iff] at hk
  have : IsUnit (Units.mk0 k hk • (1 : A)) := IsUnit.smul (Units.mk0 k hk) isUnit_one
  simpa [mem_resolvent_set_iff, Algebra.algebraMap_eq_smul_one]
#align spectrum.zero_eq spectrum.zero_eq

@[simp]
theorem scalar_eq [Nontrivial A] (k : 𝕜) : σ (↑ₐ k) = {k} := by
  rw [← add_zero (↑ₐ k), ← singleton_add_eq, zero_eq, Set.singleton_add_singleton, add_zero]
#align spectrum.scalar_eq spectrum.scalar_eq

@[simp]
theorem one_eq [Nontrivial A] : σ (1 : A) = {1} :=
  calc
    σ (1 : A) = σ (↑ₐ 1) := by rw [Algebra.algebraMap_eq_smul_one, one_smul]
    _ = {1} := scalar_eq 1

#align spectrum.one_eq spectrum.one_eq

/-- the assumption `(σ a).nonempty` is necessary and cannot be removed without
    further conditions on the algebra `A` and scalar field `𝕜`. -/
theorem smul_eq_smul [Nontrivial A] (k : 𝕜) (a : A) (ha : (σ a).Nonempty) : σ (k • a) = k • σ a :=
  by
  rcases eq_or_ne k 0 with (rfl | h)
  · simpa [ha, zero_smul_set]
  · exact unit_smul_eq_smul a (Units.mk0 k h)
#align spectrum.smul_eq_smul spectrum.smul_eq_smul

theorem nonzero_mul_eq_swap_mul (a b : A) : σ (a * b) \ {0} = σ (b * a) \ {0} :=
  by
  suffices h : ∀ x y : A, σ (x * y) \ {0} ⊆ σ (y * x) \ {0}
  · exact Set.eq_of_subset_of_subset (h a b) (h b a)
  · rintro _ _ k ⟨k_mem, k_neq⟩
    change k with ↑(Units.mk0 k k_neq) at k_mem
    exact ⟨unit_mem_mul_iff_mem_swap_mul.mp k_mem, k_neq⟩
#align spectrum.nonzero_mul_eq_swap_mul spectrum.nonzero_mul_eq_swap_mul

protected theorem map_inv (a : Aˣ) : (σ (a : A))⁻¹ = σ (↑a⁻¹ : A) :=
  by
  refine' Set.eq_of_subset_of_subset (fun k hk => _) fun k hk => _
  · rw [Set.mem_inv] at hk
    have : k ≠ 0 := by simpa only [inv_inv] using inv_ne_zero (ne_zero_of_mem_of_unit hk)
    lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr this
    rw [← Units.val_inv_eq_inv_val k] at hk
    exact inv_mem_iff.mp hk
  · lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr (ne_zero_of_mem_of_unit hk)
    simpa only [Units.val_inv_eq_inv_val] using inv_mem_iff.mp hk
#align spectrum.map_inv spectrum.map_inv

open Polynomial

/-- Half of the spectral mapping theorem for polynomials. We prove it separately
because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and
`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/
theorem subset_polynomial_aeval (a : A) (p : 𝕜[X]) : (fun k => eval k p) '' σ a ⊆ σ (aeval a p) :=
  by
  rintro _ ⟨k, hk, rfl⟩
  let q := C (eval k p) - p
  have hroot : is_root q k := by simp only [eval_C, eval_sub, sub_self, is_root.def]
  rw [← mul_div_eq_iff_is_root, ← neg_mul_neg, neg_sub] at hroot
  have aeval_q_eq : ↑ₐ (eval k p) - aeval a p = aeval a q := by
    simp only [aeval_C, AlgHom.map_sub, sub_left_inj]
  rw [mem_iff, aeval_q_eq, ← hroot, aeval_mul]
  have hcomm := (Commute.all (C k - X) (-(q / (X - C k)))).map (aeval a)
  apply mt fun h => (hcomm.is_unit_mul_iff.mp h).1
  simpa only [aeval_X, aeval_C, AlgHom.map_sub] using hk
#align spectrum.subset_polynomial_aeval spectrum.subset_polynomial_aeval

/-- The *spectral mapping theorem* for polynomials.  Note: the assumption `degree p > 0`
is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side,
assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/
theorem map_polynomial_aeval_of_degree_pos [IsAlgClosed 𝕜] (a : A) (p : 𝕜[X])
    (hdeg : 0 < degree p) : σ (aeval a p) = (fun k => eval k p) '' σ a :=
  by
  -- handle the easy direction via `spectrum.subset_polynomial_aeval`
  refine' Set.eq_of_subset_of_subset (fun k hk => _) (subset_polynomial_aeval a p)
  -- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`.
  have hprod := eq_prod_roots_of_splits_id (IsAlgClosed.splits (C k - p))
  have h_ne : C k - p ≠ 0 :=
    ne_zero_of_degree_gt
      (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)])
  have lead_ne := leading_coeff_ne_zero.mpr h_ne
  have lead_unit := (Units.map ↑ₐ.toMonoidHom (Units.mk0 _ lead_ne)).IsUnit
  /- leading coefficient is a unit so product of linear factors is not a unit;
    apply `exists_mem_of_not_is_unit_aeval_prod`. -/
  have p_a_eq : aeval a (C k - p) = ↑ₐ k - aeval a p := by
    simp only [aeval_C, AlgHom.map_sub, sub_left_inj]
  rw [mem_iff, ← p_a_eq, hprod, aeval_mul, ((Commute.all _ _).map (aeval a)).isUnit_mul_iff,
    aeval_C] at hk
  replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit)
  rcases hk with ⟨r, r_mem, r_ev⟩
  exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩
#align spectrum.map_polynomial_aeval_of_degree_pos spectrum.map_polynomial_aeval_of_degree_pos

/-- In this version of the spectral mapping theorem, we assume the spectrum
is nonempty instead of assuming the degree of the polynomial is positive. -/
theorem map_polynomial_aeval_of_nonempty [IsAlgClosed 𝕜] (a : A) (p : 𝕜[X])
    (hnon : (σ a).Nonempty) : σ (aeval a p) = (fun k => eval k p) '' σ a :=
  by
  nontriviality A
  refine' Or.elim (le_or_gt (degree p) 0) (fun h => _) (map_polynomial_aeval_of_degree_pos a p)
  · rw [eq_C_of_degree_le_zero h]
    simp only [Set.image_congr, eval_C, aeval_C, scalar_eq, Set.Nonempty.image_const hnon]
#align spectrum.map_polynomial_aeval_of_nonempty spectrum.map_polynomial_aeval_of_nonempty

/-- A specialization of `spectrum.subset_polynomial_aeval` to monic monomials for convenience. -/
theorem pow_image_subset (a : A) (n : ℕ) : (fun x => x ^ n) '' σ a ⊆ σ (a ^ n) := by
  simpa only [eval_pow, eval_X, aeval_X_pow] using subset_polynomial_aeval a (X ^ n : 𝕜[X])
#align spectrum.pow_image_subset spectrum.pow_image_subset

/-- A specialization of `spectrum.map_polynomial_aeval_of_nonempty` to monic monomials for
convenience. -/
theorem map_pow_of_pos [IsAlgClosed 𝕜] (a : A) {n : ℕ} (hn : 0 < n) :
    σ (a ^ n) = (fun x => x ^ n) '' σ a := by
  simpa only [aeval_X_pow, eval_pow, eval_X] using
    map_polynomial_aeval_of_degree_pos a (X ^ n : 𝕜[X])
      (by
        rw_mod_cast [degree_X_pow]
        exact hn)
#align spectrum.map_pow_of_pos spectrum.map_pow_of_pos

/-- A specialization of `spectrum.map_polynomial_aeval_of_nonempty` to monic monomials for
convenience. -/
theorem map_pow_of_nonempty [IsAlgClosed 𝕜] {a : A} (ha : (σ a).Nonempty) (n : ℕ) :
    σ (a ^ n) = (fun x => x ^ n) '' σ a := by
  simpa only [aeval_X_pow, eval_pow, eval_X] using map_polynomial_aeval_of_nonempty a (X ^ n) ha
#align spectrum.map_pow_of_nonempty spectrum.map_pow_of_nonempty

variable (𝕜)

-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
/-- Every element `a` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `𝕜` has non-empty spectrum. -/
theorem nonempty_of_isAlgClosed_of_finiteDimensional [IsAlgClosed 𝕜] [Nontrivial A]
    [I : FiniteDimensional 𝕜 A] (a : A) : ∃ k : 𝕜, k ∈ σ a :=
  by
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := isIntegral_of_noetherian (IsNoetherian.iff_fg.2 I) a
  have nu : ¬IsUnit (aeval a p) := by
    rw [← aeval_def] at h_eval_p
    rw [h_eval_p]
    simp
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (IsAlgClosed.splits p)] at nu
  obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu
  exact ⟨k, hk⟩
#align spectrum.nonempty_of_is_alg_closed_of_finite_dimensional spectrum.nonempty_of_isAlgClosed_of_finiteDimensional

end ScalarField

end spectrum

namespace AlgHom

section CommSemiring

variable {F R A B : Type _} [CommRing R] [Ring A] [Algebra R A] [Ring B] [Algebra R B]

variable [AlgHomClass F R A B]

-- mathport name: exprσ
local notation "σ" => spectrum R

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap R A

theorem mem_resolventSet_apply (φ : F) {a : A} {r : R} (h : r ∈ resolventSet R a) :
    r ∈ resolventSet R ((φ : A → B) a) := by
  simpa only [map_sub, AlgHomClass.commutes] using h.map φ
#align alg_hom.mem_resolvent_set_apply AlgHom.mem_resolventSet_apply

theorem spectrum_apply_subset (φ : F) (a : A) : σ ((φ : A → B) a) ⊆ σ a := fun _ =>
  mt (mem_resolventSet_apply φ)
#align alg_hom.spectrum_apply_subset AlgHom.spectrum_apply_subset

end CommSemiring

section CommRing

variable {F R A B : Type _} [CommRing R] [Ring A] [Algebra R A] [Ring B] [Algebra R B]

variable [AlgHomClass F R A R]

-- mathport name: exprσ
local notation "σ" => spectrum R

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap R A

theorem apply_mem_spectrum [Nontrivial R] (φ : F) (a : A) : φ a ∈ σ a :=
  by
  have h : ↑ₐ (φ a) - a ∈ (φ : A →+* R).ker := by
    simp only [RingHom.mem_ker, map_sub, RingHom.coe_coe, AlgHomClass.commutes,
      Algebra.id.map_eq_id, RingHom.id_apply, sub_self]
  simp only [spectrum.mem_iff, ← mem_nonunits_iff, coe_subset_nonunits (φ : A →+* R).ker_ne_top h]
#align alg_hom.apply_mem_spectrum AlgHom.apply_mem_spectrum

end CommRing

end AlgHom


/-  Math40001 : Introduction to university mathematics.

Problem Sheet 2, October 2020.

This is a Lean file. It can be read with the Lean theorem prover.

You can work on this file online via the link at
https://github.com/ImperialCollegeLondon/M40001_lean/blob/master/README.md

or you can install Lean and its maths library following the
instructions at
https://leanprover-community.github.io/get_started.html

and then just clone the project onto your own computer
with `leanproject get ImperialCollegeLondon/M40001_lean`.

There are advantages to installing Lean on your own computer
(for example it's faster), but it's more hassle than
just using it online.

In the below, delete "sorry" and replace it with some
tactics which prove the result.

-/

import data.real.basic -- need real numbers for Q5

-- Q1 prove that ∩ is symmetric
lemma question1 (α : Type) (X Y : set α) : X ∩ Y = Y ∩ X :=
begin
  sorry
end

-- question 2 defs
def A := {x : ℝ | x ^ 2 < 3}
def B := {x : ℝ | ∃ n : ℤ, x = n ∧ x ^ 2 < 3}
def C := {x : ℝ | x ^ 3 < 3}

-- Change _true to _false and put a ¬ in front
-- of the goal if you think it's false.
-- e.g. if you think 2c is false then don't
-- try to prove it's true, try proving
-- lemma question2c_false : ¬ (A ⊆ C) := ...

-- Some of these are tricky for Lean beginners.

lemma question2a_true : (1 : ℝ)/2 ∈ A ∩ B :=
begin
  sorry
end

lemma question2b_true : (1 : ℝ)/2 ∈ A ∪ B :=
begin
  sorry
end

lemma question2c_true : A ⊆ C :=
begin
  sorry
end

lemma question2d_true : B ⊆ C :=
begin
  sorry
end

lemma question2e_true : C ⊆ A ∪ B :=
begin
  sorry
end

lemma question2f_true : (A ∩ B) ∪ C = (A ∪ B) ∩ C :=
begin
  sorry
end

-- Q3 set-up
variables (X Y : Type)
variable (P : X → Prop)
variable (Q : X → Prop)
variable (R : X → Y → Prop)

-- for Q3 you're going to have to change the right hand
-- side of the ↔ in the statement
-- of the lemma to the answer you think is correct.

lemma question3a : ¬ (∀ x : X, P x ∧ ¬ Q x) ↔ true := -- change `true`!
begin
  sorry
end

lemma question3b : ¬ (∃ x : X, (¬ P x) ∧ Q x) ↔ true := -- change `true`!
begin
  sorry
end

lemma question3c : ¬ (∀ x : X, ∃ y : Y, R x y) ↔ true := -- change `true`!
begin
  sorry
end

example (f : ℝ → ℝ) (x : ℝ) :
  ¬ (∀ ε : ℝ, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ y : ℝ, abs (y - x) < δ → abs (f y -f x) < ε )
↔ -- change next line to what you think the answer is
true :=
begin
  sorry
end

-- change _true to _false in 4a, 4b if you think the opposite is true
-- and stick a `¬` in front of it
lemma question4a_true : ∀ x : ℝ, ∃ y : ℝ, x + y = 2 :=
begin
  sorry
end

lemma question4b_true : ∃ y : ℝ, ∀ x : ℝ, x + y = 2 :=
begin
  sorry
end

-- similarly for Q5 -- change _true to _false and add in a negation if you
-- want to prove that the proposition in the question is false.
lemma question5a_true : ∃ x ∈ (∅ : set ℕ), 2 + 2 = 5 :=
begin
  sorry
end

lemma question5b_true : ∀ x ∈ (∅ : set ℕ), 2 + 2 = 5 :=
begin
  sorry
end