import data.set
open set

-- 1. Replace "sorry" in these examples.
section
  variable {U : Type}
  variables A B C : set U

  example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
  assume x,
  assume h: x ∈ A ∩ C,
  show x ∈ A ∪ B, from or.inl h.left

  example : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
  assume x,
  assume : x ∈ -(A ∪ B),
  have ¬ x ∈ (A ∪ B), from this,
  assume : x ∈ A,
  show false, from ‹¬ x ∈ (A ∪ B)› (or.inl this)
end

-- 2. Replace "sorry" in the last example.
section
  variable {U : Type}

  /- defining "disjoint" -/
  def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

  example (A B : set U) (h : ∀ x, ¬ (x ∈ A ∧ x ∈ B)) : disj A B :=
  assume x,
  assume h1 : x ∈ A,
  assume h2 : x ∈ B,
  have h3 : x ∈ A ∧ x ∈ B, from and.intro h1 h2,
  show false, from h x h3

  -- notice that we do not have to mention x when applying
  --   h : disj A B
  example (A B : set U) (h1 : disj A B) (x : U) (h2 : x ∈ A) (h3 : x ∈ B) : false :=
  h1 h2 h3

  -- the same is true of ⊆
  example (A B : set U) (x : U) (h : A ⊆ B) (h1 : x ∈ A) : x ∈ B :=
  h h1

  example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A) (h3 : D ⊆ B) : disj C D :=
    assume x,
    assume g1: x ∈ C,
    assume g2: x ∈ D,
    have g3: x ∈ A, from h2 g1,
    have g4: x ∈ B, from h3 g2,
    show false, from h1 g3 g4
end

-- 3. Prove the following facts about indexed unions and
-- intersections, using the theorems Inter.intro, Inter.elim,
-- Union.intro, and Union.elim listed above.
section
  variables {I U : Type}
  variables (A : I → set U) (B : I → set U) (C : set U)

  def Union (A : I → set U) : set U := { x | ∃ i : I, x ∈ A i }
  def Inter (A : I → set U) : set U := { x | ∀ i : I, x ∈ A i }

    notation `⋃` binders `, ` r:(scoped f, Union f) := r
    notation `⋂` binders `, ` r:(scoped f, Inter f) := r

    theorem Inter.intro {x : U} (h : ∀ i, x ∈ A i) : x ∈ ⋂ i, A i :=
        by simp; assumption

    theorem Inter.elim {x : U} (h : x ∈ ⋂ i, A i) (i : I) : x ∈ A i :=
        by simp at h; apply h

    theorem Union.intro {x : U} (i : I) (h : x ∈ A i) :
    x ∈ ⋃ i, A i :=
        by {simp, existsi i, exact h}

    theorem Union.elim {b : Prop} {x : U}
    (h₁ : x ∈ ⋃ i, A i) (h₂ : ∀ (i : I), x ∈ A i → b) : b :=
        by {simp at h₁, cases h₁ with i h, exact h₂ i h}

  example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=
  assume x,
        assume h: x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
        show x ∈ (⋂ i, A i ∩ B i), from
            Inter.intro
            (assume i: I,
            have h1: x ∈ A i, from Inter.elim h.left i,
            have h2: x ∈ B i, from Inter.elim h.right i,
            show x ∈ A i ∩ B i, from and.intro h1 h2)

  example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=
  assume x : U,
        assume h : x ∈ C ∩ (⋃i, A i),
        show x ∈ ⋃ i, C ∩ A i, from
            Union.elim h.right
            (assume i : I,
            assume h1: x ∈ A i,
            show  x ∈ ⋃ i, C ∩ A i, from
                Union.intro i (and.intro h.left h1))
end

-- 4. Prove the following fact about power sets. You can use the
-- theorems subset.trans and subset.refl
section
  variable  {U : Type}
  variables A B C : set U

    @[refl] theorem subset.refl (a : set U) : a ⊆ a := assume x, id

    @[trans] theorem subset.trans {a b c : set U} (ab : a ⊆ b) (bc : b ⊆ c) : a ⊆ c :=
        assume x h, bc (ab h)
  -- For this exercise these two facts are useful
  example (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
  subset.trans h1 h2

  example : A ⊆ A :=
  subset.refl A

  example (h : A ⊆ B) : powerset A ⊆ powerset B :=
   assume X : set U,
        assume h1 : X ∈ powerset A,
        show X ∈ powerset B, from subset.trans h1 h

  example (h : powerset A ⊆ powerset B) : A ⊆ B :=
  assume x: U,
        assume h1 : x ∈ A,
        have h2: {y|x = y} ∈ powerset A, from
            assume z,
            assume : z ∈ {y| x = y},
            have x = z, from this,
            show z ∈ A, from eq.subst this h1,
        have h3: {y| x = y} ∈ powerset B, from h h2,
        have h4: x ∈ {y| x = y}, from eq.refl x,
        show x ∈ B, from h3 h4
end

-- 5. Replace the sorry commands in the following proofs to show that
-- we can create a partial order R' out of a strict partial order R.
section
  parameters {A : Type} {R : A → A → Prop}
  parameter (irreflR : irreflexive R)
  parameter (transR : transitive R)

  local infix < := R
  variables a b c : A

  def R' (a b : A) : Prop := R a b ∨ a = b
  local infix ≤ := R'

  theorem reflR' (a : A) : a ≤ a :=
  begin
        have h1: a = a, from eq.refl a,
        apply or.inr h1
    end

  theorem transR' {a b c : A} (h1 : a ≤ b) (h2 : b ≤ c): a ≤ c :=
    or.elim h1
        (assume h3: a < b, or.elim h2
                (assume h4: b < c, or.inl (transR h3 h4))
                (assume h4: b = c, eq.subst h4 h1))
        (assume h3: a = b, eq.subst (eq.symm h3) h2)

  theorem antisymmR' {a b : A} (h1 : a ≤ b) (h2 : b ≤ a) : a = b :=
  or.elim h1
        (assume h: a < b, or.elim h2
            (assume h3: b < a, false.elim ((irreflR b) (transR h3 h)))
            (assume h3: b = a, eq.symm h3))
        (assume h: a = b, h)
end

-- 6
section
  parameters {A : Type} {R : A → A → Prop}
  parameter (reflR : reflexive R)
  parameter (transR : transitive R)

  def S (a b : A) : Prop := R a b ∧ R b a

  example : transitive S :=
  assume x y z,
        assume h1 h2,
        and.intro (transR h1.left h2.left) (transR h2.right h1.right)
end

-- 7. Only one of the following two theorems is provable. Figure out
-- which one is true, and replace the sorry command with a complete
-- proof.
section
  parameters {A : Type} {a b c : A} {R : A → A → Prop}
  parameter (Rab : R a b)
  parameter (Rbc : R b c)
  parameter (nRac : ¬ R a c)

  theorem R_is_not_strict_partial_order : ¬(irreflexive R ∧ transitive R) :=
  assume h: irreflexive R ∧ transitive R,
  show false, from nRac (h.right Rab Rbc)
end

-- 8
section
  open nat

  example : 1 ≤ 4 :=
  have h1: 1 <  1 + 1, from lt_succ_self 1,
have h2: (1 + 1) < (1 + 1) + 1, from lt_succ_self (1 + 1),
have h3: (1 + 1 + 1) < (1 + 1 + 1) + 1, from lt_succ_self (1 + 1 + 1),
have h4: 4 = 1 + 1 + 1 + 1, by simp,
have h5: 1 ≤ (1 + 1 + 1) + 1, from le_of_lt (lt_trans h1 (lt_trans h2 h3)),
eq.subst h4 h5
end


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/

import data.W.basic

/-!
# W types

The file `data/W.lean` shows that if `α` is an an encodable fintype and for every `a : α`,
`β a` is encodable, then `W β` is encodable.

As an example of how this can be used, we show that the type of propositional formulas with
variables labeled from an encodable type is encodable.

The strategy is to define a type of labels corresponding to the constructors.
From the definition (using `sum`, `unit`, and an encodable type), Lean can infer
that it is encodable. We then define a map from propositional formulas to the
corresponding `Wfin` type, and show that map has a left inverse.

We mark the auxiliary constructions `private`, since their only purpose is to
show encodability.
-/

/-- Propositional formulas with labels from `α`. -/
inductive prop_form (α : Type*)
| var : α → prop_form
| not : prop_form → prop_form
| and : prop_form → prop_form → prop_form
| or  : prop_form → prop_form → prop_form

/-!
The next three functions make it easier to construct functions from a small
`fin`.
-/

section
variable {α : Type*}

/-- the trivial function out of `fin 0`. -/
def mk_fn0 : fin 0 → α
| ⟨_, h⟩ := absurd h dec_trivial

/-- defines a function out of `fin 1` -/
def mk_fn1 (t : α) : fin 1 → α
| ⟨0, _⟩   := t
| ⟨n+1, h⟩ := absurd h dec_trivial

/-- defines a function out of `fin 2` -/
def mk_fn2 (s t : α) : fin 2 → α
| ⟨0, _⟩   := s
| ⟨1, _⟩   := t
| ⟨n+2, h⟩ := absurd h dec_trivial

attribute [simp] mk_fn0 mk_fn1 mk_fn2
end

namespace prop_form

private def constructors (α : Type*) := α ⊕ unit ⊕ unit ⊕ unit

local notation `cvar` a := sum.inl a
local notation `cnot`   := sum.inr (sum.inl unit.star)
local notation `cand`   := sum.inr (sum.inr (sum.inr unit.star))
local notation `cor`    := sum.inr (sum.inr (sum.inl unit.star))

@[simp]
private def arity (α : Type*) : constructors α → nat
| (cvar a) := 0
| cnot     := 1
| cand     := 2
| cor      := 2

variable {α : Type*}

private def f : prop_form α → W_type (λ i, fin (arity α i))
| (var a)   := ⟨cvar a, mk_fn0⟩
| (not p)   := ⟨cnot, mk_fn1 (f p)⟩
| (and p q) := ⟨cand, mk_fn2 (f p) (f q)⟩
| (or  p q) := ⟨cor, mk_fn2 (f p) (f q)⟩

private def finv : W_type (λ i, fin (arity α i)) → prop_form α
| ⟨cvar a, fn⟩ := var a
| ⟨cnot, fn⟩   := not (finv (fn ⟨0, dec_trivial⟩))
| ⟨cand, fn⟩   := and (finv (fn ⟨0, dec_trivial⟩)) (finv (fn ⟨1, dec_trivial⟩))
| ⟨cor, fn⟩    := or  (finv (fn ⟨0, dec_trivial⟩)) (finv (fn ⟨1, dec_trivial⟩))

instance [encodable α] : encodable (prop_form α) :=
begin
  haveI : encodable (constructors α),
  { unfold constructors, apply_instance },
  exact encodable.of_left_inverse f finv
    (by { intro p, induction p; simp [f, finv, *] })
end

end prop_form


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

import topology.algebra.nonarchimedean.bases
import topology.algebra.uniform_filter_basis
import ring_theory.valuation.basic

/-!
# The topology on a valued ring

In this file, we define the non archimedean topology induced by a valuation on a ring.
The main definition is a `valued` type class which equips a ring with a valuation taking
values in a group with zero. Other instances are then deduced from this.
-/

open_locale classical topology uniformity
open set valuation
noncomputable theory

universes v u

variables {R : Type u} [ring R] {Γ₀ : Type v} [linear_ordered_comm_group_with_zero Γ₀]

namespace valuation

variables (v : valuation R Γ₀)

/-- The basis of open subgroups for the topology on a ring determined by a valuation. -/
lemma subgroups_basis :
  ring_subgroups_basis (λ γ : Γ₀ˣ, (v.lt_add_subgroup γ : add_subgroup R)) :=
{ inter := begin
    rintros γ₀ γ₁,
    use min γ₀ γ₁,
    simp [valuation.lt_add_subgroup] ; tauto
  end,
  mul := begin
    rintros γ,
    cases exists_square_le γ with γ₀ h,
    use γ₀,
    rintro - ⟨r, s, r_in, s_in, rfl⟩,
    calc (v (r*s) : Γ₀) = v r * v s : valuation.map_mul _ _ _
             ... < γ₀*γ₀ : mul_lt_mul₀ r_in s_in
             ... ≤ γ : by exact_mod_cast h
  end,
  left_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use (1 : Γ₀ˣ),
      rintros y (y_in : (v y : Γ₀) < 1),
      change v (x * y) < _,
      rw [valuation.map_mul, Hx, zero_mul],
      exact units.zero_lt γ },
    { simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, valuation.map_mul],
      use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change (v (x * y) : Γ₀) < γ,
      rw [valuation.map_mul, Hx, mul_comm],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end,
  right_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use 1,
      rintros y (y_in : (v y : Γ₀) < 1),
      change v (y * x) < _,
      rw [valuation.map_mul, Hx, mul_zero],
      exact units.zero_lt γ },
    { use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change (v (y * x) : Γ₀) < γ,
      rw [valuation.map_mul, Hx],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end }

