/-
Copyright (c) 2018 Luca Gerolla. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luca Gerolla, Kevin Buzzard
Results on homotopy composition, inverse, reparametrisation for fundamental group.
-/
import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space
import analysis.real
import data.real.basic tactic.norm_num
import data.set.basic
import Topology.Material.pasting_lemma
import Topology.Material.path
import Topology.Material.real_results
import Topology.Material.homotopy

open set filter lattice classical
namespace homotopy_results
open path
open homotopy

variables {α  : Type*} [topological_space α ]
variables {β  : Type*} [topological_space β ] { x y z w : β  }
variable s : I01

noncomputable theory

local attribute [instance] classical.prop_decidable

local notation `I` := @set.univ I01

-----------------------------------------------------

--- Extra Result needed later

-- Now in Mathlib
lemma frontier_lt_subset_eq [topological_space α] [decidable_linear_order α] [t : ordered_topology α]
  [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
frontier {b | f b < g b} ⊆ {b | f b = g b} :=
begin
  unfold frontier,
  have h₁ : interior {b : β | f b < g b} = {b : β | f b < g b},
    exact interior_eq_iff_open.2 (is_open_lt  hf hg), rw h₁,
  have h₂ : closure {b : β | f b < g b} ⊆ closure {b : β | f b ≤  g b},
    refine closure_mono _  , rw set.set_of_subset_set_of, intros x h, exact le_of_lt h,
  have h₃ : closure {b : β | f b ≤  g b} = {b : β | f b ≤  g b},
    exact closure_eq_iff_is_closed.2 (is_closed_le hf hg), rw h₃ at h₂ ,
  have g₁ : closure {b : β | f b < g b} \ {b : β | f b < g b} ⊆
                 {b : β | f b ≤ g b} \ {b : β | f b < g b},
   {unfold has_sdiff.sdiff set.diff, intros a Ha, simp at Ha, simp,
    cases Ha with a₁ a₂ ,
    have h₄ : a ∈ {b : β | f b ≤ g b}, exact set.mem_of_mem_of_subset a₁ h₂,
    rw mem_set_of_eq at h₄, exact ⟨ h₄, a₂ ⟩ , },
  have g₂ : {b : β | f b ≤ g b} \ {b : β | f b < g b} ⊆ {b : β | f b = g b},
    unfold has_sdiff.sdiff set.diff, intros a Ha, simp  at Ha,
    rw mem_set_of_eq, exact le_antisymm Ha.1 Ha.2,
  exact set.subset.trans g₁ g₂,
end

lemma mem_frontier_lt [topological_space α] [decidable_linear_order α] [t : ordered_topology α]
  [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) { s : β  } :
  s ∈ frontier {b | f b < g b}  → s ∈  {b | f b = g b} :=
begin intro h, exact  set.mem_of_mem_of_subset h (frontier_lt_subset_eq hf hg), end

---------------------------------------------------------

---- Other Homotopy results (for fundamental group proof)

---- Reparametrisation of path and homotopies

-- (Formalise paragraph 2 pg 27 of AT, https://pi.math.cornell.edu/~hatcher/AT/AT.pdf )

structure repar_I01  :=
(to_fun : I01 → I01 )
(at_zero : to_fun 0 = 0 )
(at_one : to_fun 1 = 1 )
(cont : continuous to_fun )

@[simp]
lemma repar_I01_at_zero ( φ  : repar_I01) : φ.to_fun 0 = 0 := φ.2

@[simp]
lemma repar_I01_at_one ( φ : repar_I01) : φ.to_fun 1 = 1 := φ.3

-- Reparametrised path f ( φ (t) )
def repar_path  ( f : path x y)( φ : repar_I01 ) : path x y :=
{   to_fun := λ t , f.to_fun ( φ.to_fun t) ,
    at_zero := by simp,
    at_one := by simp,
    cont := continuous.comp φ.cont f.cont
}

-- Function of the homotopy associated to the reparametrisation φ
def rep_hom (φ : repar_I01) : I01 × I01 → I01 :=
  λ st, ⟨ ((1 : ℝ ) - st.1.1)*(φ.to_fun st.2).1 + st.1.1 * st.2.1,
begin
  unfold I01, rw mem_set_of_eq, split,
    { suffices H1 : 0 ≤ (1 - (st.fst).val) * (φ.to_fun (st.snd)).val ,
      suffices H2 : 0 ≤ (st.fst).val * (st.snd).val, exact add_le_add H1 H2,
        refine mul_nonneg _ _, exact st.1.2.1, exact st.2.2.1,
        refine mul_nonneg _ _, show 0 ≤ 1 - (st.fst).val , refine sub_nonneg.2  _ , exact st.1.2.2, exact (φ.to_fun (st.snd)).2.1,
    }, rw (@mul_comm _ _ (1 - (st.fst).val)  (φ.to_fun (st.snd)).val), simp [@mul_add ℝ _ ((φ.to_fun (st.snd)).val )  (1:ℝ ) (- st.fst.val) ],
    rw mul_comm ((φ.to_fun (st.snd)).val ) ((st.fst).val),
    have H : ((st.fst).val * (st.snd).val + -((st.fst).val * (φ.to_fun (st.snd)).val)) = (st.fst).val * ((st.snd).val - ((φ.to_fun (st.snd)).val)), simp [mul_add],
    rw H, have H2 : (st.fst).val ≤ 1, exact st.1.2.2,
    let C := 0 < ((st.snd).val - (φ.to_fun (st.snd)).val) ,
    by_cases C,
        have C1 : 0 < ((st.snd).val - (φ.to_fun (st.snd)).val), exact h,
        have H3 : (st.fst).val * ((st.snd).val - (φ.to_fun (st.snd)).val) ≤ 1 * ((st.snd).val - (φ.to_fun (st.snd)).val), rw one_mul,
            refine (@le_div_iff _ _ (st.fst).val ((st.snd).val - (φ.to_fun (st.snd)).val) ((st.snd).val - (φ.to_fun (st.snd)).val) C1).1 _,
            have h2 : ((st.snd).val - (φ.to_fun (st.snd)).val) / ((st.snd).val - (φ.to_fun (st.snd)).val) = 1, refine div_self _, exact ne_of_gt C1,
            rw h2, exact st.1.2.2,  rw one_mul at H3,
        have G1 : (φ.to_fun (st.snd)).val + (st.fst).val * ((st.snd).val - (φ.to_fun (st.snd)).val) ≤ (φ.to_fun (st.snd)).val + ((st.snd).val - (φ.to_fun (st.snd)).val),
            refine add_le_add _ H3, refine le_of_eq _, refl,
        suffices G2 : (φ.to_fun (st.snd)).val + ((st.snd).val - (φ.to_fun (st.snd)).val) ≤ 1, exact le_trans G1 G2,
            simp [st.2.2.2],
        -----
        have C0 : ¬ 0 < ((st.snd).val - (φ.to_fun (st.snd)).val), exact h,
        have C1 : ((st.snd).val - (φ.to_fun (st.snd)).val) ≤ 0, exact not_lt.1 C0,
        have H3 : (st.fst).val * ((st.snd).val - (φ.to_fun (st.snd)).val) ≤ 0,
            exact mul_nonpos_of_nonneg_of_nonpos (st.1.2.1) C1,
        have G1 : (φ.to_fun (st.snd)).val + (st.fst).val * ((st.snd).val - (φ.to_fun (st.snd)).val) ≤ (φ.to_fun (st.snd)).val ,
            refine le_neg_add_iff_add_le.1 _, simpa ,
        have G2 : (φ.to_fun (st.snd)).val ≤ 1, exact (φ.to_fun (st.snd)).2.2,
        exact le_trans G1 G2,

    --( 1-s )φ t + s t =
    -- φ t + s (t - φ t) ≤
    -- φ t + (t - φ t) =
    -- t ≤ 1
end ⟩

@[simp]
lemma rep_hom_at_zero (φ : repar_I01) ( y : I01 ) : rep_hom φ (0, y) = φ.to_fun y :=
begin unfold rep_hom, simp, apply subtype.eq, simp [mul_comm, mul_zero],
  show  y.val * 0 + (φ.to_fun y).val * (1 + -0) = (φ.to_fun y).val, simp [mul_zero, mul_add, add_zero]
end

@[simp]
lemma rep_hom_at_one (φ : repar_I01) ( y : I01) : rep_hom φ (1, y) =  y :=
begin unfold rep_hom, apply subtype.eq, simp [-sub_eq_add_neg],
  show  1 * y.val + (1 - 1) * (φ.to_fun y).val = y.val, simp
end

@[simp]
lemma rep_hom_pt_at_zero (φ : repar_I01) ( s : I01) : rep_hom φ (s, 0) = 0 :=
begin unfold rep_hom, simp, apply subtype.eq, simp,  show s.val * 0+ (1 + -s.val) * 0 = 0, simp, end

@[simp]
lemma rep_hom_pt_at_one (φ : repar_I01) ( s : I01) : rep_hom φ (s, 1) = 1 :=
begin unfold rep_hom, simp, apply subtype.eq, simp, show s.val * 1 + (1 + -s.val) * 1 = 1, simp end

lemma cont_rep_hom (φ : repar_I01) : continuous (rep_hom φ ) :=
begin
  unfold rep_hom, refine continuous_subtype_mk _ _,
  refine @continuous_add _ _ _ _ _ _ (λ st: I01×I01 , (1 - (st.fst).val) * (φ.to_fun (st.snd)).val ) _ _ _,
   { refine continuous_mul _ _, refine continuous_add _ _, exact continuous_const,
      show continuous (( λ x : ℝ , - x ) ∘ (λ (st : ↥I01 × ↥I01), (st.fst).val) ),
      refine continuous.comp (continuous.comp continuous_fst continuous_subtype_val) (continuous_neg continuous_id),
     exact continuous.comp (continuous.comp continuous_snd φ.cont) continuous_subtype_val
   },
   refine continuous_mul _ (continuous.comp continuous_snd continuous_subtype_val) ,
   exact continuous.comp continuous_fst continuous_subtype_val,
end

-- Define homotopy from f φ to f , for any repar φ
def hom_repar_path_to_path {α : Type*} [topological_space α ] {x y : α }
( f : path x y)( φ : repar_I01 ) : path_homotopy (repar_path f φ ) f :=
{   to_fun :=  λ st, f.to_fun ( (rep_hom φ) st),
    path_s :=
    begin
      intro s, unfold is_path, split, simp, split, simp,
      show continuous ( (λ (st : I01×I01), f.to_fun (rep_hom φ st )) ∘ ( λ t : I01, ((s, t) : I01 × I01) )    ),
      refine continuous.comp _ (continuous.comp (cont_rep_hom φ ) f.cont ),
      exact continuous.prod_mk continuous_const continuous_id
    end,
    at_zero := by simp,
    at_one := by simp,
    cont :=  continuous.comp (cont_rep_hom φ ) f.cont
}

-- Prove f φ ≈ f (they are homotopic)
theorem repar_path_is_homeq {α : Type*} [topological_space α ] {x y : α } ( f : path x y)( φ : repar_I01 )
: is_homotopic_to (repar_path f φ ) f :=
begin unfold is_homotopic_to, exact nonempty.intro (hom_repar_path_to_path f φ ),  end

-----------------------------

-- Homotopy of path inverses
------  a ≈ b  →  a⁻¹ ≈ b⁻¹

def f_path_inv { a b : path x y } ( F : path_homotopy a b ) : I01 × I01 → β :=
λ st, F.to_fun (st.1 , par_inv st.2)

lemma f_path_inv_start_pt  { a b : path x y } ( F : path_homotopy a b ) :
∀ (s : I01), f_path_inv F (s, 0) = y := begin unfold f_path_inv, simp end

lemma f_path_inv_end_pt  { a b : path x y } ( F : path_homotopy a b ) :
∀ (s : I01), f_path_inv F (s, 1) = x := begin unfold f_path_inv, simp end

lemma f_path_inv_at_zero  { a b : path x y } ( F : path_homotopy a b ) :
∀ (y_1 : I01), f_path_inv F (0, y_1) = (inv_of_path a).to_fun y_1 :=
begin intro y, unfold f_path_inv inv_of_path, simp, end

lemma f_path_inv_at_one  { a b : path x y } ( F : path_homotopy a b ) :
∀ (y_1 : I01), f_path_inv F (1, y_1) = (inv_of_path b).to_fun y_1 :=
begin intro y, unfold f_path_inv inv_of_path, simp, end

lemma f_path_inv_cont { a b : path x y } ( F : path_homotopy a b ) :
continuous (f_path_inv F) :=
begin
 unfold f_path_inv,
 refine continuous.comp _ F.cont,
 refine continuous.prod_mk continuous_fst _,
 exact continuous.comp continuous_snd continuous_par_inv
end

noncomputable def path_homotopy_of_inv_path {α } [topological_space α] {x y : α}
 { a b : path x y }
  ( F : path_homotopy a b ) : path_homotopy (inv_of_path a) (inv_of_path b) :=
path_homotopy.mk' (f_path_inv F) (f_path_inv_start_pt F) (f_path_inv_end_pt F)
 (f_path_inv_at_zero F) (f_path_inv_at_one F) (f_path_inv_cont F)

---------------------------------

---------------------------------

-- Homotopy on composition of paths
------ a₁ ≈ b₁ , a₂ ≈ b₂  →  a₁ ⬝ a₂ ≈ b₁ ⬝ b₂

-- needed to prove multiplication is well definied in fundamental group

-- Define (continuous) shift function to employ results on I01 × I01 from  path_homotopy_comp
def shift_order ( α : Type* ) (β : Type*) [topological_space α] [topological_space β ] :
  α × β → β × α := λ ab, (ab.2, ab.1)

theorem continuous_shift_order {α β } [topological_space α] [topological_space β ] :
  continuous (shift_order α β ) :=
begin unfold shift_order, exact continuous.prod_mk continuous_snd continuous_fst end

local notation `shift` := shift_order _ _

@[simp]
lemma shift_cond_start  { a₁ b₁ : path x y} { a₂  b₂  : path y z}
  { F : path_homotopy a₁ b₁ } { G : path_homotopy a₂ b₂ } :
  paste cover_prod_I01 (λ (st : ↥(set.prod T1 univ)),
  F.to_fun (shift ↑st)) (λ (st : ↥(set.prod T2 univ)), G.to_fun (shift ↑st))(shift (s, 0)) = x :=
begin unfold shift_order paste, rw dif_pos, simp, simp, exact help_T1,  end

@[simp]
lemma shift_cond_end  { a₁ b₁ : path x y} { a₂  b₂  : path y z}
  { F : path_homotopy a₁ b₁ } { G : path_homotopy a₂ b₂ } :
  paste cover_prod_I01 (λ (st : ↥(set.prod T1 univ)), F.to_fun (shift ↑st))
  (λ (st : ↥(set.prod T2 univ)), G.to_fun (shift ↑st))(shift (s, 1)) = z :=
begin unfold shift_order paste, rw dif_neg, simp, simp, exact help_02,   end

---

-- Define (continuous ) reparametrisations to shift domain and construct a homotopy  : a₁ ⬝ a₂ ≈ b₁ ⬝ b₂
----- by pasting homotopies a₁ ≈ b₁ , a₂ ≈ b₂
def repar_shift_a : set.prod T1 I → I01 × I01 :=
λ st, shift (  par zero_lt_half ⟨ st.1.1, (mem_prod.1 st.2).1⟩ , st.1.2 )

def repar_shift_b : set.prod T2 I → I01 × I01 :=
λ st, shift (  par half_lt_one ⟨ st.1.1, (mem_prod.1 st.2).1 ⟩ , st.1.2 )

lemma cont_r_shift_a : continuous repar_shift_a :=
begin
  unfold repar_shift_a, refine continuous.comp _ continuous_shift_order,
  refine continuous.prod_mk _ _,
    refine continuous.comp _ (continuous_par _ ), refine continuous_subtype_mk _ _,
    exact continuous.comp continuous_subtype_val continuous_fst,
    exact continuous.comp continuous_subtype_val continuous_snd,
end

lemma cont_r_shift_b : continuous repar_shift_b :=
begin
  unfold repar_shift_b, refine continuous.comp _ continuous_shift_order,
  refine continuous.prod_mk _ _,
    refine continuous.comp _ (continuous_par _ ), refine continuous_subtype_mk _ _,
    exact continuous.comp continuous_subtype_val continuous_fst,
    exact continuous.comp continuous_subtype_val continuous_snd,
end

-- Define the function of homotopy a₁ ⬝ a₂ ≈ b₁ ⬝ b₂ and prove lemmas to use with path_homotopy.mk'
def f_path_comp { a₁ b₁ : path x y} { a₂  b₂  : path y z}
 ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :=
 λ st, ( paste  cover_prod_I01 ( λ st, F.to_fun (repar_shift_a st) )
   ( λ st, G.to_fun (repar_shift_b st) ) )  ( shift  st)

lemma f_path_comp_start_pt { a₁ b₁ : path x y} { a₂  b₂  : path y z}
  ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :
  ∀ (s : I01), f_path_comp F G (s, 0) = x :=
begin
  intro s, unfold f_path_comp, unfold repar_shift_a repar_shift_b shift_order paste, rw dif_pos,
  show F.to_fun (s, par zero_lt_half ⟨0, help_T1⟩) = x,  simp,
  simp, exact help_T1,
end

lemma f_path_comp_end_pt { a₁ b₁ : path x y} { a₂  b₂  : path y z}
  ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :
  ∀ (s : I01), f_path_comp F G (s, 1) = z :=
begin
  intro s, unfold f_path_comp, unfold repar_shift_a repar_shift_b shift_order paste, rw dif_neg, simp,
  show G.to_fun (s, par half_lt_one ⟨1, help_T2⟩) = z, simp,
  simp [help_02],
end

lemma f_path_comp_at_zero { a₁ b₁ : path x y} { a₂  b₂  : path y z} ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :
∀ (y : I01), f_path_comp F G (0, y) = (comp_of_path a₁ a₂).to_fun y :=
begin
  intro s, unfold f_path_comp comp_of_path fa_path fb_path fgen_path paste,  simp,
  split_ifs,  unfold repar_shift_a, unfold shift_order, simpa,
  { by_contradiction, unfold shift_order at h, simp at h, cc, },
  { by_contradiction, unfold shift_order at h, simp at h, cc, },
  unfold repar_shift_b, unfold shift_order, simpa,
end

lemma f_path_comp_at_one { a₁ b₁ : path x y} { a₂  b₂  : path y z} ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :
 ∀ (y : I01), f_path_comp F G (1, y) = (comp_of_path b₁ b₂).to_fun y :=
begin
  intro s, unfold f_path_comp comp_of_path fa_path fb_path fgen_path paste,  simp,
  split_ifs,  unfold repar_shift_a, unfold shift_order, simpa,
  { by_contradiction, unfold shift_order at h, simp at h, cc, },
  { by_contradiction, unfold shift_order at h, simp at h, cc, },
  unfold repar_shift_b, unfold shift_order, simpa,
end

lemma f_path_comp_cont { a₁ b₁ : path x y} { a₂  b₂  : path y z} ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :
continuous (f_path_comp F G) :=
begin
  unfold f_path_comp, refine continuous.comp continuous_shift_order _,
    refine cont_of_paste prod_T1_is_closed prod_T2_is_closed _ _ _,
    {unfold match_of_fun, intros w B1 B2,
    have Int : w ∈ set.inter (set.prod T1 I) (set.prod T2 I), exact ⟨ B1 , B2 ⟩ , rwa [prod_inter_T] at Int,
    have V : w.1.1 = 1/2, rwa [set.prod, mem_set_of_eq] at Int, rwa [mem_set_of_eq] at Int, exact Int.1, cases w,
    have xeq : w_fst = ⟨ 1/2 , help_01 ⟩ , apply subtype.eq, rw V,
    simp [xeq, -one_div_eq_inv], unfold repar_shift_a repar_shift_b shift_order,
    simp [-one_div_eq_inv],
    show F.to_fun (w_snd, par zero_lt_half ⟨⟨1 / 2, help_01⟩, help_half_T1⟩) =
    G.to_fun (w_snd, par half_lt_one ⟨⟨1 / 2, help_01⟩, help_half_T2⟩) , rw [eqn_1, eqn_2], simp,
    } ,
    exact continuous.comp cont_r_shift_a F.cont,
    exact continuous.comp cont_r_shift_b G.cont,
end

-- Prove that we have the homotopy a₁ ⬝ a₂ ≈ b₁ ⬝ b₂
noncomputable def path_homotopy_of_comp_path { a₁ b₁ : path x y} { a₂  b₂  : path y z}
  ( F : path_homotopy a₁ b₁ ) ( G : path_homotopy a₂ b₂ ) :
  path_homotopy (comp_of_path a₁ a₂) (comp_of_path b₁ b₂) :=
begin
  refine path_homotopy.mk' (f_path_comp F G ) _ _ _ _ _,
  exact f_path_comp_start_pt F G, exact f_path_comp_end_pt F G,
  exact f_path_comp_at_zero F G , exact f_path_comp_at_one F G,
  exact f_path_comp_cont F G,
end

----------------------------------------------------

local attribute [instance] classical.prop_decidable

------------------------------------------

-- Homotopy of composition with inverse
------ a⁻¹ ⬝ a ≈ c₀

-- continuity lemma employed later
lemma cont_help_1 : continuous (λ (a : ↥I01 × ↥I01), 1 - (a.fst).val ) :=
begin
  have h : continuous ( λ (r : ℝ ), 1 - r ),  conv in ( (1:ℝ)-_) begin rw help_inv, end,
    by exact continuous.comp (real.continuous_mul_const (-1) ) (real.continuous_add_const 1),
  exact continuous.comp (continuous.comp continuous_fst continuous_subtype_val) h,
end

/- To prove for a path f that f⁻¹ ⬝ f ≈ c₀ (constant loop at given basepoint),
need 2 continuous function that are (2) piecewise-linear applied as reparamatrization of path φ(s) (similar to above),
such that the composition (f⁻¹ ⬝ f) φ(1) = c₀ and (f⁻¹ ⬝ f) φ(0) = f⁻¹ ⬝ f - as depicted in AT pg 27.
-/

-- "Reparametrisation" to shrink path f⁻¹

def par_aux_a : I01 × I01 → I01 :=
λ st, if ((1 : ℝ ) - st.1.1) < st.2.1 then st.1 else par_inv st.2

lemma continuous_par_aux_a  : continuous par_aux_a :=
begin
  unfold par_aux_a,
  refine continuous_if _ continuous_fst (continuous.comp continuous_snd continuous_par_inv) ,
  intros st F,
  have H : frontier {a : ↥I01 × ↥I01 | 1 - (a.fst).val < (a.snd).val} ⊆  {a : ↥I01 × ↥I01 | 1 - (a.fst).val = (a.snd).val },
    exact frontier_lt_subset_eq cont_help_1 (continuous.comp continuous_snd continuous_subtype_val),
  have h : st ∈ {a : ↥I01 × ↥I01 | 1 - (a.fst).val = (a.snd).val},
    exact set.mem_of_mem_of_subset F H ,
    rw [ mem_set_of_eq] at h, unfold par_inv, refine subtype.eq _,
    show (st.fst).val = 1 -(st.snd).val,
    have H4 : (st.snd).val = 1 - (st.fst).val, exact eq.symm h,
  simp [H4],
end

def repar_stop_a : set.prod T1 I → I01 :=
λ st, par_aux_a ( shift (  par zero_lt_half ⟨ st.1.1, (mem_prod.1 st.2).1⟩ , st.1.2 ) )

lemma cont_r_stop_a : continuous repar_stop_a :=
begin
  unfold repar_stop_a, refine continuous.comp _ continuous_par_aux_a,
  refine continuous.comp _ continuous_shift_order,
  refine continuous.prod_mk _ (continuous.comp continuous_subtype_val continuous_snd),
  refine continuous.comp _ (continuous_par _ ),
  refine continuous_subtype_mk _ _, exact continuous.comp continuous_subtype_val continuous_fst,
end

-- This will be the actual function that will make up the left part of the homotopy (see f_inv_comp)
def fa_inv_comp (f : path x y) : set.prod T1 I → β  :=
λ st, f.to_fun  ( repar_stop_a st  )

lemma cont_fa_inv_comp  (f : path x y) :
continuous (fa_inv_comp f) :=
begin unfold fa_inv_comp, exact continuous.comp  cont_r_stop_a  f.cont, end

--------------

-- "Reparametrisation" to shrink path f

def par_aux_b : I01 × I01 → I01 :=
λ st, if st.2.1 < st.1.1 then st.1 else st.2

lemma continuous_par_aux_b  : continuous par_aux_b :=
begin
  unfold par_aux_b,
  refine continuous_if _ continuous_fst continuous_snd ,
  {intros st F,
  have H : frontier {a : ↥I01 × ↥I01 | (a.snd).val < (a.fst).val} ⊆ {a : ↥I01 × ↥I01 | (a.snd).val = (a.fst).val},
    exact frontier_lt_subset_eq (continuous.comp continuous_snd continuous_subtype_val) (continuous.comp continuous_fst continuous_subtype_val) ,
  have h : st ∈ {a : ↥I01 × ↥I01 | (a.snd).val = (a.fst).val},
   exact set.mem_of_mem_of_subset F H , rw [ mem_set_of_eq] at h,
   apply eq.symm, exact subtype.eq h,
  },
end

def repar_stop_b : set.prod T2 I → I01  :=
λ st, par_aux_b ( shift (  par half_lt_one ⟨ st.1.1, (mem_prod.1 st.2).1⟩ , st.1.2 ) )

lemma cont_r_stop_b : continuous repar_stop_b :=
begin
 unfold repar_stop_b, refine continuous.comp _ continuous_par_aux_b,
 refine continuous.comp _ continuous_shift_order,
 refine continuous.prod_mk _ (continuous.comp continuous_subtype_val continuous_snd),
 refine continuous.comp _ (continuous_par _ ),
 refine continuous_subtype_mk _ _, exact continuous.comp continuous_subtype_val continuous_fst,
end

def fb_inv_comp  (f : path x y) : set.prod T2 I → β  :=
λ st, f.to_fun (  repar_stop_b st  )

lemma cont_fb_inv_comp  (f : path x y) :
continuous (fb_inv_comp f) :=
begin unfold fb_inv_comp, exact continuous.comp cont_r_stop_b  f.cont, end

---- Combine the two reparametrisation
---- Set up function and lemmas for path_homotopy.mk'

def f_inv_comp  (f : path x y) : I01 × I01 → β  :=
λ st, ( paste cover_prod_I01  ( λ st, (fa_inv_comp f ) st ) ( λ st, (fb_inv_comp f ) st ) ) (shift st)

lemma f_inv_comp_start_pt  (f : path x y) : ∀ (s : I01), f_inv_comp f (s, 0) = y :=
begin
  intro s, unfold f_inv_comp fa_inv_comp fb_inv_comp,
  unfold repar_stop_a repar_stop_b shift_order par_aux_a par_aux_b paste, simp [-sub_eq_add_neg],
  rw [dif_pos ],
  have H : ite (1 - s.val < (par zero_lt_half ⟨0, help_T1⟩).val) s (par_inv (par zero_lt_half ⟨0, help_T1⟩)) = (1 : I01),
    split_ifs,   have H2 : s.val + (0 : I01).val = s.val, show s.val + (0:ℝ ) = s.val, exact  add_zero s.val,
      have H3 : s.val ≤ (1:I01).val, exact s.2.2, have H4 : 1 - (0:I01).val = 1, exact sub_zero 1,
      rw [ eqn_start ] at h, rw [sub_lt] at h, have H5 : 1 < s.val, rw H4 at h,  exact h,
      by_contradiction, have G : s.val < s.val, exact lt_of_le_of_lt H3 h,
        simp [lt_iff_le_and_ne] at G, trivial,
      simp,
  show f.to_fun (ite (1 - s.val < (par zero_lt_half ⟨0, help_T1⟩).val) s (par_inv (par zero_lt_half ⟨0, help_T1⟩))) = y,
  rw [H], exact f.at_one,
  simp, exact help_T1,
end

lemma f_inv_comp_end_pt (f : path x y) : ∀ (s : I01), f_inv_comp f (s, 1) = y :=
begin
  intro s, unfold f_inv_comp, unfold paste, rw dif_neg, unfold fb_inv_comp repar_stop_b shift_order par_aux_b, simp [-sub_eq_add_neg],
  have H : ite ((par half_lt_one ⟨1, help_T2⟩).val < s.val) s (par half_lt_one ⟨1, help_T2⟩) = 1,
    split_ifs, {  by_contradiction, rw eqn_end at h, have H2 : s.val ≤ (1:I01).val, exact s.2.2,
      have G : s.val < s.val, exact lt_of_le_of_lt H2 h, simp [lt_iff_le_and_ne] at G, trivial,
      },
      exact eqn_end,
  show f.to_fun (ite ((par half_lt_one ⟨1, help_T2⟩).val < s.val) s (par half_lt_one ⟨1, help_T2⟩ )) = y,
  rw H, exact f.at_one,
  unfold shift_order, simp [help_02],
end

lemma f_inv_comp_at_zero (f : path x y) :
  ∀ (y_1 : I01), f_inv_comp f (0, y_1) = (comp_of_path (inv_of_path f) f).to_fun y_1 :=
begin
  intro t, unfold f_inv_comp fa_inv_comp fb_inv_comp repar_stop_a repar_stop_b,
  unfold paste, unfold shift_order, split_ifs,
    unfold shift_order at h, simp at h, unfold par_inv comp_of_path paste,  simp [h],
    unfold fa_path par_aux_a inv_of_path, simp [-sub_eq_add_neg],
    show f.to_fun (ite (1 - 0< (par zero_lt_half ⟨t, _⟩).val) 0 (par_inv (par zero_lt_half ⟨t, _⟩))) =
     f.to_fun (par_inv (par zero_lt_half ⟨t, _⟩)),
     simp, rw if_neg, refl, refine not_lt.2 _, exact (par zero_lt_half ⟨t, _⟩).2.2,
    unfold shift_order at h, simp at h, unfold comp_of_path paste fb_path,
    unfold par_aux_b, rw if_neg, simpa [h],
    refine not_lt.2 _, simp, exact (par half_lt_one ⟨t, _⟩).2.1,
end

lemma f_inv_comp_at_one (f : path x y) :
  ∀ (y_1 : I01), f_inv_comp f (1, y_1) = (loop_const y).to_fun y_1 :=
begin
  intro t, unfold f_inv_comp fa_inv_comp fb_inv_comp repar_stop_a repar_stop_b,
  unfold paste, unfold shift_order, split_ifs,
    unfold shift_order at h, simp at h, unfold loop_const, unfold par_aux_a, split_ifs with h₂ ,
      exact f.at_one,
      simp [not_lt,  -sub_eq_add_neg] at h₂ ,
      have H :  (par zero_lt_half ⟨t, _⟩).val ≤ 1 - 1,  exact h₂ , rw [sub_self] at H,
      have h₃ : (par zero_lt_half ⟨t, h⟩).val = 0, --
        exact le_antisymm H ((par zero_lt_half ⟨t, h⟩).2.1),
      have H2 : (par zero_lt_half ⟨t, h⟩) = (0: I01),
        exact subtype.eq h₃ ,
      show f.to_fun (par_inv (par zero_lt_half ⟨t, h⟩)) = y, rw H2, simp,
    unfold shift_order at h, simp at h, unfold par_aux_b, unfold loop_const, split_ifs with h₂,
      exact f.at_one,
      simp [not_lt,  -sub_eq_add_neg] at h₂,
      have H : (par half_lt_one ⟨t, _⟩).val = (1:I01).val,
       apply eq.symm, exact le_antisymm h₂ (par half_lt_one ⟨t, _⟩).2.2,
      have H2 : (par half_lt_one ⟨t, _⟩) = (1: I01), exact subtype.eq H,
      simp [H2],
end

lemma f_inv_comp_cont (f : path x y) : continuous (f_inv_comp f) :=
begin
  unfold f_inv_comp, refine continuous.comp continuous_shift_order _,
  refine cont_of_paste prod_T1_is_closed prod_T2_is_closed _
    (cont_fa_inv_comp f) (cont_fb_inv_comp f),
  { unfold match_of_fun, intros w B1 B2,
    have Int : w ∈ set.inter (set.prod T1 I) (set.prod T2 I), exact ⟨ B1 , B2 ⟩ , rwa [prod_inter_T] at Int,
    have V : w.1.1 = 1/2, rwa [set.prod, mem_set_of_eq] at Int, rwa [mem_set_of_eq] at Int, exact Int.1, cases w,
    have xeq : w_fst = ⟨ 1/2 , help_01 ⟩ , apply subtype.eq, rw V, --
    simp [xeq, -one_div_eq_inv], unfold  fa_inv_comp fb_inv_comp,
    unfold repar_stop_a repar_stop_b shift_order par_aux_a par_aux_b, simp [-sub_eq_add_neg,-one_div_eq_inv],
    show f.to_fun
      (ite (1 - w_snd.val < (par zero_lt_half ⟨⟨1 / 2, help_01⟩, help_half_T1⟩).val) w_snd
         (par_inv (par zero_lt_half ⟨⟨1 / 2, help_01⟩, help_half_T1⟩))) =
    f.to_fun
      (ite ((par half_lt_one ⟨⟨1 / 2, help_01⟩, help_half_T2⟩).val < w_snd.val) w_snd
         (par half_lt_one ⟨⟨1 / 2, help_01⟩, help_half_T2 ⟩)),
    rw [eqn_1, eqn_2, eqn_2_par_inv], rw sub_lt,
    show f.to_fun (ite (1 - (1:ℝ ) < w_snd.val) w_snd 0) =
    f.to_fun (ite ((0:ℝ)  < w_snd.val) w_snd 0), rw sub_self,
  },
end

noncomputable def hom_inv_comp_to_const (f : path x y) :
  path_homotopy (comp_of_path (inv_of_path f) f) (loop_const y) :=
path_homotopy.mk' (f_inv_comp f) (f_inv_comp_start_pt f) (f_inv_comp_end_pt f)
(f_inv_comp_at_zero f) (f_inv_comp_at_one f) (f_inv_comp_cont f)

----------------------------------------------------------------------

-- Homotopy of three paths (associativity)
------ (f ⬝ g) ⬝ h ≈ f ⬝ ( g ⬝ h)

/-  For this define a (3) piecewise linear function φ (repar_I01),
whose corresponding homotopy will serve for associativity proof.
-/

--- Reparametrisation on [1/2, 1] ( 2 piecewise linear funtion : [1/2, 1] → [1/4, 1] )

lemma help_p3_aux₁  (s : T2) : (s.val).val - 1 / 4 ∈ I01 :=
begin
unfold I01, rw mem_set_of_eq, split,
 refine  le_sub_iff_add_le.2 _,  rw [add_comm, add_zero], refine le_trans _ s.2.1, {norm_num},
 rw sub_le_iff_le_add, refine le_trans s.2.2 _, norm_num,
end

lemma help_p3_aux₂  ( s : T2) :  2 * (s.val).val - 1 ∈ I01 :=
begin
 unfold I01,
 rw mem_set_of_eq, split,
  have h₁ : 1/2 ≤ (s.val).val, exact s.2.1,
  refine le_sub_iff_add_le.2 _, rw [add_comm, add_zero],
  have H : (2 : ℝ) > 0, {norm_num}, rw mul_comm,
  refine (div_le_iff H).1 _, exact h₁,
  have h₂ : (s.val).val ≤ (1:ℝ ), exact s.2.2,
  have H2 : 2*(s.val).val ≤ 2 * 1,
  have HH : 0 < (2 : ℝ), {norm_num},
  refine (@mul_le_mul_left _ _ s.1.1 1 2 HH ).2 _, exact h₂,
  rw [mul_one] at H2, norm_num [H2],
end

def p3_aux : T2 → I01 :=
λ s, if s.1.1 < (3/4: ℝ ) then ⟨ s.1.1 - 1/4 , help_p3_aux₁ s ⟩  else ⟨ ( 2 : ℝ )*s.1.1 - (1: ℝ) , help_p3_aux₂  s ⟩

lemma help_cont_p3_aux₁ : continuous (λ (s : ↥T2), (s.val).val - 1 / 4) :=
continuous.comp  (continuous.comp continuous_subtype_val continuous_subtype_val) (real.continuous_sub_const  (1/4) )

lemma help_cont_p3_aux₂  : continuous (λ (s : ↥T2), 2 * (s.val).val - 1) :=
continuous.comp  (continuous.comp continuous_subtype_val continuous_subtype_val) (real.continuous_linear 2 (-1) )

lemma cont_p3_aux : continuous p3_aux :=
begin
  unfold p3_aux,
  refine continuous_if _ _ _,
    intros x h,
  have h₂ := mem_frontier_lt (continuous.comp continuous_subtype_val continuous_subtype_val) (continuous_const) h,
  simp at h₂ , refine subtype.eq _, norm_num [h₂ ],
  exact continuous_subtype_mk _ help_cont_p3_aux₁,
  refine continuous_subtype_mk _ help_cont_p3_aux₂,
end

-----------------------------

-- Reparametrisation on [0, 1/2]

lemma help_p3_T1_aux (x : T1) : 1 / 2 * (x.val).val ∈ I01 :=
begin
  unfold I01, rw mem_set_of_eq, split,
    refine mul_nonneg _ x.2.1, {norm_num},
   --norm_num [x.2.2],
    have h :  x.val.val ≤ 1/2 , exact x.2.2,
    have h₂ : 1 / 2 * (x.val).val ≤ (1/2 : ℝ )* (1/2:ℝ ),
    have g₁ : (1/ 2 : ℝ)  ≤ 1/2, refine @le_of_eq _ _ (1/2:ℝ ) (1/2:ℝ ) (refl (1/2:ℝ )),
      refine mul_le_mul g₁ h x.2.1 _ , {norm_num},
    refine le_trans h₂ _  ,
    norm_num,
end

def p3_T1_aux : T1 → I01 := λ x, ⟨ (1/2:ℝ ) * x.1.1 , help_p3_T1_aux x ⟩

lemma cont_p3_T1_aux : continuous p3_T1_aux :=
begin
  unfold p3_T1_aux,
  refine continuous_subtype_mk _ ( continuous.comp
    (continuous.comp continuous_subtype_val continuous_subtype_val)
    (real.continuous_mul_const (1/2)) ) ,
end

--

-- Define the 3 p.w.l function φ needed for the homotopy

noncomputable def p3 : repar_I01 :=
{ to_fun := paste cover_I01 p3_T1_aux p3_aux,

  at_zero :=
  begin unfold paste, rw dif_pos, unfold p3_T1_aux, dsimp, refine subtype.eq _,
  exact help_T1, dsimp, exact mul_zero _,  end,

  at_one :=
  begin unfold paste, rw dif_neg, unfold p3_aux, rw if_neg, refine subtype.eq _, exact help_02,
  dsimp, show 2 * (1:ℝ) + -1 = 1, {norm_num}, dsimp, rw not_lt,
  show 3 / 4 ≤ ( 1:ℝ ), norm_num, end,

  cont :=
  begin
    refine cont_of_paste T1_is_closed T2_is_closed _ cont_p3_T1_aux cont_p3_aux ,
    unfold match_of_fun,  intros x B1 B2,
      have Int : x ∈ set.inter T1 T2, exact ⟨ B1 , B2 ⟩ ,
      rwa [inter_T] at Int,
      have V : x.val = 1/2, rwa [mem_set_of_eq] at Int,
      unfold p3_aux p3_T1_aux, dsimp, rw if_pos, rw subtype.ext , dsimp,
      {rw V, norm_num},  rw V, norm_num,
  end,

}

-----------

---- Following section is to implement this and prove that
-- hom_repar_path_to_path (( f ⬝ g ) ⬝ h) φ is indeed a homotopy  f ⬝ (g ⬝ h) ≈ ( f ⬝ g ) ⬝ h

section
variables {f : path x y} {g : path y z} {h : path z w}

-- To prove associativity need to show equality with the reparametrisation of path
-- i.e (( f ⬝ g ) ⬝ h) φ = (f ⬝ (g ⬝ h)), so that can use previous results regarding repar_I01
-- This will involve proving 9 subgoals for the different values (t : I01) can take

lemma contr_T1 {x : I01} ( h₁ : x ∈ T1 ) (h₂ : x ∉ T1) : false := by cc

-- 1

lemma step_assoc_1 {t : {x // x ∈ I01}} { h_1 : t ∈ T1 } { h_2 : p3.to_fun t ∈ T1} {h_3 : par zero_lt_half ⟨p3.to_fun t, h_2 ⟩ ∈ T1} :
f.to_fun (par zero_lt_half ⟨t, h_1⟩) = f.to_fun (par zero_lt_half ⟨par zero_lt_half ⟨p3.to_fun t, h_2⟩, h_3⟩) :=
begin
 congr,
 unfold p3, dsimp, unfold paste, simp [dif_pos h_1],
 unfold p3_T1_aux, dsimp,
 unfold par, dsimp, simp [subtype.ext], have a₁ : (2:ℝ )⁻¹ ≠ 0, {norm_num},
 rw [mul_comm 2⁻¹ t.val ], rw [mul_div_assoc , div_self a₁, mul_one],
end

-- 2

lemma p3_ineq_T1 {t : {x // x ∈ I01}} (h_1 : t ∈ T1 )  : p3.to_fun t ∈ {x : I01 | 0 ≤ x.val ∧ x.val ≤ 1 / 4 } :=
begin
  rw mem_set_of_eq, split,
    unfold p3, dsimp, unfold paste p3_T1_aux, simp [h_1, -one_div_eq_inv], refine mul_nonneg _ t.2.1 , {norm_num},
    unfold p3, dsimp, unfold paste p3_T1_aux, simp [h_1, -one_div_eq_inv],
    have h₂ : (1/4 : ℝ) = (1/2)*(1/2), {norm_num}, rw h₂, unfold T1 T at h_1,
    have h₃ := h_1.2,
    refine mul_le_mul _ h₃ t.2.1 _ , exact le_of_eq (refl (1/2)), {norm_num},
end

lemma par_T1_ineq₁ {s : {x // x ∈ I01}} {h_1 : s ∈ T1 } (h : s ∈ {x : ↥I01 | 0 ≤ x.val ∧ x.val ≤ 1 / 4 } ) :
par zero_lt_half ⟨ s , h_1 ⟩ ∈ T1 :=
begin
 unfold T1 T, rw mem_set_of_eq, split,
   { unfold par, dsimp [-sub_eq_add_neg], rw sub_zero, rw sub_zero, refine (le_div_iff _ ).2 _, {norm_num},
   rw [mul_comm, mul_zero], exact s.2.1, },
   unfold par, dsimp [-sub_eq_add_neg], rw sub_zero, rw sub_zero, refine (le_div_iff _ ).1 _ ,{norm_num},
   have h₂ : 1 / 2 / (1 / 2)⁻¹ = (1/4 : ℝ ), {norm_num}, rw h₂,
   exact h.2,
end

lemma help_step_assoc_2 {t : {x // x ∈ I01}} (h_1 : t ∈ T1 ) { h_2 : p3.to_fun t ∈ T1} (h_3 : par zero_lt_half ⟨p3.to_fun t, h_2⟩ ∉ T1) :
par zero_lt_half ⟨p3.to_fun t, h_2⟩ ∈  T2 :=  T2_of_not_T1 h_3

lemma step_assoc_2 {t : {x // x ∈ I01}} { h_1 : t ∈ T1 } { h_2 : p3.to_fun t ∈ T1} (h_3 : par zero_lt_half ⟨p3.to_fun t, h_2⟩ ∉ T1) :
f.to_fun (par zero_lt_half ⟨t, h_1⟩) = g.to_fun (par half_lt_one ⟨par zero_lt_half ⟨p3.to_fun t, h_2⟩, help_step_assoc_2 h_1 h_3 ⟩) :=
begin
 by_contradiction, unfold T1 T at h_2,
 rw [mem_set_of_eq] at h_2,
 unfold T1 T at h_3, rw [mem_set_of_eq] at h_3,
 simp [-one_div_eq_inv] at h_3,
 have H := h_3 (par zero_lt_half ⟨p3.to_fun t, h_2⟩).2.1,
 have G : par zero_lt_half ⟨p3.to_fun t, h_2⟩ ∈ T1,
 exact par_T1_ineq₁ (p3_ineq_T1 h_1), cc,
end

--3

lemma step_assoc_3 {t : {x // x ∈ I01}} ( h_1 : t ∈ T1 ) ( h_2 : p3.to_fun t ∉ T1) :
f.to_fun (par zero_lt_half ⟨t, h_1⟩) = h.to_fun (par half_lt_one ⟨p3.to_fun t, T2_of_not_T1 h_2 ⟩) :=
begin
by_contradiction, -- as p3.to_fun t ∈ {x : ↥I01 | 0 ≤ x.val ∧ x.val ≤ 1 / 4 } ⊆ T1
 have h₁ : p3.to_fun t ∈ {x : ↥I01 | 0 ≤ x.val ∧ x.val ≤ 1 / 4 }, exact p3_ineq_T1  h_1,
 suffices g₁ : p3.to_fun t ∈ T1, cc,
 refine mem_of_mem_of_subset h₁ _, unfold T1 T,
 intros x H , refine ⟨ H.1, le_trans H.2 _ ⟩ , {norm_num}
end

--4

lemma p3_not_T1 {t : {x // x ∈ I01}} (h : t ∉  T1 ) :  1/4 < (p3.to_fun t ).val :=
begin
 have h₁ : 1/2 < t.val,
  { unfold T1 T at h,
   by_contradiction, rw [not_lt] at a,
   suffices a₁ : t ∈  {x : ↥I01 | 0 ≤ x.val ∧ x.val ≤ 1 / 2}, cc,
   exact ⟨ t.2.1, a ⟩ ,
  },
  unfold p3, dsimp, unfold paste, simp [h, -one_div_eq_inv], unfold p3_aux, split_ifs,
  { refine lt_sub_iff_add_lt.2 _, have a₁ : 1 / 4 + 1 / 4 = (1/2:ℝ ), {norm_num}, rw a₁ , exact h₁ },
  simp at h_1,
  have a₁ : 5 / 4 < 2 * t.val,
    { have H : 5 / 4 = (5 /3 )*(3/4:ℝ ), {norm_num}, rw H,
    refine mul_lt_mul _ h_1 _ _, {norm_num}, {norm_num}, norm_num },
  norm_num [a₁ ] ,
end

lemma p3_impl₁ {t : {x // x ∈ I01}} (h : (p3.to_fun t ).val ≤ 1/4 )  : t ∈ T1 :=
begin
 by_contradiction,
  have h₂  : 1/4 < (p3.to_fun t ).val, exact p3_not_T1 a,
  suffices g₁ : ¬  (p3.to_fun t).val ≤ 1 / 4, cc,
  exact (le_not_le_of_lt h₂).2  ,
end

lemma par_impl_T1  {t : {x // x ∈ I01}} {h_3 : p3.to_fun t ∈ T1} (h_4 : par zero_lt_half ⟨p3.to_fun t, h_3⟩ ∈ T1) :
(p3.to_fun t ).val ≤ 1/4 :=
begin
 unfold par T1 T at h_4, rw mem_set_of_eq at h_4, cases h_4 with h₁ h₂ , simp [-one_div_eq_inv] at h₂,
 have H :  (0: ℝ )<(1 / 2) , {norm_num},
 have H2 :  1 / 4 = (1/2:ℝ )* (1/2), {norm_num}, rw H2,
 exact (div_le_iff H).1 h₂ ,
end

lemma step_assoc_4 {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) ( h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∈ T1)
( h_3 : p3.to_fun t ∈ T1) (h_4 : par zero_lt_half ⟨p3.to_fun t, h_3⟩ ∈ T1) :
 g.to_fun (par zero_lt_half ⟨par half_lt_one ⟨t, _⟩, h_2⟩) =
    f.to_fun (par zero_lt_half ⟨par zero_lt_half ⟨p3.to_fun t, h_3⟩, h_4⟩) :=
begin
by_cases H : t.val = (1/2),
  { unfold p3, dsimp, unfold paste p3_aux, simp [h_1, -one_div_eq_inv, -sub_eq_add_neg],
  have h₁ : t.val < 3 / 4, rw H, {norm_num}, simp [h₁, -one_div_eq_inv, -sub_eq_add_neg, H ],
  have a₁ : 1 / 2 - 1 / 4 = (1/4 : ℝ ), {norm_num}, simp [-one_div_eq_inv, -sub_eq_add_neg, a₁],
  unfold par, simp [-sub_eq_add_neg, -one_div_eq_inv, sub_zero, H],
  show g.to_fun ⟨((↑t - 1 / 2) / (1 - 1 / 2)) / (1 / 2), _⟩ = f.to_fun ⟨1 / 4 / (1 / 2) / (1 / 2), _⟩,
  have a₃  : ↑t = (1/2:ℝ ), exact H, simp [a₃, -one_div_eq_inv  ], simp [div_div_eq_div_mul, -one_div_eq_inv] ,
  norm_num , show g.to_fun 0 = f.to_fun 1,  simp  [ f.at_one, g.at_zero],   },

  by_contradiction,
  suffices G : t ∈ T1, cc,
  exact p3_impl₁ (par_impl_T1 h_4),
end

-- 5

set_option trace.simplify.rewrite true
--set_option pp.implicit true
lemma p3_image_not_T1 (t : {x // x ∈ I01}) (h_1 : t ∉ T1) (a_1 : 3 / 4 < t.val) : p3.to_fun t ∉  T1 :=
begin
 unfold T1 T, rw mem_set_of_eq, simp [-one_div_eq_inv], intro H, unfold p3, dsimp, unfold paste p3_aux,
 simp [h_1, -one_div_eq_inv, -sub_eq_add_neg],
 have h : ¬ t.val < 3/4, refine not_lt_of_ge (le_of_lt a_1),  simp [h, -one_div_eq_inv, -sub_eq_add_neg],
 have a₁ : 1 + 1 / 2 = (3/4:ℝ )*2 , {norm_num}, rw mul_comm,
 simp [-one_div_eq_inv, a₁ ],refine mul_lt_mul a_1 (le_of_eq (refl(2:ℝ ))) _ t.2.1, {norm_num}
end

lemma step_assoc_5  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) ( h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∈ T1)
( h_3 : p3.to_fun t ∈ T1) (h_4 : par zero_lt_half ⟨p3.to_fun t, h_3⟩ ∉ T1) :
g.to_fun (par zero_lt_half ⟨par half_lt_one ⟨t, T2_of_not_T1 h_1⟩, h_2⟩) =
    g.to_fun (par half_lt_one ⟨par zero_lt_half ⟨p3.to_fun t, h_3⟩, T2_of_not_T1 h_4 ⟩) :=
begin
 unfold p3,  dsimp, unfold paste, simp [dif_neg h_1],
 unfold p3_aux,
 by_cases a : t.val = 3/4 ,
  { have a₂ : ¬ t.val < 3/4, exact not_lt_of_ge (ge_of_eq a), simp [a₂],
   unfold par, dsimp [-one_div_eq_inv, -sub_eq_add_neg],   simp [sub_zero, -one_div_eq_inv, -sub_eq_add_neg],
   have g₂ : ↑t = t.val, trivial, {norm_num [ g₂ ,a]},
  },
   have l₁ : t.val ≤ 3/4,
    { by_contradiction, rw not_le at a_1, suffices G : p3.to_fun t ∉  T1,
    exact contr_T1 h_3 G, exact p3_image_not_T1 t h_1 a_1, },
   have l₂ : t.val < 3 / 4, exact lt_of_le_of_ne l₁ a ,
   simp [l₂ , -one_div_eq_inv, -sub_eq_add_neg], unfold par, dsimp [-one_div_eq_inv, -sub_eq_add_neg],
   simp [-sub_eq_add_neg, -one_div_eq_inv, sub_zero],
   have g₁ : (1 - 1 / 2) = (1/2:ℝ ), {norm_num}, have g₂ : ↑t = t.val, trivial,
   simp [g₁ , g₂ , -one_div_eq_inv, -sub_eq_add_neg] ,

   suffices G1 : ((t.val - 1 / 4) / (1 / 2) - 1 / 2) = (t.val - 1 / 2) / (1 / 2),
     apply congr_arg,
     apply subtype.eq,
     show (t.val - 1 / 2) / (1 / 2) / (1 / 2) = ((t.val - 1 / 4) / (1 / 2) - 1 / 2) / (1 / 2),
     rw G1,
   show ((t.val - 1 / 4) / (1 / 2)) - (1 / 2) = (t.val - 1 / 2) / (1 / 2),
    have h₁ : ((t.val - 1 / 4) / (1 / 2)) - (1 / 2) = ((t.val - 1 / 4) / (1 / 2)) - (1 / 4 ) / (1/2:ℝ ),
      have h₂  : - (1 / 2 : ℝ ) =  - (1 / 4 ) / (1/2:ℝ ), {norm_num},
      have h₃   : (1 / 2 : ℝ ) =  (1 / 4 ) / (1/2:ℝ ), {norm_num},
      simpa [h₂, -one_div_eq_inv, -sub_eq_add_neg],
    rw [h₁,  div_sub_div_same],
    have H2 : (t.val - 1 / 4 - 1 / 4) = (t.val - 1 / 2) , {norm_num},
    simp [-one_div_eq_inv, -sub_eq_add_neg, H2],

end

-- 6

local attribute [instance] classical.prop_decidable

lemma help_step_assoc_6₁  {t : {x // x ∈ I01}} {h_1 : t ∉ T1} (h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∈ T1) :
t.val ≤ 3/4 :=
begin
 by_contradiction, rw not_le at a, unfold T1 T at h_2, cases h_2 with g₁ g₂ ,
 have G1 : 1/2 < (par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩).val, unfold par, dsimp [-one_div_eq_inv, -sub_eq_add_neg],
  have a₁ : ↑t = t.val, trivial, have a₂ : (1 - 1 / 2) = (1/2:ℝ ), {norm_num}, rw [a₁, a₂ ],
  refine (lt_div_iff _).2 _, {norm_num},
  have h₁ : 1 / 2 * (1 / 2) ≤ (3/4:ℝ ) - 1/2, {norm_num},
  have h₂ : (3/4:ℝ ) - 1/2 < t.val -1/2, refine lt_sub_iff_add_lt.2 _ ,
  have a₂ : 3 / 4 - 1 / 2 + 1 / 2 = (3/4:ℝ ), {norm_num}, rw a₂ , exact a,
  exact lt_of_le_of_lt h₁ h₂ ,
 have NG1 : ¬ 1/2 < (par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩).val,
 exact not_lt_of_le g₂ , cc,
end

lemma T1_of_p3₁    {t : {x // x ∈ I01}} (h_1 : t ∉ T1) (l₂ : t.val <  3 / 4) :
 p3.to_fun t ∈  T1 :=
begin
 unfold p3, dsimp, unfold paste, simp [h_1], unfold p3_aux, simp [l₂, -sub_eq_add_neg, -one_div_eq_inv] ,
 have a₁ : t ∈ T2, exact T2_of_not_T1 h_1,
 unfold T1 T, dsimp [-sub_eq_add_neg], split,
  refine sub_nonneg.2 _  , refine le_trans _ a₁.1 , {norm_num},
  norm_num [l₂, -one_div_eq_inv, le_of_lt l₂ ],
end

---h_2 : par half_lt_one ⟨t, _⟩ ∈ T1

lemma step_assoc_6  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) ( h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∈ T1)
(h_3 : p3.to_fun t ∉ T1) :
 g.to_fun (par zero_lt_half ⟨par half_lt_one ⟨t, _⟩, h_2⟩)
    = h.to_fun (par half_lt_one ⟨p3.to_fun t, T2_of_not_T1 h_3 ⟩) :=
begin
 unfold p3,  dsimp, unfold paste, simp [h_1],  unfold p3_aux,
 by_cases a : t.val = 3/4,
   { have a₂ : ¬ t.val < 3/4, exact not_lt_of_ge (ge_of_eq a), simp [a₂, -sub_eq_add_neg, -one_div_eq_inv],
     unfold par, dsimp [-one_div_eq_inv, -sub_eq_add_neg], have g₂ : ↑t = t.val, trivial,
     simp [g₂ , a, subtype.ext], {norm_num, show g.to_fun 1 = h.to_fun 0, simp, },
   },
 have a₁ : t.val ≤ 3/4, exact help_step_assoc_6₁  h_2,
 have l₂  : t.val < 3/4, exact lt_of_le_of_ne a₁ a,
 by_contradiction,
 suffices g :  p3.to_fun t ∈  T1, exact contr_T1 g h_3 ,
 exact T1_of_p3₁  h_1  l₂ ,
end

-- 7

lemma help_step_assoc_7₁  {t : {x // x ∈ I01}} {h_1 : t ∉ T1} (h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∉  T1) :
3/4 < t.val :=
begin
  unfold T1 T at h_2, simp [(par half_lt_one ⟨t, _⟩).2.1, -one_div_eq_inv] at h_2,
  unfold par at h_2, dsimp [-one_div_eq_inv, -sub_eq_add_neg] at h_2,
  have a₁ : ↑t = t.val, trivial, have a₂  : (1 - 1 / 2) = (1/2:ℝ ), {norm_num}, rw [a₁, a₂] at h_2,
  have H : 1 / 2 * (1 / 2) < (t.val - 1 / 2), refine (lt_div_iff _).1 h_2, {norm_num},
  rw lt_sub_iff_add_lt at H, have g₁ : 1 / 2 * (1 / 2) + 1 / 2 = (3/4:ℝ ), {norm_num}, rw g₁ at H,
  exact H,
end

lemma p3_in_T1  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) (h_3 : p3.to_fun t ∈ T1) :
t.val ≤ 3/4 :=
begin
 by_contradiction, rw not_le at a, unfold p3 at h_3, dsimp at h_3, unfold paste at h_3,
 simp [h_1] at h_3, unfold p3_aux at h_3,
 have a₂ :  ¬  t.val < 3/4, exact not_lt_of_gt a, simp [a₂ , -one_div_eq_inv, -sub_eq_add_neg] at h_3,
 unfold T1 T at h_3, --simp at h_3,
 have g₁ : 2 * t.val - 1 ≤ 1/2, exact h_3.2,
 have g₂ : t.val ≤ 3/4, rw sub_le_iff_le_add at g₁  ,
   have aux₁ : 1 / 2 + 1 = (3/2:ℝ ), {norm_num}, rw aux₁ at g₁, rw mul_comm at g₁ ,
   have aux₂ : t.val ≤ (3 / 2 ) / 2, refine le_div_of_mul_le _ g₁ ,{norm_num},
   have aux₃ : 3 / 2 / 2 = (3/4:ℝ), {norm_num}, rw aux₃ at aux₂ , exact aux₂,
 have g₃ : ¬  3 / 4 < t.val, exact not_lt_of_ge g₂,
 cc,
end

lemma step_assoc_7  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) (h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∉ T1)
( h_3 : p3.to_fun t ∈ T1) (h_4 : par zero_lt_half ⟨p3.to_fun t, h_3⟩ ∈ T1) :
h.to_fun (par half_lt_one ⟨par half_lt_one ⟨t, T2_of_not_T1 h_1⟩, T2_of_not_T1 h_2⟩) =
    f.to_fun (par zero_lt_half ⟨par zero_lt_half ⟨p3.to_fun t, h_3⟩, h_4⟩) :=
begin
 by_contradiction,
 have g₁ : 3/4 < t.val, exact help_step_assoc_7₁ h_2,
 have g₂  : ¬ 3/4 < t.val, exact not_lt_of_ge (p3_in_T1  h_1 h_3),
 cc,
end

-- 8

lemma help_step_assoc_8₁  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) (h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∉ T1) :
3/4 < t.val :=
begin
 unfold T1 T at h_2, simp [-one_div_eq_inv] at h_2,  have h₁  := h_2 (par half_lt_one ⟨t, _⟩).2.1,
 unfold par at h₁,dsimp [-one_div_eq_inv, -sub_eq_add_neg] at h₁,
 have g₁ : (1 - 1 / 2) = (1/2:ℝ ), {norm_num},  have a₁ : ↑t = t.val, trivial, rw [g₁, a₁] at h₁,
 have h₂ : 1 / 2 * (1 / 2) < (t.val - 1 / 2), refine (lt_div_iff _).1 h₁ , {norm_num},
 rw lt_sub_iff_add_lt at h₂, have a₂ : 1 / 2 * (1 / 2) + 1 / 2 = (3/4:ℝ ), {norm_num},
 rw a₂ at h₂, exact h₂,
end

lemma step_assoc_8  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) (h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∉ T1)
( h_3 : p3.to_fun t ∈ T1) (h_4 : par zero_lt_half ⟨p3.to_fun t, h_3⟩ ∉ T1) :
h.to_fun (par half_lt_one ⟨par half_lt_one ⟨t, T2_of_not_T1 h_1⟩, T2_of_not_T1 h_2 ⟩) =
    g.to_fun (par half_lt_one ⟨par zero_lt_half ⟨p3.to_fun t, h_3⟩, T2_of_not_T1 h_4 ⟩) :=
begin
 have g₁ : ¬ 3/4 < t.val, exact not_lt_of_ge (p3_in_T1  h_1 h_3) ,
 have g₂ : 3/4 < t.val, exact help_step_assoc_8₁ h_1 h_2, cc,
end

-- 9

lemma step_assoc_9  {t : {x // x ∈ I01}} ( h_1 : t ∉ T1 ) (h_2 : par half_lt_one ⟨t, T2_of_not_T1 h_1 ⟩ ∉ T1)
( h_3 : p3.to_fun t ∉ T1) :
h.to_fun (par half_lt_one ⟨par half_lt_one ⟨t, T2_of_not_T1 h_1⟩, T2_of_not_T1 h_2⟩) =
h.to_fun (par half_lt_one ⟨p3.to_fun t, T2_of_not_T1 h_3⟩) :=
begin
 unfold p3, dsimp, unfold paste, simp [dif_neg h_1],
 have a₁ : ¬ t.val < 3/4, exact not_lt_of_gt (help_step_assoc_8₁ h_1 h_2),
 unfold p3_aux, simp [a₁, -one_div_eq_inv, -sub_eq_add_neg], unfold par, dsimp [-one_div_eq_inv, -sub_eq_add_neg],
 have a₂ : ↑t = t.val, trivial, have g₁ : (1 - 1 / 2) = (1/2:ℝ ), {norm_num},
 simp [a₂, g₁, -one_div_eq_inv, -sub_eq_add_neg],
 suffices H : ((t.val - 1 / 2) / (1 / 2) - 1 / 2) = (2 * t.val - 1 - 1 / 2),
  apply congr_arg,
  apply subtype.eq,
  show ((t.val - 1 / 2) / (1 / 2) - 1 / 2) / (1 / 2) = (2 * t.val - 1 - 1 / 2) / (1 / 2),
  rw H,
 have a₃ : (t.val - 1 / 2) / (1 / 2) = (t.val ) / (1 / 2) - ( 1 / 2) / (1 / 2), apply eq.symm,
 refine div_sub_div_same t.val (1/2:ℝ) (1/2:ℝ), rw div_self at a₃, rw a₃ , rw div_eq_inv_mul,
 have a₄ : (1 / 2 : ℝ )⁻¹ = 2, {norm_num}, rw a₄, {norm_num},
end

-- Homotopy for associativity

noncomputable def hom_comp_f_g_h ( f : path x y) ( g : path y z) ( h : path z w)  :
path_homotopy  ( comp_of_path f (comp_of_path g h)) (comp_of_path (comp_of_path f g) h ) :=
begin
  have h₁ : ( comp_of_path f (comp_of_path g h)) =
    repar_path (comp_of_path (comp_of_path f g) h ) p3,
   { unfold repar_path, dsimp, refine path_equal.2 _ ,  dsimp, unfold comp_of_path, dsimp,
     unfold paste fa_path fb_path fgen_path, dsimp,  unfold paste, funext, unfold paste,
     split_ifs,
      exact step_assoc_1,
      exact step_assoc_2 h_3,
      exact step_assoc_3 h_1 h_2,
      exact step_assoc_4 h_1 h_2 h_3 h_4,
      exact step_assoc_5 h_1 h_2 h_3 h_4,
      exact step_assoc_6 h_1 h_2 h_3,
      exact step_assoc_7 h_1 h_2 h_3 h_4,
      exact step_assoc_8 h_1 h_2 h_3 h_4,
      exact step_assoc_9 h_1 h_2 h_3,
   },
  rw h₁ , exact hom_repar_path_to_path (comp_of_path (comp_of_path f g) h ) p3,
end

end

end homotopy_results


/-
Copyright (c) 2020 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.core
import Mathlib.PostPort

namespace Mathlib

/-!
# Tactics About Dependencies

This module provides tactics to compute dependencies and reverse dependencies of
hypotheses. An expression `e` depends on a hypothesis `h` if `e` would not be
valid if `h` were removed from the context. For example, the expression
`e := x > 0` depends on `x`. We say that `x` is a dependency of `e` and that `e`
is a reverse dependency of `x`.

It is sometimes useful to consider *inclusive* dependency: `e` inclusively
depends on `h` iff `e` depends on `h` or `e = h` (so inclusive dependency is the
reflexive closure of regular dependency).

Note that the standard library does not use quite the same terminology:

* `kdependencies`/`kdeps` from the standard library compute reverse
  dependencies, not dependencies.
* `kdepends_on` and functions derived from it ignore local definitions and
  therefore compute a weaker dependency relation (see next section).

## Local Definitions

Determining dependencies of hypotheses is usually straightforward: a hypothesis
`r : R` depends on another hypothesis `d : D` if `d` occurs in `R`. The
implementation is more involved, however, in the presence of local definitions.
Consider this context:

```lean
n m : ℕ
k : ℕ := m
o : ℕ := k
h : o > 0
```

`h` depends on `o`, `k` and `m`, but only the dependency on `o` is syntactically
obvious. `kdepends_on` ignores this complication and claims that `h` does not
depend on `k` or `m`. We do not follow this example but process local
definitions properly. This means that if the context contains a local
definition, we need to compute the syntactic dependencies of `h`, then their
dependencies, and so on.

## Direct Dependencies

If you want to ignore local definitions while computing dependencies, this
module also provides tactics to find the *direct* dependencies of a hypothesis.
These are the hypotheses that syntactically appear in the hypothesis's type (or
value, if the hypothesis is a local definition).
-/

namespace tactic

/-! ### Direct Dependencies -/

/-! #### Checking whether hypotheses directly depend on each other -/

/--
`type_has_local_in_name_set h ns` returns true iff the type of `h` contains a
local constant whose unique name appears in `ns`.
-/
end Mathlib


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

! This file was ported from Lean 3 source module algebra.star.big_operators
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.Algebra.Star.Basic

/-! # Big-operators lemmas about `star` algebraic operations

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

These results are kept separate from `algebra.star.basic` to avoid it needing to import `finset`.
-/

variable {R : Type _}

open BigOperators

/- warning: star_prod -> star_prod is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommMonoid.{u1} R] [_inst_2 : StarSemigroup.{u1} R (Monoid.toSemigroup.{u1} R (CommMonoid.toMonoid.{u1} R _inst_1))] {α : Type.{u2}} (s : Finset.{u2} α) (f : α -> R), Eq.{succ u1} R (Star.star.{u1} R (InvolutiveStar.toHasStar.{u1} R (StarSemigroup.toHasInvolutiveStar.{u1} R (Monoid.toSemigroup.{u1} R (CommMonoid.toMonoid.{u1} R _inst_1)) _inst_2)) (Finset.prod.{u1, u2} R α _inst_1 s (fun (x : α) => f x))) (Finset.prod.{u1, u2} R α _inst_1 s (fun (x : α) => Star.star.{u1} R (InvolutiveStar.toHasStar.{u1} R (StarSemigroup.toHasInvolutiveStar.{u1} R (Monoid.toSemigroup.{u1} R (CommMonoid.toMonoid.{u1} R _inst_1)) _inst_2)) (f x)))
but is expected to have type
  forall {R : Type.{u2}} [_inst_1 : CommMonoid.{u2} R] [_inst_2 : StarSemigroup.{u2} R (Monoid.toSemigroup.{u2} R (CommMonoid.toMonoid.{u2} R _inst_1))] {α : Type.{u1}} (s : Finset.{u1} α) (f : α -> R), Eq.{succ u2} R (Star.star.{u2} R (InvolutiveStar.toStar.{u2} R (StarSemigroup.toInvolutiveStar.{u2} R (Monoid.toSemigroup.{u2} R (CommMonoid.toMonoid.{u2} R _inst_1)) _inst_2)) (Finset.prod.{u2, u1} R α _inst_1 s (fun (x : α) => f x))) (Finset.prod.{u2, u1} R α _inst_1 s (fun (x : α) => Star.star.{u2} R (InvolutiveStar.toStar.{u2} R (StarSemigroup.toInvolutiveStar.{u2} R (Monoid.toSemigroup.{u2} R (CommMonoid.toMonoid.{u2} R _inst_1)) _inst_2)) (f x)))
Case conversion may be inaccurate. Consider using '#align star_prod star_prodₓ'. -/
@[simp]
theorem star_prod [CommMonoid R] [StarSemigroup R] {α : Type _} (s : Finset α) (f : α → R) :
    star (∏ x in s, f x) = ∏ x in s, star (f x) :=
  map_prod (starMulAut : R ≃* R) _ _
#align star_prod star_prod

/- warning: star_sum -> star_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : AddCommMonoid.{u1} R] [_inst_2 : StarAddMonoid.{u1} R (AddCommMonoid.toAddMonoid.{u1} R _inst_1)] {α : Type.{u2}} (s : Finset.{u2} α) (f : α -> R), Eq.{succ u1} R (Star.star.{u1} R (InvolutiveStar.toHasStar.{u1} R (StarAddMonoid.toHasInvolutiveStar.{u1} R (AddCommMonoid.toAddMonoid.{u1} R _inst_1) _inst_2)) (Finset.sum.{u1, u2} R α _inst_1 s (fun (x : α) => f x))) (Finset.sum.{u1, u2} R α _inst_1 s (fun (x : α) => Star.star.{u1} R (InvolutiveStar.toHasStar.{u1} R (StarAddMonoid.toHasInvolutiveStar.{u1} R (AddCommMonoid.toAddMonoid.{u1} R _inst_1) _inst_2)) (f x)))
but is expected to have type
  forall {R : Type.{u2}} [_inst_1 : AddCommMonoid.{u2} R] [_inst_2 : StarAddMonoid.{u2} R (AddCommMonoid.toAddMonoid.{u2} R _inst_1)] {α : Type.{u1}} (s : Finset.{u1} α) (f : α -> R), Eq.{succ u2} R (Star.star.{u2} R (InvolutiveStar.toStar.{u2} R (StarAddMonoid.toInvolutiveStar.{u2} R (AddCommMonoid.toAddMonoid.{u2} R _inst_1) _inst_2)) (Finset.sum.{u2, u1} R α _inst_1 s (fun (x : α) => f x))) (Finset.sum.{u2, u1} R α _inst_1 s (fun (x : α) => Star.star.{u2} R (InvolutiveStar.toStar.{u2} R (StarAddMonoid.toInvolutiveStar.{u2} R (AddCommMonoid.toAddMonoid.{u2} R _inst_1) _inst_2)) (f x)))
Case conversion may be inaccurate. Consider using '#align star_sum star_sumₓ'. -/
@[simp]
theorem star_sum [AddCommMonoid R] [StarAddMonoid R] {α : Type _} (s : Finset α) (f : α → R) :
    star (∑ x in s, f x) = ∑ x in s, star (f x) :=
  (starAddEquiv : R ≃+ R).map_sum _ _
#align star_sum star_sum


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.Mathport.Rename
import Mathlib.Init.Data.Nat.Notation
import Std.Data.Nat.Lemmas
import Std.Data.List.Basic
/-!
Definitions for `List` not (yet) in `Std`
-/

open Decidable List

universe u v w

namespace List

open Option Nat

#align list.nth List.get?

/-- nth element of a list `l` given `n < l.length`. -/
@[deprecated get]
def nthLe (l : List α) (n) (h : n < l.length) : α := get l ⟨n, h⟩
#align list.nth_le List.nthLe

set_option linter.deprecated false in
@[deprecated]
theorem nthLe_eq (l : List α) (n) (h : n < l.length) : nthLe l n h = get l ⟨n, h⟩ := rfl

/-- The head of a list, or the default element of the type is the list is `nil`. -/
def headI [Inhabited α] : List α → α
| []       => default
| (a :: _) => a
#align list.head List.headI

@[simp] theorem headI_nil [Inhabited α] : ([] : List α).headI = default := rfl
@[simp] theorem headI_cons [Inhabited α] {h : α} {t : List α} : (h :: t).headI = h := rfl

#align list.map₂ List.zipWith

#noalign list.map_with_index_core

#align list.map_with_index List.mapIdx

/-- Find index of element with given property. -/
@[deprecated findIdx]
def findIndex (p : α → Prop) [DecidablePred p] : List α → ℕ := List.findIdx p
#align list.find_index List.findIndex

#align list.update_nth List.set

#align list.bor List.or

#align list.band List.and

#align list.last List.getLast

/-- The last element of a list, with the default if list empty -/
def getLastI [Inhabited α] : List α → α
  | [] => default
  | [a] => a
  | [_, b] => b
  | _ :: _ :: l => getLastI l
#align list.ilast List.getLastI

#align list.init List.dropLast

/-- List with a single given element. -/
@[inline] protected def ret {α : Type u} (a : α) : List α := [a]
#align list.ret List.ret

/-- `≤` implies not `>` for lists. -/

end List

#align list.replicate List.replicate
#align list.length_replicate List.length_replicate


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Scott Morrison
-/
import data.finset.lattice
import data.multiset.functor

/-!
# Functoriality of `finset`

This file defines the functor structure of `finset`.

## TODO

Currently, all instances are classical because the functor classes want to run over all types. If
instead we could state that a functor is lawful/applicative/traversable... between two given types,
then we could provide the instances for types with decidable equality.
-/

universes u

open function

namespace finset

/-! ### Functor -/

section functor
variables {α β : Type u} [Π P, decidable P]

/-- Because `finset.image` requires a `decidable_eq` instance for the target type, we can only
construct `functor finset` when working classically. -/
instance : functor finset :=
{ map := λ α β f s, s.image f }

instance : is_lawful_functor finset :=
{ id_map := λ α s, image_id,
  comp_map := λ α β γ f g s, image_image.symm }

@[simp] lemma fmap_def {s : finset α} (f : α → β) : f <$> s = s.image f := rfl

end functor

/-! ### Pure -/

instance : has_pure finset := ⟨λ α x, {x}⟩

@[simp] lemma pure_def {α} : (pure : α → finset α) = singleton := rfl

/-! ### Applicative functor -/

section applicative
variables {α β : Type u} [Π P, decidable P]

instance : applicative finset :=
{ seq := λ α β t s, t.sup (λ f, s.image f),
  seq_left := λ α β s t, if t = ∅ then ∅ else s,
  seq_right := λ α β s t, if s = ∅ then ∅ else t,
  .. finset.functor,
  .. finset.has_pure }

@[simp]

instance : is_lawful_applicative finset :=
{ seq_left_eq := λ α β s t, begin
    rw [seq_def, fmap_def, seq_left_def],
    obtain rfl | ht := t.eq_empty_or_nonempty,
    { simp_rw [if_pos rfl, image_empty], exact (sup_bot _).symm },
    { ext a,
      rw [if_neg ht.ne_empty, mem_sup],
      refine ⟨λ ha, ⟨const β a, mem_image_of_mem _ ha, mem_image_const_self.2 ht⟩, _⟩,
      rintro ⟨f, hf, ha⟩,
      rw mem_image at hf ha,
      obtain ⟨b, hb, rfl⟩ := hf,
      obtain ⟨_, _, rfl⟩ := ha,
      exact hb }
  end,
  seq_right_eq := λ α β s t, begin
    rw [seq_def, fmap_def, seq_right_def],
    obtain rfl | hs := s.eq_empty_or_nonempty,
    { rw [if_pos rfl, image_empty, sup_empty, bot_eq_empty] },
    { ext a,
      rw [if_neg hs.ne_empty, mem_sup],
      refine ⟨λ ha, ⟨id, mem_image_const_self.2 hs, by rwa image_id⟩, _⟩,
      rintro ⟨f, hf, ha⟩,
      rw mem_image at hf ha,
      obtain ⟨b, hb, rfl⟩ := ha,
      obtain ⟨_, _, rfl⟩ := hf,
      exact hb }
  end,
  pure_seq_eq_map := λ α β f s, sup_singleton,
  map_pure := λ α β f a, image_singleton _ _,
  seq_pure := λ α β s a, sup_singleton'' _ _,
  seq_assoc := λ α β γ s t u, begin
    ext a,
    simp_rw [seq_def, fmap_def],
    simp only [exists_prop, mem_sup, mem_image],
    split,
    { rintro ⟨g, hg, b, ⟨f, hf, a, ha, rfl⟩, rfl⟩,
      exact ⟨g ∘ f, ⟨comp g, ⟨g, hg, rfl⟩, f, hf, rfl⟩, a, ha, rfl⟩ },
    { rintro ⟨c, ⟨_, ⟨g, hg, rfl⟩, f, hf, rfl⟩, a, ha, rfl⟩,
      exact ⟨g, hg, f a, ⟨f, hf, a, ha, rfl⟩, rfl⟩ }
  end,
  .. finset.is_lawful_functor }

instance : is_comm_applicative finset :=
{ commutative_prod := λ α β s t, begin
    simp_rw [seq_def, fmap_def, sup_image, sup_eq_bUnion],
    change s.bUnion (λ a, t.image $ λ b, (a, b)) = t.bUnion (λ b, s.image $ λ a, (a, b)),
    transitivity s.product t;
      [rw product_eq_bUnion, rw product_eq_bUnion_right]; congr; ext; simp_rw mem_image,
  end,
  .. finset.is_lawful_applicative }

end applicative

/-! ### Monad -/

section monad
variables [Π P, decidable P]

instance : monad finset :=
{ bind := λ α β, @sup _ _ _ _,
  .. finset.applicative }

@[simp] lemma bind_def {α β} : (>>=) = @sup (finset α) β _ _ := rfl

instance : is_lawful_monad finset :=
{ bind_pure_comp_eq_map := λ α β f s, sup_singleton'' _ _,
  bind_map_eq_seq := λ α β t s, rfl,
  pure_bind := λ α β t s, sup_singleton,
  bind_assoc :=  λ α β γ s f g, by { convert sup_bUnion _ _, exact sup_eq_bUnion _ _ },
  .. finset.is_lawful_applicative }

end monad

/-! ### Alternative functor -/

section alternative
variables [Π P, decidable P]

instance : alternative finset :=
{ orelse := λ α, (∪),
  failure := λ α, ∅,
  .. finset.applicative }

end alternative

/-! ### Traversable functor -/

section traversable
variables {α β γ : Type u} {F G : Type u → Type u} [applicative F] [applicative G]
  [is_comm_applicative F] [is_comm_applicative G]

/-- Traverse function for `finset`. -/
def traverse [decidable_eq β] (f : α → F β) (s :  finset α) : F (finset β) :=
multiset.to_finset <$> multiset.traverse f s.1

@[simp] lemma id_traverse [decidable_eq α] (s : finset α) : traverse id.mk s = s :=
by { rw [traverse, multiset.id_traverse], exact s.val_to_finset }

open_locale classical

@[simp] lemma map_comp_coe (h : α → β) :
  functor.map h ∘ multiset.to_finset = multiset.to_finset ∘ functor.map h :=
funext $ λ s, image_to_finset

lemma map_traverse (g : α → G β) (h : β → γ) (s : finset α) :
  functor.map h <$> traverse g s = traverse (functor.map h ∘ g) s :=
begin
  unfold traverse,
  simp only [map_comp_coe] with functor_norm,
  rw [is_lawful_functor.comp_map, multiset.map_traverse],
end

end traversable
end finset


import data.serial

open serial serializer

structure point :=
(x y : unsigned)

instance : serial point :=
of_serializer (point.mk <$> ser_field point.x <*> ser_field point.y)
begin
  intro,
  apply there_and_back_again_seq,
  apply there_and_back_again_map,
  cases w, refl
end

@[derive serial]
inductive my_sum
| first : my_sum
| second : ℕ → my_sum
| third (n : ℕ) (xs : list ℕ) : n ≤ xs.length → my_sum

@[derive serial]
structure my_struct :=
(x : ℕ)
(xs : list ℕ)
(bounded : xs.length ≤ x)

@[derive [serial]]
inductive tree (α : Type)
| leaf {} : tree
| node2 : α → tree → tree → tree
| node3 : α → tree → tree → tree → tree

open tree

meta def tree.repr {α} [has_repr α] : tree α → string
| leaf := "leaf"
| (node2 x t₀ t₁) := to_string $ format!"(node2 {repr x} {tree.repr t₀} {tree.repr t₁})"
| (node3 x t₀ t₁ t₂) := to_string $ format!"(node3 {repr x} {tree.repr t₀} {tree.repr t₁} {tree.repr t₂})"

meta instance {α} [has_repr α] : has_repr (tree α) := ⟨ tree.repr ⟩

def x := node2 2 (node3 77777777777777 leaf leaf (node2 1 leaf leaf)) leaf

#eval serialize x
-- [17, 1, 5, 2, 430029026, 72437, 0, 0, 1, 3, 0, 0, 0]
#eval deserialize (tree ℕ) [17, 1, 5, 2, 430029026, 72437, 0, 0, 1, 3, 0, 0, 0]
-- (some (node2 2 (node3 77777777777777 leaf leaf (node2 1 leaf leaf)) leaf))

example (x : tree ℕ) : deserialize _ (serialize x) = some x :=
by { dsimp [serialize,deserialize],
     rw [← read_write_eq_eval_eval,serial.correctness],
     refl }


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
Ported by: Frédéric Dupuis

! This file was ported from Lean 3 source module algebra.order.hom.monoid
! leanprover-community/mathlib commit 3342d1b2178381196f818146ff79bc0e7ccd9e2d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Pi.Algebra
import Mathlib.Algebra.Hom.Group
import Mathlib.Algebra.Order.Group.Instances
import Mathlib.Algebra.Order.Monoid.WithZero.Defs
import Mathlib.Order.Hom.Basic

/-!
# Ordered monoid and group homomorphisms

This file defines morphisms between (additive) ordered monoids.

## Types of morphisms

* `OrderAddMonoidHom`: Ordered additive monoid homomorphisms.
* `OrderMonoidHom`: Ordered monoid homomorphisms.
* `OrderMonoidWithZeroHom`: Ordered monoid with zero homomorphisms.

## Typeclasses

* `OrderAddMonoidHomClass`
* `OrderMonoidHomClass`
* `OrderMonoidWithZeroHomClass`

## Notation

* `→+o`: Bundled ordered additive monoid homs. Also use for additive groups homs.
* `→*o`: Bundled ordered monoid homs. Also use for groups homs.
* `→*₀o`: Bundled ordered monoid with zero homs. Also use for groups with zero homs.

## Implementation notes

There's a coercion from bundled homs to fun, and the canonical notation is to use the bundled hom as
a function via this coercion.

There is no `OrderGroupHom` -- the idea is that `OrderMonoidHom` is used.
The constructor for `OrderMonoidHom` needs a proof of `map_one` as well as `map_mul`; a separate
constructor `OrderMonoidHom.mk'` will construct ordered group homs (i.e. ordered monoid homs
between ordered groups) given only a proof that multiplication is preserved,

Implicit `{}` brackets are often used instead of type class `[]` brackets. This is done when the
instances can be inferred because they are implicit arguments to the type `OrderMonoidHom`. When
they can be inferred from the type it is faster to use this method than to use type class inference.

## Tags

ordered monoid, ordered group, monoid with zero
-/

open Function

variable {F α β γ δ : Type _}

section AddMonoid

/-- `α →+o β` is the type of monotone functions `α → β` that preserve the `OrderedAddCommMonoid`
structure.

`OrderAddMonoidHom` is also used for ordered group homomorphisms.

When possible, instead of parametrizing results over `(f : α →+o β)`,
you should parametrize over `(F : Type _) [OrderAddMonoidHomClass F α β] (f : F)`.

When you extend this structure, make sure to extend `OrderAddMonoidHomClass`. -/
structure OrderAddMonoidHom (α β : Type _) [Preorder α] [Preorder β] [AddZeroClass α]
  [AddZeroClass β] extends α →+ β where
  /-- An `OrderAddMonoidHom` is a monotone function. -/
  monotone' : Monotone toFun
#align order_add_monoid_hom OrderAddMonoidHom

/-- Infix notation for `OrderAddMonoidHom`. -/
infixr:25 " →+o " => OrderAddMonoidHom

section

/-- `OrderAddMonoidHomClass F α β` states that `F` is a type of ordered monoid homomorphisms.

You should also extend this typeclass when you extend `OrderAddMonoidHom`. -/
class OrderAddMonoidHomClass (F : Type _) (α β : outParam <| Type _) [Preorder α] [Preorder β]
  [AddZeroClass α] [AddZeroClass β] extends AddMonoidHomClass F α β where
  /-- An `OrderAddMonoidHom` is a monotone function. -/
  monotone (f : F) : Monotone f
#align order_add_monoid_hom_class OrderAddMonoidHomClass

end

-- Instances and lemmas are defined below through `@[to_additive]`.
end AddMonoid

section Monoid

/-- `α →*o β` is the type of functions `α → β` that preserve the `OrderedCommMonoid` structure.

`OrderMonoidHom` is also used for ordered group homomorphisms.

When possible, instead of parametrizing results over `(f : α →*o β)`,
you should parametrize over `(F : Type _) [OrderMonoidHomClass F α β] (f : F)`.

When you extend this structure, make sure to extend `OrderMonoidHomClass`. -/
@[to_additive]
structure OrderMonoidHom (α β : Type _) [Preorder α] [Preorder β] [MulOneClass α]
  [MulOneClass β] extends α →* β where
  /-- An `OrderMonoidHom` is a monotone function. -/
  monotone' : Monotone toFun
#align order_monoid_hom OrderMonoidHom

/-- Infix notation for `OrderMonoidHom`. -/
infixr:25 " →*o " => OrderMonoidHom

section

/-- `OrderMonoidHomClass F α β` states that `F` is a type of ordered monoid homomorphisms.

You should also extend this typeclass when you extend `OrderMonoidHom`. -/
@[to_additive]
class OrderMonoidHomClass (F : Type _) (α β : outParam <| Type _) [Preorder α] [Preorder β]
  [MulOneClass α] [MulOneClass β] extends MonoidHomClass F α β where
  /-- An `OrderMonoidHom` is a monotone function. -/
  monotone (f : F) : Monotone f
#align order_monoid_hom_class OrderMonoidHomClass

end

variable {_ : Preorder α} {_ : Preorder β} {_ : MulOneClass α} {_ : MulOneClass β}

/-- Turn an element of a type `F` satisfying `OrderMonoidHomClass F α β` into an actual
`OrderMonoidHom`. This is declared as the default coercion from `F` to `α →*o β`. -/
@[to_additive (attr := coe)
  "Turn an element of a type `F` satisfying `OrderAddMonoidHomClass F α β` into an actual
  `OrderAddMonoidHom`. This is declared as the default coercion from `F` to `α →+o β`."]
def OrderMonoidHomClass.toOrderMonoidHom [OrderMonoidHomClass F α β] (f : F) : α →*o β :=
{ (f : α →* β) with monotone' := monotone f }

-- See note [lower instance priority]
@[to_additive]
instance (priority := 100) OrderMonoidHomClass.toOrderHomClass [OrderMonoidHomClass F α β] :
    OrderHomClass F α β :=
  { ‹OrderMonoidHomClass F α β› with map_rel := OrderMonoidHomClass.monotone }
#align order_monoid_hom_class.to_order_hom_class OrderMonoidHomClass.toOrderHomClass
#align order_add_monoid_hom_class.to_order_hom_class OrderAddMonoidHomClass.toOrderHomClass

/-- Any type satisfying `OrderMonoidHomClass` can be cast into `OrderMonoidHom` via
  `OrderMonoidHomClass.toOrderMonoidHom`. -/
@[to_additive "Any type satisfying `OrderAddMonoidHomClass` can be cast into `OrderAddMonoidHom` via
  `OrderAddMonoidHomClass.toOrderAddMonoidHom`"]
instance [OrderMonoidHomClass F α β] : CoeTC F (α →*o β) :=
  ⟨OrderMonoidHomClass.toOrderMonoidHom⟩

end Monoid

section MonoidWithZero

variable [Preorder α] [Preorder β] [MulZeroOneClass α] [MulZeroOneClass β]

/-- `OrderMonoidWithZeroHom α β` is the type of functions `α → β` that preserve
the `MonoidWithZero` structure.

`OrderMonoidWithZeroHom` is also used for group homomorphisms.

When possible, instead of parametrizing results over `(f : α →+ β)`,
you should parametrize over `(F : Type _) [OrderMonoidWithZeroHomClass F α β] (f : F)`.

When you extend this structure, make sure to extend `OrderMonoidWithZeroHomClass`. -/
structure OrderMonoidWithZeroHom (α β : Type _) [Preorder α] [Preorder β] [MulZeroOneClass α]
  [MulZeroOneClass β] extends α →*₀ β where
  /-- An `OrderMonoidWithZeroHom` is a monotone function. -/
  monotone' : Monotone toFun
#align order_monoid_with_zero_hom OrderMonoidWithZeroHom

/-- Infix notation for `OrderMonoidWithZeroHom`. -/
infixr:25 " →*₀o " => OrderMonoidWithZeroHom

section

/-- `OrderMonoidWithZeroHomClass F α β` states that `F` is a type of
ordered monoid with zero homomorphisms.

You should also extend this typeclass when you extend `OrderMonoidWithZeroHom`. -/
class OrderMonoidWithZeroHomClass (F : Type _) (α β : outParam <| Type _) [Preorder α] [Preorder β]
  [MulZeroOneClass α] [MulZeroOneClass β] extends MonoidWithZeroHomClass F α β where
  /-- An `OrderMonoidWithZeroHom` is a monotone function. -/
  monotone (f : F) : Monotone f
#align order_monoid_with_zero_hom_class OrderMonoidWithZeroHomClass

/-- Turn an element of a type `F` satisfying `OrderMonoidWithZeroHomClass F α β` into an actual
`OrderMonoidWithZeroHom`. This is declared as the default coercion from `F` to `α →+*₀o β`. -/
@[coe]
def OrderMonoidWithZeroHomClass.toOrderMonoidWithZeroHom [OrderMonoidWithZeroHomClass F α β]
    (f : F) : α →*₀o β :=
{ (f : α →*₀ β) with monotone' := monotone f }

end

-- See note [lower instance priority]
instance (priority := 100) OrderMonoidWithZeroHomClass.toOrderMonoidHomClass
    {_ : Preorder α} {_ : Preorder β} {_ : MulZeroOneClass α} {_ : MulZeroOneClass β}
    [OrderMonoidWithZeroHomClass F α β] : OrderMonoidHomClass F α β :=
  { ‹OrderMonoidWithZeroHomClass F α β› with }
#align order_monoid_with_zero_hom_class.to_order_monoid_hom_class OrderMonoidWithZeroHomClass.toOrderMonoidHomClass

instance [OrderMonoidWithZeroHomClass F α β] : CoeTC F (α →*₀o β) :=
  ⟨OrderMonoidWithZeroHomClass.toOrderMonoidWithZeroHom⟩

end MonoidWithZero

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid α] [OrderedAddCommMonoid β] [OrderAddMonoidHomClass F α β] (f : F)
  {a : α}

theorem map_nonneg (ha : 0 ≤ a) : 0 ≤ f a := by
  rw [← map_zero f]
  exact OrderHomClass.mono _ ha
#align map_nonneg map_nonneg

theorem map_nonpos (ha : a ≤ 0) : f a ≤ 0 := by
  rw [← map_zero f]
  exact OrderHomClass.mono _ ha
#align map_nonpos map_nonpos

end OrderedAddCommMonoid

section OrderedAddCommGroup

variable [OrderedAddCommGroup α] [OrderedAddCommMonoid β] [AddMonoidHomClass F α β] (f : F)

theorem monotone_iff_map_nonneg : Monotone (f : α → β) ↔ ∀ a, 0 ≤ a → 0 ≤ f a :=
  ⟨fun h a => by
    rw [← map_zero f]
    apply h, fun h a b hl => by
    rw [← sub_add_cancel b a, map_add f]
    exact le_add_of_nonneg_left (h _ <| sub_nonneg.2 hl)⟩
#align monotone_iff_map_nonneg monotone_iff_map_nonneg

theorem antitone_iff_map_nonpos : Antitone (f : α → β) ↔ ∀ a, 0 ≤ a → f a ≤ 0 :=
  monotone_toDual_comp_iff.symm.trans <| monotone_iff_map_nonneg _
#align antitone_iff_map_nonpos antitone_iff_map_nonpos

theorem monotone_iff_map_nonpos : Monotone (f : α → β) ↔ ∀ a ≤ 0, f a ≤ 0 :=
  antitone_comp_ofDual_iff.symm.trans <| antitone_iff_map_nonpos _
#align monotone_iff_map_nonpos monotone_iff_map_nonpos

theorem antitone_iff_map_nonneg : Antitone (f : α → β) ↔ ∀ a ≤ 0, 0 ≤ f a :=
  monotone_comp_ofDual_iff.symm.trans <| monotone_iff_map_nonneg _
#align antitone_iff_map_nonneg antitone_iff_map_nonneg

variable [CovariantClass β β (· + ·) (· < ·)]

theorem strictMono_iff_map_pos : StrictMono (f : α → β) ↔ ∀ a, 0 < a → 0 < f a := by
  refine ⟨fun h a => ?_, fun h a b hl => ?_⟩
  · rw [← map_zero f]
    apply h
  · rw [← sub_add_cancel b a, map_add f]
    exact lt_add_of_pos_left _ (h _ <| sub_pos.2 hl)
#align strict_mono_iff_map_pos strictMono_iff_map_pos

theorem strictAnti_iff_map_neg : StrictAnti (f : α → β) ↔ ∀ a, 0 < a → f a < 0 :=
  strictMono_toDual_comp_iff.symm.trans <| strictMono_iff_map_pos _
#align strict_anti_iff_map_neg strictAnti_iff_map_neg

theorem strictMono_iff_map_neg : StrictMono (f : α → β) ↔ ∀ a < 0, f a < 0 :=
  strictAnti_comp_ofDual_iff.symm.trans <| strictAnti_iff_map_neg _
#align strict_mono_iff_map_neg strictMono_iff_map_neg

theorem strictAnti_iff_map_pos : StrictAnti (f : α → β) ↔ ∀ a < 0, 0 < f a :=
  strictMono_comp_ofDual_iff.symm.trans <| strictMono_iff_map_pos _
#align strict_anti_iff_map_pos strictAnti_iff_map_pos

end OrderedAddCommGroup

namespace OrderMonoidHom

section Preorder

variable [Preorder α] [Preorder β] [Preorder γ] [Preorder δ] [MulOneClass α] [MulOneClass β]
  [MulOneClass γ] [MulOneClass δ] {f g : α →*o β}

@[to_additive]
 instance : OrderMonoidHomClass (α →*o β) α β where
  coe f := f.toFun
  coe_injective' f g h := by
    obtain ⟨⟨⟨_, _⟩⟩, _⟩ := f
    obtain ⟨⟨⟨_, _⟩⟩, _⟩ := g
    congr
  map_mul f := f.map_mul'
  map_one f := f.map_one'
  monotone f := f.monotone'

-- Porting note:
-- These helper instances are unhelpful in Lean 4, so omitting:
-- /-- Helper instance for when there's too many metavariables to apply `FunLike.instCoeFunForAll`
-- directly. -/
-- @[to_additive "Helper instance for when there's too many metavariables to apply
-- `FunLike.instCoeFunForAll` directly."]
-- instance : CoeFun (α →*o β) fun _ => α → β :=
--   FunLike.instCoeFunForAll

-- Other lemmas should be accessed through the `FunLike` API
@[to_additive (attr := ext)]
theorem ext (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align order_monoid_hom.ext OrderMonoidHom.ext
#align order_add_monoid_hom.ext OrderAddMonoidHom.ext

@[to_additive]
theorem toFun_eq_coe (f : α →*o β) : f.toFun = (f : α → β) :=
  rfl
#align order_monoid_hom.to_fun_eq_coe OrderMonoidHom.toFun_eq_coe
#align order_add_monoid_hom.to_fun_eq_coe OrderAddMonoidHom.toFun_eq_coe

@[to_additive (attr := simp)]
theorem coe_mk (f : α →* β) (h) : (OrderMonoidHom.mk f h : α → β) = f :=
  rfl
#align order_monoid_hom.coe_mk OrderMonoidHom.coe_mk
#align order_add_monoid_hom.coe_mk OrderAddMonoidHom.coe_mk

@[to_additive (attr := simp)]
theorem mk_coe (f : α →*o β) (h) : OrderMonoidHom.mk (f : α →* β) h = f := by
  ext
  rfl
#align order_monoid_hom.mk_coe OrderMonoidHom.mk_coe
#align order_add_monoid_hom.mk_coe OrderAddMonoidHom.mk_coe

/-- Reinterpret an ordered monoid homomorphism as an order homomorphism. -/
@[to_additive "Reinterpret an ordered additive monoid homomorphism as an order homomorphism."]
def toOrderHom (f : α →*o β) : α →o β :=
  { f with }
#align order_monoid_hom.to_order_hom OrderMonoidHom.toOrderHom
#align order_add_monoid_hom.to_order_hom OrderAddMonoidHom.toOrderHom

@[to_additive (attr := simp)]
theorem coe_monoidHom (f : α →*o β) : ((f : α →* β) : α → β) = f :=
  rfl
#align order_monoid_hom.coe_monoid_hom OrderMonoidHom.coe_monoidHom
#align order_add_monoid_hom.coe_add_monoid_hom OrderAddMonoidHom.coe_addMonoidHom

@[to_additive (attr := simp)]
theorem coe_orderHom (f : α →*o β) : ((f : α →o β) : α → β) = f :=
  rfl
#align order_monoid_hom.coe_order_hom OrderMonoidHom.coe_orderHom
#align order_add_monoid_hom.coe_order_hom OrderAddMonoidHom.coe_orderHom

@[to_additive]
theorem toMonoidHom_injective : Injective (toMonoidHom : _ → α →* β) := fun f g h =>
  ext <| by convert FunLike.ext_iff.1 h using 0
#align order_monoid_hom.to_monoid_hom_injective OrderMonoidHom.toMonoidHom_injective
#align order_add_monoid_hom.to_add_monoid_hom_injective OrderAddMonoidHom.toAddMonoidHom_injective

@[to_additive]
theorem toOrderHom_injective : Injective (toOrderHom : _ → α →o β) := fun f g h =>
  ext <| by convert FunLike.ext_iff.1 h using 0
#align order_monoid_hom.to_order_hom_injective OrderMonoidHom.toOrderHom_injective
#align order_add_monoid_hom.to_order_hom_injective OrderAddMonoidHom.toOrderHom_injective

/-- Copy of an `OrderMonoidHom` with a new `toFun` equal to the old one. Useful to fix
definitional equalities. -/
@[to_additive "Copy of an `OrderAddMonoidHom` with a new `toFun` equal to the old one. Useful to fix
definitional equalities."]
protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β :=
  { f.toMonoidHom.copy f' h with toFun := f', monotone' := h.symm.subst f.monotone' }
#align order_monoid_hom.copy OrderMonoidHom.copy
#align order_add_monoid_hom.copy OrderAddMonoidHom.copy

@[to_additive (attr := simp)]
theorem coe_copy (f : α →*o β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align order_monoid_hom.coe_copy OrderMonoidHom.coe_copy
#align order_add_monoid_hom.coe_copy OrderAddMonoidHom.coe_copy

@[to_additive]
theorem copy_eq (f : α →*o β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align order_monoid_hom.copy_eq OrderMonoidHom.copy_eq
#align order_add_monoid_hom.copy_eq OrderAddMonoidHom.copy_eq

variable (α)

/-- The identity map as an ordered monoid homomorphism. -/
@[to_additive "The identity map as an ordered additive monoid homomorphism."]
protected def id : α →*o α :=
  { MonoidHom.id α, OrderHom.id with }
#align order_monoid_hom.id OrderMonoidHom.id
#align order_add_monoid_hom.id OrderAddMonoidHom.id

@[to_additive (attr := simp)]
theorem coe_id : ⇑(OrderMonoidHom.id α) = id :=
  rfl
#align order_monoid_hom.coe_id OrderMonoidHom.coe_id
#align order_add_monoid_hom.coe_id OrderAddMonoidHom.coe_id

@[to_additive]
instance : Inhabited (α →*o α) :=
  ⟨OrderMonoidHom.id α⟩

variable {α}

/-- Composition of `OrderMonoidHom`s as an `OrderMonoidHom`. -/
@[to_additive "Composition of `OrderAddMonoidHom`s as an `OrderAddMonoidHom`"]
def comp (f : β →*o γ) (g : α →*o β) : α →*o γ :=
  { f.toMonoidHom.comp (g : α →* β), f.toOrderHom.comp (g : α →o β) with }
#align order_monoid_hom.comp OrderMonoidHom.comp
#align order_add_monoid_hom.comp OrderAddMonoidHom.comp

@[to_additive (attr := simp)]
theorem coe_comp (f : β →*o γ) (g : α →*o β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align order_monoid_hom.coe_comp OrderMonoidHom.coe_comp
#align order_add_monoid_hom.coe_comp OrderAddMonoidHom.coe_comp

@[to_additive (attr := simp)]
theorem comp_apply (f : β →*o γ) (g : α →*o β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align order_add_monoid_hom.comp_apply OrderAddMonoidHom.comp_apply
#align order_monoid_hom.comp_apply OrderMonoidHom.comp_apply

@[to_additive]
theorem coe_comp_monoidHom (f : β →*o γ) (g : α →*o β) :
    (f.comp g : α →* γ) = (f : β →* γ).comp g :=
  rfl
#align order_monoid_hom.coe_comp_monoid_hom OrderMonoidHom.coe_comp_monoidHom
#align order_add_monoid_hom.coe_comp_add_monoid_hom OrderAddMonoidHom.coe_comp_addMonoidHom

@[to_additive]
theorem coe_comp_orderHom (f : β →*o γ) (g : α →*o β) :
    (f.comp g : α →o γ) = (f : β →o γ).comp g :=
  rfl
#align order_monoid_hom.coe_comp_order_hom OrderMonoidHom.coe_comp_orderHom
#align order_add_monoid_hom.coe_comp_order_hom OrderAddMonoidHom.coe_comp_orderHom

@[to_additive (attr := simp)]
theorem comp_assoc (f : γ →*o δ) (g : β →*o γ) (h : α →*o β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align order_monoid_hom.comp_assoc OrderMonoidHom.comp_assoc
#align order_add_monoid_hom.comp_assoc OrderAddMonoidHom.comp_assoc

@[to_additive (attr := simp)]
theorem comp_id (f : α →*o β) : f.comp (OrderMonoidHom.id α) = f :=
  rfl
#align order_monoid_hom.comp_id OrderMonoidHom.comp_id
#align order_add_monoid_hom.comp_id OrderAddMonoidHom.comp_id

@[to_additive (attr := simp)]
theorem id_comp (f : α →*o β) : (OrderMonoidHom.id β).comp f = f :=
  rfl
#align order_monoid_hom.id_comp OrderMonoidHom.id_comp
#align order_add_monoid_hom.id_comp OrderAddMonoidHom.id_comp

@[to_additive]
theorem cancel_right {g₁ g₂ : β →*o γ} {f : α →*o β} (hf : Function.Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun _ => by congr⟩
#align order_monoid_hom.cancel_right OrderMonoidHom.cancel_right
#align order_add_monoid_hom.cancel_right OrderAddMonoidHom.cancel_right

@[to_additive]
theorem cancel_left {g : β →*o γ} {f₁ f₂ : α →*o β} (hg : Function.Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => ext fun a => hg <| by rw [← comp_apply, h, comp_apply], congr_arg _⟩
#align order_monoid_hom.cancel_left OrderMonoidHom.cancel_left
#align order_add_monoid_hom.cancel_left OrderAddMonoidHom.cancel_left

/-- `1` is the homomorphism sending all elements to `1`. -/
@[to_additive "`0` is the homomorphism sending all elements to `0`."]
instance : One (α →*o β) :=
  ⟨{ (1 : α →* β) with monotone' := monotone_const }⟩

@[to_additive (attr := simp)]
theorem coe_one : ⇑(1 : α →*o β) = 1 :=
  rfl
#align order_monoid_hom.coe_one OrderMonoidHom.coe_one
#align order_add_monoid_hom.coe_zero OrderAddMonoidHom.coe_zero

@[to_additive (attr := simp)]
theorem one_apply (a : α) : (1 : α →*o β) a = 1 :=
  rfl
#align order_monoid_hom.one_apply OrderMonoidHom.one_apply
#align order_add_monoid_hom.zero_apply OrderAddMonoidHom.zero_apply

@[to_additive (attr := simp)]
theorem one_comp (f : α →*o β) : (1 : β →*o γ).comp f = 1 :=
  rfl
#align order_monoid_hom.one_comp OrderMonoidHom.one_comp
#align order_add_monoid_hom.zero_comp OrderAddMonoidHom.zero_comp

@[to_additive (attr := simp)]
theorem comp_one (f : β →*o γ) : f.comp (1 : α →*o β) = 1 :=
  ext fun _ => map_one f
#align order_monoid_hom.comp_one OrderMonoidHom.comp_one
#align order_add_monoid_hom.comp_zero OrderAddMonoidHom.comp_zero

end Preorder

section Mul

variable [OrderedCommMonoid α] [OrderedCommMonoid β] [OrderedCommMonoid γ]

/-- For two ordered monoid morphisms `f` and `g`, their product is the ordered monoid morphism
sending `a` to `f a * g a`. -/
@[to_additive "For two ordered additive monoid morphisms `f` and `g`, their product is the ordered
additive monoid morphism sending `a` to `f a + g a`."]
instance : Mul (α →*o β) :=
  ⟨fun f g => { (f * g : α →* β) with monotone' := f.monotone'.mul' g.monotone' }⟩

@[to_additive (attr := simp)]
theorem coe_mul (f g : α →*o β) : ⇑(f * g) = f * g :=
  rfl
#align order_monoid_hom.coe_mul OrderMonoidHom.coe_mul
#align order_add_monoid_hom.coe_add OrderAddMonoidHom.coe_add

@[to_additive (attr := simp)]
theorem mul_apply (f g : α →*o β) (a : α) : (f * g) a = f a * g a :=
  rfl
#align order_monoid_hom.mul_apply OrderMonoidHom.mul_apply
#align order_add_monoid_hom.add_apply OrderAddMonoidHom.add_apply

@[to_additive]
theorem mul_comp (g₁ g₂ : β →*o γ) (f : α →*o β) : (g₁ * g₂).comp f = g₁.comp f * g₂.comp f :=
  rfl
#align order_monoid_hom.mul_comp OrderMonoidHom.mul_comp
#align order_add_monoid_hom.add_comp OrderAddMonoidHom.add_comp

@[to_additive]
theorem comp_mul (g : β →*o γ) (f₁ f₂ : α →*o β) : g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ :=
  ext fun _ => map_mul g _ _
#align order_monoid_hom.comp_mul OrderMonoidHom.comp_mul
#align order_add_monoid_hom.comp_add OrderAddMonoidHom.comp_add

end Mul

section OrderedCommMonoid

variable {hα : OrderedCommMonoid α} {hβ : OrderedCommMonoid β}

@[to_additive (attr := simp)]
theorem toMonoidHom_eq_coe (f : α →*o β) : f.toMonoidHom = f :=
  rfl
#align order_monoid_hom.to_monoid_hom_eq_coe OrderMonoidHom.toMonoidHom_eq_coe
#align order_add_monoid_hom.to_add_monoid_hom_eq_coe OrderAddMonoidHom.toAddMonoidHom_eq_coe

@[to_additive (attr := simp)]

end OrderedCommMonoid

section OrderedCommGroup

variable {hα : OrderedCommGroup α} {hβ : OrderedCommGroup β}

/-- Makes an ordered group homomorphism from a proof that the map preserves multiplication. -/
@[to_additive
      "Makes an ordered additive group homomorphism from a proof that the map preserves
      addition."]
def mk' (f : α → β) (hf : Monotone f) (map_mul : ∀ a b : α, f (a * b) = f a * f b) : α →*o β :=
  { MonoidHom.mk' f map_mul with monotone' := hf }
#align order_monoid_hom.mk' OrderMonoidHom.mk'
#align order_add_monoid_hom.mk' OrderAddMonoidHom.mk'

end OrderedCommGroup

end OrderMonoidHom

namespace OrderMonoidWithZeroHom

section Preorder

variable [Preorder α] [Preorder β] [Preorder γ] [Preorder δ] [MulZeroOneClass α] [MulZeroOneClass β]
  [MulZeroOneClass γ] [MulZeroOneClass δ] {f g : α →*₀o β}

instance : OrderMonoidWithZeroHomClass (α →*₀o β) α β where
  coe f := f.toFun
  coe_injective' f g h := by
    obtain ⟨⟨⟨_, _⟩⟩, _⟩ := f
    obtain ⟨⟨⟨_, _⟩⟩, _⟩ := g
    congr
  map_mul f := f.map_mul'
  map_one f := f.map_one'
  map_zero f := f.map_zero'
  monotone f := f.monotone'

-- Porting note:
-- These helper instances are unhelpful in Lean 4, so omitting:
--/-- Helper instance for when there's too many metavariables to apply `FunLike.instCoeFunForAll`
--directly. -/
--instance : CoeFun (α →*₀o β) fun _ => α → β :=
--  FunLike.instCoeFunForAll

-- Other lemmas should be accessed through the `FunLike` API
@[ext]
theorem ext (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align order_monoid_with_zero_hom.ext OrderMonoidWithZeroHom.ext

theorem toFun_eq_coe (f : α →*₀o β) : f.toFun = (f : α → β) :=
  rfl
#align order_monoid_with_zero_hom.to_fun_eq_coe OrderMonoidWithZeroHom.toFun_eq_coe

@[simp]
theorem coe_mk (f : α →*₀ β) (h) : (OrderMonoidWithZeroHom.mk f h : α → β) = f :=
  rfl
#align order_monoid_with_zero_hom.coe_mk OrderMonoidWithZeroHom.coe_mk

@[simp]
theorem mk_coe (f : α →*₀o β) (h) : OrderMonoidWithZeroHom.mk (f : α →*₀ β) h = f := rfl
#align order_monoid_with_zero_hom.mk_coe OrderMonoidWithZeroHom.mk_coe

/-- Reinterpret an ordered monoid with zero homomorphism as an order monoid homomorphism. -/
def toOrderMonoidHom (f : α →*₀o β) : α →*o β :=
  { f with }
#align order_monoid_with_zero_hom.to_order_monoid_hom OrderMonoidWithZeroHom.toOrderMonoidHom

@[simp]
theorem coe_monoidWithZeroHom (f : α →*₀o β) : ⇑(f : α →*₀ β) = f :=
  rfl
#align order_monoid_with_zero_hom.coe_monoid_with_zero_hom OrderMonoidWithZeroHom.coe_monoidWithZeroHom

@[simp]
theorem coe_orderMonoidHom (f : α →*₀o β) : ⇑(f : α →*o β) = f :=
  rfl
#align order_monoid_with_zero_hom.coe_order_monoid_hom OrderMonoidWithZeroHom.coe_orderMonoidHom

theorem toOrderMonoidHom_injective : Injective (toOrderMonoidHom : _ → α →*o β) := fun f g h =>
  ext <| by convert FunLike.ext_iff.1 h using 0
#align order_monoid_with_zero_hom.to_order_monoid_hom_injective OrderMonoidWithZeroHom.toOrderMonoidHom_injective

theorem toMonoidWithZeroHom_injective : Injective (toMonoidWithZeroHom : _ → α →*₀ β) :=
  fun f g h => ext <| by convert FunLike.ext_iff.1 h using 0
#align order_monoid_with_zero_hom.to_monoid_with_zero_hom_injective OrderMonoidWithZeroHom.toMonoidWithZeroHom_injective

/-- Copy of an `OrderMonoidWithZeroHom` with a new `toFun` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : α →*₀o β) (f' : α → β) (h : f' = f) : α →*o β :=
  { f.toOrderMonoidHom.copy f' h, f.toMonoidWithZeroHom.copy f' h with toFun := f' }
#align order_monoid_with_zero_hom.copy OrderMonoidWithZeroHom.copy

@[simp]
theorem coe_copy (f : α →*₀o β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align order_monoid_with_zero_hom.coe_copy OrderMonoidWithZeroHom.coe_copy

theorem copy_eq (f : α →*₀o β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align order_monoid_with_zero_hom.copy_eq OrderMonoidWithZeroHom.copy_eq

variable (α)

/-- The identity map as an ordered monoid with zero homomorphism. -/
protected def id : α →*₀o α :=
  { MonoidWithZeroHom.id α, OrderHom.id with }
#align order_monoid_with_zero_hom.id OrderMonoidWithZeroHom.id

@[simp]
theorem coe_id : ⇑(OrderMonoidWithZeroHom.id α) = id :=
  rfl
#align order_monoid_with_zero_hom.coe_id OrderMonoidWithZeroHom.coe_id

instance : Inhabited (α →*₀o α) :=
  ⟨OrderMonoidWithZeroHom.id α⟩

variable {α}

/-- Composition of `OrderMonoidWithZeroHom`s as an `OrderMonoidWithZeroHom`. -/
def comp (f : β →*₀o γ) (g : α →*₀o β) : α →*₀o γ :=
  { f.toMonoidWithZeroHom.comp (g : α →*₀ β), f.toOrderMonoidHom.comp (g : α →*o β) with }
#align order_monoid_with_zero_hom.comp OrderMonoidWithZeroHom.comp

@[simp]
theorem coe_comp (f : β →*₀o γ) (g : α →*₀o β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align order_monoid_with_zero_hom.coe_comp OrderMonoidWithZeroHom.coe_comp

@[simp]
theorem comp_apply (f : β →*₀o γ) (g : α →*₀o β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align order_monoid_with_zero_hom.comp_apply OrderMonoidWithZeroHom.comp_apply

theorem coe_comp_monoidWithZeroHom (f : β →*₀o γ) (g : α →*₀o β) :
    (f.comp g : α →*₀ γ) = (f : β →*₀ γ).comp g :=
  rfl
#align order_monoid_with_zero_hom.coe_comp_monoid_with_zero_hom OrderMonoidWithZeroHom.coe_comp_monoidWithZeroHom

theorem coe_comp_orderMonoidHom (f : β →*₀o γ) (g : α →*₀o β) :
    (f.comp g : α →*o γ) = (f : β →*o γ).comp g :=
  rfl
#align order_monoid_with_zero_hom.coe_comp_order_monoid_hom OrderMonoidWithZeroHom.coe_comp_orderMonoidHom

@[simp]
theorem comp_assoc (f : γ →*₀o δ) (g : β →*₀o γ) (h : α →*₀o β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align order_monoid_with_zero_hom.comp_assoc OrderMonoidWithZeroHom.comp_assoc

@[simp]
theorem comp_id (f : α →*₀o β) : f.comp (OrderMonoidWithZeroHom.id α) = f := rfl
#align order_monoid_with_zero_hom.comp_id OrderMonoidWithZeroHom.comp_id

@[simp]
theorem id_comp (f : α →*₀o β) : (OrderMonoidWithZeroHom.id β).comp f = f := rfl
#align order_monoid_with_zero_hom.id_comp OrderMonoidWithZeroHom.id_comp

theorem cancel_right {g₁ g₂ : β →*₀o γ} {f : α →*₀o β} (hf : Function.Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun _ => by congr⟩
#align order_monoid_with_zero_hom.cancel_right OrderMonoidWithZeroHom.cancel_right

theorem cancel_left {g : β →*₀o γ} {f₁ f₂ : α →*₀o β} (hg : Function.Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => ext fun a => hg <| by rw [← comp_apply, h, comp_apply], congr_arg _⟩
#align order_monoid_with_zero_hom.cancel_left OrderMonoidWithZeroHom.cancel_left

end Preorder

section Mul

variable [LinearOrderedCommMonoidWithZero α] [LinearOrderedCommMonoidWithZero β]
  [LinearOrderedCommMonoidWithZero γ]

/-- For two ordered monoid morphisms `f` and `g`, their product is the ordered monoid morphism
sending `a` to `f a * g a`. -/
instance : Mul (α →*₀o β) :=
  ⟨fun f g => { (f * g : α →*₀ β) with monotone' := f.monotone'.mul' g.monotone' }⟩

@[simp]
theorem coe_mul (f g : α →*₀o β) : ⇑(f * g) = f * g :=
  rfl
#align order_monoid_with_zero_hom.coe_mul OrderMonoidWithZeroHom.coe_mul

@[simp]
theorem mul_apply (f g : α →*₀o β) (a : α) : (f * g) a = f a * g a :=
  rfl
#align order_monoid_with_zero_hom.mul_apply OrderMonoidWithZeroHom.mul_apply

theorem mul_comp (g₁ g₂ : β →*₀o γ) (f : α →*₀o β) : (g₁ * g₂).comp f = g₁.comp f * g₂.comp f :=
  rfl
#align order_monoid_with_zero_hom.mul_comp OrderMonoidWithZeroHom.mul_comp

theorem comp_mul (g : β →*₀o γ) (f₁ f₂ : α →*₀o β) : g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ :=
  ext fun _ => map_mul g _ _
#align order_monoid_with_zero_hom.comp_mul OrderMonoidWithZeroHom.comp_mul

end Mul

section LinearOrderedCommMonoidWithZero

variable {hα : Preorder α} {hα' : MulZeroOneClass α} {hβ : Preorder β} {hβ' : MulZeroOneClass β}

@[simp]
theorem toMonoidWithZeroHom_eq_coe (f : α →*₀o β) : f.toMonoidWithZeroHom = f := by
  rfl
#align order_monoid_with_zero_hom.to_monoid_with_zero_hom_eq_coe OrderMonoidWithZeroHom.toMonoidWithZeroHom_eq_coe

@[simp]
theorem toOrderMonoidHom_eq_coe (f : α →*₀o β) : f.toOrderMonoidHom = f :=
  rfl
#align order_monoid_with_zero_hom.to_order_monoid_hom_eq_coe OrderMonoidWithZeroHom.toOrderMonoidHom_eq_coe

end LinearOrderedCommMonoidWithZero

end OrderMonoidWithZeroHom