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

! This file was ported from Lean 3 source module number_theory.fermat_psp
! leanprover-community/mathlib commit c0439b4877c24a117bfdd9e32faf62eee9b115eb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Prime
import Mathbin.FieldTheory.Finite.Basic
import Mathbin.Order.Filter.Cofinite

/-!
# Fermat Pseudoprimes

In this file we define Fermat pseudoprimes: composite numbers that pass the Fermat primality test.
A natural number `n` passes the Fermat primality test to base `b` (and is therefore deemed a
"probable prime") if `n` divides `b ^ (n - 1) - 1`. `n` is a Fermat pseudoprime to base `b` if `n`
is a composite number that passes the Fermat primality test to base `b` and is coprime with `b`.

Fermat pseudoprimes can also be seen as composite numbers for which Fermat's little theorem holds
true.

Numbers which are Fermat pseudoprimes to all bases are known as Carmichael numbers (not yet defined
in this file).

## Main Results

The main definitions for this file are

- `fermat_psp.probable_prime`: A number `n` is a probable prime to base `b` if it passes the Fermat
  primality test; that is, if `n` divides `b ^ (n - 1) - 1`
- `fermat_psp`: A number `n` is a pseudoprime to base `b` if it is a probable prime to base `b`, is
  composite, and is coprime with `b` (this last condition is automatically true if `n` divides
  `b ^ (n - 1) - 1`, but some sources include it in the definition).

Note that all composite numbers are pseudoprimes to base 0 and 1, and that the definiton of
`probable_prime` in this file implies that all numbers are probable primes to bases 0 and 1, and
that 0 and 1 are probable primes to any base.

The main theorems are
- `fermat_psp.exists_infinite_pseudoprimes`: there are infinite pseudoprimes to any base `b ≥ 1`
-/

/--
`n` is a probable prime to base `b` if `n` passes the Fermat primality test; that is, `n` divides
`b ^ (n - 1) - 1`.
This definition implies that all numbers are probable primes to base 0 or 1, and that 0 and 1 are
probable primes to any base.
-/
def FermatPsp.ProbablePrime (n b : ℕ) : Prop :=
  n ∣ b ^ (n - 1) - 1
#align fermat_psp.probable_prime FermatPsp.ProbablePrime

/--
`n` is a Fermat pseudoprime to base `b` if `n` is a probable prime to base `b` and is composite. By
this definition, all composite natural numbers are pseudoprimes to base 0 and 1. This definition
also permits `n` to be less than `b`, so that 4 is a pseudoprime to base 5, for example.
-/
def FermatPsp (n b : ℕ) : Prop :=
  FermatPsp.ProbablePrime n b ∧ ¬n.Prime ∧ 1 < n
#align fermat_psp FermatPsp

namespace FermatPsp

instance decidableProbablePrime (n b : ℕ) : Decidable (ProbablePrime n b) :=
  Nat.decidableDvd _ _
#align fermat_psp.decidable_probable_prime FermatPsp.decidableProbablePrime

instance decidablePsp (n b : ℕ) : Decidable (FermatPsp n b) :=
  And.decidable
#align fermat_psp.decidable_psp FermatPsp.decidablePsp

/-- If `n` passes the Fermat primality test to base `b`, then `n` is coprime with `b`, assuming that
`n` and `b` are both positive.
-/
theorem coprime_of_probablePrime {n b : ℕ} (h : ProbablePrime n b) (h₁ : 1 ≤ n) (h₂ : 1 ≤ b) :
    Nat.coprime n b := by
  by_cases h₃ : 2 ≤ n
  · -- To prove that `n` is coprime with `b`, we we need to show that for all prime factors of `n`,
    -- we can derive a contradiction if `n` divides `b`.
    apply Nat.coprime_of_dvd
    -- If `k` is a prime number that divides both `n` and `b`, then we know that `n = m * k` and
    -- `b = j * k` for some natural numbers `m` and `j`. We substitute these into the hypothesis.
    rintro k hk ⟨m, rfl⟩ ⟨j, rfl⟩
    -- Because prime numbers do not divide 1, it suffices to show that `k ∣ 1` to prove a
    -- contradiction
    apply Nat.Prime.not_dvd_one hk
    -- Since `n` divides `b ^ (n - 1) - 1`, `k` also divides `b ^ (n - 1) - 1`
    replace h := dvd_of_mul_right_dvd h
    -- Because `k` divides `b ^ (n - 1) - 1`, if we can show that `k` also divides `b ^ (n - 1)`,
    -- then we know `k` divides 1.
    rw [Nat.dvd_add_iff_right h, Nat.sub_add_cancel (Nat.one_le_pow _ _ h₂)]
    -- Since `k` divides `b`, `k` also divides any power of `b` except `b ^ 0`. Therefore, it
    -- suffices to show that `n - 1` isn't zero. However, we know that `n - 1` isn't zero because we
    -- assumed `2 ≤ n` when doing `by_cases`.
    refine' dvd_of_mul_right_dvd (dvd_pow_self (k * j) _)
    linarith
  -- If `n = 1`, then it follows trivially that `n` is coprime with `b`.
  · rw [show n = 1 by linarith]
    norm_num
#align fermat_psp.coprime_of_probable_prime FermatPsp.coprime_of_probablePrime

theorem probablePrime_iff_modEq (n : ℕ) {b : ℕ} (h : 1 ≤ b) :
    ProbablePrime n b ↔ b ^ (n - 1) ≡ 1 [MOD n] :=
  by
  have : 1 ≤ b ^ (n - 1) := one_le_pow_of_one_le h (n - 1)
  -- For exact_mod_cast
  rw [Nat.ModEq.comm]
  constructor
  · intro h₁
    apply Nat.modEq_of_dvd
    exact_mod_cast h₁
  · intro h₁
    exact_mod_cast Nat.ModEq.dvd h₁
#align fermat_psp.probable_prime_iff_modeq FermatPsp.probablePrime_iff_modEq

/-- If `n` is a Fermat pseudoprime to base `b`, then `n` is coprime with `b`, assuming that `b` is
positive.

This lemma is a small wrapper based on `coprime_of_probable_prime`
-/
theorem coprime_of_fermatPsp {n b : ℕ} (h : FermatPsp n b) (h₁ : 1 ≤ b) : Nat.coprime n b :=
  by
  rcases h with ⟨hp, hn₁, hn₂⟩
  exact coprime_of_probable_prime hp (by linarith) h₁
#align fermat_psp.coprime_of_fermat_psp FermatPsp.coprime_of_fermatPsp

/-- All composite numbers are Fermat pseudoprimes to base 1.
-/
theorem base_one {n : ℕ} (h₁ : 1 < n) (h₂ : ¬n.Prime) : FermatPsp n 1 :=
  by
  refine' ⟨show n ∣ 1 ^ (n - 1) - 1 from _, h₂, h₁⟩
  exact show 0 = 1 ^ (n - 1) - 1 by norm_num ▸ dvd_zero n
#align fermat_psp.base_one FermatPsp.base_one

-- Lemmas that are needed to prove statements in this file, but aren't directly related to Fermat
-- pseudoprimes
section HelperLemmas

private theorem pow_gt_exponent {a : ℕ} (b : ℕ) (h : 2 ≤ a) : b < a ^ b :=
  lt_of_lt_of_le (Nat.lt_two_pow b) <| Nat.pow_le_pow_of_le_left h _
#align fermat_psp.pow_gt_exponent fermat_psp.pow_gt_exponent

private theorem a_id_helper {a b : ℕ} (ha : 2 ≤ a) (hb : 2 ≤ b) : 2 ≤ (a ^ b - 1) / (a - 1) :=
  by
  change 1 < _
  have h₁ : a - 1 ∣ a ^ b - 1 := by simpa only [one_pow] using nat_sub_dvd_pow_sub_pow a 1 b
  rw [Nat.lt_div_iff_mul_lt h₁, mul_one, tsub_lt_tsub_iff_right (Nat.le_of_succ_le ha)]
  convert pow_lt_pow (Nat.lt_of_succ_le ha) hb
  rw [pow_one]
#align fermat_psp.a_id_helper fermat_psp.a_id_helper

