import data.real.basic

/-
AXIOMS, PROPOSITIONS, PROOFS
-/

/-
Let's again talk about propositions and
proofs involving "equality" propositions,
such as the proposition that 1 = 1. We
all *know* intuitively that 1 = 1, but
how would you prove it, given that it's
not an axiom of ordinary predicate logic?

Without getting into the weeds, suffice
it to say that the standard Lean Prover
libraries define equality pretty much as
we've discussed here: with an axiom in
the form of a universal generaliztion:
∀ {T : Type} (t : T), t = t.

In English, this says, "if you give me
*any* Type, T, and any object, t, of that
type, I will return you a proof of the
proposition, t = t. The existence of such
a proof, in turn, justifies the judgment
that the proposition, 1 = 1, is *true*.

Let's take another look at the axiom that
let's us *deduce* the *theorem* that 1 = 1.

Here it is: ∀ {T : Type} (t : T), t = t.

What that means is that if I choose any
type, T, say T = ℕ, and any value of that
type, say t = (1 : ℕ), then I should be
able to apply the axiom to the argument
values, ℕ and 1, to get back a *proof* of
the proposition, 1 = 1.

Indeed, that's just how it works, as the
follow example shows formally (in Lean).
-/

example : 1 = 1 := eq.refl 1   -- T = ℕ
--  id    type     value
--  id    propo    proof

/-
Yay! We just constructed a formal proof: a
mathematical object that certifies that 1=1.
It might not be super-impressive that Lean
rejects "eq.refl 2" as a suitable proof (try
it, and don't fail to read the entire error
message when you hover your cursor over the
red squiggle!); but the principle extends to
commplex proofs of profound propositions.
-/

example : 1 = 2 := eq.refl 1
example : 1 = 2 := eq.refl 2

/-
Nice: you've not only constructed a formal
proof object but you have a "high assurance"
check that the proof itself is correct, in
that the Lean type checker takes it as such.
Lean is not just for formalizing mathematics
and logic, but for checking that given proofs
really prove what they're claimed to prove.
-/

/-
Of course, if formalized and mechanically
checked proofs came without andy additional
costs, we'd all be using them. The benefit
of a *natural language* "proof description"
(written in, say, English, but in a highly
mathematical style) is that it's easier for
people to follow, often because details can
be elided on the assumption that the reader
will know from context what is meant.

In this case at hand, you could give a proof,
of the proposition, 1 = 1, as follows:

Proof: By the reflexive property of equality
as applied to the particular value, 1. QED."

How much detail to put in an informal proof,
or what I sometimes call a proof description,
is a matter of style and of a willingness to
make your readers fill in the missing details.

The QED, by the way, is short for quod est
demonstratum, Latin for "so it is shown." It is
a sort of traditional punctuation for natural
language proof descriptions that signals that
a given proof presentation is complete.

The downside of using natural language proof
descriptions, in lieu of formal proof objects,
is that when things get complex, it can be
hard to impossible to tell whether a proof in
natural language is correct or not. In hard
cases, it can require years of work by world
experts to decide whether a proposed, and
plausible, proof description is mathematically
correct, or, as sometimes happens, not.

In this class, we will insist, because all
mathematicians do, that your propositions
be fully formal, i.e., syntactically correct
by the grammatical rules of predicate logic,
as enforced by Lean.

While quasi-formal proofs are what most people
who are working in or with mathematics use
today. But there are now also thriving communities
in both mathematics and computer science that
are aggressively pursuing the formalization,
and the *computerization* of logic and proof,
and indeed of mathematics much more broadly.

A traditional software engineering application
of such "automated reasoning" systems is for
the specification and verification of program
behaviors. These systems are also extensively
used in the design and implementaiton of new
programming languages and compilation systems.
By contrast, the community around Lean is
more interested in formalizing mathematics.
-/

/-
So that brings us back the the purely
mathematical, not a software, question of
how to prove that 1 = 1. Now we have a
beautiful computational way to understand
the problem and its solution.

Let's write our own proof-returning function,
We'll call it gimme_a_proof. It'll take two
arguments: a type, T, and a value, t, *of that
type*; and it will return a proof of t = t,
*for that particular t*, allowing us then to
accept the judgment that the proposition,
t = t, is *true*.
-/

def gimme_a_proof   -- function name
    {T : Type}      -- first argument, value inferred
    (t : T)         -- second argument, value given explicitly
    : t = t         -- return "type"
    := eq.refl t    -- return "value" (function body)

/-
Let's decode that. We're defining a function
called gimme_a_proof that takes T and t as
its arguments and promises to return a value
of type t = t (a proof of this proposition).
The way that it upholds this promise is by
*applying* eq.refl to t, to construct a proof
of t = t as the result, the "return value" of
this function.
-/

/-
What by the way is the type of this object?
This function? Let's see. We'll use Lean's
check command, prefixing the term with @ so
that implicitness of arguments is ignored in
displaying the type of the term in question.
You can try #check without the @. You'll see
that the explicit type parameter is replaced
by an implicit "meta-variable." You can learn
to read such types either way, with really it
is often easiest to read them with implicitness
temporarily disabled for purposes of display.
-/

#check @gimme_a_proof

/-
Now that we've got this function defined,
we can apply *it* to arguments to have it
construct values that constitute proofs of
t = t, just as we can apply any function to
any argument(s) of the right type(s).

If you hover over #reduce in the
following Lean commands, Lean will report
to you the results of applying the function
to arguments of various numerical types.
Remember when reading the outputs that
"eq.refl x" *is* an object that serves
as a proof of x = x
-/

#reduce gimme_a_proof 0         -- T = ℕ
#reduce gimme_a_proof tt        -- T = bool
#reduce @gimme_a_proof ℚ 1      -- T = ℚ, complicated
#reduce @gimme_a_proof ℤ (-3)   -- T = ℝ, really complicated

/-++++++++++
EXERCISES #1.
Give a rigorous English language "proof"
of the proposition that 2 = 2 (where 2
is the natural number,two).

Theorem: 2 = 2.
Proof: [your answer here]

-/

/-++++++++++
EXERCISE #2.
Give, below, a formal statement and proof of
the proposition, 2 = 2. (See above for a good
example to follow!)
-/

-- answer here

example : 2 = 2 := @eq.refl ℕ 2 -- implicit args off
example : 2 = 2 := eq.refl 2    -- implicit arguments on
example : 2 = 2 := rfl          -- this varient infors both arguments

#check @rfl     -- same as eq.refl but with both arguments implicit
#check @eq.refl --

def foobar : 1 = 1 := rfl

#reduce foobar


/-
Copyright (c) 2022 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Amelia Livingston
-/
import algebra.homology.additive
import category_theory.abelian.pseudoelements
import category_theory.limits.preserves.shapes.kernels
import category_theory.limits.preserves.shapes.images

/-!

The object `homology f g w`, where `w : f ≫ g = 0`, can be identified with either a
cokernel or a kernel. The isomorphism with a cokernel is `homology_iso_cokernel_lift`, which
was obtained elsewhere. In the case of an abelian category, this file shows the isomorphism
with a kernel as well.

We use these isomorphisms to obtain the analogous api for `homology`:
- `homology.ι` is the map from `homology f g w` into the cokernel of `f`.
- `homology.π'` is the map from `kernel g` to `homology f g w`.
- `homology.desc'` constructs a morphism from `homology f g w`, when it is viewed as a cokernel.
- `homology.lift` constructs a morphism to `homology f g w`, when it is viewed as a kernel.
- Various small lemmas are proved as well, mimicking the API for (co)kernels.
With these definitions and lemmas, the isomorphisms between homology and a (co)kernel need not
be used directly.
-/

open category_theory.limits
open category_theory

noncomputable theory

universes v u
variables {A : Type u} [category.{v} A] [abelian A]

variables {X Y Z : A} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0)

namespace category_theory.abelian

/-- The cokernel of `kernel.lift g f w`. This is isomorphic to `homology f g w`.
  See `homology_iso_cokernel_lift`. -/
abbreviation homology_c : A :=
cokernel (kernel.lift g f w)

/-- The kernel of `cokernel.desc f g w`. This is isomorphic to `homology f g w`.
  See `homology_iso_kernel_desc`. -/
abbreviation homology_k : A :=
kernel (cokernel.desc f g w)

/-- The canonical map from `homology_c` to `homology_k`.
  This is an isomorphism, and it is used in obtaining the API for `homology f g w`
  in the bottom of this file. -/
abbreviation homology_c_to_k : homology_c f g w ⟶ homology_k f g w :=
cokernel.desc _ (kernel.lift _ (kernel.ι _ ≫ cokernel.π _) (by simp)) begin
  apply limits.equalizer.hom_ext,
  simp,
end

local attribute [instance] pseudoelement.hom_to_fun pseudoelement.has_zero

instance : mono (homology_c_to_k f g w) :=
begin
  apply pseudoelement.mono_of_zero_of_map_zero,
  intros a ha,
  obtain ⟨a,rfl⟩ := pseudoelement.pseudo_surjective_of_epi (cokernel.π (kernel.lift g f w)) a,
  apply_fun (kernel.ι (cokernel.desc f g w)) at ha,
  simp only [←pseudoelement.comp_apply, cokernel.π_desc,
    kernel.lift_ι, pseudoelement.apply_zero] at ha,
  simp only [pseudoelement.comp_apply] at ha,
  obtain ⟨b,hb⟩ : ∃ b, f b = _ := (pseudoelement.pseudo_exact_of_exact (exact_cokernel f)).2 _ ha,
  rsuffices ⟨c, rfl⟩ : ∃ c, kernel.lift g f w c = a,
  { simp [← pseudoelement.comp_apply] },
  use b,
  apply_fun kernel.ι g,
  swap, { apply pseudoelement.pseudo_injective_of_mono },
  simpa [← pseudoelement.comp_apply]
end

instance : epi (homology_c_to_k f g w) :=
begin
  apply pseudoelement.epi_of_pseudo_surjective,
  intros a,
  let b := kernel.ι (cokernel.desc f g w) a,
  obtain ⟨c,hc⟩ : ∃ c, cokernel.π f c = b,
    apply pseudoelement.pseudo_surjective_of_epi (cokernel.π f),
  have : g c = 0,
  { dsimp [b] at hc,
    rw [(show g = cokernel.π f ≫ cokernel.desc f g w, by simp), pseudoelement.comp_apply, hc],
    simp [← pseudoelement.comp_apply] },
  obtain ⟨d,hd⟩ : ∃ d, kernel.ι g d = c,
  { apply (pseudoelement.pseudo_exact_of_exact exact_kernel_ι).2 _ this },
  use cokernel.π (kernel.lift g f w) d,
  apply_fun kernel.ι (cokernel.desc f g w),
  swap, { apply pseudoelement.pseudo_injective_of_mono },
  simp only [←pseudoelement.comp_apply, cokernel.π_desc, kernel.lift_ι],
  simp only [pseudoelement.comp_apply, hd, hc],
end

instance (w : f ≫ g = 0) : is_iso (homology_c_to_k f g w) := is_iso_of_mono_of_epi _

end category_theory.abelian

/-- The homology associated to `f` and `g` is isomorphic to a kernel. -/
def homology_iso_kernel_desc : homology f g w ≅ kernel (cokernel.desc f g w) :=
homology_iso_cokernel_lift _ _ _ ≪≫ as_iso (category_theory.abelian.homology_c_to_k _ _ _)

namespace homology

-- `homology.π` is taken
/-- The canonical map from the kernel of `g` to the homology of `f` and `g`. -/
def π' : kernel g ⟶ homology f g w :=
cokernel.π _ ≫ (homology_iso_cokernel_lift _ _ _).inv

/-- The canonical map from the homology of `f` and `g` to the cokernel of `f`. -/
def ι : homology f g w ⟶ cokernel f :=
(homology_iso_kernel_desc _ _ _).hom ≫ kernel.ι _

