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

! This file was ported from Lean 3 source module group_theory.complement
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Zmod.Quotient

/-!
# Complements

In this file we define the complement of a subgroup.

## Main definitions

- `is_complement S T` where `S` and `T` are subsets of `G` states that every `g : G` can be
  written uniquely as a product `s * t` for `s ∈ S`, `t ∈ T`.
- `left_transversals T` where `T` is a subset of `G` is the set of all left-complements of `T`,
  i.e. the set of all `S : set G` that contain exactly one element of each left coset of `T`.
- `right_transversals S` where `S` is a subset of `G` is the set of all right-complements of `S`,
  i.e. the set of all `T : set G` that contain exactly one element of each right coset of `S`.
- `transfer_transversal H g` is a specific `left_transversal` of `H` that is used in the
  computation of the transfer homomorphism evaluated at an element `g : G`.

## Main results

- `is_complement_of_coprime` : Subgroups of coprime order are complements.
-/

open BigOperators Pointwise

namespace Subgroup

variable {G : Type _} [Group G] (H K : Subgroup G) (S T : Set G)

/-- `S` and `T` are complements if `(*) : S × T → G` is a bijection.
  This notion generalizes left transversals, right transversals, and complementary subgroups. -/
@[to_additive "`S` and `T` are complements if `(*) : S × T → G` is a bijection"]
def IsComplement : Prop :=
  Function.Bijective fun x : S × T => x.1.1 * x.2.1
#align subgroup.is_complement Subgroup.IsComplement
#align add_subgroup.is_complement AddSubgroup.IsComplement

/-- `H` and `K` are complements if `(*) : H × K → G` is a bijection -/
@[to_additive "`H` and `K` are complements if `(*) : H × K → G` is a bijection"]
abbrev IsComplement' :=
  IsComplement (H : Set G) (K : Set G)
#align subgroup.is_complement' Subgroup.IsComplement'
#align add_subgroup.is_complement' AddSubgroup.IsComplement'

/-- The set of left-complements of `T : set G` -/
@[to_additive "The set of left-complements of `T : set G`"]
def leftTransversals : Set (Set G) :=
  { S : Set G | IsComplement S T }
#align subgroup.left_transversals Subgroup.leftTransversals
#align add_subgroup.left_transversals AddSubgroup.leftTransversals

/-- The set of right-complements of `S : set G` -/
@[to_additive "The set of right-complements of `S : set G`"]
def rightTransversals : Set (Set G) :=
  { T : Set G | IsComplement S T }
#align subgroup.right_transversals Subgroup.rightTransversals
#align add_subgroup.right_transversals AddSubgroup.rightTransversals

variable {H K S T}

@[to_additive]
theorem isComplement'_def : IsComplement' H K ↔ IsComplement (H : Set G) (K : Set G) :=
  Iff.rfl
#align subgroup.is_complement'_def Subgroup.isComplement'_def
#align add_subgroup.is_complement'_def AddSubgroup.isComplement'_def

@[to_additive]
theorem isComplement_iff_existsUnique :
    IsComplement S T ↔ ∀ g : G, ∃! x : S × T, x.1.1 * x.2.1 = g :=
  Function.bijective_iff_existsUnique _
#align subgroup.is_complement_iff_exists_unique Subgroup.isComplement_iff_existsUnique
#align add_subgroup.is_complement_iff_exists_unique AddSubgroup.isComplement_iff_existsUnique

@[to_additive]
theorem IsComplement.existsUnique (h : IsComplement S T) (g : G) :
    ∃! x : S × T, x.1.1 * x.2.1 = g :=
  isComplement_iff_existsUnique.mp h g
#align subgroup.is_complement.exists_unique Subgroup.IsComplement.existsUnique
#align add_subgroup.is_complement.exists_unique AddSubgroup.IsComplement.existsUnique

