import make_ring
import tactic.auto_cases
open lean.parser (ident)
open interactive (parse types.with_ident_list)
namespace freealg

/----------------------------------------------------------------------------------

 Builds a 'free boolean algebra' whose elements are commutative sums of squarefree
 monomials in n indeterminates X₀, X₁, ... with coefficients mod 2. These elements
 are encoded internally as boolean vectors, via a map under which addition is 'xor' and
 multiplication is 'and', both coordinate-wise.

------------------------------------------------------------------------------------/

variables {α : Type*}[boolean_algebra α]

def freealg : nat → Type
-- base case is bool
| 0 := bool
-- inductive case is the coefficient on X_n and the coefficient on X_nᶜ
-- where the value of the term is CX_n + DX_nᶜ
-- this determines a region in the Venn diagram that represents the free boolean algebra
| (n+1) := (freealg n) × (freealg n)

section operations
def zero : forall {n : nat}, (freealg n)
| 0 := ff
| (n+1) := (zero, zero)

def one : forall {n : nat}, (freealg n)
| 0 := tt
| (n+1) := (one, one)

def var : forall {n : nat} (i : nat), (i < n) → (freealg n)
| 0 i Hi := false.elim (nat.not_lt_zero i Hi)
| (n+1) 0 Hi := (one, zero)
| (n+1) (i+1) Hi := let coeff : freealg n := var i (nat.lt_of_succ_lt_succ Hi) in (coeff, coeff)

def symmdiff : forall {n : nat}, (freealg n) → (freealg n) → (freealg n)
| 0 a b := bxor a b
| (n+1) a b := (symmdiff a.1 b.1, symmdiff a.2 b.2)

def inf : forall {n : nat}, (freealg n) → (freealg n) → (freealg n)
| 0 a b := band a b
| (n+1) a b := (inf a.1 b.1, inf a.2 b.2)

def sup : forall {n : nat}, (freealg n) → (freealg n) → (freealg n)
| 0 a b := bor a b
| (n + 1) a b := (sup a.1 b.1, sup a.2 b.2)

def compl : forall {n : nat}, (freealg n) → (freealg n)
| _ a := (symmdiff one a)

def sdiff : forall {n : nat}, (freealg n) → (freealg n) → (freealg n)
| _ a b := (inf a (compl b))

def map : forall {n : nat} (V : vector α n), (freealg n) → α
| 0 V ff := 0
| 0 V tt := 1
| (n+1) V a := (map V.tail a.1) * V.head + (map V.tail a.2) * (V.head + 1)
end operations

section conversion_lemmas
-- Our proofs rely on having ring around
-- TODO: do we need to have ring around (can we get rid of some notation)
-- having ring makes it nicer to work with symmdiff/inf so we define sup in terms of symmdiff and inf.
lemma sup_to_symmdiff_and_inf {n : nat} (a b : (freealg n)) :
  sup a b = (symmdiff (symmdiff a b) (inf a b)) :=
  begin
    induction n,
    {
      unfold sup symmdiff inf, cases a; cases b; refl
    },
    {
      unfold sup symmdiff inf,
      rewrite (n_ih a.1 b.1),
      rewrite (n_ih a.2 b.2),
    }
  end

-- These are basic lemmas about how map transforms freealg equations into
-- equations in the incoming boolean algebra
lemma on_zero : forall {n : nat} (V : vector α n),
0 = map V zero
  | 0 V := rfl
  | (n+1) V := calc
      0   = 0 * V.head + 0 * (V.head + 1)                                 : by ring
      ... = (map V.tail zero) * V.head + (map V.tail zero) * (V.head + 1) : by rw on_zero
lemma on_one : forall {n : nat} (V : vector α n),
1 = map V one
  | 0 V := rfl
  | (n+1) V := calc
      1   = V.head + (V.head + 1)                                       : (add_self_left _ _).symm
      ... = 1 * V.head + 1 * (V.head + 1)                               : by ring
      ... = (map V.tail one) * V.head + (map V.tail one) * (V.head + 1) : by rw on_one
lemma on_var : forall {n : nat} (V : vector α n) (i : nat) (Hi : i < n),
V.nth ⟨i, Hi⟩ = map V (var i Hi)
  | 0 V i Hi := false.elim (nat.not_lt_zero i Hi)
  | (n+1) V 0 Hi := calc
      V.nth ⟨0, Hi⟩ = V.head                                                       : by simp
      ...           = 1 * V.head + 0 * (V.head + 1)                                : by ring
      ...           = (map V.tail one) * V.head + (map V.tail zero) * (V.head + 1) : by rw [on_zero, on_one]
  | (n+1) V (i+1) Hi := let
      Hip : (i < n) := nat.lt_of_succ_lt_succ Hi,
      tail_var := map V.tail (var i Hip)
      in calc V.nth ⟨i + 1, Hi⟩ = V.tail.nth ⟨i, Hip⟩                         : by rw [vector.nth_tail, fin.succ.equations._eqn_1]
      ...                       = tail_var                                    : on_var _ _ _
      ...                       = _                                           : (add_self_left (tail_var * V.head) _).symm
      ...                       = tail_var * V.head + tail_var * (V.head + 1) : by ring

-- These two lemmas are useful when working with ring equations.
lemma on_add : forall {n : nat} (V : vector α n) (a b : freealg n),
(map V a) + (map V b) = map V (symmdiff a b)
  | 0 V a b :=
      begin
        cases a; cases b; unfold map symmdiff bxor; ring,
        exact two_eq_zero,
      end
  | (n+1) V a b :=
      begin
        unfold map symmdiff,
        rw [←on_add V.tail a.1 b.1, ←on_add V.tail a.2 b.2],
        ring,
      end
lemma on_mul : forall {n : nat} (V : vector α n) (a b : freealg n),
(map V a) * (map V b) = map V (inf a b)
  | 0 V a b := by cases a; cases b; unfold map inf band; ring
  | (n+1) V a b :=
      begin
        unfold map inf,
        rw [←on_mul V.tail a.1 b.1, ←on_mul V.tail a.2 b.2,←expand_product],
      end

-- These four lemmas are useful when ⊔ and ⊓, ᶜ, and \ are in the mix
lemma on_inf : forall {n : nat} (V : vector α n) (a b : freealg n),
(map V a) ⊓ (map V b) = map V (inf a b) :=
begin
  intros,
  change (map V a) * (map V b) = map V (inf a b),
  apply on_mul,
end
lemma on_sup : forall {n : nat} (V : vector α n) (a b : freealg n),
(map V a) ⊔ (map V b) = map V (sup a b) :=
begin
  intros,
  rewrite sup_to_ring,
  rewrite sup_to_symmdiff_and_inf,
  rewrite <- on_add, rewrite <- on_add, rewrite <- on_mul,
end
lemma on_compl : forall {n : nat} (V : vector α n) (a : freealg n),
(map V a)ᶜ = (map V (compl a)) :=
begin
  intros,
  rewrite compl_to_ring, unfold compl,
  rewrite <- on_add, rewrite <- on_one, ring,
end
lemma on_sdiff : forall {n : nat} (V : vector α n) (a b : freealg n),
(map V a) \ (map V b) = (map V (sdiff a b)) :=
begin
  intros,
  rewrite diff_to_ring, unfold sdiff,
  rewrite <- on_mul, unfold compl, rewrite <- on_add,
  rewrite <- on_one, ring,
end
end conversion_lemmas

section boolean_algebra_instance
-- discharging (decidable true) and (decidable false) as that's easy
meta def construct_decidable : tactic unit := tactic.focus1 $ do
  target <- tactic.target,
  match target with
  | `(decidable true) := `[apply is_true, trivial]
  | `(decidable false) := `[apply is_false, trivial]
  | _ := tactic.skip
  end
-- ≤
def le : forall {n : nat}, (freealg n) → (freealg n) → Prop
| 0 ff ff := true
| 0 ff tt := true
| 0 tt ff := false
| 0 tt tt := true
| (n+1) a b := le a.1 b.1 ∧ le a.2 b.2
-- <
def lt {n : nat} (a b : freealg n) := le a b ∧ ¬ le b a

-- So tauto can work
instance le_decidable {n : nat} (a b : freealg n) : (decidable (le a b)) :=
begin
  -- discharge the base case
  induction n; cases a; cases b; unfold le; construct_decidable,
  -- discharge the inductive case
  simp,
  letI := (n_ih a_fst b_fst),
  letI := (n_ih a_snd b_snd),
  exact and.decidable,
end

meta def every_freealg_proof : tactic unit := do
  tactic.try $ `[unfold_projs],
  tactic.intros,
  nexpr <- tactic.find_assumption `(nat),
  tactic.induction nexpr,
  tactic.all_goals $ (tactic.focus1 $ do
    tactic.repeat $ (do
      freealg_expr <- tactic.to_expr ``(freealg _),
      freealg_var <- tactic.find_assumption freealg_expr,
      tactic.cases_core freealg_var,
      tactic.skip),
    ctx <- tactic.local_context,
    tactic.all_goals $ tactic.try $ `[simp only [prod.mk.inj_iff, le, lt, sup, inf, symmdiff, sdiff, compl] at *],
    tactic.all_goals $ tactic.try $ `[tauto]),
  tactic.skip

instance freealg_as_boolalg (n : nat) : (boolean_algebra (freealg n)) := {
  sup := sup,
  le := le,
  lt := lt,
  le_refl := by every_freealg_proof,
  le_trans := by every_freealg_proof,
  lt_iff_le_not_le := by every_freealg_proof,
  le_antisymm := by every_freealg_proof,
  le_sup_left := by every_freealg_proof,
  le_sup_right := by every_freealg_proof,
  sup_le := by every_freealg_proof,
  inf := inf,
  inf_le_left := by every_freealg_proof,
  inf_le_right := by every_freealg_proof,
  le_inf := by every_freealg_proof,
  le_sup_inf := by every_freealg_proof,
  top := one,
  le_top := by every_freealg_proof,
  bot := zero,
  bot_le := by every_freealg_proof,
  compl := compl,
  sdiff := sdiff,
  inf_compl_le_bot := by every_freealg_proof,
  top_le_sup_compl := by every_freealg_proof,
  sdiff_eq := by every_freealg_proof,
}
end boolean_algebra_instance

end /-namespace-/ freealg


/-
Copyright (c) 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import order.conditionally_complete_lattice.basic
import data.set.intervals.ord_connected

/-! # Subtypes of conditionally complete linear orders

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

In this file we give conditions on a subset of a conditionally complete linear order, to ensure that
the subtype is itself conditionally complete.

We check that an `ord_connected` set satisfies these conditions.

## TODO

Add appropriate instances for all `set.Ixx`. This requires a refactor that will allow different
default values for `Sup` and `Inf`.
-/

open_locale classical
open set

variables {α : Type*} (s : set α)

section has_Sup
variables [has_Sup α]

/-- `has_Sup` structure on a nonempty subset `s` of an object with `has_Sup`. This definition is
non-canonical (it uses `default s`); it should be used only as here, as an auxiliary instance in the
construction of the `conditionally_complete_linear_order` structure. -/
noncomputable def subset_has_Sup [inhabited s] : has_Sup s := {Sup := λ t,
if ht : Sup (coe '' t : set α) ∈ s then ⟨Sup (coe '' t : set α), ht⟩ else default}

local attribute [instance] subset_has_Sup

@[simp] lemma subset_Sup_def [inhabited s] :
  @Sup s _ = λ t,
  if ht : Sup (coe '' t : set α) ∈ s then ⟨Sup (coe '' t : set α), ht⟩ else default := rfl

lemma subset_Sup_of_within [inhabited s] {t : set s} (h : Sup (coe '' t : set α) ∈ s) :
  Sup (coe '' t : set α) = (@Sup s _ t : α) :=
by simp [dif_pos h]

end has_Sup

section has_Inf
variables [has_Inf α]

/-- `has_Inf` structure on a nonempty subset `s` of an object with `has_Inf`. This definition is
non-canonical (it uses `default s`); it should be used only as here, as an auxiliary instance in the
construction of the `conditionally_complete_linear_order` structure. -/
noncomputable def subset_has_Inf [inhabited s] : has_Inf s := {Inf := λ t,
if ht : Inf (coe '' t : set α) ∈ s then ⟨Inf (coe '' t : set α), ht⟩ else default}

local attribute [instance] subset_has_Inf

@[simp] lemma subset_Inf_def [inhabited s] :
  @Inf s _ = λ t,
  if ht : Inf (coe '' t : set α) ∈ s then ⟨Inf (coe '' t : set α), ht⟩ else default := rfl

lemma subset_Inf_of_within [inhabited s] {t : set s} (h : Inf (coe '' t : set α) ∈ s) :
  Inf (coe '' t : set α) = (@Inf s _ t : α) :=
by simp [dif_pos h]

end has_Inf

variables [conditionally_complete_linear_order α]

local attribute [instance] subset_has_Sup
local attribute [instance] subset_has_Inf

/-- For a nonempty subset of a conditionally complete linear order to be a conditionally complete
linear order, it suffices that it contain the `Sup` of all its nonempty bounded-above subsets, and
the `Inf` of all its nonempty bounded-below subsets.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def subset_conditionally_complete_linear_order [inhabited s]
  (h_Sup : ∀ {t : set s} (ht : t.nonempty) (h_bdd : bdd_above t), Sup (coe '' t : set α) ∈ s)
  (h_Inf : ∀ {t : set s} (ht : t.nonempty) (h_bdd : bdd_below t), Inf (coe '' t : set α) ∈ s) :
  conditionally_complete_linear_order s :=
{ le_cSup := begin
    rintros t c h_bdd hct,
    -- The following would be a more natural way to finish, but gives a "deep recursion" error:
    -- simpa [subset_Sup_of_within (h_Sup t)] using
    --   (strict_mono_coe s).monotone.le_cSup_image hct h_bdd,
    have := (subtype.mono_coe s).le_cSup_image hct h_bdd,
    rwa subset_Sup_of_within s (h_Sup ⟨c, hct⟩ h_bdd) at this,
  end,
  cSup_le := begin
    rintros t B ht hB,
    have := (subtype.mono_coe s).cSup_image_le ht hB,
    rwa subset_Sup_of_within s (h_Sup ht ⟨B, hB⟩) at this,
  end,
  le_cInf := begin
    intros t B ht hB,
    have := (subtype.mono_coe s).le_cInf_image ht hB,
    rwa subset_Inf_of_within s (h_Inf ht ⟨B, hB⟩) at this,
  end,
  cInf_le := begin
    rintros t c h_bdd hct,
    have := (subtype.mono_coe s).cInf_image_le hct h_bdd,
    rwa subset_Inf_of_within s (h_Inf ⟨c, hct⟩ h_bdd) at this,
  end,
  ..subset_has_Sup s,
  ..subset_has_Inf s,
  ..distrib_lattice.to_lattice s,
  ..(infer_instance : linear_order s) }

