/-
Copyright (c) 2022 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov, Yakov Pechersky, Jireh Loreaux

! This file was ported from Lean 3 source module group_theory.subsemigroup.operations
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subsemigroup.Basic
import Mathlib.Algebra.Group.Prod
import Mathlib.Algebra.Group.TypeTags

/-!
# Operations on `Subsemigroup`s

In this file we define various operations on `Subsemigroup`s and `MulHom`s.

## Main definitions

### Conversion between multiplicative and additive definitions

* `Subsemigroup.toAddSubsemigroup`, `Subsemigroup.toAddSubsemigroup'`,
  `AddSubsemigroup.toSubsemigroup`, `AddSubsemigroup.toSubsemigroup'`:
  convert between multiplicative and additive subsemigroups of `M`,
  `Multiplicative M`, and `Additive M`. These are stated as `OrderIso`s.

### (Commutative) semigroup structure on a subsemigroup

* `Subsemigroup.toSemigroup`, `Subsemigroup.toCommSemigroup`: a subsemigroup inherits a
  (commutative) semigroup structure.

### Operations on subsemigroups

* `Subsemigroup.comap`: preimage of a subsemigroup under a semigroup homomorphism as a subsemigroup
  of the domain;
* `Subsemigroup.map`: image of a subsemigroup under a semigroup homomorphism as a subsemigroup of
  the codomain;
* `Subsemigroup.prod`: product of two subsemigroups `s : Subsemigroup M` and `t : Subsemigroup N`
  as a subsemigroup of `M × N`;

### Semigroup homomorphisms between subsemigroups

* `Subsemigroup.subtype`: embedding of a subsemigroup into the ambient semigroup.
* `Subsemigroup.inclusion`: given two subsemigroups `S`, `T` such that `S ≤ T`, `S.inclusion T` is
  the inclusion of `S` into `T` as a semigroup homomorphism;
* `MulEquiv.subsemigroupCongr`: converts a proof of `S = T` into a semigroup isomorphism between
  `S` and `T`.
* `Subsemigroup.prodEquiv`: semigroup isomorphism between `s.prod t` and `s × t`;

### Operations on `mul_hom`s

* `MulHom.srange`: range of a semigroup homomorphism as a subsemigroup of the codomain;
* `MulHom.restrict`: restrict a semigroup homomorphism to a subsemigroup;
* `MulHom.codRestrict`: restrict the codomain of a semigroup homomorphism to a subsemigroup;
* `MulHom.srangeRestrict`: restrict a semigroup homomorphism to its range;

### Implementation notes

This file follows closely `GroupTheory/Submonoid/Operations.lean`, omitting only that which is
necessary.

## Tags

subsemigroup, range, product, map, comap
-/

variable {M N P σ : Type _}

/-!
### Conversion to/from `Additive`/`Multiplicative`
-/

section

variable [Mul M]

/-- Subsemigroups of semigroup `M` are isomorphic to additive subsemigroups of `Additive M`. -/
@[simps]
def Subsemigroup.toAddSubsemigroup : Subsemigroup M ≃o AddSubsemigroup (Additive M) where
  toFun S :=
    { carrier := Additive.toMul ⁻¹' S
      add_mem' := S.mul_mem' }
  invFun S :=
    { carrier := Additive.ofMul ⁻¹' S
      mul_mem' := S.add_mem' }
  left_inv _ := rfl
  right_inv _ := rfl
  map_rel_iff':= Iff.rfl
#align subsemigroup.to_add_subsemigroup Subsemigroup.toAddSubsemigroup
#align subsemigroup.to_add_subsemigroup_symm_apply_coe Subsemigroup.toAddSubsemigroup_symm_apply_coe
#align subsemigroup.to_add_subsemigroup_apply_coe Subsemigroup.toAddSubsemigroup_apply_coe

/-- Additive subsemigroups of an additive semigroup `Additive M` are isomorphic to subsemigroups
of `M`. -/
abbrev AddSubsemigroup.toSubsemigroup' : AddSubsemigroup (Additive M) ≃o Subsemigroup M :=
  Subsemigroup.toAddSubsemigroup.symm
#align add_subsemigroup.to_subsemigroup' AddSubsemigroup.toSubsemigroup'