/-- Obtain a morphism from the homology, given a morphism from the kernel. -/
def desc' {W : A} (e : kernel g ⟶ W) (he : kernel.lift g f w ≫ e = 0) :
  homology f g w ⟶ W :=
(homology_iso_cokernel_lift _ _ _).hom ≫ cokernel.desc _ e he

/-- Obtain a moprhism to the homology, given a morphism to the kernel. -/
def lift {W : A} (e : W ⟶ cokernel f) (he : e ≫ cokernel.desc f g w = 0) :
  W ⟶ homology f g w :=
kernel.lift _ e he ≫ (homology_iso_kernel_desc _ _ _).inv

@[simp, reassoc]
lemma π'_desc' {W : A} (e : kernel g ⟶ W) (he : kernel.lift g f w ≫ e = 0) :
  π' f g w ≫ desc' f g w e he = e :=
by { dsimp [π', desc'], simp }

@[simp, reassoc]
lemma lift_ι {W : A} (e : W ⟶ cokernel f) (he : e ≫ cokernel.desc f g w = 0) :
  lift f g w e he ≫ ι _ _ _ = e :=
by { dsimp [ι, lift], simp }

@[simp, reassoc]
lemma condition_π' : kernel.lift g f w ≫ π' f g w = 0 :=
by { dsimp [π'], simp }

@[simp, reassoc]
lemma condition_ι : ι f g w ≫ cokernel.desc f g w = 0 :=
by { dsimp [ι], simp }

@[ext]
lemma hom_from_ext {W : A} (a b : homology f g w ⟶ W)
  (h : π' f g w ≫ a = π' f g w ≫ b) : a = b :=
begin
  dsimp [π'] at h,
  apply_fun (λ e, (homology_iso_cokernel_lift f g w).inv ≫ e),
  swap,
  { intros i j hh,
    apply_fun (λ e, (homology_iso_cokernel_lift f g w).hom ≫ e) at hh,
    simpa using hh },
  simp only [category.assoc] at h,
  exact coequalizer.hom_ext h,
end

@[ext]
lemma hom_to_ext {W : A} (a b : W ⟶ homology f g w)
  (h : a ≫ ι f g w = b ≫ ι f g w) : a = b :=
begin
  dsimp [ι] at h,
  apply_fun (λ e, e ≫ (homology_iso_kernel_desc f g w).hom),
  swap,
  { intros i j hh,
    apply_fun (λ e, e ≫ (homology_iso_kernel_desc f g w).inv) at hh,
    simpa using hh },
  simp only [← category.assoc] at h,
  exact equalizer.hom_ext h,
end

@[simp, reassoc]
lemma π'_ι : π' f g w ≫ ι f g w = kernel.ι _ ≫ cokernel.π _ :=
by { dsimp [π', ι, homology_iso_kernel_desc], simp }

@[simp, reassoc]
lemma π'_eq_π : (kernel_subobject_iso _).hom ≫ π' f g w = π _ _ _ :=
begin
  dsimp [π', homology_iso_cokernel_lift],
  simp only [← category.assoc],
  rw iso.comp_inv_eq,
  dsimp [π, homology_iso_cokernel_image_to_kernel'],
  simp,
end

section

variables {X' Y' Z' : A} (f' : X' ⟶ Y') (g' : Y' ⟶ Z') (w' : f' ≫ g' = 0)

@[simp, reassoc]
lemma π'_map (α β h) :
  π' _ _ _ ≫ map w w' α β h = kernel.map _ _ α.right β.right (by simp [h,β.w.symm]) ≫ π' _ _ _ :=
begin
  apply_fun (λ e, (kernel_subobject_iso _).hom ≫ e),
  swap,
  { intros i j hh,
    apply_fun (λ e, (kernel_subobject_iso _).inv ≫ e) at hh,
    simpa using hh },
  dsimp [map],
  simp only [π'_eq_π_assoc],
  dsimp [π],
  simp only [cokernel.π_desc],
  rw [← iso.inv_comp_eq, ← category.assoc],
  have : (limits.kernel_subobject_iso g).inv ≫ limits.kernel_subobject_map β =
    kernel.map _ _ β.left β.right β.w.symm ≫ (kernel_subobject_iso _).inv,
  { rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv],
    ext,
    dsimp,
    simp },
  rw this,
  simp only [category.assoc],
  dsimp [π', homology_iso_cokernel_lift],
  simp only [cokernel_iso_of_eq_inv_comp_desc, cokernel.π_desc_assoc],
  congr' 1,
  { congr, exact h.symm },
  { rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv],
    dsimp [homology_iso_cokernel_image_to_kernel'],
    simp }
end

lemma map_eq_desc'_lift_left (α β h) : map w w' α β h =
  homology.desc' _ _ _ (homology.lift _ _ _ (kernel.ι _ ≫ β.left ≫ cokernel.π _) (by simp))
  (by { ext, simp only [←h, category.assoc, zero_comp, lift_ι, kernel.lift_ι_assoc],
    erw ← reassoc_of α.w, simp } ) :=
begin
  apply homology.hom_from_ext,
  simp only [π'_map, π'_desc'],
  dsimp [π', lift],
  rw iso.eq_comp_inv,
  dsimp [homology_iso_kernel_desc],
  ext,
  simp [h],
end

lemma map_eq_lift_desc'_left (α β h) : map w w' α β h =
  homology.lift _ _ _ (homology.desc' _ _ _ (kernel.ι _ ≫ β.left ≫ cokernel.π _)
  (by { simp only [kernel.lift_ι_assoc, ← h], erw ← reassoc_of α.w, simp }))
  (by { ext, simp }) :=
by { rw map_eq_desc'_lift_left, ext, simp }

lemma map_eq_desc'_lift_right (α β h) : map w w' α β h =
  homology.desc' _ _ _ (homology.lift _ _ _ (kernel.ι _ ≫ α.right ≫ cokernel.π _) (by simp [h]))
  (by { ext, simp only [category.assoc, zero_comp, lift_ι, kernel.lift_ι_assoc],
    erw ← reassoc_of α.w, simp } ) :=
by { rw map_eq_desc'_lift_left, ext, simp [h] }

lemma map_eq_lift_desc'_right (α β h) : map w w' α β h =
  homology.lift _ _ _ (homology.desc' _ _ _ (kernel.ι _ ≫ α.right ≫ cokernel.π _)
  (by { simp only [kernel.lift_ι_assoc], erw ← reassoc_of α.w, simp }))
  (by { ext, simp [h] }) :=
by { rw map_eq_desc'_lift_right, ext, simp }

@[simp, reassoc]
lemma map_ι (α β h) :
  map w w' α β h ≫ ι f' g' w' = ι f g w ≫ cokernel.map f f' α.left β.left (by simp [h, β.w.symm]) :=
begin
  rw [map_eq_lift_desc'_left, lift_ι],
  ext,
  simp only [← category.assoc],
  rw [π'_ι, π'_desc', category.assoc, category.assoc, cokernel.π_desc],
end

end
end homology

namespace category_theory.functor

variables {ι : Type*} {c : complex_shape ι} {B : Type*} [category B] [abelian B] (F : A ⥤ B)
  [functor.additive F] [preserves_finite_limits F] [preserves_finite_colimits F]

/-- When `F` is an exact additive functor, `F(Hᵢ(X)) ≅ Hᵢ(F(X))` for `X` a complex. -/
noncomputable def homology_iso (C : homological_complex A c) (j : ι) :
  F.obj (C.homology j) ≅ ((F.map_homological_complex _).obj C).homology j :=
(preserves_cokernel.iso _ _).trans (cokernel.map_iso _ _ ((F.map_iso (image_subobject_iso _)).trans
  ((preserves_image.iso _ _).symm.trans (image_subobject_iso _).symm))
  ((F.map_iso (kernel_subobject_iso _)).trans ((preserves_kernel.iso _ _).trans
  (kernel_subobject_iso _).symm))
  begin
    dsimp,
    ext,
    simp only [category.assoc, image_to_kernel_arrow],
    erw [kernel_subobject_arrow', kernel_comparison_comp_ι, image_subobject_arrow'],
    simp [←F.map_comp],
  end)

/-- If `F` is an exact additive functor, then `F` commutes with `Hᵢ` (up to natural isomorphism). -/
noncomputable def homology_functor_iso (i : ι) :
  homology_functor A c i ⋙ F ≅ F.map_homological_complex c ⋙ homology_functor B c i :=
nat_iso.of_components (λ X, homology_iso F X i)
begin
  intros X Y f,
  dsimp,
  rw [←iso.inv_comp_eq, ←category.assoc, ←iso.eq_comp_inv],
  refine coequalizer.hom_ext _,
  dsimp [homology_iso],
  simp only [homology.map, ←category.assoc, cokernel.π_desc],
  simp only [category.assoc, cokernel_comparison_map_desc, cokernel.π_desc,
    π_comp_cokernel_comparison, ←F.map_comp],
  erw ←kernel_subobject_iso_comp_kernel_map_assoc,
  simp only [homological_complex.hom.sq_from_right,
    homological_complex.hom.sq_from_left, F.map_homological_complex_map_f, F.map_comp],
  dunfold homological_complex.d_from homological_complex.hom.next,
  dsimp,
  rw [kernel_map_comp_preserves_kernel_iso_inv_assoc, ←F.map_comp_assoc,
    ←kernel_map_comp_kernel_subobject_iso_inv],
  any_goals { simp },
end

end category_theory.functor


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov

! This file was ported from Lean 3 source module combinatorics.colex
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Basic
import Mathbin.Algebra.GeomSum

/-!
# Colex

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

We define the colex ordering for finite sets, and give a couple of important
lemmas and properties relating to it.

The colex ordering likes to avoid large values - it can be thought of on
`finset ℕ` as the "binary" ordering. That is, order A based on
`∑_{i ∈ A} 2^i`.
It's defined here in a slightly more general way, requiring only `has_lt α` in
the definition of colex on `finset α`. In the context of the Kruskal-Katona
theorem, we are interested in particular on how colex behaves for sets of a
fixed size. If the size is 3, colex on ℕ starts
123, 124, 134, 234, 125, 135, 235, 145, 245, 345, ...

## Main statements
* `colex.hom_lt_iff`: strictly monotone functions preserve colex
* Colex order properties - linearity, decidability and so on.
* `forall_lt_of_colex_lt_of_forall_lt`: if A < B in colex, and everything
  in B is < t, then everything in A is < t. This confirms the idea that
  an enumeration under colex will exhaust all sets using elements < t before
  allowing t to be included.
* `sum_two_pow_le_iff_lt`: colex for α = ℕ is the same as binary
  (this also proves binary expansions are unique)

## See also

Related files are:
* `data.list.lex`: Lexicographic order on lists.
* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`.
* `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
* `data.sigma.order`: Lexicographic order on `Σ i, α i`.
* `data.prod.lex`: Lexicographic order on `α × β`.

## Tags
colex, colexicographic, binary

## References
* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf

-/

variable {α : Type _}

open Finset

open BigOperators

#print Finset.Colex /-
/-- We define this type synonym to refer to the colexicographic ordering on finsets
rather than the natural subset ordering.
-/
def Finset.Colex (α) :=
  Finset α deriving Inhabited
#align finset.colex Finset.Colex
-/

#print Finset.toColex /-
/-- A convenience constructor to turn a `finset α` into a `finset.colex α`, useful in order to
use the colex ordering rather than the subset ordering.
-/
def Finset.toColex {α} (s : Finset α) : Finset.Colex α :=
  s
#align finset.to_colex Finset.toColex
-/

#print Colex.eq_iff /-
@[simp]
theorem Colex.eq_iff (A B : Finset α) : A.toColex = B.toColex ↔ A = B :=
  Iff.rfl
#align colex.eq_iff Colex.eq_iff
-/

/-- `A` is less than `B` in the colex ordering if the largest thing that's not in both sets is in B.
In other words, `max (A ∆ B) ∈ B` (if the maximum exists).
-/
instance [LT α] : LT (Finset.Colex α) :=
  ⟨fun A B : Finset α => ∃ k : α, (∀ {x}, k < x → (x ∈ A ↔ x ∈ B)) ∧ k ∉ A ∧ k ∈ B⟩

/-- We can define (≤) in the obvious way. -/
instance [LT α] : LE (Finset.Colex α) :=
  ⟨fun A B => A < B ∨ A = B⟩

#print Colex.lt_def /-
theorem Colex.lt_def [LT α] (A B : Finset α) :
    A.toColex < B.toColex ↔ ∃ k, (∀ {x}, k < x → (x ∈ A ↔ x ∈ B)) ∧ k ∉ A ∧ k ∈ B :=
  Iff.rfl
#align colex.lt_def Colex.lt_def
-/

#print Colex.le_def /-
theorem Colex.le_def [LT α] (A B : Finset α) :
    A.toColex ≤ B.toColex ↔ A.toColex < B.toColex ∨ A = B :=
  Iff.rfl
#align colex.le_def Colex.le_def
-/

#print Nat.sum_two_pow_lt /-
/-- If everything in `A` is less than `k`, we can bound the sum of powers. -/
theorem Nat.sum_two_pow_lt {k : ℕ} {A : Finset ℕ} (h₁ : ∀ {x}, x ∈ A → x < k) :
    A.Sum (pow 2) < 2 ^ k :=
  by
  apply lt_of_le_of_lt (sum_le_sum_of_subset fun t => mem_range.2 ∘ h₁)
  have z := geom_sum_mul_add 1 k
  rw [mul_one, one_add_one_eq_two] at z
  rw [← z]
  apply Nat.lt_succ_self
#align nat.sum_two_pow_lt Nat.sum_two_pow_lt
-/

namespace Colex

#print Colex.hom_lt_iff /-
/-- Strictly monotone functions preserve the colex ordering. -/
theorem hom_lt_iff {β : Type _} [LinearOrder α] [DecidableEq β] [Preorder β] {f : α → β}
    (h₁ : StrictMono f) (A B : Finset α) :
    (A.image f).toColex < (B.image f).toColex ↔ A.toColex < B.toColex :=
  by
  simp only [Colex.lt_def, not_exists, mem_image, exists_prop, not_and]
  constructor
  · rintro ⟨k, z, q, k', _, rfl⟩
    exact
      ⟨k', fun x hx => by simpa [h₁.injective.eq_iff] using z (h₁ hx), fun t => q _ t rfl, ‹k' ∈ B›⟩
  rintro ⟨k, z, ka, _⟩
  refine' ⟨f k, fun x hx => _, _, k, ‹k ∈ B›, rfl⟩
  · constructor
    any_goals
      rintro ⟨x', hx', rfl⟩
      refine' ⟨x', _, rfl⟩
      first |rwa [← z _]|rwa [z _]
      rwa [StrictMono.lt_iff_lt h₁] at hx
  · simp only [h₁.injective, Function.Injective.eq_iff]
    exact fun x hx => ne_of_mem_of_not_mem hx ka
#align colex.hom_lt_iff Colex.hom_lt_iff
-/

/- warning: colex.hom_fin_lt_iff -> Colex.hom_fin_lt_iff is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (A : Finset.{0} (Fin n)) (B : Finset.{0} (Fin n)), Iff (LT.lt.{0} (Finset.Colex.{0} Nat) (Finset.Colex.hasLt.{0} Nat Nat.hasLt) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (fun (i : Fin n) => (fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Fin n) Nat (HasLiftT.mk.{1, 1} (Fin n) Nat (CoeTCₓ.coe.{1, 1} (Fin n) Nat (coeBase.{1, 1} (Fin n) Nat (Fin.coeToNat n)))) i) A)) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (fun (i : Fin n) => (fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Fin n) Nat (HasLiftT.mk.{1, 1} (Fin n) Nat (CoeTCₓ.coe.{1, 1} (Fin n) Nat (coeBase.{1, 1} (Fin n) Nat (Fin.coeToNat n)))) i) B))) (LT.lt.{0} (Finset.Colex.{0} (Fin n)) (Finset.Colex.hasLt.{0} (Fin n) (Fin.hasLt n)) (Finset.toColex.{0} (Fin n) A) (Finset.toColex.{0} (Fin n) B))
but is expected to have type
  forall {n : Nat} (A : Finset.{0} (Fin n)) (B : Finset.{0} (Fin n)), Iff (LT.lt.{0} (Finset.Colex.{0} Nat) (instLTColex.{0} Nat instLTNat) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (fun (i : Fin n) => Fin.val n i) A)) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (fun (i : Fin n) => Fin.val n i) B))) (LT.lt.{0} (Finset.Colex.{0} (Fin n)) (instLTColex.{0} (Fin n) (instLTFin n)) (Finset.toColex.{0} (Fin n) A) (Finset.toColex.{0} (Fin n) B))
Case conversion may be inaccurate. Consider using '#align colex.hom_fin_lt_iff Colex.hom_fin_lt_iffₓ'. -/
/-- A special case of `colex.hom_lt_iff` which is sometimes useful. -/
@[simp]
theorem hom_fin_lt_iff {n : ℕ} (A B : Finset (Fin n)) :
    (A.image fun i : Fin n => (i : ℕ)).toColex < (B.image fun i : Fin n => (i : ℕ)).toColex ↔
      A.toColex < B.toColex :=
  Colex.hom_lt_iff (fun x y k => k) _ _
#align colex.hom_fin_lt_iff Colex.hom_fin_lt_iff

instance [LT α] : IsIrrefl (Finset.Colex α) (· < ·) :=
  ⟨fun A h => Exists.elim h fun _ ⟨_, a, b⟩ => a b⟩

#print Colex.lt_trans /-
@[trans]
theorem lt_trans [LinearOrder α] {a b c : Finset.Colex α} : a < b → b < c → a < c :=
  by
  rintro ⟨k₁, k₁z, notinA, inB⟩ ⟨k₂, k₂z, notinB, inC⟩
  cases lt_or_gt_of_ne (ne_of_mem_of_not_mem inB notinB)
  · refine' ⟨k₂, fun x hx => _, by rwa [k₁z h], inC⟩
    rw [← k₂z hx]
    apply k₁z (trans h hx)
  · refine' ⟨k₁, fun x hx => _, notinA, by rwa [← k₂z h]⟩
    rw [k₁z hx]
    apply k₂z (trans h hx)
#align colex.lt_trans Colex.lt_trans
-/

#print Colex.le_trans /-
@[trans]
theorem le_trans [LinearOrder α] (a b c : Finset.Colex α) : a ≤ b → b ≤ c → a ≤ c := fun AB BC =>
  AB.elim (fun k => BC.elim (fun t => Or.inl (lt_trans k t)) fun t => t ▸ AB) fun k => k.symm ▸ BC
#align colex.le_trans Colex.le_trans
-/

instance [LinearOrder α] : IsTrans (Finset.Colex α) (· < ·) :=
  ⟨fun _ _ _ => Colex.lt_trans⟩

#print Colex.lt_trichotomy /-
theorem lt_trichotomy [LinearOrder α] (A B : Finset.Colex α) : A < B ∨ A = B ∨ B < A :=
  by
  by_cases h₁ : A = B
  · tauto
  rcases exists_max_image (A \ B ∪ B \ A) id _ with ⟨k, hk, z⟩
  · simp only [mem_union, mem_sdiff] at hk
    cases hk
    · right
      right
      refine' ⟨k, fun t th => _, hk.2, hk.1⟩
      specialize z t
      by_contra h₂
      simp only [mem_union, mem_sdiff, id.def] at z
      rw [not_iff, iff_iff_and_or_not_and_not, Classical.not_not, and_comm'] at h₂
      apply not_le_of_lt th (z h₂)
    · left
      refine' ⟨k, fun t th => _, hk.2, hk.1⟩
      specialize z t
      by_contra h₃
      simp only [mem_union, mem_sdiff, id.def] at z
      rw [not_iff, iff_iff_and_or_not_and_not, Classical.not_not, and_comm', or_comm'] at h₃
      apply not_le_of_lt th (z h₃)
  rw [nonempty_iff_ne_empty]
  intro a
  simp only [union_eq_empty_iff, sdiff_eq_empty_iff_subset] at a
  apply h₁ (subset.antisymm a.1 a.2)
#align colex.lt_trichotomy Colex.lt_trichotomy
-/

instance [LinearOrder α] : IsTrichotomous (Finset.Colex α) (· < ·) :=
  ⟨lt_trichotomy⟩

#print Colex.decidableLt /-
instance decidableLt [LinearOrder α] : ∀ {A B : Finset.Colex α}, Decidable (A < B) :=
  show ∀ A B : Finset α, Decidable (A.toColex < B.toColex) from fun A B =>
    decidable_of_iff' (∃ k ∈ B, (∀ x ∈ A ∪ B, k < x → (x ∈ A ↔ x ∈ B)) ∧ k ∉ A)
      (by
        rw [Colex.lt_def]
        apply exists_congr
        simp only [mem_union, exists_prop, or_imp, and_comm' (_ ∈ B), and_assoc']
        intro k
        refine' and_congr_left' (forall_congr' _)
        tauto)
#align colex.decidable_lt Colex.decidableLt
-/

instance [LinearOrder α] : LinearOrder (Finset.Colex α) :=
  { Finset.Colex.hasLt,
    Finset.Colex.hasLe with
    le_refl := fun A => Or.inr rfl
    le_trans := le_trans
    le_antisymm := fun A B AB BA =>
      AB.elim (fun k => BA.elim (fun t => (asymm k t).elim) fun t => t.symm) id
    le_total := fun A B =>
      (lt_trichotomy A B).elim3 (Or.inl ∘ Or.inl) (Or.inl ∘ Or.inr) (Or.inr ∘ Or.inl)
    decidableLe := fun A B => by infer_instance
    decidableLt := fun A B => by infer_instance
    DecidableEq := fun A B => by infer_instance
    lt_iff_le_not_le := fun A B => by
      constructor
      · intro t
        refine' ⟨Or.inl t, _⟩
        rintro (i | rfl)
        · apply asymm_of _ t i
        · apply irrefl _ t
      rintro ⟨h₁ | rfl, h₂⟩
      · apply h₁
      apply h₂.elim (Or.inr rfl) }

/-- The instances set up let us infer that `colex.lt` is a strict total order. -/
example [LinearOrder α] : IsStrictTotalOrder (Finset.Colex α) (· < ·) :=
  inferInstance

/- warning: colex.hom_le_iff -> Colex.hom_le_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] {f : α -> β}, (StrictMono.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))) f) -> (forall (A : Finset.{u1} α) (B : Finset.{u1} α), Iff (LE.le.{u2} (Finset.Colex.{u2} β) (Finset.Colex.hasLe.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))) (Finset.toColex.{u2} β (Finset.image.{u1, u2} α β (fun (a : β) (b : β) => Eq.decidable.{u2} β _inst_2 a b) f A)) (Finset.toColex.{u2} β (Finset.image.{u1, u2} α β (fun (a : β) (b : β) => Eq.decidable.{u2} β _inst_2 a b) f B))) (LE.le.{u1} (Finset.Colex.{u1} α) (Finset.Colex.hasLe.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))) (Finset.toColex.{u1} α A) (Finset.toColex.{u1} α B)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] {f : α -> β}, (StrictMono.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))) (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))) f) -> (forall (A : Finset.{u1} α) (B : Finset.{u1} α), Iff (LE.le.{u2} (Finset.Colex.{u2} β) (instLEColex.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))) (Finset.toColex.{u2} β (Finset.image.{u1, u2} α β (fun (a : β) (b : β) => instDecidableEq.{u2} β _inst_2 a b) f A)) (Finset.toColex.{u2} β (Finset.image.{u1, u2} α β (fun (a : β) (b : β) => instDecidableEq.{u2} β _inst_2 a b) f B))) (LE.le.{u1} (Finset.Colex.{u1} α) (instLEColex.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))) (Finset.toColex.{u1} α A) (Finset.toColex.{u1} α B)))
Case conversion may be inaccurate. Consider using '#align colex.hom_le_iff Colex.hom_le_iffₓ'. -/
/-- Strictly monotone functions preserve the colex ordering. -/
theorem hom_le_iff {β : Type _} [LinearOrder α] [LinearOrder β] {f : α → β} (h₁ : StrictMono f)
    (A B : Finset α) : (A.image f).toColex ≤ (B.image f).toColex ↔ A.toColex ≤ B.toColex := by
  rw [le_iff_le_iff_lt_iff_lt, hom_lt_iff h₁]