section ord_connected

/-- The `Sup` function on a nonempty `ord_connected` set `s` in a conditionally complete linear
order takes values within `s`, for all nonempty bounded-above subsets of `s`. -/
lemma Sup_within_of_ord_connected
  {s : set α} [hs : ord_connected s] ⦃t : set s⦄ (ht : t.nonempty) (h_bdd : bdd_above t) :
  Sup (coe '' t : set α) ∈ s :=
begin
  obtain ⟨c, hct⟩ : ∃ c, c ∈ t := ht,
  obtain ⟨B, hB⟩ : ∃ B, B ∈ upper_bounds t := h_bdd,
  refine hs.out c.2 B.2 ⟨_, _⟩,
  { exact (subtype.mono_coe s).le_cSup_image hct ⟨B, hB⟩ },
  { exact (subtype.mono_coe s).cSup_image_le ⟨c, hct⟩ hB },
end

/-- The `Inf` function on a nonempty `ord_connected` set `s` in a conditionally complete linear
order takes values within `s`, for all nonempty bounded-below subsets of `s`. -/
lemma Inf_within_of_ord_connected
  {s : set α} [hs : ord_connected s] ⦃t : set s⦄ (ht : t.nonempty) (h_bdd : bdd_below t) :
  Inf (coe '' t : set α) ∈ s :=
begin
  obtain ⟨c, hct⟩ : ∃ c, c ∈ t := ht,
  obtain ⟨B, hB⟩ : ∃ B, B ∈ lower_bounds t := h_bdd,
  refine hs.out B.2 c.2 ⟨_, _⟩,
  { exact (subtype.mono_coe s).le_cInf_image ⟨c, hct⟩ hB },
  { exact (subtype.mono_coe s).cInf_image_le hct ⟨B, hB⟩ },
end

/-- A nonempty `ord_connected` set in a conditionally complete linear order is naturally a
conditionally complete linear order. -/
noncomputable instance ord_connected_subset_conditionally_complete_linear_order
  [inhabited s] [ord_connected s] :
  conditionally_complete_linear_order s :=
subset_conditionally_complete_linear_order s Sup_within_of_ord_connected Inf_within_of_ord_connected

end ord_connected


import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a

variables {f g : ℝ → ℝ}

-- BEGIN
example {c : ℝ} (ubf : fn_has_ub f) (h : c ≥ 0):
  fn_has_ub (λ x, c * f x) :=
begin
  sorry,
end
-- END


structure Point where
  x : Nat
  y : Nat

def f (x : Nat) : Point :=
  let y := x + 1
  { x, y }

theorem ex1 : f x = { x, y := x + 1 } :=
  rfl

def g (p : Point) : Nat :=
  p.x + p.y

def Set (α : Type u) : Type u :=
  α → Prop

def Set.empty : Set α :=
  fun a => False

def Set.insert (s : Set α) (a : α) : Set α :=
  fun x => x = a ∨ s a

syntax (name := finSet) "{" term,* "}" : term

