import tactic
import data.real.sqrt
import data.polynomial

/- had help from people on leanprover zulip. thank you! (gareth ma and kevin buzzard) -/

/- fibonacci sequence definition -/
/- here, we want N -> Z instead of N -> N because of potential issues that may come up when we try to go for (-1)^n. just makes my life easier ngl... -/
def fib : ℕ -> ℤ
| 0 := 0
| 1 := 1
| (x+2) := fib (x) + fib (x+1)

/- end of preamble thing, now we try to prove F_n * F_{n+2} - F_{n+1}^2 = (-1)^n -/

lemma fib_rule (n : ℕ) : fib(n + 2) = fib(n) + fib(n + 1) := rfl
lemma fib_rule' (n : ℕ) (hn : n > 0) : fib(n + 1) = fib(n) + fib(n - 1) :=
begin
  cases hn,
  { simp [fib], },
  { simp [fib], rw add_comm, }
end
lemma negative_fib_rule (n : ℕ) : fib(n + 2) - fib(n + 1) = fib (n) :=
begin
  rw [fib_rule],
  ring,
end

theorem strong_induction {P : ℕ → Prop} {H : ∀ n : ℕ, (∀ m : ℕ, m < n → P m) → P n} (n : ℕ) : P n :=
begin
  have H1 : ∀ k ≤ n, P k, {
    induction n,
    {
      intros k hk,
      apply H,
      intros m hm,
      cases hk, cases hm,
    },
    {
      intros k hk,
      apply H,
      intros m hm,
      apply n_ih,
      apply nat.le_of_lt_succ,
      apply lt_of_lt_of_le,
      exact hm,
      exact hk,
    },
  },
  apply H1,
  linarith,
end

