-- always import the tactics, we are mathematicians
import tactic
-- import the theory of G-module homomorphisms, for G a group
import algebra.group_action_hom
-- for the theory of sub-G-modules
import group_theory.group_action.sub_mul_action

/-

# Introduction to G-modules in Lean

Let `G` be a group (with group law `*`) and let `M` be an abelian
group (with group law `+`). A `G`-action on `M` is just a group
homomorphism from `G` to the group automorphisms
of `M`, or in other words an action `•` of `G` on `M` (in the sense
of groups acting on sets/types) satisfying
the axiom `smul_add g m n : g • (m + n) = g • m + g • n`.

The goal of this workshop will be to set up a cohomology theory
for G-modules. We will just do H⁰ (G-invariant elements)
and H¹ (1-cocycles modulo coboundaries), but clearly one
could go on to 2-cocycles, n-cocycles etc.

### typeclass comments ("will it work for monoids/add_monoids?")

Note that the definition of G-module does not mention `g⁻¹` at all, so
we can even define it for monoids `G`, which we will. Loads
of the theory works for `G` a monoid in fact (certainly everything
we do in this workshop). But we use subtraction on `M` quite a
lot in practice when we get to `H¹` (e.g. the coboundary `g b - b`
needs subtraction) so I've assumed that `M` is an abelian group throughout for
pedagogical reasons (and because it solved some typeclass issue at some point).

The `G`-module structure on `M` is called `distrib_mul_action G M` in Lean.
-/

section distrib_mul_action_stuff

/-

## The interface for G-modules, i.e. the theory of `•`

In Lean we learn about the typeclass `[distrib_mul_action G M]`,
which gives us the notation `•` for an action of `G` on `M`,
and all the axioms.

Notation for this section:

Let `G` be a group. Let `M` be an abelian group and furthermore
assume `M` is a `G`-module. We use the usual notation `(g₁ * g₂) • (m₁ + m₂)`

-/

variables
  {G : Type} [monoid G] --`*`
  {M : Type} [add_comm_group M] --`+`
  [distrib_mul_action G M] --`•`

-- Let `g`'ish variables be elements of `G`, and let `m`ish variables be
-- elements of `M`.
variables (g g1 g2 g₁ g₂ : G) (m m1 m2 m₁ m₂ : M)

/-

### The interface for `•`

Below are the names of the theorem proofs which you will need
to know when manipulating an element of a fixed `G`-module,
for example the element `(g₁ * g₂) • (m₁ + m₂)`.

I have explained the names of the proofs in the form
of examples. The syntax for the examples is this:

`example : <Theorem statement> := <name of proof function> input1 input2 ...`

So these examples tell you the names of the proofs of the theorems.
The proofs are functions which need inputs, and the inputs are
the variables used in the theorem statement. I also mention
whether Lean's "rw-machine" (the `simp` tactic) knows about these theorems.

-/

example : g • (0 : M) = 0 := smul_zero g -- a simp lemma
example : g • (m₁ + m₂) = g • m₁ + g • m₂ := smul_add g m₁ m₂ -- a simp lemma
example : g • (-m) = -(g • m) := smul_neg g m -- a simp lemma
example : (1 : G) • m = m := one_smul G m -- a simp lemma
-- at the time of writing, this is not a simp lemma.
example : g • (m₁ - m₂) = g • m₁ - g • m₂ := smul_sub g m₁ m₂
example : (g₁ * g₂) • m = g₁ • g₂ • m := mul_smul g₁ g₂ m -- not a simp lemma

end distrib_mul_action_stuff
/-

### Entirely optional digression on `simp`

