import datatypes -- blackboard

namespace polya

section aux

meta def mk_neg : expr → expr
| `((-%%lhs) * %%rhs) := `(%%lhs * %%rhs : ℚ)
| `(%%lhs * %%rhs) := `((-%%lhs) * %%rhs : ℚ)
| a := `((-1 : ℚ)*%%a)

meta def get_sum_components : expr → list expr
| `(%%lhs + %%rhs) := rhs::(get_sum_components lhs)
| `(%%lhs - %%rhs) := mk_neg rhs::(get_sum_components lhs)
| a := [a]

meta def get_prod_components : expr → list expr
| `(%%lhs * %%rhs) := rhs::(get_prod_components lhs)
| a := [a]

meta def is_sum (e : expr) : bool :=
e.is_app_of ``has_add.add || e.is_app_of ``has_sub.sub

meta def is_prod (e : expr) : bool :=
e.is_app_of ``has_mul.mul || e.is_app_of ``rat.pow

open tactic
meta def get_comps_of_mul (e : expr) : tactic (expr × ℚ) := match e with
| `(%%lhs * %%rhs) := (do c ← eval_expr ℚ lhs, return (rhs, c)) <|> return (e, 1)
| `(%%num / %%denom) := (do c ← eval_expr ℚ denom, return (num, 1/c)) <|> return (e, 1)
| f := return (f, 1)
end

meta def get_comps_of_exp (e : expr) : tactic (expr × ℤ) := match e with
| `(rat.pow %%base %%exp) := (do z ← eval_expr ℤ exp, return (base, z)) <|> return (e, 1)
| f := return (f, 1)
end

end aux

open native

/-meta mutual inductive sterm, term
with sterm : Type
| scaled : ℚ → term → sterm
with term : Type
| add_term : list sterm → term
| mul_term : list (term × ℤ) → term
| atom : expr → term-/
meta inductive term : Type
| add_term : rb_map term ℚ → term
| mul_term : rb_map term ℤ → term
| atom : expr → term

meta structure sterm :=
(coeff : ℚ) (body : term)

namespace term

meta mutual def cmp, list_cmp
with cmp : term → term → ordering
| (add_term m) (add_term n) := list_cmp m.keys n.keys
| (add_term _) _ := ordering.gt
| _ (add_term _) := ordering.lt
| (mul_term m) (mul_term n) := list_cmp m.keys n.keys
| (mul_term _) (atom _) := ordering.gt
| (atom _) (mul_term _) := ordering.lt
| (atom e1) (atom e2) := cmp_using has_lt.lt e1 e2
with list_cmp : list term → list term → ordering
| [] [] := ordering.eq
| [] _  := ordering.lt
| _  [] := ordering.gt
| (x::xs) (y::ys) := let c := cmp x y in if c = ordering.eq then list_cmp xs ys else c

meta def lt (x y : term) := cmp x y = ordering.lt

meta instance : has_lt term := ⟨lt⟩
meta instance : decidable_rel lt := λ x y, by delta lt; apply_instance

meta def add_term_empty : term :=
add_term mk_rb_map

meta def mul_term_empty : term :=
mul_term mk_rb_map
end term

private meta def add_term_coeff_pair (map : rb_map term ℚ) (st : term × ℚ) : rb_map term ℚ :=
match map.find st.1 with
| none := map.insert st.1 st.2
| some c := map.insert st.1 (st.2 + c)
end

private meta def add_term_coeff_pair_list (map : rb_map term ℚ) (l : list (term × ℚ)) : rb_map term ℚ :=
l.foldl add_term_coeff_pair map

private meta def add_sterm (map : rb_map term ℚ) (st : sterm) : rb_map term ℚ :=
add_term_coeff_pair map (st.body, st.coeff)

meta def add_term_of_sterm_list (l : list sterm) : term :=
term.add_term $ l.foldl add_sterm mk_rb_map

private meta def pow_term_exp (map : rb_map term ℤ) (pr : term × ℤ) : rb_map term ℤ :=
match map.find pr.1 with
| none := map.insert pr.1 pr.2
| some c := map.insert pr.1 (pr.2 + c)
end

private meta def pow_term_exp_list (map : rb_map term ℤ) (l : list (term × ℤ)) : rb_map term ℤ :=
l.foldl pow_term_exp map

meta def mul_term_of_term_exp_list (l : list (term × ℤ)) : term :=
term.mul_term $ l.foldl pow_term_exp mk_rb_map

meta def term.is_zero : term → bool
| (term.add_term m) := m.size = 0
| _ := ff

meta def sterm.is_zero (st : sterm) : bool :=
st.body.is_zero || (st.coeff = 0)

meta def term.scale (q : ℚ) (t : term) : sterm :=
⟨q, t⟩

meta def sterm.scale (q : ℚ) (st : sterm) : sterm :=
{ st with coeff := st.coeff * q }

meta def sterm.of_pair (pr : term × ℚ) : sterm :=
⟨pr.2, pr.1⟩

open tactic

private meta def expr.to_term_aux (tst : expr → tactic sterm) : expr → tactic term | e :=
if is_sum e then
  let scs := get_sum_components e in
  add_term_of_sterm_list <$> scs.mmap tst
else if is_prod e then
  let scs := get_prod_components e in
  do scs' ← scs.mmap get_comps_of_exp,
     mul_term_of_term_exp_list <$> scs'.mmap (λ pr, do tm ← expr.to_term_aux pr.1, return (tm, pr.2))
else return $ term.atom e

private meta def split_num_nonnum_prod_comps : list expr → list expr × list expr
| [] := ([], [])
| (e::l) :=
   let (t1, t2) := split_num_nonnum_prod_comps l in
   if expr.is_numeral e then (e::t1, t2) else (t1, e::t2)

private meta def fold_op_app_aux (op : pexpr) : expr → list expr → tactic expr
| h [] := return h
| h (h'::t) := do h'' ← to_expr ``(%%op %%h %%h'), fold_op_app_aux h'' t

private meta def fold_op_app (op : pexpr) (dflt : expr) : list expr → tactic expr
| [] := return dflt
| (h::t) := fold_op_app_aux op h t

meta def expr.to_sterm : expr → tactic sterm | e :=
if expr.is_numeral e then
  do q ← eval_expr ℚ e,
     return ⟨q, (term.atom `(1 : ℚ))⟩
else if is_prod e then
 let scs := get_prod_components e,
     (numcs, nnumcs) := split_num_nonnum_prod_comps scs in
 do  numcs' ← numcs.mmap (eval_expr ℚ),
 let q := numcs'.foldl (*) 1,
     sterm.mk q <$> ((fold_op_app ``((*)) `(1 : ℚ) nnumcs) >>= expr.to_term_aux expr.to_sterm)
else sterm.mk 1 <$> expr.to_term_aux expr.to_sterm e

/-match e with
| `(%%c*%%t) :=
  if expr.is_numeral c then
    do q ← eval_expr ℚ c,
       sterm.scale q <$> expr.to_sterm t
  else sterm.mk 1 <$> expr.to_term_aux expr.to_sterm e
| t := sterm.mk 1 <$> expr.to_term_aux expr.to_sterm t
end       -/

meta def expr.to_term : expr → tactic term := expr.to_term_aux expr.to_sterm

private meta def term.to_expr_aux (ste : sterm → tactic expr) : term → tactic expr
| (term.add_term l) :=
 if l.size = 0 then return `(0 : ℚ) else
 do l' ← l.to_list.mmap (λ pr, ste (sterm.of_pair pr)),
     fold_op_app ``((+)) `(0 : ℚ) l'
| (term.mul_term l) :=
  if l.size = 0 then return `(1 : ℚ) else
  do l' ← l.to_list.mmap (λ pr, do e' ← term.to_expr_aux pr.1, return (e', pr.2)),
  let l'' := l'.map (λ pr, `(rat.pow %%(pr.1) %%(pr.2.reflect))),
     fold_op_app ``((*)) `(1 : ℚ) l''
| (term.atom e) := return e

meta def sterm.to_expr : sterm → tactic expr
| ⟨c, t⟩ :=
  if t.is_zero || (c = 0) then return `(0 : ℚ) else
  do t' ← term.to_expr_aux sterm.to_expr t,
     return `(%%(c.reflect)*%%t' : ℚ)

meta def term.to_expr : term → tactic expr := term.to_expr_aux sterm.to_expr

meta def term.to_tactic_format (e : term) : tactic format :=
do ex ← e.to_expr,
   tactic_format_expr ex

meta def sterm.to_tactic_format (e : sterm) : tactic format :=
do ex ← e.to_expr,
   tactic_format_expr ex

meta instance term.has_to_tactic_format : has_to_tactic_format term :=
⟨term.to_tactic_format⟩

meta instance sterm.has_to_tactic_format : has_to_tactic_format sterm :=
⟨sterm.to_tactic_format⟩

section canonize

private meta def coeff_and_terms_of_sterm_z_list : list (sterm × ℤ) → ℚ × list (term × ℤ)
| [] := (1, [])
| ((⟨c, tm⟩, z)::t) :=
   let (q, l) := coeff_and_terms_of_sterm_z_list  t in
  (q * rat.pow c z, (tm, z)::l)

/-private meta def coeff_and_terms_of_sterm_z_list : ℚ → list (term × ℤ) → list (sterm × ℤ) → ℚ × list (term × ℤ)
| acc l [] := (acc, l)
| acc l ((sterm.scaled c tm, z)::t) := (tm, z)::coeff_and_terms_of_sterm_z_list (acc*rat.pow c z) t-/

-- only applies to add_term
private meta def term.leading_coeff : term → ℚ
| (term.add_term l) :=
  match l.to_list with
  | [] := 1
  | ((_, c)::t) := c
  end
| _ := 1

-- only applies to add_term
private meta def term.scale_coeffs (c : ℚ) : term → term
| (term.add_term l) := term.add_term $ l.map (λ c', c*c')
| a := a

-- doesn't flatten
private meta def term.canonize_aux (stc : sterm → tactic sterm) : term → tactic sterm
| (term.add_term l) :=
  do l' ← add_term_of_sterm_list <$> l.to_list.mmap (λ pr, stc (sterm.of_pair pr)),
     let c := term.leading_coeff l',
     return ⟨c, term.scale_coeffs (1/c) l'⟩
/-  do l' : list (sterm × expr) ← l.to_list.mmap (λ st, do st' ← stc (sterm.of_pair st), e ← st'.to_expr, return (st', e)),
  let l' := (l'.qsort (λ pr1 pr2 : sterm × expr, pr2.2.lt pr1.2)).map prod.fst,
  match l' with
  | [] := return $ sterm.mk 1 term.add_term_empty
  | [st] := return st
  | (⟨c, tm⟩)::t :=
    if c = 1 then return $ sterm.mk 1 (add_term_of_sterm_list l')
    else return $ sterm.mk c (add_term_of_sterm_list (l'.map (sterm.scale (1/c))))
  end-/
| (term.mul_term l) :=
  do l' ←  l.to_list.mmap (λ pr, do t' ← term.canonize_aux pr.1, return (t', pr.2)),
     let (q, l'') := coeff_and_terms_of_sterm_z_list l',
     return ⟨q, mul_term_of_term_exp_list l''⟩
 /- do l' ← l.to_list.mmap (λ pr, do t' ← term.canonize_aux pr.1, e ← t'.to_expr, return ((t', pr.2), e)),
    let l' := (l'.qsort (λ pr1 pr2 : (sterm × ℤ) × expr, pr2.2.lt pr1.2)),
    let l' := l'.map prod.fst,
    let (q, l'') := coeff_and_terms_of_sterm_z_list l',
    return $ sterm.mk q (mul_term_of_term_exp_list l'')-/
| (term.atom e) := return $ sterm.mk 1 (term.atom e)

-- doesn't flatten
private meta def sterm.canonize_aux : sterm → tactic sterm
| ⟨c, t⟩ :=
  do sterm.mk c' t' ← term.canonize_aux sterm.canonize_aux t,
  return $ sterm.mk (c*c') t'

/-private meta def flatten_sum_list : list (term × ℚ) → list (term × ℚ)
| [] := []
| ((term.add_term tm, c)::t) :=
  (tm.to_list.map (λ pr : term × ℚ, (pr.1, pr.2*c))).append (flatten_sum_list t)
| (h::t) := h::flatten_sum_list t

private meta def flatten_prod_list : list (term × ℤ) → list (term × ℤ)
| [] := []
| ((term.mul_term l, z)::t) := (l.to_list.map (λ pr : term × ℤ, (pr.1, pr.2*z))).append (flatten_prod_list t)
| (h::t) := h::flatten_prod_list t-/

private meta def scale_list {α} [has_mul α] (l : list (term × α)) (q : α) : list (term × α) :=
l.map (λ pr, {pr with snd := pr.snd * q})

private meta def flatten_sum_term_aux (t : term) (coeff : ℚ) (map : rb_map term ℚ) : rb_map term ℚ :=
match t with
| term.add_term l := add_term_coeff_pair_list map (scale_list l.to_list coeff)
| _ := map.insert t coeff
end

private meta def flatten_sum_term (map : rb_map term ℚ) : rb_map term ℚ :=
map.fold mk_rb_map flatten_sum_term_aux

private meta def flatten_mul_term_aux (t : term) (exp : ℤ) (map : rb_map term ℤ) : rb_map term ℤ :=
match t with
| term.mul_term l := pow_term_exp_list map (scale_list l.to_list exp)
| _ := map.insert t exp
end

private meta def flatten_mul_term (map : rb_map term ℤ) : rb_map term ℤ :=
map.fold mk_rb_map flatten_mul_term_aux

private meta def term.flatten : term → term
| (term.add_term l) := term.add_term $ flatten_sum_term l --$ rb_map.of_list (flatten_sum_list l.to_list)
| (term.mul_term l) := term.mul_term $ flatten_mul_term l --$ rb_map.of_list (flatten_prod_list l.to_list)
| a := a

private meta def sterm.flatten : sterm → sterm
| (sterm.mk c t) := sterm.mk c (term.flatten t)

meta def sterm.canonize : sterm → tactic sterm :=
sterm.canonize_aux ∘ sterm.flatten

meta def term.canonize (t : term) : tactic sterm :=
term.canonize_aux sterm.canonize (term.flatten t)

meta def expr.canonize (e : expr) : tactic sterm :=
match e with
| `(0 : ℚ) := return $ sterm.mk 0 (term.add_term_empty)
| _ := expr.to_sterm e >>= sterm.canonize
end

meta def expr.canonize_to_expr (e : expr) : tactic expr :=
match e with
| `(0 : ℚ) := return e
| _ := expr.to_sterm e >>= sterm.canonize >>= sterm.to_expr
end

theorem canonized_inequality {P : Prop} (h : P) (canP : Prop) : canP := sorry

meta def prove_inequality (lhs rhs pf : expr) (op : gen_comp) : tactic expr :=
do sterm.mk clhs tlhs ← expr.canonize lhs,
   --trace "tlhs", trace tlhs,
   srhs ← expr.canonize rhs,
   --trace "srhs", trace srhs,
   elhs ← tlhs.to_expr,
   if clhs = 0 then
     do erhs ← srhs.to_expr,
        tp ← op.reverse.to_function erhs elhs,
        mk_app ``canonized_inequality [pf, tp]
   else
     do erhs ← (srhs.scale (1/clhs)).to_expr,
        tp ← ((if clhs < 0 then gen_comp.reverse else id) op).to_function elhs erhs, --to_expr ``(%%op %%elhs %%erhs),
        mk_app ``canonized_inequality [pf, tp]

meta def canonize_hyp (e : expr) : tactic expr :=
do tp ← infer_type e, match tp with
/-| `(0 > %%e) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(0 > %%ce)]
| `(0 ≥ %%e) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(0 ≥ %%ce)]
| `(0 < %%e) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(0 < %%ce)]
| `(0 ≤ %%e) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(0 ≤ %%ce)]
| `(%%e > 0) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(%%ce > 0)]
| `(%%e ≥ 0) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(%%ce ≥ 0)]
| `(%%e < 0) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(%%ce < 0)]
| `(%%e ≤ 0) := do ce ← expr.canonize e,
  mk_app ``canonized_inequality [e, `(%%ce ≤ 0)]-/