theorem Subsemigroup.toAddSubsemigroup_closure (S : Set M) :
    Subsemigroup.toAddSubsemigroup (Subsemigroup.closure S) =
    AddSubsemigroup.closure (Additive.toMul ⁻¹' S) :=
  le_antisymm
    (Subsemigroup.toAddSubsemigroup.le_symm_apply.1 <|
      Subsemigroup.closure_le.2 (AddSubsemigroup.subset_closure (M := Additive M)))
    (AddSubsemigroup.closure_le.2 (Subsemigroup.subset_closure (M := M)))
#align subsemigroup.to_add_subsemigroup_closure Subsemigroup.toAddSubsemigroup_closure

theorem AddSubsemigroup.toSubsemigroup'_closure (S : Set (Additive M)) :
    AddSubsemigroup.toSubsemigroup' (AddSubsemigroup.closure S) =
      Subsemigroup.closure (Multiplicative.ofAdd ⁻¹' S) :=
  le_antisymm
    (AddSubsemigroup.toSubsemigroup'.le_symm_apply.1 <|
      AddSubsemigroup.closure_le.2 (Subsemigroup.subset_closure (M := M)))
    (Subsemigroup.closure_le.2 $ AddSubsemigroup.subset_closure (M := Additive M))
#align add_subsemigroup.to_subsemigroup'_closure AddSubsemigroup.toSubsemigroup'_closure

end

section

variable {A : Type _} [Add A]

/-- Additive subsemigroups of an additive semigroup `A` are isomorphic to
multiplicative subsemigroups of `Multiplicative A`. -/
@[simps]
def AddSubsemigroup.toSubsemigroup : AddSubsemigroup A ≃o Subsemigroup (Multiplicative A) where
  toFun S :=
    { carrier := Multiplicative.toAdd ⁻¹' S
      mul_mem' := S.add_mem' }
  invFun S :=
    { carrier := Multiplicative.ofAdd ⁻¹' S
      add_mem' := S.mul_mem' }
  left_inv _ := rfl
  right_inv _ := rfl
  map_rel_iff' := Iff.rfl
#align add_subsemigroup.to_subsemigroup AddSubsemigroup.toSubsemigroup
#align add_subsemigroup.to_subsemigroup_apply_coe AddSubsemigroup.toSubsemigroup_apply_coe
#align add_subsemigroup.to_subsemigroup_symm_apply_coe AddSubsemigroup.toSubsemigroup_symm_apply_coe

/-- Subsemigroups of a semigroup `Multiplicative A` are isomorphic to additive subsemigroups
of `A`. -/
abbrev Subsemigroup.toAddSubsemigroup' : Subsemigroup (Multiplicative A) ≃o AddSubsemigroup A :=
  AddSubsemigroup.toSubsemigroup.symm
#align subsemigroup.to_add_subsemigroup' Subsemigroup.toAddSubsemigroup'

theorem AddSubsemigroup.toSubsemigroup_closure (S : Set A) :
    AddSubsemigroup.toSubsemigroup (AddSubsemigroup.closure S) =
      Subsemigroup.closure (Multiplicative.toAdd ⁻¹' S) :=
  le_antisymm
    (AddSubsemigroup.toSubsemigroup.to_galoisConnection.l_le <|
      AddSubsemigroup.closure_le.2 $ Subsemigroup.subset_closure (M := Multiplicative A))
    (Subsemigroup.closure_le.2 $ AddSubsemigroup.subset_closure (M := A))
#align add_subsemigroup.to_subsemigroup_closure AddSubsemigroup.toSubsemigroup_closure

theorem Subsemigroup.toAddSubsemigroup'_closure (S : Set (Multiplicative A)) :
    Subsemigroup.toAddSubsemigroup' (Subsemigroup.closure S) =
    AddSubsemigroup.closure (Additive.ofMul ⁻¹' S) :=
  le_antisymm
    (Subsemigroup.toAddSubsemigroup'.to_galoisConnection.l_le <|
      Subsemigroup.closure_le.2 $ AddSubsemigroup.subset_closure (M := A))
    (AddSubsemigroup.closure_le.2 $ Subsemigroup.subset_closure (M := Multiplicative A))
#align subsemigroup.to_add_subsemigroup'_closure Subsemigroup.toAddSubsemigroup'_closure

end

namespace Subsemigroup

open Set

/-!
### `comap` and `map`
-/

variable [Mul M] [Mul N] [Mul P] (S : Subsemigroup M)

/-- The preimage of a subsemigroup along a semigroup homomorphism is a subsemigroup. -/
@[to_additive
      "The preimage of an `AddSubsemigroup` along an `AddSemigroup` homomorphism is an
      `AddSubsemigroup`."]
def comap (f : M →ₙ* N) (S : Subsemigroup N) :
    Subsemigroup M where
  carrier := f ⁻¹' S
  mul_mem' ha hb := show f (_ * _) ∈ S by rw [map_mul]; exact mul_mem ha hb
#align subsemigroup.comap Subsemigroup.comap
#align add_subsemigroup.comap AddSubsemigroup.comap

@[to_additive (attr := simp)]
theorem coe_comap (S : Subsemigroup N) (f : M →ₙ* N) : (S.comap f : Set M) = f ⁻¹' S :=
  rfl
#align subsemigroup.coe_comap Subsemigroup.coe_comap
#align add_subsemigroup.coe_comap AddSubsemigroup.coe_comap

@[to_additive (attr := simp)]
theorem mem_comap {S : Subsemigroup N} {f : M →ₙ* N} {x : M} : x ∈ S.comap f ↔ f x ∈ S :=
  Iff.rfl
#align subsemigroup.mem_comap Subsemigroup.mem_comap
#align add_subsemigroup.mem_comap AddSubsemigroup.mem_comap

@[to_additive]
theorem comap_comap (S : Subsemigroup P) (g : N →ₙ* P) (f : M →ₙ* N) :
    (S.comap g).comap f = S.comap (g.comp f) :=
  rfl
#align subsemigroup.comap_comap Subsemigroup.comap_comap
#align add_subsemigroup.comap_comap AddSubsemigroup.comap_comap

@[to_additive (attr := simp)]
theorem comap_id (S : Subsemigroup P) : S.comap (MulHom.id _) = S :=
  ext (by simp)
#align subsemigroup.comap_id Subsemigroup.comap_id
#align add_subsemigroup.comap_id AddSubsemigroup.comap_id

/-- The image of a subsemigroup along a semigroup homomorphism is a subsemigroup. -/
@[to_additive
      "The image of an `AddSubsemigroup` along an `AddSemigroup` homomorphism is
      an `AddSubsemigroup`."]
def map (f : M →ₙ* N) (S : Subsemigroup M) : Subsemigroup N where
  carrier := f '' S
  mul_mem' := by
    rintro _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩
    exact ⟨x * y, @mul_mem (Subsemigroup M) M _ _ _ _ _ _ hx hy, by rw [map_mul]⟩
#align subsemigroup.map Subsemigroup.map
#align add_subsemigroup.map AddSubsemigroup.map

@[to_additive (attr := simp)]
theorem coe_map (f : M →ₙ* N) (S : Subsemigroup M) : (S.map f : Set N) = f '' S :=
  rfl
#align subsemigroup.coe_map Subsemigroup.coe_map
#align add_subsemigroup.coe_map AddSubsemigroup.coe_map

@[to_additive (attr := simp)]
theorem mem_map {f : M →ₙ* N} {S : Subsemigroup M} {y : N} : y ∈ S.map f ↔ ∃ x ∈ S, f x = y :=
  mem_image _ _ _
#align subsemigroup.mem_map Subsemigroup.mem_map
#align add_subsemigroup.mem_map AddSubsemigroup.mem_map

@[to_additive]
theorem mem_map_of_mem (f : M →ₙ* N) {S : Subsemigroup M} {x : M} (hx : x ∈ S) : f x ∈ S.map f :=
  mem_image_of_mem f hx
#align subsemigroup.mem_map_of_mem Subsemigroup.mem_map_of_mem
#align add_subsemigroup.mem_map_of_mem AddSubsemigroup.mem_map_of_mem

@[to_additive]
theorem apply_coe_mem_map (f : M →ₙ* N) (S : Subsemigroup M) (x : S) : f x ∈ S.map f :=
  mem_map_of_mem f x.prop
#align subsemigroup.apply_coe_mem_map Subsemigroup.apply_coe_mem_map
#align add_subsemigroup.apply_coe_mem_map AddSubsemigroup.apply_coe_mem_map

@[to_additive]
theorem map_map (g : N →ₙ* P) (f : M →ₙ* N) : (S.map f).map g = S.map (g.comp f) :=
  SetLike.coe_injective <| image_image _ _ _
#align subsemigroup.map_map Subsemigroup.map_map
#align add_subsemigroup.map_map AddSubsemigroup.map_map

@[to_additive]
theorem mem_map_iff_mem {f : M →ₙ* N} (hf : Function.Injective f) {S : Subsemigroup M} {x : M} :
    f x ∈ S.map f ↔ x ∈ S :=
  hf.mem_set_image
#align subsemigroup.mem_map_iff_mem Subsemigroup.mem_map_iff_mem
#align add_subsemigroup.mem_map_iff_mem AddSubsemigroup.mem_map_iff_mem

@[to_additive]
theorem map_le_iff_le_comap {f : M →ₙ* N} {S : Subsemigroup M} {T : Subsemigroup N} :
    S.map f ≤ T ↔ S ≤ T.comap f :=
  image_subset_iff
#align subsemigroup.map_le_iff_le_comap Subsemigroup.map_le_iff_le_comap
#align add_subsemigroup.map_le_iff_le_comap AddSubsemigroup.map_le_iff_le_comap

@[to_additive]
theorem gc_map_comap (f : M →ₙ* N) : GaloisConnection (map f) (comap f) := fun _ _ =>
  map_le_iff_le_comap
#align subsemigroup.gc_map_comap Subsemigroup.gc_map_comap
#align add_subsemigroup.gc_map_comap AddSubsemigroup.gc_map_comap

@[to_additive]
theorem map_le_of_le_comap {T : Subsemigroup N} {f : M →ₙ* N} : S ≤ T.comap f → S.map f ≤ T :=
  (gc_map_comap f).l_le
#align subsemigroup.map_le_of_le_comap Subsemigroup.map_le_of_le_comap
#align add_subsemigroup.map_le_of_le_comap AddSubsemigroup.map_le_of_le_comap

@[to_additive]
theorem le_comap_of_map_le {T : Subsemigroup N} {f : M →ₙ* N} : S.map f ≤ T → S ≤ T.comap f :=
  (gc_map_comap f).le_u
#align subsemigroup.le_comap_of_map_le Subsemigroup.le_comap_of_map_le
#align add_subsemigroup.le_comap_of_map_le AddSubsemigroup.le_comap_of_map_le

@[to_additive]
theorem le_comap_map {f : M →ₙ* N} : S ≤ (S.map f).comap f :=
  (gc_map_comap f).le_u_l _
#align subsemigroup.le_comap_map Subsemigroup.le_comap_map
#align add_subsemigroup.le_comap_map AddSubsemigroup.le_comap_map

@[to_additive]
theorem map_comap_le {S : Subsemigroup N} {f : M →ₙ* N} : (S.comap f).map f ≤ S :=
  (gc_map_comap f).l_u_le _
#align subsemigroup.map_comap_le Subsemigroup.map_comap_le
#align add_subsemigroup.map_comap_le AddSubsemigroup.map_comap_le

@[to_additive]
theorem monotone_map {f : M →ₙ* N} : Monotone (map f) :=
  (gc_map_comap f).monotone_l
#align subsemigroup.monotone_map Subsemigroup.monotone_map
#align add_subsemigroup.monotone_map AddSubsemigroup.monotone_map

@[to_additive]
theorem monotone_comap {f : M →ₙ* N} : Monotone (comap f) :=
  (gc_map_comap f).monotone_u
#align subsemigroup.monotone_comap Subsemigroup.monotone_comap
#align add_subsemigroup.monotone_comap AddSubsemigroup.monotone_comap

@[to_additive (attr := simp)]
theorem map_comap_map {f : M →ₙ* N} : ((S.map f).comap f).map f = S.map f :=
  (gc_map_comap f).l_u_l_eq_l _
#align subsemigroup.map_comap_map Subsemigroup.map_comap_map
#align add_subsemigroup.map_comap_map AddSubsemigroup.map_comap_map

@[to_additive (attr := simp)]
theorem comap_map_comap {S : Subsemigroup N} {f : M →ₙ* N} :
    ((S.comap f).map f).comap f = S.comap f :=
  (gc_map_comap f).u_l_u_eq_u _
#align subsemigroup.comap_map_comap Subsemigroup.comap_map_comap
#align add_subsemigroup.comap_map_comap AddSubsemigroup.comap_map_comap

@[to_additive]
theorem map_sup (S T : Subsemigroup M) (f : M →ₙ* N) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
  (gc_map_comap f).l_sup
#align subsemigroup.map_sup Subsemigroup.map_sup
#align add_subsemigroup.map_sup AddSubsemigroup.map_sup

@[to_additive]
theorem map_supᵢ {ι : Sort _} (f : M →ₙ* N) (s : ι → Subsemigroup M) :
    (supᵢ s).map f = ⨆ i, (s i).map f :=
  (gc_map_comap f).l_supᵢ
#align subsemigroup.map_supr Subsemigroup.map_supᵢ
#align add_subsemigroup.map_supr AddSubsemigroup.map_supᵢ

@[to_additive]
theorem comap_inf (S T : Subsemigroup N) (f : M →ₙ* N) : (S ⊓ T).comap f = S.comap f ⊓ T.comap f :=
  (gc_map_comap f).u_inf
#align subsemigroup.comap_inf Subsemigroup.comap_inf
#align add_subsemigroup.comap_inf AddSubsemigroup.comap_inf

@[to_additive]
theorem comap_infᵢ {ι : Sort _} (f : M →ₙ* N) (s : ι → Subsemigroup N) :
    (infᵢ s).comap f = ⨅ i, (s i).comap f :=
  (gc_map_comap f).u_infᵢ
#align subsemigroup.comap_infi Subsemigroup.comap_infᵢ
#align add_subsemigroup.comap_infi AddSubsemigroup.comap_infᵢ

@[to_additive (attr := simp)]
theorem map_bot (f : M →ₙ* N) : (⊥ : Subsemigroup M).map f = ⊥ :=
  (gc_map_comap f).l_bot
#align subsemigroup.map_bot Subsemigroup.map_bot
#align add_subsemigroup.map_bot AddSubsemigroup.map_bot

@[to_additive (attr := simp)]
theorem comap_top (f : M →ₙ* N) : (⊤ : Subsemigroup N).comap f = ⊤ :=
  (gc_map_comap f).u_top
#align subsemigroup.comap_top Subsemigroup.comap_top
#align add_subsemigroup.comap_top AddSubsemigroup.comap_top

@[to_additive (attr := simp)]
theorem map_id (S : Subsemigroup M) : S.map (MulHom.id M) = S :=
  ext fun _ => ⟨fun ⟨_, h, rfl⟩ => h, fun h => ⟨_, h, rfl⟩⟩
#align subsemigroup.map_id Subsemigroup.map_id
#align add_subsemigroup.map_id AddSubsemigroup.map_id

section GaloisCoinsertion

variable {ι : Type _} {f : M →ₙ* N} (hf : Function.Injective f)

--include hf

/-- `map f` and `comap f` form a `GaloisCoinsertion` when `f` is injective. -/
@[to_additive " `map f` and `comap f` form a `GaloisCoinsertion` when `f` is injective. "]
def gciMapComap : GaloisCoinsertion (map f) (comap f) :=
  (gc_map_comap f).toGaloisCoinsertion fun S x => by simp [mem_comap, mem_map, hf.eq_iff]
#align subsemigroup.gci_map_comap Subsemigroup.gciMapComap
#align add_subsemigroup.gci_map_comap AddSubsemigroup.gciMapComap

@[to_additive]
theorem comap_map_eq_of_injective (S : Subsemigroup M) : (S.map f).comap f = S :=
  (gciMapComap hf).u_l_eq _
#align subsemigroup.comap_map_eq_of_injective Subsemigroup.comap_map_eq_of_injective
#align add_subsemigroup.comap_map_eq_of_injective AddSubsemigroup.comap_map_eq_of_injective

@[to_additive]
theorem comap_surjective_of_injective : Function.Surjective (comap f) :=
  (gciMapComap hf).u_surjective
#align subsemigroup.comap_surjective_of_injective Subsemigroup.comap_surjective_of_injective
#align add_subsemigroup.comap_surjective_of_injective AddSubsemigroup.comap_surjective_of_injective

@[to_additive]
theorem map_injective_of_injective : Function.Injective (map f) :=
  (gciMapComap hf).l_injective
#align subsemigroup.map_injective_of_injective Subsemigroup.map_injective_of_injective
#align add_subsemigroup.map_injective_of_injective AddSubsemigroup.map_injective_of_injective

@[to_additive]
theorem comap_inf_map_of_injective (S T : Subsemigroup M) : (S.map f ⊓ T.map f).comap f = S ⊓ T :=
  (gciMapComap hf).u_inf_l _ _
#align subsemigroup.comap_inf_map_of_injective Subsemigroup.comap_inf_map_of_injective
#align add_subsemigroup.comap_inf_map_of_injective AddSubsemigroup.comap_inf_map_of_injective

@[to_additive]
theorem comap_infᵢ_map_of_injective (S : ι → Subsemigroup M) :
    (⨅ i, (S i).map f).comap f = infᵢ S :=
  (gciMapComap hf).u_infᵢ_l _
#align subsemigroup.comap_infi_map_of_injective Subsemigroup.comap_infᵢ_map_of_injective
#align add_subsemigroup.comap_infi_map_of_injective AddSubsemigroup.comap_infᵢ_map_of_injective

@[to_additive]
theorem comap_sup_map_of_injective (S T : Subsemigroup M) : (S.map f ⊔ T.map f).comap f = S ⊔ T :=
  (gciMapComap hf).u_sup_l _ _
#align subsemigroup.comap_sup_map_of_injective Subsemigroup.comap_sup_map_of_injective
#align add_subsemigroup.comap_sup_map_of_injective AddSubsemigroup.comap_sup_map_of_injective

@[to_additive]
theorem comap_supᵢ_map_of_injective (S : ι → Subsemigroup M) :
    (⨆ i, (S i).map f).comap f = supᵢ S :=
  (gciMapComap hf).u_supᵢ_l _
#align subsemigroup.comap_supr_map_of_injective Subsemigroup.comap_supᵢ_map_of_injective
#align add_subsemigroup.comap_supr_map_of_injective AddSubsemigroup.comap_supᵢ_map_of_injective

@[to_additive]
theorem map_le_map_iff_of_injective {S T : Subsemigroup M} : S.map f ≤ T.map f ↔ S ≤ T :=
  (gciMapComap hf).l_le_l_iff
#align subsemigroup.map_le_map_iff_of_injective Subsemigroup.map_le_map_iff_of_injective
#align add_subsemigroup.map_le_map_iff_of_injective AddSubsemigroup.map_le_map_iff_of_injective

@[to_additive]
theorem map_strictMono_of_injective : StrictMono (map f) :=
  (gciMapComap hf).strictMono_l
#align subsemigroup.map_strict_mono_of_injective Subsemigroup.map_strictMono_of_injective
#align add_subsemigroup.map_strict_mono_of_injective AddSubsemigroup.map_strictMono_of_injective

end GaloisCoinsertion

section GaloisInsertion

variable {ι : Type _} {f : M →ₙ* N} (hf : Function.Surjective f)

/-- `map f` and `comap f` form a `GaloisInsertion` when `f` is surjective. -/
@[to_additive " `map f` and `comap f` form a `GaloisInsertion` when `f` is surjective. "]
def giMapComap : GaloisInsertion (map f) (comap f) :=
  (gc_map_comap f).toGaloisInsertion fun S x h =>
    let ⟨y, hy⟩ := hf x
    mem_map.2 ⟨y, by simp [hy, h]⟩
#align subsemigroup.gi_map_comap Subsemigroup.giMapComap
#align add_subsemigroup.gi_map_comap AddSubsemigroup.giMapComap

@[to_additive]
theorem map_comap_eq_of_surjective (S : Subsemigroup N) : (S.comap f).map f = S :=
  (giMapComap hf).l_u_eq _
#align subsemigroup.map_comap_eq_of_surjective Subsemigroup.map_comap_eq_of_surjective
#align add_subsemigroup.map_comap_eq_of_surjective AddSubsemigroup.map_comap_eq_of_surjective

@[to_additive]
theorem map_surjective_of_surjective : Function.Surjective (map f) :=
  (giMapComap hf).l_surjective
#align subsemigroup.map_surjective_of_surjective Subsemigroup.map_surjective_of_surjective
#align add_subsemigroup.map_surjective_of_surjective AddSubsemigroup.map_surjective_of_surjective

@[to_additive]
theorem comap_injective_of_surjective : Function.Injective (comap f) :=
  (giMapComap hf).u_injective
#align subsemigroup.comap_injective_of_surjective Subsemigroup.comap_injective_of_surjective
#align add_subsemigroup.comap_injective_of_surjective AddSubsemigroup.comap_injective_of_surjective

@[to_additive]
theorem map_inf_comap_of_surjective (S T : Subsemigroup N) :
    (S.comap f ⊓ T.comap f).map f = S ⊓ T :=
  (giMapComap hf).l_inf_u _ _
#align subsemigroup.map_inf_comap_of_surjective Subsemigroup.map_inf_comap_of_surjective
#align add_subsemigroup.map_inf_comap_of_surjective AddSubsemigroup.map_inf_comap_of_surjective

@[to_additive]
theorem map_infᵢ_comap_of_surjective (S : ι → Subsemigroup N) :
    (⨅ i, (S i).comap f).map f = infᵢ S :=
  (giMapComap hf).l_infᵢ_u _
#align subsemigroup.map_infi_comap_of_surjective Subsemigroup.map_infᵢ_comap_of_surjective
#align add_subsemigroup.map_infi_comap_of_surjective AddSubsemigroup.map_infᵢ_comap_of_surjective

@[to_additive]
theorem map_sup_comap_of_surjective (S T : Subsemigroup N) :
    (S.comap f ⊔ T.comap f).map f = S ⊔ T :=
  (giMapComap hf).l_sup_u _ _
#align subsemigroup.map_sup_comap_of_surjective Subsemigroup.map_sup_comap_of_surjective
#align add_subsemigroup.map_sup_comap_of_surjective AddSubsemigroup.map_sup_comap_of_surjective

@[to_additive]
theorem map_supᵢ_comap_of_surjective (S : ι → Subsemigroup N) :
    (⨆ i, (S i).comap f).map f = supᵢ S :=
  (giMapComap hf).l_supᵢ_u _
#align subsemigroup.map_supr_comap_of_surjective Subsemigroup.map_supᵢ_comap_of_surjective
#align add_subsemigroup.map_supr_comap_of_surjective AddSubsemigroup.map_supᵢ_comap_of_surjective

@[to_additive]
theorem comap_le_comap_iff_of_surjective {S T : Subsemigroup N} : S.comap f ≤ T.comap f ↔ S ≤ T :=
  (giMapComap hf).u_le_u_iff
#align subsemigroup.comap_le_comap_iff_of_surjective Subsemigroup.comap_le_comap_iff_of_surjective
#align add_subsemigroup.comap_le_comap_iff_of_surjective AddSubsemigroup.comap_le_comap_iff_of_surjective

@[to_additive]
theorem comap_strictMono_of_surjective : StrictMono (comap f) :=
  (giMapComap hf).strictMono_u
#align subsemigroup.comap_strict_mono_of_surjective Subsemigroup.comap_strictMono_of_surjective
#align add_subsemigroup.comap_strict_mono_of_surjective AddSubsemigroup.comap_strictMono_of_surjective

end GaloisInsertion

end Subsemigroup

namespace MulMemClass

variable {A : Type _} [Mul M] [SetLike A M] [hA : MulMemClass A M] (S' : A)

-- lower priority so other instances are found first
/-- A submagma of a magma inherits a multiplication. -/
@[to_additive "An additive submagma of an additive magma inherits an addition."]
instance (priority := 900) mul : Mul S' :=
  ⟨fun a b => ⟨a.1 * b.1, mul_mem a.2 b.2⟩⟩
#align mul_mem_class.has_mul MulMemClass.mul
#align add_mem_class.has_add AddMemClass.add

-- lower priority so later simp lemmas are used first; to appease simp_nf
@[to_additive (attr := simp low, norm_cast)]
theorem coe_mul (x y : S') : (↑(x * y) : M) = ↑x * ↑y :=
  rfl
#align mul_mem_class.coe_mul MulMemClass.coe_mul
#align add_mem_class.coe_add AddMemClass.coe_add

-- lower priority so later simp lemmas are used first; to appease simp_nf
@[to_additive (attr := simp low)]

@[to_additive]
theorem mul_def (x y : S') : x * y = ⟨x * y, mul_mem x.2 y.2⟩ :=
  rfl
#align mul_mem_class.mul_def MulMemClass.mul_def
#align add_mem_class.add_def AddMemClass.add_def

/-- A subsemigroup of a semigroup inherits a semigroup structure. -/
@[to_additive "An `AddSubsemigroup` of an `AddSemigroup` inherits an `AddSemigroup` structure."]
instance toSemigroup {M : Type _} [Semigroup M] {A : Type _} [SetLike A M] [MulMemClass A M]
    (S : A) : Semigroup S :=
  Subtype.coe_injective.semigroup Subtype.val fun _ _ => rfl
#align mul_mem_class.to_semigroup MulMemClass.toSemigroup
#align add_mem_class.to_add_semigroup AddMemClass.toAddSemigroup

/-- A subsemigroup of a `CommSemigroup` is a `CommSemigroup`. -/
@[to_additive "An `AddSubsemigroup` of an `AddCommSemigroup` is an `AddCommSemigroup`."]
instance toCommSemigroup {M} [CommSemigroup M] {A : Type _} [SetLike A M] [MulMemClass A M]
    (S : A) : CommSemigroup S :=
  Subtype.coe_injective.commSemigroup Subtype.val fun _ _ => rfl
#align mul_mem_class.to_comm_semigroup MulMemClass.toCommSemigroup
#align add_mem_class.to_add_comm_semigroup AddMemClass.toAddCommSemigroup

/-- The natural semigroup hom from a subsemigroup of semigroup `M` to `M`. -/
@[to_additive "The natural semigroup hom from an `AddSubsemigroup` of
`AddSubsemigroup` `M` to `M`."]
def subtype : S' →ₙ* M :=
  ⟨Subtype.val, fun _ _ => rfl⟩
#align mul_mem_class.subtype MulMemClass.subtype
#align add_mem_class.subtype AddMemClass.subtype

@[to_additive (attr := simp)]
theorem coe_subtype : (MulMemClass.subtype S' : S' → M) = Subtype.val :=
  rfl
#align mul_mem_class.coe_subtype MulMemClass.coe_subtype
#align add_mem_class.coe_subtype AddMemClass.coe_subtype

end MulMemClass

namespace Subsemigroup

variable [Mul M] [Mul N] [Mul P] (S : Subsemigroup M)

/-- The top subsemigroup is isomorphic to the semigroup. -/
@[to_additive (attr := simps)
  "The top additive subsemigroup is isomorphic to the additive semigroup."]
def topEquiv : (⊤ : Subsemigroup M) ≃* M where
  toFun x := x
  invFun x := ⟨x, mem_top x⟩
  left_inv x := x.eta _
  right_inv _ := rfl
  map_mul' _ _ := rfl
#align subsemigroup.top_equiv Subsemigroup.topEquiv
#align add_subsemigroup.top_equiv AddSubsemigroup.topEquiv
#align subsemigroup.top_equiv_symm_apply_coe Subsemigroup.topEquiv_symm_apply_coe
#align add_subsemigroup.top_equiv_symm_apply_coe AddSubsemigroup.topEquiv_symm_apply_coe
#align add_subsemigroup.top_equiv_apply AddSubsemigroup.topEquiv_apply

@[to_additive (attr := simp)]
theorem topEquiv_toMulHom :
    (topEquiv : _ ≃* M).toMulHom = MulMemClass.subtype (⊤ : Subsemigroup M) :=
  rfl
#align subsemigroup.top_equiv_to_mul_hom Subsemigroup.topEquiv_toMulHom
#align add_subsemigroup.top_equiv_to_add_hom AddSubsemigroup.topEquiv_toAddHom

/-- A subsemigroup is isomorphic to its image under an injective function -/
@[to_additive "An additive subsemigroup is isomorphic to its image under an injective function"]
noncomputable def equivMapOfInjective (f : M →ₙ* N) (hf : Function.Injective f) : S ≃* S.map f :=
  { Equiv.Set.image f S hf with map_mul' := fun _ _ => Subtype.ext (map_mul f _ _) }
#align subsemigroup.equiv_map_of_injective Subsemigroup.equivMapOfInjective
#align add_subsemigroup.equiv_map_of_injective AddSubsemigroup.equivMapOfInjective

@[to_additive (attr := simp)]
theorem coe_equivMapOfInjective_apply (f : M →ₙ* N) (hf : Function.Injective f) (x : S) :
    (equivMapOfInjective S f hf x : N) = f x :=
  rfl
#align subsemigroup.coe_equiv_map_of_injective_apply Subsemigroup.coe_equivMapOfInjective_apply
#align add_subsemigroup.coe_equiv_map_of_injective_apply AddSubsemigroup.coe_equivMapOfInjective_apply

@[to_additive (attr := simp)]
theorem closure_closure_coe_preimage {s : Set M} :
    closure ((Subtype.val : closure s → M) ⁻¹' s) = ⊤ :=
  eq_top_iff.2 fun x =>
    Subtype.recOn x fun x hx _ => by
      refine' closure_induction' _ (fun g hg => subset_closure hg) (fun g₁ g₂ hg₁ hg₂ => _) hx
      · exact Subsemigroup.mul_mem _
#align subsemigroup.closure_closure_coe_preimage Subsemigroup.closure_closure_coe_preimage
#align add_subsemigroup.closure_closure_coe_preimage AddSubsemigroup.closure_closure_coe_preimage

/-- Given `Subsemigroup`s `s`, `t` of semigroups `M`, `N` respectively, `s × t` as a subsemigroup
of `M × N`. -/
@[to_additive prod
      "Given `AddSubsemigroup`s `s`, `t` of `AddSemigroup`s `A`, `B` respectively,
      `s × t` as an `AddSubsemigroup` of `A × B`."]
def prod (s : Subsemigroup M) (t : Subsemigroup N) : Subsemigroup (M × N) where
  carrier := s ×ˢ t
  mul_mem' hp hq := ⟨s.mul_mem hp.1 hq.1, t.mul_mem hp.2 hq.2⟩
#align subsemigroup.prod Subsemigroup.prod
#align add_subsemigroup.prod AddSubsemigroup.prod

@[to_additive coe_prod]
theorem coe_prod (s : Subsemigroup M) (t : Subsemigroup N) : (s.prod t : Set (M × N)) = s ×ˢ t :=
  rfl
#align subsemigroup.coe_prod Subsemigroup.coe_prod
#align add_subsemigroup.coe_prod AddSubsemigroup.coe_prod

@[to_additive mem_prod]
theorem mem_prod {s : Subsemigroup M} {t : Subsemigroup N} {p : M × N} :
    p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t :=
  Iff.rfl
#align subsemigroup.mem_prod Subsemigroup.mem_prod
#align add_subsemigroup.mem_prod AddSubsemigroup.mem_prod

@[to_additive prod_mono]
theorem prod_mono {s₁ s₂ : Subsemigroup M} {t₁ t₂ : Subsemigroup N} (hs : s₁ ≤ s₂) (ht : t₁ ≤ t₂) :
    s₁.prod t₁ ≤ s₂.prod t₂ :=
  Set.prod_mono hs ht
#align subsemigroup.prod_mono Subsemigroup.prod_mono
#align add_subsemigroup.prod_mono AddSubsemigroup.prod_mono

@[to_additive prod_top]
theorem prod_top (s : Subsemigroup M) : s.prod (⊤ : Subsemigroup N) = s.comap (MulHom.fst M N) :=
  ext fun x => by simp [mem_prod, MulHom.coe_fst]
#align subsemigroup.prod_top Subsemigroup.prod_top
#align add_subsemigroup.prod_top AddSubsemigroup.prod_top

@[to_additive top_prod]
theorem top_prod (s : Subsemigroup N) : (⊤ : Subsemigroup M).prod s = s.comap (MulHom.snd M N) :=
  ext fun x => by simp [mem_prod, MulHom.coe_snd]
#align subsemigroup.top_prod Subsemigroup.top_prod
#align add_subsemigroup.top_prod AddSubsemigroup.top_prod

@[to_additive (attr := simp) top_prod_top]
theorem top_prod_top : (⊤ : Subsemigroup M).prod (⊤ : Subsemigroup N) = ⊤ :=
  (top_prod _).trans <| comap_top _
#align subsemigroup.top_prod_top Subsemigroup.top_prod_top
#align add_subsemigroup.top_prod_top AddSubsemigroup.top_prod_top

@[to_additive bot_prod_bot]
theorem bot_prod_bot : (⊥ : Subsemigroup M).prod (⊥ : Subsemigroup N) = ⊥ :=
  SetLike.coe_injective <| by simp [coe_prod, Prod.one_eq_mk]
#align subsemigroup.bot_prod_bot Subsemigroup.bot_prod_bot
#align add_subsemigroup.bot_sum_bot AddSubsemigroup.bot_prod_bot

/-- The product of subsemigroups is isomorphic to their product as semigroups. -/
@[to_additive prodEquiv
    "The product of additive subsemigroups is isomorphic to their product as additive semigroups"]
def prodEquiv (s : Subsemigroup M) (t : Subsemigroup N) : s.prod t ≃* s × t :=
  { (Equiv.Set.prod (s : Set M) (t : Set N)) with
    map_mul' := fun _ _ => rfl }
#align subsemigroup.prod_equiv Subsemigroup.prodEquiv
#align add_subsemigroup.prod_equiv AddSubsemigroup.prodEquiv

open MulHom

@[to_additive]
theorem mem_map_equiv {f : M ≃* N} {K : Subsemigroup M} {x : N} :
    x ∈ K.map f.toMulHom ↔ f.symm x ∈ K :=
  @Set.mem_image_equiv _ _ (K : Set M) f.toEquiv x
#align subsemigroup.mem_map_equiv Subsemigroup.mem_map_equiv
#align add_subsemigroup.mem_map_equiv AddSubsemigroup.mem_map_equiv

@[to_additive]
theorem map_equiv_eq_comap_symm (f : M ≃* N) (K : Subsemigroup M) :
    K.map f.toMulHom = K.comap f.symm.toMulHom :=
  SetLike.coe_injective (f.toEquiv.image_eq_preimage K)
#align subsemigroup.map_equiv_eq_comap_symm Subsemigroup.map_equiv_eq_comap_symm
#align add_subsemigroup.map_equiv_eq_comap_symm AddSubsemigroup.map_equiv_eq_comap_symm

@[to_additive]
theorem comap_equiv_eq_map_symm (f : N ≃* M) (K : Subsemigroup M) :
    K.comap f.toMulHom = K.map f.symm.toMulHom :=
  (map_equiv_eq_comap_symm f.symm K).symm
#align subsemigroup.comap_equiv_eq_map_symm Subsemigroup.comap_equiv_eq_map_symm
#align add_subsemigroup.comap_equiv_eq_map_symm AddSubsemigroup.comap_equiv_eq_map_symm

@[to_additive (attr := simp)]
theorem map_equiv_top (f : M ≃* N) : (⊤ : Subsemigroup M).map f.toMulHom = ⊤ :=
  SetLike.coe_injective <| Set.image_univ.trans f.surjective.range_eq
#align subsemigroup.map_equiv_top Subsemigroup.map_equiv_top
#align add_subsemigroup.map_equiv_top AddSubsemigroup.map_equiv_top

@[to_additive le_prod_iff]
theorem le_prod_iff {s : Subsemigroup M} {t : Subsemigroup N} {u : Subsemigroup (M × N)} :
    u ≤ s.prod t ↔ u.map (fst M N) ≤ s ∧ u.map (snd M N) ≤ t := by
  constructor
  · intro h
    constructor
    · rintro x ⟨⟨y1, y2⟩, ⟨hy1, rfl⟩⟩
      exact (h hy1).1
    · rintro x ⟨⟨y1, y2⟩, ⟨hy1, rfl⟩⟩
      exact (h hy1).2
  · rintro ⟨hH, hK⟩ ⟨x1, x2⟩ h
    exact ⟨hH ⟨_, h, rfl⟩, hK ⟨_, h, rfl⟩⟩
#align subsemigroup.le_prod_iff Subsemigroup.le_prod_iff
#align add_subsemigroup.le_prod_iff AddSubsemigroup.le_prod_iff

end Subsemigroup

namespace MulHom

open Subsemigroup

variable [Mul M] [Mul N] [Mul P] (S : Subsemigroup M)

/-- The range of a semigroup homomorphism is a subsemigroup. See Note [range copy pattern]. -/
@[to_additive "The range of an `AddHom` is an `AddSubsemigroup`."]
def srange (f : M →ₙ* N) : Subsemigroup N :=
  ((⊤ : Subsemigroup M).map f).copy (Set.range f) Set.image_univ.symm
#align mul_hom.srange MulHom.srange
#align add_hom.srange AddHom.srange

@[to_additive (attr := simp)]
theorem coe_srange (f : M →ₙ* N) : (f.srange : Set N) = Set.range f :=
  rfl
#align mul_hom.coe_srange MulHom.coe_srange
#align add_hom.coe_srange AddHom.coe_srange

@[to_additive (attr := simp)]
theorem mem_srange {f : M →ₙ* N} {y : N} : y ∈ f.srange ↔ ∃ x, f x = y :=
  Iff.rfl
#align mul_hom.mem_srange MulHom.mem_srange
#align add_hom.mem_srange AddHom.mem_srange

@[to_additive]
theorem srange_eq_map (f : M →ₙ* N) : f.srange = (⊤ : Subsemigroup M).map f :=
  copy_eq _
#align mul_hom.srange_eq_map MulHom.srange_eq_map
#align add_hom.srange_eq_map AddHom.srange_eq_map

@[to_additive]
theorem map_srange (g : N →ₙ* P) (f : M →ₙ* N) : f.srange.map g = (g.comp f).srange := by
  simpa only [srange_eq_map] using (⊤ : Subsemigroup M).map_map g f
#align mul_hom.map_srange MulHom.map_srange
#align add_hom.map_srange AddHom.map_srange

@[to_additive]
theorem srange_top_iff_surjective {N} [Mul N] {f : M →ₙ* N} :
    f.srange = (⊤ : Subsemigroup N) ↔ Function.Surjective f :=
  SetLike.ext'_iff.trans <| Iff.trans (by rw [coe_srange, coe_top]) Set.range_iff_surjective
#align mul_hom.srange_top_iff_surjective MulHom.srange_top_iff_surjective
#align add_hom.srange_top_iff_surjective AddHom.srange_top_iff_surjective

/-- The range of a surjective semigroup hom is the whole of the codomain. -/
@[to_additive "The range of a surjective `add_semigroup` hom is the whole of the codomain."]
theorem srange_top_of_surjective {N} [Mul N] (f : M →ₙ* N) (hf : Function.Surjective f) :
    f.srange = (⊤ : Subsemigroup N) :=
  srange_top_iff_surjective.2 hf
#align mul_hom.srange_top_of_surjective MulHom.srange_top_of_surjective
#align add_hom.srange_top_of_surjective AddHom.srange_top_of_surjective

@[to_additive]
theorem mclosure_preimage_le (f : M →ₙ* N) (s : Set N) : closure (f ⁻¹' s) ≤ (closure s).comap f :=
  closure_le.2 fun _ hx => SetLike.mem_coe.2 <| mem_comap.2 <| subset_closure hx
#align mul_hom.mclosure_preimage_le MulHom.mclosure_preimage_le
#align add_hom.mclosure_preimage_le AddHom.mclosure_preimage_le

/-- The image under a semigroup hom of the subsemigroup generated by a set equals the subsemigroup
generated by the image of the set. -/
@[to_additive
      "The image under an `AddSemigroup` hom of the `AddSubsemigroup` generated by a set
      equals the `AddSubsemigroup` generated by the image of the set."]
theorem map_mclosure (f : M →ₙ* N) (s : Set M) : (closure s).map f = closure (f '' s) :=
  le_antisymm
    (map_le_iff_le_comap.2 <|
      le_trans (closure_mono <| Set.subset_preimage_image _ _) (mclosure_preimage_le _ _))
    (closure_le.2 <| Set.image_subset _ subset_closure)
#align mul_hom.map_mclosure MulHom.map_mclosure
#align add_hom.map_mclosure AddHom.map_mclosure

/-- Restriction of a semigroup hom to a subsemigroup of the domain. -/
@[to_additive "Restriction of an AddSemigroup hom to an `AddSubsemigroup` of the domain."]
def restrict {N : Type _} [Mul N] [SetLike σ M] [MulMemClass σ M] (f : M →ₙ* N) (S : σ) : S →ₙ* N :=
  f.comp (MulMemClass.subtype S)
#align mul_hom.restrict MulHom.restrict
#align add_hom.restrict AddHom.restrict

@[to_additive (attr := simp)]
theorem restrict_apply {N : Type _} [Mul N] [SetLike σ M] [MulMemClass σ M] (f : M →ₙ* N) {S : σ}
    (x : S) : f.restrict S x = f x :=
  rfl
#align mul_hom.restrict_apply MulHom.restrict_apply
#align add_hom.restrict_apply AddHom.restrict_apply

/-- Restriction of a semigroup hom to a subsemigroup of the codomain. -/
@[to_additive (attr := simps)
  "Restriction of an `AddSemigroup` hom to an `AddSubsemigroup` of the codomain."]
def codRestrict [SetLike σ N] [MulMemClass σ N] (f : M →ₙ* N) (S : σ) (h : ∀ x, f x ∈ S) :
    M →ₙ* S where
  toFun n := ⟨f n, h n⟩
  map_mul' x y := Subtype.eq (map_mul f x y)
#align mul_hom.cod_restrict MulHom.codRestrict
#align add_hom.cod_restrict AddHom.codRestrict
#align mul_hom.cod_restrict_apply_coe MulHom.codRestrict_apply_coe
#align add_hom.cod_restrict_apply_coe AddHom.codRestrict_apply_coe

/-- Restriction of a semigroup hom to its range interpreted as a subsemigroup. -/
@[to_additive "Restriction of an `AddSemigroup` hom to its range interpreted as a subsemigroup."]
def srangeRestrict {N} [Mul N] (f : M →ₙ* N) : M →ₙ* f.srange :=
  (f.codRestrict f.srange) fun x => ⟨x, rfl⟩
#align mul_hom.srange_restrict MulHom.srangeRestrict
#align add_hom.srange_restrict AddHom.srangeRestrict

@[to_additive (attr := simp)]
theorem coe_srangeRestrict {N} [Mul N] (f : M →ₙ* N) (x : M) : (f.srangeRestrict x : N) = f x :=
  rfl
#align mul_hom.coe_srange_restrict MulHom.coe_srangeRestrict
#align add_hom.coe_srange_restrict AddHom.coe_srangeRestrict

@[to_additive]
theorem srangeRestrict_surjective (f : M →ₙ* N) : Function.Surjective f.srangeRestrict :=
  fun ⟨_, ⟨x, rfl⟩⟩ => ⟨x, rfl⟩
#align mul_hom.srange_restrict_surjective MulHom.srangeRestrict_surjective
#align add_hom.srange_restrict_surjective AddHom.srangeRestrict_surjective

@[to_additive prod_map_comap_prod']
theorem prod_map_comap_prod' {M' : Type _} {N' : Type _} [Mul M'] [Mul N'] (f : M →ₙ* N)
    (g : M' →ₙ* N') (S : Subsemigroup N) (S' : Subsemigroup N') :
    (S.prod S').comap (prodMap f g) = (S.comap f).prod (S'.comap g) :=
  SetLike.coe_injective <| Set.preimage_prod_map_prod f g _ _
#align mul_hom.prod_map_comap_prod' MulHom.prod_map_comap_prod'
#align add_hom.sum_map_comap_sum' AddHom.prod_map_comap_prod'

/-- The `MulHom` from the preimage of a subsemigroup to itself. -/
@[to_additive (attr := simps)
  "The `AddHom` from the preimage of an additive subsemigroup to itself."]
def subsemigroupComap (f : M →ₙ* N) (N' : Subsemigroup N) :
    N'.comap f →ₙ* N' where
  toFun x := ⟨f x, x.prop⟩
  map_mul' x y := Subtype.eq (@map_mul M N _ _ _ _ f x y)
#align mul_hom.subsemigroup_comap MulHom.subsemigroupComap
#align add_hom.subsemigroup_comap AddHom.subsemigroupComap
#align mul_hom.subsemigroup_comap_apply_coe MulHom.subsemigroupComap_apply_coe
#align add_hom.add_subsemigroup_comap_apply_coe AddHom.subsemigroupComap_apply_coe

/-- The `MulHom` from a subsemigroup to its image.
See `MulEquiv.subsemigroupMap` for a variant for `MulEquiv`s. -/
@[to_additive (attr := simps)
      "the `AddHom` from an additive subsemigroup to its image. See
      `AddEquiv.addSubsemigroupMap` for a variant for `AddEquiv`s."]
def subsemigroupMap (f : M →ₙ* N) (M' : Subsemigroup M) :
    M' →ₙ* M'.map f where
  toFun x := ⟨f x, ⟨x, x.prop, rfl⟩⟩
  map_mul' x y := Subtype.eq <| @map_mul M N _ _ _ _ f x y
#align mul_hom.subsemigroup_map MulHom.subsemigroupMap
#align add_hom.subsemigroup_map AddHom.subsemigroupMap
#align mul_hom.subsemigroup_map_apply_coe MulHom.subsemigroupMap_apply_coe
#align add_hom.subsemigroup_map_apply_coe AddHom.subsemigroupMap_apply_coe

@[to_additive]
theorem subsemigroupMap_surjective (f : M →ₙ* N) (M' : Subsemigroup M) :
    Function.Surjective (f.subsemigroupMap M') := by
  rintro ⟨_, x, hx, rfl⟩
  exact ⟨⟨x, hx⟩, rfl⟩
#align mul_hom.subsemigroup_map_surjective MulHom.subsemigroupMap_surjective
#align add_hom.subsemigroup_map_surjective AddHom.subsemigroupMap_surjective

end MulHom

namespace Subsemigroup

open MulHom

variable [Mul M] [Mul N] [Mul P] (S : Subsemigroup M)

@[to_additive (attr := simp)]
theorem srange_fst [Nonempty N] : (fst M N).srange = ⊤ :=
  (fst M N).srange_top_of_surjective <| Prod.fst_surjective
#align subsemigroup.srange_fst Subsemigroup.srange_fst
#align add_subsemigroup.srange_fst AddSubsemigroup.srange_fst

@[to_additive (attr := simp)]
theorem srange_snd [Nonempty M] : (snd M N).srange = ⊤ :=
  (snd M N).srange_top_of_surjective <| Prod.snd_surjective
#align subsemigroup.srange_snd Subsemigroup.srange_snd
#align add_subsemigroup.srange_snd AddSubsemigroup.srange_snd

@[to_additive prod_eq_top_iff]
theorem prod_eq_top_iff [Nonempty M] [Nonempty N] {s : Subsemigroup M} {t : Subsemigroup N} :
    s.prod t = ⊤ ↔ s = ⊤ ∧ t = ⊤ := by
  simp only [eq_top_iff, le_prod_iff, ← (gc_map_comap _).le_iff_le, ← srange_eq_map, srange_fst,
    srange_snd]
#align subsemigroup.prod_eq_top_iff Subsemigroup.prod_eq_top_iff
#align add_subsemigroup.sum_eq_top_iff AddSubsemigroup.prod_eq_top_iff

/-- The semigroup hom associated to an inclusion of subsemigroups. -/
@[to_additive "The `AddSemigroup` hom associated to an inclusion of subsemigroups."]
def inclusion {S T : Subsemigroup M} (h : S ≤ T) : S →ₙ* T :=
  (MulMemClass.subtype S).codRestrict _ fun x => h x.2
#align subsemigroup.inclusion Subsemigroup.inclusion
#align add_subsemigroup.inclusion AddSubsemigroup.inclusion

@[to_additive (attr := simp)]
theorem range_subtype (s : Subsemigroup M) : (MulMemClass.subtype s).srange = s :=
  SetLike.coe_injective <| (coe_srange _).trans <| Subtype.range_coe
#align subsemigroup.range_subtype Subsemigroup.range_subtype
#align add_subsemigroup.range_subtype AddSubsemigroup.range_subtype

@[to_additive]
theorem eq_top_iff' : S = ⊤ ↔ ∀ x : M, x ∈ S :=
  eq_top_iff.trans ⟨fun h m => h <| mem_top m, fun h m _ => h m⟩
#align subsemigroup.eq_top_iff' Subsemigroup.eq_top_iff'
#align add_subsemigroup.eq_top_iff' AddSubsemigroup.eq_top_iff'

end Subsemigroup

namespace MulEquiv

variable [Mul M] [Mul N] {S T : Subsemigroup M}

/-- Makes the identity isomorphism from a proof that two subsemigroups of a multiplicative
    semigroup are equal. -/
@[to_additive
      "Makes the identity additive isomorphism from a proof two
      subsemigroups of an additive semigroup are equal."]
def subsemigroupCongr (h : S = T) : S ≃* T :=
  { Equiv.setCongr <| congr_arg _ h with map_mul' := fun _ _ => rfl }
#align mul_equiv.subsemigroup_congr MulEquiv.subsemigroupCongr
#align add_equiv.subsemigroup_congr AddEquiv.subsemigroupCongr

-- this name is primed so that the version to `f.range` instead of `f.srange` can be unprimed.
/-- A semigroup homomorphism `f : M →ₙ* N` with a left-inverse `g : N → M` defines a multiplicative
equivalence between `M` and `f.srange`.

This is a bidirectional version of `MulHom.srangeRestrict`. -/
@[to_additive (attr := simps (config := { simpRhs := true }))
      "An additive semigroup homomorphism `f : M →+ N` with a left-inverse
      `g : N → M` defines an additive equivalence between `M` and `f.srange`.
      This is a bidirectional version of `AddHom.srangeRestrict`. "]
def ofLeftInverse (f : M →ₙ* N) {g : N → M} (h : Function.LeftInverse g f) : M ≃* f.srange :=
  { f.srangeRestrict with
    toFun := f.srangeRestrict
    invFun := g ∘ MulMemClass.subtype f.srange
    left_inv := h
    right_inv := fun x =>
      Subtype.ext <|
        let ⟨x', hx'⟩ := MulHom.mem_srange.mp x.prop
        show f (g x) = x by rw [← hx', h x'] }
#align mul_equiv.of_left_inverse MulEquiv.ofLeftInverse
#align add_equiv.of_left_inverse AddEquiv.ofLeftInverse
#align mul_equiv.of_left_inverse_apply MulEquiv.ofLeftInverse_apply
#align add_equiv.of_left_inverse_apply AddEquiv.ofLeftInverse_apply
#align mul_equiv.of_left_inverse_symm_apply MulEquiv.ofLeftInverse_symm_apply
#align add_equiv.of_left_inverse_symm_apply AddEquiv.ofLeftInverse_symm_apply

/-- A `MulEquiv` `φ` between two semigroups `M` and `N` induces a `MulEquiv` between
a subsemigroup `S ≤ M` and the subsemigroup `φ(S) ≤ N`.
See `MulHom.subsemigroupMap` for a variant for `MulHom`s. -/
@[to_additive (attr := simps)
      "An `AddEquiv` `φ` between two additive semigroups `M` and `N` induces an `AddEquiv`
      between a subsemigroup `S ≤ M` and the subsemigroup `φ(S) ≤ N`.
      See `AddHom.addSubsemigroupMap` for a variant for `AddHom`s."]
def subsemigroupMap (e : M ≃* N) (S : Subsemigroup M) : S ≃* S.map e.toMulHom :=
  { -- we restate this for `simps` to avoid `⇑e.symm.toEquiv x`
    e.toMulHom.subsemigroupMap S,
    e.toEquiv.image S with
    toFun := fun x => ⟨e x, _⟩
    invFun := fun x => ⟨e.symm x, _⟩ }
#align mul_equiv.subsemigroup_map MulEquiv.subsemigroupMap
#align add_equiv.subsemigroup_map AddEquiv.subsemigroupMap
#align mul_equiv.subsemigroup_map_apply_coe MulEquiv.subsemigroupMap_apply_coe
#align add_equiv.subsemigroup_map_apply_coe AddEquiv.subsemigroupMap_apply_coe
#align mul_equiv.subsemigroup_map_symm_apply_coe MulEquiv.subsemigroupMap_symm_apply_coe
#align add_equiv.subsemigroup_map_symm_apply_coe AddEquiv.subsemigroupMap_symm_apply_coe

end MulEquiv


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

/-! # Pointwise instances on `subgroup` and `add_subgroup`s

This file provides the actions

* `subgroup.pointwise_mul_action`
* `add_subgroup.pointwise_mul_action`

which matches the action of `mul_action_set`.

These actions are available in the `pointwise` locale.

## Implementation notes

This file is almost identical to `group_theory/submonoid/pointwise.lean`. Where possible, try to
keep them in sync.
-/

variables {α : Type*} {G : Type*} {A : Type*} [group G] [add_group A]

namespace subgroup

section monoid
variables [monoid α] [mul_distrib_mul_action α G]

/-- The action on a subgroup corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (subgroup G) :=
{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] subgroup.pointwise_mul_action" in pointwise
open_locale pointwise

lemma pointwise_smul_def {a : α} (S : subgroup G) :
  a • S = S.map (mul_distrib_mul_action.to_monoid_End _ _ a) := rfl

@[simp] lemma coe_pointwise_smul (a : α) (S : subgroup G) : ↑(a • S) = a • (S : set G) := rfl

@[simp] lemma pointwise_smul_to_submonoid (a : α) (S : subgroup G) :
  (a • S).to_submonoid = a • S.to_submonoid := rfl

lemma smul_mem_pointwise_smul (m : G) (a : α) (S : subgroup G) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set G))

lemma mem_smul_pointwise_iff_exists (m : G) (a : α) (S : subgroup G) :
  m ∈ a • S ↔ ∃ (s : G), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set G) ↔ _)

instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ G] [is_central_scalar α G] :
  is_central_scalar α (subgroup G) :=
⟨λ a S, congr_arg (λ f, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [mul_distrib_mul_action α G]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : subgroup G} {x : G} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : subgroup G} {x : G} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : subgroup G} {x : G} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : subgroup G} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : α} {S T : subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : α} {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

/-- Applying a `mul_distrib_mul_action` results in an isomorphic subgroup -/
@[simps] def equiv_smul (a : α) (H : subgroup G) : H ≃* (a • H : subgroup G) :=
(mul_distrib_mul_action.to_mul_equiv G a).subgroup_map H

end group

section group_with_zero
variables [group_with_zero α] [mul_distrib_mul_action α G]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : subgroup G)
  (x : G) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set G) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : subgroup G) (x : G) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set G) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : subgroup G) (x : G) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set G) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end subgroup

namespace add_subgroup

section monoid
variables [monoid α] [distrib_mul_action α A]

/-- The action on an additive subgroup corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (add_subgroup A) :=
{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] add_subgroup.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : add_subgroup A) : ↑(a • S) = a • (S : set A) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : add_subgroup A) :
  (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl

lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_subgroup A) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))

lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_subgroup A) :
  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)

instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ A] [is_central_scalar α A] :
  is_central_scalar α (add_subgroup A) :=
⟨λ a S, congr_arg (λ f, S.map f) $ add_monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : add_subgroup A} {x : A} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_subgroup A} {x : A} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : add_subgroup A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : add_subgroup A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_le_iff {a : α} {S T : add_subgroup A} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma le_pointwise_smul_iff {a : α} {S T : add_subgroup A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A)
  (x : A) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set A) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A) (x : A) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set A) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A) (x : A) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set A) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end add_subgroup


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