Some of those lemmas above were "simp lemmas" (if you `#print one_smul`
you'll see it has a `@[simp]` tag). What makes a good simp lemma?

The most important rule is that, unless you really know what you're
doing, it should be of the form `A = B` or `A ↔ B`.

The second rule is that the right hand side should in some sense
be "simpler than" the left hand side.
so the lemma should say `A simplifies_to B`, indicating a flow towards
a solution.

For example `one_mul : 1 * a = a` is a `simp` lemma for groups (and
for monoids), because it is an equality, and the right hand side
is unarguably simpler than the left hand side.

Later on we'll be making some of our own structures, and
we will want to train Lean's simplifier to use those structures. The better
you understand how the simplifier works on your structures, the easier you
will find it to type "mathematics as the mathematician thinks about it"
into Lean.

-/

/-

KB note to self: Some people think `smul_add`
`g • (m₁ + m₂) = g • m₁ + g • m₂`
is a good simp lemma. I should experiment with `simp` here perhaps
or maybe just ask how to do it.

should mul_smul be a simp lemma?

-/

/-

### The `simp` tactic

A lemma is, by definition, a `simp` lemma, if its proof term is tagged
with the `@[simp]` attribute (you can check a term's attributes with `#print`)

`simp` is an algorithm which will "follow its nose", doing
stuff like expanding out brackets automatically and tidying up.
It would tidy up by simplifying `g • 0` to `0` for example,
and it would expand out by changing `g • (m₁ + m₂)` to `g • m₁ + g • m₂`.
In general `simp` tries to rewrite equivalences, e.g. things of the
form `A = B` or `A ↔ B`, with in each case `B` the "simplified" or
"expanded out" version of `A`. The equivalences it rewrites
with are the ones in its database of a few thousand (*shrug?)
so-called "`simp` lemmas" For example, if `⇑0 : G → M` is the
zero function then `zero_val g : ⇑0 g = 0` would be a good `simp`
lemma, which is why it is tagged with the `@[simp]` attribute,
making it part of the database.

Note that `simp` does not have "ideas". It will never apply
commutativity or associativity, for example, for fear that
it might be a waste of time which would have to be undone later.
`simp` will solve `x + 0 = x` but it will not solve `m + n = n + m`,
because it is not so clear that the right hand side is any simpler
than the left hand side. problems like that you need `abel`.

To learn more about `simp`, check out the simp docs on
the leanprover-community website.
-- TODO when online -- add link to simp docs in API at leanprover-community website

## A note on `abel`

`abel` should be able to solve all problems in abelian groups
of the form ∀ a b c, a + (c + -b) = (a - b) + c etc.
Note however that it *cannot use hypotheses*. It will only
prove identities which are true in all abelian groups.

-/
example (M : Type) [add_comm_group M] (a b c : M) :
  a + (c + -b) = (a - b) + c := by abel

/-

## @JoBo's homework -- the interface for sub-G-modules

Lean also has G-invariant subsets (`sub_mul_action G A`)
but not G-invariant subgroups, rather annoyingly. Hopefully
@jobo is going to make this stuff.

-/
section Jobo_homework

set_option old_structure_cmd true

structure sub_distrib_mul_action (G M : Type)
  [monoid G] [add_comm_group M]
  [distrib_mul_action G M]
extends sub_mul_action G M, add_subgroup M

/-

Seems me to me that you either define `mem` or `coe`,
depending on whether you want to build your own `mem`
(unwise?) or rely on `coe`'s `mem`.

-- petition to abolish all `∈` other than `set.mem`

-- mathematicians like reasoning with `∈`. By not defining
-- `has_mem M` `sub_distrib_mul_action` we force set-theoretic
-- arguments to happen within `set M`.

-- We define a coercion
-/
-- **CLONE?**
-- github search for formalizing mathematics does not give me
-- this repo :-(
namespace sub_distrib_mul_action
variables {G : Type} [monoid G]
variables {M : Type} [add_comm_group M] [distrib_mul_action G M]
variables {N : Type} [add_comm_group N] [distrib_mul_action G N]

instance : has_coe (sub_distrib_mul_action G M) (set M) := ⟨carrier⟩

lemma ext {A B : sub_distrib_mul_action G M}
  (h : ∀ m : M, m ∈ (A : set M) ↔ m ∈ (B : set M)) :
A = B :=
begin
  cases A; cases B; simp, ext m, exact h m
end

theorem ext_iff {A B : sub_distrib_mul_action G M} :
  A = B ↔ ∀ m : M, m ∈ (A : set M) ↔ m ∈ (B : set M) :=
⟨by {rintro rfl m, refl}, ext⟩

end sub_distrib_mul_action

namespace distrib_mul_action_hom

variables {G : Type} [monoid G]
variables {M : Type} [add_comm_group M] [distrib_mul_action G M]
variables {N : Type} [add_comm_group N] [distrib_mul_action G N]

def ker (φ : M →+[G] N) :
  sub_distrib_mul_action G M :=
by { refine_struct {carrier := {m : M | φ m = 0}},
  try {repeat {sorry}} -- proofs missing
}

variable (φ : M →+[G] N)

lemma mem_ker_set (m : M) : m ∈ (φ.ker : set M) ↔ φ m = 0 :=
begin
  refl
end

-- let's not make this. Let's force coercion to set. No point
-- in reduplicating the theory of `∈` on `set`.
-- kevin_thinks_this_is_a_bad_instance : has_mem M (sub_distrib_mul_action G M) := ⟨λ m S, m ∈ (S : set M)⟩

/-
Will this work in Lean 4?

lemma mem_ker (m : M) : m ∈ φ.ker ↔ φ m = 0 :=
begin
  refl
end
-/
lemma mem_ker (m : M) : m ∈ (φ.ker : set M) ↔ φ m = 0 :=
begin
  refl
end

def range (φ : M →+[G] N) :
  sub_distrib_mul_action G N :=
by { refine_struct {carrier := set.range φ},
  try {repeat {sorry}} -- proofs missing
}

lemma coe_range (n : N) : n ∈ (set.range (⇑φ)) ↔ n ∈ (φ.range : set N) := iff.rfl
lemma mem_range (n : N) : n ∈ (set.range (⇑φ)) ↔ ∃ m : M, φ m = n := iff.rfl
-- now copy theorems from sub_mul_action if you want

--now port subgroup and sub_mul_action

end distrib_mul_action_hom

/-
TODO

G-invariant subgroups are a complete lattice.

Proof could perhaps go via a Galois correspondence with either
G-invariant subsets or subgroups (or both?).

-/

end Jobo_homework

/-
## The interface for morphisms of G-modules, i.e. the theory of `→+[_]`

Lean uses notation `M →+[G] N` and name `distrib_mul_action_hom`,
but you don't need to remember the name, it should work in the
background for you.

The type of G-module homs from `M` to `N`, i.e. the set
that a mathematician would call something like $$\Hom_G(M,N)$$,
is in Lean called `M →+[G] N`. The non-notation name for this function
type is `distrib_mul_action_hom G M N`, which is why you see this word in
namespaces or mentioned in sections.

Terms of this type are `G`-module morphisms from `M` to `N`.
So when we see `φ : M →+[G] N` it means that `φ` is a G-module hom
from `M` to `N`. We will often only be using `φ` only in terms of its
associated function `⇑φ : M → N`. `φ` itself is a package, consisting
of a function and a bunch of theorems about that function.

-/

-- let's make function composition notation
infixr ` ∘ᵍ `:90 := distrib_mul_action_hom.comp

namespace distrib_mul_action_hom

-- let's do the variables
variables
-- let `G` be a group (or a monoid)
{G : Type} [monoid G]

{M : Type}  [add_comm_group M] [distrib_mul_action G M] -- let `M` be a `G`-module
{N : Type}  [add_comm_group N] [distrib_mul_action G N] -- let `N` be a `G`-module
(φ : M →+[G] N) -- let φ be a morphism of G-modules
(g : G) (m m₁ m₂ m1 m2 : M) -- random useful variable names

/-

### API for `M →+[G] N`

Here are the names of the proofs of the basic axioms for G-module
morphisms. The proofs are in the `→+[_]` namespace, so you can
write things like `φ.map_smul` to access them easily.

-/
example : φ (g • m) = g • (φ m) := φ.map_smul g m -- a simp lemma
example (m₁ m₂ : M) : φ (m₁ + m₂) = φ m₁ + φ m₂ := φ.map_add m₁ m₂ -- a simp lemma

example : φ (g • (m1 + m2)) = g • φ m1 + g • φ m2 :=
begin
  -- what will you rewrite? Will you rewrite at all?
  rw φ.map_smul,
  rw φ.map_add,
  rw smul_add,
  -- or just `simp` will do it
  -- Moral : `simp` right now is being trained to "push functions further in"
  -- and this must be the `simp` normal form.
end
/-

## A G-module morphism is a pair of things

A G-module morphism `φ : M →+[G] N` is two things.
1) a function `⇑φ : M → N`
2) the dot notation system for `φ`, a database where
all the axioms and theorems for G-module homs as applied to `φ` are stored.

For example, the type of φ.map_smul is *actually* a theorem about `⇑φ`.

`φ.map_smul g m : ⇑φ (g • m) = g • ⇑φ m`

-/

example (φ : M →+[G] N) : φ 0 = 0 :=
begin
  -- library_search will take some time (I don't know why)
  -- but will eventually find the answer to this one.
  -- But you can guess it quicker!
  -- what will you rewrite? Remember rewrite tries
  -- `refl` afterwards (unlike NNG)
  rw φ.map_zero,
end

-- Can you solve it in term mode?
example : φ 0 = 0 := φ.map_zero
-- change `sorry` to the name of a tactic
example : φ 0 = 0 := by simp

/-

### Composition of G-module morphisms

You know how to compose functions, you just write `ψ (φ a)`
or whatever. Composition in the category of G-modules is
done with the `comp` method for `G`-module morphisms.

-/

-- let P be another G-module
variables {P : Type} [add_comm_monoid P] [distrib_mul_action G P]

-- Recall `φ : M →+[G] N` from earlier.
-- let ψ : N → P be another G-module morphism
variable (ψ : N →+[G] P) -- his is notation for `ψ : distrib_mul_action_hom G N P`

-- how to compose G-module maps
example : M →+[G] P := ψ ∘ᵍ φ

-- You should think of φ and ψ as morphisms in the category
-- of `G`-modules. They are functions, but they also have
-- some extra category-theoretic baggage (proofs that they
-- are G-linear maps) which needs to be moved around.

-- KB NOTE TO SELF do we ever actually compose morphisms?
-- My definition of short exact sequence of G-modules
-- is "image = kernel" , which is highly category-theoretic.
-- and functional evaluation often takes place after that.

-- The important fact is that `(ψ ∘ᵍ φ) m = ψ (φ m)`, as
-- terms of type `P`. Rather nicely, this theorem is called
-- `ψ.comp_apply` but it is also a `simp` lemma, and
-- furthermore true by definition
example (m : M) :
  (ψ ∘ᵍ φ) m = ψ (φ m) := ψ.comp_apply φ m -- and `rfl` works too and `by simp`

-- all works with function.comp too
example (m : M) :
  (ψ ∘ φ) m = ψ (φ m) := ψ.comp_apply φ m -- and `rfl` works too and `by simp`

-- By the way, `squeeze_simp` is a version of `simp` which tells you
-- which rewrites it did. Give it a try!
example :
  ψ.comp φ (g • (m₁ + m₂)) = g • (ψ (φ m₁) + ψ (φ m₂)) :=
begin
  simp,
end

end distrib_mul_action_hom

section exactness_stuff

/-

## Developing a basic API for exact sequences

This is relatively straightforward and a nice
beginner exercise.

-/
-- Let M, N and P be G-modules
variables {G M N P : Type}
  [monoid G] [add_comm_group M] [add_comm_group N] [add_comm_group P]
  [distrib_mul_action G M] [distrib_mul_action G N] [distrib_mul_action G P]

-- I don't know which definition is best. This is the slickest for sure.
definition is_exact (φ : M →+[G] N) (ψ : N →+[G] P) : Prop :=
φ.range = ψ.ker

variables (φ : M →+[G] N) (ψ : N →+[G] P)

@[simp] lemma is_exact.def' : is_exact φ ψ ↔ φ.range = ψ.ker := iff.rfl

@[simp] lemma is_exact.def :
  is_exact φ ψ ↔ ∀ n : N, (∃ m : M, φ m = n) ↔ ψ n = 0 :=
begin
  rw is_exact.def',
  rw sub_distrib_mul_action.ext_iff,
  refl,
end

/-

## more than one "definition" of `is_exact`

Mathematicians have about three different ways of saying
a sequence is exact, and they're all "the definition".
That's why I proved the last few lemmas -- so we can use whichever
of the definitions is most use to us at the time.

-/

/-

## Making an API for short exact sequences.

This is really easy.

-/
open function

/-- Fundamental to cohomology theory is the concept of a short
exact sequence. If `φ : M →+[G] N` and
`ψ : N →+[G] P` are G-module morphisms, `is_short_exact φ ψ`
is the proposition stating that `0 → M -φ→ N -ψ→ P → 0` is short exact
in the usual sense, that is:

*) `φ` is injective,
*) the range of `φ` equals the kernel of `ψ`,
*) `ψ` is surjective.

