/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.group_action.default
import Mathlib.group_theory.quotient_group
import Mathlib.group_theory.order_of_element
import Mathlib.data.zmod.basic
import Mathlib.data.fintype.card
import Mathlib.data.list.rotate
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

namespace mul_action

theorem mem_fixed_points_iff_card_orbit_eq_one {G : Type u} {α : Type v} [group G] [mul_action G α]
    {a : α} [fintype ↥(orbit G a)] : a ∈ fixed_points G α ↔ fintype.card ↥(orbit G a) = 1 :=
  sorry

theorem card_modeq_card_fixed_points {G : Type u} {α : Type v} [group G] [mul_action G α]
    [fintype α] [fintype G] [fintype ↥(fixed_points G α)] (p : ℕ) {n : ℕ} [hp : fact (nat.prime p)]
    (h : fintype.card G = p ^ n) :
    nat.modeq p (fintype.card α) (fintype.card ↥(fixed_points G α)) :=
  sorry

end mul_action

theorem quotient_group.card_preimage_mk {G : Type u} [group G] [fintype G] (s : subgroup G)
    (t : set (quotient_group.quotient s)) :
    fintype.card ↥(quotient_group.mk ⁻¹' t) = fintype.card ↥s * fintype.card ↥t :=
  sorry

namespace sylow

/-- Given a vector `v` of length `n`, make a vector of length `n+1` whose product is `1`,
by consing the the inverse of the product of `v`. -/
def mk_vector_prod_eq_one {G : Type u} [group G] (n : ℕ) (v : vector G n) : vector G (n + 1) :=
  list.prod (vector.to_list v)⁻¹::ᵥv

theorem mk_vector_prod_eq_one_injective {G : Type u} [group G] (n : ℕ) :
    function.injective (mk_vector_prod_eq_one n) :=
  sorry

/-- The type of vectors with terms from `G`, length `n`, and product equal to `1:G`. -/
def vectors_prod_eq_one (G : Type u_1) [group G] (n : ℕ) : set (vector G n) :=
  set_of fun (v : vector G n) => list.prod (vector.to_list v) = 1

theorem mem_vectors_prod_eq_one {G : Type u} [group G] {n : ℕ} (v : vector G n) :
    v ∈ vectors_prod_eq_one G n ↔ list.prod (vector.to_list v) = 1 :=
  iff.rfl

theorem mem_vectors_prod_eq_one_iff {G : Type u} [group G] {n : ℕ} (v : vector G (n + 1)) :
    v ∈ vectors_prod_eq_one G (n + 1) ↔ v ∈ set.range (mk_vector_prod_eq_one n) :=
  sorry

/-- The rotation action of `zmod n` (viewed as multiplicative group) on
`vectors_prod_eq_one G n`, where `G` is a multiplicative group. -/
def rotate_vectors_prod_eq_one (G : Type u_1) [group G] (n : ℕ) (m : multiplicative (zmod n))
    (v : ↥(vectors_prod_eq_one G n)) : ↥(vectors_prod_eq_one G n) :=
  { val := { val := list.rotate (vector.to_list (subtype.val v)) (zmod.val m), property := sorry },
    property := sorry }

protected instance rotate_vectors_prod_eq_one.mul_action {G : Type u} [group G] (n : ℕ)
    [fact (0 < n)] : mul_action (multiplicative (zmod n)) ↥(vectors_prod_eq_one G n) :=
  mul_action.mk sorry sorry

theorem one_mem_vectors_prod_eq_one {G : Type u} [group G] (n : ℕ) :
    vector.repeat 1 n ∈ vectors_prod_eq_one G n :=
  sorry

theorem one_mem_fixed_points_rotate {G : Type u} [group G] (n : ℕ) [fact (0 < n)] :
    { val := vector.repeat 1 n, property := one_mem_vectors_prod_eq_one n } ∈
        mul_action.fixed_points (multiplicative (zmod n)) ↥(vectors_prod_eq_one G n) :=
  sorry

/-- Cauchy's theorem -/
theorem exists_prime_order_of_dvd_card {G : Type u} [group G] [fintype G] (p : ℕ)
    [hp : fact (nat.prime p)] (hdvd : p ∣ fintype.card G) : ∃ (x : G), order_of x = p :=
  sorry

theorem mem_fixed_points_mul_left_cosets_iff_mem_normalizer {G : Type u} [group G] {H : subgroup G}
    [fintype ↥↑H] {x : G} :
    ↑x ∈ mul_action.fixed_points (↥H) (quotient_group.quotient H) ↔ x ∈ subgroup.normalizer H :=
  sorry

def fixed_points_mul_left_cosets_equiv_quotient {G : Type u} [group G] (H : subgroup G)
    [fintype ↥↑H] :
    ↥(mul_action.fixed_points (↥H) (quotient_group.quotient H)) ≃
        quotient_group.quotient (subgroup.comap (subgroup.subtype (subgroup.normalizer H)) H) :=
  equiv.subtype_quotient_equiv_quotient_subtype (↑(subgroup.normalizer H))
    (mul_action.fixed_points (↥H)
      (quotient
        (id (setoid.mk (fun (x y : G) => x⁻¹ * y ∈ H) (quotient_group.left_rel._proof_1 H)))))
    sorry sorry

theorem exists_subgroup_card_pow_prime {G : Type u} [group G] [fintype G] (p : ℕ) {n : ℕ}
    [hp : fact (nat.prime p)] (hdvd : p ^ n ∣ fintype.card G) :
    ∃ (H : subgroup G), fintype.card ↥H = p ^ n :=
  sorry

end Mathlib


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

! This file was ported from Lean 3 source module group_theory.subsemigroup.membership
! leanprover-community/mathlib commit baba818b9acea366489e8ba32d2cc0fcaf50a1f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Subsemigroup.Basic

/-!
# Subsemigroups: membership criteria

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

In this file we prove various facts about membership in a subsemigroup.
The intent is to mimic `group_theory/submonoid/membership`, but currently this file is mostly a
stub and only provides rudimentary support.

* `mem_supr_of_directed`, `coe_supr_of_directed`, `mem_Sup_of_directed_on`,
  `coe_Sup_of_directed_on`: the supremum of a directed collection of subsemigroup is their union.

## TODO

* Define the `free_semigroup` generated by a set. This might require some rather substantial
  additions to low-level API. For example, developing the subtype of nonempty lists, then defining
  a product on nonempty lists, powers where the exponent is a positive natural, et cetera.
  Another option would be to define the `free_semigroup` as the subsemigroup (pushed to be a
  semigroup) of the `free_monoid` consisting of non-identity elements.

## Tags
subsemigroup
-/

variable {ι : Sort _} {M A B : Type _}

section NonAssoc

variable [Mul M]

open Set

namespace Subsemigroup

/- warning: subsemigroup.mem_supr_of_directed -> Subsemigroup.mem_supᵢ_of_directed is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] {S : ι -> (Subsemigroup.{u2} M _inst_1)}, (Directed.{u2, u1} (Subsemigroup.{u2} M _inst_1) ι (LE.le.{u2} (Subsemigroup.{u2} M _inst_1) (Preorder.toLE.{u2} (Subsemigroup.{u2} M _inst_1) (PartialOrder.toPreorder.{u2} (Subsemigroup.{u2} M _inst_1) (SetLike.partialOrder.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1))))) S) -> (forall {x : M}, Iff (Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))) (Exists.{u1} ι (fun (i : ι) => Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (S i))))
but is expected to have type
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] {S : ι -> (Subsemigroup.{u2} M _inst_1)}, (Directed.{u2, u1} (Subsemigroup.{u2} M _inst_1) ι (fun (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.40 : Subsemigroup.{u2} M _inst_1) (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.42 : Subsemigroup.{u2} M _inst_1) => LE.le.{u2} (Subsemigroup.{u2} M _inst_1) (Preorder.toLE.{u2} (Subsemigroup.{u2} M _inst_1) (PartialOrder.toPreorder.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1))))) x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.40 x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.42) S) -> (forall {x : M}, Iff (Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))) (Exists.{u1} ι (fun (i : ι) => Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (S i))))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mem_supr_of_directed Subsemigroup.mem_supᵢ_of_directedₓ'. -/
-- TODO: this section can be generalized to `[mul_mem_class B M] [complete_lattice B]`
-- such that `complete_lattice.le` coincides with `set_like.le`
@[to_additive]
theorem mem_supᵢ_of_directed {S : ι → Subsemigroup M} (hS : Directed (· ≤ ·) S) {x : M} :
    (x ∈ ⨆ i, S i) ↔ ∃ i, x ∈ S i :=
  by
  refine' ⟨_, fun ⟨i, hi⟩ => (SetLike.le_def.1 <| le_supᵢ S i) hi⟩
  suffices x ∈ closure (⋃ i, (S i : Set M)) → ∃ i, x ∈ S i by
    simpa only [closure_unionᵢ, closure_eq (S _)] using this
  refine' fun hx => closure_induction hx (fun y hy => mem_Union.mp hy) _
  · rintro x y ⟨i, hi⟩ ⟨j, hj⟩
    rcases hS i j with ⟨k, hki, hkj⟩
    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩
#align subsemigroup.mem_supr_of_directed Subsemigroup.mem_supᵢ_of_directed
#align add_subsemigroup.mem_supr_of_directed AddSubsemigroup.mem_supᵢ_of_directed

/- warning: subsemigroup.coe_supr_of_directed -> Subsemigroup.coe_supᵢ_of_directed is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] {S : ι -> (Subsemigroup.{u2} M _inst_1)}, (Directed.{u2, u1} (Subsemigroup.{u2} M _inst_1) ι (LE.le.{u2} (Subsemigroup.{u2} M _inst_1) (Preorder.toLE.{u2} (Subsemigroup.{u2} M _inst_1) (PartialOrder.toPreorder.{u2} (Subsemigroup.{u2} M _inst_1) (SetLike.partialOrder.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1))))) S) -> (Eq.{succ u2} (Set.{u2} M) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Subsemigroup.{u2} M _inst_1) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (Subsemigroup.{u2} M _inst_1) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (Subsemigroup.{u2} M _inst_1) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)))) (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))) (Set.unionᵢ.{u2, u1} M ι (fun (i : ι) => (fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Subsemigroup.{u2} M _inst_1) (Set.{u2} M) (HasLiftT.mk.{succ u2, succ u2} (Subsemigroup.{u2} M _inst_1) (Set.{u2} M) (CoeTCₓ.coe.{succ u2, succ u2} (Subsemigroup.{u2} M _inst_1) (Set.{u2} M) (SetLike.Set.hasCoeT.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)))) (S i))))
but is expected to have type
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] {S : ι -> (Subsemigroup.{u2} M _inst_1)}, (Directed.{u2, u1} (Subsemigroup.{u2} M _inst_1) ι (fun (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.267 : Subsemigroup.{u2} M _inst_1) (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.269 : Subsemigroup.{u2} M _inst_1) => LE.le.{u2} (Subsemigroup.{u2} M _inst_1) (Preorder.toLE.{u2} (Subsemigroup.{u2} M _inst_1) (PartialOrder.toPreorder.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1))))) x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.267 x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.269) S) -> (Eq.{succ u2} (Set.{u2} M) (SetLike.coe.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1) (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))) (Set.unionᵢ.{u2, u1} M ι (fun (i : ι) => SetLike.coe.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1) (S i))))
Case conversion may be inaccurate. Consider using '#align subsemigroup.coe_supr_of_directed Subsemigroup.coe_supᵢ_of_directedₓ'. -/
@[to_additive]
theorem coe_supᵢ_of_directed {S : ι → Subsemigroup M} (hS : Directed (· ≤ ·) S) :
    ((⨆ i, S i : Subsemigroup M) : Set M) = ⋃ i, ↑(S i) :=
  Set.ext fun x => by simp [mem_supr_of_directed hS]