-- Fibonacci Addition Law : F_(m+n) = F_(n+1) F_m + F_n F_(m-1)
theorem fib_add (m n : ℕ) (hm : m > 0) : fib(m + n) = fib(n + 1) * fib(m) + fib(n) * fib(m - 1) :=
begin
  apply strong_induction n,
  intros k h,
  cases k,
  { simp [fib], },
  { cases k,
    { simp [fib, fib_rule' m hm], },
    { simp only [nat.succ_eq_add_one, add_assoc],
      norm_num,
      rw [←add_assoc, fib, nat.succ_eq_add_one, add_assoc m k 1],
      rw [h k _, h (k + 1) _],
      rw [fib_rule (k + 1), fib_rule k],
      ring,
      exact nat.lt_succ_self _,
      exact lt_trans (nat.lt_succ_self _) (nat.lt_succ_self _),
    },
  },
end

-- Fibonacci Divisibility : F_m | F_n if m | n.
theorem fib_divide (m n : ℕ) (hm : m > 0) (hyp_div : m ∣ n) : fib(m) ∣ fib(n) :=
begin
  rcases hyp_div with ⟨k, rfl⟩,
  induction k,
  { simp only [fib, mul_zero, dvd_zero], },
  { rw [nat.succ_eq_add_one, mul_add, add_comm, mul_one, fib_add m (m * k_n) hm],
    simp only [dvd_add, dvd_mul_left, dvd_mul_of_dvd_left k_ih], },
end

-- F_n * F_(n+2) - F_(n+1)^2 = (-1)^n
theorem fib_close_square (n : ℕ) : fib(n) * fib(n + 2) - fib(n + 1)^2 = (-1)^(n+1) :=
begin
  induction n,
  {
    rw [zero_add, zero_add],
    simp [fib],
  },

  have H1 : fib n_n.succ * fib n_n.succ + fib n_n.succ * fib (n_n.succ + 1) - fib (n_n.succ + 1) ^ 2 = fib n_n.succ * fib n_n.succ - fib (n_n.succ + 1) * (fib (n_n.succ + 1) - fib n_n.succ),
    { ring },

  have H2 : fib n_n.succ * fib n_n.succ - fib (n_n.succ + 1) * (fib (n_n.succ + 1) - fib n_n.succ) = fib n_n.succ * fib n_n.succ - fib (n_n.succ + 1) * fib (n_n.succ - 1),
    { rw negative_fib_rule, ring },

  have H3 : fib (n_n + 1) ^ 2 - fib n_n * fib (n_n + 2) = (-1) * (fib n_n * fib (n_n + 2) - fib (n_n + 1) ^ 2),
    { linarith, },

  have H4 : (-1 : ℤ) ^ (n_n + 2) = (-1 : ℤ) * (-1) ^ (n_n + 1),
    { conv begin to_rhs, congr, rw ←pow_one (-1 : ℤ), skip end, rw ←pow_add, conv begin to_rhs, congr, skip, rw nat.add_left_comm end, },

  {
    rw [fib_rule, mul_add],
    rw [H1, H2],
    ring_nf,
    rw [←nat.add_one],
    simp,
    rw [add_assoc],
    simp,
    -- conv begin to_lhs, congr, skip, congr, skip, congr, congr, skip, change 2, end,
    rw [H3, H4],
    linarith,
  },
end

section binet
open polynomial
-- todo: prove binet
noncomputable def φ := (1 + real.sqrt(5)) / 2
noncomputable def τ := (1 - real.sqrt(5)) / 2
-- noncomputable def f : polynomial ℝ := X^2 - X - 1

#check is_root

--lemma binet_lemma_τ : (f.is_root τ) :=

lemma original_binet_lemma (x : ℝ) (hx : x^2 = x + 1) (n : ℕ) (hn : n > 0) : x^n = x*(fib n) + fib (n-1) :=
begin
  cases n,
  { exfalso, linarith, },
  { induction n with n,
    { simp [fib], },
    {
      have H1 : x * ↑(fib (n + 1)) + ↑(fib n.succ) = (x + 1) * fib(n+1),
      { linarith, },

      rw [fib_rule],
      simp,
      rw [mul_add, add_assoc, H1, ←hx],
      by_cases x = 0,
      { exfalso, rw h at hx, linarith, },
      {
        rw [nat.succ_eq_add_one, pow_add, pow_one, mul_comm],
        rw [pow_two, mul_assoc, ←mul_add],
        rw [mul_right_inj' h, add_comm, ←nat.succ_eq_add_one],
        apply n_ih,
        exact nat.succ_pos n,
      },
    },
  },
end

theorem attempt_binet_formula (n : ℕ) : (fib(n) : ℝ) = (1 / real.sqrt(5)) * (((1 + real.sqrt(5)) / 2)^n - ((1 - real.sqrt(5)) / 2)^n) :=
begin
  set φ := (1 + real.sqrt(5)) / 2,
  set τ := (1 - real.sqrt(5)) / 2,

  rw [binet_lemma, binet_lemma],
  simp[φ, τ],
  field_simp,
  norm_num,
  rw [mul_comm],

  have H1 : (2 * ((1 + real.sqrt 5) * ↑(fib n)) - 2 * ((1 - real.sqrt 5) * ↑(fib n))) = fib n * (real.sqrt 5 * 4),
  {
    sorry,
  },

  rw [H1, ←div_div_eq_mul_div],
  simp,

  { sorry },
  { simp[τ], field_simp, ring, rw sub_mul, norm_num, rw [mul_assoc, ←pow_two, @real.sq_sqrt 5 (by norm_num)], linarith, },
  { sorry },
  { simp[φ], field_simp, norm_num, rw [←pow_two], },

  sorry,
end

-- binet formula, but kevin buzzard stepped in lmao:
-- this is just for reference purposes so ig i can learn
lemma binet_lemma {R : Type*} [comm_ring R] (x : R) (hx : x*x = x + 1) (m : ℕ) :
  x^(m+1) = x * (fib (m+1)) + fib m :=
begin
  induction m with d hd,
  { simp [fib], },
  { rw [pow_succ, hd],
    simp [fib, nat.succ_eq_add_one, mul_add, ← mul_assoc, hx],
    ring, }
end

theorem binet_formula (n : ℕ) :
  (fib n : ℝ) = (1 / real.sqrt 5) * (((1 + real.sqrt 5) / 2) ^ n - ((1 - real.sqrt 5) / 2) ^ n) :=
begin
  have sqrt5_not_zero : real.sqrt 5 ≠ 0 := by norm_num,
  induction n with d hd,
  { simp [fib], },
  { rw [nat.succ_eq_add_one, binet_lemma, binet_lemma],
    { field_simp, norm_num, ring, },
    { field_simp [mul_sub, sub_mul], norm_num, ring, },
    { field_simp [mul_add, add_mul], norm_num, ring, },
  },
end

end binet
--useful tactics: norm_num, norm_cast, ring

#check real.sqrt(5)


import data.int.basic

namespace Zmodn

-- variable {n : ℕ}

/- a mod n: a + k*n  -/
structure Zmodn : Type :=
(Z : ℤ)
(k : ℤ)

def zero : Zmodn := ⟨0, 0⟩
def one  : Zmodn := ⟨1, 0⟩

/- a + k₁*n + b + k₂*n = (a + b) + (k₁ + k₂)*n -/
def add (a b : Zmodn) : Zmodn :=
{
  Z := a.Z + b.Z,
  k := a.k + b.k,
}
notation a ` +ₘ ` b := add a b

/- (a + k₁*n) * (b + k₂*n) = a*b + (a*k₂ + b*k₁ + k₁*k₂*n)*n -/
def mul (a b : Zmodn) : Zmodn :=
{
  Z := a.Z * b.Z,
  k := a.Z * b.k + b.Z * a.k + a.k * b.k * 5,
}
notation a ` *ₘ ` b := mul a b

def equals (a b : Zmodn) :=
a.Z = b.Z
notation a ` =ₘ ` b := equals a b

lemma reflexive_equals :
∀ a, a =ₘ a :=
by {intro, simp [equals]}

lemma symmetric_equals :
∀ a b, (a =ₘ b) → (b =ₘ a) :=
by {intros a b h, rw equals at *, rw h.symm}

lemma transitive_equals :
∀ a b c, (a =ₘ b) → (b =ₘ c) → (a =ₘ c) :=
by {intros a b c h1 h2, simp [equals, eq.trans h1 h2]}

lemma add_zero :
∀ a, a +ₘ zero =ₘ a :=
by simp [add, zero, equals, int.add_zero]

lemma mul_one :
∀ a, a *ₘ one =ₘ a :=
by simp [mul, one, equals, int.mul_one]

lemma add_comm :
∀ (a b : Zmodn),
(a +ₘ b) =ₘ (b +ₘ a) :=
by {intros, simp [add, equals, int.add_comm]}

lemma mul_comm :
∀ (a b : Zmodn),
(a *ₘ b) =ₘ (b *ₘ a) :=
by {intros, simp [mul, equals, int.mul_comm]}

lemma add_assoc :
∀ (a b c : Zmodn),
((a +ₘ b) +ₘ c) =ₘ (a +ₘ (b +ₘ c)) :=
by {intros, simp [add, equals, int.add_assoc]}

lemma mul_assoc :
∀ (a b c : Zmodn),
((a *ₘ b) *ₘ c) =ₘ (a *ₘ (b *ₘ c)) :=
by {intros, simp [mul, equals, int.mul_assoc]}

lemma distrib :
∀ (a b c : Zmodn),
(a *ₘ (b +ₘ c)) =ₘ ((a *ₘ b) +ₘ (a *ₘ c)) :=
by {intros, simp [add, mul, equals, int.distrib_left]}

lemma add_inv :
∀ a, ∃ b,
a +ₘ b =ₘ zero :=
by {intro, use ⟨-a.Z, a.k⟩, simp [add, zero, equals]}

end Zmodn


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

import algebra.module.basic
import linear_algebra.finsupp
import linear_algebra.basis

/-!

# Projective modules

This file contains a definition of a projective module, the proof that
our definition is equivalent to a lifting property, and the
proof that all free modules are projective.

## Main definitions

Let `R` be a ring (or a semiring) and let `M` be an `R`-module.

* `is_projective R M` : the proposition saying that `M` is a projective `R`-module.

## Main theorems

* `is_projective.lifting_property` : a map from a projective module can be lifted along
  a surjection.

* `is_projective.of_lifting_property` : If for all R-module surjections `A →ₗ B`, all
  maps `M →ₗ B` lift to `M →ₗ A`, then `M` is projective.

* `is_projective.of_free` : Free modules are projective

## Implementation notes

The actual definition of projective we use is that the natural R-module map
from the free R-module on the type M down to M splits. This is more convenient
than certain other definitions which involve quantifying over universes,
and also universe-polymorphic (the ring and module can be in different universes).

Everything works for semirings and modules except that apparently
we don't have free modules over semirings, so here we stick to rings.

## References

https://en.wikipedia.org/wiki/Projective_module

## TODO

- Direct sum of two projective modules is projective.
- Arbitrary sum of projective modules is projective.
- Any module admits a surjection from a projective module.

All of these should be relatively straightforward.

## Tags

projective module

-/

universes u v

/- The actual implementation we choose: `P` is projective if the natural surjection
   from the free `R`-module on `P` to `P` splits. -/
/-- An R-module is projective if it is a direct summand of a free module, or equivalently
  if maps from the module lift along surjections. There are several other equivalent
  definitions. -/
def is_projective
  (R : Type u) [semiring R] (P : Type v) [add_comm_monoid P] [module R P] : Prop :=
∃ s : P →ₗ[R] (P →₀ R), function.left_inverse (finsupp.total P P R id) s

namespace is_projective

section semiring

variables {R : Type u} [semiring R] {P : Type v} [add_comm_monoid P] [module R P]
  {M : Type*} [add_comm_group M] [module R M] {N : Type*} [add_comm_group N] [module R N]

/-- A projective R-module has the property that maps from it lift along surjections. -/
theorem lifting_property (h : is_projective R P) (f : M →ₗ[R] N) (g : P →ₗ[R] N)
  (hf : function.surjective f) : ∃ (h : P →ₗ[R] M), f.comp h = g :=
begin
  /-
  Here's the first step of the proof.
  Recall that `X →₀ R` is Lean's way of talking about the free `R`-module
  on a type `X`. The universal property `finsupp.total` says that to a map
  `X → N` from a type to an `R`-module, we get an associated R-module map
  `(X →₀ R) →ₗ N`. Apply this to a (noncomputable) map `P → M` coming from the map
  `P →ₗ N` and a random splitting of the surjection `M →ₗ N`, and we get
  a map `φ : (P →₀ R) →ₗ M`.
  -/
  let φ : (P →₀ R) →ₗ[R] M := finsupp.total _ _ _ (λ p, function.surj_inv hf (g p)),
  -- By projectivity we have a map `P →ₗ (P →₀ R)`;
  cases h with s hs,
  -- Compose to get `P →ₗ M`. This works.
  use φ.comp s,
  ext p,
  conv_rhs {rw ← hs p},
  simp [φ, finsupp.total_apply, function.surj_inv_eq hf],
end

/-- A module which satisfies the universal property is projective. Note that the universe variables
in `huniv` are somewhat restricted. -/
theorem of_lifting_property {R : Type u} [semiring R]
  {P : Type v} [add_comm_monoid P] [module R P]
  -- If for all surjections of `R`-modules `M →ₗ N`, all maps `P →ₗ N` lift to `P →ₗ M`,
  (huniv : ∀ {M : Type (max v u)} {N : Type v} [add_comm_monoid M] [add_comm_monoid N],
    by exactI
    ∀ [module R M] [module R N],
    by exactI
    ∀ (f : M →ₗ[R] N) (g : P →ₗ[R] N),
  function.surjective f → ∃ (h : P →ₗ[R] M), f.comp h = g) :
  -- then `P` is projective.
  is_projective R P :=
begin
  -- let `s` be the universal map `(P →₀ R) →ₗ P` coming from the identity map `P →ₗ P`.
  obtain ⟨s, hs⟩ : ∃ (s : P →ₗ[R] P →₀ R),
    (finsupp.total P P R id).comp s = linear_map.id :=
    huniv (finsupp.total P P R (id : P → P)) (linear_map.id : P →ₗ[R] P) _,
  -- This `s` works.
  { use s,
    rwa linear_map.ext_iff at hs },
  { intro p,
    use finsupp.single p 1,
    simp },
end

end semiring

section ring

variables {R : Type u} [ring R] {P : Type v} [add_comm_group P] [module R P]

/-- Free modules are projective. -/
theorem of_free {ι : Type*} {b : ι → P} (hb : is_basis R b) : is_projective R P :=
begin
  -- need P →ₗ (P →₀ R) for definition of projective.
  -- get it from `ι → (P →₀ R)` coming from `b`.
  use hb.constr (λ i, finsupp.single (b i) 1),
  intro m,
  simp only [hb.constr_apply, mul_one, id.def, finsupp.smul_single', finsupp.total_single,
    linear_map.map_finsupp_sum],
  exact hb.total_repr m,
end

end ring

end is_projective


import tactic

-- References: Schmidt, G. (2010) Relational Mathematics. Cambridge: Cambridge University Press (Encyclopedia of Mathematics and its Applications). doi: 10.1017/CBO9780511778810.

namespace myrelation
variables {α β γ A: Type*}

def union (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∨ s a b
def intersect (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∧ s a b

def reflexive (R : A → A → Prop) : Prop := ∀ x, R x x
def irreflexive (R : A → A → Prop) : Prop := ∀ x, ¬ R x x
def symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x
def asymmetric (R : A → A → Prop) : Prop := ∀ (a b : A), R a b → ¬(R b a)
def transitive (R : A → A → Prop) : Prop := ∀ x y z, R x y → R y z → R x z
def anti_symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x → x = y

def preorder (R : A → A → Prop) : Prop := reflexive R ∧ transitive R
def total (R : A → A → Prop) : Prop := ∀ x y, R x y ∨ R y x
def partial_order (R : A → A → Prop) : Prop := preorder R ∧ anti_symmetric R
def total_order (R : A → A → Prop) : Prop := partial_order R ∧ total R
def strict_order (R : A → A → Prop) : Prop := transitive R ∧ asymmetric R

-- 2021 IUM Final Q1c
    -- R, S two binary relations on set {A : Type}.
    -- Define relations `def T (a b : A) : Prop := R a b ∧ S a b`,
    -- `def U (a b : A) : Prop := R a b ∨ S a b`
    -- (i)    If R, S equivalence relations, then T is equivalence relation
    -- (ii)   If R, S equivalence relations, then U may not be an equivalence relation.
    -- (iii)  If R, S antisymmetric, then T is also antisymmetric.
    -- (iv)   If R, S antisymmetric, then U may not be antisymmetric.

-- Extension
-- (1) Reflexivity: preserved under ∪ and ∩. (shown in (i)(ii))
example (R S : A → A → Prop) (reflR : reflexive R) (reflS : reflexive S) : reflexive (intersect R S) :=
begin
  intro x,
  split,
  apply reflR x,
  apply reflS x,
end

example (R S : A → A → Prop) (reflR : reflexive R) (reflS : reflexive S) : reflexive (union R S) :=
begin
  intro x,
  left,
  apply reflR x,
end

-- (2) Symmetry: preserved under ∪ and ∩. (shown in (i)(ii))
example (R S : A → A → Prop) (symmR : symmetric R) (symmS : symmetric S) : symmetric (intersect R S) :=
begin
  intros x y h,
  cases h with hRxy hSxy,
  split,
  apply symmR x y hRxy,
  apply symmS x y hSxy,
end

example (R S : A → A → Prop) (symmR : symmetric R) (symmS : symmetric S) : symmetric (union R S) :=
begin
  intros x y h,
  cases h with hRxy hSxy,
  left, apply symmR x y hRxy,
  right, apply symmS x y hSxy,
end

-- (3) Transitivity: preserved only under ∩, but not ∪ (shown in (i)(ii))
example (R S : A → A → Prop) (transR : transitive R) (transS : transitive S) : transitive (intersect R S) :=
begin
  intros x y z h1 h2,
  cases h1 with hRxy hSxy,
  cases h2 with hRyz hSyz,
  split,
  { apply transR x y z hRxy hRyz},
  { apply transS x y z hSxy hSyz},
end

-- Counterexample for `∪`: Idea (For a,b,c, we construct R and S that
                     -- R(a,b), S(b,c) true, R(b,c), S(a,b) false, R(a,c), S(a,c) false)
                     -- In fact, such R and S exist
                     -- Let X = {a,b,c}
                     -- R(a,a), R(b,b), R(c,c), R(a,b), R(b,a) true, else false
                     -- S(a,a), S(b,b), S(c,c), S(b,c), S(b,c) true, else false

namespace transitivity

inductive X : Type
| a : X
| b : X
| c : X

namespace X

-- Define binary relation R such that
-- R(a,a), R(b,b), R(c,c), R(a,b), R(b,a) true, else false
def R : X → X → Prop
| a a := true
| b b := true
| c c := true
| a b := true
| b a := true
| b c := false
| c b := false
| a c := false
| c a := false

-- Define binary relation S such that
-- S(a,a), S(b,b), S(c,c), S(b,c), S(b,c) true, else false
def S : X → X → Prop
| a a := true
| b b := true
| c c := true
| a b := false
| b a := false
| b c := true
| c b := true
| a c := false
| c a := false

def U (x y : X) : Prop := R x y ∨ S x y

-- R is transitive
lemma R_trans : transitive R :=
begin
  rintros x y z,
    rcases x,
      -- x = a
      rcases y,
        -- y = a
          rcases z, -- 3 cases
            repeat {intros h1 h2, triv}, -- solves first two T → T cases
            intros h1 h2, exact h2, -- solve last case
        -- y = b
          rcases z, -- 3 cases
            repeat {intros h1 h2, triv}, -- solves first two T → T cases
            intros h1 h2, exact h2, -- solve last case
        -- y = c
          rcases z, -- 3 cases
            repeat {intros h1 h2, triv}, -- solves first two T → T cases
            intros h1 h2, exact h1, -- solve last case

      -- x = b
      rcases y,
        -- y = a
          rcases z,
            repeat {intros h1 h2, triv},
            intros h1 h2, exact h2,
        -- y = b
          rcases z,
            repeat {intros h1 h2, triv},
            intros h1 h2, exact h2,
        -- y = c
          rcases z,
            repeat {intros h1 h2, triv},
            intros h1 h2, exact h1,
      -- x = c
      rcases y,
        -- y = a
          rcases z,
            intros h1 h2, exact h1,
            intros h1 h2, by_contra h3, exact h1,
            intros h1 h2, triv,
        -- y = b
          rcases z,
            intros h1 h2, by_contra h3, exact h1,
            intros h1 h2, exact h1,
            intros h1 h2, triv,
        -- y = c
          rcases z,
            repeat {intros h1 h2, exact h2},
end

-- S is transitive
lemma S_trans : transitive S :=
begin
  rintros x y z,
    rcases x,
      -- x = a
      rcases y,
        -- y = a
          rcases z, -- 3 cases
            intros h1 h2, triv,
            repeat {intros h1 h2, exact h2},
        -- y = b
          rcases z, -- 3 cases
            intros h1 h2, triv,
            repeat {intros h1 h2, exact h1},
        -- y = c
          rcases z, -- 3 cases
            intros h1 h2, triv, -- solves first two T → T cases
            repeat {intros h1 h2, exact h1}, -- solve last case

      -- x = b
      rcases y,
        -- y = a
          rcases z,
            intros h1 h2, exact h1,
            repeat {intros h1 h2, triv},
        -- y = b
          rcases z,
            repeat {intros h1 h2, triv},
            intros h1 h2, exact h2,
        -- y = c
          rcases z,
            repeat {intros h1 h2, triv},
            intros h1 h2, by_contra h3, exact h2,
      -- x = c
      rcases y,
        -- y = a
          rcases z,
            intros h1 h2, exact h1,
            intros h1 h2, by_contra h3, exact h1,
            intros h1 h2, triv,
        -- y = b
          rcases z,
            intros h1 h2, by_contra h3, exact h2,
            intros h1 h2, exact h1,
            intros h1 h2, triv,
        -- y = c
          rcases z,
            repeat {intros h1 h2, exact h2},
end

-- U is not transitive
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), (transitive R → transitive S) → transitive U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { intro transR,
    exact S_trans}, -- Prove S is equivalence relation
  { -- rw transitive at h,
    have h1 : U a b, -- show hypothesis that U a b is true
      {left, triv},
    have h2 : U b c, -- show hypothesis that U b c is true
      {right, triv},
    specialize h a b c h1 h2, -- focus on the specific case with h1, h2
    rcases h, repeat {exact h}, -- since U a c = R a c ∨ S a c, use the fact that R a c and S a c are false
  },
end

end X
end transitivity
-- The above is also a counter-example to the following question in 2021 IUM Q1c:
-- (ii) If R, S equivalence relations, then U may not be an equivalence relation.

-- (4) Anti-symmetry: preserved only under ∩, but not ∪ (shown in (iii)(iv))

example (R S : A → A → Prop) (antisymmR : anti_symmetric R) (antisymmS : anti_symmetric S) : anti_symmetric (intersect R S) :=
  begin
    intros a b hab hba,
    cases hab with hRab hSab,
    cases hba with hRba hSba,
    apply antisymmR a b hRab hRba,
  end

-- Counterexample for `∪`: Let X = {a,b}
                        -- R(a,b) true, else false
                        -- S(b,a) true, else false
                        -- Then U(a,b) and U(b,a) are true, but a ≠ b

namespace antisymmetry

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b) true, else false
def R : X → X → Prop
| a a := false
| a b := true
| b a := false
| b b := false

-- Define binary relation R such that
-- S(b,a) true, else false
def S : X → X → Prop
| a a := false
| a b := false
| b a := true
| b b := false

def U (x y : X) : Prop := R x y ∨ S x y

-- R is antisymmetric
lemma Q_iv_R_antisymm : anti_symmetric R :=
begin
  intros x y hXY hYX,
  rcases x,
    -- x = a
    rcases y,
      refl, -- the case y = a
      exfalso, exact hYX, -- the case y = b
    -- x = b
    rcases y,
      exfalso, exact hXY, -- the case y = a
      refl, -- the case y = b
end

-- S is antisymmetric
lemma Q_iv_S_antisymm : anti_symmetric S :=
begin
  intros x y hXY hYX,
  rcases x,
    -- x = a
    rcases y,
      refl, -- the case y = a
      exfalso, exact hXY, -- the case y = b
    -- x = b
    rcases y,
      exfalso, exact hYX, -- the case y = a
      refl, -- the case y = b
end

-- U is NOT antisymmetric
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), (anti_symmetric R → anti_symmetric S) → anti_symmetric U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { intro antisymmR,
    exact Q_iv_S_antisymm}, -- Prove S is antisymmetric
  { rw anti_symmetric at h,
    have h1 : U a b, -- show hypothesis that U a b is true
      {left, triv},
    have h2 : U b a, -- show hypothesis that U b a is true
      {right, triv},
    specialize h a b h1 h2, -- focus on the specific case with h1, h2
    rcases h, -- check that `h` is false
  },
end

end X
end antisymmetry

-- (5) Asymmetry: preserved only under ∩, but not ∪.
example (R S : A → A → Prop) (asymmR : asymmetric R) (asymmS : asymmetric S) : asymmetric (intersect R S) :=
begin
  intros x y h1 h2,
  cases h1 with hRxy hSxy,
  cases h2 with hRyx hSyx,
  apply asymmR x y hRxy hRyx,
end

namespace asymmetry

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b) true, else false
def R : X → X → Prop
| a a := false
| a b := true
| b a := false
| b b := false

-- Define binary relation R such that
-- S(b,a) true, else false
def S : X → X → Prop
| a a := false
| a b := false
| b a := true
| b b := false

def U (x y : X) : Prop := R x y ∨ S x y

-- R is asymmetric
lemma R_asymm : asymmetric R :=
begin
  intros x y hxy hyx,
  rcases x,
    -- x = a
    rcases y,
      exact hxy, -- the case y = a; follows that `R a a` is false
      exact hyx, -- the case y = b; follows that `R b a` is false

    -- x = b
    rcases y,
      exact hxy, -- the case y = a; follows that `R b a` is false
      exact hxy, -- the case y = b; follows that `R b b` is false
end

-- S is asymmetric
lemma S_asymm : asymmetric S :=
begin
  intros x y hxy hyx,
  rcases x,
    -- x = a
    rcases y,
      exact hxy, -- the case y = a; follows that `R a a` is false
      exact hxy, -- the case y = b; follows that `R b a` is false

    -- x = b
    rcases y,
      exact hyx, -- the case y = a; follows that `R b a` is false
      exact hxy, -- the case y = b; follows that `R b b` is false
end

-- U is NOT asymmetric
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), (asymmetric R → asymmetric S) → asymmetric U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { intro asymmR,
    exact S_asymm}, -- Prove S is antisymmetric
  { rw asymmetric at h,
    have h1 : U a b, -- show hypothesis that U a b is true
      {left, triv},
    have h2 : U b a, -- show hypothesis that U b a is true
      {right, triv},
    specialize h a b h1 h2, -- focus on the specific case with h1, h2
    rcases h, -- check that `h` is false
  },