If `h : is_short_exact φ ψ` then you can access various standard
facts about `φ` and `ψ` using dot notation with `h`. For example
`h.injective` is the proof that `φ` is injective, and
`h.exact_set` is the proof of some expanded-out version of the
statement that an element `n` is in the image
of `φ` if and only if it is in the kernel of `ψ`. A rather more
compact definition is `h.exact_cat`.
-/
-- This will do for an internal definition. The user should
-- never have to think about that though.
def is_short_exact (φ : M →+[G] N) (ψ : N →+[G] P) : Prop :=
  is_exact φ ψ ∧ injective φ ∧ surjective ψ

-- We need to make a nice API for this, it's easy and fun.

-- useful for rewrites when we're making the API, but the user
-- should never see this.
protected lemma is_short_exact_def :
  is_short_exact φ ψ ↔ is_exact φ ψ ∧ injective φ ∧ surjective ψ :=
-- true by definition
iff.rfl

-- I marked it protected because the end user should never have
-- to use this lemma in this repo, they should always use the `h.injective`
-- dot notation.

-- Now the proper API
namespace is_short_exact

-- We are making the API so we are allowed to unfold stuff

variables {φ} {ψ} (h : is_short_exact φ ψ)

include h
def injective : injective φ := --h.2.1
begin
  /- put your infoview filter onto only props.
     You see

     h: is_short_exact φ ψ
     ⊢ injective ⇑φ

     That's the question. You can take `h` apart
     with `cases`, and even more effectively with
     `rcases`.
  -/
  rcases h with ⟨_, _, _⟩,
  assumption
end

def surjective : surjective ψ := -- h.2.2
begin
  exact h.2.2
end

-- again we don't really want the user messing
-- with this internal function, it should be thought
-- of as "an abbreviation for several things".
protected def exact : is_exact φ ψ := h.1

--@[simp] lemma is_exact_def0 (φ : M →+[G] N) (ψ : N →+[G] P) :
--  is_exact φ ψ ↔ φ.range = ψ.ker

--@[simp] lemma is_exact_def (φ : M →+[G] N) (ψ : N →+[G] P) :
--  is_exact φ ψ ↔ ∀ n : N, (∃ m : M, φ m = n) ↔ ψ n = 0 :=

theorem exact_set : ∀ n : N, (∃ m : M, φ m = n) ↔ ψ n = 0 :=
begin
  rw ← is_exact.def,
  exact h.exact
end

theorem exact_cat : φ.range = ψ.ker :=
begin
  rw ← is_exact.def',
  -- different uses of word!
  exact h.exact,
end

@[simp] theorem comp_apply (m : M) : ψ (φ m) = 0 :=
begin
  rw ← ψ.mem_ker,
  rw ← h.exact_cat,
  rw ← φ.coe_range,
  simp,
end

-- now a noncomputable function defined by the axiom of choice,
-- a random splitting of the surjection ψ : P → N and hence a one-sided
-- inverse
noncomputable def inverse_ψ : P → N := λ p, classical.some (h.surjective p)

@[simp] lemma inverse_ψ_spec (p : P) : ψ (h.inverse_ψ p) = p :=
classical.some_spec (h.surjective p)

-- now the same sort of thing for the injection φ : M → N; this is
-- the map from the image of φ back to M.
noncomputable def inverse_φ (h : is_short_exact φ ψ) (n : N)
  (hn : ∃ m : M, φ m = n) : M :=
classical.some hn

@[simp]
lemma inverse_φ_def (h : is_short_exact φ ψ) {n : N} (hn : ∃ m : M, φ m = n) :
  φ (h.inverse_φ n hn) = n :=
classical.some_spec hn

-- injectivity implies it's independent of choice, but we used choice anyway
@[simp] lemma inverse_φ_spec (h : is_short_exact φ ψ) {n : N} {m : M} (hm : φ m = n) :
  h.inverse_φ _ ⟨m, hm⟩ = m :=
begin
  apply h.injective,
  rw hm,
  exact classical.some_spec ⟨m, hm⟩,
end

end is_short_exact

end exactness_stuff


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Module.abelian
import category_theory.limits.shapes.images
import category_theory.limits.types

/-!
# The category of R-modules has images.

Note that we don't need to register any of the constructions here as instances, because we get them
from the fact that `Module R` is an abelian category.
-/

open category_theory
open category_theory.limits

universes u v

namespace Module

variables {R : Type u} [comm_ring R]

variables {G H : Module.{v} R} (f : G ⟶ H)

local attribute [ext] subtype.ext_val

section -- implementation details of `has_image` for Module; use the API, not these
/-- The image of a morphism in `Module R` is just the bundling of `linear_map.range f` -/
def image : Module R := Module.of R (linear_map.range f)

/-- The inclusion of `image f` into the target -/
def image.ι : image f ⟶ H := f.range.subtype

instance : mono (image.ι f) := concrete_category.mono_of_injective (image.ι f) subtype.val_injective

/-- The corestriction map to the image -/
def factor_thru_image : G ⟶ image f := f.range_restrict

lemma image.fac : factor_thru_image f ≫ image.ι f = f :=
by { ext, refl, }

local attribute [simp] image.fac