#align colex.hom_le_iff Colex.hom_le_iff

/- warning: colex.hom_fin_le_iff -> Colex.hom_fin_le_iff is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (A : Finset.{0} (Fin n)) (B : Finset.{0} (Fin n)), Iff (LE.le.{0} (Finset.Colex.{0} Nat) (Finset.Colex.hasLe.{0} Nat Nat.hasLt) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (fun (i : Fin n) => (fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Fin n) Nat (HasLiftT.mk.{1, 1} (Fin n) Nat (CoeTCₓ.coe.{1, 1} (Fin n) Nat (coeBase.{1, 1} (Fin n) Nat (Fin.coeToNat n)))) i) A)) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (fun (i : Fin n) => (fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Fin n) Nat (HasLiftT.mk.{1, 1} (Fin n) Nat (CoeTCₓ.coe.{1, 1} (Fin n) Nat (coeBase.{1, 1} (Fin n) Nat (Fin.coeToNat n)))) i) B))) (LE.le.{0} (Finset.Colex.{0} (Fin n)) (Finset.Colex.hasLe.{0} (Fin n) (Fin.hasLt n)) (Finset.toColex.{0} (Fin n) A) (Finset.toColex.{0} (Fin n) B))
but is expected to have type
  forall {n : Nat} (A : Finset.{0} (Fin n)) (B : Finset.{0} (Fin n)), Iff (LE.le.{0} (Finset.Colex.{0} Nat) (instLEColex.{0} Nat instLTNat) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (fun (i : Fin n) => Fin.val n i) A)) (Finset.toColex.{0} Nat (Finset.image.{0, 0} (Fin n) Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (fun (i : Fin n) => Fin.val n i) B))) (LE.le.{0} (Finset.Colex.{0} (Fin n)) (instLEColex.{0} (Fin n) (instLTFin n)) (Finset.toColex.{0} (Fin n) A) (Finset.toColex.{0} (Fin n) B))
