import data.real.basic
import data.set
import tactic
open push_neg

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open tactic expr
local postfix *:9001 := many -- sinon ne comprends pas ident*

/- décompose en premier caractère, reste  INUTILISE-/
def un_car : string → string × string
| ⟨(x :: xs)⟩  := ( ⟨ [x] ⟩ , ⟨ xs ⟩ )
| _ := ("","")

def deux_car : string → string
| ⟨(x ::  y :: xs)⟩  := ⟨ [x,y] ⟩
| _ := ""

def trois_car : string → string
| ⟨(x ::  y :: z ::xs)⟩  := ⟨ [x,y,z] ⟩
| _ := ""

/- décompose une chaine de caractères selon la première parenthèse ouvrante
Le premier terme ne sert qu'à la récursivité  INUTILISE-/
meta def debut_chaine : string × string → string × string
| (s , t ) := do
    let d := un_car t,
    match d  with
        | ("(",reste) :=  (s,t)
        | ( ⟨(x)⟩, reste) :=  (debut_chaine (s ++ d.1, reste ))
        -- | _ := ("ERREUR", "")
        end

-- set_option trace.eqn_compiler.elim_match true
-- ne fonctionne pas : le "Prop" est ignoré, ou bien tout est Prop ??
-- meta def is_prop : expr →  bool
--     | `(%%e : Prop) := tt
   --  | _             := ff

-- détermine si l'expression est une propriété
-- basé sur le fait (peut-être optimiste) que si on échoue à trouver le type,
-- c'est qu'il y a des variables libres,
-- et donc que c'est une propriété
meta def is_prop : expr →  tactic bool
| e := do {
    expr_t ←  infer_type e,
    -- expr_tt ← infer_type expr_t,
    if expr_t = `(Prop) then return tt else return ff
        } <|> return tt

/- Décompose la racine d'une expression (un seul pas)
 LOGICS : ET, OU, SSI, QUELQUESOIT, IMPLIQUE, FONCTION, NON, EXISTE,
SETS: INTER, UNION, INCLUS, APPARTIENT, COMPLEMENTAIRE1,s IMAGE_ENSEMBLE, IMAGE_RECIPROQUE,
EGALITE, ENSEMBLE1, APPLICATION
NUMBERS: -/
private meta def analyse_expr_step  (e : expr) : tactic (string × (list expr)) :=
do  S ←  (tactic.pp e), let e_joli := to_string S,
match e with
| (lam name binder type body)          := return ("lambda[" ++ to_string name ++ "]", [type,body]) -- name → binder_info → expr → expr → expr
------------------------- LOGIQUE -------------------------
| `(%%p ∧ %%q) := return ("PROP_AND", [p,q])
| `(%%p ∨ %%q) := return ("PROP_OR", [p,q])
| `(%%p ↔ %%q) := return ("PROP_IFF", [p,q])
| `(¬ %%p) := return ("PROP_NOT", [p])
| `(%%p → false)  := return ("PROP_NOT", [p])
| `(%%p → %%q) :=   if deux_car(to_string e) = "Pi" then do match e with -- solution merdique
                        | (pi name binder type body) :=  return ("QUANT_∀[" ++ to_string name ++ "]", [p,q])
                        |  _ := return ("ERROR", [])
                        end
                    else --if has_var p then  return ("IMPLIQUE", [p,q])
                         --else do t ← infer_type p,
                         --if t = `(Prop) then return ("IMPLIQUE", [p,q])
                         do bool ← is_prop e,
                         if bool then return ("PROP_IMPLIES", [p,q])
                         else return ("FUNCTION", [p,q])
| `(Exists %%p) := do match p with          --  améliorer : cas d'une prop, mais attention aux variables !!
    | (lam name binder type body) :=
    -- la suite teste s'il s'agit de l'existence d'un objet ou d'une propriété
        -- d'abord, si `body` contient des variables libres, c'est une propriété
        -- if type.has_var then return ("EXISTE[PROP:" ++ to_string name ++ "]", [type,body])
        -- si ce n'est pas le cas, on peut chercher son type, et voir si c'est Prop
        -- else do type_type ← infer_type type,
            -- if type_type = `(Prop)
            do bool ← is_prop p, if bool
                then return ("PROP_∃[" ++ to_string name ++ "]", [type,body])
                else return ("QUANT_∃[" ++ to_string name ++ "]", [type,body])
    |  _ := return ("ERROR", [])
    end
------------------------- THEORIE DES ENSEMBLES -------------------------
| `(%%A ∩ %%B) := return ("SET_INTER", [A,B])
| `(%%A ∪ %%B) := return ("SET_UNION", [A,B])
| `(set.compl %%A) := return ("SET_COMPLEMENT", [A])
| `(%%A \ %%B) := return ("SET_SYM_DIFF", [A,B])
| `(%%A ⊆ %%B) := return ("PROP_INCLUDED", [A,B])
| `(%%a ∈ %%A) := return ("PROP_BELONGS", [a,A])
| `(@set.univ %%X) := return ("SET_UNIVERSE", [X])
| `(-%%A) := return ("MINUS", [A])
| `(set.Union %%A) := return ("SET_UNION+", [A])
| `(set.Inter %%A) := return ("SET_INTER+", [A])
| `(%%f '' %%A) := return ("SET_IMAGE", [f,A])
| `(%%f  ⁻¹' %%A) := return ("SET_INVERSE", [f,A])
| `(∅) := return ("SET_EMPTY", [])
| `(_root_.set %%X) := return ("SET", [X])
-- polymorphe
| `(%%a = %%b) := return ("PROP_EQUAL", [a,b]) -- faudrait connaitre le type ?
| `(%%a ≠ %%b) := return ("PROP_EQUAL_NOT", [a,b]) -- faudrait connaitre le type ?
----------- TOPOLOGY --------------
-- | `(B(%%x, %%r))

---------------------------- NOMBRES particuliers (cf aussi plus bas)
| `(0:ℝ) := return ("NUMBER[0]",[])               -- OK, mais peut-être faut-il garder l'info 0 : réel
| `(0:ℕ) := return ("NUMBER[0]",[])               -- non testé
| `(0:ℤ) := return ("NUMBER[0]",[])               -- non testé
| `(1:ℝ) := return ("NUMBER[1]",[])
| `(1:ℕ) := return ("NUMBER[1]",[])               -- non testé
| `(1:ℤ) := return ("NUMBER[1]",[])               -- non testé
-- | `(0 < %%b) := return ("POSITIF", [b])
| `(%%a < %%b) := return ("PROP_<", [a,b])
| `(%%a ≤ %%b) := return ("PROP_≤", [a,b])
-- | `(%%a > 0) := return ("POSITIF", [a])
| `(%%a > %%b) := return ("PROP_>", [a,b])
| `(%%a ≥ %%b) := return ("PROP_≥", [a,b])
------------------------------ Meta_applications

| (app fonction argument)   := -- do let Sfonction := to_string(fonction),
    -- pour les nombres, utiliser la pretty printer de Lean
    -- récupérer le type ?
    if is_numeral e
        then return ("NUMBER["++e_joli ++"]",[])
    -- détecter les sous-ensembles
--    else if to_string(fonction) = "set.{0}"
--        then return("SET", [argument])
--        else return("META_APPLICATION[[pp:" ++ e_joli ++"]]",[fonction,argument])
        else return("APPLICATION",[fonction,argument])