end

end X
end asymmetry

-- (6) Irreflexivity: preserved under ∪ and ∩.
example (R S : A → A → Prop) (irrflR : irreflexive R) (irrflS : irreflexive S) : irreflexive (intersect R S) :=
begin
  intros x h,
  cases h with hR hS,
  apply irrflS x hS,
end

example (R S : A → A → Prop) (irrflR : irreflexive R) (irrflS : irreflexive S) : irreflexive  (union R S) :=
begin
  intros x h,
  cases h with hR hS,
  apply irrflR x hR,
  apply irrflS x hS,
end

-- (7) Totality: preserved only under ∪, but not ∩.

example (R S : A → A → Prop) (totalR : total R) (totalS : total S) : total (union R S) :=
begin
  intros x y,
  specialize totalR x y,
  specialize totalS x y,
  cases totalR with hRxy hRyx,
  { cases totalS with hSxy hSyx,
    left, left, exact hRxy,
    right, right, exact hSyx},
  { cases totalS with hSxy hSyx,
    right, left, exact hRyx,
    right, right, exact hSyx},
end

namespace totality

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b) true, else false
def R : X → X → Prop
| a a := true
| a b := true
| b a := false
| b b := true

-- Define binary relation R such that
-- S(b,a) true, else false
def S : X → X → Prop
| a a := true
| a b := false
| b a := true
| b b := true

def T (x y : X) : Prop := R x y ∧ S x y

-- R is total
lemma R_total : total R :=
begin
  intros x y,
  rcases x,
    -- x = a
    rcases y,
      left, triv, -- the case y = a; follows that `R a a` is true
      left, triv, -- the case y = b; follows that `R a b` is true

    -- x = b
    rcases y,
      right, triv, -- the case y = a; follows that `R a b` is true
      right, triv, -- the case y = b; follows that `R b b` is true
end

-- S is total
lemma S_total : total S :=
begin
  intros x y,
  rcases x,
    -- x = a
    rcases y,
      left, triv, -- the case y = a; follows that `R a a` is true
      right, triv, -- the case y = b; follows that `R b a` is true

    -- x = b
    rcases y,
      left, triv, -- the case y = a; follows that `R b a` is true
      right, triv, -- the case y = b; follows that `R b b` is true
end

-- T is NOT asymmetric
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), (total R → total S) → total T) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { intro totalR,
    exact S_total}, -- Prove S is antisymmetric
  { rw total at h,
    have h1 : ¬(T a b), -- show hypothesis that T a b is false
      {intro hTab, cases hTab with hRab hSab, apply hSab},
    have h2 : ¬(T b a), -- show hypothesis that T b a is false
      {intro hTba, cases hTba with hRba hSba, apply hRba},
    specialize h a b, -- focus on the specific case with x = a, y = b
    rcases h, -- check that `h` is false
    {apply h1, exact h},
    {apply h2, exact h},
  },
end

end X
end totality

end myrelation


import category_theory.category.default

universes v u  -- The order in this declaration matters: v often needs to be explicitly specified while u often can be omitted

namespace category_theory

variables (C : Type u) [category.{v} C]

/-
# Category world

## Level 7: Monomorphisms & epimorphisms

A monomorphism `f : Y ⟶ Z` is a morphism such that, for all pairs `g h : X ⟶ Y`, if `h ≫ f = g ≫ f`,
then ` h = g`.

Similarly, an epimorphism `f : X ⟶ Y` is a morphism such that, for all pairs `g h : Y ⟶ Z`, if `f ≫ h = f ≫ g`, then ` h = g`.

Category theorists commonly refer to monomorphisms and epimorphisms as `mono` and `epi` respectively, and this is the case in Lean as well.

So this gives us axioms
-/

/- Axiom:
    mono f, g h : Y ⟶ Z, f ≫ g = f ≫ h → g = h-/ --figure out how to phrase these axioms jeez

/-We will now prove that, if `f` is mono, then f ≫ g = f ≫ h ↔ g = h so we can use `rw`.-/

/- Lemma
If $$f : X ⟶ Y$$ and $$g : X ⟶ Y$$ are morphisms such that $$f = g$$, then $$f ≫ h = g ≫ h$$.
-/
lemma cancel_mono' (X Y Z : C) (f : X ⟶ Y) [mono f] {g h : Z ⟶ X} : (g ≫ f = h ≫ f) ↔ g = h :=
begin
    split,

    intro hyp,
    apply mono.right_cancellation g h hyp,

    intro hyp,
    rw hyp,
end

end category_theory


import tactic -- hide
import data.real.basic -- hide

/-
## The `have` tactic