#align subsemigroup.coe_supr_of_directed Subsemigroup.coe_supᵢ_of_directed
#align add_subsemigroup.coe_supr_of_directed AddSubsemigroup.coe_supᵢ_of_directed

/- warning: subsemigroup.mem_Sup_of_directed_on -> Subsemigroup.mem_supₛ_of_directed_on is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Set.{u1} (Subsemigroup.{u1} M _inst_1)}, (DirectedOn.{u1} (Subsemigroup.{u1} M _inst_1) (LE.le.{u1} (Subsemigroup.{u1} M _inst_1) (Preorder.toLE.{u1} (Subsemigroup.{u1} M _inst_1) (PartialOrder.toPreorder.{u1} (Subsemigroup.{u1} M _inst_1) (SetLike.partialOrder.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1))))) S) -> (forall {x : M}, Iff (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x (SupSet.supₛ.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.completeLattice.{u1} M _inst_1))) S)) (Exists.{succ u1} (Subsemigroup.{u1} M _inst_1) (fun (s : Subsemigroup.{u1} M _inst_1) => Exists.{0} (Membership.Mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.hasMem.{u1} (Subsemigroup.{u1} M _inst_1)) s S) (fun (H : Membership.Mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.hasMem.{u1} (Subsemigroup.{u1} M _inst_1)) s S) => Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x s))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Set.{u1} (Subsemigroup.{u1} M _inst_1)}, (DirectedOn.{u1} (Subsemigroup.{u1} M _inst_1) (fun (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.357 : Subsemigroup.{u1} M _inst_1) (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.359 : Subsemigroup.{u1} M _inst_1) => LE.le.{u1} (Subsemigroup.{u1} M _inst_1) (Preorder.toLE.{u1} (Subsemigroup.{u1} M _inst_1) (PartialOrder.toPreorder.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1))))) x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.357 x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.359) S) -> (forall {x : M}, Iff (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x (SupSet.supₛ.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toSupSet.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1)) S)) (Exists.{succ u1} (Subsemigroup.{u1} M _inst_1) (fun (s : Subsemigroup.{u1} M _inst_1) => And (Membership.mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.instMembershipSet.{u1} (Subsemigroup.{u1} M _inst_1)) s S) (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x s))))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mem_Sup_of_directed_on Subsemigroup.mem_supₛ_of_directed_onₓ'. -/
@[to_additive]
theorem mem_supₛ_of_directed_on {S : Set (Subsemigroup M)} (hS : DirectedOn (· ≤ ·) S) {x : M} :
    x ∈ supₛ S ↔ ∃ s ∈ S, x ∈ s := by
  simp only [supₛ_eq_supᵢ', mem_supr_of_directed hS.directed_coe, SetCoe.exists, Subtype.coe_mk]
#align subsemigroup.mem_Sup_of_directed_on Subsemigroup.mem_supₛ_of_directed_on
#align add_subsemigroup.mem_Sup_of_directed_on AddSubsemigroup.mem_supₛ_of_directed_on

/- warning: subsemigroup.coe_Sup_of_directed_on -> Subsemigroup.coe_supₛ_of_directed_on is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Set.{u1} (Subsemigroup.{u1} M _inst_1)}, (DirectedOn.{u1} (Subsemigroup.{u1} M _inst_1) (LE.le.{u1} (Subsemigroup.{u1} M _inst_1) (Preorder.toLE.{u1} (Subsemigroup.{u1} M _inst_1) (PartialOrder.toPreorder.{u1} (Subsemigroup.{u1} M _inst_1) (SetLike.partialOrder.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1))))) S) -> (Eq.{succ u1} (Set.{u1} M) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Subsemigroup.{u1} M _inst_1) (Set.{u1} M) (HasLiftT.mk.{succ u1, succ u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} M) (CoeTCₓ.coe.{succ u1, succ u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} M) (SetLike.Set.hasCoeT.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)))) (SupSet.supₛ.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.completeLattice.{u1} M _inst_1))) S)) (Set.unionᵢ.{u1, succ u1} M (Subsemigroup.{u1} M _inst_1) (fun (s : Subsemigroup.{u1} M _inst_1) => Set.unionᵢ.{u1, 0} M (Membership.Mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.hasMem.{u1} (Subsemigroup.{u1} M _inst_1)) s S) (fun (H : Membership.Mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.hasMem.{u1} (Subsemigroup.{u1} M _inst_1)) s S) => (fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Subsemigroup.{u1} M _inst_1) (Set.{u1} M) (HasLiftT.mk.{succ u1, succ u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} M) (CoeTCₓ.coe.{succ u1, succ u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} M) (SetLike.Set.hasCoeT.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)))) s))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Set.{u1} (Subsemigroup.{u1} M _inst_1)}, (DirectedOn.{u1} (Subsemigroup.{u1} M _inst_1) (fun (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.428 : Subsemigroup.{u1} M _inst_1) (x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.430 : Subsemigroup.{u1} M _inst_1) => LE.le.{u1} (Subsemigroup.{u1} M _inst_1) (Preorder.toLE.{u1} (Subsemigroup.{u1} M _inst_1) (PartialOrder.toPreorder.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1))))) x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.428 x._@.Mathlib.GroupTheory.Subsemigroup.Membership._hyg.430) S) -> (Eq.{succ u1} (Set.{u1} M) (SetLike.coe.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1) (SupSet.supₛ.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toSupSet.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1)) S)) (Set.unionᵢ.{u1, succ u1} M (Subsemigroup.{u1} M _inst_1) (fun (s : Subsemigroup.{u1} M _inst_1) => Set.unionᵢ.{u1, 0} M (Membership.mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.instMembershipSet.{u1} (Subsemigroup.{u1} M _inst_1)) s S) (fun (H : Membership.mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.instMembershipSet.{u1} (Subsemigroup.{u1} M _inst_1)) s S) => SetLike.coe.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1) s))))
Case conversion may be inaccurate. Consider using '#align subsemigroup.coe_Sup_of_directed_on Subsemigroup.coe_supₛ_of_directed_onₓ'. -/
@[to_additive]
theorem coe_supₛ_of_directed_on {S : Set (Subsemigroup M)} (hS : DirectedOn (· ≤ ·) S) :
    (↑(supₛ S) : Set M) = ⋃ s ∈ S, ↑s :=
  Set.ext fun x => by simp [mem_Sup_of_directed_on hS]
#align subsemigroup.coe_Sup_of_directed_on Subsemigroup.coe_supₛ_of_directed_on
#align add_subsemigroup.coe_Sup_of_directed_on AddSubsemigroup.coe_supₛ_of_directed_on

/- warning: subsemigroup.mem_sup_left -> Subsemigroup.mem_sup_left is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Subsemigroup.{u1} M _inst_1} {T : Subsemigroup.{u1} M _inst_1} {x : M}, (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x S) -> (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x (Sup.sup.{u1} (Subsemigroup.{u1} M _inst_1) (SemilatticeSup.toHasSup.{u1} (Subsemigroup.{u1} M _inst_1) (Lattice.toSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toLattice.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.completeLattice.{u1} M _inst_1)))) S T))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Subsemigroup.{u1} M _inst_1} {T : Subsemigroup.{u1} M _inst_1} {x : M}, (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x S) -> (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x (Sup.sup.{u1} (Subsemigroup.{u1} M _inst_1) (SemilatticeSup.toSup.{u1} (Subsemigroup.{u1} M _inst_1) (Lattice.toSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toLattice.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1)))) S T))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mem_sup_left Subsemigroup.mem_sup_leftₓ'. -/
@[to_additive]
theorem mem_sup_left {S T : Subsemigroup M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
  show S ≤ S ⊔ T from le_sup_left
#align subsemigroup.mem_sup_left Subsemigroup.mem_sup_left
#align add_subsemigroup.mem_sup_left AddSubsemigroup.mem_sup_left

/- warning: subsemigroup.mem_sup_right -> Subsemigroup.mem_sup_right is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Subsemigroup.{u1} M _inst_1} {T : Subsemigroup.{u1} M _inst_1} {x : M}, (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x T) -> (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x (Sup.sup.{u1} (Subsemigroup.{u1} M _inst_1) (SemilatticeSup.toHasSup.{u1} (Subsemigroup.{u1} M _inst_1) (Lattice.toSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toLattice.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.completeLattice.{u1} M _inst_1)))) S T))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Subsemigroup.{u1} M _inst_1} {T : Subsemigroup.{u1} M _inst_1} {x : M}, (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x T) -> (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x (Sup.sup.{u1} (Subsemigroup.{u1} M _inst_1) (SemilatticeSup.toSup.{u1} (Subsemigroup.{u1} M _inst_1) (Lattice.toSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toLattice.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1)))) S T))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mem_sup_right Subsemigroup.mem_sup_rightₓ'. -/
@[to_additive]
theorem mem_sup_right {S T : Subsemigroup M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
  show T ≤ S ⊔ T from le_sup_right
#align subsemigroup.mem_sup_right Subsemigroup.mem_sup_right
#align add_subsemigroup.mem_sup_right AddSubsemigroup.mem_sup_right

/- warning: subsemigroup.mul_mem_sup -> Subsemigroup.mul_mem_sup is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Subsemigroup.{u1} M _inst_1} {T : Subsemigroup.{u1} M _inst_1} {x : M} {y : M}, (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x S) -> (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) y T) -> (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M _inst_1) x y) (Sup.sup.{u1} (Subsemigroup.{u1} M _inst_1) (SemilatticeSup.toHasSup.{u1} (Subsemigroup.{u1} M _inst_1) (Lattice.toSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toLattice.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.completeLattice.{u1} M _inst_1)))) S T))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Subsemigroup.{u1} M _inst_1} {T : Subsemigroup.{u1} M _inst_1} {x : M} {y : M}, (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x S) -> (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) y T) -> (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M _inst_1) x y) (Sup.sup.{u1} (Subsemigroup.{u1} M _inst_1) (SemilatticeSup.toSup.{u1} (Subsemigroup.{u1} M _inst_1) (Lattice.toSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toLattice.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1)))) S T))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mul_mem_sup Subsemigroup.mul_mem_supₓ'. -/
@[to_additive]
theorem mul_mem_sup {S T : Subsemigroup M} {x y : M} (hx : x ∈ S) (hy : y ∈ T) : x * y ∈ S ⊔ T :=
  mul_mem (mem_sup_left hx) (mem_sup_right hy)