| `(%%lhs ≤ %%rhs) := prove_inequality lhs rhs e gen_comp.le
| `(%%lhs < %%rhs) := prove_inequality lhs rhs e gen_comp.lt
| `(%%lhs ≥ %%rhs) := prove_inequality lhs rhs e gen_comp.ge
| `(%%lhs > %%rhs) := prove_inequality lhs rhs e gen_comp.gt
| `(%%lhs = %%rhs) := prove_inequality lhs rhs e gen_comp.eq
| `(%%lhs ≠ %%rhs) := prove_inequality lhs rhs e gen_comp.ne
| _ := /-trace e >>-/ do s ← to_string <$> pp e, fail $ "didn't recognize " ++ s
end

end canonize
end polya


/-
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 order.category.FinBoolAlg
! leanprover-community/mathlib commit e8ac6315bcfcbaf2d19a046719c3b553206dac75
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Powerset
import Mathbin.Order.Category.BoolAlg
import Mathbin.Order.Category.FinPartOrd
import Mathbin.Order.Hom.CompleteLattice

/-!
# The category of finite boolean algebras

This file defines `FinBoolAlg`, the category of finite boolean algebras.

## TODO

Birkhoff's representation for finite Boolean algebras.

`Fintype_to_FinBoolAlg_op.left_op ⋙ FinBoolAlg.dual ≅ Fintype_to_FinBoolAlg_op.left_op`

`FinBoolAlg` is essentially small.
-/

universe u

open CategoryTheory OrderDual Opposite

/-- The category of finite boolean algebras with bounded lattice morphisms. -/
structure FinBoolAlg where
  toBoolAlg : BoolAlg
  [isFintype : Fintype to_BoolAlg]
#align FinBoolAlg FinBoolAlg

namespace FinBoolAlg

instance : CoeSort FinBoolAlg (Type _) :=
  ⟨fun X => X.toBoolAlg⟩

instance (X : FinBoolAlg) : BooleanAlgebra X :=
  X.toBoolAlg.str

attribute [instance] FinBoolAlg.isFintype

@[simp]
theorem coe_toBoolAlg (X : FinBoolAlg) : ↥X.toBoolAlg = ↥X :=
  rfl
#align FinBoolAlg.coe_to_BoolAlg FinBoolAlg.coe_toBoolAlg

/-- Construct a bundled `FinBoolAlg` from `boolean_algebra` + `fintype`. -/
def of (α : Type _) [BooleanAlgebra α] [Fintype α] : FinBoolAlg :=
  ⟨⟨α⟩⟩
#align FinBoolAlg.of FinBoolAlg.of

@[simp]
theorem coe_of (α : Type _) [BooleanAlgebra α] [Fintype α] : ↥(of α) = α :=
  rfl
#align FinBoolAlg.coe_of FinBoolAlg.coe_of

instance : Inhabited FinBoolAlg :=
  ⟨of PUnit⟩

instance largeCategory : LargeCategory FinBoolAlg :=
  InducedCategory.category FinBoolAlg.toBoolAlg
#align FinBoolAlg.large_category FinBoolAlg.largeCategory

instance concreteCategory : ConcreteCategory FinBoolAlg :=
  InducedCategory.concreteCategory FinBoolAlg.toBoolAlg
#align FinBoolAlg.concrete_category FinBoolAlg.concreteCategory

instance hasForgetToBoolAlg : HasForget₂ FinBoolAlg BoolAlg :=
  InducedCategory.hasForget₂ FinBoolAlg.toBoolAlg
#align FinBoolAlg.has_forget_to_BoolAlg FinBoolAlg.hasForgetToBoolAlg

instance forgetToBoolAlgFull : Full (forget₂ FinBoolAlg BoolAlg) :=
  InducedCategory.full _
#align FinBoolAlg.forget_to_BoolAlg_full FinBoolAlg.forgetToBoolAlgFull

instance forget_to_boolAlg_faithful : Faithful (forget₂ FinBoolAlg BoolAlg) :=
  InducedCategory.faithful _
#align FinBoolAlg.forget_to_BoolAlg_faithful FinBoolAlg.forget_to_boolAlg_faithful

@[simps]
instance hasForgetToFinPartOrd : HasForget₂ FinBoolAlg FinPartOrd
    where forget₂ :=
    { obj := fun X => FinPartOrd.of X
      map := fun X Y f => show OrderHom X Y from ↑(show BoundedLatticeHom X Y from f) }
#align FinBoolAlg.has_forget_to_FinPartOrd FinBoolAlg.hasForgetToFinPartOrd

instance forget_to_finPartOrd_faithful : Faithful (forget₂ FinBoolAlg FinPartOrd) :=
  ⟨fun X Y f g h =>
    haveI := congr_arg (coeFn : _ → X → Y) h
    FunLike.coe_injective this⟩
#align FinBoolAlg.forget_to_FinPartOrd_faithful FinBoolAlg.forget_to_finPartOrd_faithful

/-- Constructs an equivalence between finite Boolean algebras from an order isomorphism between
them. -/
@[simps]
def Iso.mk {α β : FinBoolAlg.{u}} (e : α ≃o β) : α ≅ β
    where
  hom := (e : BoundedLatticeHom α β)
  inv := (e.symm : BoundedLatticeHom β α)
  hom_inv_id' := by
    ext
    exact e.symm_apply_apply _
  inv_hom_id' := by
    ext
    exact e.apply_symm_apply _
#align FinBoolAlg.iso.mk FinBoolAlg.Iso.mk

/-- `order_dual` as a functor. -/
@[simps]
def dual : FinBoolAlg ⥤ FinBoolAlg where
  obj X := of Xᵒᵈ
  map X Y := BoundedLatticeHom.dual
#align FinBoolAlg.dual FinBoolAlg.dual

/-- The equivalence between `FinBoolAlg` and itself induced by `order_dual` both ways. -/
@[simps Functor inverse]
def dualEquiv : FinBoolAlg ≌ FinBoolAlg :=
  Equivalence.mk dual dual
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
#align FinBoolAlg.dual_equiv FinBoolAlg.dualEquiv

end FinBoolAlg

/-- The powerset functor. `set` as a functor. -/
@[simps]
def fintypeToFinBoolAlgOp : FintypeCat ⥤ FinBoolAlgᵒᵖ
    where
  obj X := op <| FinBoolAlg.of (Set X)
  map X Y f :=
    Quiver.Hom.op <| (CompleteLatticeHom.setPreimage f : BoundedLatticeHom (Set Y) (Set X))