It is common in proofs to introduce auxiliary results, or claims, that help towards the goal. *Lean*
allows for this kind of structure, by allowing you to insert new hypotheses (as long as you prove them,
of course). This is done with the `have` tactic. The syntax is `have h : P,` where `h` is the name
you want to give to the new hypothesis (check that it doesn't exist already or you will run intro problems)
and `P` is a predicate like `x + 3 = 5`. You will get two goals, the first one will be to prove `P`,
and the second one will be the original goal. In the second one, you will have `h` available.

The next lemma cannot be proven by `ring` directly, since it involves an arbitrary exponent. There
are tactics that work with these kind of equations, but we will do something easier. If we can prove
first that $x+y=y+x$, then replacing that equality on the left-hand side will immediately finish the
goal. So start with `have h : x + y = y + x,` and work from there.
-/
/- Symbol:
ℝ : \R
-/
/- Lemma : no-side-bar
For all $n$, we have $(x+y)^n=(y+x)^n$.
-/
lemma h0 (x y : ℝ) (n : ℕ) : (x + y)^n = (y + x)^n :=
begin
  have h : x + y = y + x,
  {
    ring,
  },
  rw h,

end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/

import data.mv_polynomial.variables
import algebra.module.basic
import tactic.ring

/-!
# Partial derivatives of polynomials

This file defines the notion of the formal *partial derivative* of a polynomial,
the derivative with respect to a single variable.
This derivative is not connected to the notion of derivative from analysis.
It is based purely on the polynomial exponents and coefficients.

## Main declarations

* `mv_polynomial.pderiv i p` : the partial derivative of `p` with respect to `i`.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_ring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u
variables {R : Type u}

namespace mv_polynomial
variables {σ : Type*} {a a' a₁ a₂ : R} {s : σ →₀ ℕ}

section pderiv

variables {R} [comm_semiring R]

/-- `pderiv i p` is the partial derivative of `p` with respect to `i` -/
def pderiv (i : σ) : mv_polynomial σ R →ₗ[R] mv_polynomial σ R :=
{ to_fun := λ p, p.sum (λ A B, monomial (A - single i 1) (B * (A i))),
  map_smul' := begin
    intros c x,
    rw [sum_smul_index', smul_sum],
    { dsimp, simp_rw [← (monomial _).map_smul, smul_eq_mul, mul_assoc] },
    { intros s,
      simp only [monomial_zero, zero_mul] }
  end,
  map_add' := λ f g, sum_add_index (by simp only [monomial_zero, forall_const, zero_mul])
    (by simp only [add_mul, forall_const, eq_self_iff_true, (monomial _).map_add]), }

@[simp]
lemma pderiv_monomial {i : σ} :
  pderiv i (monomial s a) = monomial (s - single i 1) (a * (s i)) :=
by simp only [pderiv, monomial_zero, sum_monomial_eq, zero_mul, linear_map.coe_mk]

@[simp]
lemma pderiv_C {i : σ} : pderiv i (C a) = 0 :=
suffices pderiv i (monomial 0 a) = 0, by simpa,
by simp only [monomial_zero, pderiv_monomial, nat.cast_zero, mul_zero, zero_apply]

@[simp]
lemma pderiv_one {i : σ} : pderiv i (1 : mv_polynomial σ R) = 0 := pderiv_C

lemma pderiv_eq_zero_of_not_mem_vars {i : σ} {f : mv_polynomial σ R} (h : i ∉ f.vars) :
  pderiv i f = 0 :=
begin
  change (pderiv i) f = 0,
  rw [f.as_sum, linear_map.map_sum],
  apply finset.sum_eq_zero,
  intros x H,
  simp [mem_support_not_mem_vars_zero H h],
end

lemma pderiv_X [decidable_eq σ] {i j : σ} :
  pderiv i (X j : mv_polynomial σ R) = if i = j then 1 else 0 :=
begin
  refine pderiv_monomial.trans _,
  rcases eq_or_ne i j with (rfl|hne),
  { simp },
  { simp [hne, hne.symm] }
end

@[simp] lemma pderiv_X_self {i : σ} : pderiv i (X i : mv_polynomial σ R) = 1 :=
by simp [pderiv_X]

lemma pderiv_monomial_single {i : σ} {n : ℕ} :
  pderiv i (monomial (single i n) a) = monomial (single i (n-1)) (a * n) :=
by simp

private lemma monomial_sub_single_one_add {i : σ} {s' : σ →₀ ℕ} :
  monomial (s - single i 1 + s') (a * (s i) * a') =
    monomial (s + s' - single i 1) (a * (s i) * a') :=
by by_cases h : s i = 0; simp [h, sub_single_one_add]

private lemma monomial_add_sub_single_one {i : σ} {s' : σ →₀ ℕ} :
  monomial (s + (s' - single i 1)) (a * (a' * (s' i))) =
    monomial (s + s' - single i 1) (a * (a' * (s' i))) :=
by by_cases h : s' i = 0; simp [h, add_sub_single_one]

lemma pderiv_monomial_mul {i : σ} {s' : σ →₀ ℕ} :
  pderiv i (monomial s a * monomial s' a') =
    pderiv i (monomial s a) * monomial s' a' + monomial s a * pderiv i (monomial s' a') :=
begin
  simp only [monomial_sub_single_one_add, monomial_add_sub_single_one, pderiv_monomial,
    pi.add_apply, monomial_mul, nat.cast_add, coe_add],
  rw [mul_add, (monomial _).map_add, ← mul_assoc, mul_right_comm a _ a']
end

@[simp]
lemma pderiv_mul {i : σ} {f g : mv_polynomial σ R} :
  pderiv i (f * g) = pderiv i f * g + f * pderiv i g :=
begin
  apply induction_on' f,
  { apply induction_on' g,
    { intros u r u' r', exact pderiv_monomial_mul },
    { intros p q hp hq u r,
      rw [mul_add, linear_map.map_add, hp, hq, mul_add, linear_map.map_add],
      ring } },
  { intros p q hp hq,
    simp [add_mul, hp, hq],
    ring, }
end

@[simp]
lemma pderiv_C_mul {f : mv_polynomial σ R} {i : σ} :
  pderiv i (C a * f) = C a * pderiv i f :=
by convert linear_map.map_smul (pderiv i) a f; rw C_mul'

@[simp]
lemma pderiv_pow {i : σ} {f : mv_polynomial σ R} {n : ℕ} :
  pderiv i (f^n) = n * pderiv i f * f^(n-1) :=
begin
  induction n with n ih,
  { simp, },
  { simp only [nat.succ_sub_succ_eq_sub, nat.cast_succ, tsub_zero, mv_polynomial.pderiv_mul,
      pow_succ, ih],
    cases n,
    { simp, },
    { simp only [nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, nat.cast_add, nat.cast_one,
        pow_succ],
      ring, }, },
end

@[simp]
lemma pderiv_nat_cast {i : σ} {n : ℕ} : pderiv i (n : mv_polynomial σ R) = 0 :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih], },
end

end pderiv

end mv_polynomial


import betweenness_world.level04 --hide
open IncidencePlane --hide

/- Axiom :
between_symmetric {A B C : Ω} : (A * B * C) ↔ (C * B * A)
-/

/-
# Betweenness World

## Level 5: the definition of segment.

We've already seen how to define some primitive notions from a given set of axioms, such as **point**, **line**, **incidence** or **betweenness**. In
mathematics, we can also define new concepts by combining those that we've learned so far. In this way, the notion of **segment** joins the party.

**Definition:** a point C is in the segment A·B if and only if A * C * B or C = A or C = B.

In Lean, a segment is represented as A·B. When we refer to the point A, it is represented as (A·B).A. When we refer to the point B, it is represented
as (A·B).B. With that being said, you can try to solve this level by your own. You may want to use the first axiom of order once (`different_of_between`).

In case you get stuck, click right below for a hint.

-/

/- Hint : Click here for a hint, in case you get stuck.
Whenever you see the hypothesis `hx: B ∈ A⬝A`, the `cases` tactic will make progress. Whenever you see the goal `⊢ A ∈ A⬝A`, the `left` and `right` tactics
will make progress. Still bewildered? Click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
The only point on the segment A⬝A is A itself.
-/
lemma one_point_segment (A B : Ω) : B ∈ A⬝A ↔ B = A :=
begin
  split,
  {
    intro hx,
    cases hx,
    {
      exact hx,
    },
    {
      cases hx,
      {
        exact hx,
      },
      {
        exfalso,
        apply (different_of_between hx).2.1,
        refl,
      }
    }
  },
  {
    intro h,
    rw h,
    left,
    refl,
  },

end


/-
  Same as covering but the Ui's are elements of the basis and such that Ui ∩ Uj
  (not necessarily in the basis) is covered by Uijk's all in the basis.
-/

import topology.basic
import to_mathlib.opens
import sheaves.covering.covering

universes u v

open topological_space lattice

section covering_on_basis

parameters {α : Type u} [topological_space α]
parameters {B : set (opens α)} [HB : opens.is_basis B]

-- Open cover for basis.

structure covering_basis (U : opens α) extends covering U :=
{Iij       : γ → γ → Type v }
(Uijks     : Π (i j), Iij i j → opens α)
(BUis      : ∀ i, Uis i ∈ B)
(BUijks    : ∀ i j k, Uijks i j k ∈ B)
(Hintercov : ∀ i j, ⋃ (Uijks i j) = Uis i ∩ Uis j)

-- If ⋃ Uijk = Ui ∩ Uj then for all k, Uijk ⊆ Ui ∩ Uj.

lemma subset_covering_basis {U : opens α} {OC : covering_basis U}
: ∀ i j k, OC.Uijks i j k ⊆ OC.Uis i ∩ OC.Uis j :=
λ i j k x, (OC.Hintercov i j) ▸ opens_supr_mem (OC.Uijks i j) k x

-- If ⋃ Uijk = Ui ∩ Uj then for all k, Uijk ⊆ Ui.

lemma subset_covering_basis_inter_left {U : opens α} {OC : covering_basis U}
: ∀ i j k, OC.Uijks i j k ⊆ OC.Uis i :=
λ i j k, set.subset.trans (subset_covering_basis i j k) (set.inter_subset_left _ _)

-- If ⋃ Uijk = Ui ∩ Uj then for all k, Uijk ⊆ Uj.

lemma subset_covering_basis_inter_right {U : opens α} {OC : covering_basis U}
: ∀ i j k, OC.Uijks i j k ⊆ OC.Uis j :=
λ i j k, set.subset.trans (subset_covering_basis i j k) (set.inter_subset_right _ _)

end covering_on_basis


-- let's define the real numbers to be a number system which satisfies
-- the basic properties of the real numbers which we will need.

noncomputable theory
constant real : Type
@[instance] constant real_field : linear_ordered_field real

-- This piece of magic means that "real" now behaves a lot like
-- the real numbers. In particular we now have a bunch
-- of theorems:

example : ∀ x y : real, x * y = y * x := mul_comm

variable x : real
variable n : nat

-- We do _not_ have powers though. So we need to make them.

open nat

definition natural_power : real → nat → real
| x 0 := 1
| x (succ n) := (natural_power x n) * x

theorem T1 : ∀ x:real, ∀ m n:nat, natural_power x (m+n) = natural_power x m *natural_power x n :=
    begin
        assume x m n,
        induction n with n H,
        unfold natural_power,
        rw [add_zero, mul_one],
        unfold natural_power,
        rw [H, mul_assoc],
    end

theorem T2 : ∀ x: real, ∀ m n : nat, natural_power (natural_power x m) n = natural_power x (m*n) :=
    begin
        assume x m n,
        induction n with n H,
        unfold natural_power,
        rw [mul_zero, eq_comm],
        unfold natural_power,
        rw [succ_eq_add_one,mul_add,mul_one,add_one],
        unfold natural_power,
        rw [T1,H]
    end

theorem T3 : ∀ x y: real, ∀ n : nat, natural_power x n * natural_power y n = natural_power (x*y) n :=
    begin
        assume x y n,
        induction n with n H,
        unfold natural_power,
        exact mul_one 1,
        rw[succ_eq_add_one],
        rw[T1],
        unfold natural_power,
        rw[one_mul],
        cc,
    end

constant nth_root (x : real) (n : nat) : (x>0) → (n>0) → real

axiom is_nth_root (x : real) (n : nat) (Hx : x>0) (Hn : n>0) : natural_power (nth_root x n Hx Hn) n = x

definition rational_power_v0 (x : real) (n : nat) (d : nat) (Hx : x > 0) (Hd : d > 0) : real :=
natural_power (nth_root x d Hx Hd) n

theorem T4 (x:real) (n:ℕ) (Hx:x≥0): 0 ≤ natural_power x n:=
    begin
        induction n with n H,
        unfold natural_power,
        exact zero_le_one,
        unfold natural_power,
        exact calc 0 = 0*x:by rw[zero_mul]
            ... ≤ natural_power x n * x:mul_le_mul_of_nonneg_right H Hx,
    end

theorem T5 (x y:real) (n:ℕ) (Hx:x≥0) (Hy:y≥0) (Hn:n≥1): natural_power x n = natural_power y n → x = y :=
    begin
        have H1:  ∀ (s t:real), ∀ (Hs : s ≥ 0), ∀ (Ht : t ≥ 0) , s < t → natural_power s n < natural_power t n,
            assume s t Hs Ht Hslt,
            cases n with k,
            exfalso,
            have Htemp : 0 < 0,
            exact calc 0 < 1 : zero_lt_one
                ... ≤ 0 : Hn,
            have Htemp2 : ¬ (0=0),
            exact ne_of_lt Htemp,
            apply Htemp2,
            trivial,
            clear Hn,

            induction k with k Hk,
                unfold natural_power,
                rwa[one_mul,one_mul],
                unfold natural_power,
                exact calc natural_power s k * s * s = natural_power s (succ k) * s:rfl
                    ... ≤ natural_power s (succ k) * t:mul_le_mul_of_nonneg_left (le_of_lt Hslt) (T4 s (succ k) Hs) --  (sorry)
                    ... < natural_power t (succ k) * t: mul_lt_mul_of_pos_right Hk (calc 0≤s : Hs ... <t : Hslt)
                    ... = natural_power t k * t * t : rfl,

        intro Hnp,
        cases  lt_or_ge x y with H2 H3,
        exfalso,
        exact ne_of_lt (H1 x y Hx Hy H2) Hnp,

        cases lt_or_eq_of_le H3 with H4 H5,
        tactic.swap,
        exact eq.symm H5,
        exfalso,
        exact ne_of_lt (H1 y x Hy Hx H4) (eq.symm Hnp),
    end

axiom positive_nth_root (x:real) (n:ℕ) (Hx:x>0) (Hn:n>0):0<nth_root x n Hx Hn

theorem T6 (x:real) (m n k l:ℕ) (Hx:x>0) (Hm:m≥0) (Hn:n>0) (Hk:k≥0) (Hl:l>0) (Hmnkl:m*l=k*n): rational_power_v0 x m n Hx Hn=rational_power_v0 x k l Hx Hl:=
begin
    have H2:natural_power (rational_power_v0 x m n Hx Hn) (n*l)=natural_power (rational_power_v0 x k l Hx Hl) (n*l):=
        begin
            have H2_1:natural_power (rational_power_v0 x k l Hx Hl) (n*l) = natural_power (rational_power_v0 x k l Hx Hl) (l*n):=
                begin rw[mul_comm] end,
            rw[H2_1], clear H2_1,
            rw[←T2,←T2],
            unfold rational_power_v0,
            rw[T2 (nth_root x l Hx Hl), mul_comm,←T2, is_nth_root],
            rw[T2 (nth_root x n Hx Hn), mul_comm,←T2, is_nth_root],
            rw[T2,T2,Hmnkl]
        end,
    have Hxmn:rational_power_v0 x m n Hx Hn≥0:=
        begin
            unfold rational_power_v0,
            have Hxmn_1:0≤nth_root x n Hx Hn:= le_of_lt (positive_nth_root x n Hx Hn),
            exact T4 (nth_root x n Hx Hn) m Hxmn_1,
        end,
    have Hxkl:rational_power_v0 x k l Hx Hl≥0:=
        begin
            unfold rational_power_v0,
            have Hxkl_1:0≤nth_root x l Hx Hl:= le_of_lt (positive_nth_root x l Hx Hl),
            exact T4 (nth_root x l Hx Hl) k Hxkl_1,
        end,
    have Hnl:n*l≥1:=
        begin
            have Hnl_1:0<n*l:=mul_pos Hn Hl,
            have Hnl_2:1<1+(n*l):=add_lt_add_left Hnl_1 1,
            have Hnl_3:1<succ(n*l):=
                begin
                    rw[succ_eq_add_one,add_comm],
                    exact Hnl_2,
                end,
            have Hnl_4:1≤(n*l):=le_of_lt_succ Hnl_3,
            exact(Hnl_4),
        end,

    exact T5 (rational_power_v0 x m n Hx Hn) (rational_power_v0 x k l Hx Hl) (n*l) Hxmn Hxkl Hnl H2,

end

theorem T7 (x:real) (m n k l:ℕ) (Hx:x>0) (Hm:m≥0) (Hn:n>0) (Hk:k≥0) (Hl:l>0) (Hmnkl:m*l=k*n): T6 x m n k l Hx Hm Hn Hk Hl Hmnkl = T6 x m n k l Hx Hm Hn Hk Hl Hmnkl :=
begin
unfold T6,
end


import data.nat.basic
import tactic.library_search

-- Turn off trace messages so they don't pollute the test build:
set_option trace.silence_library_search true
-- For debugging purposes, we can display the list of lemmas:
-- set_option trace.library_search true

-- Check that `library_search` fails if there are no goals.
example : true :=
begin
  trivial,
  success_if_fail { library_search },
end

example (a b : ℕ) : a + b = b + a :=
by library_search -- says: `exact add_comm a b`

example {a b : ℕ} : a ≤ a + b :=
by library_search -- says: `exact le_add_right a b`

example (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by library_search -- says: `exact nat.mul_sub_left_distrib n m k`

example {n m : ℕ} (h : m < n) : m ≤ n - 1 :=
by library_search -- says: `exact nat.le_pred_of_lt h`

example {α : Type} (x y : α) : x = y ↔ y = x :=
by library_search -- says: `exact eq_comm`

example (a b : ℕ) (ha : 0 < a) (hb : 0 < b) : 0 < a + b :=
by library_search -- says: `exact add_pos ha hb`

example (a b : ℕ) : 0 < a → 0 < b → 0 < a + b :=
by library_search -- says: `exact add_pos`

example (a b : ℕ) (h : a ∣ b) (w : b > 0) : a ≤ b :=
by library_search -- says: `exact nat.le_of_dvd w h`

-- We even find `iff` results:

example {b : ℕ} (w : b > 0) : b ≥ 1 :=
by library_search -- says: `exact nat.succ_le_iff.mpr w`

example : ∀ P : Prop, ¬(P ↔ ¬P) :=
by library_search -- says: `λ (a : Prop), (iff_not_self a).mp`

example {a b c : ℕ} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b :=
by library_search -- says `exact (nat.dvd_add_left h₁).mp h₂`

example {a b c : ℕ} (h₁ : a ∣ b) (h₂ : a ∣ b + c) : a ∣ c :=
by library_search -- says `exact (nat.dvd_add_left h₁).mp h₂`


import tutorial_world.level06_intro --hide
open IncidencePlane --hide

/- Tactic : split

## Summary:

If the goal is `P ∧ Q` or `P ↔ Q` then `split` will break it into two goals.

## Details

If `P Q : Prop` and the goal is `⊢ P ∧ Q`, then `split` will change it into
two goals, namely `⊢ P` and `⊢ Q`.

If `P Q : Prop` and the goal is `⊢ P ↔ Q`, then `split` will change it into
two goals, namely `⊢ P → Q` and `⊢ Q → P`.

## Example:

If your local context (the top right window) looks like this
```
X : Type
A B : set X
x : X
⊢ x ∈ A ↔ x ∈ B
```

then after

`split,`

it will look like this:

```
2 goals
X : Type
A B : set X
x : X
⊢ x ∈ A → x ∈ B

X : Type
A B : set X
x : X
⊢ x ∈ B → x ∈ A
```
-/

/-
# Tutorial World

## Level 7: the `split` tactic.

In this level we will learn the `split` tactic. It breaks a goal of the type `P ∧ Q` into two goals (proving `P`, and then proving `Q`),
and also breaks goals of the form `P ↔ Q` into proving each of the implications separately. That is to say, it asks us to prove `P → Q` first, and
then `Q → P`. In mathematics and logic, the **∧** symbol is read as **and**. For example, `IT RAINS ∧ I AM IN THE STREET → I OPEN THE UMBRELLA`.
Analogously, the **`↔`** symbol refers to a **double implication**, or an **if and only if** statement. In written mathematics, you could also
find the **`↔`** symbol written as **iff**.

Because you are supposed to be making process, try to solve this level by your own. You can solve it in three lines of code.
After deleting `sorry` and typing `split,`, you will see that this level is remarkably similar to Level 5. Feel free to go back to it!
[**Remember:** Whenever there are two goals to solve in Lean, you will always have to solve the above goal first, and then the one below.]
-/

/- Hint : Click here for a hint, in case you get stuck.
Delete `sorry` and type `split,` (don't forget the comma!). Directly after, go to the "Theorem statements" box (located on the
top left of the game screen) and try to find a lemma which could be suitable to solve this level. Still bewildered? Click on "View source"
(located on the top right corner of the game screen) to see the solution.

-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma : no-side-bar
If two lines contain two distinct points, then they are the same line.
-/
lemma line_through_contains_points (P Q : Ω) : P ∈ (line_through P Q) ∧ Q ∈ (line_through P Q)
:=
begin
  split,
  exact line_through_left P Q,
  exact line_through_right P Q,
end


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

! This file was ported from Lean 3 source module algebra.group.commutator
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Data.Bracket

/-!
# The bracket on a group given by commutator.
-/

/-- The commutator of two elements `g₁` and `g₂`. -/
instance commutatorElement {G : Type _} [Group G] : Bracket G G :=
  ⟨fun g₁ g₂ ↦ g₁ * g₂ * g₁⁻¹ * g₂⁻¹⟩
#align commutator_element commutatorElement

theorem commutatorElement_def {G : Type _} [Group G] (g₁ g₂ : G) :
  ⁅g₁, g₂⁆ = g₁ * g₂ * g₁⁻¹ * g₂⁻¹ :=
  rfl
#align commutator_element_def commutatorElement_def


import tactic.basic data.num.lemmas data.list.basic

namespace ring_tac
open tactic

-- We start by modelling polynomials as lists of integers. Note that znum
-- is basically the same as int, but optimised for computations.

-- The list [a0,a1,...,an] represents a0 + a1*x + a2*x^2 + ... +an*x^n

def poly := list znum

-- We now make basic definitions and prove basic lemmas about addition of polynomials,
-- multiplication of a polynomial by a scalar, and multiplication of polynomials.

def poly.add : poly → poly → poly
| [] g := g
| f [] := f
| (a :: f') (b :: g') := (a + b) :: poly.add f' g'

@[simp] lemma poly.zero_add (p : poly) : poly.add [] p = p := by induction p;refl

def poly.smul : znum → poly → poly
| _ [] := []
| z (a :: f') := (z * a) :: poly.smul z f'

def poly.mul : poly → poly → poly
| [] _ := []
| (a :: f') g := poly.add (poly.smul a g) (0 :: (poly.mul f' g))

def poly.const : znum → poly := λ z, [z]

def poly.X : poly := [0,1]

-- One problem with our implementation is that the lists [1,2,3] and [1,2,3,0] are different
-- list, but represent the same polynomial. So we define an "is_equal" predicate.

def poly.is_eq_aux : list znum -> list znum -> bool
| [] [] := tt
| [] (h₂ :: t₂) := if (h₂ = 0) then poly.is_eq_aux [] t₂ else ff
| (h₁ :: t₁) [] := if (h₁ = 0) then poly.is_eq_aux t₁ [] else ff
| (h₁ :: t₁) (h₂ :: t₂) := if (h₁ = h₂) then poly.is_eq_aux t₁ t₂ else ff

def poly.is_eq : poly → poly → bool := poly.is_eq_aux

-- evaluation of a polynomial at some element of a commutative ring.
def poly.eval {α} [comm_ring α] (X : α) : poly → α
| [] := 0
| (n::l) := n + X * poly.eval l

-- Lemmas saying that evaluation plays well with addition, multiplication, polynomial equality etc

@[simp] lemma poly.eval_zero {α} [comm_ring α] (X : α) : poly.eval X [] = 0 := rfl

@[simp] theorem poly.eval_add {α} [comm_ring α] (X : α) : ∀ p₁ p₂ : poly,
  (p₁.add p₂).eval X = p₁.eval X + p₂.eval X :=
begin
  intro p₁,
  induction p₁ with h₁ t₁ H,
    -- base case
    intros,simp [poly.eval],
  -- inductive step
  intro p₂,
  cases p₂ with h₂ t₂,
    simp [poly.add],
  unfold poly.eval poly.add,
  rw (H t₂),
  simp [mul_add]
end

@[simp] lemma poly.eval_mul_zero {α} [comm_ring α] (f : poly) (X : α) :
  poly.eval X (poly.mul f []) = 0 :=
begin
  induction f with h t H,
    refl,
  unfold poly.mul poly.smul poly.add poly.mul poly.eval,
  rw H,simp
end

@[simp] lemma poly.eval_smul {α} [comm_ring α] (X : α) (z : znum) (f : poly) :
  poly.eval X (poly.smul z f) = z * poly.eval X f :=
begin
  induction f with h t H, simp [poly.smul,poly.eval,mul_zero],
  unfold poly.smul poly.eval,
  rw H,
  simp [mul_add,znum.cast_mul,mul_assoc,mul_comm]
end

@[simp] theorem poly.eval_mul {α} [comm_ring α] (X : α) : ∀ p₁ p₂ : poly,
  (p₁.mul p₂).eval X = p₁.eval X * p₂.eval X :=
begin
  intro p₁,induction p₁ with h₁ t₁ H,
    simp [poly.mul],
  intro p₂,
  unfold poly.mul,
  rw poly.eval_add,
  unfold poly.eval,
  rw [H p₂,znum.cast_zero,zero_add,add_mul,poly.eval_smul,mul_assoc]
end

@[simp] theorem poly.eval_const {α} [comm_ring α] (X : α) : ∀ n : znum,
  (poly.const n).eval X = n :=
begin
  intro n,
  unfold poly.const poly.eval,simp
end

@[simp] theorem poly.eval_X {α} [comm_ring α] (X : α) : poly.X.eval X = X :=
begin
  unfold poly.X poly.eval,simp
end

-- Different list representing the same polynomials evaluate to the same thing
theorem poly.eval_is_eq {α} [comm_ring α] (X : α) {p₁ p₂ : poly} :
  poly.is_eq p₁ p₂ → p₁.eval X = p₂.eval X :=
begin
  revert p₂,
  induction p₁ with h₁ t₁ H₁,
  { intros p₂ H,
    induction p₂ with h₁ t₁ H₂,refl,
    unfold poly.eval,
    unfold poly.is_eq poly.is_eq_aux at H,
    split_ifs at H,swap,cases H,
    rw [h,←H₂ H],
    simp,
  },
  { intros p₂ H,
    induction p₂ with h₂ t₂ H₂,
    { unfold poly.eval,
      unfold poly.is_eq poly.is_eq_aux at H,
      split_ifs at H,swap,cases H,
      rw [h,H₁ H],
      simp
    },
    { unfold poly.eval,
      unfold poly.is_eq poly.is_eq_aux at H,
      split_ifs at H,swap,cases H,
      unfold poly.is_eq at H₂,
      rw [h,H₁ H]
    }
  }

end

-- That's the end of the poly interface. We now prepare for the reflection.

-- First an abstract version of polynomials (where equality is harder to test, and we won't
-- need to test it). We'll construct a term of this type from (x+1)*(x+1)*(x+1)

-- fancy attribute because we will be using reflection in meta-land
@[derive has_reflect]
inductive ring_expr : Type
| add : ring_expr → ring_expr → ring_expr
| mul : ring_expr → ring_expr → ring_expr
| const : znum → ring_expr
| X : ring_expr

-- turning the abstract poly into a concrete list of coefficients.
def to_poly : ring_expr → poly
| (ring_expr.add e₁ e₂) := (to_poly e₁).add (to_poly e₂)
| (ring_expr.mul e₁ e₂) := (to_poly e₁).mul (to_poly e₂)
| (ring_expr.const z) := poly.const z
| ring_expr.X := poly.X

-- evaluating the abstract poly
def ring_expr.eval {α} [comm_ring α] (X : α) : ring_expr → α
| (ring_expr.add e₁ e₂) := e₁.eval + e₂.eval
| (ring_expr.mul e₁ e₂) := e₁.eval * e₂.eval
| (ring_expr.const z) := z
| ring_expr.X := X

-- evaluating the abstract and the concrete polynomial gives the same answer
theorem to_poly_eval {α} [comm_ring α] (X : α) (e) : (to_poly e).eval X = e.eval X :=
by induction e; simp [to_poly, ring_expr.eval, *]

-- The big theorem! If the concrete polys are equal then the abstract ones evaluate
-- to the same value.
theorem main_thm {α} [comm_ring α] (X : α) (e₁ e₂) {x₁ x₂}
  (H : poly.is_eq (to_poly e₁) (to_poly e₂)) (R1 : e₁.eval X = x₁) (R2 : e₂.eval X = x₂) : x₁ = x₂ :=
by rw [← R1, ← R2, ← to_poly_eval,poly.eval_is_eq X H, to_poly_eval]

-- Now a "reflection" of this abstract type which the VM can play with.
meta def reflect_expr (X : expr) : expr → option ring_expr
| `(%%e₁ + %%e₂) := do
  p₁ ← reflect_expr e₁,
  p₂ ← reflect_expr e₂,
  return (ring_expr.add p₁ p₂)
| `(%%e₁ * %%e₂) := do
  p₁ ← reflect_expr e₁,
  p₂ ← reflect_expr e₂,
  return (ring_expr.mul p₁ p₂)
| e := if e = X then return ring_expr.X else
  do n ← expr.to_int e,
     return (ring_expr.const (znum.of_int' n))

-- Now here's the tactic! It takes as input the unknown but concrete variable x
-- and an expression f(x)=g(x),
-- creates abstract polys f(X) and g(X), proves they're equal using rfl,
-- and then applies the main theorem to deduce f(x)=g(x).

meta def ring_tac (X : pexpr) : tactic unit := do
  X ← to_expr X,
  `(%%x₁ = %%x₂) ← target,
  r₁ ← reflect_expr X x₁,
  r₂ ← reflect_expr X x₂,
  let e₁ : expr := reflect r₁,
  let e₂ : expr := reflect r₂,
  `[refine main_thm %%X %%e₁ %%e₂ rfl _ _],
  all_goals `[simp only [ring_expr.eval,
    znum.cast_pos, znum.cast_neg, znum.cast_zero',
    pos_num.cast_bit0, pos_num.cast_bit1,
    pos_num.cast_one']]

example (x : ℤ) : (x + 1) * (x + 1) = x*x+2*x+1 := by do ring_tac ```(x)

example (x : ℤ) : (x + 1) * (x + 1) * (x + 1) = x*x*x+3*x*x+3*x+1 := by do ring_tac ```(x)

example (x : ℤ) : (x + 1) + ((-1)*x + 1) = 2 := by do ring_tac ```(x)

end ring_tac


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

! This file was ported from Lean 3 source module order.pfilter
! leanprover-community/mathlib commit 740acc0e6f9adf4423f92a485d0456fc271482da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Ideal

/-!
# Order filters

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections
require more structure, such as a bottom element, a top element, or
a join-semilattice structure.

- `Order.PFilter P`: The type of nonempty, downward directed, upward closed
               subsets of `P`. This is dual to `Order.Ideal`, so it
               simply wraps `Order.Ideal Pᵒᵈ`.
- `Order.IsPFilter P`: a predicate for when a `Set P` is a filter.

Note the relation between `Order/Filter` and `Order/PFilter`: for any
type `α`, `Filter α` represents the same mathematical object as
`PFilter (Set α)`.

## References

- <https://en.wikipedia.org/wiki/Filter_(mathematics)>

## Tags

pfilter, filter, ideal, dual

-/

open OrderDual

namespace Order

variable {P : Type _}

/-- A filter on a preorder `P` is a subset of `P` that is
  - nonempty
  - downward directed
  - upward closed. -/
structure PFilter (P) [Preorder P] where
  dual : Ideal Pᵒᵈ
#align order.pfilter Order.PFilter

/-- A predicate for when a subset of `P` is a filter. -/
def IsPFilter [Preorder P] (F : Set P) : Prop :=
  IsIdeal (OrderDual.ofDual ⁻¹' F)
#align order.is_pfilter Order.IsPFilter

theorem IsPFilter.of_def [Preorder P] {F : Set P} (nonempty : F.Nonempty)
    (directed : DirectedOn (· ≥ ·) F) (mem_of_le : ∀ {x y : P}, x ≤ y → x ∈ F → y ∈ F) :
    IsPFilter F :=
  ⟨fun _ _ _ _ => mem_of_le ‹_› ‹_›, nonempty, directed⟩
#align order.is_pfilter.of_def Order.IsPFilter.of_def

/-- Create an element of type `Order.PFilter` from a set satisfying the predicate
`Order.IsPFilter`. -/
def IsPFilter.toPFilter [Preorder P] {F : Set P} (h : IsPFilter F) : PFilter P :=
  ⟨h.toIdeal⟩
#align order.is_pfilter.to_pfilter Order.IsPFilter.toPFilter

namespace PFilter

section Preorder

variable [Preorder P] {x y : P} (F s t : PFilter P)

instance [Inhabited P] : Inhabited (PFilter P) := ⟨⟨default⟩⟩

/-- A filter on `P` is a subset of `P`. -/
instance : SetLike (PFilter P) P where
  coe F := toDual ⁻¹' F.dual.carrier
  coe_injective' := fun ⟨_⟩ ⟨_⟩ h => congr_arg mk <| Ideal.ext h

#align order.pfilter.mem_coe SetLike.mem_coeₓ

theorem isPFilter : IsPFilter (F : Set P) := F.dual.isIdeal
#align order.pfilter.is_pfilter Order.PFilter.isPFilter

protected theorem nonempty : (F : Set P).Nonempty := F.dual.nonempty
#align order.pfilter.nonempty Order.PFilter.nonempty

theorem directed : DirectedOn (· ≥ ·) (F : Set P) := F.dual.directed
#align order.pfilter.directed Order.PFilter.directed

theorem mem_of_le {F : PFilter P} : x ≤ y → x ∈ F → y ∈ F := fun h => F.dual.lower h
#align order.pfilter.mem_of_le Order.PFilter.mem_of_le

/-- Two filters are equal when their underlying sets are equal. -/
@[ext]
theorem ext (h : (s : Set P) = t) : s = t := SetLike.ext' h
#align order.pfilter.ext Order.PFilter.ext

@[trans]
theorem mem_of_mem_of_le {F G : PFilter P} (hx : x ∈ F) (hle : F ≤ G) : x ∈ G :=
  hle hx
#align order.pfilter.mem_of_mem_of_le Order.PFilter.mem_of_mem_of_le

/-- The smallest filter containing a given element. -/
def principal (p : P) : PFilter P :=
  ⟨Ideal.principal (toDual p)⟩
#align order.pfilter.principal Order.PFilter.principal

@[simp]
theorem mem_mk (x : P) (I : Ideal Pᵒᵈ) : x ∈ (⟨I⟩ : PFilter P) ↔ toDual x ∈ I :=
  Iff.rfl
#align order.pfilter.mem_def Order.PFilter.mem_mk

@[simp]
theorem principal_le_iff {F : PFilter P} : principal x ≤ F ↔ x ∈ F :=
  Ideal.principal_le_iff (x := toDual x)
#align order.pfilter.principal_le_iff Order.PFilter.principal_le_iff

@[simp] theorem mem_principal : x ∈ principal y ↔ y ≤ x := Iff.rfl
#align order.pfilter.mem_principal Order.PFilter.mem_principal

theorem principal_le_principal_iff {p q : P} : principal q ≤ principal p ↔ p ≤ q := by simp
#align order.pfilter.principal_le_principal_iff Order.PFilter.principal_le_principal_iff

-- defeq abuse
theorem antitone_principal : Antitone (principal : P → PFilter P) := fun _ _ =>
  principal_le_principal_iff.2
#align order.pfilter.antitone_principal Order.PFilter.antitone_principal

end Preorder

section OrderTop

variable [Preorder P] [OrderTop P] {F : PFilter P}

/-- A specific witness of `pfilter.nonempty` when `P` has a top element. -/
@[simp] theorem top_mem : ⊤ ∈ F := Ideal.bot_mem _
#align order.pfilter.top_mem Order.PFilter.top_mem

/-- There is a bottom filter when `P` has a top element. -/
instance : OrderBot (PFilter P) where
  bot := ⟨⊥⟩
  bot_le F := (bot_le : ⊥ ≤ F.dual)

end OrderTop

/-- There is a top filter when `P` has a bottom element. -/
instance {P} [Preorder P] [OrderBot P] : OrderTop (PFilter P) where
  top := ⟨⊤⟩
  le_top F := (le_top : F.dual ≤ ⊤)

section SemilatticeInf

variable [SemilatticeInf P] {x y : P} {F : PFilter P}

/-- A specific witness of `pfilter.directed` when `P` has meets. -/
theorem inf_mem (hx : x ∈ F) (hy : y ∈ F) : x ⊓ y ∈ F :=
  Ideal.sup_mem hx hy
#align order.pfilter.inf_mem Order.PFilter.inf_mem

@[simp]
theorem inf_mem_iff : x ⊓ y ∈ F ↔ x ∈ F ∧ y ∈ F :=
  Ideal.sup_mem_iff
#align order.pfilter.inf_mem_iff Order.PFilter.inf_mem_iff

end SemilatticeInf

section CompleteSemilatticeInf

variable [CompleteSemilatticeInf P] {F : PFilter P}

theorem infₛ_gc :
    GaloisConnection (fun x => toDual (principal x)) fun F => infₛ (ofDual F : PFilter P) :=
  fun x F => by
  simp
  rfl
#align order.pfilter.Inf_gc Order.PFilter.infₛ_gc

/-- If a poset `P` admits arbitrary `Inf`s, then `principal` and `Inf` form a Galois coinsertion. -/
def infGi :
    GaloisCoinsertion (fun x => toDual (principal x)) fun F => infₛ (ofDual F : PFilter P) :=
  infₛ_gc.toGaloisCoinsertion fun _ => infₛ_le <| mem_principal.2 le_rfl
#align order.pfilter.Inf_gi Order.PFilter.infGi

end CompleteSemilatticeInf

end PFilter

end Order


import algebra.ring

namespace my_ring

variables {R : Type*} [ring R]

#check add_zero
#check mul_add
#check add_left_cancel

-- BEGIN

theorem mul_zero (a : R) : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
    { rw [←mul_add, add_zero, add_zero] },
  rw add_left_cancel h,
end
-- END

#check mul_zero

end my_ring


import game.world3.level5 -- hide
import mynat.mul -- hide
namespace mynat -- hide

/-
# Multiplication World

## Level 6: `succ_mul`

We now begin our journey to `mul_comm`, the proof that `a * b = b * a`.
We'll get there in level 8. Until we're there, it is frustrating
but true that we cannot assume commutativity. We have `mul_succ`
but we're going to need `succ_mul` (guess what it says -- maybe you
are getting the hang of Lean's naming conventions).

Remember also that we have tools like

* `add_right_comm a b c : a + b + c = a + c + b`

These things are the tools we need to slowly build up the results
which we will need to do mathematics "normally".
We also now have access to Lean's `simp` tactic,
which will solve any goal which just needs a bunch
of rewrites of `add_assoc` and `add_comm`. Use if
you're getting lazy!
-/

/- Lemma
For all natural numbers $a$ and $b$, we have
$$ \operatorname{succ}(a) \times b = ab + b. $$
-/
lemma succ_mul (a b : mynat) : succ a * b = a * b + b :=
begin [nat_num_game]
  induction b with d hd,
  {
    rw mul_zero,
    rw mul_zero,
    rw add_zero,
    refl,
  },
  {
    rw mul_succ,
    rw mul_succ,
    rw hd,
    rw add_succ,
    rw add_succ,
    rw add_right_comm,
    refl,
  }
end

end mynat -- hide


-- ∀x A(x) -> (∀x B(x) -> ∀y(A(y) ∧ B(y)))

variable U: Type
variables A B: U -> Prop

example : (∀ x, A x) -> (∀ x, B x) -> (∀ x, A x ∧ B x) :=
assume hA:  ∀ x, A x,
assume hB:  ∀ x, B x,
assume y,
have pAy: A y, from hA y,
have pBy: B y, from hB y,
show A y ∧ B y, from and.intro pAy pBy


theorem inv_inv
  {G: Type}
  (inv: G → G)
  (mul: G → G → G)
  (one: G)
  (assocMul: forall (a b c: G), mul a (mul b c) = (mul (mul a b) c))
  (invLeft: forall (a: G), mul (inv a) a = one)
  (mulOne: forall (a: G), mul a one = a)
  (oneMul: forall (a: G), mul one a = a)
  (invRight: forall (a: G), mul a (inv a) = one)
  (x: G)
  : (inv (inv x) = x) := by
  simp [assocMul, invLeft, mulOne, oneMul, invRight]

theorem inv_mul_cancel_left
  {G: Type}
  (inv: G → G)
  (mul: G → G → G)
  (one: G)
  (assocMul: forall (a b c: G), mul a (mul b c) = (mul (mul a b) c))
  (invLeft: forall (a: G), mul (inv a) a = one)
  (mulOne: forall (a: G), mul a one = a)
  (oneMul: forall (a: G), mul one a = a)
  (invRight: forall (a: G), mul a (inv a) = one)
  (x y : G)
  : (mul (inv x) (mul x y)) = y := by
  simp [assocMul, invLeft, mulOne, oneMul, invRight]

theorem mul_inv_cancel_left
  {G: Type}
  (inv: G → G)
  (mul: G → G → G)
  (one: G)
  (assocMul: forall (a b c: G), mul a (mul b c) = (mul (mul a b) c))
  (invLeft: forall (a: G), mul (inv a) a = one)
  (mulOne: forall (a: G), mul a one = a)
  (oneMul: forall (a: G), mul one a = a)
  (invRight: forall (a: G), mul a (inv a) = one)
  (x y : G)
  : (mul x (mul (inv x) y)) = y := by
  simp [assocMul, invLeft, mulOne, oneMul, invRight]

theorem inv_mul
  {G: Type}
  (inv: G → G)
  (mul: G → G → G)
  (one: G)
  (assocMul: forall (a b c: G), mul a (mul b c) = (mul (mul a b) c))
  (invLeft: forall (a: G), mul (inv a) a = one)
  (mulOne: forall (a: G), mul a one = a)
  (oneMul: forall (a: G), mul one a = a)
  (invRight: forall (a: G), mul a (inv a) = one)
  (x y : G)
  : (inv (mul x y)) = (mul (inv y) (inv x)) := by
  simp [assocMul, invLeft, mulOne, oneMul, invRight]

theorem one_inv
  {G: Type}
  (inv: G → G)
  (mul: G → G → G)
  (one: G)
  (assocMul: forall (a b c: G), mul a (mul b c) = (mul (mul a b) c))
  (invLeft: forall (a: G), mul (inv a) a = one)
  (mulOne: forall (a: G), mul a one = a)
  (oneMul: forall (a: G), mul one a = a)
  (invRight: forall (a: G), mul a (inv a) = one)
  (x y : G)
  : (inv one) = one := by
  simp [assocMul, invLeft, mulOne, oneMul, invRight]


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yaël Dillies
-/
import data.nat.pow
import tactic.by_contra

/-!
# Natural number logarithms

This file defines two `ℕ`-valued analogs of the logarithm of `n` with base `b`:
* `log b n`: Lower logarithm, or floor **log**. Greatest `k` such that `b^k ≤ n`.
* `clog b n`: Upper logarithm, or **c**eil **log**. Least `k` such that `n ≤ b^k`.

These are interesting because, for `1 < b`, `nat.log b` and `nat.clog b` are respectively right and
left adjoints of `nat.pow b`. See `pow_le_iff_le_log` and `le_pow_iff_clog_le`.
-/

namespace nat

/-! ### Floor logarithm -/

/-- `log b n`, is the logarithm of natural number `n` in base `b`. It returns the largest `k : ℕ`
such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def log (b : ℕ) : ℕ → ℕ
| n :=
  if h : b ≤ n ∧ 1 < b then
    have n / b < n,
      from div_lt_self ((zero_lt_one.trans h.2).trans_le h.1) h.2,
    log (n / b) + 1
  else 0

private lemma log_eq_zero_aux {b n : ℕ} (hnb : n < b ∨ b ≤ 1) : log b n = 0 :=
begin
  rw [or_iff_not_and_not, not_lt, not_le] at hnb,
  rw [log, ←ite_not, if_pos hnb]
end

lemma log_of_lt {b n : ℕ} (hb : n < b) : log b n = 0 :=
log_eq_zero_aux (or.inl hb)

lemma log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n) : log b n = 0 :=
log_eq_zero_aux (or.inr hb)

lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
by { rw log, exact if_pos ⟨hn, h⟩ }

lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
⟨λ h_log, begin
  by_contra' h,
  have := log_of_one_lt_of_le h.2 h.1,
  rw h_log at this,
  exact succ_ne_zero _ this.symm
end, log_eq_zero_aux⟩

lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
-- This is best possible: if b = 2, n = 5, then 1 < b and b ≤ n but n > b * b.
begin
  refine ⟨λ h_log, _, _⟩,
  { have bound : 1 < b ∧ b ≤ n,
    { contrapose h_log,
      rw [not_and_distrib, not_lt, not_le, or_comm, ←log_eq_zero_iff] at h_log,
      rw h_log,
      exact nat.zero_ne_one, },
    cases bound with one_lt_b b_le_n,
    refine ⟨_, one_lt_b, b_le_n⟩,
    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
        log_eq_zero_iff, nat.div_lt_iff_lt_mul (lt_trans zero_lt_one one_lt_b)] at h_log,
    exact h_log.resolve_right (λ b_small, lt_irrefl _ (lt_of_lt_of_le one_lt_b b_small)), },
  { rintros ⟨h, one_lt_b, b_le_n⟩,
    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
        log_eq_zero_iff, nat.div_lt_iff_lt_mul (lt_trans zero_lt_one one_lt_b)],
    exact or.inl h, },
end

@[simp] lemma log_zero_left : ∀ n, log 0 n = 0 :=
log_of_left_le_one zero_le_one

@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 :=
by { rw log, cases b; refl }

@[simp] lemma log_one_left : ∀ n, log 1 n = 0 :=
log_of_left_le_one le_rfl

@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 :=
if h : b ≤ 1 then
  log_of_left_le_one h 1
else
  log_of_lt (not_le.mp h)

/-- `pow b` and `log b` (almost) form a Galois connection. -/
lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) : b ^ x ≤ y ↔ x ≤ log b y :=
begin
  induction y using nat.strong_induction_on with y ih generalizing x,
  cases x,
  { exact iff_of_true hy (zero_le _) },
  rw log, split_ifs,
  { have b_pos : 0 < b := zero_le_one.trans_lt hb,
    rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy hb)
      (nat.div_pos h.1 b_pos), le_div_iff_mul_le b_pos, pow_succ'] },
  { refine iff_of_false (λ hby, h ⟨le_trans _ hby, hb⟩) (not_succ_le_zero _),
    convert pow_mono hb.le (zero_lt_succ x),
    exact (pow_one b).symm }
end

lemma lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) : y < b ^ x ↔ log b y < x :=
lt_iff_lt_of_le_iff_le (pow_le_iff_le_log hb hy)

lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
eq_of_forall_le_iff $ λ z,
by { rw ←pow_le_iff_le_log hb (pow_pos (zero_lt_one.trans hb) _),
    exact (pow_right_strict_mono hb).le_iff_le }

lemma log_pos {b n : ℕ} (hb : 1 < b) (hn : b ≤ n) : 0 < log b n :=
by { rwa [←succ_le_iff, ←pow_le_iff_le_log hb (hb.le.trans hn), pow_one] }

lemma log_mul_base (b n : ℕ) (hb : 1 < b) (hn : 0 < n) : log b (n * b) = log b n + 1 :=
eq_of_forall_le_iff $ λ z,
begin
  cases z,
  { simp },
  have : 0 < b := zero_lt_one.trans hb,
  rw [←pow_le_iff_le_log hb, pow_succ', (strict_mono_mul_right_of_pos this).le_iff_le,
      pow_le_iff_le_log hb hn, nat.succ_le_succ_iff],
  simp [hn, this]
end

lemma lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) (x : ℕ) :
  x < b ^ (log b x).succ :=
begin
  cases x.eq_zero_or_pos with hx hx,
  { simp only [hx, log_zero_right, pow_one],
    exact pos_of_gt hb },
  rw [←not_le, pow_le_iff_le_log hb hx, not_le],
  exact lt_succ_self _,
end

lemma pow_log_le_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) : b ^ log b x ≤ x :=
(pow_le_iff_le_log hb hx).2 le_rfl

@[mono] lemma log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw log_of_left_le_one hb, exact zero_le _ },
  { cases nat.eq_zero_or_pos n with hn hn,
    { rw [hn, log_zero_right], exact zero_le _ },
    { rw ←pow_le_iff_le_log hb (hn.trans_le h),
      exact (pow_log_le_self hb hn).trans h } }
end

@[mono] lemma log_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n :=
begin
  cases n, { rw [log_zero_right, log_zero_right] },
  rw ←pow_le_iff_le_log hc (zero_lt_succ n),
  calc c ^ log b n.succ ≤ b ^ log b n.succ : pow_le_pow_of_le_left
                                              (zero_lt_one.trans hc).le hb _
                    ... ≤ n.succ           : pow_log_le_self (hc.trans_le hb)
                                              (zero_lt_succ n)
end

lemma log_monotone {b : ℕ} : monotone (log b) :=
λ x y, log_mono_right

lemma log_antitone_left {n : ℕ} : antitone_on (λ b, log b n) (set.Ioi 1) :=
λ _ hc _ _ hb, log_anti_left (set.mem_Iio.1 hc) hb

@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n :=
eq_of_forall_le_iff (λ z, ⟨λ h, h.trans (log_monotone (div_mul_le_self _ _)), λ h, begin
  rcases b with _|_|b,
  { rwa log_zero_left at * },
  { rwa log_one_left at * },
  rcases n.zero_le.eq_or_lt with rfl|hn,
  { rwa [nat.zero_div, zero_mul] },
  cases le_or_lt b.succ.succ n with hb hb,
  { cases z,
    { apply zero_le },
    rw [←pow_le_iff_le_log, pow_succ'] at h ⊢,
    { rwa [(strict_mono_mul_right_of_pos nat.succ_pos').le_iff_le,
            nat.le_div_iff_mul_le nat.succ_pos'] },
    all_goals { simp [hn, nat.div_pos hb nat.succ_pos'] } },
  { simpa [div_eq_of_lt, hb, log_of_lt] using h }
end⟩)

@[simp] lemma log_div_base (b n : ℕ) : log b (n / b) = log b n - 1 :=
begin
  cases lt_or_le n b with h h,
  { rw [div_eq_of_lt h, log_of_lt h, log_zero_right] },
  rcases n.zero_le.eq_or_lt with rfl|hn,
  { rw [nat.zero_div, log_zero_right] },
  rcases b with _|_|b,
  { rw [log_zero_left, log_zero_left] },
  { rw [log_one_left, log_one_left] },
  rw [←succ_inj', ←succ_inj'],
  simp_rw succ_eq_add_one,
  rw [nat.sub_add_cancel, ←log_mul_base];
  { simp [succ_le_iff, log_pos, h, nat.div_pos] },
end

private lemma add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1) / b < n :=
begin
  rw [div_lt_iff_lt_mul (zero_lt_one.trans hb), ←succ_le_iff, ←pred_eq_sub_one,
    succ_pred_eq_of_pos (add_pos (zero_lt_one.trans hn) (zero_lt_one.trans hb))],
  exact add_le_mul hn hb,
end

/-! ### Ceil logarithm -/

/-- `clog b n`, is the upper logarithm of natural number `n` in base `b`. It returns the smallest
`k : ℕ` such that `n ≤ b^k`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def clog (b : ℕ) : ℕ → ℕ
| n :=
  if h : 1 < b ∧ 1 < n then
    have (n + b - 1)/b < n := add_pred_div_lt h.1 h.2,
    clog ((n + b - 1)/b) + 1
  else 0

lemma clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.1.not_le hb)]

lemma clog_of_right_le_one {n : ℕ} (hn : n ≤ 1) (b : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.2.not_le hn)]

@[simp] lemma clog_zero_left (n : ℕ) : clog 0 n = 0 :=
clog_of_left_le_one zero_le_one _

@[simp] lemma clog_zero_right (b : ℕ) : clog b 0 = 0 :=
clog_of_right_le_one zero_le_one _

@[simp] lemma clog_one_left (n : ℕ) : clog 1 n = 0 :=
clog_of_left_le_one le_rfl _

@[simp] lemma clog_one_right (b : ℕ) : clog b 1 = 0 :=
clog_of_right_le_one le_rfl _

lemma clog_of_two_le {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) :
  clog b n = clog b ((n + b - 1)/b) + 1 :=
by rw [clog, if_pos (⟨hb, hn⟩ : 1 < b ∧ 1 < n)]

lemma clog_pos {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : 0 < clog b n :=
by { rw clog_of_two_le hb hn, exact zero_lt_succ _ }

lemma clog_eq_one {b n : ℕ} (hn : 2 ≤ n) (h : n ≤ b) : clog b n = 1 :=
begin
  rw [clog_of_two_le (hn.trans h) hn, clog_of_right_le_one],
  have n_pos : 0 < n := zero_lt_two.trans_le hn,
  rw [←lt_succ_iff, nat.div_lt_iff_lt_mul (n_pos.trans_le h), ←succ_le_iff,
    ←pred_eq_sub_one, succ_pred_eq_of_pos (add_pos n_pos (n_pos.trans_le h)), succ_mul, one_mul],
  exact add_le_add_right h _,
end

/--`clog b` and `pow b` form a Galois connection. -/
lemma le_pow_iff_clog_le {b : ℕ} (hb : 1 < b) {x y : ℕ} : x ≤ b ^ y ↔ clog b x ≤ y :=
begin
  induction x using nat.strong_induction_on with x ih generalizing y,
  cases y,
  { rw [pow_zero],
    refine ⟨λ h, (clog_of_right_le_one h b).le, _⟩,
    simp_rw ←not_lt,
    contrapose!,
    exact clog_pos hb },
  have b_pos : 0 < b := zero_lt_two.trans_le hb,
  rw clog, split_ifs,
  { rw [succ_eq_add_one, add_le_add_iff_right, ←ih ((x + b - 1)/b) (add_pred_div_lt hb h.2),
      nat.div_le_iff_le_mul_add_pred b_pos,
      ← pow_succ, add_tsub_assoc_of_le (nat.succ_le_of_lt b_pos), add_le_add_iff_right] },
  { exact iff_of_true ((not_lt.1 (not_and.1 h hb)).trans $ succ_le_of_lt $ pow_pos b_pos _)
    (zero_le _) }
end

lemma pow_lt_iff_lt_clog {b : ℕ} (hb : 1 < b) {x y : ℕ} : b ^ y < x ↔ y < clog b x :=
lt_iff_lt_of_le_iff_le (le_pow_iff_clog_le hb)

lemma clog_pow (b x : ℕ) (hb : 1 < b) : clog b (b ^ x) = x :=
eq_of_forall_ge_iff $ λ z,
by { rw ←le_pow_iff_clog_le hb, exact (pow_right_strict_mono hb).le_iff_le }

lemma pow_pred_clog_lt_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 1 < x) :
  b ^ (clog b x).pred < x :=
begin
  rw [←not_le, le_pow_iff_clog_le hb, not_le],
  exact pred_lt (clog_pos hb hx).ne',
end

lemma le_pow_clog {b : ℕ} (hb : 1 < b) (x : ℕ) : x ≤ b ^ clog b x :=
(le_pow_iff_clog_le hb).2 le_rfl

@[mono] lemma clog_mono_right (b : ℕ) {n m : ℕ} (h : n ≤ m) : clog b n ≤ clog b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw clog_of_left_le_one hb, exact zero_le _ },
  { rw ←le_pow_iff_clog_le hb,
    exact h.trans (le_pow_clog hb _) }
end

@[mono] lemma clog_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : clog b n ≤ clog c n :=
begin
  rw ← le_pow_iff_clog_le (lt_of_lt_of_le hc hb),
  calc
    n ≤ c ^ clog c n : le_pow_clog hc _
  ... ≤ b ^ clog c n : pow_le_pow_of_le_left (zero_lt_one.trans hc).le hb _
end

lemma clog_monotone (b : ℕ) : monotone (clog b) :=
λ x y, clog_mono_right _

lemma clog_antitone_left {n : ℕ} : antitone_on (λ b : ℕ, clog b n) (set.Ioi 1) :=
λ _ hc _ _ hb, clog_anti_left (set.mem_Iio.1 hc) hb

lemma log_le_clog (b n : ℕ) : log b n ≤ clog b n :=
begin
  obtain hb | hb := le_or_lt b 1,
  { rw log_of_left_le_one hb,
    exact zero_le _},
  cases n,
  { rw log_zero_right,
    exact zero_le _},
  exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self hb $ succ_pos _).trans $
    le_pow_clog hb _),
end

end nat


/-
  Standard opens form basis.

  https://stacks.math.columbia.edu/tag/04PM
-/

import topology.basic
import to_mathlib.opens
import spectrum_of_a_ring.zariski_topology
import spectrum_of_a_ring.properties

universe u

open topological_space

local attribute [instance] classical.prop_decidable

section standard_basis

parameters (R : Type u) [comm_ring R]

@[reducible] def D_fs := {U : opens (Spec R) | ∃ f : R, U = Spec.DO R (f)}

lemma D_fs.mem : ∀ f, Spec.DO R f ∈ D_fs := λ f, ⟨f, rfl⟩

lemma D_fs_basis : opens.is_basis D_fs :=
begin
  refine topological_space.is_topological_basis_of_open_of_nhds _ _,
  { intros U HU,
    rcases HU with ⟨OU, HOU, HOUval⟩,
    rw ←HOUval,
    exact OU.2, },
  { intros x U HxU OU,
    cases OU with E HVE,
    have HDE : U = -Spec.V E := by simp [HVE],
    have HDE' := HDE,
    rw set.ext_iff at HDE,
    replace HDE := HDE x,
    rw iff_true_left HxU at HDE,
    simp [Spec.V, has_subset.subset, set.subset] at HDE,
    rw not_forall at HDE,
    cases HDE with f Hf,
    rw not_imp at Hf,
    cases Hf with HfE Hfx,
    use Spec.D' f,
    have HDfDfs : Spec.D' f ∈ subtype.val '' D_fs,
      simp,
      use [D_fs_open R f, f],
      dsimp [Spec.DO],
      refl,
    use HDfDfs,
    split,
    { exact Hfx, },
    { intros y Hy,
      rw HDE',
      intro HyE,
      simp [Spec.D'] at Hy,
      apply Hy,
      exact HyE HfE, } }
end

lemma Spec.V'.empty : Spec.V'((1 : R)) = ∅ :=
begin
  simp [Spec.V'],
  apply set.ext,
  rintros ⟨I, PI⟩,
  split,
  { intros HI,
    exfalso,
    replace HI : (1 : R) ∈ I := HI,
    apply PI.1,
    rw ideal.eq_top_iff_one,
    exact HI, },
  { intros HI,
    cases HI, }
end

lemma D_fs_standard_basis :
opens.univ ∈ D_fs ∧ ∀ {U V}, U ∈ D_fs → V ∈ D_fs → U ∩ V ∈ D_fs :=
begin
  split,
  { use 1,
    apply subtype.eq,
    simp [Spec.DO, Spec.D'],
    rw Spec.V'.empty,
    rw set.compl_empty,
    refl, },
  { intros U V HU HV,
    cases HU with fU HU,
    cases HV with fV HV,
    use [fU * fV],
    apply subtype.eq,
    rw [HU, HV],
    simp [Spec.DO],
    exact (Spec.D'.product_eq_inter _ _).symm, }
end

end standard_basis


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/

import data.polynomial.basic
import data.finset.nat_antidiagonal
import data.nat.choose.sum

/-!
# Theory of univariate polynomials

The theorems include formulas for computing coefficients, such as
`coeff_add`, `coeff_sum`, `coeff_mul`

-/

noncomputable theory

open finsupp finset add_monoid_algebra
open_locale big_operators

namespace polynomial
universes u v
variables {R : Type u} {S : Type v} {a b : R} {n m : ℕ}

variables [semiring R] {p q r : polynomial R}

section coeff

lemma coeff_one (n : ℕ) : coeff (1 : polynomial R) n = if 0 = n then 1 else 0 :=
coeff_monomial

@[simp]
lemma coeff_add (p q : polynomial R) (n : ℕ) : coeff (p + q) n = coeff p n + coeff q n :=
by { rcases p, rcases q, simp [coeff, add_to_finsupp] }

@[simp] lemma coeff_smul [monoid S] [distrib_mul_action S R] (r : S) (p : polynomial R) (n : ℕ) :
  coeff (r • p) n = r • coeff p n :=
by { rcases p, simp [coeff, smul_to_finsupp] }

lemma support_smul [monoid S] [distrib_mul_action S R] (r : S) (p : polynomial R) :
  support (r • p) ⊆ support p :=
begin
  assume i hi,
  simp [mem_support_iff] at hi ⊢,
  contrapose! hi,
  simp [hi]
end

/-- `polynomial.sum` as a linear map. -/
@[simps] def lsum {R A M : Type*} [semiring R] [semiring A] [add_comm_monoid M]
  [module R A] [module R M] (f : ℕ → A →ₗ[R] M) :
  polynomial A →ₗ[R] M :=
{ to_fun := λ p, p.sum (λ n r, f n r),
  map_add' := λ p q, sum_add_index p q _ (λ n, (f n).map_zero) (λ n _ _, (f n).map_add _ _),
  map_smul' := λ c p,
  begin
    rw [sum_eq_of_subset _ (λ n r, f n r) (λ n, (f n).map_zero) _ (support_smul c p)],
    simp only [sum_def, finset.smul_sum, coeff_smul, linear_map.map_smul, ring_hom.id_apply]
  end }

variable (R)
/-- The nth coefficient, as a linear map. -/
def lcoeff (n : ℕ) : polynomial R →ₗ[R] R :=
{ to_fun := λ p, coeff p n,
  map_add' := λ p q, coeff_add p q n,
  map_smul' := λ r p, coeff_smul r p n }

variable {R}

@[simp] lemma lcoeff_apply (n : ℕ) (f : polynomial R) : lcoeff R n f = coeff f n := rfl

@[simp] lemma finset_sum_coeff {ι : Type*} (s : finset ι) (f : ι → polynomial R) (n : ℕ) :
  coeff (∑ b in s, f b) n = ∑ b in s, coeff (f b) n :=
(lcoeff R n).map_sum

lemma coeff_sum [semiring S] (n : ℕ) (f : ℕ → R → polynomial S) :
  coeff (p.sum f) n = p.sum (λ a b, coeff (f a b) n) :=
by { rcases p, simp [polynomial.sum, support, coeff] }

/-- Decomposes the coefficient of the product `p * q` as a sum
over `nat.antidiagonal`. A version which sums over `range (n + 1)` can be obtained
by using `finset.nat.sum_antidiagonal_eq_sum_range_succ`. -/
lemma coeff_mul (p q : polynomial R) (n : ℕ) :
  coeff (p * q) n = ∑ x in nat.antidiagonal n, coeff p x.1 * coeff q x.2 :=
begin
  rcases p, rcases q,
  simp only [coeff, mul_to_finsupp],
  exact add_monoid_algebra.mul_apply_antidiagonal p q n _ (λ x, nat.mem_antidiagonal)
end

@[simp] lemma mul_coeff_zero (p q : polynomial R) : coeff (p * q) 0 = coeff p 0 * coeff q 0 :=
by simp [coeff_mul]

lemma coeff_mul_X_zero (p : polynomial R) : coeff (p * X) 0 = 0 :=
by simp

lemma coeff_X_mul_zero (p : polynomial R) : coeff (X * p) 0 = 0 :=
by simp

lemma coeff_C_mul_X (x : R) (k n : ℕ) :
  coeff (C x * X^k : polynomial R) n = if n = k then x else 0 :=
by { rw [← monomial_eq_C_mul_X, coeff_monomial], congr' 1, simp [eq_comm] }

@[simp] lemma coeff_C_mul (p : polynomial R) : coeff (C a * p) n = a * coeff p n :=
by { rcases p, simp only [C, monomial, monomial_fun, mul_to_finsupp, ring_hom.coe_mk,
  coeff, add_monoid_algebra.single_zero_mul_apply p a n] }

lemma C_mul' (a : R) (f : polynomial R) : C a * f = a • f :=
by { ext, rw [coeff_C_mul, coeff_smul, smul_eq_mul] }

@[simp] lemma coeff_mul_C (p : polynomial R) (n : ℕ) (a : R) :
  coeff (p * C a) n = coeff p n * a :=
by { rcases p, simp only [C, monomial, monomial_fun, mul_to_finsupp, ring_hom.coe_mk,
  coeff, add_monoid_algebra.mul_single_zero_apply p a n] }

lemma coeff_X_pow (k n : ℕ) :
  coeff (X^k : polynomial R) n = if n = k then 1 else 0 :=
by simp only [one_mul, ring_hom.map_one, ← coeff_C_mul_X]

@[simp]
lemma coeff_X_pow_self (n : ℕ) :
  coeff (X^n : polynomial R) n = 1 :=
by simp [coeff_X_pow]

theorem coeff_mul_X_pow (p : polynomial R) (n d : ℕ) :
  coeff (p * polynomial.X ^ n) (d + n) = coeff p d :=
begin
  rw [coeff_mul, sum_eq_single (d,n), coeff_X_pow, if_pos rfl, mul_one],
  { rintros ⟨i,j⟩ h1 h2, rw [coeff_X_pow, if_neg, mul_zero], rintro rfl, apply h2,
    rw [nat.mem_antidiagonal, add_right_cancel_iff] at h1, subst h1 },
  { exact λ h1, (h1 (nat.mem_antidiagonal.2 rfl)).elim }
end

lemma coeff_mul_X_pow' (p : polynomial R) (n d : ℕ) :
  (p * X ^ n).coeff d = ite (n ≤ d) (p.coeff (d - n)) 0 :=
begin
  split_ifs,
  { rw [← tsub_add_cancel_of_le h, coeff_mul_X_pow, add_tsub_cancel_right] },
  { refine (coeff_mul _ _ _).trans (finset.sum_eq_zero (λ x hx, _)),
    rw [coeff_X_pow, if_neg, mul_zero],
    exact ne_of_lt (lt_of_le_of_lt (nat.le_of_add_le_right
      (le_of_eq (finset.nat.mem_antidiagonal.mp hx))) (not_le.mp h)) },
end

@[simp] theorem coeff_mul_X (p : polynomial R) (n : ℕ) :
  coeff (p * X) (n + 1) = coeff p n :=
by simpa only [pow_one] using coeff_mul_X_pow p 1 n

theorem mul_X_pow_eq_zero {p : polynomial R} {n : ℕ}
  (H : p * X ^ n = 0) : p = 0 :=
ext $ λ k, (coeff_mul_X_pow p n k).symm.trans $ ext_iff.1 H (k+n)

lemma C_mul_X_pow_eq_monomial (c : R) (n : ℕ) : C c * X^n = monomial n c :=
by { ext1, rw [monomial_eq_smul_X, coeff_smul, coeff_C_mul, smul_eq_mul] }

lemma support_mul_X_pow (c : R) (n : ℕ) (H : c ≠ 0) : (C c * X^n).support = singleton n :=
by rw [C_mul_X_pow_eq_monomial, support_monomial n c H]

lemma support_C_mul_X_pow' {c : R} {n : ℕ} : (C c * X^n).support ⊆ singleton n :=
by { rw [C_mul_X_pow_eq_monomial], exact support_monomial' n c }

lemma coeff_X_add_one_pow (R : Type*) [semiring R] (n k : ℕ) :
  ((X + 1) ^ n).coeff k = (n.choose k : R) :=
begin
  rw [(commute_X (1 : polynomial R)).add_pow, ← lcoeff_apply, linear_map.map_sum],
  simp only [one_pow, mul_one, lcoeff_apply, ← C_eq_nat_cast, coeff_mul_C, nat.cast_id],
  rw [finset.sum_eq_single k, coeff_X_pow_self, one_mul],
  { intros _ _,
    simp only [coeff_X_pow, boole_mul, ite_eq_right_iff, ne.def] {contextual := tt},
    rintro h rfl, contradiction },
  { simp only [coeff_X_pow_self, one_mul, not_lt, finset.mem_range],
    intro h, rw [nat.choose_eq_zero_of_lt h, nat.cast_zero], }
end

lemma coeff_one_add_X_pow (R : Type*) [semiring R] (n k : ℕ) :
  ((1 + X) ^ n).coeff k = (n.choose k : R) :=
by rw [add_comm _ X, coeff_X_add_one_pow]

lemma C_dvd_iff_dvd_coeff (r : R) (φ : polynomial R) :
  C r ∣ φ ↔ ∀ i, r ∣ φ.coeff i :=
begin
  split,
  { rintros ⟨φ, rfl⟩ c, rw coeff_C_mul, apply dvd_mul_right },
  { intro h,
    choose c hc using h,
    classical,
    let c' : ℕ → R := λ i, if i ∈ φ.support then c i else 0,
    let ψ : polynomial R := ∑ i in φ.support, monomial i (c' i),
    use ψ,
    ext i,
    simp only [ψ, c', coeff_C_mul, mem_support_iff, coeff_monomial,
               finset_sum_coeff, finset.sum_ite_eq'],
    split_ifs with hi hi,
    { rw hc },
    { rw [not_not] at hi, rwa mul_zero } },
end

lemma coeff_bit0_mul (P Q : polynomial R) (n : ℕ) :
  coeff (bit0 P * Q) n = 2 * coeff (P * Q) n :=
by simp [bit0, add_mul]

lemma smul_eq_C_mul (a : R) : a • p = C a * p := by simp [ext_iff]

lemma update_eq_add_sub_coeff {R : Type*} [ring R] (p : polynomial R) (n : ℕ) (a : R) :
  p.update n a = p + (polynomial.C (a - p.coeff n) * polynomial.X ^ n) :=
begin
  ext,
  rw [coeff_update_apply, coeff_add, coeff_C_mul_X],
  split_ifs with h;
  simp [h]
end

end coeff

section cast

@[simp] lemma nat_cast_coeff_zero {n : ℕ} {R : Type*} [semiring R] :
  (n : polynomial R).coeff 0 = n :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih], },
end

@[simp, norm_cast] theorem nat_cast_inj
  {m n : ℕ} {R : Type*} [semiring R] [char_zero R] : (↑m : polynomial R) = ↑n ↔ m = n :=
begin
  fsplit,
  { intro h,
    apply_fun (λ p, p.coeff 0) at h,
    simpa using h, },
  { rintro rfl, refl, },
end

@[simp] lemma int_cast_coeff_zero {i : ℤ} {R : Type*} [ring R] :
  (i : polynomial R).coeff 0 = i :=
by cases i; simp

@[simp, norm_cast] theorem int_cast_inj
  {m n : ℤ} {R : Type*} [ring R] [char_zero R] : (↑m : polynomial R) = ↑n ↔ m = n :=
begin
  fsplit,
  { intro h,
    apply_fun (λ p, p.coeff 0) at h,
    simpa using h, },
  { rintro rfl, refl, },
end

end cast

end polynomial


import Mathlib

/-!
# Monads and randomness
We will first recall the `Option` monad and its properties.

* If `α` is a type `Option α` is a type.
* Given `a: α` we get a term of type `Option α` by writing `some a`.
-/

example : Option ℕ := pure 42 -- `pure` is terminology from any Monad.

/-!
* Given `a: Option α` and `f : α → β` we get a term of type `Option β` by writing `a.map f`.
* Given `a: Option α` and `f: α → Option β` we get a term of type `Option β` by writing `a.bind f`.

For both these it is more pleasant to use the `do` notation.

Equivalent to the second is that there is a function `Option Option α → Option α` called `join`.
-/

#check Option.join

#check Task.spawn

/-!
## IO Monad

Roughly wraps with the state of the *real world*.

For example, a random number is wrapped in this.
-/

#check IO.rand -- IO.rand (lo hi : ℕ) : IO ℕ

/-!
**Question::** Why not just `ℕ`?

* Otherwise we will violate the principle that the value of a function is determined by its arguments.

We still do want a natural number. To get this we can `run` the `IO` computation.
-/

/-- A random natural number -/
def rnd (lo hi : ℕ) : ℕ :=
  ((IO.rand lo hi).run'
      (() : IO.RealWorld)).get!

/-!
This does not lead to a contradiction, though in a way that may be somewhat surprising.
-/

/-- A random number between 0 and 100-/
def a : ℕ := rnd 0 100
/-- A random number between 0 and 100-/
def b : ℕ := rnd 0 100

/-!
We can run these (every run gives a different result).
```lean
#eval a -- 23
#eval b -- 96
```

Interestingly, we can also run the pair of them and get a result on the diagonal.
```lean
#eval (a, b) -- (87, 87)
```
-/

#eval a -- 23
#eval b -- 96

#eval (a, b) -- (87, 87)

/-- A random pair -/
def rndPair (lo hi : ℕ) : IO <| ℕ × ℕ := do
  let a ← IO.rand lo hi
  let b ← IO.rand lo hi
  pure (a, b)

#eval rndPair 0 100 -- (47, 30)
/-!
```lean
#eval a -- 23
#eval b -- 96

#eval (a, b) -- (87, 87)
```
-/

#check IO.RealWorld

#check Unit

example : a = b := by rfl

-- #reduce a -- times out

-- example : a = 23 := by rfl -- fails

#check Option.orElse

#eval (some 3).orElse
          (fun _ ↦ some 4) -- some 3

#eval (none).orElse
          (fun _ ↦ some 4) -- some 4


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

import data.polynomial.algebra_map
import data.polynomial.hasse_deriv
import data.polynomial.degree.lemmas

/-!
# Taylor expansions of polynomials

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

## Main declarations

* `polynomial.taylor`: the Taylor expansion of the polynomial `f` at `r`
* `polynomial.taylor_coeff`: the `k`th coefficient of `taylor r f` is
  `(polynomial.hasse_deriv k f).eval r`
* `polynomial.eq_zero_of_hasse_deriv_eq_zero`:
  the identity principle: a polynomial is 0 iff all its Hasse derivatives are zero

-/

noncomputable theory

namespace polynomial
open_locale polynomial

variables {R : Type*} [semiring R] (r : R) (f : R[X])

/-- The Taylor expansion of a polynomial `f` at `r`. -/
def taylor (r : R) : R[X] →ₗ[R] R[X] :=
{ to_fun := λ f, f.comp (X + C r),
  map_add' := λ f g, add_comp,
  map_smul' := λ c f, by simp only [smul_eq_C_mul, C_mul_comp, ring_hom.id_apply] }

lemma taylor_apply : taylor r f = f.comp (X + C r) := rfl

@[simp] lemma taylor_X : taylor r X = X + C r :=
by simp only [taylor_apply, X_comp]

@[simp] lemma taylor_C (x : R) : taylor r (C x) = C x :=
by simp only [taylor_apply, C_comp]

@[simp] lemma taylor_zero' : taylor (0 : R) = linear_map.id :=
begin
  ext,
  simp only [taylor_apply, add_zero, comp_X, _root_.map_zero, linear_map.id_comp, function.comp_app,
             linear_map.coe_comp]
end

lemma taylor_zero (f : R[X]) : taylor 0 f = f :=
by rw [taylor_zero', linear_map.id_apply]

@[simp] lemma taylor_one : taylor r (1 : R[X]) = C 1 :=
by rw [← C_1, taylor_C]

@[simp] lemma taylor_monomial (i : ℕ) (k : R) : taylor r (monomial i k) = C k * (X + C r) ^ i :=
by simp [taylor_apply]

/-- The `k`th coefficient of `polynomial.taylor r f` is `(polynomial.hasse_deriv k f).eval r`. -/
lemma taylor_coeff (n : ℕ) : (taylor r f).coeff n = (hasse_deriv n f).eval r :=
show (lcoeff R n).comp (taylor r) f = (leval r).comp (hasse_deriv n) f,
begin
  congr' 1, clear f, ext i,
  simp only [leval_apply, mul_one, one_mul, eval_monomial, linear_map.comp_apply, coeff_C_mul,
    hasse_deriv_monomial, taylor_apply, monomial_comp, C_1,
    (commute_X (C r)).add_pow i, linear_map.map_sum],
  simp only [lcoeff_apply, ← C_eq_nat_cast, mul_assoc, ← C_pow, ← C_mul, coeff_mul_C,
    (nat.cast_commute _ _).eq, coeff_X_pow, boole_mul, finset.sum_ite_eq, finset.mem_range],
  split_ifs with h, { refl },
  push_neg at h, rw [nat.choose_eq_zero_of_lt h, nat.cast_zero, mul_zero],
end

@[simp] lemma taylor_coeff_zero : (taylor r f).coeff 0 = f.eval r :=
by rw [taylor_coeff, hasse_deriv_zero, linear_map.id_apply]

@[simp] lemma taylor_coeff_one : (taylor r f).coeff 1 = f.derivative.eval r :=
by rw [taylor_coeff, hasse_deriv_one]

@[simp] lemma nat_degree_taylor (p : R[X]) (r : R) :
  nat_degree (taylor r p) = nat_degree p :=
begin
  refine map_nat_degree_eq_nat_degree _ _,
  nontriviality R,
  intros n c c0,
  simp [taylor_monomial, nat_degree_C_mul_eq_of_mul_ne_zero, nat_degree_pow_X_add_C, c0]
end

@[simp] lemma taylor_mul {R} [comm_semiring R] (r : R) (p q : R[X]) :
  taylor r (p * q) = taylor r p * taylor r q :=
by simp only [taylor_apply, mul_comp]

/-- `polynomial.taylor` as a `alg_hom` for commutative semirings -/
@[simps apply] def taylor_alg_hom {R} [comm_semiring R] (r : R) : R[X] →ₐ[R] R[X] :=
alg_hom.of_linear_map (taylor r) (taylor_one r) (taylor_mul r)

lemma taylor_taylor {R} [comm_semiring R] (f : R[X]) (r s : R) :
  taylor r (taylor s f) = taylor (r + s) f :=
by simp only [taylor_apply, comp_assoc, map_add, add_comp, X_comp, C_comp, C_add, add_assoc]

lemma taylor_eval {R} [comm_semiring R] (r : R) (f : R[X]) (s : R) :
  (taylor r f).eval s = f.eval (s + r) :=
by simp only [taylor_apply, eval_comp, eval_C, eval_X, eval_add]

lemma taylor_eval_sub {R} [comm_ring R] (r : R) (f : R[X]) (s : R) :
  (taylor r f).eval (s - r) = f.eval s :=
by rw [taylor_eval, sub_add_cancel]

lemma taylor_injective {R} [comm_ring R] (r : R) : function.injective (taylor r) :=
begin
  intros f g h,
  apply_fun taylor (-r) at h,
  simpa only [taylor_apply, comp_assoc, add_comp, X_comp, C_comp, C_neg,
    neg_add_cancel_right, comp_X] using h,
end

/-- Taylor's formula. -/
lemma sum_taylor_eq {R} [comm_ring R] (f : R[X]) (r : R) :
  (taylor r f).sum (λ i a, C a * (X - C r) ^ i) = f :=
by rw [←comp_eq_sum_left, sub_eq_add_neg, ←C_neg, ←taylor_apply, taylor_taylor, neg_add_self,
       taylor_zero]

end polynomial