#align subsemigroup.mul_mem_sup Subsemigroup.mul_mem_sup
#align add_subsemigroup.add_mem_sup AddSubsemigroup.add_mem_sup

/- warning: subsemigroup.mem_supr_of_mem -> Subsemigroup.mem_supᵢ_of_mem is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] {S : ι -> (Subsemigroup.{u2} M _inst_1)} (i : ι) {x : M}, (Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (S i)) -> (Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι S))
but is expected to have type
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] {S : ι -> (Subsemigroup.{u2} M _inst_1)} (i : ι) {x : M}, (Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (S i)) -> (Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι S))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mem_supr_of_mem Subsemigroup.mem_supᵢ_of_memₓ'. -/
@[to_additive]
theorem mem_supᵢ_of_mem {S : ι → Subsemigroup M} (i : ι) : ∀ {x : M}, x ∈ S i → x ∈ supᵢ S :=
  show S i ≤ supᵢ S from le_supᵢ _ _
#align subsemigroup.mem_supr_of_mem Subsemigroup.mem_supᵢ_of_mem
#align add_subsemigroup.mem_supr_of_mem AddSubsemigroup.mem_supᵢ_of_mem

/- warning: subsemigroup.mem_Sup_of_mem -> Subsemigroup.mem_supₛ_of_mem is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Set.{u1} (Subsemigroup.{u1} M _inst_1)} {s : Subsemigroup.{u1} M _inst_1}, (Membership.Mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.hasMem.{u1} (Subsemigroup.{u1} M _inst_1)) s S) -> (forall {x : M}, (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x s) -> (Membership.Mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.hasMem.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.setLike.{u1} M _inst_1)) x (SupSet.supₛ.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.completeLattice.{u1} M _inst_1))) S)))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Mul.{u1} M] {S : Set.{u1} (Subsemigroup.{u1} M _inst_1)} {s : Subsemigroup.{u1} M _inst_1}, (Membership.mem.{u1, u1} (Subsemigroup.{u1} M _inst_1) (Set.{u1} (Subsemigroup.{u1} M _inst_1)) (Set.instMembershipSet.{u1} (Subsemigroup.{u1} M _inst_1)) s S) -> (forall {x : M}, (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x s) -> (Membership.mem.{u1, u1} M (Subsemigroup.{u1} M _inst_1) (SetLike.instMembership.{u1, u1} (Subsemigroup.{u1} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u1} M _inst_1)) x (SupSet.supₛ.{u1} (Subsemigroup.{u1} M _inst_1) (CompleteLattice.toSupSet.{u1} (Subsemigroup.{u1} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u1} M _inst_1)) S)))
Case conversion may be inaccurate. Consider using '#align subsemigroup.mem_Sup_of_mem Subsemigroup.mem_supₛ_of_memₓ'. -/
@[to_additive]
theorem mem_supₛ_of_mem {S : Set (Subsemigroup M)} {s : Subsemigroup M} (hs : s ∈ S) :
    ∀ {x : M}, x ∈ s → x ∈ supₛ S :=
  show s ≤ supₛ S from le_supₛ hs
#align subsemigroup.mem_Sup_of_mem Subsemigroup.mem_supₛ_of_mem
#align add_subsemigroup.mem_Sup_of_mem AddSubsemigroup.mem_supₛ_of_mem

/- warning: subsemigroup.supr_induction -> Subsemigroup.supᵢ_induction is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] (S : ι -> (Subsemigroup.{u2} M _inst_1)) {C : M -> Prop} {x : M}, (Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))) -> (forall (i : ι) (x : M), (Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (S i)) -> (C x)) -> (forall (x : M) (y : M), (C x) -> (C y) -> (C (HMul.hMul.{u2, u2, u2} M M M (instHMul.{u2} M _inst_1) x y))) -> (C x)
but is expected to have type
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] (S : ι -> (Subsemigroup.{u2} M _inst_1)) {C : M -> Prop} {x : M}, (Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))) -> (forall (i : ι) (x : M), (Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (S i)) -> (C x)) -> (forall (x : M) (y : M), (C x) -> (C y) -> (C (HMul.hMul.{u2, u2, u2} M M M (instHMul.{u2} M _inst_1) x y))) -> (C x)
Case conversion may be inaccurate. Consider using '#align subsemigroup.supr_induction Subsemigroup.supᵢ_inductionₓ'. -/
/-- An induction principle for elements of `⨆ i, S i`.
If `C` holds all elements of `S i` for all `i`, and is preserved under multiplication,
then it holds for all elements of the supremum of `S`. -/
@[elab_as_elim,
  to_additive
      " An induction principle for elements of `⨆ i, S i`.\nIf `C` holds all elements of `S i` for all `i`, and is preserved under addition,\nthen it holds for all elements of the supremum of `S`. "]
theorem supᵢ_induction (S : ι → Subsemigroup M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, S i)
    (hp : ∀ (i), ∀ x ∈ S i, C x) (hmul : ∀ x y, C x → C y → C (x * y)) : C x :=
  by
  rw [supr_eq_closure] at hx
  refine' closure_induction hx (fun x hx => _) hmul
  obtain ⟨i, hi⟩ := set.mem_Union.mp hx
  exact hp _ _ hi
#align subsemigroup.supr_induction Subsemigroup.supᵢ_induction
#align add_subsemigroup.supr_induction AddSubsemigroup.supᵢ_induction

/- warning: subsemigroup.supr_induction' -> Subsemigroup.supᵢ_induction' is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] (S : ι -> (Subsemigroup.{u2} M _inst_1)) {C : forall (x : M), (Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))) -> Prop}, (forall (i : ι) (x : M) (H : Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (S i)), C x (Subsemigroup.mem_supᵢ_of_mem.{u1, u2} ι M _inst_1 (fun (i : ι) => S i) i x H)) -> (forall (x : M) (y : M) (hx : Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))) (hy : Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) y (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))), (C x hx) -> (C y hy) -> (C (HMul.hMul.{u2, u2, u2} M M M (instHMul.{u2} M _inst_1) x y) (MulMemClass.mul_mem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M _inst_1 (Subsemigroup.setLike.{u2} M _inst_1) (Subsemigroup.mulMemClass.{u2} M _inst_1) (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i)) x y hx hy))) -> (forall {x : M} (hx : Membership.Mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.hasMem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.setLike.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteSemilatticeSup.toHasSup.{u2} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toCompleteSemilatticeSup.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.completeLattice.{u2} M _inst_1))) ι (fun (i : ι) => S i))), C x hx)
but is expected to have type
  forall {ι : Sort.{u1}} {M : Type.{u2}} [_inst_1 : Mul.{u2} M] (S : ι -> (Subsemigroup.{u2} M _inst_1)) {C : forall (x : M), (Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))) -> Prop}, (forall (i : ι) (x : M) (H : Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (S i)), C x (Subsemigroup.mem_supᵢ_of_mem.{u1, u2} ι M _inst_1 (fun (i : ι) => S i) i x H)) -> (forall (x : M) (y : M) (hx : Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))) (hy : Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) y (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))), (C x hx) -> (C y hy) -> (C (HMul.hMul.{u2, u2, u2} M M M (instHMul.{u2} M _inst_1) x y) (MulMemClass.mul_mem.{u2, u2} (Subsemigroup.{u2} M _inst_1) M _inst_1 (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1) (Subsemigroup.instMulMemClassSubsemigroupInstSetLikeSubsemigroup.{u2} M _inst_1) (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i)) x y hx hy))) -> (forall {x : M} (hx : Membership.mem.{u2, u2} M (Subsemigroup.{u2} M _inst_1) (SetLike.instMembership.{u2, u2} (Subsemigroup.{u2} M _inst_1) M (Subsemigroup.instSetLikeSubsemigroup.{u2} M _inst_1)) x (supᵢ.{u2, u1} (Subsemigroup.{u2} M _inst_1) (CompleteLattice.toSupSet.{u2} (Subsemigroup.{u2} M _inst_1) (Subsemigroup.instCompleteLatticeSubsemigroup.{u2} M _inst_1)) ι (fun (i : ι) => S i))), C x hx)
Case conversion may be inaccurate. Consider using '#align subsemigroup.supr_induction' Subsemigroup.supᵢ_induction'ₓ'. -/
/-- A dependent version of `subsemigroup.supr_induction`. -/
@[elab_as_elim, to_additive "A dependent version of `add_subsemigroup.supr_induction`. "]
theorem supᵢ_induction' (S : ι → Subsemigroup M) {C : ∀ x, (x ∈ ⨆ i, S i) → Prop}
    (hp : ∀ (i), ∀ x ∈ S i, C x (mem_supᵢ_of_mem i ‹_›))
    (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›)) {x : M}
    (hx : x ∈ ⨆ i, S i) : C x hx :=
  by
  refine' Exists.elim _ fun (hx : x ∈ ⨆ i, S i) (hc : C x hx) => hc
  refine' supr_induction S hx (fun i x hx => _) fun x y => _
  · exact ⟨_, hp _ _ hx⟩
  · rintro ⟨_, Cx⟩ ⟨_, Cy⟩
    exact ⟨_, hmul _ _ _ _ Cx Cy⟩
#align subsemigroup.supr_induction' Subsemigroup.supᵢ_induction'
#align add_subsemigroup.supr_induction' AddSubsemigroup.supᵢ_induction'

end Subsemigroup

end NonAssoc


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.preserves.shapes.products
import topology.sheaves.sheaf

/-!
# Checking the sheaf condition on the underlying presheaf of types.

If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
(we assume all limits exist in both `C` and `D`),
then checking the sheaf condition for a presheaf `F : presheaf C X`
is equivalent to checking the sheaf condition for `F ⋙ G`.

The important special case is when
`C` is a concrete category with a forgetful functor
that preserves limits and reflects isomorphisms.
Then to check the sheaf condition it suffices
to check it on the underlying sheaf of types.

## References
* https://stacks.math.columbia.edu/tag/0073
-/

noncomputable theory

open category_theory
open category_theory.limits
open topological_space
open opposite

namespace Top

namespace presheaf

namespace sheaf_condition

open sheaf_condition_equalizer_products

universes v u₁ u₂