macro_rules (kind := finSet)
  | `({ $as,* }) => do
    as.getElems.foldlM (β := Lean.TSyntax _) (init := ← `(Set.empty)) fun s a => `(Set.insert $s $a)

#check { 1, 2, 3 }

#check fun x y => g {x, y}

#check fun x y : Nat => {x, y}

#check fun x y : Nat => {x, y : Point}

theorem ex2 (x y : Nat) : { x, y } = (Set.empty.insert x |>.insert y) :=
  rfl


/-additive group homomorphisms
-/

import add_subgroup.basic

@[reducible] def add_group_hom (G : Type*) (H : Type*) [add_group G] [add_group H] :=
  add_monoid_hom G H

def add_group_hom.comp {G : Type*} {H : Type*} {K : Type*}
  [add_group G] [add_group H] [add_group K]
    (f : add_group_hom H K) (g : add_group_hom G H):
  add_group_hom G K := add_monoid_hom.comp f g

def add_group_hom.mk {G : Type*} [add_group G] {H : Type*} [add_group H] (f : G → H)
(h : ∀ a b : G, f(a + b) = f a + f b) : add_group_hom G H :=
{ to_fun := f,
  map_zero' := begin
    have h1: f (0:G) + f 0=f((0:G)+(0:G)),
    rw h,
    norm_num at h1,
    exact h1,
  end,
  map_add' := h }

namespace add_group_hom

variables {G : Type*} {H : Type*} [add_group G] [add_group H]

def map {G₁ : Type*} [add_group G₁] {G₂ : Type*} [add_group G₂]
  (f : add_group_hom G₁ G₂) (H : add_subgroup G₁) : add_subgroup G₂ :=
{ carrier := (f : G₁ → G₂) '' H.carrier,
  is_add_subgroup := {
    zero_mem := ⟨0, H.zero_mem, f.map_zero⟩,
    add_mem := begin rintros _ _ ⟨c, hc, rfl⟩ ⟨d, hd, rfl⟩,
      exact ⟨c + d, H.add_mem hc hd, f.map_add c d⟩ end,
    neg_mem := begin rintros _ ⟨c, hc, rfl⟩, exact ⟨-c, H.neg_mem hc, f.map_neg c⟩ end
  }
}

def comap {G₁ : Type*} [add_group G₁] {G₂ : Type*} [add_group G₂]
  (f : add_group_hom G₁ G₂) (H : add_subgroup G₂) : add_subgroup G₁ :=
{ carrier := (f : G₁ → G₂) ⁻¹' H.carrier,
  is_add_subgroup := {
    zero_mem := begin
      show f 0 ∈ H,
      rw f.map_zero,
      exact H.zero_mem
    end,
    add_mem := begin
      intros a b ha hb,
      show f (a + b) ∈ H,
      rw f.map_add,
      exact H.add_mem ha hb,
    end,
    neg_mem := begin
      intros a ha,
      show f (-a) ∈ H,
      rw f.map_neg,
      exact H.neg_mem ha
    end
  }
}

lemma comap_comp {G₁ : Type*} [add_group G₁] {G₂ : Type*} [add_group G₂]
  {G₃ : Type*} [add_group G₃] (f : add_group_hom G₁ G₂) (g : add_group_hom G₂ G₃)
  (H : add_subgroup G₃) :
  add_group_hom.comap (g.comp f) H = add_group_hom.comap f (add_group_hom.comap g H)
  := rfl

-- this works:
--def ker (f : add_monoid_hom G H) : add_submonoid G := f.comap ⊥

def ker (f : add_group_hom G H) : add_subgroup G := add_group_hom.comap f ⊥

lemma mem_ker (f : add_group_hom G H) (g : G) : g ∈ ker f ↔ f g = 0 :=
iff.rfl

-- but f.comap ⊥ doesn't :-/

def range (f : add_group_hom G H) : add_subgroup H := add_group_hom.map f ⊤

def induced {f : add_group_hom G H} {G₁ : add_subgroup G}
  {H₁ : add_subgroup H} (h : f '' G₁ ⊆ H₁) :
add_group_hom G₁ H₁ :=
{ to_fun := λ g, ⟨f g.1, h ⟨g.1, g.2, rfl⟩⟩,
  map_zero' := begin
  rw subtype.ext,
  simp,
  convert f.map_zero,
  end,
  map_add' :=  begin
  intros,
  simp [subtype.ext],
  apply f.map_add,
  end }
end add_group_hom

/- quotients -/

namespace add_subgroup

variables {A : Type*} [add_comm_group A]

@[derive add_comm_group]
def quotient (B : add_subgroup A) := quotient_add_group.quotient B.carrier

variable (B : add_subgroup A)

def quotient.mk : add_group_hom A B.quotient :=
{ to_fun := quotient.mk',
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

lemma quotient.ker_mk : add_group_hom.ker (quotient.mk B) = B :=
begin
  rw ←ext_iff,
  intro g,
  rw add_group_hom.mem_ker,
  show quotient.mk' g = quotient.mk' 0 ↔ _,
  rw quotient.eq',
  show -g + 0 ∈ B ↔ _,
  rw add_zero,
  rw neg_mem_iff,
end

def quotient.lift {A : Type*} [add_comm_group A] {C : Type*} [add_comm_group C]
  (f : add_group_hom A C) (B : add_subgroup A) (hB : B ≤ add_group_hom.ker f) :
add_group_hom B.quotient C :=
{ to_fun := λ q, q.lift_on' ⇑f begin
    intros a₁ a₂ h,
    change (-a₁) + a₂ ∈ B at h,
    have h2 : f (-a₁ + a₂) = 0 := (f.mem_ker _).1 (hB h),
    rwa [f.map_add, f.map_neg, neg_add_eq_iff_eq_add,
      add_zero, eq_comm] at h2,
  end,
  map_zero' := begin
  show f 0= 0,
  exact f.map_zero,
  end,
  map_add' := begin
  intros x y,
  apply quotient.induction_on₂' x y,
  exact f.map_add,

  end }

def quotient.map {A₁ : Type*} [add_comm_group A₁] {A₂ : Type*} [add_comm_group A₂]
  (B₁ : add_subgroup A₁) (B₂ : add_subgroup A₂) (f : add_group_hom A₁ A₂)
  (hf : B₁ ≤ add_group_hom.comap f B₂) :
  add_group_hom (quotient B₁) (quotient B₂) :=
{ to_fun := quotient.lift ((quotient.mk B₂).comp f) B₁ $ le_trans hf begin
  unfold add_group_hom.ker,
  rw add_group_hom.comap_comp,
  apply le_of_eq _,
  congr',
  symmetry,
  apply quotient.ker_mk,
end,
  map_zero' := begin
    apply add_monoid_hom.map_zero,
  end,
  map_add' := by apply add_monoid_hom.map_add }

end add_subgroup


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

! This file was ported from Lean 3 source module linear_algebra.exterior_algebra.grading
! leanprover-community/mathlib commit 34020e531ebc4e8aac6d449d9eecbcd1508ea8d0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.ExteriorAlgebra.Basic
import Mathbin.RingTheory.GradedAlgebra.Basic

/-!
# Results about the grading structure of the exterior algebra

Many of these results are copied with minimal modification from the tensor algebra.

The main result is `exterior_algebra.graded_algebra`, which says that the exterior algebra is a
ℕ-graded algebra.
-/

namespace ExteriorAlgebra

variable {R M : Type _} [CommRing R] [AddCommGroup M] [Module R M]

variable (R M)

open DirectSum

/-- A version of `exterior_algebra.ι` that maps directly into the graded structure. This is
primarily an auxiliary construction used to provide `exterior_algebra.graded_algebra`. -/
def GradedAlgebra.ι : M →ₗ[R] ⨁ i : ℕ, ↥((ι R : M →ₗ[_] _).range ^ i) :=
  DirectSum.lof R ℕ (fun i => ↥((ι R : M →ₗ[_] _).range ^ i)) 1 ∘ₗ
    (ι R).codRestrict _ fun m => by simpa only [pow_one] using LinearMap.mem_range_self _ m
#align exterior_algebra.graded_algebra.ι ExteriorAlgebra.GradedAlgebra.ι

theorem GradedAlgebra.ι_apply (m : M) :
    GradedAlgebra.ι R M m =
      DirectSum.of (fun i => ↥((ι R : M →ₗ[_] _).range ^ i)) 1
        ⟨ι R m, by simpa only [pow_one] using LinearMap.mem_range_self _ m⟩ :=
  rfl
#align exterior_algebra.graded_algebra.ι_apply ExteriorAlgebra.GradedAlgebra.ι_apply

theorem GradedAlgebra.ι_sq_zero (m : M) : GradedAlgebra.ι R M m * GradedAlgebra.ι R M m = 0 :=
  by
  rw [graded_algebra.ι_apply, DirectSum.of_mul_of]
  refine' dfinsupp.single_eq_zero.mpr (Subtype.ext <| ι_sq_zero _)
#align exterior_algebra.graded_algebra.ι_sq_zero ExteriorAlgebra.GradedAlgebra.ι_sq_zero

/-- `exterior_algebra.graded_algebra.ι` lifted to exterior algebra. This is
primarily an auxiliary construction used to provide `exterior_algebra.graded_algebra`. -/
def GradedAlgebra.liftι :
    ExteriorAlgebra R M →ₐ[R] ⨁ i : ℕ, ↥((ι R).range ^ i : Submodule R (ExteriorAlgebra R M)) :=
  lift R ⟨by apply graded_algebra.ι R M, GradedAlgebra.ι_sq_zero R M⟩
#align exterior_algebra.graded_algebra.lift_ι ExteriorAlgebra.GradedAlgebra.liftι

variable (R M)

theorem GradedAlgebra.liftι_eq (i : ℕ)
    (x : ((ι R : M →ₗ[R] ExteriorAlgebra R M).range ^ i : Submodule R (ExteriorAlgebra R M))) :
    GradedAlgebra.liftι R M x =
      DirectSum.of (fun i => ↥((ι R).range ^ i : Submodule R (ExteriorAlgebra R M))) i x :=
  by
  cases' x with x hx
  dsimp only [Subtype.coe_mk, DirectSum.lof_eq_of]
  refine'
    Submodule.pow_induction_on_left' _ (fun r => _) (fun x y i hx hy ihx ihy => _)
      (fun m hm i x hx ih => _) hx
  · rw [AlgHom.commutes, DirectSum.algebraMap_apply]
    rfl
  · rw [AlgHom.map_add, ihx, ihy, ← map_add]
    rfl
  · obtain ⟨_, rfl⟩ := hm
    rw [AlgHom.map_mul, ih, graded_algebra.lift_ι, lift_ι_apply, graded_algebra.ι_apply R M,
      DirectSum.of_mul_of]
    exact DirectSum.of_eq_of_gradedMonoid_eq (Sigma.subtype_ext (add_comm _ _) rfl)
#align exterior_algebra.graded_algebra.lift_ι_eq ExteriorAlgebra.GradedAlgebra.liftι_eq

/-- The exterior algebra is graded by the powers of the submodule `(exterior_algebra.ι R).range`. -/
instance gradedAlgebra :
    GradedAlgebra ((· ^ ·) (ι R : M →ₗ[R] ExteriorAlgebra R M).range : ℕ → Submodule R _) :=
  GradedAlgebra.ofAlgHom _
    (-- while not necessary, the `by apply` makes this elaborate faster
    by apply graded_algebra.lift_ι R M)
    (-- the proof from here onward is identical to the `tensor_algebra` case
    by
      ext m
      dsimp only [LinearMap.comp_apply, AlgHom.toLinearMap_apply, AlgHom.comp_apply,
        AlgHom.id_apply, graded_algebra.lift_ι]
      rw [lift_ι_apply, graded_algebra.ι_apply R M, DirectSum.coeAlgHom_of, Subtype.coe_mk])
    (by apply graded_algebra.lift_ι_eq R M)
#align exterior_algebra.graded_algebra ExteriorAlgebra.gradedAlgebra

end ExteriorAlgebra


import tactic
import topology.basic topology.path_connected
import lemmas

open classical unit_interval path
open_locale classical unit_interval filter topological_space
noncomputable theory

universes u v w

namespace based

variables (X : Type u) [topological_space X] (x : X)

def loop_space := path x x

structure homotopy (p q : loop_space X x) :=
(to_fun  : I × I → X)
(contin  : continuous to_fun)
(source' : ∀ t, to_fun ⟨0 , t⟩ = x)
(target' : ∀ t, to_fun ⟨1 , t⟩ = x )
(left'   : ∀ y, to_fun ⟨y , 0⟩ = p.to_fun y)
(right'  : ∀ y, to_fun ⟨y , 1⟩ = q.to_fun y)

def in_homotopy : loop_space X x → loop_space X x → Prop := λ p q, nonempty (homotopy X x p q)

variables p q r : loop_space X x

def trivial_homotopy : homotopy X x p p :=
{ to_fun  := p.to_fun ∘ prod.fst,
  contin  := continuous.comp (p.continuous') (continuous_fst),
  source' := λ _, p.source',
  target' := λ _, p.target',
  left'   := λ _, rfl,
  right'  := λ _, rfl }

def inverse_homotopy (h : homotopy X x q p) : homotopy X x p q :=
{ to_fun  := h.to_fun ∘ (λ i, ⟨id i.1, σ i.2⟩),
  contin  := continuous.comp (h.contin) (continuous.prod_map (continuous_id) (continuous_symm)),
  source' := λ _, h.source' _,
  target' := λ _, h.target' _,
  left'   := λ _, by simp [h.right'],
  right'  := λ _, by simp [h.left'] }

def coe_I_Icc02 : ↥I × ↥I → ↥I × ↥(I ∪ (set.Icc (1 : ℝ) 2)) := λ i, ⟨i.1 , ⟨i.2 , or.inl i.2.2⟩⟩

instance : has_coe (↥I × ↥I) (↥I × ↥(I ∪ (set.Icc (1 : ℝ) 2))) := { coe := coe_I_Icc02 }

def third_fun1 (h : homotopy X x p r) : Π (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)), (ij.2 ≤ 1) → X := λ ij h', h.to_fun ⟨ij.1 , ⟨ij.2 , and.intro ij.2.2.1 h'⟩⟩

#check add_neg_le_add_neg_iff

def zero_le_sub_one_of_not_le_one (j : ℝ) (h : ¬ j ≤ 1) : 0 ≤ j - 1 :=
begin
  rw sub_eq_add_neg,
  rw ← (sub_zero (0 : ℝ)),
  rw sub_eq_add_neg,
  rw add_neg_le_add_neg_iff,
  rw add_zero,
  rw zero_add,
  linarith,
end

def sub_one_le_one_of_le_two (j : ℝ) (h : j ≤ 2) : j - 1 ≤ 1 :=
begin
  rw sub_eq_add_neg,
  linarith,
end

def zero_le_sub_one_of_one_le (j : ℝ) (h : 1 ≤ j) : 0 ≤ j - 1 :=
begin
  rw sub_eq_add_neg,
  linarith,
end

def third_fun2 (g : homotopy X x r q) : Π (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)), (¬ ij.2 ≤ 1) → X :=
λ ij h', g.to_fun ⟨ij.1 , ⟨ij.2 - 1 , and.intro (zero_le_sub_one_of_not_le_one _ h') (sub_one_le_one_of_le_two ij.2 ij.2.2.2)⟩⟩

def third_fun (h : homotopy X x p r) (g : homotopy X x r q) :
↥I × ↥(set.Icc (0 : ℝ) 2) → X := λ ij, dite (ij.2 ≤ 1) (third_fun1 X x p r h ij)
                                                       (third_fun2 X x q r g ij)

lemma third_fun1_contin (h : homotopy X x p r) : continuous (third_fun1 X x p r h : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2)| ij.2 ≤ 1} → X)
:= continuous.comp (h.contin) (by continuity)

lemma third_fun2_contin (g : homotopy X x r q) : continuous (third_fun2 X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | ¬ ij.2 ≤ 1} → X)
:= continuous.comp (g.contin) (by continuity)

@[simp, norm_cast] lemma coe_one_two (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (H : ij.2 = 1) : (ij.2 : ℝ) = 1 :=
begin
  rw H,
  split,
end

lemma third_fun1_eq (h : homotopy X x p r) (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : ij.2 ≤ 1) : third_fun1 X x p r h ij hij = h.to_fun ⟨ij.1 , ⟨ij.2 , and.intro ij.2.2.1 hij⟩⟩ :=
rfl

lemma third_fun2_eq (g : homotopy X x r q) (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : ¬ ij.2 ≤ 1) : third_fun2 X x q r g ij hij = g.to_fun ⟨ij.1 , ⟨ij.2 - 1 , and.intro (zero_le_sub_one_of_not_le_one _ hij) (sub_one_le_one_of_le_two ij.2 ij.2.2.2)⟩⟩ :=
rfl

lemma third_fun1_eq_at_one (h : homotopy X x p r) (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : ij.2 ≤ 1) (H : ij.2 = 1) :
(third_fun1 X x p r h ij hij) = r.to_fun ij.1 :=
begin
  transitivity,
  rw third_fun1_eq,
  simp only [H],
  simp,
  rw h.right',
end

def aux_third_fun (g : homotopy X x r q) : Π (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)), (1 ≤ ij.2) → X :=
λ ij h', g.to_fun (ij.1 , ⟨ij.2 - 1 , and.intro (zero_le_sub_one_of_one_le _ h') (sub_one_le_one_of_le_two _ ij.2.2.2)⟩)

lemma aux_third_fun_contin (g : homotopy X x r q) : continuous (aux_third_fun X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2)| 1 ≤ ij.2} → X) :=
continuous.comp (g.contin) (by continuity)

lemma third_fun2_eq_aux (g : homotopy X x r q) (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : ¬ ij.2 ≤ 1) (hij' : 1 ≤ ij.2): third_fun2 X x q r g ij hij = aux_third_fun X x q r g ij hij' := rfl

lemma aux_third_fun_eq (g : homotopy X x r q) (ij  : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : 1 ≤ ij.2) : aux_third_fun X x q r g ij hij = g.to_fun ⟨ij.1 , ⟨ij.2 - 1 , and.intro (zero_le_sub_one_of_one_le _ hij) (sub_one_le_one_of_le_two _ ij.2.2.2)⟩⟩ := rfl

lemma third_fun2_eq_aux2 (g : homotopy X x r q) (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : ¬ ij.2 ≤ 1) : third_fun2 X x q r g ij hij = aux_third_fun X x q r g ij (le_of_not_le hij) := rfl

lemma aux_third_fun_eq_at_one (g : homotopy X x r q) (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)) (hij : 1 ≤ ij.2) (H : ij.2 = 1) :
(aux_third_fun X x q r g ij hij) = r.to_fun ij.1 :=
begin
  rw aux_third_fun_eq,
  simp [H],
  rw g.left',
end

lemma third_fun2_aux_preimage_agree (g : homotopy X x r q) (s : set X) : (↑((third_fun2 X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | ¬ ij.2 ≤ 1} → X) ⁻¹' s) : set (↥I × ↥(set.Icc (0 : ℝ) 2)))
                                                                       = ↑((aux_third_fun X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | 1 ≤ ij.2} → X) ⁻¹' s) \ {ij | ij.2 = 1} :=
begin
  ext,
  split,
  rename x_1 i,
  intro hi,
  cases hi with hi2 hi,
  split,
  split,
  swap,
  apply set.mem_def.2,
  apply le_of_not_le,
  apply (@set.mem_def _ i _).1,
  exact hi2,
  apply (@set.mem_preimage _ _ (aux_third_fun X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | 1 ≤ ij.2} → X) s ⟨i , _⟩).2,
  rw coe_pi_fun_eq,
  rw ← third_fun2_eq_aux,
  have H := (@set.mem_preimage _ _ (third_fun2 X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | ¬ ij.2 ≤ 1} → X) s ⟨i , hi2⟩).1 hi,
  use H,
  apply (@set.mem_def _ i _).2,
  intro H,
  apply set.mem_def.2 hi2,
  apply le_of_eq,
  exact set.mem_def.2 H,
  rename x_1 i,
  intro hi,
  cases hi with hi1 hi2,
  split,
  apply (@set.mem_preimage _ _ (third_fun2 X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | ¬ ij.2 ≤ 1} → X) s ⟨i , _⟩).2,
  rw coe_pi_fun_eq,
  rw third_fun2_eq_aux,
  cases hi1 with hi hi1,
  have H := (@set.mem_preimage _ _ (aux_third_fun X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2) | 1 ≤ ij.2} → X) s ⟨i , _⟩).1 hi1,
  use H,
  cases hi1 with hi hi1,
  use hi,
  cases hi1 with hi1 hi,
  apply set.mem_def.2,
  simp,
  apply lt_of_le_of_ne,
  use hi1,
  simp at hi2,
  symmetry,
  exact hi2,
end

lemma third_frontier1 (h : homotopy X x p r) (g : homotopy X x r q) :
∀ (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)),
ij ∈ frontier {jk : ↥I × ↥(set.Icc (0 : ℝ) 2) | jk.2 ≤ 1} →
∀ (H : ¬ ij.2 ≤ 1),
filter.tendsto (third_fun1 X x p r h : {jk : ↥I × ↥(set.Icc (0 : ℝ) 2) | jk.2 ≤ 1} → X)
               ↑(𝓝 ij)
               (𝓝 ((third_fun2 X x q r g) ij H)) :=
begin
  intros ij hij H,
  apply filter.tendsto_def.2,
  intros s hs,
  have H' := front_single ij hij,
  by_contra,
  apply H,
  apply le_of_eq,
  exact H',
end

lemma third_frontier2 (h : homotopy X x p r) (g : homotopy X x r q) :
∀ (ij : ↥I × ↥(set.Icc (0 : ℝ) 2)),
ij ∈ frontier {jk : ↥I × ↥(set.Icc (0 : ℝ) 2) | jk.2 ≤ 1} →
∀ (H : ij.2 ≤ 1),
filter.tendsto (third_fun2 X x q r g : {jk : ↥I × ↥(set.Icc (0 : ℝ) 2) | ¬ jk.2 ≤ 1} → X)
               ↑(𝓝 ij)
               (𝓝 ((third_fun1 X x p r h) ij H)) :=
begin
  intros ij hij H,
  apply filter.tendsto_def.2,
  intros s hs,
  have H' := front_single ij hij,
  rw (third_fun1_eq_at_one X x p r h ij H H') at hs,
  rw ← (aux_third_fun_eq_at_one X x q r g ij _ H') at hs,
  swap,
  apply le_of_eq,
  symmetry,
  exact H',
  rw ← (@coe_pi_fun_eq _ _ _ (aux_third_fun X x q r g) _ _) at hs,
  have aux_H := continuous.continuous_at (aux_third_fun_contin X x q r g),
  swap,
  split,
  apply le_of_eq,
  symmetry,
  exact H',
  have aux_H' := continuous_at.preimage_mem_nhds aux_H hs,
  rw nhds_subtype_eq_comap at aux_H',
  rcases aux_H' with ⟨U , hU1 , hU2⟩,
  split,
  swap,
  exact U ∪ (↑((third_fun2 X x q r g : {ij : ↥I × ↥(set.Icc (0 : ℝ) 2)| ¬ ij.2 ≤ 1} → X) ⁻¹' s) : set (↥I × ↥(set.Icc (0 : ℝ) 2))),
  split,
  apply (𝓝 ij).sets_of_superset,
  exact hU1,
  intros a ha,
  left,
  exact ha,
  ext,
  rename x_1 jk,
  split,
  intro hjk,
  cases hjk with hjk1 hjk2,
  split,
  exact hjk1,
  right,
  split,
  exact hjk2,
  intro hjk,
  cases hjk with hjk1 hjk2,
  cases hjk2,
  rw third_fun2_aux_preimage_agree,
  split,
  split,
  apply hU2,
  use hjk2,
  apply set.mem_def.2,
  by_contra,
  apply hjk1,
  apply le_of_not_le,
  use h,
  simp,
  intro H,
  apply hjk1,
  apply le_of_eq,
  exact H,
  exact hjk2,
end

lemma third_contin (h : homotopy X x p r)
                   (g : homotopy X x r q) :
continuous (third_fun X x p q r h g) :=
continuous_dif (↥I × ↥(set.Icc (0 : ℝ) 2)) X (_)
               (third_fun1 X x p r h) (third_fun2 X x q r g)
               (third_fun1_contin X x p r h) (third_fun2_contin X x q r g)
               (third_frontier1 X x p q r h g) (third_frontier2 X x p q r h g)

def third_homotopy (h : homotopy X x p r) (g : homotopy X x r q) : homotopy X x p q :=
{ to_fun  := third_fun X x p q r h g ∘ (prod.map id (Icc_homeo_I (0 : ℝ) 2 (by linarith)).symm),
  contin  := continuous.comp (third_contin X x p q r h g) (continuous.prod_map continuous_id (Icc_homeo_I (0 : ℝ) 2 (by linarith)).continuous_inv_fun),
  source' := λ t,
  begin
    rename h hom,
    simp,
    have H := Icc_homeo_I_symm_apply_coe (0 : ℝ) 2 (by linarith) t,
    rw sub_zero at H,
    rw add_zero at H,
    have H' : (((Icc_homeo_I (0 : ℝ) 2 (by linarith)).symm t) : set.Icc (0 : ℝ) 2) = ⟨2 * t , _⟩,
    ext,
    exact H,
    rw H',
    by_cases ((⟨0 , ⟨2 * t , _⟩⟩ : ↥I × ↥(set.Icc (0 : ℝ) 2)).2 ≤ 1),
    rw third_fun,
    simp [h],
    rw third_fun1_eq,
    simp,
    exact hom.source' _,
    split,
    apply (zero_le_mul_left _).2,
    exact t.2.1,
    linarith,
    conv_rhs { rw ← (mul_one (2 : ℝ)) },
    apply mul_le_mul,
    linarith,
    exact t.2.2,
    exact t.2.1,
    linarith,
    split,
    apply (zero_le_mul_left _).2,
    exact t.2.1,
    linarith,
    conv_rhs { rw ← (mul_one (2 : ℝ)) },
    apply mul_le_mul,
    linarith,
    exact t.2.2,
    exact t.2.1,
    linarith,
    rw third_fun,
    simp [h],
    rw third_fun2_eq,
    simp,
    exact g.source' _,
  end,
  target' := λ t,
  begin
    have H'' : (2 * ↑t : ℝ) ∈ set.Icc (0 : ℝ) 2,
    split,
    apply (zero_le_mul_left _).2,
    exact t.2.1,
    linarith,
    conv_rhs { rw ← (mul_one (2 : ℝ)) },
    apply mul_le_mul,
    linarith,
    exact t.2.2,
    exact t.2.1,
    linarith,
    rename h hom,
    simp,
    have H := Icc_homeo_I_symm_apply_coe (0 : ℝ) 2 (by linarith) t,
    rw sub_zero at H,
    rw add_zero at H,
    have H' : (((Icc_homeo_I (0 : ℝ) 2 (by linarith)).symm t) : set.Icc (0 : ℝ) 2) = ⟨2 * t , H''⟩,
    ext,
    exact H,
    rw H',
    by_cases ((⟨1 , ⟨2 * t , H''⟩⟩ : ↥I × ↥(set.Icc (0 : ℝ) 2)).2 ≤ 1),
    rw third_fun,
    simp [h],
    rw third_fun1_eq,
    simp,
    exact hom.target' _,
    rw third_fun,
    simp [h],
    rw third_fun2_eq,
    simp,
    exact g.target' _,
  end,
  left'   := λ y,
  begin
    simp,
    have H := Icc_homeo_I_symm_apply_coe (0 : ℝ) 2 (by linarith) 0,
    rw sub_zero at H,
    rw add_zero at H,
    simp only [mul_zero, unit_interval.coe_zero] at H,
    have H' : (((Icc_homeo_I (0 : ℝ) 2 (by linarith)).symm 0) : set.Icc (0 : ℝ) 2) = 0,
    ext,
    exact H,
    rw H',
    have H'' : (0 : set.Icc (0 : ℝ) 2) ≤ 1,
    apply subtype.mk_le_mk.2,
    linarith,
    rw third_fun,
    simp [H''],
    rw third_fun1_eq,
    simp,
    exact h.left' _,
  end,
  right'  := λ y,
  begin
    simp,
    have H := Icc_homeo_I_symm_apply_coe (0 : ℝ) 2 (by linarith) 1,
    rw sub_zero at H,
    rw add_zero at H,
    simp only [mul_one, unit_interval.coe_one] at H,
    have H' : (((Icc_homeo_I (0 : ℝ) 2 (by linarith)).symm 1) : set.Icc (0 : ℝ) 2) = two,
    ext,
    exact H,
    rw H',
    have H'' : ¬ (two : set.Icc (0 : ℝ) 2) ≤ 1,
    intro Ha,
    have Ha' := subtype.mk_le_mk.1 Ha,
    linarith,
    rw third_fun,
    simp [H''],
    rw third_fun2_eq,
    simp,
    rw two_sub_one,
    exact g.right' _,
  end }

instance : inhabited (homotopy X x p p) := { default := trivial_homotopy X x p }

instance third_inhabited (h : inhabited (homotopy X x p r)) (g : inhabited (homotopy X x r q)) : inhabited (homotopy X x p q) :=
{ default := third_homotopy X x p q r h.default g.default }

instance inhabited_if_opp_inhabited (h : inhabited (homotopy X x q p)) : inhabited (homotopy X x p q) :=
{ default := inverse_homotopy X x p q h.default }

def in_hom_reflx : reflexive (in_homotopy X x) := λ p, nonempty_of_inhabited

def in_hom_symm  : symmetric (in_homotopy X x) := λ p q, assume h' : in_homotopy X x p q,
                                                         have h : inhabited (homotopy X x p q) := inhabited_of_nonempty h',
                                                         @nonempty_of_inhabited (homotopy X x q p) (based.inhabited_if_opp_inhabited X x q p h)

def in_hom_trans : transitive (in_homotopy X x) := λ p r q h' g',
                                                     have h : inhabited (homotopy X x p r) := inhabited_of_nonempty h',
                                                     have g : inhabited (homotopy X x r q) := inhabited_of_nonempty g',
                                                     @nonempty_of_inhabited (homotopy X x p q) (based.third_inhabited X x p q r h g)

def loop_space_setoid : setoid (loop_space X x) :=
{ r     := in_homotopy X x,
  iseqv := and.intro (in_hom_reflx X x)
           (and.intro (in_hom_symm X x) (in_hom_trans X x)) }

def Fundamental_Group := quotient (loop_space_setoid X x)

end based


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

namespace classical
universes u v

/- the axiom -/
axiom choice {α : Sort u} : nonempty α → α

@[irreducible] noncomputable def indefinite_description {α : Sort u} (p : α → Prop)
  (h : ∃ x, p x) : {x // p x} :=
choice $ let ⟨x, px⟩ := h in ⟨⟨x, px⟩⟩

noncomputable def some {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : α :=
(indefinite_description p h).val

theorem some_spec {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : p (some h) :=
(indefinite_description p h).property

/- Diaconescu's theorem: using function extensionality and propositional extensionality,
   we can get excluded middle from this. -/
section diaconescu
parameter  p : Prop

private def U (x : Prop) : Prop := x = true ∨ p
private def V (x : Prop) : Prop := x = false ∨ p

private lemma exU : ∃ x, U x := ⟨true, or.inl rfl⟩
private

/- TODO(Leo): check why the code generator is not ignoring (some exU)
   when we mark u as def. -/
private lemma u : Prop := some exU
private lemma v : Prop := some exV

set_option type_context.unfold_lemmas true
private lemma u_def : U u := some_spec exU
private lemma v_def : V v := some_spec exV

private lemma not_uv_or_p : u ≠ v ∨ p :=
or.elim u_def
  (assume hut : u = true,
    or.elim v_def
      (assume hvf : v = false,
        have hne : u ≠ v, from hvf.symm ▸ hut.symm ▸ true_ne_false,
        or.inl hne)
      or.inr)
  or.inr

private lemma p_implies_uv (hp : p) : u = v :=
have hpred : U = V, from
  funext (assume x : Prop,
    have hl : (x = true ∨ p) → (x = false ∨ p), from
      assume a, or.inr hp,
    have hr : (x = false ∨ p) → (x = true ∨ p), from
      assume a, or.inr hp,
    show (x = true ∨ p) = (x = false ∨ p), from
      propext (iff.intro hl hr)),
have h₀ : ∀ exU exV,
    @some _ U exU = @some _ V exV,
  from hpred ▸ λ exU exV, rfl,
show u = v, from h₀ _ _

theorem em : p ∨ ¬p :=
or.elim not_uv_or_p
  (assume hne : u ≠ v, or.inr (mt p_implies_uv hne))
  or.inl
end diaconescu

theorem exists_true_of_nonempty {α : Sort u} : nonempty α → ∃ x : α, true
| ⟨x⟩ := ⟨x, trivial⟩

noncomputable def inhabited_of_nonempty {α : Sort u} (h : nonempty α) : inhabited α :=
⟨choice h⟩

noncomputable def inhabited_of_exists {α : Sort u} {p : α → Prop} (h : ∃ x, p x) :
  inhabited α :=
inhabited_of_nonempty (exists.elim h (λ w hw, ⟨w⟩))

/- all propositions are decidable -/
noncomputable def prop_decidable (a : Prop) : decidable a :=
choice $ or.elim (em a)
  (assume ha, ⟨is_true ha⟩)
  (assume hna, ⟨is_false hna⟩)
local attribute [instance] prop_decidable

noncomputable def decidable_inhabited (a : Prop) : inhabited (decidable a) :=
⟨prop_decidable a⟩
local attribute [instance] decidable_inhabited

noncomputable def type_decidable_eq (α : Sort u) : decidable_eq α :=
λ x y, prop_decidable (x = y)

noncomputable def type_decidable (α : Sort u) : psum α (α → false) :=
match (prop_decidable (nonempty α)) with
| (is_true hp)  := psum.inl (@inhabited.default _ (inhabited_of_nonempty hp))
| (is_false hn) := psum.inr (λ a, absurd (nonempty.intro a) hn)
end

@[irreducible] noncomputable def strong_indefinite_description {α : Sort u} (p : α → Prop)
  (h : nonempty α) : {x : α // (∃ y : α, p y) → p x} :=
if hp : ∃ x : α, p x then
  let xp := indefinite_description _ hp in
  ⟨xp.val, λ h', xp.property⟩
else ⟨choice h, λ h, absurd h hp⟩

/- the Hilbert epsilon function -/

noncomputable def epsilon {α : Sort u} [h : nonempty α] (p : α → Prop) : α :=
(strong_indefinite_description p h).val

theorem epsilon_spec_aux {α : Sort u} (h : nonempty α) (p : α → Prop)
  : (∃ y, p y) → p (@epsilon α h p) :=
(strong_indefinite_description p h).property

theorem epsilon_spec {α : Sort u} {p : α → Prop} (hex : ∃ y, p y) :
    p (@epsilon α (nonempty_of_exists hex) p) :=
epsilon_spec_aux (nonempty_of_exists hex) p hex

theorem epsilon_singleton {α : Sort u} (x : α) : @epsilon α ⟨x⟩ (λ y, y = x) = x :=
@epsilon_spec α (λ y, y = x) ⟨x, rfl⟩

/- the axiom of choice -/

theorem axiom_of_choice {α : Sort u} {β : α → Sort v} {r : Π x, β x → Prop} (h : ∀ x, ∃ y, r x y) :
  ∃ (f : Π x, β x), ∀ x, r x (f x) :=
⟨_, λ x, some_spec (h x)⟩

theorem skolem {α : Sort u} {b : α → Sort v} {p : Π x, b x → Prop} :
  (∀ x, ∃ y, p x y) ↔ ∃ (f : Π x, b x), ∀ x, p x (f x) :=
⟨axiom_of_choice, λ ⟨f, hw⟩ x, ⟨f x, hw x⟩⟩

theorem prop_complete (a : Prop) : a = true ∨ a = false :=
or.elim (em a)
  (λ t, or.inl (eq_true_intro t))
  (λ f, or.inr (eq_false_intro f))

section aux
attribute [elab_as_eliminator]
theorem cases_true_false (p : Prop → Prop) (h1 : p true) (h2 : p false) (a : Prop) : p a :=
or.elim (prop_complete a)
  (assume ht : a = true,  ht.symm ▸ h1)
  (assume hf : a = false, hf.symm ▸ h2)

theorem cases_on (a : Prop) {p : Prop → Prop} (h1 : p true) (h2 : p false) : p a :=
cases_true_false p h1 h2 a

-- this supercedes by_cases in decidable
lemma by_cases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
decidable.by_cases hpq hnpq

-- this supercedes by_contradiction in decidable
theorem by_contradiction {p : Prop} (h : ¬p → false) : p :=
decidable.by_contradiction h

theorem eq_false_or_eq_true (a : Prop) : a = false ∨ a = true :=
(prop_complete a).symm
end aux

end classical


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

import linear_algebra.multilinear
import linear_algebra.linear_independent
import group_theory.perm.sign
import group_theory.perm.subgroup
import data.equiv.fin
import linear_algebra.tensor_product
import group_theory.quotient_group

/-!
# Alternating Maps

We construct the bundled function `alternating_map`, which extends `multilinear_map` with all the
arguments of the same type.

## Main definitions
* `alternating_map R M N ι` is the space of `R`-linear alternating maps from `ι → M` to `N`.
* `f.map_eq_zero_of_eq` expresses that `f` is zero when two inputs are equal.
* `f.map_swap` expresses that `f` is negated when two inputs are swapped.
* `f.map_perm` expresses how `f` varies by a sign change under a permutation of its inputs.
* An `add_comm_monoid`, `add_comm_group`, and `module` structure over `alternating_map`s that
  matches the definitions over `multilinear_map`s.
* `multilinear_map.alternatization`, which makes an alternating map out of a non-alternating one.
* `alternating_map.dom_coprod`, which behaves as a product between two alternating maps.

## Implementation notes
`alternating_map` is defined in terms of `map_eq_zero_of_eq`, as this is easier to work with than
using `map_swap` as a definition, and does not require `has_neg N`.

`alternating_map`s are provided with a coercion to `multilinear_map`, along with a set of
`norm_cast` lemmas that act on the algebraic structure:

* `alternating_map.coe_add`
* `alternating_map.coe_zero`
* `alternating_map.coe_sub`
* `alternating_map.coe_neg`
* `alternating_map.coe_smul`
-/

-- semiring / add_comm_monoid
variables {R : Type*} [semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]

-- semiring / add_comm_group
variables {M' : Type*} [add_comm_group M'] [module R M']
variables {N' : Type*} [add_comm_group N'] [module R N']

variables {ι : Type*} [decidable_eq ι]

set_option old_structure_cmd true

section
variables (R M N ι)
/--
An alternating map is a multilinear map that vanishes when two of its arguments are equal.
-/
structure alternating_map extends multilinear_map R (λ i : ι, M) N :=
(map_eq_zero_of_eq' : ∀ (v : ι → M) (i j : ι) (h : v i = v j) (hij : i ≠ j), to_fun v = 0)
end

/-- The multilinear map associated to an alternating map -/
add_decl_doc alternating_map.to_multilinear_map

namespace alternating_map

variables (f f' : alternating_map R M N ι)
variables (g g₂ : alternating_map R M N' ι)
variables (g' : alternating_map R M' N' ι)
variables (v : ι → M) (v' : ι → M')
open function

/-! Basic coercion simp lemmas, largely copied from `ring_hom` and `multilinear_map` -/
section coercions

instance : has_coe_to_fun (alternating_map R M N ι) := ⟨_, λ x, x.to_fun⟩

initialize_simps_projections alternating_map (to_fun → apply)

@[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl

@[simp] lemma coe_mk (f : (ι → M) → N) (h₁ h₂ h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ :
  alternating_map R M N ι) = f := rfl

theorem congr_fun {f g : alternating_map R M N ι} (h : f = g) (x : ι → M) : f x = g x :=
congr_arg (λ h : alternating_map R M N ι, h x) h

theorem congr_arg (f : alternating_map R M N ι) {x y : ι → M} (h : x = y) : f x = f y :=
congr_arg (λ x : ι → M, f x) h

theorem coe_inj ⦃f g : alternating_map R M N ι⦄ (h : ⇑f = g) : f = g :=
by { cases f, cases g, cases h, refl }

@[ext] theorem ext {f f' : alternating_map R M N ι} (H : ∀ x, f x = f' x) : f = f' :=
coe_inj (funext H)

theorem ext_iff {f g : alternating_map R M N ι} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

instance : has_coe (alternating_map R M N ι) (multilinear_map R (λ i : ι, M) N) :=
⟨λ x, x.to_multilinear_map⟩

@[simp, norm_cast] lemma coe_multilinear_map : ⇑(f : multilinear_map R (λ i : ι, M) N) = f := rfl

lemma coe_multilinear_map_injective :
  function.injective (coe : alternating_map R M N ι → multilinear_map R (λ i : ι, M) N) :=
λ x y h, ext $ multilinear_map.congr_fun h

@[simp] lemma to_multilinear_map_eq_coe : f.to_multilinear_map = f := rfl

@[simp] lemma coe_multilinear_map_mk (f : (ι → M) → N) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : alternating_map R M N ι) :  multilinear_map R (λ i : ι, M) N) = ⟨f, h₁, h₂⟩ :=
rfl

end coercions

/-!
### Simp-normal forms of the structure fields

These are expressed in terms of `⇑f` instead of `f.to_fun`.
-/
@[simp] lemma map_add (i : ι) (x y : M) :
  f (update v i (x + y)) = f (update v i x) + f (update v i y) :=
f.to_multilinear_map.map_add' v i x y

@[simp] lemma map_sub (i : ι) (x y : M') :
  g' (update v' i (x - y)) = g' (update v' i x) - g' (update v' i y) :=
g'.to_multilinear_map.map_sub v' i x y

@[simp] lemma map_neg (i : ι) (x : M') :
  g' (update v' i (-x)) = -g' (update v' i x) :=
g'.to_multilinear_map.map_neg v' i x

@[simp] lemma map_smul (i : ι) (r : R) (x : M) :
  f (update v i (r • x)) = r • f (update v i x) :=
f.to_multilinear_map.map_smul' v i r x

@[simp] lemma map_eq_zero_of_eq (v : ι → M) {i j : ι} (h : v i = v j) (hij : i ≠ j) :
  f v = 0 :=
f.map_eq_zero_of_eq' v i j h hij

@[simp] lemma map_update_zero (m : ι → M) (i : ι) : f (update m i 0) = 0 :=
f.to_multilinear_map.map_update_zero m i

@[simp] lemma map_zero [nonempty ι] : f 0 = 0 :=
f.to_multilinear_map.map_zero

/-!
### Algebraic structure inherited from `multilinear_map`

`alternating_map` carries the same `add_comm_monoid`, `add_comm_group`, and `module` structure
as `multilinear_map`
-/

instance : has_add (alternating_map R M N ι) :=
⟨λ a b,
  { map_eq_zero_of_eq' :=
      λ v i j h hij, by simp [a.map_eq_zero_of_eq v h hij, b.map_eq_zero_of_eq v h hij],
    ..(a + b : multilinear_map R (λ i : ι, M) N)}⟩

@[simp] lemma add_apply : (f + f') v = f v + f' v := rfl

@[norm_cast] lemma coe_add : (↑(f  + f') : multilinear_map R (λ i : ι, M) N) = f + f' := rfl

instance : has_zero (alternating_map R M N ι) :=
⟨{map_eq_zero_of_eq' := λ v i j h hij, by simp,
  ..(0 : multilinear_map R (λ i : ι, M) N)}⟩

@[simp] lemma zero_apply : (0 : alternating_map R M N ι) v = 0 := rfl

@[norm_cast] lemma coe_zero :
  ((0 : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N) = 0 := rfl

instance : inhabited (alternating_map R M N ι) := ⟨0⟩

instance : add_comm_monoid (alternating_map R M N ι) :=
{ zero := 0,
  add := (+),
  zero_add := by intros; ext; simp [add_comm, add_left_comm],
  add_zero := by intros; ext; simp [add_comm, add_left_comm],
  add_comm := by intros; ext; simp [add_comm, add_left_comm],
  add_assoc := by intros; ext; simp [add_comm, add_left_comm],
  nsmul := λ n f, { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    .. ((n • f : multilinear_map R (λ i : ι, M) N)) },
  nsmul_zero' := by { intros, ext, simp [add_smul], },
  nsmul_succ' := by { intros, ext, simp [add_smul, nat.succ_eq_one_add], } }

instance : has_neg (alternating_map R M N' ι) :=
⟨λ f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    ..(-(f : multilinear_map R (λ i : ι, M) N')) }⟩

@[simp] lemma neg_apply (m : ι → M) : (-g) m = -(g m) := rfl

@[norm_cast] lemma coe_neg :
  ((-g : alternating_map R M N' ι) : multilinear_map R (λ i : ι, M) N') = -g := rfl

instance : has_sub (alternating_map R M N' ι) :=
⟨λ f g,
  { map_eq_zero_of_eq' :=
      λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij, g.map_eq_zero_of_eq v h hij],
    ..(f - g : multilinear_map R (λ i : ι, M) N')  }⟩

@[simp] lemma sub_apply (m : ι → M) : (g - g₂) m = g m - g₂ m := rfl

@[norm_cast] lemma coe_sub : (↑(g - g₂) : multilinear_map R (λ i : ι, M) N') = g - g₂ := rfl

instance : add_comm_group (alternating_map R M N' ι) :=
by refine
{ zero := 0,
  add := (+),
  neg := has_neg.neg,
  sub := has_sub.sub,
  sub_eq_add_neg := _,
  nsmul := λ n f, { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    .. ((n • f : multilinear_map R (λ i : ι, M) N')) },
  gsmul := λ n f, { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    .. ((n • f : multilinear_map R (λ i : ι, M) N')) },
  gsmul_zero' := _,
  gsmul_succ' := _,
  gsmul_neg' := _,
  .. alternating_map.add_comm_monoid, .. };
intros; ext;
simp [add_comm, add_left_comm, sub_eq_add_neg, add_smul, nat.succ_eq_add_one, gsmul_coe_nat]

section distrib_mul_action

variables {S : Type*} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N]

instance : has_scalar S (alternating_map R M N ι) :=
⟨λ c f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    ..((c • f : multilinear_map R (λ i : ι, M) N)) }⟩

@[simp] lemma smul_apply (c : S) (m : ι → M) :
  (c • f) m = c • f m := rfl

@[norm_cast] lemma coe_smul (c : S):
  ((c • f : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N) = c • f := rfl

instance : distrib_mul_action S (alternating_map R M N ι) :=
{ one_smul := λ f, ext $ λ x, one_smul _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul _ _ _,
  smul_zero := λ r, ext $ λ x, smul_zero _,
  smul_add := λ r f₁ f₂, ext $ λ x, smul_add _ _ _ }

end distrib_mul_action

section module

variables {S : Type*} [semiring S] [module S N] [smul_comm_class R S N]

/-- The space of multilinear maps over an algebra over `R` is a module over `R`, for the pointwise
addition and scalar multiplication. -/
instance : module S (alternating_map R M N ι) :=
{ add_smul := λ r₁ r₂ f, ext $ λ x, add_smul _ _ _,
  zero_smul := λ f, ext $ λ x, zero_smul _ _ }

end module

end alternating_map

/-!
### Composition with linear maps
-/

namespace linear_map

variables {N₂ : Type*} [add_comm_monoid N₂] [module R N₂]

/-- Composing a alternating map with a linear map gives again a alternating map. -/
def comp_alternating_map (g : N →ₗ[R] N₂) : alternating_map R M N ι →+ alternating_map R M N₂ ι :=
{ to_fun := λ f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
              ..(g.comp_multilinear_map (f : multilinear_map R (λ _ : ι, M) N)) },
  map_zero' := by { ext, simp },
  map_add' := λ a b, by { ext, simp } }

@[simp] lemma coe_comp_alternating_map (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) :
  ⇑(g.comp_alternating_map f) = g ∘ f := rfl

lemma comp_alternating_map_apply (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) (m : ι → M) :
  g.comp_alternating_map f m = g (f m) := rfl

end linear_map

namespace alternating_map

variables (f f' : alternating_map R M N ι)
variables (g g₂ : alternating_map R M N' ι)
variables (g' : alternating_map R M' N' ι)
variables (v : ι → M) (v' : ι → M')
open function

/-!
### Other lemmas from `multilinear_map`
-/
section

open_locale big_operators

lemma map_update_sum {α : Type*} (t : finset α) (i : ι) (g : α → M) (m : ι → M):
  f (update m i (∑ a in t, g a)) = ∑ a in t, f (update m i (g a)) :=
f.to_multilinear_map.map_update_sum t i g m

end

/-!
### Theorems specific to alternating maps

Various properties of reordered and repeated inputs which follow from
`alternating_map.map_eq_zero_of_eq`.
-/

lemma map_update_self {i j : ι} (hij : i ≠ j) :
  f (function.update v i (v j)) = 0 :=
f.map_eq_zero_of_eq _ (by rw [function.update_same, function.update_noteq hij.symm]) hij

lemma map_update_update {i j : ι} (hij : i ≠ j) (m : M) :
  f (function.update (function.update v i m) j m) = 0 :=
f.map_eq_zero_of_eq _
  (by rw [function.update_same, function.update_noteq hij, function.update_same]) hij

lemma map_swap_add {i j : ι} (hij : i ≠ j) :
  f (v ∘ equiv.swap i j) + f v = 0 :=
begin
  rw equiv.comp_swap_eq_update,
  convert f.map_update_update v hij (v i + v j),
  simp [f.map_update_self _ hij,
        f.map_update_self _ hij.symm,
        function.update_comm hij (v i + v j) (v _) v,
        function.update_comm hij.symm (v i) (v i) v],
end

lemma map_add_swap {i j : ι} (hij : i ≠ j) :
  f v + f (v ∘ equiv.swap i j) = 0 :=
by { rw add_comm, exact f.map_swap_add v hij }

lemma map_swap {i j : ι} (hij : i ≠ j) :
  g (v ∘ equiv.swap i j) = - g v  :=
eq_neg_of_add_eq_zero (g.map_swap_add v hij)

lemma map_perm [fintype ι] (v : ι → M) (σ : equiv.perm ι) :
  g (v ∘ σ) = (σ.sign : ℤ) • g v :=
begin
  apply equiv.perm.swap_induction_on' σ,
  { simp },
  { intros s x y hxy hI,
    simpa [g.map_swap (v ∘ s) hxy, equiv.perm.sign_swap hxy] using hI, }
end

lemma map_congr_perm [fintype ι] (σ : equiv.perm ι) :
  g v = (σ.sign : ℤ) • g (v ∘ σ) :=
by { rw [g.map_perm, smul_smul], simp }

lemma coe_dom_dom_congr [fintype ι] (σ : equiv.perm ι) :
  (g : multilinear_map R (λ _ : ι, M) N').dom_dom_congr σ
    = (σ.sign : ℤ) • (g : multilinear_map R (λ _ : ι, M) N') :=
multilinear_map.ext $ λ v, g.map_perm v σ

/-- If the arguments are linearly dependent then the result is `0`. -/
lemma map_linear_dependent
  {K : Type*} [ring K]
  {M : Type*} [add_comm_group M] [module K M]
  {N : Type*} [add_comm_group N] [module K N] [no_zero_smul_divisors K N]
  (f : alternating_map K M N ι) (v : ι → M)
  (h : ¬linear_independent K v) :
  f v = 0 :=
begin
  obtain ⟨s, g, h, i, hi, hz⟩ := linear_dependent_iff.mp h,
  suffices : f (update v i (g i • v i)) = 0,
  { rw [f.map_smul, function.update_eq_self, smul_eq_zero] at this,
    exact or.resolve_left this hz, },
  conv at h in (g _ • v _) { rw ←if_t_t (i = x) (g _ • v _), },
  rw [finset.sum_ite, finset.filter_eq, finset.filter_ne, if_pos hi, finset.sum_singleton,
    add_eq_zero_iff_eq_neg] at h,
  rw [h, f.map_neg, f.map_update_sum, neg_eq_zero, finset.sum_eq_zero],
  intros j hj,
  obtain ⟨hij, _⟩ := finset.mem_erase.mp hj,
  rw [f.map_smul, f.map_update_self _ hij.symm, smul_zero],
end

end alternating_map

open_locale big_operators

namespace multilinear_map

open equiv

variables [fintype ι]

private lemma alternization_map_eq_zero_of_eq_aux
  (m : multilinear_map R (λ i : ι, M) N')
  (v : ι → M) (i j : ι) (i_ne_j : i ≠ j) (hv : v i = v j) :
  (∑ (σ : perm ι), (σ.sign : ℤ) • m.dom_dom_congr σ) v = 0 :=
begin
  rw sum_apply,
  exact finset.sum_involution
    (λ σ _, swap i j * σ)
    (λ σ _, by simp [perm.sign_swap i_ne_j, apply_swap_eq_self hv])
    (λ σ _ _, (not_congr swap_mul_eq_iff).mpr i_ne_j)
    (λ σ _, finset.mem_univ _)
    (λ σ _, swap_mul_involutive i j σ)
end

/-- Produce an `alternating_map` out of a `multilinear_map`, by summing over all argument
permutations. -/
def alternatization : multilinear_map R (λ i : ι, M) N' →+ alternating_map R M N' ι :=
{ to_fun := λ m,
  { to_fun := ⇑(∑ (σ : perm ι), (σ.sign : ℤ) • m.dom_dom_congr σ),
    map_eq_zero_of_eq' := λ v i j hvij hij, alternization_map_eq_zero_of_eq_aux m v i j hij hvij,
    .. (∑ (σ : perm ι), (σ.sign : ℤ) • m.dom_dom_congr σ)},
  map_add' := λ a b, begin
    ext,
    simp only [
      finset.sum_add_distrib, smul_add, add_apply, dom_dom_congr_apply, alternating_map.add_apply,
      alternating_map.coe_mk, smul_apply, sum_apply],
  end,
  map_zero' := begin
    ext,
    simp only [
      finset.sum_const_zero, smul_zero, zero_apply, dom_dom_congr_apply, alternating_map.zero_apply,
      alternating_map.coe_mk, smul_apply, sum_apply],
  end }

lemma alternatization_def (m : multilinear_map R (λ i : ι, M) N') :
  ⇑(alternatization m) = (∑ (σ : perm ι), (σ.sign : ℤ) • m.dom_dom_congr σ : _) :=
rfl

lemma alternatization_coe (m : multilinear_map R (λ i : ι, M) N') :
  ↑m.alternatization = (∑ (σ : perm ι), (σ.sign : ℤ) • m.dom_dom_congr σ : _) :=
coe_inj rfl

lemma alternatization_apply (m : multilinear_map R (λ i : ι, M) N') (v : ι → M) :
  alternatization m v = ∑ (σ : perm ι), (σ.sign : ℤ) • m.dom_dom_congr σ v :=
by simp only [alternatization_def, smul_apply, sum_apply]

end multilinear_map

namespace alternating_map

/-- Alternatizing a multilinear map that is already alternating results in a scale factor of `n!`,
where `n` is the number of inputs. -/
lemma coe_alternatization [fintype ι] (a : alternating_map R M N' ι) :
  (↑a : multilinear_map R (λ ι, M) N').alternatization = nat.factorial (fintype.card ι) • a :=
begin
  apply alternating_map.coe_inj,
  simp_rw [multilinear_map.alternatization_def, coe_dom_dom_congr, smul_smul,
    int.units_coe_mul_self, one_smul, finset.sum_const, finset.card_univ, fintype.card_perm,
    ←coe_multilinear_map, coe_smul],
end

end alternating_map

namespace linear_map

variables {N'₂ : Type*} [add_comm_group N'₂] [module R N'₂] [fintype ι]

/-- Composition with a linear map before and after alternatization are equivalent. -/
lemma comp_multilinear_map_alternatization (g : N' →ₗ[R] N'₂)
  (f : multilinear_map R (λ _ : ι, M) N') :
  (g.comp_multilinear_map f).alternatization = g.comp_alternating_map (f.alternatization) :=
by { ext, simp [multilinear_map.alternatization_def] }

end linear_map

section coprod

open_locale big_operators
open_locale tensor_product

variables {ιa ιb : Type*} [decidable_eq ιa] [decidable_eq ιb] [fintype ιa] [fintype ιb]

variables
  {R' : Type*} {Mᵢ N₁ N₂ : Type*}
  [comm_semiring R']
  [add_comm_group N₁] [module R' N₁]
  [add_comm_group N₂] [module R' N₂]
  [add_comm_monoid Mᵢ] [module R' Mᵢ]

namespace equiv.perm

/-- Elements which are considered equivalent if they differ only by swaps within α or β  -/
abbreviation mod_sum_congr (α β : Type*) :=
quotient_group.quotient (equiv.perm.sum_congr_hom α β).range

lemma mod_sum_congr.swap_smul_involutive {α β : Type*} [decidable_eq (α ⊕ β)] (i j : α ⊕ β) :
  function.involutive (has_scalar.smul (equiv.swap i j) : mod_sum_congr α β → mod_sum_congr α β) :=
λ σ, begin
  apply σ.induction_on' (λ σ, _),
  exact _root_.congr_arg quotient.mk' (equiv.swap_mul_involutive i j σ)
end

end equiv.perm

namespace alternating_map
open equiv

/-- summand used in `alternating_map.dom_coprod` -/
def dom_coprod.summand
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb) :
  multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗[R'] N₂) :=
quotient.lift_on' σ
  (λ σ,
    (σ.sign : ℤ) •
      (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ)
  (λ σ₁ σ₂ ⟨⟨sl, sr⟩, h⟩, begin
    ext v,
    simp only [multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply,
      coe_multilinear_map, multilinear_map.smul_apply],
    replace h := inv_mul_eq_iff_eq_mul.mp h.symm,
    have : ((σ₁ * perm.sum_congr_hom _ _ (sl, sr)).sign : ℤ) = σ₁.sign * (sl.sign * sr.sign) :=
      by simp,
    rw [h, this, mul_smul, mul_smul, units.smul_left_cancel,
      ←tensor_product.tmul_smul, tensor_product.smul_tmul'],
    simp only [sum.map_inr, perm.sum_congr_hom_apply, perm.sum_congr_apply, sum.map_inl,
              function.comp_app, perm.coe_mul],
    rw [←a.map_congr_perm (λ i, v (σ₁ _)), ←b.map_congr_perm (λ i, v (σ₁ _))],
  end)

lemma dom_coprod.summand_mk'
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : equiv.perm (ιa ⊕ ιb)) :
  dom_coprod.summand a b (quotient.mk' σ) = (σ.sign : ℤ) •
    (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ :=
rfl

/-- Swapping elements in `σ` with equal values in `v` results in an addition that cancels -/
lemma dom_coprod.summand_add_swap_smul_eq_zero
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb)
  {v : ιa ⊕ ιb → Mᵢ} {i j : ιa ⊕ ιb} (hv : v i = v j) (hij : i ≠ j) :
  dom_coprod.summand a b σ v + dom_coprod.summand a b (swap i j • σ) v = 0 :=
begin
  apply σ.induction_on' (λ σ, _),
  dsimp only [quotient.lift_on'_mk', quotient.map'_mk', mul_action.quotient.smul_mk,
    dom_coprod.summand],
  rw [perm.sign_mul, perm.sign_swap hij],
  simp only [one_mul, units.neg_mul, function.comp_app, neg_smul, perm.coe_mul,
    units.coe_neg, multilinear_map.smul_apply, multilinear_map.neg_apply,
    multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply],
  convert add_right_neg _;
  { ext k, rw equiv.apply_swap_eq_self hv },
end

/-- Swapping elements in `σ` with equal values in `v` result in zero if the swap has no effect
on the quotient. -/
lemma dom_coprod.summand_eq_zero_of_smul_invariant
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb)
  {v : ιa ⊕ ιb → Mᵢ} {i j : ιa ⊕ ιb} (hv : v i = v j) (hij : i ≠ j) :
  swap i j • σ = σ → dom_coprod.summand a b σ v = 0 :=
begin
  apply σ.induction_on' (λ σ, _),
  dsimp only [quotient.lift_on'_mk', quotient.map'_mk', multilinear_map.smul_apply,
    multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply, dom_coprod.summand],
  intro hσ,
  with_cases {
    cases hi : σ⁻¹ i;
      cases hj : σ⁻¹ j;
      rw perm.inv_eq_iff_eq at hi hj;
      substs hi hj, },
  case [sum.inl sum.inr : i' j', sum.inr sum.inl : i' j'] {
    -- the term pairs with and cancels another term
    all_goals { obtain ⟨⟨sl, sr⟩, hσ⟩ := quotient.exact' hσ, },
    work_on_goal 0 { replace hσ := equiv.congr_fun hσ (sum.inl i'), },
    work_on_goal 1 { replace hσ := equiv.congr_fun hσ (sum.inr i'), },
    all_goals {
      rw [←equiv.mul_swap_eq_swap_mul, mul_inv_rev, equiv.swap_inv, inv_mul_cancel_right] at hσ,
      simpa using hσ, }, },
  case [sum.inr sum.inr : i' j', sum.inl sum.inl : i' j'] {
    -- the term does not pair but is zero
    all_goals { convert smul_zero _, },
    work_on_goal 0 { convert tensor_product.tmul_zero _ _, },
    work_on_goal 1 { convert tensor_product.zero_tmul _ _, },
    all_goals { exact alternating_map.map_eq_zero_of_eq _ _ hv (λ hij', hij (hij' ▸ rfl)), },
    },
end

/-- Like `multilinear_map.dom_coprod`, but ensures the result is also alternating.

Note that this is usually defined (for instance, as used in Proposition 22.24 in [Gallier2011Notes])
over integer indices `ιa = fin n` and `ιb = fin m`, as
$$
(f \wedge g)(u_1, \ldots, u_{m+n}) =
  \sum_{\operatorname{shuffle}(m, n)} \operatorname{sign}(\sigma)
    f(u_{\sigma(1)}, \ldots, u_{\sigma(m)}) g(u_{\sigma(m+1)}, \ldots, u_{\sigma(m+n)}),
$$
where $\operatorname{shuffle}(m, n)$ consists of all permutations of $[1, m+n]$ such that
$\sigma(1) < \cdots < \sigma(m)$ and $\sigma(m+1) < \cdots < \sigma(m+n)$.

Here, we generalize this by replacing:
* the product in the sum with a tensor product
* the filtering of $[1, m+n]$ to shuffles with an isomorphic quotient
* the additions in the subscripts of $\sigma$ with an index of type `sum`

The specialized version can be obtained by combining this definition with `fin_sum_fin_equiv` and
`algebra.lmul'`.
-/
@[simps]
def dom_coprod
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  alternating_map R' Mᵢ (N₁ ⊗[R'] N₂) (ιa ⊕ ιb) :=
{ to_fun := λ v, ⇑(∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ) v,
  map_eq_zero_of_eq' := λ v i j hv hij, begin
    dsimp only,
    rw multilinear_map.sum_apply,
    exact finset.sum_involution
      (λ σ _, equiv.swap i j • σ)
      (λ σ _, dom_coprod.summand_add_swap_smul_eq_zero a b σ hv hij)
      (λ σ _, mt $ dom_coprod.summand_eq_zero_of_smul_invariant a b σ hv hij)
      (λ σ _, finset.mem_univ _)
      (λ σ _, equiv.perm.mod_sum_congr.swap_smul_involutive i j σ),
  end,
  ..(∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ) }