end valuation

/-- A valued ring is a ring that comes equipped with a distinguished valuation. The class `valued`
is designed for the situation that there is a canonical valuation on the ring.

TODO: show that there always exists an equivalent valuation taking values in a type belonging to
the same universe as the ring.

See Note [forgetful inheritance] for why we extend `uniform_space`, `uniform_add_group`. -/
class valued (R : Type u) [ring R] (Γ₀ : out_param (Type v))
  [linear_ordered_comm_group_with_zero Γ₀] extends uniform_space R, uniform_add_group R :=
(v : valuation R Γ₀)
(is_topological_valuation : ∀ s, s ∈ 𝓝 (0 : R) ↔ ∃ (γ : Γ₀ˣ), { x : R | v x < γ } ⊆ s)

/-- The `dangerous_instance` linter does not check whether the metavariables only occur in
arguments marked with `out_param`, so in this instance it gives a false positive. -/
attribute [nolint dangerous_instance] valued.to_uniform_space

namespace valued

/-- Alternative `valued` constructor for use when there is no preferred `uniform_space`
structure. -/
def mk' (v : valuation R Γ₀) : valued R Γ₀ :=
{ v := v,
  to_uniform_space := @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _,
  to_uniform_add_group := @topological_add_comm_group_is_uniform _ _ v.subgroups_basis.topology _,
  is_topological_valuation :=
  begin
    letI := @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _,
    intros s,
    rw filter.has_basis_iff.mp v.subgroups_basis.has_basis_nhds_zero s,
    exact exists_congr (λ γ, by simpa),
  end }

variables (R Γ₀) [_i : valued R Γ₀]
include _i

lemma has_basis_nhds_zero :
  (𝓝 (0 : R)).has_basis (λ _, true) (λ (γ : Γ₀ˣ), { x | v x < (γ : Γ₀) }) :=
by simp [filter.has_basis_iff, is_topological_valuation]

lemma has_basis_uniformity :
  (𝓤 R).has_basis (λ _, true) (λ (γ : Γ₀ˣ), { p : R × R | v (p.2 - p.1) < (γ : Γ₀) }) :=
begin
  rw uniformity_eq_comap_nhds_zero,
  exact (has_basis_nhds_zero R Γ₀).comap _,
end

lemma to_uniform_space_eq :
  to_uniform_space = @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _ :=
uniform_space_eq
  ((has_basis_uniformity R Γ₀).eq_of_same_basis $ v.subgroups_basis.has_basis_nhds_zero.comap _)

variables {R Γ₀}

lemma mem_nhds {s : set R} {x : R} :
  (s ∈ 𝓝 x) ↔ ∃ (γ : Γ₀ˣ), {y | (v (y - x) : Γ₀) < γ } ⊆ s :=
by simp only [← nhds_translation_add_neg x, ← sub_eq_add_neg, preimage_set_of_eq, exists_true_left,
  ((has_basis_nhds_zero R Γ₀).comap (λ y, y - x)).mem_iff]

lemma mem_nhds_zero {s : set R} :
  (s ∈ 𝓝 (0 : R)) ↔ ∃ γ : Γ₀ˣ, {x | v x < (γ : Γ₀) } ⊆ s :=
by simp only [mem_nhds, sub_zero]

lemma loc_const {x : R} (h : (v x : Γ₀) ≠ 0) : {y : R | v y = v x} ∈ 𝓝 x :=
begin
  rw mem_nhds,
  rcases units.exists_iff_ne_zero.mpr h with ⟨γ, hx⟩,
  use γ,
  rw hx,
  intros y y_in,
  exact valuation.map_eq_of_sub_lt _ y_in
end

@[priority 100]
instance : topological_ring R :=
(to_uniform_space_eq R Γ₀).symm ▸ v.subgroups_basis.to_ring_filter_basis.is_topological_ring

lemma cauchy_iff {F : filter R} :
  cauchy F ↔ F.ne_bot ∧ ∀ γ : Γ₀ˣ, ∃ M ∈ F, ∀ x y ∈ M, (v (y - x) : Γ₀) < γ :=
begin
  rw [to_uniform_space_eq, add_group_filter_basis.cauchy_iff],
  apply and_congr iff.rfl,
  simp_rw valued.v.subgroups_basis.mem_add_group_filter_basis_iff,
  split,
  { intros h γ,
    exact h _ (valued.v.subgroups_basis.mem_add_group_filter_basis _) },
  { rintros h - ⟨γ, rfl⟩,
    exact h γ }
end

end valued


/-
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
-/
import 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.is_pfilter 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

-/

namespace order

variables {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] :=
(dual : ideal Pᵒᵈ)

/-- A predicate for when a subset of `P` is a filter. -/
def is_pfilter [preorder P] (F : set P) : Prop :=
@is_ideal Pᵒᵈ _ F

lemma is_pfilter.of_def [preorder P] {F : set P} (nonempty : F.nonempty)
  (directed : directed_on (≥) F) (mem_of_le : ∀ {x y : P}, x ≤ y → x ∈ F → y ∈ F) : is_pfilter F :=
⟨λ _ _ _ _, mem_of_le ‹_› ‹_›,  nonempty, directed⟩

/-- Create an element of type `order.pfilter` from a set satisfying the predicate
`order.is_pfilter`. -/
def is_pfilter.to_pfilter [preorder P] {F : set P} (h : is_pfilter F) : pfilter P :=
⟨h.to_ideal⟩

namespace pfilter