Case conversion may be inaccurate. Consider using '#align colex.hom_fin_le_iff Colex.hom_fin_le_iffₓ'. -/
/-- A special case of `colex_hom` which is sometimes useful. -/
@[simp]
theorem hom_fin_le_iff {n : ℕ} (A B : Finset (Fin n)) :
    (A.image fun i : Fin n => (i : ℕ)).toColex ≤ (B.image fun i : Fin n => (i : ℕ)).toColex ↔
      A.toColex ≤ B.toColex :=
  Colex.hom_le_iff (fun x y k => k) _ _
#align colex.hom_fin_le_iff Colex.hom_fin_le_iff

#print Colex.forall_lt_of_colex_lt_of_forall_lt /-
/-- If `A` is before `B` in colex, and everything in `B` is small, then everything in `A` is small.
-/
theorem forall_lt_of_colex_lt_of_forall_lt [LinearOrder α] {A B : Finset α} (t : α)
    (h₁ : A.toColex < B.toColex) (h₂ : ∀ x ∈ B, x < t) : ∀ x ∈ A, x < t :=
  by
  rw [Colex.lt_def] at h₁
  rcases h₁ with ⟨k, z, _, _⟩
  intro x hx
  apply lt_of_not_ge
  intro a
  refine' not_lt_of_ge a (h₂ x _)
  rwa [← z]
  apply lt_of_lt_of_le (h₂ k ‹_›) a
#align colex.forall_lt_of_colex_lt_of_forall_lt Colex.forall_lt_of_colex_lt_of_forall_lt
-/

#print Colex.lt_singleton_iff_mem_lt /-
/-- `s.to_colex < {r}.to_colex` iff all elements of `s` are less than `r`. -/
theorem lt_singleton_iff_mem_lt [LinearOrder α] {r : α} {s : Finset α} :
    s.toColex < ({r} : Finset α).toColex ↔ ∀ x ∈ s, x < r :=
  by
  simp only [lt_def, mem_singleton, ← and_assoc', exists_eq_right]
  constructor
  · intro t x hx
    rw [← not_le]
    intro h
    rcases lt_or_eq_of_le h with (h₁ | rfl)
    · exact ne_of_irrefl h₁ ((t.1 h₁).1 hx).symm
    · exact t.2 hx
  ·
    exact fun h =>
      ⟨fun z hz => ⟨fun i => (asymm hz (h _ i)).elim, fun i => (hz.ne' i).elim⟩, by simpa using h r⟩
#align colex.lt_singleton_iff_mem_lt Colex.lt_singleton_iff_mem_lt
-/

/- warning: colex.mem_le_of_singleton_le -> Colex.mem_le_of_singleton_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {r : α} {s : Finset.{u1} α}, Iff (LE.le.{u1} (Finset.Colex.{u1} α) (Finset.Colex.hasLe.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))) (Finset.toColex.{u1} α (Singleton.singleton.{u1, u1} α (Finset.{u1} α) (Finset.hasSingleton.{u1} α) r)) (Finset.toColex.{u1} α s)) (Exists.{succ u1} α (fun (x : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) x s) (fun (H : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) x s) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) r x)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {r : α} {s : Finset.{u1} α}, Iff (LE.le.{u1} (Finset.Colex.{u1} α) (instLEColex.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))) (Finset.toColex.{u1} α (Singleton.singleton.{u1, u1} α (Finset.{u1} α) (Finset.instSingletonFinset.{u1} α) r)) (Finset.toColex.{u1} α s)) (Exists.{succ u1} α (fun (x : α) => And (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) x s) (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1)))))) r x)))
Case conversion may be inaccurate. Consider using '#align colex.mem_le_of_singleton_le Colex.mem_le_of_singleton_leₓ'. -/
/-- If {r} is less than or equal to s in the colexicographical sense,
  then s contains an element greater than or equal to r. -/
theorem mem_le_of_singleton_le [LinearOrder α] {r : α} {s : Finset α} :
    ({r} : Finset α).toColex ≤ s.toColex ↔ ∃ x ∈ s, r ≤ x :=
  by
  rw [← not_lt]
  simp [lt_singleton_iff_mem_lt]
#align colex.mem_le_of_singleton_le Colex.mem_le_of_singleton_le

#print Colex.singleton_lt_iff_lt /-
/-- Colex is an extension of the base ordering on α. -/
theorem singleton_lt_iff_lt [LinearOrder α] {r s : α} :
    ({r} : Finset α).toColex < ({s} : Finset α).toColex ↔ r < s := by simp [lt_singleton_iff_mem_lt]
#align colex.singleton_lt_iff_lt Colex.singleton_lt_iff_lt
-/

#print Colex.singleton_le_iff_le /-
/-- Colex is an extension of the base ordering on α. -/
theorem singleton_le_iff_le [LinearOrder α] {r s : α} :
    ({r} : Finset α).toColex ≤ ({s} : Finset α).toColex ↔ r ≤ s := by
  rw [le_iff_le_iff_lt_iff_lt, singleton_lt_iff_lt]
#align colex.singleton_le_iff_le Colex.singleton_le_iff_le
-/

#print Colex.sdiff_lt_sdiff_iff_lt /-
/-- Colex doesn't care if you remove the other set -/
@[simp]
theorem sdiff_lt_sdiff_iff_lt [LT α] [DecidableEq α] (A B : Finset α) :
    (A \ B).toColex < (B \ A).toColex ↔ A.toColex < B.toColex :=
  by
  rw [Colex.lt_def, Colex.lt_def]
  apply exists_congr
  intro k
  simp only [mem_sdiff, not_and, Classical.not_not]
  constructor
  · rintro ⟨z, kAB, kB, kA⟩
    refine' ⟨_, kA, kB⟩
    · intro x hx
      specialize z hx
      tauto
  · rintro ⟨z, kA, kB⟩
    refine' ⟨_, fun _ => kB, kB, kA⟩
    intro x hx
    rw [z hx]
#align colex.sdiff_lt_sdiff_iff_lt Colex.sdiff_lt_sdiff_iff_lt
-/

/- warning: colex.sdiff_le_sdiff_iff_le -> Colex.sdiff_le_sdiff_iff_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] (A : Finset.{u1} α) (B : Finset.{u1} α), Iff (LE.le.{u1} (Finset.Colex.{u1} α) (Finset.Colex.hasLe.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))) (Finset.toColex.{u1} α (SDiff.sdiff.{u1} (Finset.{u1} α) (Finset.hasSdiff.{u1} α (fun (a : α) (b : α) => Eq.decidable.{u1} α _inst_1 a b)) A B)) (Finset.toColex.{u1} α (SDiff.sdiff.{u1} (Finset.{u1} α) (Finset.hasSdiff.{u1} α (fun (a : α) (b : α) => Eq.decidable.{u1} α _inst_1 a b)) B A))) (LE.le.{u1} (Finset.Colex.{u1} α) (Finset.Colex.hasLe.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))) (Finset.toColex.{u1} α A) (Finset.toColex.{u1} α B))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] (A : Finset.{u1} α) (B : Finset.{u1} α), Iff (LE.le.{u1} (Finset.Colex.{u1} α) (instLEColex.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))) (Finset.toColex.{u1} α (SDiff.sdiff.{u1} (Finset.{u1} α) (Finset.instSDiffFinset.{u1} α (fun (a : α) (b : α) => instDecidableEq.{u1} α _inst_1 a b)) A B)) (Finset.toColex.{u1} α (SDiff.sdiff.{u1} (Finset.{u1} α) (Finset.instSDiffFinset.{u1} α (fun (a : α) (b : α) => instDecidableEq.{u1} α _inst_1 a b)) B A))) (LE.le.{u1} (Finset.Colex.{u1} α) (instLEColex.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))) (Finset.toColex.{u1} α A) (Finset.toColex.{u1} α B))
Case conversion may be inaccurate. Consider using '#align colex.sdiff_le_sdiff_iff_le Colex.sdiff_le_sdiff_iff_leₓ'. -/
/-- Colex doesn't care if you remove the other set -/
@[simp]
theorem sdiff_le_sdiff_iff_le [LinearOrder α] (A B : Finset α) :
    (A \ B).toColex ≤ (B \ A).toColex ↔ A.toColex ≤ B.toColex := by
  rw [le_iff_le_iff_lt_iff_lt, sdiff_lt_sdiff_iff_lt]
#align colex.sdiff_le_sdiff_iff_le Colex.sdiff_le_sdiff_iff_le

