/-
Copyright (c) 2022 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 analysis.normed_space.matrix_exponential
! leanprover-community/mathlib commit 1e3201306d4d9eb1fd54c60d7c4510ad5126f6f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Exponential
import Mathbin.Analysis.Matrix
import Mathbin.LinearAlgebra.Matrix.Zpow
import Mathbin.LinearAlgebra.Matrix.Hermitian
import Mathbin.LinearAlgebra.Matrix.Symmetric
import Mathbin.Topology.UniformSpace.Matrix

/-!
# Lemmas about the matrix exponential

In this file, we provide results about `exp` on `matrix`s over a topological or normed algebra.
Note that generic results over all topological spaces such as `exp_zero` can be used on matrices
without issue, so are not repeated here. The topological results specific to matrices are:

* `matrix.exp_transpose`
* `matrix.exp_conj_transpose`
* `matrix.exp_diagonal`
* `matrix.exp_block_diagonal`
* `matrix.exp_block_diagonal'`

Lemmas like `exp_add_of_commute` require a canonical norm on the type; while there are multiple
sensible choices for the norm of a `matrix` (`matrix.normed_add_comm_group`,
`matrix.frobenius_normed_add_comm_group`, `matrix.linfty_op_normed_add_comm_group`), none of them
are canonical. In an application where a particular norm is chosen using
`local attribute [instance]`, then the usual lemmas about `exp` are fine. When choosing a norm is
undesirable, the results in this file can be used.

In this file, we copy across the lemmas about `exp`, but hide the requirement for a norm inside the
proof.

* `matrix.exp_add_of_commute`
* `matrix.exp_sum_of_commute`
* `matrix.exp_nsmul`
* `matrix.is_unit_exp`
* `matrix.exp_units_conj`
* `matrix.exp_units_conj'`

Additionally, we prove some results about `matrix.has_inv` and `matrix.div_inv_monoid`, as the
results for general rings are instead stated about `ring.inverse`:

* `matrix.exp_neg`
* `matrix.exp_zsmul`
* `matrix.exp_conj`
* `matrix.exp_conj'`

## Implementation notes

This file runs into some sharp edges on typeclass search in lean 3, especially regarding pi types.
To work around this, we copy a handful of instances for when lean can't find them by itself.
Hopefully we will be able to remove these in Lean 4.

## TODO

* Show that `matrix.det (exp 𝕂 A) = exp 𝕂 (matrix.trace A)`

## References

* https://en.wikipedia.org/wiki/Matrix_exponential
-/

open Matrix BigOperators

section HacksForPiInstanceSearch

/-- A special case of `pi.topological_ring` for when `R` is not dependently typed. -/
instance Function.topologicalRing (I : Type _) (R : Type _) [NonUnitalRing R] [TopologicalSpace R]
    [TopologicalRing R] : TopologicalRing (I → R) :=
  Pi.topologicalRing
#align function.topological_ring Function.topologicalRing

/-- A special case of `function.algebra` for when A is a `ring` not a `semiring` -/
instance Function.algebraRing (I : Type _) {R : Type _} (A : Type _) [CommSemiring R] [Ring A]
    [Algebra R A] : Algebra R (I → A) :=
  Pi.algebra _ _
#align function.algebra_ring Function.algebraRing

/-- A special case of `pi.algebra` for when `f = λ i, matrix (m i) (m i) A`. -/
instance Pi.matrixAlgebra (I R A : Type _) (m : I → Type _) [CommSemiring R] [Semiring A]
    [Algebra R A] [∀ i, Fintype (m i)] [∀ i, DecidableEq (m i)] :
    Algebra R (∀ i, Matrix (m i) (m i) A) :=
  @Pi.algebra I R (fun i => Matrix (m i) (m i) A) _ _ fun i => Matrix.algebra
#align pi.matrix_algebra Pi.matrixAlgebra

/-- A special case of `pi.topological_ring` for when `f = λ i, matrix (m i) (m i) A`. -/
instance Pi.matrix_topologicalRing (I A : Type _) (m : I → Type _) [Ring A] [TopologicalSpace A]
    [TopologicalRing A] [∀ i, Fintype (m i)] : TopologicalRing (∀ i, Matrix (m i) (m i) A) :=
  @Pi.topologicalRing _ (fun i => Matrix (m i) (m i) A) _ _ fun i => Matrix.topologicalRing
#align pi.matrix_topological_ring Pi.matrix_topologicalRing

end HacksForPiInstanceSearch