private theorem b_id_helper {a b : ℕ} (ha : 2 ≤ a) (hb : 2 < b) : 2 ≤ (a ^ b + 1) / (a + 1) :=
  by
  rw [Nat.le_div_iff_mul_le (Nat.zero_lt_succ _)]
  apply Nat.succ_le_succ
  calc
    2 * a + 1 ≤ a ^ 2 * a := by nlinarith
    _ = a ^ 3 := by rw [pow_succ' a 2]
    _ ≤ a ^ b := pow_le_pow (Nat.le_of_succ_le ha) hb

#align fermat_psp.b_id_helper fermat_psp.b_id_helper

private theorem AB_id_helper (b p : ℕ) (hb : 2 ≤ b) (hp : Odd p) :
    (b ^ p - 1) / (b - 1) * ((b ^ p + 1) / (b + 1)) = (b ^ (2 * p) - 1) / (b ^ 2 - 1) :=
  by
  have q₁ : b - 1 ∣ b ^ p - 1 := by simpa only [one_pow] using nat_sub_dvd_pow_sub_pow b 1 p
  have q₂ : b + 1 ∣ b ^ p + 1 := by simpa only [one_pow] using hp.nat_add_dvd_pow_add_pow b 1
  convert Nat.div_mul_div_comm q₁ q₂ <;> rw [mul_comm (_ - 1), ← Nat.sq_sub_sq]
  · ring
  · simp
#align fermat_psp.AB_id_helper fermat_psp.AB_id_helper

/-- Used in the proof of `psp_from_prime_psp`
-/
private theorem bp_helper {b p : ℕ} (hb : 0 < b) (hp : 1 ≤ p) :
    b ^ (2 * p) - 1 - (b ^ 2 - 1) = b * (b ^ (p - 1) - 1) * (b ^ p + b) :=
  have hi_bsquared : 1 ≤ b ^ 2 := Nat.one_le_pow _ _ hb
  calc
    b ^ (2 * p) - 1 - (b ^ 2 - 1) = b ^ (2 * p) - (1 + (b ^ 2 - 1)) := by rw [Nat.sub_sub]
    _ = b ^ (2 * p) - (1 + b ^ 2 - 1) := by rw [Nat.add_sub_assoc hi_bsquared]
    _ = b ^ (2 * p) - b ^ 2 := by rw [Nat.add_sub_cancel_left]
    _ = b ^ (p * 2) - b ^ 2 := by rw [mul_comm]
    _ = (b ^ p) ^ 2 - b ^ 2 := by rw [pow_mul]
    _ = (b ^ p + b) * (b ^ p - b) := by rw [Nat.sq_sub_sq]
    _ = (b ^ p - b) * (b ^ p + b) := by rw [mul_comm]
    _ = (b ^ (p - 1 + 1) - b) * (b ^ p + b) := by rw [Nat.sub_add_cancel hp]
    _ = (b * b ^ (p - 1) - b) * (b ^ p + b) := by rw [pow_succ]
    _ = (b * b ^ (p - 1) - b * 1) * (b ^ p + b) := by rw [mul_one]
    _ = b * (b ^ (p - 1) - 1) * (b ^ p + b) := by rw [Nat.mul_sub_left_distrib]

#align fermat_psp.bp_helper fermat_psp.bp_helper

end HelperLemmas

/-- Given a prime `p` which does not divide `b * (b ^ 2 - 1)`, we can produce a number `n` which is
larger than `p` and pseudoprime to base `b`. We do this by defining
`n = ((b ^ p - 1) / (b - 1)) * ((b ^ p + 1) / (b + 1))`

The primary purpose of this definition is to help prove `exists_infinite_pseudoprimes`. For a proof
that `n` is actually pseudoprime to base `b`, see `psp_from_prime_psp`, and for a proof that `n` is
greater than `p`, see `psp_from_prime_gt_p`.

This lemma is intended to be used when `2 ≤ b`, `2 < p`, `p` is prime, and `¬p ∣ b * (b ^ 2 - 1)`,
because those are the hypotheses for `psp_from_prime_psp`.
-/
private def psp_from_prime (b : ℕ) (p : ℕ) : ℕ :=
  (b ^ p - 1) / (b - 1) * ((b ^ p + 1) / (b + 1))
#align fermat_psp.psp_from_prime fermat_psp.psp_from_prime

/--
This is a proof that the number produced using `psp_from_prime` is actually pseudoprime to base `b`.
The primary purpose of this lemma is to help prove `exists_infinite_pseudoprimes`.

We use <https://primes.utm.edu/notes/proofs/a_pseudoprimes.html> as a rough outline of the proof.
-/
private theorem psp_from_prime_psp {b : ℕ} (b_ge_two : 2 ≤ b) {p : ℕ} (p_prime : p.Prime)
    (p_gt_two : 2 < p) (not_dvd : ¬p ∣ b * (b ^ 2 - 1)) : FermatPsp (pspFromPrime b p) b :=
  by
  unfold psp_from_prime
  set A := (b ^ p - 1) / (b - 1)
  set B := (b ^ p + 1) / (b + 1)
  -- Inequalities
  have hi_A : 1 < A := a_id_helper (nat.succ_le_iff.mp b_ge_two) (Nat.Prime.one_lt p_prime)
  have hi_B : 1 < B := b_id_helper (nat.succ_le_iff.mp b_ge_two) p_gt_two
  have hi_AB : 1 < A * B := one_lt_mul'' hi_A hi_B
  have hi_b : 0 < b := by linarith
  have hi_p : 1 ≤ p := Nat.one_le_of_lt p_gt_two
  have hi_bsquared : 0 < b ^ 2 - 1 := by nlinarith [Nat.one_le_pow 2 b hi_b]
  have hi_bpowtwop : 1 ≤ b ^ (2 * p) := Nat.one_le_pow (2 * p) b hi_b
  have hi_bpowpsubone : 1 ≤ b ^ (p - 1) := Nat.one_le_pow (p - 1) b hi_b
  -- Other useful facts
  have p_odd : Odd p := p_prime.odd_of_ne_two p_gt_two.ne.symm
  have AB_not_prime : ¬Nat.Prime (A * B) := Nat.not_prime_mul hi_A hi_B
  have AB_id : A * B = (b ^ (2 * p) - 1) / (b ^ 2 - 1) := AB_id_helper _ _ b_ge_two p_odd
  have hd : b ^ 2 - 1 ∣ b ^ (2 * p) - 1 := by
    simpa only [one_pow, pow_mul] using nat_sub_dvd_pow_sub_pow _ 1 p
  -- We know that `A * B` is not prime, and that `1 < A * B`. Since two conditions of being
  -- pseudoprime are satisfied, we only need to show that `A * B` is probable prime to base `b`
  refine' ⟨_, AB_not_prime, hi_AB⟩
  -- Used to prove that `2 * p * (b ^ 2 - 1) ∣ (b ^ 2 - 1) * (A * B - 1)`.
  have ha₁ : (b ^ 2 - 1) * (A * B - 1) = b * (b ^ (p - 1) - 1) * (b ^ p + b) :=
    by
    apply_fun fun x => x * (b ^ 2 - 1)  at AB_id
    rw [Nat.div_mul_cancel hd] at AB_id
    apply_fun fun x => x - (b ^ 2 - 1)  at AB_id
    nth_rw 2 [← one_mul (b ^ 2 - 1)] at AB_id
    rw [← Nat.mul_sub_right_distrib, mul_comm] at AB_id
    rw [AB_id]
    exact bp_helper hi_b hi_p
  -- If `b` is even, then `b^p` is also even, so `2 ∣ b^p + b`
  -- If `b` is odd, then `b^p` is also odd, so `2 ∣ b^p + b`
  have ha₂ : 2 ∣ b ^ p + b := by
    by_cases h : Even b
    · replace h : 2 ∣ b := even_iff_two_dvd.mp h
      have : p ≠ 0 := by linarith
      have : 2 ∣ b ^ p := dvd_pow h this
      exact dvd_add this h
    · have h : Odd b := nat.odd_iff_not_even.mpr h
      have : Odd (b ^ p) := Odd.pow h
      have : Even (b ^ p + b) := Odd.add_odd this h
      exact even_iff_two_dvd.mp this
  -- Since `b` isn't divisible by `p`, `b` is coprime with `p`. we can use Fermat's Little Theorem
  -- to prove this.
  have ha₃ : p ∣ b ^ (p - 1) - 1 :=
    by
    have : ¬p ∣ b := mt (fun h : p ∣ b => dvd_mul_of_dvd_left h _) not_dvd
    have : p.coprime b := Or.resolve_right (Nat.coprime_or_dvd_of_prime p_prime b) this
    have : IsCoprime (b : ℤ) ↑p := this.symm.is_coprime
    have : ↑b ^ (p - 1) ≡ 1 [ZMOD ↑p] := Int.ModEq.pow_card_sub_one_eq_one p_prime this
    have : ↑p ∣ ↑b ^ (p - 1) - ↑1 := Int.ModEq.dvd (Int.ModEq.symm this)
    exact_mod_cast this
  -- Because `p - 1` is even, there is a `c` such that `2 * c = p - 1`. `nat_sub_dvd_pow_sub_pow`
  -- implies that `b ^ c - 1 ∣ (b ^ c) ^ 2 - 1`, and `(b ^ c) ^ 2 = b ^ (p - 1)`.
  have ha₄ : b ^ 2 - 1 ∣ b ^ (p - 1) - 1 :=
    by
    cases' p_odd with k hk
    have : 2 ∣ p - 1 := ⟨k, by simp [hk]⟩
    cases' this with c hc
    have : b ^ 2 - 1 ∣ (b ^ 2) ^ c - 1 := by
      simpa only [one_pow] using nat_sub_dvd_pow_sub_pow _ 1 c
    have : b ^ 2 - 1 ∣ b ^ (2 * c) - 1 := by rwa [← pow_mul] at this
    rwa [← hc] at this
  -- Used to prove that `2 * p` divides `A * B - 1`
  have ha₅ : 2 * p * (b ^ 2 - 1) ∣ (b ^ 2 - 1) * (A * B - 1) :=
    by
    suffices q : 2 * p * (b ^ 2 - 1) ∣ b * (b ^ (p - 1) - 1) * (b ^ p + b)
    · rwa [ha₁]
    -- We already proved that `b ^ 2 - 1 ∣ b ^ (p - 1) - 1`.
    -- Since `2 ∣ b ^ p + b` and `p ∣ b ^ p + b`, if we show that 2 and p are coprime, then we
    -- know that `2 * p ∣ b ^ p + b`
    have q₁ : Nat.coprime p (b ^ 2 - 1) :=
      haveI q₂ : ¬p ∣ b ^ 2 - 1 := by
        rw [mul_comm] at not_dvd
        exact mt (fun h : p ∣ b ^ 2 - 1 => dvd_mul_of_dvd_left h _) not_dvd
      (Nat.Prime.coprime_iff_not_dvd p_prime).mpr q₂
    have q₂ : p * (b ^ 2 - 1) ∣ b ^ (p - 1) - 1 := Nat.coprime.mul_dvd_of_dvd_of_dvd q₁ ha₃ ha₄
    have q₃ : p * (b ^ 2 - 1) * 2 ∣ (b ^ (p - 1) - 1) * (b ^ p + b) := mul_dvd_mul q₂ ha₂
    have q₄ : p * (b ^ 2 - 1) * 2 ∣ b * ((b ^ (p - 1) - 1) * (b ^ p + b)) :=
      dvd_mul_of_dvd_right q₃ _
    rwa [mul_assoc, mul_comm, mul_assoc b]
  have ha₆ : 2 * p ∣ A * B - 1 := by
    rw [mul_comm] at ha₅
    exact Nat.dvd_of_mul_dvd_mul_left hi_bsquared ha₅
  -- `A * B` divides `b ^ (2 * p) - 1` because `A * B * (b ^ 2 - 1) = b ^ (2 * p) - 1`.
  -- This can be proven by multiplying both sides of `AB_id` by `b ^ 2 - 1`.
  have ha₇ : A * B ∣ b ^ (2 * p) - 1 := by
    use b ^ 2 - 1
    have : A * B * (b ^ 2 - 1) = (b ^ (2 * p) - 1) / (b ^ 2 - 1) * (b ^ 2 - 1) :=
      congr_arg (fun x : ℕ => x * (b ^ 2 - 1)) AB_id
    simpa only [add_comm, Nat.div_mul_cancel hd, Nat.sub_add_cancel hi_bpowtwop] using this.symm
  -- Since `2 * p ∣ A * B - 1`, there is a number `q` such that `2 * p * q = A * B - 1`.
  -- By `nat_sub_dvd_pow_sub_pow`, we know that `b ^ (2 * p) - 1 ∣ b ^ (2 * p * q) - 1`.
  -- This means that `b ^ (2 * p) - 1 ∣ b ^ (A * B - 1) - 1`.
  cases' ha₆ with q hq
  have ha₈ : b ^ (2 * p) - 1 ∣ b ^ (A * B - 1) - 1 := by
    simpa only [one_pow, pow_mul, hq] using nat_sub_dvd_pow_sub_pow _ 1 q
  -- We have proved that `A * B ∣ b ^ (2 * p) - 1` and `b ^ (2 * p) - 1 ∣ b ^ (A * B - 1) - 1`.
  -- Therefore, `A * B ∣ b ^ (A * B - 1) - 1`.
  exact dvd_trans ha₇ ha₈
#align fermat_psp.psp_from_prime_psp fermat_psp.psp_from_prime_psp

/--
This is a proof that the number produced using `psp_from_prime` is greater than the prime `p` used
to create it. The primary purpose of this lemma is to help prove `exists_infinite_pseudoprimes`.
-/
private theorem psp_from_prime_gt_p {b : ℕ} (b_ge_two : 2 ≤ b) {p : ℕ} (p_prime : p.Prime)
    (p_gt_two : 2 < p) : p < pspFromPrime b p :=
  by
  unfold psp_from_prime
  set A := (b ^ p - 1) / (b - 1)
  set B := (b ^ p + 1) / (b + 1)
  rw [show A * B = (b ^ (2 * p) - 1) / (b ^ 2 - 1) from
      AB_id_helper _ _ b_ge_two (p_prime.odd_of_ne_two p_gt_two.ne.symm)]
  have AB_dvd : b ^ 2 - 1 ∣ b ^ (2 * p) - 1 := by
    simpa only [one_pow, pow_mul] using nat_sub_dvd_pow_sub_pow _ 1 p
  suffices h : p * (b ^ 2 - 1) < b ^ (2 * p) - 1
  · have h₁ : p * (b ^ 2 - 1) / (b ^ 2 - 1) < (b ^ (2 * p) - 1) / (b ^ 2 - 1) :=
      Nat.div_lt_div_of_lt_of_dvd AB_dvd h
    have h₂ : 0 < b ^ 2 - 1 := by
      linarith [show 3 ≤ b ^ 2 - 1 from le_tsub_of_add_le_left (show 4 ≤ b ^ 2 by nlinarith)]
    rwa [Nat.mul_div_cancel _ h₂] at h₁
  rw [Nat.mul_sub_left_distrib, mul_one, pow_mul]
  nth_rw_rhs 1 [← Nat.sub_add_cancel (show 1 ≤ p by linarith)]
  rw [pow_succ (b ^ 2)]
  suffices h : p * b ^ 2 < b ^ 2 * (b ^ 2) ^ (p - 1)
  · apply gt_of_ge_of_gt
    · exact tsub_le_tsub_left (show 1 ≤ p by linarith) (b ^ 2 * (b ^ 2) ^ (p - 1))
    · have : p ≤ p * b ^ 2 := Nat.le_mul_of_pos_right (show 0 < b ^ 2 by nlinarith)
      exact tsub_lt_tsub_right_of_le this h
  suffices h : p < (b ^ 2) ^ (p - 1)
  · rw [mul_comm (b ^ 2)]
    have : 4 ≤ b ^ 2 := by nlinarith
    have : 0 < b ^ 2 := by linarith
    exact mul_lt_mul_of_pos_right h this
  rw [← pow_mul, Nat.mul_sub_left_distrib, mul_one]
  have : 2 ≤ 2 * p - 2 := le_tsub_of_add_le_left (show 4 ≤ 2 * p by linarith)
  have : 2 + p ≤ 2 * p := by linarith
  have : p ≤ 2 * p - 2 := le_tsub_of_add_le_left this
  exact Nat.lt_of_le_of_lt this (pow_gt_exponent _ b_ge_two)
#align fermat_psp.psp_from_prime_gt_p fermat_psp.psp_from_prime_gt_p

/-- For all positive bases, there exist Fermat infinite pseudoprimes to that base.
Given in this form: for all numbers `b ≥ 1` and `m`, there exists a pseudoprime `n` to base `b` such
that `m ≤ n`. This form is similar to `nat.exists_infinite_primes`.
-/
theorem exists_infinite_pseudoprimes {b : ℕ} (h : 1 ≤ b) (m : ℕ) : ∃ n : ℕ, FermatPsp n b ∧ m ≤ n :=
  by
  by_cases b_ge_two : 2 ≤ b
  -- If `2 ≤ b`, then because there exist infinite prime numbers, there is a prime number p such
  -- `m ≤ p` and `¬p ∣ b*(b^2 - 1)`. We pick a prime number `b*(b^2 - 1) + 1 + m ≤ p` because we
  -- automatically know that `p` is greater than m and that it does not divide `b*(b^2 - 1)`
  -- (because `p` can't divide a number less than `p`).
  -- From `p`, we can use the lemmas we proved earlier to show that
  -- `((b^p - 1)/(b - 1)) * ((b^p + 1)/(b + 1))` is a pseudoprime to base `b`.
  · have h := Nat.exists_infinite_primes (b * (b ^ 2 - 1) + 1 + m)
    cases' h with p hp
    cases' hp with hp₁ hp₂
    have h₁ : 0 < b := pos_of_gt (nat.succ_le_iff.mp b_ge_two)
    have h₂ : 4 ≤ b ^ 2 := pow_le_pow_of_le_left' b_ge_two 2
    have h₃ : 0 < b ^ 2 - 1 := tsub_pos_of_lt (gt_of_ge_of_gt h₂ (by norm_num))
    have h₄ : 0 < b * (b ^ 2 - 1) := mul_pos h₁ h₃
    have h₅ : b * (b ^ 2 - 1) < p := by linarith
    have h₆ : ¬p ∣ b * (b ^ 2 - 1) := Nat.not_dvd_of_pos_of_lt h₄ h₅
    have h₇ : b ≤ b * (b ^ 2 - 1) := Nat.le_mul_of_pos_right h₃
    have h₈ : 2 ≤ b * (b ^ 2 - 1) := le_trans b_ge_two h₇
    have h₉ : 2 < p := gt_of_gt_of_ge h₅ h₈
    have h₁₀ := psp_from_prime_gt_p b_ge_two hp₂ h₉
    use psp_from_prime b p
    constructor
    · exact psp_from_prime_psp b_ge_two hp₂ h₉ h₆
    · exact le_trans (show m ≤ p by linarith) (le_of_lt h₁₀)
  -- If `¬2 ≤ b`, then `b = 1`. Since all composite numbers are pseudoprimes to base 1, we can pick
  -- any composite number greater than m. We choose `2 * (m + 2)` because it is greater than `m` and
  -- is composite for all natural numbers `m`.
  · have h₁ : b = 1 := by linarith
    rw [h₁]
    use 2 * (m + 2)
    have : ¬Nat.Prime (2 * (m + 2)) := Nat.not_prime_mul (by norm_num) (by norm_num)
    exact ⟨base_one (by linarith) this, by linarith⟩
#align fermat_psp.exists_infinite_pseudoprimes FermatPsp.exists_infinite_pseudoprimes

theorem frequently_atTop_fermatPsp {b : ℕ} (h : 1 ≤ b) : ∃ᶠ n in Filter.atTop, FermatPsp n b :=
  by
  -- Based on the proof of `nat.frequently_at_top_modeq_one`
  refine' Filter.frequently_atTop.2 fun n => _
  obtain ⟨p, hp⟩ := exists_infinite_pseudoprimes h n
  exact ⟨p, hp.2, hp.1⟩
#align fermat_psp.frequently_at_top_fermat_psp FermatPsp.frequently_atTop_fermatPsp

/-- Infinite set variant of `exists_infinite_pseudoprimes`
-/
theorem infinite_setOf_prime_modeq_one {b : ℕ} (h : 1 ≤ b) :
    Set.Infinite { n : ℕ | FermatPsp n b } :=
  Nat.frequently_atTop_iff_infinite.mp (frequently_atTop_fermatPsp h)
#align fermat_psp.infinite_set_of_prime_modeq_one FermatPsp.infinite_setOf_prime_modeq_one

end FermatPsp


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro hp; exact and.intro hq hp,
end


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.nat.preterm
import Mathlib.PostPort

universes l

namespace Mathlib

/-
Linear natural number arithmetic preformulas in pre-normalized preform.
-/

namespace omega

namespace nat

/-- Intermediate shadow syntax for LNA formulas that includes unreified exprs -/
/-- Intermediate shadow syntax for LNA formulas that includes non-canonical terms -/
inductive preform where
| eq : preterm → preterm → preform
| le : preterm → preterm → preform
| not : preform → preform
| or : preform → preform → preform
| and : preform → preform → preform

namespace preform

/-- Evaluate a preform into prop using the valuation `v`. -/
@[simp] def holds (v : ℕ → ℕ) : preform → Prop := sorry

end preform

/-- `univ_close p n` := `p` closed by prepending `n` universal quantifiers -/
@[simp] def univ_close (p : preform) : (ℕ → ℕ) → ℕ → Prop := sorry

namespace preform

/-- Argument is free of negations -/
def neg_free : preform → Prop := sorry

/-- Return expr of proof that argument is free of subtractions -/
def sub_free : preform → Prop := sorry

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preform → ℕ := sorry

theorem holds_constant {v : ℕ → ℕ} {w : ℕ → ℕ} (p : preform) :
    (∀ (x : ℕ), x < fresh_index p → v x = w x) → (holds v p ↔ holds w p) :=
  sorry

/-- All valuations satisfy argument -/
def valid (p : preform) := ∀ (v : ℕ → ℕ), holds v p

/-- There exists some valuation that satisfies argument -/
def sat (p : preform) := ∃ (v : ℕ → ℕ), holds v p

/-- `implies p q` := under any valuation, `q` holds if `p` holds -/
def implies (p : preform) (q : preform) := ∀ (v : ℕ → ℕ), holds v p → holds v q

/-- `equiv p q` := under any valuation, `p` holds iff `q` holds -/
def equiv (p : preform) (q : preform) := ∀ (v : ℕ → ℕ), holds v p ↔ holds v q

theorem sat_of_implies_of_sat {p : preform} {q : preform} : implies p q → sat p → sat q :=
  fun (h1 : implies p q) (h2 : sat p) => exists_imp_exists h1 h2

theorem sat_or {p : preform} {q : preform} : sat (or p q) ↔ sat p ∨ sat q := sorry

/-- There does not exist any valuation that satisfies argument -/
def unsat (p : preform) := ¬sat p

def repr : preform → string := sorry

protected instance has_repr : has_repr preform := has_repr.mk repr

end preform

theorem univ_close_of_valid {p : preform} {m : ℕ} {v : ℕ → ℕ} :
    preform.valid p → univ_close p v m :=
  sorry

theorem valid_of_unsat_not {p : preform} : preform.unsat (preform.not p) → preform.valid p := sorry

end Mathlib


/-
Copyright (c) 2018 Luca Gerolla. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luca Gerolla, Kenny Lau
Basic definitions of probability theory and
(one-sided/discrete) stochastic processes
-/
import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space
import analysis.real
import analysis.metric_space
import analysis.normed_space
import data.real.basic tactic.norm_num
import data.set.basic
import analysis.measure_theory.borel_space
import analysis.measure_theory.lebesgue_measure
import analysis.measure_theory.integration
import analysis.measure_theory.measurable_space
import analysis.measure_theory.measure_space
import data.set order.galois_connection analysis.ennreal
       analysis.measure_theory.outer_measure
import Topology.Material.path
import data.set.lattice

noncomputable theory

open classical set lattice filter finset function
local attribute [instance] prop_decidable

open measure_theory
open topological_space

--local notation `meas` := measure_theory.measure

universes u v w x

section
-- Section containing prelimanary definitions for
-- later works (only ind_fun needed for next section)

variables {α : Type*} [measure_space α]
variables { μ : measure α }{ v : measure α  } {s : set α }

---- Preliminaries: Abs. cont. measures, Radon Nikodym, and indicator function (for later)

definition abs_cont ( μ : measure α  )(v : measure α ) : Prop :=
∀ (s : set α), v s = 0 → μ s = 0

-- (stronger then needed)
def finite_measure ( μ : measure α ) := μ (univ : set α) < (⊤ : ennreal)

def rad_nik_property ( μ : measure α )(v : measure α ) ( f : α → ennreal) :=
  ∀ s : set α, μ s = @lintegral α { μ := v } f

structure rad_nik_der ( μ : measure α )(v : measure α ) :=
(to_fun : α → ennreal )
(meas : measurable to_fun )
(density_rn : rad_nik_property μ v to_fun  )

def radon_nikodym_build ( h : abs_cont μ v ) ( hf : finite_measure v ) : rad_nik_der μ v :=
  sorry

theorem radon_nikodym_thm₂ ( h : abs_cont μ v ) ( hf : finite_measure v ) :
    ∃ (D : rad_nik_der μ v),  rad_nik_property μ v D.to_fun :=
begin
 existsi radon_nikodym_build h hf, exact (radon_nikodym_build h hf).3,
end

-- indicator function
def ind_fun ( A : set α ) { F : measurable_space α } (h : F.is_measurable A ) : simple_func α ennreal :=
{ to_fun := λ (x: α ), if x ∈ A then (1:ennreal) else (0:ennreal),

  measurable_sn :=
  begin intro a, by_cases H : a = 1 ,
  have h₂ : (λ (x : α), ite (x ∈ A) (1 : ennreal) 0) ⁻¹' {1} = A,
    unfold set.preimage, apply set.ext, intro x,
    have h₃ : ite (x ∈ A) (1:ennreal) 0 = (1:ennreal) ↔ x ∈ A,
      split_ifs, --or double cc
        exact ⟨ begin intro y, exact h_1 end, begin intro y, trivial end ⟩,
        refine ⟨ _, _ ⟩, intro y, by_contradiction,
        have j : (0:ennreal) = (1:ennreal) → false, { simp}, exact j y,
        intro y, cc,
  simp [ h₃], subst H, rw h₂, exact h,
  by_cases T : a = 0,
    { have g₁ : (λ (x : α), ite (x ∈ A) (1:ennreal) 0) ⁻¹' {a} = -A,
      ext z, simp, subst a, split_ifs; simpa,
    rw g₁, exact is_measurable.compl h,
    },
  have g₁ : (λ (x : α), ite (x ∈ A) (1:ennreal) 0) ⁻¹' {a} = ∅, ext z, simp, split_ifs; cc,
  rw g₁ , exact is_measurable.empty,
  end ,

  finite := begin unfold set.range,
  have w : {x : ennreal | ∃ (y : α), ite (y ∈ A) (1:ennreal) 0 = x} ⊆  {(1:ennreal), 0},
    intro r, rw mem_set_of_eq,
    rintro ⟨y, rfl⟩, split_ifs; simp,
  refine finite_subset _ w  ,
  simp [w],
  end,

}

end

--------------
---- Random Variables, Cond. Expectations, Stochastic and Markvov Processes
--------------

section

---- Define spaces

-- Complete separable metric space
class csm_space (β : Type*) extends metric_space β , complete_space β, separable_space β

class measurable_csm_space (β : Type*) extends csm_space β, measurable_space β

class probability_space (α : Type*) extends measure_space α :=
( univ_one : volume (univ : set α) = 1)

----

variables {β : Type*} [measurable_space β ]{γ  : Type*} [measurable_space γ ]

---- Random variables

/-  Should define this with measurable_csm_space β but
need to prove ennreal is a measurable_csm_space
-/

structure random_variable (α : Type*) [probability_space α] (β : Type*) [measurable_space β ]:=
( to_fun : α → β )
( meas : measurable to_fun )

structure real_rv (α : Type*) [probability_space α] extends random_variable α ennreal

variables {α : Type*} [probability_space α] { F : measurable_space α }

definition random_variable.comp (x : random_variable α β ) {f : β  → γ } (h : measurable f) :
  random_variable α γ  :=
{ to_fun := f ∘ x.to_fun ,
  meas := measurable.comp x.2 h,
}

-- measure_of
def push_forward {α : Type*} [probability_space α] {β : Type*} [measurable_space β ] (x : random_variable α β ) : measure β :=
{ measure_of := λ s, sorry,  --(x ⁻¹' s) ,
 empty := sorry,
 mono := sorry,
 Union_nat := sorry,
 m_Union := sorry,
 trimmed := sorry,
}

definition to_prob_space {β : Type*} [measurable_space β ] (x : random_variable α β ) :
  probability_space β :=
{ μ := push_forward x,
  univ_one := begin unfold volume, sorry end,
}

-- add condition that F of probability space ≥ m₁ m₂?
definition independent (m₁ : measurable_space α )(m₂ : measurable_space α ) : Prop :=
∀ (a b : set α ) (h₁ : m₁.is_measurable a) (h₂  : m₂.is_measurable a), volume (a ∩ b) = volume a * volume b

---- Expectation and conditional expectation

def expectation (f : α → ennreal ) := lintegral f

def match_integ ( t : measurable_space α ) (f g : α → ennreal) { s : set α } ( h : t.is_measurable s ): Prop :=
lintegral (( ind_fun s h ).to_fun * f ) = lintegral (( ind_fun s h ).to_fun * g )

structure cond_exp ( X : random_variable α ennreal) ( t : measurable_space α ) :=
( to_fun : α → ennreal)
( meas : @measurable _ _ t _ to_fun)
( aver_match : ∀ (s : set α ) (h : t.is_measurable s), match_integ t X.to_fun to_fun h )

---- Stochastic process

structure stoch_process (α : Type*) [probability_space α](β : Type*) [measurable_space β ]:=
( seq : ℕ → α → β   )
( meas : ∀ n : ℕ, measurable (seq n) )

attribute [class] stoch_process

-- instance (α : Type*) [probability_space α](β : Type*) [measurable_space β ] :
--   has_coe_to_fun ( stoch_process α β ) := begin sorry end
--   --⟨ _ , stoch_process.to_fun ⟩

def stoch_process.comp {f : β  → γ } (h : measurable f) ( x : stoch_process α β ) :
  stoch_process α γ :=
{ seq := λ n , f ∘ (x.seq n) ,
  meas := λ n, measurable.comp (x.2 n) h,
}

def rv_of_stoch_proc ( x : stoch_process α β ) (n : ℕ ) : random_variable α β  :=
{ to_fun := x.seq n ,
 meas := x.meas n,
}

def rv_of_stoch_proc.comp {f : β  → γ } (h : measurable f) ( x : stoch_process α β ) (n : ℕ ) :
  random_variable α γ :=
{ to_fun :=  f ∘ (x.seq n),
  meas := measurable.comp (x.2 n) h,
}

----- Sigma algebras generated

def gen_from_rv (h : measurable_space β) ( X : random_variable α β) : measurable_space α :=
measurable_space.comap X.to_fun h

def gen_from_one_stoch ( n : ℕ ) ( x : stoch_process α β ) : measurable_space α :=
measurable_space.comap (x.seq n) infer_instance

def gen_from_stoch ( n : ℕ ) ( x : stoch_process α β  ) : measurable_space α :=
⨆ k ≤ n, measurable_space.comap (x.seq n) infer_instance

----- Markov Process

def markov_property {f : β → ennreal } ( h : measurable f) ( x : stoch_process α β ) (n : ℕ ) : Prop :=
cond_exp  ( rv_of_stoch_proc.comp h x (n+1)) ( gen_from_stoch n x ) = cond_exp (rv_of_stoch_proc.comp h x (n+1)) ( gen_from_one_stoch n x )

structure markov_process extends stoch_process α β  :=
( markov : ∀ (n :ℕ) {f : β → ennreal} (h : measurable f), markov_property h (to_stoch_process) n)

instance : measurable_space (with_top ℕ) := ⊤

-- sort out β as csm_space /
structure stopping_time {α : Type*} [probability_space α] {β : Type*} [measurable_space β ]
 ( x : stoch_process α β ) extends random_variable α (with_top ℕ)  :=
( meas_at_n : ∀ (n:ℕ), (gen_from_stoch n x).is_measurable ( to_random_variable.to_fun⁻¹' {n}) )
-- prove equivalent to ≤ n

/- structure random_variable (α : Type*) [probability_space α] (β : Type*) [measurable_space β ]:=
( to_fun : α → β )
( meas : measurable to_fun )-/

end

section

-- unbundled
structure is_measure_inv {α : Type*} [measure_space α] (f : α → α) :=
( meas : measurable f )
( inv : ∀ (s : set α) (h : measurable s), volume (f ⁻¹' s) = volume s )

structure ergodic {α β : Type*} [probability_space α] (f : α → α )
  extends is_measure_inv f :=
( ergod : ∀ (s : set α) (h : measurable s) (h₂ : (f ⁻¹' s) = s ),
  volume s = 0 ∨ volume s = 1 )

--- un bundled
/- class is_linear_map {α : Type u} {β : Type v} {γ : Type w}
  [ring α] [add_comm_group β] [add_comm_group γ] [module α β] [module α γ]
  (f : β → γ) : Prop :=
(add  : ∀x y, f (x + y) = f x + f y)
(smul : ∀c x, f (c • x) = c • f x)
-- bundled
structure linear_map {α : Type u} (β : Type v) (γ : Type w)
  [ring α] [add_comm_group β] [add_comm_group γ] [module α β] [module α γ] :=
(to_fun : β → γ)
(add  : ∀x y, to_fun (x + y) = to_fun x + to_fun y)
(smul : ∀c x, to_fun (c • x) = c • to_fun x)-/
end

-- TO DO (/wish list) ----------------------------------------------

------- FIXES
-- Sort out sigma algebra on sample space (set it to be power set?)
---- so sort out independence

-- Push forward and induced probability space

------- Definitions
-- almost surely

-- Push forward

-- Stopping time ++ prove definition equivalent to ≤ n

-- Independence ++ For finite collection

-- Product measures (!)

-- F(x, ξ )

-- General T sided processes, Feller property

------- Lemmas
-- Filtration of sigma algebras

-- a.s. as function of α → Prop and measure of reference

-- Towering property of cond expectation and f measurable checking

-- +++ Notation of cond. expect

-- Subst a.s equality when appropriate

------ Prove uniqueness (a.s.) of cond expectation
--- conditional expectation is Radon-Nikodym derivative of (X real valued)
-- μ induced by X    : = ∫a  X dP   (a ∈ F')
-- v = P restricted to F'
-- essentially unique

-- THMS of lectures...

-------- Further
-- Tight, weak convergence (weak topology)

-- Ergodicity / invariant map
------  + Transition probability

-- ODEs

---------------------------------

------- Concrete
-- Bernoulli (or Multinoulli?) -> Random walk on integers
section
variables {α : Type*} [probability_space α]
open path

instance ennreal_of_I01 : has_coe I01 ennreal := ⟨ λ t, option.some ⟨t.1, t.2.1⟩ ⟩

-- lemma ennreal_of_I01 (t : I01) : ennreal :=
-- begin unfold ennreal nnreal, have h : 0 ≤ t.1, exact t.2.1, exact ⟨t.1, h ⟩,    end
-- instance {α} [topological_space α] (x y : α) : has_coe_to_fun (path x y) := ⟨_, path.to_fun⟩

structure ref_event (α : Type*) [probability_space α] ( p : I01 ) :=
( to_set : set α )
( meas : is_measurable to_set)
( prob : volume to_set =  p )

@[simp] lemma prob_ref_event {α : Type*} [probability_space α] { p : I01 } (s : ref_event α p) :
  volume s.1 = p := s.3

def base {p : I01} (A : ref_event α p): random_variable α Prop :=
{ to_fun := λ w, if w ∈ A.1 then tt else ff,
  meas := measurable.if A.2 measurable_const measurable_const,
}

-- def cite (a b : ℝ ) : Prop → ℝ := λ w, ite w a b
def gen_bernoulli {p : I01} (A : ref_event α p) (a b : ℝ ): random_variable α ℝ :=
{ to_fun := (λ s, ite s a b) ∘ (base A).1,
--ite ((base A).1 w) a b,
  meas := begin refine measurable.comp (base A).2 _,
  refine measurable.if _ measurable_const measurable_const, apply measurable_space.generate_measurable.basic _, show topological_space.is_open _ _,
  apply generate_open.basic, left, ext a, rcases eq_true_or_eq_false a with rfl | rfl; simp,
  end
}

def bernoulli {p : I01} (A : ref_event α p) := gen_bernoulli A 0 1

lemma prob_bernoulli {p : I01} {A : ref_event α p} {a b : ℝ } ( x = gen_bernoulli A a b) :
  volume (x.to_fun ⁻¹' {a} ) = p :=
begin rw H, unfold gen_bernoulli, simp,
  suffices h : (λ (s : Prop), ite s a b) ∘ (base A).to_fun ⁻¹' {a} = A.1,
    rw h, exact A.3, --simp
  rw preimage_comp,
  have h₂ : (λ (s : Prop), ite s a b) ⁻¹' {a} = {true},
  {  apply set.ext, intro q, split, intro hq, sorry,--rw mem_set_of_eq at hq,
    --have y : q = true → (ite q a b) = a)
    simp, sorry,
  },
  rw h₂, unfold base, simp, sorry ,

 end

-- general
def F {p : I01} (A : ref_event α p) : α → (ℝ → ℝ ) := λ w, ( λ x, x + ((gen_bernoulli A 1 (-1 : ℝ) ).1 w) )

-- def F_rec (x : stoch_process α ℝ ) {p : I01} (A : ref_event α p):  α → ℕ →

#check (by apply_instance : measurable_space Prop)
#check (by apply_instance : complete_lattice (topological_space Prop))
#check topological_space.lattice.complete_lattice

end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Eric Wieser
-/
import data.matrix.basis
import ring_theory.tensor_product

/-!
We show `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
-/

universes u v w

open_locale tensor_product
open_locale big_operators

open tensor_product
open algebra.tensor_product
open matrix

variables {R : Type u} [comm_semiring R]
variables {A : Type v} [semiring A] [algebra R A]
variables {n : Type w}

variables (R A n)
namespace matrix_equiv_tensor

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-bilinear map.
-/
def to_fun_bilinear : A →ₗ[R] matrix n n R →ₗ[R] matrix n n A :=
(algebra.lsmul R (matrix n n A)).to_linear_map.compl₂ (algebra.linear_map R A).map_matrix

@[simp] lemma to_fun_bilinear_apply (a : A) (m : matrix n n R) :
  to_fun_bilinear R A n a m = a • m.map (algebra_map R A) := rfl

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-linear map.
-/
def to_fun_linear : A ⊗[R] matrix n n R →ₗ[R] matrix n n A :=
tensor_product.lift (to_fun_bilinear R A n)

variables [decidable_eq n] [fintype n]

/--
The function `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`, as an algebra homomorphism.
-/
def to_fun_alg_hom : (A ⊗[R] matrix n n R) →ₐ[R] matrix n n A :=
alg_hom_of_linear_map_tensor_product
(to_fun_linear R A n)
begin
  intros,
  simp_rw [to_fun_linear, lift.tmul, to_fun_bilinear_apply, mul_eq_mul, matrix.map_mul],
  ext,
  dsimp,
  simp_rw [matrix.mul_apply, pi.smul_apply, matrix.map_apply, smul_eq_mul, finset.mul_sum,
    _root_.mul_assoc, algebra.left_comm],
end
begin
  intros,
  simp_rw [to_fun_linear, lift.tmul, to_fun_bilinear_apply,
    matrix.map_one (algebra_map R A) (map_zero _) (map_one _), algebra_map_smul,
    algebra.algebra_map_eq_smul_one],
end

@[simp] lemma to_fun_alg_hom_apply (a : A) (m : matrix n n R) :
  to_fun_alg_hom R A n (a ⊗ₜ m) = a • m.map (algebra_map R A) :=
by simp [to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear]

/--
(Implementation detail.)

The bare function `matrix n n A → A ⊗[R] matrix n n R`.
(We don't need to show that it's an algebra map, thankfully --- just that it's an inverse.)
-/
def inv_fun (M : matrix n n A) : A ⊗[R] matrix n n R :=
∑ (p : n × n), M p.1 p.2 ⊗ₜ (std_basis_matrix p.1 p.2 1)

@[simp] lemma inv_fun_zero : inv_fun R A n 0 = 0 :=
by simp [inv_fun]

@[simp] lemma inv_fun_add (M N : matrix n n A) :
  inv_fun R A n (M + N) = inv_fun R A n M + inv_fun R A n N :=
by simp [inv_fun, add_tmul, finset.sum_add_distrib]

@[simp] lemma inv_fun_smul (a : A) (M : matrix n n A) :
  inv_fun R A n (a • M) = (a ⊗ₜ 1) * inv_fun R A n M :=
by simp [inv_fun,finset.mul_sum]

@[simp] lemma inv_fun_algebra_map (M : matrix n n R) :
  inv_fun R A n (M.map (algebra_map R A)) = 1 ⊗ₜ M :=
begin
  dsimp [inv_fun],
  simp only [algebra.algebra_map_eq_smul_one, smul_tmul, ←tmul_sum, mul_boole],
  congr,
  conv_rhs {rw matrix_eq_sum_std_basis M},
  convert finset.sum_product, simp,
end

lemma right_inv (M : matrix n n A) : (to_fun_alg_hom R A n) (inv_fun R A n M) = M :=
begin
  simp only [inv_fun, alg_hom.map_sum, std_basis_matrix, apply_ite ⇑(algebra_map R A), smul_eq_mul,
    mul_boole, to_fun_alg_hom_apply, ring_hom.map_zero, ring_hom.map_one, matrix.map_apply,
    pi.smul_def],
  convert finset.sum_product, apply matrix_eq_sum_std_basis,
end

lemma left_inv (M : A ⊗[R] matrix n n R) : inv_fun R A n (to_fun_alg_hom R A n M) = M :=
begin
  induction M using tensor_product.induction_on with a m x y hx hy,
  { simp, },
  { simp, },
  { simp [alg_hom.map_sum, hx, hy], },
end

/--
(Implementation detail)

The equivalence, ignoring the algebra structure, `(A ⊗[R] matrix n n R) ≃ matrix n n A`.
-/
def equiv : (A ⊗[R] matrix n n R) ≃ matrix n n A :=
{ to_fun := to_fun_alg_hom R A n,
  inv_fun := inv_fun R A n,
  left_inv := left_inv R A n,
  right_inv := right_inv R A n, }

end matrix_equiv_tensor

variables [fintype n] [decidable_eq n]

/--
The `R`-algebra isomorphism `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
-/
def matrix_equiv_tensor : matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R) :=
alg_equiv.symm { ..(matrix_equiv_tensor.to_fun_alg_hom R A n), ..(matrix_equiv_tensor.equiv R A n) }

open matrix_equiv_tensor

@[simp] lemma matrix_equiv_tensor_apply (M : matrix n n A) :
  matrix_equiv_tensor R A n M =
    ∑ (p : n × n), M p.1 p.2 ⊗ₜ (std_basis_matrix p.1 p.2 1) :=
rfl

@[simp] lemma matrix_equiv_tensor_apply_std_basis (i j : n) (x : A):
  matrix_equiv_tensor R A n (std_basis_matrix i j x) =
    x ⊗ₜ (std_basis_matrix i j 1) :=
begin
  have t : ∀ (p : n × n), (i = p.1 ∧ j = p.2) ↔ (p = (i, j)) := by tidy,
  simp [ite_tmul, t, std_basis_matrix],
end

@[simp] lemma matrix_equiv_tensor_apply_symm (a : A) (M : matrix n n R) :
  (matrix_equiv_tensor R A n).symm (a ⊗ₜ M) =
    M.map (λ x, a * algebra_map R A x) :=
begin
  simp [matrix_equiv_tensor, to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear],
  refl,
end


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import tactic.monotonicity
import tactic.norm_num
import algebra.order.ring
import measure_theory.measure.lebesgue
import data.list.defs

open list tactic tactic.interactive set

example
  (h : 3 + 6 ≤ 4 + 5)
: 1 + 3 + 2 + 6 ≤ 4 + 2 + 1 + 5 :=
begin
  ac_mono,
end

example
  (h : 3 ≤ (4 : ℤ))
  (h' : 5 ≤ (6 : ℤ))
: (1 + 3 + 2) - 6 ≤ (4 + 2 + 1 : ℤ) - 5 :=
begin
  ac_mono,
  mono,
end

example
  (h : 3 ≤ (4 : ℤ))
  (h' : 5 ≤ (6 : ℤ))
: (1 + 3 + 2) - 6 ≤ (4 + 2 + 1 : ℤ) - 5 :=
begin
  transitivity (1 + 3 + 2 - 5 : ℤ),
  { ac_mono },
  { ac_mono },
end

example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y)
: (k + 3 + x) - y ≤ (k + 4 + x) - z :=
begin
  mono, norm_num
end

example (x y z a b : ℤ)
  (h : a ≤ (b : ℤ))
  (h' : z ≤ y)
: (1 + a + x) - y ≤ (1 + b + x) - z :=
begin
  transitivity (1 + a + x - z),
  { mono, },
  { mono, mono, mono },
end

example (x y z : ℤ)
  (h' : z ≤ y)
: (1 + 3 + x) - y ≤ (1 + 4 + x) - z :=
begin
  transitivity (1 + 3 + x - z),
  { mono },
  { mono, mono, norm_num },
end

example (x y z : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y)
: (1 + 3 + x) - y ≤ (1 + 4 + x) - z :=
begin
  ac_mono, mono*
end

@[simp]
def list.le' {α : Type*} [has_le α] : list α → list α → Prop
 | (x::xs) (y::ys) := x ≤ y ∧ list.le' xs ys
 | [] [] := true
 | _ _ := false

@[simp]
instance list_has_le {α : Type*} [has_le α] : has_le (list α) :=
⟨ list.le' ⟩

lemma list.le_refl {α : Type*} [preorder α] {xs : list α}
: xs ≤ xs :=
begin
  induction xs with x xs,
  { trivial },
  { simp [has_le.le,list.le],
    split, exact le_rfl, apply xs_ih }
end

-- @[trans]
lemma list.le_trans {α : Type*} [preorder α]
  {xs zs : list α} (ys : list α)
  (h  : xs ≤ ys)
  (h' : ys ≤ zs)
: xs ≤ zs :=
begin
  revert ys zs,
  induction xs with x xs
  ; intros ys zs h h'
  ; cases ys with y ys
  ; cases zs with z zs
  ; try { cases h ; cases h' ; done },
  { apply list.le_refl },
  { simp [has_le.le,list.le],
    split,
    apply le_trans h.left h'.left,
    apply xs_ih _ h.right h'.right, }
end

@[mono]
lemma list_le_mono_left {α : Type*} [preorder α] {xs ys zs : list α}
  (h : xs ≤ ys)
: xs ++ zs ≤ ys ++ zs :=
begin
  revert ys,
  induction xs with x xs ; intros ys h,
  { cases ys, apply list.le_refl, cases h },
  { cases ys with y ys, cases h, simp [has_le.le,list.le] at *,
    revert h, apply and.imp_right,
    apply xs_ih }
end

@[mono]
lemma list_le_mono_right {α : Type*} [preorder α] {xs ys zs : list α}
  (h : xs ≤ ys)
: zs ++ xs ≤ zs ++ ys :=
begin
  revert ys zs,
  induction xs with x xs ; intros ys zs h,
  { cases ys, { simp, apply list.le_refl }, cases h },
  { cases ys with y ys, cases h, simp [has_le.le,list.le] at *,
    suffices : list.le' ((zs ++ [x]) ++ xs) ((zs ++ [y]) ++ ys),
    { refine cast _ this, simp, },
    apply list.le_trans (zs ++ [y] ++ xs),
    { apply list_le_mono_left,
      induction zs with z zs,
      { simp [has_le.le,list.le], apply h.left },
      { simp [has_le.le,list.le], split, exact le_rfl,
        apply zs_ih, } },
    { apply xs_ih h.right, } }
end

lemma bar_bar'
  (h : [] ++ [3] ++ [2] ≤ [1] ++ [5] ++ [4])
: [] ++ [3] ++ [2] ++ [2] ≤ [1] ++ [5] ++ ([4] ++ [2]) :=
begin
  ac_mono,
end

lemma bar_bar''
  (h : [3] ++ [2] ++ [2] ≤ [5] ++ [4] ++ [])
: [1] ++ ([3] ++ [2]) ++ [2] ≤ [1] ++ [5] ++ ([4] ++ []) :=
begin
  ac_mono,
end

lemma bar_bar
  (h : [3] ++ [2] ≤ [5] ++ [4])
: [1] ++ [3] ++ [2] ++ [2] ≤ [1] ++ [5] ++ ([4] ++ [2]) :=
begin
  ac_mono,
end

def P (x : ℕ) := 7 ≤ x
def Q (x : ℕ) := x ≤ 7

@[mono]
lemma P_mono {x y : ℕ}
  (h : x ≤ y)
: P x → P y :=
by { intro h', apply le_trans h' h }

@[mono]
lemma Q_mono {x y : ℕ}
  (h : y ≤ x)
: Q x → Q y :=
by apply le_trans h

example (x y z : ℕ)
  (h : x ≤ y)
: P (x + z) → P (z + y) :=
begin
  ac_mono,
  ac_mono,
end

example (x y z : ℕ)
  (h : y ≤ x)
: Q (x + z) → Q (z + y) :=
begin
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℤ)
  (h₀ : z ≤ 0)
  (h₁ : y ≤ x)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  -- ⊢ (m + x + n) * z ≤ z * (y + n + m)
  ac_mono,
  -- ⊢ m + x + n ≤ y + n + m
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by { ac_mono* := h₁ }

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : m + x + n ≤ y + n + m)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by { ac_mono* := h₁ }

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : n + x + m ≤ y + n + m)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono* : m + x + n ≤ y + n + m,
  transitivity ; [ skip , apply h₁ ],
  apply le_of_eq,
  ac_refl,
end

example (x y z k m n : ℤ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono,
    success_if_fail { ac_mono },
    admit },
  trivial
end

example (x y z k m n : ℕ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono*,
    change 0 ≤ z, apply nat.zero_le, },
  trivial
end

example (x y z k m n : ℕ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono,
    change (m + x + n) * z ≤ z * (y + n + m),
    admit },
  trivial,
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: (m + x + n + i) * z + k = z * (j + n + m + y) + k :=
begin
  ac_mono^3,
  cc
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: z * (x + i + n + m) + k = z * (y + j + n + m) + k :=
begin
  congr,
  simp [h₁],
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: (m + x + n + i) * z + k = z * (j + n + m + y) + k :=
begin
  ac_mono*,
  cc,
end

example (x y : ℕ)
  (h : x ≤ y)
: true :=
begin
  (do v ← mk_mvar,
      p ← to_expr ```(%%v + x ≤ y + %%v),
      assert `h' p),
  ac_mono := h,
  trivial,
  exact 1,
end

example {x y z : ℕ} : true :=
begin
  have : y + x ≤ y + z,
  { mono,
    guard_target' x ≤ z,
    admit },
  trivial
end

example {x y z : ℕ} : true :=
begin
  suffices : x + y ≤ z + y, trivial,
  mono,
  guard_target' x ≤ z,
  admit,
end

example {x y z w : ℕ} : true :=
begin
  have : x + y ≤ z + w,
  { mono,
    guard_target' x ≤ z, admit,
    guard_target' y ≤ w, admit },
  trivial
end

example {x y z w : ℕ} : true :=
begin
  have : x * y ≤ z * w,
  { mono with [0 ≤ z,0 ≤ y],
    { guard_target 0 ≤ z, admit },
    { guard_target 0 ≤ y, admit },
    guard_target' x ≤ z, admit,
    guard_target' y ≤ w, admit },
  trivial
end

example {x y z w : Prop} : true :=
begin
  have : x ∧ y → z ∧ w,
  { mono,
    guard_target' x → z, admit,
    guard_target' y → w, admit },
  trivial
end

example {x y z w : Prop} : true :=
begin
  have : x ∨ y → z ∨ w,
  { mono,
    guard_target' x → z, admit,
    guard_target' y → w, admit },
  trivial
end

example {x y z w : ℤ} : true :=
begin
  suffices : x + y < w + z, trivial,
  have : x < w, admit,
  have : y ≤ z, admit,
  mono right,
end

example {x y z w : ℤ} : true :=
begin
  suffices : x * y < w * z, trivial,
  have : x < w, admit,
  have : y ≤ z, admit,
  mono right,
  { guard_target' 0 < y, admit },
  { guard_target' 0 ≤ w, admit },
end

open tactic

example (x y : ℕ)
  (h : x ≤ y)
: true :=
begin
  (do v ← mk_mvar,
      p ← to_expr ```(%%v + x ≤ y + %%v),
      assert `h' p),
  ac_mono := h,
  trivial,
  exact 3
end

example {α} [linear_order α]
  (a b c d e : α) :
  max a b ≤ e → b ≤ e :=
by { mono, apply le_max_right }

example (a b c d e : Prop)
  (h : d → a) (h' : c → e) :
  (a ∧ b → c) ∨ d → (d ∧ b → e) ∨ a :=
begin
  mono,
  mono,
  mono,
end

example : ∫ x in Icc 0 1, real.exp x ≤ ∫ x in Icc 0 1, real.exp (x+1) :=
begin
  mono,
  { exact real.continuous_exp.integrable_on_compact is_compact_Icc },
  { exact (real.continuous_exp.comp $ continuous_add_right 1).integrable_on_compact
      is_compact_Icc },
  intro x,
  dsimp only,
  mono,
  linarith
end


class foo (α : Type) : Type := (f : α)
def foo.f' {α : Type} [c : foo α] : α := foo.f

#print foo.f  -- def foo.f : {α : Type} → [self : foo α] → α
#print foo.f' -- def foo.f' : {α : Type} → [c : foo α] → α

variable {α : Type} [c : foo α]
#check c.f  -- ok
#check c.f' -- ok

structure bar : Prop := (f : ∀ {m : Nat}, m = 0)
def bar.f' : bar → ∀ {m : Nat}, m = 0 := bar.f

#print bar.f  -- def bar.f  : bar → ∀ {m : ℕ}, m = 0
#print bar.f' -- def bar.f' : bar → ∀ {m : ℕ}, m = 0

variable (h : bar) (m : Nat)

#check (h.f : ∀ {m : Nat}, m = 0) -- ok
#check (h.f : m = 0)  -- ok
#check h.f (m := m)   -- ok
#check h.f (m := 0)   -- ok
#check (h.f' : m = 0) -- ok

theorem ex1 (n) : (h.f : n = 0) = h.f (m := n) :=
  rfl


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.calculus.extend_deriv
! 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.Calculus.MeanValue

/-!
# Extending differentiability to the boundary

We investigate how differentiable functions inside a set extend to differentiable functions
on the boundary. For this, it suffices that the function and its derivative admit limits there.
A general version of this statement is given in `has_fderiv_at_boundary_of_tendsto_fderiv`.

One-dimensional versions, in which one wants to obtain differentiability at the left endpoint or
the right endpoint of an interval, are given in
`has_deriv_at_interval_left_endpoint_of_tendsto_deriv` and
`has_deriv_at_interval_right_endpoint_of_tendsto_deriv`. These versions are formulated in terms
of the one-dimensional derivative `deriv ℝ f`.
-/

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] {F : Type _} [NormedAddCommGroup F]
  [NormedSpace ℝ F]

open Filter Set Metric ContinuousLinearMap

open Topology

attribute [local mono] prod_mono

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- If a function `f` is differentiable in a convex open set and continuous on its closure, and its
derivative converges to a limit `f'` at a point on the boundary, then `f` is differentiable there
with derivative `f'`. -/
theorem has_fderiv_at_boundary_of_tendsto_fderiv {f : E → F} {s : Set E} {x : E} {f' : E →L[ℝ] F}
    (f_diff : DifferentiableOn ℝ f s) (s_conv : Convex ℝ s) (s_open : IsOpen s)
    (f_cont : ∀ y ∈ closure s, ContinuousWithinAt f s y)
    (h : Tendsto (fun y => fderiv ℝ f y) (𝓝[s] x) (𝓝 f')) : HasFderivWithinAt f f' (closure s) x :=
  by
  classical
    -- one can assume without loss of generality that `x` belongs to the closure of `s`, as the
    -- statement is empty otherwise
    by_cases hx : x ∉ closure s
    · rw [← closure_closure] at hx
      exact hasFderivWithinAt_of_not_mem_closure hx
    push_neg  at hx
    rw [HasFderivWithinAt, HasFderivAtFilter, Asymptotics.isOCat_iff]
    /- One needs to show that `‖f y - f x - f' (y - x)‖ ≤ ε ‖y - x‖` for `y` close to `x` in `closure
      s`, where `ε` is an arbitrary positive constant. By continuity of the functions, it suffices to
      prove this for nearby points inside `s`. In a neighborhood of `x`, the derivative of `f` is
      arbitrarily close to `f'` by assumption. The mean value inequality completes the proof. -/
    intro ε ε_pos
    obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ y ∈ s, dist y x < δ → ‖fderiv ℝ f y - f'‖ < ε := by
      simpa [dist_zero_right] using tendsto_nhds_within_nhds.1 h ε ε_pos
    set B := ball x δ
    suffices : ∀ y ∈ B ∩ closure s, ‖f y - f x - (f' y - f' x)‖ ≤ ε * ‖y - x‖
    exact mem_nhds_within_iff.2 ⟨δ, δ_pos, fun y hy => by simpa using this y hy⟩
    suffices
      ∀ p : E × E,
        p ∈ closure ((B ∩ s) ×ˢ (B ∩ s)) → ‖f p.2 - f p.1 - (f' p.2 - f' p.1)‖ ≤ ε * ‖p.2 - p.1‖
      by
      rw [closure_prod_eq] at this
      intro y y_in
      apply this ⟨x, y⟩
      have : B ∩ closure s ⊆ closure (B ∩ s) := is_open_ball.inter_closure
      exact ⟨this ⟨mem_ball_self δ_pos, hx⟩, this y_in⟩
    have key :
      ∀ p : E × E, p ∈ (B ∩ s) ×ˢ (B ∩ s) → ‖f p.2 - f p.1 - (f' p.2 - f' p.1)‖ ≤ ε * ‖p.2 - p.1‖ :=
      by
      rintro ⟨u, v⟩ ⟨u_in, v_in⟩
      have conv : Convex ℝ (B ∩ s) := (convex_ball _ _).inter s_conv
      have diff : DifferentiableOn ℝ f (B ∩ s) := f_diff.mono (inter_subset_right _ _)
      have bound : ∀ z ∈ B ∩ s, ‖fderivWithin ℝ f (B ∩ s) z - f'‖ ≤ ε :=
        by
        intro z z_in
        convert le_of_lt (hδ _ z_in.2 z_in.1)
        have op : IsOpen (B ∩ s) := is_open_ball.inter s_open
        rw [DifferentiableAt.fderivWithin _ (op.unique_diff_on z z_in)]
        exact (diff z z_in).DifferentiableAt (IsOpen.mem_nhds op z_in)
      simpa using conv.norm_image_sub_le_of_norm_fderiv_within_le' diff bound u_in v_in
    rintro ⟨u, v⟩ uv_in
    refine' ContinuousWithinAt.closure_le uv_in _ _ key
    have f_cont' : ∀ y ∈ closure s, ContinuousWithinAt (f - f') s y :=
      by
      intro y y_in
      exact tendsto.sub (f_cont y y_in) f'.cont.continuous_within_at
    all_goals
      -- common start for both continuity proofs
      have : (B ∩ s) ×ˢ (B ∩ s) ⊆ s ×ˢ s := by mono <;> exact inter_subset_right _ _
      obtain ⟨u_in, v_in⟩ : u ∈ closure s ∧ v ∈ closure s := by
        simpa [closure_prod_eq] using closure_mono this uv_in
      apply ContinuousWithinAt.mono _ this
      simp only [ContinuousWithinAt]
    rw [nhdsWithin_prod_eq]
    · have : ∀ u v, f v - f u - (f' v - f' u) = f v - f' v - (f u - f' u) :=
        by
        intros
        abel
      simp only [this]
      exact
        tendsto.comp continuous_norm.continuous_at
          ((tendsto.comp (f_cont' v v_in) tendsto_snd).sub <|
            tendsto.comp (f_cont' u u_in) tendsto_fst)
    · apply tendsto_nhdsWithin_of_tendsto_nhds
      rw [nhds_prod_eq]
      exact
        tendsto_const_nhds.mul
          (tendsto.comp continuous_norm.continuous_at <| tendsto_snd.sub tendsto_fst)
#align has_fderiv_at_boundary_of_tendsto_fderiv has_fderiv_at_boundary_of_tendsto_fderiv

/-- If a function is differentiable on the right of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the right at `a`. -/
theorem has_deriv_at_interval_left_endpoint_of_tendsto_deriv {s : Set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
    (f_diff : DifferentiableOn ℝ f s) (f_lim : ContinuousWithinAt f s a) (hs : s ∈ 𝓝[>] a)
    (f_lim' : Tendsto (fun x => deriv f x) (𝓝[>] a) (𝓝 e)) : HasDerivWithinAt f e (Ici a) a :=
  by
  /- This is a specialization of `has_fderiv_at_boundary_of_tendsto_fderiv`. To be in the setting of
    this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
    call `t = (a, b)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ab : a < b, sab : Ioc a b ⊆ s⟩ := mem_nhdsWithin_Ioi_iff_exists_Ioc_subset.1 hs
  let t := Ioo a b
  have ts : t ⊆ s := subset.trans Ioo_subset_Ioc_self sab
  have t_diff : DifferentiableOn ℝ f t := f_diff.mono ts
  have t_conv : Convex ℝ t := convex_Ioo a b
  have t_open : IsOpen t := isOpen_Ioo
  have t_closure : closure t = Icc a b := closure_Ioo ab.ne
  have t_cont : ∀ y ∈ closure t, ContinuousWithinAt f t y :=
    by
    rw [t_closure]
    intro y hy
    by_cases h : y = a
    · rw [h]
      exact f_lim.mono ts
    · have : y ∈ s := sab ⟨lt_of_le_of_ne hy.1 (Ne.symm h), hy.2⟩
      exact (f_diff.continuous_on y this).mono ts
  have t_diff' : tendsto (fun x => fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)) :=
    by
    simp only [deriv_fderiv.symm]
    exact
      tendsto.comp
        (isBoundedBilinearMapSmulRight : IsBoundedBilinearMap ℝ _).continuous_right.ContinuousAt
        (tendsto_nhdsWithin_mono_left Ioo_subset_Ioi_self f_lim')
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : HasDerivWithinAt f e (Icc a b) a :=
    by
    rw [hasDerivWithinAt_iff_hasFderivWithinAt, ← t_closure]
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff'
  exact this.nhds_within (Icc_mem_nhdsWithin_Ici <| left_mem_Ico.2 ab)
#align has_deriv_at_interval_left_endpoint_of_tendsto_deriv has_deriv_at_interval_left_endpoint_of_tendsto_deriv

/-- If a function is differentiable on the left of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the left at `a`. -/
theorem has_deriv_at_interval_right_endpoint_of_tendsto_deriv {s : Set ℝ} {e : E} {a : ℝ}
    {f : ℝ → E} (f_diff : DifferentiableOn ℝ f s) (f_lim : ContinuousWithinAt f s a)
    (hs : s ∈ 𝓝[<] a) (f_lim' : Tendsto (fun x => deriv f x) (𝓝[<] a) (𝓝 e)) :
    HasDerivWithinAt f e (Iic a) a :=
  by
  /- This is a specialization of `has_fderiv_at_boundary_of_differentiable`. To be in the setting of
    this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
    call `t = (b, a)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ba, sab⟩ : ∃ b ∈ Iio a, Ico b a ⊆ s := mem_nhdsWithin_Iio_iff_exists_Ico_subset.1 hs
  let t := Ioo b a
  have ts : t ⊆ s := subset.trans Ioo_subset_Ico_self sab
  have t_diff : DifferentiableOn ℝ f t := f_diff.mono ts
  have t_conv : Convex ℝ t := convex_Ioo b a
  have t_open : IsOpen t := isOpen_Ioo
  have t_closure : closure t = Icc b a := closure_Ioo (ne_of_lt ba)
  have t_cont : ∀ y ∈ closure t, ContinuousWithinAt f t y :=
    by
    rw [t_closure]
    intro y hy
    by_cases h : y = a
    · rw [h]
      exact f_lim.mono ts
    · have : y ∈ s := sab ⟨hy.1, lt_of_le_of_ne hy.2 h⟩
      exact (f_diff.continuous_on y this).mono ts
  have t_diff' : tendsto (fun x => fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)) :=
    by
    simp only [deriv_fderiv.symm]
    exact
      tendsto.comp
        (isBoundedBilinearMapSmulRight : IsBoundedBilinearMap ℝ _).continuous_right.ContinuousAt
        (tendsto_nhdsWithin_mono_left Ioo_subset_Iio_self f_lim')
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : HasDerivWithinAt f e (Icc b a) a :=
    by
    rw [hasDerivWithinAt_iff_hasFderivWithinAt, ← t_closure]
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff'
  exact this.nhds_within (Icc_mem_nhdsWithin_Iic <| right_mem_Ioc.2 ba)
#align has_deriv_at_interval_right_endpoint_of_tendsto_deriv has_deriv_at_interval_right_endpoint_of_tendsto_deriv

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (y «expr ≠ » x) -/
/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is also the derivative of `f` at this point. -/
theorem hasDerivAt_of_hasDerivAt_of_ne {f g : ℝ → E} {x : ℝ}
    (f_diff : ∀ (y) (_ : y ≠ x), HasDerivAt f (g y) y) (hf : ContinuousAt f x)
    (hg : ContinuousAt g x) : HasDerivAt f (g x) x :=
  by
  have A : HasDerivWithinAt f (g x) (Ici x) x :=
    by
    have diff : DifferentiableOn ℝ f (Ioi x) := fun y hy =>
      (f_diff y (ne_of_gt hy)).DifferentiableAt.DifferentiableWithinAt
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply
      has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff hf.continuous_within_at
        self_mem_nhdsWithin
    have : tendsto g (𝓝[>] x) (𝓝 (g x)) := tendsto_inf_left hg
    apply this.congr' _
    apply mem_of_superset self_mem_nhdsWithin fun y hy => _
    exact (f_diff y (ne_of_gt hy)).deriv.symm
  have B : HasDerivWithinAt f (g x) (Iic x) x :=
    by
    have diff : DifferentiableOn ℝ f (Iio x) := fun y hy =>
      (f_diff y (ne_of_lt hy)).DifferentiableAt.DifferentiableWithinAt
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply
      has_deriv_at_interval_right_endpoint_of_tendsto_deriv diff hf.continuous_within_at
        self_mem_nhdsWithin
    have : tendsto g (𝓝[<] x) (𝓝 (g x)) := tendsto_inf_left hg
    apply this.congr' _
    apply mem_of_superset self_mem_nhdsWithin fun y hy => _
    exact (f_diff y (ne_of_lt hy)).deriv.symm
  simpa using B.union A
#align has_deriv_at_of_has_deriv_at_of_ne hasDerivAt_of_hasDerivAt_of_ne

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (y «expr ≠ » x) -/
/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is the derivative of `f` everywhere. -/
theorem hasDerivAt_of_hasDerivAt_of_ne' {f g : ℝ → E} {x : ℝ}
    (f_diff : ∀ (y) (_ : y ≠ x), HasDerivAt f (g y) y) (hf : ContinuousAt f x)
    (hg : ContinuousAt g x) (y : ℝ) : HasDerivAt f (g y) y :=
  by
  rcases eq_or_ne y x with (rfl | hne)
  · exact hasDerivAt_of_hasDerivAt_of_ne f_diff hf hg
  · exact f_diff y hne
#align has_deriv_at_of_has_deriv_at_of_ne' hasDerivAt_of_hasDerivAt_of_ne'


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.int.basic
import data.nat.succ_pred

/-!
# Successors and predecessors of integers

In this file, we show that `ℤ` is both an archimedean `succ_order` and an archimedean `pred_order`.
-/

open function order

namespace int

@[reducible] -- so that Lean reads `int.succ` through `succ_order.succ`
instance : succ_order ℤ :=
{ succ := succ,
  ..succ_order.of_succ_le_iff succ (λ a b, iff.rfl) }

@[reducible] -- so that Lean reads `int.pred` through `pred_order.pred`
instance : pred_order ℤ :=
{ pred := pred,
  pred_le := λ a, (sub_one_lt_of_le le_rfl).le,
  min_of_le_pred := λ a ha, ((sub_one_lt_of_le le_rfl).not_le ha).elim,
  le_pred_of_lt := λ a b, le_sub_one_of_lt,
  le_of_pred_lt := λ a b, le_of_sub_one_lt }

@[simp] lemma succ_eq_succ : order.succ = succ := rfl
@[simp] lemma pred_eq_pred : order.pred = pred := rfl

lemma succ_iterate (a : ℤ) : ∀ n, succ^[n] a = a + n
| 0       := (add_zero a).symm
| (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←add_assoc],
    exact congr_arg _ (succ_iterate n) }

lemma pred_iterate (a : ℤ) : ∀ n, pred^[n] a = a - n
| 0       := (sub_zero a).symm
| (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←sub_sub],
    exact congr_arg _ (pred_iterate n) }

instance : is_succ_archimedean ℤ :=
⟨λ a b h, ⟨(b - a).to_nat,
  by rw [succ_eq_succ, succ_iterate, to_nat_sub_of_le h, ←add_sub_assoc, add_sub_cancel']⟩⟩

instance : is_pred_archimedean ℤ :=
⟨λ a b h, ⟨(b - a).to_nat, by rw [pred_eq_pred, pred_iterate, to_nat_sub_of_le h, sub_sub_cancel]⟩⟩

/-! ### Covering relation -/

protected lemma covby_iff_succ_eq {m n : ℤ} : m ⋖ n ↔ m + 1 = n := succ_eq_iff_covby.symm

end int

@[simp, norm_cast] lemma nat.cast_int_covby_iff {a b : ℕ} : (a : ℤ) ⋖ b ↔ a ⋖ b :=
by { rw [nat.covby_iff_succ_eq, int.covby_iff_succ_eq], exact int.coe_nat_inj' }

alias nat.cast_int_covby_iff ↔ _ covby.cast_int


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

/-! # Pointwise instances on `subsemiring`s

This file provides the action `subsemiring.pointwise_mul_action` which matches the action of
`mul_action_set`.

This actions is available in the `pointwise` locale.

## Implementation notes

This file is almost identical to `group_theory/submonoid/pointwise.lean`. Where possible, try to
keep them in sync.
-/

open set

variables {M R : Type*}

namespace subsemiring

section monoid
variables [monoid M] [semiring R] [mul_semiring_action M R]

/-- The action on a subsemiring corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action M (subsemiring R) :=
{ smul := λ a S, S.map (mul_semiring_action.to_ring_hom _ _ a),
  one_smul := λ S,
    (congr_arg (λ f, S.map f) (ring_hom.ext $ by exact one_smul M)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (ring_hom.ext $ by exact mul_smul _ _)).trans (S.map_map _ _).symm }

localized "attribute [instance] subsemiring.pointwise_mul_action" in pointwise
open_locale pointwise

lemma pointwise_smul_def {a : M} (S : subsemiring R) :
  a • S = S.map (mul_semiring_action.to_ring_hom _ _ a) := rfl

@[simp] lemma coe_pointwise_smul (m : M) (S : subsemiring R) : ↑(m • S) = m • (S : set R) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (m : M) (S : subsemiring R) :
  (m • S).to_add_submonoid = m • S.to_add_submonoid := rfl

lemma mem_smul_pointwise_iff_exists (m : M) (r : R) (S : subsemiring R) :
  r ∈ m • S ↔ ∃ (s : R), s ∈ S ∧ m • s = r :=
(set.mem_smul_set : r ∈ m • (S : set R) ↔ _)

instance pointwise_central_scalar [mul_semiring_action Mᵐᵒᵖ R] [is_central_scalar M R] :
  is_central_scalar M (subsemiring R) :=
⟨λ a S, congr_arg (λ f, S.map f) $ ring_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group M] [semiring R] [mul_semiring_action M R]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : M} {S : subsemiring R} {x : R} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : M} {S : subsemiring R} {x : R} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : M} {S : subsemiring R} {x : R} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : M} {S T : subsemiring R} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : M} {S T : subsemiring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : M} {S T : subsemiring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

/-! TODO: add `equiv_smul` like we have for subgroup. -/

end group

section group_with_zero
variables [group_with_zero M] [semiring R] [mul_semiring_action M R]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : subsemiring R)
  (x : R) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set R) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : M} (ha : a ≠ 0) (S : subsemiring R) (x : R) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set R) x

lemma mem_inv_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : subsemiring R) (x : R) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set R) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : subsemiring R} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : M} (ha : a ≠ 0) {S T : subsemiring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : subsemiring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end subsemiring


import category_theory.comma
import algebra.category.CommRing
import .global
import .ideals
import .Omega
import data.opposite
import ring_theory.ideals
import  .src.sieve
import  .src.grothendieck
open category_theory
open opposite
universes u
local notation `Ring` := CommRing.{u}
local notation `Aff`  := Ringᵒᵖ
local notation `Set` :=  Type u

--- The goals is to define Zariski topology on Aff := Ringᵒᵖ
--- We use the definition on Topos theory !
--- Starting we ideal lemma

namespace ideals
lemma set_image_S_subset_set_image_span_S (A B : Ring )(f : A ⟶ B) (S : set A) :
set.image f S ⊆  set.image f (ideal.span S) :=
begin
    apply set.image_subset,
    exact ideal.subset_span ,
end

lemma ideal.map_span_eq_span_image(A B : Ring )(f : A ⟶ B) (S : set A):
    ideal.span (set.image f S) = ideal.map f (ideal.span S) :=
begin
    apply le_antisymm,
    exact ideal.span_mono (set_image_S_subset_set_image_span_S A B f S),
    exact ideal.map_le_iff_le_comap.2 (ideal.span_le.2 (set.image_subset_iff.1 (ideal.subset_span))),
end

-- idée
-- Profiter de ⊤

lemma top_ideal_map (A B : Ring)(f : A ⟶ B)(S : set A) :
ideal.span S = ⊤ → ideal.span (set.image f S) = ⊤ := λ certif,
begin
    rw ideal.map_span_eq_span_image,
    rw certif,
    exact ideal.map_top f,
end

lemma one_ideal_map {A  B : Ring}(f : A ⟶ B)(S : set A) :
(1 : A) ∈ ideal.span S → (1 : B) ∈ ideal.span( set.image f S) := λ P, begin
have hyp : f 1  ∈ ideal.span (set.image f S),
        rw ideal.map_span_eq_span_image,
        apply ideal.mem_map_of_mem,
        exact P,
    rw  f.map_one at hyp,
    assumption,
end
end ideals
open ideals

namespace Pre_sieves
structure Presieves (X : Aff) :=
(S : set (X.unop))
(co_maximality : (1 : X.unop) ∈ ideal.span S)

@[ext] lemma ext (X : Aff) (P Q : Presieves X) : P.S = Q.S → P = Q  :=
    begin
        intros h1,
        cases P,
        cases Q,
        congr ; try { assumption },
    end
def pull_back{X Y : Aff}(f : Y ⟶ X) : Presieves(X) → Presieves(Y)  := λ P, begin
 exact {S := set.image f.unop P.S, co_maximality := one_ideal_map f.unop P.S P.co_maximality},
 end
lemma pull_back_ext {X Y : Aff}(f : Y ⟶ X)(P : Presieves X): (pull_back f P).S = set.image f.unop P.S := rfl
/-
Test for a Presieves to be eq to pull-back.
-/
theorem pull_back_eq {X Y : Aff}(f : Y ⟶ X)(P : Presieves X)(Q_Y : Presieves Y) :
        pull_back f P = Q_Y ↔ set.image f.unop P.S = Q_Y.S :=
    begin
        split,
        intros, subst a, rw pull_back_ext,
            intros, apply ext, rw pull_back_ext, assumption,
    end
/-
    Direct image of a presieves.
-/
lemma inverse_image_ideal (A B : Ring)(f : A ⟶ B)(S : set B) :
    ideal.span (set.preimage f S) ≤  ideal.comap f (ideal.span S) :=
    begin
        rw ideal.span_le,   -- span S \leq I ↔  S ≤ I
        apply set.preimage_mono ideal.subset_span,
    end

def direct_image (X Y : Aff) (P : Presieves Y) (h : Y ⟶ X) : Presieves(X) :=
begin
    -- inverse image
    -- h : R(X) ⟶ R(Y)  and P : set R(Y) with 1 ∈ ideal.span P.S
    -- i take :  P' := { comap h S }
    have hyp : (1 : X.unop) ∈ ideal.span (set.preimage h.unop (ideal.span(P.S))),
        apply ideal.subset_span,
        rw  set.mem_preimage,
    have F : (has_hom.hom.unop h) 1 = (1 : Y.unop),
        exact h.unop.map_one,
    have j : (1 : Y.unop) ∈ ideal.span P.S,
        exact P.co_maximality,
    rw ← F at j,
    assumption,
    have hyp2 : (ideal.span (set.preimage h.unop (ideal.span(P.S))) : set X.unop) = set.preimage h.unop (ideal.span(P.S)),

    -- exact {S := set.preimage h.unop P.S, co_maximality := hyp},
end
end  Pre_sieves

open Pre_sieves
def sieves_of (X : Aff) (P : Presieves X) :=
{ f : over X |∃ s : P.S, ∃ u : unop f.left,  ((f.hom s.val * u ) : unop f.left ) = 1 }

-- Ici le plus simple va être de faire appel à units !
--
lemma mem_sieves (X : Aff) (P : Presieves X)(f : over X) : (
∃ s : P.S, ∃ u : unop f.left, ((f.hom s.val * u ) : unop f.left ) = 1) →   f ∈ (sieves_of X P) := λ hyp, hyp

lemma sieves_mem {X : Aff} {P : Presieves X}{f : over X} : f ∈ (sieves_of X P) →
(∃ s : P.S,∃ u : unop f.left, ((f.hom s.val * u ) : unop f.left ) = 1) := λ hyp,hyp

def subs (X : Aff) (P : Presieves X) :
∀ (f : over X) (hyp : f ∈ (sieves_of X P)) (Z : Aff) (g : Z ⟶ f.left),
 (over.mk (g ≫ f.hom)) ∈ (sieves_of X P) :=
begin
    intros, apply mem_sieves, rw over.mk_hom, rcases hyp with ⟨s,u, hyp_su⟩, use s, use g u,
    show  g.unop( f.hom(s.val)) * g.unop (u) = (1 : unop Z),
        rw ← g.unop.map_mul (f.hom s.val) u,rw hyp_su,
        exact g.unop.map_one,
end

def Aff_sieves (X : Aff )(P : Presieves X) : sieve(X) := {arrows := sieves_of X P,subs := subs X P}
def Aff_sieves_arrow (X : Aff )(P : Presieves X) : (Aff_sieves X P).arrows = sieves_of X P := rfl

/-
Fondamental theorem  : le faire mieux avec Aff_sieves !
-/
theorem pull_back_stability{X Y: Aff}(h : Y ⟶ X) (S : Presieves X)(f : over Y) :
 (over.mk (f.hom ≫ h)) ∈ Aff_sieves X S  →  f ∈ (Aff_sieves Y (pull_back h S))  :=
λ fh_hyp, begin
    rcases  sieves_mem  fh_hyp with s,
    apply mem_sieves,
    use h.unop s,
        rw pull_back_ext,
        exact set.mem_image_of_mem h.unop s.property,
    exact h_1,
end
theorem pull_back_stability'{X Y: Aff}(h : Y ⟶ X) (S : Presieves X)(f : over Y) :
  f ∈ (Aff_sieves Y (pull_back h S)) → (over.mk (f.hom ≫ h)) ∈ Aff_sieves X S :=
λ fh_hyp, begin
    rcases  sieves_mem  fh_hyp with hs,
    apply mem_sieves,
    cases  set.mem_image_iff_bex.1 hs.property with s hyp_s,
    use s,
    rcases hyp_s with hyp_hs,
    exact hyp_hs,
    rcases hyp_s with hyp_hs,
    rw ← hyp_s_h at h_1,
    exact h_1,
end
/-
Zariski
-/

def Zariski_topology( X : Aff)  :=  {S : sieve X | ∃ P : Presieves X, S = Aff_sieves X P}

lemma mem_Zariski ( X : Aff) (S : sieve X) :
S ∈ Zariski_topology( X) →  ∃  P : Presieves X, S = Aff_sieves X P := λ SS,
begin
cases SS with a t,
use a,
exact t,
end
lemma mem_Zariski_ ( X : Aff) (S : sieve X) : (∃  P : Presieves X, S = Aff_sieves X P) →
S ∈ Zariski_topology( X)  := λ hyp, hyp

def Zariski_of (X : Aff) : Presieves X → Zariski_topology(X) := λ S,begin
use Aff_sieves X S,
unfold Zariski_topology,
split,
show Aff_sieves X S = Aff_sieves X S,
    exact rfl,
end
-- But : prouver que Zariski Topology is grothendieck topology !
-- Il nous faut parler du sieves max
def max'(X : Aff) : sieve X := Zariski_of (X) ({S := {(1 : unop X)}, co_maximality :=
begin
    apply ideal.subset_span,
    exact set.mem_singleton 1,
end  })
lemma max_is_max(X : Aff) :  max'(X) = ⊤ := begin
    ext f,
    split,intros, trivial,
    intros hyp, apply mem_sieves, use 1,exact set.mem_singleton 1,use 1,rw mul_one,
    exact f.hom.unop.map_one,
end

lemma pull_back_comp (X Y : Aff) (P : Presieves X) (h : Y ⟶ X) :
    sieve.pullback (Aff_sieves X P) h = Aff_sieves Y (pull_back h P) :=
begin
    ext f,
    split,
        intros hyp,apply pull_back_stability, rw ← sieve.pullback_def2 h,exact hyp,
        intros, show f ∈ sieve.pullback (Aff_sieves X P) h,
                    rw sieve.pullback_def2 h, apply pull_back_stability',exact a,
end

#print grothendieck
def stab'  (X Y : Aff) (S ∈ Zariski_topology X) (h : Y ⟶ X) :
            sieve.pullback S h ∈ Zariski_topology(Y) :=
    begin
        apply mem_Zariski_ Y,
        cases H with P Hyp,
        use pull_back h P,
        subst Hyp ,
        exact pull_back_comp X Y P h ,
    end
-- il nous faut étudier un peu les choses !
-- Par exemple l'hypothèse :  (f : over X),  sieve.pullback R f.fom ∈ Zariski(f.left)
--    f :  Z    →  X, il existe  (S(Z) set Z) tel que sieve.pullback R f.hom = Ring sieve S(Z)
--     g Z' → Z, g f ∈ R ↔  ∃ s_Z  g s_Z inversible

def trans' (X : Aff)(S ∈ Zariski_topology X)(R : sieve X) : (∀(f : over X), f ∈ S →
sieve.pullback R f.hom ∈  Zariski_topology(f.left)) → (R ∈ Zariski_topology(X)) :=
begin
 sorry,
end


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

! This file was ported from Lean 3 source module topology.sets.order
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.UpperLower.Basic
import Mathlib.Topology.Sets.Closeds

/-!
# Clopen upper sets

In this file we define the type of clopen upper sets.
-/

open Set TopologicalSpace

variable {α β : Type _} [TopologicalSpace α] [LE α] [TopologicalSpace β] [LE β]

/-! ### Compact open sets -/

/-- The type of clopen upper sets of a topological space. -/
structure ClopenUpperSet (α : Type _) [TopologicalSpace α] [LE α] extends Clopens α where
  upper' : IsUpperSet carrier
#align clopen_upper_set ClopenUpperSet

namespace ClopenUpperSet

instance : SetLike (ClopenUpperSet α) α where
  coe s := s.carrier
  coe_injective' s t h := by
    obtain ⟨⟨_, _⟩, _⟩ := s
    obtain ⟨⟨_, _⟩, _⟩ := t
    congr

/-- See Note [custom simps projection]. -/
def Simps.coe (s : ClopenUpperSet α) : Set α := s

initialize_simps_projections ClopenUpperSet (carrier → coe)

theorem upper (s : ClopenUpperSet α) : IsUpperSet (s : Set α) :=
  s.upper'
#align clopen_upper_set.upper ClopenUpperSet.upper

theorem clopen (s : ClopenUpperSet α) : IsClopen (s : Set α) :=
  s.clopen'
#align clopen_upper_set.clopen ClopenUpperSet.clopen

/-- Reinterpret a upper clopen as an upper set. -/
@[simps]
def toUpperSet (s : ClopenUpperSet α) : UpperSet α :=
  ⟨s, s.upper⟩
#align clopen_upper_set.to_upper_set ClopenUpperSet.toUpperSet

@[ext]
protected theorem ext {s t : ClopenUpperSet α} (h : (s : Set α) = t) : s = t :=
  SetLike.ext' h
#align clopen_upper_set.ext ClopenUpperSet.ext

@[simp]

instance : Sup (ClopenUpperSet α) :=
  ⟨fun s t => ⟨s.toClopens ⊔ t.toClopens, s.upper.union t.upper⟩⟩

instance : Inf (ClopenUpperSet α) :=
  ⟨fun s t => ⟨s.toClopens ⊓ t.toClopens, s.upper.inter t.upper⟩⟩

instance : Top (ClopenUpperSet α) :=
  ⟨⟨⊤, isUpperSet_univ⟩⟩

instance : Bot (ClopenUpperSet α) :=
  ⟨⟨⊥, isUpperSet_empty⟩⟩

instance : Lattice (ClopenUpperSet α) :=
  SetLike.coe_injective.lattice _ (fun _ _ => rfl) fun _ _ => rfl

instance : BoundedOrder (ClopenUpperSet α) :=
  BoundedOrder.lift ((↑) : _ → Set α) (fun _ _ => id) rfl rfl

@[simp]
theorem coe_sup (s t : ClopenUpperSet α) : (↑(s ⊔ t) : Set α) = ↑s ∪ ↑t :=
  rfl
#align clopen_upper_set.coe_sup ClopenUpperSet.coe_sup

@[simp]
theorem coe_inf (s t : ClopenUpperSet α) : (↑(s ⊓ t) : Set α) = ↑s ∩ ↑t :=
  rfl
#align clopen_upper_set.coe_inf ClopenUpperSet.coe_inf

@[simp]
theorem coe_top : (↑(⊤ : ClopenUpperSet α) : Set α) = univ :=
  rfl
#align clopen_upper_set.coe_top ClopenUpperSet.coe_top

@[simp]
theorem coe_bot : (↑(⊥ : ClopenUpperSet α) : Set α) = ∅ :=
  rfl
#align clopen_upper_set.coe_bot ClopenUpperSet.coe_bot

instance : Inhabited (ClopenUpperSet α) :=
  ⟨⊥⟩

end ClopenUpperSet


/-
Copyright (c) 2021 Jakob Scholbach. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob Scholbach, Joël Riou

! This file was ported from Lean 3 source module category_theory.lifting_properties.basic
! leanprover-community/mathlib commit 3dadefa3f544b1db6214777fe47910739b54c66a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.CommSq

/-!
# Lifting properties

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

This file defines the lifting property of two morphisms in a category and
shows basic properties of this notion.

## Main results
- `has_lifting_property`: the definition of the lifting property

## Tags
lifting property

@TODO :
1) define llp/rlp with respect to a `morphism_property`
2) retracts, direct/inverse images, (co)products, adjunctions

-/

universe v

namespace CategoryTheory

open Category

variable {C : Type _} [Category C] {A B B' X Y Y' : C} (i : A ⟶ B) (i' : B ⟶ B') (p : X ⟶ Y)
  (p' : Y ⟶ Y')

#print CategoryTheory.HasLiftingProperty /-
/-- `has_lifting_property i p` means that `i` has the left lifting
property with respect to `p`, or equivalently that `p` has
the right lifting property with respect to `i`. -/
class HasLiftingProperty : Prop where
  sq_hasLift : ∀ {f : A ⟶ X} {g : B ⟶ Y} (sq : CommSq f i p g), sq.HasLift
#align category_theory.has_lifting_property CategoryTheory.HasLiftingProperty
-/

#print CategoryTheory.sq_hasLift_of_hasLiftingProperty /-
instance (priority := 100) sq_hasLift_of_hasLiftingProperty {f : A ⟶ X} {g : B ⟶ Y}
    (sq : CommSq f i p g) [hip : HasLiftingProperty i p] : sq.HasLift := by apply hip.sq_has_lift
#align category_theory.sq_has_lift_of_has_lifting_property CategoryTheory.sq_hasLift_of_hasLiftingProperty
-/

namespace HasLiftingProperty

variable {i p}

/- warning: category_theory.has_lifting_property.op -> CategoryTheory.HasLiftingProperty.op is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] {A : C} {B : C} {X : C} {Y : C} {i : Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) A B} {p : Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) X Y}, (CategoryTheory.HasLiftingProperty.{u1, u2} C _inst_1 A B X Y i p) -> (CategoryTheory.HasLiftingProperty.{u1, u2} (Opposite.{succ u1} C) (CategoryTheory.Category.opposite.{u2, u1} C _inst_1) (Opposite.op.{succ u1} C Y) (Opposite.op.{succ u1} C X) (Opposite.op.{succ u1} C B) (Opposite.op.{succ u1} C A) (Quiver.Hom.op.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) X Y p) (Quiver.Hom.op.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) A B i))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {A : C} {B : C} {X : C} {Y : C} {i : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) A B} {p : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y}, (CategoryTheory.HasLiftingProperty.{u2, u1} C _inst_1 A B X Y i p) -> (CategoryTheory.HasLiftingProperty.{u2, u1} (Opposite.{succ u2} C) (CategoryTheory.Category.opposite.{u1, u2} C _inst_1) (Opposite.op.{succ u2} C Y) (Opposite.op.{succ u2} C X) (Opposite.op.{succ u2} C B) (Opposite.op.{succ u2} C A) (Quiver.Hom.op.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y p) (Quiver.Hom.op.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) A B i))
Case conversion may be inaccurate. Consider using '#align category_theory.has_lifting_property.op CategoryTheory.HasLiftingProperty.opₓ'. -/
theorem op (h : HasLiftingProperty i p) : HasLiftingProperty p.op i.op :=
  ⟨fun f g sq => by
    simp only [comm_sq.has_lift.iff_unop, Quiver.Hom.unop_op]
    infer_instance⟩
#align category_theory.has_lifting_property.op CategoryTheory.HasLiftingProperty.op

/- warning: category_theory.has_lifting_property.unop -> CategoryTheory.HasLiftingProperty.unop is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] {A : Opposite.{succ u1} C} {B : Opposite.{succ u1} C} {X : Opposite.{succ u1} C} {Y : Opposite.{succ u1} C} {i : Quiver.Hom.{succ u2, u1} (Opposite.{succ u1} C) (Quiver.opposite.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1))) A B} {p : Quiver.Hom.{succ u2, u1} (Opposite.{succ u1} C) (Quiver.opposite.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1))) X Y}, (CategoryTheory.HasLiftingProperty.{u1, u2} (Opposite.{succ u1} C) (CategoryTheory.Category.opposite.{u2, u1} C _inst_1) A B X Y i p) -> (CategoryTheory.HasLiftingProperty.{u1, u2} C _inst_1 (Opposite.unop.{succ u1} C Y) (Opposite.unop.{succ u1} C X) (Opposite.unop.{succ u1} C B) (Opposite.unop.{succ u1} C A) (Quiver.Hom.unop.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) X Y p) (Quiver.Hom.unop.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) A B i))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {A : Opposite.{succ u2} C} {B : Opposite.{succ u2} C} {X : Opposite.{succ u2} C} {Y : Opposite.{succ u2} C} {i : Quiver.Hom.{succ u1, u2} (Opposite.{succ u2} C) (Quiver.opposite.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1))) A B} {p : Quiver.Hom.{succ u1, u2} (Opposite.{succ u2} C) (Quiver.opposite.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1))) X Y}, (CategoryTheory.HasLiftingProperty.{u2, u1} (Opposite.{succ u2} C) (CategoryTheory.Category.opposite.{u1, u2} C _inst_1) A B X Y i p) -> (CategoryTheory.HasLiftingProperty.{u2, u1} C _inst_1 (Opposite.unop.{succ u2} C Y) (Opposite.unop.{succ u2} C X) (Opposite.unop.{succ u2} C B) (Opposite.unop.{succ u2} C A) (Quiver.Hom.unop.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y p) (Quiver.Hom.unop.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) A B i))
Case conversion may be inaccurate. Consider using '#align category_theory.has_lifting_property.unop CategoryTheory.HasLiftingProperty.unopₓ'. -/
theorem unop {A B X Y : Cᵒᵖ} {i : A ⟶ B} {p : X ⟶ Y} (h : HasLiftingProperty i p) :
    HasLiftingProperty p.unop i.unop :=
  ⟨fun f g sq => by
    rw [comm_sq.has_lift.iff_op]
    simp only [Quiver.Hom.op_unop]
    infer_instance⟩