#print Colex.empty_toColex_lt /-
theorem empty_toColex_lt [LinearOrder α] {A : Finset α} (hA : A.Nonempty) :
    (∅ : Finset α).toColex < A.toColex :=
  by
  rw [Colex.lt_def]
  refine' ⟨max' _ hA, _, by simp, max'_mem _ _⟩
  simp only [false_iff_iff, not_mem_empty]
  intro x hx t
  apply not_le_of_lt hx (le_max' _ _ t)
#align colex.empty_to_colex_lt Colex.empty_toColex_lt
-/

#print Colex.colex_lt_of_ssubset /-
/-- If `A ⊂ B`, then `A` is less than `B` in the colex order. Note the converse does not hold, as
`⊆` is not a linear order. -/
theorem colex_lt_of_ssubset [LinearOrder α] {A B : Finset α} (h : A ⊂ B) : A.toColex < B.toColex :=
  by
  rw [← sdiff_lt_sdiff_iff_lt, sdiff_eq_empty_iff_subset.2 h.1]
  exact empty_to_colex_lt (by simpa [Finset.Nonempty] using exists_of_ssubset h)
#align colex.colex_lt_of_ssubset Colex.colex_lt_of_ssubset
-/

#print Colex.empty_toColex_le /-
@[simp]
theorem empty_toColex_le [LinearOrder α] {A : Finset α} : (∅ : Finset α).toColex ≤ A.toColex :=
  by
  rcases A.eq_empty_or_nonempty with (rfl | hA)
  · simp
  · apply (empty_to_colex_lt hA).le
#align colex.empty_to_colex_le Colex.empty_toColex_le
-/

#print Colex.colex_le_of_subset /-
/-- If `A ⊆ B`, then `A ≤ B` in the colex order. Note the converse does not hold, as `⊆` is not a
linear order. -/
theorem colex_le_of_subset [LinearOrder α] {A B : Finset α} (h : A ⊆ B) : A.toColex ≤ B.toColex :=
  by
  rw [← sdiff_le_sdiff_iff_le, sdiff_eq_empty_iff_subset.2 h]
  apply empty_to_colex_le
#align colex.colex_le_of_subset Colex.colex_le_of_subset
-/

#print Colex.toColexRelHom /-
/-- The function from finsets to finsets with the colex order is a relation homomorphism. -/
@[simps]
def toColexRelHom [LinearOrder α] :
    ((· ⊆ ·) : Finset α → Finset α → Prop) →r ((· ≤ ·) : Finset.Colex α → Finset.Colex α → Prop)
    where
  toFun := Finset.toColex
  map_rel' A B := colex_le_of_subset
#align colex.to_colex_rel_hom Colex.toColexRelHom
-/

instance [LinearOrder α] : OrderBot (Finset.Colex α)
    where
  bot := (∅ : Finset α).toColex
  bot_le x := empty_toColex_le

instance [LinearOrder α] [Fintype α] : OrderTop (Finset.Colex α)
    where
  top := Finset.univ.toColex
  le_top x := colex_le_of_subset (subset_univ _)

instance [LinearOrder α] : Lattice (Finset.Colex α) :=
  { (by infer_instance : SemilatticeSup (Finset.Colex α)),
    (by infer_instance : SemilatticeInf (Finset.Colex α)) with }

instance [LinearOrder α] [Fintype α] : BoundedOrder (Finset.Colex α) :=
  { (by infer_instance : OrderTop (Finset.Colex α)),
    (by infer_instance : OrderBot (Finset.Colex α)) with }

#print Colex.sum_two_pow_lt_iff_lt /-
/-- For subsets of ℕ, we can show that colex is equivalent to binary. -/
theorem sum_two_pow_lt_iff_lt (A B : Finset ℕ) :
    ((∑ i in A, 2 ^ i) < ∑ i in B, 2 ^ i) ↔ A.toColex < B.toColex :=
  by
  have z : ∀ A B : Finset ℕ, A.toColex < B.toColex → (∑ i in A, 2 ^ i) < ∑ i in B, 2 ^ i :=
    by
    intro A B
    rw [← sdiff_lt_sdiff_iff_lt, Colex.lt_def]
    rintro ⟨k, z, kA, kB⟩
    rw [← sdiff_union_inter A B]
    conv_rhs => rw [← sdiff_union_inter B A]
    rw [sum_union (disjoint_sdiff_inter _ _), sum_union (disjoint_sdiff_inter _ _), inter_comm,
      add_lt_add_iff_right]
    apply lt_of_lt_of_le (@Nat.sum_two_pow_lt k (A \ B) _)
    · apply single_le_sum (fun _ _ => Nat.zero_le _) kB
    intro x hx
    apply lt_of_le_of_ne (le_of_not_lt fun kx => _)
    · apply ne_of_mem_of_not_mem hx kA
    have := (z kx).1 hx
    rw [mem_sdiff] at this hx
    exact hx.2 this.1
  refine'
    ⟨fun h => (lt_trichotomy A B).resolve_right fun h₁ => h₁.elim _ (not_lt_of_gt h ∘ z _ _), z A B⟩
  rintro rfl
  apply irrefl _ h
#align colex.sum_two_pow_lt_iff_lt Colex.sum_two_pow_lt_iff_lt
-/

#print Colex.sum_two_pow_le_iff_lt /-
/-- For subsets of ℕ, we can show that colex is equivalent to binary. -/
theorem sum_two_pow_le_iff_lt (A B : Finset ℕ) :
    ((∑ i in A, 2 ^ i) ≤ ∑ i in B, 2 ^ i) ↔ A.toColex ≤ B.toColex := by
  rw [le_iff_le_iff_lt_iff_lt, sum_two_pow_lt_iff_lt]
#align colex.sum_two_pow_le_iff_lt Colex.sum_two_pow_le_iff_lt
-/

end Colex


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Simon Hudon
-/

import Qpf.MathlibPort.Fin2
import Qpf.Util.HEq
import Qpf.Util.Vec
import Lean.Elab.Tactic.Conv

/-!

# Tuples of types, and their categorical structure.

## Features

* `TypeVec n` - n-tuples of types
* `α ⟹ β`    - n-tuples of maps
* `f ⊚ g`     - composition

Also, support functions for operating with n-tuples of types, such as:

* `append1 α β`    - append type `β` to n-tuple `α` to obtain an (n+1)-tuple
* `drop α`         - drops the last element of an (n+1)-tuple
* `last α`         - returns the last element of an (n+1)-tuple
* `appendFun f g` - appends a function g to an n-tuple of functions
* `dropFun f`     - drops the last function from an n+1-tuple
* `lastFun f`     - returns the last function of a tuple.

Since e.g. `append1 α.drop α.last` is propositionally equal to `α` but not definitionally equal
to it, we need support functions and lemmas to mediate between constructions.
-/

universe u v w

-- set_option pp.all true

/--
n-tuples of types, as a category
-/
def TypeVec := Vec (Type _)

instance {n} : Inhabited (TypeVec.{u} n) :=
  ⟨fun _ => PUnit⟩

namespace TypeVec
  export Vec (last)

  variable {n : Nat}

  /-- An empty vector -/
  abbrev nil : TypeVec 0 := Vec.nil

  /-- arrow in the category of `typevec` -/
  -- def Arrow (α β : TypeVec n) := ∀ i : Fin2 n, α i → β i
  abbrev Arrow (α β : TypeVec n) := DVec (fun i => α i → β i)

  infixl:40 " ⟹ " => Arrow

  /-- Identity Arrow of `TypeVec` -/
  def id {α : TypeVec n} : α ⟹ α := λ i x => x

  /-- Composition of `TypeVec` Arrows -/
  def comp {α β γ : TypeVec n} (g : β ⟹ γ) (f : α ⟹ β) : α ⟹ γ :=
  λ i x => g i (f i x)

  infixr:80 " ⊚ " => TypeVec.comp   -- type as \oo

  @[simp] theorem id_comp {α β : TypeVec n} (f : α ⟹ β) : id ⊚ f = f := rfl

  @[simp] theorem comp_id {α β : TypeVec n} (f : α ⟹ β) : f ⊚ id = f := rfl

  theorem comp_assoc {α β γ δ : TypeVec n} (h : γ ⟹ δ) (g : β ⟹ γ) (f : α ⟹ β) :
    (h ⊚ g) ⊚ f = h ⊚ g ⊚ f := rfl

  /-- Appends a single type to a `TypeVec` -/
  @[simp]
  abbrev append1 : TypeVec n → Type _ → TypeVec (n+1)
    := Vec.append1

  infixl:67 " ::: " => append1

  -- Longer chains of `:::` can cause timeouts; the overload below means there are exponentially
  -- many branches to explore. So, we also add a notation that only works for TypeVecs
  infixl:67 " :::ᵥ " => append1

  /-- drop the last type from a `TypeVec` -/
  @[simp]
  abbrev drop : TypeVec (n.succ) → TypeVec n := Vec.drop

  def append1_cases
    {C : TypeVec (n+1) → Sort u} (H : ∀ α β, C (append1 α β)) (γ) : C γ :=
  by rw [← @Vec.append1_drop_last _ _ γ]; apply H

  @[simp] theorem append1_cases_append1 {C : TypeVec (n+1) → Sort u}
    (H : ∀ α β, C (append1 α β)) (α β) :
    @append1_cases _ C H (append1 α β) = H α β := rfl

  def splitFun {α α' : TypeVec (n+1)}
    (f : drop α ⟹ drop α') (g : last α → last α') : α ⟹ α'
  | (Fin2.fs i) => f i
  | Fin2.fz      => g

  def appendFun {α α' : TypeVec n}
                {β β' : Type _}
                (f : α ⟹ α')
                (g : β → β')
                  : α ::: β ⟹ α' ::: β'
    := splitFun f g

  infixl:67 " ::: " => appendFun

  abbrev dropFun {α β : TypeVec (n+1)} (f : α ⟹ β) : drop α ⟹ drop β
    :=
  λ i => f i.fs

  def lastFun {α β : TypeVec (n+1)} (f : α ⟹ β) : last α → last β :=
  f Fin2.fz

  theorem eq_of_drop_last_eq {α β : TypeVec (n+1)} {f g : α ⟹ β}
    (h₀ : ∀ j, dropFun f j = dropFun g j) (h₁ : lastFun f = lastFun g) : f = g :=
  by funext i; cases i; apply h₁; apply h₀;

  @[simp] theorem drop_fun_split_fun {α α' : TypeVec (n+1)}
    (f : drop α ⟹ drop α') (g : last α → last α') :
    dropFun (splitFun f g) = f := rfl

  def Arrow.mp {α β : TypeVec n} (h : α = β) : α ⟹ β
  | i => Eq.mp (congrFun h _)

  def Arrow.mpr {α β : TypeVec n} (h : α = β) : β ⟹ α
  | i => Eq.mpr (congrFun h _)

  def to_Vec.append1_drop_last {α : TypeVec (n+1)} : α ⟹ drop α ::: last α :=
  Arrow.mpr (Vec.append1_drop_last _)

  /-- stitch two bits of a vector back together -/
  def from_append1_drop_last {α : TypeVec (n+1)} : drop α ::: last α ⟹ α :=
  Arrow.mp (Vec.append1_drop_last _)

  @[simp] theorem last_fun_split_fun {α α' : TypeVec (n+1)}
    (f : drop α ⟹ drop α') (g : last α → last α') :
    lastFun (splitFun f g) = g := rfl

  @[simp] theorem drop_fun_append_fun {α α' : TypeVec n} {β β' : Type _} (f : α ⟹ α') (g : β → β') :
    dropFun (f ::: g : α ::: β ⟹ _) = f := rfl

  @[simp] theorem last_fun_append_fun {α α' : TypeVec n} {β β' : Type _} (f : α ⟹ α') (g : β → β') :
    lastFun (f ::: g : α ::: β ⟹ _) = g := rfl

  theorem split_drop_fun_last_fun {α α' : TypeVec (n+1)} (f : α ⟹ α') :
    splitFun (dropFun f) (lastFun f) = f :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  theorem split_fun_inj
    {α α' : TypeVec (n+1)} {f f' : drop α ⟹ drop α'} {g g' : last α → last α'}
    (H : splitFun f g = splitFun f' g') : f = f' ∧ g = g' :=
  by rw [← drop_fun_split_fun f g, H, ← last_fun_split_fun f g, H]; simp

  /-- The unique Arrow between empty `TypeVec`s -/
  def nil_fun {α β : TypeVec 0} : α ⟹ β :=
  λ i _ => Fin2.elim0 i

  /-- `nil_fun` is indeed the unique Arrow between `TypeVec 0`s -/
  @[simp] theorem nil_fun_uniq {α β : TypeVec 0} (f : α ⟹ β) : f = nil_fun :=
  by funext i; cases i

  @[simp] theorem nil_fun_uniq' (f : Fin2.elim0 ⟹ Fin2.elim0) : f = nil_fun :=
  by funext i; cases i

  theorem append_fun_inj {α α' : TypeVec n} {β β' : Type _} {f f' : α ⟹ α'} {g g' : β → β'} :
    (f ::: g : α ::: β ⟹ _) = (f' ::: g' : α ::: β ⟹ _)
    → f = f' ∧ g = g' :=
  split_fun_inj

  theorem split_fun_comp {α₀ α₁ α₂ : TypeVec (n+1)}
      (f₀ : drop α₀ ⟹ drop α₁) (f₁ : drop α₁ ⟹ drop α₂)
      (g₀ : last α₀ → last α₁) (g₁ : last α₁ → last α₂) :
    splitFun (f₁ ⊚ f₀) (g₁ ∘ g₀) = splitFun f₁ g₁ ⊚ splitFun f₀ g₀ :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  theorem append_fun_comp_split_fun {α γ : TypeVec n} {β δ : Type _} {ε : TypeVec (n + 1)}
          (f₀ : drop ε ⟹ α)
          (f₁ : α ⟹ γ)
          (g₀ : last ε → β)
          (g₁ : β → δ) :
   appendFun f₁ g₁ ⊚ splitFun f₀ g₀
      = splitFun (α':=γ.append1 δ) (f₁ ⊚ f₀) (g₁ ∘ g₀)
  :=
  (split_fun_comp _ _ _ _).symm

  theorem append_fun_comp {α₀ α₁ α₂ : TypeVec n} {β₀ β₁ β₂ : Type _}
      (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂) (g₀ : β₀ → β₁) (g₁ : β₁ → β₂) :
    (f₁ ⊚ f₀ ::: g₁ ∘ g₀  :   α₀ ::: β₀ ⟹ α₂ ::: β₂)
    = (f₁ ::: g₁  : α₁ ::: β₁ ⟹ α₂ ::: β₂) ⊚ (f₀ ::: g₀ : α₀ ::: β₀ ⟹ α₁ ::: β₁) :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  theorem append_fun_comp' {α₀ α₁ α₂ : TypeVec n} {β₀ β₁ β₂ : Type _}
      (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂) (g₀ : β₀ → β₁) (g₁ : β₁ → β₂) :
    (f₁ ::: g₁) ⊚ (f₀ ::: g₀) = f₁ ⊚ f₀ ::: g₁ ∘ g₀ :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  theorem nil_fun_comp {α₀ : TypeVec 0} (f₀ : α₀ ⟹ Fin2.elim0) : nil_fun ⊚ f₀ = f₀ :=
  funext $ λ x => Fin2.elim0 (C:= fun _ => comp nil_fun f₀ x = f₀ x) x

  theorem append_fun_comp_id {α : TypeVec n} {β₀ β₁ β₂ : Type _}
      (g₀ : β₀ → β₁) (g₁ : β₁ → β₂) :
    @id _ α ::: g₁ ∘ g₀ = (id ::: g₁) ⊚ (id ::: g₀) :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  @[simp]
  theorem drop_fun_comp {α₀ α₁ α₂ : TypeVec (n+1)} (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂) :
    dropFun (f₁ ⊚ f₀) = dropFun f₁ ⊚ dropFun f₀ := rfl

  @[simp]
  theorem last_fun_comp {α₀ α₁ α₂ : TypeVec (n+1)} (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂) :
    lastFun (f₁ ⊚ f₀) = lastFun f₁ ∘ lastFun f₀ := rfl

  theorem append_fun_aux {α α' : TypeVec n} {β β' : Type _}
    (f : α ::: β ⟹ α' ::: β') : dropFun f ::: lastFun f = f :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  theorem append_fun_id_id {α : TypeVec n} {β : Type _} :
    @id n α ::: @_root_.id β = id :=
  eq_of_drop_last_eq (λ _ => rfl) rfl

  instance Subsingleton0 : Subsingleton (TypeVec 0) :=
  ⟨ λ a b => funext $ λ a => Fin2.elim0 (C:=fun _ => _) a  ⟩

  -- run_cmd mk_simp_attr `TypeVec
  -- attribute [TypeVec]

  set_option quotPrecheck false
  local prefix:0 "♯" => cast (by simp; apply congrArg <|> skip; simp <|> skip)

  def typevec_cases_nil {β : TypeVec 0 → Sort _} (f : β Fin2.elim0) :
    ∀ v, β v :=
  λ v => cast (by apply congrArg; apply Fin2.eq_fn0) f
  -- λ v => ♯ f

  def typevec_cases_cons (n : Nat) {β : TypeVec (n+1) → Sort _} (f : ∀ t (v : TypeVec n), β (v ::: t)) :
    ∀ v, β v :=
  λ v => cast (by simp) (f v.last v.drop)
  -- λ v => ♯ f v.last v.drop

  theorem typevec_cases_nil_append1 {β : TypeVec 0 → Sort _} (f : β Fin2.elim0) :
    typevec_cases_nil f Fin2.elim0 = f := rfl

  theorem typevec_cases_cons_append1 (n : Nat) {β : TypeVec (n+1) → Sort _}
        (f : ∀ t (v : TypeVec n), β (v ::: t))
        (v : TypeVec n) (α) :
    typevec_cases_cons n f (v ::: α) = f α v := rfl

  @[simp] def eq0 (f : TypeVec 0) : f = Fin2.elim0
  := by apply Fin2.eq_fn0

  def typevec_cases_nil₃ {β : ∀ v v' : TypeVec 0, v ⟹ v' → Sort _} (f : β Fin2.elim0 Fin2.elim0 nil_fun) :
    ∀ v v' f, β v v' f :=
  fun v v' fs => cast (
    by
      have : v = Fin2.elim0 := by funext i; contradiction
      cases this;
      have : v' = Fin2.elim0 := by funext i; contradiction
      cases this;
      have : fs = nil_fun := by funext i; contradiction;
      cases this
      rfl
  ) f

  def typevec_cases_cons₃ (n : Nat) {β : ∀ v v' : TypeVec (n+1), v ⟹ v' → Sort _}
    (F : ∀ t t' (f : t → t') (v v' : TypeVec n) (fs : v ⟹ v'), β (v ::: t) (v' ::: t') (fs ::: f)) :
    ∀ v v' fs, β v v' fs :=
  by
    intros v v'
    rw [←Vec.append1_drop_last v, ←Vec.append1_drop_last v']
    intro fs
    rw [←split_drop_fun_last_fun fs]
    apply F

  def typevec_cases_nil₂ {β : Fin2.elim0 ⟹ Fin2.elim0 → Sort _}
    (f : β nil_fun) :
    ∀ f, β f :=
  by
    intro g
    have : g = nil_fun := by funext x; cases x
    rw [this]
    exact f

  def typevec_cases_cons₂ (n : Nat) (t t' : Type _) (v v' : TypeVec (n)) {β : (v ::: t) ⟹ (v' ::: t') → Sort _}
    (F : ∀ (f : t → t') (fs : v ⟹ v'), β (fs ::: f)) :
    ∀ fs, β fs :=
  by
    intro fs
    rw [←split_drop_fun_last_fun fs]
    apply F

  theorem typevec_cases_nil₂_append_fun {β : Fin2.elim0 ⟹ Fin2.elim0 → Sort _}
    (f : β nil_fun) :
    typevec_cases_nil₂ f nil_fun = f := rfl

  theorem typevec_cases_cons₂_append_fun (n : Nat) (t t' : Type _) (v v' : TypeVec (n)) {β : (v ::: t) ⟹ (v' ::: t') → Sort _}
    (F : ∀ (f : t → t') (fs : v ⟹ v'), β (fs ::: f)) (f fs) :
    typevec_cases_cons₂ n t t' v v' F (fs ::: f) = F f fs := rfl

  /- for lifting predicates and relations -/

  /-- `predLast α p x` predicates `p` of the last element of `x : α.append1 β`. -/
  def predLast (α : TypeVec n) {β : Type _} (p : β → Prop) : ∀ ⦃i⦄, (α.append1 β) i → Prop
  | (Fin2.fs i) => λ x => true
  | Fin2.fz      => p

  /-- `relLast α r x y` says that `p` the last elements of `x y : α.append1 β` are related by `r` and all the other elements are equal. -/
  def relLast (α : TypeVec n) {β γ : Type _} (r : β → γ → Prop) :
    ∀ {i}, (α.append1 β) i → (α.append1 γ) i → Prop
  | (Fin2.fs i) => Eq
  | Fin2.fz      => r

open Nat

/-- `repeat n t` is a `n-length` type vector that contains `n` occurences of `t` -/
def Repeat : (n : Nat) → (t : Sort _) → TypeVec n
  | 0, t => Fin2.elim0
  | Nat.succ i, t => append1 (Repeat i t) t

/-- `prod α β` is the pointwise product of the components of `α` and `β` -/
def Prod : {n : Nat} → (α β : TypeVec.{u} n) → TypeVec n
  | 0, α, β     => Fin2.elim0
  | n + 1, α, β => (@Prod n (drop α) (drop β)) ::: (last α × last β)

-- mathport name: «expr ⊗ »
infixl:45 " ⊗ " => TypeVec.Prod

/-- `const x α` is an arrow that ignores its source and constructs a `typevec` that
contains nothing but `x` -/
protected def const {β} (x : β) : {n : Nat} → (α : TypeVec n) → α ⟹ Repeat n β
  | succ n, α, Fin2.fs i => TypeVec.const x (drop α) _
  | succ n, α, Fin2.fz => fun _ => x

open Function (uncurry)

/-- vector of equality on a product of vectors -/
def repeatEq : ∀ {n} α : TypeVec n, α ⊗ α ⟹ Repeat _ Prop
  | 0, α => nil_fun
  | succ n, α => repeatEq (drop α) ::: uncurry Eq

theorem const_append1 {β γ} (x : γ) {n} (α : TypeVec n) :
    TypeVec.const x (α ::: β) = appendFun (TypeVec.const x α) fun _ => x :=
by
  funext i
  cases i
  repeat rfl

theorem eq_nil_fun {α β : TypeVec 0} (f : α ⟹ β) : f = nil_fun := by
  ext x <;> cases x

theorem id_eq_nil_fun {α : TypeVec 0} : @id _ α = nil_fun := by
  ext x <;> cases x

theorem const_nil {β} (x : β) (α : TypeVec 0) : TypeVec.const x α = nil_fun := by
  ext i <;> cases i <;> rfl

-- @[TypeVec]
theorem repeat_eq_append1 {β} {n} (α : TypeVec n) :
  repeatEq (α ::: β) = splitFun (α := (α ⊗ α) ::: _ )
                                (α' := (Repeat n Prop) ::: _)
                                (repeatEq α)
                                (uncurry Eq) :=
by
  induction n <;> rfl

-- @[typevec]
theorem repeat_eq_nil (α : TypeVec 0) : repeatEq α = nil_fun := by
  ext i <;> cases i <;> rfl

/-- predicate on a type vector to constrain only the last object -/
def predLast' (α : TypeVec n) {β : Type _} (p : β → Prop) : (α ::: β) ⟹ Repeat (n + 1) Prop :=
  splitFun (TypeVec.const True α) p

/-- predicate on the product of two type vectors to constrain only their last object -/
def relLast' (α : TypeVec n) {β : Type _} (p : β → β → Prop) : (α ::: β) ⊗ (α ::: β) ⟹ Repeat (n + 1) Prop :=
  splitFun (repeatEq α) (uncurry p)

/-- given `F : typevec.{u} (n+1) → Type u`, `curry F : Type u → typevec.{u} → Type u`,
i.e. its first argument can be fed in separately from the rest of the vector of arguments -/
def Curry (F : TypeVec.{u} (n + 1) → Type _) (α : Type u) (β : TypeVec.{u} n) : Type _ :=
  F (β ::: α)

instance Curry.inhabited (F : TypeVec.{u} (n + 1) → Type _) (α : Type u) (β : TypeVec.{u} n)
    [I : Inhabited (F <| (β ::: α))] : Inhabited (Curry F α β) :=
  I

/-- arrow to remove one element of a `repeat` vector -/
def dropRepeat (α : Type _) : ∀ {n}, drop (Repeat (succ n) α) ⟹ Repeat n α
  | succ n, Fin2.fs i => dropRepeat _ i
  | succ n, Fin2.fz   => fun (a : α) => a

/-- projection for a repeat vector -/
def ofRepeat {α : Sort _} : ∀ {n i}, Repeat n α i → α
  | _, Fin2.fz   => fun (a : α) => a
  | _, Fin2.fs i => @ofRepeat _ _ i

theorem const_iff_true {α : TypeVec n} {i x p} : ofRepeat (TypeVec.const p α i x) ↔ p :=
by
  induction' i
  . rfl
  . rename_i n i i_ih
    erw [TypeVec.const, @i_ih (drop α) x]

-- variables  {F : typevec.{u} n → Type*} [mvfunctor F]
-- variable {α β γ : TypeVec.{u} n}
-- variable (p : α ⟹ Repeat n Prop) (r : α ⊗ α ⟹ Repeat n Prop)

/-- left projection of a `prod` vector -/
def Prod.fst : ∀ {n} {α β : TypeVec.{u} n}, α ⊗ β ⟹ α
  | succ n, α, β, Fin2.fs i => @fst _ (drop α) (drop β) i
  | succ n, α, β, Fin2.fz => Prod.fst

/-- right projection of a `prod` vector -/
def Prod.snd : ∀ {n} {α β : TypeVec.{u} n}, α ⊗ β ⟹ β
  | succ n, α, β, Fin2.fs i => @snd _ (drop α) (drop β) i
  | succ n, α, β, Fin2.fz => Prod.snd

/-- introduce a product where both components are the same -/
def Prod.diag : ∀ {n} {α : TypeVec.{u} n}, α ⟹ α ⊗ α
  | succ n, α, Fin2.fs i, x => @diag _ (drop α) _ x
  | succ n, α, Fin2.fz, x => (x, x)

/-- constructor for `prod` -/
def Prod.mk : ∀ {n} {α β : TypeVec.{u} n} i : Fin2 n, α i → β i → (α ⊗ β) i
  | succ n, α, β, Fin2.fs i => mk (α := fun i => α i.fs) (β := fun i => β i.fs) i
  | succ n, α, β, Fin2.fz => Prod.mk

@[simp]
theorem prod_fst_mk {α β : TypeVec.{u} n} (i : Fin2 n) (a : α i) (b : β i) :
  TypeVec.Prod.fst i (Prod.mk i a b) = a :=
by
  induction i
  simp_all only [Prod.fst, Prod.mk]
  rename_i i i_ih
  apply i_ih

@[simp]
theorem prod_snd_mk {α β : TypeVec n} (i : Fin2 n) (a : α i) (b : β i) :
  TypeVec.Prod.snd i (Prod.mk i a b) = b :=
by
  induction i
  simp_all [Prod.snd, Prod.mk]
  rename_i i i_ih
  apply i_ih

/-- `prod` is functorial -/
protected def Prod.map : ∀ {n} {α α' β β' : TypeVec.{u} n}, α ⟹ β → α' ⟹ β' → α ⊗ α' ⟹ β ⊗ β'
  | succ n, α, α', β, β', x, y, Fin2.fs i, a =>
    @Prod.map _ (drop α) (drop α') (drop β) (drop β') (dropFun x) (dropFun y) _ a
  | succ n, α, α', β, β', x, y, Fin2.fz, a => (x _ a.1, y _ a.2)

-- mathport name: «expr ⊗' »
infixl:45 " ⊗' " => TypeVec.Prod.map

theorem fst_prod_mk {α α' β β' : TypeVec.{u} n} (f : α ⟹ β) (g : α' ⟹ β') :
    TypeVec.Prod.fst ⊚ (f ⊗' g) = f ⊚ TypeVec.Prod.fst :=
by
  ext i
  intros
  induction i
  rfl
  rename_i i i_ih α''
  apply i_ih

theorem snd_prod_mk {α α' β β' : TypeVec.{u} n} (f : α ⟹ β) (g : α' ⟹ β') :
    TypeVec.Prod.snd ⊚ (f ⊗' g) = g ⊚ TypeVec.Prod.snd :=
by
  ext i
  intros
  induction i
  rfl
  rename_i i i_ih α''
  apply i_ih

theorem fst_diag {α : TypeVec.{u} n} :
    TypeVec.Prod.fst ⊚ (Prod.diag : α ⟹ _) = id :=
by
  ext i
  intros
  induction i
  rfl
  rename_i i i_ih _
  apply i_ih

theorem snd_diag {α : TypeVec n} :
    TypeVec.Prod.snd ⊚ (Prod.diag : α ⟹ _) = id :=
by
  ext i
  intros
  induction i
  rfl
  rename_i i i_ih _
  apply i_ih

theorem repeat_eq_iff_eq {α : TypeVec.{u} n} {i x y} :
  ofRepeat (repeatEq α i (Prod.mk _ x y)) ↔ x = y :=
by
  induction i
  rfl
  rename_i i i_ih
  erw [repeatEq, i_ih]

/-- given a predicate vector `p` over vector `α`, `subtype_ p` is the type of vectors
that contain an `α` that satisfies `p` -/
def Subtype_ : ∀ {n} {α : TypeVec.{u} n} p : α ⟹ Repeat n Prop, TypeVec n
  | _, α, p, Fin2.fz => Subtype fun x => p Fin2.fz x
  | _, α, p, Fin2.fs i => Subtype_ (dropFun p) i

/-- projection on `subtype_` -/
def subtypeVal : ∀ {n} {α : TypeVec.{u} n} p : α ⟹ Repeat n Prop, Subtype_ p ⟹ α
  | succ n, α, p, Fin2.fs i => @subtypeVal n _ _ i
  | succ n, α, p, Fin2.fz => Subtype.val

/-- arrow that rearranges the type of `subtype_` to turn a subtype of vector into
a vector of subtypes -/
def toSubtype :
    ∀ {n} {α : TypeVec.{u} n} (p : α ⟹ Repeat n Prop),
      (fun i : Fin2 n => { x // ofRepeat <| p i x }) ⟹ Subtype_ p
  | succ n, α, p, Fin2.fs i, x => toSubtype (dropFun p) i x
  | succ n, α, p, Fin2.fz, x => x

/-- arrow that rearranges the type of `subtype_` to turn a vector of subtypes
into a subtype of vector -/
def ofSubtype :
    ∀ {n} {α : TypeVec.{u} n} (p : α ⟹ Repeat n Prop),
        Subtype_ p ⟹ fun (i : Fin2 n) => { x // ofRepeat <| p i x }
  | succ n, α, p, Fin2.fs i, x => ofSubtype _ i x
  | succ n, α, p, Fin2.fz, x => x

/-- similar to `to_subtype` adapted to relations (i.e. predicate on product) -/
def toSubtype' :
    ∀ {n} {α : TypeVec.{u} n} p : α ⊗ α ⟹ Repeat n Prop,
      (fun i : Fin2 n => { x : α i × α i // ofRepeat <| p i (Prod.mk _ x.1 x.2) }) ⟹ Subtype_ p
  | succ n, α, p, Fin2.fs i, x => toSubtype' (dropFun p) i x
  | succ n, α, p, Fin2.fz, x =>
    ⟨x.val,
      cast
        (by apply congrArg; simp [Prod.mk])
        x.property
    ⟩

/-- similar to `ofSubtype` adapted to relations (i.e. predicate on product) -/
def ofSubtype' :
    ∀ {n} {α : TypeVec.{u} n} p : α ⊗ α ⟹ Repeat n Prop,
      Subtype_ p ⟹ fun i : Fin2 n => { x : α i × α i // ofRepeat <| p i (Prod.mk _ x.1 x.2) }
  | _, α, p, Fin2.fs i, x => ofSubtype' _ i x
  | _, α, p, Fin2.fz, x =>
    ⟨x.val,
      cast
        (by apply congrFun; simp [Prod.mk])
        x.property
    ⟩

/-- similar to `diag` but the target vector is a `Subtype_`
guaranteeing the equality of the components -/
def diagSub : ∀ {n} {α : TypeVec.{u} n}, α ⟹ Subtype_ (repeatEq α)
  | succ n, α, Fin2.fs i, x => @diagSub _ (drop α) _ x
  | succ n, α, Fin2.fz, x => ⟨(x, x), rfl⟩

theorem subtype_val_nil {α : TypeVec.{u} 0} (ps : α ⟹ Repeat 0 Prop) : TypeVec.subtypeVal ps = nil_fun :=
  funext <| by
    rintro ⟨⟩ <;> rfl

theorem diag_sub_val {n} {α : TypeVec.{u} n} :
  subtypeVal (repeatEq α) ⊚ diagSub = Prod.diag :=
by
  ext i
  induction i
  simp [Prod.diag, diagSub, repeatEq, subtypeVal, comp]
  rename_i i i_ih
  apply @i_ih (drop α)

theorem prod_id : ∀ {n} {α β : TypeVec.{u} n}, (id ⊗' id) = (id : α ⊗ β ⟹ _) := by
  intros
  ext i a
  induction i
  · cases a
    rfl
  · rename_i i i_ih _ _
    apply i_ih

theorem append_prod_append_fun  {n}
                                {α α' β β' : TypeVec.{u} n}
                                {φ φ' ψ ψ' : Type u}
                                {f₀ : α ⟹ α'}
                                {g₀ : β ⟹ β'}
                                {f₁ : φ → φ'}
                                {g₁ : ψ → ψ'} :
        ((f₀ ⊗' g₀) ::: (_root_.Prod.map f₁ g₁)) = ((f₀ ::: f₁) ⊗' (g₀ ::: g₁)) :=
by
  ext i a
  cases i
  . cases a
    rfl
  . rfl

@[simp]
theorem drop_fun_diag {α} :
  dropFun (@Prod.diag (n + 1) α) = Prod.diag :=
by
  ext i
  induction i
  all_goals
    simp [dropFun, Prod.diag, *]

@[simp]
theorem drop_fun_subtype_val {α} (p : α ⟹ Repeat (n + 1) Prop) :
  dropFun (subtypeVal p) = subtypeVal _ :=
  rfl

@[simp]
theorem last_fun_subtype_val {α} (p : α ⟹ Repeat (n + 1) Prop) :
  lastFun (subtypeVal p) = Subtype.val :=
  rfl

@[simp]
theorem drop_fun_to_subtype {α} (p : α ⟹ Repeat (n + 1) Prop) : dropFun (toSubtype p) = toSubtype _ :=
by
  ext i
  cases i
  all_goals
    simp [dropFun, toSubtype, *]

@[simp]
theorem last_fun_to_subtype {α} (p : α ⟹ Repeat (n + 1) Prop) : lastFun (toSubtype p) = _root_.id := by
  ext i
  cases i
  simp [dropFun, lastFun, toSubtype, *]

@[simp]
theorem drop_fun_of_subtype {α} (p : α ⟹ Repeat (n + 1) Prop) : dropFun (ofSubtype p) = ofSubtype _ := by
  ext i
  cases i
  all_goals
    simp [dropFun, ofSubtype, *]

@[simp]
theorem last_fun_of_subtype {α} (p : α ⟹ Repeat (n + 1) Prop) : lastFun (ofSubtype p) = _root_.id := by
  ext i
  cases i
  simp [dropFun, lastFun, ofSubtype, *]

@[simp]
theorem drop_fun_relLast {α : TypeVec n} {β} (R : β → β → Prop) : dropFun (relLast' α R) = repeatEq α :=
  rfl

-- open_locale MvFunctor

@[simp]
theorem drop_fun_prod {α α' β β' : TypeVec (n + 1)} (f : α ⟹ β) (f' : α' ⟹ β') :
    dropFun (f ⊗' f') = (dropFun f ⊗' dropFun f') :=
by
  ext i
  cases i
  all_goals
    simp [dropFun, Prod.map, *]

@[simp]
theorem last_fun_prod {α α' β β' : TypeVec (n + 1)} (f : α ⟹ β) (f' : α' ⟹ β') :
    lastFun (f ⊗' f') = _root_.Prod.map (lastFun f) (lastFun f') :=
by
  ext i
  cases i
  simp [lastFun, *]
  rfl

@[simp]
theorem drop_fun_from_append1_drop_last {α : TypeVec (n + 1)} : dropFun (@from_append1_drop_last _ α) = id :=
  rfl

@[simp]
theorem last_fun_from_append1_drop_last {α : TypeVec (n + 1)} : lastFun (@from_append1_drop_last _ α) = _root_.id :=
  rfl

@[simp]
theorem drop_fun_id {α : TypeVec (n + 1)} : dropFun (@TypeVec.id _ α) = id :=
  rfl

@[simp]
theorem prod_map_id {α β : TypeVec n} : (@TypeVec.id _ α ⊗' @TypeVec.id _ β) = id := by
  ext i
  induction i
  all_goals
    intro x
    simp only [TypeVec.Prod.map, *, drop_fun_id]
  rfl
  skip
  simp [Prod.map, id]

@[simp]
theorem subtype_val_diag_sub {α : TypeVec n} : subtypeVal (repeatEq α) ⊚ diagSub = Prod.diag :=
by
  ext i
  induction i
  . simp [comp, diagSub, subtypeVal, Prod.diag]
  . rename_i i i_ih
    simp [Prod.diag]
    simp [comp, diagSub, subtypeVal, Prod.diag] at *
    apply @i_ih (drop _)

  all_goals
    intro x
    simp [comp, diagSub, subtypeVal, Prod.diag, *]

@[simp]
theorem to_subtype_of_subtype {α : TypeVec.{u} n} (p : α ⟹ Repeat n Prop) :
    toSubtype p ⊚ ofSubtype p = id :=
by
  ext i x
  induction i
  all_goals
    simp only [id, toSubtype, comp, ofSubtype, dropFun] at *
  rename_i α' p' i_ih
  apply i_ih

@[simp]
theorem subtype_val_to_subtype {α : TypeVec n} (p : α ⟹ Repeat n Prop) :
    subtypeVal p ⊚ toSubtype p = fun _ => Subtype.val :=
by
  ext i x
  induction i
  all_goals
    simp only [toSubtype, comp, subtypeVal]  at *
  rename_i α' p' i_ih
  apply i_ih

@[simp]
theorem to_subtype_of_subtype_assoc {α β : TypeVec n} (p : α ⟹ Repeat n Prop) (f : β ⟹ Subtype_ p) :
    @toSubtype n _ p ⊚ ofSubtype _ ⊚ f = f :=
by
  rw [← comp_assoc, to_subtype_of_subtype]
  simp

@[simp]
theorem to_subtype'_of_subtype' {α : TypeVec n} (r : α ⊗ α ⟹ Repeat n Prop) :
    toSubtype' r ⊚ ofSubtype' r = id :=
by
  ext i x <;> induction i <;> simp only [id, toSubtype', comp, ofSubtype']  at * <;> simp [Subtype.eta, *]

theorem subtype_val_to_subtype' {α : TypeVec n} (r : α ⊗ α ⟹ Repeat n Prop) :
    subtypeVal r ⊚ toSubtype' r = fun i x => Prod.mk i x.1.fst x.1.snd :=
by
  ext i x <;> induction i <;> simp only [id, toSubtype', comp, subtypeVal, Prod.mk]  at * <;> simp [*]

/-
Reverse an arrow
-/
def Arrow.reverse (f : α ⟹ β) : α.reverse ⟹ β.reverse :=
  fun i v => cast (
    by simp[Vec.reverse, Vec.normalize_lawful]
  ) $ f i.inv (cast (by simp[Vec.reverse, Vec.normalize_lawful]) v)

end TypeVec

/-
Support for extending a TypeVec by one element.
-/
namespace Eq

theorem mp_mpr {α β : Type _} (h : α = β) (x : β) :
  Eq.mp h (Eq.mpr h x) = x :=
by induction h; rfl

theorem mpr_mp {α β : Type _} (h : α = β) (x : α) :
  Eq.mpr h (Eq.mp h x) = x :=
by induction h; rfl

end Eq


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.set.image
import tactic.interactive

open set

variables {α β : Type}
@[simp] lemma singleton_inter_singleton_eq_empty {x y : α} :
  ({x} ∩ {y} = (∅ : set α)) ↔ x ≠ y :=
by simp [singleton_inter_eq_empty]

example {f : β → α} {x y : α} (h : x ≠ y) : f ⁻¹' {x} ∩ f ⁻¹' {y} = ∅ :=
begin
  have : {x} ∩ {y} = (∅ : set α) := by simpa using h,
  convert preimage_empty,
  rw [←preimage_inter,this],
end

example (P : Prop) (h : P) : P := by convert h


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.suggest -- No other imports, for fast testing

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

namespace test.library_search

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

-- Verify that `library_search` solves goals via `solve_by_elim` when the library isn't
-- even needed.
example (P : Prop) (p : P) : P :=
by library_search
example (P : Prop) (p : P) (np : ¬P) : false :=
by library_search
example (X : Type) (P : Prop) (x : X) (h : Π x : X, x = x → P) : P :=
by library_search

example (α : Prop) : α → α :=
by library_search -- says: `exact id`

example (p : Prop) [decidable p] : (¬¬p) → p :=
by library_search -- says: `exact not_not.mp`

example (a b : Prop) (h : a ∧ b) : a :=
by library_search -- says: `exact h.left`

example (P Q : Prop) [decidable P] [decidable Q]: (¬ Q → ¬ P) → (P → Q) :=
by library_search -- says: `exact not_imp_not.mp`

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

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

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

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

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

section synonym

-- Synonym `>` for `<` in another part of the goal
example (a b : ℕ) (ha : a > 0) (hb : 0 < b) : 0 < a + b :=
by library_search -- says: `exact add_pos ha hb`

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

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

-- A lemma with head symbol `¬` can be used to prove `¬ p` or `⊥`
example (a : ℕ) : ¬ (a < 0) := by library_search -- says `exact not_lt_bot`

example (a : ℕ) (h : a < 0) : false := by library_search -- says `exact not_lt_bot h`

-- An inductive type hides the constructor's arguments enough
-- so that `library_search` doesn't accidentally close the goal.
inductive P : ℕ → Prop
| gt_in_head {n : ℕ} : n < 0 → P n

-- This lemma with `>` as its head symbol should also be found for goals with head symbol `<`.
lemma lemma_with_gt_in_head (a : ℕ) (h : P a) : 0 > a := by { cases h, assumption }

-- This lemma with `false` as its head symbols should also be found for goals with head symbol `¬`.
lemma lemma_with_false_in_head (a b : ℕ) (h1 : a < b) (h2 : P a) : false :=
by { apply nat.not_lt_zero, cases h2, assumption }

example (a : ℕ) (h : P a) : 0 > a := by library_search -- says `exact lemma_with_gt_in_head a h`

example (a : ℕ) (h : P a) : a < 0 := by library_search -- says `exact lemma_with_gt_in_head a h`

example (a b : ℕ) (h1 : a < b) (h2 : P a) : false := by library_search
-- says `exact lemma_with_false_in_head a b h1 h2`

example (a b : ℕ) (h1 : a < b) : ¬ (P a) := by library_search!
-- says `exact lemma_with_false_in_head a b h1`

end synonym

-- We even find `iff` results:

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

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

-- Checking examples from issue #2220
example {α : Sort*} (h : empty) : α :=
by library_search

example {α : Type*} (h : empty) : α :=
by library_search

def map_from_sum {A B C : Type} (f : A → C) (g : B → C) : (A ⊕ B) → C := by library_search

-- Test that we can set the transparency level in `apply`
-- to change how aggressively we unfold definitions while trying to apply lemmas.
lemma bind_singleton {α β} (x : α) (f : α → list β) : list.bind [x] f = f x :=
begin
  success_if_fail {
    library_search { md := tactic.transparency.reducible },
  },
  library_search!,
end

constant f : ℕ → ℕ
axiom F (a b : ℕ) : f a ≤ f b ↔ a ≤ b

example (a b : ℕ) (h : a ≤ b) : f a ≤ f b := by library_search

-- Test #3432
theorem nonzero_gt_one (n : ℕ) : ¬ n = 0 → n ≥ 1 :=
by library_search!   -- `exact nat.pos_of_ne_zero`

end test.library_search


/-
Copyright (c) 2020 Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning and Patrick Lutz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.adjoin
import Mathlib.field_theory.separable
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Primitive Element Theorem

In this file we prove the primitive element theorem.

## Main results

- `exists_primitive_element`: a finite separable extension `E / F` has a primitive element, i.e.
  there is an `α : E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.

## Implementation notes

In declaration names, `primitive_element` abbreviates `adjoin_simple_eq_top`:
it stands for the statement `F⟮α⟯ = (⊤ : subalgebra F E)`. We did not add an extra
declaration `is_primitive_element F α := F⟮α⟯ = (⊤ : subalgebra F E)` because this
requires more unfolding without much obvious benefit.

## Tags

primitive element, separable field extension, separable extension, intermediate field, adjoin, exists_adjoin_simple_eq_top

-/

namespace field

/-! ### Primitive element theorem for finite fields -/

/-- Primitive element theorem assuming E is finite. -/
theorem exists_primitive_element_of_fintype_top (F : Type u_1) [field F] (E : Type u_2) [field E]
    [algebra F E] [fintype E] :
    ∃ (α : E), intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α) = ⊤ :=
  sorry

/-- Primitive element theorem for finite dimensional extension of a finite field. -/
theorem exists_primitive_element_of_fintype_bot (F : Type u_1) [field F] (E : Type u_2) [field E]
    [algebra F E] [fintype F] [finite_dimensional F E] :
    ∃ (α : E), intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α) = ⊤ :=
  exists_primitive_element_of_fintype_top F E

/-! ### Primitive element theorem for infinite fields -/

theorem primitive_element_inf_aux_exists_c {F : Type u_1} [field F] [infinite F] {E : Type u_2}
    [field E] (ϕ : F →+* E) (α : E) (β : E) (f : polynomial F) (g : polynomial F) :
    ∃ (c : F),
        ∀ (α' : E),
          α' ∈ polynomial.roots (polynomial.map ϕ f) →
            ∀ (β' : E),
              β' ∈ polynomial.roots (polynomial.map ϕ g) → -(α' - α) / (β' - β) ≠ coe_fn ϕ c :=
  sorry

-- This is the heart of the proof of the primitive element theorem. It shows that if `F` is

-- infinite and `α` and `β` are separable over `F` then `F⟮α, β⟯` is generated by a single element.

theorem primitive_element_inf_aux {F : Type u_1} [field F] [infinite F] {E : Type u_2} [field E]
    (α : E) (β : E) [algebra F E] (F_sep : is_separable F E) :
    ∃ (γ : E),
        intermediate_field.adjoin F
            (intermediate_field.insert.insert (intermediate_field.insert.insert ∅ β) α) =
          intermediate_field.adjoin F (intermediate_field.insert.insert ∅ γ) :=
  sorry

/-- Primitive element theorem: a finite separable field extension `E` of `F` has a
  primitive element, i.e. there is an `α ∈ E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.-/
theorem exists_primitive_element {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E]
    [finite_dimensional F E] (F_sep : is_separable F E) :
    ∃ (α : E), intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α) = ⊤ :=
  sorry

end Mathlib