#align Fintype_to_FinBoolAlg_op fintypeToFinBoolAlgOp


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import algebra.ne_zero
import data.nat.modeq
import data.fintype.lattice

/-!
# Definition of `zmod n` + basic results.

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

This file provides the basic details of `zmod n`, including its commutative ring structure.

## Implementation details

This used to be inlined into data/zmod/basic.lean. This file imports `char_p/basic`, which is an
issue; all `char_p` instances create an `algebra (zmod p) R` instance; however, this instance may
not be definitionally equal to other `algebra` instances (for example, `galois_field` also has an
`algebra` instance as it is defined as a `splitting_field`). The way to fix this is to use the
forgetful inheritance pattern, and make `char_p` carry the data of what the `smul` should be (so
for example, the `smul` on the `galois_field` `char_p` instance should be equal to the `smul` from
its `splitting_field` structure); there is only one possible `zmod p` algebra for any `p`, so this
is not an issue mathematically. For this to be possible, however, we need `char_p/basic` to be
able to import some part of `zmod`.

-/

namespace fin

/-!
## Ring structure on `fin n`

We define a commutative ring structure on `fin n`, but we do not register it as instance.
Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
to register the ring structure on `zmod n` as type class instance.
-/

open nat.modeq int

/-- Multiplicative commutative semigroup structure on `fin n`. -/
instance (n : ℕ) : comm_semigroup (fin n) :=
{ mul_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
    (calc ((a * b) % n * c) ≡ a * b * c [MOD n] : (nat.mod_modeq _ _).mul_right _
      ... ≡ a * (b * c) [MOD n] : by rw mul_assoc
      ... ≡ a * (b * c % n) [MOD n] : (nat.mod_modeq _ _).symm.mul_left _),
  mul_comm := fin.mul_comm,
  ..fin.has_mul }

private lemma left_distrib_aux (n : ℕ) : ∀ a b c : fin n, a * (b + c) = a * b + a * c :=
λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
(calc a * ((b + c) % n) ≡ a * (b + c) [MOD n] : (nat.mod_modeq _ _).mul_left _
  ... ≡ a * b + a * c [MOD n] : by rw mul_add
  ... ≡ (a * b) % n + (a * c) % n [MOD n] :
        (nat.mod_modeq _ _).symm.add (nat.mod_modeq _ _).symm)

/-- Commutative ring structure on `fin n`. -/
instance (n : ℕ) [ne_zero n] : comm_ring (fin n) :=
{ one_mul := fin.one_mul,
  mul_one := fin.mul_one,
  left_distrib := left_distrib_aux n,
  right_distrib := λ a b c, by rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm]; refl,
  ..fin.add_monoid_with_one,
  ..fin.add_comm_group n,
  ..fin.comm_semigroup n }

end fin

/-- The integers modulo `n : ℕ`. -/
def zmod : ℕ → Type
| 0     := ℤ
| (n+1) := fin (n+1)

instance zmod.decidable_eq : Π (n : ℕ), decidable_eq (zmod n)
| 0     := int.decidable_eq
| (n+1) := fin.decidable_eq _

instance zmod.has_repr : Π (n : ℕ), has_repr (zmod n)
| 0     := int.has_repr
| (n+1) := fin.has_repr _

namespace zmod

instance fintype : Π (n : ℕ) [ne_zero n], fintype (zmod n)
| 0    h  := by exactI (ne_zero.ne 0 rfl).elim
| (n+1) _ := fin.fintype (n+1)

instance infinite : infinite (zmod 0) :=
int.infinite

@[simp] lemma card (n : ℕ) [fintype (zmod n)] : fintype.card (zmod n) = n :=
begin
  casesI n,
  { exact (not_finite (zmod 0)).elim },
  { convert fintype.card_fin (n+1) }
end

/- We define each field by cases, to ensure that the eta-expanded `zmod.comm_ring` is defeq to the
original, this helps avoid diamonds with instances coming from classes extending `comm_ring` such as
field. -/
instance comm_ring (n : ℕ) : comm_ring (zmod n) :=
{ add := nat.cases_on n ((@has_add.add) int _) (λ n, @has_add.add (fin n.succ) _),
  add_assoc := nat.cases_on n (@add_assoc int _) (λ n, @add_assoc (fin n.succ) _),
  zero := nat.cases_on n (0 : int) (λ n, (0 : fin n.succ)),
  zero_add := nat.cases_on n (@zero_add int _) (λ n, @zero_add (fin n.succ) _),
  add_zero := nat.cases_on n (@add_zero int _) (λ n, @add_zero (fin n.succ) _),
  neg := nat.cases_on n ((@has_neg.neg) int _) (λ n, @has_neg.neg (fin n.succ) _),
  sub := nat.cases_on n ((@has_sub.sub) int _) (λ n, @has_sub.sub (fin n.succ) _),
  sub_eq_add_neg := nat.cases_on n (@sub_eq_add_neg int _) (λ n, @sub_eq_add_neg (fin n.succ) _),
  zsmul := nat.cases_on n ((@comm_ring.zsmul) int _) (λ n, @comm_ring.zsmul (fin n.succ) _),
  zsmul_zero' := nat.cases_on n (@comm_ring.zsmul_zero' int _)
    (λ n, @comm_ring.zsmul_zero' (fin n.succ) _),
  zsmul_succ' := nat.cases_on n (@comm_ring.zsmul_succ' int _)
    (λ n, @comm_ring.zsmul_succ' (fin n.succ) _),
  zsmul_neg' := nat.cases_on n (@comm_ring.zsmul_neg' int _)
    (λ n, @comm_ring.zsmul_neg' (fin n.succ) _),
  nsmul := nat.cases_on n ((@comm_ring.nsmul) int _) (λ n, @comm_ring.nsmul (fin n.succ) _),
  nsmul_zero' := nat.cases_on n (@comm_ring.nsmul_zero' int _)
    (λ n, @comm_ring.nsmul_zero' (fin n.succ) _),
  nsmul_succ' := nat.cases_on n (@comm_ring.nsmul_succ' int _)
    (λ n, @comm_ring.nsmul_succ' (fin n.succ) _),
  add_left_neg := by { cases n, exacts [@add_left_neg int _, @add_left_neg (fin n.succ) _] },
  add_comm := nat.cases_on n (@add_comm int _) (λ n, @add_comm (fin n.succ) _),
  mul := nat.cases_on n ((@has_mul.mul) int _) (λ n, @has_mul.mul (fin n.succ) _),
  mul_assoc := nat.cases_on n (@mul_assoc int _) (λ n, @mul_assoc (fin n.succ) _),
  one := nat.cases_on n (1 : int) (λ n, (1 : fin n.succ)),
  one_mul := nat.cases_on n (@one_mul int _) (λ n, @one_mul (fin n.succ) _),
  mul_one := nat.cases_on n (@mul_one int _) (λ n, @mul_one (fin n.succ) _),
  nat_cast := nat.cases_on n (coe : ℕ → ℤ) (λ n, (coe : ℕ → fin n.succ)),
  nat_cast_zero := nat.cases_on n (@nat.cast_zero int _) (λ n, @nat.cast_zero (fin n.succ) _),
  nat_cast_succ := nat.cases_on n (@nat.cast_succ int _) (λ n, @nat.cast_succ (fin n.succ) _),
  int_cast := nat.cases_on n (coe : ℤ → ℤ) (λ n, (coe : ℤ → fin n.succ)),
  int_cast_of_nat := nat.cases_on n (@int.cast_of_nat int _) (λ n, @int.cast_of_nat (fin n.succ) _),
  int_cast_neg_succ_of_nat := nat.cases_on n (@int.cast_neg_succ_of_nat int _)
    (λ n, @int.cast_neg_succ_of_nat (fin n.succ) _),
  left_distrib := nat.cases_on n (@left_distrib int _ _ _) (λ n, @left_distrib (fin n.succ) _ _ _),
  right_distrib :=
    nat.cases_on n (@right_distrib int _ _ _) (λ n, @right_distrib (fin n.succ) _ _ _),
  mul_comm := nat.cases_on n (@mul_comm int _) (λ n, @mul_comm (fin n.succ) _) }

instance inhabited (n : ℕ) : inhabited (zmod n) := ⟨0⟩

end zmod


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.associated
import Mathlib.algebra.big_operators.basic
import Mathlib.data.nat.enat
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-- `multiplicity a b` returns the largest natural number `n` such that
  `a ^ n ∣ b`, as an `enat` or natural with infinity. If `∀ n, a ^ n ∣ b`,
  then it returns `⊤`-/
def multiplicity {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] (a : α) (b : α) : enat :=
  enat.find fun (n : ℕ) => ¬a ^ (n + 1) ∣ b

namespace multiplicity

/-- `multiplicity.finite a b` indicates that the multiplicity of `a` in `b` is finite. -/
def finite {α : Type u_1} [comm_monoid α] (a : α) (b : α) := ∃ (n : ℕ), ¬a ^ (n + 1) ∣ b

theorem finite_iff_dom {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α} :
    finite a b ↔ roption.dom (multiplicity a b) :=
  iff.rfl

theorem finite_def {α : Type u_1} [comm_monoid α] {a : α} {b : α} :
    finite a b ↔ ∃ (n : ℕ), ¬a ^ (n + 1) ∣ b :=
  iff.rfl

theorem int.coe_nat_multiplicity (a : ℕ) (b : ℕ) : multiplicity ↑a ↑b = multiplicity a b := sorry

theorem not_finite_iff_forall {α : Type u_1} [comm_monoid α] {a : α} {b : α} :
    ¬finite a b ↔ ∀ (n : ℕ), a ^ n ∣ b :=
  sorry

theorem not_unit_of_finite {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : finite a b) :
    ¬is_unit a :=
  sorry

theorem finite_of_finite_mul_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} {c : α} :
    finite a (b * c) → finite a c :=
  sorry

theorem finite_of_finite_mul_right {α : Type u_1} [comm_monoid α] {a : α} {b : α} {c : α} :
    finite a (b * c) → finite a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (finite a (b * c) → finite a b)) (mul_comm b c)))
    finite_of_finite_mul_left

theorem pow_dvd_of_le_multiplicity {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    {b : α} {k : ℕ} : ↑k ≤ multiplicity a b → a ^ k ∣ b :=
  sorry

theorem pow_multiplicity_dvd {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    {b : α} (h : finite a b) : a ^ roption.get (multiplicity a b) h ∣ b :=
  pow_dvd_of_le_multiplicity
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (↑(roption.get (multiplicity a b) h) ≤ multiplicity a b))
          (enat.coe_get h)))
      (le_refl (multiplicity a b)))

theorem is_greatest {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α}
    {m : ℕ} (hm : multiplicity a b < ↑m) : ¬a ^ m ∣ b :=
  sorry

theorem is_greatest' {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α}
    {m : ℕ} (h : finite a b) (hm : roption.get (multiplicity a b) h < m) : ¬a ^ m ∣ b :=
  is_greatest
    (eq.mp (Eq._oldrec (Eq.refl (↑(roption.get (multiplicity a b) h) < ↑m)) (enat.coe_get h))
      (eq.mp
        (Eq._oldrec (Eq.refl (roption.get (multiplicity a b) h < m))
          (Eq.symm (propext enat.coe_lt_coe)))
        hm))

theorem unique {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α} {k : ℕ}
    (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) : ↑k = multiplicity a b :=
  sorry

theorem unique' {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α} {k : ℕ}
    (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) :
    k = roption.get (multiplicity a b) (Exists.intro k hsucc) :=
  sorry