variables {C : Type u₁} [category.{v} C] [has_limits C]
variables {D : Type u₂} [category.{v} D] [has_limits D]
variables (G : C ⥤ D) [preserves_limits G]
variables {X : Top.{v}} (F : presheaf C X)
variables {ι : Type v} (U : ι → opens X)

local attribute [reducible] diagram left_res right_res

/--
When `G` preserves limits, the sheaf condition diagram for `F` composed with `G` is
naturally isomorphic to the sheaf condition diagram for `F ⋙ G`.
-/
def diagram_comp_preserves_limits :
  diagram F U ⋙ G ≅ diagram (F ⋙ G) U :=
begin
  fapply nat_iso.of_components,
  rintro ⟨j⟩,
  exact (preserves_product.iso _ _),
  exact (preserves_product.iso _ _),
  rintros ⟨⟩ ⟨⟩ ⟨⟩,
  { ext, simp, dsimp, simp, }, -- non-terminal `simp`, but `squeeze_simp` fails
  { ext,
    simp only [limit.lift_π, functor.comp_map, map_lift_pi_comparison, fan.mk_π_app,
               preserves_product.iso_hom, parallel_pair_map_left, functor.map_comp,
               category.assoc],
    dsimp, simp, },
  { ext,
    simp only [limit.lift_π, functor.comp_map, parallel_pair_map_right, fan.mk_π_app,
               preserves_product.iso_hom, map_lift_pi_comparison, functor.map_comp,
               category.assoc],
    dsimp, simp, },
  { ext, simp, dsimp, simp, },
end

local attribute [reducible] res

/--
When `G` preserves limits, the image under `G` of the sheaf condition fork for `F`
is the sheaf condition fork for `F ⋙ G`,
postcomposed with the inverse of the natural isomorphism `diagram_comp_preserves_limits`.
-/
def map_cone_fork : G.map_cone (fork F U) ≅
  (cones.postcompose (diagram_comp_preserves_limits G F U).inv).obj (fork (F ⋙ G) U) :=
cones.ext (iso.refl _) (λ j,
begin
  dsimp, simp [diagram_comp_preserves_limits], cases j; dsimp,
  { rw iso.eq_comp_inv,
    ext,
    simp, dsimp, simp, },
  { rw iso.eq_comp_inv,
    ext,
    simp, -- non-terminal `simp`, but `squeeze_simp` fails
    dsimp,
    simp only [limit.lift_π, fan.mk_π_app, ←G.map_comp, limit.lift_π_assoc, fan.mk_π_app] }
end)

end sheaf_condition

universes v u₁ u₂

open sheaf_condition sheaf_condition_equalizer_products

variables {C : Type u₁} [category.{v} C] {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)
variables [reflects_isomorphisms G]
variables [has_limits C] [has_limits D] [preserves_limits G]

variables {X : Top.{v}} (F : presheaf C X)

/--
If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
(we assume all limits exist in both `C` and `D`),
then checking the sheaf condition for a presheaf `F : presheaf C X`
is equivalent to checking the sheaf condition for `F ⋙ G`.

The important special case is when
`C` is a concrete category with a forgetful functor
that preserves limits and reflects isomorphisms.
Then to check the sheaf condition it suffices to check it on the underlying sheaf of types.

Another useful example is the forgetful functor `TopCommRing ⥤ Top`.

See https://stacks.math.columbia.edu/tag/0073.
In fact we prove a stronger version with arbitrary complete target category.
-/
lemma is_sheaf_iff_is_sheaf_comp :
  presheaf.is_sheaf F ↔ presheaf.is_sheaf (F ⋙ G) :=