#align category_theory.has_lifting_property.unop CategoryTheory.HasLiftingProperty.unop

/- warning: category_theory.has_lifting_property.iff_op -> CategoryTheory.HasLiftingProperty.iff_op is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] {A : C} {B : C} {X : C} {Y : C} {i : Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) A B} {p : Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) X Y}, Iff (CategoryTheory.HasLiftingProperty.{u1, u2} C _inst_1 A B X Y i p) (CategoryTheory.HasLiftingProperty.{u1, u2} (Opposite.{succ u1} C) (CategoryTheory.Category.opposite.{u2, u1} C _inst_1) (Opposite.op.{succ u1} C Y) (Opposite.op.{succ u1} C X) (Opposite.op.{succ u1} C B) (Opposite.op.{succ u1} C A) (Quiver.Hom.op.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) X Y p) (Quiver.Hom.op.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) A B i))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {A : C} {B : C} {X : C} {Y : C} {i : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) A B} {p : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y}, Iff (CategoryTheory.HasLiftingProperty.{u2, u1} C _inst_1 A B X Y i p) (CategoryTheory.HasLiftingProperty.{u2, u1} (Opposite.{succ u2} C) (CategoryTheory.Category.opposite.{u1, u2} C _inst_1) (Opposite.op.{succ u2} C Y) (Opposite.op.{succ u2} C X) (Opposite.op.{succ u2} C B) (Opposite.op.{succ u2} C A) (Quiver.Hom.op.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y p) (Quiver.Hom.op.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) A B i))
Case conversion may be inaccurate. Consider using '#align category_theory.has_lifting_property.iff_op CategoryTheory.HasLiftingProperty.iff_opₓ'. -/
theorem iff_op : HasLiftingProperty i p ↔ HasLiftingProperty p.op i.op :=
  ⟨op, unop⟩