variables {f}
/-- The universal property for the image factorisation -/
noncomputable def image.lift (F' : mono_factorisation f) : image f ⟶ F'.I :=
{ to_fun :=
  (λ x, F'.e (classical.indefinite_description _ x.2).1 : image f → F'.I),
  map_add' :=
  begin
    intros x y,
    haveI := F'.m_mono,
    apply (mono_iff_injective F'.m).1, apply_instance,
    rw [linear_map.map_add],
    change (F'.e ≫ F'.m) _ = (F'.e ≫ F'.m) _ + (F'.e ≫ F'.m) _,
    rw [F'.fac],
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    refl,
  end,
  map_smul' := λ c x,
  begin
    haveI := F'.m_mono,
    apply (mono_iff_injective F'.m).1, apply_instance,
    rw [linear_map.map_smul],
    change (F'.e ≫ F'.m) _ = _ • (F'.e ≫ F'.m) _,
    rw [F'.fac],
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    refl,
  end }

lemma image.lift_fac (F' : mono_factorisation f) : image.lift F' ≫ F'.m = image.ι f :=
begin
  ext x,
  change (F'.e ≫ F'.m) _ = _,
  rw [F'.fac, (classical.indefinite_description _ x.2).2],
  refl,
end
end

/-- The factorisation of any morphism in `Module R` through a mono. -/
def mono_factorisation : mono_factorisation f :=
{ I := image f,
  m := image.ι f,
  e := factor_thru_image f }

/-- The factorisation of any morphism in `Module R` through a mono has the universal property of
the image. -/
noncomputable def is_image : is_image (mono_factorisation f) :=
{ lift := image.lift,
  lift_fac' := image.lift_fac }

/--
The categorical image of a morphism in `Module R`
agrees with the linear algebraic range.
-/
noncomputable def image_iso_range {G H : Module.{v} R} (f : G ⟶ H) :
  limits.image f ≅ Module.of R f.range :=
is_image.iso_ext (image.is_image f) (is_image f)

@[simp, reassoc, elementwise]
lemma image_iso_range_inv_image_ι {G H : Module.{v} R} (f : G ⟶ H) :
  (image_iso_range f).inv ≫ limits.image.ι f = Module.of_hom f.range.subtype :=
is_image.iso_ext_inv_m _ _

@[simp, reassoc, elementwise]
lemma image_iso_range_hom_subtype {G H : Module.{v} R} (f : G ⟶ H) :
  (image_iso_range f).hom ≫ Module.of_hom f.range.subtype = limits.image.ι f :=
by erw [←image_iso_range_inv_image_ι f, iso.hom_inv_id_assoc]

end Module


/-
Copyright (c) 2021 Vladimir Goryachev. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Vladimir Goryachev, Kyle Miller, Scott Morrison, Eric Rodriguez
-/
import data.list.basic
import data.nat.prime
import set_theory.fincard

/-!
# Counting on ℕ

This file defines the `count` function, which gives, for any predicate on the natural numbers,
"how many numbers under `k` satisfy this predicate?".
We then prove several expected lemmas about `count`, relating it to the cardinality of other
objects, and helping to evaluate it for specific `k`.

-/

open finset

namespace nat
variable (p : ℕ → Prop)

section count
variable [decidable_pred p]

/-- Count the number of naturals `k < n` satisfying `p k`. -/
def count (n : ℕ) : ℕ := (list.range n).countp p

@[simp] lemma count_zero : count p 0 = 0 :=
by rw [count, list.range_zero, list.countp]

/-- A fintype instance for the set relevant to `nat.count`. Locally an instance in locale `count` -/
def count_set.fintype (n : ℕ) : fintype {i // i < n ∧ p i} :=
begin
  apply fintype.of_finset ((finset.range n).filter p),
  intro x,
  rw [mem_filter, mem_range],
  refl,
end

localized "attribute [instance] nat.count_set.fintype" in count

lemma count_eq_card_filter_range (n : ℕ) : count p n = ((range n).filter p).card :=
by { rw [count, list.countp_eq_length_filter], refl, }

/-- `count p n` can be expressed as the cardinality of `{k // k < n ∧ p k}`. -/
lemma count_eq_card_fintype (n : ℕ) : count p n = fintype.card {k : ℕ // k < n ∧ p k} :=
by { rw [count_eq_card_filter_range, ←fintype.card_of_finset, ←count_set.fintype], refl, }

lemma count_succ (n : ℕ) : count p (n + 1) = count p n + (if p n then 1 else 0) :=
by split_ifs; simp [count, list.range_succ, h]

@[mono] lemma count_monotone : monotone (count p) :=
monotone_nat_of_le_succ $ λ n, by by_cases h : p n; simp [count_succ, h]

lemma count_add (a b : ℕ) : count p (a + b) = count p a + count (λ k, p (a + k)) b :=
begin
  have : disjoint ((range a).filter p) (((range b).map $ add_left_embedding a).filter p),
  { intros x hx,
    simp_rw [inf_eq_inter, mem_inter, mem_filter, mem_map, mem_range] at hx,
    obtain ⟨⟨hx, _⟩, ⟨c, _, rfl⟩, _⟩ := hx,
    exact (self_le_add_right _ _).not_lt hx },
  simp_rw [count_eq_card_filter_range, range_add, filter_union, card_disjoint_union this,
    map_filter, add_left_embedding, card_map], refl,
end

lemma count_add' (a b : ℕ) : count p (a + b) = count (λ k, p (k + b)) a + count p b :=
by { rw [add_comm, count_add, add_comm], simp_rw [add_comm b] }

lemma count_one : count p 1 = if p 0 then 1 else 0 := by simp [count_succ]

lemma count_succ' (n : ℕ) : count p (n + 1) = count (λ k, p (k + 1)) n + if p 0 then 1 else 0 :=
by rw [count_add', count_one]

variables {p}

@[simp] lemma count_lt_count_succ_iff {n : ℕ} : count p n < count p (n + 1) ↔ p n :=
by by_cases h : p n; simp [count_succ, h]

lemma count_succ_eq_succ_count_iff {n : ℕ} : count p (n + 1) = count p n + 1 ↔ p n :=
by by_cases h : p n; simp [h, count_succ]

lemma count_succ_eq_count_iff {n : ℕ} : count p (n + 1) = count p n ↔ ¬p n :=
by by_cases h : p n; simp [h, count_succ]

alias count_succ_eq_succ_count_iff ↔ _ count_succ_eq_succ_count
alias count_succ_eq_count_iff ↔ _ count_succ_eq_count

lemma count_le_cardinal (n : ℕ) : (count p n : cardinal) ≤ cardinal.mk {k | p k} :=
begin
  rw [count_eq_card_fintype, ← cardinal.mk_fintype],
  exact cardinal.mk_subtype_mono (λ x hx, hx.2),
end

lemma lt_of_count_lt_count {a b : ℕ} (h : count p a < count p b) : a < b :=
(count_monotone p).reflect_lt h

lemma count_strict_mono {m n : ℕ} (hm : p m) (hmn : m < n) : count p m < count p n :=
(count_lt_count_succ_iff.2 hm).trans_le $ count_monotone _ (nat.succ_le_iff.2 hmn)

lemma count_injective {m n : ℕ} (hm : p m) (hn : p n) (heq : count p m = count p n) : m = n :=
begin
  by_contra,
  wlog hmn : m < n,
  { exact ne.lt_or_lt h },
  { simpa [heq] using count_strict_mono hm hmn }
end

lemma count_le_card (hp : (set_of p).finite) (n : ℕ) : count p n ≤ hp.to_finset.card :=
begin
  rw count_eq_card_filter_range,
  exact finset.card_mono (λ x hx, hp.mem_to_finset.2 (mem_filter.1 hx).2)
end

lemma count_lt_card {n : ℕ} (hp : (set_of p).finite) (hpn : p n) :
  count p n < hp.to_finset.card :=
(count_lt_count_succ_iff.2 hpn).trans_le (count_le_card hp _)

variable {q : ℕ → Prop}
variable [decidable_pred q]

end count

end nat


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

! This file was ported from Lean 3 source module init.meta.well_founded_tactics
! leanprover-community/lean commit 855e5b74e3a52a40552e8f067169d747d48743fd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Mathlib.Init.Data.Nat.Lemmas

-- Porting note: meta code used to implement well-founded recursion is not ported

theorem Nat.lt_add_of_zero_lt_left (a b : Nat) (h : 0 < b) : a < a + b :=
  show a + 0 < a + b by
    apply Nat.add_lt_add_left
    assumption
#align nat.lt_add_of_zero_lt_left Nat.lt_add_of_zero_lt_left

theorem Nat.zero_lt_one_add (a : Nat) : 0 < 1 + a :=
  suffices 0 < a + 1 by
    simp [Nat.add_comm]
    assumption
  Nat.zero_lt_succ _
#align nat.zero_lt_one_add Nat.zero_lt_one_add

#align nat.lt_add_right Nat.lt_add_right

theorem Nat.lt_add_left (a b c : Nat) : a < b → a < c + b := fun h =>
  lt_of_lt_of_le h (Nat.le_add_left _ _)
#align nat.lt_add_left Nat.lt_add_left

/-
The remainder of the original Lean 3 source module is subsumed by Lean 4 core.
-/


/-
Copyright (c) 2021 Tian Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tian Chen
-/
import data.pnat.basic

/-!
# IMO 1977 Q6

Suppose `f : ℕ+ → ℕ+` satisfies `f(f(n)) < f(n + 1)` for all `n`.
Prove that `f(n) = n` for all `n`.

We first prove the problem statement for `f : ℕ → ℕ`
then we use it to prove the statement for positive naturals.
-/

theorem imo1977_q6_nat (f : ℕ → ℕ) (h : ∀ n, f (f n) < f (n + 1)) :
  ∀ n, f n = n :=
begin
  have h' : ∀ (k n : ℕ), k ≤ n → k ≤ f n,
  { intro k,
    induction k with k h_ind,
    { intros, exact nat.zero_le _ },
    { intros n hk,
      apply nat.succ_le_of_lt,
      calc k ≤ f (f (n - 1)) : h_ind _ (h_ind (n - 1) (nat.le_sub_right_of_add_le hk))
         ... < f n           : nat.sub_add_cancel
        (le_trans (nat.succ_le_succ (nat.zero_le _)) hk) ▸ h _ } },
  have hf : ∀ n, n ≤ f n := λ n, h' n n rfl.le,
  have hf_mono : strict_mono f := strict_mono.nat (λ _, lt_of_le_of_lt (hf _) (h _)),
  intro,
  exact nat.eq_of_le_of_lt_succ (hf _) (hf_mono.lt_iff_lt.mp (h _))
end

theorem imo1977_q6 (f : ℕ+ → ℕ+) (h : ∀ n, f (f n) < f (n + 1)) :
  ∀ n, f n = n :=
begin
  intro n,
  simpa using imo1977_q6_nat (λ m, if 0 < m then f m.to_pnat' else 0) _ n,
  { intro x, cases x,
    { simp },
    { simpa using h _ } }
end


-- Based on Kevin Buzzard's Zulip message "Two hours of Lean" - Nov 23rd 2021

import tactic

-- Define a number as a zero, and a successor
inductive number
| zero           : number
| S (n : number) : number

-- start a namespace to work in (means we can type zero rather than number.zero)
namespace number

-- Define some common numbers
def one   := S(zero)
def two   := S(one)
def three := S(two)
def four  := S(three)

-- before we can prove two + two = four we have to define what + means

-- add is a binary operator on two numbers that make another number
def add : number → number → number
| n zero   := n            -- adding zero to a number just returns that number
| n (S(d)) := S(add n d)   -- adding a non zero number to n is the successor of n and that non zero number

-- Surprisingly refl will easily prove this
example : add two two = four := rfl

-- We can't at this point write 2 + 2 because we haven't defined the infix notation of +

-- In lean we define the infix notation + to be number.add
infix `+` := number.add

-- and now we can write
example : two + two = four := rfl

-- end our namespace
end number


import group_theory.subgroup

/-!
This file supplements two instances relavant to monoid homomorphisms
-/

namespace monoid_hom
variables {G N: Type*} [group G] [group N]

/-- If the equality in `N` is decidable and `f : G →* N` is a `monoid_hom`,
    then the membership of `f.ker.carrier` is decidable. -/
instance [decidable_eq N] (f : G →* N) (x : G) :
decidable (x ∈ f.ker.carrier) := f.decidable_mem_ker x

/-- If `G` is a finite type, and the equality in `N` is decidable,
    and `f : G →* N` is a `monoid_hom`, then `f.ker.carrier` is a finite type. -/
instance [fintype G] [decidable_eq N] (f : G →* N) :
fintype (f.ker.carrier) := set_fintype (f.ker.carrier)

/-
lemma fintype_card_ker_eq_card_ker_carrier [fintype G] [decidable_eq N] (f : G →* N) :
fintype.card f.ker = fintype.card f.ker.carrier :=
by refl
-/

end monoid_hom


/-
Copyright (c) 2020 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang, Johan Commelin
-/
import data.fintype.card
import data.mv_polynomial.rename
import data.mv_polynomial.comm_ring
import algebra.algebra.subalgebra.basic

/-!
# Symmetric Polynomials and Elementary Symmetric Polynomials

This file defines symmetric `mv_polynomial`s and elementary symmetric `mv_polynomial`s.
We also prove some basic facts about them.

## Main declarations

* `mv_polynomial.is_symmetric`

* `mv_polynomial.symmetric_subalgebra`

* `mv_polynomial.esymm`

## Notation

+ `esymm σ R n`, is the `n`th elementary symmetric polynomial in `mv_polynomial σ R`.

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

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

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

+ `r : R` elements of the coefficient ring

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

+ `φ ψ : mv_polynomial σ R`

-/

open equiv (perm)
open_locale big_operators
noncomputable theory

namespace mv_polynomial

variables {σ : Type*} {R : Type*}
variables {τ : Type*} {S : Type*}

/-- A `mv_polynomial φ` is symmetric if it is invariant under
permutations of its variables by the  `rename` operation -/
def is_symmetric [comm_semiring R] (φ : mv_polynomial σ R) : Prop :=
∀ e : perm σ, rename e φ = φ

variables (σ R)

/-- The subalgebra of symmetric `mv_polynomial`s. -/
def symmetric_subalgebra [comm_semiring R] : subalgebra R (mv_polynomial σ R) :=
{ carrier := set_of is_symmetric,
  algebra_map_mem' := λ r e, rename_C e r,
  mul_mem' := λ a b ha hb e, by rw [alg_hom.map_mul, ha, hb],
  add_mem' := λ a b ha hb e, by rw [alg_hom.map_add, ha, hb] }

variables {σ R}

@[simp] lemma mem_symmetric_subalgebra [comm_semiring R] (p : mv_polynomial σ R) :
  p ∈ symmetric_subalgebra σ R ↔ p.is_symmetric := iff.rfl

namespace is_symmetric

section comm_semiring
variables [comm_semiring R] [comm_semiring S] {φ ψ : mv_polynomial σ R}

@[simp]
lemma C (r : R) : is_symmetric (C r : mv_polynomial σ R) :=
(symmetric_subalgebra σ R).algebra_map_mem r

@[simp]
lemma zero : is_symmetric (0 : mv_polynomial σ R) :=
(symmetric_subalgebra σ R).zero_mem

@[simp]
lemma one : is_symmetric (1 : mv_polynomial σ R) :=
(symmetric_subalgebra σ R).one_mem

lemma add (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ + ψ) :=
(symmetric_subalgebra σ R).add_mem hφ hψ

lemma mul (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ * ψ) :=
(symmetric_subalgebra σ R).mul_mem hφ hψ

lemma smul (r : R) (hφ : is_symmetric φ) : is_symmetric (r • φ) :=
(symmetric_subalgebra σ R).smul_mem hφ r

@[simp]
lemma map (hφ : is_symmetric φ) (f : R →+* S) : is_symmetric (map f φ) :=
λ e, by rw [← map_rename, hφ]

end comm_semiring

section comm_ring
variables [comm_ring R] {φ ψ : mv_polynomial σ R}

lemma neg (hφ : is_symmetric φ) : is_symmetric (-φ) :=
(symmetric_subalgebra σ R).neg_mem hφ

lemma sub (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ - ψ) :=
(symmetric_subalgebra σ R).sub_mem hφ hψ

end comm_ring

end is_symmetric

section elementary_symmetric
open finset
variables (σ R) [comm_semiring R] [comm_semiring S] [fintype σ] [fintype τ]

/-- The `n`th elementary symmetric `mv_polynomial σ R`. -/
def esymm (n : ℕ) : mv_polynomial σ R :=
∑ t in powerset_len n univ, ∏ i in t, X i

/-- We can define `esymm σ R n` by summing over a subtype instead of over `powerset_len`. -/
lemma esymm_eq_sum_subtype (n : ℕ) : esymm σ R n =
  ∑ t : {s : finset σ // s.card = n}, ∏ i in (t : finset σ), X i :=
begin
  rw esymm,
  let i : Π (a : finset σ), a ∈ powerset_len n univ → {s : finset σ // s.card = n} :=
    λ a ha, ⟨_, (mem_powerset_len.mp ha).2⟩,
  refine sum_bij i (λ a ha, mem_univ (i a ha)) _ (λ _ _ _ _ hi, subtype.ext_iff_val.mp hi) _,
  { intros,
    apply prod_congr,
    simp only [subtype.coe_mk],
    intros, refl,},
  { refine (λ b H, ⟨b.val, mem_powerset_len.mpr ⟨subset_univ b.val, b.property⟩, _⟩),
    simp [i] },
end

/-- We can define `esymm σ R n` as a sum over explicit monomials -/
lemma esymm_eq_sum_monomial (n : ℕ) : esymm σ R n =
  ∑ t in powerset_len n univ, monomial (∑ i in t, finsupp.single i 1) 1 :=
begin
  refine sum_congr rfl (λ x hx, _),
  rw monic_monomial_eq,
  rw finsupp.prod_pow,
  rw ← prod_subset (λ y _, finset.mem_univ y : x ⊆ univ) (λ y _ hy, _),
  { refine prod_congr rfl (λ x' hx', _),
    convert (pow_one _).symm,
    convert (finsupp.apply_add_hom x' : (σ →₀ ℕ) →+ ℕ).map_sum _ x,
    classical,
    simp [finsupp.single_apply, finset.filter_eq', apply_ite, apply_ite finset.card],
    rw if_pos, exact hx', },
  { convert pow_zero _,
    convert (finsupp.apply_add_hom y : (σ →₀ ℕ) →+ ℕ).map_sum _ x,
    classical,
    simp [finsupp.single_apply, finset.filter_eq', apply_ite, apply_ite finset.card],
    rw if_neg, exact hy }
end

@[simp] lemma esymm_zero : esymm σ R 0 = 1 :=
by simp only [esymm, powerset_len_zero, sum_singleton, prod_empty]

lemma map_esymm (n : ℕ) (f : R →+* S) : map f (esymm σ R n) = esymm σ S n :=
begin
  rw [esymm, (map f).map_sum],
  refine sum_congr rfl (λ x hx, _),
  rw (map f).map_prod,
  simp,
end

lemma rename_esymm (n : ℕ) (e : σ ≃ τ) : rename e (esymm σ R n) = esymm τ R n :=
begin
  rw [esymm_eq_sum_subtype, esymm_eq_sum_subtype, (rename ⇑e).map_sum],
  let e' : {s : finset σ // s.card = n} ≃ {s : finset τ // s.card = n} :=
    equiv.subtype_equiv (equiv.finset_congr e) (by simp),
  rw ← equiv.sum_comp e'.symm,
  apply fintype.sum_congr,
  intro,
  calc _ = (∏ i in (e'.symm a : finset σ), (rename e) (X i)) : (rename e).map_prod _ _
     ... = (∏ i in (a : finset τ), (rename e) (X (e.symm i))) : prod_map (a : finset τ) _ _
     ... = _ : _,
  apply finset.prod_congr rfl,
  intros,
  simp,
end

lemma esymm_is_symmetric (n : ℕ) : is_symmetric (esymm σ R n) :=
by { intro, rw rename_esymm }

lemma support_esymm'' (n : ℕ) [decidable_eq σ] [nontrivial R] :
  (esymm σ R n).support = (powerset_len n (univ : finset σ)).bUnion
    (λ t, (finsupp.single (∑ (i : σ) in t, finsupp.single i 1) (1:R)).support) :=
begin
  rw esymm_eq_sum_monomial,
  simp only [← single_eq_monomial],
  convert finsupp.support_sum_eq_bUnion (powerset_len n (univ : finset σ)) _,
  intros s t hst d,
  simp only [finsupp.support_single_ne_zero one_ne_zero, and_imp, inf_eq_inter, mem_inter,
             mem_singleton],
  rintro h rfl,
  have := congr_arg finsupp.support h,
  rw [finsupp.support_sum_eq_bUnion, finsupp.support_sum_eq_bUnion] at this,
  { simp only [finsupp.support_single_ne_zero one_ne_zero, bUnion_singleton_eq_self] at this,
    exact absurd this hst.symm },
  all_goals { intros x y, simp [finsupp.support_single_disjoint] }
end

lemma support_esymm' (n : ℕ) [decidable_eq σ] [nontrivial R] :
  (esymm σ R n).support =
  (powerset_len n (univ : finset σ)).bUnion (λ t, {∑ (i : σ) in t, finsupp.single i 1}) :=
begin
  rw support_esymm'',
  congr,
  funext,
  exact finsupp.support_single_ne_zero one_ne_zero
end

lemma support_esymm (n : ℕ) [decidable_eq σ] [nontrivial R] :
  (esymm σ R n).support =
  (powerset_len n (univ : finset σ)).image (λ t, ∑ (i : σ) in t, finsupp.single i 1) :=
by { rw support_esymm', exact bUnion_singleton }

lemma degrees_esymm [nontrivial R]
  (n : ℕ) (hpos : 0 < n) (hn : n ≤ fintype.card σ) :
  (esymm σ R n).degrees = (univ : finset σ).val :=
begin
  classical,
  have : (finsupp.to_multiset ∘ λ (t : finset σ), ∑ (i : σ) in t, finsupp.single i 1) = finset.val,
  { funext, simp [finsupp.to_multiset_sum_single] },
  rw [degrees, support_esymm, sup_finset_image, this, ←comp_sup_eq_sup_comp],
  { obtain ⟨k, rfl⟩ := nat.exists_eq_succ_of_ne_zero hpos.ne',
    simpa using powerset_len_sup _ _ (nat.lt_of_succ_le hn) },
  { intros,
    simp only [union_val, sup_eq_union],
    congr },
  { refl }
end

end elementary_symmetric

end mv_polynomial


import categories.category
import categories.isomorphism
import categories.tactics
import categories.functor
import categories.ndefs
open categories
open categories.isomorphism
open categories.functor
open tactic

--delaration of universes and variables
universes u v u₁ v₁
variables (C : Type u₁) [𝒞 : category.{u₁ v₁} C]
include 𝒞

-- 1a Show that identities in a category are unique
theorem uniq_id (X : C) (id' : X ⟶ X) : (∀ {A : C} (g : X ⟶ A), id' ≫ g = g) → (∀ {A : C} (g : A ⟶ X), g ≫ id' = g) → (id' = 𝟙X) :=
    begin
        intros hl hr,
        transitivity,
        symmetry,
        exact category.right_identity_lemma C id',
        exact hl(𝟙X)
    end

-- 1b Show that a morphism with both a left inverse and right inverse is an isomorphism
theorem landr_id (X Y Z : C) (f : X ⟶ Y) : (∃ gl : Y ⟶ X, gl ≫ f = 𝟙Y) → (∃ gr : Y ⟶ X, f ≫ gr = 𝟙X) → (is_Isomorphism' f) :=
    begin
    intros,
    cases (classical.indefinite_description _ a) with gl hl,
    cases (classical.indefinite_description _ a_1) with gr hr,
    apply nonempty.intro
        (⟨gr, hr,
            begin
                simp,
                symmetry,
                exact calc
                𝟙Y     = gl ≫ f                : eq.symm hl
                ...    = gl ≫ 𝟙X ≫ f           : by rw category.left_identity_lemma C f
                ...    = (gl ≫ 𝟙X) ≫ f         : by rw category.associativity_lemma
                ...    = (gl ≫ (f ≫ gr)) ≫ f  : by rw hr
                ...    = ((gl ≫ f) ≫ gr) ≫ f  : by rw category.associativity_lemma C gl f gr
                ...    = (𝟙Y ≫ gr) ≫ f         : by rw hl
                ...    = gr ≫ f                 : by rw category.left_identity_lemma C gr
            end⟩
        : is_Isomorphism f)
    end

-- 1c Consider f : X ⟶ Y and g : Y ⟶ Z. Show that if two out of f, g and gf are isomorphisms,then so is the third.
section Two_Out_Of_Three
    variables (X Y Z : C)
    variables (f : X ⟶ Y) (g : Y ⟶ Z)

    theorem tootfirsec : is_Isomorphism' f → is_Isomorphism' g → is_Isomorphism' (f ≫ g) :=
        begin
            intros hf hg,
            apply hf.elim,
            apply hg.elim,
            intros Ig If,
            exact nonempty.intro
                ⟨Ig.1 ≫ If.1,
                begin
                    simp,
                    exact calc
                    f ≫ g ≫ Ig.1 ≫ If.1 = f ≫ (g ≫ Ig.1) ≫ If.1 : by rw category.associativity_lemma
                    ...                   = f ≫ 𝟙Y ≫ If.1          : by rw is_Isomorphism.witness_1_lemma
                    ...                   = f ≫ If.1               : by rw category.left_identity_lemma
                    ...                   = 𝟙X                      : by rw is_Isomorphism.witness_1_lemma
                end,
                begin
                    simp,
                    exact calc
                        Ig.1 ≫ If.1 ≫ f ≫ g  = Ig.1 ≫ (If.1 ≫ f) ≫ g : by rw category.associativity_lemma
                        ...                    = Ig.1 ≫ 𝟙Y ≫ g          : by rw is_Isomorphism.witness_2_lemma
                        ...                    = Ig.1 ≫ g               : by rw category.left_identity_lemma
                        ...                    = 𝟙Z                      : by rw is_Isomorphism.witness_2_lemma
                end⟩
        end

    theorem tootsecthi : is_Isomorphism' g → is_Isomorphism' (f ≫ g) → is_Isomorphism' f :=
        begin
            intros hg hfg,
            apply hg.elim,
            apply hfg.elim,
            intros Ifg Ig,
            exact nonempty.intro
                ⟨g ≫ Ifg.1,
                    begin
                        simp,
                        exact calc
                            f ≫ g ≫ Ifg.1 = (f ≫ g) ≫ Ifg.1 : by rw category.associativity_lemma
                            ... = 𝟙X : by rw is_Isomorphism.witness_1_lemma
                    end,
                    begin
                        simp,
                        exact calc
                            g ≫ Ifg.1 ≫ f = (g ≫ Ifg.1 ≫ f) ≫ 𝟙Y : by rw category.right_identity_lemma
                            ... = g ≫ (Ifg.1 ≫ f) ≫ 𝟙Y : by rw category.associativity_lemma
                            ... = g ≫ Ifg.1 ≫ f ≫ 𝟙Y : by rw category.associativity_lemma
                            ... = g ≫ Ifg.1 ≫ f ≫ g ≫ Ig.1 : by rw is_Isomorphism.witness_1_lemma
                            ... = g ≫ (Ifg.1 ≫ ((f ≫ g) ≫ Ig.1)) : by rw category.associativity_lemma
                            ... = g ≫ (Ifg.1 ≫ (f ≫ g)) ≫ Ig.1 : by rw (category.associativity_lemma C Ifg.1 (f ≫ g) Ig.1)
                            ... = g ≫ 𝟙Z ≫ Ig.1 : by rw is_Isomorphism.witness_2_lemma
                            ... = g ≫ Ig.1 : by rw category.left_identity_lemma
                            ... = 𝟙Y : by rw is_Isomorphism.witness_1_lemma
                    end⟩
        end
    theorem tootfirthi : is_Isomorphism' f → is_Isomorphism' (f ≫ g) → is_Isomorphism' g :=
        begin
            intros hf hfg,
            apply hf.elim,
            apply hfg.elim,
            intros Ifg If,
            exact nonempty.intro
                ⟨Ifg.1 ≫ f,
                    begin
                        simp,
                        exact calc
                            g ≫ Ifg.1 ≫ f = 𝟙Y ≫ g ≫ Ifg.1 ≫ f : by rw category.left_identity_lemma
                            ... = (If.1 ≫ f) ≫ g ≫ Ifg.1 ≫ f : by rw is_Isomorphism.witness_2_lemma
                            ... = ((If.1 ≫ f) ≫ g) ≫ Ifg.1 ≫ f : by rw (category.associativity_lemma C (If.1 ≫ f) g (Ifg.1 ≫ f))
                            ... = (If.1 ≫ (f ≫ g)) ≫ Ifg.1 ≫ f : by rw (category.associativity_lemma C If.1 f g)
                            ... = If.1 ≫ (f ≫ g) ≫ Ifg.1 ≫ f : by rw category.associativity_lemma
                            ... = If.1 ≫ ((f ≫ g) ≫ Ifg.1) ≫ f : by rw (category.associativity_lemma C (f ≫ g) Ifg.1 f)
                            ... = If.1 ≫ 𝟙X ≫ f : by rw is_Isomorphism.witness_1_lemma
                            ... = If.1 ≫ f : by rw category.left_identity_lemma
                            ... = 𝟙Y : by rw is_Isomorphism.witness_2_lemma
                    end,
                    begin
                        simp
                    end⟩
        end
end Two_Out_Of_Three

variables {D : Type u} [𝒟 : category.{u v} D]
include 𝒟

-- 1d Show functors preserve isomorphisms
theorem fun_id (F : C ↝ D) (X Y : C) (f : X ⟶ Y) : (is_Isomorphism' f) → (is_Isomorphism' (F &> f)) :=
    begin
        intro hf,
        apply hf.elim,
        intro If,
        exact nonempty.intro
            /- ⟨F &> If.1,
            begin
                simp,
                exact calc
                    (F &> f) ≫ (F &> If.1) = F &> (f ≫ If.1) : by rw Functor.functoriality_lemma
                    ... = F &> 𝟙X : by rw is_Isomorphism.witness_1_lemma
                    ... = 𝟙 (F +> X) : by rw Functor.identities
            end,
            begin
                simp,
                exact calc
                    (F &> If.1) ≫ (F &> f) = F &> (If.1 ≫ f) : by rw Functor.functoriality_lemma
                    ... = F &> 𝟙Y : by rw is_Isomorphism.witness_2_lemma
                    ... = 𝟙 (F +> Y) : by rw Functor.identities
            end⟩ -/
            (isomorphism.is_Isomorphism_of_Isomorphism (F.onIsomorphisms ⟨f , If.1, by simp, by simp⟩))
    end

-- 1e Show that if F : C ↝ D is full and faithful, and F &> f : F +> A ⟶ F +> B is an isomorphism in 𝒟, then f : A ⟶ B is an isomorphism in 𝒞
theorem reflecting_isomorphisms (F : C ↝ D) (X Y : C) (f : X ⟶ Y) : is_Full_Functor F → is_Faithful_Functor F → is_Isomorphism' (F &> f) → is_Isomorphism' f :=
    begin
        intros hfu hfa hFf,
        apply hFf.elim,
        intro IFf,
        cases (classical.indefinite_description _ (hfu IFf.1)) with g hg,
        apply nonempty.intro
            (⟨g,
            begin
                simp,
                exact hfa
                    (calc
                        F &> (f ≫ g) = (F &> f) ≫ (F &> g) : by rw Functor.functoriality_lemma
                        ... = 𝟙(F +> X) : by rw [hg, is_Isomorphism.witness_1_lemma]
                        ... = F &> (𝟙X) : by rw Functor.identities
                    )
            end,
            begin
                simp,
                exact hfa
                    (calc
                        F &> (g ≫ f) = (F &> g) ≫ (F &> f) : by rw Functor.functoriality_lemma
                        ... = 𝟙(F +> Y) : by rw [hg, is_Isomorphism.witness_2_lemma]
                        ... = F &> (𝟙Y) : by rw Functor.identities
                    )
            end⟩
            : is_Isomorphism f)
    end


-- Chapter 16

-- Lucas Machado Moschen

-- Exercício 1
import data.set

open function int algebra

section

    def f (x : ℤ) : ℤ := x + 3
    def g (x : ℤ) : ℤ := -x
    def h (x : ℤ) : ℤ := 2 * x + 3

    example : injective f :=
    assume x1 x2,
    assume h1 : x1 + 3 = x2 + 3,   -- Lean knows this is the same as f x1 = f x2
    show x1 = x2, from eq_of_add_eq_add_right h1

    example : surjective f :=
    assume y,
    have h1 : f (y - 3) = y, from calc
    f (y - 3) = (y - 3) + 3 : rfl
            ... = y           : by rw sub_add_cancel,
    show ∃ x, f x = y, from exists.intro (y - 3) h1

    example (x y : ℤ) (h : 2 * x = 2 * y) : x = y :=
    have h1 : 2 ≠ (0 : ℤ), from dec_trivial,  -- this tells Lean to figure it out itself
    show x = y, from eq_of_mul_eq_mul_left h1 h

    example (x : ℤ) : -(-x) = x := neg_neg x

    example (A B : Type) (u : A → B) (v : B → A) (h : left_inverse u v) :
    ∀ x, u (v x) = x :=
    h

    example (A B : Type) (u : A → B) (v : B → A) (h : left_inverse u v) :
    right_inverse v u :=
    h

    -- fill in the sorry's in the following proofs

    example : injective h :=
    begin
        assume x1 x2,
        assume h1,
        have h2: 2 ≠ (0 : ℤ), from dec_trivial,
        apply eq_of_mul_eq_mul_left h2 (eq_of_add_eq_add_right h1),
    end

    example : surjective g :=
    begin
        assume y,
        have h: g (-y) = y, from calc
            g (-y) = -(-y) : rfl
            ...    = y : by rw neg_neg,
        apply exists.intro (-y),
        exact h
    end

    example (A B : Type) (u : A → B) (v1 : B → A) (v2 : B → A)
    (h1 : left_inverse v1 u) (h2 : right_inverse v2 u) : v1 = v2 :=
    funext
    (assume x,
        calc
        v1 x = v1 (u (v2 x)) : by rw h2
        ... = v2 x          : by rw h1)
end

-- Exercício 2

section

    open function set

    variables {X Y : Type}
    variable  f : X → Y
    variables A B : set X

    example : f '' (A ∪ B) = f '' A ∪ f '' B :=
    eq_of_subset_of_subset
    (assume y,
        assume h1 : y ∈ f '' (A ∪ B),
        exists.elim h1 $
        assume x h,
        have h2 : x ∈ A ∪ B, from h.left,
        have h3 : f x = y, from h.right,
        or.elim h2
        (assume h4 : x ∈ A,
            have h5 : y ∈ f '' A, from ⟨x, h4, h3⟩,
            show y ∈ f '' A ∪ f '' B, from or.inl h5)
        (assume h4 : x ∈ B,
            have h5 : y ∈ f ''  B, from ⟨x, h4, h3⟩,
            show y ∈ f '' A ∪ f '' B, from or.inr h5))
    (assume y,
        assume h2 : y ∈ f '' A ∪ f '' B,
        or.elim h2
        (assume h3 : y ∈ f '' A,
            exists.elim h3 $
            assume x h,
            have h4 : x ∈ A, from h.left,
            have h5 : f x = y, from h.right,
            have h6 : x ∈ A ∪ B, from or.inl h4,
            show y ∈ f '' (A ∪ B), from ⟨x, h6, h5⟩)
        (assume h3 : y ∈ f '' B,
            exists.elim h3 $
            assume x h,
            have h4 : x ∈ B, from h.left,
            have h5 : f x = y, from h.right,
            have h6 : x ∈ A ∪ B, from or.inr h4,
            show y ∈ f '' (A ∪ B), from ⟨x, h6, h5⟩))

    -- remember, x ∈ A ∩ B is the same as x ∈ A ∧ x ∈ B
    example (x : X) (h1 : x ∈ A) (h2 : x ∈ B) : x ∈ A ∩ B :=
    and.intro h1 h2

    example (x : X) (h1 : x ∈ A ∩ B) : x ∈ A :=
    and.left h1

    -- Fill in the proof below.
    -- (It should take about 8 lines.)

    example : f '' (A ∩ B) ⊆ f '' A ∩ f '' B :=
    assume y,
    assume h1 : y ∈ f '' (A ∩ B),
    show y ∈ f '' A ∩ f '' B, from
    begin
        apply and.intro,
        cases h1 with x h2,
            have h3: x ∈ A ∧ f x = y,
                from and.intro (h2.left.left) h2.right,
            apply exists.intro x,
            exact h3,
        cases h1 with x h2,
            have h3: x ∈ B ∧ f x = y,
                from and.intro (h2.left.right) h2.right,
            apply exists.intro x,
            exact h3
    end

end


import inter.level3
import tactic

/- Tactic : use
When the goal is to prove an existential, `∃` we can
supply the witness (an example that has the desired property)
using the tactic `use`.

For example :
If the goal is
```
⊢ ∃ n : ℕ, n + 1 = 1
```
then we have to take `n` to be zero, so we type `use 0`.
The remaining goal will then be that
`0 + 1 = 1`
which is provable with `zero_add`.
-/

/- Lemma :
-/
lemma exists_betwn : ∃ n : ℕ, 8 < n ∧ n < 10 :=
begin
  use 9,
  split,
  exact nat.lt_succ_self 8,
  exact nat.lt_succ_self 9,
end


/-
The definition of a totally ordered set.
-/
class TotalOrder (α : Type _) [LE α] [DecidableRel $ @LE.le α _] where
  (reflLE : ∀ a : α, a ≤ a)
  (antisymmLE : ∀ {a b : α}, a ≤ b → b ≤ a → a = b)
  (transLE : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c)
  (totalLE : ∀ a b : α, a ≤ b ∨ b ≤ a)

namespace TotalOrder

def max {α : Type _} [LE α] [DecidableRel $ @LE.le α _] : α → α → α
  | a, b =>
    if a ≤ b then
      b
    else
      a

def min {α : Type _} [LE α] [DecidableRel $ @LE.le α _] : α → α → α
  | a, b =>
    if a ≤ b then
      a
    else
      b

variable {α : Type} [LE α] [DecidableRel $ @LE.le α _] [TotalOrder α]
variable {a b x : α}

theorem notLE : ¬(a ≤ b) → b ≤ a :=
  λ h : ¬(a ≤ b) =>
    match TotalOrder.totalLE a b with
      | Or.inl h' => False.elim (h h')
      | Or.inr h' => h'

theorem max_symm : max a b = max b a := by
  byCases h:(a ≤ b) <;> byCases h':(b ≤ a) <;> simp [max, h, h']
  · apply TotalOrder.antisymmLE <;> assumption
  · apply TotalOrder.antisymmLE <;> (apply notLE ; assumption)

@[simp] theorem max_left_le : TotalOrder.max a b ≤ x → a ≤ x :=
  if h:(a ≤ b) then by
    simp [max, h]
    intro h'
    apply TotalOrder.transLE h h'
  else by
    simp [max, h]
    exact id

@[simp] theorem max_right_le : max a b ≤ x → b ≤ x := by
  byCases h:(a ≤ b) <;> simp [max, h]
  · exact id
  · intro h'
    apply TotalOrder.transLE (notLE h) h'

theorem min_symm : min a b = min b a := by
 byCases h:(a ≤ b) <;> byCases h':(b ≤ a) <;> simp [min, h, h']
  · apply TotalOrder.antisymmLE <;> assumption
  · apply TotalOrder.antisymmLE <;> (apply notLE ; assumption)

@[simp] theorem min_le_left : x ≤ min a b → x ≤ a := by
  byCases h:(a ≤ b) <;> simp [min, h]
  · exact id
  · intro h'
    apply TotalOrder.transLE
    · assumption
    · apply notLE ; assumption

@[simp] theorem min_le_right : x ≤ min a b → x ≤ b := by
  byCases h:(a ≤ b) <;> simp [min, h]
  · intro h'
    exact TotalOrder.transLE h' h
  · exact id

theorem both_le_max_le : a ≤ x → b ≤ x → (max a b) ≤ x := by
  intro ; intro ; byCases h:(a ≤ b) <;> simp [max, h] <;> assumption

theorem le_both_le_min : x ≤ a → x ≤ b → x ≤ (min a b) := by
  intro ; intro ; byCases h:(a ≤ b) <;> simp [min, h] <;> assumption

end TotalOrder