import dyck.basic
import free_group.extras

universe u
variables {α : Type u} {L L₁ : list (α × bool)}

namespace dyck

def positive (L) :=
∃ L₁ : list (α × bool), L₁ ≠ [] ∧ mk L = mk L₁ ∧ (∀ (x : α × bool), x ∈ L₁ → x.2 = tt)

def negative (L) :=
∃ L₁ : list (α × bool), L₁ ≠ [] ∧ mk L = mk L₁ ∧ (∀ (x : α × bool), x ∈ L₁ → x.2 = ff)

lemma red.all_pos_iff {H : ∀ x' : α × bool, x' ∈ L → x'.snd = tt} :
red L L₁ ↔ L = L₁ :=
begin
  split,
  { intro h,
    induction h with L₂ L₃ h ih,
    refl,
    subst_vars,
    rw ← red at *,
    simp at *,
    induction ih,
    specialize H ih_x ff (by simp),
    simp at *,
    contradiction },
  intro h,
  rw h,
end

lemma red.all_neg_iff {H : ∀ x' : α × bool, x' ∈ L → x'.snd = ff} :
red L L₁ ↔ L = L₁ :=
begin
  split,
  { intro h,
    induction h with L₂ L₃ h ih,
    refl,
    subst_vars,
    rw ← red at *,
    simp at *,
    induction ih,
    specialize H ih_x tt (by simp),
    simp at *,
    contradiction },
  intro h,
  rw h,
end

lemma one_not_positive : mk L = 1 → ¬ positive L :=
begin
  rintros h ⟨L', hnil, hmk, hpos⟩,
  rw h at hmk,
  have h₁ := eq.symm hmk,
  rw mk_one_iff at h₁,
  cases L',
  contradiction,
  cases L'_hd with a b,
  cases b,
  { specialize hpos (a, ff) (by simp), contradiction, },
  { rw red.cons_nil_iff_singleton at h₁,
    have h₂ := red.sublist h₁,
    simp at h₂,
    specialize hpos (a, ff) (by simp; exact h₂),
    contradiction }
end

lemma one_not_negative : mk L = 1 → ¬ negative L :=
begin
  rintros h ⟨L', hnil, hmk, hneg⟩,
  rw h at hmk,
  have h₁ := mk_free_group (eq.symm hmk),
  rw [←  free_group.one_eq_mk, free_group.mk_one_iff] at h₁,
  cases L',
  contradiction,
  cases L'_hd with a b,
  cases b,
  { rw free_group.red.cons_nil_iff_singleton at h₁,
    have h₂ := free_group.red.sublist h₁,
    simp at h₂,
    specialize hneg (a, tt) (by simp; exact h₂),
    contradiction },
  { specialize hneg (a, tt) (by simp), contradiction }
end

lemma positive_not_negative : positive L → ¬ negative L :=
begin
  rintros ⟨L', hnil, hmk, hpos⟩ ⟨LL', hnil', hmk', hneg⟩,
  rw [hmk, red.exact] at hmk',
  rcases hmk' with ⟨c, hl, hr⟩,
  rw red.all_pos_iff at hl,
  rw red.all_neg_iff at hr,
  rw ← hl at hr,
  cases L',
  contradiction,
  cases L'_hd with a b,
  cases b,
  { specialize hpos (a, ff) (by simp),
    contradiction },
  { specialize hneg (a, tt) _,
    rw hr; simp, contradiction },
  exacts [hneg, hpos],
end

lemma negative_not_positive : negative L → ¬ positive L :=
begin
  rintros ⟨L', hnil, hmk, hneg⟩ ⟨LL', hnil', hmk', hpos⟩,
  rw [hmk, red.exact] at hmk',
  rcases hmk' with ⟨c, hl, hr⟩,
  rw red.all_pos_iff at hr,
  rw red.all_neg_iff at hl,
  rw ← hl at hr,
  cases L',
  contradiction,
  cases L'_hd with a b,
  cases b,
  { specialize hpos (a, ff) _,
    rw hr; simp, contradiction },
  { specialize hneg (a, tt) (by simp),
    contradiction},
  exacts [hneg, hpos],
end

lemma positive_append : positive L → positive L₁ → positive (L ++ L₁)
| ⟨L', hnil, hmk, hpos⟩ ⟨LL', hnil', hmk', hpos'⟩ :=
begin
  use (L' ++ LL'),
  split,
  simp,
  intro h,
  contradiction,
  split,
  repeat {rw ← mul_mk},
  rw [hmk, hmk'],
  intros x hx,
  simp at hx,
  cases hx,
  specialize hpos x hx,
  exact hpos,
  specialize hpos' x hx,
  exact hpos',
end

lemma positive_singleton_iff {x : α × bool} : positive [x] ↔ x.snd = tt :=
begin
  split,
  rintro ⟨L', hnil, hmk, hpos⟩,
  have hmk' := mk_free_group hmk,
  induction x with x b,
  induction b,
  rw [← mul_left_inj (free_group.mk L')⁻¹, mul_inv_self,
      free_group.inv_mk, free_group.mul_mk, list.singleton_append,
      free_group.mk_one_iff, free_group.red.cons_nil_iff_singleton] at hmk',
  simp at *,
  have h₁ := free_group.red.sublist hmk',
  simp at *,
  specialize hpos x ff h₁,
  contradiction,
  refl,
  intro h,
  induction x with x b,
  use ([(x, b)]),
  simp,
  intros a b' h₁ h₂,
  simp at *,
  rw h₂,
  exact h,
end
lemma negative_singleton_iff {x : α × bool} : negative [x] ↔ x.snd = ff :=
begin
  split,
  rintro ⟨L', hnil, hmk, hneg⟩,
  have hmk' := mk_free_group hmk,
  induction x with x b,
  induction b,
  refl,
  rw [← mul_left_inj (free_group.mk L')⁻¹, mul_inv_self,
      free_group.inv_mk, free_group.mul_mk, list.singleton_append,
      free_group.mk_one_iff, free_group.red.cons_nil_iff_singleton] at hmk',
  simp at *,
  have h₁ := free_group.red.sublist hmk',
  simp at *,
  specialize hneg x tt h₁,
  contradiction,
  intro h,
  induction x with x b,
  use ([(x, b)]),
  simp,
  intros a b' h₁ h₂,
  simp at *,
  rw h₂,
  exact h,
end

lemma negative_append : negative L → negative L₁ → negative (L ++ L₁)
| ⟨L', hnil, hmk, hneg⟩ ⟨LL', hnil', hmk', hneg'⟩ :=
begin
  use (L' ++ LL'),
  split,
  simp,
  intro h,
  contradiction,
  split,
  repeat {rw ← mul_mk},
  rw [hmk, hmk'],
  intros x hx,
  simp at hx,
  cases hx,
  specialize hneg x hx,
  exact hneg,
  specialize hneg' x hx,
  exact hneg',
end

lemma negative_cons {x} : negative L → negative ((x, ff) :: L)
| ⟨L', hnil, hmk, hneg⟩ :=
begin
  use ((x, ff) :: L'),
  split,
  simp,
  split,
  rw [← list.singleton_append, ← mul_mk, hmk, mul_mk, list.singleton_append],
  intros x hx,
  simp at hx,
  cases hx,
  rw hx,
  specialize hneg x hx,
  exact hneg,
end

end dyck


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Enumerate elements of a set with a select function.
-/

import data.equiv.encodable data.set.finite data.set.lattice logic.function
noncomputable theory

open function set encodable

namespace set

section enumerate
parameters {α : Type*} (sel : set α → option α)

def enumerate : set α → ℕ → option α
| s 0       := sel s
| s (n + 1) := do a ← sel s, enumerate (s - {a}) n

lemma enumerate_eq_none_of_sel {s : set α} (h : sel s = none) : ∀{n}, enumerate s n = none
| 0       := by simp [h, enumerate]; refl
| (n + 1) := by simp [h, enumerate]; refl

lemma enumerate_eq_none : ∀{s n₁ n₂}, enumerate s n₁ = none → n₁ ≤ n₂ → enumerate s n₂ = none
| s 0       m := assume : sel s = none, by simp [enumerate_eq_none_of_sel, this]
| s (n + 1) m := assume h hm,
  begin
    cases hs : sel s,
    { by simp [enumerate_eq_none_of_sel, hs] },
    { cases m,
      case nat.zero {
        have : n + 1 = 0, from nat.eq_zero_of_le_zero hm,
        contradiction },
      case nat.succ : m' {
        simp [hs, enumerate] at h ⊢,
        have hm : n ≤ m', from nat.le_of_succ_le_succ hm,
        exact enumerate_eq_none h hm } }
  end

lemma enumerate_mem (h_sel : ∀s a, sel s = some a → a ∈ s) :
  ∀{s n a}, enumerate s n = some a → a ∈ s
| s 0 a     := h_sel s a
| s (n+1) a :=
  begin
    cases h : sel s,
    case none { simp [enumerate_eq_none_of_sel, h] },
    case some : a' {
      simp [enumerate, h],
      exact assume h' : enumerate _ (s - {a'}) n = some a,
        have a ∈ s - {a'}, from enumerate_mem h',
        this.left }
  end

lemma enumerate_inj {n₁ n₂ : ℕ} {a : α} {s : set α} (h_sel : ∀s a, sel s = some a → a ∈ s)
  (h₁ : enumerate s n₁ = some a) (h₂ : enumerate s n₂ = some a) : n₁ = n₂ :=
begin
  wlog hn : n₁ ≤ n₂,
  { rcases nat.le.dest hn with ⟨m, rfl⟩, clear hn,
    induction n₁ generalizing s,
    case nat.zero {
      cases m,
      case nat.zero { refl },
      case nat.succ : m {
        have : enumerate sel (s - {a}) m = some a, { simp [enumerate, *] at * },
        have : a ∈ s \ {a}, from enumerate_mem _ h_sel this,
        by simpa } },
    case nat.succ { cases h : sel s; simp [enumerate, nat.add_succ, *] at *; tauto } }
end

end enumerate

end set


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.bind
import data.multiset.powerset
import data.multiset.range

/-!
# The `nodup` predicate for multisets without duplicate elements.
-/

namespace multiset
open list

variables {α β γ : Type*}

/- nodup -/

/-- `nodup s` means that `s` has no duplicates, i.e. the multiplicity of
  any element is at most 1. -/
def nodup (s : multiset α) : Prop :=
quot.lift_on s nodup (λ s t p, propext p.nodup_iff)

@[simp] theorem coe_nodup {l : list α} : @nodup α l ↔ l.nodup := iff.rfl

@[simp] theorem nodup_zero : @nodup α 0 := pairwise.nil

@[simp] theorem nodup_cons {a : α} {s : multiset α} : nodup (a ::ₘ s) ↔ a ∉ s ∧ nodup s :=
quot.induction_on s $ λ l, nodup_cons

theorem nodup_cons_of_nodup {a : α} {s : multiset α} (m : a ∉ s) (n : nodup s) : nodup (a ::ₘ s) :=
nodup_cons.2 ⟨m, n⟩

theorem nodup_singleton : ∀ a : α, nodup ({a} : multiset α) := nodup_singleton

theorem nodup_of_nodup_cons {a : α} {s : multiset α} (h : nodup (a ::ₘ s)) : nodup s :=
(nodup_cons.1 h).2

theorem not_mem_of_nodup_cons {a : α} {s : multiset α} (h : nodup (a ::ₘ s)) : a ∉ s :=
(nodup_cons.1 h).1

theorem nodup_of_le {s t : multiset α} (h : s ≤ t) : nodup t → nodup s :=
le_induction_on h $ λ l₁ l₂, nodup_of_sublist

theorem not_nodup_pair : ∀ a : α, ¬ nodup (a ::ₘ a ::ₘ 0) := not_nodup_pair

theorem nodup_iff_le {s : multiset α} : nodup s ↔ ∀ a : α, ¬ a ::ₘ a ::ₘ 0 ≤ s :=
quot.induction_on s $ λ l, nodup_iff_sublist.trans $ forall_congr $ λ a,
not_congr (@repeat_le_coe _ a 2 _).symm

lemma nodup_iff_ne_cons_cons {s : multiset α} : s.nodup ↔ ∀ a t, s ≠ a ::ₘ a ::ₘ t :=
nodup_iff_le.trans
  ⟨λ h a t s_eq, h a (s_eq.symm ▸ cons_le_cons a (cons_le_cons a (zero_le _))),
   λ h a le, let ⟨t, s_eq⟩ := le_iff_exists_add.mp le in
     h a t (by rwa [cons_add, cons_add, zero_add] at s_eq )⟩

theorem nodup_iff_count_le_one [decidable_eq α] {s : multiset α} : nodup s ↔ ∀ a, count a s ≤ 1 :=
quot.induction_on s $ λ l, nodup_iff_count_le_one

@[simp] theorem count_eq_one_of_mem [decidable_eq α] {a : α} {s : multiset α}
  (d : nodup s) (h : a ∈ s) : count a s = 1 :=
le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)

lemma nodup_iff_pairwise {α} {s : multiset α} : nodup s ↔ pairwise (≠) s :=
quotient.induction_on s $ λ l, (pairwise_coe_iff_pairwise (by exact λ a b, ne.symm)).symm

lemma pairwise_of_nodup {r : α → α → Prop} {s : multiset α} :
  (∀a∈s, ∀b∈s, a ≠ b → r a b) → nodup s → pairwise r s :=
quotient.induction_on s $ assume l h hl, ⟨l, rfl, hl.imp_of_mem $ assume a b ha hb, h a ha b hb⟩

lemma forall_of_pairwise {r : α → α → Prop} (H : symmetric r) {s : multiset α}
   (hs : pairwise r s) : (∀a∈s, ∀b∈s, a ≠ b → r a b) :=
let ⟨l, hl₁, hl₂⟩ := hs in hl₁.symm ▸ list.forall_of_pairwise H hl₂

theorem nodup_add {s t : multiset α} : nodup (s + t) ↔ nodup s ∧ nodup t ∧ disjoint s t :=
quotient.induction_on₂ s t $ λ l₁ l₂, nodup_append

theorem disjoint_of_nodup_add {s t : multiset α} (d : nodup (s + t)) : disjoint s t :=
(nodup_add.1 d).2.2

theorem nodup_add_of_nodup {s t : multiset α} (d₁ : nodup s) (d₂ : nodup t) :
  nodup (s + t) ↔ disjoint s t :=
by simp [nodup_add, d₁, d₂]

theorem nodup_of_nodup_map (f : α → β) {s : multiset α} : nodup (map f s) → nodup s :=
quot.induction_on s $ λ l, nodup_of_nodup_map f

theorem nodup_map_on {f : α → β} {s : multiset α} : (∀x∈s, ∀y∈s, f x = f y → x = y) →
  nodup s → nodup (map f s) :=
quot.induction_on s $ λ l, nodup_map_on

theorem nodup_map {f : α → β} {s : multiset α} (hf : function.injective f) :
  nodup s → nodup (map f s) :=
nodup_map_on (λ x _ y _ h, hf h)

theorem inj_on_of_nodup_map {f : α → β} {s : multiset α} :
  nodup (map f s) → ∀ (x ∈ s) (y ∈ s), f x = f y → x = y :=
quot.induction_on s $ λ l, inj_on_of_nodup_map

theorem nodup_map_iff_inj_on {f : α → β} {s : multiset α} (d : nodup s) :
  nodup (map f s) ↔ (∀ (x ∈ s) (y ∈ s), f x = f y → x = y) :=
⟨inj_on_of_nodup_map, λ h, nodup_map_on h d⟩

theorem nodup_filter (p : α → Prop) [decidable_pred p] {s} : nodup s → nodup (filter p s) :=
quot.induction_on s $ λ l, nodup_filter p

@[simp] theorem nodup_attach {s : multiset α} : nodup (attach s) ↔ nodup s :=
quot.induction_on s $ λ l, nodup_attach

theorem nodup_pmap {p : α → Prop} {f : Π a, p a → β} {s : multiset α} {H}
  (hf : ∀ a ha b hb, f a ha = f b hb → a = b) : nodup s → nodup (pmap f s H) :=
quot.induction_on s (λ l H, nodup_pmap hf) H

instance nodup_decidable [decidable_eq α] (s : multiset α) : decidable (nodup s) :=
quotient.rec_on_subsingleton s $ λ l, l.nodup_decidable

theorem nodup_erase_eq_filter [decidable_eq α] (a : α) {s} : nodup s → s.erase a = filter (≠ a) s :=
quot.induction_on s $ λ l d, congr_arg coe $ nodup_erase_eq_filter a d

theorem nodup_erase_of_nodup [decidable_eq α] (a : α) {l} : nodup l → nodup (l.erase a) :=
nodup_of_le (erase_le _ _)

theorem mem_erase_iff_of_nodup [decidable_eq α] {a b : α} {l} (d : nodup l) :
  a ∈ l.erase b ↔ a ≠ b ∧ a ∈ l :=
by rw nodup_erase_eq_filter b d; simp [and_comm]

theorem mem_erase_of_nodup [decidable_eq α] {a : α} {l} (h : nodup l) : a ∉ l.erase a :=
by rw mem_erase_iff_of_nodup h; simp

theorem nodup_product {s : multiset α} {t : multiset β} : nodup s → nodup t → nodup (product s t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d₁ d₂, by simp [nodup_product d₁ d₂]

theorem nodup_sigma {σ : α → Type*} {s : multiset α} {t : Π a, multiset (σ a)} :
  nodup s → (∀ a, nodup (t a)) → nodup (s.sigma t) :=
quot.induction_on s $ assume l₁,
begin
  choose f hf using assume a, quotient.exists_rep (t a),
  rw show t = λ a, f a, from (eq.symm $ funext $ λ a, hf a),
  simpa using nodup_sigma
end

theorem nodup_filter_map (f : α → option β) {s : multiset α}
  (H : ∀ (a a' : α) (b : β), b ∈ f a → b ∈ f a' → a = a') :
  nodup s → nodup (filter_map f s) :=
quot.induction_on s $ λ l, nodup_filter_map H

theorem nodup_inter_left [decidable_eq α] {s : multiset α} (t) : nodup s → nodup (s ∩ t) :=
nodup_of_le $ inter_le_left _ _

theorem nodup_inter_right [decidable_eq α] (s) {t : multiset α} : nodup t → nodup (s ∩ t) :=
nodup_of_le $ inter_le_right _ _

@[simp] theorem nodup_union [decidable_eq α] {s t : multiset α} :
  nodup (s ∪ t) ↔ nodup s ∧ nodup t :=
⟨λ h, ⟨nodup_of_le (le_union_left _ _) h, nodup_of_le (le_union_right _ _) h⟩,
 λ ⟨h₁, h₂⟩, nodup_iff_count_le_one.2 $ λ a, by rw [count_union]; exact
   max_le (nodup_iff_count_le_one.1 h₁ a) (nodup_iff_count_le_one.1 h₂ a)⟩

@[simp] theorem nodup_powerset {s : multiset α} : nodup (powerset s) ↔ nodup s :=
⟨λ h, nodup_of_nodup_map _ (nodup_of_le (map_single_le_powerset _) h),
  quotient.induction_on s $ λ l h,
  by simp; refine list.nodup_map_on _ (nodup_sublists'.2 h); exact
  λ x sx y sy e,
    (h.sublist_ext (mem_sublists'.1 sx) (mem_sublists'.1 sy)).1
      (quotient.exact e)⟩

theorem nodup_powerset_len {n : ℕ} {s : multiset α}
  (h : nodup s) : nodup (powerset_len n s) :=
nodup_of_le (powerset_len_le_powerset _ _) (nodup_powerset.2 h)

@[simp] lemma nodup_bind {s : multiset α} {t : α → multiset β} :
  nodup (bind s t) ↔ ((∀a∈s, nodup (t a)) ∧ (s.pairwise (λa b, disjoint (t a) (t b)))) :=
have h₁ : ∀a, ∃l:list β, t a = l, from
  assume a, quot.induction_on (t a) $ assume l, ⟨l, rfl⟩,
let ⟨t', h'⟩ := classical.axiom_of_choice h₁ in
have t = λa, t' a, from funext h',
have hd : symmetric (λa b, list.disjoint (t' a) (t' b)), from assume a b h, h.symm,
quot.induction_on s $ by simp [this, list.nodup_bind, pairwise_coe_iff_pairwise hd]

theorem nodup_ext {s t : multiset α} : nodup s → nodup t → (s = t ↔ ∀ a, a ∈ s ↔ a ∈ t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d₁ d₂, quotient.eq.trans $ perm_ext d₁ d₂

theorem le_iff_subset {s t : multiset α} : nodup s → (s ≤ t ↔ s ⊆ t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d, ⟨subset_of_le, subperm_of_subset_nodup d⟩

theorem range_le {m n : ℕ} : range m ≤ range n ↔ m ≤ n :=
(le_iff_subset (nodup_range _)).trans range_subset

theorem mem_sub_of_nodup [decidable_eq α] {a : α} {s t : multiset α} (d : nodup s) :
  a ∈ s - t ↔ a ∈ s ∧ a ∉ t :=
⟨λ h, ⟨mem_of_le tsub_le_self h, λ h',
  by refine count_eq_zero.1 _ h; rw [count_sub a s t, tsub_eq_zero_iff_le];
     exact le_trans (nodup_iff_count_le_one.1 d _) (count_pos.2 h')⟩,
 λ ⟨h₁, h₂⟩, or.resolve_right (mem_add.1 $ mem_of_le le_tsub_add h₁) h₂⟩

lemma map_eq_map_of_bij_of_nodup (f : α → γ) (g : β → γ) {s : multiset α} {t : multiset β}
  (hs : s.nodup) (ht : t.nodup) (i : Πa∈s, β)
  (hi : ∀a ha, i a ha ∈ t) (h : ∀a ha, f a = g (i a ha))
  (i_inj : ∀a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂)
  (i_surj : ∀b∈t, ∃a ha, b = i a ha) :
  s.map f = t.map g :=
have t = s.attach.map (λ x, i x.1 x.2),
  from (nodup_ext ht (nodup_map
      (show function.injective (λ x : {x // x ∈ s}, i x.1 x.2), from λ x y hxy,
        subtype.eq (i_inj x.1 y.1 x.2 y.2 hxy))
      (nodup_attach.2 hs))).2
    (λ x, by simp only [mem_map, true_and, subtype.exists, eq_comm, mem_attach];
      exact ⟨i_surj _, λ ⟨y, hy⟩, hy.snd.symm ▸ hi _ _⟩),
calc s.map f = s.pmap  (λ x _, f x) (λ _, id) : by rw [pmap_eq_map]
... = s.attach.map (λ x, f x.1) : by rw [pmap_eq_map_attach]
... = t.map g : by rw [this, multiset.map_map]; exact map_congr rfl (λ x _, h _ _)

end multiset


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module order.rel_iso.group
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Group.Defs
import Mathbin.Order.RelIso.Basic

/-!
# Relation isomorphisms form a group

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

variable {α : Type _} {r : α → α → Prop}

namespace RelIso

instance : Group (r ≃r r) where
  one := RelIso.refl r
  mul f₁ f₂ := f₂.trans f₁
  inv := RelIso.symm
  mul_assoc f₁ f₂ f₃ := rfl
  one_mul f := ext fun _ => rfl
  mul_one f := ext fun _ => rfl
  mul_left_inv f := ext f.symm_apply_apply

/- warning: rel_iso.coe_one -> RelIso.coe_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop}, Eq.{succ u1} (α -> α) (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) (OfNat.ofNat.{u1} (RelIso.{u1, u1} α α r r) 1 (OfNat.mk.{u1} (RelIso.{u1, u1} α α r r) 1 (One.one.{u1} (RelIso.{u1, u1} α α r r) (MulOneClass.toHasOne.{u1} (RelIso.{u1, u1} α α r r) (Monoid.toMulOneClass.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toMonoid.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.group.{u1} α r))))))))) (id.{succ u1} α)
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop}, Eq.{succ u1} (forall (ᾰ : α), (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) ᾰ) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r (OfNat.ofNat.{u1} (RelIso.{u1, u1} α α r r) 1 (One.toOfNat1.{u1} (RelIso.{u1, u1} α α r r) (RightCancelMonoid.toOne.{u1} (RelIso.{u1, u1} α α r r) (CancelMonoid.toRightCancelMonoid.{u1} (RelIso.{u1, u1} α α r r) (Group.toCancelMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.instGroupRelIso.{u1} α r))))))))) (id.{succ u1} α)
Case conversion may be inaccurate. Consider using '#align rel_iso.coe_one RelIso.coe_oneₓ'. -/
@[simp]
theorem coe_one : ⇑(1 : r ≃r r) = id :=
  rfl
#align rel_iso.coe_one RelIso.coe_one

/- warning: rel_iso.coe_mul -> RelIso.coe_mul is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e₁ : RelIso.{u1, u1} α α r r) (e₂ : RelIso.{u1, u1} α α r r), Eq.{succ u1} (α -> α) (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) (HMul.hMul.{u1, u1, u1} (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (instHMul.{u1} (RelIso.{u1, u1} α α r r) (MulOneClass.toHasMul.{u1} (RelIso.{u1, u1} α α r r) (Monoid.toMulOneClass.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toMonoid.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.group.{u1} α r)))))) e₁ e₂)) (Function.comp.{succ u1, succ u1, succ u1} α α α (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) e₁) (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) e₂))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e₁ : RelIso.{u1, u1} α α r r) (e₂ : RelIso.{u1, u1} α α r r), Eq.{succ u1} (forall (ᾰ : α), (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) ᾰ) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r (HMul.hMul.{u1, u1, u1} (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (instHMul.{u1} (RelIso.{u1, u1} α α r r) (MulOneClass.toMul.{u1} (RelIso.{u1, u1} α α r r) (Monoid.toMulOneClass.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toMonoid.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.instGroupRelIso.{u1} α r)))))) e₁ e₂)))) (Function.comp.{succ u1, succ u1, succ u1} α α α (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e₁))) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e₂))))
Case conversion may be inaccurate. Consider using '#align rel_iso.coe_mul RelIso.coe_mulₓ'. -/
@[simp]
theorem coe_mul (e₁ e₂ : r ≃r r) : ⇑(e₁ * e₂) = e₁ ∘ e₂ :=
  rfl