variable (𝕂 : Type _) {m n p : Type _} {n' : m → Type _} {𝔸 : Type _}

namespace Matrix

section Topological

section Ring

variable [Fintype m] [DecidableEq m] [Fintype n] [DecidableEq n] [∀ i, Fintype (n' i)]
  [∀ i, DecidableEq (n' i)] [Field 𝕂] [Ring 𝔸] [TopologicalSpace 𝔸] [TopologicalRing 𝔸]
  [Algebra 𝕂 𝔸] [T2Space 𝔸]

theorem exp_diagonal (v : m → 𝔸) : exp 𝕂 (diagonal v) = diagonal (exp 𝕂 v) := by
  simp_rw [exp_eq_tsum, diagonal_pow, ← diagonal_smul, ← diagonal_tsum]
#align matrix.exp_diagonal Matrix.exp_diagonal

theorem exp_blockDiagonal (v : m → Matrix n n 𝔸) :
    exp 𝕂 (blockDiagonal v) = blockDiagonal (exp 𝕂 v) := by
  simp_rw [exp_eq_tsum, ← block_diagonal_pow, ← block_diagonal_smul, ← block_diagonal_tsum]
#align matrix.exp_block_diagonal Matrix.exp_blockDiagonal

theorem exp_blockDiagonal' (v : ∀ i, Matrix (n' i) (n' i) 𝔸) :
    exp 𝕂 (blockDiagonal' v) = blockDiagonal' (exp 𝕂 v) := by
  simp_rw [exp_eq_tsum, ← block_diagonal'_pow, ← block_diagonal'_smul, ← block_diagonal'_tsum]
#align matrix.exp_block_diagonal' Matrix.exp_blockDiagonal'

theorem exp_conjTranspose [StarRing 𝔸] [ContinuousStar 𝔸] (A : Matrix m m 𝔸) :
    exp 𝕂 Aᴴ = (exp 𝕂 A)ᴴ :=
  (star_exp A).symm
#align matrix.exp_conj_transpose Matrix.exp_conjTranspose

theorem IsHermitian.exp [StarRing 𝔸] [ContinuousStar 𝔸] {A : Matrix m m 𝔸} (h : A.IsHermitian) :
    (exp 𝕂 A).IsHermitian :=
  (exp_conjTranspose _ _).symm.trans <| congr_arg _ h
#align matrix.is_hermitian.exp Matrix.IsHermitian.exp

end Ring

section CommRing

variable [Fintype m] [DecidableEq m] [Field 𝕂] [CommRing 𝔸] [TopologicalSpace 𝔸] [TopologicalRing 𝔸]
  [Algebra 𝕂 𝔸] [T2Space 𝔸]

theorem exp_transpose (A : Matrix m m 𝔸) : exp 𝕂 Aᵀ = (exp 𝕂 A)ᵀ := by
  simp_rw [exp_eq_tsum, transpose_tsum, transpose_smul, transpose_pow]
#align matrix.exp_transpose Matrix.exp_transpose

theorem IsSymm.exp {A : Matrix m m 𝔸} (h : A.IsSymm) : (exp 𝕂 A).IsSymm :=
  (exp_transpose _ _).symm.trans <| congr_arg _ h
#align matrix.is_symm.exp Matrix.IsSymm.exp

end CommRing

end Topological

section Normed

variable [IsROrC 𝕂] [Fintype m] [DecidableEq m] [Fintype n] [DecidableEq n] [∀ i, Fintype (n' i)]
  [∀ i, DecidableEq (n' i)] [NormedRing 𝔸] [NormedAlgebra 𝕂 𝔸] [CompleteSpace 𝔸]

theorem exp_add_of_commute (A B : Matrix m m 𝔸) (h : Commute A B) :
    exp 𝕂 (A + B) = exp 𝕂 A ⬝ exp 𝕂 B :=
  by
  letI : SeminormedRing (Matrix m m 𝔸) := Matrix.linftyOpSemiNormedRing
  letI : NormedRing (Matrix m m 𝔸) := Matrix.linftyOpNormedRing
  letI : NormedAlgebra 𝕂 (Matrix m m 𝔸) := Matrix.linftyOpNormedAlgebra
  exact exp_add_of_commute h
#align matrix.exp_add_of_commute Matrix.exp_add_of_commute

theorem exp_sum_of_commute {ι} (s : Finset ι) (f : ι → Matrix m m 𝔸)
    (h : (s : Set ι).Pairwise fun i j => Commute (f i) (f j)) :
    exp 𝕂 (∑ i in s, f i) =
      s.noncommProd (fun i => exp 𝕂 (f i)) fun i hi j hj _ => (h.of_refl hi hj).exp 𝕂 :=
  by
  letI : SeminormedRing (Matrix m m 𝔸) := Matrix.linftyOpSemiNormedRing
  letI : NormedRing (Matrix m m 𝔸) := Matrix.linftyOpNormedRing
  letI : NormedAlgebra 𝕂 (Matrix m m 𝔸) := Matrix.linftyOpNormedAlgebra
  exact exp_sum_of_commute s f h
#align matrix.exp_sum_of_commute Matrix.exp_sum_of_commute

theorem exp_nsmul (n : ℕ) (A : Matrix m m 𝔸) : exp 𝕂 (n • A) = exp 𝕂 A ^ n :=
  by
  letI : SeminormedRing (Matrix m m 𝔸) := Matrix.linftyOpSemiNormedRing
  letI : NormedRing (Matrix m m 𝔸) := Matrix.linftyOpNormedRing
  letI : NormedAlgebra 𝕂 (Matrix m m 𝔸) := Matrix.linftyOpNormedAlgebra
  exact exp_nsmul n A
#align matrix.exp_nsmul Matrix.exp_nsmul

theorem isUnit_exp (A : Matrix m m 𝔸) : IsUnit (exp 𝕂 A) :=
  by
  letI : SeminormedRing (Matrix m m 𝔸) := Matrix.linftyOpSemiNormedRing
  letI : NormedRing (Matrix m m 𝔸) := Matrix.linftyOpNormedRing
  letI : NormedAlgebra 𝕂 (Matrix m m 𝔸) := Matrix.linftyOpNormedAlgebra
  exact isUnit_exp _ A
#align matrix.is_unit_exp Matrix.isUnit_exp

theorem exp_units_conj (U : (Matrix m m 𝔸)ˣ) (A : Matrix m m 𝔸) :
    exp 𝕂 (↑U ⬝ A ⬝ ↑U⁻¹ : Matrix m m 𝔸) = ↑U ⬝ exp 𝕂 A ⬝ ↑U⁻¹ :=
  by
  letI : SeminormedRing (Matrix m m 𝔸) := Matrix.linftyOpSemiNormedRing
  letI : NormedRing (Matrix m m 𝔸) := Matrix.linftyOpNormedRing
  letI : NormedAlgebra 𝕂 (Matrix m m 𝔸) := Matrix.linftyOpNormedAlgebra
  exact exp_units_conj _ U A
#align matrix.exp_units_conj Matrix.exp_units_conj

theorem exp_units_conj' (U : (Matrix m m 𝔸)ˣ) (A : Matrix m m 𝔸) :
    exp 𝕂 (↑U⁻¹ ⬝ A ⬝ U : Matrix m m 𝔸) = ↑U⁻¹ ⬝ exp 𝕂 A ⬝ U :=
  exp_units_conj 𝕂 U⁻¹ A
#align matrix.exp_units_conj' Matrix.exp_units_conj'

end Normed

section NormedComm

variable [IsROrC 𝕂] [Fintype m] [DecidableEq m] [Fintype n] [DecidableEq n] [∀ i, Fintype (n' i)]
  [∀ i, DecidableEq (n' i)] [NormedCommRing 𝔸] [NormedAlgebra 𝕂 𝔸] [CompleteSpace 𝔸]

theorem exp_neg (A : Matrix m m 𝔸) : exp 𝕂 (-A) = (exp 𝕂 A)⁻¹ :=
  by
  rw [nonsing_inv_eq_ring_inverse]
  letI : SeminormedRing (Matrix m m 𝔸) := Matrix.linftyOpSemiNormedRing
  letI : NormedRing (Matrix m m 𝔸) := Matrix.linftyOpNormedRing
  letI : NormedAlgebra 𝕂 (Matrix m m 𝔸) := Matrix.linftyOpNormedAlgebra
  exact (Ring.inverse_exp _ A).symm
#align matrix.exp_neg Matrix.exp_neg

theorem exp_zsmul (z : ℤ) (A : Matrix m m 𝔸) : exp 𝕂 (z • A) = exp 𝕂 A ^ z :=
  by
  obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg
  · rw [zpow_ofNat, coe_nat_zsmul, exp_nsmul]
  · have : IsUnit (exp 𝕂 A).det := (Matrix.isUnit_iff_isUnit_det _).mp (isUnit_exp _ _)
    rw [Matrix.zpow_neg this, zpow_ofNat, neg_smul, exp_neg, coe_nat_zsmul, exp_nsmul]
#align matrix.exp_zsmul Matrix.exp_zsmul

theorem exp_conj (U : Matrix m m 𝔸) (A : Matrix m m 𝔸) (hy : IsUnit U) :
    exp 𝕂 (U ⬝ A ⬝ U⁻¹) = U ⬝ exp 𝕂 A ⬝ U⁻¹ :=
  let ⟨u, hu⟩ := hy
  hu ▸ by simpa only [Matrix.coe_units_inv] using exp_units_conj 𝕂 u A
#align matrix.exp_conj Matrix.exp_conj

theorem exp_conj' (U : Matrix m m 𝔸) (A : Matrix m m 𝔸) (hy : IsUnit U) :
    exp 𝕂 (U⁻¹ ⬝ A ⬝ U) = U⁻¹ ⬝ exp 𝕂 A ⬝ U :=
  let ⟨u, hu⟩ := hy
  hu ▸ by simpa only [Matrix.coe_units_inv] using exp_units_conj' 𝕂 u A
#align matrix.exp_conj' Matrix.exp_conj'

end NormedComm

end Matrix


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Joey van Langen, Casper Putz
-/
import tactic.apply_fun
import data.equiv.ring
import data.zmod.basic
import linear_algebra.basis
import ring_theory.integral_domain
import field_theory.separable

/-!
# Finite fields

This file contains basic results about finite fields.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

See `ring_theory.integral_domain` for the fact that the unit group of a finite field is a
cyclic group, as well as the fact that every finite integral domain is a field
(`field_of_integral_domain`).

## Main results

1. `card_units`: The unit group of a finite field is has cardinality `q - 1`.
2. `sum_pow_units`: The sum of `x^i`, where `x` ranges over the units of `K`, is
   - `q-1` if `q-1 ∣ i`
   - `0`   otherwise
3. `finite_field.card`: The cardinality `q` is a power of the characteristic of `K`.
   See `card'` for a variant.

## Notation

Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

-/

variables {K : Type*} [field K] [fintype K]
variables {R : Type*} [integral_domain R]
local notation `q` := fintype.card K

open_locale big_operators

namespace finite_field
open finset function

section polynomial

open polynomial

/-- The cardinality of a field is at most `n` times the cardinality of the image of a degree `n`
  polynomial -/
lemma card_image_polynomial_eval [decidable_eq R] [fintype R] {p : polynomial R}
  (hp : 0 < p.degree) : fintype.card R ≤ nat_degree p * (univ.image (λ x, eval x p)).card :=
finset.card_le_mul_card_image _ _
  (λ a _, calc _ = (p - C a).roots.to_finset.card : congr_arg card
    (by simp [finset.ext_iff, mem_roots_sub_C hp])
    ... ≤ (p - C a).roots.card : multiset.to_finset_card_le _
    ... ≤ _ : card_roots_sub_C' hp)

/-- If `f` and `g` are quadratic polynomials, then the `f.eval a + g.eval b = 0` has a solution. -/
lemma exists_root_sum_quadratic [fintype R] {f g : polynomial R} (hf2 : degree f = 2)
  (hg2 : degree g = 2) (hR : fintype.card R % 2 = 1) : ∃ a b, f.eval a + g.eval b = 0 :=
by letI := classical.dec_eq R; exact
suffices ¬ disjoint (univ.image (λ x : R, eval x f)) (univ.image (λ x : R, eval x (-g))),
begin
  simp only [disjoint_left, mem_image] at this,
  push_neg at this,
  rcases this with ⟨x, ⟨a, _, ha⟩, ⟨b, _, hb⟩⟩,
  exact ⟨a, b, by rw [ha, ← hb, eval_neg, neg_add_self]⟩
end,
assume hd : disjoint _ _,
lt_irrefl (2 * ((univ.image (λ x : R, eval x f)) ∪ (univ.image (λ x : R, eval x (-g)))).card) $
calc 2 * ((univ.image (λ x : R, eval x f)) ∪ (univ.image (λ x : R, eval x (-g)))).card
    ≤ 2 * fintype.card R : nat.mul_le_mul_left _ (finset.card_le_univ _)
... = fintype.card R + fintype.card R : two_mul _
... < nat_degree f * (univ.image (λ x : R, eval x f)).card +
      nat_degree (-g) * (univ.image (λ x : R, eval x (-g))).card :
    add_lt_add_of_lt_of_le
      (lt_of_le_of_ne
        (card_image_polynomial_eval (by rw hf2; exact dec_trivial))
        (mt (congr_arg (%2)) (by simp [nat_degree_eq_of_degree_eq_some hf2, hR])))
      (card_image_polynomial_eval (by rw [degree_neg, hg2]; exact dec_trivial))
... = 2 * (univ.image (λ x : R, eval x f) ∪ univ.image (λ x : R, eval x (-g))).card :
  by rw [card_disjoint_union hd]; simp [nat_degree_eq_of_degree_eq_some hf2,
    nat_degree_eq_of_degree_eq_some hg2, bit0, mul_add]

end polynomial

lemma card_units : fintype.card (units K) = fintype.card K - 1 :=
begin
  classical,
  rw [eq_comm, nat.sub_eq_iff_eq_add (fintype.card_pos_iff.2 ⟨(0 : K)⟩)],
  haveI := set_fintype {a : K | a ≠ 0},
  haveI := set_fintype (@set.univ K),
  rw [fintype.card_congr (equiv.units_equiv_ne_zero _),
    ← @set.card_insert _ _ {a : K | a ≠ 0} _ (not_not.2 (eq.refl (0 : K)))
    (set.fintype_insert _ _), fintype.card_congr (equiv.set.univ K).symm],
  congr; simp [set.ext_iff, classical.em]
end

lemma prod_univ_units_id_eq_neg_one :
  (∏ x : units K, x) = (-1 : units K) :=
begin
  classical,
  have : (∏ x in (@univ (units K) _).erase (-1), x) = 1,
  from prod_involution (λ x _, x⁻¹) (by simp)
    (λ a, by simp [units.inv_eq_self_iff] {contextual := tt})
    (λ a, by simp [@inv_eq_iff_inv_eq _ _ a, eq_comm] {contextual := tt})
    (by simp),
  rw [← insert_erase (mem_univ (-1 : units K)), prod_insert (not_mem_erase _ _),
      this, mul_one]
end

lemma pow_card_sub_one_eq_one (a : K) (ha : a ≠ 0) : a ^ (q - 1) = 1 :=
calc a ^ (fintype.card K - 1) = (units.mk0 a ha ^ (fintype.card K - 1) : units K) :
    by rw [units.coe_pow, units.coe_mk0]
  ... = 1 : by { classical, rw [← card_units, pow_card_eq_one], refl }

lemma pow_card (a : K) : a ^ q = a :=
begin
  have hp : fintype.card K > 0 := fintype.card_pos_iff.2 (by apply_instance),
  by_cases h : a = 0, { rw h, apply zero_pow hp },
  rw [← nat.succ_pred_eq_of_pos hp, pow_succ, nat.pred_eq_sub_one,
    pow_card_sub_one_eq_one a h, mul_one],
end

variable (K)

theorem card (p : ℕ) [char_p K p] : ∃ (n : ℕ+), nat.prime p ∧ q = p^(n : ℕ) :=
begin
  haveI hp : fact p.prime := ⟨char_p.char_is_prime K p⟩,
  letI : module (zmod p) K := { .. (zmod.cast_hom (dvd_refl _) K).to_module },
  obtain ⟨n, h⟩ := vector_space.card_fintype (zmod p) K,
  rw zmod.card at h,
  refine ⟨⟨n, _⟩, hp.1, h⟩,
  apply or.resolve_left (nat.eq_zero_or_pos n),
  rintro rfl,
  rw pow_zero at h,
  have : (0 : K) = 1, { apply fintype.card_le_one_iff.mp (le_of_eq h) },
  exact absurd this zero_ne_one,
end

theorem card' : ∃ (p : ℕ) (n : ℕ+), nat.prime p ∧ q = p^(n : ℕ) :=
let ⟨p, hc⟩ := char_p.exists K in ⟨p, @finite_field.card K _ _ p hc⟩

@[simp] lemma cast_card_eq_zero : (q : K) = 0 :=
begin
  rcases char_p.exists K with ⟨p, _char_p⟩, resetI,
  rcases card K p with ⟨n, hp, hn⟩,
  simp only [char_p.cast_eq_zero_iff K p, hn],
  conv { congr, rw [← pow_one p] },
  exact pow_dvd_pow _ n.2,
end

lemma forall_pow_eq_one_iff (i : ℕ) :
  (∀ x : units K, x ^ i = 1) ↔ q - 1 ∣ i :=
begin
  obtain ⟨x, hx⟩ := is_cyclic.exists_generator (units K),
  classical,
  rw [← card_units, ← order_of_eq_card_of_forall_mem_gpowers hx, order_of_dvd_iff_pow_eq_one],
  split,
  { intro h, apply h },
  { intros h y,
    simp_rw ← mem_powers_iff_mem_gpowers at hx,
    rcases hx y with ⟨j, rfl⟩,
    rw [← pow_mul, mul_comm, pow_mul, h, one_pow], }
end

/-- The sum of `x ^ i` as `x` ranges over the units of a finite field of cardinality `q`
is equal to `0` unless `(q - 1) ∣ i`, in which case the sum is `q - 1`. -/
lemma sum_pow_units (i : ℕ) :
  ∑ x : units K, (x ^ i : K) = if (q - 1) ∣ i then -1 else 0 :=
begin
  let φ : units K →* K :=
  { to_fun   := λ x, x ^ i,
    map_one' := by rw [units.coe_one, one_pow],
    map_mul' := by { intros, rw [units.coe_mul, mul_pow] } },
  haveI : decidable (φ = 1) := by { classical, apply_instance },
  calc ∑ x : units K, φ x = if φ = 1 then fintype.card (units K) else 0 : sum_hom_units φ
                      ... = if (q - 1) ∣ i then -1 else 0 : _,
  suffices : (q - 1) ∣ i ↔ φ = 1,
  { simp only [this],
    split_ifs with h h, swap, refl,
    rw [card_units, nat.cast_sub, cast_card_eq_zero, nat.cast_one, zero_sub],
    show 1 ≤ q, from fintype.card_pos_iff.mpr ⟨0⟩ },
  rw [← forall_pow_eq_one_iff, monoid_hom.ext_iff],
  apply forall_congr, intro x,
  rw [units.ext_iff, units.coe_pow, units.coe_one, monoid_hom.one_apply],
  refl,
end

/-- The sum of `x ^ i` as `x` ranges over a finite field of cardinality `q`
is equal to `0` if `i < q - 1`. -/
lemma sum_pow_lt_card_sub_one (i : ℕ) (h : i < q - 1) :
  ∑ x : K, x ^ i = 0 :=
begin
  by_cases hi : i = 0,
  { simp only [hi, nsmul_one, sum_const, pow_zero, card_univ, cast_card_eq_zero], },
  classical,
  have hiq : ¬ (q - 1) ∣ i, { contrapose! h,  exact nat.le_of_dvd (nat.pos_of_ne_zero hi) h },
  let φ : units K ↪ K := ⟨coe, units.ext⟩,
  have : univ.map φ = univ \ {0},
  { ext x,
    simp only [true_and, embedding.coe_fn_mk, mem_sdiff, units.exists_iff_ne_zero,
               mem_univ, mem_map, exists_prop_of_true, mem_singleton] },
  calc ∑ x : K, x ^ i = ∑ x in univ \ {(0 : K)}, x ^ i :
    by rw [← sum_sdiff ({0} : finset K).subset_univ, sum_singleton,
           zero_pow (nat.pos_of_ne_zero hi), add_zero]
    ... = ∑ x : units K, x ^ i : by { rw [← this, univ.sum_map φ], refl }
    ... = 0 : by { rw [sum_pow_units K i, if_neg], exact hiq, }
end

variables {K}

theorem frobenius_pow {p : ℕ} [fact p.prime] [char_p K p] {n : ℕ} (hcard : q = p^n) :
  (frobenius K p) ^ n = 1 :=
begin
  ext, conv_rhs { rw [ring_hom.one_def, ring_hom.id_apply, ← pow_card x, hcard], }, clear hcard,
  induction n, {simp},
  rw [pow_succ, pow_succ', pow_mul, ring_hom.mul_def, ring_hom.comp_apply, frobenius_def, n_ih]
end

open polynomial

lemma expand_card (f : polynomial K) :
  expand K q f = f ^ q :=
begin
  cases char_p.exists K with p hp, letI := hp,
  rcases finite_field.card K p with ⟨⟨n, npos⟩, ⟨hp, hn⟩⟩, haveI : fact p.prime := ⟨hp⟩,
  dsimp at hn, rw hn at *,
  rw ← map_expand_pow_char,
  rw [frobenius_pow hn, ring_hom.one_def, map_id],
end

end finite_field

namespace zmod

open finite_field polynomial

lemma sq_add_sq (p : ℕ) [hp : fact p.prime] (x : zmod p) :
  ∃ a b : zmod p, a^2 + b^2 = x :=
begin
  cases hp.1.eq_two_or_odd with hp2 hp_odd,
  { substI p, change fin 2 at x, fin_cases x, { use 0, simp }, { use [0, 1], simp } },
  let f : polynomial (zmod p) := X^2,
  let g : polynomial (zmod p) := X^2 - C x,
  obtain ⟨a, b, hab⟩ : ∃ a b, f.eval a + g.eval b = 0 :=
    @exists_root_sum_quadratic _ _ _ f g
      (degree_X_pow 2) (degree_X_pow_sub_C dec_trivial _) (by rw [zmod.card, hp_odd]),
  refine ⟨a, b, _⟩,
  rw ← sub_eq_zero,
  simpa only [eval_C, eval_X, eval_pow, eval_sub, ← add_sub_assoc] using hab,
end

end zmod

namespace char_p

lemma sq_add_sq (R : Type*) [integral_domain R] (p : ℕ) [fact (0 < p)] [char_p R p] (x : ℤ) :
  ∃ a b : ℕ, (a^2 + b^2 : R) = x :=
begin
  haveI := char_is_prime_of_pos R p,
  obtain ⟨a, b, hab⟩ := zmod.sq_add_sq p x,
  refine ⟨a.val, b.val, _⟩,
  simpa using congr_arg (zmod.cast_hom (dvd_refl _) R) hab
end

end char_p

open_locale nat
open zmod

/-- The Fermat-Euler totient theorem. `nat.modeq.pow_totient` is an alternative statement
  of the same theorem. -/
@[simp] lemma zmod.pow_totient {n : ℕ} [fact (0 < n)] (x : units (zmod n)) : x ^ φ n = 1 :=
by rw [← card_units_eq_totient, pow_card_eq_one]

/-- The Fermat-Euler totient theorem. `zmod.pow_totient` is an alternative statement
  of the same theorem. -/
lemma nat.modeq.pow_totient {x n : ℕ} (h : nat.coprime x n) : x ^ φ n ≡ 1 [MOD n] :=
begin
  cases n, {simp},
  rw ← zmod.eq_iff_modeq_nat,
  let x' : units (zmod (n+1)) := zmod.unit_of_coprime _ h,
  have := zmod.pow_totient x',
  apply_fun (coe : units (zmod (n+1)) → zmod (n+1)) at this,
  simpa only [-zmod.pow_totient, nat.succ_eq_add_one, nat.cast_pow, units.coe_one,
    nat.cast_one, coe_unit_of_coprime, units.coe_pow],
end

open finite_field
namespace zmod

/-- A variation on Fermat's little theorem. See `zmod.pow_card_sub_one_eq_one` -/
@[simp] lemma pow_card {p : ℕ} [fact p.prime] (x : zmod p) : x ^ p = x :=
by { have h := finite_field.pow_card x, rwa zmod.card p at h }

@[simp] lemma frobenius_zmod (p : ℕ) [fact p.prime] :
  frobenius (zmod p) p = ring_hom.id _ :=
by { ext a, rw [frobenius_def, zmod.pow_card, ring_hom.id_apply] }

@[simp] lemma card_units (p : ℕ) [fact p.prime] : fintype.card (units (zmod p)) = p - 1 :=
by rw [card_units, card]

/-- Fermat's Little Theorem: for every unit `a` of `zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem units_pow_card_sub_one_eq_one (p : ℕ) [fact p.prime] (a : units (zmod p)) :
  a ^ (p - 1) = 1 :=
by rw [← card_units p, pow_card_eq_one]

/-- Fermat's Little Theorem: for all nonzero `a : zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem pow_card_sub_one_eq_one {p : ℕ} [fact p.prime] {a : zmod p} (ha : a ≠ 0) :
  a ^ (p - 1) = 1 :=
by { have h := pow_card_sub_one_eq_one a ha, rwa zmod.card p at h }

open polynomial

lemma expand_card {p : ℕ} [fact p.prime] (f : polynomial (zmod p)) :
  expand (zmod p) p f = f ^ p :=
by { have h := finite_field.expand_card f, rwa zmod.card p at h }

end zmod


import .semantics

inductive fml
| var (n : nat)
| neg (φ : fml)
| and (φ ψ : fml)
| or (φ ψ : fml)
| impl (φ ψ : fml)
| box (φ : fml)
| dia (φ : fml)

open fml

def fml.to_string : fml → string
| (var n)    := "P" ++ n.repr
| (neg ϕ)    := "¬" ++ "(" ++ fml.to_string ϕ ++ ")"
| (and φ ψ)  := fml.to_string φ ++ "∧" ++ fml.to_string ψ
| (or φ ψ)   := fml.to_string φ ++ "∨" ++ fml.to_string ψ
| (impl φ ψ) := fml.to_string φ ++ "→" ++ fml.to_string ψ
| (box φ)    := "□" ++ "(" ++ fml.to_string φ ++ ")"
| (dia φ)    := "◇" ++ "(" ++ fml.to_string φ ++ ")"

instance fml_repr : has_repr fml := ⟨fml.to_string⟩

instance dec_eq_fml : decidable_eq fml := by tactic.mk_dec_eq_instance

@[simp] def fml_size : fml → ℕ
| (var n)    := 1
| (neg φ)    := fml_size φ + 1
| (and φ ψ)  := fml_size φ + fml_size ψ + 1
| (or φ ψ)   := fml_size φ + fml_size ψ + 1
| (impl φ ψ) := fml_size φ + fml_size ψ + 2
| (box φ)    := fml_size φ + 1
| (dia φ)    := fml_size φ + 1

@[simp] def fml_force {states : Type} (k : S4 states) : states → fml → Prop
| s (var n)    := k.val n s
| s (neg φ)    := ¬ fml_force s φ
| s (and φ ψ)  := fml_force s φ ∧ fml_force s ψ
| s (or φ ψ)   := fml_force s φ ∨ fml_force s ψ
| s (impl φ ψ) := ¬ fml_force s φ ∨ fml_force s ψ
| s (box φ)    := ∀ s', k.rel s s' → fml_force s' φ
| s (dia φ)    := ∃ s', k.rel s s' ∧ fml_force s' φ

@[simp] def fml.to_nnf : fml → nnf
| (var n)          := nnf.var n
| (neg (var n))    := nnf.neg n
| (neg (neg φ))    := fml.to_nnf φ
| (neg (and φ ψ))  := nnf.or (fml.to_nnf (neg φ)) (fml.to_nnf (neg ψ))
| (neg (or φ ψ))   := nnf.and (fml.to_nnf (neg φ)) (fml.to_nnf (neg ψ))
| (neg (impl φ ψ)) := nnf.and (fml.to_nnf φ) (fml.to_nnf (neg ψ))
| (neg (box φ))    := nnf.dia (fml.to_nnf (neg φ))
| (neg (dia φ))    := nnf.box (fml.to_nnf (neg φ))
| (and φ ψ)        := nnf.and (fml.to_nnf φ) (fml.to_nnf ψ)
| (or φ ψ)         := nnf.or (fml.to_nnf φ) (fml.to_nnf ψ)
| (impl φ ψ)       := nnf.or (fml.to_nnf (neg φ)) (fml.to_nnf ψ)
| (box φ)          := nnf.box (fml.to_nnf φ)
| (dia φ)          := nnf.dia (fml.to_nnf φ)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf fml_size⟩]}

@[simp] def trans_size_left {st} (k : S4 st) : (Σ' (s) (φ : fml), fml_force k s φ) → ℕ :=
λ h, fml_size h.snd.fst

@[simp] def trans_size_right {st} (k : S4 st) : (Σ' (s : st) (φ : fml), force k s (fml.to_nnf φ)) → ℕ :=
λ h, fml_size h.snd.fst

theorem trans_left {st} (k : S4 st) : Π s φ,
fml_force k s φ → force k s (fml.to_nnf φ)
| s (var n)          h := h
| s (neg (var n))    h := h
| s (neg (neg φ))    h := by dsimp at h; rw classical.not_not at h; exact trans_left _ _ h
| s (neg (and φ ψ))  h := begin
                            have := trans_left s (neg φ),
                            dsimp at h,
                            rw classical.not_and_distrib at h,
                            cases h with l r,
                            {simp [trans_left _ (neg φ) l]},
                            {simp [trans_left _ (neg ψ) r]}
                          end
| s (neg (or φ ψ))   h := begin
                            dsimp at h,
                            rw not_or_distrib at h,
                            simp [and.intro (trans_left _ (neg φ) h.1) (trans_left _ (neg ψ) h.2)]
                          end
| s (neg (impl φ ψ)) h := begin
                            dsimp at h,
                            rw not_or_distrib at h,
                            have : force k s (fml.to_nnf φ),
                              { apply trans_left, have := h.1,
                                rw classical.not_not at this,
                                exact this },
                            simp [and.intro this (trans_left _ (neg ψ) h.2)]
                          end
| s (neg (box φ))    h := begin
                            dsimp at h,
                            rw classical.not_forall at h,
                            cases h with w hw,
                            rw classical.not_imp at hw,
                            simp, split, split,
                            {exact hw.1}, {apply trans_left, exact hw.2}
                          end
| s (neg (dia φ))    h := begin
                            dsimp at h, simp,
                            intros s' hs',
                            rw not_exists at h,
                            have := h s',
                            rw not_and at this,
                            have hnf := this hs',
                            apply trans_left, exact hnf
                          end
| s (and φ ψ)        h := by dsimp at h; simp [and.intro (trans_left _ _ h.1) (trans_left _ _ h.2)]
| s (or φ ψ)         h := begin
                            dsimp at h, cases h,
                            {exact or.inl (trans_left _ _ h)},
                            {exact or.inr (trans_left _ _ h)}
                          end
| s (impl φ ψ)       h := begin
                            dsimp at h, simp,
                            cases h,
                            {left, apply trans_left, exact h},
                            {right, apply trans_left, exact h}
                          end
| s (box φ)          h := begin
                            dsimp at h, simp,
                            intros s' hs',
                            exact trans_left _ _ (h s' hs')
                          end
| s (dia φ)          h := begin
                            dsimp at h, simp,
                            cases h with w hw,
                            split, split, {exact hw.1}, {exact trans_left _ _ hw.2}
                          end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (trans_size_left k)⟩]}

theorem trans_right {st} (k : S4 st) : Π s φ,
force k s (fml.to_nnf φ) → fml_force k s φ
| s (var n)          h := h
| s (neg (var n))    h := h
| s (neg (neg φ))    h := by dsimp; simp at h; exact not_not_intro (trans_right _ _ h)
| s (neg (and φ ψ))  h := begin
                            dsimp, simp at h,
                            apply not_and_of_not_or_not,
                            cases h,
                            {left, exact trans_right _ _ h},
                            {right, exact trans_right _ _ h}
                          end
| s (neg (or φ ψ))   h := begin
                            dsimp, simp at h,
                            apply not_or,
                            {exact trans_right _ _ h.1}, {exact trans_right _ _ h.2}
                          end
| s (neg (impl φ ψ)) h := begin
                            dsimp, simp at h,
                            apply not_or,
                            {exact not_not_intro (trans_right _ _ h.1)}, {exact trans_right _ _ h.2}
                          end
| s (neg (box φ))    h := begin
                            dsimp, simp at h,
                            apply not_forall_of_exists_not,
                            cases h with w hw,
                            split,
                            {apply not_imp_of_and_not, split, exact hw.1, exact trans_right _ _ hw.2}
                          end
| s (neg (dia φ))    h := begin
                            dsimp, simp at h,
                            rw not_exists,
                            intros s' hs',
                            have := h s' hs'.1,
                            have hn := trans_right _ _ this,
                            have := hs'.2,
                            contradiction
                          end
| s (and φ ψ)        h := begin
                            dsimp, simp at h,
                            split, {exact trans_right _ _ h.1}, {exact trans_right _ _ h.2}
                          end
| s (or φ ψ)         h := begin
                            dsimp, simp at h,
                            cases h, {left, exact trans_right _ _ h}, {right, exact trans_right _ _ h}
                          end
| s (impl φ ψ)       h := begin
                            dsimp, simp at h, cases h,
                            {left, exact trans_right _ _ h}, {right, exact trans_right _ _ h}
                          end
| s (box φ)          h := begin
                            dsimp, simp at h,
                            intros s' hs',
                            exact trans_right _ _ (h s' hs')
                          end
| s (dia φ)          h := begin
                            dsimp, simp at h,
                            cases h with w hw,
                            split, split, {exact hw.1}, {exact trans_right _ _ hw.2}
                          end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (trans_size_right k)⟩]}

theorem trans_iff {st} (k : S4 st) (s φ) : fml_force k s φ ↔ force k s (fml.to_nnf φ) :=
⟨trans_left k s φ, trans_right k s φ⟩

def fml_sat {st} (k : S4 st) (s) (Γ : list fml) : Prop :=
∀ φ ∈ Γ, fml_force k s φ

theorem fml_sat_of_empty {st} (k : S4 st) (s) : fml_sat k s [] :=
λ φ h, absurd h $ list.not_mem_nil _

def fml_unsatisfiable (Γ : list fml) : Prop :=
∀ (st) (k : S4 st) s, ¬ fml_sat k s Γ

theorem trans_sat_iff {st} (k : S4 st) (s) : Π Γ,
fml_sat k s Γ ↔ sat k s (list.map fml.to_nnf Γ)
| [] := by simp [sat_of_empty, fml_sat_of_empty]
| (hd::tl) :=
begin
split,
{ intro h, dsimp, intros φ hφ, cases hφ,
  { rw hφ, rw ←trans_iff, apply h, simp },
  { have : fml_sat k s tl,
      { intros ψ hψ, apply h, simp [hψ] },
    rw trans_sat_iff at this,
    exact this _ hφ } },
{ intros h φ hφ, cases hφ,
  { rw hφ, rw trans_iff, apply h, simp },
  { have : sat k s (list.map fml.to_nnf tl),
      { intros ψ hψ, apply h, simp [hψ] },
    rw ←trans_sat_iff at this,
    exact this _ hφ } }
end

theorem trans_unsat_iff (Γ : list fml) : fml_unsatisfiable Γ ↔ unsatisfiable (list.map fml.to_nnf Γ) :=
begin
  split,
  {intros h _ _ _ _, apply h, rw trans_sat_iff, assumption},
  {intros h _ _ _ _, apply h, rw ←trans_sat_iff, assumption}
end


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Anatole Dedecker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.separation
import Mathlib.PostPort

universes u_2 u_1

namespace Mathlib

/-!
# Extending a function from a subset

The main definition of this file is `extend_from A f` where `f : X → Y`
and `A : set X`. This defines a new function `g : X → Y` which maps any
`x₀ : X` to the limit of `f` as `x` tends to `x₀`, if such a limit exists.

This is analoguous to the way `dense_inducing.extend` "extends" a function
`f : X → Z` to a function `g : Y → Z` along a dense inducing `i : X → Y`.

The main theorem we prove about this definition is `continuous_on_extend_from`
which states that, for `extend_from A f` to be continuous on a set `B ⊆ closure A`,
it suffices that `f` converges within `A` at any point of `B`, provided that
`f` is a function to a regular space.

-/

/-- Extend a function from a set `A`. The resulting function `g` is such that
at any `x₀`, if `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `g x₀` is defined to be one of these `y`. Else, `g x₀` could be anything. -/
def extend_from {X : Type u_1} {Y : Type u_2} [topological_space X] [topological_space Y]
    (A : set X) (f : X → Y) : X → Y :=
  fun (x : X) => lim (nhds_within x A) f

/-- If `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `f` tends to `extend_from A f x` as `x` tends to `x₀`. -/
theorem tendsto_extend_from {X : Type u_1} {Y : Type u_2} [topological_space X]
    [topological_space Y] {A : set X} {f : X → Y} {x : X}
    (h : ∃ (y : Y), filter.tendsto f (nhds_within x A) (nhds y)) :
    filter.tendsto f (nhds_within x A) (nhds (extend_from A f x)) :=
  tendsto_nhds_lim h

theorem extend_from_eq {X : Type u_1} {Y : Type u_2} [topological_space X] [topological_space Y]
    [t2_space Y] {A : set X} {f : X → Y} {x : X} {y : Y} (hx : x ∈ closure A)
    (hf : filter.tendsto f (nhds_within x A) (nhds y)) : extend_from A f x = y :=
  tendsto_nhds_unique (tendsto_nhds_lim (Exists.intro y hf)) hf

theorem extend_from_extends {X : Type u_1} {Y : Type u_2} [topological_space X]
    [topological_space Y] [t2_space Y] {f : X → Y} {A : set X} (hf : continuous_on f A) (x : X)
    (H : x ∈ A) : extend_from A f x = f x :=
  extend_from_eq (subset_closure x_in) (hf x x_in)

/-- If `f` is a function to a regular space `Y` which has a limit within `A` at any
point of a set `B ⊆ closure A`, then `extend_from A f` is continuous on `B`. -/
theorem continuous_on_extend_from {X : Type u_1} {Y : Type u_2} [topological_space X]
    [topological_space Y] [regular_space Y] {f : X → Y} {A : set X} {B : set X} (hB : B ⊆ closure A)
    (hf : ∀ (x : X), x ∈ B → ∃ (y : Y), filter.tendsto f (nhds_within x A) (nhds y)) :
    continuous_on (extend_from A f) B :=
  sorry

/-- If a function `f` to a regular space `Y` has a limit within a
dense set `A` for any `x`, then `extend_from A f` is continuous. -/
theorem continuous_extend_from {X : Type u_1} {Y : Type u_2} [topological_space X]
    [topological_space Y] [regular_space Y] {f : X → Y} {A : set X} (hA : dense A)
    (hf : ∀ (x : X), ∃ (y : Y), filter.tendsto f (nhds_within x A) (nhds y)) :
    continuous (extend_from A f) :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
Ported by: Joël Riou

! This file was ported from Lean 3 source module category_theory.essential_image
! leanprover-community/mathlib commit 550b58538991c8977703fdeb7c9d51a5aa27df11
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.NatIso
import Mathlib.CategoryTheory.FullSubcategory

/-!
# Essential image of a functor

The essential image `essImage` of a functor consists of the objects in the target category which
are isomorphic to an object in the image of the object function.
This, for instance, allows us to talk about objects belonging to a subcategory expressed as a
functor rather than a subtype, preserving the principle of equivalence. For example this lets us
define exponential ideals.

The essential image can also be seen as a subcategory of the target category, and witnesses that
a functor decomposes into a essentially surjective functor and a fully faithful functor.
(TODO: show that this decomposition forms an orthogonal factorisation system).
-/

universe v₁ v₂ u₁ u₂

noncomputable section

namespace CategoryTheory

variable {C : Type u₁} {D : Type u₂} [Category.{v₁} C] [Category.{v₂} D] {F : C ⥤ D}

namespace Functor

/-- The essential image of a functor `F` consists of those objects in the target category which are
isomorphic to an object in the image of the function `F.obj`. In other words, this is the closure
under isomorphism of the function `F.obj`.
This is the "non-evil" way of describing the image of a functor.
-/
def essImage (F : C ⥤ D) : Set D := fun Y => ∃ X : C, Nonempty (F.obj X ≅ Y)
#align category_theory.functor.ess_image CategoryTheory.Functor.essImage

/-- Get the witnessing object that `Y` is in the subcategory given by `F`. -/
def essImage.witness {Y : D} (h : Y ∈ F.essImage) : C :=
  h.choose
#align category_theory.functor.ess_image.witness CategoryTheory.Functor.essImage.witness

/-- Extract the isomorphism between `F.obj h.witness` and `Y` itself. -/
-- Porting note: in the next, the dot notation `h.witness` no longer works
def essImage.getIso {Y : D} (h : Y ∈ F.essImage) : F.obj (essImage.witness h) ≅ Y :=
  Classical.choice h.choose_spec
#align category_theory.functor.ess_image.get_iso CategoryTheory.Functor.essImage.getIso

/-- Being in the essential image is a "hygenic" property: it is preserved under isomorphism. -/
theorem essImage.ofIso {Y Y' : D} (h : Y ≅ Y') (hY : Y ∈ essImage F) : Y' ∈ essImage F :=
  hY.imp fun _ => Nonempty.map (· ≪≫ h)
#align category_theory.functor.ess_image.of_iso CategoryTheory.Functor.essImage.ofIso

/-- If `Y` is in the essential image of `F` then it is in the essential image of `F'` as long as
`F ≅ F'`.
-/
theorem essImage.ofNatIso {F' : C ⥤ D} (h : F ≅ F') {Y : D} (hY : Y ∈ essImage F) :
    Y ∈ essImage F' :=
  hY.imp fun X => Nonempty.map fun t => h.symm.app X ≪≫ t
#align category_theory.functor.ess_image.of_nat_iso CategoryTheory.Functor.essImage.ofNatIso

/-- Isomorphic functors have equal essential images. -/
theorem essImage_eq_of_natIso {F' : C ⥤ D} (h : F ≅ F') : essImage F = essImage F' :=
  funext fun _ => propext ⟨essImage.ofNatIso h, essImage.ofNatIso h.symm⟩
#align category_theory.functor.ess_image_eq_of_nat_iso CategoryTheory.Functor.essImage_eq_of_natIso

/-- An object in the image is in the essential image. -/
theorem obj_mem_essImage (F : D ⥤ C) (Y : D) : F.obj Y ∈ essImage F :=
  ⟨Y, ⟨Iso.refl _⟩⟩
#align category_theory.functor.obj_mem_ess_image CategoryTheory.Functor.obj_mem_essImage

/-- The essential image of a functor, interpreted of a full subcategory of the target category. -/
-- Porting note: no hasNonEmptyInstance linter yet
def EssImageSubcategory (F : C ⥤ D) :=
  FullSubcategory F.essImage
#align category_theory.functor.ess_image_subcategory CategoryTheory.Functor.EssImageSubcategory

-- Porting note: `deriving Category` is not able to derive this instance
instance : Category (EssImageSubcategory F) :=
  (inferInstance : Category.{v₂} (FullSubcategory _))

/-- The essential image as a subcategory has a fully faithful inclusion into the target category. -/
@[simps!]
def essImageInclusion (F : C ⥤ D) : F.EssImageSubcategory ⥤ D :=
  fullSubcategoryInclusion _
#align category_theory.functor.ess_image_inclusion CategoryTheory.Functor.essImageInclusion
#align category_theory.functor.ess_image_inclusion_obj CategoryTheory.Functor.essImageInclusion_obj
#align category_theory.functor.ess_image_inclusion_map CategoryTheory.Functor.essImageInclusion_map

-- Porting note: `deriving Full` is not able to derive this instance
instance : Full (essImageInclusion F) :=
  (inferInstance : Full (fullSubcategoryInclusion _))

-- Porting note: `deriving Faithful` is not able to derive this instance
instance : Faithful (essImageInclusion F) :=
  (inferInstance : Faithful (fullSubcategoryInclusion _))

/--
Given a functor `F : C ⥤ D`, we have an (essentially surjective) functor from `C` to the essential
image of `F`.
-/
@[simps!]
def toEssImage (F : C ⥤ D) : C ⥤ F.EssImageSubcategory :=
  FullSubcategory.lift _ F (obj_mem_essImage _)
#align category_theory.functor.to_ess_image CategoryTheory.Functor.toEssImage
#align category_theory.functor.to_ess_image_map CategoryTheory.Functor.toEssImage_map
#align category_theory.functor.to_ess_image_obj_obj CategoryTheory.Functor.toEssImage_obj_obj

/-- The functor `F` factorises through its essential image, where the first functor is essentially
surjective and the second is fully faithful.
-/
@[simps!]
def toEssImageCompEssentialImageInclusion (F : C ⥤ D) : F.toEssImage ⋙ F.essImageInclusion ≅ F :=
  FullSubcategory.lift_comp_inclusion _ _ _
#align category_theory.functor.to_ess_image_comp_essential_image_inclusion CategoryTheory.Functor.toEssImageCompEssentialImageInclusion
#align category_theory.functor.to_ess_image_comp_essential_image_inclusion_hom_app CategoryTheory.Functor.toEssImageCompEssentialImageInclusion_hom_app
#align category_theory.functor.to_ess_image_comp_essential_image_inclusion_inv_app CategoryTheory.Functor.toEssImageCompEssentialImageInclusion_inv_app

end Functor

/-- A functor `F : C ⥤ D` is essentially surjective if every object of `D` is in the essential
image of `F`. In other words, for every `Y : D`, there is some `X : C` with `F.obj X ≅ Y`.

See <https://stacks.math.columbia.edu/tag/001C>.
-/
class EssSurj (F : C ⥤ D) : Prop where
  /-- All the objects of the target category are in the essential image. -/
  mem_essImage (Y : D) : Y ∈ F.essImage
#align category_theory.ess_surj CategoryTheory.EssSurj

instance :
    EssSurj
      F.toEssImage where mem_essImage := fun ⟨_, hY⟩ =>
    ⟨_, ⟨⟨_, _, hY.getIso.hom_inv_id, hY.getIso.inv_hom_id⟩⟩⟩

variable (F) [EssSurj F]

/-- Given an essentially surjective functor, we can find a preimage for every object `Y` in the
    codomain. Applying the functor to this preimage will yield an object isomorphic to `Y`, see
    `obj_obj_preimage_iso`. -/
def Functor.objPreimage (Y : D) : C :=
  essImage.witness (@EssSurj.mem_essImage _ _ _ _ F _ Y)
#align category_theory.functor.obj_preimage CategoryTheory.Functor.objPreimage

/-- Applying an essentially surjective functor to a preimage of `Y` yields an object that is
    isomorphic to `Y`. -/
def Functor.objObjPreimageIso (Y : D) : F.obj (F.objPreimage Y) ≅ Y :=
  Functor.essImage.getIso _
#align category_theory.functor.obj_obj_preimage_iso CategoryTheory.Functor.objObjPreimageIso

/-- The induced functor of a faithful functor is faithful -/
instance Faithful.toEssImage (F : C ⥤ D) [Faithful F] : Faithful F.toEssImage :=
  Faithful.of_comp_iso F.toEssImageCompEssentialImageInclusion
#align category_theory.faithful.to_ess_image CategoryTheory.Faithful.toEssImage

/-- The induced functor of a full functor is full -/
instance Full.toEssImage (F : C ⥤ D) [Full F] : Full F.toEssImage :=
  haveI := Full.ofIso F.toEssImageCompEssentialImageInclusion.symm
  Full.ofCompFaithful F.toEssImage F.essImageInclusion
#align category_theory.full.to_ess_image CategoryTheory.Full.toEssImage

end CategoryTheory


import tactic

section

parameters {α : Type} {x y : α} {r : α → α → Prop}

def equivalence_class (x : α) : set α := {y | r x y}

-- Proposition 3.12. If R ⊆ A^2 is an equivalence relation, then Rxy iff
-- [x]_R = [y]_R.
lemma proposition_3_12 (hr : equivalence r) :
  r x y ↔ equivalence_class x = equivalence_class y :=
begin
  rcases hr with ⟨hr₁, hr₂, hr₃⟩,
  split,
  { intro h,
    ext z,
    split,
    { intro hz,
      change r x z at hz,
      change r y z,
      specialize hr₂ h,
      specialize hr₃ hr₂ hz,
      assumption },
    { intro hz,
      change r y z at hz,
      change r x z,
      specialize hr₂ hz,
      specialize hr₃ h hz,
      assumption } },
  { intro h,
    have : r x = r y, from h,
    rw this,
    exact hr₁ y }
end

-- Definition 3.9 (Asymmetry). A relation R ⊆ A^2 is called asymmetric if for
-- no pair x, y ∈ A we have both Rxy and Ryx.
def asymmetric (r : α → α → Prop) := ∀ ⦃x y⦄, ¬(r x y ∧ r y x)

#print irreflexive
#print transitive

-- Definition 3.21 (Strict order). A strict order is a relation which is
-- irreflexive, asymmetric, and transitive.
def strict_order (r : α → α → Prop) := irreflexive r ∧ asymmetric r ∧ transitive r

#check @relation.refl_gen

def partial_order' (r : α → α → Prop) := reflexive r ∧ transitive r ∧ anti_symmetric r

-- Proposition 3.25. If R is a strict order on A, then R^+ = R ∪ Id_A is a
-- partial order. Moreover, if R is total, then R^+ is a linear order.
lemma proposition_3_25_a (h : strict_order r) : partial_order' (relation.refl_gen r) :=
begin
  rcases h with ⟨h₁, h₂, h₃⟩,
  refine ⟨_, _, _⟩,
  { intro x, refl },
  { intros x y z,
    intros hr₁ hr₂,
    cases hr₁ with hr₁ hr₁; cases hr₂ with hr₂ hr₂,
    { refl },
    { exact relation.refl_gen.single hr₂ },
    { exact relation.refl_gen.single hr₁ },
    { have : r x z, by tidy,
      exact relation.refl_gen.single this } },
  { intros x y,
    intros hr₁ hr₂,
    by_contra,
    have hr₁ : r x y,
    { cases hr₁ with hr₁ hr₁,
      { exfalso,
        apply h,
        refl },
      { assumption } },
    have hr₂ : r y x,
    { cases hr₂ with hr₂ hr₂,
      { exfalso,
        apply h,
        refl },
      { assumption } },
    exact h₂ ⟨hr₁, hr₂⟩ }
end

-- Definition 3.7 (Connectivity). A relation R ⊆ A2 is connected if for all
-- x, y ∈ A, if x ≠ y, then either Rxy or Ryx.
def connected (r : α → α → Prop) := ∀ ⦃x y⦄, x ≠ y → r x y ∨ r y x

-- Definition 3.24 (Total order). A strict order which is also connected is
-- called a total order. This is also sometimes called a strict linear order.
def total_order (r : α → α → Prop) := strict_order r ∧ connected r

-- Definition 3.16 (Linear order). A partial order which is also connected is
-- called a total order or linear order.
def linear_order' (r : α → α → Prop) := partial_order' r ∧ connected r

-- Moreover, if R is total, then R^+ is a linear order.
lemma proposition_3_25_b (h : total_order r) : linear_order' (relation.refl_gen r) :=
begin
  split,
  { exact proposition_3_25_a h.1 },
  { intros x y,
    intro hxy,
    have : r x y ∨ r y x, from h.2 hxy,
    cases this,
    { left,
      exact relation.refl_gen.single this },
    { right,
      exact relation.refl_gen.single this } }
end

-- Proposition 3.28. If < totally orders A, then:
-- (∀ a, b ∈ A) ((∀ x ∈ A) (x < a ↔ x < b) → a = b)
lemma proposition_3_28 (h : total_order r) (a b : α) (h' : ∀ x, r x a ↔ r x b) : a = b :=
begin
  have h₁ : ¬r a b,
  { intro hab,
    specialize h' a,
    rw ←h' at hab,
    exact h.1.1 a hab },
  have h₂ : ¬r b a,
  { intro hab,
    specialize h' b,
    rw h' at hab,
    exact h.1.1 b hab },
  by_contra hab,
  cases h.2 hab with h h,
  { exact h₁ h },
  { exact h₂ h }
end

def irrefl_gen (r : α → α → Prop) := λ a b, r a b ∧ a ≠ b

-- Problem 3.4. Give a proof of Proposition 3.26.
--
-- Proposition 3.26. If R is a partial order on X, then R^− = R \ Id_X is a
-- strict order. Moreover, if R is linear, then R^− is total.
lemma proposition_3_26 (h : partial_order' r) : strict_order (irrefl_gen r) :=
begin
  obtain ⟨h₁, h₂, h₃⟩ := h,
  refine ⟨_, _, _⟩,
  { unfold irreflexive,
    rintros x ⟨hx₁, hx₂⟩,
    apply hx₂,
    refl },
  { rintros x y ⟨⟨h₁₁, h₁₂⟩, ⟨h₂₁, h₂₂⟩⟩,
    apply h₁₂,
    apply h₃ h₁₁ h₂₁ },
  { rintros x y z ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩,
    have hxz₁ := h₂ hxy₁ hyz₁,
    refine ⟨hxz₁, _⟩,
    unfold anti_symmetric at h₃,
    rintro h,
    subst h,
    specialize h₃ hxy₁ hyz₁,
    subst h₃,
    tidy }
end

def relative_product (r s : α → α → Prop) := λ a b, ∃ c, r a c ∧ s c b

-- Problem 3.5. Show that the transitive closure of R is in fact transitive.
lemma problem_3_5 : sorry := sorry

end


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.measure.measure_space
import order.filter.ennreal

/-!
# Essential supremum and infimum
We define the essential supremum and infimum of a function `f : α → β` with respect to a measure
`μ` on `α`. The essential supremum is the infimum of the constants `c : β` such that `f x ≤ c`
almost everywhere.

TODO: The essential supremum of functions `α → ℝ≥0∞` is used in particular to define the norm in
the `L∞` space (see measure_theory/lp_space.lean).

There is a different quantity which is sometimes also called essential supremum: the least
upper-bound among measurable functions of a family of measurable functions (in an almost-everywhere
sense). We do not define that quantity here, which is simply the supremum of a map with values in
`α →ₘ[μ] β` (see measure_theory/ae_eq_fun.lean).

## Main definitions

* `ess_sup f μ := μ.ae.limsup f`
* `ess_inf f μ := μ.ae.liminf f`
-/

open measure_theory filter
open_locale ennreal measure_theory

variables {α β : Type*} {m : measurable_space α} {μ ν : measure α}

section conditionally_complete_lattice
variable [conditionally_complete_lattice β]

/-- Essential supremum of `f` with respect to measure `μ`: the smallest `c : β` such that
`f x ≤ c` a.e. -/
def ess_sup {m : measurable_space α} (f : α → β) (μ : measure α) := μ.ae.limsup f

/-- Essential infimum of `f` with respect to measure `μ`: the greatest `c : β` such that
`c ≤ f x` a.e. -/
def ess_inf {m : measurable_space α} (f : α → β) (μ : measure α) := μ.ae.liminf f

lemma ess_sup_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) : ess_sup f μ = ess_sup g μ :=
limsup_congr hfg

lemma ess_inf_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) :  ess_inf f μ = ess_inf g μ :=
@ess_sup_congr_ae α (order_dual β) _ _ _ _ _ hfg

end conditionally_complete_lattice

section complete_lattice
variable [complete_lattice β]

@[simp] lemma ess_sup_measure_zero {m : measurable_space α} {f : α → β} :
  ess_sup f (0 : measure α) = ⊥ :=
le_bot_iff.mp (Inf_le (by simp [set.mem_set_of_eq, eventually_le, ae_iff]))

@[simp] lemma ess_inf_measure_zero {m : measurable_space α} {f : α → β} :
  ess_inf f (0 : measure α) = ⊤ :=
@ess_sup_measure_zero α (order_dual β) _ _ _

lemma ess_sup_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_sup f μ ≤ ess_sup g μ :=
limsup_le_limsup hfg

lemma ess_inf_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_inf f μ ≤ ess_inf g μ :=
liminf_le_liminf hfg

lemma ess_sup_const (c : β) (hμ : μ ≠ 0) : ess_sup (λ x : α, c) μ = c :=
begin
  haveI hμ_ne_bot : μ.ae.ne_bot, { rwa [ne_bot_iff, ne.def, ae_eq_bot] },
  exact limsup_const c,
end

lemma ess_sup_le_of_ae_le {f : α → β} (c : β) (hf : f ≤ᵐ[μ] (λ _, c)) : ess_sup f μ ≤ c :=
begin
  refine (ess_sup_mono_ae hf).trans _,
  by_cases hμ : μ = 0,
  { simp [hμ], },
  { rwa ess_sup_const, },
end

lemma ess_inf_const (c : β) (hμ : μ ≠ 0) : ess_inf (λ x : α, c) μ = c :=
@ess_sup_const α (order_dual β) _ _ _ _ hμ

lemma le_ess_inf_of_ae_le {f : α → β} (c : β) (hf : (λ _, c) ≤ᵐ[μ] f) : c ≤ ess_inf f μ :=
@ess_sup_le_of_ae_le α (order_dual β) _ _ _ _ c hf

lemma ess_sup_const_bot : ess_sup (λ x : α, (⊥ : β)) μ = (⊥ : β) :=
limsup_const_bot

lemma ess_inf_const_top : ess_inf (λ x : α, (⊤ : β)) μ = (⊤ : β) :=
liminf_const_top

lemma order_iso.ess_sup_apply {m : measurable_space α} {γ} [complete_lattice γ]
  (f : α → β) (μ : measure α) (g : β ≃o γ) :
  g (ess_sup f μ) = ess_sup (λ x, g (f x)) μ :=
begin
  refine order_iso.limsup_apply g _ _ _ _,
  all_goals { is_bounded_default, },
end

lemma order_iso.ess_inf_apply {m : measurable_space α} {γ} [complete_lattice γ]
  (f : α → β) (μ : measure α) (g : β ≃o γ) :
  g (ess_inf f μ) = ess_inf (λ x, g (f x)) μ :=
@order_iso.ess_sup_apply α (order_dual β) _ _  (order_dual γ) _ _ _ g.dual

lemma ess_sup_mono_measure {f : α → β} (hμν : ν ≪ μ) : ess_sup f ν ≤ ess_sup f μ :=
begin
  refine limsup_le_limsup_of_le (measure.ae_le_iff_absolutely_continuous.mpr hμν) _ _,
  all_goals { is_bounded_default, },
end

lemma ess_inf_antitone_measure {f : α → β} (hμν : μ ≪ ν) : ess_inf f ν ≤ ess_inf f μ :=
begin
  refine liminf_le_liminf_of_le (measure.ae_le_iff_absolutely_continuous.mpr hμν) _ _,
  all_goals { is_bounded_default, },
end

lemma ess_sup_smul_measure {f : α → β} {c : ℝ≥0∞} (hc : c ≠ 0) :
  ess_sup f (c • μ) = ess_sup f μ :=
begin
  simp_rw ess_sup,
  suffices h_smul : (c • μ).ae = μ.ae, by rw h_smul,
  ext1,
  simp_rw mem_ae_iff,
  simp [hc],
end

end complete_lattice

section complete_linear_order
variable [complete_linear_order β]

lemma ae_lt_of_ess_sup_lt {f : α → β} {x : β} (hf : ess_sup f μ < x) : ∀ᵐ y ∂μ, f y < x :=
filter.eventually_lt_of_limsup_lt hf

lemma ae_lt_of_lt_ess_inf {f : α → β} {x : β} (hf : x < ess_inf f μ) : ∀ᵐ y ∂μ, x < f y :=
@ae_lt_of_ess_sup_lt α (order_dual β) _ _ _ _ _ hf

lemma ess_sup_indicator_eq_ess_sup_restrict [has_zero β] {s : set α}
  {f : α → β} (hf : 0 ≤ᵐ[μ.restrict s] f) (hs : measurable_set s) (hs_not_null : μ s ≠ 0) :
  ess_sup (s.indicator f) μ = ess_sup f (μ.restrict s) :=
begin
  refine le_antisymm _ (Limsup_le_Limsup_of_le (map_restrict_ae_le_map_indicator_ae hs)
    (by is_bounded_default) (by is_bounded_default)),
  refine Limsup_le_Limsup (by is_bounded_default) (by is_bounded_default) (λ c h_restrict_le, _),
  rw eventually_map at h_restrict_le ⊢,
  rw ae_restrict_iff' hs at h_restrict_le,
  have hc : 0 ≤ c,
  { suffices : ∃ x, 0 ≤ f x ∧ f x ≤ c, by { obtain ⟨x, hx⟩ := this, exact hx.1.trans hx.2, },
    refine frequently.exists _,
    { exact μ.ae, },
    rw [eventually_le, ae_restrict_iff' hs] at hf,
    have hs' : ∃ᵐ x ∂μ, x ∈ s,
    { contrapose! hs_not_null,
      rw [not_frequently, ae_iff] at hs_not_null,
      suffices : {a : α | ¬a ∉ s} = s, by rwa ← this,
      simp, },
    refine hs'.mp (hf.mp (h_restrict_le.mono (λ x hxs_imp_c hxf_nonneg hxs, _))),
    rw pi.zero_apply at hxf_nonneg,
    exact ⟨hxf_nonneg hxs, hxs_imp_c hxs⟩, },
  refine h_restrict_le.mono (λ x hxc, _),
  by_cases hxs : x ∈ s,
  { simpa [hxs] using hxc hxs, },
  { simpa [hxs] using hc, },
end

end complete_linear_order

namespace ennreal

variables {f : α → ℝ≥0∞}

lemma ae_le_ess_sup (f : α → ℝ≥0∞) : ∀ᵐ y ∂μ, f y ≤ ess_sup f μ :=
eventually_le_limsup f

@[simp] lemma ess_sup_eq_zero_iff : ess_sup f μ = 0 ↔ f =ᵐ[μ] 0 :=
limsup_eq_zero_iff

lemma ess_sup_const_mul {a : ℝ≥0∞} : ess_sup (λ (x : α), a * (f x)) μ = a * ess_sup f μ :=
limsup_const_mul

lemma ess_sup_add_le (f g : α → ℝ≥0∞) : ess_sup (f + g) μ ≤ ess_sup f μ + ess_sup g μ :=
limsup_add_le f g

lemma ess_sup_liminf_le {ι} [encodable ι] [linear_order ι] (f : ι → α → ℝ≥0∞) :
  ess_sup (λ x, at_top.liminf (λ n, f n x)) μ ≤ at_top.liminf (λ n, ess_sup (λ x, f n x) μ) :=
by { simp_rw ess_sup, exact ennreal.limsup_liminf_le_liminf_limsup (λ a b, f b a), }

end ennreal


import tactic.push_neg
import data.int.basic

example (h : ∃ p: ℕ, ¬ ∀ n : ℕ, n > p)
        (h' : ∃ p: ℕ, ¬ ∃ n : ℕ, n < p) :
        ¬ ∀ n : ℕ, n = 0 :=
begin
  push_neg at *,
  -- use 0,
  -- guard_target_strict 0 ≠ 0,
  use 42, -- 42 must be > 0 because <= we can prove (x : ℕ) ≠ 0 only for x > 0
end


import data.real.basic tactic data.set.basic

universes u v
variables (F : Type u) (V : Type v)
variables [semiring F] [add_comm_group V]

/-
  These are the notes that I wrote for ECM2903 Linear Algebra, but they define all
  of the necessary stuff. Firstly, a vector space,
-/

class vector_space extends has_scalar F V :=
(left_dist : ∀ (a : F) (u v : V), a • ( u + v ) = a • u + a • v)
(right_dist : ∀ (a b : F) (u : V), (a + b) • u = a • u + b • u)
(smul_smul : ∀ (a b : F) (u : V), a • (b • u) = (a * b) • u)
(smul_id : ∀ (u : V), (1 : F) • u = u)
(smul_add : ∀ (a : F) (u v : V), a • (u + v) = a • u + a • v)
(add_smul : ∀ (a b : F) (u : V), (a + b) • u = a • u + b • u)

/-
  Now we to define what we are working on, so let us define a field, an additive
  abelian group (a group thats additive and commutative) and then a vector space.
  Now, three elements of the vectorspace `u`, `v` and `w` and then `a`, `b` and `c`
  elements of a field.
-/
variables [field F] [add_comm_group V] [vector_space F V] (u v w : V) (a b c : F)

open vector_space

structure subSpace : Type v :=
  (carrier : set V)
  (zero_mem' : (0 : V) ∈ carrier)
  (add_mem' : ∀ {a b : V}, a ∈ carrier → b ∈ carrier → a + b ∈ carrier)
  (smul_mem' : ∀ (c_1 : F) {x : V}, x ∈ carrier → c_1 • x ∈ carrier)

variables {p q : subSpace F V}
variables (p q)

@[simp] lemma zero_mem : (0 : V) ∈ p.carrier := p.zero_mem'
@[simp] lemma add_mem (u v : V) (hu : u ∈ p.carrier) (hv : v ∈ p.carrier) : u + v ∈ p.carrier := p.add_mem' hu hv
@[simp] lemma smul_mem (a : F) (u : V) (hu : u ∈ p.carrier): a • u ∈ p.carrier := p.smul_mem' a hu

def Has_Inf (U W : subSpace F V) : subSpace F V := {
  carrier := U.carrier ∩ W.carrier,
  zero_mem' := begin
    split,
      { exact U.zero_mem'},
      { exact W.zero_mem'},
  end,
  add_mem' := begin
    intros a b ha hb,
    cases ha with aU aW,
    cases hb with bU bW,
    split,
      { exact U.add_mem' aU bU},
      { exact W.add_mem' aW bW}
  end,
  smul_mem' := begin
    intros c x hx,
    split,
      { exact U.smul_mem' c hx.left},
      { exact W.smul_mem' c hx.right}
  end }

def Has_Inf' (U W : subSpace F V) : subSpace F V := {
  carrier := U.carrier ∩ W.carrier,
  zero_mem' := by simp,
  add_mem' := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt},}

instance : has_inf (subSpace F V) :=
⟨λ p q, {
  carrier := p.carrier ∩ q.carrier,
  zero_mem' := by simp,
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