From: https://github.com/leanprover-community/mathlib/blob/master/src/algebra/decomposition.lean
-/
import algebra.direct_sum.module
import algebra.module.submodule.basic

/-!
# Decompositions of additive monoids, groups, and modules into direct sums

## Main definitions

* `direct_sum.decomposition ℳ`: A typeclass to provide a constructive decomposition from
  an additive monoid `M` into a family of additive submonoids `ℳ`
* `direct_sum.decompose ℳ`: The canonical equivalence provided by the above typeclass

## Main statements

* `direct_sum.decomposition.is_internal`: The link to `direct_sum.is_internal`.

## Implementation details

As we want to talk about different types of decomposition (additive monoids, modules, rings, ...),
we choose to avoid heavily bundling `direct_sum.decompose`, instead making copies for the
`add_equiv`, `linear_equiv`, etc. This means we have to repeat statements that follow from these
bundled homs, but means we don't have to repeat statements for different types of decomposition.
-/

variables {ι R M σ : Type*}
open_locale direct_sum big_operators
namespace direct_sum

section add_comm_monoid
variables [decidable_eq ι] [add_comm_monoid M]
variables [set_like σ M] [add_submonoid_class σ M] (ℳ : ι → σ)

/-- A decomposition is an equivalence between an additive monoid `M` and a direct sum of additive
submonoids `ℳ i` of that `M`, such that the "recomposition" is canonical. This definition also
works for additive groups and modules.