theorem le_multiplicity_of_pow_dvd {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    {b : α} {k : ℕ} (hk : a ^ k ∣ b) : ↑k ≤ multiplicity a b :=
  le_of_not_gt fun (hk' : ↑k > multiplicity a b) => is_greatest hk' hk

theorem pow_dvd_iff_le_multiplicity {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd]
    {a : α} {b : α} {k : ℕ} : a ^ k ∣ b ↔ ↑k ≤ multiplicity a b :=
  { mp := le_multiplicity_of_pow_dvd, mpr := pow_dvd_of_le_multiplicity }

theorem multiplicity_lt_iff_neg_dvd {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd]
    {a : α} {b : α} {k : ℕ} : multiplicity a b < ↑k ↔ ¬a ^ k ∣ b :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (multiplicity a b < ↑k ↔ ¬a ^ k ∣ b))
        (propext pow_dvd_iff_le_multiplicity)))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (multiplicity a b < ↑k ↔ ¬↑k ≤ multiplicity a b)) (propext not_le)))
      (iff.refl (multiplicity a b < ↑k)))

theorem eq_some_iff {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α}
    {n : ℕ} : multiplicity a b = ↑n ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b :=
  sorry

theorem eq_top_iff {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α} {b : α} :
    multiplicity a b = ⊤ ↔ ∀ (n : ℕ), a ^ n ∣ b :=
  sorry

theorem one_right {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    (ha : ¬is_unit a) : multiplicity a 1 = 0 :=
  sorry

@[simp] theorem get_one_right {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    (ha : finite a 1) : roption.get (multiplicity a 1) ha = 0 :=
  sorry

@[simp] theorem multiplicity_unit {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    (b : α) (ha : is_unit a) : multiplicity a b = ⊤ :=
  iff.mpr eq_top_iff fun (_x : ℕ) => iff.mp is_unit_iff_forall_dvd (is_unit.pow _x ha) b

@[simp] theorem one_left {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] (b : α) :
    multiplicity 1 b = ⊤ :=
  sorry

theorem multiplicity_eq_zero_of_not_dvd {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd]
    {a : α} {b : α} (ha : ¬a ∣ b) : multiplicity a b = 0 :=
  sorry

theorem eq_top_iff_not_finite {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    {b : α} : multiplicity a b = ⊤ ↔ ¬finite a b :=
  roption.eq_none_iff'

theorem multiplicity_le_multiplicity_iff {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd]
    {a : α} {b : α} {c : α} {d : α} :
    multiplicity a b ≤ multiplicity c d ↔ ∀ (n : ℕ), a ^ n ∣ b → c ^ n ∣ d :=
  sorry

theorem multiplicity_le_multiplicity_of_dvd {α : Type u_1} [comm_monoid α]
    [DecidableRel has_dvd.dvd] {a : α} {b : α} {c : α} (hdvd : a ∣ b) :
    multiplicity b c ≤ multiplicity a c :=
  iff.mpr multiplicity_le_multiplicity_iff
    fun (n : ℕ) (h : b ^ n ∣ c) => dvd_trans (pow_dvd_pow_of_dvd hdvd n) h

theorem dvd_of_multiplicity_pos {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    {b : α} (h : 0 < multiplicity a b) : a ∣ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ b)) (Eq.symm (pow_one a))))
    (pow_dvd_of_le_multiplicity (iff.mp enat.pos_iff_one_le h))

theorem dvd_iff_multiplicity_pos {α : Type u_1} [comm_monoid α] [DecidableRel has_dvd.dvd] {a : α}
    {b : α} : 0 < multiplicity a b ↔ a ∣ b :=
  sorry

theorem finite_nat_iff {a : ℕ} {b : ℕ} : finite a b ↔ a ≠ 1 ∧ 0 < b := sorry

theorem ne_zero_of_finite {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α}
    (h : finite a b) : b ≠ 0 :=
  sorry

@[simp] protected theorem zero {α : Type u_1} [comm_monoid_with_zero α] [DecidableRel has_dvd.dvd]
    (a : α) : multiplicity a 0 = ⊤ :=
  sorry

@[simp] theorem multiplicity_zero_eq_zero_of_ne_zero {α : Type u_1} [comm_monoid_with_zero α]
    [DecidableRel has_dvd.dvd] (a : α) (ha : a ≠ 0) : multiplicity 0 a = 0 :=
  multiplicity_eq_zero_of_not_dvd
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬0 ∣ a)) (propext zero_dvd_iff))) ha)

theorem min_le_multiplicity_add {α : Type u_1} [comm_semiring α] [DecidableRel has_dvd.dvd] {p : α}
    {a : α} {b : α} : min (multiplicity p a) (multiplicity p b) ≤ multiplicity p (a + b) :=
  sorry

@[simp] protected theorem neg {α : Type u_1} [comm_ring α] [DecidableRel has_dvd.dvd] (a : α)
    (b : α) : multiplicity a (-b) = multiplicity a b :=
  sorry

theorem multiplicity_add_of_gt {α : Type u_1} [comm_ring α] [DecidableRel has_dvd.dvd] {p : α}
    {a : α} {b : α} (h : multiplicity p b < multiplicity p a) :
    multiplicity p (a + b) = multiplicity p b :=
  sorry

theorem multiplicity_sub_of_gt {α : Type u_1} [comm_ring α] [DecidableRel has_dvd.dvd] {p : α}
    {a : α} {b : α} (h : multiplicity p b < multiplicity p a) :
    multiplicity p (a - b) = multiplicity p b :=
  sorry

theorem multiplicity_add_eq_min {α : Type u_1} [comm_ring α] [DecidableRel has_dvd.dvd] {p : α}
    {a : α} {b : α} (h : multiplicity p a ≠ multiplicity p b) :
    multiplicity p (a + b) = min (multiplicity p a) (multiplicity p b) :=
  sorry

theorem finite_mul_aux {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} (hp : prime p)
    {n : ℕ} {m : ℕ} {a : α} {b : α} :
    ¬p ^ (n + 1) ∣ a → ¬p ^ (m + 1) ∣ b → ¬p ^ (n + m + 1) ∣ a * b :=
  sorry

theorem finite_mul {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} {a : α} {b : α}
    (hp : prime p) : finite p a → finite p b → finite p (a * b) :=
  sorry

theorem finite_mul_iff {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} {a : α} {b : α}
    (hp : prime p) : finite p (a * b) ↔ finite p a ∧ finite p b :=
  { mp :=
      fun (h : finite p (a * b)) =>
        { left := finite_of_finite_mul_right h, right := finite_of_finite_mul_left h },
    mpr := fun (h : finite p a ∧ finite p b) => finite_mul hp (and.left h) (and.right h) }

theorem finite_pow {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} {a : α} (hp : prime p)
    {k : ℕ} (ha : finite p a) : finite p (a ^ k) :=
  sorry