#align rel_iso.coe_mul RelIso.coe_mul

/- warning: rel_iso.mul_apply -> RelIso.mul_apply is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e₁ : RelIso.{u1, u1} α α r r) (e₂ : RelIso.{u1, u1} α α r r) (x : α), Eq.{succ u1} α (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) (HMul.hMul.{u1, u1, u1} (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (instHMul.{u1} (RelIso.{u1, u1} α α r r) (MulOneClass.toHasMul.{u1} (RelIso.{u1, u1} α α r r) (Monoid.toMulOneClass.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toMonoid.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.group.{u1} α r)))))) e₁ e₂) x) (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) e₁ (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) e₂ x))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e₁ : RelIso.{u1, u1} α α r r) (e₂ : RelIso.{u1, u1} α α r r) (x : α), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) x) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r (HMul.hMul.{u1, u1, u1} (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (RelIso.{u1, u1} α α r r) (instHMul.{u1} (RelIso.{u1, u1} α α r r) (MulOneClass.toMul.{u1} (RelIso.{u1, u1} α α r r) (Monoid.toMulOneClass.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toMonoid.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.instGroupRelIso.{u1} α r)))))) e₁ e₂))) x) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e₁)) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e₂)) x))
Case conversion may be inaccurate. Consider using '#align rel_iso.mul_apply RelIso.mul_applyₓ'. -/
theorem mul_apply (e₁ e₂ : r ≃r r) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) :=
  rfl