#align category_theory.has_lifting_property.iff_op CategoryTheory.HasLiftingProperty.iff_op

/- warning: category_theory.has_lifting_property.iff_unop -> CategoryTheory.HasLiftingProperty.iff_unop is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] {A : Opposite.{succ u1} C} {B : Opposite.{succ u1} C} {X : Opposite.{succ u1} C} {Y : Opposite.{succ u1} C} (i : Quiver.Hom.{succ u2, u1} (Opposite.{succ u1} C) (Quiver.opposite.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1))) A B) (p : Quiver.Hom.{succ u2, u1} (Opposite.{succ u1} C) (Quiver.opposite.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1))) X Y), Iff (CategoryTheory.HasLiftingProperty.{u1, u2} (Opposite.{succ u1} C) (CategoryTheory.Category.opposite.{u2, u1} C _inst_1) A B X Y i p) (CategoryTheory.HasLiftingProperty.{u1, u2} C _inst_1 (Opposite.unop.{succ u1} C Y) (Opposite.unop.{succ u1} C X) (Opposite.unop.{succ u1} C B) (Opposite.unop.{succ u1} C A) (Quiver.Hom.unop.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) X Y p) (Quiver.Hom.unop.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) A B i))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {A : Opposite.{succ u2} C} {B : Opposite.{succ u2} C} {X : Opposite.{succ u2} C} {Y : Opposite.{succ u2} C} (i : Quiver.Hom.{succ u1, u2} (Opposite.{succ u2} C) (Quiver.opposite.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1))) A B) (p : Quiver.Hom.{succ u1, u2} (Opposite.{succ u2} C) (Quiver.opposite.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1))) X Y), Iff (CategoryTheory.HasLiftingProperty.{u2, u1} (Opposite.{succ u2} C) (CategoryTheory.Category.opposite.{u1, u2} C _inst_1) A B X Y i p) (CategoryTheory.HasLiftingProperty.{u2, u1} C _inst_1 (Opposite.unop.{succ u2} C Y) (Opposite.unop.{succ u2} C X) (Opposite.unop.{succ u2} C B) (Opposite.unop.{succ u2} C A) (Quiver.Hom.unop.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y p) (Quiver.Hom.unop.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) A B i))
Case conversion may be inaccurate. Consider using '#align category_theory.has_lifting_property.iff_unop CategoryTheory.HasLiftingProperty.iff_unopₓ'. -/
theorem iff_unop {A B X Y : Cᵒᵖ} (i : A ⟶ B) (p : X ⟶ Y) :
    HasLiftingProperty i p ↔ HasLiftingProperty p.unop i.unop :=
  ⟨unop, op⟩