lemma dom_coprod_coe (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  (↑(a.dom_coprod b) : multilinear_map R' (λ _, Mᵢ) _) =
    ∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ :=
multilinear_map.ext $ λ _, rfl

/-- A more bundled version of `alternating_map.dom_coprod` that maps
`((ι₁ → N) → N₁) ⊗ ((ι₂ → N) → N₂)` to `(ι₁ ⊕ ι₂ → N) → N₁ ⊗ N₂`. -/
def dom_coprod' :
  (alternating_map R' Mᵢ N₁ ιa ⊗[R'] alternating_map R' Mᵢ N₂ ιb) →ₗ[R']
    alternating_map R' Mᵢ (N₁ ⊗[R'] N₂) (ιa ⊕ ιb) :=
tensor_product.lift $ by
  refine linear_map.mk₂ R' (dom_coprod)
    (λ m₁ m₂ n, _)
    (λ c m n, _)
    (λ m n₁ n₂, _)
    (λ c m n, _);
  { ext,
    simp only [dom_coprod_apply, add_apply, smul_apply, ←finset.sum_add_distrib,
      finset.smul_sum, multilinear_map.sum_apply, dom_coprod.summand],
    congr,
    ext σ,
    apply σ.induction_on' (λ σ, _),
    simp only [quotient.lift_on'_mk', coe_add, coe_smul, multilinear_map.smul_apply,
      ←multilinear_map.dom_coprod'_apply],
    simp only [tensor_product.add_tmul, ←tensor_product.smul_tmul',
      tensor_product.tmul_add, tensor_product.tmul_smul, linear_map.map_add, linear_map.map_smul],
    rw ←smul_add <|> rw smul_comm,
    congr }

@[simp]
lemma dom_coprod'_apply
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  dom_coprod' (a ⊗ₜ[R'] b) = dom_coprod a b :=
by simp only [dom_coprod', tensor_product.lift.tmul, linear_map.mk₂_apply]

end alternating_map

open equiv

/-- A helper lemma for `multilinear_map.dom_coprod_alternization`. -/
lemma multilinear_map.dom_coprod_alternization_coe
  (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
  multilinear_map.dom_coprod ↑a.alternatization ↑b.alternatization =
    ∑ (σa : perm ιa) (σb : perm ιb), (σa.sign : ℤ) • (σb.sign : ℤ) •
      multilinear_map.dom_coprod (a.dom_dom_congr σa) (b.dom_dom_congr σb) :=
begin
  simp_rw [←multilinear_map.dom_coprod'_apply, multilinear_map.alternatization_coe],
  simp_rw [tensor_product.sum_tmul, tensor_product.tmul_sum, linear_map.map_sum,
    ←tensor_product.smul_tmul', tensor_product.tmul_smul, linear_map.map_smul_of_tower],
end

open alternating_map

/-- Computing the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` is the same
as computing the `alternating_map.dom_coprod` of the `multilinear_map.alternatization`s.
-/
lemma multilinear_map.dom_coprod_alternization
  (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
  (multilinear_map.dom_coprod a b).alternatization =
    a.alternatization.dom_coprod b.alternatization :=
begin
  apply coe_multilinear_map_injective,
  rw [dom_coprod_coe, multilinear_map.alternatization_coe,
    finset.sum_partition (quotient_group.left_rel (perm.sum_congr_hom ιa ιb).range)],
  congr' 1,
  ext1 σ,
  apply σ.induction_on' (λ σ, _),

  -- unfold the quotient mess left by `finset.sum_partition`
  conv in (_ = quotient.mk' _) {
    change quotient.mk' _ = quotient.mk' _,
    rw quotient.eq',
    rw [quotient_group.left_rel],
    dsimp only [setoid.r] },

  -- eliminate a multiplication
  have : @finset.univ (perm (ιa ⊕ ιb)) _ = finset.univ.image ((*) σ) :=
    (finset.eq_univ_iff_forall.mpr $ λ a, let ⟨a', ha'⟩ := mul_left_surjective σ a in
      finset.mem_image.mpr ⟨a', finset.mem_univ _, ha'⟩).symm,
  rw [this, finset.image_filter],
  simp only [function.comp, mul_inv_rev, inv_mul_cancel_right, subgroup.inv_mem_iff],
  simp only [monoid_hom.mem_range], -- needs to be separate from the above `simp only`
  rw [finset.filter_congr_decidable,
    finset.univ_filter_exists (perm.sum_congr_hom ιa ιb),
    finset.sum_image (λ x _ y _ (h : _ = _), mul_right_injective _ h),
    finset.sum_image (λ x _ y _ (h : _ = _), perm.sum_congr_hom_injective h)],
  dsimp only,

  -- now we're ready to clean up the RHS, pulling out the summation
  rw [dom_coprod.summand_mk', multilinear_map.dom_coprod_alternization_coe,
    ←finset.sum_product', finset.univ_product_univ,
    ←multilinear_map.dom_dom_congr_equiv_apply, add_equiv.map_sum, finset.smul_sum],
  congr' 1,
  ext1 ⟨al, ar⟩,
  dsimp only,

  -- pull out the pair of smuls on the RHS, by rewriting to `add_monoid_hom` and back
  rw [←add_equiv.coe_to_add_monoid_hom, add_monoid_hom.map_int_module_smul,
    add_monoid_hom.map_int_module_smul,
    add_equiv.coe_to_add_monoid_hom, multilinear_map.dom_dom_congr_equiv_apply],

  -- pick up the pieces
  rw [multilinear_map.dom_dom_congr_mul, perm.sign_mul, units.coe_mul,
    perm.sum_congr_hom_apply, multilinear_map.dom_coprod_dom_dom_congr_sum_congr,
    perm.sign_sum_congr, units.coe_mul, ←mul_smul ↑al.sign ↑ar.sign, ←mul_smul],
end

/-- Taking the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` of two
`alternating_map`s gives a scaled version of the `alternating_map.coprod` of those maps.
-/
lemma multilinear_map.dom_coprod_alternization_eq
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  (multilinear_map.dom_coprod a b : multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗ N₂))
    .alternatization =
    ((fintype.card ιa).factorial * (fintype.card ιb).factorial) • a.dom_coprod b :=
begin
  rw [multilinear_map.dom_coprod_alternization, coe_alternatization, coe_alternatization, mul_smul,
    ←dom_coprod'_apply, ←dom_coprod'_apply, ←tensor_product.smul_tmul', tensor_product.tmul_smul,
    linear_map.map_smul_of_tower dom_coprod', linear_map.map_smul_of_tower dom_coprod'],
  -- typeclass resolution is a little confused here
  apply_instance, apply_instance,
end

end coprod


import data.fintype algebra.big_operators

/-- finset.sum_bij, but on isomorphism. -/
lemma finset.sum_iso {α₁ α₂ β: Type} [add_comm_monoid β]
    (f : α₁ → β) (g : α₂ → β) (iso : α₁ ≃ α₂)
    (feq : ∀ x, f x = g (iso.to_fun x))
    (xs : finset α₁) (ys : finset α₂)
  : (∀ x, x ∈ xs → iso.to_fun x ∈ ys)
  → (∀ y, y ∈ ys → iso.inv_fun y ∈ xs)
  → finset.sum xs f = finset.sum ys g
| mem mem' := finset.sum_bij (λ a _, iso.to_fun a) mem (λ x _, feq x)
    (λ a₁ a₂ _ _ eq, equiv.injective iso eq)
    (λ b mem, ⟨ iso.inv_fun b, mem' b mem, symm (iso.right_inv b) ⟩)

lemma fintype.sum_iso {α₁ α₂ β: Type} [add_comm_monoid β] [xs : fintype α₁] [ys : fintype α₂]
    (f : α₁ → β) (g : α₂ → β) (iso : α₁ ≃ α₂)
    (feq : ∀ x, f x = g (iso.to_fun x))
  : finset.sum (fintype.elems α₁) f = finset.sum (fintype.elems α₂) g
  := finset.sum_iso f g iso feq (fintype.elems α₁) (fintype.elems α₂)
    (λ x _, fintype.complete (iso.to_fun x))
    (λ x _, fintype.complete (iso.inv_fun x))

/-- Insert an item into a finset, given a proof it does not occur already. -/
def finset.insert_nmem {α : Type*} : ∀ {xs : finset α} {a : α}, a ∉ xs → finset α
| xs a nmem := ⟨ a :: xs.val, multiset.nodup_cons_of_nodup nmem xs.nodup ⟩

/-- `finset.insert_nmem` with an explicit element and vector, useful for working
    outside of tactic mode. -/
def finset.insert_nmem' {α : Type*} (a : α) (xs : finset α) : a ∉ xs → finset α
  := finset.insert_nmem

lemma finset.mem_insert_nmem_self {α : Type*} {a : α} {s : finset α} (nmem : a ∉ s)
  : a ∈ finset.insert_nmem nmem := multiset.mem_cons_self a s.val

lemma finset.mem_insert_nmem_of_mem {α : Type*} {a b : α} {s : finset α} (h : a ∈ s) (nmem : b ∉ s)
  : a ∈ finset.insert_nmem nmem := multiset.mem_cons_of_mem h

/-- Build a union of two disjoint finite sets -/
def finset.union_disjoint {α : Type*} (xs ys : finset α)
  : multiset.disjoint xs.val ys.val → finset α
| disj := ⟨ xs.val + ys.val, (multiset.nodup_add_of_nodup xs.nodup ys.nodup).mpr disj ⟩

lemma finset.mem_union_disjoint {α : Type*} {a : α} {xs ys : finset α}
    {h : multiset.disjoint xs.val ys.val}
  : a ∈ finset.union_disjoint xs ys h ↔ a ∈ xs ∨ a ∈ ys
  := multiset.mem_add

/-- A composition of `multiset.map` and `multiset.sum`, which has the same
    signature as `finset.sum`. -/
def multiset.sum' {α : Type*} {β : Type*} [add_comm_monoid β] (s : multiset α) (f : α → β) : β
  := (multiset.map f s).sum

@[simp]
lemma multiset.sum'_zero {α : Type*} {β : Type*} [add_comm_monoid β] (f : α → β)
  : multiset.sum' 0 f = 0
  := rfl

@[simp]
lemma multiset.sum'_singleton {α : Type*} {β : Type*} [add_comm_monoid β] (f : α → β) (a : α)
  : multiset.sum' [a] f = f a
  := add_zero (f a)

@[simp]
lemma multiset.sum'_add {α : Type*} {β : Type*} [add_comm_monoid β] (s₁ s₂ : multiset α) (f : α → β)
  : (s₁ + s₂).sum' f = s₁.sum' f + s₂.sum' f
  := by simp only [multiset.sum', multiset.map_add, multiset.sum_add]

#lint-


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

! This file was ported from Lean 3 source module topology.uniform_space.compact
! leanprover-community/mathlib commit 735b22f8f9ff9792cf4212d7cb051c4c994bc685
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.UniformSpace.UniformConvergence
import Mathlib.Topology.UniformSpace.Equicontinuity
import Mathlib.Topology.Separation
import Mathlib.Topology.Support

/-!
# Compact separated uniform spaces

## Main statements

* `compactSpace_uniformity`: On a compact uniform space, the topology determines the
  uniform structure, entourages are exactly the neighborhoods of the diagonal.

* `uniformSpace_of_compact_t2`: every compact T2 topological structure is induced by a uniform
  structure. This uniform structure is described in the previous item.

* **Heine-Cantor** theorem: continuous functions on compact uniform spaces with values in uniform
  spaces are automatically uniformly continuous. There are several variations, the main one is
  `CompactSpace.uniformContinuous_of_continuous`.

## Implementation notes

The construction `uniformSpace_of_compact_t2` is not declared as an instance, as it would badly
loop.

## tags

uniform space, uniform continuity, compact space
-/

open Classical Uniformity Topology Filter

open Filter UniformSpace Set

variable {α β γ : Type _} [UniformSpace α] [UniformSpace β]

/-!
### Uniformity on compact spaces
-/

/-- On a compact uniform space, the topology determines the uniform structure, entourages are
exactly the neighborhoods of the diagonal. -/
theorem nhdsSet_diagonal_eq_uniformity [CompactSpace α] : 𝓝ˢ (diagonal α) = 𝓤 α := by
  refine' nhdsSet_diagonal_le_uniformity.antisymm _
  have :
    (𝓤 (α × α)).HasBasis (fun U => U ∈ 𝓤 α) fun U =>
      (fun p : (α × α) × α × α => ((p.1.1, p.2.1), p.1.2, p.2.2)) ⁻¹' U ×ˢ U :=
    by
    rw [uniformity_prod_eq_comap_prod]
    exact (𝓤 α).basis_sets.prod_self.comap _
  refine' (isCompact_diagonal.nhdsSet_basis_uniformity this).ge_iff.2 fun U hU => _
  exact mem_of_superset hU fun ⟨x, y⟩ hxy => mem_unionᵢ₂.2
    ⟨(x, x), rfl, refl_mem_uniformity hU, hxy⟩
#align nhds_set_diagonal_eq_uniformity nhdsSet_diagonal_eq_uniformity

/-- On a compact uniform space, the topology determines the uniform structure, entourages are
exactly the neighborhoods of the diagonal. -/
theorem compactSpace_uniformity [CompactSpace α] : 𝓤 α = ⨆ x, 𝓝 (x, x) :=
  nhdsSet_diagonal_eq_uniformity.symm.trans (nhdsSet_diagonal _)
#align compact_space_uniformity compactSpace_uniformity

theorem unique_uniformity_of_compact [t : TopologicalSpace γ] [CompactSpace γ]
    {u u' : UniformSpace γ} (h : u.toTopologicalSpace = t) (h' : u'.toTopologicalSpace = t) :
    u = u' := by
  refine uniformSpace_eq ?_
  have : @CompactSpace γ u.toTopologicalSpace := by rwa [h]
  have : @CompactSpace γ u'.toTopologicalSpace := by rwa [h']
  rw [@compactSpace_uniformity _ u, compactSpace_uniformity, h, h']
#align unique_uniformity_of_compact unique_uniformity_of_compact

/-- The unique uniform structure inducing a given compact topological structure. -/
def uniformSpaceOfCompactT2 [TopologicalSpace γ] [CompactSpace γ] [T2Space γ] : UniformSpace γ
    where
  uniformity := 𝓝ˢ (diagonal γ)
  refl := principal_le_nhdsSet
  symm := continuous_swap.tendsto_nhdsSet fun x => Eq.symm
  comp :=
    by
    /-  This is the difficult part of the proof. We need to prove that, for each neighborhood `W`
        of the diagonal `Δ`, there exists a smaller neighborhood `V` such that `V ○ V ⊆ W`.
        -/
    set 𝓝Δ := 𝓝ˢ (diagonal γ)
    -- The filter of neighborhoods of Δ
    set F := 𝓝Δ.lift' fun s : Set (γ × γ) => s ○ s
    -- Compositions of neighborhoods of Δ
    -- If this weren't true, then there would be V ∈ 𝓝Δ such that F ⊓ 𝓟 Vᶜ ≠ ⊥
    rw [le_iff_forall_inf_principal_compl]
    intro V V_in
    by_contra H
    haveI : NeBot (F ⊓ 𝓟 (Vᶜ)) := ⟨H⟩
    -- Hence compactness would give us a cluster point (x, y) for F ⊓ 𝓟 Vᶜ
    obtain ⟨⟨x, y⟩, hxy⟩ : ∃ p : γ × γ, ClusterPt p (F ⊓ 𝓟 (Vᶜ)) := cluster_point_of_compact _
    -- In particular (x, y) is a cluster point of 𝓟 Vᶜ, hence is not in the interior of V,
    -- and a fortiori not in Δ, so x ≠ y
    have clV : ClusterPt (x, y) (𝓟 <| Vᶜ) := hxy.of_inf_right
    have : (x, y) ∉ interior V :=
      by
      have : (x, y) ∈ closure (Vᶜ) := by rwa [mem_closure_iff_clusterPt]
      rwa [closure_compl] at this
    have diag_subset : diagonal γ ⊆ interior V := subset_interior_iff_mem_nhdsSet.2 V_in
    have x_ne_y : x ≠ y := mt (@diag_subset (x, y)) this
    -- Since γ is compact and Hausdorff, it is normal, hence T₃.
    haveI : NormalSpace γ := normalOfCompactT2
    -- So there are closed neighboords V₁ and V₂ of x and y contained in disjoint open neighborhoods
    -- U₁ and U₂.
    obtain
      ⟨U₁, _, V₁, V₁_in, U₂, _, V₂, V₂_in, V₁_cl, V₂_cl, U₁_op, U₂_op, VU₁, VU₂, hU₁₂⟩ :=
      disjoint_nested_nhds x_ne_y
    -- We set U₃ := (V₁ ∪ V₂)ᶜ so that W := U₁ ×ˢ U₁ ∪ U₂ ×ˢ U₂ ∪ U₃ ×ˢ U₃ is an open
    -- neighborhood of Δ.
    let U₃ := (V₁ ∪ V₂)ᶜ
    have U₃_op : IsOpen U₃ := (V₁_cl.union V₂_cl).isOpen_compl
    let W := U₁ ×ˢ U₁ ∪ U₂ ×ˢ U₂ ∪ U₃ ×ˢ U₃
    have W_in : W ∈ 𝓝Δ := by
      rw [mem_nhdsSet_iff_forall]
      rintro ⟨z, z'⟩ (rfl : z = z')
      refine' IsOpen.mem_nhds _ _
      · apply_rules [IsOpen.union, IsOpen.prod]
      · simp only [mem_union, mem_prod, and_self_iff]
        exact (_root_.em _).imp_left fun h => union_subset_union VU₁ VU₂ h
    -- So W ○ W ∈ F by definition of F
    have : W ○ W ∈ F := @mem_lift' _ _ _ (fun s => s ○ s) _ W_in
      -- Porting note: was `by simpa only using mem_lift' W_in`
    -- And V₁ ×ˢ V₂ ∈ 𝓝 (x, y)
    have hV₁₂ : V₁ ×ˢ V₂ ∈ 𝓝 (x, y) := prod_mem_nhds V₁_in V₂_in
    -- But (x, y) is also a cluster point of F so (V₁ ×ˢ V₂) ∩ (W ○ W) ≠ ∅
    -- However the construction of W implies (V₁ ×ˢ V₂) ∩ (W ○ W) = ∅.
    -- Indeed assume for contradiction there is some (u, v) in the intersection.
    obtain ⟨⟨u, v⟩, ⟨u_in, v_in⟩, w, huw, hwv⟩ := clusterPt_iff.mp hxy.of_inf_left hV₁₂ this
    -- So u ∈ V₁, v ∈ V₂, and there exists some w such that (u, w) ∈ W and (w ,v) ∈ W.
    -- Because u is in V₁ which is disjoint from U₂ and U₃, (u, w) ∈ W forces (u, w) ∈ U₁ ×ˢ U₁.
    have uw_in : (u, w) ∈ U₁ ×ˢ U₁ :=
      (huw.resolve_right fun h => h.1 <| Or.inl u_in).resolve_right fun h =>
        hU₁₂.le_bot ⟨VU₁ u_in, h.1⟩
    -- Similarly, because v ∈ V₂, (w ,v) ∈ W forces (w, v) ∈ U₂ ×ˢ U₂.
    have wv_in : (w, v) ∈ U₂ ×ˢ U₂ :=
      (hwv.resolve_right fun h => h.2 <| Or.inr v_in).resolve_left fun h =>
        hU₁₂.le_bot ⟨h.2, VU₂ v_in⟩
    -- Hence w ∈ U₁ ∩ U₂ which is empty.
    -- So we have a contradiction
    exact hU₁₂.le_bot ⟨uw_in.2, wv_in.1⟩
  isOpen_uniformity :=
    by
    -- Here we need to prove the topology induced by the constructed uniformity is the
    -- topology we started with.
    suffices ∀ x : γ, Filter.comap (Prod.mk x) (𝓝ˢ (diagonal γ)) = 𝓝 x
      by
      intro s
      simp_rw [isOpen_fold, isOpen_iff_mem_nhds, ← mem_comap_prod_mk, this]
    intro x
    simp_rw [nhdsSet_diagonal, comap_supᵢ, nhds_prod_eq, comap_prod, (· ∘ ·), comap_id']
    rw [supᵢ_split_single _ x, comap_const_of_mem fun V => mem_of_mem_nhds]
    suffices ∀ (y) (_ : y ≠ x), comap (fun _ : γ => x) (𝓝 y) ⊓ 𝓝 y ≤ 𝓝 x by simpa
    intro y hxy
    simp [comap_const_of_not_mem (compl_singleton_mem_nhds hxy) (Classical.not_not.2 rfl)]
#align uniform_space_of_compact_t2 uniformSpaceOfCompactT2

/-!
### Heine-Cantor theorem
-/

/-- Heine-Cantor: a continuous function on a compact uniform space is uniformly
continuous. -/
theorem CompactSpace.uniformContinuous_of_continuous [CompactSpace α] {f : α → β}
    (h : Continuous f) : UniformContinuous f :=
  have : Tendsto (Prod.map f f) (𝓝ˢ (diagonal α)) (𝓝ˢ (diagonal β)) :=
    (h.prod_map h).tendsto_nhdsSet mapsTo_prod_map_diagonal
  (this.mono_left nhdsSet_diagonal_eq_uniformity.ge).mono_right nhdsSet_diagonal_le_uniformity
#align compact_space.uniform_continuous_of_continuous CompactSpace.uniformContinuous_of_continuous

/-- Heine-Cantor: a continuous function on a compact set of a uniform space is uniformly
continuous. -/
theorem IsCompact.uniformContinuousOn_of_continuous {s : Set α} {f : α → β} (hs : IsCompact s)
    (hf : ContinuousOn f s) : UniformContinuousOn f s := by
  rw [uniformContinuousOn_iff_restrict]
  rw [isCompact_iff_compactSpace] at hs
  rw [continuousOn_iff_continuous_restrict] at hf
  skip
  exact CompactSpace.uniformContinuous_of_continuous hf
#align is_compact.uniform_continuous_on_of_continuous IsCompact.uniformContinuousOn_of_continuous

/-- If `s` is compact and `f` is continuous at all points of `s`, then `f` is
"uniformly continuous at the set `s`", i.e. `f x` is close to `f y` whenever `x ∈ s` and `y` is
close to `x` (even if `y` is not itself in `s`, so this is a stronger assertion than
`UniformContinuousOn s`). -/
theorem IsCompact.uniformContinuousAt_of_continuousAt {r : Set (β × β)} {s : Set α}
    (hs : IsCompact s) (f : α → β) (hf : ∀ a ∈ s, ContinuousAt f a) (hr : r ∈ 𝓤 β) :
    { x : α × α | x.1 ∈ s → (f x.1, f x.2) ∈ r } ∈ 𝓤 α := by
  obtain ⟨t, ht, htsymm, htr⟩ := comp_symm_mem_uniformity_sets hr
  choose U hU T hT hb using fun a ha =>
    exists_mem_nhds_ball_subset_of_mem_nhds ((hf a ha).preimage_mem_nhds <| mem_nhds_left _ ht)
  obtain ⟨fs, hsU⟩ := hs.elim_nhds_subcover' U hU
  apply mem_of_superset ((binterᵢ_finset_mem fs).2 fun a _ => hT a a.2)
  rintro ⟨a₁, a₂⟩ h h₁
  obtain ⟨a, ha, haU⟩ := Set.mem_unionᵢ₂.1 (hsU h₁)
  apply htr
  refine' ⟨f a, htsymm.mk_mem_comm.1 (hb _ _ _ haU _), hb _ _ _ haU _⟩
  exacts[mem_ball_self _ (hT a a.2), mem_interᵢ₂.1 h a ha]
#align is_compact.uniform_continuous_at_of_continuous_at IsCompact.uniformContinuousAt_of_continuousAt

theorem Continuous.uniformContinuous_of_tendsto_cocompact {f : α → β} {x : β}
    (h_cont : Continuous f) (hx : Tendsto f (cocompact α) (𝓝 x)) : UniformContinuous f :=
  uniformContinuous_def.2 fun r hr =>
    by
    obtain ⟨t, ht, htsymm, htr⟩ := comp_symm_mem_uniformity_sets hr
    obtain ⟨s, hs, hst⟩ := mem_cocompact.1 (hx <| mem_nhds_left _ ht)
    apply
      mem_of_superset
        (symmetrize_mem_uniformity <|
          (hs.uniformContinuousAt_of_continuousAt f fun _ _ => h_cont.continuousAt) <|
            symmetrize_mem_uniformity hr)
    rintro ⟨b₁, b₂⟩ h
    by_cases h₁ : b₁ ∈ s; · exact (h.1 h₁).1
    by_cases h₂ : b₂ ∈ s; · exact (h.2 h₂).2
    apply htr
    exact ⟨x, htsymm.mk_mem_comm.1 (hst h₁), hst h₂⟩
#align continuous.uniform_continuous_of_tendsto_cocompact Continuous.uniformContinuous_of_tendsto_cocompact

/-- If `f` has compact multiplicative support, then `f` tends to 1 at infinity. -/
@[to_additive "If `f` has compact support, then `f` tends to zero at infinity."]
theorem HasCompactMulSupport.is_one_at_infty {f : α → γ} [TopologicalSpace γ] [One γ]
    (h : HasCompactMulSupport f) : Tendsto f (cocompact α) (𝓝 1) := by
  -- porting note: move to src/topology/support.lean once the port is over
  intro N hN
  rw [mem_map, mem_cocompact']
  refine' ⟨mulTSupport f, h.isCompact, _⟩
  rw [compl_subset_comm]
  intro v hv
  rw [mem_preimage, image_eq_one_of_nmem_mulTSupport hv]
  exact mem_of_mem_nhds hN
#align has_compact_mul_support.is_one_at_infty HasCompactMulSupport.is_one_at_infty
#align has_compact_support.is_zero_at_infty HasCompactSupport.is_zero_at_infty

@[to_additive]
theorem HasCompactMulSupport.uniformContinuous_of_continuous {f : α → β} [One β]
    (h1 : HasCompactMulSupport f) (h2 : Continuous f) : UniformContinuous f :=
  h2.uniformContinuous_of_tendsto_cocompact h1.is_one_at_infty
#align has_compact_mul_support.uniform_continuous_of_continuous HasCompactMulSupport.uniformContinuous_of_continuous
#align has_compact_support.uniform_continuous_of_continuous HasCompactSupport.uniformContinuous_of_continuous

/-- A family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is locally compact,
`β` is compact and `f` is continuous on `U × (univ : Set β)` for some neighborhood `U` of `x`. -/
theorem ContinuousOn.tendstoUniformly [LocallyCompactSpace α] [CompactSpace β] [UniformSpace γ]
    {f : α → β → γ} {x : α} {U : Set α} (hxU : U ∈ 𝓝 x) (h : ContinuousOn (↿f) (U ×ˢ univ)) :
    TendstoUniformly f (f x) (𝓝 x) := by
  rcases LocallyCompactSpace.local_compact_nhds _ _ hxU with ⟨K, hxK, hKU, hK⟩
  have : UniformContinuousOn (↿f) (K ×ˢ univ) :=
    IsCompact.uniformContinuousOn_of_continuous (hK.prod isCompact_univ)
      (h.mono <| prod_mono hKU Subset.rfl)
  exact this.tendstoUniformly hxK
#align continuous_on.tendsto_uniformly ContinuousOn.tendstoUniformly

/-- A continuous family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is
locally compact and `β` is compact. -/
theorem Continuous.tendstoUniformly [LocallyCompactSpace α] [CompactSpace β] [UniformSpace γ]
    (f : α → β → γ) (h : Continuous ↿f) (x : α) : TendstoUniformly f (f x) (𝓝 x) :=
  h.continuousOn.tendstoUniformly univ_mem
#align continuous.tendsto_uniformly Continuous.tendstoUniformly

section UniformConvergence

/-- An equicontinuous family of functions defined on a compact uniform space is automatically
uniformly equicontinuous. -/
theorem CompactSpace.uniformEquicontinuous_of_equicontinuous {ι : Type _} {F : ι → β → α}
    [CompactSpace β] (h : Equicontinuous F) : UniformEquicontinuous F := by
  rw [equicontinuous_iff_continuous] at h
  rw [uniformEquicontinuous_iff_uniformContinuous]
  exact CompactSpace.uniformContinuous_of_continuous h
#align compact_space.uniform_equicontinuous_of_equicontinuous CompactSpace.uniformEquicontinuous_of_equicontinuous

end UniformConvergence


variable {α} (p : α → Prop) [DecidablePred p]

def filter : List α → List α
| []    => []
| a::as => if p a then a :: filter as else filter as

theorem filter_nil : filter p [] = [] :=
rfl

theorem filter_cons (a : α) (as : List α) : filter p (a :: as) = if p a then a :: filter p as else filter p as :=
rfl

theorem filter_cons_of_pos {a : α} (as : List α) (h : p a) : filter p (a :: as) = a :: filter p as := by
rw [filter_cons];
rw [if_pos h]

theorem filter_cons_of_neg {a : α} (as : List α) (h : ¬ p a) : filter p (a :: as) = filter p as := by
rw [filter_cons];
rw [if_neg h]


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

! This file was ported from Lean 3 source module data.set.functor
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Lattice

/-!
# Functoriality of `set`

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

This file defines the functor structure of `set`.
-/

universe u

open Function

namespace Set

variable {α β : Type u} {s : Set α} {f : α → Set β} {g : Set (α → β)}

instance : Monad.{u} Set where
  pure α a := {a}
  bind α β s f := ⋃ i ∈ s, f i
  seq α β := Set.seq
  map α β := Set.image

#print Set.bind_def /-
@[simp]
theorem bind_def : s >>= f = ⋃ i ∈ s, f i :=
  rfl
#align set.bind_def Set.bind_def
-/

#print Set.fmap_eq_image /-
@[simp]
theorem fmap_eq_image (f : α → β) : f <$> s = f '' s :=
  rfl
#align set.fmap_eq_image Set.fmap_eq_image
-/

#print Set.seq_eq_set_seq /-
@[simp]
theorem seq_eq_set_seq (s : Set (α → β)) (t : Set α) : s <*> t = s.seq t :=
  rfl
#align set.seq_eq_set_seq Set.seq_eq_set_seq
-/

#print Set.pure_def /-
@[simp]
theorem pure_def (a : α) : (pure a : Set α) = {a} :=
  rfl
#align set.pure_def Set.pure_def
-/

#print Set.image2_def /-
/-- `set.image2` in terms of monadic operations. Note that this can't be taken as the definition
because of the lack of universe polymorphism. -/
theorem image2_def {α β γ : Type _} (f : α → β → γ) (s : Set α) (t : Set β) :
    image2 f s t = f <$> s <*> t := by
  ext
  simp
#align set.image2_def Set.image2_def
-/

instance : LawfulMonad Set where
  id_map α := image_id
  comp_map α β γ f g s := image_comp _ _ _
  pure_bind α β := bunionᵢ_singleton
  bind_assoc α β γ s f g := by simp only [bind_def, bUnion_Union]
  bind_pure_comp_eq_map α β f s := (image_eq_unionᵢ _ _).symm
  bind_map_eq_seq α β s t := seq_def.symm

instance : CommApplicative (Set : Type u → Type u) :=
  ⟨fun α β s t => prod_image_seq_comm s t⟩

instance : Alternative Set :=
  { Set.monad with
    orelse := fun α => (· ∪ ·)
    failure := fun α => ∅ }

end Set


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kevin Buzzard
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.default
import Mathlib.data.fintype.card
import Mathlib.PostPort

namespace Mathlib

/-!
# Bernoulli numbers

The Bernoulli numbers are a sequence of rational numbers that frequently show up in
number theory.

## Mathematical overview

The Bernoulli numbers $(B_0, B_1, B_2, \ldots)=(1, 1/2, 1/6, 0, -1/30, \ldots)$ are
a sequence of rational numbers. They show up in the formula for the sums of $k$th
powers. They are related to the Taylor series expansions of $x/\tan(x)$ and
of $\coth(x)$, and also show up in the values that the Riemann Zeta function
takes both at both negative and positive integers (and hence in the
theory of modular forms). For example, if $1 \leq n$ is even then

$$\zeta(2n)=\sum_{t\geq1}t^{-2n}=(-1)^{n+1}\frac{(2\pi)^{2n}B_{2n}}{2(2n)!}.$$

Note however that this result is not yet formalised in Lean.

The Bernoulli numbers can be formally defined using the power series

$$\sum B_n\frac{t^n}{n!}=\frac{t}{1-e^{-t}}$$

although that happens to not be the definition in mathlib (this is an *implementation
detail* though, and need not concern the mathematician).

Note that $B_1=+1/2$, meaning that we are using the $B_n^+$ of
[from Wikipedia](https://en.wikipedia.org/wiki/Bernoulli_number).
To get the "minus" convention, just use `(-1)^n * bernoulli n`.

There is no particular reason that the `+` convention was used.
In some sense it's like choosing whether you want to sum over `fin n`
(so `j < n`) or sum over `j ≤ n` (or `nat.antidiagonal n`). Indeed
$$(t+1)\sum_{j\lt n}j^t=\sum_{k\leq t}\binom{t+1}{k}B_k^{-}n^{t+1-k}$$
and
$$(t+1)\sum_{j\leq n}j^t=\sum_{k\leq t}\binom{t+1}{k}B_k^{+}n^{t+1-k}.$$

## Implementation detail

The Bernoulli numbers are defined using well-founded induction, by the formula
$$B_n=1-\sum_{k\lt n}\frac{\binom{n}{k}}{n-k+1}B_k.$$
This formula is true for all $n$ and in particular $B_0=1$.

## Main theorems

`sum_bernoulli : ∑ k in finset.range n, (n.choose k : ℚ) * bernoulli k = n`

## Todo

* `∑ k : fin n, n.binomial k * (-1)^k * bernoulli k = if n = 1 then 1 else 0`

* Bernoulli polynomials

* `∑ k : fin n, k ^ t =` the Bernoulli polynomial B_t evaluated at n

* `∑ k : fin n.succ, n.succ.choose k bernoulli_poly k X = n.succ * X ^ n` as polynomials
-/

/-!

### Definitions

-/

/-- The Bernoulli numbers:
the $n$-th Bernoulli number $B_n$ is defined recursively via
$$B_n = 1 - \sum_{k < n} \binom{n}{k}\frac{B_k}{n+1-k}$$ -/
def bernoulli : ℕ → ℚ :=
  well_founded.fix nat.lt_wf
    fun (n : ℕ) (bernoulli : (y : ℕ) → nat.lt y n → ℚ) =>
      1 -
        finset.sum finset.univ
          fun (k : fin n) => ↑(nat.choose n ↑k) / (↑n - ↑k + 1) * bernoulli ↑k sorry

theorem bernoulli_def' (n : ℕ) :
    bernoulli n =
        1 -
          finset.sum finset.univ
            fun (k : fin n) => ↑(nat.choose n ↑k) / (↑n - ↑k + 1) * bernoulli ↑k :=
  sorry

theorem bernoulli_def (n : ℕ) :
    bernoulli n =
        1 -
          finset.sum (finset.range n)
            fun (k : ℕ) => ↑(nat.choose n k) / (↑n - ↑k + 1) * bernoulli k :=
  sorry

/-!

### Examples

-/

@[simp] theorem bernoulli_zero : bernoulli 0 = 1 := rfl

@[simp] theorem bernoulli_one : bernoulli 1 = 1 / bit0 1 := sorry

@[simp] theorem bernoulli_two : bernoulli (bit0 1) = 1 / bit0 (bit1 1) := sorry

@[simp] theorem bernoulli_three : bernoulli (bit1 1) = 0 := sorry

@[simp] theorem bernoulli_four : bernoulli (bit0 (bit0 1)) = -1 / bit0 (bit1 (bit1 (bit1 1))) :=
  sorry

@[simp] theorem sum_bernoulli (n : ℕ) :
    (finset.sum (finset.range n) fun (k : ℕ) => ↑(nat.choose n k) * bernoulli k) = ↑n :=
  sorry

end Mathlib


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_251
  (x : ℝ)
  (h₀ : x ≠ 0)
  (h₁ : 3 + 1 / x = 7 / x) :
  x = 2 :=
begin
  field_simp [h₀] at h₁,
  linarith,
end