#align rel_iso.mul_apply RelIso.mul_apply

/- warning: rel_iso.inv_apply_self -> RelIso.inv_apply_self is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e : RelIso.{u1, u1} α α r r) (x : α), Eq.{succ u1} α (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) (Inv.inv.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toHasInv.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.group.{u1} α r))) e) (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) e x)) x
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e : RelIso.{u1, u1} α α r r) (x : α), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (a : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) a) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e)) x)) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r (Inv.inv.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toInv.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.instGroupRelIso.{u1} α r))) e))) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e)) x)) x
Case conversion may be inaccurate. Consider using '#align rel_iso.inv_apply_self RelIso.inv_apply_selfₓ'. -/
@[simp]
theorem inv_apply_self (e : r ≃r r) (x) : e⁻¹ (e x) = x :=
  e.symm_apply_apply x
#align rel_iso.inv_apply_self RelIso.inv_apply_self

/- warning: rel_iso.apply_inv_self -> RelIso.apply_inv_self is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e : RelIso.{u1, u1} α α r r) (x : α), Eq.{succ u1} α (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) e (coeFn.{succ u1, succ u1} (RelIso.{u1, u1} α α r r) (fun (_x : RelIso.{u1, u1} α α r r) => α -> α) (RelIso.hasCoeToFun.{u1, u1} α α r r) (Inv.inv.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toHasInv.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.group.{u1} α r))) e) x)) x
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} (e : RelIso.{u1, u1} α α r r) (x : α), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (a : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) a) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r (Inv.inv.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toInv.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.instGroupRelIso.{u1} α r))) e))) x)) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r e)) (FunLike.coe.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : α) => α) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (Function.Embedding.{succ u1, succ u1} α α) α α (Function.instEmbeddingLikeEmbedding.{succ u1, succ u1} α α)) (RelEmbedding.toEmbedding.{u1, u1} α α r r (RelIso.toRelEmbedding.{u1, u1} α α r r (Inv.inv.{u1} (RelIso.{u1, u1} α α r r) (DivInvMonoid.toInv.{u1} (RelIso.{u1, u1} α α r r) (Group.toDivInvMonoid.{u1} (RelIso.{u1, u1} α α r r) (RelIso.instGroupRelIso.{u1} α r))) e))) x)) x
Case conversion may be inaccurate. Consider using '#align rel_iso.apply_inv_self RelIso.apply_inv_selfₓ'. -/
@[simp]
theorem apply_inv_self (e : r ≃r r) (x) : e (e⁻¹ x) = x :=
  e.apply_symm_apply x
#align rel_iso.apply_inv_self RelIso.apply_inv_self

end RelIso


/-
Copyright (c) 2018 Johannes Hölzl. 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
-/
import group_theory.group_action.defs
import group_theory.submonoid.basic

/-!
# Operations on `submonoid`s

In this file we define various operations on `submonoid`s and `monoid_hom`s.

## Main definitions

### Conversion between multiplicative and additive definitions

* `submonoid.to_add_submonoid`, `submonoid.to_add_submonoid'`, `add_submonoid.to_submonoid`,
  `add_submonoid.to_submonoid'`: convert between multiplicative and additive submonoids of `M`,
  `multiplicative M`, and `additive M`. These are stated as `order_iso`s.

### (Commutative) monoid structure on a submonoid

* `submonoid.to_monoid`, `submonoid.to_comm_monoid`: a submonoid inherits a (commutative) monoid
  structure.

### Group actions by submonoids

* `submonoid.mul_action`, `submonoid.distrib_mul_action`: a submonoid inherits (distributive)
  multiplicative actions.

### Operations on submonoids

* `submonoid.comap`: preimage of a submonoid under a monoid homomorphism as a submonoid of the
  domain;
* `submonoid.map`: image of a submonoid under a monoid homomorphism as a submonoid of the codomain;
* `submonoid.prod`: product of two submonoids `s : submonoid M` and `t : submonoid N` as a submonoid
  of `M × N`;

### Monoid homomorphisms between submonoid

* `submonoid.subtype`: embedding of a submonoid into the ambient monoid.
* `submonoid.inclusion`: given two submonoids `S`, `T` such that `S ≤ T`, `S.inclusion T` is the
  inclusion of `S` into `T` as a monoid homomorphism;
* `mul_equiv.submonoid_congr`: converts a proof of `S = T` into a monoid isomorphism between `S`
  and `T`.
* `submonoid.prod_equiv`: monoid isomorphism between `s.prod t` and `s × t`;

### Operations on `monoid_hom`s

* `monoid_hom.mrange`: range of a monoid homomorphism as a submonoid of the codomain;
* `monoid_hom.mker`: kernel of a monoid homomorphism as a submonoid of the domain;
* `monoid_hom.mrestrict`: restrict a monoid homomorphism to a submonoid;
* `monoid_hom.cod_mrestrict`: restrict the codomain of a monoid homomorphism to a submonoid;
* `monoid_hom.mrange_restrict`: restrict a monoid homomorphism to its range;

## Tags

submonoid, range, product, map, comap
-/

variables {M N P : Type*} [mul_one_class M] [mul_one_class N] [mul_one_class P] (S : submonoid M)

/-!
### Conversion to/from `additive`/`multiplicative`
-/

section