section preorder
variables [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 : has_coe (pfilter P) (set P) := ⟨λ F, F.dual.carrier⟩

/-- For the notation `x ∈ F`. -/
instance : has_mem P (pfilter P) := ⟨λ x F, x ∈ (F : set P)⟩

@[simp] lemma mem_coe : x ∈ (F : set P) ↔ x ∈ F := iff_of_eq rfl

lemma is_pfilter : is_pfilter (F : set P) :=
F.dual.is_ideal

lemma nonempty : (F : set P).nonempty := F.dual.nonempty

lemma directed : directed_on (≥) (F : set P) := F.dual.directed

lemma mem_of_le {F : pfilter P} : x ≤ y → x ∈ F → y ∈ F := λ h, F.dual.lower h

/-- Two filters are equal when their underlying sets are equal. -/
@[ext] lemma ext (h : (s : set P) = t) : s = t :=
by { cases s, cases t, exact congr_arg _ (ideal.ext h) }

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (pfilter P) := partial_order.lift coe ext

@[trans] lemma mem_of_mem_of_le {F G : pfilter P} : x ∈ F → F ≤ G → x ∈ G :=
ideal.mem_of_mem_of_le

/-- The smallest filter containing a given element. -/
def principal (p : P) : pfilter P := ⟨ideal.principal p⟩

@[simp] lemma mem_def (x : P) (I : ideal Pᵒᵈ) :
  x ∈ (⟨I⟩ : pfilter P) ↔ order_dual.to_dual x ∈ I :=
iff.rfl

@[simp] lemma principal_le_iff {F : pfilter P} : principal x ≤ F ↔ x ∈ F :=
ideal.principal_le_iff

@[simp] lemma mem_principal : x ∈ principal y ↔ y ≤ x :=
ideal.mem_principal -- defeq abuse

lemma antitone_principal : antitone (principal : P → pfilter P) := by delta antitone; simp

lemma principal_le_principal_iff {p q : P} : principal q ≤ principal p ↔ p ≤ q :=
by simp

end preorder

section order_top
variables [preorder P] [order_top P] {F : pfilter P}

/-- A specific witness of `pfilter.nonempty` when `P` has a top element. -/
@[simp] lemma top_mem : ⊤ ∈ F := ideal.bot_mem _

/-- There is a bottom filter when `P` has a top element. -/
instance : order_bot (pfilter P) :=
{ bot := ⟨⊥⟩,
  bot_le := λ F, (bot_le : ⊥ ≤ F.dual) }

end order_top

/-- There is a top filter when `P` has a bottom element. -/
instance {P} [preorder P] [order_bot P] : order_top (pfilter P) :=
{ top := ⟨⊤⟩,
  le_top := λ F, (le_top : F.dual ≤ ⊤) }

section semilattice_inf
variables [semilattice_inf P] {x y : P} {F : pfilter P}

/-- A specific witness of `pfilter.directed` when `P` has meets. -/
lemma inf_mem (hx : x ∈ F) (hy : y ∈ F) : x ⊓ y ∈ F := ideal.sup_mem hx hy

@[simp] lemma inf_mem_iff : x ⊓ y ∈ F ↔ x ∈ F ∧ y ∈ F :=
ideal.sup_mem_iff

end semilattice_inf

section complete_semilattice_Inf

variables [complete_semilattice_Inf P] {F : pfilter P}

lemma Inf_gc : galois_connection (λ x, order_dual.to_dual (principal x))
  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
λ x F, by { simp, refl }

/-- If a poset `P` admits arbitrary `Inf`s, then `principal` and `Inf` form a Galois coinsertion. -/
def Inf_gi : galois_coinsertion (λ x, order_dual.to_dual (principal x))
  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
{ choice := λ F _, Inf (id F : pfilter P),
  gc := Inf_gc,
  u_l_le := λ s, Inf_le $ mem_principal.2 $ le_refl s,
  choice_eq := λ _ _, rfl }

end complete_semilattice_Inf

end pfilter

end order


/-
Require Import List.

Fixpoint prefix_sum sum l :=
  match l with
  | nil => sum :: nil
  | head :: tail => sum :: prefix_sum (sum + head) tail
  end.

Fixpoint plus_list l1 l2 :=
  match (l1, l2) with
  | (nil, _) => nil
  | (_, nil) => nil
  | (h1 :: t1, h2 :: t2) => (h1 + h2) :: plus_list t1 t2
  end.

Definition task :=
  forall l1 l2,
    prefix_sum 0 (plus_list l1 l2) =
    plus_list (prefix_sum 0 l1) (prefix_sum 0 l2).
-/

def prefix_sum : nat → list nat → list nat
| sum list.nil := sum :: list.nil
| sum (head :: tail) := sum :: prefix_sum (sum + head) tail

def plus_list : list nat → list nat → list nat
| list.nil _ := list.nil
| _ list.nil := list.nil
| (h1 :: t1) (h2 :: t2) := (h1 + h2) :: plus_list t1 t2

lemma nil_plus_list : ∀ l : list nat, plus_list list.nil l = list.nil :=
by intro l; induction l; simp [plus_list]

lemma plus_list_comm : ∀ l1 l2 :list nat, plus_list l1 l2 = plus_list l2 l1 :=
begin
    intro l1, induction l1,
        intro l2, induction l2; simp [plus_list],
    intro l2, induction l2,
        simp [plus_list],
    simp [plus_list, l1_ih],
end

lemma plus_list_nil (l : list nat) : plus_list l list.nil = list.nil :=
by simp [plus_list_comm l, nil_plus_list]

lemma plus_list_prefix_sum : ∀ h1 h2 : nat, ∀ l1 l2 :list nat, plus_list (prefix_sum h1 l1) (prefix_sum h2 l2)
    = prefix_sum (h1 + h2) (plus_list l1 l2) :=
begin
    intros,
    revert l2 h1 h2,
    induction l1,
        simp [prefix_sum, nil_plus_list],
        intro l2, induction l2,
            simp [prefix_sum],
            simp [plus_list],
            intros, trivial,
        simp [prefix_sum],
        simp [plus_list],
        simp [nil_plus_list],
        intros, trivial,
    intro l2, induction l2,
        simp [prefix_sum, nil_plus_list, plus_list_nil],
        simp [plus_list, plus_list_nil],
        intros, trivial,
    intros,
    simp [prefix_sum],
    simp [plus_list, prefix_sum],
    simp [l1_ih],
end

example : ∀ l1 l2 : list nat, prefix_sum 0 (plus_list l1 l2) = plus_list (prefix_sum 0 l1) (prefix_sum 0 l2) :=
begin
    simp [plus_list_prefix_sum],
    intros, trivial,
end


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module field_theory.finiteness
! leanprover-community/mathlib commit 6eeb941cf39066417a09b1bbc6e74761cadfcb1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Finiteness
import Mathbin.LinearAlgebra.Dimension

/-!
# A module over a division ring is noetherian if and only if it is finite.

-/

universe u v

open Classical Cardinal

open Cardinal Submodule Module Function

namespace IsNoetherian

variable {K : Type u} {V : Type v} [DivisionRing K] [AddCommGroup V] [Module K V]

/-- A module over a division ring is noetherian if and only if
its dimension (as a cardinal) is strictly less than the first infinite cardinal `ℵ₀`.
-/
theorem iff_dim_lt_aleph0 : IsNoetherian K V ↔ Module.rank K V < ℵ₀ :=
  by
  let b := Basis.ofVectorSpace K V
  rw [← b.mk_eq_dim'', lt_aleph_0_iff_set_finite]
  constructor
  · intro
    exact finite_of_linearIndependent (Basis.ofVectorSpaceIndex.linearIndependent K V)
  · intro hbfinite
    refine'
      @isNoetherian_of_linearEquiv K (⊤ : Submodule K V) V _ _ _ _ _ (LinearEquiv.ofTop _ rfl)
        (id _)
    refine' isNoetherian_of_fg_of_noetherian _ ⟨Set.Finite.toFinset hbfinite, _⟩
    rw [Set.Finite.coe_toFinset, ← b.span_eq, Basis.coe_ofVectorSpace, Subtype.range_coe]
#align is_noetherian.iff_dim_lt_aleph_0 IsNoetherian.iff_dim_lt_aleph0

variable (K V)

/-- The dimension of a noetherian module over a division ring, as a cardinal,
is strictly less than the first infinite cardinal `ℵ₀`. -/
theorem dim_lt_aleph0 : ∀ [IsNoetherian K V], Module.rank K V < ℵ₀ :=
  IsNoetherian.iff_dim_lt_aleph0.1
#align is_noetherian.dim_lt_aleph_0 IsNoetherian.dim_lt_aleph0

variable {K V}

/-- In a noetherian module over a division ring, all bases are indexed by a finite type. -/
noncomputable def fintypeBasisIndex {ι : Type _} [IsNoetherian K V] (b : Basis ι K V) : Fintype ι :=
  b.fintypeIndexOfDimLtAleph0 (dim_lt_aleph0 K V)
#align is_noetherian.fintype_basis_index IsNoetherian.fintypeBasisIndex

/-- In a noetherian module over a division ring,
`basis.of_vector_space` is indexed by a finite type. -/
noncomputable instance [IsNoetherian K V] : Fintype (Basis.ofVectorSpaceIndex K V) :=
  fintypeBasisIndex (Basis.ofVectorSpace K V)

/-- In a noetherian module over a division ring,
if a basis is indexed by a set, that set is finite. -/
theorem finite_basis_index {ι : Type _} {s : Set ι} [IsNoetherian K V] (b : Basis s K V) :
    s.Finite :=
  b.finite_index_of_dim_lt_aleph0 (dim_lt_aleph0 K V)
#align is_noetherian.finite_basis_index IsNoetherian.finite_basis_index

variable (K V)

/-- In a noetherian module over a division ring,
there exists a finite basis. This is the indexing `finset`. -/
noncomputable def finsetBasisIndex [IsNoetherian K V] : Finset V :=
  (finite_basis_index (Basis.ofVectorSpace K V)).toFinset
#align is_noetherian.finset_basis_index IsNoetherian.finsetBasisIndex

@[simp]
theorem coe_finsetBasisIndex [IsNoetherian K V] :
    (↑(finsetBasisIndex K V) : Set V) = Basis.ofVectorSpaceIndex K V :=
  Set.Finite.coe_toFinset _
#align is_noetherian.coe_finset_basis_index IsNoetherian.coe_finsetBasisIndex

@[simp]
theorem coeSort_finsetBasisIndex [IsNoetherian K V] :
    (finsetBasisIndex K V : Type _) = Basis.ofVectorSpaceIndex K V :=
  Set.Finite.coeSort_toFinset _
#align is_noetherian.coe_sort_finset_basis_index IsNoetherian.coeSort_finsetBasisIndex

/-- In a noetherian module over a division ring, there exists a finite basis.
This is indexed by the `finset` `finite_dimensional.finset_basis_index`.
This is in contrast to the result `finite_basis_index (basis.of_vector_space K V)`,
which provides a set and a `set.finite`.
-/
noncomputable def finsetBasis [IsNoetherian K V] : Basis (finsetBasisIndex K V) K V :=
  (Basis.ofVectorSpace K V).reindex (by simp)
#align is_noetherian.finset_basis IsNoetherian.finsetBasis

@[simp]
theorem range_finsetBasis [IsNoetherian K V] :
    Set.range (finsetBasis K V) = Basis.ofVectorSpaceIndex K V := by
  rw [finset_basis, Basis.range_reindex, Basis.range_ofVectorSpace]
#align is_noetherian.range_finset_basis IsNoetherian.range_finsetBasis

variable {K V}

/-- A module over a division ring is noetherian if and only if it is finitely generated. -/
theorem iff_fg : IsNoetherian K V ↔ Module.Finite K V :=
  by
  constructor
  · intro h
    exact
      ⟨⟨finset_basis_index K V, by
          convert(finset_basis K V).span_eq
          simp⟩⟩
  · rintro ⟨s, hs⟩
    rw [IsNoetherian.iff_dim_lt_aleph0, ← dim_top, ← hs]
    exact lt_of_le_of_lt (dim_span_le _) s.finite_to_set.lt_aleph_0
#align is_noetherian.iff_fg IsNoetherian.iff_fg

end IsNoetherian


import tactic

/-!
# Groups
Definition and basic properties of a group.
-/

-- Technical note: We work in a namespace `xena` because Lean already has groups.
namespace xena
-- Now our definition of a group will really be called `xena.group`.

/-
## Definition of a group
The `group` class will extend `has_mul`, `has_one` and `has_inv`.
`has_mul G` means that `G` has a multiplication `* : G → G → G`
`has_one G` means that `G` has a `1 : G`
`has_inv G` means that `G` has an `⁻¹ : G → G`
All of `*`, `1` and `⁻¹` are notation for functions -- no axioms yet.
A `group` has all of this notation, and the group axioms too.
Let's now define the group class.
-/

/-- A `group` structure on a type `G` is multiplication, identity and inverse,
plus the usual axioms -/
class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-
Formally, a term of type `group G` is now the following data:
a multiplication, 1, and inverse function,
and proofs that the group axioms are satisfied.
The way to say "let G be a group" is now `(G : Type) [group G]`
The square bracket notation is the notation used for classes.
Formally, it means "put a term of type `group G` into the type class
inference system". In practice this just means "you can use group
notation and axioms in proofs, and Lean will figure out why they're true"
We have been extremely mean with our axioms. Some authors also add
the axioms `mul_one : ∀ (a : G), a * 1 = a`
and `mul_right_inv : ∀ (a : G), a * a⁻¹ = 1`.
But these follow from the three axioms we used. Our first job is
to prove them. As you might imagine, mathematically this is pretty
much the trickiest part, because we have to be careful not to
accidentally assume these axioms when we're proving them.
Here are the four lemmas we will prove next.
`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
-/

-- We're proving things about groups so let's work in the `group` namespace
-- (really this is `xena.group`)

namespace group

-- let `G` be a group.
variables {G : Type} [group G]

/-
We start by proving `mul_left_cancel : ∀ a b c, a * b = a * c → b = c`.
We assume `Habac : a * b = a * c` and deduce `b = c`. I've written
down the maths proof. Your job is to supply the rewrites that are
necessary to justify each step. Each rewrite is either one of
the axioms of a group, or an assumption. A reminder of the axioms:
`mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)`
`one_mul : ∀ (a : G), 1 * a = a`
`mul_left_inv : ∀ (a : G), a⁻¹ * a = 1`
This proof could be done using rewrites, but I will take this opportunity
to introduce the `calc` tactic.
-/
lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by sorry -- replace `sorry` with `rw X` as appropriate
    ... = a⁻¹ * (a * b) : by sorry
    ... = a⁻¹ * (a * c) : by sorry
    ... = (a⁻¹ * a) * c : by sorry
    ... = 1 * c         : by sorry
    ... = c             : by sorry
end

/-
Next we prove that if `x = a⁻¹ * y` then `a * x = y`. Remember we are still
missing `mul_one` and `mul_right_inv`. A proof that avoids them is
the following: we want `a * x = y`. Now `apply`ing the previous lemma, it
suffices to prove that `a⁻¹ * (a * x) = a⁻¹ * y.`
Now use associativity and left cancellation on on the left, to reduce
to `h`.
Note that `mul_left_cancel` is a function, and its first input is
called `a`, but you had better give it `a⁻¹` instead.
-/
lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  sorry
end

-- It's a bore to keep introducing variable names.

-- Let `a,b,c,x,y` be elements of `G`.
variables (a b c x y : G)

/-
We can use `mul_eq_of_eq_inv_mul` to prove the two "missing" axioms `mul_one`
and `mul_right_inv`, and then our lives will be much easier. Try `apply`ing it
in the theorems below.
-/

@[simp] theorem mul_one : a * 1 = a :=
begin
  sorry
end

@[simp] theorem mul_right_inv : a * a⁻¹ = 1 :=
begin
  sorry
end

-- Now let's talk about what that `@[simp]` means.

/-
## Lean's simplifier
A human sees `a * a⁻¹` in group theory, and instantly replaces it with `1`.
We are going to train a simple AI called `simp` to do the same thing.
Lean's simplifier `simp` is a "term rewriting system". This means
that if you teach it a bunch of theorems of the form `A = B` or
`P ↔ Q` (by tagging them with the `@[simp]` attribute) and then give
it a complicated goal, like
`example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1`
then it will try to use the `rw` tactic as much as it can, using the lemmas
it has been taught, in an attempt to simplify the goal. If it manages
to solve it completely, then great! If it does not, but you feel like
it should have done, you might want to tag more lemmas with `@[simp]`.
`simp` should only be used to completely close goals. We are now
going to train the simplifier to solve the example above (indeed, we are
going to train it to reduce an arbitrary element of a free group into
a unique normal form, so it will solve any equalities which are true
for all groups, like the example above).
## Important note
Lean's simplifier does a series of rewrites, each one replacing something
with something else. But the simplifier will always rewrite from left to right!
If you tell it that `A = B` is a `simp` lemma then it will replace `A`s with
`B`s, but it will never replace `B`s with `A`s. If you tag a proof
of `A = B` with `@[simp]` and you also tag a proof of `B = A` with
`@[simp]`, then the simplifier will get stuck in an infinite loop when
it runs into an `A`! Equality should not be thought of as symmetric here.
Because the simplifier works from left to right, an important
rule of thumb is that if `A = B` is a `simp` lemma, then `B` should
probably be simpler than `A`! In particular, equality should not be
thought of as symmetric here. It is not a coincidence that in
the theorems below
`@[simp] theorem mul_one (a : G) : a * 1 = a`
`@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1`
the right hand side is simpler than the left hand side. It would be a
> disaster to tag `a = a * 1` with the `@[simp]` tag -- can you see why?
Let's train Lean's simplifier! Let's teach it the axioms of a `group` next.
We have already done the axioms, so we have to retrospectively tag
them with the `@[simp]` attribute.
-/

attribute [simp] one_mul mul_left_inv mul_assoc

/-
Now let's teach the simplifier the following five lemmas:
`inv_mul_cancel_left : a⁻¹ * (a * b) = b`
`mul_inv_cancel_left : a * (a⁻¹ * b) = b`
`inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹`
`one_inv : (1 : G)⁻¹ = 1`
`inv_inv : (a⁻¹)⁻¹ = a`
Note that in each case, the right hand side is simpler
than the left hand side.
Try using the simplifier in your proofs! I will do the
first one for you.
-/

@[simp] lemma inv_mul_cancel_left : a⁻¹ * (a * b) = b :=
begin
  rw ← mul_assoc, -- the simplifier wouldn't do it that way
                  -- so we have to do it manually
  simp, -- simplifier takes it from here,
        -- rewriting a⁻¹ * a to 1 and then 1 * b to b
end

@[simp] lemma mul_inv_cancel_left : a * (a⁻¹ * b) = b :=
begin
  sorry
end

@[simp] lemma inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  sorry
end

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  sorry
end

@[simp] lemma inv_inv : a ⁻¹ ⁻¹ = a :=
begin
  sorry
end

/-
The reason I choose these five lemmas in particular, is that
term rewriting systems are very well understood by computer
scientists, and in particular there is something called the
Knuth-Bendix algorithm, which, given as input the three axioms
for a group which we used, produces a "confluent and noetherian
term rewrite system" that transforms every term into a unique
normal form. The system it produces is precisely the `simp`
lemmas which we haven proven above! See
https://en.wikipedia.org/wiki/Word_problem_(mathematics)#Example:_A_term_rewriting_system_to_decide_the_word_problem_in_the_free_group
for more information. I won't talk any more about the Knuth-Bendix
algorithm because it's really computer science, and I don't really
understand it, but apparently if you apply it to polynomial rings
then you get Buchberger's algorithm for computing Gröbner bases.
-/

-- Now let's try our example...
example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1 := by simp -- short for begin simp end

-- The simplifier solves it!

-- try your own identities. `simp` will solve them all!

/-
This is everything I wanted to show you about groups and the simplifier today.
You can now either go on to subgroups in Part B, or practice your group
theory skills by proving the lemmas below.
-/

/-
We already proved `mul_eq_of_eq_inv_mul` but there are several other
similar-looking, but slightly different, versions of this. Here
is one.
-/

lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  sorry
end

lemma eq_inv_mul_of_mul_eq {a b c : G} (h : b * a = c) : a = b⁻¹ * c :=
begin
  sorry
end

lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  sorry
end

lemma mul_right_eq_self {a b : G} : a * b = a ↔ b = 1 :=
begin
  sorry
end

lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
begin
  sorry
end

lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  sorry,
end

lemma unique_left_id {e : G} (h : ∀ x : G, e * x = x) : e = 1 :=
begin
  sorry
end

lemma unique_right_inv {a b : G} (h : a * b = 1) : b = a⁻¹ :=
begin
  sorry
end

lemma mul_left_cancel_iff (a x y : G) : a * x = a * y ↔ x = y :=
begin
  split,
  { apply mul_left_cancel },
  { intro hxy,
    rwa hxy }
end

-- You don't even need to go into tactic mode (begin/end) to use `calc`:
lemma mul_right_cancel (a x y : G) (Habac : x * a = y * a) : x = y :=
calc x = x * 1 : by rw mul_one
  -- missing arguments here
  ... = y : by sorry

-- `↔` lemmas are good simp lemmas too.
@[simp] theorem inv_inj_iff {a b : G}: a⁻¹ = b⁻¹ ↔ a = b :=
begin
  sorry
end

theorem inv_eq {a b : G}: a⁻¹ = b ↔ b⁻¹ = a :=
begin
  sorry
end

end group

end xena


import mynat.definition -- hide
import mynat.add -- hide
import game.world2.level3 -- hide
namespace mynat -- hide

/-
# Addition World

## Level 4: `add_comm` (boss level)

[boss battle music]

Look in Theorem statements -> Addition world to see the proofs you have.
These should be enough.
-/

/- Lemma
On the set of natural numbers, addition is commutative.
In other words, for all natural numbers $a$ and $b$, we have
$$ a + b = b + a. $$
-/
lemma add_comm (a b : mynat) : a + b = b + a :=
begin [nat_num_game]
  induction b with d hd,
  { rw zero_add,
    rw add_zero,
    refl
  },
  { rw add_succ,
    rw hd,
    rw succ_add,
    refl
  }
end

/-

If you got this far -- nice! You're nearly ready to make a choice:
Multiplication World or Function World. But there are just a couple
more useful lemmas in Addition World which you should prove first.
Press on to level 5.

-/
end mynat -- hide


/-
If P and Q are of type Prop, we think
of P → Q as a proposition in the form
of an implication.

Moreover, as we've seen, the way that
we give a proof of P → Q in the logic
of Lean is to produce a function that,
if given a proof of P returns a proof
of Q.

On the other hand, nothing in Lean will
prevent our using types such as nat and
bool as P and Q. In this case we'd say
that P → Q, or nat → bool, is a type: a
type of functions from P → Q, e.g., from
nat to bool.

EXERCISE: Give two or three examples
of interesting functions from nat to
bool. A program that takes any natural
number as an argument and always returns
a Boolean value as a result is a value
(a "function", or it would be better to
say, a lambda expression) of this type,
ℕ → bool.
-/

def zero_nat (n : ℕ) : ℕ := 0 -- explicit return type
#check zero_nat
#check zero_nat 5
#reduce zero_nat 5

def zero_nat': ℕ → ℕ := λ n : nat, (0 : nat)
def zero_nat'': ℕ → ℕ := λ n, 0
def zero_nat''' := λ n : nat, 0

/-
EXERCISE: define a function, one_nat that takes any natural
number as an argument and always returns the natural number
1. Write it in traditional function definition notation and
using lambda expressions and type inference.
-/

def one_nat' : ℕ → ℕ := λ n : nat, 1

def identity_nat (n : ℕ) : nat := n --explicit return type
#check identity_nat
#check identity_nat 5
#reduce identity_nat 5

/-
EXERCISE: define the same function, call it identity_nat'
and write it using a lambda expression.
-/

def double (n : ℕ) := 2 * n -- return type inferred
#check double
#check double 3
#reduce double 3

def double' : ℕ →  ℕ := λ n , 2 * n

/-
EXERCISE: Write it using a lambda expression.
-/

def square (n: ℕ) := n * n -- return type inferred
#check square
#check square 3
#reduce square 3

def square' : ℤ → ℤ := λ n, n * n

#reduce square' (-3)
-- #reduce square (-3) -- Nope

/-
EXERCISE: Write it using a lambda expression.
-/
def isPositive (n: nat) : bool := n > 0

--    if n > 0 then tt else ff

#check isPositive
#check isPositive 0
#check isPositive 1
#check isPositive 2
#reduce isPositive 0
#reduce isPositive 1
#reduce isPositive 2

/-
EXERCISE: Write it using a lambda expression.
-/

/-
Here's a function that returns boolean true
(tt) if a given natural number n is greater
than or equal to zero and less than 2^32. It
is given using lambda notation. Write it with
a prime on its name using ordinary function
definition notation (as the functions above
are written).
-/

def uint32: ℕ → bool :=
    λ n,
        if n >= 0 ∧ n < 2^32 then tt else ff

#check uint32

/-
An equivalent function definition with
a type declaration using arrow notation,
and an explicit lambda expression as a
value.
-/
def positive' : nat → bool :=
    λ n : nat,
        (if n > 0 then tt else ff : bool)

#check positive'
#check λ n : nat, (if n > 0 then tt else ff : bool)
#check λ n, (if n > 0 then tt else ff)
#check λ n, n > 0

/-
Read the first line as saying positive'
is a proof of (a value of type) nat → bool.
There are many values of this type: they
are all the functions taking nat arguments
and returning bool results. The specific
value that we use here to "prove the type"
is the function that returns true if the
argument is strictly greater than zero,
otherwise is returns false.

Read the lambda expression as follows:
A function that takes an argument, n, of
type nat, and that returns the result of
evaluating the expression, involving n,
after the comma: here, true if n > 0,
and false otherwise.

Here's an equivalent expression using
type inference to skip declaring the
type of n.
-/

def positive'' : nat → bool :=
    λ n, if n > 0 then tt else ff

/-
Here we use type inference to skip
declaring the function type, while
still using a lambda expression for
the program.
-/

def positive''' :=
    λ n, if n > 0 then tt else ff

#check positive'''
#reduce positive''' 3
#reduce positive''' 0

theorem pos_is_pos : isPositive = positive''' := rfl

def my_pow (x: nat) (y: nat) := x^y

#eval my_pow 2 16

/-
EXERCISE: Give two or three examples
of interesting functions from nat to
nat. A program that takes any natural
number as an argument and always returns
a natural as a result is a value
(a "function", or it would be better to
say, a lambda expression) of this type,
ℕ → ℕ
-/

/-
We can also pass functions as arguments
to other functions!
-/

def compose (f: ℕ → ℕ) (g: ℕ → ℕ) (x: ℕ) : ℕ :=
  f (g x)

#check compose
#check compose square double
#reduce compose double double 3
#reduce compose square double 3
#reduce square (double 3)

def do_twice (f : ℕ → ℕ) (x: ℕ) : ℕ := f (f x)
#check do_twice
#reduce do_twice square 3

/-
Let's write this as a lambda expression and
see what we get.
-/

def do_twice' : (ℕ → ℕ) → ℕ → ℕ :=
    λ (f: ℕ → ℕ) (x: ℕ), f (f x)

/-
And that's a shorthand for this!
-/

def do_twice'' : (ℕ → ℕ) → ℕ → ℕ :=
    λ (f : ℕ → ℕ),
        λ (x : ℕ),
            f (f x)

def foo := (do_twice'' double)
#check foo
#eval foo 5

def sub_do_twice (f: ℕ → ℕ) := λ (x : ℕ), f (f x)

#check sub_do_twice

def call_sub_do_twice := sub_do_twice (λ (x: ℕ), x + 1)
#check call_sub_do_twice
#reduce call_sub_do_twice 2

theorem dt_eq_dt : do_twice = do_twice'' := rfl

/-
Inception! Here we define a function that takes
as an argument a function that takes as an argument
a function (and a natural number)
-/

def do_twice''' (f: (ℕ → ℕ) → ℕ → ℕ) (x: (ℕ → ℕ)) : (ℕ → ℕ) := f (f x)

#check do_twice'''
#check do_twice''' do_twice
#reduce do_twice'''

/-
Use #eval instead of #reduce because #reduce will
have recursion problems unless we increase our
stack space.
-/

#eval (do_twice''' do_twice) square 2
#eval 2^16


/-
In Lean and related proof assistants, such
as Coq, you can obtain proofs not only by
applying inference rules, such as eq.refl,
directly, but also by using programs, called
tactics, that automate some of the details
of finding and applying inference rules or
sequences of such rules.

As an example, we look at the "rfl" tactic,
which slightly simplifies the application of
the eq.refl inference rule. Let's first look
at a few uses of rfl.
-/

theorem t1 : 2 = 1 + 1 := rfl
theorem t2 : tt = tt := rfl

/-
The rfl tactics appear to be producing
proofs of the given propositions, and that
is indeed the case. If we #check t1 we'll
see that this is so. t1 is a proof of 0=0
and in fact is exactly eq.refl 0.
-/

#check t1
#reduce t1

/-
What rfl is doing is grabbing the left side
of an equality proposition, such as 2 or tt
in the examples here, and returning eq.refl
applied to that value.
-/

/-
EXERCISE: Use rfl to produce a proof, h, of
the proposition, "Hello" = "He" ++ "llo".

EXERCISE: Use rfl to prove p: 3*3+4*4=5*5.
-/

/- * A brief aside about terminology *-/

/-
Note: The word "theorem" in mathematics is generally
used to mean an "important" proposition that has been
proved. The word lemma is used to mean a less
important proposition that has been proved, often as
part of a larger proof of a more important theorem.
Mathematicians also use the word corollary to refer
to a proposition the proof of which follows from the
proof of a more important theorem. You can read all
about the various words used to refer to things that
have been proved, or that are intended to be proved,
here: https://academia.stackexchange.com/questions/113819/is-it-acceptable-for-a-referee-to-suggest-changing-theorem-into-proposition.
For our purposes, we'll typically just use theorem.
-/

/-
As you have now seen, Lean's notion of equality
does not mean exact equality of expressions. It
means instead the equality the values to which
they "reduce" when you "evaluate" them. We can
prove 2 = 1 + 1 using rfl (or eq.refl of course)
because the "literal expression", 2, reduces to
the value 2; the function application expression,
1 + 1 (wherein the plus function is applied to
the two arguments, 1 and 1) also reduces to 2;
those two values are the same; and so eq.refl 2
generates a proof that type-checks.
-/

/-
EXERCISE: Prove as a theorem, tthof (a silly and
uninformative name to be sure), that 2 + 3 = 1 + 4.

EXERCISE: Prove as a theorem, hpleqhl, that "Hello "
++ "Lean! is equal to "Hello Lean!" (these values
are of type string in Lean and the ++ operator here
refers to the string concatenation function in Lean.)
-/


-- Church numerals

-- Another way of doing nat.

-- The church nat, chℕ (happy to change the name) is a pi type
-- and not a structure. So proofs are not done by induction!
--import data.equiv
--open or

def chℕ := Π X : Type, (X → X) → X → X

def chℕfree := {m : Π X : Type, (X → X) → X → X // ∀ (X Y : Type) (a : X → Y) (f : X → X) (x : X),
  m (X → Y) (λ g, g ∘ f) a x = a (m X f x)}

namespace chnat

-- forgetful functor
definition of_chnatfree : chℕfree → chℕ := λ m, m.val

-- we can go back from chℕ to ℕ
definition to_nat : chℕ → ℕ := λ m, m ℕ nat.succ 0 -- there is a beauty here
-- it is almost as if the structure ℕ were built to be fed into chℕ
-- chℕ is the church encoding of ℕ.

--open nat
-- map from normal nats
open nat
def of_nat : ℕ → chℕ
| (zero) := λ X f x, x
| (succ n) := λ X f x, f (of_nat n X f x) --this works

theorem nat_of_chnat_of_nat (n : ℕ) : to_nat (of_nat n) = n := begin
  induction n with d Hd,
  -- n = 0 case
  { refl },
  -- n = d + 1
  unfold of_nat,
  intros,unfold to_nat,
  unfold to_nat at Hd,
  rw Hd,
end

definition of_nat' : ℕ → chℕ
| 0 := λ X f x, x
| (n + 1) := λ X f x, of_nat' n X f (f x) --a bit different

-- Might need to write a different destructor for ℕ? True for n implies true for 1 + n?

-- broken and I don't kow why

/-
theorem of_nat'_is_of_nat (n : ℕ) : of_nat n = of_nat' n :=
begin
induction n with d Hd,
{ refl},
unfold of_nat,
unfold of_nat',
funext,
rw Hd,
conv {
  to_rhs,
  rw ←Hd,
},
--clear Hd,
cases d with e,
{ refl},
unfold of_nat at *,
unfold of_nat' at *,
exact Hd, -- error is here
end
-/

variable (n : ℕ)
#reduce (n + 1)

lemma of_nat_functorial (n : ℕ) (X Y : Type) (a : X → Y) (f : X → X) (x : X) :
a (of_nat n X f x) = of_nat n (X → Y) (λ g x', g (f x')) a x :=
begin
induction n with d Hd,refl,
unfold of_nat, -- I have the wrong constructor.
end

#check of_nat_functorial

theorem of_nat_is_chnatfree (n : ℕ) :
∀ (X Y : Type) (a : X → Y) (f : X → X) (x : X),
  (of_nat n) (X → Y) (λ g, g ∘ f) a x = a ((of_nat n) X f x) := begin
  induction n with d Hd,
    -- base case
    intros,refl,

  -- inductive step
  intros,unfold of_nat,
  -- v1
  have H1 := Hd X Y (a ∘ f) f x,
  -- goal : f (of_nat d X f x) = of_nat d X f (f x)
  have H2 := Hd X Y a f (f x),

admit,
end

--| 0 := ⟨λ X f x, x,by intros;refl⟩
--| (succ n) := ⟨λ X f x,
--  f ((of_nat n).val X f x),
--    by {intros,have H := (of_nat n).property X Y a h x,simp * at *, rw ←H,sorry}⟩
--  (of_nat n).val X f $ f x,
--    by {intros, have H := (of_nat n).property X Y a f (f x),rw ←H,
--    show (of_nat n).val (X → Y) (λ (g : X → Y), g ∘ f) (a ∘ f) x =
--    (of_nat n).val (X → Y) (λ (g : X → Y), g ∘ f) a (f x),
--    exact _}⟩
-- can I close nat now?

-- examples of chnats
def c0 := of_nat 0
def c1 := of_nat 1
def c2 := of_nat 2
def c3 := of_nat 3

-- now we have some constants.

-- what is zero?
example (X f x) : c0 X f x = x := rfl
-- what is one?
example (X f x) : c1 X f x = f x := rfl
-- what is two?
example (X f x) : c2 X f x = f (f x) := rfl
-- what is three?
example (X f x) : c3 X f x = f (f (f x)) := rfl
-- and so on

-- that definition needs to be moved if we can't prove functoriality wrt succ

example : to_nat c3 = 3 := rfl

-- exercise: define succ
def succ :chℕ → chℕ := sorry -- KB can do this one
-- no notation

--unit tests -- KB can pass these
example : succ c0 = c1 := sorry
example : succ c2 = c3 := sorry

example (n : ℕ) : of_nat (nat.succ n) = succ (of_nat n) := sorry

--KB can't do this one. Is it unprovable? If so, move definition of to_nat much further down.
example (m : chℕ) : to_nat (succ m) = nat.succ (to_nat m) := sorry

-- exercise : define add
def add : chℕ → chℕ → chℕ := sorry -- KB can do this
instance : has_add chℕ := ⟨add⟩ -- now we have + notation

example : c2 + c1 = c3 := sorry
-- KB didn't do this one yet but feels it should be true.
example (m n : ℕ) : of_nat (m + n) = of_nat m + of_nat n := sorry

-- exercise : define mul
def mul : chℕ → chℕ → chℕ := sorry -- KB can do this
instance : has_mul chℕ := ⟨mul⟩ -- incantation to give us *

-- KB can do this one
example : c1 + c2 + c3 = c2 * c3 := sorry
-- KB didn't try this one
example (m n : ℕ) : of_nat (m * n) = of_nat m * of_nat n := sorry

-- exercise : define pow
def pow : chℕ → chℕ → chℕ := sorry -- KB can do this one
-- instance : has_pow chℕ := ⟨pow⟩ -- doesn't seem to work

-- KB can do this
example : pow c2 c3 + c1 = pow c3 c2 := sorry
-- KB didn't try this
example (m n : ℕ) : nat.pow m n = pow (of_nat m) (of_nat n) := sorry

-- exercise : define Ackermann
def ack : chℕ → chℕ → chℕ := sorry -- KB didn't try this one
-- Is it possible?

-- if it's possible, prove it agrees with usual ackermnann
-- example : ack m n = ack (of_nat m) (of_nat n) := sorry

-- question : Is this provable? KB couldn't do this one
theorem add_comm (m n : chℕ) : m + n = n + m := sorry

-- KB thinks this might be chℕ's free theorem
-- KB can't prove it
theorem free_chnat : ∀ (A B : Type), ∀ f : A → B,
∀ r : chℕ, ∀ a : A, r (A → B) (λ g,f) f a  = r (A → B) (λ g,g) f a
 := sorry

structure equiv' (α : Sort*) (β : Sort*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : ∀ (x : α), inv_fun (to_fun x) = x)
(right_inv : ∀ (y : β), to_fun (inv_fun y) = y)

-- is ℕ equiv to chℕ ?

theorem ij : ∀ n : ℕ, to_nat (of_nat n) = n := begin
intro n,
induction n with d Hd,refl,
unfold of_nat,
unfold to_nat,
unfold to_nat at Hd,
rw Hd,
end

-- KB can't do this one
theorem ji : ∀ c : chℕ, of_nat (to_nat c) = c := sorry
-- Can someone write down an uncomputable counterexample?

-- so KB can't do this either
definition ℕ_is_chℕ : equiv' ℕ chℕ := sorry

-- idle question
theorem is_it_true (X : Type) (f : X → X) (x : X) : f x = x := sorry

end chnat


/- Even more induction! -/

variable (r : α → α → Prop)

-- The reflexive transitive closure of `r` as an inductive predicate
inductive RTC : α → α → Prop where
  -- Notice how declaring `r` as a `variable` instead of as a parameter instead of declaring it
  -- directly as a parameter of `RTC` means we don't have to write `RTC r a a` inside the
  -- declaration of `RTC`. This also works with recursive `def`s!
  | refl : RTC a a
  | trans : r a b → RTC b c → RTC a c

-- We have arbitrarily chosen a "left-biased" definition of `RTC.trans`, but can easily show the
-- mirror version by induction on the predicate
theorem RTC.trans' : RTC r a b → r b c → RTC r a c := by
  intros hab hbc
  induction hab with
  | refl => _
  -- `a/b/c` in the constructor `RTC.trans` are marked as *implicit* because we didn't specify them
  -- explicitly.
  -- Just like in other contexts, we can use `@` to specify/match implicit parameters in `induction`.
  | @trans a a' b haa' ha'b ih =>

open Nat

-- By the way, we can leave out `:= fun p1 ... => match p1, ... with` at `def`
def double : Nat → Nat
  | zero   => 0
  | succ n => succ (succ (double n))

theorem double.inj : double n = double m → n = m := by
  intro h
  -- Try to finish this proof. You might find that the inductive case is impossible to solve!
  -- Do you see a different approach? If not, read on!
  induction n with

-- The issue with the above approach is that our inductive hypothesis is not sufficiently general!
-- When we begin induction, we have already fixed (introduced) a particular `m`, but for the inductive
-- step we need the inductive hypothesis for a *different* m.
-- We could avoid this by carefully introducing `m` (and `h`, which depends on it) only after `induction`:
-- ```
-- theorem double.inj : ∀ m, double n = double m → n = m := by
--   induction n with
--   | zero => intro m h; ...
--   ...
-- ```
-- `induction` even allows us to apply a tactic before *each* case:
-- ```
-- theorem double.inj : ∀ m, double n = double m → n = m := by
--   induction n with
--       intro m h
--   | zero => ...
--   ...
-- ```
-- However, it turns out that we do not have to change the theorem statement at all: if we simply say
-- ```
-- induction n generalizing m with
-- ```
-- then `induction` will automatically `revert` (yes, that's also a tactic) and re`intro`duce the variable(s)
-- before/after induction for us! So add `generalizing m` above, see how the inductive hypothesis is
-- affected, and then go finish that proof!

/- Partial & dependent maps -/

-- *Partial maps* are a useful data type for the semantics project and many other topics.
-- They map *some* keys of one type to values of another type.
abbrev Map (α β : Type) := α → Option β
-- We express partiality via the `Option` type, which either holds `some b` for `b : β`, or `none`.
-- Ctrl+click it for the whole definition.

namespace Map

def empty : Map α β := fun k => none

-- If we wanted a partial map for programming, we might choose a more efficient implementation such
-- as a search tree or a hash map. If, on the other hand, we are only interested in using it in a
-- formalization, a simple function like above is usually the simpler solution. For example, a
-- simple typing context `Γ` can be formalized as a partial map from variable names to their types.

-- The function-based definition makes defining operations such as a map update quite easy:

/-- Set the entry `k` of the map `m` to the value `v`. All other entries are unchanged. -/
def update [DecidableEq α] (m : Map α β) (k : α) (v : Option β) : Map α β := _

-- A `scoped` notation is activated only when opening/inside the current namespace
scoped notation:max m "[" k " ↦ " v "]" => update m k v

theorem apply_update [DecidableEq α] (m : Map α β) : m[k ↦ v] k = v := by

-- hint: use function extensionality (`apply funext`)
theorem update_self [DecidableEq α] (m : Map α β) : m[k ↦ m k] = m := by

end Map

-- One interesting generalization of partial maps we can express in Lean are *dependent maps* where
-- the *type* of the value may depend on the key:
abbrev DepMap (α : Type) (β : α → Type) := (k : α) → Option (β k)

namespace DepMap

def empty : DepMap α β := fun k => none

-- If we try to define `update` as above, it turns out that we run into a type error!
-- You may want to use the "dependent if" `if h : p then t else e` that makes a *proof* of
-- the condition `p` available in each branch: `h : p` in the `then` branch and `h : ¬p` in the
-- `else` branch. You should then be able to use rewriting (e.g. `▸`) to fix the type error.
def update [DecidableEq α] (m : DepMap α β) (k : α) (v : Option (β k)) : DepMap α β := _

local notation:max m "[" k " ↦ " v "]" => update m k v

-- This one should be as before...
theorem apply_update [DecidableEq α] (m : DepMap α β) : m[k ↦ v] k = v := by

-- ...but this one is where the fun starts: try replicating the corresponding `Map` proof...
theorem update_self [DecidableEq α] (m : DepMap α β) : m[k ↦ m k] = m := by
-- and you should end up with an unsolved goal containing a subterm of the shape `(_ : a = b) ▸ c`. This
-- is the rewrite from `update`; the proof is elided as `_` by default because, as we said in week 1, Lean
-- considers all proofs of a proposition as equal, so we really don't care what proof is displayed there.
-- So how do we get rid of the `▸`? We know it is something like a match  on `Eq.refl`; more formally,
-- both `▸` and such a match compile down to an application of `Eq`'s *recursor* (week 3).
-- We know matches/recursors reduce ("go away") when applied to a matching constructor application,
-- i.e. for `▸` we have `(rfl ▸ c) ≡ c`.
-- So why didn't `simp` reduce away `(_ : a = b) ▸` if it works for `rfl` and all proofs are the same?
-- Well, all proofs of a *single* proposition are the same, but `rfl` is not a proof of `a = b` unless
-- `a` and `b` are in fact the same term! Thus the general way to get rid of `(_ : a = b) ▸` is to
-- first rewrite the goal with a proof of the very equality `a = b`. After that, `simp`, or definitional
-- equality in general, will get rid of the `▸`.
-- Now, for technical reasons we should use `rw` instead of `simp` itself to do this rewrite. The short
-- answer as to why that is is that `simp` tries to be *too clever* in this case: it will rewrite `a = b`
-- on both sides of the `▸` individually, which usually makes it more flexible (week 4, slide pages 17 & 20),
-- but in this case unfortunately leads to a type-incorrect proof. The "naive" strategy of `rw`, which will
-- simply replace all `a` with `b` everywhere simultaneously by applying the `Eq` recursor once at the root,
-- turns out to be the better approach in this case.
-- Phew, that was a lot of typing (in the theoretic sense and on my keyboard). If you can't get the proof to
-- work, don't worry about it, we will not bother you with this kind of "esoteric" proof again. If, on the
-- other hand, you are interested in this kind of strong dependent typing, we may have an interesting variant
-- of the semantics project to offer you next week!

end DepMap

open List Nat

/- Insertion Sort -/

-- We want to implement insertion sort in Lean and show that the resulting `List` is indeed sorted.
-- To that end, we first assume that the type `α` is of the type class `LE`, meaning that we can use
-- the symbol `≤` (\le) as notation.
-- We also assume (notice that cool dot notation) that this relation is decidable:
variable [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)]

-- First, we want to define a predicate that holds if a list is sorted.
-- The predicate should have three constructors:
-- The empty list `[]` and the single element list `[a]` are sorted,
-- and we can add `a` to the front of a sorted list `b :: l`, if `a ≤ b`.s
inductive Sorted : List α → Prop where

-- The main ingredient to insertion sort is a function `insertInOrder` which inserts
-- a given element `a` before the first entry `x` of a list for which `a ≤ x` holds.
-- Define that function by recursion on the list. Remember that `≤` is decidable.
def insertInOrder (a : α) (xs : List α) : List α := _

-- Now, see whether the function actually does what it should do.
#eval insertInOrder 4 [1, 3, 4, 6, 7]
#eval insertInOrder 4 [1, 2, 3]

-- Defining `insertionSort` itself is now an easy recursion.
def insertionSort (xs : List α) : List α := _

-- Let's test the sorting algorithm next.
#eval insertionSort [6, 2, 4, 4, 1, 3, 64]
#eval insertionSort [1, 2, 3]
#eval insertionSort (repeat (fun xs => xs.length :: xs) 500 [])

-- Now we want to move on to actually verify that the algorithm does what it claims to do!
-- To prove this, we don't need the relation to be transitive, but we need to assume the following property:
variable (antisymm : ∀ {x y : α}, ¬ x ≤ y → (y ≤ x))

-- Okay, now prove the statement itself!
-- Hints:
--   * You might at one point have the choice to either apply induction on a list or on a witness of `Sorted`.
--     Choose wisely.
--   * Remember the tactic `byCases` from the fifth exercise!

theorem sorted_insertionSort (as : List α) : Sorted (insertionSort as) := _

-- Here's a "soft" question: Have we now fully verified that `insertionSort` is a sorting algorithm?
-- What other property would be an obvious one to verify?


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.factors
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Prime
import Mathlib.Data.List.Prime
import Mathlib.Data.List.Sort
import Mathlib.Tactic.NthRewrite

/-!
# Prime numbers

This file deals with the factors of natural numbers.

## Important declarations

- `Nat.factors n`: the prime factorization of `n`
- `Nat.factors_unique`: uniqueness of the prime factorisation

-/

set_option autoImplicit false

open Bool Subtype

open Nat

namespace Nat

attribute [instance 0] instBEqNat

/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → List ℕ
  | 0 => []
  | 1 => []
  | k + 2 =>
    let m := minFac (k + 2)
    have : (k + 2) / m < (k + 2) := factors_lemma
    m :: factors ((k + 2) / m)
#align nat.factors Nat.factors

@[simp]
theorem factors_zero : factors 0 = [] := by rw [factors]
#align nat.factors_zero Nat.factors_zero

@[simp]
theorem factors_one : factors 1 = [] := by rw [factors]
#align nat.factors_one Nat.factors_one

theorem prime_of_mem_factors {n : ℕ} : ∀ {p : ℕ}, (h : p ∈ factors n) → Prime p := by
  match n with
  | 0 => simp
  | 1 => simp
  | k + 2 =>
      intro p h
      let m := minFac (k + 2)
      have : (k + 2) / m < (k + 2) := factors_lemma
      have h₁ : p = m ∨ p ∈ factors ((k + 2) / m) :=
        List.mem_cons.1 (by rwa [factors] at h)
      exact Or.casesOn h₁ (fun h₂ => h₂.symm ▸ minFac_prime (by simp)) prime_of_mem_factors
#align nat.prime_of_mem_factors Nat.prime_of_mem_factors

theorem pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p :=
  Prime.pos (prime_of_mem_factors h)
#align nat.pos_of_mem_factors Nat.pos_of_mem_factors

theorem prod_factors : ∀ {n}, n ≠ 0 → List.prod (factors n) = n
  | 0 => by simp
  | 1 => by simp
  | k + 2 => fun _ =>
    let m := minFac (k + 2)
    have : (k + 2) / m < (k + 2) := factors_lemma
    show (factors (k + 2)).prod = (k + 2) by
      have h₁ : (k + 2) / m ≠ 0 := fun h => by
        have : (k + 2) = 0 * m := (Nat.div_eq_iff_eq_mul_left (minFac_pos _) (minFac_dvd _)).1 h
        rw [zero_mul] at this; exact (show k + 2 ≠ 0 by simp) this
      rw [factors, List.prod_cons, prod_factors h₁, Nat.mul_div_cancel' (minFac_dvd _)]
#align nat.prod_factors Nat.prod_factors

theorem factors_prime {p : ℕ} (hp : Nat.Prime p) : p.factors = [p] := by
  have : p = p - 2 + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl
  rw [this, Nat.factors]
  simp only [Eq.symm this]
  have : Nat.minFac p = p := (Nat.prime_def_minFac.mp hp).2
  simp only [this, Nat.factors, Nat.div_self (Nat.Prime.pos hp)]
#align nat.factors_prime Nat.factors_prime

theorem factors_chain {n : ℕ} :
    ∀ {a}, (∀ p, Prime p → p ∣ n → a ≤ p) → List.Chain (· ≤ ·) a (factors n) := by
  match n with
  | 0 => simp
  | 1 => simp
  | k + 2 =>
      intro a h
      let m := minFac (k + 2)
      have : (k + 2) / m < (k + 2) := factors_lemma
      rw [factors]
      refine' List.Chain.cons ((le_minFac.2 h).resolve_left (by simp)) (factors_chain _)
      exact fun p pp d => minFac_le_of_dvd pp.two_le (d.trans <| div_dvd_of_dvd <| minFac_dvd _)
#align nat.factors_chain Nat.factors_chain

theorem factors_chain_2 (n) : List.Chain (· ≤ ·) 2 (factors n) :=
  factors_chain fun _ pp _ => pp.two_le
#align nat.factors_chain_2 Nat.factors_chain_2

theorem factors_sorted (n : ℕ) : List.Sorted (· ≤ ·) (factors n) :=
  List.chain'_iff_pairwise.1 (factors_chain' _)
#align nat.factors_sorted Nat.factors_sorted

/-- `factors` can be constructed inductively by extracting `minFac`, for sufficiently large `n`. -/
theorem factors_add_two (n : ℕ) :
    factors (n + 2) = minFac (n + 2) :: factors ((n + 2) / minFac (n + 2)) := by rw [factors]
#align nat.factors_add_two Nat.factors_add_two

@[simp]
theorem factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 := by
  constructor <;> intro h
  · rcases n with (_ | _ | n)
    · exact Or.inl rfl
    · exact Or.inr rfl
    · rw [factors] at h
      injection h
  · rcases h with (rfl | rfl)
    · exact factors_zero
    · exact factors_one
#align nat.factors_eq_nil Nat.factors_eq_nil

theorem eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) :
    a = b := by simpa [prod_factors ha, prod_factors hb] using List.Perm.prod_eq h
#align nat.eq_of_perm_factors Nat.eq_of_perm_factors

section

open List

theorem mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : Prime p) : p ∈ factors n ↔ p ∣ n :=
  ⟨fun h => prod_factors hn ▸ List.dvd_prod h, fun h =>
    mem_list_primes_of_dvd_prod (prime_iff.mp hp) (fun _ h => prime_iff.mp (prime_of_mem_factors h))
      ((prod_factors hn).symm ▸ h)⟩
#align nat.mem_factors_iff_dvd Nat.mem_factors_iff_dvd

theorem dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n := by
  rcases n.eq_zero_or_pos with (rfl | hn)
  · exact dvd_zero p
  · rwa [← mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h)]
#align nat.dvd_of_mem_factors Nat.dvd_of_mem_factors

theorem mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ Prime p ∧ p ∣ n :=
  ⟨fun h => ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩, fun ⟨hprime, hdvd⟩ =>
    (mem_factors_iff_dvd hn hprime).mpr hdvd⟩
#align nat.mem_factors Nat.mem_factors

theorem le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n := by
  rcases n.eq_zero_or_pos with (rfl | hn)
  · rw [factors_zero] at h
    cases h
  · exact le_of_dvd hn (dvd_of_mem_factors h)
#align nat.le_of_mem_factors Nat.le_of_mem_factors

/-- **Fundamental theorem of arithmetic**-/
theorem factors_unique {n : ℕ} {l : List ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, Prime p) :
    l ~ factors n := by
  refine' perm_of_prod_eq_prod _ _ _
  · rw [h₁]
    refine' (prod_factors _).symm
    rintro rfl
    rw [prod_eq_zero_iff] at h₁
    exact Prime.ne_zero (h₂ 0 h₁) rfl
  · simp_rw [← prime_iff]
    exact h₂
  · simp_rw [← prime_iff]
    exact fun p => prime_of_mem_factors
#align nat.factors_unique Nat.factors_unique

theorem Prime.factors_pow {p : ℕ} (hp : p.Prime) (n : ℕ) :
    (p ^ n).factors = List.replicate n p := by
  symm
  rw [← List.replicate_perm]
  apply Nat.factors_unique (List.prod_replicate n p)
  intro q hq
  rwa [eq_of_mem_replicate hq]
#align nat.prime.factors_pow Nat.Prime.factors_pow

theorem eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0)
    (h : ∀ {d}, Nat.Prime d → d ∣ n → d = p) : n = p ^ n.factors.length := by
  set k := n.factors.length
  rw [← prod_factors hpos, ← prod_replicate k p,
    eq_replicate_of_mem fun d hd => h (prime_of_mem_factors hd) (dvd_of_mem_factors hd)]
#align nat.eq_prime_pow_of_unique_prime_dvd Nat.eq_prime_pow_of_unique_prime_dvd

/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
theorem perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
    (a * b).factors ~ a.factors ++ b.factors := by
  refine' (factors_unique _ _).symm
  · rw [List.prod_append, prod_factors ha, prod_factors hb]
  · intro p hp
    rw [List.mem_append] at hp
    cases' hp with hp' hp' <;> exact prime_of_mem_factors hp'

#align nat.perm_factors_mul Nat.perm_factors_mul

/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
theorem perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
    (a * b).factors ~ a.factors ++ b.factors := by
  rcases a.eq_zero_or_pos with (rfl | ha)
  · simp [(coprime_zero_left _).mp hab]
  rcases b.eq_zero_or_pos with (rfl | hb)
  · simp [(coprime_zero_right _).mp hab]
  exact perm_factors_mul ha.ne' hb.ne'
#align nat.perm_factors_mul_of_coprime Nat.perm_factors_mul_of_coprime

theorem factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors := by
  cases' n with hn
  · simp [zero_mul]
  apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _)
  simp [(perm_factors_mul (Nat.succ_ne_zero _) h).subperm_left]
  exact (sublist_append_left _ _).subperm
#align nat.factors_sublist_right Nat.factors_sublist_right

theorem factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors := by
  obtain ⟨a, rfl⟩ := h
  exact factors_sublist_right (right_ne_zero_of_mul h')
#align nat.factors_sublist_of_dvd Nat.factors_sublist_of_dvd

theorem factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors :=
  (factors_sublist_right h).subset
#align nat.factors_subset_right Nat.factors_subset_right

theorem factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors :=
  (factors_sublist_of_dvd h h').subset
#align nat.factors_subset_of_dvd Nat.factors_subset_of_dvd

theorem dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b := by
  rcases b.eq_zero_or_pos with (rfl | hb)
  · exact dvd_zero _
  rcases a with (_ | _ | a)
  · exact (ha rfl).elim
  · exact one_dvd _
  --Porting note: previous proof
  --use (b.factors.diff a.succ.succ.factors).prod
  use (@List.diff _ instBEq b.factors a.succ.succ.factors).prod
  nth_rw 1 [← Nat.prod_factors ha]
  rw [← List.prod_append,
    List.Perm.prod_eq <| List.subperm_append_diff_self_of_count_le <| List.subperm_ext_iff.mp h,
    Nat.prod_factors hb.ne']
#align nat.dvd_of_factors_subperm Nat.dvd_of_factors_subperm

end

theorem mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} :
    p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors := by
  rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ← and_or_left]
  simpa only [and_congr_right_iff] using Prime.dvd_mul
#align nat.mem_factors_mul Nat.mem_factors_mul

/-- The sets of factors of coprime `a` and `b` are disjoint -/
theorem coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) :
    List.Disjoint a.factors b.factors := by
  intro q hqa hqb
  apply not_prime_one
  rw [← eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)]
  exact prime_of_mem_factors hqa
#align nat.coprime_factors_disjoint Nat.coprime_factors_disjoint

theorem mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ) :
    p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors := by
  rcases a.eq_zero_or_pos with (rfl | ha)
  · simp [(coprime_zero_left _).mp hab]
  rcases b.eq_zero_or_pos with (rfl | hb)
  · simp [(coprime_zero_right _).mp hab]
  rw [mem_factors_mul ha.ne' hb.ne', List.mem_union]
#align nat.mem_factors_mul_of_coprime Nat.mem_factors_mul_of_coprime

open List

/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/
theorem mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a * b).factors :=
  by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simp at hpa
  apply (mem_factors_mul ha hb).2 (Or.inl hpa)
#align nat.mem_factors_mul_left Nat.mem_factors_mul_left

/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/
theorem mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) :
    p ∈ (a * b).factors := by
  rw [mul_comm]
  exact mem_factors_mul_left hpb ha
#align nat.mem_factors_mul_right Nat.mem_factors_mul_right

theorem eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) :
    (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, Nat.Prime p ∧ p ∣ n ∧ Odd p :=
  (eq_or_ne n 0).elim (fun hn => Or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩) fun hn =>
    or_iff_not_imp_right.mpr fun H =>
      ⟨n.factors.length,
        eq_prime_pow_of_unique_prime_dvd hn fun {_} hprime hdvd =>
          hprime.eq_two_or_odd'.resolve_right fun hodd => H ⟨_, hprime, hdvd, hodd⟩⟩
#align nat.eq_two_pow_or_exists_odd_prime_and_dvd Nat.eq_two_pow_or_exists_odd_prime_and_dvd

end Nat

-- Porting note: `assert_not_exists` is not implemented yet.
--assert_not_exists Multiset


-- Potencias_de_potencias_en_monoides.lean
-- Potencias de potencias en monoides
-- José A. Alonso Jiménez
-- Sevilla, 9 de julio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En los [monoides](https://en.wikipedia.org/wiki/Monoid) se define la
-- potencia con exponentes naturales. En Lean la potencia x^n se
-- se caracteriza por los siguientes lemas:
--    pow_zero : x^0 = 1
--    pow_succ' : x^(succ n) = x * x^n
--
-- Demostrar que si M, a ∈ M y m, n ∈ ℕ, entonces
--    a^(m * n) = (a^m)^n
--
-- Indicación: Se puede usar el lema
--    pow_add : a^(m + n) = a^m * a^n
-- ---------------------------------------------------------------------

import algebra.group_power.basic
open monoid nat

variables {M : Type} [monoid M]
variable  a : M
variables (m n : ℕ)

-- Para que no use la notación con puntos
set_option pp.structure_projections false

-- 1ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
begin
  induction n with n HI,
  { calc a^(m * 0)
         = a^0             : congr_arg ((^) a) (nat.mul_zero m)
     ... = 1               : pow_zero a
     ... = (a^m)^0         : (pow_zero (a^m)).symm },
  { calc a^(m * succ n)
         = a^(m * n + m)   : congr_arg ((^) a) (nat.mul_succ m n)
     ... = a^(m * n) * a^m : pow_add a (m * n) m
     ... = (a^m)^n * a^m   : congr_arg (* a^m) HI
     ... = (a^m)^(succ n)  : (pow_succ' (a^m) n).symm },
end

-- 2ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
begin
  induction n with n HI,
  { calc a^(m * 0)
         = a^0             : by simp only [nat.mul_zero]
     ... = 1               : by simp only [pow_zero]
     ... = (a^m)^0         : by simp only [pow_zero] },
  { calc a^(m * succ n)
         = a^(m * n + m)   : by simp only [nat.mul_succ]
     ... = a^(m * n) * a^m : by simp only [pow_add]
     ... = (a^m)^n * a^m   : by simp only [HI]
     ... = (a^m)^succ n    : by simp only [pow_succ'] },
end

-- 3ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
begin
  induction n with n HI,
  { calc a^(m * 0)
         = a^0             : by simp [nat.mul_zero]
     ... = 1               : by simp
     ... = (a^m)^0         : by simp },
  { calc a^(m * succ n)
         = a^(m * n + m)   : by simp [nat.mul_succ]
     ... = a^(m * n) * a^m : by simp [pow_add]
     ... = (a^m)^n * a^m   : by simp [HI]
     ... = (a^m)^succ n    : by simp [pow_succ'] },
end

-- 4ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
begin
  induction n with n HI,
  { by simp [nat.mul_zero] },
  { by simp [nat.mul_succ,
             pow_add,
             HI,
             pow_succ'] },
end

-- 5ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
begin
  induction n with n HI,
  { rw nat.mul_zero,
    rw pow_zero,
    rw pow_zero, },
  { rw nat.mul_succ,
    rw pow_add,
    rw HI,
    rw pow_succ', }
end

-- 6ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
begin
  induction n with n HI,
  { rw [nat.mul_zero, pow_zero, pow_zero] },
  { rw [nat.mul_succ, pow_add, HI, pow_succ'] }
end

-- 7ª demostración
-- ===============

example : a^(m * n) = (a^m)^n :=
pow_mul a m n


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

! This file was ported from Lean 3 source module group_theory.subsemigroup.center
! leanprover-community/mathlib commit a437a2499163d85d670479f69f625f461cc5fef9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Defs
import Mathlib.GroupTheory.Subsemigroup.Operations

/-!
# Centers of magmas and semigroups

## Main definitions

* `Set.center`: the center of a magma
* `Subsemigroup.center`: the center of a semigroup
* `Set.addCenter`: the center of an additive magma
* `AddSubsemigroup.center`: the center of an additive semigroup

We provide `Submonoid.center`, `AddSubmonoid.center`, `Subgroup.center`, `AddSubgroup.center`,
`Subsemiring.center`, and `Subring.center` in other files.
-/

variable {M : Type _}

namespace Set

variable (M)

/-- The center of a magma. -/
@[to_additive addCenter " The center of an additive magma. "]
def center [Mul M] : Set M :=
  { z | ∀ m, m * z = z * m }
#align set.center Set.center
#align set.add_center Set.addCenter

-- porting note: The `to_additive` version used to be `mem_addCenter` without the iff
@[to_additive mem_addCenter_iff]
theorem mem_center_iff [Mul M] {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g :=
  Iff.rfl
#align set.mem_center_iff Set.mem_center_iff
#align set.mem_add_center Set.mem_addCenter_iff

instance decidableMemCenter [Mul M] [∀ a : M, Decidable <| ∀ b : M, b * a = a * b] :
    DecidablePred (· ∈ center M) := fun _ => decidable_of_iff' _ (mem_center_iff M)
#align set.decidable_mem_center Set.decidableMemCenter

@[to_additive (attr := simp) zero_mem_addCenter]
theorem one_mem_center [MulOneClass M] : (1 : M) ∈ Set.center M := by simp [mem_center_iff]
#align set.one_mem_center Set.one_mem_center
#align set.zero_mem_add_center Set.zero_mem_addCenter

@[simp]
theorem zero_mem_center [MulZeroClass M] : (0 : M) ∈ Set.center M := by simp [mem_center_iff]
#align set.zero_mem_center Set.zero_mem_center

variable {M}

@[to_additive (attr := simp) add_mem_addCenter]
theorem mul_mem_center [Semigroup M] {a b : M} (ha : a ∈ Set.center M) (hb : b ∈ Set.center M) :
    a * b ∈ Set.center M := fun g => by rw [mul_assoc, ← hb g, ← mul_assoc, ha g, mul_assoc]
#align set.mul_mem_center Set.mul_mem_center
#align set.add_mem_add_center Set.add_mem_addCenter

@[to_additive (attr := simp) neg_mem_addCenter]
theorem inv_mem_center [Group M] {a : M} (ha : a ∈ Set.center M) :
    a⁻¹ ∈ Set.center M := fun g => by
  rw [← inv_inj, mul_inv_rev, inv_inv, ← ha, mul_inv_rev, inv_inv]
#align set.inv_mem_center Set.inv_mem_center
#align set.neg_mem_add_center Set.neg_mem_addCenter

@[simp]
theorem add_mem_center [Distrib M] {a b : M} (ha : a ∈ Set.center M) (hb : b ∈ Set.center M) :
    a + b ∈ Set.center M := fun c => by rw [add_mul, mul_add, ha c, hb c]
#align set.add_mem_center Set.add_mem_center

@[simp]
theorem neg_mem_center [Ring M] {a : M} (ha : a ∈ Set.center M) : -a ∈ Set.center M := fun c => by
  rw [← neg_mul_comm, ha (-c), neg_mul_comm]
#align set.neg_mem_center Set.neg_mem_center

@[to_additive subset_addCenter_add_units]
theorem subset_center_units [Monoid M] : ((↑) : Mˣ → M) ⁻¹' center M ⊆ Set.center Mˣ :=
  fun _ ha _ => Units.ext <| ha _
#align set.subset_center_units Set.subset_center_units
#align set.subset_add_center_add_units Set.subset_addCenter_add_units

theorem center_units_subset [GroupWithZero M] : Set.center Mˣ ⊆ ((↑) : Mˣ → M) ⁻¹' center M :=
  fun a ha b => by
  obtain rfl | hb := eq_or_ne b 0
  · rw [zero_mul, mul_zero]
  · exact Units.ext_iff.mp (ha (Units.mk0 _ hb))
#align set.center_units_subset Set.center_units_subset

/-- In a group with zero, the center of the units is the preimage of the center. -/
theorem center_units_eq [GroupWithZero M] : Set.center Mˣ = ((↑) : Mˣ → M) ⁻¹' center M :=
  Subset.antisymm center_units_subset subset_center_units
#align set.center_units_eq Set.center_units_eq

@[simp]
theorem inv_mem_center₀ [GroupWithZero M] {a : M} (ha : a ∈ Set.center M) : a⁻¹ ∈ Set.center M := by
  obtain rfl | ha0 := eq_or_ne a 0
  · rw [inv_zero]
    exact zero_mem_center M
  rcases IsUnit.mk0 _ ha0 with ⟨a, rfl⟩
  rw [← Units.val_inv_eq_inv_val]
  exact center_units_subset (inv_mem_center (subset_center_units ha))
#align set.inv_mem_center₀ Set.inv_mem_center₀

@[to_additive (attr := simp) sub_mem_addCenter]
theorem div_mem_center [Group M] {a b : M} (ha : a ∈ Set.center M) (hb : b ∈ Set.center M) :
    a / b ∈ Set.center M := by
  rw [div_eq_mul_inv]
  exact mul_mem_center ha (inv_mem_center hb)
#align set.div_mem_center Set.div_mem_center
#align set.sub_mem_add_center Set.sub_mem_addCenter

@[simp]
theorem div_mem_center₀ [GroupWithZero M] {a b : M} (ha : a ∈ Set.center M)
    (hb : b ∈ Set.center M) : a / b ∈ Set.center M := by
  rw [div_eq_mul_inv]
  exact mul_mem_center ha (inv_mem_center₀ hb)
#align set.div_mem_center₀ Set.div_mem_center₀

variable (M)

@[to_additive (attr := simp) addCenter_eq_univ]
theorem center_eq_univ [CommSemigroup M] : center M = Set.univ :=
  (Subset.antisymm (subset_univ _)) fun x _ y => mul_comm y x
#align set.center_eq_univ Set.center_eq_univ
#align set.add_center_eq_univ Set.addCenter_eq_univ

end Set

namespace Subsemigroup

section

variable (M) [Semigroup M]

/-- The center of a semigroup `M` is the set of elements that commute with everything in `M` -/
@[to_additive
      "The center of a semigroup `M` is the set of elements that commute with everything in `M`"]
def center : Subsemigroup M where
  carrier := Set.center M
  mul_mem':= Set.mul_mem_center
#align subsemigroup.center Subsemigroup.center
#align add_subsemigroup.center AddSubsemigroup.center

-- porting note: `coe_center` is now redundant
#noalign subsemigroup.coe_center
#noalign add_subsemigroup.coe_center

variable {M}

@[to_additive]
theorem mem_center_iff {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g :=
  Iff.rfl
#align subsemigroup.mem_center_iff Subsemigroup.mem_center_iff
#align add_subsemigroup.mem_center_iff AddSubsemigroup.mem_center_iff

@[to_additive]
instance decidableMemCenter (a) [Decidable <| ∀ b : M, b * a = a * b] : Decidable (a ∈ center M) :=
  decidable_of_iff' _ mem_center_iff
#align subsemigroup.decidable_mem_center Subsemigroup.decidableMemCenter
#align add_subsemigroup.decidable_mem_center AddSubsemigroup.decidableMemCenter

/-- The center of a semigroup is commutative. -/
@[to_additive "The center of an additive semigroup is commutative."]
instance : CommSemigroup (center M) :=
  { MulMemClass.toSemigroup (center M) with mul_comm := fun _ b => Subtype.ext <| b.2 _ }

end

section

variable (M) [CommSemigroup M]

@[to_additive (attr := simp)]
theorem center_eq_top : center M = ⊤ :=
  SetLike.coe_injective (Set.center_eq_univ M)
#align subsemigroup.center_eq_top Subsemigroup.center_eq_top
#align add_subsemigroup.center_eq_top AddSubsemigroup.center_eq_top

end

end Subsemigroup

-- Guard against import creep
-- Porting note: Not implemented yet
-- assert_not_exists finset


import tactic

/-

# Prove that there exists infinitely many positive integers n such that
# 4n² + 1 is divisible both by 5 and 13.

This is the third question in Sierpinski's book "250 elementary problems
in number theory".

maths proof: if n=1 then 4n^2+1 is divisible by 5
so if n=1 mod 5 then 4n^2+1 will be divisible by 5

in fact if n=4 then 4n^2+1 is divisible by both 5 and 13
so if n=4+65*t then this will work
-/

lemma divides_of_cong_four (t : ℕ) : 5 ∣ 4 * (65 * t + 4)^2 + 1 ∧
13 ∣ 4 * (65 * t + 4)^2 + 1 :=
begin
  split,
  { use 3380*t^2 + 416*t + 13,
    ring },
  { use 1300*t^2 + 160*t + 5,
    ring }
end

lemma arb_large_soln : ∀ N : ℕ, ∃ n > N, 5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1 :=
begin
  intro N,
  -- need to find t such that 65t+4>N
  use 65 * N + 4,
  split,
  { linarith },
  { apply divides_of_cong_four }
end

lemma infinite_iff_arb_large (S : set ℕ) : S.infinite ↔ ∀ N, ∃ n > N, n ∈ S :=
begin
  split,
  { intro h,
    have h2 := set.infinite.exists_nat_lt h,
    intro n,
    rcases h2 n with ⟨m, hm, h3⟩,
    use m,
    exact ⟨h3, hm⟩,
  },
  { contrapose!,
    intro h,
    rw set.not_infinite at h,
    let S2 : finset ℕ := set.finite.to_finset h,
    have h2 : ∃ B, ∀n ∈ S2, n ≤ B,
    { use finset.sup S2 id,
      intros,
      apply finset.le_sup H },
    cases h2 with N hN,
    use N,
    have h3 : ∀n : ℕ, n ∈ S ↔ n ∈ S2,
      intro n,
      exact (set.finite.mem_to_finset h).symm,
    intros n hn h4,
    rw h3 at h4,
    specialize hN n h4,
    linarith,
  }
end

example : {n : ℕ | 5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1}.infinite :=
begin
  rw infinite_iff_arb_large,
  exact arb_large_soln,
end


import MyNat.Definition
namespace MyNat
open MyNat

/-!
# Function world.

## Level 8: `(P → Q) → ((Q → empty) → (P → empty))`

Level 8 is the same as level 7, except we have replaced the
set  `F` with the empty set `∅`. The same proof will work (after all, our
previous proof worked for all sets, and the empty set is a set).
But note that if you start with `intro f; intro h; intro p,`
(which can incidentally be shortened to `intros f h p`,
see [intros tactic](../Tactics/intros.lean.md)),
then the local context looks like this:

```
P Q : Type,
f : P → Q,
h : Q → empty,
p : P
⊢ empty
```

and your job is to construct an element of the empty set!
This on the face of it seems hard, but what is going on is that
our hypotheses (we have an element of  `P `, and functions  `P → Q`
and  `Q → ∅`) are themselves contradictory, so
I guess we are doing some kind of proof by contradiction at this point? However,
if your next line is `apply h` then all of a sudden the goal
seems like it might be possible again. If this is confusing, note
that the proof of the previous world worked for all sets  `F `, so in particular
it worked for the empty set, you just probably weren't really thinking about
this case explicitly beforehand. [Technical note to constructivists: I know
that we are not doing a proof by contradiction. But how else do you explain
to a classical mathematician that their goal is to prove something false
and this is OK because their hypotheses don't add up?]

## Definition

Whatever the sets  `P ` and  `Q ` are, we
make an element of \\(\operatorname{Hom}(\operatorname{Hom}(P,Q),
\operatorname{Hom}(\operatorname{Hom}(Q,\emptyset),\operatorname{Hom}(P,\emptyset)))\\).
-/
example (P Q : Type) : (P → Q) → ((Q → empty) → (P → empty)) := by
  intros f h p
  apply h
  apply f
  exact p

/-!

Next up [Level 9](./Level9.lean.md)
-/


import formula

/- The soundness and completeness theorems are always proven with respect to a
semantics. In this file we define the usual truth-value based reasoning
system, where formulas are evaluated to the truth value they denote. The
evaluation is based on what truth values are assigned to the variables, so a
semantic model of propositional logic in this system is a truth assignment
function to the propositional variables. We also define some related notions
such as satisfiability.
-/

variable {vars : Type}

/-- Evaluates formulas to truth values given a propositional variable
    truth assignment `v`. -/
def eval (v : vars → bool) : Form vars → bool
| ⊥       := ff
| ⦃x⦄     := v x
| (~ P)   := not (eval P)
| (P ⋀ Q) := and (eval P) (eval Q)
| (P ⋁ Q) := or (eval P) (eval Q)

notation `⟦` P `⟧_` v := eval v P
notation v ` ⊨ ` A := ⟦A⟧_v
notation v ` ⊨ ` Γ := ∀ γ, γ ∈ Γ → ⟦γ⟧_v

theorem no_bot (v : vars → bool) : ¬ (↥(v ⊨ ⊥)) :=
by simp [eval]

/-- A set of formulas Γ semantically entail another formula A iff
all the models of Γ are models of A. -/
def entail (Γ : set (Form vars)) (A : Form vars) : Prop :=
∀ (v : vars → bool), (v ⊨ Γ) → (v ⊨ A)

notation Γ ` ⊨ ` A := entail Γ A
notation Γ ` ⊭ ` A := ¬ entail Γ A

/-- A set of formulas are satisfiable iff it has a model. -/
def satisfiable (Γ : set (Form vars)) : Prop :=
∃ (v : vars → bool), v ⊨ Γ

/-- A set of formulas are satisfiable iff it has no model. -/
def unsatisfiable (Γ : set (Form vars)) : Prop :=
¬ satisfiable Γ

variable {Γ : set (Form vars)}

theorem satisfiable_iff : satisfiable Γ ↔ (Γ ⊭ ⊥) :=
by simp [satisfiable, entail, eval]

theorem unsatisfiable_iff : unsatisfiable Γ ↔ (Γ ⊨ ⊥) :=
by simp [unsatisfiable, satisfiable_iff]

#lint


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.pgame
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Basic definitions about who has a winning stratergy

We define `G.first_loses`, `G.first_wins`, `G.left_wins` and `G.right_wins` for a pgame `G`, which
means the second, first, left and right players have a winning strategy respectively.
These are defined by inequalities which can be unfolded with `pgame.lt_def` and `pgame.le_def`.
-/

namespace pgame

/-- The player who goes first loses -/
def first_loses (G : pgame) :=
  G ≤ 0 ∧ 0 ≤ G

/-- The player who goes first wins -/
def first_wins (G : pgame) :=
  0 < G ∧ G < 0

/-- The left player can always win -/
def left_wins (G : pgame) :=
  0 < G ∧ 0 ≤ G

/-- The right player can always win -/
def right_wins (G : pgame) :=
  G ≤ 0 ∧ G < 0

theorem zero_first_loses : first_loses 0 :=
  { left := le_refl 0, right := le_refl 0 }

theorem one_left_wins : left_wins 1 := sorry

theorem star_first_wins : first_wins star :=
  { left := zero_lt_star, right := star_lt_zero }

theorem omega_left_wins : left_wins omega := sorry

theorem winner_cases (G : pgame) : left_wins G ∨ right_wins G ∨ first_loses G ∨ first_wins G := sorry

theorem first_loses_is_zero {G : pgame} : first_loses G ↔ equiv G 0 :=
  iff.refl (first_loses G)

theorem first_loses_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : first_loses G → first_loses H :=
  fun (hGp : first_loses G) =>
    { left := le_of_equiv_of_le (and.symm h) (and.left hGp), right := le_of_le_of_equiv (and.right hGp) h }

theorem first_wins_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : first_wins G → first_wins H :=
  fun (hGn : first_wins G) =>
    { left := lt_of_lt_of_equiv (and.left hGn) h, right := lt_of_equiv_of_lt (and.symm h) (and.right hGn) }

theorem left_wins_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : left_wins G → left_wins H :=
  fun (hGl : left_wins G) => { left := lt_of_lt_of_equiv (and.left hGl) h, right := le_of_le_of_equiv (and.right hGl) h }

theorem right_wins_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : right_wins G → right_wins H :=
  fun (hGr : right_wins G) =>
    { left := le_of_equiv_of_le (and.symm h) (and.left hGr), right := lt_of_equiv_of_lt (and.symm h) (and.right hGr) }

theorem first_loses_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) : first_loses G ↔ first_loses H :=
  { mp := first_loses_of_equiv h, mpr := first_loses_of_equiv (and.symm h) }

theorem first_wins_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) : first_wins G ↔ first_wins H :=
  { mp := first_wins_of_equiv h, mpr := first_wins_of_equiv (and.symm h) }

theorem left_wins_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) : left_wins G ↔ left_wins H :=
  { mp := left_wins_of_equiv h, mpr := left_wins_of_equiv (and.symm h) }

theorem right_wins_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) : right_wins G ↔ right_wins H :=
  { mp := right_wins_of_equiv h, mpr := right_wins_of_equiv (and.symm h) }

theorem not_first_wins_of_first_loses {G : pgame} : first_loses G → ¬first_wins G := sorry

theorem not_first_loses_of_first_wins {G : pgame} : first_wins G → ¬first_loses G :=
  iff.mp imp_not_comm not_first_wins_of_first_loses


variables p q : Prop

-- Equivilant
example (h : p ∧ q) : q ∧ p :=
have hp : p, from and.left h,
have hq : q, from and.right h,
show q ∧ p, from ⟨hq, hp⟩

example (h : p ∧ q) : q ∧ p :=
have hp : p, from and.left h,
suffices hq: q, from and.intro hq hp,
show q, from and.right h
--


import game.sup_inf.supSumSets
namespace xena -- hide

/-
# Chapter 3 : Sup and Inf

## Level 6

This level, very similar to the previous, showcases the infimum.
-/

def sum_of_sets (A : set ℝ) (B : set ℝ) := { x : ℝ | ∃ y ∈ A, ∃ z ∈ B, x = y + z}

/- Lemma
If $A$ and $B$ are sets of reals, then
$$ \textrm{inf} (A + B) = \textrm{inf} (A) + \textrm{inf}(B)$$
-/
lemma inf_sum_of_sets (A : set ℝ) (B : set ℝ) (h1A : A.nonempty) (h1B : B.nonempty)
  (h2A : bdd_below A) (h2B : bdd_below B) (a : ℝ) (b : ℝ) :
  (is_glb A a) ∧ (is_glb B b) → is_glb (sum_of_sets A B) (a + b) :=
begin
  intro h,
  cases h with hA hB,
  split,
  -- prove that (a+b) is a lower bound
  intros x h0,
  cases h0 with y h1,
  cases h1 with yA h2,
  cases h2 with z h3,
  cases h3 with zB hx,
  --have H11A := hA.right, have H11B := hB.right,
  have H12A := hA.left, have H12B := hB.left,
  have H13A := H12A yA, have H13B := H12B zB,
  linarith,
  -- now prove (a+b) is the greatest lower bound
  intros L hL,  -- L is another lower bound of (A+B)
  have H1 : ∀ x ∈ A, (L - x) ∈ lower_bounds B,
  {
    intros x hx y hy,
    suffices : L ≤ x + y, by linarith,
    exact hL ⟨x, hx, y, hy, rfl⟩,
  },
  have H2 : L - b ∈ lower_bounds A,
  {
    intros x hx,
    suffices : L - x ≤ b, by linarith,
    exact hB.2 (H1 x hx),
  },
  linarith [hA.2 H2], done
end

end xena -- hide