import data.real.basic

/- TEXT:
.. _section_algebraic_structures:

Algebraic Structures
--------------------

To clarify what we mean by the phrase *algebraic structure*,
it will help to consider some examples.

#. A *partially ordered set* consists of a set :math:`P` and
   a binary relation :math:`\le` on :math:`P` that is transitive
   and antireflexive.

#. A *group* consists of a set :math:`G` with an associative
   binary operation, an identity element
   :math:`1`, and a function :math:`g \mapsto g^{-1}` that returns
   an inverse for each :math:`g` in :math:`G`.
   A group is *abelian* or *commutative* if the operation is commutative.

#. A *lattice* is a partially ordered set with meets and joins.

#. A *ring* consists of an (addively written) abelian group
   :math:`(R, +, 0, x \mapsto -x)`
   together with an associative multiplication operation
   :math:`\cdot` and an identity :math:`1`,
   such that multiplication distributes over addition.
   A ring is *commutative* if the multiplication is commutative.

#. An *ordered ring* :math:`(R, +, 0, -, \cdot, 1, \le)` consists of a ring
   together with a partial order on its elements, such that :math:`a \le b` implies
   :math:`a + c \le b + c` for every :math:`a`, :math:`b`, and :math:`c` in :math:`R`,
   and :math:`0 \le a` and :math:`0 \le b` implies :math:`0 \le a b` for
   every :math:`a` and :math:`b` in :math:`R`.

#. A *metric space* consists of a set :math:`X` and a function
   :math:`d : X \times X \to \mathbb{R}` such that the following hold:

   - :math:`d(x, y) \ge 0` for every :math:`x` and :math:`y` in :math:`X`.
   - :math:`d(x, y) = 0` if and only if :math:`x = y`.
   - :math:`d(x, y) = d(y, x)` for every :math:`x` and :math:`y` in :math:`X`.
   - :math:`d(x, z) \le d(x, y) + d(y, z)` for every :math:`x`, :math:`y`, and
     :math:`z` in :math:`X`.

#. A *topological space* consists of a set :math:`X` and a collection :math:`\mathcal T`
   of subsets of :math:`X`, called the *open subsets of* :math:`X`, such that
   the following hold:

   - The empty set and :math:`X` are open.
   - The intersection of two open sets is open.
   - An arbitrary union of open sets is open.

In each of these examples, the elements of the structure belong to a
set, the *carrier set*,
that sometimes stands proxy for the entire structure.
For example, when we say "let :math:`G` be a group" and then
"let :math:`g \in G`," we are using :math:`G` to stand for both
the structure and its carrier.
Not every algebraic structure is associated with a single carrier set in this way.
For example, a *bipartite graph* involves a relation between two sets,
as does a *Galois connection*,
A *category* also involves two sets of interest, commonly called the *objects*
and the *morphisms*.

The examples indicate some of the things that a proof assistant has to do
in order to support algebraic reasoning.
First, it needs to recognize concrete instances of structures.
The number systems :math:`\mathbb{Z}`, :math:`\mathbb{Q}`,
and :math:`\mathbb{R}` are all ordered rings,
and we should be able to apply a generic theorem about ordered rings
in any of these instances.
Sometimes a concrete set may be an instance of a structure in more than one way.
For example, in addition to the usual topology on :math:`\mathbb{R}`,
which forms the basis for real analysis,
we can also consider the *discrete* topology on :math:`\mathbb{R}`,
in which every set is open.

Second, a proof assistant needs to support generic notation on structures.
In Lean, the notation ``*``
is used for multiplication in all the usual number systems,
as well as for multiplication in generic groups and rings.
When we use an expression like ``f x * y``,
Lean has to use information about the types of ``f``, ``x``, and ``y``
to determine which multiplication we have in mind.

Third, it needs to deal with the fact that structures can inherit
definitions, theorems, and notation from other structures in various ways.
Some structures extend others by adding more axioms.
A commutative ring is still a ring, so any definition
that makes sense in a ring also makes sense in a commutative ring,
and any theorem that holds in a ring also holds in a commutative ring.
Some structures extend others by adding more data.
For example, the additive part of any ring is an additive group.
The ring structure adds a multiplication and an identity,
as well as axioms that govern them and relate them to the additive part.
Sometimes we can define one structure in terms of another.
Any metric space has a canonical topology associated with it,
the *metric space topology*, and there are various topologies that can be
associated with any linear ordering.

Finally, it is important to keep in mind that mathematics allows us to
use functions and operations to define structures in the same way we
use functions and operations to define numbers.
Products and powers of groups are again groups.
For every :math:`n`, the integers modulo :math:`n` form a ring,
and for every :math:`k > 0`, the :math:`k \times k` matrices of polynomials
with coefficients in that ring again form a ring.
Thus we can calculate with structures just as easily as we can calculate
with their elements.
This means that algebraic structures lead dual lives in mathematics,
as containers for collections of objects and as objects in their own right.
A proof assistant has to accommodate this dual role.

When dealing with elements of a type that has an algebraic structure
associated with it,
a proof assistant needs to recognize the structure and find the relevant
definitions, theorems, and notation.
All this should sound like a lot of work, and it is.
But Lean uses a small collection of fundamental mechanisms to
carry out these tasks.
The goal of this section is to explain these mechanisms and show you
how to use them.

The first ingredient is almost too obvious to mention:
formally speaking, algebraic structures are structures in the sense
of :numref:`section_structures`.
An algebraic structure is a specification of a bundle of data satisfying
some axiomatic hypotheses, and we saw in :numref:`section_structures` that
this is exactly what the ``structure`` command is designed to accommodate.
It's a marriage made in heaven!

Given a data type ``α``, we can define the group structure on ``α``
as follows.
EXAMPLES: -/
-- QUOTE:
structure group₁ (α : Type*) :=
(mul: α → α → α)
(one: α)
(inv: α → α)
(mul_assoc : ∀ x y z : α, mul (mul x y) z = mul x (mul y z))
(mul_one: ∀ x : α, mul x one = x)
(one_mul: ∀ x : α, mul x one = x)
(mul_left_inv : ∀ x : α, mul (inv x) x = one)
-- QUOTE.

-- OMIT: TODO: explain the extends command later, and also redundant inheritance
/- TEXT:
Notice that the type ``α`` is a *parameter* in the definition of ``group₁``.
So you should think of an object ``struc : group₁ α`` as being
a group structure on ``α``.
We saw in :numref:`proving_identities_in_algebraic_structures`
that the counterpart ``mul_right_inv`` to ``mul_left_inv``
follows from the other group axioms, so there is no need
to add it to the definition.

This definition of a group is similar to the definition of ``group`` in
mathlib,
and we have chosen the name ``group₁`` to distinguish our version.
If you write ``#check group`` and ctrl-click on the definition,
you will see that the mathlib version of ``group`` is defined to
extend another structure; we will explain how to do that later.
If you type ``#print group`` you will also see that the mathlib
version of ``group`` has a number of extra fields.
For reasons we will explain later, sometimes it is useful to add
redundant information to a structure,
so that there are additional fields for objects and functions
that can be defined from the core
data. Don't worry about that for now.
Rest assured that our simplified version ``group₁`` is
morally the same as the definition of a group that mathlib uses.

It is sometimes useful to bundle
the type together with the structure, and mathlib also
contains a definition of a ``Group`` structure that is equivalent to
the following:
EXAMPLES: -/
-- QUOTE:
structure Group₁ :=
(α : Type*)
(str : group₁ α)
-- QUOTE.

/- TEXT:
The mathlib version is found in ``algebra.category.Group.basic``,
and you can ``#check`` it if you add this to the imports at the
beginning of the examples file.

For reasons that will become clearer below, it is more often
useful to keep the type ``α`` separate from the structure ``group α``.
We refer to the two objects together as a *partially bundled structure*,
since the representation combines most, but not all, of the components
into one structure. It is common in mathlib
to use capital roman letters like ``G`` for a type
when it is used as the carrier type for a group.

Let's construct a group, which is to say, an element of the ``group₁`` type.
For any pair of types ``α`` and ``β``, Mathlib defines the type ``equiv α β``
of *equivalences* between ``α`` and ``β``.
Mathlib also defines the suggestive notation ``α ≃ β`` for this type.
An element ``f : α ≃ β`` is a bijection between ``α`` and ``β``
represented by four components:
a function ``f.to_fun`` from ``α`` to ``β``,
the inverse function ``f.inv_fun`` from ``β`` to ``α``,
and two properties that specify these functions are indeed inverse
to one another.
EXAMPLES: -/
section
-- QUOTE:
variables (α β γ : Type*)
variables (f : α ≃ β) (g : β ≃ γ)

#check equiv α β
#check (f.to_fun : α → β)
#check (f.inv_fun : β → α)
#check (f.right_inv: ∀ x : β, f (f.inv_fun x) = x)
#check (f.left_inv: ∀ x : α, f.inv_fun (f x) = x)

#check (equiv.refl α : α ≃ α)
#check (f.symm : β ≃ α)
#check (f.trans g : α ≃ γ)
-- QUOTE.

/- TEXT:
Notice the creative naming of the last three constructions. We think of the
identity function ``equiv.refl``, the inverse operation ``equiv.symm``,
and the composition operation ``equiv.trans`` as explicit evidence
that the property of being in bijective correspondence is an equivalence relation.

Notice also that ``f.trans g`` requires composing the forward functions
in reverse order. Mathlib has declared a *coercion* from ``equiv α β``
to the function type ``α → β``, so we can omit writing ``.to_fun``
and have Lean insert it for us.
EXAMPLES: -/
-- QUOTE:
example (x : α) : (f.trans g).to_fun x = g.to_fun (f.to_fun x) := rfl

example (x : α) : (f.trans g) x = g (f x) := rfl

example : (f.trans g : α → γ) = g ∘ f := rfl
-- QUOTE.

end

/- TEXT:
Mathlib also defines the type ``perm α`` of equivalences between
``α`` and itself.
EXAMPLES: -/
-- QUOTE:
example (α : Type*) : equiv.perm α = (α ≃ α) := rfl
-- QUOTE.

/- TEXT:
It should be clear that ``equiv.perm α`` forms a group under composition
of equivalences. We orient things so that ``mul f g`` is
equal to ``g.trans f``, whose forward function is ``f ∘ g``.
In other words, multiplication is what we ordinarily think of as
composition of the bijections. Here we define this group:
EXAMPLES: -/
-- QUOTE:
def perm_group {α : Type*} : group₁ (equiv.perm α) :=
{ mul          := λ f g, equiv.trans g f,
  one          := equiv.refl α,
  inv          := equiv.symm,
  mul_assoc    := λ f g h, (equiv.trans_assoc _ _ _).symm,
  one_mul      := equiv.trans_refl,
  mul_one      := equiv.refl_trans,
  mul_left_inv := equiv.self_trans_symm }
-- QUOTE.

/- TEXT:
In fact, mathlib defines exactly this ``group`` structure on ``equiv.perm α``
in the file ``group_theory.perm.basic``.
As always, you can hover over the theorems used in the definition of
``perm_group`` to see their statements,
and you can jump to their definitions in the original file to learn
more about how they are implemented.

In ordinary mathematics, we generally think of notation as
independent of structure.
For example, we can consider groups :math:`(G_1, \cdot, 1, \cdot^{-1})`,
:math:`(G_2, \circ, e, i(\cdot))`, and :math:`(G_3, +, 0, -)`.
In the first case, we write the binary operation as :math:`\cdot`,
the identity at :math:`1`, and the inverse function as :math:`x \mapsto x^{-1}`.
In the second and third cases, we use the notational alternatives shown.
When we formalize the notion of a group in Lean, however,
the notation is more tightly linked to the structure.
In Lean, the components of any ``group`` are named
``mul``, ``one``, and ``inv``,
and in a moment we will see how multplicative notation is
set up to refer to them.
If we want to use additive notation, we instead use an isomorphic structure
``additive_group``. Its components are named ``add``, ``zero``,
and ``neg``, and the associated notation is what you would expect it to be.

Recall the type ``point`` that we defined in :numref:`section_structures`,
and the addition function that we defined there.
These definitions are reproduced in the examples file that accompanies
this section.
As an exercise, define an ``add_group₁`` structure that is similar
to the ``group₁`` structure we defined above, except that it uses the
additive naming scheme just described.
Define negation and a zero on the ``point`` data type,
and define the ``add_group₁`` structure on ``point``.
BOTH: -/
-- QUOTE:
structure add_group₁ (α : Type*) :=
/- EXAMPLES:
(add : α → α → α)
-- fill in the rest
SOLUTIONS: -/
(add: α → α → α)
(zero: α)
(neg: α → α)
(add_assoc : ∀ x y z : α, add (add x y) z = add x (add y z))
(add_zero: ∀ x : α, add x zero = x)
(zero_add: ∀ x : α, add x zero = x)
(add_left_neg : ∀ x : α, add (neg x) x = zero)
-- BOTH:

@[ext] structure point := (x : ℝ) (y : ℝ) (z : ℝ)

namespace point

def add (a b : point) : point := ⟨a.x + b.x, a.y + b.y, a.z + b.z⟩

/- EXAMPLES:
def neg (a b : point) : point := sorry

def zero : point := sorry

def add_group_point : add_group point := sorry
SOLUTIONS: -/
def neg (a : point) : point := ⟨-a.x, -a.y, -a.z⟩

def zero : point := ⟨0, 0, 0⟩

def add_group_point : add_group₁ point :=
{ add          := point.add,
  zero         := point.zero,
  neg          := point.neg,
  add_assoc    := by { simp [point.add, add_assoc] },
  add_zero     := by { simp [point.add, point.zero], intro, ext; refl },
  zero_add     := by { simp [point.add, point.zero], intro, ext; refl },
  add_left_neg := by { simp [point.add, point.neg, point.zero] } }
-- BOTH:

end point
-- QUOTE.

/- TEXT:
We are making progress.
Now we know how to define algebraic structures in Lean,
and we know how to define instances of those structures.
But we also want to associate notation with structures
so that we can use it with each instance.
Moreover, we want to arrange it so that we can define an operation
on a structure and use it with any particular instance,
and we want to arrange it so that we can prove a theorem about
a structure and use it with any instance.

In fact, mathlib is already set up to use generic group notation,
definitions, and theorems for ``equiv.perm α``.
EXAMPLES: -/
section
-- QUOTE:
variables {α : Type*} (f g : equiv.perm α) (n : ℕ)

#check f * g
#check mul_assoc f g g⁻¹

-- group power, defined for any group
#check g^n

example : f * g * (g⁻¹) = f :=
by { rw [mul_assoc, mul_right_inv, mul_one] }

example : f * g * (g⁻¹) = f := mul_inv_cancel_right f g

example {α : Type*} (f g : equiv.perm α) : g.symm.trans (g.trans f) = f :=
mul_inv_cancel_right f g
-- QUOTE.

end

/- TEXT:
You can check that this is not the case for the additive group structure
on ``point`` that we asked you to define above.
Our task now is to understand that magic that goes on under the hood
in order to make the examples for ``equiv.perm α`` work the way they do.

The issue is that Lean needs to be able to *find* the relevant
notation and the implicit group structure,
using the information that is found in the expressions that we type.
Simiarly, when we write ``x + y`` with expressions ``x`` and ``y``
that have type ``ℝ``, Lean needs to interpret the ``+``
symbol as the relevant addition function on the reals.
It also has to recognize the type ``ℝ`` as an instance of a commutative ring,
so that all the definitions and theorems for a commutative ring are available.
For another example,
continuity is defined in Lean relative to any two topological spaces.
When we have ``f : ℝ → ℂ`` and we write ``continuous f``, Lean has to find the
relevant topologies on ``ℝ`` and ``ℂ``.

The magic is achieved with a combination of three things.

#. *Logic.* A definition that should be interpreted in any group takes, as
   arguments, the type of the group and the group structure as arguments.
   Similarly, a theorem about the elements of an arbitrary group
   begins with universal quantifiers over
   the type of the group and the group structure.

#. *Implicit arguments.* The arguments for the type and the structure
   are generally left implicit, so that we do not have to write them
   or see them in the Lean information window. Lean fills the
   information in for us silently.

#. *Type class inference.* Also known as *class inference*,
   this is a simple but powerful mechanism
   that enables us to register information for Lean to use later on.
   When Lean is called on to fill in implicit arguments to a
   definition, theorem, or piece of notation,
   it can make use of information that has been registered.

Whereas an annotation ``(grp : group G)`` tells Lean that it should
expect to be given that argument explicitly and the annotation
``{grp : group G}`` tells Lean that it should try to figure it out
from contextual cues in the expression,
the annotation ``[grp : group G]`` tells Lean that the corresponding
argument should be synthesized using type class inference.
Since the whole point to the use of such arguments is that
we generally do not need to refer to them explicitly,
Lean allows us to write ``[group G]`` and leave the name anonymous.
You have probably already noticed that Lean chooses names like ``_inst_1``
automatically.
When we use the anonymous square-bracket annotation with the ``variables`` command,
then as long as the variables are still in scope,
Lean automatically adds the argument ``[group G]`` to any definition or
theorem that mentions ``G``.

How do we register the information that Lean needs to use to carry
out the search?
Returning to our group example, we need only make two changes.
First, instead of using the ``structure`` command to define the group structure,
we use the keyword ``class`` to indicate that it is a candidate
for class inference.
Second, instead of defining particular instances with ``def``,
we use the keyword ``instance`` to register the particular instance with
Lean. As with the names of class variables, we are allowed to leave the
name of an instance definition anonymous,
since in general we intend Lean to find it and put it to use
without troubling us with the details.
EXAMPLES: -/
-- QUOTE:
class group₂ (α : Type*) :=
(mul: α → α → α)
(one: α)
(inv: α → α)
(mul_assoc : ∀ x y z : α, mul (mul x y) z = mul x (mul y z))
(mul_one: ∀ x : α, mul x one = x)
(one_mul: ∀ x : α, mul x one = x)
(mul_left_inv : ∀ x : α, mul (inv x) x = one)

instance {α : Type*} : group₂ (equiv.perm α) :=
{ mul          := λ f g, equiv.trans g f,
  one          := equiv.refl α,
  inv          := equiv.symm,
  mul_assoc    := λ f g h, (equiv.trans_assoc _ _ _).symm,
  one_mul      := equiv.trans_refl,
  mul_one      := equiv.refl_trans,
  mul_left_inv := equiv.self_trans_symm }
-- QUOTE.

/- TEXT:
The following illustrates their use.
EXAMPLES: -/
-- QUOTE:
#check @group₂.mul

def my_square {α : Type*} [group₂ α] (x : α) := group₂.mul x x

#check @my_square

section
variables {β : Type*} (f g : equiv.perm β)

example : group₂.mul f g = g.trans f := rfl

example : my_square f = f.trans f := rfl

end
-- QUOTE.

/- TEXT:
The ``#check`` command shows that ``group₂.mul`` has an implicit argument
``[group₂ α]`` that we expect to be found by class inference,
where ``α`` is the type of the arguments to ``group₂.mul``.
In other words, ``{α : Type*}`` is the implicit argument for the type
of the group elements and ``[group₂ α]`` is the implicit argument for the
group structure on ``α``.
Similarly, when we define a generic squaring function ``my_square``
for ``group₂``, we use an implicit argument ``{α : Type*}`` for
the type of the elements and an implicit argument ``[group₂ α]`` for
the ``group₂`` structure.

In the first example,
when we write ``group₂.mul f g``, the type of ``f`` and ``g``
tells Lean that in the argument ``α`` to ``group₂.mul``
has to be instantiated to ``equiv.perm β``.
That means that Lean has to find an element of ``group₂ (equiv.perm β)``.
The previous ``instance`` declaration tells Lean exactly how to do that.
Problem solved!

This simple mechanism for registering information so that Lean can find it
when it needs it is remarkably useful.
Here is one way it comes up.
In Lean's foundation, a data type ``α`` may be empty.
In a number of applications, however, it is useful to know that a
type has at least one element.
For example, the function ``list.head``, which returns the first
element of a list, can return the default value when the list is empty.
To make that work, the Lean library defines a class ``inhabited α``,
which does nothing more than store a default value.
We can show that the ``point`` type is an instance:
EXAMPLES: -/
-- QUOTE:
instance : inhabited point := { default := ⟨0, 0, 0⟩ }

#check (default : point)

example : ([] : list point).head = default := rfl
-- QUOTE.

/- TEXT:
The class inference mechanism is also used for generic notation.
The expression ``x + y`` is an abbreviation for ``has_add.add x y``
where---you guessed it---``has_add α`` is a class that stores
a binary function on ``α``.
Writing ``x + y`` tells Lean to find a registered instance of ``[has_add.add α]``
and use the corresponding function.
Below, we register the addition function for ``point``.
EXAMPLES: -/
-- QUOTE:
instance : has_add point := { add := point.add }

section
variables x y : point

#check x + y

example : x + y = point.add x y := rfl

end
-- QUOTE.

/- TEXT:
In this way, we can assign the notation ``+`` to binary operations on other
types as well.

But we can do even better. We have seen that ``*`` can be used in any
group, ``+`` can be used in any additive group, and both can be used in
any ring.
When we define a new instance of a ring in Lean,
we don't have to define ``+`` and ``*`` for that instance,
because Lean knows that these are defined for every ring.
We can use this method to specify notation for our ``group₂`` class:
EXAMPLES: -/
-- QUOTE:
instance has_mul_group₂ {α : Type*} [group₂ α] : has_mul α := ⟨group₂.mul⟩

instance has_one_group₂ {α : Type*} [group₂ α] : has_one α := ⟨group₂.one⟩

instance has_inv_group₂ {α : Type*} [group₂ α] : has_inv α := ⟨group₂.inv⟩

section
variables {α : Type*} (f g : equiv.perm α)

#check f * 1 * g⁻¹

def foo: f * 1 * g⁻¹ = g.symm.trans ((equiv.refl α).trans f) := rfl

end
-- QUOTE.

/- TEXT:
In this case, we have to supply names for the instances, because
Lean has a hard time coming up with good defaults.
What makes this approach work is that Lean carries out a recursive search.
According to the instances we have declared, Lean can find an instance of
``has_mul (equiv.perm α)`` by finding an
instance of ``group₂ (equiv.perm α)``, and it can find an instance of
``group₂ (equiv.perm α)`` because we have provided one.
Lean is capable of finding these two facts and chaining them together.

The example we have just given is dangerous, because Lean's
library also has an instance of ``group (equiv.perm α)``, and
multiplication is defined on any group.
So it is ambiguous as to which instance is found.
In fact, Lean favors more recent declarations unless you explicitly
specify a different priority.
Also, there is another way to tell Lean that one structure is an
instance of another, using the ``extends`` keyword.
This is how ``mathlib`` specifies that, for example,
every commutative ring is a ring.
You can find more information in a
`section on class inference <https://leanprover.github.io/theorem_proving_in_lean/type_classes.html#managing-type-class-inference>`_ in *Theorem Proving in Lean*.

In general, it is a bad idea to specify a value of
``*`` for an instance of an algebraic structure that already has
the notation defined.
Redefining the notion of ``group`` in Lean is an artificial example.
In this case, however, both interpretations of the group notation unfold to
``equiv.trans``, ``equiv.refl``, and ``equiv.symm``, in the same way.

As a similarly artificial exercise,
define a class ``add_group₂`` in analogy to ``group₂``.
Define the usual notation for addition, negation, and zero
on any ``add_group₂``
using the classes ``has_add``, ``has_neg``, and ``has_zero``.
Then show ``point`` is an instance of ``add_group₂``.
Try it out and make sure that the additive group notation works for
elements of ``point``.
BOTH: -/
-- QUOTE:
class add_group₂ (α : Type*) :=
/- EXAMPLES:
(add : α → α → α)
-- fill in the rest
-- QUOTE.
SOLUTIONS: -/
(add: α → α → α)
(zero: α)
(neg: α → α)
(add_assoc : ∀ x y z : α, add (add x y) z = add x (add y z))
(add_zero: ∀ x : α, add x zero = x)
(zero_add: ∀ x : α, add x zero = x)
(add_left_neg : ∀ x : α, add (neg x) x = zero)

instance has_add_add_group₂ {α : Type*} [add_group₂ α] :
has_add α := ⟨add_group₂.add⟩

instance has_zero_add_group₂ {α : Type*} [add_group₂ α] :
has_zero α := ⟨add_group₂.zero⟩

instance has_neg_add_group₂ {α : Type*} [add_group₂ α] :
has_neg α := ⟨add_group₂.neg⟩

instance : add_group₂ point :=
{ add          := point.add,
  zero         := point.zero,
  neg          := point.neg,
  add_assoc    := by { simp [point.add, add_assoc] },
  add_zero     := by { simp [point.add, point.zero], intro, ext; refl },
  zero_add     := by { simp [point.add, point.zero], intro, ext; refl },
  add_left_neg := by { simp [point.add, point.neg, point.zero] } }

section
variables (x y : point)

#check x + -y + 0
end

/- TEXT:
It is not a big problem that we have already declared instances
``has_add``, ``has_neg``, and ``has_zero`` for ``point`` above.
Once again, the two ways of synthesizing the notation should come up
with the same answer.