This is a version of `direct_sum.is_internal` which comes with a constructive inverse to the
canonical "recomposition" rather than just a proof that the "recomposition" is bijective. -/
class decomposition :=
(decompose' : M → ⨁ i, ℳ i)
(left_inv : function.left_inverse (direct_sum.coe_add_monoid_hom ℳ) decompose' )
(right_inv : function.right_inverse (direct_sum.coe_add_monoid_hom ℳ) decompose')

include M

/-- `direct_sum.decomposition` instances, while carrying data, are always equal. -/
instance : subsingleton (decomposition ℳ) :=
⟨λ x y, begin
  cases x with x xl xr,
  cases y with y yl yr,
  congr',
  exact function.left_inverse.eq_right_inverse xr yl,
end⟩

variables [decomposition ℳ]

protected lemma decomposition.is_internal : direct_sum.is_internal ℳ :=
⟨decomposition.right_inv.injective, decomposition.left_inv.surjective⟩

/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as
to a direct sum of components. This is the canonical spelling of the `decompose'` field. -/
def decompose : M ≃ ⨁ i, ℳ i :=
{ to_fun := decomposition.decompose',
  inv_fun := direct_sum.coe_add_monoid_hom ℳ,
  left_inv := decomposition.left_inv,
  right_inv := decomposition.right_inv }

@[simp] lemma decomposition.decompose'_eq : decomposition.decompose' = decompose ℳ := rfl

@[simp] lemma decompose_symm_of {i : ι} (x : ℳ i) :
  (decompose ℳ).symm (direct_sum.of _ i x) = x :=
direct_sum.coe_add_monoid_hom_of ℳ _ _

@[simp] lemma decompose_coe {i : ι} (x : ℳ i) :
  decompose ℳ (x : M) = direct_sum.of _ i x :=
by rw [←decompose_symm_of, equiv.apply_symm_apply]

lemma decompose_of_mem {x : M} {i : ι} (hx : x ∈ ℳ i) :
  decompose ℳ x = direct_sum.of (λ i, ℳ i) i ⟨x, hx⟩ :=
decompose_coe _ ⟨x, hx⟩

lemma decompose_of_mem_same {x : M} {i : ι} (hx : x ∈ ℳ i) :
  (decompose ℳ x i : M) = x :=
by rw [decompose_of_mem _ hx, direct_sum.of_eq_same, subtype.coe_mk]

lemma decompose_of_mem_ne {x : M} {i j : ι} (hx : x ∈ ℳ i) (hij : i ≠ j):
  (decompose ℳ x j : M) = 0 :=
by rw [decompose_of_mem _ hx, direct_sum.of_eq_of_ne _ _ _ _ hij,
  add_submonoid_class.coe_zero]

/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as
an additive monoid to a direct sum of components. -/
@[simps {fully_applied := ff}]
def decompose_add_equiv : M ≃+ ⨁ i, ℳ i := add_equiv.symm
{ map_add' := map_add (direct_sum.coe_add_monoid_hom ℳ),
  ..(decompose ℳ).symm }

@[simp] lemma decompose_zero : decompose ℳ (0 : M) = 0 := map_zero (decompose_add_equiv ℳ)
@[simp] lemma decompose_symm_zero : (decompose ℳ).symm 0 = (0 : M) :=
map_zero (decompose_add_equiv ℳ).symm

@[simp] lemma decompose_add (x y : M) : decompose ℳ (x + y) = decompose ℳ x + decompose ℳ y :=
map_add (decompose_add_equiv ℳ) x y
@[simp] lemma decompose_symm_add (x y : ⨁ i, ℳ i) :
  (decompose ℳ).symm (x + y) = (decompose ℳ).symm x + (decompose ℳ).symm y :=
map_add (decompose_add_equiv ℳ).symm x y

@[simp] lemma decompose_sum {ι'} (s : finset ι') (f : ι' → M) :
  decompose ℳ (∑ i in s, f i) = ∑ i in s, decompose ℳ (f i) :=
map_sum (decompose_add_equiv ℳ) f s
@[simp] lemma decompose_symm_sum {ι'} (s : finset ι') (f : ι' → ⨁ i, ℳ i) :
  (decompose ℳ).symm (∑ i in s, f i) = ∑ i in s, (decompose ℳ).symm (f i) :=
map_sum (decompose_add_equiv ℳ).symm f s

lemma sum_support_decompose [Π i (x : ℳ i), decidable (x ≠ 0)] (r : M) :
  ∑ i in (decompose ℳ r).support, (decompose ℳ r i : M) = r :=
begin
  conv_rhs { rw [←(decompose ℳ).symm_apply_apply r,
    ←sum_support_of (λ i, (ℳ i)) (decompose ℳ r)] },
  rw [decompose_symm_sum],
  simp_rw decompose_symm_of,
end

end add_comm_monoid

/-- The `-` in the statements below doesn't resolve without this line.

This seems to a be a problem of synthesized vs inferred typeclasses disagreeing. If we replace
the statement of `decompose_neg` with `@eq (⨁ i, ℳ i) (decompose ℳ (-x)) (-decompose ℳ x)`
instead of `decompose ℳ (-x) = -decompose ℳ x`, which forces the typeclasses needed by `⨁ i, ℳ i` to
be found by unification rather than synthesis, then everything works fine without this instance. -/
instance add_comm_group_set_like [add_comm_group M] [set_like σ M] [add_subgroup_class σ M]
  (ℳ : ι → σ) : add_comm_group (⨁ i, ℳ i) := by apply_instance

section add_comm_group
variables [decidable_eq ι] [add_comm_group M]
variables [set_like σ M] [add_subgroup_class σ M] (ℳ : ι → σ)
variables [decomposition ℳ]
include M

@[simp] lemma decompose_neg (x : M) : decompose ℳ (-x) = -decompose ℳ x :=
map_neg (decompose_add_equiv ℳ) x
@[simp] lemma decompose_symm_neg (x : ⨁ i, ℳ i) :
  (decompose ℳ).symm (-x) = -(decompose ℳ).symm x :=
map_neg (decompose_add_equiv ℳ).symm x

@[simp] lemma decompose_sub (x y : M) : decompose ℳ (x - y) = decompose ℳ x - decompose ℳ y :=
map_sub (decompose_add_equiv ℳ) x y
@[simp] lemma decompose_symm_sub (x y : ⨁ i, ℳ i) :
  (decompose ℳ).symm (x - y) = (decompose ℳ).symm x - (decompose ℳ).symm y :=
map_sub (decompose_add_equiv ℳ).symm x y

end add_comm_group

section module
variables [decidable_eq ι] [semiring R] [add_comm_monoid M] [module R M]
variables (ℳ : ι → submodule R M)
variables [decomposition ℳ]
include M

/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as
a module to a direct sum of components. -/
@[simps {fully_applied := ff}]
def decompose_linear_equiv : M ≃ₗ[R] ⨁ i, ℳ i := linear_equiv.symm
{ map_smul' := map_smul (direct_sum.coe_linear_map ℳ),
  ..(decompose_add_equiv ℳ).symm }

@[simp] lemma decompose_smul (r : R) (x : M) : decompose ℳ (r • x) = r • decompose ℳ x :=
map_smul (decompose_linear_equiv ℳ) r x

end module

end direct_sum


import .transfer_mathlib

inductive xnat : Type
| zero : xnat
| succ : xnat → xnat

instance : has_zero xnat := ⟨xnat.zero⟩
instance : has_one xnat := ⟨xnat.succ 0⟩

def to_xnat : ℕ → xnat
| 0 := 0
| (nat.succ n) := (to_xnat n).succ

def of_xnat : xnat → ℕ
| 0 := 0
| (xnat.succ n) := (of_xnat n).succ

theorem to_of_xnat : ∀ n, (to_xnat (of_xnat n)) = n
| 0 := rfl
| (xnat.succ n) := congr_arg xnat.succ (to_of_xnat n)

theorem of_to_xnat : ∀ n, (of_xnat (to_xnat n)) = n
| 0 := rfl
| (nat.succ n) := congr_arg nat.succ (of_to_xnat n)

def rel (x : xnat) (n : ℕ) : Prop := to_xnat n = x

lemma rel_zero : rel 0 0 := eq.refl _

run_cmd do rds ← transfer.analyse_decls
  [``rel_zero],
    rds_fmt ← rds.mmap has_to_tactic_format.to_tactic_format,
    tactic.trace (((rds_fmt.map to_string).intersperse "; ").to_string),
  transfer.compute_transfer rds [] `(rel (0 : xnat)) >>= tactic.trace

lemma rel_succ : (rel ⇒ rel) xnat.succ nat.succ :=
sorry
lemma rel_one : rel 1 1 := eq.refl _

instance : has_add xnat :=
⟨λ m n, by induction n; [exact m, exact n_ih.succ]⟩

theorem to_xnat_add (m) : ∀ n, to_xnat (m + n) = to_xnat m + to_xnat n
| 0 := rfl
| (nat.succ n) := congr_arg xnat.succ (to_xnat_add n)

lemma rel_add : (rel ⇒ rel ⇒ rel) (+) (+) :=
sorry

lemma rel_eq : (rel ⇒ rel ⇒ iff) (=) (=) :=
sorry

instance : relator.bi_total rel :=
⟨λ a, ⟨_, to_of_xnat _⟩, λ a, ⟨_, rfl⟩⟩

example : ∀ x y : xnat, x + y = y + x :=
begin
  transfer.transfer [``relator.rel_forall_of_total, ``rel_eq, ``rel_add],
  simp [add_comm]
end

run_cmd do rds ← transfer.analyse_decls
  [``relator.rel_forall_of_total, ``rel_eq, ``rel_add],
    rds_fmt ← rds.mmap has_to_tactic_format.to_tactic_format,
    tactic.trace (((rds_fmt.map to_string).intersperse "; ").to_string),
  transfer.compute_transfer rds []
  `(∀ x y : xnat, x + y = y + x)


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Temporary file; move in Lean3.
-/
import data.set algebra.order_bigops algebra.ordered_field
import data.finset data.list.sort
import data.real

-- move this to init.function

section
open function
postfix `^~` :std.prec.max_plus := swap
end

-- move to algebra

theorem eq_of_inv_mul_eq_one {A : Type} {a b : A} [group A] (H : b⁻¹ * a = 1) : a = b :=
have a⁻¹ * 1 = a⁻¹, by inst_simp,
by inst_simp

theorem lt_neg_self_of_neg {A : Type} {a : A} [ordered_comm_group A] (Ha : a < 0) : a < -a :=
calc
    a < 0  : Ha
  ... = -0 : by rewrite neg_zero
  ... < -a : neg_lt_neg Ha

theorem lt_of_add_lt_of_nonneg_left {A : Type} {a b c : A} [ordered_comm_group A]
        (H : a + b < c) (Hb : b ≥ 0) : a < c :=
calc
    a < c - b : lt_sub_right_of_add_lt H
  ... ≤ c : sub_le_self _ Hb

theorem lt_of_add_lt_of_nonneg_right {A : Type} {a b c : A} [ordered_comm_group A]
        (H : a + b < c) (Hb : a ≥ 0) : b < c :=
calc
    b < c - a : lt_sub_left_of_add_lt H
  ... ≤ c : sub_le_self _ Hb

  theorem lt_mul_of_div_lt_of_pos {A : Type} {a b c : A} [linear_ordered_field A]
 (Hc : c > 0) (H : a / c < b) : a < b * c :=
    calc
      a = a / c * c : !div_mul_cancel (ne.symm (ne_of_lt Hc))
    ... < b * c     : mul_lt_mul_of_pos_right H Hc

theorem add_sub_self {A : Type} [add_comm_group A] (a b : A) : a + b - a = b :=
  by rewrite [add_sub_assoc, add.comm, sub_add_cancel]

-- move to init.quotient

namespace quot
open classical

variables {A : Type} [s : setoid A]

protected theorem exists_eq_mk (x : quot s) : ∃ a : A, x = ⟦a⟧ :=
quot.induction_on x (take a, exists.intro _ rfl)

protected noncomputable definition repr (x : quot s) : A := some (quot.exists_eq_mk x)

protected theorem mk_repr_eq (x : quot s) : ⟦ quot.repr x ⟧ = x :=
eq.symm (some_spec (quot.exists_eq_mk x))

open setoid
include s
protected theorem repr_mk_equiv (a : A) : quot.repr ⟦a⟧ ≈ a :=
quot.exact (by rewrite quot.mk_repr_eq)

end quot

-- move to data.set.basic

-- move to algebra.ring

theorem mul_two {A : Type} [semiring A] (a : A) : a * 2 = a + a :=
by rewrite [-one_add_one_eq_two, left_distrib, +mul_one]

theorem two_mul {A : Type} [semiring A] (a : A) : 2 * a = a + a :=
by rewrite [-one_add_one_eq_two, right_distrib, +one_mul]

-- move to data.set

namespace set
open function

lemma inter_eq_self_of_subset {X : Type} {s t : set X} (Hst : s ⊆ t) : s ∩ t = s :=
ext (take x, iff.intro
  (assume H, !inter_subset_left H)
  (assume H, and.intro H (Hst H)))

lemma inter_eq_self_of_subset_right {X : Type} {s t : set X} (Hst : t ⊆ s) : s ∩ t = t :=
by rewrite [inter_comm]; apply inter_eq_self_of_subset Hst

proposition diff_self_inter {X : Type} (s t : set X) : s \ (s ∩ t) = s \ t :=
by rewrite [*diff_eq, compl_inter, inter_distrib_left, inter_compl_self, empty_union]

proposition diff_eq_diff {X : Type} {s t u : set X} (H : s ∩ u = s ∩ t) :
  s \ u = s \ t :=
by rewrite [-diff_self_inter, H, diff_self_inter]

-- classical
proposition inter_eq_inter_of_diff_eq_diff {X : Type} {s t u : set X} (H : s \ u = s \ t) :
  s ∩ u = s ∩ t :=
by rewrite [-compl_compl u, -compl_compl t]; apply diff_eq_diff H

proposition compl_inter_eq_compl_inter {X : Type} {s t u : set X}
    (H : u ∩ s = t ∩ s) :
  -u ∩ s = -t ∩ s :=
by rewrite [*inter_comm _ s]; apply diff_eq_diff; rewrite [*inter_comm s, H]

proposition inter_eq_inter_of_compl_inter_eq_compl_inter {X : Type} {s t u : set X}
    (H : -u ∩ s = -t ∩ s) :
  u ∩ s = t ∩ s :=
begin
  rewrite [*inter_comm _ s], apply inter_eq_inter_of_diff_eq_diff,
  rewrite [*diff_eq, *inter_comm s, H]
end

proposition singleton_subset_of_mem {X : Type} {x : X} {s : set X} (xs : x ∈ s) : '{x} ⊆ s :=
take y, assume yx,
  have y = x, from eq_of_mem_singleton yx,
  by rewrite this; exact xs

proposition mem_of_singleton_subset {X : Type} {x : X} {s : set X} (xs : '{x} ⊆ s) : x ∈ s :=
xs !mem_singleton

proposition singleton_subset_iff {X : Type} (x : X) (s : set X) : '{x} ⊆ s ↔ x ∈ s :=
iff.intro mem_of_singleton_subset singleton_subset_of_mem

theorem singleton_subset {X : Type} {a : X} {s : set X} (H : a ∈ s) : '{a} ⊆ s :=
take b, suppose b ∈ '{a},
have b = a, from eq_of_mem_singleton this,
show b ∈ s, by rewrite this; assumption

lemma inter_eq_inter_left {X : Type} {s t u : set X} (H₁ : s ∩ t ⊆ u) (H₂ : s ∩ u ⊆ t) :
  s ∩ t = s ∩ u :=
eq_of_subset_of_subset
  (subset_inter (inter_subset_left _ _) H₁)
  (subset_inter (inter_subset_left _ _) H₂)

lemma inter_eq_inter_right {X : Type} {s t u : set X} (H₁ : s ∩ t ⊆ u) (H₂ : u ∩ t ⊆ s) :
  s ∩ t = u ∩ t :=
eq_of_subset_of_subset
  (subset_inter H₁ (inter_subset_right _ _))
  (subset_inter H₂ (inter_subset_right _ _))

proposition sUnion_subset {X : Type} {S : set (set X)} {t : set X} (H : ∀₀ u ∈ S, u ⊆ t) :
  ⋃₀ S ⊆ t :=
take x, assume Hx,
obtain u [uS xu], from Hx,
H uS xu

proposition subset_of_sUnion_subset {X : Type} {S : set (set X)} {t : set X}
  (H : ⋃₀ S ⊆ t) {u : set X} (Hu : u ∈ S) : u ⊆ t :=
λ x xu, H (exists.intro u (and.intro Hu xu))

proposition preimage_Union {I X Y : Type} (f : X → Y) (u : I → set Y) :
  f '- (⋃ i, u i) = ⋃ i, (f '- (u i)) :=
ext (take x, !iff.refl)

-- TODO: rename "injective" to "inj"
-- TODO: turn around equality in definition of image
-- TODO: use ∀₀ in definition of injective (and define notation for ∀₀ x y ∈ s, ...)

attribute [trans] subset.trans -- really? this was never declared? And all the variants...

proposition mem_set_of_iff {X : Type} (P : X → Prop) (a : X) : a ∈ { x : X | P x } ↔ P a :=
 iff.refl _

proposition mem_set_of {X : Type} {P : X → Prop} {a : X} (Pa : P a) : a ∈ { x : X | P x } := Pa

proposition of_mem_set_of {X : Type} {P : X → Prop} {a : X} (H : a ∈ { x : X | P x }) : P a := H

proposition forallb_of_forall {X : Type} {P : X → Prop} (s : set X) (H : ∀ x, P x) :
  ∀₀ x ∈ s, P x :=
λ x xs, H x

proposition forall_of_forallb_univ {X : Type} {P : X → Prop} (H : ∀₀ x ∈ univ, P x) : ∀ x, P x :=
λ x, H trivial

proposition forallb_univ_iff_forall {X : Type} (P : X → Prop) : (∀₀ x ∈ univ, P x) ↔ ∀ x, P x :=
iff.intro forall_of_forallb_univ !forallb_of_forall

proposition forallb_of_subset {X : Type} {s t : set X} {P : X → Prop}
  (ssubt : s ⊆ t) (Ht : ∀₀ x ∈ t, P x) : ∀₀ x ∈ s, P x :=
λ x xs, Ht (ssubt xs)

proposition forallb_of_forall₂ {X Y : Type} {P : X → Y → Prop} (s : set X) (t : set Y)
  (H : ∀ x y, P x y) : ∀₀ x ∈ s, ∀₀ y ∈ t, P x y :=
λ x xs y yt, H x y

proposition forall_of_forallb_univ₂ {X Y : Type} {P : X → Y → Prop}
  (H : ∀₀ x ∈ univ, ∀₀ y ∈ univ, P x y) : ∀ x y, P x y :=
λ x y, H trivial trivial

proposition forallb_univ_iff_forall₂ {X Y : Type} (P : X → Y → Prop) :
  (∀₀ x ∈ univ, ∀₀ y ∈ univ, P x y) ↔ ∀ x y, P x y :=
iff.intro forall_of_forallb_univ₂ !forallb_of_forall₂

proposition forallb_of_subset₂ {X Y : Type} {s₁ t₁ : set X} {s₂ t₂ : set Y} {P : X → Y → Prop}
    (ssubt₁ : s₁ ⊆ t₁) (ssubt₂ : s₂ ⊆ t₂) (Ht : ∀₀ x ∈ t₁, ∀₀ y ∈ t₂, P x y) :
  ∀₀ x ∈ s₁, ∀₀ y ∈ s₂, P x y :=
λ x xs y ys, Ht (ssubt₁ xs) (ssubt₂ ys)

theorem maps_to_univ {X Y : Type} (f : X → Y) (a : set X) : maps_to f a univ :=
take x, assume H, trivial

theorem surj_on_image {X Y : Type} (f : X → Y) (a : set X) : surj_on f a (f ' a) :=
λ y Hy, Hy

theorem image_eq_univ_of_surjective {X Y : Type} {f : X → Y} (H : surjective f) :
  f ' univ = univ :=
ext (take y, iff.intro (λ H', trivial)
  (λ H', obtain x xeq, from H y,
    show y ∈ f ' univ, from mem_image trivial xeq))

proposition image_inter_subset {X Y : Type} (f : X → Y) (s t : set X) :
  f ' (s ∩ t) ⊆ f ' s ∩ f ' t :=
take y, assume ymem,
obtain x [[xs xt] (xeq : f x = y)], from ymem,
show y ∈ f ' s ∩ f ' t,
  begin
    rewrite -xeq,
    exact (and.intro (mem_image_of_mem f xs) (mem_image_of_mem f xt))
  end

--proposition image_eq_of_maps_to_of_surj_on {X Y : Type} {f : X → Y} {s : set X} {t : set Y}
--    (H : maps_to f s t) (H' : surj_on f s t) :
--  f ' s = t :=
--eq_of_subset_of_subset (image_subset_of_maps_to H) H'

proposition surj_on_of_image_eq {X Y : Type} {f : X → Y} {s : set X} {t : set Y}
    (H : f ' s = t) :
  surj_on f s t :=
by rewrite [↑surj_on, H]; apply subset.refl

proposition surjective_induction {X Y : Type} {P : Y → Prop} {f : X → Y}
    (surjf : surjective f) (H : ∀ x, P (f x)) :
  ∀ y, P y :=
take y,
obtain x (yeq : f x = y), from surjf y,
show P y, by rewrite -yeq; apply H x

proposition surjective_induction₂ {X Y : Type} {P : Y → Y → Prop} {f : X → Y}
    (surjf : surjective f) (H : ∀ x₁ x₂, P (f x₁) (f x₂)) :
  ∀ y₁ y₂, P y₁ y₂ :=
take y₁ y₂,
obtain x₁ (y₁eq : f x₁ = y₁), from surjf y₁,
obtain x₂ (y₂eq : f x₂ = y₂), from surjf y₂,
show P y₁ y₂, by rewrite [-y₁eq, -y₂eq]; apply H x₁ x₂

proposition surj_on_univ_induction {X Y : Type} {P : Y → Prop} {f : X → Y} {s : set X}
    (surjfs : surj_on f s univ) (H : ∀₀ x ∈ s, P (f x)) :
  ∀ y, P y :=
take y,
obtain x [xs (yeq : f x = y)], from surjfs trivial,
show P y, by rewrite -yeq; apply H xs

proposition surj_on_univ_induction₂ {X Y : Type} {P : Y → Y → Prop} {f : X → Y} {s : set X}
    (surjfs : surj_on f s univ) (H : ∀₀ x₁ ∈ s, ∀₀ x₂ ∈ s, P (f x₁) (f x₂)) :
  ∀ y₁ y₂, P y₁ y₂ :=
take y₁ y₂,
obtain x₁ [x₁s (y₁eq : f x₁ = y₁)], from surjfs trivial,
obtain x₂ [x₂s (y₂eq : f x₂ = y₂)], from surjfs trivial,
show P y₁ y₂, by rewrite [-y₁eq, -y₂eq]; apply H x₁s x₂s

proposition surj_on_univ_of_surjective {X Y : Type} {f : X → Y} (s : set Y) (H : surjective f) :
  surj_on f univ s :=
take y, assume ys,
obtain x yeq, from H y,
mem_image !mem_univ yeq

proposition mem_of_mem_image_of_injective {X Y : Type} {f : X → Y} {s : set X} {a : X}
    (injf : injective f) (H : f a ∈ f ' s) :
  a ∈ s :=
obtain b [bs faeq], from H,
have b = a, from injf faeq,
by rewrite -this; apply bs

proposition mem_of_mem_image_of_inj_on {X Y : Type} {f : X → Y} {s t : set X} {a : X} (Ha : a ∈ t)
    (Hs : s ⊆ t) (injft : inj_on f t) (H : f a ∈ f ' s)  :
  a ∈ s :=
obtain b [bs faeq], from H,
have b = a, from injft (Hs bs) Ha faeq,
by rewrite -this; apply bs

proposition eq_singleton_of_forall_eq {A : Type} {s : set A} {x : A} (xs : x ∈ s) (H : ∀₀ y ∈ s, y = x) :
  s = '{x} :=
ext (take y, iff.intro
  (assume ys, mem_singleton_of_eq (H ys))
  (assume yx, by rewrite (eq_of_mem_singleton yx); assumption))

proposition insert_subset {A : Type} {s t : set A} {a : A} (amem : a ∈ t) (ssubt : s ⊆ t) : insert a s ⊆ t :=
take x, assume xias,
  or.elim (eq_or_mem_of_mem_insert xias)
    (by simp)
    (take H, ssubt H)

-- move to data.set.finite

lemma finite_sUnion {A : Type} {S : set (set A)} [H : finite S] :
  (∀s, s ∈ S → finite s) → finite ⋃₀S :=
induction_on_finite S
  (by intro H; rewrite sUnion_empty; apply finite_empty)
  (take a s, assume fins anins ih h,
    begin
      rewrite sUnion_insert,
      apply finite_union,
        {apply h _ (mem_insert a s)},
      apply ih (forall_of_forall_insert h)
    end)

lemma subset_powerset_sUnion {A : Type} (S : set (set A)) : S ⊆ 𝒫 (⋃₀ S) :=
take u, suppose u ∈ S, show u ⊆ ⋃₀ S, from subset_sUnion_of_mem this

lemma finite_of_finite_sUnion {A : Type} (S : set (set A)) (H : finite ⋃₀S) : finite S :=
have finite (𝒫 (⋃₀ S)), from finite_powerset _,
show finite S, from finite_subset (subset_powerset_sUnion S)

section nat
open nat

proposition ne_empty_of_card_pos {A : Type} {s : set A} (H : card s > 0) : s ≠ ∅ :=
take H', begin rewrite [H' at H, card_empty at H], exact lt.irrefl 0 H end

lemma eq_of_card_eq_one {A : Type} {S : set A} (H : card S = 1) {x y : A} (Hx : x ∈ S) (Hy : y ∈ S) :
  x = y :=
have finite S,
  from classical.by_contradiction
    (assume nfinS, begin rewrite (card_of_not_finite nfinS) at H, contradiction end),
classical.by_contradiction
(assume H0 : x ≠ y,
  have H1 : '{x, y} ⊆ S, from insert_subset Hx (insert_subset Hy (empty_subset _)),
  have x ∉ '{y}, from assume H, H0 (eq_of_mem_singleton H),
  have 2 ≤ 1, from calc
    2 = card '{x, y} : by rewrite [card_insert_of_not_mem this,
                            card_insert_of_not_mem (not_mem_empty _), card_empty]
      ... ≤ card S   : card_le_card_of_subset H1
      ... = 1        : H,
  show false, from dec_trivial this)

proposition eq_singleton_of_card_eq_one {A : Type} {s : set A} {x : A} (H : card s = 1) (xs : x ∈ s) :
  s = '{x} :=
eq_singleton_of_forall_eq xs (take y, assume ys, eq.symm (eq_of_card_eq_one H xs ys))

proposition exists_eq_singleton_of_card_eq_one {A : Type} {s : set A} (H : card s = 1) : ∃ x, s = '{x} :=
have s ≠ ∅, from ne_empty_of_card_pos (by rewrite H; apply dec_trivial),
obtain (x : A) (xs : x ∈ s), from exists_mem_of_ne_empty this,
exists.intro x (eq_singleton_of_card_eq_one H xs)

end nat

-- move to data.set.classical_inverse (and rename file to "inverse")

theorem inv_fun_spec {X Y : Type} {f : X → Y} {a : set X} {dflt : X} {x : X} (xa : x ∈ a) :
  f (inv_fun f a dflt (f x)) = f x :=
and.right (inv_fun_pos (exists.intro x (and.intro xa rfl)))

theorem inv_fun_spec' {X Y : Type} {f : X → Y} {a : set X} {dflt : X} {x : X} (xa : x ∈ a) :
  inv_fun f a dflt (f x) ∈ a :=
and.left (inv_fun_pos (exists.intro x (and.intro xa rfl)))

-- TODO: move to data.set.filter

namespace filter
  protected theorem le_iff {X : Type} (F₁ F₂ : filter X) : F₁ ≤ F₂ ↔ F₂ ⊆ F₁ := iff.refl _

  -- TODO: change names of fields in filter
  -- TODO: reorder hypotheses in eventually_of_le, and change "le" to "ge"
  -- TODO: fix eventually_inf: implicit argument, and use implication
  -- TODO: set: add spaces around ∀₀ x ∈ s and ∃₀ x ∈ s

  theorem eventually_inf_left {X : Type} {P : X → Prop} {F₁ : filter X} (F₂ : filter X)
    (H : eventually P F₁) : eventually P (inf F₁ F₂) :=
  eventually_of_le H !inf_le_left

  theorem eventually_inf_right {X : Type} {P : X → Prop} (F₁ : filter X) {F₂ : filter X}
    (H : eventually P F₂) : eventually P (inf F₁ F₂) :=
  eventually_of_le H !inf_le_right

  theorem eventually_Inf {X : Type} {P : X → Prop} {S : set (filter X)} {F : filter X} (FS : F ∈ S)
    (H : eventually P F) : eventually P (Inf S) :=
  eventually_of_le H (Inf_le FS)

  -- TODO: replace definition of Inf with this

  definition Inf' {X : Type} (S : set (filter X)) : filter X :=
  ⦃ filter,
    sets          := { s | ∃ T : set (set X), finite T ∧ T ⊆ (⋃ F ∈ S, sets F) ∧ ⋂₀ T ⊆ s},
    univ_mem_sets :=  abstract
                        have H : (⋂₀ ∅) ⊆ @univ X, by rewrite sInter_empty; apply subset.refl,
                        exists.intro ∅ (and.intro !finite_empty (and.intro (empty_subset _) H))
                      end,
    inter_closed  := abstract
                       take s t, assume Hs Ht,
                       obtain Ts finTs Tssub ITs, from Hs,
                       obtain Tt finTt Ttsub ITt, from Ht,
                       have H1 : finite (Ts ∪ Tt), proof finite_union Ts Tt qed,
                       have H2 : Ts ∪ Tt ⊆ (⋃ F ∈ S, sets F), from union_subset Tssub Ttsub,
                       have H3 : ⋂₀ (Ts ∪ Tt) ⊆ s ∩ t,
                       begin
                         rewrite sInter_union, apply subset_inter,
                           {exact subset.trans (inter_subset_left _ _) ITs},
                         exact subset.trans (inter_subset_right _ _) ITt
                       end,
                       exists.intro _ (and.intro H1 (and.intro H2 H3))
                     end,
    is_mono       := abstract
                       take s t ssubt Hs,
                       obtain T finT Tsub IT, from Hs,
                       exists.intro T (and.intro finT (and.intro Tsub (subset.trans IT ssubt)))
                     end
  ⦄

  theorem sets_Inf' {A : Type} (S : set (filter A)) :
    sets (Inf' S) = { s | ∃ T : set (set A), finite T ∧ T ⊆ (⋃ F ∈ S, sets F) ∧ ⋂₀ T ⊆ s} :=
  rfl

  theorem sInter_mem_of_finite {A : Type} {F : filter A} {T : set (set A)} (finT : finite T)
    (Tsub : T ⊆ sets F) : ⋂₀ T ∈ sets F :=
  begin
    induction finT with a T finT aninT ih,
      {rewrite sInter_empty, apply filter.univ_mem_sets},
    rewrite sInter_insert, apply filter.inter_closed,
      show a ∈ sets F, from Tsub (mem_insert a T),
    show ⋂₀ T ∈ sets F, from ih (subset.trans (subset_insert _ _) Tsub)
  end

  theorem le_Inf' {A : Type} {F : filter A} {S : set (filter A)} (H : ∀₀ G ∈ S, F ≤ G) :
    F ≤ Inf' S :=
  filter.le_of_subset
    (take s, suppose s ∈ sets (Inf' S),
      obtain (T : set (set A)) finT (Tsub : T ⊆ (⋃ G ∈ S, sets G)) (IT : ⋂₀ T ⊆ s), from this,
      have T ⊆ sets F, from subset.trans Tsub (bUnion_subset H),
      have ⋂₀ T ∈ sets F, from sInter_mem_of_finite finT this,
      show s ∈ sets F, from filter.is_mono _ IT this)

  theorem Inf'_le {A : Type} {F : filter A} {S : set (filter A)} (FS : F ∈ S) :
    Inf' S ≤ F :=
  filter.le_of_subset
    (take s, suppose s ∈ sets F,
      have '{s} ⊆ ⋃ G ∈ S, sets G, from singleton_subset (mem_bUnion FS this),
      exists.intro '{s} (and.intro _
      (and.intro this (by rewrite sInter_singleton; apply subset.refl))))

  theorem Inf_eq_Inf' {A : Type} (S : set (filter A)) : Inf S = Inf' S :=
  le.antisymm (le_Inf' (λ F FS, Inf_le FS)) (le_Inf (λ F FS, Inf'_le FS))

  theorem exists_eventually_of_eventually_Inf {A : Type} {P : A → Prop} {F : filter A}
      {S : set (filter A)} (FS : F ∈ S) (H' : eventually P (Inf S))
      (H : ∀₀ F₁ ∈ S, ∀₀ F₂ ∈ S, ∃₀ F ∈ S, F ≤ inf F₁ F₂) :
    ∃₀ F ∈ S, eventually P F :=
  have P ∈ Inf' S, by rewrite -Inf_eq_Inf'; apply H',
  have ∃ T : set (set A), finite T ∧ T ⊆ (⋃ F ∈ S, sets F) ∧ ⋂₀ T ⊆ P,
    by rewrite sets_Inf' at this; exact this,
  obtain T finT Tsub ITP, from this,
  have ∃₀ F ∈ S, ⋂₀ T ∈ F,
    begin
      clear ITP,
      induction finT with s T finT sninT ih,
        {exact exists.intro F (and.intro FS (by rewrite sInter_empty; apply filter.univ_mem_sets))},
      have ∃₀ F ∈ S, ⋂₀ T ∈ F, from ih (subset.trans (subset_insert _ _) Tsub),
      cases this with F₁ H₁,
      cases H₁ with F₁S ITF₁,
      have s ∈ (⋃ F ∈ S, sets F), from Tsub !mem_insert,
      cases this with F₂ H₂,
      cases H₂ with F₂S sF₂,
      cases H F₁S F₂S with F' HF',
      cases HF' with F'S F'le,
      existsi F', split, exact F'S,
      show ⋂₀ insert s T ∈ sets F',
        begin
          rewrite sInter_insert, apply filter.inter_closed,
            show s ∈ sets F', from filter.subset_of_le (le.trans F'le !inf_le_right) sF₂,
          show ⋂₀ T ∈ sets F', from filter.subset_of_le (le.trans F'le !inf_le_left) ITF₁,
        end
    end,
  obtain F FS IT, from this,
  exists.intro F (and.intro FS (filter.is_mono _ ITP IT))
end filter

end set

-- move to data.finset

namespace finset

section
  variables {A : Type} [decidable_linear_order A]

  definition finset_to_list (s : finset A) : list A :=
  quot.lift_on s
    (take l, list.sort le (subtype.elt_of l))
    (take a b, assume eqab, list.sort_eq_of_perm eqab)

  proposition to_finset_finset_to_list (s : finset A) : to_finset (finset_to_list s) = s :=
  quot.induction_on s
    begin
      intro l,
      have H : list.nodup (list.sort le (subtype.elt_of l)),
        from perm.nodup_of_perm_of_nodup (perm.symm !list.sort_perm) (subtype.has_property l),
      rewrite [↑finset_to_list, -to_finset_eq_of_nodup H],
      apply quot.sound,
      apply list.sort_perm
    end

  proposition nodup_finset_to_list (s : finset A) : list.nodup (finset_to_list s) :=
  quot.induction_on s
    (take l, perm.nodup_of_perm_of_nodup (perm.symm !list.sort_perm) (subtype.has_property l))

  proposition sorted_finset_to_list (s : finset A) : list.sorted le (finset_to_list s) :=
  quot.induction_on s
    (take l, list.sorted_of_strongly_sorted (list.strongly_sorted_sort _))
end

end finset

-- move to data.nat?

namespace nat
open finset

theorem succ_Max₀_not_mem (s : finset ℕ) : succ (Max₀ s) ∉ s :=
suppose succ (Max₀ s) ∈ s,
have succ (Max₀ s) ≤ Max₀ s, from le_Max₀ this,
show false, from not_succ_le_self this

end nat

-- move to real

namespace real
theorem lt_of_abs_lt {a b : ℝ} (Ha : abs a < b) : a < b :=
if Hnn : a ≥ 0 then
  by rewrite [-abs_of_nonneg Hnn]; exact Ha
else
  have Hlt : a < 0, from lt_of_not_ge Hnn,
  have -a < b, by rewrite [-abs_of_neg Hlt]; exact Ha,
  calc
    a < -a : lt_neg_self_of_neg Hlt
  ... < b  : this
end real


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

! This file was ported from Lean 3 source module analysis.convex.body
! leanprover-community/mathlib commit 858a10cf68fd6c06872950fc58c4dcc68d465591
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Basic
import Mathbin.Analysis.NormedSpace.Basic
import Mathbin.Topology.MetricSpace.HausdorffDistance

/-!
# Convex bodies

This file contains the definition of the type `convex_body V`
consisting of
convex, compact, nonempty subsets of a real topological vector space `V`.

`convex_body V` is a module over the nonnegative reals (`nnreal`) and a pseudo-metric space.
If `V` is a normed space, `convex_body V` is a metric space.

## TODO

- define positive convex bodies, requiring the interior to be nonempty
- introduce support sets
- Characterise the interaction of the distance with algebraic operations, eg
  `dist (a • K) (a • L) = ‖a‖ * dist K L`, `dist (a +ᵥ K) (a +ᵥ L) = dist K L`

## Tags

convex, convex body
-/

open Pointwise

open NNReal

variable {V : Type _}

/-- Let `V` be a real topological vector space. A subset of `V` is a convex body if and only if
it is convex, compact, and nonempty.
-/
structure ConvexBody (V : Type _) [TopologicalSpace V] [AddCommMonoid V] [SMul ℝ V] where
  carrier : Set V
  convex' : Convex ℝ carrier
  is_compact' : IsCompact carrier
  nonempty' : carrier.Nonempty
#align convex_body ConvexBody

namespace ConvexBody

section TVS

variable [TopologicalSpace V] [AddCommGroup V] [Module ℝ V]

instance : SetLike (ConvexBody V) V
    where
  coe := ConvexBody.carrier
  coe_injective' K L h := by
    cases K
    cases L
    congr

protected theorem convex (K : ConvexBody V) : Convex ℝ (K : Set V) :=
  K.convex'
#align convex_body.convex ConvexBody.convex

protected theorem isCompact (K : ConvexBody V) : IsCompact (K : Set V) :=
  K.is_compact'
#align convex_body.is_compact ConvexBody.isCompact

protected theorem nonempty (K : ConvexBody V) : (K : Set V).Nonempty :=
  K.nonempty'
#align convex_body.nonempty ConvexBody.nonempty

@[ext]
protected theorem ext {K L : ConvexBody V} (h : (K : Set V) = L) : K = L :=
  SetLike.ext' h
#align convex_body.ext ConvexBody.ext

@[simp]
theorem coe_mk (s : Set V) (h₁ h₂ h₃) : (mk s h₁ h₂ h₃ : Set V) = s :=
  rfl
#align convex_body.coe_mk ConvexBody.coe_mk

section ContinuousAdd

variable [ContinuousAdd V]

instance : AddMonoid (ConvexBody V)
    where
  -- we cannot write K + L to avoid reducibility issues with the set.has_add instance
  add K L :=
    ⟨Set.image2 (· + ·) K L, K.Convex.add L.Convex, K.IsCompact.add L.IsCompact,
      K.Nonempty.add L.Nonempty⟩
  add_assoc K L M := by
    ext
    simp only [coe_mk, Set.image2_add, add_assoc]
  zero := ⟨0, convex_singleton 0, isCompact_singleton, Set.singleton_nonempty 0⟩
  zero_add K := by
    ext
    simp only [coe_mk, Set.image2_add, zero_add]
  add_zero K := by
    ext
    simp only [coe_mk, Set.image2_add, add_zero]

@[simp]
theorem coe_add (K L : ConvexBody V) : (↑(K + L) : Set V) = (K : Set V) + L :=
  rfl
#align convex_body.coe_add ConvexBody.coe_add

@[simp]
theorem coe_zero : (↑(0 : ConvexBody V) : Set V) = 0 :=
  rfl
#align convex_body.coe_zero ConvexBody.coe_zero

instance : Inhabited (ConvexBody V) :=
  ⟨0⟩

instance : AddCommMonoid (ConvexBody V) :=
  { ConvexBody.addMonoid with
    add_comm := fun K L => by
      ext
      simp only [coe_add, add_comm] }

end ContinuousAdd

variable [ContinuousSMul ℝ V]

instance : SMul ℝ (ConvexBody V)
    where smul c K := ⟨c • (K : Set V), K.Convex.smul _, K.IsCompact.smul _, K.Nonempty.smul_set⟩

@[simp]
theorem coe_smul (c : ℝ) (K : ConvexBody V) : (↑(c • K) : Set V) = c • (K : Set V) :=
  rfl
#align convex_body.coe_smul ConvexBody.coe_smul

variable [ContinuousAdd V]

instance : DistribMulAction ℝ (ConvexBody V)
    where
  toSMul := ConvexBody.hasSmul
  one_smul K := by
    ext
    simp only [coe_smul, one_smul]
  mul_smul c d K := by
    ext
    simp only [coe_smul, mul_smul]
  smul_add c K L := by
    ext
    simp only [coe_smul, coe_add, smul_add]
  smul_zero c := by
    ext
    simp only [coe_smul, coe_zero, smul_zero]

@[simp]
theorem coe_smul' (c : ℝ≥0) (K : ConvexBody V) : (↑(c • K) : Set V) = c • (K : Set V) :=
  rfl
#align convex_body.coe_smul' ConvexBody.coe_smul'

/-- The convex bodies in a fixed space $V$ form a module over the nonnegative reals.
-/
instance : Module ℝ≥0 (ConvexBody V)
    where
  add_smul c d K := by
    ext1
    simp only [coe_smul, coe_add]
    exact Convex.add_smul K.convex (NNReal.coe_nonneg _) (NNReal.coe_nonneg _)
  zero_smul K := by
    ext1
    exact Set.zero_smul_set K.nonempty

end TVS

section SeminormedAddCommGroup

variable [SeminormedAddCommGroup V] [NormedSpace ℝ V] (K L : ConvexBody V)

protected theorem bounded : Metric.Bounded (K : Set V) :=
  K.IsCompact.Bounded
#align convex_body.bounded ConvexBody.bounded

theorem hausdorffEdist_ne_top {K L : ConvexBody V} : Emetric.hausdorffEdist (K : Set V) L ≠ ⊤ := by
  apply_rules [Metric.hausdorffEdist_ne_top_of_nonempty_of_bounded, ConvexBody.nonempty,
    ConvexBody.bounded]
#align convex_body.Hausdorff_edist_ne_top ConvexBody.hausdorffEdist_ne_top

/-- Convex bodies in a fixed seminormed space $V$ form a pseudo-metric space under the Hausdorff
metric. -/
noncomputable instance : PseudoMetricSpace (ConvexBody V)
    where
  dist K L := Metric.hausdorffDist (K : Set V) L
  dist_self _ := Metric.hausdorffDist_self_zero
  dist_comm _ _ := Metric.hausdorffDist_comm
  dist_triangle K L M := Metric.hausdorffDist_triangle hausdorffEdist_ne_top

@[simp, norm_cast]
theorem hausdorffDist_coe : Metric.hausdorffDist (K : Set V) L = dist K L :=
  rfl
#align convex_body.Hausdorff_dist_coe ConvexBody.hausdorffDist_coe

@[simp, norm_cast]
theorem hausdorffEdist_coe : Emetric.hausdorffEdist (K : Set V) L = edist K L :=
  by
  rw [edist_dist]
  exact (ENNReal.ofReal_toReal Hausdorff_edist_ne_top).symm
#align convex_body.Hausdorff_edist_coe ConvexBody.hausdorffEdist_coe

end SeminormedAddCommGroup

section NormedAddCommGroup

variable [NormedAddCommGroup V] [NormedSpace ℝ V]

/-- Convex bodies in a fixed normed space `V` form a metric space under the Hausdorff metric. -/
noncomputable instance : MetricSpace (ConvexBody V)
    where eq_of_dist_eq_zero K L hd :=
    ConvexBody.ext <|
      (K.IsCompact.IsClosed.hausdorffDist_zero_iff_eq L.IsCompact.IsClosed hausdorffEdist_ne_top).mp
        hd

end NormedAddCommGroup

end ConvexBody