import analysis.real tactic.norm_num algebra.group_power

def S (a : {n : ℕ // n ≥ 1} → ℝ)
  (n : ℕ) (H : n ≥ 1) := { r: ℝ | ∃ (m : ℕ) (Hm : m ≥ n), r = a ⟨m,ge_trans Hm H⟩ }

/- HORRIBLE ERROR
theorem Q6a1 (a : {n : ℕ // n ≥ 1} → ℝ)
  (HB : ∃ B : ℝ, ∀ n : ℕ, ∀ H : n ≥ 1, a ⟨n,H⟩ ≤ B) : ∀ (n : ℕ) (H : n ≥ 1),
  (∃ r : ℝ, r ∈ S a HB n H) ∧ (∃ B : ℝ, ∀ x : ℝ, x ∈ S a HB n H → x ≤ B) :=
begin
intros n Hn,
split,
{ existsi a ⟨n Hn⟩,
}
end
-/

--set_option trace.class_instances true

theorem Q6a1 (a : {n : ℕ // n ≥ 1} → ℝ)
  (HB : ∃ B : ℝ, ∀ n : ℕ, ∀ H : n ≥ 1, a ⟨n,H⟩ ≤ B) : ∀ (n : ℕ) (H : n ≥ 1),
  (∃ r : ℝ, r ∈ S a n H) ∧ (∃ B : ℝ, ∀ x : ℝ, x ∈ S a n H → x ≤ B) :=
begin
intros n Hn,
split,
{ existsi a ⟨n,Hn⟩,
  existsi n,
  existsi (le_of_eq (refl n)),
  refl },
cases HB with B H,
existsi B,
intro x,
intro Hx,
cases Hx with m Hm,
cases Hm with H1 Hx,
rw Hx,
refine H _ _,
end

theorem Q6a2 (a : {n : ℕ // n ≥ 1} → ℝ)
  (HB : ∃ B : ℝ, ∀ n : ℕ, ∀ H : n ≥ 1, a ⟨n,H⟩ ≤ B) (n : ℕ) (H : n ≥ 1) :
  ∃ x : ℝ, is_lub (S a n H) x :=
begin
have H1 := Q6a1 a HB n H,
cases H1.left with y Hy,
cases H1.right with B H2,
refine exists_supremum_real Hy H2
end

theorem Q6b1 (a : {n : ℕ // n ≥ 1} → ℝ)
  (HB : ∃ B : ℝ, ∀ n : ℕ, ∀ H : n ≥ 1, a ⟨n,H⟩ ≤ B) (n : ℕ) (H : n ≥ 1) :
  ∀ bnp1 bn : ℝ, is_lub (S a n H) bn ∧ is_lub (S a (n+1) (le_trans H (nat.le_succ _))) bnp1
  → bnp1 ≤ bn :=
begin
introv H1,
suffices : bn ∈ upper_bounds (S a (n+1) (le_trans H (nat.le_succ _))),
refine (H1.right).right bn this,
intros x Hx,
suffices : x ∈ (S a n H),
exact H1.left.left x this,
cases Hx with m Hm,
cases Hm with H2 H3,
existsi m,
existsi (le_trans (nat.le_succ _) H2),
assumption
end

def limsup (a : {n : ℕ // n ≥ 1} → ℝ) (lsup : ℝ) : Prop :=
  ∃ b : { n : ℕ // n ≥ 1} → ℝ, is_glb { x : ℝ | ∃ (n : ℕ) (H : n ≥ 1), x = b ⟨n,H⟩} lsup
  ∧ ∀ (n : ℕ) (H : n ≥ 1), is_lub (S a n H) (b ⟨n,H⟩)

def a1 : {n : ℕ // n ≥ 1} → ℝ := λ _, 1
theorem Q6c1 : limsup a1 1 :=
begin
existsi (λ _,(1:ℝ)),
split,
{ split,
  { intros y Hy,
    cases Hy with n Hn,
    cases Hn with H1 H2,
    rw H2,
    show (1:ℝ) ≤ 1,
    norm_num
  },
  intros y Hy,
  have H1 := Hy 1,
  refine H1 _,
  existsi 1,
  existsi (show 1 ≤ 1, by norm_num),
  simp

},
intros n Hn,
show is_lub (S a1 n Hn) 1,
split,
{ intros x Hx,
  cases Hx with m Hm,
  cases Hm with H1 H2,
  rw H2,
  show (1:ℝ)≤1,
  norm_num
},
{ intros x Hx,
  have H1 := Hx 1,
  apply H1,
  clear H1, -- ask Mario how to do apply then clear
  existsi n,
  existsi _,
  {refl},
  show n≤n,
  refl,

}
end

--set_option pp.all true

noncomputable def a2 : {n : ℕ // n ≥ 1} → ℝ := λ N, 1/N.val
theorem Q6c2 : limsup a2 0 :=
begin
existsi a2,
split,
{ split,
  {
  intros x Hx,
  cases Hx with m Hm,
  cases Hm with H1 H2,
  rw H2,
  show (0:ℝ) ≤ 1/m,
  refine div_nonneg_of_nonneg_of_pos _ _,
  {norm_num},
  refine lt_of_lt_of_le zero_lt_one _,
  rwa [←nat.cast_one,nat.cast_le] },
  { intros y Hy,
    refine not_lt.1 _,
    intro Hny,
    cases (exists_lt_nat (1/y)) with m Hm,
    have H1 := Hy (1/m),
    rw ←inv_eq_one_div at Hm,
    have H2 : m ≥ 1,
    { have H3 : ↑0 < ↑m := lt_trans (inv_pos Hny) Hm,
      rw [nat.cast_lt] at H3,
      exact nat.succ_le_of_lt H3 },
    have H4 : 1 / (↑m:ℝ) ∈ {x : ℝ | ∃ (n : ℕ) (H : n ≥ 1), x = a2 ⟨n, H⟩},
    { existsi [m,H2],
      refl },
    have H5 := H1 H4,
    have H6 := inv_le_inv _ _ Hny H5,
    rw [←inv_eq_one_div,inv_inv'] at H6,
    apply lt_irrefl (m:ℝ),
    exact lt_of_le_of_lt H6 Hm,
  }
},
{
intros n H,
split,
{ intros x Hx,
  cases Hx with d Hd,
  cases Hd with Hm H1,
  rw H1,
  show 1/(d:ℝ) ≤ 1/n,
  rw [←inv_eq_one_div,←inv_eq_one_div],
  refine inv_le_inv _ _ _ _,
  { rw [←nat.cast_zero,nat.cast_lt], exact lt_of_lt_of_le zero_lt_one H},
  rwa [nat.cast_le]
  },
intros x Hx,
have := Hx (1/(n:ℝ)),
apply this,
existsi n,
existsi _,
refl,
show n ≤ n,
refl
}
end

noncomputable def a3 : {n : ℕ // n ≥ 1} → ℝ := λ N, 1 - ((((N.val % (2:ℕ))):ℤ):ℝ)
--#eval a3 ⟨1,dec_trivial⟩

theorem Q6c3 : limsup a3 1 :=
begin
existsi (λ _, (1:ℝ)),
split,
{ split,
  { intros x Hx,
    cases Hx with m Hm,
    cases Hm with H1 H2,
    rw H2,
    simp [le_refl],
  },
  intros x Hx,
  apply Hx,
  existsi 2,
  existsi _,
  refl,
  exact dec_trivial,

},
intros n Hn,
split,
{ intros y Hy,
  cases Hy with m Hm,
  show y ≤ 1,
  cases Hm with H1 H2,
  rw H2,
  unfold a3,
  refine sub_le_self _ _,
  rw [←int.cast_zero],
  unfold ge,
  rw int.cast_le,
  refine int.mod_nonneg _ _,
  exact dec_trivial,
},
intros x Hx,
show 1 ≤ x,
apply Hx,
existsi (2*n),
existsi _,
{ unfold a3,
  simp,
},
rw [mul_comm,mul_two],
exact nat.le_add_left _ _,
end

/-
Say we have a sequence of real numbers a 1 , a 2 , a 3 , . . ., which is
 bounded above in the sense
that there exists some real number B such that a i ≤ B for all i.
Now let’s define some sets S 1 , S 2 , S 3 , . . . by
S n = {a n , a n+1 , a n+2 , . . .}.
For example S 3 = {a 3 , a 4 , a 5 , . . .}.
a) Prove that for all n ≥ 1, S n is a non-empty set which is bounded above, and hence has a
least upper bound b n .
b) Prove that b n+1 ≤ b n and hence b 1 , b 2 , b 3 is a decreasing sequence.
If the set {b 1 , b 2 , b 3 , . . .} is bounded below, then its greatest lower bound ` is called the limsup
of the sequence (a 1 , a 2 , a 3 , . . .) (this is an abbreviation for Limit Superior).
c) Find the limsup of the following sequences (they do exist).
i) 1, 1, 1, 1, 1, . . .
ii) 1, 2 1 , 13 , 14 , . . .
iii) 0, 1, 0, 1, 0, 1, 0, 1, . . .
d) If you like, then guess the definition of liminf (Limit Inferior) and compute it for examples
(i) to (iii) of (c) above. Which of these sequences converges? Can you tell just from looking at
the limsup and liminf?-/

def liminf (a : {n : ℕ // n ≥ 1} → ℝ) (linf : ℝ) : Prop :=
  ∃ c : { n : ℕ // n ≥ 1} → ℝ, is_lub { x : ℝ | ∃ (n : ℕ) (H : n ≥ 1), x = c ⟨n,H⟩} linf
  ∧ ∀ (n : ℕ) (H : n ≥ 1), is_glb (S a n H) (c ⟨n,H⟩)

theorem Q6c1' : liminf a1 1 :=
begin
existsi (λ _,(1:ℝ)),
split,
{ split,
  { intros y Hy,
    cases Hy with n Hn,
    cases Hn with H1 H2,
    rw H2,
    show (1:ℝ) ≤ 1,
    exact le_refl _,
  },
  intros y Hy,
  have H1 := Hy 1,
  refine H1 _,
  existsi 1,
  existsi (show 1 ≤ 1, by exact le_refl _),
  simp
},
intros n Hn,
show is_glb (S a1 n Hn) 1,
split,
{ intros x Hx,
  cases Hx with m Hm,
  cases Hm with H1 H2,
  rw H2,
  show (1:ℝ)≤1,
  exact le_refl _,
},
{ intros x Hx,
  have H1 := Hx 1,
  apply H1,
  clear H1, -- ask Mario how to do apply then clear
  existsi n,
  existsi _,
  {refl},
  show n≤n,
  refl,
}
end

theorem Q6c2' : liminf a2 0 :=
begin
existsi (λ _,(0:ℝ)),
split,
{ split,
  {
  intros x Hx,
  cases Hx with m Hm,
  cases Hm with H1 H2,
  rw H2,
  exact le_refl _,
  },
  intros y Hy,
  apply Hy,
  existsi 1,
  existsi _,refl,
  show 1 ≤ 1,
  exact le_refl _
},
intros n Hn,
split,
{ intros x Hx,
  cases Hx with m Hm,
  cases Hm with H1 H2,
  show 0 ≤ x,
  rw H2,
  unfold a2,
  show 0 ≤ 1/(↑m:ℝ),
  rw [←inv_eq_one_div],
  apply le_of_lt _,
  apply inv_pos,
  rw [←nat.cast_zero,nat.cast_lt],
  exact calc 0 < 1 : zero_lt_one ... ≤ n : Hn ... ≤ m : H1
},
intros x Hx,
show x ≤ 0,
    refine not_lt.1 _,
    intro Hny,
    cases (exists_lt_nat (max (1/x) n)) with m Hm,
    have H1 := Hx (1/m),
    rw ←inv_eq_one_div at Hm,
    have H2 : n ≤ m,
    { suffices : ↑n < (↑m:ℝ),exact le_of_lt (nat.cast_lt.1 this), exact lt_of_le_of_lt (le_max_right _ _) Hm },
    have H4 : 1 / (↑m:ℝ) ∈ {x : ℝ | ∃ (m : ℕ) (H : m ≥ n), x = a2 ⟨m, (le_trans Hn H)⟩},
    { existsi [m,H2],
      refl },
    have H5 := H1 H4,
    have H6 := inv_le_inv _ _ Hny H5,
    rw [←inv_eq_one_div,inv_inv'] at H6,
    apply lt_irrefl (m:ℝ),
    refine lt_of_le_of_lt H6 _,
    refine lt_of_le_of_lt (le_max_left _ _) Hm,
end

--noncomputable def a3 : {n : ℕ // n ≥ 1} → ℝ := λ N, 1 - ((((N.val % (2:ℕ))):ℤ):ℝ)
theorem Q6c3' : liminf a3 0 :=
begin
existsi (λ _,(0:ℝ)),
split,
{ split,
  { intros x₁ Hx₁,
    cases Hx₁ with n₁ Hn₁,
    cases Hn₁ with H1 H2,
    rw H2,
    exact le_refl 0 },
  intros x₂ Hx₂,
  apply Hx₂,
  existsi 1,
  existsi _,refl,
  exact le_refl 1 },
intros n H,
split,
{ intro x₁,
  intro H1,
  show 0 ≤ x₁,
  cases H1 with n₁ Hn₁,
  cases Hn₁ with H1 H2,
  rw H2,
  unfold a3,
  rw [sub_nonneg],
  show ↑((↑n₁:ℤ) % (↑2:ℤ)) ≤ (1:ℝ),
  have H3 : (1:ℝ) = ↑(1:ℤ), rw [←int.cast_one],
  rw [H3],
  rw [int.cast_le],
  apply int.le_of_lt_add_one,
  show ↑n₁ % ↑2 < (2:ℤ),
  refine int.mod_lt_of_pos ↑n₁ _,
  norm_num },
intros x₁ Hx₁,
show x₁ ≤ 0,
apply Hx₁,
existsi (2*n+1),
existsi _,
{ unfold a3,
  apply eq.symm,
  apply sub_eq_zero_of_eq,
  rw ←int.cast_one,
  rw int.cast_inj,
  show (1:ℤ) = ↑((2*n+1) % 2),
  suffices : 1 = 1 % 2,simpa,
  refl },
rw [mul_comm,mul_two,add_assoc],
apply nat.le_add_right
end


import tactic
import set_theory.surreal
import ring_theory.localization

namespace surreal
#check pow

def powers_half : ℕ → surreal := sorry

def powers_two : submonoid ℤ := submonoid.powers 2

lemma mem_powers_iff {α : Type*} [monoid α] (z x : α) :
  x ∈ submonoid.powers z ↔ ∃ n : ℕ, z ^ n = x := iff.rfl

@[simp] noncomputable def log (n : powers 2) : ℕ :=
classical.some n.property

@[simp] def pow (n : ℕ) : powers 2 := ⟨2 ^ n, n, rfl⟩

instance : has_coe (powers 2) (submonoid.powers 2) := ⟨λ n, n⟩

theorem log_pow_eq_self (n : ℕ) : log (pow n) = n :=
begin
  unfold log,
  generalize_proofs h,
  exact @nat.pow_right_injective 2 rfl.ge (classical.some h) n (classical.some_spec h),
end

theorem pow_log_eq_self (n : powers 2) : pow (log n) = n :=
begin
  dsimp,
  rcases n with ⟨_, hn⟩,
  congr,
  exact classical.some_spec hn,
end

@[simp]
noncomputable def dyadic_mk : ℤ × powers_two → surreal :=
λ p, p.fst • powers_half (classical.some p.snd.prop)

@[simp]
theorem dyadic_mk' {m n} : dyadic_mk (m, ⟨2 ^ n, n, rfl⟩) = m • powers_half n :=
begin
  dsimp,
  generalize_proofs h,
  congr,
  simp only [powers_two, mem_powers_iff, subtype.coe_mk] at h,
  suffices : (2 : ℤ) ^ (classical.some h) = 2 ^ n,
  { have h2 : (2 : ℤ) = (2 : ℕ) := rfl,
    simp_rw [h2, ←int.coe_nat_pow, int.coe_nat_inj'] at this,
    convert nat.pow_right_injective le_rfl this,
    ext m,
    simp_rw [h2, ←int.coe_nat_pow, int.coe_nat_inj'] },
  { exact classical.some_spec h }
end

lemma int.exists_nat_eq_of_nonneg {x : ℤ} (h : 0 ≤ x) : ∃ (y : ℕ), (y : ℤ) = x :=
begin
  cases x,
  { simp },
  { refine absurd h _,
    simp },
end

lemma int.pow_right_injective {x : ℤ} (h : 2 ≤ x) : function.injective (λ (n : ℕ), x ^ n) :=
begin
  intros n m hnm,
  obtain ⟨y, rfl⟩ : ∃ (y : ℕ), (y : ℤ) = x := int.exists_nat_eq_of_nonneg ((zero_le_two).trans h),
  have : 2 ≤ y,
  { rw ←int.coe_nat_le,
    simpa using h },
  apply nat.pow_right_injective this,
  simpa [←int.coe_nat_pow, int.coe_nat_inj'] using hnm
end

@[simp]
theorem dyadic_mk'' {m n} : dyadic_mk (m, ⟨2 ^ n, n, rfl⟩) = m • powers_half n :=
begin
  dsimp,
  generalize_proofs h,
  congr,
  simp only [powers_two, mem_powers_iff, subtype.coe_mk] at h,
  apply int.pow_right_injective le_rfl,
  simpa using classical.some_spec h
end

end surreal


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Constructing pullbacks from binary products and equalizers

If a category as binary products and equalizers, then it has pullbacks.
Also, if a category has binary coproducts and coequalizers, then it has pushouts
-/

namespace category_theory.limits

/-- If the product `X ⨯ Y` and the equalizer of `π₁ ≫ f` and `π₂ ≫ g` exist, then the
    pullback of `f` and `g` exists: It is given by composing the equalizer with the projections. -/
theorem has_limit_cospan_of_has_limit_pair_of_has_limit_parallel_pair {C : Type u} [𝒞 : category C]
    {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [has_limit (pair X Y)]
    [has_limit (parallel_pair (prod.fst ≫ f) (prod.snd ≫ g))] : has_limit (cospan f g) :=
  sorry

/-- If a category has all binary products and all equalizers, then it also has all pullbacks.
    As usual, this is not an instance, since there may be a more direct way to construct
    pullbacks. -/
theorem has_pullbacks_of_has_binary_products_of_has_equalizers (C : Type u) [𝒞 : category C]
    [has_binary_products C] [has_equalizers C] : has_pullbacks C :=
  has_limits_of_shape.mk
    fun (F : walking_cospan ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_cospan F))

/-- If the coproduct `Y ⨿ Z` and the coequalizer of `f ≫ ι₁` and `g ≫ ι₂` exist, then the
    pushout of `f` and `g` exists: It is given by composing the inclusions with the coequalizer. -/
theorem has_colimit_span_of_has_colimit_pair_of_has_colimit_parallel_pair {C : Type u}
    [𝒞 : category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) [has_colimit (pair Y Z)]
    [has_colimit (parallel_pair (f ≫ coprod.inl) (g ≫ coprod.inr))] : has_colimit (span f g) :=
  sorry

/-- If a category has all binary coproducts and all coequalizers, then it also has all pushouts.
    As usual, this is not an instance, since there may be a more direct way to construct
    pushouts. -/
theorem has_pushouts_of_has_binary_coproducts_of_has_coequalizers (C : Type u) [𝒞 : category C]
    [has_binary_coproducts C] [has_coequalizers C] : has_pushouts C :=
  has_pushouts_of_has_colimit_span C

end Mathlib


import group_theory.semidirect_product for_mathlib.coprod.free_group

noncomputable theory

variables {G : Type} [group G] [decidable_eq G]
variables {H : Type} [group H] [decidable_eq H]
variables {K : Type} [group K] [decidable_eq K]

open free_group semidirect_product function

def mul_left {G : Type*} [group G] : G →* equiv.perm G :=
{ to_fun := λ g,
  { to_fun := λ h, g * h,
    inv_fun := λ h, g⁻¹ * h,
    left_inv := λ _, by simp [mul_assoc],
    right_inv := λ _, by simp [mul_assoc] },
  map_one' := by ext; simp,
  map_mul' := λ _ _, by ext; simp [mul_assoc] }

@[simp] lemma coe_fn_mul_left {G : Type*} [group G] (g : G) : (⇑(_root_.mul_left g) : G → G) = (*) g := rfl
@[simp] lemma coe_fn_mul_left_symm {G : Type*} [group G] (g : G) : (⇑(_root_.mul_left g).symm : G → G) = (*) g⁻¹ := rfl

def mul_free : G →* mul_aut (free_group G) :=
{ to_fun := λ g, free_group.equiv (_root_.mul_left g),
  map_mul' := by simp [mul_aut.mul_def, equiv.perm.mul_def],
  map_one' := by simp [mul_aut.one_def, equiv.perm.one_def] }

@[simp] lemma mul_free_of' (g : G) (h : G) (n : C∞) :
  mul_free g (of' h n) = of' (g * h) n :=
by simp [mul_free]

@[simp] lemma mul_free_of (g : G) (h : G) : mul_free g (of h) = of (g * h) :=
by simp [mul_free, of_eq_of']

@[simp] lemma mul_free_inv_of (g : G) (h : G) : (mul_free g)⁻¹ (of h) = of (g⁻¹ * h) :=
by rw [← monoid_hom.map_inv, mul_free_of]

variable (G)
@[reducible] def P : Type* := free_group G ⋊[mul_free] G

instance [decidable_eq G] : decidable_eq (P G) :=
semidirect_product.decidable_eq _ _ _

variable {G}
namespace P

variables {r rG : G} {rH : H} {rK : K}

instance : group (P G) := semidirect_product.group

def lhs (r : G) : P G →* G :=
semidirect_product.lift (free_group.lift (λ g, mul_aut.conj g r))
  (monoid_hom.id _)
  (λ g, free_group.hom_ext
    (by simp [of'_eq_of_pow, gpowers_hom, mul_assoc]))

@[simp] lemma lhs_comp_inr : (lhs r).comp inr = monoid_hom.id _ :=
by simp [lhs]

@[simp] lemma lhs_inr (g : G) : lhs r (inr g) = g := by simp [lhs]

@[simp] lemma lhs_comp_inl : (lhs r).comp inl = free_group.lift (λ g, mul_aut.conj g r) :=
by simp [lhs]

lemma lhs_inl (w : free_group G) :
  lhs r (inl w) = free_group.lift (λ g, mul_aut.conj g r) w :=
by simp [lhs]

def symm (r : G) (x : P G) : P G :=
⟨x.left⁻¹, lhs r x⟩

def trans (x y : P G) : P G :=
⟨x.1 * y.1, y.2⟩

lemma lhs_symm (r : G) (x : P G) : lhs r (symm r x) = x.right :=
by cases x; simp [symm]

lemma right_symm (r : G) (x : P G) : (symm r x).right = lhs r x :=
by simp [symm]

lemma trans_eq (x y : P G) : trans x y = x * inr x.right⁻¹ * y :=
semidirect_product.ext _ _ (by simp [trans, right_hom]) (by simp [trans, right_hom])

@[simp] lemma trans_right (x y : P G) : (x.trans y).right = y.right :=
by simp [right_hom, trans]

@[simp] lemma lhs_trans (x y : P G) : lhs r (x.trans y) = lhs r x * x.right⁻¹ * lhs r y :=
by simp [lhs, right_hom, trans_eq]

section map

/-- This is mainly used with `f` being `remove_subscript` which is not injective,
nor is it injective on the words on which it is used. -/
def map (f : G →* H) (hf : injective f) : P G →* P H :=
semidirect_product.map (free_group.embedding ⟨f, hf⟩) f
  (λ g, free_group.hom_ext (by simp))

@[simp] lemma map_id : map (monoid_hom.id G) injective_id = monoid_hom.id (P G) :=
semidirect_product.hom_ext (free_group.hom_ext (by simp [map]))
  (monoid_hom.ext $ by simp [map])

/-- `change_r w` take a proof about `w * r * w⁻¹` and returns a proof about
  `r`  -/
def change_r (w : G) : P G →* P G :=
semidirect_product.map (free_group.equiv (equiv.mul_right w)).to_monoid_hom
  (monoid_hom.id _)
  (λ g, free_group.hom_ext $ by simp [mul_assoc])

@[simp] lemma lhs_comp_change_r (r w : G) :
  (lhs r).comp (change_r w) = lhs (w * r * w⁻¹) :=
semidirect_product.hom_ext (free_group.hom_ext
  (by simp [change_r, mul_assoc, lhs_inl]))
  (by simp [monoid_hom.comp_assoc, change_r])

@[simp] lemma right_hom_comp_change_r (w : G) (x : P G) :
  right_hom.comp (change_r w) = right_hom := rfl

end map

end P

/-- `solver r T` is defined to be the type `free_group ι → option (P (free_group ι))`.
By convention, a `solver r T` will solve the word problem with respect to `r` and `T` -/
@[reducible] def solver {ι : Type} [decidable_eq ι] (r : free_group ι) (T : set ι) : Type :=
free_group ι → option (P (free_group ι))