#align category_theory.has_lifting_property.iff_unop CategoryTheory.HasLiftingProperty.iff_unop

variable (i p)

#print CategoryTheory.HasLiftingProperty.of_left_iso /-
instance (priority := 100) of_left_iso [IsIso i] : HasLiftingProperty i p :=
  ⟨fun f g sq =>
    CommSq.HasLift.mk'
      { l := inv i ≫ f
        fac_left' := by simp only [is_iso.hom_inv_id_assoc]
        fac_right' := by simp only [sq.w, assoc, is_iso.inv_hom_id_assoc] }⟩
#align category_theory.has_lifting_property.of_left_iso CategoryTheory.HasLiftingProperty.of_left_iso
-/

#print CategoryTheory.HasLiftingProperty.of_right_iso /-
instance (priority := 100) of_right_iso [IsIso p] : HasLiftingProperty i p :=
  ⟨fun f g sq =>
    CommSq.HasLift.mk'
      { l := g ≫ inv p
        fac_left' := by simp only [← sq.w_assoc, is_iso.hom_inv_id, comp_id]
        fac_right' := by simp only [assoc, is_iso.inv_hom_id, comp_id] }⟩
#align category_theory.has_lifting_property.of_right_iso CategoryTheory.HasLiftingProperty.of_right_iso
-/

#print CategoryTheory.HasLiftingProperty.of_comp_left /-
instance of_comp_left [HasLiftingProperty i p] [HasLiftingProperty i' p] :
    HasLiftingProperty (i ≫ i') p :=
  ⟨fun f g sq => by
    have fac := sq.w
    rw [assoc] at fac
    exact
      comm_sq.has_lift.mk'
        { l := (comm_sq.mk (comm_sq.mk fac).fac_right).lift
          fac_left' := by simp only [assoc, comm_sq.fac_left]
          fac_right' := by simp only [comm_sq.fac_right] }⟩
#align category_theory.has_lifting_property.of_comp_left CategoryTheory.HasLiftingProperty.of_comp_left
-/

#print CategoryTheory.HasLiftingProperty.of_comp_right /-
instance of_comp_right [HasLiftingProperty i p] [HasLiftingProperty i p'] :
    HasLiftingProperty i (p ≫ p') :=
  ⟨fun f g sq => by
    have fac := sq.w
    rw [← assoc] at fac
    let sq₂ := (comm_sq.mk (comm_sq.mk fac).fac_left.symm).lift
    exact
      comm_sq.has_lift.mk'
        { l := (comm_sq.mk (comm_sq.mk fac).fac_left.symm).lift
          fac_left' := by simp only [comm_sq.fac_left]
          fac_right' := by simp only [comm_sq.fac_right_assoc, comm_sq.fac_right] }⟩
#align category_theory.has_lifting_property.of_comp_right CategoryTheory.HasLiftingProperty.of_comp_right
-/

#print CategoryTheory.HasLiftingProperty.of_arrow_iso_left /-
theorem of_arrow_iso_left {A B A' B' X Y : C} {i : A ⟶ B} {i' : A' ⟶ B'}
    (e : Arrow.mk i ≅ Arrow.mk i') (p : X ⟶ Y) [hip : HasLiftingProperty i p] :
    HasLiftingProperty i' p := by
  rw [arrow.iso_w' e]
  infer_instance
#align category_theory.has_lifting_property.of_arrow_iso_left CategoryTheory.HasLiftingProperty.of_arrow_iso_left
-/

#print CategoryTheory.HasLiftingProperty.of_arrow_iso_right /-
theorem of_arrow_iso_right {A B X Y X' Y' : C} (i : A ⟶ B) {p : X ⟶ Y} {p' : X' ⟶ Y'}
    (e : Arrow.mk p ≅ Arrow.mk p') [hip : HasLiftingProperty i p] : HasLiftingProperty i p' :=
  by
  rw [arrow.iso_w' e]
  infer_instance
#align category_theory.has_lifting_property.of_arrow_iso_right CategoryTheory.HasLiftingProperty.of_arrow_iso_right
-/

#print CategoryTheory.HasLiftingProperty.iff_of_arrow_iso_left /-
theorem iff_of_arrow_iso_left {A B A' B' X Y : C} {i : A ⟶ B} {i' : A' ⟶ B'}
    (e : Arrow.mk i ≅ Arrow.mk i') (p : X ⟶ Y) : HasLiftingProperty i p ↔ HasLiftingProperty i' p :=
  by
  constructor <;> intro
  exacts[of_arrow_iso_left e p, of_arrow_iso_left e.symm p]
#align category_theory.has_lifting_property.iff_of_arrow_iso_left CategoryTheory.HasLiftingProperty.iff_of_arrow_iso_left
-/

#print CategoryTheory.HasLiftingProperty.iff_of_arrow_iso_right /-
theorem iff_of_arrow_iso_right {A B X Y X' Y' : C} (i : A ⟶ B) {p : X ⟶ Y} {p' : X' ⟶ Y'}
    (e : Arrow.mk p ≅ Arrow.mk p') : HasLiftingProperty i p ↔ HasLiftingProperty i p' :=
  by
  constructor <;> intro
  exacts[of_arrow_iso_right i e, of_arrow_iso_right i e.symm]
#align category_theory.has_lifting_property.iff_of_arrow_iso_right CategoryTheory.HasLiftingProperty.iff_of_arrow_iso_right
-/

end HasLiftingProperty

end CategoryTheory