@[simp] theorem multiplicity_self {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [DecidableRel has_dvd.dvd] {a : α} (ha : ¬is_unit a) (ha0 : a ≠ 0) : multiplicity a a = 1 :=
  sorry

@[simp] theorem get_multiplicity_self {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [DecidableRel has_dvd.dvd] {a : α} (ha : finite a a) : roption.get (multiplicity a a) ha = 1 :=
  sorry

protected theorem mul' {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableRel has_dvd.dvd]
    {p : α} {a : α} {b : α} (hp : prime p) (h : roption.dom (multiplicity p (a * b))) :
    roption.get (multiplicity p (a * b)) h =
        roption.get (multiplicity p a) (and.left (iff.mp (finite_mul_iff hp) h)) +
          roption.get (multiplicity p b) (and.right (iff.mp (finite_mul_iff hp) h)) :=
  sorry

protected theorem mul {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableRel has_dvd.dvd]
    {p : α} {a : α} {b : α} (hp : prime p) :
    multiplicity p (a * b) = multiplicity p a + multiplicity p b :=
  sorry

theorem finset.prod {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableRel has_dvd.dvd]
    {β : Type u_2} {p : α} (hp : prime p) (s : finset β) (f : β → α) :
    multiplicity p (finset.prod s fun (x : β) => f x) =
        finset.sum s fun (x : β) => multiplicity p (f x) :=
  sorry

protected theorem pow' {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableRel has_dvd.dvd]
    {p : α} {a : α} (hp : prime p) (ha : finite p a) {k : ℕ} :
    roption.get (multiplicity p (a ^ k)) (finite_pow hp ha) =
        k * roption.get (multiplicity p a) ha :=
  sorry

theorem pow {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableRel has_dvd.dvd] {p : α}
    {a : α} (hp : prime p) {k : ℕ} : multiplicity p (a ^ k) = k •ℕ multiplicity p a :=
  sorry

theorem multiplicity_pow_self {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [DecidableRel has_dvd.dvd] {p : α} (h0 : p ≠ 0) (hu : ¬is_unit p) (n : ℕ) :
    multiplicity p (p ^ n) = ↑n :=
  sorry

theorem multiplicity_pow_self_of_prime {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [DecidableRel has_dvd.dvd] {p : α} (hp : prime p) (n : ℕ) : multiplicity p (p ^ n) = ↑n :=
  multiplicity_pow_self (prime.ne_zero hp) (prime.not_unit hp) n

end multiplicity

theorem multiplicity_eq_zero_of_coprime {p : ℕ} {a : ℕ} {b : ℕ} (hp : p ≠ 1)
    (hle : multiplicity p a ≤ multiplicity p b) (hab : nat.coprime a b) : multiplicity p a = 0 :=
  sorry

end Mathlib


import .supermatroid

universes u v

variables {α : Type u} [supermatroid α] {a i s x y b : α}

open subtype set

section restriction

/-- The restriction of a supermatroid to the elements below a given `a` -/
instance  : supermatroid (Iic a) := {
  carrier := range (λ (i : {i // i basis_for a}), ⟨i,i.2.le⟩),
  nonempty := exists.elim (exists_basis a) (λ i hi, ⟨⟨i,hi.le⟩,by simpa⟩),

  is_antichain :=
  begin
    rintros ⟨x,hx⟩ ⟨⟨y,hyb⟩,hy⟩ ⟨z,hz⟩ ⟨⟨w,hwb⟩,hw⟩ h_ne h_le,
    simp only [coe_mk, mk_eq_mk] at hw hy, subst hw, subst hy,
    exact basis_antichain a hyb hwb (λ hxz, h_ne (mk_eq_mk.mpr hxz)) (mk_le_mk.mp h_le),
  end,

  exists_base_mid_of_indep_le_spanning :=
  begin
    rintros ⟨x,hxa⟩ ⟨y,hya⟩ ⟨⟨i,hi⟩,⟨⟨i₀,hi₀b⟩,hi₀⟩,hxi⟩ ⟨⟨i',hi'⟩,⟨⟨i₁,hi₁b⟩,hi₁⟩,hys⟩ hle,
    simp only [coe_mk, mk_eq_mk] at hi₀ hi₁, subst hi₀, subst hi₁,
    rw [mk_le_mk] at hle hxi hys,
    refine (em (x basis_for a)).elim
      (λ hx, ⟨⟨x, hx.le⟩, ⟨⟨x,hx⟩, by simp only [coe_mk, mk_eq_mk]⟩, by simpa⟩)
      (λ h_nb, _),

    obtain ⟨b,hba,hxb,hbx⟩ :=
      ((hi₀b.indep.indep_of_le hxi).lt_basis_le_sup_of_not_basis h_nb hi₁b (hxi.trans hi₀b.le)),

    exact ⟨⟨b,hba.le⟩,⟨⟨b,hba⟩, by simp⟩, by simpa using hxb.le, (hbx.trans (sup_le hle hys))⟩,
  end,

  le_basis_of_indep_le :=
  begin
    rintros ⟨i,hia⟩ ⟨x,hxa⟩ ⟨⟨i',hi'⟩,⟨⟨i₀,hi₀b⟩,hi₀⟩,hxi'⟩ hix,
    simp only [coe_mk, mk_eq_mk] at hi₀, subst hi₀,
    rw [mk_le_mk] at hxi' hix,
    obtain ⟨j,hj,hij⟩ := (hi₀b.indep.indep_of_le hxi').le_basis_of_le hix,
    obtain ⟨j',hj',hjj'⟩ := hj.indep.le_basis_of_le (hj.le.trans hxa),
    refine ⟨⟨j,hj.le.trans hxa⟩, ⟨⟨⟨j',hj'.le⟩,⟨⟨j',hj'⟩,rfl⟩,mk_le_mk.mpr hjj'⟩,
      mk_le_mk.mpr hj.le, _⟩,
      mk_le_mk.mpr hij⟩,

    rintros ⟨j₁,hj₁a⟩ ⟨⟨b₁, hb₁a⟩,⟨⟨b',hb'⟩,hbb'⟩,hj₁b₁⟩ hj₁x hjj₁,
    simp only [coe_mk, mk_eq_mk] at hbb' ⊢, subst hbb', rw mk_le_mk at *,
    exact hj.eq_of_le_indep (hb'.indep_of_le hj₁b₁) hjj₁ hj₁x,
  end,

  .. (infer_instance : complete_lattice (Iic a)) }

@[simp] lemma base_Iic_iff_coe_basis {b : Iic a} : base b ↔ (↑b : α) basis_for a :=
begin
  obtain ⟨b,hba⟩ := b, rw coe_mk,
  exact ⟨λ ⟨⟨b',hb'⟩,hb⟩, by {simp only [coe_mk, mk_eq_mk] at hb, exact hb ▸ hb'},
    λ hb, ⟨⟨b,hb⟩,rfl⟩⟩,
end

@[simp] lemma mk_base_iff {a b : α} {hba : b ≤ a} : @base (Iic a) _ ⟨b,hba⟩ ↔ b basis_for a :=
by simp only [base_Iic_iff_coe_basis, coe_mk]

@[simp] lemma indep_Iic_iff_indep {i : Iic a} : indep i ↔ indep (i : α) :=
begin
  obtain ⟨i,hia⟩ := i,
  simp only [@indep_iff_le_base (Iic a), base_Iic_iff_coe_basis, set_coe.exists, mem_Iic, coe_mk,
    mk_le_mk, exists_prop],
  exact ⟨λ h, exists.elim h (λ j hj, hj.2.1.indep_of_le hj.2.2),
    λ h, (h.le_basis_of_le hia).imp (λ j hj, ⟨hj.1.le,hj⟩)⟩,
end

@[simp] lemma mk_indep_iff {a i : α} {ha : i ≤ a} : @indep (Iic a) _ ⟨i,ha⟩ ↔ indep i :=
by simp only [indep_Iic_iff_indep, coe_mk]

@[simp] lemma basis_Iic_iff_coe_basis_coe {i x : Iic a} :
  i basis_for x ↔ (i : α) basis_for (x : α) :=
begin
  obtain ⟨⟨i,hia⟩,⟨x,hxa⟩⟩ := ⟨i,x⟩,
  simp only [@basis_iff (Iic a), indep_Iic_iff_indep, coe_mk, mk_le_mk, set_coe.forall, mk_eq_mk,
    mem_Iic],
  exact ⟨λ ⟨hi,hix,hi'⟩, hi.basis_for hix (λ j hj hjx hij, hi' j (hjx.trans hxa) hj hjx hij),
    λ h, ⟨h.indep,h.le,λ j hja hj hjx hij, h.eq_of_le_indep hj hij hjx⟩⟩,
end

@[simp] lemma mk_basis_iff {a i x : α} {hia : i ≤ a} {hxa : x ≤ a} :
  (⟨i,hia⟩ : Iic a) basis_for ⟨x,hxa⟩ ↔ i basis_for x :=
by simp only [basis_Iic_iff_coe_basis_coe, coe_mk]

@[simp] lemma spanning_Iic_iff_exists_basis_le_coe {s : Iic a} :
  spanning s ↔ ∃ i, i basis_for a ∧ i ≤ s :=
begin
  obtain ⟨s,hs⟩ := s,
  simp only [spanning_iff_basis_le, base_Iic_iff_coe_basis, set_coe.exists, mem_Iic, coe_mk,
    mk_le_mk, exists_prop],
  exact ⟨λ h, h.imp (λ i hi, hi.2), λ h, h.imp (λ i hi, ⟨hi.1.le,hi⟩)⟩,
end

end restriction

section corestriction

/-- The corestriction of a supermatroid to the elements above a given `a` -/
instance : supermatroid (Ici a) :=
{ carrier := range (λ (s : {s // s canopy_for a}), ⟨s,s.2.le⟩),
  nonempty := exists.elim (exists_canopy a) (λ s hs, ⟨⟨s,hs.le⟩,by simpa⟩),

  is_antichain :=
  begin
    rintros ⟨x,hx⟩ ⟨⟨y,hyb⟩,hy⟩ ⟨z,hz⟩ ⟨⟨w,hwb⟩,hw⟩ h_ne h_le,
    simp only [coe_mk, mk_eq_mk] at hw hy, subst hy, subst hw,
    exact canopy_antichain a hyb hwb (λ hxz, h_ne (mk_eq_mk.mpr hxz)) (mk_le_mk.mp h_le),
  end,

  exists_base_mid_of_indep_le_spanning :=
    λ i s hi hs his, @spanning.exists_base_mid_of_indep_le (Iic a : set αᵒᵈ) _ s i hi hs his,

  le_basis_of_indep_le := λ i x hi hix, @spanning.canopy_le_of_le (Iic a : set αᵒᵈ) _ i x hi hix,

  .. (infer_instance : complete_lattice (Ici a)) }

lemma base_Ici_iff_coe_canopy {b : Ici a} :
  base b ↔ (b : α) canopy_for a :=
@base_Iic_iff_coe_basis αᵒᵈ _ _ _

lemma base_Ici_iff_eq_sup_and_inf_basis {s : Ici a} :
  base s ↔ ∃ b, base b ∧ (s : α) = a ⊔ b ∧ a ⊓ b basis_for a :=
begin
  obtain ⟨s,(hs : a ≤ s)⟩ := s,
  rw [base_Ici_iff_coe_canopy, coe_mk],
  refine ⟨λ h, _, by {rintros ⟨_,h,rfl,_⟩, rwa h.sup_canopy_iff_inf_basis}⟩,
  obtain ⟨b, hb, rfl ,h'⟩ := h.exists_base,
  exact ⟨_,hb,rfl,hb.sup_canopy_iff_inf_basis.mp h⟩,
end

lemma base.sup_base_Ici_iff (hb : base b) :
  base (⟨a ⊔ b, @le_sup_left _ _ a b⟩ : Ici a) ↔ a ⊓ b basis_for a :=
by rw [base_Ici_iff_coe_canopy, coe_mk, hb.sup_canopy_iff_inf_basis]

lemma base.sup_base_Ici_of_inf_basis (hb : base b) (hab : a ⊓ b basis_for a):
  base (⟨a ⊔ b, @le_sup_left _ _ a b⟩ : Ici a) :=
hb.sup_base_Ici_iff.mpr hab

lemma indep_Ici_iff_exists_canopy_ge_coe {s : Ici a} :
  indep s ↔ ∃ t, t canopy_for a ∧ (s : α) ≤ t :=
@spanning_Iic_iff_exists_basis_le_coe αᵒᵈ _ _ s

lemma indep_Ici_iff_coe_le_sup_base {i : Ici a} :
  indep i ↔ ∃ b, base b ∧ (a ⊓ b) basis_for a ∧ (i : α) ≤ a ⊔ b :=
begin
  rw indep_Ici_iff_exists_canopy_ge_coe,
  split,
  { rintros ⟨t,hta,hit⟩,
    obtain ⟨b,hb,rfl,hmin⟩ := hta.exists_base,
    exact ⟨_, hb, hb.sup_canopy_iff_inf_basis.mp hta, hit⟩},
  rintros ⟨b,hb,hab,hiab⟩,
  refine ⟨_, hb.sup_canopy_iff_inf_basis.mpr hab, hiab⟩,
end

lemma foo_Ici {i x : α} (hix : i basis_for x) :
  ∃ (j : Ici a), (j :α) ≤ a ⊔ i ∧ j basis_for ⟨a ⊔ x, (le_sup_left : a ≤ a ⊔ x)⟩ :=
begin
  obtain ⟨⟨k,(hak : a ≤ k)⟩,hk⟩ := exists_basis (⟨a ⊔ i, (le_sup_left : a ≤ a ⊔ i)⟩ : Ici a),
  refine ⟨⟨k,hak⟩,hk.le, hk.indep, mk_le_mk.mpr (le_trans hk.le (sup_le_sup_left hix.le _)),_⟩,
  rintros ⟨j,(hja : a ≤ j)⟩ hji hjax hkj,
  refine hk.eq_of_le_indep hji hkj (mk_le_mk.mpr _),

  --obtain ⟨b,hb,hab,hjab⟩ := indep_Ici_iff_coe_le_sup_base.mp hji,

  --rw mk_le_mk at *, rw mk_eq_mk,

  --rintros ⟨⟨j,(hja : a ≤ j)⟩, _⟩,

end

-- lemma basis_Ici_iff {i x : Ici a} :
--   i basis_for x ↔ ∃ b, base b ∧ (a ⊓ b) basis_for a ∧ (i :α) = x ⊓ (a ⊔ b) ∧
--     ∀ b', base b' → (a ⊓ b') basis_for a → a ⊓ b ≤ b' → a ⊓ b = a ⊓ b' :=
-- begin

--   obtain ⟨⟨i, (hai : a ≤ i)⟩,⟨x, (hax : a ≤ x)⟩⟩ := ⟨i,x⟩,

--   simp_rw coe_mk at *,
--   refine ⟨λ h, _, λ h, _⟩,
--   { obtain ⟨⟨s,h₀⟩,hs, hixs, hforall⟩ := h.exists_base,
--     rw [base_Ici_iff_coe_canopy, coe_mk] at hs,
--     obtain ⟨b,hb,rfl,hmax⟩ := hs.exists_base,
--     simp only [subtype.mk_sup, subtype.mk_inf, mk_eq_mk] at *,
--     subst hixs,
--     rw hb.sup_canopy_iff_inf_basis at hs,
--     refine ⟨b,hb,hs,rfl,λ b' hb' hab' hb'b, _⟩,

--     have := hforall _ (hb'.sup_base_Ici_of_inf_basis hab')
--       (mk_le_mk.mpr (by {rw [inf_comm, sup_inf_assoc_of_le _ hax, inf_comm],
--         refine sup_le le_sup_left _,
--         have := hab'.eq_of_le_indep (hb.inf_left_indep x) sorry,
--          })),

--      },

--   -- { rintros ⟨⟨b,hb,hab,hiab⟩,hix, hmax⟩,
--   --   simp_rw coe_mk at *,
--   --   refine ⟨b, hb, hab, (le_inf (mk_le_mk.mp hix) hiab).antisymm _, _⟩,

--   --   { },

-- end

-- lemma foo {a : α} {i x : Iic a} {j : α} (hix : i basis_for x) (hji : j basis_for i)
-- (haj : a ⊓ j basis_for a) : j basis_for x :=
-- begin
--   obtain ⟨⟨i,hia⟩,⟨x,hxa⟩⟩ := ⟨i,x⟩,
--   rw [coe_mk] at *,
--   refine hji.indep.basis_for (hji.le.trans (coe_le_coe.mpr hix.le)) (λ j' hj' hj'x hjj', _),

-- end

end corestriction


-- Multilinear functions on pairs

import algebra.algebra.basic
import analysis.complex.basic
import analysis.normed.field.basic
import analysis.normed_space.basic
import analysis.normed_space.multilinear
import data.complex.basic
import topology.algebra.module.multilinear

import tactics

open_locale complex_conjugate
noncomputable theory
variables {n : ℕ}
variables {𝕜 : Type} [nontrivially_normed_field 𝕜]
variables {R A B E : Type} [semiring R]

lemma continuous_multilinear_map.to_fun_eq_coe {R A B : Type} [semiring R]
    [add_comm_monoid A] [module R A] [topological_space A]
    [add_comm_monoid B] [module R B] [topological_space B]
    (f : continuous_multilinear_map R (λ _ : fin n, A) B) : f.to_fun = ⇑f := begin
  rw multilinear_map.to_fun_eq_coe, simp
end

-- A version of curry0 that doesn't assume commutativity
def curry0 (R A : Type) {B : Type} [semiring R]
    [add_comm_monoid A] [module R A] [topological_space A]
    [add_comm_monoid B] [module R B] [topological_space B]
    (b : B) : continuous_multilinear_map R (λ _ : fin 0, A) B := {
  to_fun := λ _, b,
  map_add' := by simp,
  map_smul' := by simp,
  cont := by continuity
}

lemma curry0_apply [add_comm_monoid A] [module R A] [topological_space A] [add_comm_monoid B] [module R B] [topological_space B]
    (b : B) (a : Π _ : fin 0, A) : curry0 R A b a = b := by rw [curry0, ←continuous_multilinear_map.to_fun_eq_coe]

lemma curry0_norm [normed_add_comm_group A] [normed_space 𝕜 A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (b : B) : ∥curry0 𝕜 A b∥ = ∥b∥ := begin
  apply le_antisymm, {
    apply continuous_multilinear_map.op_norm_le_bound,
    simp, intro a, rw [curry0_apply b a, finset.univ_eq_empty, finset.prod_empty], simp
  }, {
    have lo := continuous_multilinear_map.unit_le_op_norm (curry0 𝕜 A b) fin.elim0 _,
    rw curry0_apply at lo, assumption,
    rw pi.norm_def, simp
  }
end

-- fst as a continuous_multilinear_map
def fst_cmmap (R : Type) (A B : Type) [semiring R]
    [add_comm_monoid A] [module R A] [topological_space A]
    [add_comm_monoid B] [module R B] [topological_space B]
    : continuous_multilinear_map R (λ _ : fin 1, A × B) A := {
  -- Once we upgrade mathlib, this can be
  --   (continuous_linear_map.fst R A B).comp_continuous_multilinear_map
  --     (continuous_multilinear_map.of_subsingleton R (A × B) (0 : fin 1))
  -- and similarly for snd_cmmap.
  to_fun := λ z, (z 0).fst,
  map_add' := begin intros z i x y, have i0 : i = 0 := by simp, rw i0, simp end,
  map_smul' := begin intros z i s x, have i0 : i = 0 := by simp, rw i0, simp end,
  cont := by continuity
}

-- snd as a continuous_multilinear_map
def snd_cmmap (R : Type) (A B : Type) [semiring R]
    [add_comm_monoid A] [module R A] [topological_space A]
    [add_comm_monoid B] [module R B] [topological_space B]
    : continuous_multilinear_map R (λ _ : fin 1, A × B) B := {
  to_fun := λ z, (z 0).snd,
  map_add' := begin intros z i x y, have i0 : i = 0 := by simp, rw i0, simp end,
  map_smul' := begin intros z i s x, have i0 : i = 0 := by simp, rw i0, simp end,
  cont := by continuity
}

lemma fst_cmmap_apply [add_comm_monoid A] [module R A] [topological_space A] [add_comm_monoid B] [module R B] [topological_space B]
    (a : A) (b : B) : fst_cmmap R A B (λ _, (a,b)) = a := by rw [fst_cmmap, ←continuous_multilinear_map.to_fun_eq_coe]

lemma snd_cmmap_apply [add_comm_monoid A] [module R A] [topological_space A] [add_comm_monoid B] [module R B] [topological_space B]
    (a : A) (b : B) : snd_cmmap R A B (λ _, (a,b)) = b := by rw [snd_cmmap, ←continuous_multilinear_map.to_fun_eq_coe]

lemma fst_cmmap_norm [normed_ring A] [normed_algebra 𝕜 A] [norm_one_class A] [normed_ring B] [normed_algebra 𝕜 B] [norm_one_class B]
    : ∥fst_cmmap 𝕜 A B∥ = 1 := begin
  apply le_antisymm, {
    apply @continuous_multilinear_map.op_norm_le_bound 𝕜 _ (λ _ : fin 1, A × B) _ _ _ _ _ _ _ _ (fst_cmmap 𝕜 A B) (1 : ℝ) (by norm_num),
    intro z, simp,
    have e : z = (λ _, ((z 0).fst, (z 0).snd)), { apply funext, intro i, rw fin.eq_zero i, simp }, rw e,
    rw fst_cmmap_apply, simp, exact norm_fst_le (z 0)
  }, {
    have lo := @continuous_multilinear_map.unit_le_op_norm 𝕜 _ (λ _ : fin 1, A × B) A _ _ _ _ _ _ _ (fst_cmmap 𝕜 A B) (λ _, (1,1)) _,
    rw [fst_cmmap_apply, norm_one] at lo, assumption,
    rw pi_norm_le_iff, intro i, rw prod.norm_def, simp, norm_num
  }
end

lemma snd_cmmap_norm [normed_ring A] [normed_algebra 𝕜 A] [norm_one_class A] [normed_ring B] [normed_algebra 𝕜 B] [norm_one_class B]
    : ∥snd_cmmap 𝕜 A B∥ = 1 := begin
  apply le_antisymm, {
    apply @continuous_multilinear_map.op_norm_le_bound 𝕜 _ (λ _ : fin 1, A × B) _ _ _ _ _ _ _ _ (snd_cmmap 𝕜 A B) (1 : ℝ) (by norm_num),
    intro z, simp,
    have e : z = (λ _, ((z 0).fst, (z 0).snd)), { apply funext, intro i, rw fin.eq_zero i, simp }, rw e,
    rw snd_cmmap_apply, simp, exact norm_snd_le (z 0)
  }, {
    have lo := @continuous_multilinear_map.unit_le_op_norm 𝕜 _ (λ _ : fin 1, A × B) B _ _ _ _ _ _ _ (snd_cmmap 𝕜 A B) (λ _, (1,1)) _,
    rw [snd_cmmap_apply, norm_one] at lo, assumption,
    rw pi_norm_le_iff, intro i, rw prod.norm_def, simp, norm_num
  }
end

-- Lemmas for smul_cmmap
lemma update_0_0 (z : fin (n+1) → A) (x : A) : function.update (λ _ : fin 1, z 0) 0 x = (λ _ : fin 1, x) := begin
  apply funext, intro i,
  have i0 : i = 0 := by simp,
  rw i0, simp
end
lemma update_0_succ (f : fin (n+1) → A) (x : A) (i : fin n) : function.update f 0 x i.succ = f i.succ := begin
  rw function.update_apply, simp,
  have i0 := fin.succ_ne_zero i,
  finish
end
lemma update_nz_0 (f : fin (n+1) → A) {x : A} {i : fin (n+1)} (i0 : i ≠ 0) : function.update f i x 0 = f 0 :=
  by rw function.update_noteq i0.symm
lemma update_nz_succ (f : fin (n+1) → A) (x : A) {i : fin (n+1)} (i0 : i ≠ 0)
    : (λ j : fin n, function.update f i x j.succ) = function.update (λ j : fin n, f j.succ) (i.pred i0) x := begin
  apply funext, intro k,
  by_cases ki : k.succ = i, {
    have ki' : k = i.pred i0 := by simp_rw [←ki, fin.pred_succ],
    rw [ki,ki'], rw function.update_same, rw function.update_same
  }, {
    rw function.update_noteq ki,
    rw function.update_noteq _,
    by_contradiction,
    rw [h,fin.succ_pred _] at ki,
    finish
  }
end

-- Raw cons of two continuous multilinear maps
def smul_cmmap_fn [add_comm_monoid A] [module 𝕜 A] [topological_space A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    : (Π _ : fin (n+1), A) → B :=
  λ z, (x.to_fun (λ _, z 0)) • (xs.to_fun (λ i, z i.succ))

-- smul_cmmap_fn is multiadditive
lemma smul_cmmap_add [add_comm_monoid A] [module 𝕜 A] [topological_space A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    : ∀ (z : Π _ : fin (n+1), A) (i : fin (n+1)) (u v : A),
      smul_cmmap_fn x xs (function.update z i (u + v)) =
      smul_cmmap_fn x xs (function.update z i u) + smul_cmmap_fn x xs (function.update z i v) := begin
  intros z i u v,
  rw smul_cmmap_fn,
  by_cases i0 : i = 0, {
    rw i0, simp, simp_rw update_0_succ z _ _,
    have uv := x.map_add (λ _, z 0) 0 u v,
    rw update_0_0 z _ at uv,
    rw update_0_0 z _ at uv,
    rw update_0_0 z _ at uv,
    rw [uv, add_smul]
  }, {
    simp,
    simp_rw update_nz_0 z i0,
    rw update_nz_succ z _ i0,
    rw update_nz_succ z _ i0,
    rw update_nz_succ z _ i0,
    have uv := xs.map_add (λ j, z j.succ) (i.pred i0) u v,
    rw [uv, smul_add]
  }
end

-- smul_cmmap_fn commutes with scalars
lemma smul_cmmap_smul [add_comm_monoid A] [module 𝕜 A] [topological_space A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    : ∀ (z : Π _ : fin (n+1), A) (i : fin (n+1)) (s : 𝕜) (u : A),
      smul_cmmap_fn x xs (function.update z i (s • u)) = s • smul_cmmap_fn x xs (function.update z i u) := begin
  intros z i s u,
  rw smul_cmmap_fn,
  by_cases i0 : i = 0, {
    rw i0, simp, simp_rw update_0_succ z _ _,
    have su := x.map_smul (λ _, z 0) 0 s u,
    rw update_0_0 z _ at su,
    rw update_0_0 z _ at su,
    rw [su, smul_assoc]
  }, {
    simp,
    simp_rw update_nz_0 z i0,
    rw update_nz_succ z _ i0,
    rw update_nz_succ z _ i0,
    have su := xs.map_smul (λ j, z j.succ) (i.pred i0) s u,
    rw [su, smul_comm]
  }
end

-- smul_cmmap_fn is continuous
lemma smul_cmmap_cont [add_comm_monoid A] [module 𝕜 A] [topological_space A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    : continuous (smul_cmmap_fn x xs) := begin
  rw smul_cmmap_fn, continuity,
  exact x.cont, exact xs.cont
end

-- Cons two continuous_multilinear_maps together
def smul_cmmap (𝕜 A B : Type) [nontrivially_normed_field 𝕜]
    [add_comm_monoid A] [module 𝕜 A] [topological_space A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    : continuous_multilinear_map 𝕜 (λ _ : fin (n+1), A) B := {
  to_fun := smul_cmmap_fn x xs,
  map_add' := smul_cmmap_add x xs,
  map_smul' := smul_cmmap_smul x xs,
  cont := smul_cmmap_cont x xs,
}

lemma smul_cmmap_apply [add_comm_monoid A] [module 𝕜 A] [topological_space A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    (z : Π _ : fin (n+1), A)
    : smul_cmmap _ _ _ x xs z = x (λ _, z 0) • xs (λ i, z i.succ) := begin
  rw [smul_cmmap, ←continuous_multilinear_map.to_fun_eq_coe],
  simp, rw smul_cmmap_fn, simp
end

lemma smul_cmmap_norm [normed_add_comm_group A] [normed_space 𝕜 A] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : continuous_multilinear_map 𝕜 (λ _ : fin 1, A) 𝕜)
    (xs : continuous_multilinear_map 𝕜 (λ _ : fin n, A) B)
    : ∥smul_cmmap 𝕜 A B x xs∥ ≤ ∥x∥ * ∥xs∥ := begin
  apply continuous_multilinear_map.op_norm_le_bound, bound,
  intro z, rw smul_cmmap_apply,
  have xb := continuous_multilinear_map.le_op_norm x (λ _ : fin 1, z 0),
  have xsb := continuous_multilinear_map.le_op_norm xs (λ i : fin n, z i.succ),
  simp at xb xsb,
  have e0 := fin.prod_cons (∥z 0∥) (λ i : fin n, ∥z i.succ∥),
  simp at e0,
  have e1 : ∥z 0∥ = (λ i : fin (n+1), ∥z i∥) 0 := rfl,
  have e2 : (λ (i : fin n), ∥z i.succ∥) = fin.tail (λ i : fin (n+1), ∥z i∥) := rfl,
  nth_rewrite 0 e1 at e0, nth_rewrite 0 e2 at e0, rw fin.cons_self_tail at e0,
  calc ∥x (λ _ : fin 1, z 0) • xs (λ i : fin n, z i.succ)∥
      ≤ ∥x∥ * ∥z 0∥ * (∥xs∥ * finset.univ.prod (λ (i : fin n), ∥z i.succ∥)) : by { rw norm_smul, bound }
  ... = ∥x∥ * ∥xs∥ * (∥z 0∥ * finset.univ.prod (λ (i : fin n), ∥z i.succ∥)) : by ring
  ... = ∥x∥ * ∥xs∥ * finset.univ.prod (λ (i : fin (n + 1)), ∥z i∥) : by rw ←e0
end

-- A term of the general n-linear map on ℂ × ℂ, equal to z0^k * z1^(n-k) when applied to (λ _, (z0,z1))
noncomputable def term_cmmap (𝕜 : Type) [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]
    : Π (n : ℕ), ℕ → E → continuous_multilinear_map 𝕜 (λ _ : fin n, 𝕜 × 𝕜) E
| 0 := λ _ x, curry0 _ _ x
| (n+1) := λ k x, smul_cmmap _ _ _ (if n < k then fst_cmmap 𝕜 𝕜 𝕜 else snd_cmmap 𝕜 𝕜 𝕜) (term_cmmap n k x)

lemma term_cmmap_apply [normed_add_comm_group E] [normed_space 𝕜 E] [smul_comm_class 𝕜 𝕜 E] [is_scalar_tower 𝕜 𝕜 E]
    (n k : ℕ) (a b : 𝕜) (x : E) : term_cmmap 𝕜 n k x (λ _, (a,b)) = a^(min k n) • b^(n-k) • x := begin
  induction n with n h, {
    rw term_cmmap, rw curry0_apply, simp
  }, {
    rw [term_cmmap, smul_cmmap_apply, h],
    by_cases nk : n < k, {
      simp [nk],
      rw fst_cmmap_apply,
      have nsk : n.succ ≤ k := nat.succ_le_iff.mpr nk,
      rw [min_eq_right (le_of_lt nk), min_eq_right nsk, nat.sub_eq_zero_of_le (le_of_lt nk), nat.sub_eq_zero_of_le nsk],
      simp, rw [←smul_assoc, smul_eq_mul, ←pow_succ]
    }, {
      simp [nk], simp at nk,
      rw snd_cmmap_apply,
      have nsk : k ≤ n.succ := nat.le_succ_of_le nk,
      rw [min_eq_left nk, min_eq_left nsk],
      rw [smul_comm b _, ←smul_assoc b _ _, smul_eq_mul, ←pow_succ, ←nat.sub_add_comm nk],
      assumption, assumption
    }
  }
end

lemma term_cmmap_norm (𝕜 : Type) [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]
    (n k : ℕ) (x : E) : ∥term_cmmap 𝕜 n k x∥ ≤ ∥x∥ := begin
  induction n with n nh, {
    rw [term_cmmap, curry0_norm]
  }, {
    rw term_cmmap, simp,
    generalize ht : term_cmmap 𝕜 n k x = t, rw ht at nh,
    have tn := smul_cmmap_norm (ite (n < k) (fst_cmmap 𝕜 𝕜 𝕜) (snd_cmmap 𝕜 𝕜 𝕜)) t,
    by_cases nk : n < k, {
      simp [nk] at ⊢ tn, rw fst_cmmap_norm at tn, simp at tn, exact trans tn nh
    }, {
      simp [nk] at ⊢ tn, rw snd_cmmap_norm at tn, simp at tn, exact trans tn nh
    }
  }
end

-- conj as a continuous_linear_map
def conj_clm : ℂ →L[ℝ] ℂ := {
  to_fun := λ z, conj z,
  map_add' := by simp,
  map_smul' := by simp,
}
lemma conj_clm_apply (z : ℂ) : conj_clm z = conj z := rfl

-- The continuous linear map that evaluates a continuous multilinear map at a point
def cmmap_apply_cmap (𝕜 : Type) {I : Type} (A : I → Type) (B : Type)
    [fintype I] [decidable_eq I] [nontrivially_normed_field 𝕜]
    [Π i, normed_add_comm_group (A i)] [Π i, normed_space 𝕜 (A i)] [normed_add_comm_group B] [normed_space 𝕜 B]
    (x : Π i, A i) : continuous_multilinear_map 𝕜 A B →L[𝕜] B := {
  to_fun := λ f, f x,
  map_add' := by simp,
  map_smul' := by simp,
  cont := by simp [continuous_multilinear_map.continuous_eval_left],
}


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  apply nat.strong_induction_on n,
  assume n hn,
  assume h : ∀ m < n, (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),
  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
  -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
  have h1 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (polynomial.bernoulli n).eval (1 + x), from by auto [polynomial.eval_mul, polynomial.eval_add, polynomial.eval_pow, polynomial.eval_C],
  have h2 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (polynomial.bernoulli n).eval x + n * x^(n - 1), from by auto [polynomial.eval_mul, polynomial.eval_add, polynomial.eval_pow, polynomial.eval_C, h],
  -- The conclusion then follows easily.
  show (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^n, from by auto [h1, h2],
end

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$.
  have h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [nat.lt_succ_iff, nat.succ_pos],
  have h2 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h1],
  have h3 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h2],
  have h4 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h3],
  have h5 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h4],
  have h6 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h5],
  have h7 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h6],
  have h8 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h7],
  have h9 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h8],
  have h10 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h9],
  have h11 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h10],
  have h12 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h11],
  have h13 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h12],
  have h14 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h13],
  have h15 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h14],
  have h16 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h15],
  have h17 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h16],
  have h18 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h17],
  have h19 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h18],
  have h20 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h19],
  have h21 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h20],
  have h22 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h21],
  have h23 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h22],
  have h24 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h23],
  have h25 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h24],
  have h26 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h25],
  have h27 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h26],
  have h28 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h27],
  have h29 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h28],
  have h30 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto using [h29],
  have h31 : ∀ m : ℕ, m < n → (polynomial.bern
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  apply nat.strong_induction_on n,
  assume d hd,
  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
  -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
  have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (polynomial.sum (λ (k : ℕ), (polynomial.C (nat.choose (d + 1) k) * polynomial.X^k)) (d + 1)),
  begin
    -- expand the polynomials
    rw [polynomial.eval_sum, polynomial.eval_C, polynomial.eval_X],
    -- use the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number)
    rw [polynomial.bernoulli_sum_of_choose],
    -- use the fact that $(1 + x)^d = x^d + \sum_{l = 0}^{d} {d \choose l} x^l$
    rw [polynomial.eval_sum, polynomial.eval_C, polynomial.eval_X, polynomial.eval_sum, polynomial.eval_C, polynomial.eval_X],
    -- use the fact that $x^d = x^d$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.eval_X],
    -- use the fact that $x^l = x^l$
    rw [polynomial.
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import category_theory.action
import combinatorics.quiver.arborescence
import combinatorics.quiver.connected_component
import group_theory.is_free_group
/-!
# The Nielsen-Schreier theorem

This file proves that a subgroup of a free group is itself free.

## Main result

- `subgroup_is_free_of_is_free H`: an instance saying that a subgroup of a free group is free.

## Proof overview

The proof is analogous to the proof using covering spaces and fundamental groups of graphs,
but we work directly with groupoids instead of topological spaces. Under this analogy,

- `is_free_groupoid G` corresponds to saying that a space is a graph.
- `End_mul_equiv_subgroup H` plays the role of replacing 'subgroup of fundamental group' with
  'fundamental group of covering space'.
- `action_groupoid_is_free G A` corresponds to the fact that a covering of a (single-vertex)
  graph is a graph.
- `End_is_free T` corresponds to the fact that, given a spanning tree `T` of a
  graph, its fundamental group is free (generated by loops from the complement of the tree).

## Implementation notes

Our definition of `is_free_groupoid` is nonstandard. Normally one would require that functors
`G ⥤ X` to any _groupoid_ `X` are given by graph homomorphisms from the generators, but we only
consider _groups_ `X`. This simplifies the argument since functor equality is complicated in
general, but simple for functors to single object categories.

## References

https://ncatlab.org/nlab/show/Nielsen-Schreier+theorem

## Tags

free group, free groupoid, Nielsen-Schreier

-/

noncomputable theory
open_locale classical
universes v u

open category_theory category_theory.action_category category_theory.single_obj quiver
  is_free_group as fgp

/-- `is_free_groupoid.generators G` is a type synonym for `G`. We think of this as
the vertices of the generating quiver of `G` when `G` is free. We can't use `G` directly,
since `G` already has a quiver instance from being a groupoid. -/
@[nolint unused_arguments has_nonempty_instance]
def is_free_groupoid.generators (G) [groupoid G] := G

/-- A groupoid `G` is free when we have the following data:
 - a quiver on `is_free_groupoid.generators G` (a type synonym for `G`)
 - a function `of` taking a generating arrow to a morphism in `G`
 - such that a functor from `G` to any group `X` is uniquely determined
   by assigning labels in `X` to the generating arrows.

   This definition is nonstandard. Normally one would require that functors `G ⥤ X`
   to any _groupoid_ `X` are given by graph homomorphisms from `generators`. -/
class is_free_groupoid (G) [groupoid.{v} G] :=
(quiver_generators : quiver.{v+1} (is_free_groupoid.generators G))
(of : Π {a b : is_free_groupoid.generators G}, (a ⟶ b) → ((show G, from a) ⟶ b))
(unique_lift : ∀ {X : Type v} [group X] (f : labelling (is_free_groupoid.generators G) X),
                ∃! F : G ⥤ category_theory.single_obj X, ∀ a b (g : a ⟶ b),
                  F.map (of g) = f g)

namespace is_free_groupoid

attribute [instance] quiver_generators

/-- Two functors from a free groupoid to a group are equal when they agree on the generating
quiver. -/
@[ext]
lemma ext_functor {G} [groupoid.{v} G] [is_free_groupoid G] {X : Type v} [group X]
  (f g : G ⥤ category_theory.single_obj X)
  (h : ∀ a b (e : a ⟶ b), f.map (of e) = g.map (of e)) :
  f = g :=
let ⟨_, _, u⟩ := @unique_lift G _ _ X _ (λ (a b : generators G) (e : a ⟶ b), g.map (of e)) in
trans (u _ h) (u _ (λ _ _ _, rfl)).symm

/-- An action groupoid over a free group is free. More generally, one could show that the groupoid
of elements over a free groupoid is free, but this version is easier to prove and suffices for our
purposes.

Analogous to the fact that a covering space of a graph is a graph. (A free groupoid is like a graph,
and a groupoid of elements is like a covering space.) -/
instance action_groupoid_is_free {G A : Type u} [group G] [is_free_group G] [mul_action G A] :
  is_free_groupoid (action_category G A) :=
{ quiver_generators := ⟨λ a b, { e : fgp.generators G // fgp.of e • a.back = b.back }⟩,
  of := λ a b e, ⟨fgp.of e, e.property⟩,
  unique_lift := begin
    introsI X _ f,
    let f' : fgp.generators G → (A → X) ⋊[mul_aut_arrow] G :=
      λ e, ⟨λ b, @f ⟨(), _⟩ ⟨(), b⟩ ⟨e, smul_inv_smul _ b⟩, fgp.of e⟩,
    rcases fgp.unique_lift f' with ⟨F', hF', uF'⟩,
    refine ⟨uncurry F' _, _, _⟩,
    { suffices : semidirect_product.right_hom.comp F' = monoid_hom.id _,
      { exact monoid_hom.ext_iff.mp this },
      ext,
      rw [monoid_hom.comp_apply, hF'],
      refl },
    { rintros ⟨⟨⟩, a : A⟩ ⟨⟨⟩, b⟩ ⟨e, h : fgp.of e • a = b⟩,
      change (F' (fgp.of _)).left _ = _,
      rw hF',
      cases (inv_smul_eq_iff.mpr h.symm),
      refl },
    { intros E hE,
      have : curry E = F',
      { apply uF',
        intro e,
        ext,
        { convert hE _ _ _, refl },
        { refl } },
      apply functor.hext,
      { intro, apply unit.ext },
      { refine action_category.cases _, intros,
        simp only [←this, uncurry_map, curry_apply_left, coe_back, hom_of_pair.val] } },
  end }

namespace spanning_tree
/- In this section, we suppose we have a free groupoid with a spanning tree for its generating
quiver. The goal is to prove that the vertex group at the root is free. A picture to have in mind
is that we are 'pulling' the endpoints of all the edges of the quiver along the spanning tree to
the root. -/
variables {G : Type u} [groupoid.{u} G] [is_free_groupoid G]
  (T : wide_subquiver (symmetrify $ generators G)) [arborescence T]

/-- The root of `T`, except its type is `G` instead of the type synonym `T`. -/
private def root' : G := show T, from root T

/-- A path in the tree gives a hom, by composition. -/
-- this has to be marked noncomputable, see issue #451.
-- It might be nicer to define this in terms of `compose_path`
noncomputable def hom_of_path : Π {a : G}, path (root T) a → (root' T ⟶ a)
| _ path.nil := 𝟙 _
| a (path.cons p f) := hom_of_path p ≫ sum.rec_on f.val (λ e, of e) (λ e, inv (of e))

/-- For every vertex `a`, there is a canonical hom from the root, given by the path in the tree. -/
def tree_hom (a : G) : root' T ⟶ a := hom_of_path T default

/-- Any path to `a` gives `tree_hom T a`, since paths in the tree are unique. -/
lemma tree_hom_eq {a : G} (p : path (root T) a) : tree_hom T a = hom_of_path T p :=
by rw [tree_hom, unique.default_eq]

@[simp] lemma tree_hom_root : tree_hom T (root' T) = 𝟙 _ :=
-- this should just be `tree_hom_eq T path.nil`, but Lean treats `hom_of_path` with suspicion.
trans (tree_hom_eq T path.nil) rfl

/-- Any hom in `G` can be made into a loop, by conjugating with `tree_hom`s. -/
def loop_of_hom {a b : G} (p : a ⟶ b) : End (root' T) :=
tree_hom T a ≫ p ≫ inv (tree_hom T b)

/-- Turning an edge in the spanning tree into a loop gives the indentity loop. -/
lemma loop_of_hom_eq_id {a b : generators G} (e ∈ wide_subquiver_symmetrify T a b) :
  loop_of_hom T (of e) = 𝟙 (root' T) :=
begin
  rw [loop_of_hom, ←category.assoc, is_iso.comp_inv_eq, category.id_comp],
  cases H,
  { rw [tree_hom_eq T (path.cons default ⟨sum.inl e, H⟩), hom_of_path], refl },
  { rw [tree_hom_eq T (path.cons default ⟨sum.inr e, H⟩), hom_of_path],
    simp only [is_iso.inv_hom_id, category.comp_id, category.assoc, tree_hom] }
end

/-- Since a hom gives a loop, any homomorphism from the vertex group at the root
    extends to a functor on the whole groupoid. -/
@[simps] def functor_of_monoid_hom {X} [monoid X] (f : End (root' T) →* X) :
  G ⥤ category_theory.single_obj X :=
{ obj := λ _, (),
  map := λ a b p, f (loop_of_hom T p),
  map_id' := begin
    intro a,
    rw [loop_of_hom, category.id_comp, is_iso.hom_inv_id, ←End.one_def, f.map_one, id_as_one],
 end,
  map_comp' := begin
    intros,
    rw [comp_as_mul, ←f.map_mul],
    simp only [is_iso.inv_hom_id_assoc, loop_of_hom, End.mul_def, category.assoc]
  end }

/-- Given a free groupoid and an arborescence of its generating quiver, the vertex
    group at the root is freely generated by loops coming from generating arrows
    in the complement of the tree. -/
def End_is_free : is_free_group (End (root' T)) :=
is_free_group.of_unique_lift
  ((wide_subquiver_equiv_set_total $ wide_subquiver_symmetrify T)ᶜ : set _)
  (λ e, loop_of_hom T (of e.val.hom))
  begin
    introsI X _ f,
    let f' : labelling (generators G) X := λ a b e,
      if h : e ∈ wide_subquiver_symmetrify T a b then 1
      else f ⟨⟨a, b, e⟩, h⟩,
    rcases unique_lift f' with ⟨F', hF', uF'⟩,
    refine ⟨F'.map_End _, _, _⟩,
    { suffices : ∀ {x y} (q : x ⟶ y), F'.map (loop_of_hom T q) = (F'.map q : X),
      { rintro ⟨⟨a, b, e⟩, h⟩,
        rw [functor.map_End_apply, this, hF'],
        exact dif_neg h },
      intros,
      suffices : ∀ {a} (p : path (root' T) a), F'.map (hom_of_path T p) = 1,
      { simp only [this, tree_hom, comp_as_mul, inv_as_inv, loop_of_hom,
        inv_one, mul_one, one_mul, functor.map_inv, functor.map_comp] },
      intros a p, induction p with b c p e ih,
      { rw [hom_of_path, F'.map_id, id_as_one] },
      rw [hom_of_path, F'.map_comp, comp_as_mul, ih, mul_one],
      rcases e with ⟨e | e, eT⟩,
      { rw hF', exact dif_pos (or.inl eT) },
      { rw [F'.map_inv, inv_as_inv, inv_eq_one, hF'], exact dif_pos (or.inr eT) } },
    { intros E hE,
      ext,
      suffices : (functor_of_monoid_hom T E).map x = F'.map x,
      { simpa only [loop_of_hom, functor_of_monoid_hom_map, is_iso.inv_id, tree_hom_root,
          category.id_comp, category.comp_id] using this },
      congr,
      apply uF',
      intros a b e,
      change E (loop_of_hom T _) = dite _ _ _,
      split_ifs,
      { rw [loop_of_hom_eq_id T e h, ←End.one_def, E.map_one] },
      { exact hE ⟨⟨a, b, e⟩, h⟩ } }
  end

end spanning_tree

/-- Another name for the identity function `G → G`, to help type checking. -/
private def symgen {G : Type u} [groupoid.{v} G] [is_free_groupoid G] :
  G → symmetrify (generators G) := id

/-- If there exists a morphism `a → b` in a free groupoid, then there also exists a zigzag
from `a` to `b` in the generating quiver. -/
lemma path_nonempty_of_hom {G} [groupoid.{u u} G] [is_free_groupoid G] {a b : G} :
  nonempty (a ⟶ b) → nonempty (path (symgen a) (symgen b)) :=
begin
  rintro ⟨p⟩,
  rw [←@weakly_connected_component.eq (generators G), eq_comm,
    ←free_group.of_injective.eq_iff, ←mul_inv_eq_one],
  let X := free_group (weakly_connected_component $ generators G),
  let f : G → X := λ g, free_group.of (weakly_connected_component.mk g),
  let F : G ⥤ category_theory.single_obj X := single_obj.difference_functor f,
  change F.map p = ((category_theory.functor.const G).obj ()).map p,
  congr, ext,
  rw [functor.const_obj_map, id_as_one, difference_functor_map, mul_inv_eq_one],
  apply congr_arg free_group.of,
  apply (weakly_connected_component.eq _ _).mpr,
  exact ⟨hom.to_path (sum.inr e)⟩,
end

/-- Given a connected free groupoid, its generating quiver is rooted-connected. -/
instance generators_connected (G) [groupoid.{u u} G] [is_connected G] [is_free_groupoid G]
  (r : G) : rooted_connected (symgen r) :=
⟨λ b, path_nonempty_of_hom (category_theory.nonempty_hom_of_connected_groupoid r b)⟩

/-- A vertex group in a free connected groupoid is free. With some work one could drop the
connectedness assumption, by looking at connected components. -/
instance End_is_free_of_connected_free {G} [groupoid G] [is_connected G] [is_free_groupoid G]
  (r : G) : is_free_group (End r) :=
spanning_tree.End_is_free $ geodesic_subtree (symgen r)

end is_free_groupoid

/-- The Nielsen-Schreier theorem: a subgroup of a free group is free. -/
instance subgroup_is_free_of_is_free {G : Type u} [group G] [is_free_group G]
  (H : subgroup G) : is_free_group H :=
is_free_group.of_mul_equiv (End_mul_equiv_subgroup H)