/-- Submonoids of monoid `M` are isomorphic to additive submonoids of `additive M`. -/
@[simps]
def submonoid.to_add_submonoid : submonoid M ≃o add_submonoid (additive M) :=
{ to_fun := λ S,
  { carrier := additive.to_mul ⁻¹' S,
    zero_mem' := S.one_mem',
    add_mem' := S.mul_mem' },
  inv_fun := λ S,
  { carrier := additive.of_mul ⁻¹' S,
    one_mem' := S.zero_mem',
    mul_mem' := S.add_mem' },
  left_inv := λ x, by cases x; refl,
  right_inv := λ x, by cases x; refl,
  map_rel_iff' := λ a b, iff.rfl, }

/-- Additive submonoids of an additive monoid `additive M` are isomorphic to submonoids of `M`. -/
abbreviation add_submonoid.to_submonoid' : add_submonoid (additive M) ≃o submonoid M :=
submonoid.to_add_submonoid.symm

lemma submonoid.to_add_submonoid_closure (S : set M) :
  (submonoid.closure S).to_add_submonoid = add_submonoid.closure (additive.to_mul ⁻¹' S) :=
le_antisymm
  (submonoid.to_add_submonoid.le_symm_apply.1 $
    submonoid.closure_le.2 add_submonoid.subset_closure)
  (add_submonoid.closure_le.2 submonoid.subset_closure)

lemma add_submonoid.to_submonoid'_closure (S : set (additive M)) :
  (add_submonoid.closure S).to_submonoid' = submonoid.closure (multiplicative.of_add ⁻¹' S) :=
le_antisymm
  (add_submonoid.to_submonoid'.le_symm_apply.1 $
    add_submonoid.closure_le.2 submonoid.subset_closure)
  (submonoid.closure_le.2 add_submonoid.subset_closure)

end

section

variables {A : Type*} [add_zero_class A]

/-- Additive submonoids of an additive monoid `A` are isomorphic to
multiplicative submonoids of `multiplicative A`. -/
@[simps]
def add_submonoid.to_submonoid : add_submonoid A ≃o submonoid (multiplicative A) :=
{ to_fun := λ S,
  { carrier := multiplicative.to_add ⁻¹' S,
    one_mem' := S.zero_mem',
    mul_mem' := S.add_mem' },
  inv_fun := λ S,
  { carrier := multiplicative.of_add ⁻¹' S,
    zero_mem' := S.one_mem',
    add_mem' := S.mul_mem' },
  left_inv := λ x, by cases x; refl,
  right_inv := λ x, by cases x; refl,
  map_rel_iff' := λ a b, iff.rfl, }

/-- Submonoids of a monoid `multiplicative A` are isomorphic to additive submonoids of `A`. -/
abbreviation submonoid.to_add_submonoid' : submonoid (multiplicative A) ≃o add_submonoid A :=
add_submonoid.to_submonoid.symm

lemma add_submonoid.to_submonoid_closure (S : set A) :
  (add_submonoid.closure S).to_submonoid = submonoid.closure (multiplicative.to_add ⁻¹' S) :=
le_antisymm
  (add_submonoid.to_submonoid.to_galois_connection.l_le $
    add_submonoid.closure_le.2 submonoid.subset_closure)
  (submonoid.closure_le.2 add_submonoid.subset_closure)

lemma submonoid.to_add_submonoid'_closure (S : set (multiplicative A)) :
  (submonoid.closure S).to_add_submonoid' = add_submonoid.closure (additive.of_mul ⁻¹' S) :=
le_antisymm
  (submonoid.to_add_submonoid'.to_galois_connection.l_le $
    submonoid.closure_le.2 add_submonoid.subset_closure)
  (add_submonoid.closure_le.2 submonoid.subset_closure)

end

namespace submonoid

open set

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

/-- The preimage of a submonoid along a monoid homomorphism is a submonoid. -/
@[to_additive "The preimage of an `add_submonoid` along an `add_monoid` homomorphism is an
`add_submonoid`."]
def comap (f : M →* N) (S : submonoid N) : submonoid M :=
{ carrier := (f ⁻¹' S),
  one_mem' := show f 1 ∈ S, by rw f.map_one; exact S.one_mem,
  mul_mem' := λ a b ha hb,
    show f (a * b) ∈ S, by rw f.map_mul; exact S.mul_mem ha hb }

@[simp, to_additive]
lemma coe_comap (S : submonoid N) (f : M →* N) : (S.comap f : set M) = f ⁻¹' S := rfl

@[simp, to_additive]
lemma mem_comap {S : submonoid N} {f : M →* N} {x : M} : x ∈ S.comap f ↔ f x ∈ S := iff.rfl

@[to_additive]
lemma comap_comap (S : submonoid P) (g : N →* P) (f : M →* N) :
  (S.comap g).comap f = S.comap (g.comp f) :=
rfl

@[simp, to_additive]
lemma comap_id (S : submonoid P) : S.comap (monoid_hom.id _) = S :=
ext (by simp)

/-- The image of a submonoid along a monoid homomorphism is a submonoid. -/
@[to_additive "The image of an `add_submonoid` along an `add_monoid` homomorphism is
an `add_submonoid`."]
def map (f : M →* N) (S : submonoid M) : submonoid N :=
{ carrier := (f '' S),
  one_mem' := ⟨1, S.one_mem, f.map_one⟩,
  mul_mem' := begin rintros _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩, exact ⟨x * y, S.mul_mem hx hy,
    by rw f.map_mul; refl⟩ end }

@[simp, to_additive]
lemma coe_map (f : M →* N) (S : submonoid M) :
  (S.map f : set N) = f '' S := rfl

@[simp, to_additive]
lemma mem_map {f : M →* N} {S : submonoid M} {y : N} :
  y ∈ S.map f ↔ ∃ x ∈ S, f x = y :=
mem_image_iff_bex

@[to_additive]
lemma mem_map_of_mem (f : M →* N) {S : submonoid M} {x : M} (hx : x ∈ S) : f x ∈ S.map f :=
mem_image_of_mem f hx

@[to_additive]
lemma apply_coe_mem_map (f : M →* N) (S : submonoid M) (x : S) : f x ∈ S.map f :=
mem_map_of_mem f x.prop

@[to_additive]
lemma map_map (g : N →* P) (f : M →* N) : (S.map f).map g = S.map (g.comp f) :=
set_like.coe_injective $ image_image _ _ _

@[to_additive]
lemma mem_map_iff_mem {f : M →* N} (hf : function.injective f) {S : submonoid M} {x : M} :
  f x ∈ S.map f ↔ x ∈ S :=
hf.mem_set_image

@[to_additive]
lemma map_le_iff_le_comap {f : M →* N} {S : submonoid M} {T : submonoid N} :
  S.map f ≤ T ↔ S ≤ T.comap f :=
image_subset_iff

@[to_additive]
lemma gc_map_comap (f : M →* N) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

@[to_additive]
lemma map_le_of_le_comap {T : submonoid N} {f : M →* N} : S ≤ T.comap f → S.map f ≤ T :=
(gc_map_comap f).l_le

@[to_additive]
lemma le_comap_of_map_le {T : submonoid N} {f : M →* N} : S.map f ≤ T → S ≤ T.comap f :=
(gc_map_comap f).le_u

@[to_additive]
lemma le_comap_map {f : M →* N} : S ≤ (S.map f).comap f :=
(gc_map_comap f).le_u_l _

@[to_additive]
lemma map_comap_le {S : submonoid N} {f : M →* N} : (S.comap f).map f ≤ S :=
(gc_map_comap f).l_u_le _

@[to_additive]
lemma monotone_map {f : M →* N} : monotone (map f) :=
(gc_map_comap f).monotone_l

@[to_additive]
lemma monotone_comap {f : M →* N} : monotone (comap f) :=
(gc_map_comap f).monotone_u

@[simp, to_additive]
lemma 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 _

@[simp, to_additive]
lemma comap_map_comap {S : submonoid N} {f : M →* N} : ((S.comap f).map f).comap f = S.comap f :=
(gc_map_comap f).u_l_u_eq_u _

@[to_additive]
lemma map_sup (S T : submonoid M) (f : M →* N) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
(gc_map_comap f).l_sup

@[to_additive]
lemma map_supr {ι : Sort*} (f : M →* N) (s : ι → submonoid M) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

@[to_additive]
lemma comap_inf (S T : submonoid N) (f : M →* N) : (S ⊓ T).comap f = S.comap f ⊓ T.comap f :=
(gc_map_comap f).u_inf

@[to_additive]
lemma comap_infi {ι : Sort*} (f : M →* N) (s : ι → submonoid N) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp, to_additive] lemma map_bot (f : M →* N) : (⊥ : submonoid M).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp, to_additive]

@[simp, to_additive] lemma map_id (S : submonoid M) : S.map (monoid_hom.id M) = S :=
ext (λ x, ⟨λ ⟨_, h, rfl⟩, h, λ h, ⟨_, h, rfl⟩⟩)

section galois_coinsertion

variables {ι : Type*} {f : M →* N} (hf : function.injective f)

include hf

/-- `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. -/
@[to_additive /-" `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. "-/]
def gci_map_comap : galois_coinsertion (map f) (comap f) :=
(gc_map_comap f).to_galois_coinsertion
  (λ S x, by simp [mem_comap, mem_map, hf.eq_iff])

@[to_additive]
lemma comap_map_eq_of_injective (S : submonoid M) : (S.map f).comap f = S :=
(gci_map_comap hf).u_l_eq _

@[to_additive]
lemma comap_surjective_of_injective : function.surjective (comap f) :=
(gci_map_comap hf).u_surjective

@[to_additive]
lemma map_injective_of_injective : function.injective (map f) :=
(gci_map_comap hf).l_injective

@[to_additive]
lemma comap_inf_map_of_injective (S T : submonoid M) : (S.map f ⊓ T.map f).comap f = S ⊓ T :=
(gci_map_comap hf).u_inf_l _ _

@[to_additive]
lemma comap_infi_map_of_injective (S : ι → submonoid M) : (⨅ i, (S i).map f).comap f = infi S :=
(gci_map_comap hf).u_infi_l _

@[to_additive]
lemma comap_sup_map_of_injective (S T : submonoid M) : (S.map f ⊔ T.map f).comap f = S ⊔ T :=
(gci_map_comap hf).u_sup_l _ _

@[to_additive]
lemma comap_supr_map_of_injective (S : ι → submonoid M) : (⨆ i, (S i).map f).comap f = supr S :=
(gci_map_comap hf).u_supr_l _

@[to_additive]
lemma map_le_map_iff_of_injective {S T : submonoid M} : S.map f ≤ T.map f ↔ S ≤ T :=
(gci_map_comap hf).l_le_l_iff

@[to_additive]
lemma map_strict_mono_of_injective : strict_mono (map f) :=
(gci_map_comap hf).strict_mono_l

end galois_coinsertion

section galois_insertion

variables {ι : Type*} {f : M →* N} (hf : function.surjective f)

include hf

/-- `map f` and `comap f` form a `galois_insertion` when `f` is surjective. -/
@[to_additive /-" `map f` and `comap f` form a `galois_insertion` when `f` is surjective. "-/]
def gi_map_comap : galois_insertion (map f) (comap f) :=
(gc_map_comap f).to_galois_insertion
  (λ S x h, let ⟨y, hy⟩ := hf x in mem_map.2 ⟨y, by simp [hy, h]⟩)

@[to_additive]
lemma map_comap_eq_of_surjective (S : submonoid N) : (S.comap f).map f = S :=
(gi_map_comap hf).l_u_eq _

@[to_additive]
lemma map_surjective_of_surjective : function.surjective (map f) :=
(gi_map_comap hf).l_surjective

@[to_additive]
lemma comap_injective_of_surjective : function.injective (comap f) :=
(gi_map_comap hf).u_injective

@[to_additive]
lemma map_inf_comap_of_surjective (S T : submonoid N) : (S.comap f ⊓ T.comap f).map f = S ⊓ T :=
(gi_map_comap hf).l_inf_u _ _

@[to_additive]
lemma map_infi_comap_of_surjective (S : ι → submonoid N) : (⨅ i, (S i).comap f).map f = infi S :=
(gi_map_comap hf).l_infi_u _

@[to_additive]
lemma map_sup_comap_of_surjective (S T : submonoid N) : (S.comap f ⊔ T.comap f).map f = S ⊔ T :=
(gi_map_comap hf).l_sup_u _ _

@[to_additive]
lemma map_supr_comap_of_surjective (S : ι → submonoid N) : (⨆ i, (S i).comap f).map f = supr S :=
(gi_map_comap hf).l_supr_u _

@[to_additive]
lemma comap_le_comap_iff_of_surjective {S T : submonoid N} : S.comap f ≤ T.comap f ↔ S ≤ T :=
(gi_map_comap hf).u_le_u_iff

@[to_additive]
lemma comap_strict_mono_of_surjective : strict_mono (comap f) :=
(gi_map_comap hf).strict_mono_u

end galois_insertion

end submonoid

namespace submonoid_class

variables {A : Type*} [set_like A M] [hA : submonoid_class A M] (S' : A)
include hA

open mul_mem_class

/-- A submonoid of a monoid inherits a multiplication. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an addition."]
instance has_mul : has_mul S' := ⟨λ a b, ⟨a.1 * b.1, mul_mem a.2 b.2⟩⟩

/-- A submonoid of a monoid inherits a 1. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits a zero."]
instance has_one : has_one S' := ⟨⟨_, one_mem S'⟩⟩

@[simp, norm_cast, to_additive] lemma coe_mul (x y : S') : (↑(x * y) : M) = ↑x * ↑y := rfl
@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S') : M) = 1 := rfl

variables {S'}
@[simp, norm_cast, to_additive] lemma coe_eq_one {x : S'} : (↑x : M) = 1 ↔ x = 1 :=
(subtype.ext_iff.symm : (x : M) = (1 : S') ↔ x = 1)
variables (S')

@[simp, to_additive] lemma mk_mul_mk (x y : M) (hx : x ∈ S') (hy : y ∈ S') :
  (⟨x, hx⟩ : S') * ⟨y, hy⟩ = ⟨x * y, mul_mem hx hy⟩ := rfl

@[to_additive] lemma mul_def (x y : S') : x * y = ⟨x * y, mul_mem x.2 y.2⟩ := rfl
@[to_additive] lemma one_def : (1 : S') = ⟨1, one_mem S'⟩ := rfl

omit hA

/-- An `add_submonoid` of an `add_monoid` inherits a scalar multiplication. -/
instance _root_.add_submonoid_class.has_nsmul {M} [add_monoid M] {A : Type*} [set_like A M]
  [add_submonoid_class A M] (S : A) :
  has_scalar ℕ S :=
⟨λ n a, ⟨n • a.1, nsmul_mem a.2 n⟩⟩

/-- A submonoid of a monoid inherits a power operator. -/
instance has_pow {M} [monoid M] {A : Type*} [set_like A M] [submonoid_class A M] (S : A) :
  has_pow S ℕ :=
⟨λ a n, ⟨a.1 ^ n, pow_mem a.2 n⟩⟩

attribute [to_additive] submonoid_class.has_pow

@[simp, norm_cast, to_additive] lemma coe_pow {M} [monoid M] {A : Type*} [set_like A M]
  [submonoid_class A M] {S : A} (x : S) (n : ℕ) :
  (↑(x ^ n) : M) = ↑x ^ n :=
rfl

@[simp, to_additive] lemma mk_pow {M} [monoid M] {A : Type*} [set_like A M]
  [submonoid_class A M] {S : A} (x : M) (hx : x ∈ S) (n : ℕ) :
  (⟨x, hx⟩ : S) ^ n = ⟨x ^ n, pow_mem hx n⟩ :=
rfl

/-- A submonoid of a unital magma inherits a unital magma structure. -/
@[to_additive "An `add_submonoid` of an unital additive magma inherits an unital additive magma
structure.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_mul_one_class {M : Type*} [mul_one_class M] {A : Type*} [set_like A M]
  [submonoid_class A M] (S : A) : mul_one_class S :=
subtype.coe_injective.mul_one_class _ rfl (λ _ _, rfl)

/-- A submonoid of a monoid inherits a monoid structure. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an `add_monoid`
structure.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_monoid {M : Type*} [monoid M] {A : Type*} [set_like A M] [submonoid_class A M]
  (S : A) : monoid S :=
subtype.coe_injective.monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `comm_monoid` is a `comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `add_comm_monoid` is
an `add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_comm_monoid {M} [comm_monoid M] {A : Type*} [set_like A M] [submonoid_class A M]
  (S : A) : comm_monoid S :=
subtype.coe_injective.comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_comm_monoid` is an `ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_add_comm_monoid` is
an `ordered_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_ordered_comm_monoid {M} [ordered_comm_monoid M] {A : Type*} [set_like A M]
  [submonoid_class A M] (S : A) : ordered_comm_monoid S :=
subtype.coe_injective.ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_comm_monoid` is a `linear_ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of a `linear_ordered_add_comm_monoid` is
a `linear_ordered_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] {A : Type*}
  [set_like A M] [submonoid_class A M] (S : A) :
  linear_ordered_comm_monoid S :=
subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
an `ordered_cancel_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_ordered_cancel_comm_monoid {M} [ordered_cancel_comm_monoid M] {A : Type*}
  [set_like A M] [submonoid_class A M] (S : A) :
  ordered_cancel_comm_monoid S :=
subtype.coe_injective.ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_cancel_comm_monoid` is a `linear_ordered_cancel_comm_monoid`.
-/
@[to_additive "An `add_submonoid` of a `linear_ordered_cancel_add_comm_monoid` is
a `linear_ordered_cancel_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
  {A : Type*} [set_like A M] [submonoid_class A M] (S : A) : linear_ordered_cancel_comm_monoid S :=
subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

include hA

/-- The natural monoid hom from a submonoid of monoid `M` to `M`. -/
@[to_additive "The natural monoid hom from an `add_submonoid` of `add_monoid` `M` to `M`."]
def subtype : S' →* M := ⟨coe, rfl, λ _ _, rfl⟩

@[simp, to_additive] theorem coe_subtype : (submonoid_class.subtype S' : S' → M) = coe := rfl

end submonoid_class

namespace submonoid

/-- A submonoid of a monoid inherits a multiplication. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an addition."]
instance has_mul : has_mul S := ⟨λ a b, ⟨a.1 * b.1, S.mul_mem a.2 b.2⟩⟩

/-- A submonoid of a monoid inherits a 1. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits a zero."]
instance has_one : has_one S := ⟨⟨_, S.one_mem⟩⟩

@[simp, norm_cast, to_additive] lemma coe_mul (x y : S) : (↑(x * y) : M) = ↑x * ↑y := rfl
@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S) : M) = 1 := rfl

@[simp, to_additive] lemma mk_mul_mk (x y : M) (hx : x ∈ S) (hy : y ∈ S) :
  (⟨x, hx⟩ : S) * ⟨y, hy⟩ = ⟨x * y, S.mul_mem hx hy⟩ := rfl

@[to_additive] lemma mul_def (x y : S) : x * y = ⟨x * y, S.mul_mem x.2 y.2⟩ := rfl
@[to_additive] lemma one_def : (1 : S) = ⟨1, S.one_mem⟩ := rfl

/-- A submonoid of a unital magma inherits a unital magma structure. -/
@[to_additive "An `add_submonoid` of an unital additive magma inherits an unital additive magma
structure."]
instance to_mul_one_class {M : Type*} [mul_one_class M] (S : submonoid M) : mul_one_class S :=
subtype.coe_injective.mul_one_class coe rfl (λ _ _, rfl)

@[to_additive] lemma pow_mem {M : Type*} [monoid M] (S : submonoid M) {x : M}
  (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S :=
pow_mem hx n

instance _root_.add_submonoid.has_nsmul {M : Type*} [add_monoid M] (S : add_submonoid M) :
  has_scalar ℕ S :=
⟨λ n x, ⟨n • x, S.nsmul_mem x.prop _⟩⟩

@[to_additive]
instance has_pow {M : Type*} [monoid M] (S : submonoid M) : has_pow S ℕ :=
⟨λ x n, ⟨x ^ n, S.pow_mem x.prop _⟩⟩

@[simp, norm_cast, to_additive] theorem coe_pow  {M : Type*} [monoid M] {S : submonoid M}
  (x : S) (n : ℕ) : ↑(x ^ n) = (x ^ n : M) :=
rfl

/-- A submonoid of a monoid inherits a monoid structure. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an `add_monoid`
structure."]
instance to_monoid {M : Type*} [monoid M] (S : submonoid M) : monoid S :=
subtype.coe_injective.monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `comm_monoid` is a `comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `add_comm_monoid` is
an `add_comm_monoid`."]
instance to_comm_monoid {M} [comm_monoid M] (S : submonoid M) : comm_monoid S :=
subtype.coe_injective.comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_comm_monoid` is an `ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_add_comm_monoid` is
an `ordered_add_comm_monoid`."]
instance to_ordered_comm_monoid {M} [ordered_comm_monoid M] (S : submonoid M) :
  ordered_comm_monoid S :=
subtype.coe_injective.ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_comm_monoid` is a `linear_ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of a `linear_ordered_add_comm_monoid` is
a `linear_ordered_add_comm_monoid`."]
instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] (S : submonoid M) :
  linear_ordered_comm_monoid S :=
subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
an `ordered_cancel_add_comm_monoid`."]
instance to_ordered_cancel_comm_monoid {M} [ordered_cancel_comm_monoid M] (S : submonoid M) :
  ordered_cancel_comm_monoid S :=
subtype.coe_injective.ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_cancel_comm_monoid` is a `linear_ordered_cancel_comm_monoid`.
-/
@[to_additive "An `add_submonoid` of a `linear_ordered_cancel_add_comm_monoid` is
a `linear_ordered_cancel_add_comm_monoid`."]
instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
  (S : submonoid M) : linear_ordered_cancel_comm_monoid S :=
subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- The natural monoid hom from a submonoid of monoid `M` to `M`. -/
@[to_additive "The natural monoid hom from an `add_submonoid` of `add_monoid` `M` to `M`."]
def subtype : S →* M := ⟨coe, rfl, λ _ _, rfl⟩

@[simp, to_additive] theorem coe_subtype : ⇑S.subtype = coe := rfl

/-- The top submonoid is isomorphic to the monoid. -/
@[to_additive "The top additive submonoid is isomorphic to the additive monoid.", simps]
def top_equiv : (⊤ : submonoid M) ≃* M :=
{ to_fun    := λ x, x,
  inv_fun   := λ x, ⟨x, mem_top x⟩,
  left_inv  := λ x, x.eta _,
  right_inv := λ _, rfl,
  map_mul'  := λ _ _, rfl }

@[simp, to_additive] lemma top_equiv_to_monoid_hom :
  (top_equiv : _ ≃* M).to_monoid_hom = (⊤ : submonoid M).subtype :=
rfl

/-- A submonoid is isomorphic to its image under an injective function -/
@[to_additive "An additive submonoid is isomorphic to its image under an injective function"]
noncomputable def equiv_map_of_injective
  (f : M →* N) (hf : function.injective f) : S ≃* S.map f :=
{ map_mul' := λ _ _, subtype.ext (f.map_mul _ _), ..equiv.set.image f S hf }

@[simp, to_additive] lemma coe_equiv_map_of_injective_apply
  (f : M →* N) (hf : function.injective f) (x : S) :
  (equiv_map_of_injective S f hf x : N) = f x := rfl

@[simp, to_additive]
lemma closure_closure_coe_preimage {s : set M} : closure ((coe : closure s → M) ⁻¹' s) = ⊤ :=
eq_top_iff.2 $ λ x, subtype.rec_on x $ λ x hx _, begin
  refine closure_induction' _ (λ g hg, _) _ (λ g₁ g₂ hg₁ hg₂, _) hx,
  { exact subset_closure hg },
  { exact submonoid.one_mem _ },
  { exact submonoid.mul_mem _ },
end

/-- Given `submonoid`s `s`, `t` of monoids `M`, `N` respectively, `s × t` as a submonoid
of `M × N`. -/
@[to_additive prod "Given `add_submonoid`s `s`, `t` of `add_monoid`s `A`, `B` respectively, `s × t`
as an `add_submonoid` of `A × B`."]
def prod (s : submonoid M) (t : submonoid N) : submonoid (M × N) :=
{ carrier := (s : set M) ×ˢ (t : set N),
  one_mem' := ⟨s.one_mem, t.one_mem⟩,
  mul_mem' := λ p q hp hq, ⟨s.mul_mem hp.1 hq.1, t.mul_mem hp.2 hq.2⟩ }

@[to_additive coe_prod]
lemma coe_prod (s : submonoid M) (t : submonoid N) :
 (s.prod t : set (M × N)) = (s : set M) ×ˢ (t : set N) :=
rfl

@[to_additive mem_prod]
lemma mem_prod {s : submonoid M} {t : submonoid N} {p : M × N} :
  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[to_additive prod_mono]
lemma prod_mono {s₁ s₂ : submonoid M} {t₁ t₂ : submonoid N} (hs : s₁ ≤ s₂) (ht : t₁ ≤ t₂) :
  s₁.prod t₁ ≤ s₂.prod t₂ :=
set.prod_mono hs ht

@[to_additive prod_top]
lemma prod_top (s : submonoid M) :
  s.prod (⊤ : submonoid N) = s.comap (monoid_hom.fst M N) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]

@[to_additive top_prod]
lemma top_prod (s : submonoid N) :
  (⊤ : submonoid M).prod s = s.comap (monoid_hom.snd M N) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]

@[simp, to_additive top_prod_top]
lemma top_prod_top : (⊤ : submonoid M).prod (⊤ : submonoid N) = ⊤ :=
(top_prod _).trans $ comap_top _

@[to_additive] lemma bot_prod_bot : (⊥ : submonoid M).prod (⊥ : submonoid N) = ⊥ :=
set_like.coe_injective $ by simp [coe_prod, prod.one_eq_mk]

/-- The product of submonoids is isomorphic to their product as monoids. -/
@[to_additive prod_equiv "The product of additive submonoids is isomorphic to their product
as additive monoids"]
def prod_equiv (s : submonoid M) (t : submonoid N) : s.prod t ≃* s × t :=
{ map_mul' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }

open monoid_hom

@[to_additive]
lemma map_inl (s : submonoid M) : s.map (inl M N) = s.prod ⊥ :=
ext $ λ p, ⟨λ ⟨x, hx, hp⟩, hp ▸ ⟨hx, set.mem_singleton 1⟩,
  λ ⟨hps, hp1⟩, ⟨p.1, hps, prod.ext rfl $ (set.eq_of_mem_singleton hp1).symm⟩⟩

@[to_additive]
lemma map_inr (s : submonoid N) : s.map (inr M N) = prod ⊥ s :=
ext $ λ p, ⟨λ ⟨x, hx, hp⟩, hp ▸ ⟨set.mem_singleton 1, hx⟩,
  λ ⟨hp1, hps⟩, ⟨p.2, hps, prod.ext (set.eq_of_mem_singleton hp1).symm rfl⟩⟩

@[simp, to_additive prod_bot_sup_bot_prod]
lemma prod_bot_sup_bot_prod (s : submonoid M) (t : submonoid N) :
  (s.prod ⊥) ⊔ (prod ⊥ t) = s.prod t :=
le_antisymm (sup_le (prod_mono (le_refl s) bot_le) (prod_mono bot_le (le_refl t))) $
assume p hp, prod.fst_mul_snd p ▸ mul_mem _
  ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, set.mem_singleton 1⟩)
  ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨set.mem_singleton 1, hp.2⟩)

@[to_additive]
lemma mem_map_equiv {f : M ≃* N} {K : submonoid M} {x : N} :
  x ∈ K.map f.to_monoid_hom ↔ f.symm x ∈ K :=
@set.mem_image_equiv _ _ ↑K f.to_equiv x

@[to_additive]
lemma map_equiv_eq_comap_symm (f : M ≃* N) (K : submonoid M) :
  K.map f.to_monoid_hom = K.comap f.symm.to_monoid_hom :=
set_like.coe_injective (f.to_equiv.image_eq_preimage K)

@[to_additive]
lemma comap_equiv_eq_map_symm (f : N ≃* M) (K : submonoid M) :
  K.comap f.to_monoid_hom = K.map f.symm.to_monoid_hom :=
(map_equiv_eq_comap_symm f.symm K).symm

@[simp, to_additive]
lemma map_equiv_top (f : M ≃* N) : (⊤ : submonoid M).map f.to_monoid_hom = ⊤ :=
set_like.coe_injective $ set.image_univ.trans f.surjective.range_eq

@[to_additive le_prod_iff]
lemma le_prod_iff {s : submonoid M} {t : submonoid N} {u : submonoid (M × N)} :
  u ≤ s.prod t ↔ u.map (fst M N) ≤ s ∧ u.map (snd M N) ≤ t :=
begin
  split,
  { intros h,
    split,
    { rintros x ⟨⟨y1,y2⟩, ⟨hy1,rfl⟩⟩, exact (h hy1).1 },
    { rintros x ⟨⟨y1,y2⟩, ⟨hy1,rfl⟩⟩, exact (h hy1).2 }, },
  { rintros ⟨hH, hK⟩ ⟨x1, x2⟩ h, exact ⟨hH ⟨_ , h, rfl⟩, hK ⟨ _, h, rfl⟩⟩, }
end

@[to_additive prod_le_iff]
lemma prod_le_iff {s : submonoid M} {t : submonoid N} {u : submonoid (M × N)} :
  s.prod t ≤ u ↔ s.map (inl M N) ≤ u ∧ t.map (inr M N) ≤ u :=
begin
  split,
  { intros h,
    split,
    { rintros _ ⟨x, hx, rfl⟩, apply h, exact ⟨hx, (submonoid.one_mem _)⟩, },
    { rintros _ ⟨x, hx, rfl⟩, apply h, exact ⟨submonoid.one_mem _, hx⟩, }, },
  { rintros ⟨hH, hK⟩ ⟨x1, x2⟩ ⟨h1, h2⟩,
    have h1' : inl M N x1 ∈ u, { apply hH, simpa using h1, },
    have h2' : inr M N x2 ∈ u, { apply hK, simpa using h2, },
    simpa using submonoid.mul_mem _ h1' h2', }
end

end submonoid

namespace monoid_hom

open submonoid

/-- For many categories (monoids, modules, rings, ...) the set-theoretic image of a morphism `f` is
a subobject of the codomain. When this is the case, it is useful to define the range of a morphism
in such a way that the underlying carrier set of the range subobject is definitionally
`set.range f`. In particular this means that the types `↥(set.range f)` and `↥f.range` are
interchangeable without proof obligations.

A convenient candidate definition for range which is mathematically correct is `map ⊤ f`, just as
`set.range` could have been defined as `f '' set.univ`. However, this lacks the desired definitional
convenience, in that it both does not match `set.range`, and that it introduces a redudant `x ∈ ⊤`
term which clutters proofs. In such a case one may resort to the `copy`
pattern. A `copy` function converts the definitional problem for the carrier set of a subobject
into a one-off propositional proof obligation which one discharges while writing the definition of
the definitionally convenient range (the parameter `hs` in the example below).

A good example is the case of a morphism of monoids. A convenient definition for
`monoid_hom.mrange` would be `(⊤ : submonoid M).map f`. However since this lacks the required
definitional convenience, we first define `submonoid.copy` as follows:
```lean
protected def copy (S : submonoid M) (s : set M) (hs : s = S) : submonoid M :=
{ carrier  := s,
  one_mem' := hs.symm ▸ S.one_mem',
  mul_mem' := hs.symm ▸ S.mul_mem' }
```
and then finally define:
```lean
def mrange (f : M →* N) : submonoid N :=
((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm
```
-/
library_note "range copy pattern"

/-- The range of a monoid homomorphism is a submonoid. See Note [range copy pattern]. -/
@[to_additive "The range of an `add_monoid_hom` is an `add_submonoid`."]
def mrange (f : M →* N) : submonoid N :=
((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm

@[simp, to_additive]
lemma coe_mrange (f : M →* N) :
  (f.mrange : set N) = set.range f :=
rfl

@[simp, to_additive] lemma mem_mrange {f : M →* N} {y : N} :
  y ∈ f.mrange ↔ ∃ x, f x = y :=
iff.rfl

@[to_additive] lemma mrange_eq_map (f : M →* N) : f.mrange = (⊤ : submonoid M).map f :=
copy_eq _

@[to_additive]
lemma map_mrange (g : N →* P) (f : M →* N) : f.mrange.map g = (g.comp f).mrange :=
by simpa only [mrange_eq_map] using (⊤ : submonoid M).map_map g f

@[to_additive]
lemma mrange_top_iff_surjective {N} [mul_one_class N] {f : M →* N} :
  f.mrange = (⊤ : submonoid N) ↔ function.surjective f :=
set_like.ext'_iff.trans $ iff.trans (by rw [coe_mrange, coe_top]) set.range_iff_surjective

/-- The range of a surjective monoid hom is the whole of the codomain. -/
@[to_additive "The range of a surjective `add_monoid` hom is the whole of the codomain."]
lemma mrange_top_of_surjective {N} [mul_one_class N] (f : M →* N) (hf : function.surjective f) :
  f.mrange = (⊤ : submonoid N) :=
mrange_top_iff_surjective.2 hf

@[to_additive]
lemma mclosure_preimage_le (f : M →* N) (s : set N) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a monoid hom of the submonoid generated by a set equals the submonoid generated
    by the image of the set. -/
@[to_additive "The image under an `add_monoid` hom of the `add_submonoid` generated by a set equals
the `add_submonoid` generated by the image of the set."]
lemma 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)

/-- Restriction of a monoid hom to a submonoid of the domain. -/
@[to_additive "Restriction of an add_monoid hom to an `add_submonoid` of the domain."]
def mrestrict {N : Type*} [mul_one_class N] (f : M →* N) (S : submonoid M) : S →* N :=
f.comp S.subtype

@[simp, to_additive]
lemma mrestrict_apply {N : Type*} [mul_one_class N] (f : M →* N) (x : S) : f.mrestrict S x = f x :=
rfl

/-- Restriction of a monoid hom to a submonoid of the codomain. -/
@[to_additive "Restriction of an `add_monoid` hom to an `add_submonoid` of the codomain.", simps]
def cod_mrestrict (f : M →* N) (S : submonoid N) (h : ∀ x, f x ∈ S) : M →* S :=
{ to_fun := λ n, ⟨f n, h n⟩,
  map_one' := subtype.eq f.map_one,
  map_mul' := λ x y, subtype.eq (f.map_mul x y) }

/-- Restriction of a monoid hom to its range interpreted as a submonoid. -/
@[to_additive "Restriction of an `add_monoid` hom to its range interpreted as a submonoid."]
def mrange_restrict {N} [mul_one_class N] (f : M →* N) : M →* f.mrange :=
f.cod_mrestrict f.mrange $ λ x, ⟨x, rfl⟩

@[simp, to_additive]
lemma coe_mrange_restrict {N} [mul_one_class N] (f : M →* N) (x : M) :
  (f.mrange_restrict x : N) = f x :=
rfl

@[to_additive]
lemma mrange_restrict_surjective (f : M →* N) : function.surjective f.mrange_restrict :=
λ ⟨_, ⟨x, rfl⟩⟩, ⟨x, rfl⟩

/-- The multiplicative kernel of a monoid homomorphism is the submonoid of elements `x : G` such
that `f x = 1` -/
@[to_additive "The additive kernel of an `add_monoid` homomorphism is the `add_submonoid` of
elements such that `f x = 0`"]
def mker (f : M →* N) : submonoid M := (⊥ : submonoid N).comap f

@[to_additive]
lemma mem_mker (f : M →* N) {x : M} : x ∈ f.mker ↔ f x = 1 := iff.rfl

@[to_additive]
lemma coe_mker (f : M →* N) : (f.mker : set M) = (f : M → N) ⁻¹' {1} := rfl

@[to_additive]
instance decidable_mem_mker [decidable_eq N] (f : M →* N) :
  decidable_pred (∈ f.mker) :=
λ x, decidable_of_iff (f x = 1) f.mem_mker

@[to_additive]
lemma comap_mker (g : N →* P) (f : M →* N) : g.mker.comap f = (g.comp f).mker := rfl

@[simp, to_additive] lemma comap_bot' (f : M →* N) :
  (⊥ : submonoid N).comap f = f.mker := rfl

@[to_additive] lemma range_restrict_mker (f : M →* N) : mker (mrange_restrict f) = mker f :=
begin
  ext,
  change (⟨f x, _⟩ : mrange f) = ⟨1, _⟩ ↔ f x = 1,
  simp only [],
end

@[simp, to_additive]
lemma mker_one : (1 : M →* N).mker = ⊤ :=
by { ext, simp [mem_mker] }

@[to_additive]
lemma prod_map_comap_prod' {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N']
  (f : M →* N) (g : M' →* N') (S : submonoid N) (S' : submonoid N') :
  (S.prod S').comap (prod_map f g) = (S.comap f).prod (S'.comap g) :=
set_like.coe_injective $ set.preimage_prod_map_prod f g _ _

@[to_additive]
lemma mker_prod_map {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N'] (f : M →* N)
  (g : M' →* N') : (prod_map f g).mker = f.mker.prod g.mker :=
by rw [←comap_bot', ←comap_bot', ←comap_bot', ←prod_map_comap_prod', bot_prod_bot]

@[simp, to_additive]
lemma mker_inl : (inl M N).mker = ⊥ := by { ext x, simp [mem_mker] }

@[simp, to_additive]
lemma mker_inr : (inr M N).mker = ⊥ := by { ext x, simp [mem_mker] }

/-- The `monoid_hom` from the preimage of a submonoid to itself. -/
@[to_additive "the `add_monoid_hom` from the preimage of an additive submonoid to itself.", simps]
def submonoid_comap (f : M →* N) (N' : submonoid N) :
  N'.comap f →* N' :=
{ to_fun := λ x, ⟨f x, x.prop⟩,
  map_one' := subtype.eq f.map_one,
  map_mul' := λ x y, subtype.eq (f.map_mul x y) }

/-- The `monoid_hom` from a submonoid to its image.
See `mul_equiv.submonoid_map` for a variant for `mul_equiv`s. -/
@[to_additive "the `add_monoid_hom` from an additive submonoid to its image. See
`add_equiv.add_submonoid_map` for a variant for `add_equiv`s.", simps]
def submonoid_map (f : M →* N) (M' : submonoid M) :
  M' →* M'.map f :=
{ to_fun := λ x, ⟨f x, ⟨x, x.prop, rfl⟩⟩,
  map_one' := subtype.eq $ f.map_one,
  map_mul' := λ x y, subtype.eq $ f.map_mul x y }

@[to_additive]
lemma submonoid_map_surjective (f : M →* N) (M' : submonoid M) :
  function.surjective (f.submonoid_map M') :=
by { rintro ⟨_, x, hx, rfl⟩, exact ⟨⟨x, hx⟩, rfl⟩ }

end monoid_hom

namespace submonoid
open monoid_hom

@[to_additive]
lemma mrange_inl : (inl M N).mrange = prod ⊤ ⊥ :=
by simpa only [mrange_eq_map] using map_inl ⊤

@[to_additive]
lemma mrange_inr : (inr M N).mrange = prod ⊥ ⊤ :=
by simpa only [mrange_eq_map] using map_inr ⊤

@[to_additive]
lemma mrange_inl' : (inl M N).mrange = comap (snd M N) ⊥ := mrange_inl.trans (top_prod _)

@[to_additive]
lemma mrange_inr' : (inr M N).mrange = comap (fst M N) ⊥ := mrange_inr.trans (prod_top _)

@[simp, to_additive]
lemma mrange_fst : (fst M N).mrange = ⊤ :=
(fst M N).mrange_top_of_surjective $ @prod.fst_surjective _ _ ⟨1⟩

@[simp, to_additive]
lemma mrange_snd : (snd M N).mrange = ⊤ :=
(snd M N).mrange_top_of_surjective $ @prod.snd_surjective _ _ ⟨1⟩

@[to_additive]
lemma prod_eq_bot_iff {s : submonoid M} {t : submonoid N} :
  s.prod t = ⊥ ↔ s = ⊥ ∧ t = ⊥ :=
by simp only [eq_bot_iff, prod_le_iff, (gc_map_comap _).le_iff_le, comap_bot', mker_inl, mker_inr]

@[to_additive]
lemma prod_eq_top_iff {s : submonoid M} {t : submonoid N} :
  s.prod t = ⊤ ↔ s = ⊤ ∧ t = ⊤ :=
by simp only [eq_top_iff, le_prod_iff, ← (gc_map_comap _).le_iff_le, ← mrange_eq_map,
  mrange_fst, mrange_snd]

@[simp, to_additive]
lemma mrange_inl_sup_mrange_inr : (inl M N).mrange ⊔ (inr M N).mrange = ⊤ :=
by simp only [mrange_inl, mrange_inr, prod_bot_sup_bot_prod, top_prod_top]

/-- The monoid hom associated to an inclusion of submonoids. -/
@[to_additive "The `add_monoid` hom associated to an inclusion of submonoids."]
def inclusion {S T : submonoid M} (h : S ≤ T) : S →* T :=
S.subtype.cod_mrestrict _ (λ x, h x.2)

@[simp, to_additive]
lemma range_subtype (s : submonoid M) : s.subtype.mrange = s :=
set_like.coe_injective $ (coe_mrange _).trans $ subtype.range_coe

@[to_additive] lemma eq_top_iff' : S = ⊤ ↔ ∀ x : M, x ∈ S :=
eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩

@[to_additive] lemma eq_bot_iff_forall : S = ⊥ ↔ ∀ x ∈ S, x = (1 : M) :=
set_like.ext_iff.trans $ by simp [iff_def, S.one_mem] { contextual := tt }

@[to_additive] lemma nontrivial_iff_exists_ne_one (S : submonoid M) :
  nontrivial S ↔ ∃ x ∈ S, x ≠ (1:M) :=
calc nontrivial S ↔ ∃ x : S, x ≠ 1                                   : nontrivial_iff_exists_ne 1
              ... ↔ ∃ x (hx : x ∈ S), (⟨x, hx⟩ : S) ≠ ⟨1, S.one_mem⟩ : subtype.exists
              ... ↔ ∃ x ∈ S, x ≠ (1 : M)                             : by simp only [ne.def]

/-- A submonoid is either the trivial submonoid or nontrivial. -/
@[to_additive "An additive submonoid is either the trivial additive submonoid or nontrivial."]
lemma bot_or_nontrivial (S : submonoid M) : S = ⊥ ∨ nontrivial S :=
by simp only [eq_bot_iff_forall, nontrivial_iff_exists_ne_one, ← not_forall, classical.em]

/-- A submonoid is either the trivial submonoid or contains a nonzero element. -/
@[to_additive "An additive submonoid is either the trivial additive submonoid or contains a nonzero
element."]
lemma bot_or_exists_ne_one (S : submonoid M) : S = ⊥ ∨ ∃ x ∈ S, x ≠ (1:M) :=
S.bot_or_nontrivial.imp_right S.nontrivial_iff_exists_ne_one.mp

end submonoid

namespace mul_equiv

variables {S} {T : submonoid M}

/-- Makes the identity isomorphism from a proof that two submonoids of a multiplicative
    monoid are equal. -/
@[to_additive "Makes the identity additive isomorphism from a proof two
submonoids of an additive monoid are equal."]
def submonoid_congr (h : S = T) : S ≃* T :=
{ map_mul' :=  λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }

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

This is a bidirectional version of `monoid_hom.mrange_restrict`. -/
@[to_additive /-"
An additive monoid homomorphism `f : M →+ N` with a left-inverse `g : N → M` defines an additive
equivalence between `M` and `f.mrange`.

This is a bidirectional version of `add_monoid_hom.mrange_restrict`. "-/, simps {simp_rhs := tt}]
def of_left_inverse' (f : M →* N) {g : N → M} (h : function.left_inverse g f) : M ≃* f.mrange :=
{ to_fun := f.mrange_restrict,
  inv_fun := g ∘ f.mrange.subtype,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := monoid_hom.mem_mrange.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  .. f.mrange_restrict }

/-- A `mul_equiv` `φ` between two monoids `M` and `N` induces a `mul_equiv` between
a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`.
See `monoid_hom.submonoid_map` for a variant for `monoid_hom`s. -/
@[to_additive "An `add_equiv` `φ` between two additive monoids `M` and `N` induces an `add_equiv`
between a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`. See `add_monoid_hom.add_submonoid_map`
for a variant for `add_monoid_hom`s.", simps]
def submonoid_map (e : M ≃* N) (S : submonoid M) : S ≃* S.map e.to_monoid_hom :=
{ to_fun := λ x, ⟨e x, _⟩,
  inv_fun := λ x, ⟨e.symm x, _⟩, -- we restate this for `simps` to avoid `⇑e.symm.to_equiv x`
  ..e.to_monoid_hom.submonoid_map S,
  ..e.to_equiv.image S }

end mul_equiv

section actions
/-! ### Actions by `submonoid`s

These instances tranfer the action by an element `m : M` of a monoid `M` written as `m • a` onto the
action by an element `s : S` of a submonoid `S : submonoid M` such that `s • a = (s : M) • a`.

These instances work particularly well in conjunction with `monoid.to_mul_action`, enabling
`s • m` as an alias for `↑s * m`.
-/

namespace submonoid
variables {M' : Type*} {α β : Type*}

section mul_one_class
variables [mul_one_class M']

@[to_additive]
instance [has_scalar M' α] (S : submonoid M') : has_scalar S α := has_scalar.comp _ S.subtype

@[to_additive]
instance smul_comm_class_left
  [has_scalar M' β] [has_scalar α β] [smul_comm_class M' α β] (S : submonoid M') :
  smul_comm_class S α β :=
⟨λ a, (smul_comm (a : M') : _)⟩

@[to_additive]
instance smul_comm_class_right
  [has_scalar α β] [has_scalar M' β] [smul_comm_class α M' β] (S : submonoid M') :
  smul_comm_class α S β :=
⟨λ a s, (smul_comm a (s : M') : _)⟩

/-- Note that this provides `is_scalar_tower S M' M'` which is needed by `smul_mul_assoc`. -/
instance
  [has_scalar α β] [has_scalar M' α] [has_scalar M' β] [is_scalar_tower M' α β] (S : submonoid M') :
  is_scalar_tower S α β :=
⟨λ a, (smul_assoc (a : M') : _)⟩

@[to_additive]
lemma smul_def [has_scalar M' α] {S : submonoid M'} (g : S) (m : α) : g • m = (g : M') • m := rfl

instance [has_scalar M' α] [has_faithful_scalar M' α] (S : submonoid M') :
  has_faithful_scalar S α :=
⟨λ x y h, subtype.ext $ eq_of_smul_eq_smul h⟩

end mul_one_class

variables [monoid M']

/-- The action by a submonoid is the action by the underlying monoid. -/
@[to_additive /-"The additive action by an add_submonoid is the action by the underlying
add_monoid. "-/]
instance [mul_action M' α] (S : submonoid M') : mul_action S α := mul_action.comp_hom _ S.subtype

/-- The action by a submonoid is the action by the underlying monoid. -/
instance [add_monoid α] [distrib_mul_action M' α] (S : submonoid M') : distrib_mul_action S α :=
distrib_mul_action.comp_hom _ S.subtype

/-- The action by a submonoid is the action by the underlying monoid. -/
instance [monoid α] [mul_distrib_mul_action M' α] (S : submonoid M') : mul_distrib_mul_action S α :=
mul_distrib_mul_action.comp_hom _ S.subtype

example {S : submonoid M'} : is_scalar_tower S M' M' := by apply_instance

end submonoid

end actions


import data.matrix.notation

example (x : ℕ) (h : x = 3)  : x + x + x = 9 :=
begin
  set y := x with ←h_xy,
  guard_hyp y : ℕ := x,
  guard_hyp h_xy : x = y,
  guard_hyp h : y = 3,
  guard_target y + y + y = 9,
  set! z : ℕ := y,
  guard_target y + y + y = 9,
  simp [h]
end

example : true :=
let X1 := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ), -- X1 : fin 1.succ → fin 2 → ℕ
    X2 : matrix (fin 2) (fin 2) ℕ := ![![1, 0], ![0, 0]] in -- X2 : matrix (fin 2) (fin 2) ℕ
begin
  set Y1 := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ),
  set Y2 : matrix (fin 2) (fin 2) ℕ := ![![1, 0], ![0, 0]],
  let Z1 := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ),
  let Z2 : matrix (fin 2) (fin 2) ℕ := ![![1, 0], ![0, 0]],
  guard_hyp Y2 : matrix (fin 2) (fin 2) ℕ := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ),
  trivial
end

def T {α : Type} := ℕ
def v : @T ℕ := nat.zero

def S := @T ℕ
def u : S := nat.zero

def p : true :=
begin
  set a : T := v,
  set b : T := u, -- the type `T` can't be fully elaborated without the body but this is fine
  trivial
end

section lean_555 -- https://github.com/leanprover-community/mathlib/pull/14488

inductive foo | bar

instance : has_coe_to_sort foo _ :=
⟨λ _, unit⟩

example : true :=
begin
  set x : foo.bar := (),
  trivial,
end

end lean_555


/-
  Specifications file for constants_spec.cairo

  Do not modify the constant definitions, structure definitions, or automatic specifications.
  Do not change the name or arguments of the user specifications and soundness theorems.

  You may freely move the definitions around in the file.
  You may add definitions and theorems wherever you wish in this file.
-/
import starkware.cairo.lean.semantics.soundness.prelude

namespace starkware.cairo.common.cairo_secp.constants

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]

-- End of automatically generated prelude.

-- Main scope definitions.

@[reducible] def SECP_REM := 2 ^ 32 + 2 ^ 9 + 2 ^ 8 + 2 ^ 7 + 2 ^ 6 + 2 ^ 4 + 1
@[reducible] def BASE := 2 ^ 86
@[reducible] def P0 := 77371252455336262886226991
@[reducible] def P1 := 77371252455336267181195263
@[reducible] def P2 := 19342813113834066795298815
@[reducible] def N0 := 10428087374290690730508609
@[reducible] def N1 := 77371252455330678278691517
@[reducible] def N2 := 19342813113834066795298815
@[reducible] def BETA := 7

-- End of main scope definitions.

/-
Useful calculations collected here.
-/

@[reducible] def secp_n := N0 + BASE * N1 + BASE^2 * N2

lemma BASE_nonneg: 0 ≤ (↑BASE : ℤ) :=
by { unfold BASE, simp_int_casts, norm_num1 }

lemma BASE_div_4_nonneg: 0 ≤ (↑BASE : ℤ) / 4 :=
int.div_nonneg BASE_nonneg (by norm_num)

lemma SECP_REM_nonneg: 0 ≤ (↑SECP_REM : ℤ) :=
by { unfold SECP_REM, simp_int_casts, norm_num1 }

lemma BASE_ne_zero_aux : (BASE : F) ≠ 0 :=
begin
  suffices : ((BASE : nat) : F) ≠ ((0 : nat) : F),
  { simpa },
  intro h,
  have:= PRIME.nat_coe_field_inj _ _ h,
  { norm_num at this},
  repeat {dsimp only [BASE, PRIME], norm_num }
end

lemma BASE_ne_zero_aux' : (2 : F)^86 ≠ 0 :=
begin
  suffices : ((2^86 : nat) : F) ≠ ((0 : nat) : F),
  { simpa },
  intro h,
  have:= PRIME.nat_coe_field_inj _ _ h,
  { norm_num at this},
  repeat {dsimp only [BASE, PRIME], norm_num }
end

@[irreducible] def SECP_PRIME : ℕ := BASE^3 / 4 - SECP_REM

theorem SECP_PRIME_eq : (↑SECP_PRIME : ℤ) = (↑BASE : ℤ)^3 / 4 - ↑SECP_REM :=
begin
  simp only [SECP_PRIME],
  rw int.coe_nat_sub, rotate, { dsimp only [SECP_REM, BASE], norm_num },
  refl,
end

/--
Some bounds use 3 * BASE - 1, and some use 3 * (BASE - 1).
This theorem mediates between them.
-/
theorem bound_slack : (3 : ℤ) * (BASE - 1) ≤ 3 * BASE - 1 :=
by { unfold BASE, simp_int_casts, norm_num }

theorem bound_lt_prime : (3 : ℤ) * BASE - 1 < PRIME :=
by { unfold BASE, unfold PRIME, simp_int_casts, norm_num }

end starkware.cairo.common.cairo_secp.constants


/-
This file contains the definitions of formulas in conjunctive normal form.
CNF is implemented as a list of clauses (see clause.lean).
The variable type used in the formula is polymorphic.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import basic
import cnf.literal
import cnf.clause

import data.list.basic
import data.list.nodup
import data.list.perm
import init.data.nat
import data.nat.basic

-- Represents the parametric type of the variable stored in the literal
variables {V : Type*}

/- Conjunctive normal form is a list of clauses joined by logical ANDs -/
def cnf (V : Type*) := list (clause V)

-- Note that the above definition allows for duplication of clauses (and
-- permutations of clauses), whereas a set definition would not (assuming a
-- set definition of clauses as well). However, lists allow for computable
-- functions to be defined on them.

namespace cnf

open literal
open clause
open list
open function
open finset

/-! # Instance properties -/

instance [inhabited V] : inhabited (cnf V) := ⟨[arbitrary (clause V)]⟩
instance : has_mem (clause V) (cnf V) := ⟨list.mem⟩
instance : has_emptyc (cnf V) := ⟨list.nil⟩
instance [decidable_eq V] : has_union (cnf V) := ⟨list.union⟩
instance [decidable_eq V] : has_inter (cnf V) := ⟨list.inter⟩
instance : has_singleton (clause V) (cnf V) := ⟨λ c, [c]⟩
instance [decidable_eq V] : has_insert (clause V) (cnf V) := ⟨list.insert⟩
instance : has_append (cnf V) := ⟨list.append⟩
instance : has_subset (cnf V) := ⟨list.subset⟩
instance [has_repr V] : has_repr (cnf V) := ⟨list.repr⟩

instance [decidable_eq V] (c : clause V) (f : cnf V) : decidable (c ∈ f) :=
begin
  induction f with cl cls ih,
  { exact decidable.false },
  { cases ih,
    { by_cases h : c = cl,
      { rw h, exact decidable.is_true (mem_cons_self cl cls) },
      { exact decidable.is_false (not_mem_cons_of_ne_of_not_mem h ih) } },
    exact decidable.is_true (mem_cons_of_mem cl ih) }
end

/-! ### Evaluation under assignment -/
section eval

variables {τ : assignment V} {c : clause V} {f : cnf V}

protected def eval (τ : assignment V) (f : cnf V) : bool :=
  f.foldr (λ c b, b && (clause.eval τ c)) tt

@[simp] theorem eval_nil : cnf.eval τ [] = tt := rfl

@[simp] theorem eval_singleton : cnf.eval τ [c] = c.eval τ :=
by simp only [cnf.eval, foldr, tt_band]

@[simp] theorem eval_cons : cnf.eval τ (c :: f) = c.eval τ && f.eval τ :=
by simp only [cnf.eval, foldr, bool.band_comm]

theorem eval_ff_cons_of_eval_ff (c : clause V) : f.eval τ = ff → cnf.eval τ (c :: f) = ff :=
assume h, by rw [eval_cons, h, band_ff]

@[simp] theorem eval_append (τ : assignment V) (f₁ f₂ : cnf V) :
  cnf.eval τ (f₁ ++ f₂) = f₁.eval τ && f₂.eval τ :=
begin
  unfold cnf.eval,
  rw foldr_append,
  cases foldr (λ c b, b && clause.eval τ c) tt f₂,
  { rw [band_ff, foldr_band_ff] },
  { rw band_tt }
end

theorem eval_tt_iff_forall_clause_eval_tt : f.eval τ = tt ↔ ∀ (c : clause V), c ∈ f → c.eval τ = tt :=
begin
  induction f with c cs ih,
  { simp only [eval_nil, eq_self_iff_true, not_mem_nil, is_empty.forall_iff, implies_true_iff] },
  { simp only [ih, eval_cons, band_eq_true_eq_eq_tt_and_eq_tt, mem_cons_iff, forall_eq_or_imp] }
end

theorem eval_ff_iff_exists_clause_eval_ff : f.eval τ = ff ↔ ∃ c, c ∈ f ∧ clause.eval τ c = ff :=
begin
  induction f with c cs ih,
  { simp only [eval_nil, not_mem_nil, false_and, exists_false] },
  { simp only [eval_cons, band_eq_false_eq_eq_ff_or_eq_ff, mem_cons_iff],
    split,
    { rintros (h | h),
      { use [c, or.inl rfl, h] },
      { rcases ih.mp h with ⟨c₂, hc, he⟩,
        use [c₂, mem_cons_of_mem c hc, he] } },
    { rintros ⟨c₂, (rfl | hc), he⟩,
      { exact or.inl he },
      { exact or.inr (ih.mpr ⟨c₂, hc, he⟩) } } }
end

end eval

def satisfiable (f : cnf V) := ∃ τ, f.eval τ = tt

theorem satisfiable_of_eval_tt (f : cnf V) (τ : assignment V) : f.eval τ = tt → satisfiable f :=
assume h, exists.intro τ h

/-! ### Counting -/
section counting

variables (τ : assignment V) (c : clause V) (f f₁ f₂ : cnf V)

protected def count_tt : nat := f.countp (λ c, clause.eval τ c = tt)
protected def count_ff : nat := f.countp (λ c, clause.eval τ c = ff)

@[simp] theorem count_tt_nil : cnf.count_tt τ [] = 0 := rfl
@[simp] theorem count_ff_nil : cnf.count_ff τ [] = 0 := rfl

@[simp] theorem count_tt_singleton : cnf.count_tt τ [c] = cond (c.eval τ) 1 0 :=
by cases h : (c.eval τ); simp [h, cnf.count_tt]

@[simp] theorem count_ff_singleton : cnf.count_ff τ [c] = cond (c.eval τ) 0 1 :=
by cases h : (c.eval τ); simp [h, cnf.count_ff]

@[simp] theorem count_tt_cons : cnf.count_tt τ (c :: f) = cond (c.eval τ) (1 + f.count_tt τ) (f.count_tt τ) :=
by cases h : (c.eval τ); simp [h, cnf.count_tt, add_comm]

@[simp] theorem count_ff_cons : cnf.count_ff τ (c :: f) = cond (c.eval τ) (f.count_ff τ) (1 + f.count_ff τ) :=
by cases h : (c.eval τ); simp [h, cnf.count_ff, add_comm]

theorem count_tt_append : cnf.count_tt τ (f₁ ++ f₂) = cnf.count_tt τ f₁ + cnf.count_tt τ f₂ :=
begin
  induction f₁ with c cs ih,
  { simp only [nil_append, count_tt_nil, zero_add] },
  { cases h : (c.eval τ); simp [h, ih, add_assoc] }
end

theorem count_ff_append : cnf.count_ff τ (f₁ ++ f₂) = cnf.count_ff τ f₁ + cnf.count_ff τ f₂ :=
begin
  induction f₁ with c cs ih,
  { simp only [nil_append, count_ff_nil, zero_add] },
  { cases h : (c.eval τ); simp [h, ih, add_assoc] }
end

end counting

/-! # vars -/
section vars

variables [decidable_eq V] {v : V} {c : clause V} {f f₁ f₂ : cnf V}

protected def vars : cnf V → finset V
| []        := ∅
| (c :: cs) := (c.vars) ∪ (vars cs)

@[simp] theorem vars_nil : cnf.vars ([] : cnf V) = ∅ := rfl

@[simp] theorem vars_singleton (c : clause V) : cnf.vars [c] = clause.vars c :=
by { unfold cnf.vars, rw finset.union_empty }

@[simp] theorem vars_cons (c : clause V) (f : cnf V) : cnf.vars (c :: f) = c.vars ∪ f.vars := rfl

theorem mem_vars_cons_of_mem_vars (c : clause V) : v ∈ f.vars → v ∈ cnf.vars (c :: f) :=
assume h, finset.mem_union.mpr (or.inr h)

@[simp] theorem vars_append (f₁ f₂ : cnf V) : cnf.vars (f₁ ++ f₂) = f₁.vars ∪ f₂.vars :=
begin
  induction f₁ with c cs ih,
  { simp only [empty_union, vars_nil, nil_append] },
  { simp only [cnf.vars, cons_append c cs f₂, ih, finset.union_assoc] }
end

theorem vars_perm : f₁ ~ f₂ → f₁.vars = f₂.vars :=
begin
  intro hp,
  induction hp with _ _ _ _ IH  x y _  _ _ _ _ _ IH₁ IH₂,
  { refl },
  { unfold cnf.vars, rw IH },
  { unfold cnf.vars,
    rw [← finset.union_assoc, ← finset.union_assoc, finset.union_comm y.vars x.vars] },
  { exact eq.trans IH₁ IH₂ }
end

@[simp] theorem vars_join {v : V} : ∀ ⦃L : list (cnf V)⦄,
  v ∈ cnf.vars (join L) ↔ ∃ (F : cnf V), F ∈ L ∧ v ∈ cnf.vars F :=
begin
  intro L,
  induction L with F Fs ih,
  { simp only [join, vars_nil, not_mem_empty, not_mem_nil, false_and, exists_false] },
  { simp [ih, cnf.vars_append],
    split,
    { rintro (h | ⟨F, hf₁, hf₂⟩),
      { use [F, or.inl rfl, h] },
      { use [F, or.inr hf₁, hf₂] } },
    { rintro ⟨F, (rfl | hf₁), hf₂⟩,
      { exact or.inl hf₂ },
      { exact or.inr ⟨_, hf₁, hf₂⟩ } } }
end

theorem clause_vars_subset_of_vars_of_mem : c ∈ f → c.vars ⊆ f.vars :=
begin
  induction f with cl cls ih,
  { intro h, exact absurd h (not_mem_nil _) },
  { intros hc v hv,
    rcases eq_or_mem_of_mem_cons hc with rfl | hc,
    { unfold cnf.vars,
      rw finset.mem_union,
      exact or.inl hv },
    { exact mem_vars_cons_of_mem_vars cl (ih hc hv) } }
end

theorem mem_vars_iff_exists_mem_clause_and_mem : v ∈ f.vars ↔ ∃ (c : clause V), c ∈ f ∧ v ∈ c.vars :=
begin
  induction f with cl cls ih,
  { simp only [not_mem_empty, not_mem_nil, exists_false, vars_nil, false_and] },
  { split,
    { intro hv,
      by_cases h : (v ∈ cl.vars),
      { use [cl, and.intro (mem_cons_self _ _) h] },
      { rcases ih.mp (or.resolve_left (finset.mem_union.mp hv) h) with ⟨c, hc, hv⟩,
        use [c, and.intro (mem_cons_of_mem cl hc) hv] } },
    { rintros ⟨c, hc, hv⟩,
      rw cnf.vars,
      rcases eq_or_mem_of_mem_cons hc with (rfl | hc),
      { exact finset.mem_union_left _ hv },
      { exact finset.mem_union_right _ (ih.mpr ⟨c, hc, hv⟩) } } }
end

theorem vars_subset_of_subset : f₁ ⊆ f₂ → (cnf.vars f₁) ⊆ (cnf.vars f₂) :=
begin
  intros h v hv,
  rcases cnf.mem_vars_iff_exists_mem_clause_and_mem.mp hv with ⟨c, hf, hvc⟩,
  exact clause_vars_subset_of_vars_of_mem (h hf) hvc
end

end vars

/-! # Equisatisfiability -/

def eqsat (f₁ f₂ : cnf V) := satisfiable f₁ ↔ satisfiable f₂

--notation f₁ ` ≈ ` f₂ := equisatisfiable f₁ f₂

@[refl] theorem eqsat.refl (f : cnf V) : eqsat f f := ⟨id, id⟩

@[symm] theorem eqsat.symm (f₁ f₂ : cnf V) : eqsat f₁ f₂ → eqsat f₂ f₁ := λ h, ⟨h.2, h.1⟩

@[trans] theorem eqsat.trans {f₁ f₂ f₃ : cnf V} : eqsat f₁ f₂ → eqsat f₂ f₃ → eqsat f₁ f₃ :=
λ h₁ h₂, ⟨λ h, h₂.1 (h₁.1 h), λ h, h₁.2 (h₂.2 h)⟩

open assignment

/-! # S-equivalence -/

def sequiv (F₁ F₂ : cnf V) (s : finset V) := ∀ τ,
  ((∃ σ₁, F₁.eval σ₁ = tt ∧ (agree_on τ σ₁ s)) ↔ (∃ σ₂, F₂.eval σ₂ = tt ∧ (agree_on τ σ₂ s)))

@[refl] theorem sequiv.refl (F : cnf V) (s : finset V) : sequiv F F s :=
assume _, iff.rfl

@[symm] theorem sequiv.symm {F₁ F₂ : cnf V} {s : finset V} : sequiv F₁ F₂ s → sequiv F₂ F₁ s :=
assume h τ, (h τ).symm

@[trans] theorem sequiv.trans {F₁ F₂ F₃ : cnf V} {s : finset V} :
  sequiv F₁ F₂ s → sequiv F₂ F₃ s → sequiv F₁ F₃ s :=
assume h₁ h₂ τ, ⟨λ h, (h₂ τ).mp ((h₁ τ).mp h), λ h, (h₁ τ).mpr ((h₂ τ).mpr h)⟩

/-! # Output to CNF -/

def toCNF [decidable_eq V] (var_to_num : V → nat) (F : cnf V) : string :=
  let numVars : nat := F.vars.card in
  let numClauses : nat := F.length in
  "p cnf " ++ numVars.repr ++ " " ++ numClauses.repr ++ "\n" ++
  string.join (F.map (λ cl,
    (string.join (cl.map (λ lit,
      match lit with
      | Pos v := (var_to_num v).repr ++ " "
      | Neg v := "-" ++ (var_to_num v).repr ++ " "
      end))) ++ "0\n"
  ))

private def F₀ : cnf nat := [[Pos 1, Neg 2], [Pos 2, Neg 3], [Pos 3, Neg 1]]
private def S₀ := F₀.toCNF id
#eval S₀
#eval S₀.length

/-! # agree_on theorems -/

theorem eval_eq_of_agree_on [decidable_eq V] {τ₁ τ₂ : assignment V} {f : cnf V} :
  (agree_on τ₁ τ₂ f.vars) → f.eval τ₁ = f.eval τ₂ :=
begin
  intro h,
  cases hev : (cnf.eval τ₂ f),
  { apply eval_ff_iff_exists_clause_eval_ff.mpr,
    rcases eval_ff_iff_exists_clause_eval_ff.mp hev with ⟨c, hc, hff⟩,
    use [c, hc],
    exact hff ▸ clause.eval_eq_of_agree_on
      (agree_on_subset (clause_vars_subset_of_vars_of_mem hc) h) },
  { apply eval_tt_iff_forall_clause_eval_tt.mpr,
    intros c hc,
    exact (eval_tt_iff_forall_clause_eval_tt.mp hev c hc) ▸ clause.eval_eq_of_agree_on
      (agree_on_subset (clause_vars_subset_of_vars_of_mem hc) h) }
end

end cnf