Class inference is subtle, and you have to be careful when using it,
because it configures automation that invisibly governs the interpretation of
the expressions we type.
When used wisely, however, class inference is a powerful tool.
It is what makes algebraic reasoning possible in Lean.
TEXT. -/


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ring.ulift
import Mathlib.ring_theory.witt_vector.basic
import Mathlib.data.mv_polynomial.funext
import Mathlib.PostPort

universes u_2 u_1 u

namespace Mathlib

/-!
# The `is_poly` predicate

`witt_vector.is_poly` is a (type-valued) predicate on functions `f : Π R, 𝕎 R → 𝕎 R`.
It asserts that there is a family of polynomials `φ : ℕ → mv_polynomial ℕ ℤ`,
such that the `n`th coefficient of `f x` is equal to `φ n` evaluated on the coefficients of `x`.
Many operations on Witt vectors satisfy this predicate (or an analogue for higher arity functions).
We say that such a function `f` is a *polynomial function*.

The power of satisfying this predicate comes from `is_poly.ext`.
It shows that if `φ` and `ψ` witness that `f` and `g` are polynomial functions,
then `f = g` not merely when `φ = ψ`, but in fact it suffices to prove
```
∀ n, bind₁ φ (witt_polynomial p _ n) = bind₁ ψ (witt_polynomial p _ n)
```
(in other words, when evaluating the Witt polynomials on `φ` and `ψ`, we get the same values)
which will then imply `φ = ψ` and hence `f = g`.

Even though this sufficient condition looks somewhat intimidating,
it is rather pleasant to check in practice;
more so than direct checking of `φ = ψ`.

In practice, we apply this technique to show that the composition of `witt_vector.frobenius`
and `witt_vector.verschiebung` is equal to multiplication by `p`.

## Main declarations

* `witt_vector.is_poly`, `witt_vector.is_poly₂`:
  two predicates that assert that a unary/binary function on Witt vectors
  is polynomial in the coefficients of the input values.
* `witt_vector.is_poly.ext`, `witt_vector.is_poly₂.ext`:
  two polynomial functions are equal if their families of polynomials are equal
  after evaluating the Witt polynmials on them.
* `witt_vector.is_poly.comp` (+ many variants) show that unary/binary compositions
  of polynomial functions are polynomial.
* `witt_vector.id_is_poly`, `witt_vector.neg_is_poly`,
  `witt_vector.add_is_poly₂`, `witt_vector.mul_is_poly₂`:
  several well-known operations are polynomial functions
  (for Verschiebung, Frobenius, and multiplication by `p`, see their respective files).

## On higher arity analogues

Ideally, there should be a predicate `is_polyₙ` for functions of higher arity,
together with `is_polyₙ.comp` that shows how such functions compose.
Since mathlib does not have a library on composition of higher arity functions,
we have only implemented the unary and binary variants so far.
Nullary functions (a.k.a. constants) are treated
as constant functions and fall under the unary case.

## Tactics

There are important metaprograms defined in this file:
the tactics `ghost_simp` and `ghost_calc` and the attributes `@[is_poly]` and `@[ghost_simps]`.
These are used in combination to discharge proofs of identities between polynomial functions.

Any atomic proof of `is_poly` or `is_poly₂` (i.e. not taking additional `is_poly` arguments)
should be tagged as `@[is_poly]`.

Any lemma doing "ring equation rewriting" with polynomial functions should be tagged
`@[ghost_simps]`, e.g.
```lean
@[ghost_simps]
lemma bind₁_frobenius_poly_witt_polynomial (n : ℕ) :
  bind₁ (frobenius_poly p) (witt_polynomial p ℤ n) = (witt_polynomial p ℤ (n+1))
```

Proofs of identities between polynomial functions will often follow the pattern
```lean
begin
  ghost_calc _,
  <minor preprocessing>,
  ghost_simp
end
```
-/

/-
### Simplification tactics

`ghost_simp` is used later in the development for certain simplifications.
We define it here so it is a shared import.
-/

namespace tactic

namespace interactive

/-- A macro for a common simplification when rewriting with ghost component equations. -/
/--
`ghost_calc` is a tactic for proving identities between polynomial functions.
Typically, when faced with a goal like
```lean
∀ (x y : 𝕎 R), verschiebung (x * frobenius y) = verschiebung x * y
```
you can
1. call `ghost_calc`
2. do a small amount of manual work -- maybe nothing, maybe `rintro`, etc
3. call `ghost_simp`

and this will close the goal.

`ghost_calc` cannot detect whether you are dealing with unary or binary polynomial functions.
You must give it arguments to determine this.
If you are proving a universally quantified goal like the above,
call `ghost_calc _ _`.
If the variables are introduced already, call `ghost_calc x y`.
In the unary case, use `ghost_calc _` or `ghost_calc x`.

`ghost_calc` is a light wrapper around type class inference.
All it does is apply the appropriate extensionality lemma and try to infer the resulting goals.
This is subtle and Lean's elaborator doesn't like it because of the HO unification involved,
so it is easier (and prettier) to put it in a tactic script.
-/
end interactive

end tactic

namespace witt_vector

/-!
### The `is_poly` predicate
-/

theorem poly_eq_of_witt_polynomial_bind_eq' (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)]
    (f : ℕ → mv_polynomial (idx × ℕ) ℤ) (g : ℕ → mv_polynomial (idx × ℕ) ℤ)
    (h :
      ∀ (n : ℕ),
        coe_fn (mv_polynomial.bind₁ f) (witt_polynomial p ℤ n) =
          coe_fn (mv_polynomial.bind₁ g) (witt_polynomial p ℤ n)) :
    f = g :=
  sorry

theorem poly_eq_of_witt_polynomial_bind_eq (p : ℕ) [hp : fact (nat.prime p)]
    (f : ℕ → mv_polynomial ℕ ℤ) (g : ℕ → mv_polynomial ℕ ℤ)
    (h :
      ∀ (n : ℕ),
        coe_fn (mv_polynomial.bind₁ f) (witt_polynomial p ℤ n) =
          coe_fn (mv_polynomial.bind₁ g) (witt_polynomial p ℤ n)) :
    f = g :=
  sorry

-- Ideally, we would generalise this to n-ary functions

-- But we don't have a good theory of n-ary compositions in mathlib

/--
A function `f : Π R, 𝕎 R → 𝕎 R` that maps Witt vectors to Witt vectors over arbitrary base rings
is said to be *polynomial* if there is a family of polynomials `φₙ` over `ℤ` such that the `n`th
coefficient of `f x` is given by evaluating `φₙ` at the coefficients of `x`.

See also `witt_vector.is_poly₂` for the binary variant.

The `ghost_calc` tactic treats `is_poly` as a type class,
and the `@[is_poly]` attribute derives certain specialized composition instances
for declarations of type `is_poly f`.
For the most part, users are not expected to treat `is_poly` as a class.
-/
def is_poly (p : ℕ)
    (f : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R) :=
  ∃ (φ : ℕ → mv_polynomial ℕ ℤ),
    ∀ {R : Type u_1} [_inst_4 : comm_ring R] (x : witt_vector p R),
      coeff (f x) = fun (n : ℕ) => coe_fn (mv_polynomial.aeval (coeff x)) (φ n)

/-- The identity function on Witt vectors is a polynomial function. -/
protected instance id_is_poly (p : ℕ) : is_poly p fun (_x : Type u_1) (_x_1 : comm_ring _x) => id :=
  Exists.intro mv_polynomial.X
    fun (R : Type u_1) (_inst_4 : comm_ring R) (x : witt_vector p R) =>
      eq.mpr
        (id
          ((fun (a a_1 : ℕ → R) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℕ → R) (e_2 : ᾰ = ᾰ_1) =>
              congr (congr_arg Eq e_1) e_2)
            (coeff ((fun (_x : Type u_1) (_x_1 : comm_ring _x) => id) R _inst_4 x)) (coeff x)
            ((fun (x x_1 : witt_vector p R) (e_1 : x = x_1) => congr_arg coeff e_1)
              ((fun (_x : Type u_1) (_x_1 : comm_ring _x) => id) R _inst_4 x) x
              (id.equations._eqn_1 x))
            (fun (n : ℕ) => coe_fn (mv_polynomial.aeval (coeff x)) (mv_polynomial.X n)) (coeff x)
            (funext fun (n : ℕ) => mv_polynomial.aeval_X (coeff x) n)))
        (Eq.refl (coeff x))

protected instance id_is_poly_i' (p : ℕ) :
    is_poly p fun (_x : Type u_1) (_x_1 : comm_ring _x) (a : witt_vector p _x) => a :=
  witt_vector.id_is_poly p

namespace is_poly

protected instance inhabited (p : ℕ) :
    Inhabited (is_poly p fun (_x : Type u_1) (_x_1 : comm_ring _x) => id) :=
  { default := witt_vector.id_is_poly p }