begin
  split,
  { intros S ι U,
    -- We have that the sheaf condition fork for `F` is a limit fork,
    obtain ⟨t₁⟩ := S U,
    -- and since `G` preserves limits, the image under `G` of this fork is a limit fork too.
    have t₂ := @preserves_limit.preserves _ _ _ _ _ _ _ G _ _ t₁,
    -- As we established above, that image is just the sheaf condition fork
    -- for `F ⋙ G` postcomposed with some natural isomorphism,
    have t₃ := is_limit.of_iso_limit t₂ (map_cone_fork G F U),
    -- and as postcomposing by a natural isomorphism preserves limit cones,
    have t₄ := is_limit.postcompose_inv_equiv _ _ t₃,
    -- we have our desired conclusion.
    exact ⟨t₄⟩, },
  { intros S ι U,
    refine ⟨_⟩,
    -- Let `f` be the universal morphism from `F.obj U` to the equalizer
    -- of the sheaf condition fork, whatever it is.
    -- Our goal is to show that this is an isomorphism.
    let f := equalizer.lift _ (w F U),
    -- If we can do that,
    suffices : is_iso (G.map f),
    { resetI,
      -- we have that `f` itself is an isomorphism, since `G` reflects isomorphisms
      haveI : is_iso f := is_iso_of_reflects_iso f G,
      -- TODO package this up as a result elsewhere:
      apply is_limit.of_iso_limit (limit.is_limit _),
      apply iso.symm,
      fapply cones.ext,
      exact (as_iso f),
      rintro ⟨_|_⟩; { dsimp [f], simp, }, },
    { -- Returning to the task of shwoing that `G.map f` is an isomorphism,
      -- we note that `G.map f` is almost but not quite (see below) a morphism
      -- from the sheaf condition cone for `F ⋙ G` to the
      -- image under `G` of the equalizer cone for the sheaf condition diagram.
      let c := fork (F ⋙ G) U,
      obtain ⟨hc⟩ := S U,
      let d := G.map_cone (equalizer.fork (left_res F U) (right_res F U)),
      have hd : is_limit d := preserves_limit.preserves (limit.is_limit _),
      -- Since both of these are limit cones
      -- (`c` by our hypothesis `S`, and `d` because `G` preserves limits),
      -- we hope to be able to conclude that `f` is an isomorphism.
      -- We say "not quite" above because `c` and `d` don't quite have the same shape:
      -- we need to postcompose by the natural isomorphism `diagram_comp_preserves_limits`
      -- introduced above.
      let d' := (cones.postcompose (diagram_comp_preserves_limits G F U).hom).obj d,
      have hd' : is_limit d' :=
        (is_limit.postcompose_hom_equiv (diagram_comp_preserves_limits G F U : _) d).symm hd,
      -- Now everything works: we verify that `f` really is a morphism between these cones:
      let f' : c ⟶ d' :=
      fork.mk_hom (G.map f)
      begin
        dsimp only [c, d, d', f, diagram_comp_preserves_limits, res],
        dunfold fork.ι,
        ext1 j,
        dsimp,
        simp only [category.assoc, ←functor.map_comp_assoc, equalizer.lift_ι,
          map_lift_pi_comparison_assoc],
        dsimp [res], simp,
      end,
      -- conclude that it is an isomorphism,
      -- just because it's a morphism between two limit cones.
      haveI : is_iso f' := is_limit.hom_is_iso hc hd' f',
      -- A cone morphism is an isomorphism exactly if the morphism between the cone points is,
      -- so we're done!
      exact is_iso.of_iso ((cones.forget _).map_iso (as_iso f')) }, },
end

/-!
As an example, we now have everything we need to check the sheaf condition
for a presheaf of commutative rings, merely by checking the sheaf condition
for the underlying sheaf of types.
```
import algebra.category.CommRing.limits
example (X : Top) (F : presheaf CommRing X) (h : presheaf.is_sheaf (F ⋙ (forget CommRing))) :
  F.is_sheaf :=
(is_sheaf_iff_is_sheaf_comp (forget CommRing) F).mpr h
```
-/

end presheaf

end Top


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.natural_transformation
import Mathlib.PostPort

universes u₁ u₂ v₁ v₂ v₃ u₃

namespace Mathlib

namespace category_theory

/--
`functor.category C D` gives the category structure on functors and natural transformations
between categories `C` and `D`.

Notice that if `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/
protected instance functor.category (C : Type u₁) [category C] (D : Type u₂) [category D] : category (C ⥤ D) :=
  category.mk

namespace nat_trans

@[simp] theorem vcomp_eq_comp {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) : vcomp α β = α ≫ β :=
  rfl

theorem vcomp_app' {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) : app (α ≫ β) X = app α X ≫ app β X :=
  rfl

theorem congr_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {α : F ⟶ G} {β : F ⟶ G} (h : α = β) (X : C) : app α X = app β X :=
  eq.mpr (id (Eq._oldrec (Eq.refl (app α X = app β X)) h)) (Eq.refl (app β X))

@[simp] theorem id_app {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (X : C) : app 𝟙 X = 𝟙 :=
  rfl

@[simp] theorem comp_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) : app (α ≫ β) X = app α X ≫ app β X :=
  rfl

theorem app_naturality {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D ⥤ E} {G : C ⥤ D ⥤ E} (T : F ⟶ G) (X : C) {Y : D} {Z : D} (f : Y ⟶ Z) : functor.map (functor.obj F X) f ≫ app (app T X) Z = app (app T X) Y ≫ functor.map (functor.obj G X) f :=
  naturality (app T X) f

theorem naturality_app {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D ⥤ E} {G : C ⥤ D ⥤ E} (T : F ⟶ G) (Z : D) {X : C} {Y : C} (f : X ⟶ Y) : app (functor.map F f) Z ≫ app (app T Y) Z = app (app T X) Z ≫ app (functor.map G f) Z :=
  congr_fun (congr_arg app (naturality T f)) Z

/-- A natural transformation is a monomorphism if each component is. -/
theorem mono_app_of_mono {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} (α : F ⟶ G) [∀ (X : C), mono (app α X)] : mono α := sorry

/-- A natural transformation is an epimorphism if each component is. -/
theorem epi_app_of_epi {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} (α : F ⟶ G) [∀ (X : C), epi (app α X)] : epi α := sorry

/-- `hcomp α β` is the horizontal composition of natural transformations. -/
def hcomp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D} {G : C ⥤ D} {H : D ⥤ E} {I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : F ⋙ H ⟶ G ⋙ I :=
  mk fun (X : C) => app β (functor.obj F X) ≫ functor.map I (app α X)

infixl:80 " ◫ " => Mathlib.category_theory.nat_trans.hcomp

@[simp] theorem hcomp_app {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D} {G : C ⥤ D} {H : D ⥤ E} {I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) (X : C) : app (α ◫ β) X = app β (functor.obj F X) ≫ functor.map I (app α X) :=
  rfl

@[simp] theorem hcomp_id_app {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D} {G : C ⥤ D} {H : D ⥤ E} (α : F ⟶ G) (X : C) : app (α ◫ 𝟙) X = functor.map H (app α X) := sorry

theorem id_hcomp_app {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D} {G : C ⥤ D} {H : E ⥤ C} (α : F ⟶ G) (X : E) : app (𝟙 ◫ α) X = app α (functor.obj H X) := sorry

-- Note that we don't yet prove a `hcomp_assoc` lemma here: even stating it is painful, because we

-- need to use associativity of functor composition. (It's true without the explicit associator,

-- because functor composition is definitionally associative, but relying on the definitional equality

-- causes bad problems with elaboration later.)

theorem exchange {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} {I : D ⥤ E} {J : D ⥤ E} {K : D ⥤ E} (α : F ⟶ G) (β : G ⟶ H) (γ : I ⟶ J) (δ : J ⟶ K) : (α ≫ β) ◫ (γ ≫ δ) = α ◫ γ ≫ β ◫ δ := sorry

end nat_trans

namespace functor

/-- Flip the arguments of a bifunctor. See also `currying.lean`. -/
protected def flip {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D ⥤ E) : D ⥤ C ⥤ E :=
  mk (fun (k : D) => mk (fun (j : C) => obj (obj F j) k) fun (j j' : C) (f : j ⟶ j') => nat_trans.app (map F f) k)
    fun (c c' : D) (f : c ⟶ c') => nat_trans.mk fun (j : C) => map (obj F j) f

@[simp] theorem flip_obj_obj {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D ⥤ E) (c : C) (d : D) : obj (obj (functor.flip F) d) c = obj (obj F c) d :=
  rfl

@[simp] theorem flip_obj_map {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D ⥤ E) {c : C} {c' : C} (f : c ⟶ c') (d : D) : map (obj (functor.flip F) d) f = nat_trans.app (map F f) d :=
  rfl

@[simp] theorem flip_map_app {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D ⥤ E) {d : D} {d' : D} (f : d ⟶ d') (c : C) : nat_trans.app (map (functor.flip F) f) c = map (obj F c) f :=
  rfl


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

/-!
# Basic definitions
-/

universe u v

inductive DEq {α : Type u} (β : α → Type v) : {a₁ a₂ : α} → β a₁ → β a₂ → Prop
| refl {a : α} (b : β a) : DEq β b b

namespace DEq

variable {α : Type u} {β : α → Type v}

theorem trans {a₁ a₂ a₃ : α} : ∀ {x₁ : β a₁} {x₂ : β a₂} {x₃ : β a₃}, DEq β x₁ x₂ → DEq β x₂ x₃ → DEq β x₁ x₃
| _, _, _, DEq.refl _, DEq.refl _ => DEq.refl _

instance instTransDEq (a₁ a₂ a₃ : α) : Trans (DEq β (a₁:=a₁) (a₂:=a₂)) (DEq β (a₁:=a₂) (a₂:=a₃)) (DEq β (a₁:=a₁) (a₂:=a₃)) where
  trans hxy hyz := DEq.trans hxy hyz

theorem symm : ∀ {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂}, DEq β b₁ b₂ → DEq β b₂ b₁
| _, _, _, _, DEq.refl _ => DEq.refl _

theorem subst_deq : ∀ {a₁ a₂ : α} {h : a₁ = a₂} {b : β a₁}, DEq β (h ▸ b) b
| _, _, Eq.refl _, _ => DEq.refl _

theorem eq_param : ∀ {a₁ a₂ : α} {x₁ : β a₁} {x₂ : β a₂}, DEq β x₁ x₂ → a₁ = a₂
| _, _, _, _, DEq.refl _ => rfl

theorem deq_of_eq : ∀ {a : α} {x₁ x₂ : β a}, x₁ = x₂ → DEq β x₁ x₂
| _, _, _, rfl => DEq.refl _

theorem eq_of_deq : ∀ {a : α} {x₁ x₂ : β a}, DEq β x₁ x₂ → x₁ = x₂
| _, _, _, DEq.refl _ => rfl

end DEq


example (x y : Nat) (h : x = y) : y = x := by exact h.symm
                                                     --^ textDocument/hover
                                                  --^ textDocument/hover

example (x y : Nat) (h : x = y) : y = x := h.symm
                                            --^ textDocument/hover

example (x y : Nat) (h : x = y) : y = x := by exact (Eq.symm (Eq.symm h.symm))
                                                    --^ textDocument/hover
                                                               --^ textDocument/hover
                                                                    --^ textDocument/hover
                                                                      --^ textDocument/hover


import tactic
import fol
import Rings.Notation
import Rings.ToMathlib
import data.polynomial.eval
import data.mv_polynomial

universe u

namespace Rings

local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

/-- The constant symbols in RingSignature -/
inductive RingConsts : Type u
| zero : RingConsts
| one : RingConsts

/-- The unary function symbols in RingSignature-/
inductive RingUnaries : Type u
| neg : RingUnaries

/-- The binary function symbols in RingSignature-/
inductive RingBinaries : Type u
| add : RingBinaries
| mul : RingBinaries

/-- All function symbols in RingSignature-/
def RingFuncs : ℕ → Type u
| 0 := RingConsts
| 1 := RingUnaries
| 2 := RingBinaries
| (n + 3) := pempty

instance : inhabited RingConsts := ⟨ RingConsts.zero ⟩
instance : inhabited RingUnaries := ⟨ RingUnaries.neg ⟩
instance : inhabited RingBinaries := ⟨ RingBinaries.add ⟩

open fol

/-- The language of rings -/
def RingSignature : Language :=
(Language.mk) (RingFuncs) (λ n, pempty)

@[reducible] private def bdt (n : ℕ) := bounded_term RingSignature n
@[reducible] private def bdt' (n : ℕ) := bounded_preterm RingSignature n 0
-- I shouldn't need to make a duplicate since they are definitionally equal

/- The following instances allow us to use symbols 0 1 - + * to write down terms in the language-/
@[simp] def zero {n} : bdt n := bd_func RingConsts.zero

@[reducible] instance RingBDTHasZero {n} : has_zero (bdt n) := ⟨ zero ⟩
@[reducible] instance RingBDTHasZero' {n} : has_zero (bdt' n) := ⟨ zero ⟩

@[simp] def one {n} : bdt n := bd_func RingConsts.one
@[reducible] instance RingBDTHasOne {n} : has_one (bdt n) := ⟨ one ⟩
@[reducible] instance RingBDTHasOne' {n} : has_one (bdt' n) := ⟨ one ⟩

@[simp] def neg {n} : bdt n → bdt n := bd_app (bd_func RingUnaries.neg)
@[reducible] instance RingBDTHasNeg {n} : has_neg (bdt n) := ⟨ neg ⟩
@[reducible] instance RingBDTHasNeg' {n} : has_neg (bdt'  n) := ⟨ neg ⟩

@[reducible] instance RingBDTHasAdd {n} : has_add (bdt n) :=
  ⟨ λ x, bd_app (bd_app (@bd_func RingSignature _ 2 RingBinaries.add) x) ⟩
@[reducible] instance RingBDTHasAdd' {n} : has_add (bdt'  n) :=
⟨ λ x, bd_app (bd_app (@bd_func RingSignature _ 2 RingBinaries.add) x) ⟩

@[simp] def mul {n} (x : bdt n) : bdt n → bdt n :=
  bd_app (bd_app (bd_func RingBinaries.mul) x)
@[reducible] instance RingBDTHasMul {n} : has_mul (bdt n) := ⟨ mul ⟩
@[reducible] instance RingBDTHasMul' {n} : has_mul (bdt' n) := ⟨ mul ⟩

-- has_pow comes for free by having instances of mul and 1 (see ToMathlib) -- input x ^ n

@[simp] lemma pow_zero {n} (t : bounded_term RingSignature n) : t ^ 0 = 1 := rfl
@[simp] lemma pow_succ {n m} (t : bounded_term RingSignature m) : t ^ (n + 1) = t * t ^ n := rfl

-- with has_one and has_add you can write any natural and lean will know what term you mean
-- with has_neg you can write any integer etc.

/-
-- variables x0 , x1 in the signature
-- (they are only variables in bounded terms that have up to n + 1, n + 2 variables)
example {n} : bounded_term RingSignature (n + 1) := x_ 0
-- for example {n} : bounded_term RingSignature n := x_ 0 doesn't work
-- since fin n doesn't have an instance of 0 in general (when n = 0)
example {n} : bounded_term RingSignature (n + 2) := x_ 1
-- actually example {n} : bounded_term RingSignature (n + 1) := x_ 1 also works because
-- fin (n + 1) is implemented mod (n + 1), in particular 1 = 0 ∈ fin 1
-- but let's avoid that

-- neg x
example {n} : bounded_term RingSignature (n + 1) := - (x_ 0)
example {n} : bounded_term RingSignature (n + 1) := (x_ 0) + 1
example {n} : bounded_term RingSignature (n + 2):= (- x_ 0) * x_ 1
example {n} : bounded_term RingSignature (n + 1) := x_ 0 + x_ 0
-/

/-- Part of the definition of BdtRec -/
@[simp] def RingFuncRec {n} {C : bounded_term RingSignature n → Sort u}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t)) :
  Π {l : ℕ} (f : RingSignature.functions l) (ts : dvector (bounded_term RingSignature n) l),
  (Π (t : bounded_term RingSignature n), dvector.pmem t ts → C t)
  → C (bd_apps (bd_func f) ts)
| 0 (RingConsts.zero) ([]) h := c0
| 0 (RingConsts.one) ([]) h := c1
| 1 (RingUnaries.neg) ([t]) h := cneg (h t (psum.inl rfl))
| 2 (RingBinaries.add) ([s,t]) h := cadd (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))
| 2 (RingBinaries.mul) ([s,t]) h := cmul (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))
| (n + 3) f ts h := pempty.elim f

/-- An interface for mapping out of bounded_term RingSignature n (basically bounded_term.rec) -/
def RingTermRec {n : ℕ} {C : bounded_term RingSignature n → Sort u}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t))
  : Π (t : bounded_term RingSignature n), C t :=
@bounded_term.rec RingSignature n C
(λ k, cvar k)
(λ l, RingFuncRec cvar c0 c1 @cneg @cadd @cmul)

def RingTermInd {n : ℕ} {C : bounded_term RingSignature n → Prop}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t))
  : Π (t : bounded_term RingSignature n), C t :=
@bounded_term.rec RingSignature n C
(λ k, cvar k)
(λ l, RingFuncRec cvar c0 c1 @cneg @cadd @cmul)

/- Commutative group for additions axioms -/

/-- Assosiativity of addition -/
def AddAssoc : sentence RingSignature :=
  ∀' ∀' ∀' ( (x_ 0 + x_ 1) + x_ 2 ≃ x_ 0 + (x_ 1 + x_ 2) )

/-- Identity for addition -/
def AddId : sentence RingSignature := ∀' ( x_ 0 + 0 ≃ x_ 0 )
-- def AddId : sentence RingSignature := ∀' (   &'0 r+ r0 ≃ &'0   ⊓   r0 r+ &'0 ≃ &'0   )

/-- Inverse for addition -/
def AddInv : sentence RingSignature := ∀' ( - x_ 0 + x_ 0 ≃ 0 )
-- def AddInv : sentence RingSignature := ∀' (  &'0 r+ r- &'0 ≃ r0  ⊓  r- &'0 r+ &'0 ≃ r0  )

/-- Commutativity of addition-/
def AddComm : sentence RingSignature := ∀' ∀' ( x_ 0 + x_ 1 ≃ x_ 1 + x_ 0 )

/- Commutative monoid for multiplication axioms -/
/-- Associativity of multiplication -/
def MulAssoc : sentence RingSignature := ∀' ∀' ∀' ( (x_ 0 * x_ 1) * x_ 2 ≃ x_ 0 * (x_ 1 * x_ 2) )

/-- Identity of multiplication -/
def MulId : sentence RingSignature :=  ∀' ( x_ 0 * 1 ≃ x_ 0 )
-- def MulId : sentence RingSignature :=  ∀' (   &'0 r× r1 ≃ &'0   )

/-- Commutativity of multiplication -/
def MulComm : sentence RingSignature := ∀' ∀' ( x_ 0 * x_ 1 ≃ x_ 1 * x_ 0   )

/-- Distributibity -/
def AddMul : sentence RingSignature := ∀' ∀' ∀' ( (x_ 0 + x_ 1) * x_ 2 ≃ x_ 0 * x_ 2 + x_ 1 * x_ 2 )

/-- The theory of rings -/
def RingTheory : Theory RingSignature :=
{AddAssoc, AddId, AddInv, AddComm, MulAssoc, MulId, MulComm, AddMul}

lemma AddAssocInRingTheory : AddAssoc ∈ RingTheory :=
begin unfold RingTheory, left, refl end

lemma AddIdInRingTheory : AddId ∈ RingTheory :=
begin unfold RingTheory, iterate 1 {right}, left, refl end

lemma AddInvInRingTheory : AddInv ∈ RingTheory :=
begin unfold RingTheory, iterate 2 {right}, left, refl end

lemma AddCommInRingTheory : AddComm ∈ RingTheory :=
begin unfold RingTheory, iterate 3 {right}, left, refl end

lemma MulAssocInRingTheory : MulAssoc ∈ RingTheory :=
begin unfold RingTheory, iterate 4 {right}, left, refl end

lemma MulIdInRingTheory : MulId ∈ RingTheory :=
begin unfold RingTheory, iterate 5 {right}, left, refl end

lemma MulCommInRingTheory : MulComm ∈ RingTheory :=
begin unfold RingTheory, iterate 6 {right}, left, refl end

lemma AddMulInRingTheory : AddMul ∈ RingTheory :=
begin unfold RingTheory, iterate 7 {right}, exact set.mem_singleton _, end

namespace structureTo
  -- We make any (type theoretic) structure A,0,1,-,+,* into a
  -- (model theoretic) Structure in RingSignature

  variable
    {A : Type u}

  /-- Interpreting consant symbols from RingSignature -/
  @[simp] def ConstMap [has_zero A] [has_one A] : RingConsts → (dvector A 0) → A
  | RingConsts.zero _ := 0
  | RingConsts.one  _ := 1

  /-- Interpreting unary function symbols from RingSignature -/
  @[simp] def UnariesMap [has_neg A] : RingUnaries → (dvector A 1) → A
  | RingUnaries.neg a := - (dvector.last a)

  /-- Interpreting binary function symbols from RingSignature -/
  @[simp] def BinariesMap [has_add A] [has_mul A] : RingBinaries → (dvector A 2) → A
  | RingBinaries.add   (a :: b) := a + dvector.last b
  | RingBinaries.mul  (a :: b) := a * dvector.last b

  variables [has_zero A] [has_one A] [has_neg A] [has_add A] [has_mul A]

  /-- Interpreting all symbols from RingSignature-/
  @[simp] def FuncMap : Π (n : ℕ), (RingFuncs n) → (dvector A n) → A
  | 0       := ConstMap
  | 1       := UnariesMap
  | 2       := BinariesMap
  | (n + 3) := pempty.elim

  variable (A)

  /-- Interpreting the symbols -/
  @[reducible] def Structure : Structure RingSignature :=
  Structure.mk A FuncMap (λ n, pempty.elim)

  @[simp] lemma realize_zero {n} {vec : dvector A n} :
    @realize_bounded_term RingSignature (structureTo.Structure A) n vec 0
      (@bd_func RingSignature _ 0 RingConsts.zero) dvector.nil = 0 := rfl

  lemma apps_zero {n} : Π {t_ : dvector (bounded_term RingSignature n) 0},
    bd_apps (@bd_func RingSignature _ 0 RingConsts.zero) t_ = 0
  | [] := rfl

  @[simp] lemma realize_one {n} {vec : dvector A n} :
    @realize_bounded_term RingSignature (structureTo.Structure A) n vec 0
      (@bd_func RingSignature _ 0 RingConsts.one) dvector.nil = 1 := rfl

  lemma apps_one {n} : Π {t_ : dvector (bounded_term RingSignature n) 0},
    bd_apps (@bd_func RingSignature _ 0 RingConsts.one) t_ = 1
  | [] := rfl

  lemma app_neg {n} {t : bounded_term RingSignature n} :
    bd_app (@bd_func RingSignature _ 1 RingUnaries.neg) t = - t := rfl

  lemma apps_neg {n} {t : bounded_term RingSignature n} :
     bd_apps (@bd_func RingSignature _ 1 RingUnaries.neg) ([t]) = - t := rfl

  lemma app_add {n} {s t : bounded_term RingSignature n} :
    ((@bd_func RingSignature _ 2 RingBinaries.add).bd_app t).bd_app s = t + s := rfl

  lemma apps_add {n} {s t : bounded_term RingSignature n} :
     bd_apps (@bd_func RingSignature _ 2 RingBinaries.add) ([s,t]) = s + t := rfl

  lemma app_mul {n} {s t : bounded_term RingSignature n} :
    ((@bd_func RingSignature _ 2 RingBinaries.mul).bd_app t).bd_app s = t * s := rfl

  lemma apps_mul {n} {s t : bounded_term RingSignature n} :
     bd_apps (@bd_func RingSignature _ 2 RingBinaries.mul) ([s,t]) = s * t := rfl

  -- lemma preterm_upper_bound {n} : bounded_preterm RingSignature n 3 → false := _

end structureTo

namespace comm_ring_to

  variables
    (A : Type u) [comm_ring A]

  lemma RealizeRingTheory :
    (structureTo.Structure A) ⊨ RingTheory :=
  begin
    intros ϕ h,
    repeat {cases h},
    {
      intros a b c,
      simp only [structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap, dvector.last,
        realize_bounded_formula, realize_bounded_term, fin.val_two, fin.val_one, dvector.nth],
      apply add_assoc
    },
    {
      intro a,
      simp only [add_zero, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
        dvector.last, eq_self_iff_true, realize_bounded_term_bd_app, realize_bounded_formula,
        realize_bounded_term, structureTo.realize_zero, dvector.nth, zero],
    },
    {
      intro a,
      simp only [structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
        structureTo.UnariesMap, dvector.last, eq_self_iff_true, realize_bounded_term_bd_app,
        realize_bounded_formula, realize_bounded_term, structureTo.realize_zero,
        dvector.nth, zero, neg, add_left_neg],
    },
    {
      intros a b,
      simp only [structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
        dvector.last, realize_bounded_formula,
        realize_bounded_term, fin.val_one, dvector.nth, add_comm]
    },
    {
      intros a b c,
      simp only [mul, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
      dvector.last, realize_bounded_formula,
      realize_bounded_term, fin.val_two, fin.val_one, dvector.nth, mul_assoc],
    },
    {
      intro a,
      simp only [mul, structureTo.realize_one, structureTo.FuncMap, fin.val_zero',
        structureTo.ConstMap, mul_one, structureTo.BinariesMap, dvector.last, eq_self_iff_true, one,
        realize_bounded_term_bd_app, realize_bounded_formula, realize_bounded_term, dvector.nth],
    },
    {
      intros a b,
      simp only [mul, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
      dvector.last, realize_bounded_formula,
      realize_bounded_term, fin.val_one, dvector.nth, mul_comm],
    },
    {
      intros a b c,
      simp only [mul, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap, dvector.last,
      realize_bounded_formula, realize_bounded_term, fin.val_two,
      fin.val_one, dvector.nth, add_mul]
    }
  end

  /-- -/
  def ModelOfRingTheory : Model RingTheory.{u} :=
  ⟨ structureTo.Structure A ,  RealizeRingTheory A ⟩

end comm_ring_to

namespace mv_polynomial
  /- Terms in the RingSignature are multivariable polynomials over ℤ -/

  variable {σ : Type}

  @[simp] noncomputable def Const : RingConsts → mv_polynomial σ ℤ
  | RingConsts.zero := 0
  | RingConsts.one := 1

  @[simp] noncomputable def UniAux : RingUnaries → mv_polynomial σ ℤ → mv_polynomial σ ℤ
  | RingUnaries.neg p := - p

  @[simp] noncomputable def Uni {n} (f : RingSignature.functions 1) :
    Π (ts : dvector (bounded_term RingSignature n) 1),
    (Π (t : bounded_term RingSignature n), dvector.pmem t ts → mv_polynomial σ ℤ)
    → mv_polynomial σ ℤ
  | [t] h := UniAux f (h t (psum.inl rfl))

  noncomputable def BinAux : RingBinaries →
    mv_polynomial σ ℤ → mv_polynomial σ ℤ → mv_polynomial σ ℤ
  | RingBinaries.add p q := p + q
  | RingBinaries.mul p q := p * q

  noncomputable def Bin {n} (f : RingSignature.functions 2) :
    Π (ts : dvector (bounded_term RingSignature n) 2),
    (Π (t : bounded_term RingSignature n), dvector.pmem t ts → mv_polynomial σ ℤ)
    → mv_polynomial σ ℤ
  | [s, t] h := BinAux f (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))

  @[simp] noncomputable def Func {n} :
    Π {l : ℕ} (f : RingSignature.functions l) (ts : dvector (bounded_term RingSignature n) l),
    (Π (t : bounded_term RingSignature n), dvector.pmem t ts → mv_polynomial σ ℤ) →
    (λ (_x : bounded_term RingSignature n), mv_polynomial σ ℤ) (bd_apps (bd_func f) ts)
  | 0 := λ f ts h, Const f
  | 1 := Uni
  | 2 := Bin
  | (n + 3) := λ f, pempty.elim f

  noncomputable def Term {n} :
    bounded_term RingSignature n → mv_polynomial (fin n) ℤ :=
  @RingTermRec n (λ _, mv_polynomial (fin n) ℤ)
    mv_polynomial.X 0 1
    (λ _ p, - p)
    (λ _ _ p q, p + q)
    (λ _ _ p q, p * q)

  noncomputable def Term' {n} :
    bounded_term RingSignature n → mv_polynomial (fin n) ℤ :=
  @bounded_term.rec RingSignature n (λ _, mv_polynomial (fin n) ℤ)
    mv_polynomial.X (λ _, Func)

  @[simp] lemma TermX {n} {k : fin n} : Term (x_ k) = mv_polynomial.X k := rfl

  @[simp] lemma TermZero {n} : @Term n (bd_func RingConsts.zero) = 0 := rfl
  @[simp] lemma TermOne {n} : @Term n (bd_func RingConsts.one) = 1 := rfl

  @[simp] lemma TermNeg {n} {t : bounded_term RingSignature n} :
    Term (- t) = - Term t := rfl

  @[simp] lemma TermAdd {n} {s t : bounded_term RingSignature n} :
    Term (s + t) = Term s + Term t := rfl

  @[simp] lemma TermMul {n} {s t : bounded_term RingSignature n} :
    Term (s * t) = Term s * Term t := rfl

  variables {A : Type u} [comm_ring A]

  @[reducible] private def AStruc := structureTo.Structure A

  lemma RealisedVarIsEvaluatedVar {n} {as : dvector A n} : Π (k : fin n),
  @realize_bounded_term _ AStruc _ as _ (x_ k) dvector.nil
  = mv_polynomial.eval (fin_val_of_dvector as) (Term (x_ k)) :=
  begin
    intro k,
    simpa only [mv_polynomial.eval_X, fin_val_of_dvector, fin.val_eq_coe,
      TermX, coe_mv_poly_X, realize_bounded_term],
  end

  lemma RealisedFuncIsEvaluatedFunc {n} {as : dvector A n} :
    Π {l : ℕ} (f : RingSignature.functions l)
    (ts : dvector (bounded_term RingSignature n) l),
    (Π (t : bounded_term RingSignature (n )),
       dvector.pmem t ts →
       (@realize_bounded_term _ AStruc _ as _ t dvector.nil =
         mv_polynomial.eval (fin_val_of_dvector as) (Term t)))
    → @realize_bounded_term _ AStruc _ as _ (bd_apps (bd_func f) ts) dvector.nil =
       mv_polynomial.eval (fin_val_of_dvector as) (Term (bd_apps (bd_func f) ts))
  | 0 RingConsts.zero _ h :=
  begin
    rw structureTo.apps_zero,
    simp only [fin_val_of_dvector, realize_bounded_term, structureTo.realize_zero, TermZero, zero],
    refl,
  end
  | 0 RingConsts.one _ h :=
  begin
    rw structureTo.apps_one,
    simp only [fin_val_of_dvector, realize_bounded_term, structureTo.realize_one, TermOne,
      one, coe_mv_poly_one, ring_hom.map_one],
  end
  | 1 RingUnaries.neg [t] h :=
  begin
    rw [structureTo.apps_neg, TermNeg],
    unfold_coes,
    unfold_coes at h,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
    simp only [structureTo.UnariesMap, structureTo.FuncMap,
      dvector.last, realize_bounded_term, neg, dvector.nth, coe_mv_poly_neg],
    simp only [ring_hom.to_fun_eq_coe, ring_hom.map_neg,
    mv_polynomial.eval_map, neg_inj],
    rw ← h t (psum.inl rfl),
  end
  | 2 RingBinaries.add ([s,t]) h :=
  begin
    rw [structureTo.apps_add, TermAdd],
    unfold_coes,
    unfold_coes at h,
    simp only [structureTo.FuncMap, structureTo.BinariesMap,
      ring_hom.map_add, dvector.last, ring_hom.to_fun_eq_coe,
      realize_bounded_term, mv_polynomial.eval_map, dvector.nth],
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
    rw ← (h s (psum.inl rfl)),
    rw ← (h t (psum.inr (psum.inl rfl))),
  end
  | 2 RingBinaries.mul [s,t] h :=
  begin
    rw [structureTo.apps_mul, TermMul],
    unfold_coes,
    unfold_coes at h,
    simp only [structureTo.FuncMap, structureTo.BinariesMap,
      ring_hom.map_mul, dvector.last, ring_hom.to_fun_eq_coe,
      realize_bounded_term, mv_polynomial.eval_map, dvector.nth, mul],
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
    rw ← (h s (psum.inl rfl)),
    rw ← (h t (psum.inr (psum.inl rfl))),
  end
  | (n + 3) f t_ h := pempty.elim f

  lemma RealizedTermIsEvaluatedPoly {n} {as : dvector A n} :
  Π (t : bounded_term RingSignature n),
    @realize_bounded_term _ AStruc _ as _ t dvector.nil
    = mv_polynomial.eval (fin_val_of_dvector as) (Term t) :=
  @bounded_term.rec RingSignature n
  (λ t, @realize_bounded_term _ AStruc _ as _ t dvector.nil
    = mv_polynomial.eval (fin_val_of_dvector as) (Term t))
  (RealisedVarIsEvaluatedVar)
  (λ l, RealisedFuncIsEvaluatedFunc)

end mv_polynomial

namespace polynomial

  variables {A : Type u} [comm_ring A]

  @[reducible] private def AStruc := structureTo.Structure A

  -- noncomputable def mv_poly_Z_to_poly_A {n} (as : dvector A n) (p : mv_polynomial (fin n.succ) ℤ) :
  --   polynomial A :=
  -- let σ : fin n.succ → polynomial A :=
  -- @fin.cases n (λ _, polynomial A) polynomial.X (λ i, polynomial.C (dvector.nth' as i)) in
  -- mv_polynomial.eval σ p

  noncomputable def TermEvaluatedAtCoeffs {n} (as : dvector A n)
    (t : bounded_term RingSignature n.succ) : polynomial A :=
  let σ : fin n.succ → polynomial A :=
  @fin.cases n (λ _, polynomial A) polynomial.X (λ i, polynomial.C (dvector.nth' as i)) in
  mv_polynomial.eval σ (mv_polynomial.Term t)

  lemma fin_val_of_dvector_eq_x_val {n} {x : A} {as : dvector A n} :
    fin_val_of_dvector (x :: as) = x_val x (fin_val_of_dvector as) :=
    funext (
    @fin.cases n (λ k, fin_val_of_dvector (x :: as) k = x_val x (fin_val_of_dvector as) k)
    rfl
    (λ k, begin unfold fin_val_of_dvector, simp, end)
    )

  lemma eval_eq_realize_bounded_term
    {n} {as : dvector A n} {x : A} (t : bounded_term.{u} RingSignature n.succ) :
    (polynomial.eval x (TermEvaluatedAtCoeffs as t)
      = @realize_bounded_term _ AStruc n.succ (x::as) _ t dvector.nil) :=
  begin
    rw mv_polynomial.RealizedTermIsEvaluatedPoly,
    rw fin_val_of_dvector_eq_x_val,
    rw mv_polynomial.eval_eq_poly_eval_mv_coeffs,
    simp only [fin_val_of_dvector, function.comp_app, x_val,
      mv_poly_coeffs_to_poly, TermEvaluatedAtCoeffs],
    have hcoes : polynomial.C.comp (int.cast_ring_hom AStruc) = int.cast_ring_hom (polynomial A) :=
    by simp,
    unfold_coes,
    rw ← hcoes,
    simp,
  end

  lemma TermEvaluatedAtCoeffsX {n} {as : dvector A n} :
    TermEvaluatedAtCoeffs as (x_ 0) = polynomial.X :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermX],
    simp,
  end

  @[simp] lemma TermEvaluatedAtCoeffsCoeff
  {n} {as : dvector A n} {k : fin n} :
    TermEvaluatedAtCoeffs as (x_ (k.succ)) = polynomial.C (dvector.nth' as k) :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermX],
    simp,
  end

  lemma TermEvaluatedAtCoeffsZero {n} {as : dvector A n} :
    TermEvaluatedAtCoeffs as (bd_func RingConsts.zero) = 0 :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermZero],
    simp,
  end

  lemma TermEvaluatedAtCoeffsOne {n} {as : dvector A n} :
    TermEvaluatedAtCoeffs as (bd_func RingConsts.one) = 1 :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermOne],
    simp,
  end

  lemma TermEvaluatedAtCoeffsNeg {n} {as : dvector A n} {t : bounded_term RingSignature n.succ} :
    TermEvaluatedAtCoeffs as (- t) = - TermEvaluatedAtCoeffs as t :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermNeg],
    simp,
  end

  lemma TermEvaluatedAtCoeffsAdd {n} {as : dvector A n} {s t : bounded_term RingSignature n.succ} :
    TermEvaluatedAtCoeffs as (s + t) = TermEvaluatedAtCoeffs as s + TermEvaluatedAtCoeffs as t :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermAdd],
    simp,
  end

  lemma TermEvaluatedAtCoeffsMul {n} {as : dvector A n} {s t : bounded_term RingSignature n.succ} :
    TermEvaluatedAtCoeffs as (s * t) = TermEvaluatedAtCoeffs as s * TermEvaluatedAtCoeffs as t :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermMul],
    simp,
  end

  lemma TermEvaluatedAtCoeffsPow {n : ℕ} : Π {m : ℕ} {as : dvector A n},
    polynomial.TermEvaluatedAtCoeffs as (x_ 0 ^ m) = polynomial.X ^ m
  | 0       _ :=
  begin
    rw pow_zero,
    simp only [one, TermEvaluatedAtCoeffsOne],
    refl,
  end
  | (n + 1) as :=
  begin
    rw Rings.pow_succ,
    rw TermEvaluatedAtCoeffsMul,
    rw TermEvaluatedAtCoeffsX,
    rw TermEvaluatedAtCoeffsPow,
    refl
  end

  lemma TermEvaluatedAtCoeffsMonomial {n : ℕ} {m : ℕ} {as : dvector A n} {k : fin n} :
    polynomial.TermEvaluatedAtCoeffs as (x_ (k.succ) * x_ 0 ^ m)
      = polynomial.monomial m (dvector.nth' as k) :=
  begin
    rw TermEvaluatedAtCoeffsMul,
    rw TermEvaluatedAtCoeffsCoeff,
    rw TermEvaluatedAtCoeffsPow,
    rw polynomial.monomial_eq_C_mul_X,
  end

  lemma nth_eq_succ_nth : Π {k n : ℕ} {as : dvector A (n + 1)} {h : k < n},
  as.nth k (lt_trans h (by simp)) = (dvector.remove_mth (n + 2) as).nth k h
  | k nat.zero ([a]) h := by {exfalso, simpa using h}
  | nat.zero (nat.succ n) (a::as) h := by simp
  | (nat.succ k) (nat.succ n) (a::as) h := by {simpa using nth_eq_succ_nth}

  lemma lift_succ_remove_last {n : ℕ} :
  Π {t : bounded_term RingSignature (n + 1)} {as : dvector A (n + 1)},
    polynomial.TermEvaluatedAtCoeffs as (lift_succ t)
    = polynomial.TermEvaluatedAtCoeffs (dvector.remove_mth (n + 2) as) t :=
  @RingTermRec (n + 1)
  (λ {t : bounded_term RingSignature (n + 1)}, Π {as : dvector A (n + 1)},
    polynomial.TermEvaluatedAtCoeffs as (lift_succ t)
    = polynomial.TermEvaluatedAtCoeffs (dvector.remove_mth (n + 2) as) t)
    (begin -- variables
      intros k as,
      rw lift_succ_x_k,
      cases k with k hk,
      cases k,
      {simp only [mv_polynomial.eval_X, fin.mk_zero, fin.cases_zero, fin.coe_eq_cast_succ,
        fin.cast_succ_zero, coe_mv_poly_X,
        mv_polynomial.TermX, TermEvaluatedAtCoeffs]},
      {
        simp only [mv_polynomial.eval_X, polynomial.C_inj,
          fin.coe_eq_cast_succ, fin.cases_succ', coe_mv_poly_X, fin.cast_succ_mk,
          mv_polynomial.TermX, TermEvaluatedAtCoeffs, dvector.nth'],
        apply nth_eq_succ_nth,
      },
    end)
    (begin -- 0
      intro as,
      simp only [zero, lift_succ],
      repeat {rw TermEvaluatedAtCoeffsZero},
    end)
    (begin -- 1
      intro as,
      simp only [one, lift_succ],
      repeat {rw TermEvaluatedAtCoeffsOne},
    end)
    (begin -- neg
      intros t h as,
      simp only [neg, lift_succ],
      repeat {rw structureTo.app_neg},
      repeat {rw TermEvaluatedAtCoeffsNeg},
      rw h,
    end)
    (begin -- add
      intros s t hs ht as,
      simp only [lift_succ],
      repeat {rw structureTo.app_add},
      repeat {rw TermEvaluatedAtCoeffsAdd},
      rw [hs, ht],
    end)
    (begin -- mul
      intros s t hs ht as,
      simp only [mul, lift_succ],
      repeat {rw structureTo.app_mul},
      repeat {rw TermEvaluatedAtCoeffsMul},
      rw [hs, ht],
    end)

end polynomial

namespace ModelTo

  variable {M : Structure RingSignature}

  def zero : ↥ M := @Structure.fun_map _ M 0 RingConsts.zero dvector.nil
  def one : ↥ M := @Structure.fun_map _ M 0 RingConsts.one dvector.nil
  def neg (a : M.carrier) : M.carrier := @Structure.fun_map _ M 1 RingUnaries.neg ([a])
  def add (a b : M.carrier) : M.carrier := @Structure.fun_map _ M 2 RingBinaries.add ([a , b])
  def mul (a b : M.carrier) : M.carrier := @Structure.fun_map _ M 2 RingBinaries.mul ([a , b])

  instance : has_zero M := ⟨ zero ⟩
  instance : has_one M := ⟨ one ⟩
  instance : has_neg M := ⟨ neg ⟩
  instance : has_add M := ⟨ add ⟩
  instance : has_mul M := ⟨ mul ⟩

  @[simp] lemma realize_zero {n} {vec : dvector M.carrier n} :
    realize_bounded_term vec (@bd_func RingSignature _ 0 RingConsts.zero) dvector.nil = 0 := rfl

  @[simp] lemma realize_one {n} {vec : dvector M.carrier n} :
    realize_bounded_term vec (@bd_func RingSignature _ 0 RingConsts.one) dvector.nil = 1 := rfl

  @[simp] lemma realize_neg {a : M.carrier} :
    @Structure.fun_map _ M 1 RingUnaries.neg ([a]) = - a := rfl

  @[simp] lemma realize_add {a b : M.carrier} :
    @Structure.fun_map _ M 2 RingBinaries.add ([a , b]) = a + b := rfl

  @[simp] lemma realize_mul {a b : M.carrier} :
    @Structure.fun_map _ M 2 RingBinaries.mul ([a , b]) = a * b := rfl

  variable [h : fact (M ⊨ RingTheory)]

  include h
  lemma add_assoc (a b c : M) : (a + b) + c = a + (b + c) :=
  begin
    have hAssoc := h.elim AddAssocInRingTheory,
    have habc := hAssoc c b a,
    simpa using habc,
  end

  lemma add_comm (a b : M) : a + b = b + a :=
  begin
    have hId := h.elim AddCommInRingTheory, have hab := hId b a, simpa using hab
  end

  lemma add_zero (a : M) : a + 0 = a :=
  begin
    have hId := h.elim AddIdInRingTheory, have ha := hId a, simpa using ha
  end

  lemma zero_add (a : M) : 0 + a = a :=
  begin
    rw add_comm, apply add_zero,
  end

  lemma left_neg (a : M) : - a + a = 0 :=
  begin
    have hInv := h.elim AddInvInRingTheory, have ha := hInv a, simpa using ha
  end

  lemma mul_assoc (a b c : M) : (a * b) * c = a * (b * c) :=
  begin
    have hAssoc := h.elim MulAssocInRingTheory, have habc := hAssoc c b a,
    simpa using habc
  end

  lemma mul_comm (a b : M) : a * b = b * a :=
  begin
    have hId := h.elim MulCommInRingTheory, have hab := hId b a, simpa using hab
  end

  lemma mul_one (a : M) : a * 1 = a :=
  begin
    have hId := h.elim MulIdInRingTheory, have ha := hId a, simpa using ha
  end

  lemma one_mul (a : M) : 1 * a = a :=
  begin
    rw mul_comm, apply mul_one
  end

  lemma add_mul (a b c : M) : (a + b) * c = a * c + b * c :=
  begin
    have hAM := h.elim AddMulInRingTheory, have habc := hAM c b a, simpa using habc
  end

  lemma mul_add (c a b : M) : c * (a + b) = c * a + c * b :=
  begin
    rw (mul_comm c (a + b)), rw (mul_comm c a), rw (mul_comm c b),
    exact add_mul a b c,
  end

  instance CommRing : comm_ring M :=
  {
    add            := add,
    add_assoc      := add_assoc,
    zero           := zero,
    zero_add       := zero_add,
    add_zero       := add_zero,
    neg            := neg,
    add_left_neg   := left_neg,
    add_comm       := add_comm,
    mul            := mul,
    mul_assoc      := mul_assoc,
    one            := one,
    one_mul        := one_mul,
    mul_one        := mul_one,
    left_distrib   := mul_add,
    right_distrib  := add_mul,
    mul_comm       := mul_comm,
  }

end ModelTo

end Rings


import category_theory.yoneda

open category_theory

universes u v

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

@[simps] def Pprod (F G : C ⥤ Type) : C ⥤ Type :=
{ obj := λ X, F.obj X × G.obj X,
  map := λ X Y f, prod.map (F.map f) (G.map f) }

@[simps] def Pprod_lift {F G H : C ⥤ Type} (f : F ⟶ G) (g : F ⟶ H) : F ⟶ Pprod G H :=
{ app := λ X x, (f.app X x, g.app X x),
  naturality' := begin
    intros X Y n,
    have := f.naturality n,
    have := g.naturality n,
    simp only [function.funext_iff] at *,
    dsimp at *,
    intros,
    ext;
    simp *,
  end }

@[simps] def Pprod_fst {F G : C ⥤ Type} : Pprod F G ⟶ F :=
{ app := λ X x, x.fst,
  naturality' := begin
    tidy
  end }

@[simps] def Pprod_snd {F G : C ⥤ Type} : Pprod F G ⟶ G :=
{ app := λ X x, x.snd,
  naturality' := begin
    tidy
  end }

@[simp] lemma Pprod_lift_comp_fst {F G H : C ⥤ Type} (f : F ⟶ G) (g : F ⟶ H) :
  Pprod_lift f g ≫ Pprod_fst = f := by ext; refl

@[simp] lemma Pprod_lift_comp_snd {F G H : C ⥤ Type} (f : F ⟶ G) (g : F ⟶ H) :
  Pprod_lift f g ≫ Pprod_snd = g := by ext; refl

@[simps] def Pcoprod (F G : C ⥤ Type) : C ⥤ Type :=
{ obj := λ X, F.obj X ⊕ G.obj X,
  map := λ X Y f, sum.map (F.map f) (G.map f) }

@[simps] def Pcoprod_lift {F G H : C ⥤ Type} (f : F ⟶ H) (g : G ⟶ H) : Pcoprod F G ⟶ H :=
{ app := λ X x, sum.cases_on x (f.app X) (g.app X),
  naturality' := begin
    intros X Y n,
    have := f.naturality n,
    have := g.naturality n,
    simp only [function.funext_iff] at *,
    dsimp at *,
    intros x,
    cases x; dsimp; simp [*, sum.map]
  end }

@[simps] def Pcoprod_inl {F G : C ⥤ Type} : F ⟶ Pcoprod F G :=
{ app := λ X x, sum.inl x,
  naturality' := begin
    tidy
  end }

@[simps] def Pcoprod_inr {F G : C ⥤ Type} : G ⟶ Pcoprod F G :=
{ app := λ X x, sum.inr x,
  naturality' := begin
    tidy
  end }

@[simp] lemma inl_comp_Pcoprod_lift {F G H : C ⥤ Type} (f : F ⟶ H) (g : G ⟶ H) :
  Pcoprod_inl ≫ Pcoprod_lift f g = f := by ext; refl

@[simp] lemma inr_comp_Pcoprod_lift {F G H : C ⥤ Type} (f : F ⟶ H) (g : G ⟶ H) :
  Pcoprod_inr ≫ Pcoprod_lift f g = g := by ext; refl


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.default
import Mathlib.set_theory.cardinal
import Mathlib.PostPort

namespace Mathlib

namespace rat

protected instance infinite : infinite ℚ :=
  infinite.of_injective coe nat.cast_injective

protected instance denumerable : denumerable ℚ :=
  let T : Type := Subtype fun (x : ℤ × ℕ) => 0 < prod.snd x ∧ nat.coprime (int.nat_abs (prod.fst x)) (prod.snd x);
  let _inst : infinite T := sorry;
  let _inst_1 : encodable T := encodable.subtype;
  let _inst_2 : denumerable T := denumerable.of_encodable_of_infinite T;
  denumerable.of_equiv T denumerable_aux

end rat

namespace cardinal

theorem mk_rat : mk ℚ = omega :=
  iff.mp denumerable_iff (Nonempty.intro rat.denumerable)