@[to_additive]
theorem IsComplement'.symm (h : IsComplement' H K) : IsComplement' K H :=
  by
  let ϕ : H × K ≃ K × H :=
    Equiv.mk (fun x => ⟨x.2⁻¹, x.1⁻¹⟩) (fun x => ⟨x.2⁻¹, x.1⁻¹⟩)
      (fun x => Prod.ext (inv_inv _) (inv_inv _)) fun x => Prod.ext (inv_inv _) (inv_inv _)
  let ψ : G ≃ G := Equiv.mk (fun g : G => g⁻¹) (fun g : G => g⁻¹) inv_inv inv_inv
  suffices (ψ ∘ fun x : H × K => x.1.1 * x.2.1) = (fun x : K × H => x.1.1 * x.2.1) ∘ ϕ by
    rwa [is_complement'_def, is_complement, ← Equiv.bijective_comp, ← this, Equiv.comp_bijective]
  exact funext fun x => mul_inv_rev _ _
#align subgroup.is_complement'.symm Subgroup.IsComplement'.symm
#align add_subgroup.is_complement'.symm AddSubgroup.IsComplement'.symm

@[to_additive]
theorem isComplement'_comm : IsComplement' H K ↔ IsComplement' K H :=
  ⟨IsComplement'.symm, IsComplement'.symm⟩
#align subgroup.is_complement'_comm Subgroup.isComplement'_comm
#align add_subgroup.is_complement'_comm AddSubgroup.isComplement'_comm

@[to_additive]
theorem isComplement_top_singleton {g : G} : IsComplement (⊤ : Set G) {g} :=
  ⟨fun ⟨x, _, rfl⟩ ⟨y, _, rfl⟩ h => Prod.ext (Subtype.ext (mul_right_cancel h)) rfl, fun x =>
    ⟨⟨⟨x * g⁻¹, ⟨⟩⟩, g, rfl⟩, inv_mul_cancel_right x g⟩⟩
#align subgroup.is_complement_top_singleton Subgroup.isComplement_top_singleton
#align add_subgroup.is_complement_top_singleton AddSubgroup.isComplement_top_singleton

@[to_additive]
theorem isComplement_singleton_top {g : G} : IsComplement ({g} : Set G) ⊤ :=
  ⟨fun ⟨⟨_, rfl⟩, x⟩ ⟨⟨_, rfl⟩, y⟩ h => Prod.ext rfl (Subtype.ext (mul_left_cancel h)), fun x =>
    ⟨⟨⟨g, rfl⟩, g⁻¹ * x, ⟨⟩⟩, mul_inv_cancel_left g x⟩⟩
#align subgroup.is_complement_singleton_top Subgroup.isComplement_singleton_top
#align add_subgroup.is_complement_singleton_top AddSubgroup.isComplement_singleton_top

@[to_additive]
theorem isComplement_singleton_left {g : G} : IsComplement {g} S ↔ S = ⊤ :=
  by
  refine'
    ⟨fun h => top_le_iff.mp fun x hx => _, fun h => (congr_arg _ h).mpr is_complement_singleton_top⟩
  obtain ⟨⟨⟨z, rfl : z = g⟩, y, _⟩, hy⟩ := h.2 (g * x)
  rwa [← mul_left_cancel hy]
#align subgroup.is_complement_singleton_left Subgroup.isComplement_singleton_left
#align add_subgroup.is_complement_singleton_left AddSubgroup.isComplement_singleton_left

@[to_additive]
theorem isComplement_singleton_right {g : G} : IsComplement S {g} ↔ S = ⊤ :=
  by
  refine'
    ⟨fun h => top_le_iff.mp fun x hx => _, fun h => (congr_arg _ h).mpr is_complement_top_singleton⟩
  obtain ⟨y, hy⟩ := h.2 (x * g)
  conv_rhs at hy => rw [← show y.2.1 = g from y.2.2]
  rw [← mul_right_cancel hy]
  exact y.1.2
#align subgroup.is_complement_singleton_right Subgroup.isComplement_singleton_right
#align add_subgroup.is_complement_singleton_right AddSubgroup.isComplement_singleton_right

@[to_additive]
theorem isComplement_top_left : IsComplement ⊤ S ↔ ∃ g : G, S = {g} :=
  by
  refine'
    ⟨fun h => set.exists_eq_singleton_iff_nonempty_subsingleton.mpr ⟨_, fun a ha b hb => _⟩, _⟩
  · obtain ⟨a, ha⟩ := h.2 1
    exact ⟨a.2.1, a.2.2⟩
  · have : (⟨⟨_, mem_top a⁻¹⟩, ⟨a, ha⟩⟩ : (⊤ : Set G) × S) = ⟨⟨_, mem_top b⁻¹⟩, ⟨b, hb⟩⟩ :=
      h.1 ((inv_mul_self a).trans (inv_mul_self b).symm)
    exact subtype.ext_iff.mp (prod.ext_iff.mp this).2
  · rintro ⟨g, rfl⟩
    exact is_complement_top_singleton
#align subgroup.is_complement_top_left Subgroup.isComplement_top_left
#align add_subgroup.is_complement_top_left AddSubgroup.isComplement_top_left

@[to_additive]
theorem isComplement_top_right : IsComplement S ⊤ ↔ ∃ g : G, S = {g} :=
  by
  refine'
    ⟨fun h => set.exists_eq_singleton_iff_nonempty_subsingleton.mpr ⟨_, fun a ha b hb => _⟩, _⟩
  · obtain ⟨a, ha⟩ := h.2 1
    exact ⟨a.1.1, a.1.2⟩
  · have : (⟨⟨a, ha⟩, ⟨_, mem_top a⁻¹⟩⟩ : S × (⊤ : Set G)) = ⟨⟨b, hb⟩, ⟨_, mem_top b⁻¹⟩⟩ :=
      h.1 ((mul_inv_self a).trans (mul_inv_self b).symm)
    exact subtype.ext_iff.mp (prod.ext_iff.mp this).1
  · rintro ⟨g, rfl⟩
    exact is_complement_singleton_top
#align subgroup.is_complement_top_right Subgroup.isComplement_top_right
#align add_subgroup.is_complement_top_right AddSubgroup.isComplement_top_right

@[to_additive]
theorem isComplement'_top_bot : IsComplement' (⊤ : Subgroup G) ⊥ :=
  isComplement_top_singleton
#align subgroup.is_complement'_top_bot Subgroup.isComplement'_top_bot
#align add_subgroup.is_complement'_top_bot AddSubgroup.isComplement'_top_bot

@[to_additive]
theorem isComplement'_bot_top : IsComplement' (⊥ : Subgroup G) ⊤ :=
  isComplement_singleton_top
#align subgroup.is_complement'_bot_top Subgroup.isComplement'_bot_top
#align add_subgroup.is_complement'_bot_top AddSubgroup.isComplement'_bot_top

@[simp, to_additive]
theorem isComplement'_bot_left : IsComplement' ⊥ H ↔ H = ⊤ :=
  isComplement_singleton_left.trans coe_eq_univ
#align subgroup.is_complement'_bot_left Subgroup.isComplement'_bot_left
#align add_subgroup.is_complement'_bot_left AddSubgroup.isComplement'_bot_left

@[simp, to_additive]
theorem isComplement'_bot_right : IsComplement' H ⊥ ↔ H = ⊤ :=
  isComplement_singleton_right.trans coe_eq_univ
#align subgroup.is_complement'_bot_right Subgroup.isComplement'_bot_right
#align add_subgroup.is_complement'_bot_right AddSubgroup.isComplement'_bot_right

@[simp, to_additive]
theorem isComplement'_top_left : IsComplement' ⊤ H ↔ H = ⊥ :=
  isComplement_top_left.trans coe_eq_singleton
#align subgroup.is_complement'_top_left Subgroup.isComplement'_top_left
#align add_subgroup.is_complement'_top_left AddSubgroup.isComplement'_top_left

@[simp, to_additive]
theorem isComplement'_top_right : IsComplement' H ⊤ ↔ H = ⊥ :=
  isComplement_top_right.trans coe_eq_singleton
#align subgroup.is_complement'_top_right Subgroup.isComplement'_top_right
#align add_subgroup.is_complement'_top_right AddSubgroup.isComplement'_top_right

@[to_additive]
theorem mem_leftTransversals_iff_existsUnique_inv_mul_mem :
    S ∈ leftTransversals T ↔ ∀ g : G, ∃! s : S, (s : G)⁻¹ * g ∈ T :=
  by
  rw [left_transversals, Set.mem_setOf_eq, is_complement_iff_exists_unique]
  refine' ⟨fun h g => _, fun h g => _⟩
  · obtain ⟨x, h1, h2⟩ := h g
    exact
      ⟨x.1, (congr_arg (· ∈ T) (eq_inv_mul_of_mul_eq h1)).mp x.2.2, fun y hy =>
        (prod.ext_iff.mp (h2 ⟨y, y⁻¹ * g, hy⟩ (mul_inv_cancel_left y g))).1⟩
  · obtain ⟨x, h1, h2⟩ := h g
    refine' ⟨⟨x, x⁻¹ * g, h1⟩, mul_inv_cancel_left x g, fun y hy => _⟩
    have := h2 y.1 ((congr_arg (· ∈ T) (eq_inv_mul_of_mul_eq hy)).mp y.2.2)
    exact Prod.ext this (Subtype.ext (eq_inv_mul_of_mul_eq ((congr_arg _ this).mp hy)))
#align subgroup.mem_left_transversals_iff_exists_unique_inv_mul_mem Subgroup.mem_leftTransversals_iff_existsUnique_inv_mul_mem
#align add_subgroup.mem_left_transversals_iff_exists_unique_neg_add_mem AddSubgroup.mem_leftTransversals_iff_existsUnique_neg_add_mem

@[to_additive]
theorem mem_rightTransversals_iff_existsUnique_mul_inv_mem :
    S ∈ rightTransversals T ↔ ∀ g : G, ∃! s : S, g * (s : G)⁻¹ ∈ T :=
  by
  rw [right_transversals, Set.mem_setOf_eq, is_complement_iff_exists_unique]
  refine' ⟨fun h g => _, fun h g => _⟩
  · obtain ⟨x, h1, h2⟩ := h g
    exact
      ⟨x.2, (congr_arg (· ∈ T) (eq_mul_inv_of_mul_eq h1)).mp x.1.2, fun y hy =>
        (prod.ext_iff.mp (h2 ⟨⟨g * y⁻¹, hy⟩, y⟩ (inv_mul_cancel_right g y))).2⟩
  · obtain ⟨x, h1, h2⟩ := h g
    refine' ⟨⟨⟨g * x⁻¹, h1⟩, x⟩, inv_mul_cancel_right g x, fun y hy => _⟩
    have := h2 y.2 ((congr_arg (· ∈ T) (eq_mul_inv_of_mul_eq hy)).mp y.1.2)
    exact Prod.ext (Subtype.ext (eq_mul_inv_of_mul_eq ((congr_arg _ this).mp hy))) this
#align subgroup.mem_right_transversals_iff_exists_unique_mul_inv_mem Subgroup.mem_rightTransversals_iff_existsUnique_mul_inv_mem
#align add_subgroup.mem_right_transversals_iff_exists_unique_add_neg_mem AddSubgroup.mem_rightTransversals_iff_existsUnique_add_neg_mem

@[to_additive]
theorem mem_leftTransversals_iff_existsUnique_quotient_mk''_eq :
    S ∈ leftTransversals (H : Set G) ↔
      ∀ q : Quotient (QuotientGroup.leftRel H), ∃! s : S, Quotient.mk'' s.1 = q :=
  by
  simp_rw [mem_left_transversals_iff_exists_unique_inv_mul_mem, SetLike.mem_coe, ←
    QuotientGroup.eq']
  exact ⟨fun h q => Quotient.inductionOn' q h, fun h g => h (Quotient.mk'' g)⟩
#align subgroup.mem_left_transversals_iff_exists_unique_quotient_mk'_eq Subgroup.mem_leftTransversals_iff_existsUnique_quotient_mk''_eq
#align add_subgroup.mem_left_transversals_iff_exists_unique_quotient_mk'_eq AddSubgroup.mem_leftTransversals_iff_existsUnique_quotient_mk''_eq

@[to_additive]
theorem mem_rightTransversals_iff_existsUnique_quotient_mk''_eq :
    S ∈ rightTransversals (H : Set G) ↔
      ∀ q : Quotient (QuotientGroup.rightRel H), ∃! s : S, Quotient.mk'' s.1 = q :=
  by
  simp_rw [mem_right_transversals_iff_exists_unique_mul_inv_mem, SetLike.mem_coe, ←
    QuotientGroup.rightRel_apply, ← Quotient.eq'']
  exact ⟨fun h q => Quotient.inductionOn' q h, fun h g => h (Quotient.mk'' g)⟩
#align subgroup.mem_right_transversals_iff_exists_unique_quotient_mk'_eq Subgroup.mem_rightTransversals_iff_existsUnique_quotient_mk''_eq
#align add_subgroup.mem_right_transversals_iff_exists_unique_quotient_mk'_eq AddSubgroup.mem_rightTransversals_iff_existsUnique_quotient_mk''_eq

@[to_additive]
theorem mem_leftTransversals_iff_bijective :
    S ∈ leftTransversals (H : Set G) ↔
      Function.Bijective (S.restrict (Quotient.mk'' : G → Quotient (QuotientGroup.leftRel H))) :=
  mem_leftTransversals_iff_existsUnique_quotient_mk''_eq.trans
    (Function.bijective_iff_existsUnique (S.restrict Quotient.mk'')).symm
#align subgroup.mem_left_transversals_iff_bijective Subgroup.mem_leftTransversals_iff_bijective
#align add_subgroup.mem_left_transversals_iff_bijective AddSubgroup.mem_leftTransversals_iff_bijective

@[to_additive]
theorem mem_rightTransversals_iff_bijective :
    S ∈ rightTransversals (H : Set G) ↔
      Function.Bijective (S.restrict (Quotient.mk'' : G → Quotient (QuotientGroup.rightRel H))) :=
  mem_rightTransversals_iff_existsUnique_quotient_mk''_eq.trans
    (Function.bijective_iff_existsUnique (S.restrict Quotient.mk'')).symm
#align subgroup.mem_right_transversals_iff_bijective Subgroup.mem_rightTransversals_iff_bijective
#align add_subgroup.mem_right_transversals_iff_bijective AddSubgroup.mem_rightTransversals_iff_bijective

@[to_additive]
theorem card_left_transversal (h : S ∈ leftTransversals (H : Set G)) : Nat.card S = H.index :=
  Nat.card_congr <| Equiv.ofBijective _ <| mem_leftTransversals_iff_bijective.mp h
#align subgroup.card_left_transversal Subgroup.card_left_transversal
#align add_subgroup.card_left_transversal AddSubgroup.card_left_transversal

@[to_additive]
theorem card_right_transversal (h : S ∈ rightTransversals (H : Set G)) : Nat.card S = H.index :=
  Nat.card_congr <|
    (Equiv.ofBijective _ <| mem_rightTransversals_iff_bijective.mp h).trans <|
      QuotientGroup.quotientRightRelEquivQuotientLeftRel H
#align subgroup.card_right_transversal Subgroup.card_right_transversal
#align add_subgroup.card_right_transversal AddSubgroup.card_right_transversal

@[to_additive]
theorem range_mem_leftTransversals {f : G ⧸ H → G} (hf : ∀ q, ↑(f q) = q) :
    Set.range f ∈ leftTransversals (H : Set G) :=
  mem_leftTransversals_iff_bijective.mpr
    ⟨by
      rintro ⟨-, q₁, rfl⟩ ⟨-, q₂, rfl⟩ h <;>
        exact congr_arg _ (((hf q₁).symm.trans h).trans (hf q₂)),
      fun q => ⟨⟨f q, q, rfl⟩, hf q⟩⟩
#align subgroup.range_mem_left_transversals Subgroup.range_mem_leftTransversals
#align add_subgroup.range_mem_left_transversals AddSubgroup.range_mem_leftTransversals

@[to_additive]
theorem range_mem_rightTransversals {f : Quotient (QuotientGroup.rightRel H) → G}
    (hf : ∀ q, Quotient.mk'' (f q) = q) : Set.range f ∈ rightTransversals (H : Set G) :=
  mem_rightTransversals_iff_bijective.mpr
    ⟨by
      rintro ⟨-, q₁, rfl⟩ ⟨-, q₂, rfl⟩ h <;>
        exact congr_arg _ (((hf q₁).symm.trans h).trans (hf q₂)),
      fun q => ⟨⟨f q, q, rfl⟩, hf q⟩⟩
#align subgroup.range_mem_right_transversals Subgroup.range_mem_rightTransversals
#align add_subgroup.range_mem_right_transversals AddSubgroup.range_mem_rightTransversals

@[to_additive]
theorem exists_left_transversal (g : G) : ∃ S ∈ leftTransversals (H : Set G), g ∈ S := by
  classical
    refine'
      ⟨Set.range (Function.update Quotient.out' (↑g) g), range_mem_left_transversals fun q => _, g,
        Function.update_same g g Quotient.out'⟩
    by_cases hq : q = g
    · exact hq.symm ▸ congr_arg _ (Function.update_same g g Quotient.out')
    · exact Eq.trans (congr_arg _ (Function.update_noteq hq g Quotient.out')) q.out_eq'
#align subgroup.exists_left_transversal Subgroup.exists_left_transversal
#align add_subgroup.exists_left_transversal AddSubgroup.exists_left_transversal

@[to_additive]
theorem exists_right_transversal (g : G) : ∃ S ∈ rightTransversals (H : Set G), g ∈ S := by
  classical
    refine'
      ⟨Set.range (Function.update Quotient.out' _ g), range_mem_right_transversals fun q => _,
        Quotient.mk'' g, Function.update_same (Quotient.mk'' g) g Quotient.out'⟩
    by_cases hq : q = Quotient.mk'' g
    · exact hq.symm ▸ congr_arg _ (Function.update_same (Quotient.mk'' g) g Quotient.out')
    · exact Eq.trans (congr_arg _ (Function.update_noteq hq g Quotient.out')) q.out_eq'
#align subgroup.exists_right_transversal Subgroup.exists_right_transversal
#align add_subgroup.exists_right_transversal AddSubgroup.exists_right_transversal

namespace MemLeftTransversals

/-- A left transversal is in bijection with left cosets. -/
@[to_additive "A left transversal is in bijection with left cosets."]
noncomputable def toEquiv (hS : S ∈ Subgroup.leftTransversals (H : Set G)) : G ⧸ H ≃ S :=
  (Equiv.ofBijective _ (Subgroup.mem_leftTransversals_iff_bijective.mp hS)).symm
#align subgroup.mem_left_transversals.to_equiv Subgroup.MemLeftTransversals.toEquiv
#align add_subgroup.mem_left_transversals.to_equiv AddSubgroup.MemLeftTransversals.toEquiv

@[to_additive]
theorem mk''_toEquiv (hS : S ∈ Subgroup.leftTransversals (H : Set G)) (q : G ⧸ H) :
    Quotient.mk'' (toEquiv hS q : G) = q :=
  (toEquiv hS).symm_apply_apply q
#align subgroup.mem_left_transversals.mk'_to_equiv Subgroup.MemLeftTransversals.mk''_toEquiv
#align add_subgroup.mem_left_transversals.mk'_to_equiv AddSubgroup.MemLeftTransversals.mk'_to_equiv

@[to_additive]
theorem toEquiv_apply {f : G ⧸ H → G} (hf : ∀ q, (f q : G ⧸ H) = q) (q : G ⧸ H) :
    (toEquiv (range_mem_leftTransversals hf) q : G) = f q :=
  by
  refine' (subtype.ext_iff.mp _).trans (Subtype.coe_mk (f q) ⟨q, rfl⟩)
  exact (to_equiv (range_mem_left_transversals hf)).apply_eq_iff_eq_symm_apply.mpr (hf q).symm
#align subgroup.mem_left_transversals.to_equiv_apply Subgroup.MemLeftTransversals.toEquiv_apply
#align add_subgroup.mem_left_transversals.to_equiv_apply AddSubgroup.MemLeftTransversals.to_equiv_apply

/-- A left transversal can be viewed as a function mapping each element of the group
  to the chosen representative from that left coset. -/
@[to_additive
      "A left transversal can be viewed as a function mapping each element of the group\n  to the chosen representative from that left coset."]
noncomputable def toFun (hS : S ∈ Subgroup.leftTransversals (H : Set G)) : G → S :=
  toEquiv hS ∘ Quotient.mk''
#align subgroup.mem_left_transversals.to_fun Subgroup.MemLeftTransversals.toFun
#align add_subgroup.mem_left_transversals.to_fun AddSubgroup.MemLeftTransversals.toFun

@[to_additive]
theorem inv_toFun_mul_mem (hS : S ∈ Subgroup.leftTransversals (H : Set G)) (g : G) :
    (toFun hS g : G)⁻¹ * g ∈ H :=
  QuotientGroup.leftRel_apply.mp <| Quotient.exact' <| mk''_toEquiv _ _
#align subgroup.mem_left_transversals.inv_to_fun_mul_mem Subgroup.MemLeftTransversals.inv_toFun_mul_mem
#align add_subgroup.mem_left_transversals.neg_to_fun_add_mem AddSubgroup.MemLeftTransversals.neg_toFun_add_mem

@[to_additive]
theorem inv_mul_toFun_mem (hS : S ∈ Subgroup.leftTransversals (H : Set G)) (g : G) :
    g⁻¹ * toFun hS g ∈ H :=
  (congr_arg (· ∈ H) (by rw [mul_inv_rev, inv_inv])).mp (H.inv_mem (inv_toFun_mul_mem hS g))
#align subgroup.mem_left_transversals.inv_mul_to_fun_mem Subgroup.MemLeftTransversals.inv_mul_toFun_mem
#align add_subgroup.mem_left_transversals.neg_add_to_fun_mem AddSubgroup.MemLeftTransversals.neg_add_toFun_mem

end MemLeftTransversals

namespace MemRightTransversals

/-- A right transversal is in bijection with right cosets. -/
@[to_additive "A right transversal is in bijection with right cosets."]
noncomputable def toEquiv (hS : S ∈ Subgroup.rightTransversals (H : Set G)) :
    Quotient (QuotientGroup.rightRel H) ≃ S :=
  (Equiv.ofBijective _ (Subgroup.mem_rightTransversals_iff_bijective.mp hS)).symm
#align subgroup.mem_right_transversals.to_equiv Subgroup.MemRightTransversals.toEquiv
#align add_subgroup.mem_right_transversals.to_equiv AddSubgroup.MemRightTransversals.toEquiv

@[to_additive]
theorem mk''_toEquiv (hS : S ∈ Subgroup.rightTransversals (H : Set G))
    (q : Quotient (QuotientGroup.rightRel H)) : Quotient.mk'' (toEquiv hS q : G) = q :=
  (toEquiv hS).symm_apply_apply q
#align subgroup.mem_right_transversals.mk'_to_equiv Subgroup.MemRightTransversals.mk''_toEquiv
#align add_subgroup.mem_right_transversals.mk'_to_equiv AddSubgroup.MemRightTransversals.mk'_to_equiv

@[to_additive]
theorem toEquiv_apply {f : Quotient (QuotientGroup.rightRel H) → G}
    (hf : ∀ q, Quotient.mk'' (f q) = q) (q : Quotient (QuotientGroup.rightRel H)) :
    (toEquiv (range_mem_rightTransversals hf) q : G) = f q :=
  by
  refine' (subtype.ext_iff.mp _).trans (Subtype.coe_mk (f q) ⟨q, rfl⟩)
  exact (to_equiv (range_mem_right_transversals hf)).apply_eq_iff_eq_symm_apply.mpr (hf q).symm
#align subgroup.mem_right_transversals.to_equiv_apply Subgroup.MemRightTransversals.toEquiv_apply
#align add_subgroup.mem_right_transversals.to_equiv_apply AddSubgroup.MemRightTransversals.to_equiv_apply

/-- A right transversal can be viewed as a function mapping each element of the group
  to the chosen representative from that right coset. -/
@[to_additive
      "A right transversal can be viewed as a function mapping each element of the group\n  to the chosen representative from that right coset."]
noncomputable def toFun (hS : S ∈ Subgroup.rightTransversals (H : Set G)) : G → S :=
  toEquiv hS ∘ Quotient.mk''
#align subgroup.mem_right_transversals.to_fun Subgroup.MemRightTransversals.toFun
#align add_subgroup.mem_right_transversals.to_fun AddSubgroup.MemRightTransversals.toFun

@[to_additive]
theorem mul_inv_toFun_mem (hS : S ∈ Subgroup.rightTransversals (H : Set G)) (g : G) :
    g * (toFun hS g : G)⁻¹ ∈ H :=
  QuotientGroup.rightRel_apply.mp <| Quotient.exact' <| mk''_toEquiv _ _
#align subgroup.mem_right_transversals.mul_inv_to_fun_mem Subgroup.MemRightTransversals.mul_inv_toFun_mem
#align add_subgroup.mem_right_transversals.add_neg_to_fun_mem AddSubgroup.MemRightTransversals.add_neg_toFun_mem

@[to_additive]
theorem toFun_mul_inv_mem (hS : S ∈ Subgroup.rightTransversals (H : Set G)) (g : G) :
    (toFun hS g : G) * g⁻¹ ∈ H :=
  (congr_arg (· ∈ H) (by rw [mul_inv_rev, inv_inv])).mp (H.inv_mem (mul_inv_toFun_mem hS g))
#align subgroup.mem_right_transversals.to_fun_mul_inv_mem Subgroup.MemRightTransversals.toFun_mul_inv_mem
#align add_subgroup.mem_right_transversals.to_fun_add_neg_mem AddSubgroup.MemRightTransversals.toFun_add_neg_mem

end MemRightTransversals

section Action

open Pointwise

open MulAction MemLeftTransversals

variable {F : Type _} [Group F] [MulAction F G] [QuotientAction F H]

@[to_additive]
instance : MulAction F (leftTransversals (H : Set G))
    where
  smul f T :=
    ⟨f • T, by
      refine' mem_left_transversals_iff_exists_unique_inv_mul_mem.mpr fun g => _
      obtain ⟨t, ht1, ht2⟩ := mem_left_transversals_iff_exists_unique_inv_mul_mem.mp T.2 (f⁻¹ • g)
      refine' ⟨⟨f • t, Set.smul_mem_smul_set t.2⟩, _, _⟩
      · exact (congr_arg _ (smul_inv_smul f g)).mp (quotient_action.inv_mul_mem f ht1)
      · rintro ⟨-, t', ht', rfl⟩ h
        replace h := quotient_action.inv_mul_mem f⁻¹ h
        simp only [Subtype.ext_iff, Subtype.coe_mk, smul_left_cancel_iff, inv_smul_smul] at h⊢
        exact subtype.ext_iff.mp (ht2 ⟨t', ht'⟩ h)⟩
  one_smul T := Subtype.ext (one_smul F T)
  mul_smul f₁ f₂ T := Subtype.ext (mul_smul f₁ f₂ T)

@[to_additive]
theorem smul_toFun (f : F) (T : leftTransversals (H : Set G)) (g : G) :
    (f • toFun T.2 g : G) = toFun (f • T).2 (f • g) :=
  Subtype.ext_iff.mp <|
    @ExistsUnique.unique (↥(f • T)) (fun s => (↑s)⁻¹ * f • g ∈ H)
      (mem_leftTransversals_iff_existsUnique_inv_mul_mem.mp (f • T).2 (f • g))
      ⟨f • toFun T.2 g, Set.smul_mem_smul_set (Subtype.coe_prop _)⟩ (toFun (f • T).2 (f • g))
      (QuotientAction.inv_mul_mem f (inv_toFun_mul_mem T.2 g)) (inv_toFun_mul_mem (f • T).2 (f • g))
#align subgroup.smul_to_fun Subgroup.smul_toFun
#align add_subgroup.vadd_to_fun AddSubgroup.vadd_toFun

@[to_additive]
theorem smul_toEquiv (f : F) (T : leftTransversals (H : Set G)) (q : G ⧸ H) :
    f • (toEquiv T.2 q : G) = toEquiv (f • T).2 (f • q) :=
  Quotient.inductionOn' q fun g => smul_toFun f T g
#align subgroup.smul_to_equiv Subgroup.smul_toEquiv
#align add_subgroup.vadd_to_equiv AddSubgroup.vadd_to_equiv

@[to_additive]
theorem smul_apply_eq_smul_apply_inv_smul (f : F) (T : leftTransversals (H : Set G)) (q : G ⧸ H) :
    (toEquiv (f • T).2 q : G) = f • (toEquiv T.2 (f⁻¹ • q) : G) := by
  rw [smul_to_equiv, smul_inv_smul]
#align subgroup.smul_apply_eq_smul_apply_inv_smul Subgroup.smul_apply_eq_smul_apply_inv_smul
#align add_subgroup.vadd_apply_eq_vadd_apply_neg_vadd AddSubgroup.vadd_apply_eq_vadd_apply_neg_vadd

end Action

@[to_additive]
instance : Inhabited (leftTransversals (H : Set G)) :=
  ⟨⟨Set.range Quotient.out', range_mem_leftTransversals Quotient.out_eq'⟩⟩

@[to_additive]
instance : Inhabited (rightTransversals (H : Set G)) :=
  ⟨⟨Set.range Quotient.out', range_mem_rightTransversals Quotient.out_eq'⟩⟩

theorem IsComplement'.isCompl (h : IsComplement' H K) : IsCompl H K :=
  by
  refine'
    ⟨disjoint_iff_inf_le.mpr fun g ⟨p, q⟩ =>
        let x : H × K := ⟨⟨g, p⟩, 1⟩
        let y : H × K := ⟨1, g, q⟩
        subtype.ext_iff.mp
          (prod.ext_iff.mp (show x = y from h.1 ((mul_one g).trans (one_mul g).symm))).1,
      codisjoint_iff_le_sup.mpr fun g _ => _⟩
  obtain ⟨⟨h, k⟩, rfl⟩ := h.2 g
  exact Subgroup.mul_mem_sup h.2 k.2
#align subgroup.is_complement'.is_compl Subgroup.IsComplement'.isCompl

theorem IsComplement'.sup_eq_top (h : IsComplement' H K) : H ⊔ K = ⊤ :=
  h.IsCompl.sup_eq_top
#align subgroup.is_complement'.sup_eq_top Subgroup.IsComplement'.sup_eq_top

theorem IsComplement'.disjoint (h : IsComplement' H K) : Disjoint H K :=
  h.IsCompl.Disjoint
#align subgroup.is_complement'.disjoint Subgroup.IsComplement'.disjoint

theorem IsComplement'.index_eq_card (h : IsComplement' H K) : K.index = Nat.card H :=
  (card_left_transversal h).symm
#align subgroup.is_complement'.index_eq_card Subgroup.IsComplement'.index_eq_card

theorem IsComplement.card_mul [Fintype G] [Fintype S] [Fintype T] (h : IsComplement S T) :
    Fintype.card S * Fintype.card T = Fintype.card G :=
  (Fintype.card_prod _ _).symm.trans (Fintype.card_of_bijective h)
#align subgroup.is_complement.card_mul Subgroup.IsComplement.card_mul

theorem IsComplement'.card_mul [Fintype G] [Fintype H] [Fintype K] (h : IsComplement' H K) :
    Fintype.card H * Fintype.card K = Fintype.card G :=
  h.card_mul
#align subgroup.is_complement'.card_mul Subgroup.IsComplement'.card_mul

theorem isComplement'_of_disjoint_and_mul_eq_univ (h1 : Disjoint H K)
    (h2 : ↑H * ↑K = (Set.univ : Set G)) : IsComplement' H K :=
  by
  refine' ⟨mul_injective_of_disjoint h1, fun g => _⟩
  obtain ⟨h, k, hh, hk, hg⟩ := set.eq_univ_iff_forall.mp h2 g
  exact ⟨(⟨h, hh⟩, ⟨k, hk⟩), hg⟩
#align subgroup.is_complement'_of_disjoint_and_mul_eq_univ Subgroup.isComplement'_of_disjoint_and_mul_eq_univ

theorem isComplement'_of_card_mul_and_disjoint [Fintype G] [Fintype H] [Fintype K]
    (h1 : Fintype.card H * Fintype.card K = Fintype.card G) (h2 : Disjoint H K) :
    IsComplement' H K :=
  (Fintype.bijective_iff_injective_and_card _).mpr
    ⟨mul_injective_of_disjoint h2, (Fintype.card_prod H K).trans h1⟩
#align subgroup.is_complement'_of_card_mul_and_disjoint Subgroup.isComplement'_of_card_mul_and_disjoint

theorem isComplement'_iff_card_mul_and_disjoint [Fintype G] [Fintype H] [Fintype K] :
    IsComplement' H K ↔ Fintype.card H * Fintype.card K = Fintype.card G ∧ Disjoint H K :=
  ⟨fun h => ⟨h.card_mul, h.Disjoint⟩, fun h => isComplement'_of_card_mul_and_disjoint h.1 h.2⟩
#align subgroup.is_complement'_iff_card_mul_and_disjoint Subgroup.isComplement'_iff_card_mul_and_disjoint

theorem isComplement'_of_coprime [Fintype G] [Fintype H] [Fintype K]
    (h1 : Fintype.card H * Fintype.card K = Fintype.card G)
    (h2 : Nat.coprime (Fintype.card H) (Fintype.card K)) : IsComplement' H K :=
  isComplement'_of_card_mul_and_disjoint h1 (disjoint_iff.mpr (inf_eq_bot_of_coprime h2))
#align subgroup.is_complement'_of_coprime Subgroup.isComplement'_of_coprime

theorem isComplement'_stabilizer {α : Type _} [MulAction G α] (a : α)
    (h1 : ∀ h : H, h • a = a → h = 1) (h2 : ∀ g : G, ∃ h : H, h • g • a = a) :
    IsComplement' H (MulAction.stabilizer G a) :=
  by
  refine' is_complement_iff_exists_unique.mpr fun g => _
  obtain ⟨h, hh⟩ := h2 g
  have hh' : (↑h * g) • a = a := by rwa [mul_smul]
  refine' ⟨⟨h⁻¹, h * g, hh'⟩, inv_mul_cancel_left h g, _⟩
  rintro ⟨h', g, hg : g • a = a⟩ rfl
  specialize h1 (h * h') (by rwa [mul_smul, smul_def h', ← hg, ← mul_smul, hg])
  refine' Prod.ext (eq_inv_of_mul_eq_one_right h1) (Subtype.ext _)
  rwa [Subtype.ext_iff, coe_one, coe_mul, ← self_eq_mul_left, mul_assoc (↑h) (↑h') g] at h1
#align subgroup.is_complement'_stabilizer Subgroup.isComplement'_stabilizer

end Subgroup

namespace Subgroup

open Equiv Function MemLeftTransversals MulAction MulAction.quotient ZMod

universe u

variable {G : Type u} [Group G] (H : Subgroup G) (g : G)

/-- Partition `G ⧸ H` into orbits of the action of `g : G`. -/
noncomputable def quotientEquivSigmaZmod :
    G ⧸ H ≃ Σq : orbitRel.Quotient (zpowers g) (G ⧸ H), ZMod (minimalPeriod ((· • ·) g) q.out') :=
  (selfEquivSigmaOrbits (zpowers g) (G ⧸ H)).trans
    (sigmaCongrRight fun q => orbitZpowersEquiv g q.out')
#align subgroup.quotient_equiv_sigma_zmod Subgroup.quotientEquivSigmaZmod

theorem quotientEquivSigmaZmod_symm_apply (q : orbitRel.Quotient (zpowers g) (G ⧸ H))
    (k : ZMod (minimalPeriod ((· • ·) g) q.out')) :
    (quotientEquivSigmaZmod H g).symm ⟨q, k⟩ = g ^ (k : ℤ) • q.out' :=
  rfl
#align subgroup.quotient_equiv_sigma_zmod_symm_apply Subgroup.quotientEquivSigmaZmod_symm_apply

theorem quotientEquivSigmaZmod_apply (q : orbitRel.Quotient (zpowers g) (G ⧸ H)) (k : ℤ) :
    quotientEquivSigmaZmod H g (g ^ k • q.out') = ⟨q, k⟩ := by
  rw [apply_eq_iff_eq_symm_apply, quotient_equiv_sigma_zmod_symm_apply, ZMod.coe_int_cast,
    zpow_smul_mod_minimal_period]
#align subgroup.quotient_equiv_sigma_zmod_apply Subgroup.quotientEquivSigmaZmod_apply

/-- The transfer transversal as a function. Given a `⟨g⟩`-orbit `q₀, g • q₀, ..., g ^ (m - 1) • q₀`
  in `G ⧸ H`, an element `g ^ k • q₀` is mapped to `g ^ k • g₀` for a fixed choice of
  representative `g₀` of `q₀`. -/
noncomputable def transferFunction : G ⧸ H → G := fun q =>
  g ^ ((quotientEquivSigmaZmod H g q).2 : ℤ) * (quotientEquivSigmaZmod H g q).1.out'.out'
#align subgroup.transfer_function Subgroup.transferFunction

theorem transferFunction_apply (q : G ⧸ H) :
    transferFunction H g q =
      g ^ ((quotientEquivSigmaZmod H g q).2 : ℤ) * (quotientEquivSigmaZmod H g q).1.out'.out' :=
  rfl
#align subgroup.transfer_function_apply Subgroup.transferFunction_apply

theorem coe_transferFunction (q : G ⧸ H) : ↑(transferFunction H g q) = q := by
  rw [transfer_function_apply, ← smul_eq_mul, coe_smul_out', ← quotient_equiv_sigma_zmod_symm_apply,
    Sigma.eta, symm_apply_apply]
#align subgroup.coe_transfer_function Subgroup.coe_transferFunction

/-- The transfer transversal as a set. Contains elements of the form `g ^ k • g₀` for fixed choices
  of representatives `g₀` of fixed choices of representatives `q₀` of `⟨g⟩`-orbits in `G ⧸ H`. -/
def transferSet : Set G :=
  Set.range (transferFunction H g)
#align subgroup.transfer_set Subgroup.transferSet

theorem mem_transferSet (q : G ⧸ H) : transferFunction H g q ∈ transferSet H g :=
  ⟨q, rfl⟩
#align subgroup.mem_transfer_set Subgroup.mem_transferSet

/-- The transfer transversal. Contains elements of the form `g ^ k • g₀` for fixed choices
  of representatives `g₀` of fixed choices of representatives `q₀` of `⟨g⟩`-orbits in `G ⧸ H`. -/
def transferTransversal : leftTransversals (H : Set G) :=
  ⟨transferSet H g, range_mem_leftTransversals (coe_transferFunction H g)⟩
#align subgroup.transfer_transversal Subgroup.transferTransversal

theorem transferTransversal_apply (q : G ⧸ H) :
    ↑(toEquiv (transferTransversal H g).2 q) = transferFunction H g q :=
  toEquiv_apply (coe_transferFunction H g) q
#align subgroup.transfer_transversal_apply Subgroup.transferTransversal_apply

theorem transferTransversal_apply' (q : orbitRel.Quotient (zpowers g) (G ⧸ H))
    (k : ZMod (minimalPeriod ((· • ·) g) q.out')) :
    ↑(toEquiv (transferTransversal H g).2 (g ^ (k : ℤ) • q.out')) = g ^ (k : ℤ) * q.out'.out' := by
  rw [transfer_transversal_apply, transfer_function_apply, ← quotient_equiv_sigma_zmod_symm_apply,
    apply_symm_apply]
#align subgroup.transfer_transversal_apply' Subgroup.transferTransversal_apply'

theorem transferTransversal_apply'' (q : orbitRel.Quotient (zpowers g) (G ⧸ H))
    (k : ZMod (minimalPeriod ((· • ·) g) q.out')) :
    ↑(toEquiv (g • transferTransversal H g).2 (g ^ (k : ℤ) • q.out')) =
      if k = 0 then g ^ minimalPeriod ((· • ·) g) q.out' * q.out'.out'
      else g ^ (k : ℤ) * q.out'.out' :=
  by
  rw [smul_apply_eq_smul_apply_inv_smul, transfer_transversal_apply, transfer_function_apply, ←
    mul_smul, ← zpow_neg_one, ← zpow_add, quotient_equiv_sigma_zmod_apply, smul_eq_mul, ← mul_assoc,
    ← zpow_one_add, Int.cast_add, Int.cast_neg, Int.cast_one, int_cast_cast, cast_id', id.def, ←
    sub_eq_neg_add, cast_sub_one, add_sub_cancel'_right]
  by_cases hk : k = 0
  · rw [if_pos hk, if_pos hk, zpow_ofNat]
  · rw [if_neg hk, if_neg hk]
#align subgroup.transfer_transversal_apply'' Subgroup.transferTransversal_apply''

end Subgroup


import Mathlib.Algebra.Ring.Basic
import Mathlib.Tactic.NormNum
import Mathlib.Tactic.NormCast

/-!
# Dyadic rationals

In this file, we define dyadic rationals
-/

structure Dyadic where
  mantissa : Int
  exponent : Int
  coprime : (mantissa = 0 ∧ exponent = 0) ∨ mantissa.natAbs.coprime 2
  deriving DecidableEq

instance : Inhabited Dyadic := ⟨⟨1, 0, Or.inr (by rfl)⟩⟩

lemma Dyadic.eq_iff (d₁ d₂ : Dyadic) :
  d₁ = d₂ ↔ d₁.mantissa = d₂.mantissa ∧ d₁.exponent = d₂.exponent :=
⟨λ h => ⟨h ▸ rfl, h ▸ rfl⟩, λ ⟨h₁, h₂⟩ => by
  cases d₁
  cases d₂
  simp at * -- non-terminal simp
  apply And.intro
  · exact h₁
  · exact h₂⟩

instance : ToString Dyadic where
  toString a := s!"{a.mantissa} * 2^{a.exponent}"

-- instance : Repr Dyadic where
--   reprPrec a _ := s!"⟨{a.mantissa}, {a.exponent}⟩"

section Rat

def Rat.pow (a : Rat) : Nat → Rat
  | 0 => 1
  | n+1 => a.pow n * a

instance : Pow Rat Nat := ⟨Rat.pow⟩

instance : Pow Rat Int where
  pow a | Int.ofNat n => a ^ n
        | Int.negSucc n => (1 / a) ^ (n + 1)

@[simp]
lemma Rat.ofInt_zero : Rat.ofInt 0 = 0 := rfl

@[simp]
lemma Rat.zero_mul (a : Rat) : 0 * a = 0 := sorry

def Dyadic.toRat (d : Dyadic) : Rat :=
  d.mantissa * (2 : Rat) ^ d.exponent

end Rat

private lemma Nat.two_dvd_or_coprime_two (n : ℕ) : 2 ∣ n ∨ n.coprime 2 :=
  let m := gcd 2 n
  have hmpos : 0 < m := gcd_pos_of_pos_left _ <| by decide
  have hm2 : m ≤ 2 := gcd_le_left _ <| by decide
  have hm : m = gcd 2 n := rfl
  match m with
  | 0 => absurd hmpos <| not_lt.2 <| le_refl _
  | 1 => Or.inr <| coprime_comm.1 hm.symm
  | 2 => Or.inl <| hm.symm ▸ gcd_dvd_right 2 n
  | (k + 3) =>
    have : 3 ≤ k + 3 := le_add_left _ _
    have : 3 ≤ 2 := le_trans this hm2
    False.elim <| by norm_num at this; exact this

def Dyadic.mk' (m e : Int) : Dyadic :=
  if hm : m = 0 then
    ⟨0, 0, by decide⟩
  else if hm2 : 2 ∣ m then
    have : m.natAbs / (2 : Int).natAbs < m.natAbs :=
      Nat.div_lt_self (Int.natAbs_pos.2 hm) (by decide)
    Dyadic.mk' (m / 2) (e + 1)
  else
    ⟨m, e, Or.inr <| Nat.two_dvd_or_coprime_two m.natAbs |>.resolve_left <| by
      rw [←Int.dvd_natAbs, show (2 : Int) = (2 : Nat) by norm_num] at hm2
      intro ⟨x, hx⟩
      rw [hx] at hm2
      exact hm2 ⟨x, by norm_cast⟩
    ⟩
  termination_by _ => m.natAbs

lemma Dyadic.to_rat_mk' (m e : Int) :
  Dyadic.toRat (Dyadic.mk' m e) = m * (2 : Rat) ^ e := by
  rw [Dyadic.mk', Dyadic.toRat]
  by_cases hm : m = 0
  · simp [hm]
  admit

def Dyadic.add (d₁ d₂ : Dyadic) : Dyadic :=
  Dyadic.mk'
    (d₁.mantissa * 2 ^ (d₁.exponent - d₂.exponent).toNat +
      d₂.mantissa * 2 ^ (d₂.exponent - d₁.exponent).toNat)
    (min d₁.exponent d₂.exponent)

instance : Add Dyadic := ⟨Dyadic.add⟩

private lemma Dyadic.add_eq (d₁ d₂ : Dyadic) :
  d₁ + d₂ = Dyadic.mk'
    (d₁.mantissa * 2 ^ (d₁.exponent - d₂.exponent).toNat +
      d₂.mantissa * 2 ^ (d₂.exponent - d₁.exponent).toNat)
    (min d₁.exponent d₂.exponent) := rfl

def Dyadic.mul (d₁ d₂ : Dyadic) : Dyadic :=
  Dyadic.mk' (d₁.mantissa * d₂.mantissa) (d₁.exponent + d₂.exponent)

instance : Mul Dyadic := ⟨Dyadic.mul⟩

private lemma Dyadic.mul_eq (d₁ d₂ : Dyadic) :
  d₁ * d₂ = Dyadic.mk' (d₁.mantissa * d₂.mantissa) (d₁.exponent + d₂.exponent)
:= rfl

def Dyadic.neg (d : Dyadic) : Dyadic where
  mantissa := -d.mantissa
  exponent := d.exponent
  coprime := d.coprime.elim (λ ⟨h₁, h₂⟩ => Or.inl ⟨by simp [h₁], h₂⟩)
    (λ h => Or.inr <| by rwa [Int.natAbs_neg])

instance : Neg Dyadic := ⟨Dyadic.neg⟩

instance : Zero Dyadic := ⟨⟨0, 0, Or.inl <| by decide⟩⟩

instance : One Dyadic := ⟨⟨1, 0, Or.inr <| by rfl⟩⟩

instance : OfNat Dyadic n := ⟨Dyadic.mk' n 0⟩

def Dyadic.div₂ (d : Dyadic) (n : Nat) : Dyadic :=
  Dyadic.mk' d.mantissa (d.exponent - n)

#eval (3 : Dyadic).div₂ 4 + (4 : Dyadic)

example : (3 : Dyadic).div₂ 4 + (4 : Dyadic) = (67 : Dyadic).div₂ 4 := by rfl

def Dyadic.blt (d₁ d₂ : Dyadic) : Bool :=
  (d₁.mantissa * 2 ^ (d₁.exponent - d₂.exponent).natAbs) <
  (d₂.mantissa * 2 ^ (d₂.exponent - d₁.exponent).natAbs)

instance : LT Dyadic := ⟨(·.blt ·)⟩

instance (a b : Dyadic) : Decidable (a < b) :=
  inferInstanceAs (Decidable (_ = true))

def Dyadic.ble (d₁ d₂ : Dyadic) : Bool :=
  (d₁.mantissa * 2 ^ (d₁.exponent - d₂.exponent).natAbs) ≤
  (d₂.mantissa * 2 ^ (d₂.exponent - d₁.exponent).natAbs)

instance : LE Dyadic := ⟨(·.ble ·)⟩

instance (a b : Dyadic) : Decidable (a ≤ b) :=
  inferInstanceAs (Decidable (_ = true))
namespace Dyadic

@[simp]
lemma mantissa_zero : (0 : Dyadic).mantissa = 0 := rfl

lemma eq_zero_iff_mantissa_eq_zero (d : Dyadic) :
  d = 0 ↔ d.mantissa = 0 := by
  constructor
  · intro h
    rw [h]
    rfl
  · intro h
    rw [d.eq_iff]
    constructor
    · rw [h]
      rfl
    · cases d.coprime with
      | inl h₁ =>
        rw [h₁.2]
        rfl
      | inr h₁ =>
        rw [h, Nat.coprime_iff_gcd_eq_one, Int.natAbs_zero,
          Nat.gcd_zero_left] at h₁
        norm_num at h₁
        exact h₁.elim

lemma zero_mul (d : Dyadic) : 0 * d = 0 := by
  rw [Dyadic.mul_eq, mantissa_zero, Int.zero_mul]
  rfl

lemma mul_zero (d : Dyadic) : d * 0 = 0 := by
  rw [Dyadic.mul_eq, mantissa_zero, Int.mul_zero]
  rfl

lemma mul_comm (d₁ d₂ : Dyadic) : d₁ * d₂ = d₂ * d₁ := by
  rw [Dyadic.mul_eq, Dyadic.mul_eq, Int.mul_comm, Int.add_comm]

lemma left_distrib (c d₁ d₂ : Dyadic) : c * (d₁ + d₂) = c * d₁ + c * d₂ := sorry

instance : CommRing Dyadic where
  zero_mul := sorry
  mul_zero := sorry
  mul_comm := sorry
  left_distrib := sorry
  right_distrib := sorry
  mul_one := sorry
  one_mul := sorry
  mul_assoc := sorry
  add_comm := sorry
  add_assoc := sorry
  add_zero := sorry
  zero_add := sorry
  add_left_neg := sorry
  natCast := (Dyadic.mk' · 0)
  natCast_zero := sorry
  natCast_succ _ := sorry
  intCast := (Dyadic.mk' · 0)
  intCast_ofNat _ := sorry
  intCast_negSucc _ := sorry
  npow_zero' n := sorry
  npow_succ' n x := sorry
  nsmul_zero' := sorry
  nsmul_succ' n x := sorry
  sub_eq_add_neg := sorry
  gsmul_zero' := sorry
  gsmul_succ' n x := sorry
  gsmul_neg' n x := sorry

end Dyadic

-- instance : CommRing ℤ where
--   zero_mul := Int.zero_mul
--   mul_zero := Int.mul_zero
--   mul_comm := Int.mul_comm
--   left_distrib := Int.mul_add
--   right_distrib := Int.add_mul
--   mul_one := Int.mul_one
--   one_mul := Int.one_mul
--   npow (n x) := x ^ n
--   npow_zero' n := rfl
--   npow_succ' n x := by rw [Int.mul_comm]; rfl
--   mul_assoc := Int.mul_assoc
--   add_comm := Int.add_comm
--   add_assoc := Int.add_assoc
--   add_zero := Int.add_zero
--   zero_add := Int.zero_add
--   add_left_neg := Int.add_left_neg
--   nsmul := (·*·)
--   nsmul_zero' := Int.zero_mul
--   nsmul_succ' n x := by
--     show ofNat (Nat.succ n) * x = x + ofNat n * x
--     rw [Int.ofNat_succ, Int.add_mul, Int.add_comm, Int.one_mul]
--   sub_eq_add_neg a b := Int.sub_eq_add_neg
--   gsmul := HMul.hMul
--   gsmul_zero' := Int.zero_mul
--   gsmul_succ' n x := by rw [Int.ofNat_succ, Int.add_mul, Int.add_comm, Int.one_mul]
--   gsmul_neg' n x := by
--     cases x with
--     | ofNat m =>
--       rw [Int.negSucc_ofNat_ofNat, Int.ofNat_mul_ofNat]
--       exact rfl
--     | negSucc m =>
--       rw [Int.mul_negSucc_ofNat_negSucc_ofNat, Int.ofNat_mul_negSucc_ofNat]
--       exact rfl
--   natCast := (·)
--   natCast_zero := rfl
--   natCast_succ _ := rfl
--   intCast := (·)
--   intCast_ofNat _ := rfl
--   intCast_negSucc _ := rfl