theorem ext {p : ℕ} [hp : fact (nat.prime p)]
    {f : {R : Type u} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    {g : {R : Type u} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    (hf : is_poly p f) (hg : is_poly p g)
    (h :
      ∀ (R : Type u) [_Rcr : comm_ring R] (x : witt_vector p R) (n : ℕ),
        coe_fn (ghost_component n) (f x) = coe_fn (ghost_component n) (g x))
    (R : Type u) [comm_ring R] (x : witt_vector p R) : f x = g x :=
  sorry

/-- The composition of polynomial functions is polynomial. -/
theorem comp {p : ℕ}
    {g : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    {f : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    (hg : is_poly p g) (hf : is_poly p f) :
    is_poly p fun (R : Type u_1) (_Rcr : comm_ring R) => g ∘ f :=
  sorry

end is_poly

/--
A binary function `f : Π R, 𝕎 R → 𝕎 R → 𝕎 R` on Witt vectors
is said to be *polynomial* if there is a family of polynomials `φₙ` over `ℤ` such that the `n`th
coefficient of `f x y` is given by evaluating `φₙ` at the coefficients of `x` and `y`.

See also `witt_vector.is_poly` for the unary variant.

The `ghost_calc` tactic treats `is_poly₂` as a type class,
and the `@[is_poly]` attribute derives certain specialized composition instances
for declarations of type `is_poly₂ f`.
For the most part, users are not expected to treat `is_poly₂` as a class.
-/
def is_poly₂ (p : ℕ)
    (f :
      {R : Type u_1} →
        [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R) :=
  ∃ (φ : ℕ → mv_polynomial (fin (bit0 1) × ℕ) ℤ),
    ∀ {R : Type u_1} [_inst_4 : comm_ring R] (x y : witt_vector p R),
      coeff (f x y) =
        fun (n : ℕ) =>
          peval (φ n) (matrix.vec_cons (coeff x) (matrix.vec_cons (coeff y) matrix.vec_empty))

/-- The composition of polynomial functions is polynomial. -/
theorem is_poly₂.comp {p : ℕ}
    {h :
      {R : Type u_1} →
        [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    {f : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    {g : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    (hh : is_poly₂ p h) (hf : is_poly p f) (hg : is_poly p g) :
    is_poly₂ p fun (R : Type u_1) (_Rcr : comm_ring R) (x y : witt_vector p R) => h (f x) (g y) :=
  sorry

/-- The composition of a polynomial function with a binary polynomial function is polynomial. -/
theorem is_poly.comp₂ {p : ℕ}
    {g : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    {f :
      {R : Type u_1} →
        [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    (hg : is_poly p g) (hf : is_poly₂ p f) :
    is_poly₂ p fun (R : Type u_1) (_Rcr : comm_ring R) (x y : witt_vector p R) => g (f x y) :=
  sorry

/-- The diagonal `λ x, f x x` of a polynomial function `f` is polynomial. -/
theorem is_poly₂.diag {p : ℕ}
    {f :
      {R : Type u_1} →
        [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    (hf : is_poly₂ p f) :
    is_poly p fun (R : Type u_1) (_Rcr : comm_ring R) (x : witt_vector p R) => f x x :=
  sorry

namespace tactic

/-!
### The `@[is_poly]` attribute

This attribute is used to derive specialized composition instances
for `is_poly` and `is_poly₂` declarations.
-/

/--
If `n` is the name of a lemma with opened type `∀ vars, is_poly p _`,
`mk_poly_comp_lemmas n vars p` adds composition instances to the environment
`n.comp_i` and `n.comp₂_i`.
-/
/--
If `n` is the name of a lemma with opened type `∀ vars, is_poly₂ p _`,
`mk_poly₂_comp_lemmas n vars p` adds composition instances to the environment
`n.comp₂_i` and `n.comp_diag`.
-/
/--
The `after_set` function for `@[is_poly]`. Calls `mk_poly(₂)_comp_lemmas`.
-/
/--
`@[is_poly]` is applied to lemmas of the form `is_poly f φ` or `is_poly₂ f φ`.
These lemmas should *not* be tagged as instances, and only atomic `is_poly` defs should be tagged:
composition lemmas should not. Roughly speaking, lemmas that take `is_poly` proofs as arguments
should not be tagged.

Type class inference struggles with function composition, and the higher order unification problems
involved in inferring `is_poly` proofs are complex. The standard style writing these proofs by hand
doesn't work very well. Instead, we construct the type class hierarchy "under the hood", with
limited forms of composition.

Applying `@[is_poly]` to a lemma creates a number of instances. Roughly, if the tagged lemma is a
proof of `is_poly f φ`, the instances added have the form
```lean
∀ g ψ, [is_poly g ψ] → is_poly (f ∘ g) _
```
Since `f` is fixed in this instance, it restricts the HO unification needed when the instance is
applied. Composition lemmas relating `is_poly` with `is_poly₂` are also added.
`id_is_poly` is an atomic instance.

The user-written lemmas are not instances. Users should be able to assemble `is_poly` proofs by hand
"as normal" if the tactic fails.
-/
end tactic

/-!
### `is_poly` instances

These are not declared as instances at the top level,
but the `@[is_poly]` attribute adds instances based on each one.
Users are expected to use the non-instance versions manually.
-/

/-- The additive negation is a polynomial function on Witt vectors. -/
theorem neg_is_poly {p : ℕ} [hp : fact (nat.prime p)] :
    is_poly p fun (R : Type u_1) (_x : comm_ring R) => Neg.neg :=
  sorry

/- To avoid a theory of 0-ary functions (a.k.a. constants)
we model them as constant unary functions. -/

/-- The function that is constantly zero on Witt vectors is a polynomial function. -/
protected instance zero_is_poly {p : ℕ} [hp : fact (nat.prime p)] :
    is_poly p fun (_x : Type u_1) (_x_1 : comm_ring _x) (_x_2 : witt_vector p _x) => 0 :=
  Exists.intro 0
    fun (R : Type u_1) (_inst_4 : comm_ring R) (x : witt_vector p R) =>
      funext
        fun (n : ℕ) =>
          eq.mpr
            (id
              ((fun (a a_1 : R) (e_1 : a = a_1) (ᾰ ᾰ_1 : R) (e_2 : ᾰ = ᾰ_1) =>
                  congr (congr_arg Eq e_1) e_2)
                (coeff
                  ((fun (_x : Type u_1) (_x_1 : comm_ring _x) (_x_2 : witt_vector p _x) => 0) R
                    _inst_4 x)
                  n)
                0 (zero_coeff p R n) (coe_fn (mv_polynomial.aeval (coeff x)) (HasZero.zero n)) 0
                (Eq.trans
                  ((fun (x x_1 : alg_hom ℤ (mv_polynomial ℕ ℤ) R) (e_1 : x = x_1)
                      (ᾰ ᾰ_1 : mv_polynomial ℕ ℤ) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg coe_fn e_1) e_2)
                    (mv_polynomial.aeval (coeff x)) (mv_polynomial.aeval (coeff x))
                    (Eq.refl (mv_polynomial.aeval (coeff x))) (HasZero.zero n) 0 (pi.zero_apply n))
                  (alg_hom.map_zero (mv_polynomial.aeval (coeff x))))))
            (Eq.refl 0)

@[simp] theorem bind₁_zero_witt_polynomial {p : ℕ} {R : Type u} [hp : fact (nat.prime p)]
    [comm_ring R] (n : ℕ) : coe_fn (mv_polynomial.bind₁ 0) (witt_polynomial p R n) = 0 :=
  sorry

/-- The coefficients of `1 : 𝕎 R` as polynomials. -/
def one_poly (n : ℕ) : mv_polynomial ℕ ℤ := ite (n = 0) 1 0

@[simp] theorem bind₁_one_poly_witt_polynomial {p : ℕ} [hp : fact (nat.prime p)] (n : ℕ) :
    coe_fn (mv_polynomial.bind₁ one_poly) (witt_polynomial p ℤ n) = 1 :=
  sorry

/-- The function that is constantly one on Witt vectors is a polynomial function. -/
protected instance one_is_poly {p : ℕ} [hp : fact (nat.prime p)] :
    is_poly p fun (_x : Type u_1) (_x_1 : comm_ring _x) (_x_2 : witt_vector p _x) => 1 :=
  sorry

/-- Addition of Witt vectors is a polynomial function. -/
theorem add_is_poly₂ {p : ℕ} [fact (nat.prime p)] :
    is_poly₂ p fun (_x : Type u_1) (_x_1 : comm_ring _x) => Add.add :=
  Exists.intro (witt_add p)
    fun (R : Type u_1) (_inst_4 : comm_ring R) (x y : witt_vector p R) =>
      Eq.refl (coeff ((fun (_x : Type u_1) (_x_1 : comm_ring _x) => Add.add) R _inst_4 x y))

/-- Multiplication of Witt vectors is a polynomial function. -/
theorem mul_is_poly₂ {p : ℕ} [fact (nat.prime p)] :
    is_poly₂ p fun (_x : Type u_1) (_x_1 : comm_ring _x) => Mul.mul :=
  Exists.intro (witt_mul p)
    fun (R : Type u_1) (_inst_4 : comm_ring R) (x y : witt_vector p R) =>
      Eq.refl (coeff ((fun (_x : Type u_1) (_x_1 : comm_ring _x) => Mul.mul) R _inst_4 x y))

-- unfortunately this is not universe polymorphic, merely because `f` isn't

theorem is_poly.map {p : ℕ} {R : Type u} {S : Type u} [hp : fact (nat.prime p)] [comm_ring R]
    [comm_ring S] {f : {R : Type u} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    (hf : is_poly p f) (g : R →+* S) (x : witt_vector p R) :
    coe_fn (map g) (f x) = f (coe_fn (map g) x) :=
  sorry

namespace is_poly₂

protected instance inhabited {p : ℕ} [fact (nat.prime p)] :
    Inhabited (is_poly₂ p fun (_x : Type u_1) (_x_1 : comm_ring _x) => Add.add) :=
  { default := add_is_poly₂ }

/-- The composition of a binary polynomial function
 with a unary polynomial function in the first argument is polynomial. -/
theorem comp_left {p : ℕ}
    {g :
      {R : Type u_1} →
        [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    {f : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    (hg : is_poly₂ p g) (hf : is_poly p f) :
    is_poly₂ p fun (R : Type u_1) (_Rcr : comm_ring R) (x y : witt_vector p R) => g (f x) y :=
  comp hg hf (witt_vector.id_is_poly p)

/-- The composition of a binary polynomial function
 with a unary polynomial function in the second argument is polynomial. -/
theorem comp_right {p : ℕ}
    {g :
      {R : Type u_1} →
        [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    {f : {R : Type u_1} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R}
    (hg : is_poly₂ p g) (hf : is_poly p f) :
    is_poly₂ p fun (R : Type u_1) (_Rcr : comm_ring R) (x y : witt_vector p R) => g x (f y) :=
  comp hg (witt_vector.id_is_poly p) hf

theorem ext {p : ℕ} [hp : fact (nat.prime p)]
    {f :
      {R : Type u} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    {g :
      {R : Type u} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    (hf : is_poly₂ p f) (hg : is_poly₂ p g)
    (h :
      ∀ (R : Type u) [_Rcr : comm_ring R] (x y : witt_vector p R) (n : ℕ),
        coe_fn (ghost_component n) (f x y) = coe_fn (ghost_component n) (g x y))
    (R : Type u) [comm_ring R] (x : witt_vector p R) (y : witt_vector p R) : f x y = g x y :=
  sorry

-- unfortunately this is not universe polymorphic, merely because `f` isn't

theorem map {p : ℕ} {R : Type u} {S : Type u} [hp : fact (nat.prime p)] [comm_ring R] [comm_ring S]
    {f :
      {R : Type u} → [_inst_3 : comm_ring R] → witt_vector p R → witt_vector p R → witt_vector p R}
    (hf : is_poly₂ p f) (g : R →+* S) (x : witt_vector p R) (y : witt_vector p R) :
    coe_fn (map g) (f x y) = f (coe_fn (map g) x) (coe_fn (map g) y) :=
  sorry

end Mathlib


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

import group_theory.subgroup.basic
import group_theory.group_action.basic

/-!

# Fixing submonoid, fixing subgroup of an action

In the presence of of an action of a monoid or a group,
this file defines the fixing submonoid or the fixing subgroup,
and relates it to the set of fixed points via a Galois connection.

## Main definitions

* `fixing_submonoid M s` : in the presence of `mul_action M α` (with `monoid M`)
  it is the `submonoid M` consisting of elements which fix `s : set α` pointwise.

* `fixing_submonoid_fixed_points_gc M α` is the `galois_connection`
  that relates `fixing_submonoid` with `fixed_points`.

* `fixing_subgroup M s` : in the presence of `mul_action M α` (with `group M`)
  it is the `subgroup M` consisting of elements which fix `s : set α` pointwise.

* `fixing_subgroup_fixed_points_gc M α` is the `galois_connection`
  that relates `fixing_subgroup` with `fixed_points`.

TODO :

* Maybe other lemmas are useful

* Treat semigroups ?

-/

section monoid

open mul_action

variables (M : Type*) {α : Type*} [monoid M] [mul_action M α]

/-- The submonoid fixing a set under a `mul_action`. -/
@[to_additive /-" The additive submonoid fixing a set under an `add_action`. "-/]
def fixing_submonoid (s : set α) : submonoid M :=
{ carrier := { ϕ : M | ∀ x : s, ϕ • (x : α) = x },
  one_mem' := λ _, one_smul _ _,
  mul_mem' := λ x y hx hy z, by rw [mul_smul, hy z, hx z], }

lemma mem_fixing_submonoid_iff {s : set α} {m : M} :
  m ∈ fixing_submonoid M s ↔ ∀ y ∈ s, m • y = y :=
⟨λ hg y hy, hg ⟨y, hy⟩, λ h ⟨y, hy⟩, h y hy⟩

variable (α)

/-- The Galois connection between fixing submonoids and fixed points of a monoid action -/
theorem fixing_submonoid_fixed_points_gc : galois_connection
  (order_dual.to_dual ∘ (fixing_submonoid M))
  ((λ P : submonoid M, (fixed_points P α)) ∘ order_dual.of_dual) :=
λ s P, ⟨λ h s hs p, h p.2 ⟨s, hs⟩, λ h p hp s, h s.2 ⟨p, hp⟩⟩

lemma fixing_submonoid_antitone : antitone (λ (s : set α), fixing_submonoid M s) :=
(fixing_submonoid_fixed_points_gc M α).monotone_l

lemma fixed_points_antitone :
  antitone (λ (P : submonoid M), fixed_points P α) :=
(fixing_submonoid_fixed_points_gc M α).monotone_u.dual_left

/-- Fixing submonoid of union is intersection -/
lemma fixing_submonoid_union {s t : set α} :
  fixing_submonoid M (s ∪ t) = fixing_submonoid M s ⊓ fixing_submonoid M t :=
(fixing_submonoid_fixed_points_gc M α).l_sup

/-- Fixing submonoid of Union is intersection -/
lemma fixing_submonoid_Union {ι : Sort*} {s : ι → set α} :
  fixing_submonoid M (⋃ i, s i) = ⨅ i, fixing_submonoid M (s i) :=
(fixing_submonoid_fixed_points_gc M α).l_supr

/-- Fixed points of sup of submonoids is intersection -/
lemma fixed_points_submonoid_sup {P Q : submonoid M} :
  fixed_points ↥(P ⊔ Q) α = fixed_points P α ∩ fixed_points Q α :=
(fixing_submonoid_fixed_points_gc M α).u_inf

/-- Fixed points of supr of submonoids is intersection -/
lemma fixed_points_submonoid_supr {ι : Sort*} {P : ι → submonoid M} :
  fixed_points ↥(supr P) α = ⋂ i, fixed_points (P i) α :=
(fixing_submonoid_fixed_points_gc M α).u_infi

end monoid

section group

open mul_action

variables (M : Type*) {α : Type*} [group M] [mul_action M α]

/-- The subgroup fixing a set under a `mul_action`. -/
@[to_additive /-" The additive subgroup fixing a set under an `add_action`. "-/]
def fixing_subgroup (s : set α) : subgroup M :=
{ inv_mem' := λ _ hx z, by rw [inv_smul_eq_iff, hx z],
  ..fixing_submonoid M s, }

lemma mem_fixing_subgroup_iff {s : set α} {m : M} :
  m ∈ fixing_subgroup M s ↔ ∀ y ∈ s, m • y = y :=
⟨λ hg y hy, hg ⟨y, hy⟩, λ h ⟨y, hy⟩, h y hy⟩

variable (α)

/-- The Galois connection between fixing subgroups and fixed points of a group action -/
lemma fixing_subgroup_fixed_points_gc : galois_connection
  (order_dual.to_dual ∘ fixing_subgroup M)
  ((λ P : subgroup M, fixed_points P α) ∘ order_dual.of_dual) :=
λ s P, ⟨λ h s hs p, h p.2 ⟨s, hs⟩, λ h p hp s, h s.2 ⟨p, hp⟩⟩

lemma fixing_subgroup_antitone : antitone (fixing_subgroup M : set α → subgroup M) :=
(fixing_subgroup_fixed_points_gc M α).monotone_l

lemma fixed_points_subgroup_antitone :
  antitone (λ (P : subgroup M), fixed_points P α) :=
(fixing_subgroup_fixed_points_gc M α).monotone_u.dual_left

/-- Fixing subgroup of union is intersection -/
lemma fixing_subgroup_union {s t : set α} :
  fixing_subgroup M (s ∪ t) = fixing_subgroup M s ⊓ fixing_subgroup M t :=
(fixing_subgroup_fixed_points_gc M α).l_sup

/-- Fixing subgroup of Union is intersection -/
lemma fixing_subgroup_Union {ι : Sort*} {s : ι → set α} :
  fixing_subgroup M (⋃ i, s i) = ⨅ i, fixing_subgroup M (s i) :=
(fixing_subgroup_fixed_points_gc M α).l_supr

/-- Fixed points of sup of subgroups is intersection -/
lemma fixed_points_subgroup_sup {P Q : subgroup M} :
  fixed_points ↥(P ⊔ Q) α = fixed_points P α ∩ fixed_points Q α :=
(fixing_subgroup_fixed_points_gc M α).u_inf

/-- Fixed points of supr of subgroups is intersection -/
lemma fixed_points_subgroup_supr {ι : Sort*} {P : ι → subgroup M} :
  fixed_points ↥(supr P) α = ⋂ i, fixed_points (P i) α :=
(fixing_subgroup_fixed_points_gc M α).u_infi

end group


import Mynat.Ineq

structure myint where
  x : mynat
  y : mynat
  deriving Repr

-- The approach is that we define ℤ by the following quotient:
-- ℕ × ℕ ⧸ ∼
-- ∼ = {((a, b), (c, d)) ∈ (ℕ × ℕ)² : a + d = b + c}

namespace myint

def myequal (a b : myint) : Prop :=
  (a.x + b.y) = (a.y + b.x)

def myintofnat (n : Nat) :=
  myint.mk (mynat.myofnat n) 0

instance : OfNat myint n where
  ofNat := myintofnat n

def toInt (n : myint) :=
  (n.x : Int) - (n.y : Int)

instance : Coe myint Int where
  coe := toInt

#check Quot myequal

-- The following section proves that myequal is an equivalence relation,
-- which means refl, symm and trans hold.

theorem refl (a : myint) : myequal a a := by
  rw [myequal]
  rw [mynat.add_comm]

theorem symm {a b : myint} (hab : myequal a b) : myequal b a := by
  rw [myequal]
  apply Eq.symm
  rw [myequal] at hab
  rw [mynat.add_comm]
  rw [mynat.add_comm b.x a.y]
  exact hab

theorem trans {a b c : myint} (hab : myequal a b) (hbc : myequal b c) : myequal a c := by
  rw [myequal] at hab hbc ⊢
  have hsum := (calc
    a.x + b.y + (b.x + c.y) = a.y + b.x + (b.y + c.x) := by rw [hab, hbc]
  )
  rw [← mynat.add_assoc _ b.x c.y] at hsum
  rw [mynat.add_assoc a.x b.y _] at hsum
  rw [mynat.add_comm b.y b.x] at hsum
  rw [mynat.add_comm a.x _] at hsum
  rw [← mynat.add_assoc (a.y + b.x) b.y c.x] at hsum
  rw [mynat.add_assoc a.y _ _] at hsum
  rw [mynat.add_comm a.y _] at hsum
  rw [mynat.add_assoc (b.x + b.y) _ _] at hsum
  rw [mynat.add_assoc (b.x + b.y) _ _] at hsum
  exact mynat.add_left_cancel (b.x + b.y) _ _ hsum

instance : Equivalence myequal where
  refl := refl
  symm := symm
  trans := trans

instance : HasEquiv myint where
  Equiv := myequal

theorem equiv_is_myequal (a b : myint) : a ≈ b ↔ myequal a b := Iff.rfl
axiom equal_is_xyequal (a b : myint) : a = b ↔ a.x = b.x ∧ a.y = b.y
theorem equal_implies_equiv (a b : myint) : a = b → a ≈ b := by
  intro hab
  rw [equiv_is_myequal]
  rw [myequal]
  rw [hab]
  rw [mynat.add_comm]

theorem destruct_x (ax ay : mynat) : ({ x := ax, y := ay } : myint).x = ax := rfl
theorem destruct_y (ax ay : mynat) : ({ x := ax, y := ay } : myint).y = ay := rfl

theorem default_nat_has_no_y (n : Nat) : (@OfNat.ofNat myint n instOfNatMyint).y = 0 := by
  rw [OfNat.ofNat, instOfNatMyint, myintofnat]

theorem default_nat_has_same_x (n : Nat) : (@OfNat.ofNat myint n instOfNatMyint).x = mynat.myofnat n := by
  rw [OfNat.ofNat, instOfNatMyint, myintofnat]

def mynotequal (a b : myint) : Prop :=
  (a.x + b.y) ≠ (a.y + b.x)

infix:50 " ≉  " => mynotequal

theorem nequiv_iff_not_equiv (a b : myint) : a ≉ b ↔ ¬ (a ≈ b) := by
  apply Iff.intro
  . intro h
    rw [mynotequal] at h
    rw [equiv_is_myequal, myequal]
    exact h
  . intro h
    rw [equiv_is_myequal, myequal] at h
    rw [mynotequal]
    exact h

end myint


import   data.set.finite
open  set

variables α  : Type
variable [decidable_eq α]

 theorem infinite_ramsey (s  :set α) (C:finset α → ℕ  ) (m n:ℕ):
 infinite s ∧
 (∀ t:finset α,   t.to_set ⊆ s ∧ t.card  = n  → C t≤ m)
→  ∃ t c, infinite t ∧ t ⊆ s ∧
        (∀ u:finset α,    u.to_set ⊆ t ∧ u.card =n  → C u = c)
:=
begin
end

def complete_graph (s:finset(finset α )):Prop:=
(∀ t:finset α, t∈ s → t.card =2) ∧
(∀ t:finset α, t ∈ finset.powerset( s.bind (λ t,t)) ∧ t.card=2 →  t ∈ s )

def complete_k_graph (s:finset(finset α )) (k:ℕ):Prop:=
(∀ t:finset α, t∈ s → t.card =k) ∧
(∀ t:finset α, t ∈ finset.powerset( s.bind (λ t,t)) ∧ t.card=k →  t ∈ s )

theorem ramsey2 (M N:ℕ ):
∃ (n : ℕ) (s:finset(finset α )),
  complete_graph _ s ∧
     ( s.bind (λ t,t)).card =n ∧
      ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ s → c t ≤ 1) →
        (∃ r t : finset(finset α ),
           r ⊆ s ∧ complete_graph _ r ∧
             t ⊆ s ∧ complete_graph _ t ∧
               (∀ (e : finset α), e ∈ t → c e = 0) ∧
                 (∀ (e : finset α), e ∈ r → c e = 1) ∧  ( t.bind (λ t,t)).card =M ∧
                  ( r.bind (λ t,t)).card =N)
:=
begin
end

theorem colours_ramsey (S:finset ℕ ):
∃ (n : ℕ) (s : finset(finset α)),
  complete_graph _ s ∧
     ( s.bind (λ t,t)).card =n ∧
       ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ s → c t ≤ S.card ) →
              ∀ (ci : ℕ),ci ∈ S →
               (∃ (ri : finset(finset α )) (cc:ℕ ),
                ri ⊆ s ∧ complete_graph _ ri ∧
                ( ri.bind (λ t,t)).card = ci ∧
                 ∀ (x : finset α), x ∈ ri → c x = cc )
:=
begin
end

theorem ramsey2_hypergraph (M N k:ℕ ):
∃ (n : ℕ) (s:finset(finset α )),
  complete_k_graph _ s k ∧
     ( s.bind (λ t,t)).card =n ∧
      ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ s → c t ≤ 1) →
        (∃ r t : finset(finset α ),
           r ⊆ s ∧ complete_k_graph _ r k ∧
             t ⊆ s ∧ complete_k_graph _ t k ∧
               (∀ (e : finset α), e ∈ t → c e = 0) ∧
                 (∀ (e : finset α), e ∈ r → c e = 1) ∧  ( t.bind (λ t,t)).card =M ∧
                  ( r.bind (λ t,t)).card =N)
:=
begin
end

theorem colours_ramsey_hypergraph (S:finset ℕ) (k:ℕ):
∃ (n : ℕ) (s : finset(finset α)),
  complete_k_graph _ s k ∧
     ( s.bind (λ t,t)).card =n ∧
       ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ s → c t ≤ S.card ) →
              ∀ (ci : ℕ), ci ∈ S →
               (∃ (ri : finset(finset α )) (cc:ℕ ),
               ri ⊆ s ∧ complete_k_graph _ ri k ∧
               ( ri.bind (λ t,t)).card = ci ∧
                 ∀ (x : finset α), x ∈ ri → c x = cc )
:=
begin
end

def complete_graph_v1 (s:finset α ):finset(finset α):=
(finset.powerset s).filter (λ t:finset α, t.card =2)

def complete_k_graph_v1 (s:(finset α )) (k:ℕ):finset(finset α) :=
(finset.powerset s).filter (λ t:finset α, t.card =k)

theorem ramsey2_v1 (M N:ℕ ):
∃ (n : ℕ) (s:finset α ),
      s.card =n ∧
      ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ (complete_graph_v1 α s) → c t ≤ 1) →
        (∃ r t : finset α,
           r ⊆ s ∧  t ⊆ s ∧
               (∀ (e : finset α), e ∈ (complete_graph_v1 _ r) → c e = 0) ∧
                 (∀ (e : finset α), e ∈ complete_graph_v1 _ t → c e = 1) ∧
                  t.card =M ∧ r.card =N)
:=
begin
end

theorem colours_ramsey_v1 (S:finset ℕ ):
∃ (n : ℕ) (s :(finset α)),
      s.card =n ∧
       ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ complete_graph_v1 _ s → c t ≤ S.card ) →
              ∀ (ci : ℕ), ci ∈ S →
               (∃ (ri : finset α ) (cc:ℕ ),
                 ri ⊆ s ∧     ri.card = ci ∧
                 ∀ (x : finset α), x ∈ complete_graph_v1 _ ri → c x = cc )
:=
begin

end

theorem ramsey2_hypergraph_v1 (M N k:ℕ ):
∃ (n : ℕ) (s:(finset α )),
      s.card =n ∧
      ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ (complete_k_graph_v1 _ s k) → c t ≤ 1) →
        (∃ r t : finset α ,
           r ∈  (complete_k_graph_v1 _ s M) ∧
           t ∈  (complete_k_graph_v1 _ s N) ∧
               (∀ (e : finset α), e ∈ (complete_k_graph_v1 _ r k) → c e = 0) ∧
                 (∀ (e : finset α), e ∈ (complete_k_graph_v1 _ t k) → c e = 1))
:=
begin
end

theorem colours_ramsey_hypergraph_v1 (S:finset ℕ) (k:ℕ):
∃ (n : ℕ) (s :finset α),
     ( s.card =n ∧
       ∀ (c : finset α → ℕ),
        (∀ (t : finset α), t ∈ (complete_k_graph_v1 _ s k) → c t ≤ S.card ) →
              ∀ (ci : ℕ),  ci ∈ S →
               (∃ (ri : finset α ) (cc:ℕ ),
                ri ∈ (complete_k_graph_v1 _ s ci)∧
                 ∀ (x : finset α), x ∈ (complete_k_graph_v1 _ ri k) → c x = cc ))
:=
begin
end


import data.real.basic
import data.set
import tactic
import data.finset
import tactic.induction
open finset

open_locale big_operators
open_locale classical

--constant X : finset ℕ
--X = ({ x : ℕ // x < 5})
--X = 2
--#print X
--inductive oier : Sort*
--| a
--| b
--| c
--def aosdjfl : finset oier
--:= let x := ({oier.a} : finset oier)
--   in xᶜ
notation ` V' ` := univ

structure strange_digraph (V : Type*)  :=
  (is_edge : V → V → Prop)
  (hnonsymmetric : ∀ u v : V, ¬ ((is_edge u v) ∧ (is_edge v u)))

structure capacity (V : Type*)
  extends strange_digraph V:=
  (c : V -> V -> ℝ)
  (non_neg_capacity : ∀ u v : V, c u v ≥ 0)
  (vanishes : ∀ u v : V, ¬ (is_edge u v) → c u v = 0)

structure flow_network (V : Type*)
  extends capacity V :=
  (source : V)
  (sink : V)

noncomputable
def mk_in {V : Type* } [inst : fintype V]
  (f : V -> V -> ℝ) (s : finset V) : ℝ
  := ∑ x in finset.univ \ s, ∑ y in s, f x y

noncomputable
def mk_out {V : Type* } [inst : fintype V]
  (f : V -> V -> ℝ) (s : finset V) : ℝ
  := ∑ x in s, ∑ y in finset.univ \ s, f x y

structure active_flow_network (V : Type*)  [fintype V]
  :=
  (network : flow_network V)
  (f : V -> V -> ℝ)
  (non_neg_flow : ∀ u v : V, f u v ≥ 0)
  (no_overflow : ∀ u v : V, f u v ≤ network.c u v)
  (conservation : ∀ v : V,
                  v ∈ (V' : finset V) \ {network.source, network.sink} →
                  mk_out f {v} = mk_in f {v})

noncomputable def F_value {V : Type*}  [fintype V] :
                  active_flow_network V -> ℝ
:= λ N, mk_out N.f {N.network.source} - mk_in N.f {N.network.source}

structure cut (V : Type*)  [fintype V]
  :=
  (network : flow_network V)
  (S : finset V)
  (T : finset V)
  (sins : network.source ∈ S)
  (tint : network.sink ∈ T)
  (Tcomp : T = univ \ S)

noncomputable
def cut_value {V : Type*}  [inst' : fintype V]
    (c : cut V) : ℝ
:= mk_out c.network.c c.S

lemma f_vanishes_outside_edge {V : Type*} [fintype V]
  (afn : active_flow_network V) (u : V) (v : V) (not_edge: ¬afn.network.is_edge u v): afn.f u v = 0 :=
  begin
    have cap_is_zero: afn.network.c u v = 0 :=
      begin
        exact afn.network.vanishes u v not_edge,
      end,
    have bar := afn.no_overflow u v,
    have foo := afn.non_neg_flow u v,
    linarith,
  end

lemma x_not_in_s {V : Type*} [fintype V]
  (c : cut V)  : ∀ x : V, x ∈ c.T -> x ∉ ({c.network.source} : finset V) :=
begin
  intros x hxinS,
  cases c,
  simp only [mem_singleton] at *,
  rw c_Tcomp at hxinS,
  have foo : univ \ c_S ∩ c_S = ∅ := sdiff_inter_self c_S univ,
  have foo : disjoint (univ \ c_S)  c_S  := sdiff_disjoint,
  have bar : c_network.source ∈ c_S := c_sins,
  exact disjoint_iff_ne.mp foo x hxinS c_network.source c_sins
end

lemma foobar { a b : ℝ } : a + - b = a - b := rfl

lemma f_zero_zero {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (x : V) : afn.f x x = 0 :=
begin
 have hnonsymm : _ := afn.network.hnonsymmetric x x,
 have hvanish: _ := afn.network.vanishes x x,
 simp only [not_and, imp_not_self] at hnonsymm,
 have hnon_edge := hnonsymm, clear hnonsymm,
 have hcapacity_zero := hvanish hnon_edge,
 have hno_overflow := afn.no_overflow x x,
 rw hcapacity_zero at hno_overflow,
 have hnon_neg_flow := afn.non_neg_flow x x,
 linarith,
end

lemma mk_in_single_node { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  mk_in (afn.f) {p} = ∑ v in finset.univ, (afn.f) v p :=
  begin
      rw @sum_eq_sum_diff_singleton_add _ _ _ _ univ p (by simp only [mem_univ]) (λ x, afn.f x p),
      have foo : (λ (x : V), afn.f x p) p = afn.f p p := rfl,
      simp only [congr_fun],
      rw f_zero_zero afn p,
      have bar : ∑ (x : V) in univ \ {p}, afn.f x p + 0 = (λp', ∑ (x : V) in univ \ {p'}, afn.f x p' ) p
      := by simp only [add_zero],
      rw bar, clear bar,
      rw ← @finset.sum_singleton _ _ p (λp', ∑ (x : V) in univ \ {p'}, afn.f x p' ) _,
      simp only [mk_in, sum_singleton],
  end

@[simp] lemma mk_in_single_node' { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  ∑ v in finset.univ, (afn.f) v p = mk_in (afn.f) {p} :=
  by rw mk_in_single_node

lemma mk_out_single_node { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  mk_out afn.f {p} = ∑ v in finset.univ, (afn.f) p v :=
begin
  sorry,
end

@[simp] lemma mk_out_single_node' { V : Type* }  [fintype V]
  (p : V) (afn : active_flow_network V) :
  ∑ v in finset.univ, (afn.f) p v = mk_out afn.f {p} :=
  by rw mk_out_single_node

lemma break_out_neg (a b : ℝ) : (-a) + -(b) = -(a + b) :=
by ring

noncomputable
def tmp_f {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (x : V) : ℝ
:= (mk_out afn.f {x} - mk_in afn.f {x})

def tmp_zero {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (x : V) : ℝ
:= 0

lemma lemma_1 {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V) :
S ⊆ finset.univ \ {afn.network.source, afn.network.sink} -> mk_in afn.f S = mk_out afn.f S
:=
begin
  intro hin,
  rw ← add_left_inj (- mk_out afn.f S),
  simp only [add_right_neg],
  rw ← add_zero (mk_in afn.f S),
  nth_rewrite 0 ← add_neg_self (∑ u in S, (∑ v in S, afn.f u v)),
  rw ← add_assoc,
  have tmp : mk_in afn.f S + ∑ u in S, ∑ v in S, afn.f u v =
             ∑ u in S, ∑ v in finset.univ, afn.f u v
             := by sorry,

  have tmp2: mk_out afn.f S + (∑ u in S, ∑ v in S, afn.f u v) =
             ∑ u in S, ∑ v in finset.univ, afn.f v u
             := by sorry,
  rw tmp,
  rw add_assoc,
  rw break_out_neg,
  nth_rewrite 1 add_comm,
  rw tmp2,
  clear tmp tmp2,
  rw foobar,
  rw ← @sum_sub_distrib _ _ S _ _ _,
  simp only [mk_in_single_node', mk_out_single_node'],
  -- have f := λ x, (mk_out afn.f {x} - mk_in afn.f {x}),
  have hseq : S = S := rfl,
  have h : ∀ (x : V), x ∈ S -> tmp_f afn x = tmp_zero afn x :=
  begin
    intros x hx,
    unfold tmp_f,
    unfold tmp_zero,
    rw afn.conservation x,
    { ring, },
    { exact finset.mem_of_subset hin hx,}
  end,
  have foo := finset.sum_congr hseq h,
  unfold tmp_f at foo,
  rw foo,
  unfold tmp_zero,
  simp only [sum_const_zero],
end

lemma out_in_disjunct {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S T : finset V) (disjunct : ∀ (x : V), x ∈ S → x ∉ T ) :
  mk_out afn.f (S ∪ T) - mk_in afn.f (S ∪ T) = mk_out afn.f S + mk_out afn.f T - mk_in afn.f S - mk_in afn.f T :=
begin
  have foo : mk_out afn.f (S ∪ T) + ∑ u in S, ∑ v in T, afn.f u v + ∑ u in T, ∑ v in S, afn.f u v
             =
             mk_out afn.f S + mk_out afn.f T
  :=
  begin
    have mk_out1 : mk_out afn.f S = ∑ (x : V) in S, ∑ (y : V) in univ \ S, afn.f x y := rfl,
    have mk_out2 : mk_out afn.f T = ∑ (x : V) in T, ∑ (y : V) in univ \ T, afn.f x y := rfl,
    unfold1 mk_out,
    rw ← mk_out1,
    rw ← mk_out2,
    clear mk_out1,
    clear mk_out2,
    rw ← disj_union_eq_union S T disjunct,
    rw finset.sum_disj_union disjunct,
    have foo : ∀ (x : V), x ∈ univ \ S.disj_union T disjunct → x ∉ T := sorry,
    have bar : ∀ (x : V), x ∈ univ \ S.disj_union T disjunct → x ∉ S := sorry,
    exact calc
     ∑ (x : V) in S, ∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y +
               ∑ (x : V) in T, ∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y +
               ∑ (u : V) in S, ∑ (v : V) in T, afn.f u v +
               ∑ (u : V) in T, ∑ (v : V) in S, afn.f u v
               =
               ∑ (x : V) in S, ∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y +
               ∑ (u : V) in S, ∑ (v : V) in T, afn.f u v +
               (∑ (x : V) in T, ∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y +
                ∑ (u : V) in T, ∑ (v : V) in S, afn.f u v) : by linarith
         ... = ∑ (u : V) in S, (∑ (v : V) in (V' \ S.disj_union T disjunct), afn.f u v +
                                ∑ v in T, afn.f u v) +
               (∑ (u : V) in T, (∑ (v : V) in V' \ S.disj_union T disjunct, afn.f u v +
                                 ∑ (v : V) in S, afn.f u v)) : begin  rw ← sum_add_distrib, rw ← sum_add_distrib,  end
           ... = ∑ (u : V) in S, (∑ (v : V) in (V' \ S.disj_union T disjunct).disj_union T foo, afn.f u v) +
               (∑ (u : V) in T, (∑ (v : V) in (V' \ S.disj_union T disjunct).disj_union S bar, afn.f u v +
                                 ∑ (v : V) in S, afn.f u v))  :
               begin
                 simp_rw ← finset.sum_disj_union foo,
                 sorry,
                 -- simp_rw ← finset.sum_disj_union foo,
               end
           ... = mk_out afn.f S + mk_out afn.f T : sorry,
    -- rw tmp, clear tmp,
    -- have tmp : ∑ (x : V) in S, (∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y + ∑ (v : V) in T, afn.f x v) +
    --            (∑ (x : V) in T, ∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y +
    --             ∑ (u : V) in T, ∑ (v : V) in S, afn.f u v)
    --            =
    --            ∑ (x : V) in S, (∑ (y : V) in (V' \ S.disj_union T disjunct).disj_union T foo, afn.f x y) +
    --            (∑ (x : V) in T, ∑ (y : V) in V' \ S.disj_union T disjunct, afn.f x y +
    --             ∑ (u : V) in T, ∑ (v : V) in S, afn.f u v) :=
    -- begin

    -- end,
    -- rw ← sum_add_distrib,
    -- rw ← finset.sum_disj_union foo,
  end,

  -- simp only [mk_in, mk_out],
  -- rw ← disj_union_eq_union S T disjunct,
  -- rw finset.sum_disj_union disjunct,

  sorry,
end

lemma out_as_in {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V):
  mk_out afn.f S = mk_in afn.f (univ \ S) := --Perhaps reconsider univ
  begin
    rw mk_out,
    rw mk_in,
    rw sum_comm,
    rw sum_comm,
    have foo: S = univ \ (univ \ S):=
    begin
      simp only [sdiff_sdiff_right_self, finset.inf_eq_inter, finset.univ_inter],
    end,
    nth_rewrite 0 foo,
  end

lemma in_as_out {V : Type*}  [inst' : fintype V]
(afn : active_flow_network V) (S : finset V):
  mk_in afn.f S = mk_out afn.f (univ \ S) :=
  begin
    have foo: S = univ \ (univ \ S):= --This occurs in the previous lemma.
    begin
      simp only [sdiff_sdiff_right_self, finset.inf_eq_inter, finset.univ_inter],
    end,
    nth_rewrite 0 foo,
    rw out_as_in,
  end

lemma S_minus_s_eq_T_union_s {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V):
  V' \ (ct.S \ {afn.network.source}) = ct.T ∪ {afn.network.source} :=
begin
  rw sdiff_sdiff_right',
  simp only [inf_eq_inter, univ_inter, sup_eq_union],
  have fljlkoo : (V' \ ct.S) = ct.T :=
  begin
    rw cut.Tcomp,
  end,
  rw fljlkoo,
end

lemma zero_left_move {a b c d : ℝ} : (0 = a + b - c - d) -> (d - b = a - c) :=
begin
  intro h,
  linarith,
end
lemma flow_value_global_ver {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V)
  (h_equal_networks : afn.network = ct.network) :
  mk_out afn.f {afn.network.source} - mk_in afn.f {afn.network.source} = mk_out afn.f ct.S - mk_in afn.f ct.S:=
  begin
    set S := ct.S,
    set T := ct.T,
    set s := afn.network.source,
    set t := afn.network.sink,
    set f := afn.f,
    have hs : s = afn.network.source := rfl,
    have hT : T = ct.T := rfl,
    have foo : mk_out f (S \ {s}) = mk_in f (T ∪ {s})
    :=
    begin
      rw ← S_minus_s_eq_T_union_s,
      exact out_as_in afn (S \ {s}),
    end,
    have bar : mk_in f (S \ {s}) = mk_out f (T ∪ {s})
    :=
    begin
      rw ← S_minus_s_eq_T_union_s,
      exact in_as_out afn (S \ {s}),
    end,
    have baz : 0 = mk_out f S + mk_in f {s} - mk_in f S - mk_out f {s} :=
    calc 0 = mk_out f (S \ {s}) - mk_out f (S \ {s}) : (sub_self (mk_out f (S \ {s}))).symm
       ... =  mk_out f (S \ {s}) - mk_in f (S \ {s}) :
       begin
         have baz : S \ {s} ⊆ V' \ {s, t} := begin
           sorry
         end,
         rw lemma_1 afn (S \ {s}) baz,
       end
       ... = mk_in f (T ∪ {s}) - mk_out f (T ∪ {s}) :
       begin
         rw foo,
         rw bar,
       end
       ... = - (mk_out f (T ∪ {s}) - mk_in f (T ∪ {s})) : (neg_sub (mk_out f (T ∪ {s})) (mk_in f (T ∪ {s}))).symm
       ... = mk_in f T + mk_in f {s} - mk_out f T - mk_out f {s} :
       begin
         rw hs, rw hT,
         have blurg := (x_not_in_s ct),
         rw ← h_equal_networks at blurg,
         rw out_in_disjunct afn ct.T {afn.network.source} blurg,
         ring,
       end
       ... = mk_out f S + mk_in f {s} - mk_in f S - mk_out f {s}  :
       begin
         simp_rw [in_as_out, out_as_in],
         simp only [sdiff_sdiff_right_self, inf_eq_inter, univ_inter, sub_left_inj],
         rw ← ct.Tcomp,
         simp only [sub_right_inj],
         have b : V' \ T = S :=
         begin
           rw [hT, ct.Tcomp],
           simp only [sdiff_sdiff_right_self, inf_eq_inter, univ_inter],
         end,
         rw b,
       end,
       exact zero_left_move baz,
  end

lemma outFlow_leq_outCut {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V) : mk_out afn.f S ≤ mk_out afn.network.c S
  :=
  begin
    sorry
  end

lemma major_doublesum {V : Type*} (X : finset V) (Y : finset V) (f : V → V → ℝ) (g : V → V → ℝ): (∀ x y: V, f x y ≤ g x y) →
∑ (x : V) in X, ∑ (y : V) in Y, f x y ≤ ∑ (x : V) in X, ∑ (y : V) in Y, g x y:=
  begin
    sorry
  end

lemma flow_leq_cap_global_ver {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V): mk_out afn.f S ≤ mk_out afn.network.c S
  :=
  begin
    sorry,
  end

lemma sub_non_neg_ineq (x : ℝ) (y : ℝ): y ≥ 0 -> x-y ≤ x
:= begin simp only [sub_le_self_iff, imp_self] end

lemma mk_in_non_neg {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (S : finset V): mk_in afn.f S ≥ 0
  :=
  begin
    sorry
  end

lemma flow_leq_cut {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V) (same_net : afn.network = ct.network):
  F_value afn ≤ cut_value ct :=
begin
  unfold F_value,
  rw flow_value_global_ver afn ct same_net,

  have foo: mk_out afn.f ct.S - mk_in afn.f ct.S ≤ mk_out afn.f ct.S :=
    begin
      exact sub_non_neg_ineq (mk_out afn.f ct.S) (mk_in afn.f ct.S) (mk_in_non_neg afn ct.S),
    end,

  have bar: mk_out afn.f ct.S ≤ mk_out afn.network.c ct.S :=
    begin
      rw [mk_out, mk_out],
      have blurg: ∀ (x y : V), (afn.f x y ≤ afn.network.to_capacity.c x y) :=
        begin
          exact afn.no_overflow,
        end,
      exact major_doublesum (ct.S) (V' \ ct.S) (afn.f) (afn.network.c) (blurg),
    end,

  have blurg: mk_out afn.network.to_capacity.c ct.S = cut_value ct :=
    begin
      rw same_net,
      refl,
    end,

  have soap: mk_out afn.f ct.S - mk_in afn.f ct.S ≤ mk_out afn.network.to_capacity.c ct.S :=
    begin
      exact le_trans (foo) (bar),
    end,

  rw blurg at soap,
  exact soap,
end

def is_max_flow_network  {V : Type*}  [inst' : fintype V]
  (fn: active_flow_network V) : Prop
:= ∀ fn' : active_flow_network V, fn.network = fn'.network → F_value fn' ≤ F_value fn

def is_min_cut {V : Type*}  [inst' : fintype V]
  (fn: cut V) : Prop
:= ∀ fn' : cut V, fn.network = fn'.network → cut_value fn ≤ cut_value fn'

lemma superlemma_1  {V : Type*}  [inst' : fintype V]
  (afn : active_flow_network V) (ct : cut V) (hsame_network: afn.network = ct.network):
  cut_value ct = F_value afn -> is_max_flow_network afn --∧ is_min_cut ct
  :=
  begin
    intro h_eq_val,
    intro fn,
    intro h_same_net,
    rw ← h_eq_val,
    have blorgon: fn.network = ct.network :=
    begin
      rw ← h_same_net,
      exact hsame_network,
    end,
    exact flow_leq_cut (fn) (ct) (blorgon),
  end

lemma imp_is_trans {p : Prop} {q : Prop} {r : Prop} (h_1: p → q) (h_2: q → r): (p → r)
:=
begin
  exact h_2 ∘ h_1,
  --intro p,
  --exact h_2(h_1(p)),
end

noncomputable
def mk_cf {V : Type*}  [inst' : fintype V]
  (n : active_flow_network V)
  (u v : V)
  : ℝ
:= if  n.network.is_edge u v
   then n.network.c  u v - n.f u v
   else if n.network.is_edge v u
        then n.f v u
        else 0

structure residual_network  (V : Type*)  [inst' : fintype V]
  :=
  (afn : active_flow_network V)
  (f' : V -> V -> ℝ)
  (f_def : f' = mk_cf afn)
  (is_edge : V -> V -> Prop)
  (is_edge_def : is_edge = λ u v, f' u v > 0 )

noncomputable
def mk_rsn {V : Type*} [fintype V]
  (afn : active_flow_network V) : residual_network V
:= ⟨afn, mk_cf afn, rfl, λ u v, mk_cf afn u v > 0 , rfl ⟩

universe u

inductive path {V : Type u } (is_edge : V -> V -> Prop) (a : V) : V → Type (u + 1)
| nil  : path a
| cons : Π {b c : V}, path b → (is_edge b c) → path c

def no_augumenting_path {V : Type*} [inst' : fintype V]
  (rsn : residual_network V) : Prop
  := ∀ t : V, ∀ p : path rsn.is_edge rsn.afn.network.source t, ¬ (t = rsn.afn.network.sink)

def path.in {V : Type u }
  {is_edge : V -> V -> Prop}
  (u v : V)
  {s : V}
  : ∀ {t : V}, path is_edge s t  -> Prop
  | t (@path.nil  _ is_edge' a)  := u = v
  | t (@path.cons _ _ _ t' _ p _)  := (u = t' ∧ v = t) ∨ (@path.in t' p)

lemma residual_capacity_non_neg {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  : ∀ u v : V,  0 ≤ rsn.f' u v :=
begin
  intros u v,
  cases rsn,
  simp only,
  rw rsn_f_def,
  unfold mk_cf,
  have tmp := classical.em (rsn_afn.network.to_capacity.to_strange_digraph.is_edge u v),
  cases tmp,
  {
    simp only [tmp, if_true, sub_nonneg, rsn_afn.no_overflow],
  },
  {
    simp only [tmp, if_false], clear tmp,
    have tmp := classical.em (rsn_afn.network.to_capacity.to_strange_digraph.is_edge v u),
    cases tmp,
    {
      have tmp' := rsn_afn.non_neg_flow v u,
      simp only [tmp, tmp', if_true],
      linarith,
    },
    {
      simp only [tmp, if_false],
    },
  },
end

@[simp]
noncomputable
def augumenting_path_min_weight {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  {s : V} :
  ℝ -> Π {t : V}, path rsn.is_edge s t -> ℝ
  | weight _ path.nil := weight
  | weight t (@path.cons _ _ _ t' _ p is_edge') :=
  if (weight < rsn.f' t' t) && (rsn.f' t' t ≠ 0)
  then augumenting_path_min_weight (rsn.f' t' t) p
  else augumenting_path_min_weight weight p

lemma min_weight {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  (s t : V)
  (p : path rsn.is_edge s t) :
  ∀ u v : V, path.in u v p -> augumenting_path_min_weight rsn 0 p ≤ rsn.f' u v :=
begin
  intros u v hin_p,
  induction' p,
  {
    simp,
    simp_rw [rsn.f_def, mk_cf],
    cases classical.em (rsn.afn.network.to_capacity.to_strange_digraph.is_edge u v),
    {
      simp [h],
      exact rsn.afn.no_overflow u v,
    },
    {
      simp [h],
      cases classical.em (rsn.afn.network.to_capacity.to_strange_digraph.is_edge v u),
      {
        simp [h_1],
        exact rsn.afn.non_neg_flow v u,
      },
      {
        simp [h_1],
      }
    }
  },
  {
    unfold augumenting_path_min_weight,
    simp,
    cases classical.em (0 < rsn.f' b t ∧ ¬rsn.f' b t = 0),
    {
      simp [h_1],
      sorry
    },
    {
      simp [h_1],
      exact ih u v,
    }

    -- simp_rw [rsn.f_def, mk_cf],
    -- cases classical.em (rsn.afn.network.to_capacity.to_strange_digraph.is_edge u v),
    -- {
    --   simp [h_1],
    --   cases classical.em (0 < rsn.f' b t ∧ ¬rsn.f' b t = 0),
    --   {
    --     simp [h_2],

    --   },
    --   {  }
    -- },
    -- {  }
  }
end

lemma superlemma2 {V : Type*} [inst' : fintype V]
  (rsn : residual_network V)
  : (is_max_flow_network rsn.afn) -> no_augumenting_path rsn
:=
begin
sorry
end

section superlemma3

  noncomputable
  def mk_S {V : Type u} [inst' : fintype V]
    (rsn : residual_network V) : finset V :=
    {x | (∃ p : path rsn.is_edge rsn.afn.network.source x, true)}.to_finset

  noncomputable
  def mk_cut_from_S {V : Type*} [inst' : fintype V]
    (rsn : residual_network V)
    (hno_augumenting_path : no_augumenting_path rsn)
    (S : finset V) (hS : S = mk_S rsn) : cut V :=
  ⟨rsn.afn.network, S, V' \ S,
    begin
      rw hS,
      unfold mk_S,
      simp only [set.mem_to_finset, set.mem_set_of_eq],
      exact exists.intro path.nil trivial,
    end,
    begin
      rw hS,
      unfold mk_S,
      simp only [mem_sdiff, mem_univ, set.mem_to_finset, set.mem_set_of_eq, true_and],
      intro p,
      unfold no_augumenting_path at hno_augumenting_path,
      specialize hno_augumenting_path rsn.afn.network.sink ,
      simp only [eq_self_iff_true, not_true] at hno_augumenting_path,
      apply exists.elim p,
      intros p h,
      specialize hno_augumenting_path p,
      exact hno_augumenting_path,
    end,
      rfl⟩

  lemma s_t_not_connected {V : Type*} [inst' : fintype V]
    (rsn : residual_network V)
    (S : finset V) (hS : S = mk_S rsn) :
    ∀ u ∈ S, ∀ v ∈ (V' \ S), ¬ rsn.is_edge u v
    :=
    begin
      intros u h_u_in_S v h_v_in_T is_edge_u_v,
      rw hS at *,
      unfold mk_S at *,
      simp only [set.mem_to_finset, set.mem_set_of_eq, mem_sdiff, mem_univ, true_and] at *,
      apply exists.elim h_u_in_S,
      intros p _,
      have tmp := path.cons p is_edge_u_v,
      apply h_v_in_T,
      exact exists.intro tmp trivial,
    end

  lemma residual_capacity_zero {V : Type*} [inst' : fintype V]
    (rsn : residual_network V)
    (ct : cut V)
    (h_eq_network : rsn.afn.network = ct.network)
    (h: ∀ u ∈ ct.S, ∀ v ∈ ct.T, ¬ rsn.is_edge u v) :
    ∀ u ∈ ct.S, ∀ v ∈ ct.T, rsn.f' u v = 0 :=
  begin
    intros u h_u_in_S v h_v_in_T,
    specialize h u h_u_in_S v h_v_in_T,
    rw rsn.is_edge_def at h,
    simp only [not_lt] at h,
    have hge := residual_capacity_non_neg rsn u v,
    exact ge_antisymm hge h,
  end

  lemma min_max_cap_flow {V : Type*} [inst' : fintype V]
    (rsn : residual_network V)
    (ct : cut V)
    (h_eq_network : rsn.afn.network = ct.network)
    (h: ∀ u ∈ ct.S, ∀ v ∈ ct.T, rsn.f' u v = 0 ) :
    (∀ u ∈ ct.S, ∀ v ∈ ct.T, rsn.afn.f u v = rsn.afn.network.c u v) ∧
    (∀ u ∈ ct.T, ∀ v ∈ ct.S, rsn.afn.f u v = 0) :=
  begin
    split,
    {
      intros u h_u_in_S v h_v_in_T,
      specialize h u h_u_in_S v h_v_in_T,
      rw rsn.f_def at h,
      unfold mk_cf at h,
      have tmp := classical.em (rsn.afn.network.to_capacity.to_strange_digraph.is_edge u v),
      cases tmp,
      {
        simp only [tmp, if_true] at h,
        linarith,
      },
      {
        simp only [tmp, if_false, ite_eq_right_iff] at h,
        have foo := rsn.afn.network.vanishes u v tmp,
        rw foo,
        clear tmp h,
        have foo := rsn.afn.non_neg_flow u v,
        have bar := rsn.afn.no_overflow u v,
        linarith,
      }
    },
    {
      intros v h_v_in_T u h_u_in_S,
      specialize h u h_u_in_S v h_v_in_T,
      rw rsn.f_def at h,
      unfold mk_cf at h,
      have tmp := classical.em (rsn.afn.network.to_capacity.to_strange_digraph.is_edge u v),
      cases tmp,
      {
        have foo := rsn.afn.network.hnonsymmetric u v,
        simp only [not_and] at foo,
        specialize foo tmp,
        have bar := rsn.afn.non_neg_flow v u,
        have baz := rsn.afn.no_overflow v u,
        have blurg := rsn.afn.network.vanishes v u foo,
        linarith,
      },
      {
        simp only [tmp, if_false, ite_eq_right_iff] at h,
        clear tmp,
        have tmp := classical.em (rsn.afn.network.to_capacity.to_strange_digraph.is_edge v u),
        cases tmp,
        {
          exact h tmp,
        },
        {
          have foo := rsn.afn.non_neg_flow v u,
          have bar := rsn.afn.no_overflow v u,
          have baz := rsn.afn.network.vanishes v u tmp,
          linarith,
        },
      },
    }
  end

  lemma f_value_eq_out {V : Type*} [inst' : fintype V]
    (ct : cut V)
    (afn : active_flow_network V)
    (h_eq_network : afn.network = ct.network)
    (h : (∀ u ∈ ct.T, ∀ v ∈ ct.S, afn.f u v = 0)) :
    F_value afn = mk_out afn.f ct.S :=
  begin
    dsimp [F_value],
    rw flow_value_global_ver afn ct h_eq_network,
    dsimp [mk_in],
    simp_rw [← ct.Tcomp],
    simp only [sub_eq_self],
    have sum_eq_sum_zero : ∑ (x : V) in ct.T, ∑ y in ct.S, (afn.f x y) = ∑ x in ct.T, ∑ y in ct.S, 0
    :=
    begin
      apply finset.sum_congr rfl,
      intros x x_in_T,
      apply finset.sum_congr rfl,
      intros y y_in_S,
      exact h x x_in_T y y_in_S,
    end,
    rw sum_eq_sum_zero,
    simp only [sum_const_zero],
  end

  lemma cut_value_eq_out {V : Type*} [inst' : fintype V]
    (ct : cut V)
    (afn : active_flow_network V)
    (h_eq_network : afn.network = ct.network)
    (h : (∀ u ∈ ct.S, ∀ v ∈ V' \ ct.S, afn.f u v = afn.network.c u v) ∧
         (∀ u ∈ V' \ ct.S, ∀ v ∈ ct.S, afn.f u v = 0)) :
        mk_out afn.f ct.S = cut_value ct :=
  begin
    cases h with h_flow_eq_cap h_flow_zero,
    dsimp [cut_value, mk_out],
    apply finset.sum_congr rfl,
    intros x x_in_S,
    rw ← ct.Tcomp at *,
    apply finset.sum_congr rfl,
    intros y y_in_T,
    simp [h_eq_network, h_flow_eq_cap x x_in_S y y_in_T],
  end

  lemma eq_on_res_then_on_sum {V : Type*} [inst' : fintype V]
    (A : finset V) (B : finset V) (f : V → V → ℝ) (g : V → V → ℝ)
    (eq_on_res : ∀ u ∈ A, ∀ v ∈ B, f u v = g u v) :
    ∑ (u : V) in A, ∑ (v : V) in B, f u v = ∑ (u : V) in A, ∑ (v : V) in B, g u v :=
  begin
    apply finset.sum_congr rfl,
    intros a a_in_A,
    apply finset.sum_congr rfl,
    intros b b_in_B,
    exact eq_on_res a a_in_A b b_in_B,
  end

  lemma superlemma3 {V : Type*} [inst' : fintype V]
    (rsn : residual_network V)
    -- (hno_augumenting_path : ∀ s t : V, path rsn.is_edge s t → ¬(s = rsn.afn.network.source ∧ t = rsn.afn.network.sink))
    (hno_augumenting_path : no_augumenting_path rsn)
    : (∃c : cut V, cut_value c = F_value rsn.afn) :=
  begin
    let S : finset V := mk_S rsn,
    let T := V' \ S,
    have blorg: S = mk_S rsn := by refl,
    let min_cut := mk_cut_from_S (rsn) (hno_augumenting_path) (S) (blorg),

    have subtract: ∀ x y : ℝ, (x=y) ↔ y-x=0 := begin intros x y, split, intro heq, linarith, intro heq, linarith, end,

    have cf_vanishes_on_pipes: ∀u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, rsn.f' u v = 0 := sorry,
    have cf_vanishes_on_pipes_spec: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, (rsn.afn.network.is_edge u v) →
        (rsn.afn.network.c u v - rsn.afn.f u v = 0) :=
        begin
          intros u u_in_S v v_in_T is_edge,
          have t: mk_cf rsn.afn u v = rsn.afn.network.c u v - rsn.afn.f u v := begin unfold mk_cf, simp only [is_edge, if_true], end,
          rw ← t,
          have r: mk_cf rsn.afn u v = rsn.f' u v := begin rw rsn.f_def, end,
          rw r,
          exact cf_vanishes_on_pipes u u_in_S v v_in_T,
        end,
    have eq_on_pipes: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, rsn.afn.f u v = rsn.afn.network.c u v :=
      begin
        intros u u_in_S v v_in_T,
        cases classical.em (rsn.afn.network.is_edge u v),
        { rw subtract (rsn.afn.f u v) (rsn.afn.network.to_capacity.c u v),
          have mk_cf_spec: (rsn.f' u v = rsn.afn.network.c u v - rsn.afn.f u v)
          :=
            begin
              rw rsn.f_def,
              unfold mk_cf,
              simp only [h, if_true],
            end,
          rw ← mk_cf_spec,
          have h: rsn.f' u v = 0 :=
          begin
            exact cf_vanishes_on_pipes u u_in_S v v_in_T,
          end,
          exact h,
          },
        {
          rw rsn.afn.network.vanishes u v h,
          exact f_vanishes_outside_edge (rsn.afn) (u) (v) (h),

         },
        --have no_edge: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, ¬rsn.is_edge u v := sorry,
        --have f_prim_is_zero: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S, rsn.f' u v = 0 := sorry,
        --have connector_full_or_non_existent: ∀ u ∈ min_cut.S, ∀ v ∈ V' \ min_cut.S,
        --(rsn.afn.network.c u v = rsn.afn.f u v) ∨ (¬rsn.afn.network.is_edge u v)  := sorry,
      end,

    have no_backflow: ∀ u ∈ V' \ min_cut.S, ∀ v ∈ min_cut.S, rsn.afn.f u v = 0 := begin sorry end,
    have no_backflow_func: ∀ u ∈ V' \ min_cut.S, ∀ v ∈ min_cut.S, rsn.afn.f u v = (λ u v, 0) u v :=
      begin
        simp_rw ← no_backflow,
        exact no_backflow,
      end,

    have eq_net : rsn.afn.network = min_cut.network := by refl,

    have cut_eq_flow: cut_value min_cut = F_value rsn.afn :=
    begin
      rw F_value,
      simp only,
      rw flow_value_global_ver rsn.afn min_cut eq_net,

      have no_input : mk_in rsn.afn.f min_cut.S = 0 :=
        begin
          rw mk_in,
          rw eq_on_res_then_on_sum (V' \ min_cut.S) (min_cut.S) (rsn.afn.f) (λ u v, 0) (no_backflow_func),
          simp only [sum_const_zero],
        end,

      rw no_input,
      simp only [sub_zero],

      have flow_eq_cap_on_cut : mk_out rsn.afn.f min_cut.S = mk_out rsn.afn.network.c min_cut.S :=
        begin
          unfold mk_out,
          rw eq_on_res_then_on_sum (min_cut.S) (V' \ min_cut.S) (rsn.afn.f) (rsn.afn.network.to_capacity.c) (eq_on_pipes),
        end,

      rw flow_eq_cap_on_cut,
      refl,
    end,
      --begin
        --have blurg : F_value rsn.afn = mk_out rsn.afn.f ted.S :=
        --  begin
        --    have h_eq_network : rsn.afn.network = ted.network := by refl,
        --    have h_right : ∀ u ∈ ted.T, ∀ v ∈ ted.S, rsn.f' u v = 0 := sorry,

            --have no_backward : ∀ u ∈ ted.T, ∀ v ∈ ted.S, rsn.afn.f u v = 0 := sorry,

            --rw F_value,
            --rw flow_value_global_ver (rsn.afn) (ted) (),
            --exact f_value_eq_out (ted) (rsn.afn) (h_eq_network) (h_right),
          --  sorry
          --end,
        --rw blurg,

        --have blurgon : mk_out rsn.afn.f ted.S = cut_value ted :=
        --  begin
            --have substitute : mk_out rsn.afn.f ted.S = mk_out rsn.afn.network.c S := begin unfold mk_out, sorry end,
            --rw cut_value,
            --rw sub2,
            --unfold mk_out,

            --have flow_eq_cap : ∀ u ∈ ted.S, ∀ v ∈ V' \ ted.S, rsn.afn.f u v = rsn.afn.network.c u v := sorry,
            --have sub2 : (∀ u ∈ ted.S, ∀ v ∈ V' \ ted.S, rsn.afn.f u v = ted.network.to_capacity.c u v) :=
            --begin
            --  have h_eq_network : rsn.afn.network = ted.network := by refl,
            --  exact min_max_cap_flow (rsn) (ted) (h_eq_network)
            --  sorry
            --end,

            --exact eq_on_res_then_on_sum (ted.S) (ted.T) (rsn.afn.f) (ted.network.to_capacity.c) (sub2),
        --    sorry
        --  end,
        --rw ← blurgon,
      --end,
    exact exists.intro min_cut cut_eq_flow,
  end

-- lemma three_way_equiv (a b c : Prop) : (a -> b) -> (b -> c) -> (c -> a) -> ((a <-> b) ∧ (b <-> c) ∧ (c <-> a))
-- :=
-- begin
--   intros hab hbc hca,
--   split,
--   {
--     have foo := hca ∘ hbc,
--     exact ⟨hab, foo⟩,
--   },
--   { split,
--     {
--       exact ⟨hbc, hab ∘ hca⟩
--     },
--     exact ⟨hca, hbc ∘ hab ⟩,
--   }
-- end
end superlemma3

theorem maxflow_mincut {V : Type*} [inst' : fintype V]
  (rsn : residual_network V) :
  (is_max_flow_network rsn.afn -> no_augumenting_path rsn) ∧
  (no_augumenting_path rsn -> (∃c : cut V, cut_value c = F_value rsn.afn)) ∧
  ((∃c : cut V, cut_value c = F_value rsn.afn ∧ c.network = rsn.afn.network) -> is_max_flow_network rsn.afn)
:=
begin
split,
{
  exact superlemma2 rsn,
},
{
  split,
  { exact superlemma3 rsn },
  {
    intro c,
    cases c with c heq,
    cases heq with heq heq_network,
    have foo := superlemma_1 rsn.afn c heq_network.symm heq,
    exact foo,
  }
}
end