| `(ℝ) := return ("TYPE_NUMBER[ℝ]",[])
| `(ℕ) := return ("TYPE_NUMBER[ℕ]",[])
| (const name list_level)   := return ("CONSTANT[name:"++ e_joli ++ "/" ++ to_string name ++"]", []) -- name → list level → expr
| (var nat)       := return ("VAR["++ to_string nat ++ "]", []) --  nat → expr
| (sort level)      := return ("TYPE", [])  -- level → expr
| (mvar name pretty_name type)        := return ("METAVAR[" ++ to_string pretty_name ++ "]", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("LOCAL_CONSTANT[name:"++ to_string pretty_name++"/identifier:"++ to_string name ++ "]", []) -- name → name → binder_info → expr → expr
| (elet name_var type_var expr body)        := return ("LET["++ to_string name_var ++"]", [type_var,expr,body]) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("MACRO", []) -- macro_def → list expr → expr
end

-- A node will be a leaf of the analysis tree iff it belongs to the following list:
-- leaves = ["NOMBRE", "CONSTANT", "VAR", "TYPE", "METAVAR", "LOCAL_CONSTANT",
--          "LET", "MACRO", "ERREUR"]
-- A leaf is followed by a separateur_virgule or a ")"
-- A node which is not a leaf is followed by a "("

def separateur_virgule := "¿, "
def separateur_egale := " ¿= "
def open_paren := "¿("
def closed_paren := "¿)"
/- Analyse récursivement une expression à l'aide de analyse_expr_step,
renvoie le résultat sous forme de chaine bien parenthésée-/
private meta def analyse_rec : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step(e),
--    bool ← is_prop e,
--    let string := to_string bool ++ "." ++ string,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec e1,
       return(string ++ open_paren ++ string1 ++ closed_paren)
    |[e1,e2] :=  do
        string1 ← analyse_rec e1,
        string2 ← analyse_rec e2,
--        if  string = "APPLICATION"
--            then return (string1 ++ open_paren ++ string2 ++ closed_paren) else
        return (string ++ open_paren ++ string1 ++ separateur_virgule ++ string2 ++ closed_paren)
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec e1,
        string2 ← analyse_rec e2,
        string3 ← analyse_rec e3,
        return (string ++ open_paren ++ string1 ++ separateur_virgule ++ string2 ++ separateur_virgule ++ string3 ++ closed_paren)
    | _ :=    return(string)
    end
private meta def analyse_expr : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    bool ← is_prop expr_t,
    -- expr_tt ← infer_type expr_t,
    if bool then do
            -- S ←  (tactic.pp expr_t),
            -- let S1 := to_string S,
            S ←  (tactic.pp expr_t), let et_joli := to_string S,
            S1b ← analyse_rec e,
            S2 ← analyse_rec expr_t,
            let S3 := "PROPERTY[" ++ S1b ++ "/pp_type: " ++ et_joli ++ "]" ++ separateur_egale ++ S2,
            return(S3)
        else  do
            -- let S1 :=  to_string e,
            S1b ← analyse_rec e,
            S2 ← analyse_rec expr_t,
            let S3 := "OBJECT[" ++ S1b ++ separateur_egale ++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte : tactic unit :=
do liste_expr ← local_context,
    trace "context:",
    liste_expr.mmap (λ h, analyse_expr h >>= trace),
    return ()

/- Affiche la liste des buts, même format que analyse_contexte
(excepté qu'il n'y a que des PROPRIETES) -/
meta def analyse_buts : tactic unit :=
do liste_expr ← get_goals,
    trace "goals:",
    liste_expr.mmap (λ h, analyse_expr h >>= trace),
    return ()

---------------------------------------------------------
--------- NON UTILISES (debuggage) ----------------------------------
---------------------------------------------------------

/- Appelle l'analyse récursive sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def analyse (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_rec goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                expr_tt ← infer_type expr_t,
                -- la suite différencie selon la sémantique,
                -- ie les objets (éléments, ensembles, fonctions)
                -- vs les propriétés
                if expr_tt = `(Prop) then
                    trace (analyse_rec expr_t)
                else  do S1 ← (analyse_rec expr),
                        S2 ← (analyse_rec expr_t),
                        --let S2 := to_string expr_t,
                        let S3 := S1 ++ " : "++ S2,
                        trace(S3)
    | _ := skip
    end

/- Appelle l'analyse en 1 coup sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def analyse1 (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_expr_step goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace (analyse_expr_step expr_t)
    | _ := skip
    end

-- non utilisé
private meta def analyse_expr2 : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec expr_t,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

---------------------------------------------------------
----------------- Essai de rendu LateX, non abouti ------
---------------------------------------------------------

/- transforme une expression lean en expression latex
AMELIORER :
tenir compte de la profondeur de l'arbre pour décider si on met des prenthèses-/
/- ET, OU, SSI, QUELQUESOIT, IMPLIQUE, FONCTION, NON1, EXISTE,
INTER, UNION, INCLUS, APPARTIENT, COMPLEMENTAIRE1, IMAGE_ENSEMBLE, IMAGE_RECIPROQUE,
EGALITE, ENSEMBLE1, APPLICATION-/
meta def latex_expr : expr →  tactic string
| e := do
    ⟨string, liste_expr⟩ ←  analyse_expr_step e,
    if list.length liste_expr =2 then do
        let e1 := list.head liste_expr,
        let e2 := list.head (list.tail liste_expr),
        S1 ← latex_expr e1,
        S2 ← latex_expr e2,
        match string with
            | "ET" := return (S1 ++ " et " ++ S2)
            | "OU" := return (S1 ++ " ou " ++ S2)
            | "SSI" := return ("(" ++ S1 ++ "" ++") \\Leftrightarrow (" ++ S2 ++ ")")

            | "INCLUS" := return (S1 ++ "" ++" \\subset " ++ S2)
            | _ := return "ERREUR"
            end

    else if list.length liste_expr =1 then do
        let e1 := list.head liste_expr,
        S1 ← latex_expr e1,
        match string with
            | "NON" := return ("NON (" ++ S1 ++ ")")
            | "COMPLEMENTAIRE" := return (S1  ++ "^c")
            | _ := return "ERREUR"
            end
    else return (string)

meta def latex_buts : tactic unit :=
do liste_expr ← get_goals,
    trace "Buts :",
    -- liste_buts ← tactic.get_goals,
    -- types ← list.mmap tactic.infer_type liste_buts,
    -- trace types,
    liste_expr.mmap (λ h, latex_expr h >>= trace),
    return ()

meta def latex_but : tactic unit :=
do expr ← target,
    trace "But :",
    -- liste_buts ← tactic.get_goals,
    -- types ← list.mmap tactic.infer_type liste_buts,
    -- trace types,
    trace (latex_expr expr),
    return ()

----------------------------------------------
------------- DEBUGGAGE -------------------
-------------------------------------------

/- debug -/
private meta def analyse_expr_step_brut  (e : expr) : tactic (string × (list expr)) :=
match e with
-- autres
| (pi name binder type body ) := return ("pi (nom : " ++ to_string name ++ ")",[type,body])
| (app fonction argument)   := return ("application", [fonction,argument])
| (const name list_level)   := return ("constante :" ++ to_string name, []) -- name → list level → expr
| (var nat)       := return ("var_"++ to_string nat, []) --  nat → expr
| (sort level)      := return ("sort", [])  -- level → expr
| (mvar name pretty_name type)        := return ("metavar", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("constante_locale :" ++ to_string pretty_name, []) -- name → name → binder_info → expr → expr
| (lam name binder type body)          := return ("lambda (nom : " ++ to_string name ++ ")", [type,body]) -- name → binder_info → expr → expr → expr
| (elet name_var type_var expr body)        := return ("let", []) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("macro", []) -- macro_def → list expr → expr
end

/-  Debug -/
private meta def analyse_rec_brut : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step_brut e,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec_brut e1,
       return(string ++ "(" ++ string1 ++ ")")
    |[e1,e2] :=  do
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        if  string = "APPLICATION" then do
            { type2 ← infer_type e2,
            let string_type2 := to_string type2, -- trace string_type2,
            if (string_type2 = "Type" ) ∨ (trois_car (to_string(e2)) = "_in" ) -- Type  ou instance
                then return (string1)
                else return (string1 ++ "(" ++ string2 ++")")
            }   <|> return (string1 ++ "(" ++ string2 ++")")
            else return (string ++ "(" ++ string1 ++ "," ++ string2 ++ ")")
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        string3 ← analyse_rec_brut e3,
        return (string ++ "(" ++ string1 ++ "," ++ string2 ++ "," ++ string3 ++ ")")
    | _ :=    return(string)
    end

/- Debug -/
meta def analyse_brut (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_rec_brut goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                expr_tt ← infer_type expr_t,
                -- la suite différencie selon la sémantique,
                -- ie les objets (éléments, ensembles, fonctions)
                -- vs les propriétés
                if expr_tt = `(Prop) then
                    trace (analyse_rec_brut expr_t)
                else  do S1 ← (analyse_rec_brut expr),
                        S2 ← (analyse_rec_brut expr_t),
                        --let S2 := to_string expr_t,
                        let S3 := S1 ++ " : "++ S2,
                        trace(S3)
    | _ := skip
    end

-- débug
private meta def analyse_expr_brut : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec_brut expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec_brut expr_t,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte_brut : tactic unit :=
do liste_expr ← local_context,
    trace "Contexte :",
    liste_expr.mmap (λ h, analyse_expr_brut h >>= trace),
    return ()

/- Analyse brute de Lean (dans expr) -/
meta def analyse_raw (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace $ to_raw_fmt goal
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace $ to_raw_fmt expr_t
    | _ := skip
    end

end tactic.interactive

#print set

example (x:ℝ) :  x^2 ≥ 0 :=
begin
    analyse_contexte,
end


-- Hausdorff abelianization, i.e.
-- quotient by the closure of the commutator

import group_theory.abelianization
import .topological_group

universes u v

theorem list.prod_map {G : Type u} {H : Type v} [group G] [group H]
  (f : G → H) [is_group_hom f] {L : list G} :
  (L.map f).prod = f L.prod :=
list.rec_on L (eq.symm $ is_group_hom.one f) $ λ hd tl ih,
by simp [ih, is_group_hom.mul f]

def commutator_subgroup (G : Type u) [group G] (S : set G) : set G :=
{ z | ∃ L : list G, (∀ x ∈ L, ∃ p ∈ S, ∃ q ∈ S, x = p * q * p⁻¹ * q⁻¹) ∧ L.prod = z }

instance commutator_subgroup.subgroup
  (G : Type u) [group G] (S : set G) :
  is_subgroup (commutator_subgroup G S) :=
{ mul_mem := λ x y ⟨L1, h1, h2⟩ ⟨L2, h3, h4⟩, ⟨L1 ++ L2,
    list.forall_mem_append.2 ⟨h1, h3⟩,
    by simp [h2, h4]⟩,
  one_mem := ⟨[], by simp⟩,
  inv_mem := λ x ⟨L, h1, h2⟩, ⟨L.reverse.map has_inv.inv,
    λ x hx, let ⟨y, h3, h4⟩ := list.exists_of_mem_map hx in
      let ⟨p, hp, q, hq, h5⟩ := h1 y (list.mem_reverse.1 h3) in
      ⟨q, hq, p, hp, by rw [← h4, h5]; simp [mul_assoc]⟩,
    by rw ← h2; from list.rec_on L (by simp) (λ hd tl ih,
      by rw [list.reverse_cons, list.map_append, list.prod_append, ih]; simp)⟩ }

instance commutator_subgroup.normal_subgroup
  (G : Type u) [group G] (N : set G) [normal_subgroup N] :
  normal_subgroup (commutator_subgroup G N) :=
{ normal := λ x ⟨L, h1, h2⟩ g, ⟨L.map $ λ z, g * z * g⁻¹,
    λ x hx, let ⟨y, h3, h4⟩ := list.exists_of_mem_map hx in
      let ⟨p, hp, q, hq, h5⟩ := h1 y h3 in
      ⟨g * p * g⁻¹, normal_subgroup.normal _ hp _,
      g * q * g⁻¹, normal_subgroup.normal _ hq _,
      by rw [← h4, h5]; simp [mul_assoc]⟩,
    by rw ← h2; from list.rec_on L (by simp) (λ hd tl ih,
      by rw [list.map_cons, list.prod_cons, ih]; simp [mul_assoc])⟩ }

variables (G : Type u) (H : Type v)
variables [topological_space G] [group G] [topological_group G]
variables [topological_space H] [group H] [topological_group H]

def Hausdorff_abelianization : Type u :=
quotient_group.quotient (closure (commutator_subgroup G set.univ))

attribute [elab_as_eliminator] quotient_group.induction_on
instance Hausdorff_abelianization.comm_group : comm_group (Hausdorff_abelianization G) :=
{ mul_comm := λ x y, quotient_group.induction_on x $ λ m,
    quotient_group.induction_on y $ λ n, quotient_group.eq.2 $
    subset_closure ⟨[n⁻¹*m⁻¹*n*m], list.forall_mem_singleton.2
      ⟨n⁻¹, trivial, m⁻¹, trivial, by rw [inv_inv, inv_inv]⟩,
    by rw [list.prod_cons, list.prod_nil, mul_one, mul_inv_rev, ← mul_assoc]⟩,
  .. quotient_group.group _ }

instance Hausdorff_abelianization.topological_space : topological_space (Hausdorff_abelianization G) :=
quotient_group.topological_space _ _

instance Hausdorff_abelianization.topological_group : topological_group (Hausdorff_abelianization G) :=
quotient_group.topological_group _ _

variables {G H}
def Hausdorff_abelianization.map (f : G → H) [hf : is_topological_group_hom f] :
  Hausdorff_abelianization G → Hausdorff_abelianization H :=
quotient_group.map _ _ f $ (closure_subset_iff_subset_of_is_closed $
  continuous_iff_is_closed.1 (is_topological_group_hom.cts f) _ is_closed_closure).2 $
λ x ⟨L, hL, hLx⟩, subset_closure ⟨L.map f,
  λ c hcfL, let ⟨b, hbL, hfbc⟩ := list.exists_of_mem_map hcfL in
    let ⟨p, _, q, _, hb⟩ := hL b hbL in
    ⟨f p, trivial, f q, trivial, by rw [← hfbc, hb];
      simp only [is_group_hom.mul f, is_group_hom.inv f]⟩,
  by rw [list.prod_map f, hLx]⟩

set_option class.instance_max_depth 100
theorem Hausdorff_abelianization.induced.is_topological_group_hom
  (f : G → H) [hf : is_topological_group_hom f] :
  is_topological_group_hom (Hausdorff_abelianization.map f) :=
{ cts := continuous_coinduced_dom $
    show continuous (quotient_group.mk ∘ f),
    from hf.cts.comp continuous_coinduced_rng,
  .. quotient_group.is_group_hom_quotient_lift _ _ _ }


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebraic_geometry.presheafed_space
import topology.category.Top.limits
import topology.sheaves.limits
import category_theory.limits.concrete_category

/-!
# `PresheafedSpace C` has colimits.

If `C` has limits, then the category `PresheafedSpace C` has colimits,
and the forgetful functor to `Top` preserves these colimits.

When restricted to a diagram where the underlying continuous maps are open embeddings,
this says that we can glue presheaved spaces.

Given a diagram `F : J ⥤ PresheafedSpace C`,
we first build the colimit of the underlying topological spaces,
as `colimit (F ⋙ PresheafedSpace.forget C)`. Call that colimit space `X`.

Our strategy is to push each of the presheaves `F.obj j`
forward along the continuous map `colimit.ι (F ⋙ PresheafedSpace.forget C) j` to `X`.
Since pushforward is functorial, we obtain a diagram `J ⥤ (presheaf C X)ᵒᵖ`
of presheaves on a single space `X`.
(Note that the arrows now point the other direction,
because this is the way `PresheafedSpace C` is set up.)

The limit of this diagram then constitutes the colimit presheaf.
-/

noncomputable theory

universes v u

open category_theory
open Top
open Top.presheaf
open topological_space
open opposite
open category_theory.category
open category_theory.limits
open category_theory.functor

variables {J : Type v} [small_category J]
variables {C : Type u} [category.{v} C]

namespace algebraic_geometry

namespace PresheafedSpace

local attribute [simp] eq_to_hom_map

@[simp]
lemma map_id_c_app (F : J ⥤ PresheafedSpace C) (j) (U) :
  (F.map (𝟙 j)).c.app (op U) =
    (pushforward.id (F.obj j).presheaf).inv.app (op U) ≫
      (pushforward_eq (by { simp, refl }) (F.obj j).presheaf).hom.app (op U) :=
begin
  cases U,
  dsimp,
  simp [PresheafedSpace.congr_app (F.map_id j)],
  refl,
end

@[simp]

/--
Given a diagram of presheafed spaces,
we can push all the presheaves forward to the colimit `X` of the underlying topological spaces,
obtaining a diagram in `(presheaf C X)ᵒᵖ`.
-/
@[simps]
def pushforward_diagram_to_colimit (F : J ⥤ PresheafedSpace C) :
  J ⥤ (presheaf C (colimit (F ⋙ PresheafedSpace.forget C)))ᵒᵖ :=
{ obj := λ j, op ((colimit.ι (F ⋙ PresheafedSpace.forget C) j) _* (F.obj j).presheaf),
  map := λ j j' f,
  (pushforward_map (colimit.ι (F ⋙ PresheafedSpace.forget C) j') (F.map f).c ≫
    (pushforward.comp (F.obj j).presheaf ((F ⋙ PresheafedSpace.forget C).map f)
      (colimit.ι (F ⋙ PresheafedSpace.forget C) j')).inv ≫
    (pushforward_eq (colimit.w (F ⋙ PresheafedSpace.forget C) f) (F.obj j).presheaf).hom).op,
  map_id' := λ j,
  begin
    apply (op_equiv _ _).injective,
    ext U,
    induction U using opposite.rec,
    cases U,
    dsimp, simp, dsimp, simp,
  end,
  map_comp' := λ j₁ j₂ j₃ f g,
  begin
    apply (op_equiv _ _).injective,
    ext U,
    dsimp,
    simp only [map_comp_c_app, id.def, eq_to_hom_op, pushforward_map_app, eq_to_hom_map, assoc,
      id_comp, pushforward.comp_inv_app, pushforward_eq_hom_app],
    dsimp,
    simp only [eq_to_hom_trans, id_comp],
    congr' 1,
    -- The key fact is `(F.map f).c.congr`,
    -- which allows us in rewrite in the argument of `(F.map f).c.app`.
    rw (F.map f).c.congr,
    -- Now we pick up the pieces. First, we say what we want to replace that open set by:
    swap 3,
    refine op ((opens.map (colimit.ι (F ⋙ PresheafedSpace.forget C) j₂)).obj (unop U)),
    -- Now we show the open sets are equal.
    swap 2,
    { apply unop_injective,
      rw ←opens.map_comp_obj,
      congr,
      exact colimit.w (F ⋙ PresheafedSpace.forget C) g, },
    -- Finally, the original goal is now easy:
    swap 2,
    { simp, refl, },
  end, }

variables [has_limits C]

/--
Auxiliary definition for `PresheafedSpace.has_colimits`.
-/
def colimit (F : J ⥤ PresheafedSpace C) : PresheafedSpace C :=
{ carrier := colimit (F ⋙ PresheafedSpace.forget C),
  presheaf := limit (pushforward_diagram_to_colimit F).left_op, }

@[simp] lemma colimit_carrier (F : J ⥤ PresheafedSpace C) :
  (colimit F).carrier = limits.colimit (F ⋙ PresheafedSpace.forget C) := rfl

@[simp] lemma colimit_presheaf (F : J ⥤ PresheafedSpace C) :
  (colimit F).presheaf = limit (pushforward_diagram_to_colimit F).left_op := rfl

/--
Auxiliary definition for `PresheafedSpace.has_colimits`.
-/
@[simps]
def colimit_cocone (F : J ⥤ PresheafedSpace C) : cocone F :=
{ X := colimit F,
  ι :=
  { app := λ j,
    { base := colimit.ι (F ⋙ PresheafedSpace.forget C) j,
      c := limit.π _ (op j), },
    naturality' := λ j j' f,
    begin
      fapply PresheafedSpace.ext,
      { ext x,
        exact colimit.w_apply (F ⋙ PresheafedSpace.forget C) f x, },
      { ext U,
        induction U using opposite.rec,
        cases U,
        dsimp,
        simp only [PresheafedSpace.id_c_app, eq_to_hom_op, eq_to_hom_map, assoc,
          pushforward.comp_inv_app],
        rw ← congr_arg nat_trans.app (limit.w (pushforward_diagram_to_colimit F).left_op f.op),
        dsimp,
        simp only [eq_to_hom_op, eq_to_hom_map, assoc, id_comp, pushforward.comp_inv_app],
        congr,
        dsimp,
        simp only [id_comp],
        simpa, }
    end, }, }

namespace colimit_cocone_is_colimit

/--
Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-/
def desc_c_app (F : J ⥤ PresheafedSpace C) (s : cocone F) (U : (opens ↥(s.X.carrier))ᵒᵖ) :
  s.X.presheaf.obj U ⟶
    (colimit.desc (F ⋙ PresheafedSpace.forget C)
         ((PresheafedSpace.forget C).map_cocone s) _*
       limit (pushforward_diagram_to_colimit F).left_op).obj
      U :=
begin
  refine
    limit.lift _ { X := s.X.presheaf.obj U, π := { app := λ j, _, naturality' := λ j j' f, _, }} ≫
      (limit_obj_iso_limit_comp_evaluation _ _).inv,
  -- We still need to construct the `app` and `naturality'` fields omitted above.
  { refine (s.ι.app (unop j)).c.app U ≫ (F.obj (unop j)).presheaf.map (eq_to_hom _),
    dsimp,
    rw ←opens.map_comp_obj,
    simp, },
  { rw (PresheafedSpace.congr_app (s.w f.unop).symm U),
    dsimp,
    have w := functor.congr_obj (congr_arg opens.map
      (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (unop U),
    simp only [opens.map_comp_obj_unop] at w,
    replace w := congr_arg op w,
    have w' := nat_trans.congr (F.map f.unop).c w,
    rw w',
    dsimp, simp, dsimp, simp, },
end

lemma desc_c_naturality (F : J ⥤ PresheafedSpace C) (s : cocone F)
  {U V : (opens ↥(s.X.carrier))ᵒᵖ} (i : U ⟶ V) :
  s.X.presheaf.map i ≫ desc_c_app F s V =
  desc_c_app F s U ≫ (colimit.desc (F ⋙ forget C)
    ((forget C).map_cocone s) _* (colimit_cocone F).X.presheaf).map i :=
begin
  dsimp [desc_c_app],
  ext,
  simp only [limit.lift_π, nat_trans.naturality, limit.lift_π_assoc, eq_to_hom_map, assoc,
    pushforward_obj_map, nat_trans.naturality_assoc, op_map,
    limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc,
    limit_obj_iso_limit_comp_evaluation_inv_π_app],
  dsimp,
  have w := functor.congr_hom (congr_arg opens.map
    (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (i.unop),
  simp only [opens.map_comp_map] at w,
  replace w := congr_arg quiver.hom.op w,
  rw w,
  dsimp, simp,
end

/--
Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-/
def desc (F : J ⥤ PresheafedSpace C) (s : cocone F) : colimit F ⟶ s.X :=
{ base := colimit.desc (F ⋙ PresheafedSpace.forget C) ((PresheafedSpace.forget C).map_cocone s),
  c :=
  { app := λ U, desc_c_app F s U,
    naturality' := λ U V i, desc_c_naturality F s i } }

lemma desc_fac  (F : J ⥤ PresheafedSpace C) (s : cocone F) (j : J) :
  (colimit_cocone F).ι.app j ≫ desc F s = s.ι.app j :=
begin
  fapply PresheafedSpace.ext,
  { simp [desc] },
  { ext,
    dsimp [desc, desc_c_app],
    simpa }
end

end colimit_cocone_is_colimit

open colimit_cocone_is_colimit

/--
Auxiliary definition for `PresheafedSpace.has_colimits`.
-/
def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace C) : is_colimit (colimit_cocone F) :=
{ desc := λ s, desc F s,
  fac' := λ s, desc_fac F s,
  uniq' := λ s m w,
  begin
    -- We need to use the identity on the continuous maps twice, so we prepare that first:
    have t : m.base = colimit.desc (F ⋙ PresheafedSpace.forget C)
                        ((PresheafedSpace.forget C).map_cocone s),
    { apply category_theory.limits.colimit.hom_ext, intros j,
      apply continuous_map.ext, intros x,
      dsimp,
      simp only [colimit.ι_desc_apply, map_cocone_ι_app],
      rw ← w j,
      simp, },
    fapply PresheafedSpace.ext, -- could `ext` please not reorder goals?
    { exact t, },
    { ext U j, dsimp [desc, desc_c_app],
      simp only [limit.lift_π, eq_to_hom_op, eq_to_hom_map, assoc,
        limit_obj_iso_limit_comp_evaluation_inv_π_app],
      rw PresheafedSpace.congr_app (w (unop j)).symm U,
      dsimp,
      have w := congr_arg op (functor.congr_obj (congr_arg opens.map t) (unop U)),
      rw nat_trans.congr (limit.π (pushforward_diagram_to_colimit F).left_op j) w,
      simp }
  end, }

/--
When `C` has limits, the category of presheaved spaces with values in `C` itself has colimits.
-/
instance : has_colimits (PresheafedSpace C) :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone     := colimit_cocone F,
      is_colimit := colimit_cocone_is_colimit F } } }

/--
The underlying topological space of a colimit of presheaved spaces is
the colimit of the underlying topological spaces.
-/
instance forget_preserves_colimits : preserves_colimits (PresheafedSpace.forget C) :=
{ preserves_colimits_of_shape := λ J 𝒥, by exactI
  { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
    (colimit_cocone_is_colimit F)
    begin
      apply is_colimit.of_iso_colimit (colimit.is_colimit _),
      fapply cocones.ext,
      { refl, },
      { intro j, dsimp, simp, }
    end } }

/--
Given a diagram of `PresheafedSpace C`s, its colimit is computed by pushing the sheaves onto
the colimit of the underlying spaces, and taking componentwise limit.
This is the componentwise diagram for an open set `U` of the colimit of the underlying spaces.
-/
@[simps]
def componentwise_diagram (F : J ⥤ PresheafedSpace C)
  (U : opens (limits.colimit F).carrier) : Jᵒᵖ ⥤ C :=
{ obj := λ j, (F.obj (unop j)).presheaf.obj (op ((opens.map (colimit.ι F (unop j)).base).obj U)),
  map := λ j k f, (F.map f.unop).c.app _ ≫ (F.obj (unop k)).presheaf.map
    (eq_to_hom (by { rw [← colimit.w F f.unop, comp_base], refl })),
  map_comp' := λ i j k f g,
  begin
    cases U,
    dsimp,
    simp_rw [map_comp_c_app, category.assoc],
    congr' 1,
    rw [Top.presheaf.pushforward.comp_inv_app, Top.presheaf.pushforward_eq_hom_app,
      category_theory.nat_trans.naturality_assoc, Top.presheaf.pushforward_map_app],
    congr' 1,
    rw [category.id_comp, ← (F.obj (unop k)).presheaf.map_comp],
    erw ← (F.obj (unop k)).presheaf.map_comp,
    congr
  end }

/--
The components of the colimit of a diagram of `PresheafedSpace C` is obtained
via taking componentwise limits.
-/
def colimit_presheaf_obj_iso_componentwise_limit (F : J ⥤ PresheafedSpace C)
  (U : opens (limits.colimit F).carrier) :
  (limits.colimit F).presheaf.obj (op U) ≅ limit (componentwise_diagram F U) :=
begin
  refine ((sheaf_iso_of_iso (colimit.iso_colimit_cocone
    ⟨_, colimit_cocone_is_colimit F⟩).symm).app (op U)).trans _,
  refine (limit_obj_iso_limit_comp_evaluation _ _).trans (limits.lim.map_iso _),
  fapply nat_iso.of_components,
  { intro X,
    refine ((F.obj (unop X)).presheaf.map_iso (eq_to_iso _)),
    dsimp only [functor.op, unop_op, opens.map],
    congr' 2,
    rw set.preimage_preimage,
    simp_rw ← comp_app,
    congr' 2,
    exact ι_preserves_colimits_iso_inv (forget C) F (unop X) },
  { intros X Y f,
    change ((F.map f.unop).c.app _ ≫ _ ≫ _) ≫ (F.obj (unop Y)).presheaf.map _ = _ ≫ _,
    rw Top.presheaf.pushforward.comp_inv_app,
    erw category.id_comp,
    rw category.assoc,
    erw [← (F.obj (unop Y)).presheaf.map_comp, (F.map f.unop).c.naturality_assoc,
      ← (F.obj (unop Y)).presheaf.map_comp],
    congr }
end

@[simp]
lemma colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app (F : J ⥤ PresheafedSpace C)
  (U : opens (limits.colimit F).carrier) (j : J) :
  (colimit_presheaf_obj_iso_componentwise_limit F U).inv ≫ (colimit.ι F j).c.app (op U) =
    limit.π _ (op j) :=
begin
  delta colimit_presheaf_obj_iso_componentwise_limit,
  rw [iso.trans_inv, iso.trans_inv, iso.app_inv, sheaf_iso_of_iso_inv, pushforward_to_of_iso_app,
    congr_app (iso.symm_inv _)],
  simp_rw category.assoc,
  rw [← functor.map_comp_assoc, nat_trans.naturality],
  erw ← comp_c_app_assoc,
  rw congr_app (colimit.iso_colimit_cocone_ι_hom _ _),
  simp_rw category.assoc,
  erw [limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc, lim_map_π_assoc],
  convert category.comp_id _,
  erw ← (F.obj j).presheaf.map_id,
  iterate 2 { erw ← (F.obj j).presheaf.map_comp },
  congr
end

@[simp]
lemma colimit_presheaf_obj_iso_componentwise_limit_hom_π (F : J ⥤ PresheafedSpace C)
  (U : opens (limits.colimit F).carrier) (j : J) :
    (colimit_presheaf_obj_iso_componentwise_limit F U).hom ≫ limit.π _ (op j) =
      (colimit.ι F j).c.app (op U) :=
by rw [← iso.eq_inv_comp, colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app]

end PresheafedSpace

end algebraic_geometry


import SciLean.Basic
import SciLean.Tactic
import SciLean.Operators.Calculus.RevCore

namespace SciLean

variable {α β γ : Type}
variable {X Y Z : Type} [Hilbert X] [Hilbert Y] [Hilbert Z]
variable {ι κ : Type} [Enumtype ι] [Enumtype κ]

variable {n : Nat} [NonZero n]

-- set_option trace.Meta.Tactic.simp true in
example
  : 𝓑 (λ x : Fin n → Fin 3 → ℝ => ∑ i j, ∥x i - x j∥²)
    =
    0 :=
by
  simp
  simp
  admit

instance (x y : X) : HasAdjoint λ dx => ∂ (λ x y : X => x - y) x dx y :=
by
  simp infer_instance done

instance (x y : X) : HasAdjoint λ dy => ∂ (λ y : X => x - y) y dy :=
by
  simp
  infer_instance done

variable (f : (α → (β×(β→α))))

@[simp]
theorem reverse_comp_id {α β : Type} (f : (α → (β×(β→α))))
  : f • (λ x => (x, λ dx => dx)) = f :=
by
  funext x; simp[reverse_comp]
  conv => lhs; enter [2,x]; simp
  done

@[simp]
theorem reverse_id_comp {α β : Type} (f : (α → (β×(β→α))))
  : (λ x => (x, λ dx => dx)) • f = f :=
by
  funext x; simp[reverse_comp]
  conv => lhs; enter [2,x]; simp
  done

example (i j : Fin n)
  : (𝓑 fun (x : Fin n → X) => x i - x j)
    =
    (fun x : X×X => (x.1 - x.2, fun dx : X => (dx, -dx))) •
      ReverseDiff.reverse_lmap
        (fun fx : Fin n → X => (fx i, fun (dv : X) k => kron i k * dv))
        (fun fx : Fin n → X => (fx j, fun (dv : X) k => kron j k * dv))
   :=
by
  simp
  simp[reverse_diff, Function.uncurry, adjoint_differential]
  done

-- These collect what needs to be defined for atomic functions

section NN
  variable {X₀ X₁ X₂ X₃ : Type} [Hilbert X₀] [Hilbert X₁] [Hilbert X₂] [Hilbert X₃]
  variable {W₁ W₂ : Type} [Hilbert W₁] [Hilbert W₂] [Hilbert W₃]
  variable (f₁ : W₁ → X₀ → X₁) [IsSmooth f₁] [∀ w, IsSmooth (f₁ w)]
     [∀ w x, HasAdjoint λ dw => ∂ f₁ w dw x]
     [∀ w x, HasAdjoint λ dx => ∂ (f₁ w) x dx]
  variable (f₂ : W₂ → X₁ → X₂) [IsSmooth f₂] [∀ w, IsSmooth (f₂ w)]
     [∀ w x, HasAdjoint λ dw => ∂ f₂ w dw x]
     [∀ w x, HasAdjoint λ dx => ∂ (f₂ w) x dx]
  variable (f₃ : W₃ → X₂ → X₃) [IsSmooth f₃] [∀ w, IsSmooth (f₃ w)]
     [∀ w x, HasAdjoint λ dw => ∂ f₃ w dw x]
     [∀ w x, HasAdjoint λ dx => ∂ (f₃ w) x dx]

     -- [∀ x₀ (x : W₁ × W₂), SciLean.HasAdjoint (SciLean.differential (fun x => f₁ x.1 x₀) x)]
     -- [∀ (x₀ : X₀) (x : W₁ × W₂), SciLean.HasAdjoint (SciLean.differential (fun x => x₀) x)]

  instance (x : W₁ × W₂) : SciLean.HasAdjoint (∂ (fun x => x.1) x) := sorry
  instance (x : W₁ × W₂) : SciLean.HasAdjoint (∂ (fun x => x.2) x) := sorry

  instance (f : X → W₁×W₂) [IsSmooth f] [HasAdjoint (∂ f x)] : SciLean.HasAdjoint (∂ (fun x => (f x).1) x) := by simp admit
  instance (f : X → W₁×W₂) [IsSmooth f] [HasAdjoint (∂ f x)] : SciLean.HasAdjoint (∂ (fun x => (f x).2) x) := by simp admit

  -- instance : ∀ (x : W₁ × W₂ × W₃), SciLean.HasAdjoint (SciLean.differential (fun x => x.2.2) x) := by infer_instance done

  -- set_option trace.Meta.synthInstance true in
  -- instance : IsSmooth (λ ((w₁,w₂,w₃) : W₁ × W₂ × W₃) => w₃) := by  infer_instance

  @[simp]
  theorem reverse_diff_of_id
    : 𝓑 (λ x : X => x) = λ x => (x, λ dx => dx) := by simp[reverse_diff, adjoint_differential] done

  @[simp]
  theorem reverse_diff_of_const (y : Y)
    : 𝓑 (λ x : X => y) = λ x => (y, λ dy : Y => (0:X)) := by simp[reverse_diff, adjoint_differential] done

  @[simp]
  theorem reverse_diff_of_fst
    : 𝓑 (λ xy : X×Y => xy.1) = λ xy => (xy.1, λ dx => (dx, (0:Y))) := by simp[reverse_diff, adjoint_differential] done

  @[simp]
  theorem reverse_diff_of_snd
    : 𝓑 (λ xy : X×Y => xy.2) = λ xy => (xy.2, λ dy => ((0:X), dy)) := by simp[reverse_diff, adjoint_differential] done

  @[simp]
  theorem reverse_diff_of_fst_comp (f : X → Y×Z) [IsSmooth f] [∀ x, HasAdjoint (∂ f x)]
    : 𝓑 (λ x : X => (f x).1) = (λ yz => (yz.1, λ dy => (dy, (0:Z)))) • 𝓑 f :=
  by
    funext x; simp[reverse_diff,reverse_comp]
    funext dy; simp
    admit

  @[simp]
  theorem reverse_diff_of_snd_comp (f : X → Y×Z) [IsSmooth f] [∀ x, HasAdjoint (∂ f x)]
    : 𝓑 (λ x : X => (f x).2) = (λ yz => (yz.2, λ dz => ((0:Y), dz))) • 𝓑 f :=
  by
    funext x; simp[reverse_diff,reverse_comp]
    funext dy; simp
    admit

  -- instance : SciLean.IsSmooth fun x => f₂ x.2.1 (f₁ x.1 x₀)
  -- set_option trace.Meta.synthInstance true in
  -- set_option maxHeartbeats 1000000 in
  -- set_option synthInstance.maxHeartbeats 500000 in
  set_option synthInstance.maxSize 20480 in
  -- set_option trace.Meta.Tactic.simp.discharge true in
  example (x₀ : X₀)
    -- : 𝓑 (λ (w₁,w₂,w₃) => x₀ |> f₁ w₁ |> f₂ w₂ |> f₃ w₃) = 0 :=
    : 𝓑 (λ (w₁,w₂,w₃) => x₀ |> f₁ w₁ |> f₂ w₂ |> f₃ w₃) = 0 :=
  by
    simp
    conv =>
      lhs
      conv =>
        enter [2,1]
        simp [reverse_comp, Function.comp]
      conv =>
        enter [2,2,2,1]
        simp [reverse_comp, Function.comp]
      conv =>
        enter [2,2,2,2,2]
        simp [reverse_comp, Function.comp, ReverseDiff.reverse_lmap]
    .
    -- simp (config := {singlePass := true})

    -- simp[reverse_diff,Function.uncurry]
    -- -- unfold hold
    -- unfold_atomic
    -- simp[AtomicAdjointFun.adj,ReverseDiff.reverse_lmap]
    -- unfold hold

    unfold hold
    admit

end NN

#check Sigma

structure HArray (Ts : List Type) where
  data : Array (Sigma (λ T : Type => T))
  h_len : Ts.length = data.size
  typed : ∀ i : Fin Ts.length, (data.get (h_len ▸ i)).1 = Ts.get i

namespace HArray

  variable {n} {Ts : List Type}

  def get (u : HArray Ts) (i : Fin Ts.length) : Ts.get i
    := u.typed i ▸ (u.data.get (u.h_len ▸ i)).2

  def getOp (self : HArray Ts) (idx : Fin Ts.length) : Ts.get idx
    := self.typed idx ▸ (self.data.get (self.h_len ▸ idx)).2

  def set (u : HArray Ts) (i : Fin Ts.length) (x : Ts.get i) : HArray Ts
    := ⟨u.data.set (u.h_len ▸ i) (⟨_, x⟩), sorry, sorry⟩

end HArray

class HCurryType (n : Nat) (F : Type) where
  Xs : List Type
  Y  : Type

attribute [reducible] HCurryType.Xs HCurryType.Y

@[reducible]
instance : HCurryType 0 Y where
  Xs := []
  Y := Y

@[reducible]
instance [t : HCurryType n Y] : HCurryType (n + 1) (X → Y) where
  Xs := X::t.Xs
  Y := t.Y

class HCurryImpl (i : Nat) (Xs' Xs : List Type) (Y : Type) where
  index_valid : Xs'.length + i = Xs.length
  types_valid : ∀ j, i + j < Xs.length → Xs'.get ⟨j, sorry⟩ = Xs.get ⟨i + j, sorry⟩
  G : Type
  uncurry : G → (HArray Xs → Y)

attribute [reducible] HCurryImpl.G HCurryImpl.uncurry

@[reducible]
instance (Xs : List Type) (Y : Type) : HCurryImpl n [] Xs Y where
  index_valid := sorry
  types_valid := sorry
  G := Y
  uncurry := λ y xs => y

@[reducible]
instance [c : HCurryImpl (i+1) (Xs') Xs Y] : HCurryImpl (i) (X'::Xs') Xs Y where
  index_valid := sorry
  types_valid := sorry
  G := X' → c.G
  uncurry := λ f xs =>
    let h : (Xs.get ⟨i,sorry⟩ = X') := sorry
    let xi : X' := (h ▸ xs[⟨i,sorry⟩])
    c.uncurry (f xi) xs

def huncurry (n : Nat) {F : Type} [HCurryType n F]
  [ci : HCurryImpl 0 (HCurryType.Xs n F) (HCurryType.Xs n F) (HCurryType.Y n F)]
  (f : F) :=
    let h : F = ci.G := sorry
    ci.uncurry (h ▸ f)

-- example : huncurry 3 (λ (i j k : Nat) => i + j)
--           =
--           λ xs => xs[⟨0, by decide⟩] + xs[⟨1, by decide⟩] := by simp[huncurry]


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

! This file was ported from Lean 3 source module algebra.homology.Module
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.Homotopy
import Mathbin.Algebra.Category.Module.Abelian
import Mathbin.Algebra.Category.Module.Subobject
import Mathbin.CategoryTheory.Limits.ConcreteCategory

/-!
# Complexes of modules

We provide some additional API to work with homological complexes in `Module R`.
-/

universe v u

open Classical

noncomputable section

open CategoryTheory CategoryTheory.Limits HomologicalComplex

variable {R : Type v} [Ring R]

variable {ι : Type _} {c : ComplexShape ι} {C D : HomologicalComplex (ModuleCat.{u} R) c}

namespace ModuleCat

/-- To prove that two maps out of a homology group are equal,
it suffices to check they are equal on the images of cycles.
-/
theorem homology_ext {L M N K : ModuleCat R} {f : L ⟶ M} {g : M ⟶ N} (w : f ≫ g = 0)
    {h k : homology f g w ⟶ K}
    (w :
      ∀ x : LinearMap.ker g,
        h (cokernel.π (imageToKernel _ _ w) (toKernelSubobject x)) =
          k (cokernel.π (imageToKernel _ _ w) (toKernelSubobject x))) :
    h = k := by
  refine' cokernel_funext fun n => _
  -- Gosh it would be nice if `equiv_rw` could directly use an isomorphism, or an enriched `≃`.
  equiv_rw(kernel_subobject_iso g ≪≫ ModuleCat.kernelIsoKer g).toLinearEquiv.toEquiv  at n
  convert w n <;> simp [to_kernel_subobject]
#align Module.homology_ext ModuleCat.homology_ext

/-- Bundle an element `C.X i` such that `C.d_from i x = 0` as a term of `C.cycles i`. -/
abbrev toCycles {C : HomologicalComplex (ModuleCat.{u} R) c} {i : ι}
    (x : LinearMap.ker (C.dFrom i)) : C.cycles i :=
  toKernelSubobject x
#align Module.to_cycles ModuleCat.toCycles

@[ext]
theorem cycles_ext {C : HomologicalComplex (ModuleCat.{u} R) c} {i : ι} {x y : C.cycles i}
    (w : (C.cycles i).arrow x = (C.cycles i).arrow y) : x = y :=
  by
  apply_fun (C.cycles i).arrow using (ModuleCat.mono_iff_injective _).mp (cycles C i).arrow_mono
  exact w
#align Module.cycles_ext ModuleCat.cycles_ext

attribute [local instance] concrete_category.has_coe_to_sort

@[simp]
theorem cyclesMap_toCycles (f : C ⟶ D) {i : ι} (x : LinearMap.ker (C.dFrom i)) :
    (cyclesMap f i) (toCycles x) = toCycles ⟨f.f i x.1, by simp [x.2]⟩ :=
  by
  ext
  simp
#align Module.cycles_map_to_cycles ModuleCat.cyclesMap_toCycles

/-- Build a term of `C.homology i` from an element `C.X i` such that `C.d_from i x = 0`. -/
abbrev toHomology {C : HomologicalComplex (ModuleCat.{u} R) c} {i : ι}
    (x : LinearMap.ker (C.dFrom i)) : C.homology i :=
  homology.π (C.dTo i) (C.dFrom i) _ (toCycles x)
#align Module.to_homology ModuleCat.toHomology

@[ext]
theorem homology_ext' {M : ModuleCat R} (i : ι) {h k : C.homology i ⟶ M}
    (w : ∀ x : LinearMap.ker (C.dFrom i), h (toHomology x) = k (toHomology x)) : h = k :=
  homology_ext _ w
#align Module.homology_ext' ModuleCat.homology_ext'

/-- We give an alternative proof of `homology_map_eq_of_homotopy`,
specialized to the setting of `V = Module R`,
to demonstrate the use of extensionality lemmas for homology in `Module R`. -/
example (f g : C ⟶ D) (h : Homotopy f g) (i : ι) :
    (homologyFunctor (ModuleCat.{u} R) c i).map f = (homologyFunctor (ModuleCat.{u} R) c i).map g :=
  by
  -- To check that two morphisms out of a homology group agree, it suffices to check on cycles:
  ext
  simp only [homologyFunctor_map, homology.π_map_apply]
  -- To check that two elements are equal mod boundaries, it suffices to exhibit a boundary:
  ext1
  swap; exact (toPrev i h.hom) x.1
  -- Moreover, to check that two cycles are equal, it suffices to check their underlying elements:
  ext1
  simp only [map_add, imageToKernel_arrow_apply, HomologicalComplex.Hom.sqFrom_left,
    ModuleCat.toKernelSubobject_arrow, CategoryTheory.Limits.kernelSubobjectMap_arrow_apply,
    dNext_eq_dFrom_fromNext, Function.comp_apply, zero_add, ModuleCat.coe_comp, LinearMap.add_apply,
    map_zero, Subtype.val_eq_coe, CategoryTheory.Limits.imageSubobject_arrow_comp_apply,
    LinearMap.map_coe_ker, prevD_eq_toPrev_dTo, h.comm i, x.2]
  abel

end ModuleCat


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

! This file was ported from Lean 3 source module algebra.module.graded_module
! leanprover-community/mathlib commit 59cdeb0da2480abbc235b7e611ccd9a7e5603d7c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.GradedAlgebra.Basic
import Mathbin.Algebra.GradedMulAction
import Mathbin.Algebra.DirectSum.Decomposition
import Mathbin.Algebra.Module.BigOperators

/-!
# Graded Module

Given an `R`-algebra `A` graded by `𝓐`, a graded `A`-module `M` is expressed as
`direct_sum.decomposition 𝓜` and `set_like.has_graded_smul 𝓐 𝓜`.
Then `⨁ i, 𝓜 i` is an `A`-module and is isomorphic to `M`.

## Tags

graded module
-/

section

open DirectSum

variable {ι : Type _} (A : ι → Type _) (M : ι → Type _)

namespace DirectSum

open GradedMonoid

/-- A graded version of `distrib_mul_action`. -/
class GdistribMulAction [AddMonoid ι] [GMonoid A] [∀ i, AddMonoid (M i)] extends
  GMulAction A M where
  smul_add {i j} (a : A i) (b c : M j) : smul a (b + c) = smul a b + smul a c
  smul_zero {i j} (a : A i) : smul a (0 : M j) = 0
#align direct_sum.gdistrib_mul_action DirectSum.GdistribMulAction

/-- A graded version of `module`. -/
class Gmodule [AddMonoid ι] [∀ i, AddMonoid (A i)] [∀ i, AddMonoid (M i)] [GMonoid A] extends
  GdistribMulAction A M where
  add_smul {i j} (a a' : A i) (b : M j) : smul (a + a') b = smul a b + smul a' b
  zero_smul {i j} (b : M j) : smul (0 : A i) b = 0
#align direct_sum.gmodule DirectSum.Gmodule

/-- A graded version of `semiring.to_module`. -/
instance Gsemiring.toGmodule [DecidableEq ι] [AddMonoid ι] [∀ i : ι, AddCommMonoid (A i)]
    [Gsemiring A] : Gmodule A A :=
  { GMonoid.toGMulAction A with
    smul_add := fun _ _ => Gsemiring.mul_add
    smul_zero := fun i j => Gsemiring.mul_zero
    add_smul := fun i j => Gsemiring.add_mul
    zero_smul := fun i j => Gsemiring.zero_mul }
#align direct_sum.gsemiring.to_gmodule DirectSum.Gsemiring.toGmodule

variable [AddMonoid ι] [∀ i : ι, AddCommMonoid (A i)] [∀ i, AddCommMonoid (M i)]

/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/
@[simps]
def gsmulHom [GMonoid A] [Gmodule A M] {i j} : A i →+ M j →+ M (i + j)
    where
  toFun a :=
    { toFun := fun b => GSmul.smul a b
      map_zero' := GdistribMulAction.smul_zero _
      map_add' := GdistribMulAction.smul_add _ }
  map_zero' := AddMonoidHom.ext fun a => Gmodule.zero_smul a
  map_add' a₁ a₂ := AddMonoidHom.ext fun b => Gmodule.add_smul _ _ _
#align direct_sum.gsmul_hom DirectSum.gsmulHom

namespace Gmodule

/-- For graded monoid `A` and a graded module `M` over `A`. `gmodule.smul_add_monoid_hom` is the
`⨁ᵢ Aᵢ`-scalar multiplication on `⨁ᵢ Mᵢ` induced by `gsmul_hom`. -/
def smulAddMonoidHom [DecidableEq ι] [GMonoid A] [Gmodule A M] :
    (⨁ i, A i) →+ (⨁ i, M i) →+ ⨁ i, M i :=
  toAddMonoid fun i =>
    AddMonoidHom.flip <|
      toAddMonoid fun j => AddMonoidHom.flip <| (of M _).compHom.comp <| gsmulHom A M
#align direct_sum.gmodule.smul_add_monoid_hom DirectSum.Gmodule.smulAddMonoidHom

section

open GradedMonoid DirectSum Gmodule

instance [DecidableEq ι] [GMonoid A] [Gmodule A M] : SMul (⨁ i, A i) (⨁ i, M i)
    where smul x y := smulAddMonoidHom A M x y

@[simp]
theorem smul_def [DecidableEq ι] [GMonoid A] [Gmodule A M] (x : ⨁ i, A i) (y : ⨁ i, M i) :
    x • y = smulAddMonoidHom _ _ x y :=
  rfl
#align direct_sum.gmodule.smul_def DirectSum.Gmodule.smul_def

@[simp]
theorem smulAddMonoidHom_apply_of_of [DecidableEq ι] [GMonoid A] [Gmodule A M] {i j} (x : A i)
    (y : M j) :
    smulAddMonoidHom A M (DirectSum.of A i x) (of M j y) = of M (i + j) (GSmul.smul x y) := by
  simp [smul_add_monoid_hom]
#align direct_sum.gmodule.smul_add_monoid_hom_apply_of_of DirectSum.Gmodule.smulAddMonoidHom_apply_of_of

@[simp]
theorem of_smul_of [DecidableEq ι] [GMonoid A] [Gmodule A M] {i j} (x : A i) (y : M j) :
    DirectSum.of A i x • of M j y = of M (i + j) (GSmul.smul x y) :=
  smulAddMonoidHom_apply_of_of _ _ _ _
#align direct_sum.gmodule.of_smul_of DirectSum.Gmodule.of_smul_of

open AddMonoidHom

-- Almost identical to the proof of `direct_sum.one_mul`
private theorem one_smul [DecidableEq ι] [GMonoid A] [Gmodule A M] (x : ⨁ i, M i) :
    (1 : ⨁ i, A i) • x = x :=
  by
  suffices smulAddMonoidHom A M 1 = AddMonoidHom.id (⨁ i, M i) from AddMonoidHom.congr_fun this x
  apply DirectSum.addHom_ext; intro i xi
  unfold One.one
  rw [smul_add_monoid_hom_apply_of_of]
  exact DirectSum.of_eq_of_gradedMonoid_eq (one_smul (GradedMonoid A) <| GradedMonoid.mk i xi)
#align direct_sum.gmodule.one_smul direct_sum.gmodule.one_smul

-- Almost identical to the proof of `direct_sum.mul_assoc`
private theorem mul_smul [DecidableEq ι] [Gsemiring A] [Gmodule A M] (a b : ⨁ i, A i)
    (c : ⨁ i, M i) : (a * b) • c = a • b • c :=
  by
  suffices
    (-- `λ a b c, (a * b) • c` as a bundled hom
              smulAddMonoidHom
              A M).compHom.comp
        (DirectSum.mulHom A) =
      (AddMonoidHom.compHom AddMonoidHom.flipHom <|
          (smulAddMonoidHom A M).flip.compHom.comp <| smulAddMonoidHom A M).flip
    from-- `λ a b c, a • (b • c)` as a bundled hom
      AddMonoidHom.congr_fun
      (AddMonoidHom.congr_fun (AddMonoidHom.congr_fun this a) b) c
  ext (ai ax bi bx ci cx) : 6
  dsimp only [coe_comp, Function.comp_apply, comp_hom_apply_apply, flip_apply, flip_hom_apply]
  rw [smul_add_monoid_hom_apply_of_of, smul_add_monoid_hom_apply_of_of, DirectSum.mulHom_of_of,
    smul_add_monoid_hom_apply_of_of]
  exact
    DirectSum.of_eq_of_gradedMonoid_eq
      (mul_smul (GradedMonoid.mk ai ax) (GradedMonoid.mk bi bx) (GradedMonoid.mk ci cx))
#align direct_sum.gmodule.mul_smul direct_sum.gmodule.mul_smul

/-- The `module` derived from `gmodule A M`. -/
instance module [DecidableEq ι] [Gsemiring A] [Gmodule A M] : Module (⨁ i, A i) (⨁ i, M i)
    where
  smul := (· • ·)
  one_smul := one_smul _ _
  mul_smul := mul_smul _ _
  smul_add r := (smulAddMonoidHom A M r).map_add
  smul_zero r := (smulAddMonoidHom A M r).map_zero
  add_smul r s x := by simp only [smul_def, map_add, AddMonoidHom.add_apply]
  zero_smul x := by simp only [smul_def, map_zero, AddMonoidHom.zero_apply]
#align direct_sum.gmodule.module DirectSum.Gmodule.module

end

end Gmodule

end DirectSum

end

open DirectSum BigOperators

variable {ι R A M σ σ' : Type _}

variable [AddMonoid ι] [CommSemiring R] [Semiring A] [Algebra R A]

variable (𝓐 : ι → σ') [SetLike σ' A]

variable (𝓜 : ι → σ)

namespace SetLike

include σ' A σ M

instance gmulAction [AddMonoid M] [DistribMulAction A M] [SetLike σ M] [SetLike.GradedMonoid 𝓐]
    [SetLike.GradedSmul 𝓐 𝓜] : GradedMonoid.GMulAction (fun i => 𝓐 i) fun i => 𝓜 i :=
  {
    SetLike.toGSmul 𝓐
      𝓜 with
    one_smul := fun ⟨i, m⟩ => Sigma.subtype_ext (zero_add _) (one_smul _ _)
    mul_smul := fun ⟨i, a⟩ ⟨j, a'⟩ ⟨k, b⟩ => Sigma.subtype_ext (add_assoc _ _ _) (mul_smul _ _ _) }
#align set_like.gmul_action SetLike.gmulAction

instance gdistribMulAction [AddMonoid M] [DistribMulAction A M] [SetLike σ M]
    [AddSubmonoidClass σ M] [SetLike.GradedMonoid 𝓐] [SetLike.GradedSmul 𝓐 𝓜] :
    DirectSum.GdistribMulAction (fun i => 𝓐 i) fun i => 𝓜 i :=
  {
    SetLike.gmulAction 𝓐
      𝓜 with
    smul_add := fun i j a b c => Subtype.ext <| smul_add _ _ _
    smul_zero := fun i j a => Subtype.ext <| smul_zero _ }
#align set_like.gdistrib_mul_action SetLike.gdistribMulAction

variable [AddCommMonoid M] [Module A M] [SetLike σ M] [AddSubmonoidClass σ' A]
  [AddSubmonoidClass σ M] [SetLike.GradedMonoid 𝓐] [SetLike.GradedSmul 𝓐 𝓜]

/-- `[set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜]` is the internal version of graded
  module, the internal version can be translated into the external version `gmodule`. -/
instance gmodule : DirectSum.Gmodule (fun i => 𝓐 i) fun i => 𝓜 i :=
  {
    SetLike.gdistribMulAction 𝓐
      𝓜 with
    smul := fun i j x y => ⟨(x : A) • (y : M), SetLike.GradedSmul.smul_mem x.2 y.2⟩
    add_smul := fun i j a a' b => Subtype.ext <| add_smul _ _ _
    zero_smul := fun i j b => Subtype.ext <| zero_smul _ _ }
#align set_like.gmodule SetLike.gmodule

end SetLike

namespace GradedModule

include σ' A σ M

variable [AddCommMonoid M] [Module A M] [SetLike σ M] [AddSubmonoidClass σ' A]
  [AddSubmonoidClass σ M] [SetLike.GradedMonoid 𝓐] [SetLike.GradedSmul 𝓐 𝓜]

/-- The smul multiplication of `A` on `⨁ i, 𝓜 i` from `(⨁ i, 𝓐 i) →+ (⨁ i, 𝓜 i) →+ ⨁ i, 𝓜 i`
turns `⨁ i, 𝓜 i` into an `A`-module
-/
def isModule [DecidableEq ι] [GradedRing 𝓐] : Module A (⨁ i, 𝓜 i) :=
  { Module.compHom _ (DirectSum.decomposeRingEquiv 𝓐 : A ≃+* ⨁ i, 𝓐 i).toRingHom with
    smul := fun a b => DirectSum.decompose 𝓐 a • b }
#align graded_module.is_module GradedModule.isModule

attribute [local instance] GradedModule.isModule

/-- `⨁ i, 𝓜 i` and `M` are isomorphic as `A`-modules.
"The internal version" and "the external version" are isomorphism as `A`-modules.
-/
def linearEquiv [DecidableEq ι] [GradedRing 𝓐] [DirectSum.Decomposition 𝓜] : M ≃ₗ[A] ⨁ i, 𝓜 i :=
  {
    DirectSum.decomposeAddEquiv
      𝓜 with
    toFun := DirectSum.decomposeAddEquiv 𝓜
    map_smul' := fun x y => by
      classical
        rw [← DirectSum.sum_support_decompose 𝓐 x, map_sum, Finset.sum_smul, map_sum,
          Finset.sum_smul, Finset.sum_congr rfl fun i hi => _]
        rw [RingHom.id_apply, ← DirectSum.sum_support_decompose 𝓜 y, map_sum, Finset.smul_sum,
          map_sum, Finset.smul_sum, Finset.sum_congr rfl fun j hj => _]
        simp only [(· • ·), DirectSum.decomposeAddEquiv_apply, DirectSum.decompose_coe,
          DirectSum.Gmodule.smulAddMonoidHom_apply_of_of]
        convert DirectSum.decompose_coe 𝓜 _
        rfl }
#align graded_module.linear_equiv GradedModule.linearEquiv

end GradedModule


def f (x : Nat) : Nat :=
match x with
| 30  => 31
| y+1 => y
| 0   => 10

#eval f 20
#eval f 0
#eval f 30

universes u

theorem ex1 {α : Sort u} {a b : α} (h : a ≅ b) : a = b :=
match α, a, b, h with
| _, _, _, HEq.refl _ => rfl

theorem ex2 {α : Sort u} {a b : α} (h : a ≅ b) : a = b :=
match a, b, h with
| _, _, HEq.refl _ => rfl

theorem ex3 {α : Sort u} {a b : α} (h : a ≅ b) : a = b :=
match b, h with
| _, HEq.refl _ => rfl

theorem ex4  {α β : Sort u} {b : β} {a a' : α} (h₁ : a = a') (h₂ : a' ≅ b) : a ≅ b :=
match β, a', b, h₁, h₂ with
| _, _, _, rfl, HEq.refl _ => HEq.refl _

theorem ex5  {α β : Sort u} {b : β} {a a' : α} (h₁ : a = a') (h₂ : a' ≅ b) : a ≅ b :=
match a', h₁, h₂ with
| _, rfl, h₂ => h₂

theorem ex6  {α β : Sort u} {b : β} {a a' : α} (h₁ : a = a') (h₂ : a' ≅ b) : a ≅ b :=
by {
  subst h₁;
  assumption
}

theorem ex7 (a : Bool) (p q : Prop) (h₁ : a = true → p) (h₂ : a = false → q) : p ∨ q :=
  match (generalizing := false) h:a with
  | true  => Or.inl $ h₁ h
  | false => Or.inr $ h₂ h

theorem ex7' (a : Bool) (p q : Prop) (h₁ : a = true → p) (h₂ : a = false → q) : p ∨ q :=
  match a with
  | true  => Or.inl $ h₁ rfl
  | false => Or.inr $ h₂ rfl

def head {α} (xs : List α) (h : xs = [] → False) : α :=
  match he:xs with
  | []   => by contradiction
  | x::_ => x

variable {α : Type u} {p : α → Prop}

theorem ex8 {a1 a2 : {x // p x}} (h : a1.val = a2.val) : a1 = a2 :=
match a1, a2, h with
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl

universes v
variable {β : α → Type v}

theorem ex9 {p₁ p₂ : Sigma (fun a => β a)} (h₁ : p₁.1 = p₂.1) (h : p₁.2 ≅ p₂.2) : p₁ = p₂ :=
match p₁, p₂, h₁, h with
| ⟨_, _⟩, ⟨_, _⟩, rfl, HEq.refl _ => rfl

inductive F : Nat → Type
| z : {n : Nat} → F (n+1)
| s : {n : Nat} → F n → F (n+1)

def f0 {α : Sort u} (x : F 0) : α :=
nomatch x

def f0' {α : Sort u} (x : F 0) : α :=
nomatch id x

def f1 {α : Sort u} (x : F 0 × Bool) : α :=
nomatch x

def f2 {α : Sort u} (x : Sum (F 0) (F 0)) : α :=
nomatch x

def f3 {α : Sort u} (x : Bool × F 0) : α :=
nomatch x

def f4 (x : Sum (F 0 × Bool) Nat) : Nat :=
match x with
| Sum.inr x => x

#eval f4 $ Sum.inr 100


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou

! This file was ported from Lean 3 source module category_theory.idempotents.functor_extension
! leanprover-community/mathlib commit 5f68029a863bdf76029fa0f7a519e6163c14152e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Idempotents.Karoubi

/-!
# Extension of functors to the idempotent completion

In this file, we construct an extension `functor_extension₁`
of functors `C ⥤ karoubi D` to functors `karoubi C ⥤ karoubi D`. This results in an
equivalence `karoubi_universal₁ C D : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`.

We also construct an extension `functor_extension₂` of functors
`(C ⥤ D) ⥤ (karoubi C ⥤ karoubi D)`. Moreover,
when `D` is idempotent complete, we get equivalences
`karoubi_universal₂ C D : C ⥤ D ≌ karoubi C ⥤ karoubi D`
and `karoubi_universal C D : C ⥤ D ≌ karoubi C ⥤ D`.

We occasionally state and use equalities of functors because it is
sometimes convenient to use rewrites when proving properties of
functors obtained using the constructions in this file. Users are
encouraged to use the corresponding natural isomorphism
whenever possible.

-/

open CategoryTheory.Category

open CategoryTheory.Idempotents.Karoubi

namespace CategoryTheory

namespace Idempotents

variable {C D E : Type _} [Category C] [Category D] [Category E]

/-- A natural transformation between functors `karoubi C ⥤ D` is determined
by its value on objects coming from `C`. -/
theorem nat_trans_eq {F G : Karoubi C ⥤ D} (φ : F ⟶ G) (P : Karoubi C) :
    φ.app P = F.map (decompIdI P) ≫ φ.app P.pt ≫ G.map (decompIdP P) :=
  by
  rw [← φ.naturality, ← assoc, ← F.map_comp]
  conv =>
    lhs
    rw [← id_comp (φ.app P), ← F.map_id]
  congr
  apply decomp_id
#align category_theory.idempotents.nat_trans_eq CategoryTheory.Idempotents.nat_trans_eq

namespace FunctorExtension₁

/-- The canonical extension of a functor `C ⥤ karoubi D` to a functor
`karoubi C ⥤ karoubi D` -/
@[simps]
def obj (F : C ⥤ Karoubi D) : Karoubi C ⥤ Karoubi D
    where
  obj P :=
    ⟨(F.obj P.pt).pt, (F.map P.p).f, by simpa only [F.map_comp, hom_ext] using F.congr_map P.idem⟩
  map P Q f := ⟨(F.map f.f).f, by simpa only [F.map_comp, hom_ext] using F.congr_map f.comm⟩
#align category_theory.idempotents.functor_extension₁.obj CategoryTheory.Idempotents.FunctorExtension₁.obj

/-- Extension of a natural transformation `φ` between functors
`C ⥤ karoubi D` to a natural transformation between the
extension of these functors to `karoubi C ⥤ karoubi D` -/
@[simps]
def map {F G : C ⥤ Karoubi D} (φ : F ⟶ G) : obj F ⟶ obj G
    where
  app P :=
    { f := (F.map P.p).f ≫ (φ.app P.pt).f
      comm := by
        have h := φ.naturality P.p
        have h' := F.congr_map P.idem
        simp only [hom_ext, karoubi.comp_f, F.map_comp] at h h'
        simp only [obj_obj_p, assoc, ← h]
        slice_rhs 1 3 => rw [h', h'] }
  naturality' P Q f := by
    ext
    dsimp [obj]
    have h := φ.naturality f.f
    have h' := F.congr_map (comp_p f)
    have h'' := F.congr_map (p_comp f)
    simp only [hom_ext, functor.map_comp, comp_f] at h h' h''⊢
    slice_rhs 2 3 => rw [← h]
    slice_lhs 1 2 => rw [h']
    slice_rhs 1 2 => rw [h'']
#align category_theory.idempotents.functor_extension₁.map CategoryTheory.Idempotents.FunctorExtension₁.map

end FunctorExtension₁

variable (C D E)

/-- The canonical functor `(C ⥤ karoubi D) ⥤ (karoubi C ⥤ karoubi D)` -/
@[simps]
def functorExtension₁ : (C ⥤ Karoubi D) ⥤ Karoubi C ⥤ Karoubi D
    where
  obj := FunctorExtension₁.obj
  map F G := FunctorExtension₁.map
  map_id' F := by
    ext P
    exact comp_p (F.map P.p)
  map_comp' F G H φ φ' := by
    ext P
    simp only [comp_f, functor_extension₁.map_app_f, nat_trans.comp_app, assoc]
    have h := φ.naturality P.p
    have h' := F.congr_map P.idem
    simp only [hom_ext, comp_f, F.map_comp] at h h'
    slice_rhs 2 3 => rw [← h]
    slice_rhs 1 2 => rw [h']
    simp only [assoc]
#align category_theory.idempotents.functor_extension₁ CategoryTheory.Idempotents.functorExtension₁

theorem functorExtension₁_comp_whiskeringLeft_toKaroubi :
    functorExtension₁ C D ⋙ (whiskeringLeft C (Karoubi C) (Karoubi D)).obj (toKaroubi C) = 𝟭 _ :=
  by
  refine' Functor.ext _ _
  · intro F
    refine' Functor.ext _ _
    · intro X
      ext
      · dsimp
        rw [id_comp, comp_id, F.map_id, id_eq]
      · rfl
    · intro X Y f
      ext
      dsimp
      simp only [comp_id, eq_to_hom_f, eq_to_hom_refl, comp_p, functor_extension₁.obj_obj_p,
        to_karoubi_obj_p, comp_f]
      dsimp
      simp only [Functor.map_id, id_eq, p_comp]
  · intro F G φ
    ext X
    dsimp
    simp only [eq_to_hom_app, F.map_id, comp_f, eq_to_hom_f, id_eq, p_comp, eq_to_hom_refl, comp_id,
      comp_p, functor_extension₁.obj_obj_p, to_karoubi_obj_p, F.map_id X]
#align category_theory.idempotents.functor_extension₁_comp_whiskering_left_to_karoubi CategoryTheory.Idempotents.functorExtension₁_comp_whiskeringLeft_toKaroubi

/-- The natural isomorphism expressing that functors `karoubi C ⥤ karoubi D` obtained
using `functor_extension₁` actually extends the original functors `C ⥤ karoubi D`. -/
@[simps]
def functorExtension₁CompWhiskeringLeftToKaroubiIso :
    functorExtension₁ C D ⋙ (whiskeringLeft C (Karoubi C) (Karoubi D)).obj (toKaroubi C) ≅ 𝟭 _ :=
  eqToIso (functorExtension₁_comp_whiskeringLeft_toKaroubi C D)
#align category_theory.idempotents.functor_extension₁_comp_whiskering_left_to_karoubi_iso CategoryTheory.Idempotents.functorExtension₁CompWhiskeringLeftToKaroubiIso

/-- The counit isomorphism of the equivalence `(C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. -/
@[simps]
def KaroubiUniversal₁.counitIso :
    (whiskeringLeft C (Karoubi C) (Karoubi D)).obj (toKaroubi C) ⋙ functorExtension₁ C D ≅ 𝟭 _ :=
  NatIso.ofComponents
    (fun G =>
      { Hom :=
          { app := fun P =>
              { f := (G.map (decompIdP P)).f
                comm := by
                  simpa only [hom_ext, G.map_comp, G.map_id] using
                    G.congr_map
                      (show P.decomp_id_p = (to_karoubi C).map P.p ≫ P.decomp_id_p ≫ 𝟙 _ by simp) }
            naturality' := fun P Q f => by
              simpa only [hom_ext, G.map_comp] using (G.congr_map (decomp_id_p_naturality f)).symm }
        inv :=
          { app := fun P =>
              { f := (G.map (decompIdI P)).f
                comm := by
                  simpa only [hom_ext, G.map_comp, G.map_id] using
                    G.congr_map
                      (show P.decomp_id_i = 𝟙 _ ≫ P.decomp_id_i ≫ (to_karoubi C).map P.p by simp) }
            naturality' := fun P Q f => by
              simpa only [hom_ext, G.map_comp] using G.congr_map (decomp_id_i_naturality f) }
        hom_inv_id' := by
          ext P
          simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_p.symm
        inv_hom_id' := by
          ext P
          simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_id.symm })
    fun G₁ G₂ φ => by
    ext P
    dsimp
    simpa only [nat_trans_eq φ P, comp_f, functor_extension₁.map_app_f, functor.comp_map,
      whisker_left_app, assoc, P.decomp_p, G₁.map_comp]
#align category_theory.idempotents.karoubi_universal₁.counit_iso CategoryTheory.Idempotents.KaroubiUniversal₁.counitIso

/-- The equivalence of categories `(C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. -/
@[simps]
def karoubiUniversal₁ : C ⥤ Karoubi D ≌ Karoubi C ⥤ Karoubi D
    where
  Functor := functorExtension₁ C D
  inverse := (whiskeringLeft C (Karoubi C) (Karoubi D)).obj (toKaroubi C)
  unitIso := (functorExtension₁CompWhiskeringLeftToKaroubiIso C D).symm
  counitIso := KaroubiUniversal₁.counitIso C D
  functor_unitIso_comp' F := by
    ext P
    dsimp [functor_extension₁.map, karoubi_universal₁.counit_iso]
    simpa only [comp_f, eq_to_hom_app, eq_to_hom_f, eq_to_hom_refl, comp_id, hom_ext, F.map_comp,
      comp_p] using F.congr_map P.idem
#align category_theory.idempotents.karoubi_universal₁ CategoryTheory.Idempotents.karoubiUniversal₁

theorem functorExtension₁_comp (F : C ⥤ Karoubi D) (G : D ⥤ Karoubi E) :
    (functorExtension₁ C E).obj (F ⋙ (functorExtension₁ D E).obj G) =
      (functorExtension₁ C D).obj F ⋙ (functorExtension₁ D E).obj G :=
  Functor.ext (by tidy) fun X Y f => by
    dsimp
    simpa only [id_comp, comp_id]
#align category_theory.idempotents.functor_extension₁_comp CategoryTheory.Idempotents.functorExtension₁_comp

/-- The canonical functor `(C ⥤ D) ⥤ (karoubi C ⥤ karoubi D)` -/
@[simps]
def functorExtension₂ : (C ⥤ D) ⥤ Karoubi C ⥤ Karoubi D :=
  (whiskeringRight C D (Karoubi D)).obj (toKaroubi D) ⋙ functorExtension₁ C D
#align category_theory.idempotents.functor_extension₂ CategoryTheory.Idempotents.functorExtension₂

theorem functorExtension₂_comp_whiskeringLeft_toKaroubi :
    functorExtension₂ C D ⋙ (whiskeringLeft C (Karoubi C) (Karoubi D)).obj (toKaroubi C) =
      (whiskeringRight C D (Karoubi D)).obj (toKaroubi D) :=
  by
  simp only [functor_extension₂, functor.assoc, functor_extension₁_comp_whiskering_left_to_karoubi,
    functor.comp_id]
#align category_theory.idempotents.functor_extension₂_comp_whiskering_left_to_karoubi CategoryTheory.Idempotents.functorExtension₂_comp_whiskeringLeft_toKaroubi

/-- The natural isomorphism expressing that functors `karoubi C ⥤ karoubi D` obtained
using `functor_extension₂` actually extends the original functors `C ⥤ D`. -/
@[simps]
def functorExtension₂CompWhiskeringLeftToKaroubiIso :
    functorExtension₂ C D ⋙ (whiskeringLeft C (Karoubi C) (Karoubi D)).obj (toKaroubi C) ≅
      (whiskeringRight C D (Karoubi D)).obj (toKaroubi D) :=
  eqToIso (functorExtension₂_comp_whiskeringLeft_toKaroubi C D)
#align category_theory.idempotents.functor_extension₂_comp_whiskering_left_to_karoubi_iso CategoryTheory.Idempotents.functorExtension₂CompWhiskeringLeftToKaroubiIso

section IsIdempotentComplete

variable [IsIdempotentComplete D]

noncomputable instance : IsEquivalence (toKaroubi D) :=
  toKaroubiIsEquivalence D

/-- The equivalence of categories `(C ⥤ D) ≌ (karoubi C ⥤ karoubi D)` when `D`
is idempotent complete. -/
@[simps]
noncomputable def karoubiUniversal₂ : C ⥤ D ≌ Karoubi C ⥤ Karoubi D :=
  (Equivalence.congrRight (toKaroubi D).asEquivalence).trans (karoubiUniversal₁ C D)
#align category_theory.idempotents.karoubi_universal₂ CategoryTheory.Idempotents.karoubiUniversal₂

theorem karoubiUniversal₂_functor_eq : (karoubiUniversal₂ C D).Functor = functorExtension₂ C D :=
  rfl
#align category_theory.idempotents.karoubi_universal₂_functor_eq CategoryTheory.Idempotents.karoubiUniversal₂_functor_eq

noncomputable instance : IsEquivalence (functorExtension₂ C D) :=
  by
  rw [← karoubi_universal₂_functor_eq]
  infer_instance

/-- The extension of functors functor `(C ⥤ D) ⥤ (karoubi C ⥤ D)`
when `D` is idempotent compltete. -/
@[simps]
noncomputable def functorExtension : (C ⥤ D) ⥤ Karoubi C ⥤ D :=
  functorExtension₂ C D ⋙
    (whiskeringRight (Karoubi C) (Karoubi D) D).obj (toKaroubiIsEquivalence D).inverse
#align category_theory.idempotents.functor_extension CategoryTheory.Idempotents.functorExtension

/-- The equivalence `(C ⥤ D) ≌ (karoubi C ⥤ D)` when `D` is idempotent complete. -/
@[simps]
noncomputable def karoubiUniversal : C ⥤ D ≌ Karoubi C ⥤ D :=
  (karoubiUniversal₂ C D).trans (Equivalence.congrRight (toKaroubi D).asEquivalence.symm)
#align category_theory.idempotents.karoubi_universal CategoryTheory.Idempotents.karoubiUniversal

theorem karoubiUniversal_functor_eq : (karoubiUniversal C D).Functor = functorExtension C D :=
  rfl
#align category_theory.idempotents.karoubi_universal_functor_eq CategoryTheory.Idempotents.karoubiUniversal_functor_eq

noncomputable instance : IsEquivalence (functorExtension C D) :=
  by
  rw [← karoubi_universal_functor_eq]
  infer_instance

noncomputable instance : IsEquivalence ((whiskeringLeft C (Karoubi C) D).obj (toKaroubi C)) :=
  IsEquivalence.cancelCompRight _
    ((whiskeringRight C _ _).obj (toKaroubi D) ⋙ (whiskeringRight C _ _).obj (toKaroubi D).inv)
    (IsEquivalence.ofEquivalence
      (@Equivalence.congrRight _ _ _ _ C _
        ((toKaroubi D).asEquivalence.trans (toKaroubi D).asEquivalence.symm)))
    (by
      change is_equivalence (karoubi_universal C D).inverse
      infer_instance)

variable {C D}

theorem whiskeringLeft_obj_preimage_app {F G : Karoubi C ⥤ D}
    (τ : toKaroubi _ ⋙ F ⟶ toKaroubi _ ⋙ G) (P : Karoubi C) :
    (((whiskeringLeft _ _ _).obj (toKaroubi _)).preimage τ).app P =
      F.map P.decompIdI ≫ τ.app P.pt ≫ G.map P.decompIdP :=
  by
  rw [nat_trans_eq]
  congr 2
  exact congr_app (((whiskering_left _ _ _).obj (to_karoubi _)).image_preimage τ) P.X
#align category_theory.idempotents.whiskering_left_obj_preimage_app CategoryTheory.Idempotents.whiskeringLeft_obj_preimage_app

end IsIdempotentComplete

end Idempotents

end CategoryTheory


import orthoganality_of_character.orthogonality
noncomputable theory
set_option pp.generalized_field_notation false
open_locale big_operators
universes u v w w'
open car_pol
open  Schur₂ morphism.from_irreductible equiv_morphism shur₁_comm_ring stability
open  Reynold
open matrix linear_map character
namespace decomposition
variables {G : Type u} [group G]  [fintype G][decidable_eq G]
          {X : Type v} [fintype X][decidable_eq X]
          (ρ : group_representation G ℂ (X → ℂ))
          {Y : Type w} [fintype Y][decidable_eq Y]
          (ι : Type v) [fintype ι][decidable_eq ι] (M : ι → Type w)
          [Π i, fintype(M i)][Π i,decidable_eq (M i)]
          (φ : Π i,group_representation G ℂ  (M i → ℂ )) [Π i, Irreductible (φ i) ]
          {π  : group_representation G ℂ (Y → ℂ)} [Irreductible π  ]
#check finset
def  is_decomposition := χ ρ = ∑ i, χ (φ i)  ---- baby decomposition !
#check   subtype (λ i : ι , is_isomorphic ρ (φ i))
open_locale classical
instance  : fintype { i : ι // is_isomorphic ρ (φ i)  } := begin
    exact set_fintype (λ (x : ι), nonempty (ρ ≃ᵣ φ x)),
end
end decomposition
open decomposition
variables {G : Type u} [group G]  [fintype G][decidable_eq G]
          {X : Type v} [fintype X][decidable_eq X]
          (ρ : group_representation G ℂ (X → ℂ))
          {Y : Type w} [fintype Y][decidable_eq Y]
          (ι : Type v) [fintype ι][decidable_eq ι] (M : ι → Type w)
          [Π i, fintype(M i)][Π i,decidable_eq (M i)]
          (φ : Π i,group_representation G ℂ  (M i → ℂ )) [Π i, Irreductible (φ i) ]
          {π  : group_representation G ℂ (Y → ℂ)} [Irreductible π  ]
theorem scal (hyp : is_decomposition ρ ι M φ  ) (hyp' : 0 < fintype.card Y ) (hyp'' : fintype.card Y ≠ 0) :
    scalar_product G ℂ (χ (π )) (χ (ρ )) = (fintype.card { i : ι  | is_isomorphic π   (φ    i)  }) * ↑(fintype.card G)  :=
begin
    unfold is_decomposition at *, rw hyp,
    rw bilin_form.map_sum_right,
    let g := λ i,  scalar_product_ite  π (φ i)hyp'  hyp'',
    conv_lhs{
        apply_congr,skip,
        rw g,
    },
    rw finset.sum_ite, rw finset.sum_const_zero, rw add_zero,
    rw finset.sum_const, rw add_monoid.smul_eq_mul,
    erw fintype.card_of_subtype _, intros,
    split,  intros, rw finset.mem_filter at a, exact a.2,
    intros, rw finset.mem_filter, split, exact finset.mem_univ _,
    exact a,
end
namespace regular
variables {Z : Type w} [fintype Y][decidable_eq Y]
          (t : Type u) [fintype t][decidable_eq t] (Mt : t → Type w)
          [Π i, fintype(Mt i)][Π i,decidable_eq (Mt i)]
          (ψ  : Π i,group_representation G ℂ  (Mt i → ℂ )) [Π i, Irreductible (ψ i) ]
theorem scal_regular  (hyp : is_decomposition (Regular.Regular_representation G ℂ ) t Mt ψ   )(hyp'' :0 < fintype.card Y ) (hyp' : fintype.card Y ≠ 0):

    (χ π  1) * ↑(fintype.card G) = (fintype.card { i : t | is_isomorphic π   (ψ   i)  }) * ↑(fintype.card G) :=
begin
    erw ← scal (Regular.Regular_representation G ℂ ) t Mt ψ hyp _,
    rw scalar_product_with_regular, by assumption, by assumption,
    exact hyp'',
    end
end regular


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module combinatorics.additive.ruzsa_covering
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Pointwise

/-!
# Ruzsa's covering lemma

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

This file proves the Ruzsa covering lemma. This says that, for `s`, `t` finsets, we can cover `s`
with at most `(s + t).card /  t.card` copies of `t - t`.

## TODO

Merge this file with other prerequisites to Freiman's theorem once we have them.
-/

open Pointwise

namespace Finset

variable {α : Type _} [DecidableEq α] [CommGroup α] (s : Finset α) {t : Finset α}

/- warning: finset.exists_subset_mul_div -> Finset.exists_subset_mul_div is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommGroup.{u1} α] (s : Finset.{u1} α) {t : Finset.{u1} α}, (Finset.Nonempty.{u1} α t) -> (Exists.{succ u1} (Finset.{u1} α) (fun (u : Finset.{u1} α) => And (LE.le.{0} Nat Nat.hasLe (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (Finset.card.{u1} α u) (Finset.card.{u1} α t)) (Finset.card.{u1} α (HMul.hMul.{u1, u1, u1} (Finset.{u1} α) (Finset.{u1} α) (Finset.{u1} α) (instHMul.{u1} (Finset.{u1} α) (Finset.mul.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))))) s t))) (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s (HDiv.hDiv.{u1, u1, u1} (Finset.{u1} α) (Finset.{u1} α) (Finset.{u1} α) (instHDiv.{u1} (Finset.{u1} α) (Finset.div.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (DivInvMonoid.toHasDiv.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))) (HMul.hMul.{u1, u1, u1} (Finset.{u1} α) (Finset.{u1} α) (Finset.{u1} α) (instHMul.{u1} (Finset.{u1} α) (Finset.mul.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))))) u t) t))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommGroup.{u1} α] (s : Finset.{u1} α) {t : Finset.{u1} α}, (Finset.Nonempty.{u1} α t) -> (Exists.{succ u1} (Finset.{u1} α) (fun (u : Finset.{u1} α) => And (LE.le.{0} Nat instLENat (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Finset.card.{u1} α u) (Finset.card.{u1} α t)) (Finset.card.{u1} α (HMul.hMul.{u1, u1, u1} (Finset.{u1} α) (Finset.{u1} α) (Finset.{u1} α) (instHMul.{u1} (Finset.{u1} α) (Finset.mul.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))))) s t))) (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) s (HDiv.hDiv.{u1, u1, u1} (Finset.{u1} α) (Finset.{u1} α) (Finset.{u1} α) (instHDiv.{u1} (Finset.{u1} α) (Finset.div.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (DivInvMonoid.toDiv.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))) (HMul.hMul.{u1, u1, u1} (Finset.{u1} α) (Finset.{u1} α) (Finset.{u1} α) (instHMul.{u1} (Finset.{u1} α) (Finset.mul.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))))) u t) t))))
Case conversion may be inaccurate. Consider using '#align finset.exists_subset_mul_div Finset.exists_subset_mul_divₓ'. -/
/-- **Ruzsa's covering lemma**. -/
@[to_additive "**Ruzsa's covering lemma**"]
theorem exists_subset_mul_div (ht : t.Nonempty) :
    ∃ u : Finset α, u.card * t.card ≤ (s * t).card ∧ s ⊆ u * t / t :=
  by
  haveI : ∀ u, Decidable ((u : Set α).PairwiseDisjoint (· • t)) := fun u => Classical.dec _
  set C := s.powerset.filter fun u => (u : Set α).PairwiseDisjoint (· • t)
  obtain ⟨u, hu, hCmax⟩ :=
    C.exists_maximal (filter_nonempty_iff.2 ⟨∅, empty_mem_powerset _, Set.pairwiseDisjoint_empty⟩)
  rw [mem_filter, mem_powerset] at hu
  refine'
    ⟨u,
      (card_mul_iff.2 <| pairwise_disjoint_smul_iff.1 hu.2).ge.trans
        (card_le_of_subset <| mul_subset_mul_right hu.1),
      fun a ha => _⟩
  rw [mul_div_assoc]
  by_cases hau : a ∈ u
  · exact subset_mul_left _ ht.one_mem_div hau
  by_cases H : ∀ b ∈ u, Disjoint (a • t) (b • t)
  · refine' (hCmax _ _ <| ssubset_insert hau).elim
    rw [mem_filter, mem_powerset, insert_subset, coe_insert]
    exact ⟨⟨ha, hu.1⟩, hu.2.insert fun b hb _ => H _ hb⟩
  push_neg  at H
  simp_rw [not_disjoint_iff, ← inv_smul_mem_iff] at H
  obtain ⟨b, hb, c, hc₁, hc₂⟩ := H
  exact mem_mul.2 ⟨_, _, hb, mem_div.2 ⟨_, _, hc₂, hc₁, by simp [div_eq_mul_inv a b]⟩, by simp⟩
#align finset.exists_subset_mul_div Finset.exists_subset_mul_div
#align finset.exists_subset_add_sub Finset.exists_subset_add_sub

end Finset