/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.geom_sum
import linear_algebra.smodeq
import ring_theory.ideal.quotient
import ring_theory.jacobson_ideal

/-!
# Completion of a module with respect to an ideal.

In this file we define the notions of Hausdorff, precomplete, and complete for an `R`-module `M`
with respect to an ideal `I`:

## Main definitions

- `is_Hausdorff I M`: this says that the intersection of `I^n M` is `0`.
- `is_precomplete I M`: this says that every Cauchy sequence converges.
- `is_adic_complete I M`: this says that `M` is Hausdorff and precomplete.
- `Hausdorffification I M`: this is the universal Hausdorff module with a map from `M`.
- `completion I M`: if `I` is finitely generated, then this is the universal complete module (TODO)
  with a map from `M`. This map is injective iff `M` is Hausdorff and surjective iff `M` is
  precomplete.

-/

open submodule

variables {R : Type*} [comm_ring R] (I : ideal R)
variables (M : Type*) [add_comm_group M] [module R M]
variables {N : Type*} [add_comm_group N] [module R N]

/-- A module `M` is Hausdorff with respect to an ideal `I` if `⋂ I^n M = 0`. -/
class is_Hausdorff : Prop :=
(haus' : ∀ x : M, (∀ n : ℕ, x ≡ 0 [SMOD (I ^ n • ⊤ : submodule R M)]) → x = 0)

/-- A module `M` is precomplete with respect to an ideal `I` if every Cauchy sequence converges. -/
class is_precomplete : Prop :=
(prec' : ∀ f : ℕ → M,
  (∀ {m n}, m ≤ n → f m ≡ f n [SMOD (I ^ m • ⊤ : submodule R M)]) →
  ∃ L : M, ∀ n, f n ≡ L [SMOD (I ^ n • ⊤ : submodule R M)])

/-- A module `M` is `I`-adically complete if it is Hausdorff and precomplete. -/
class is_adic_complete extends is_Hausdorff I M, is_precomplete I M : Prop

variables {I M}

theorem is_Hausdorff.haus (h : is_Hausdorff I M) :
  ∀ x : M, (∀ n : ℕ, x ≡ 0 [SMOD (I ^ n • ⊤ : submodule R M)]) → x = 0 := is_Hausdorff.haus'

theorem is_Hausdorff_iff : is_Hausdorff I M ↔
  ∀ x : M, (∀ n : ℕ, x ≡ 0 [SMOD (I ^ n • ⊤ : submodule R M)]) → x = 0 :=
⟨is_Hausdorff.haus, λ h, ⟨h⟩⟩

theorem is_precomplete.prec (h : is_precomplete I M) {f : ℕ → M} :
  (∀ {m n}, m ≤ n → f m ≡ f n [SMOD (I ^ m • ⊤ : submodule R M)]) →
  ∃ L : M, ∀ n, f n ≡ L [SMOD (I ^ n • ⊤ : submodule R M)] := is_precomplete.prec' _

theorem is_precomplete_iff : is_precomplete I M ↔ ∀ f : ℕ → M,
  (∀ {m n}, m ≤ n → f m ≡ f n [SMOD (I ^ m • ⊤ : submodule R M)]) →
  ∃ L : M, ∀ n, f n ≡ L [SMOD (I ^ n • ⊤ : submodule R M)] :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

variables (I M)

/-- The Hausdorffification of a module with respect to an ideal. -/
@[reducible] def Hausdorffification : Type* :=
M ⧸ (⨅ n : ℕ, I ^ n • ⊤ : submodule R M)

/-- The completion of a module with respect to an ideal. This is not necessarily Hausdorff.
In fact, this is only complete if the ideal is finitely generated. -/
def adic_completion : submodule R (Π n : ℕ, (M ⧸ (I ^ n • ⊤ : submodule R M))) :=
{ carrier := { f | ∀ {m n} (h : m ≤ n), liftq _ (mkq _)
    (by { rw ker_mkq, exact smul_mono (ideal.pow_le_pow h) (le_refl _) }) (f n) = f m },
  zero_mem' := λ m n hmn, by rw [pi.zero_apply, pi.zero_apply, linear_map.map_zero],
  add_mem' := λ f g hf hg m n hmn, by rw [pi.add_apply, pi.add_apply,
    linear_map.map_add, hf hmn, hg hmn],
  smul_mem' := λ c f hf m n hmn, by rw [pi.smul_apply, pi.smul_apply, linear_map.map_smul, hf hmn] }

namespace is_Hausdorff

instance bot : is_Hausdorff (⊥ : ideal R) M :=
⟨λ x hx, by simpa only [pow_one ⊥, bot_smul, smodeq.bot] using hx 1⟩

variables {M}
protected theorem subsingleton (h : is_Hausdorff (⊤ : ideal R) M) : subsingleton M :=
⟨λ x y, eq_of_sub_eq_zero $ h.haus (x - y) $ λ n,
  by { rw [ideal.top_pow, top_smul], exact smodeq.top }⟩
variables (M)

@[priority 100] instance of_subsingleton [subsingleton M] : is_Hausdorff I M :=
⟨λ x _, subsingleton.elim _ _⟩

variables {I M}
theorem infi_pow_smul (h : is_Hausdorff I M) :
  (⨅ n : ℕ, I ^ n • ⊤ : submodule R M) = ⊥ :=
eq_bot_iff.2 $ λ x hx, (mem_bot _).2 $ h.haus x $ λ n, smodeq.zero.2 $
(mem_infi $ λ n : ℕ, I ^ n • ⊤).1 hx n

end is_Hausdorff

namespace Hausdorffification

/-- The canonical linear map to the Hausdorffification. -/
def of : M →ₗ[R] Hausdorffification I M := mkq _

variables {I M}
@[elab_as_eliminator]
lemma induction_on {C : Hausdorffification I M → Prop} (x : Hausdorffification I M)
  (ih : ∀ x, C (of I M x)) : C x :=
quotient.induction_on' x ih
variables (I M)

instance : is_Hausdorff I (Hausdorffification I M) :=
⟨λ x, quotient.induction_on' x $ λ x hx, (quotient.mk_eq_zero _).2 $ (mem_infi _).2 $ λ n, begin
  have := comap_map_mkq (⨅ n : ℕ, I ^ n • ⊤ : submodule R M) (I ^ n • ⊤),
  simp only [sup_of_le_right (infi_le (λ n, (I ^ n • ⊤ : submodule R M)) n)] at this,
  rw [← this, map_smul'', mem_comap, map_top, range_mkq, ← smodeq.zero], exact hx n
end⟩

variables {M} [h : is_Hausdorff I N]
include h

/-- universal property of Hausdorffification: any linear map to a Hausdorff module extends to a
unique map from the Hausdorffification. -/
def lift (f : M →ₗ[R] N) : Hausdorffification I M →ₗ[R] N :=
liftq _ f $ map_le_iff_le_comap.1 $ h.infi_pow_smul ▸ le_infi (λ n,
le_trans (map_mono $ infi_le _ n) $ by { rw map_smul'', exact smul_mono (le_refl _) le_top })

theorem lift_of (f : M →ₗ[R] N) (x : M) : lift I f (of I M x) = f x := rfl

theorem lift_comp_of (f : M →ₗ[R] N) : (lift I f).comp (of I M) = f :=
linear_map.ext $ λ _, rfl

/-- Uniqueness of lift. -/
theorem lift_eq (f : M →ₗ[R] N) (g : Hausdorffification I M →ₗ[R] N) (hg : g.comp (of I M) = f) :
  g = lift I f :=
linear_map.ext $ λ x, induction_on x $ λ x, by rw [lift_of, ← hg, linear_map.comp_apply]

end Hausdorffification

namespace is_precomplete

instance bot : is_precomplete (⊥ : ideal R) M :=
begin
  refine ⟨λ f hf, ⟨f 1, λ n, _⟩⟩, cases n,
  { rw [pow_zero, ideal.one_eq_top, top_smul], exact smodeq.top },
  specialize hf (nat.le_add_left 1 n),
  rw [pow_one, bot_smul, smodeq.bot] at hf, rw hf
end

instance top : is_precomplete (⊤ : ideal R) M :=
⟨λ f hf, ⟨0, λ n, by { rw [ideal.top_pow, top_smul], exact smodeq.top }⟩⟩

@[priority 100] instance of_subsingleton [subsingleton M] : is_precomplete I M :=
⟨λ f hf, ⟨0, λ n, by rw subsingleton.elim (f n) 0⟩⟩

end is_precomplete

namespace adic_completion

/-- The canonical linear map to the completion. -/
def of : M →ₗ[R] adic_completion I M :=
{ to_fun    := λ x, ⟨λ n, mkq _ x, λ m n hmn, rfl⟩,
  map_add'  := λ x y, rfl,
  map_smul' := λ c x, rfl }

@[simp] lemma of_apply (x : M) (n : ℕ) : (of I M x).1 n = mkq _ x := rfl

/-- Linearly evaluating a sequence in the completion at a given input. -/
def eval (n : ℕ) : adic_completion I M →ₗ[R] (M ⧸ (I ^ n • ⊤ : submodule R M)) :=
{ to_fun    := λ f, f.1 n,
  map_add'  := λ f g, rfl,
  map_smul' := λ c f, rfl }

@[simp] lemma coe_eval (n : ℕ) :
  (eval I M n : adic_completion I M → (M ⧸ (I ^ n • ⊤ : submodule R M))) = λ f, f.1 n := rfl

lemma eval_apply (n : ℕ) (f : adic_completion I M) : eval I M n f = f.1 n := rfl

lemma eval_of (n : ℕ) (x : M) : eval I M n (of I M x) = mkq _ x := rfl

@[simp] lemma eval_comp_of (n : ℕ) : (eval I M n).comp (of I M) = mkq _ := rfl

@[simp] lemma range_eval (n : ℕ) : (eval I M n).range = ⊤ :=
linear_map.range_eq_top.2 $ λ x, quotient.induction_on' x $ λ x, ⟨of I M x, rfl⟩

variables {I M}
@[ext] lemma ext {x y : adic_completion I M} (h : ∀ n, eval I M n x = eval I M n y) : x = y :=
subtype.eq $ funext h
variables (I M)

instance : is_Hausdorff I (adic_completion I M) :=
⟨λ x hx, ext $ λ n, smul_induction_on (smodeq.zero.1 $ hx n)
  (λ r hr x _, ((eval I M n).map_smul r x).symm ▸ quotient.induction_on' (eval I M n x)
    (λ x, smodeq.zero.2 $ smul_mem_smul hr mem_top))
  rfl
  (λ _ _ ih1 ih2, by rw [linear_map.map_add, ih1, ih2, linear_map.map_zero, add_zero])
  (λ c _ ih, by rw [linear_map.map_smul, ih, linear_map.map_zero, smul_zero])⟩

end adic_completion

namespace is_adic_complete

instance bot : is_adic_complete (⊥ : ideal R) M := {}

protected theorem subsingleton (h : is_adic_complete (⊤ : ideal R) M) : subsingleton M :=
h.1.subsingleton

@[priority 100] instance of_subsingleton [subsingleton M] : is_adic_complete I M := {}

open_locale big_operators

lemma le_jacobson_bot [is_adic_complete I R] : I ≤ (⊥ : ideal R).jacobson :=
begin
  intros x hx,
  rw [← ideal.neg_mem_iff, ideal.mem_jacobson_bot],
  intros y,
  rw add_comm,
  let f : ℕ → R := geom_sum (x * y),
  have hf : ∀ m n, m ≤ n → f m ≡ f n [SMOD I ^ m • (⊤ : submodule R R)],
  { intros m n h,
    simp only [f, geom_sum_def, algebra.id.smul_eq_mul, ideal.mul_top, smodeq.sub_mem],
    rw [← add_tsub_cancel_of_le h, finset.sum_range_add, ← sub_sub, sub_self, zero_sub,
      neg_mem_iff],
    apply submodule.sum_mem,
    intros n hn,
    rw [mul_pow, pow_add, mul_assoc],
    exact ideal.mul_mem_right _ (I ^ m) (ideal.pow_mem_pow hx m) },
  obtain ⟨L, hL⟩ := is_precomplete.prec to_is_precomplete hf,
  { rw is_unit_iff_exists_inv,
    use L,
    rw [← sub_eq_zero, neg_mul_eq_neg_mul_symm],
    apply is_Hausdorff.haus (to_is_Hausdorff : is_Hausdorff I R),
    intros n,
    specialize hL n,
    rw [smodeq.sub_mem, algebra.id.smul_eq_mul, ideal.mul_top] at ⊢ hL,
    rw sub_zero,
    suffices : (1 - x * y) * (f n) - 1 ∈ I ^ n,
    { convert (ideal.sub_mem _ this (ideal.mul_mem_left _ (1 + - (x * y)) hL)) using 1,
      ring },
    cases n,
    { simp only [ideal.one_eq_top, pow_zero] },
    { dsimp [f],
      rw [← neg_sub _ (1:R), neg_mul_eq_neg_mul_symm, mul_geom_sum, neg_sub,
        sub_sub, add_comm, ← sub_sub, sub_self, zero_sub, neg_mem_iff, mul_pow],
      exact ideal.mul_mem_right _ (I ^ _) (ideal.pow_mem_pow hx _), } },
end

end is_adic_complete


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Anne Baanen

! This file was ported from Lean 3 source module order.hom.order
! leanprover-community/mathlib commit ba2245edf0c8bb155f1569fd9b9492a9b384cde6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Function.Iterate
import Mathlib.Order.GaloisConnection
import Mathlib.Order.Hom.Basic

/-!
# Lattice structure on order homomorphisms

This file defines the lattice structure on order homomorphisms, which are bundled
monotone functions.

## Main definitions

 * `OrderHom.CompleteLattice`: if `β` is a complete lattice, so is `α →o β`

## Tags

monotone map, bundled morphism
-/

namespace OrderHom

variable {α β : Type _}

section Preorder

variable [Preorder α]

instance [SemilatticeSup β] : Sup (α →o β) where
  sup f g := ⟨fun a => f a ⊔ g a, f.mono.sup g.mono⟩

--Porting note: this is the lemma that could have been generated by `@[simps]` on the
--above instance but with a nicer name
@[simp] lemma coe_sup [SemilatticeSup β] (f g : α →o β) :
  ((f ⊔ g : α →o β) : α → β) = (f : α → β) ⊔ g := rfl

instance [SemilatticeSup β] : SemilatticeSup (α →o β) :=
  { (_ : PartialOrder (α →o β)) with
    sup := Sup.sup
    le_sup_left := fun _ _ _ => le_sup_left
    le_sup_right := fun _ _ _ => le_sup_right
    sup_le := fun _ _ _ h₀ h₁ x => sup_le (h₀ x) (h₁ x) }

instance [SemilatticeInf β] : Inf (α →o β) where
  inf f g := ⟨fun a => f a ⊓ g a, f.mono.inf g.mono⟩

--Porting note: this is the lemma that could have been generated by `@[simps]` on the
--above instance but with a nicer name
@[simp] lemma coe_inf [SemilatticeInf β] (f g : α →o β) :
  ((f ⊓ g : α →o β) : α → β) = (f : α → β) ⊓ g := rfl

instance [SemilatticeInf β] : SemilatticeInf (α →o β) :=
  { (_ : PartialOrder (α →o β)), (dualIso α β).symm.toGaloisInsertion.liftSemilatticeInf with
    inf := (· ⊓ ·) }

instance lattice [Lattice β] : Lattice (α →o β) :=
  { (_ : SemilatticeSup (α →o β)), (_ : SemilatticeInf (α →o β)) with }

@[simps]
instance [Preorder β] [OrderBot β] : Bot (α →o β) where
  bot := const α ⊥

instance orderBot [Preorder β] [OrderBot β] : OrderBot (α →o β) where
  bot := ⊥
  bot_le _ _ := bot_le

@[simps]
instance [Preorder β] [OrderTop β] : Top (α →o β) where
  top := const α ⊤

instance orderTop [Preorder β] [OrderTop β] : OrderTop (α →o β) where
  top := ⊤
  le_top _ _ := le_top

instance [CompleteLattice β] : InfSet (α →o β) where
  infₛ s := ⟨fun x => ⨅ f ∈ s, (f : _) x, fun _ _ h => infᵢ₂_mono fun f _ => f.mono h⟩

@[simp]
theorem infₛ_apply [CompleteLattice β] (s : Set (α →o β)) (x : α) :
    infₛ s x = ⨅ f ∈ s, (f : _) x :=
  rfl
#align order_hom.Inf_apply OrderHom.infₛ_apply

theorem infᵢ_apply {ι : Sort _} [CompleteLattice β] (f : ι → α →o β) (x : α) :
    (⨅ i, f i) x = ⨅ i, f i x :=
  (infₛ_apply _ _).trans infᵢ_range
#align order_hom.infi_apply OrderHom.infᵢ_apply

@[simp, norm_cast]
theorem coe_infᵢ {ι : Sort _} [CompleteLattice β] (f : ι → α →o β) :
    ((⨅ i, f i : α →o β) : α → β) = ⨅ i, (f i : α → β) := by
  funext x; simp [infᵢ_apply]
#align order_hom.coe_infi OrderHom.coe_infᵢ

instance [CompleteLattice β] : SupSet (α →o β) where
  supₛ s := ⟨fun x => ⨆ f ∈ s, (f : _) x, fun _ _ h => supᵢ₂_mono fun f _ => f.mono h⟩

@[simp]
theorem supₛ_apply [CompleteLattice β] (s : Set (α →o β)) (x : α) :
    supₛ s x = ⨆ f ∈ s, (f : _) x :=
  rfl
#align order_hom.Sup_apply OrderHom.supₛ_apply

theorem supᵢ_apply {ι : Sort _} [CompleteLattice β] (f : ι → α →o β) (x : α) :
    (⨆ i, f i) x = ⨆ i, f i x :=
  (supₛ_apply _ _).trans supᵢ_range
#align order_hom.supr_apply OrderHom.supᵢ_apply

@[simp, norm_cast]
theorem coe_supᵢ {ι : Sort _} [CompleteLattice β] (f : ι → α →o β) :
    ((⨆ i, f i : α →o β) : α → β) = ⨆ i, (f i : α → β) := by
  funext x; simp [supᵢ_apply]
#align order_hom.coe_supr OrderHom.coe_supᵢ

instance [CompleteLattice β] : CompleteLattice (α →o β) :=
  { (_ : Lattice (α →o β)), OrderHom.orderTop, OrderHom.orderBot with
    -- supₛ := SupSet.supₛ   -- Porting note: removed, unecessary?
    -- Porting note: Added `by apply`, was `fun s f hf x => le_supᵢ_of_le f (le_supᵢ _ hf)`
    le_supₛ := fun s f hf x => le_supᵢ_of_le f (by apply le_supᵢ _ hf)
    supₛ_le := fun s f hf x => supᵢ₂_le fun g hg => hf g hg x
    --inf := infₛ      -- Porting note: removed, unecessary?
    le_infₛ := fun s f hf x => le_infᵢ₂ fun g hg => hf g hg x
    infₛ_le := fun s f hf x => infᵢ_le_of_le f (infᵢ_le _ hf)
    }

theorem iterate_sup_le_sup_iff {α : Type _} [SemilatticeSup α] (f : α →o α) :
    (∀ n₁ n₂ a₁ a₂, (f^[n₁ + n₂]) (a₁ ⊔ a₂) ≤ (f^[n₁]) a₁ ⊔ (f^[n₂]) a₂) ↔
      ∀ a₁ a₂, f (a₁ ⊔ a₂) ≤ f a₁ ⊔ a₂ := by
  constructor <;> intro h
  · exact h 1 0
  · intro n₁ n₂ a₁ a₂
    have h' : ∀ n a₁ a₂, (f^[n]) (a₁ ⊔ a₂) ≤ (f^[n]) a₁ ⊔ a₂ := by
      intro n
      induction' n with n ih <;> intro a₁ a₂
      · rfl
      · calc
          (f^[n + 1]) (a₁ ⊔ a₂) = (f^[n]) (f (a₁ ⊔ a₂)) := Function.iterate_succ_apply f n _
          _ ≤ (f^[n]) (f a₁ ⊔ a₂) := f.mono.iterate n (h a₁ a₂)
          _ ≤ (f^[n]) (f a₁) ⊔ a₂ := ih _ _
          _ = (f^[n + 1]) a₁ ⊔ a₂ := by rw [← Function.iterate_succ_apply]

    calc
      (f^[n₁ + n₂]) (a₁ ⊔ a₂) = (f^[n₁]) ((f^[n₂]) (a₁ ⊔ a₂)) :=
        Function.iterate_add_apply f n₁ n₂ _
      _ = (f^[n₁]) ((f^[n₂]) (a₂ ⊔ a₁)) := by rw [sup_comm]
      _ ≤ (f^[n₁]) ((f^[n₂]) a₂ ⊔ a₁) := f.mono.iterate n₁ (h' n₂ _ _)
      _ = (f^[n₁]) (a₁ ⊔ (f^[n₂]) a₂) := by rw [sup_comm]
      _ ≤ (f^[n₁]) a₁ ⊔ (f^[n₂]) a₂ := h' n₁ a₁ _

#align order_hom.iterate_sup_le_sup_iff OrderHom.iterate_sup_le_sup_iff

end Preorder

end OrderHom


import algebra.group

example (M : Type) [monoid M] : ∀ a b c : M, a * b * c = a * (b * c) := by {}


-- Keith
-- Chapter 2

import data.fin data.list algebra.binary algebra.group classical

open nat fin list

definition no_dup {V : Type} : list V → Prop
| [] := true
| (x :: xs) := ¬ x ∈ xs ∧ no_dup xs

definition rcons {V : Type} : list V → V → list V
| [] v := [v]
| (x :: xs) v := x :: (rcons xs v)

lemma rcons_reverse {V : Type} (u : V) (xs : list V) : reverse (u :: xs) = rcons (reverse xs) u := sorry

definition relation V := V → V → Prop
-- definition graph n := relation (fin n)

definition graph V := relation V -- for now, until we need finiteness
section V

variables {V : Type} (g : graph V)
variables [V_decidable : decidable_eq V]
variables [g_decidable : decidable_rel g]

include V_decidable g_decidable

inductive path : V → list V → V → Prop :=
| edge : ∀ {x y}, g x y → path x [] y
| trans : ∀ {x xs1 y xs2 z}, path x xs1 y → path y xs2 z → path x (xs1 ++ (y :: xs2)) z

-- There must be an easier way to do this!

/-
theorem decidable_path [instance] : ∀ (x_start : V) (xs : list V) (x_end : V), decidable (path g x_start xs x_end)
| x_start [] x_end := decidable.rec_on (prop_decidable (x_start = x_end)) (take yes, decidable.inl yes) (take no, decidable.inr no)
| x_start (x :: xs) x_end := decidable.rec_on (prop_decidable (g x_start x ∧ path g x xs x_end)) (take yes, decidable.inl yes) (take no, decidable.inr no)

definition simple {x_start : V} {xs : list V} {x_end : V} (p : path g x_start xs x_end) : Prop :=
  no_dup (x_start :: xs)

definition cycle {x_start : V} {xs : list V} {x_end : V} (p : path g x_start xs x_end) : Prop :=
  x_start = x_end

definition simple_cycle {x_start : V} {xs : list V} {x_end : V} (p : path g x_start xs x_end) : Prop :=
  (simple g p) ∧ (cycle g p)
-/

definition connected (u v : V) := u = v ∨ ∃ xs, path g u xs v

/- [KS]
Theorem: Let G = (V, E) be an undirected graph. Then:
(1) If v ∈ V, then v ↔ v.
(2) If u, v ∈ V and u ↔ v, then v ↔ u.
(3) If u, v, w ∈ V, then if u ↔ v and v ↔ w, then u ↔ w.
Proof: We prove each part independently.
To prove (1), note that for any v ∈ V, the trivial path (v) is a path from v to itself. Thus v ↔ v.
To prove (2), consider any u, v ∈ V where u ↔ v. Then there must be some path (u, x1, x2, …, xn, v).
Since G is an undirected graph, this means v, xn, …, x1, u is a path from v to u. Thus v ↔ u.
To prove (3), consider any u, v, w ∈ V where u ↔ v and v ↔ w. Then there must be paths u, x1, x2,
…, xn, v and v, y1, y2, …, ym, w. Consequently, (u, x1, …, xn, v, y1, …, ym, w) is a path from u to w.
Thus u ↔ w.
-/

local notation a ↔ b := @connected V g V_decidable g_decidable a b
variable [g_undirected : symmetric g]
open eq.ops

theorem connected_refl : ∀ (v : V), v ↔ v := take v, or.inl rfl

lemma path_edge_inv : ∀ (u v : V), path g u [] v → g u v :=

check @path.edge
lemma path_reverse {xs : list V} : ∀ {u v : V}, path g u xs v → path g v (reverse xs) u :=
  list.induction_on
    xs
    (show ∀ (u v : V), path g u [] v → path g v [] u, from
     take (u v : V),
     assume (u_path_v : path g u [] v),
     path.cases_on u_path_v
                   _
                   _)
    sorry

/-
    (take (x : V) (xs : list V),
     assume (IHxs : ∀ {u v : V}, path g u xs v → path g v (reverse xs) u),
     show ∀ (u v : V), path g u (x :: xs) v → path g v (reverse (x :: xs)) u, from
     take (u v : V),
     assume (u_path_v : path g u (x :: xs) v),
     have g_u_x : g u x, from and.elim_left u_path_v,
     have x_path_v : path g x xs v, from and.elim_right u_path_v,
     have v_path_x : path g v (reverse xs) x, from IHxs x_path_v,
     have g_x_u : g x u, from g_undirected g_u_x,
     have x_path_u : path g x [] u, from
     have v_path_u : path g v (reverse xs) x) u, from rcons_path g v_path_x g_x_u,
     show path g v (reverse (x :: xs)) u, from (rcons_reverse x xs)⁻¹ ▸ v_path_u)
-/

theorem connected_sym : ∀ (u v : V), u ↔ v → v ↔ u :=
  take u v,
  assume u_conn_v : u ↔ v,
  or.elim u_conn_v
          (take u_eq_v : u = v, or.inl u_eq_v⁻¹)
          (take H_uv : ∃ xs, path g u xs v,
           obtain xs (u_path_v : path g u xs v), from H_uv,
           have v_path_u : path g v (reverse xs) u, from @path_reverse V g V_decidable g_decidable g_undirected xs u v u_path_v,
           or.inr (exists.intro _ v_path_u))

lemma path_reverse_nil (u v : V) : ¬ path g u [] v := λ H,H
lemma path_reverse_one (x u v : V) (u_path_v : path g u [x] v) : path g v [x] u := iff.elim_left and.comm u_path_v

lemma path_reverse (xs : list V) : ∀ (u v : V), path g u xs v → path g v (reverse xs) u :=
  list.induction_on xs
                (take (u v : V),
                 assume (u_path_v : path g u [] v),
                 false.rec _ u_path_v)
                (take (x1 : V) (xs : list V),
                 assume (IHxs : ∀ (u v : V), path g u xs v → path g v (reverse xs) u),
                 show ∀ (u v : V), path g u (x1 :: xs) v → path g v (reverse (x1 :: xs)) u, from
                 list.cases_on xs
                               (take (u v : V),
                                assume (u_path_v : path g u [x1] v),
                                show path g v [x1] u, from iff.elim_left and.comm u_path_v)
                               (take (x2 : V) (xs : list V),
                                take (u v : V),
                                list.cases_on xs
                                  (assume u_path_v : path g u [x1,x2] v, show path g v [x2,x1] u, from sorry)
                                  (take (x3 : V) (xs : list V),
                                   assume (u_path_v : path g u (x1 :: x2 :: x3 :: xs) v),
                                have H_u_path_v : u = x1 ∧ g x1 x2 ∧ path g x2 (x2 :: xs) v, from u_path_v,
                                have u_eq_x2 : u = x1, from and.elim_left H_u_path_v,
                                have g_x2_x1 : g x1 x2, from and.elim_left (and.elim_right H_u_path_v),
                                have g_x1_x2 : g x2 x1, from g_undirected g_x2_x1,
                                have x2_path_v : path g x2 (x2 :: x3 :: xs) v, from and.elim_right (and.elim_right H_u_path_v),

                                have v_path_x2 : path g v (reverse (x2 :: xs)) x2, from IHxs x2 v x2_path_v,
                                have v_path_x1 : path g v (rcons (reverse (x2 :: xs)) x1) x1, from rcons_path v_path_x2 g_x2_x1,
                                show path g v (reverse (x2 :: x1 :: xs)) u, from (rcons_reverse x2 (x1 :: xs))⁻¹ ▸ v_path_x2))

/-
                                    have x1_path_v : path g x1 (x1 :: xs) v, from and.elim_right (and.elim_right H_u_path_v),

-/

theorem graph_theorems1b_dep : ∀ (u v : V), u ↔ v → v ↔ u :=
  -- To prove (2), consider any u, v ∈ V where u ↔ v.
  take u v,
  assume u_conn_v : u ↔ v,
  -- Then there must be some path (u, x1, x2, …, xn, v).
  obtain (xs : list V) (u_path_v : path g u xs v), from u_conn_v,
  -- Since G is an undirected graph, this means v, xn, …, x1, u is a path from v to u.
  have v_conn_u : ∀ (u v : V), path g u xs v → path g v (reverse xs) u, from
    list.induction_on xs
                      (take (u v : V),
                       assume (u_path_v : path g u [] v),
                       false.rec _ u_path_v)
                      (take (x : V) (xs : list V),
                       assume IHxs : ∀ (u v : V), path g u xs v → path g v (reverse xs) u,
                       take (u v : V),
                       assume u_path_v : path g u (x :: xs) v,
                       show path g v (reverse (x :: xs)) u, from sorry),

  -- Thus v ↔ u.
  show v ↔ u, from exists.intro _ (v_conn_u _ _ u_path_v)

end V


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.exposed
import order.order_dual

open_locale classical affine big_operators
open set
--TODO: Generalise to LCTVS
variables {E : Type*} [normed_group E] [normed_space ℝ E] {x : E} {A B : set E}

namespace affine

--to move to mathlib
theorem zorn.subset_reverse {α : Type*} (S : set (set α))
  (h : ∀c ⊆ S, zorn.chain (⊆) c → ∃lb ∈ S, ∀ s ∈ c, lb ⊆ s) :
  ∃ m ∈ S, ∀ a ∈ S, a ⊆ m → a = m :=
begin
  let rev : S → S → Prop := λ X Y, Y.1 ⊆ X.1,
  have hS : ∀ (c : set S), zorn.chain rev c → ∃ ub, ∀ a ∈ c, rev a ub,
  { intros c hc,
    obtain ⟨t, ht₁, ht₂⟩ := h (coe '' c) (by simp)
      (by { rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ ne,
            apply (hc _ hx _ hy (λ t, ne (congr_arg coe t))).symm }),
    exact ⟨⟨_, ht₁⟩, λ a ha, ht₂ a ⟨_, ha, rfl⟩⟩ },
  obtain ⟨m, hm₁⟩ := zorn.exists_maximal_of_chains_bounded hS _,
  { refine ⟨m, m.prop, λ a ha ha₂, set.subset.antisymm ha₂ (hm₁ ⟨a, ha⟩ ha₂)⟩ },
  intros x y z xy yz,
  apply set.subset.trans yz xy
end

/--
The Krein-Milman lemma
-/
lemma has_extreme_point_of_convex_of_compact_of_nonempty (hAnemp : A.nonempty)
  (hAcomp : is_compact A) (hAconv : convex A) :
  A.extreme_points.nonempty :=
begin
  sorry
  /-
  let S : set (set E) := {B | B.nonempty ∧ is_closed B ∧ is_extreme A B},
  suffices h : ∃ B ∈ S, ∀ C ∈ S, C ⊆ B → C = B,
  { obtain ⟨B, ⟨hBnemp, hBclos, hAB⟩, hBmin⟩ := h,
    obtain ⟨x, hxB⟩ := hBnemp,
    refine ⟨x, mem_extreme_points_iff_extreme_singleton.2 _⟩,
    suffices h : B = {x},
    { rw ←h,
      exact hAB },
    refine eq_singleton_iff_unique_mem.2 ⟨hxB, λ y hyB, _⟩,
    by_contra hyx,
    obtain ⟨l, hl⟩ := geometric_hahn_banach_point_point hyx,
    obtain ⟨z, hzB, hz⟩ := is_compact.exists_forall_ge (compact_of_is_closed_subset hAcomp hBclos
      hAB.1) ⟨x, hxB⟩ (continuous.continuous_on l.continuous),
    rw ←hBmin {z ∈ B | ∀ w ∈ B, l w ≤ l z} ⟨⟨z, hzB, hz⟩, is_exposed.is_closed ⟨l, rfl⟩ hBclos,
      hAB.trans (is_exposed.is_extreme ⟨l, rfl⟩)⟩ (λ z hz, hz.1) at hyB,
    exact not_le.2 hl (hyB.2 x hxB) },
  apply zorn.subset_reverse,
  rintro F hFS hF,
  cases F.eq_empty_or_nonempty with hFemp hFnemp,
  { rw hFemp,
    refine ⟨A, ⟨hAnemp, is_compact.is_closed hAcomp, is_extreme.refl _⟩, λ B hB, _⟩,
    exfalso,
    exact hB },
  refine ⟨⋂₀ F, ⟨_, is_closed_sInter (λ B hB, (hFS hB).2.1), is_extreme.sInter hFnemp
    (λ B hB, (hFS hB).2.2)⟩, λ B hB, sInter_subset_of_mem hB⟩,
  rw sInter_eq_Inter,
  apply is_compact.nonempty_Inter_of_directed_nonempty_compact_closed _,
  { rintro B C,
    cases zorn.chain.total_of_refl hF (subtype.mem _) (subtype.mem _) with hBC hCB,
    exacts [⟨B, subset.refl _, hBC⟩, ⟨C, hCB, subset.refl _⟩] },
  exacts [λ B, (hFS (subtype.mem _)).1, λ B, compact_of_is_closed_subset hAcomp
    (hFS (subtype.mem _)).2.1 (hFS (subtype.mem _)).2.2.1, λ B, (hFS (subtype.mem _)).2.1,
   nonempty_subtype.2 hFnemp],
   -/
end

/--
The Krein-Milman theorem
-/
lemma eq_closure_convex_hull_extreme_points_of_compact_of_convex (hAcomp : is_compact A)
  (hAconv : convex A) :
  A = closure (convex_hull A.extreme_points) :=
begin
  sorry
  /-
  let B := closure (convex_hull A.extreme_points),
  have hBA : B ⊆ A :=
    closure_minimal (convex_hull_min (λ x hx, hx.1) hAconv) (is_compact.is_closed hAcomp),
  refine subset.antisymm _ hBA,
  by_contra hAB,
  have hABdiff : (A \ B).nonempty := nonempty_diff.2 hAB,
  obtain ⟨x, hxA, hxB⟩ := id hABdiff,
  obtain ⟨l, s, hls, hsx⟩ := geometric_hahn_banach_closed_point
    (convex.closure (convex_convex_hull _)) is_closed_closure hxB,
  let C := {y ∈ A | ∀ z ∈ A, l z ≤ l y},
  have hCexp : is_exposed A C := ⟨l, rfl⟩,
  obtain ⟨y, hyC⟩ := has_extreme_point_of_convex_of_compact_of_nonempty
    begin
      obtain ⟨z, hzA, hz⟩ := is_compact.exists_forall_ge hAcomp ⟨x, hxA⟩
        (continuous.continuous_on l.continuous),
      exact ⟨z, hzA, hz⟩,
    end
    (hCexp.is_compact hAcomp) (hCexp.is_convex hAconv),
  linarith [hls _ (subset_closure (subset_convex_hull _
    (hCexp.is_extreme.extreme_points_subset_extreme_points hyC))),
    hyC.1.2 x hxA],
  -/
end

/--
Carathéodory's theorem, the extreme points way
-/
lemma eq_convex_hull_extreme_points_of_compact_of_convex [finite_dimensional ℝ E]
  (hAcomp : is_compact A) (hAconv : convex A) :
  A = convex_hull A.extreme_points :=
begin

  sorry
  /-let B := convex_hull A.extreme_points,
  have hBA : B ⊆ A :=
    convex_hull_min (λ x hx, hx.1) hAconv,
  refine subset.antisymm _ hBA,
  by_contra hAB,
  have hABdiff : (A \ B).nonempty := nonempty_diff.2 hAB,
  obtain ⟨x, hxA, hxB⟩ := id hABdiff,
  sorry-/
end

lemma closed_convex_hull_extreme_points_of_compact_of_convex [finite_dimensional ℝ E]
  (hAcomp : is_compact A) (hAconv : convex A) :
  is_closed (convex_hull A.extreme_points) :=
closure_eq_iff_is_closed.1
  (by rw [←eq_closure_convex_hull_extreme_points_of_compact_of_convex hAcomp hAconv,
     ←eq_convex_hull_extreme_points_of_compact_of_convex hAcomp hAconv])

end affine


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

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

/-!
# More operations on `with_one` and `with_zero`

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

This file defines various bundled morphisms on `with_one` and `with_zero`
that were not available in `algebra/group/with_one/defs`.

## Main definitions

* `with_one.lift`, `with_zero.lift`
* `with_one.map`, `with_zero.map`
-/

universe u v w

variable {α : Type u} {β : Type v} {γ : Type w}

namespace WithOne

section

#print WithOne.coeMulHom /-
-- workaround: we make `with_one`/`with_zero` irreducible for this definition, otherwise `simps`
-- will unfold it in the statement of the lemma it generates.
/-- `coe` as a bundled morphism -/
@[to_additive "`coe` as a bundled morphism", simps apply]
def coeMulHom [Mul α] : α →ₙ* WithOne α where
  toFun := coe
  map_mul' x y := rfl
#align with_one.coe_mul_hom WithOne.coeMulHom
#align with_zero.coe_add_hom WithZero.coeAddHom
-/

end

section lift

attribute [local semireducible] WithOne WithZero

variable [Mul α] [MulOneClass β]

/- warning: with_one.lift -> WithOne.lift is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : MulOneClass.{u2} β], Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : MulOneClass.{u2} β], Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)
Case conversion may be inaccurate. Consider using '#align with_one.lift WithOne.liftₓ'. -/
/-- Lift a semigroup homomorphism `f` to a bundled monoid homorphism. -/
@[to_additive "Lift an add_semigroup homomorphism `f` to a bundled add_monoid homorphism."]
def lift : (α →ₙ* β) ≃ (WithOne α →* β)
    where
  toFun f :=
    { toFun := fun x => Option.casesOn x 1 f
      map_one' := rfl
      map_mul' := fun x y =>
        WithOne.cases_on x
          (by
            rw [one_mul]
            exact (one_mul _).symm)
          fun x =>
          WithOne.cases_on y
            (by
              rw [mul_one]
              exact (mul_one _).symm)
            fun y => f.map_mul x y }
  invFun F := F.toMulHom.comp coeMulHom
  left_inv f := MulHom.ext fun x => rfl
  right_inv F := MonoidHom.ext fun x => WithOne.cases_on x F.map_one.symm fun x => rfl
#align with_one.lift WithOne.lift
#align with_zero.lift WithZero.lift

variable (f : α →ₙ* β)

/- warning: with_one.lift_coe -> WithOne.lift_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : MulOneClass.{u2} β] (f : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (x : α), Eq.{succ u2} β (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) (fun (_x : MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) => (WithOne.{u1} α) -> β) (MonoidHom.hasCoeToFun.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) (coeFn.{max 1 (succ u2) (succ u1), max (succ u2) (succ u1)} (Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (fun (_x : Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) => (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) -> (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (Equiv.hasCoeToFun.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (WithOne.lift.{u1, u2} α β _inst_1 _inst_2) f) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) α (WithOne.{u1} α) (HasLiftT.mk.{succ u1, succ u1} α (WithOne.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} α (WithOne.{u1} α) (WithOne.hasCoeT.{u1} α))) x)) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (fun (_x : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) => α -> β) (MulHom.hasCoeToFun.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) f x)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : MulOneClass.{u2} β] (f : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (x : α), Eq.{succ u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) (WithOne.coe.{u1} α x)) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) f) (WithOne.{u1} α) (fun (_x : WithOne.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) f) (WithOne.{u1} α) β (MulOneClass.toMul.{u1} (WithOne.{u1} α) (WithOne.mulOneClass.{u1} α _inst_1)) (MulOneClass.toMul.{u2} β _inst_2) (MonoidHomClass.toMulHomClass.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) f) (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2 (MonoidHom.monoidHomClass.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2))) (FunLike.coe.{max (succ u2) (succ u1), max (succ u2) (succ u1), max (succ u2) (succ u1)} (Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (fun (_x : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) _x) (Equiv.instFunLikeEquiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (WithOne.lift.{u1, u2} α β _inst_1 _inst_2) f) (WithOne.coe.{u1} α x)) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2) (MulHom.mulHomClass.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2))) f x)
Case conversion may be inaccurate. Consider using '#align with_one.lift_coe WithOne.lift_coeₓ'. -/
@[simp, to_additive]
theorem lift_coe (x : α) : lift f x = f x :=
  rfl
#align with_one.lift_coe WithOne.lift_coe
#align with_zero.lift_coe WithZero.lift_coe

/- warning: with_one.lift_one -> WithOne.lift_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : MulOneClass.{u2} β] (f : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)), Eq.{succ u2} β (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) (fun (_x : MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) => (WithOne.{u1} α) -> β) (MonoidHom.hasCoeToFun.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) (coeFn.{max 1 (succ u2) (succ u1), max (succ u2) (succ u1)} (Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (fun (_x : Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) => (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) -> (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (Equiv.hasCoeToFun.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toHasMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (WithOne.lift.{u1, u2} α β _inst_1 _inst_2) f) (OfNat.ofNat.{u1} (WithOne.{u1} α) 1 (OfNat.mk.{u1} (WithOne.{u1} α) 1 (One.one.{u1} (WithOne.{u1} α) (WithOne.one.{u1} α))))) (OfNat.ofNat.{u2} β 1 (OfNat.mk.{u2} β 1 (One.one.{u2} β (MulOneClass.toHasOne.{u2} β _inst_2))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : MulOneClass.{u2} β] (f : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)), Eq.{succ u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) (OfNat.ofNat.{u1} (WithOne.{u1} α) 1 (One.toOfNat1.{u1} (WithOne.{u1} α) (WithOne.one.{u1} α)))) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) f) (WithOne.{u1} α) (fun (_x : WithOne.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) f) (WithOne.{u1} α) β (MulOneClass.toMul.{u1} (WithOne.{u1} α) (WithOne.mulOneClass.{u1} α _inst_1)) (MulOneClass.toMul.{u2} β _inst_2) (MonoidHomClass.toMulHomClass.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) f) (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2 (MonoidHom.monoidHomClass.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2))) (FunLike.coe.{max (succ u2) (succ u1), max (succ u2) (succ u1), max (succ u2) (succ u1)} (Equiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (fun (_x : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) => MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2) _x) (Equiv.instFunLikeEquiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (MulHom.{u1, u2} α β _inst_1 (MulOneClass.toMul.{u2} β _inst_2)) (MonoidHom.{u1, u2} (WithOne.{u1} α) β (WithOne.mulOneClass.{u1} α _inst_1) _inst_2)) (WithOne.lift.{u1, u2} α β _inst_1 _inst_2) f) (OfNat.ofNat.{u1} (WithOne.{u1} α) 1 (One.toOfNat1.{u1} (WithOne.{u1} α) (WithOne.one.{u1} α)))) (OfNat.ofNat.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) (OfNat.ofNat.{u1} (WithOne.{u1} α) 1 (One.toOfNat1.{u1} (WithOne.{u1} α) (WithOne.one.{u1} α)))) 1 (One.toOfNat1.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) (OfNat.ofNat.{u1} (WithOne.{u1} α) 1 (One.toOfNat1.{u1} (WithOne.{u1} α) (WithOne.one.{u1} α)))) (MulOneClass.toOne.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => β) (OfNat.ofNat.{u1} (WithOne.{u1} α) 1 (One.toOfNat1.{u1} (WithOne.{u1} α) (WithOne.one.{u1} α)))) _inst_2)))
Case conversion may be inaccurate. Consider using '#align with_one.lift_one WithOne.lift_oneₓ'. -/
@[simp, to_additive]
theorem lift_one : lift f 1 = 1 :=
  rfl
#align with_one.lift_one WithOne.lift_one
#align with_zero.lift_zero WithZero.lift_zero

#print WithOne.lift_unique /-
@[to_additive]
theorem lift_unique (f : WithOne α →* β) : f = lift (f.toMulHom.comp coeMulHom) :=
  (lift.apply_symm_apply f).symm
#align with_one.lift_unique WithOne.lift_unique
#align with_zero.lift_unique WithZero.lift_unique
-/

end lift

section Map

variable [Mul α] [Mul β] [Mul γ]

#print WithOne.map /-
/-- Given a multiplicative map from `α → β` returns a monoid homomorphism
  from `with_one α` to `with_one β` -/
@[to_additive
      "Given an additive map from `α → β` returns an add_monoid homomorphism\n  from `with_zero α` to `with_zero β`"]
def map (f : α →ₙ* β) : WithOne α →* WithOne β :=
  lift (coeMulHom.comp f)
#align with_one.map WithOne.map
#align with_zero.map WithZero.map
-/

/- warning: with_one.map_coe -> WithOne.map_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : Mul.{u2} β] (f : MulHom.{u1, u2} α β _inst_1 _inst_2) (a : α), Eq.{succ u2} (WithOne.{u2} β) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (fun (_x : MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) => (WithOne.{u1} α) -> (WithOne.{u2} β)) (MonoidHom.hasCoeToFun.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.map.{u1, u2} α β _inst_1 _inst_2 f) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) α (WithOne.{u1} α) (HasLiftT.mk.{succ u1, succ u1} α (WithOne.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} α (WithOne.{u1} α) (WithOne.hasCoeT.{u1} α))) a)) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) β (WithOne.{u2} β) (HasLiftT.mk.{succ u2, succ u2} β (WithOne.{u2} β) (CoeTCₓ.coe.{succ u2, succ u2} β (WithOne.{u2} β) (WithOne.hasCoeT.{u2} β))) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MulHom.{u1, u2} α β _inst_1 _inst_2) (fun (_x : MulHom.{u1, u2} α β _inst_1 _inst_2) => α -> β) (MulHom.hasCoeToFun.{u1, u2} α β _inst_1 _inst_2) f a))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Mul.{u1} α] [_inst_2 : Mul.{u2} β] (f : MulHom.{u1, u2} α β _inst_1 _inst_2) (a : α), Eq.{succ u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => WithOne.{u2} β) (WithOne.coe.{u1} α a)) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (fun (_x : WithOne.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => WithOne.{u2} β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (WithOne.{u2} β) (MulOneClass.toMul.{u1} (WithOne.{u1} α) (WithOne.mulOneClass.{u1} α _inst_1)) (MulOneClass.toMul.{u2} (WithOne.{u2} β) (WithOne.mulOneClass.{u2} β _inst_2)) (MonoidHomClass.toMulHomClass.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2) (MonoidHom.monoidHomClass.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)))) (WithOne.map.{u1, u2} α β _inst_1 _inst_2 f) (WithOne.coe.{u1} α a)) (WithOne.coe.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => β) a) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (MulHom.{u1, u2} α β _inst_1 _inst_2) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : α) => β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (MulHom.{u1, u2} α β _inst_1 _inst_2) α β _inst_1 _inst_2 (MulHom.mulHomClass.{u1, u2} α β _inst_1 _inst_2)) f a))
Case conversion may be inaccurate. Consider using '#align with_one.map_coe WithOne.map_coeₓ'. -/
@[simp, to_additive]
theorem map_coe (f : α →ₙ* β) (a : α) : map f (a : WithOne α) = f a :=
  lift_coe _ _
#align with_one.map_coe WithOne.map_coe
#align with_zero.map_coe WithZero.map_coe

#print WithOne.map_id /-
@[simp, to_additive]
theorem map_id : map (MulHom.id α) = MonoidHom.id (WithOne α) :=
  by
  ext
  induction x using WithOne.cases_on <;> rfl
#align with_one.map_id WithOne.map_id
#align with_zero.map_id WithZero.map_id
-/

/- warning: with_one.map_map -> WithOne.map_map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : Mul.{u1} α] [_inst_2 : Mul.{u2} β] [_inst_3 : Mul.{u3} γ] (f : MulHom.{u1, u2} α β _inst_1 _inst_2) (g : MulHom.{u2, u3} β γ _inst_2 _inst_3) (x : WithOne.{u1} α), Eq.{succ u3} (WithOne.{u3} γ) (coeFn.{max (succ u3) (succ u2), max (succ u2) (succ u3)} (MonoidHom.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)) (fun (_x : MonoidHom.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)) => (WithOne.{u2} β) -> (WithOne.{u3} γ)) (MonoidHom.hasCoeToFun.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.map.{u2, u3} β γ _inst_2 _inst_3 g) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (fun (_x : MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) => (WithOne.{u1} α) -> (WithOne.{u2} β)) (MonoidHom.hasCoeToFun.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.map.{u1, u2} α β _inst_1 _inst_2 f) x)) (coeFn.{max (succ u3) (succ u1), max (succ u1) (succ u3)} (MonoidHom.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)) (fun (_x : MonoidHom.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)) => (WithOne.{u1} α) -> (WithOne.{u3} γ)) (MonoidHom.hasCoeToFun.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.map.{u1, u3} α γ _inst_1 _inst_3 (MulHom.comp.{u1, u2, u3} α β γ _inst_1 _inst_2 _inst_3 g f)) x)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : Mul.{u1} α] [_inst_2 : Mul.{u2} β] [_inst_3 : Mul.{u3} γ] (f : MulHom.{u1, u2} α β _inst_1 _inst_2) (g : MulHom.{u2, u3} β γ _inst_2 _inst_3) (x : WithOne.{u1} α), Eq.{succ u3} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u2} β) => WithOne.{u3} γ) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (fun (a : WithOne.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => WithOne.{u2} β) a) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (WithOne.{u2} β) (MulOneClass.toMul.{u1} (WithOne.{u1} α) (WithOne.mulOneClass.{u1} α _inst_1)) (MulOneClass.toMul.{u2} (WithOne.{u2} β) (WithOne.mulOneClass.{u2} β _inst_2)) (MonoidHomClass.toMulHomClass.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2) (MonoidHom.monoidHomClass.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)))) (WithOne.map.{u1, u2} α β _inst_1 _inst_2 f) x)) (FunLike.coe.{max (succ u2) (succ u3), succ u2, succ u3} (MonoidHom.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.{u2} β) (fun (_x : WithOne.{u2} β) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u2} β) => WithOne.{u3} γ) _x) (MulHomClass.toFunLike.{max u2 u3, u2, u3} (MonoidHom.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.{u2} β) (WithOne.{u3} γ) (MulOneClass.toMul.{u2} (WithOne.{u2} β) (WithOne.mulOneClass.{u2} β _inst_2)) (MulOneClass.toMul.{u3} (WithOne.{u3} γ) (WithOne.mulOneClass.{u3} γ _inst_3)) (MonoidHomClass.toMulHomClass.{max u2 u3, u2, u3} (MonoidHom.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3) (MonoidHom.monoidHomClass.{u2, u3} (WithOne.{u2} β) (WithOne.{u3} γ) (WithOne.mulOneClass.{u2} β _inst_2) (WithOne.mulOneClass.{u3} γ _inst_3)))) (WithOne.map.{u2, u3} β γ _inst_2 _inst_3 g) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (fun (_x : WithOne.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => WithOne.{u2} β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (WithOne.{u2} β) (MulOneClass.toMul.{u1} (WithOne.{u1} α) (WithOne.mulOneClass.{u1} α _inst_1)) (MulOneClass.toMul.{u2} (WithOne.{u2} β) (WithOne.mulOneClass.{u2} β _inst_2)) (MonoidHomClass.toMulHomClass.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)) (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2) (MonoidHom.monoidHomClass.{u1, u2} (WithOne.{u1} α) (WithOne.{u2} β) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u2} β _inst_2)))) (WithOne.map.{u1, u2} α β _inst_1 _inst_2 f) x)) (FunLike.coe.{max (succ u1) (succ u3), succ u1, succ u3} (MonoidHom.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.{u1} α) (fun (_x : WithOne.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : WithOne.{u1} α) => WithOne.{u3} γ) _x) (MulHomClass.toFunLike.{max u1 u3, u1, u3} (MonoidHom.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.{u1} α) (WithOne.{u3} γ) (MulOneClass.toMul.{u1} (WithOne.{u1} α) (WithOne.mulOneClass.{u1} α _inst_1)) (MulOneClass.toMul.{u3} (WithOne.{u3} γ) (WithOne.mulOneClass.{u3} γ _inst_3)) (MonoidHomClass.toMulHomClass.{max u1 u3, u1, u3} (MonoidHom.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)) (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3) (MonoidHom.monoidHomClass.{u1, u3} (WithOne.{u1} α) (WithOne.{u3} γ) (WithOne.mulOneClass.{u1} α _inst_1) (WithOne.mulOneClass.{u3} γ _inst_3)))) (WithOne.map.{u1, u3} α γ _inst_1 _inst_3 (MulHom.comp.{u1, u2, u3} α β γ _inst_1 _inst_2 _inst_3 g f)) x)
Case conversion may be inaccurate. Consider using '#align with_one.map_map WithOne.map_mapₓ'. -/
@[to_additive]
theorem map_map (f : α →ₙ* β) (g : β →ₙ* γ) (x) : map g (map f x) = map (g.comp f) x := by
  induction x using WithOne.cases_on <;> rfl
#align with_one.map_map WithOne.map_map
#align with_zero.map_map WithZero.map_map

#print WithOne.map_comp /-
@[simp, to_additive]
theorem map_comp (f : α →ₙ* β) (g : β →ₙ* γ) : map (g.comp f) = (map g).comp (map f) :=
  MonoidHom.ext fun x => (map_map f g x).symm
#align with_one.map_comp WithOne.map_comp
#align with_zero.map_comp WithZero.map_comp
-/

#print MulEquiv.withOneCongr /-
/-- A version of `equiv.option_congr` for `with_one`. -/
@[to_additive "A version of `equiv.option_congr` for `with_zero`.", simps apply]
def MulEquiv.withOneCongr (e : α ≃* β) : WithOne α ≃* WithOne β :=
  { map e.toMulHom with
    toFun := map e.toMulHom
    invFun := map e.symm.toMulHom
    left_inv := fun x => (map_map _ _ _).trans <| by induction x using WithOne.cases_on <;> · simp
    right_inv := fun x =>
      (map_map _ _ _).trans <| by induction x using WithOne.cases_on <;> · simp }
#align mul_equiv.with_one_congr MulEquiv.withOneCongr
#align add_equiv.with_zero_congr AddEquiv.withZeroCongr
-/

#print MulEquiv.withOneCongr_refl /-
@[simp]
theorem MulEquiv.withOneCongr_refl : (MulEquiv.refl α).withOneCongr = MulEquiv.refl _ :=
  MulEquiv.toMonoidHom_injective map_id
#align mul_equiv.with_one_congr_refl MulEquiv.withOneCongr_refl
-/

#print MulEquiv.withOneCongr_symm /-
@[simp]
theorem MulEquiv.withOneCongr_symm (e : α ≃* β) : e.withOneCongr.symm = e.symm.withOneCongr :=
  rfl
#align mul_equiv.with_one_congr_symm MulEquiv.withOneCongr_symm
-/

#print MulEquiv.withOneCongr_trans /-
@[simp]
theorem MulEquiv.withOneCongr_trans (e₁ : α ≃* β) (e₂ : β ≃* γ) :
    e₁.withOneCongr.trans e₂.withOneCongr = (e₁.trans e₂).withOneCongr :=
  MulEquiv.toMonoidHom_injective (map_comp _ _).symm
#align mul_equiv.with_one_congr_trans MulEquiv.withOneCongr_trans
-/

end Map

end WithOne


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import algebra.invertible
import algebra.group_power.ring
import algebra.order.monoid.with_top
import data.nat.pow
import data.int.cast.lemmas

/-!
# Lemmas about power operations on monoids and groups

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

This file contains lemmas about `monoid.pow`, `group.pow`, `nsmul`, `zsmul`
which require additional imports besides those available in `algebra.group_power.basic`.
-/

open function int nat

universes u v w x y z u₁ u₂

variables {α : Type*} {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### (Additive) monoid
-/
section monoid

@[simp] theorem nsmul_one [add_monoid_with_one A] : ∀ n : ℕ, n • (1 : A) = n :=
begin
  refine eq_nat_cast' (⟨_, _, _⟩ : ℕ →+ A) _,
  { show 0 • (1 : A) = 0, simp [zero_nsmul] },
  { show ∀ x y : ℕ, (x + y) • (1 : A) = x • 1 + y • 1, simp [add_nsmul] },
  { show 1 • (1 : A) = 1, simp }
end

variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

instance invertible_pow (m : M) [invertible m] (n : ℕ) : invertible (m ^ n) :=
{ inv_of := ⅟ m ^ n,
  inv_of_mul_self := by rw [← (commute_inv_of m).symm.mul_pow, inv_of_mul_self, one_pow],
  mul_inv_of_self := by rw [← (commute_inv_of m).mul_pow, mul_inv_of_self, one_pow] }

lemma inv_of_pow (m : M) [invertible m] (n : ℕ) [invertible (m ^ n)] :
  ⅟(m ^ n) = ⅟m ^ n :=
@invertible_unique M _ (m ^ n) (m ^ n) _ (invertible_pow m n) rfl

@[to_additive] lemma is_unit.pow {m : M} (n : ℕ) : is_unit m → is_unit (m ^ n) :=
λ ⟨u, hu⟩, ⟨u ^ n, hu ▸ u.coe_pow _⟩

/-- If a natural power of `x` is a unit, then `x` is a unit. -/
@[to_additive "If a natural multiple of `x` is an additive unit, then `x` is an additive unit."]
def units.of_pow (u : Mˣ) (x : M) {n : ℕ} (hn : n ≠ 0) (hu : x ^ n = u) : Mˣ :=
u.left_of_mul x (x ^ (n - 1))
  (by rwa [← pow_succ, nat.sub_add_cancel (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn)])
  (commute.self_pow _ _)

@[simp, to_additive] lemma is_unit_pow_iff {a : M} {n : ℕ} (hn : n ≠ 0) :
  is_unit (a ^ n) ↔ is_unit a :=
⟨λ ⟨u, hu⟩, (u.of_pow a hn hu.symm).is_unit, λ h, h.pow n⟩

@[to_additive] lemma is_unit_pow_succ_iff {m : M} {n : ℕ} : is_unit (m ^ (n + 1)) ↔ is_unit m :=
is_unit_pow_iff n.succ_ne_zero

/-- If `x ^ n = 1`, `n ≠ 0`, then `x` is a unit. -/
@[to_additive "If `n • x = 0`, `n ≠ 0`, then `x` is an additive unit.", simps]
def units.of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : n ≠ 0) : Mˣ := units.of_pow 1 x hn hx

@[simp, to_additive] lemma units.pow_of_pow_eq_one {x : M} {n : ℕ} (hx : x ^ n = 1) (hn : n ≠ 0) :
  units.of_pow_eq_one x n hx hn ^ n = 1 :=
units.ext $ by rwa [units.coe_pow, units.coe_of_pow_eq_one, units.coe_one]

@[to_additive] lemma is_unit_of_pow_eq_one {x : M} {n : ℕ} (hx : x ^ n = 1) (hn : n ≠ 0) :
  is_unit x :=
(units.of_pow_eq_one x n hx hn).is_unit

/-- If `x ^ n = 1` then `x` has an inverse, `x^(n - 1)`. -/
def invertible_of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : n ≠ 0) :
  invertible x :=
(units.of_pow_eq_one x n hx hn).invertible

lemma smul_pow [mul_action M N] [is_scalar_tower M N N] [smul_comm_class M N N]
  (k : M) (x : N) (p : ℕ) :
  (k • x) ^ p = k ^ p • x ^ p :=
begin
  induction p with p IH,
  { simp },
  { rw [pow_succ', IH, smul_mul_smul, ←pow_succ', ←pow_succ'] }
end

@[simp] lemma smul_pow' [mul_distrib_mul_action M N] (x : M) (m : N) (n : ℕ) :
  x • m ^ n = (x • m) ^ n :=
begin
  induction n with n ih,
  { rw [pow_zero, pow_zero], exact smul_one x },
  { rw [pow_succ, pow_succ], exact (smul_mul' x m (m ^ n)).trans (congr_arg _ ih) }
end

end monoid

lemma zsmul_one [add_group_with_one A] (n : ℤ) : n • (1 : A) = n := by cases n; simp

section division_monoid
variables [division_monoid α]

-- Note that `mul_zsmul` and `zpow_mul` have the primes swapped since their argument order,
-- and therefore the more "natural" choice of lemma, is reversed.
@[to_additive mul_zsmul'] lemma zpow_mul (a : α) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n
| (m : ℕ) (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat, ← pow_mul, ← zpow_coe_nat], refl }
| (m : ℕ) -[1+ n] := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← pow_mul, coe_nat_mul_neg_succ,
    zpow_neg, inv_inj, ← zpow_coe_nat], refl }
| -[1+ m] (n : ℕ) := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← inv_pow, ← pow_mul,
    neg_succ_mul_coe_nat, zpow_neg, inv_pow, inv_inj, ← zpow_coe_nat], refl }
| -[1+ m] -[1+ n] := by { rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, neg_succ_mul_neg_succ,
    inv_pow, inv_inv, ← pow_mul, ← zpow_coe_nat], refl }

@[to_additive mul_zsmul] lemma zpow_mul' (a : α) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, zpow_mul]

@[to_additive bit0_zsmul] lemma zpow_bit0 (a : α) : ∀ n : ℤ, a ^ bit0 n = a ^ n * a ^ n
| (n : ℕ) := by simp only [zpow_coe_nat, ←int.coe_nat_bit0, pow_bit0]
| -[1+n]  := by { simp [←mul_inv_rev, ←pow_bit0], rw [neg_succ_of_nat_eq, bit0_neg, zpow_neg],
  norm_cast }

@[to_additive bit0_zsmul'] lemma zpow_bit0' (a : α) (n : ℤ) : a ^ bit0 n = (a * a) ^ n :=
(zpow_bit0 a n).trans ((commute.refl a).mul_zpow n).symm

@[simp] lemma zpow_bit0_neg [has_distrib_neg α] (x : α) (n : ℤ) : (-x) ^ (bit0 n) = x ^ bit0 n :=
by rw [zpow_bit0', zpow_bit0', neg_mul_neg]

end division_monoid

section group
variables [group G]

@[to_additive add_one_zsmul]
lemma zpow_add_one (a : G) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a
| (n : ℕ) := by simp only [← int.coe_nat_succ, zpow_coe_nat, pow_succ']
| -[1+ 0] := by erw [zpow_zero, zpow_neg_succ_of_nat, pow_one, mul_left_inv]
| -[1+ n+1] := begin
  rw [zpow_neg_succ_of_nat, pow_succ, mul_inv_rev, inv_mul_cancel_right],
  rw [int.neg_succ_of_nat_eq, neg_add, add_assoc, neg_add_self, add_zero],
  exact zpow_neg_succ_of_nat _ _
end

@[to_additive sub_one_zsmul]
lemma zpow_sub_one (a : G) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ :=
calc a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ : (mul_inv_cancel_right _ _).symm
             ... = a^n * a⁻¹             : by rw [← zpow_add_one, sub_add_cancel]

@[to_additive add_zsmul]
lemma zpow_add (a : G) (m n : ℤ) : a ^ (m + n) = a ^ m * a ^ n :=
begin
  induction n using int.induction_on with n ihn n ihn,
  case hz : { simp },
  { simp only [← add_assoc, zpow_add_one, ihn, mul_assoc] },
  { rw [zpow_sub_one, ← mul_assoc, ← ihn, ← zpow_sub_one, add_sub_assoc] }
end

@[to_additive add_zsmul_self]
lemma mul_self_zpow (b : G) (m : ℤ) : b*b^m = b^(m+1) :=
by { conv_lhs {congr, rw ← zpow_one b }, rw [← zpow_add, add_comm] }

@[to_additive add_self_zsmul]
lemma mul_zpow_self (b : G) (m : ℤ) : b^m*b = b^(m+1) :=
by { conv_lhs {congr, skip, rw ← zpow_one b }, rw [← zpow_add, add_comm] }

@[to_additive sub_zsmul]
lemma zpow_sub (a : G) (m n : ℤ) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ :=
by rw [sub_eq_add_neg, zpow_add, zpow_neg]

@[to_additive one_add_zsmul]
theorem zpow_one_add (a : G) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [zpow_add, zpow_one]

@[to_additive] lemma zpow_mul_comm (a : G) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i :=
(commute.refl _).zpow_zpow _ _

@[to_additive bit1_zsmul]
theorem zpow_bit1 (a : G) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
by rw [bit1, zpow_add, zpow_bit0, zpow_one]

end group

/-!
### `zpow`/`zsmul` and an order

Those lemmas are placed here (rather than in `algebra.group_power.order` with their friends) because
they require facts from `data.int.basic`.
-/

section ordered_add_comm_group
variables [ordered_comm_group α] {m n : ℤ} {a b : α}

@[to_additive zsmul_pos]
lemma one_lt_zpow' (ha : 1 < a) {k : ℤ} (hk : (0:ℤ) < k) : 1 < a^k :=
begin
  lift k to ℕ using int.le_of_lt hk,
  rw zpow_coe_nat,
  exact one_lt_pow' ha (coe_nat_pos.mp hk).ne',
end

@[to_additive zsmul_strict_mono_left]
lemma zpow_strict_mono_right (ha : 1 < a) : strict_mono (λ n : ℤ, a ^ n) :=
λ m n h,
  calc a ^ m = a ^ m * 1 : (mul_one _).symm
    ... < a ^ m * a ^ (n - m) : mul_lt_mul_left' (one_lt_zpow' ha $ sub_pos_of_lt h) _
    ... = a ^ n : by { rw ←zpow_add, simp }

@[to_additive zsmul_mono_left]
lemma zpow_mono_right (ha : 1 ≤ a) : monotone (λ n : ℤ, a ^ n) :=
λ m n h,
  calc a ^ m = a ^ m * 1 : (mul_one _).symm
    ... ≤ a ^ m * a ^ (n - m) : mul_le_mul_left' (one_le_zpow ha $ sub_nonneg_of_le h) _
    ... = a ^ n : by { rw ←zpow_add, simp }

@[to_additive]
lemma zpow_le_zpow (ha : 1 ≤ a) (h : m ≤ n) : a ^ m ≤ a ^ n := zpow_mono_right ha h

@[to_additive]
lemma zpow_lt_zpow (ha : 1 < a) (h : m < n) : a ^ m < a ^ n := zpow_strict_mono_right ha h

@[to_additive]
lemma zpow_le_zpow_iff (ha : 1 < a) : a ^ m ≤ a ^ n ↔ m ≤ n := (zpow_strict_mono_right ha).le_iff_le

@[to_additive]
lemma zpow_lt_zpow_iff (ha : 1 < a) : a ^ m < a ^ n ↔ m < n := (zpow_strict_mono_right ha).lt_iff_lt

variables (α)

@[to_additive zsmul_strict_mono_right]
lemma zpow_strict_mono_left (hn : 0 < n) : strict_mono ((^ n) : α → α) :=
λ a b hab, by { rw [←one_lt_div', ←div_zpow], exact one_lt_zpow' (one_lt_div'.2 hab) hn }

@[to_additive zsmul_mono_right]
lemma zpow_mono_left (hn : 0 ≤ n) : monotone ((^ n) : α → α) :=
λ a b hab, by { rw [←one_le_div', ←div_zpow], exact one_le_zpow (one_le_div'.2 hab) hn }

variables {α}

@[to_additive]
lemma zpow_le_zpow' (hn : 0 ≤ n) (h : a ≤ b) : a ^ n ≤ b ^ n := zpow_mono_left α hn h

@[to_additive]
lemma zpow_lt_zpow' (hn : 0 < n) (h : a < b) : a ^ n < b ^ n := zpow_strict_mono_left α hn h

end ordered_add_comm_group

section linear_ordered_comm_group
variables [linear_ordered_comm_group α] {n : ℤ} {a b : α}

@[to_additive]
lemma zpow_le_zpow_iff' (hn : 0 < n) {a b : α} : a ^ n ≤ b ^ n ↔ a ≤ b :=
(zpow_strict_mono_left α hn).le_iff_le

@[to_additive]
lemma zpow_lt_zpow_iff' (hn : 0 < n) {a b : α} : a ^ n < b ^ n ↔ a < b :=
(zpow_strict_mono_left α hn).lt_iff_lt

@[nolint to_additive_doc, to_additive zsmul_right_injective
"See also `smul_right_injective`. TODO: provide a `no_zero_smul_divisors` instance. We can't do that
here because importing that definition would create import cycles."]
lemma zpow_left_injective (hn : n ≠ 0) : function.injective ((^ n) : α → α) :=
begin
  cases hn.symm.lt_or_lt,
  { exact (zpow_strict_mono_left α h).injective },
  { refine λ a b (hab : a ^ n = b ^ n), (zpow_strict_mono_left α (neg_pos.mpr h)).injective _,
    rw [zpow_neg, zpow_neg, hab] }
end

@[to_additive zsmul_right_inj]
lemma zpow_left_inj (hn : n ≠ 0) : a ^ n = b ^ n ↔ a = b := (zpow_left_injective hn).eq_iff

/-- Alias of `zsmul_right_inj`, for ease of discovery alongside `zsmul_le_zsmul_iff'` and
`zsmul_lt_zsmul_iff'`. -/
@[to_additive "Alias of `zsmul_right_inj`, for ease of discovery alongside `zsmul_le_zsmul_iff'` and
`zsmul_lt_zsmul_iff'`."]
lemma zpow_eq_zpow_iff' (hn : n ≠ 0) : a ^ n = b ^ n ↔ a = b := zpow_left_inj hn

end linear_ordered_comm_group

section linear_ordered_add_comm_group
variables [linear_ordered_add_comm_group α] {a b : α}

lemma abs_nsmul (n : ℕ) (a : α) : |n • a| = n • |a| :=
begin
  cases le_total a 0 with hneg hpos,
  { rw [abs_of_nonpos hneg, ← abs_neg, ← neg_nsmul, abs_of_nonneg],
    exact nsmul_nonneg (neg_nonneg.mpr hneg) n },
  { rw [abs_of_nonneg hpos, abs_of_nonneg],
    exact nsmul_nonneg hpos n }
end

lemma abs_zsmul (n : ℤ) (a : α) : |n • a| = |n| • |a| :=
begin
  obtain n0 | n0 := le_total 0 n,
  { lift n to ℕ using n0,
    simp only [abs_nsmul, abs_coe_nat, coe_nat_zsmul] },
  { lift (- n) to ℕ using neg_nonneg.2 n0 with m h,
    rw [← abs_neg (n • a), ← neg_zsmul, ← abs_neg n, ← h, coe_nat_zsmul, abs_coe_nat,
      coe_nat_zsmul],
    exact abs_nsmul m _ },
end

lemma abs_add_eq_add_abs_le (hle : a ≤ b) : |a + b| = |a| + |b| ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
begin
  obtain a0 | a0 := le_or_lt 0 a; obtain b0 | b0 := le_or_lt 0 b,
  { simp [a0, b0, abs_of_nonneg, add_nonneg a0 b0] },
  { exact (lt_irrefl (0 : α) $ a0.trans_lt $ hle.trans_lt b0).elim },
  any_goals { simp [a0.le, b0.le, abs_of_nonpos, add_nonpos, add_comm] },
  have : (|a + b| = -a + b ↔ b ≤ 0) ↔ (|a + b| =
    |a| + |b| ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0),
  { simp [a0, a0.le, a0.not_le, b0, abs_of_neg, abs_of_nonneg] },
  refine this.mp ⟨λ h, _, λ h, by simp only [le_antisymm h b0, abs_of_neg a0, add_zero]⟩,
  obtain ab | ab := le_or_lt (a + b) 0,
  { refine le_of_eq (eq_zero_of_neg_eq _),
    rwa [abs_of_nonpos ab, neg_add_rev, add_comm, add_right_inj] at h },
  { refine (lt_irrefl (0 : α) _).elim,
    rw [abs_of_pos ab, add_left_inj] at h,
    rwa eq_zero_of_neg_eq h.symm at a0 }
end

lemma abs_add_eq_add_abs_iff (a b : α) : |a + b| = |a| + |b| ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
begin
  obtain ab | ab := le_total a b,
  { exact abs_add_eq_add_abs_le ab },
  { rw [add_comm a, add_comm (abs _), abs_add_eq_add_abs_le ab, and.comm, @and.comm (b ≤ 0)] }
end

end linear_ordered_add_comm_group

@[simp] lemma with_bot.coe_nsmul [add_monoid A] (a : A) (n : ℕ) :
  ((n • a : A) : with_bot A) = n • a :=
add_monoid_hom.map_nsmul ⟨(coe : A → with_bot A), with_bot.coe_zero, with_bot.coe_add⟩ a n

theorem nsmul_eq_mul' [non_assoc_semiring R] (a : R) (n : ℕ) : n • a = a * n :=
by induction n with n ih; [rw [zero_nsmul, nat.cast_zero, mul_zero],
  rw [succ_nsmul', ih, nat.cast_succ, mul_add, mul_one]]

@[simp] theorem nsmul_eq_mul [non_assoc_semiring R] (n : ℕ) (a : R) : n • a = n * a :=
by rw [nsmul_eq_mul', (n.cast_commute a).eq]

/-- Note that `add_comm_monoid.nat_smul_comm_class` requires stronger assumptions on `R`. -/
instance non_unital_non_assoc_semiring.nat_smul_comm_class [non_unital_non_assoc_semiring R] :
  smul_comm_class ℕ R R :=
⟨λ n x y, match n with
  | 0 := by simp_rw [zero_nsmul, smul_eq_mul, mul_zero]
  | (n + 1) := by simp_rw [succ_nsmul, smul_eq_mul, mul_add, ←smul_eq_mul, _match n]
  end⟩

/-- Note that `add_comm_monoid.nat_is_scalar_tower` requires stronger assumptions on `R`. -/
instance non_unital_non_assoc_semiring.nat_is_scalar_tower [non_unital_non_assoc_semiring R] :
  is_scalar_tower ℕ R R :=
⟨λ n x y, match n with
  | 0 := by simp_rw [zero_nsmul, smul_eq_mul, zero_mul]
  | (n + 1) := by simp_rw [succ_nsmul, ←_match n, smul_eq_mul, add_mul]
  end⟩

@[simp, norm_cast] theorem nat.cast_pow [semiring R] (n m : ℕ) : (↑(n ^ m) : R) = ↑n ^ m :=
begin
  induction m with m ih,
  { rw [pow_zero, pow_zero], exact nat.cast_one },
  { rw [pow_succ', pow_succ', nat.cast_mul, ih] }
end

@[simp, norm_cast] theorem int.coe_nat_pow (n m : ℕ) : ((n ^ m : ℕ) : ℤ) = n ^ m :=
by induction m with m ih; [exact int.coe_nat_one, rw [pow_succ', pow_succ', int.coe_nat_mul, ih]]

theorem int.nat_abs_pow (n : ℤ) (k : ℕ) : int.nat_abs (n ^ k) = (int.nat_abs n) ^ k :=
by induction k with k ih; [refl, rw [pow_succ', int.nat_abs_mul, pow_succ', ih]]

-- The next four lemmas allow us to replace multiplication by a numeral with a `zsmul` expression.
-- They are used by the `noncomm_ring` tactic, to normalise expressions before passing to `abel`.

lemma bit0_mul [non_unital_non_assoc_ring R] {n r : R} : bit0 n * r = (2 : ℤ) • (n * r) :=
by { dsimp [bit0], rw [add_mul, add_zsmul, one_zsmul], }

lemma mul_bit0 [non_unital_non_assoc_ring R] {n r : R} : r * bit0 n = (2 : ℤ) • (r * n) :=
by { dsimp [bit0], rw [mul_add, add_zsmul, one_zsmul], }

lemma bit1_mul [non_assoc_ring R] {n r : R} : bit1 n * r = (2 : ℤ) • (n * r) + r :=
by { dsimp [bit1], rw [add_mul, bit0_mul, one_mul], }

lemma mul_bit1 [non_assoc_ring R] {n r : R} : r * bit1 n = (2 : ℤ) • (r * n) + r :=
by { dsimp [bit1], rw [mul_add, mul_bit0, mul_one], }

@[simp] theorem zsmul_eq_mul [ring R] (a : R) : ∀ (n : ℤ), n • a = n * a
| (n : ℕ) := by rw [coe_nat_zsmul, nsmul_eq_mul, int.cast_coe_nat]
| -[1+ n] := by simp [nat.cast_succ, neg_add_rev, int.cast_neg_succ_of_nat, add_mul]

theorem zsmul_eq_mul' [ring R] (a : R) (n : ℤ) : n • a = a * n :=
by rw [zsmul_eq_mul, (n.cast_commute a).eq]

/-- Note that `add_comm_group.int_smul_comm_class` requires stronger assumptions on `R`. -/
instance non_unital_non_assoc_ring.int_smul_comm_class [non_unital_non_assoc_ring R] :
  smul_comm_class ℤ R R :=
⟨λ n x y, match n with
  | (n : ℕ) := by simp_rw [coe_nat_zsmul, smul_comm]
  | -[1+n]  := by simp_rw [zsmul_neg_succ_of_nat, smul_eq_mul, mul_neg, mul_smul_comm]
  end⟩

/-- Note that `add_comm_group.int_is_scalar_tower` requires stronger assumptions on `R`. -/
instance non_unital_non_assoc_ring.int_is_scalar_tower [non_unital_non_assoc_ring R] :
  is_scalar_tower ℤ R R :=
⟨λ n x y, match n with
  | (n : ℕ) := by simp_rw [coe_nat_zsmul, smul_assoc]
  | -[1+n]  := by simp_rw [zsmul_neg_succ_of_nat, smul_eq_mul, neg_mul, smul_mul_assoc]
  end⟩

lemma zsmul_int_int (a b : ℤ) : a • b = a * b := by simp

lemma zsmul_int_one (n : ℤ) : n • 1 = n := by simp

@[simp, norm_cast] theorem int.cast_pow [ring R] (n : ℤ) (m : ℕ) : (↑(n ^ m) : R) = ↑n ^ m :=
begin
  induction m with m ih,
  { rw [pow_zero, pow_zero, int.cast_one] },
  { rw [pow_succ, pow_succ, int.cast_mul, ih] }
end

lemma neg_one_pow_eq_pow_mod_two [ring R] {n : ℕ} : (-1 : R) ^ n = (-1) ^ (n % 2) :=
by rw [← nat.mod_add_div n 2, pow_add, pow_mul]; simp [sq]

section strict_ordered_semiring
variables [strict_ordered_semiring R] {a : R}

/-- Bernoulli's inequality. This version works for semirings but requires
additional hypotheses `0 ≤ a * a` and `0 ≤ (1 + a) * (1 + a)`. -/
theorem one_add_mul_le_pow' (Hsq : 0 ≤ a * a) (Hsq' : 0 ≤ (1 + a) * (1 + a))
  (H : 0 ≤ 2 + a) :
  ∀ (n : ℕ), 1 + (n : R) * a ≤ (1 + a) ^ n
| 0     := by simp
| 1     := by simp
| (n+2) :=
have 0 ≤ (n : R) * (a * a * (2 + a)) + a * a,
  from add_nonneg (mul_nonneg n.cast_nonneg (mul_nonneg Hsq H)) Hsq,
calc 1 + (↑(n + 2) : R) * a ≤ 1 + ↑(n + 2) * a + (n * (a * a * (2 + a)) + a * a) :
  (le_add_iff_nonneg_right _).2 this
... = (1 + a) * (1 + a) * (1 + n * a) :
  by { simp [add_mul, mul_add, bit0, mul_assoc, (n.cast_commute (_ : R)).left_comm],
       ac_refl }
... ≤ (1 + a) * (1 + a) * (1 + a)^n :
  mul_le_mul_of_nonneg_left (one_add_mul_le_pow' n) Hsq'
... = (1 + a)^(n + 2) : by simp only [pow_succ, mul_assoc]

private lemma pow_le_pow_of_le_one_aux (h : 0 ≤ a) (ha : a ≤ 1) (i : ℕ) :
  ∀ k : ℕ, a ^ (i + k) ≤ a ^ i
| 0 := by simp
| (k+1) := by { rw [←add_assoc, ←one_mul (a^i), pow_succ],
                exact mul_le_mul ha (pow_le_pow_of_le_one_aux _) (pow_nonneg h _) zero_le_one }

lemma pow_le_pow_of_le_one (h : 0 ≤ a) (ha : a ≤ 1) {i j : ℕ} (hij : i ≤ j) :
  a ^ j ≤ a ^ i :=
let ⟨k, hk⟩ := nat.exists_eq_add_of_le hij in
by rw hk; exact pow_le_pow_of_le_one_aux h ha _ _

lemma pow_le_of_le_one (h₀ : 0 ≤ a) (h₁ : a ≤ 1) {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ a :=
(pow_one a).subst (pow_le_pow_of_le_one h₀ h₁ (nat.pos_of_ne_zero hn))

lemma sq_le (h₀ : 0 ≤ a) (h₁ : a ≤ 1) : a ^ 2 ≤ a := pow_le_of_le_one h₀ h₁ two_ne_zero

end strict_ordered_semiring

section linear_ordered_semiring

variables [linear_ordered_semiring R]

lemma sign_cases_of_C_mul_pow_nonneg {C r : R} (h : ∀ n : ℕ, 0 ≤ C * r ^ n) :
  C = 0 ∨ (0 < C ∧ 0 ≤ r) :=
begin
  have : 0 ≤ C, by simpa only [pow_zero, mul_one] using h 0,
  refine this.eq_or_lt.elim (λ h, or.inl h.symm) (λ hC, or.inr ⟨hC, _⟩),
  refine nonneg_of_mul_nonneg_right _ hC,
  simpa only [pow_one] using h 1
end

end linear_ordered_semiring

section linear_ordered_ring

variables [linear_ordered_ring R] {a : R} {n : ℕ}

@[simp] lemma abs_pow (a : R) (n : ℕ) : |a ^ n| = |a| ^ n :=
(pow_abs a n).symm

@[simp] theorem pow_bit1_neg_iff : a ^ bit1 n < 0 ↔ a < 0 :=
⟨λ h, not_le.1 $ λ h', not_le.2 h $ pow_nonneg h' _, λ ha, pow_bit1_neg ha n⟩

@[simp] theorem pow_bit1_nonneg_iff : 0 ≤ a ^ bit1 n ↔ 0 ≤ a :=
le_iff_le_iff_lt_iff_lt.2 pow_bit1_neg_iff

@[simp] theorem pow_bit1_nonpos_iff : a ^ bit1 n ≤ 0 ↔ a ≤ 0 :=
by simp only [le_iff_lt_or_eq, pow_bit1_neg_iff, pow_eq_zero_iff (bit1_pos (zero_le n))]

@[simp] theorem pow_bit1_pos_iff : 0 < a ^ bit1 n ↔ 0 < a :=
lt_iff_lt_of_le_iff_le pow_bit1_nonpos_iff

lemma strict_mono_pow_bit1 (n : ℕ) : strict_mono (λ a : R, a ^ bit1 n) :=
begin
  intros a b hab,
  cases le_total a 0 with ha ha,
  { cases le_or_lt b 0 with hb hb,
    { rw [← neg_lt_neg_iff, ← neg_pow_bit1, ← neg_pow_bit1],
      exact pow_lt_pow_of_lt_left (neg_lt_neg hab) (neg_nonneg.2 hb) (bit1_pos (zero_le n)) },
    { exact (pow_bit1_nonpos_iff.2 ha).trans_lt (pow_bit1_pos_iff.2 hb) } },
  { exact pow_lt_pow_of_lt_left hab ha (bit1_pos (zero_le n)) }
end

/-- Bernoulli's inequality for `n : ℕ`, `-2 ≤ a`. -/
theorem one_add_mul_le_pow (H : -2 ≤ a) (n : ℕ) : 1 + (n : R) * a ≤ (1 + a) ^ n :=
one_add_mul_le_pow' (mul_self_nonneg _) (mul_self_nonneg _) (neg_le_iff_add_nonneg'.1 H) _

/-- Bernoulli's inequality reformulated to estimate `a^n`. -/
theorem one_add_mul_sub_le_pow (H : -1 ≤ a) (n : ℕ) : 1 + (n : R) * (a - 1) ≤ a ^ n :=
have -2 ≤ a - 1, by rwa [bit0, neg_add, ← sub_eq_add_neg, sub_le_sub_iff_right],
by simpa only [add_sub_cancel'_right] using one_add_mul_le_pow this n

end linear_ordered_ring

namespace int

lemma nat_abs_sq (x : ℤ) : (x.nat_abs ^ 2 : ℤ) = x ^ 2 := by rw [sq, int.nat_abs_mul_self', sq]

alias nat_abs_sq ← nat_abs_pow_two

lemma abs_le_self_sq (a : ℤ) : (int.nat_abs a : ℤ) ≤ a ^ 2 :=
by { rw [← int.nat_abs_sq a, sq], norm_cast, apply nat.le_mul_self }

alias abs_le_self_sq ← abs_le_self_pow_two

lemma le_self_sq (b : ℤ) : b ≤ b ^ 2 := le_trans (le_nat_abs) (abs_le_self_sq _)

alias le_self_sq ← le_self_pow_two

lemma pow_right_injective {x : ℤ} (h : 1 < x.nat_abs) : function.injective ((^) x : ℕ → ℤ) :=
begin
  suffices : function.injective (nat_abs ∘ ((^) x : ℕ → ℤ)),
  { exact function.injective.of_comp this },
  convert nat.pow_right_injective h,
  ext n,
  rw [function.comp_app, nat_abs_pow]
end

end int

variables (M G A)

/-- Monoid homomorphisms from `multiplicative ℕ` are defined by the image
of `multiplicative.of_add 1`. -/
def powers_hom [monoid M] : M ≃ (multiplicative ℕ →* M) :=
{ to_fun := λ x, ⟨λ n, x ^ n.to_add, by { convert pow_zero x, exact to_add_one },
    λ m n, pow_add x m n⟩,
  inv_fun := λ f, f (multiplicative.of_add 1),
  left_inv := pow_one,
  right_inv := λ f, monoid_hom.ext $ λ n, by { simp [← f.map_pow, ← of_add_nsmul] } }

/-- Monoid homomorphisms from `multiplicative ℤ` are defined by the image
of `multiplicative.of_add 1`. -/
def zpowers_hom [group G] : G ≃ (multiplicative ℤ →* G) :=
{ to_fun := λ x, ⟨λ n, x ^ n.to_add, zpow_zero x, λ m n, zpow_add x m n⟩,
  inv_fun := λ f, f (multiplicative.of_add 1),
  left_inv := zpow_one,
  right_inv := λ f, monoid_hom.ext $ λ n, by { simp [← f.map_zpow, ← of_add_zsmul ] } }

/-- Additive homomorphisms from `ℕ` are defined by the image of `1`. -/
def multiples_hom [add_monoid A] : A ≃ (ℕ →+ A) :=
{ to_fun := λ x, ⟨λ n, n • x, zero_nsmul x, λ m n, add_nsmul _ _ _⟩,
  inv_fun := λ f, f 1,
  left_inv := one_nsmul,
  right_inv := λ f, add_monoid_hom.ext_nat $ one_nsmul (f 1) }

/-- Additive homomorphisms from `ℤ` are defined by the image of `1`. -/
def zmultiples_hom [add_group A] : A ≃ (ℤ →+ A) :=
{ to_fun := λ x, ⟨λ n, n • x, zero_zsmul x, λ m n, add_zsmul _ _ _⟩,
  inv_fun := λ f, f 1,
  left_inv := one_zsmul,
  right_inv := λ f, add_monoid_hom.ext_int $ one_zsmul (f 1) }

attribute [to_additive multiples_hom] powers_hom
attribute [to_additive zmultiples_hom] zpowers_hom

variables {M G A}

@[simp] lemma powers_hom_apply [monoid M] (x : M) (n : multiplicative ℕ) :
  powers_hom M x n = x ^ n.to_add := rfl

@[simp] lemma powers_hom_symm_apply [monoid M] (f : multiplicative ℕ →* M) :
  (powers_hom M).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma zpowers_hom_apply [group G] (x : G) (n : multiplicative ℤ) :
  zpowers_hom G x n = x ^ n.to_add := rfl

@[simp] lemma zpowers_hom_symm_apply [group G] (f : multiplicative ℤ →* G) :
  (zpowers_hom G).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma multiples_hom_apply [add_monoid A] (x : A) (n : ℕ) :
  multiples_hom A x n = n • x := rfl

attribute [to_additive multiples_hom_apply] powers_hom_apply

@[simp] lemma multiples_hom_symm_apply [add_monoid A] (f : ℕ →+ A) :
  (multiples_hom A).symm f = f 1 := rfl

attribute [to_additive multiples_hom_symm_apply] powers_hom_symm_apply

@[simp] lemma zmultiples_hom_apply [add_group A] (x : A) (n : ℤ) :
  zmultiples_hom A x n = n • x := rfl

attribute [to_additive zmultiples_hom_apply] zpowers_hom_apply

@[simp] lemma zmultiples_hom_symm_apply [add_group A] (f : ℤ →+ A) :
  (zmultiples_hom A).symm f = f 1 := rfl

attribute [to_additive zmultiples_hom_symm_apply] zpowers_hom_symm_apply

-- TODO use to_additive in the rest of this file

lemma monoid_hom.apply_mnat [monoid M] (f : multiplicative ℕ →* M) (n : multiplicative ℕ) :
  f n = (f (multiplicative.of_add 1)) ^ n.to_add :=
by rw [← powers_hom_symm_apply, ← powers_hom_apply, equiv.apply_symm_apply]

@[ext] lemma monoid_hom.ext_mnat [monoid M] ⦃f g : multiplicative ℕ →* M⦄
  (h : f (multiplicative.of_add 1) = g (multiplicative.of_add 1)) : f = g :=
monoid_hom.ext $ λ n, by rw [f.apply_mnat, g.apply_mnat, h]

lemma monoid_hom.apply_mint [group M] (f : multiplicative ℤ →* M) (n : multiplicative ℤ) :
  f n = (f (multiplicative.of_add 1)) ^ n.to_add :=
by rw [← zpowers_hom_symm_apply, ← zpowers_hom_apply, equiv.apply_symm_apply]

/-! `monoid_hom.ext_mint` is defined in `data.int.cast` -/

lemma add_monoid_hom.apply_nat [add_monoid M] (f : ℕ →+ M) (n : ℕ) :
  f n = n • (f 1) :=
by rw [← multiples_hom_symm_apply, ← multiples_hom_apply, equiv.apply_symm_apply]

/-! `add_monoid_hom.ext_nat` is defined in `data.nat.cast` -/

lemma add_monoid_hom.apply_int [add_group M] (f : ℤ →+ M) (n : ℤ) :
  f n = n • (f 1) :=
by rw [← zmultiples_hom_symm_apply, ← zmultiples_hom_apply, equiv.apply_symm_apply]

/-! `add_monoid_hom.ext_int` is defined in `data.int.cast` -/

variables (M G A)

/-- If `M` is commutative, `powers_hom` is a multiplicative equivalence. -/
def powers_mul_hom [comm_monoid M] : M ≃* (multiplicative ℕ →* M) :=
{ map_mul' := λ a b, monoid_hom.ext $ by simp [mul_pow],
  ..powers_hom M}

/-- If `M` is commutative, `zpowers_hom` is a multiplicative equivalence. -/
def zpowers_mul_hom [comm_group G] : G ≃* (multiplicative ℤ →* G) :=
{ map_mul' := λ a b, monoid_hom.ext $ by simp [mul_zpow],
  ..zpowers_hom G}

/-- If `M` is commutative, `multiples_hom` is an additive equivalence. -/
def multiples_add_hom [add_comm_monoid A] : A ≃+ (ℕ →+ A) :=
{ map_add' := λ a b, add_monoid_hom.ext $ by simp [nsmul_add],
  ..multiples_hom A}

/-- If `M` is commutative, `zmultiples_hom` is an additive equivalence. -/
def zmultiples_add_hom [add_comm_group A] : A ≃+ (ℤ →+ A) :=
{ map_add' := λ a b, add_monoid_hom.ext $ by simp [zsmul_add],
  ..zmultiples_hom A}

variables {M G A}

@[simp] lemma powers_mul_hom_apply [comm_monoid M] (x : M) (n : multiplicative ℕ) :
  powers_mul_hom M x n = x ^ n.to_add := rfl

@[simp] lemma powers_mul_hom_symm_apply [comm_monoid M] (f : multiplicative ℕ →* M) :
  (powers_mul_hom M).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma zpowers_mul_hom_apply [comm_group G] (x : G) (n : multiplicative ℤ) :
  zpowers_mul_hom G x n = x ^ n.to_add := rfl

@[simp] lemma zpowers_mul_hom_symm_apply [comm_group G] (f : multiplicative ℤ →* G) :
  (zpowers_mul_hom G).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma multiples_add_hom_apply [add_comm_monoid A] (x : A) (n : ℕ) :
  multiples_add_hom A x n = n • x := rfl

@[simp] lemma multiples_add_hom_symm_apply [add_comm_monoid A] (f : ℕ →+ A) :
  (multiples_add_hom A).symm f = f 1 := rfl

@[simp] lemma zmultiples_add_hom_apply [add_comm_group A] (x : A) (n : ℤ) :
  zmultiples_add_hom A x n = n • x := rfl

@[simp] lemma zmultiples_add_hom_symm_apply [add_comm_group A] (f : ℤ →+ A) :
  (zmultiples_add_hom A).symm f = f 1 := rfl

/-!
### Commutativity (again)

Facts about `semiconj_by` and `commute` that require `zpow` or `zsmul`, or the fact that integer
multiplication equals semiring multiplication.
-/

namespace semiconj_by

section

variables [semiring R] {a x y : R}

@[simp] lemma cast_nat_mul_right (h : semiconj_by a x y) (n : ℕ) :
  semiconj_by a ((n : R) * x) (n * y) :=
semiconj_by.mul_right (nat.commute_cast _ _) h

@[simp] lemma cast_nat_mul_left (h : semiconj_by a x y) (n : ℕ) : semiconj_by ((n : R) * a) x y :=
semiconj_by.mul_left (nat.cast_commute _ _) h

@[simp] lemma cast_nat_mul_cast_nat_mul (h : semiconj_by a x y) (m n : ℕ) :
  semiconj_by ((m : R) * a) (n * x) (n * y) :=
(h.cast_nat_mul_left m).cast_nat_mul_right n

end

variables [monoid M] [group G] [ring R]

@[simp, to_additive] lemma units_zpow_right {a : M} {x y : Mˣ} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (↑(x^m)) (↑(y^m))
| (n : ℕ) := by simp only [zpow_coe_nat, units.coe_pow, h, pow_right]
| -[1+n] := by simp only [zpow_neg_succ_of_nat, units.coe_pow, units_inv_right, h, pow_right]

variables {a b x y x' y' : R}

@[simp] lemma cast_int_mul_right (h : semiconj_by a x y) (m : ℤ) :
  semiconj_by a ((m : ℤ) * x) (m * y) :=
semiconj_by.mul_right (int.commute_cast _ _) h

@[simp] lemma cast_int_mul_left (h : semiconj_by a x y) (m : ℤ) : semiconj_by ((m : R) * a) x y :=
semiconj_by.mul_left (int.cast_commute _ _) h

@[simp] lemma cast_int_mul_cast_int_mul (h : semiconj_by a x y) (m n : ℤ) :
  semiconj_by ((m : R) * a) (n * x) (n * y) :=
(h.cast_int_mul_left m).cast_int_mul_right n

end semiconj_by

namespace commute

section

variables [semiring R] {a b : R}

@[simp] theorem cast_nat_mul_right (h : commute a b) (n : ℕ) : commute a ((n : R) * b) :=
h.cast_nat_mul_right n

@[simp] theorem cast_nat_mul_left (h : commute a b) (n : ℕ) : commute ((n : R) * a) b :=
h.cast_nat_mul_left n

@[simp] theorem cast_nat_mul_cast_nat_mul (h : commute a b) (m n : ℕ) :
  commute (m * a : R) (n * b : R) :=
h.cast_nat_mul_cast_nat_mul m n

variables (a) (m n : ℕ)

@[simp] lemma self_cast_nat_mul : commute a (n * a : R) := (commute.refl a).cast_nat_mul_right n
@[simp] lemma cast_nat_mul_self : commute ((n : R) * a) a := (commute.refl a).cast_nat_mul_left n

@[simp] theorem self_cast_nat_mul_cast_nat_mul : commute (m * a : R) (n * a : R) :=
(commute.refl a).cast_nat_mul_cast_nat_mul m n

end

variables [monoid M] [group G] [ring R]

@[simp, to_additive] lemma units_zpow_right {a : M} {u : Mˣ} (h : commute a u) (m : ℤ) :
  commute a (↑(u^m)) :=
h.units_zpow_right m

@[simp, to_additive] lemma units_zpow_left {u : Mˣ} {a : M} (h : commute ↑u a) (m : ℤ) :
  commute (↑(u^m)) a :=
(h.symm.units_zpow_right m).symm

variables {a b : R}

@[simp] lemma cast_int_mul_right (h : commute a b) (m : ℤ) : commute a (m * b : R) :=
h.cast_int_mul_right m

@[simp] lemma cast_int_mul_left (h : commute a b) (m : ℤ) : commute ((m : R) * a) b :=
h.cast_int_mul_left m

lemma cast_int_mul_cast_int_mul (h : commute a b) (m n : ℤ) : commute (m * a : R) (n * b : R) :=
h.cast_int_mul_cast_int_mul m n

variables (a) (m n : ℤ)

@[simp] lemma cast_int_left : commute (m : R) a := int.cast_commute _ _
@[simp] lemma cast_int_right : commute a m := int.commute_cast _ _

@[simp] theorem self_cast_int_mul : commute a (n * a : R) := (commute.refl a).cast_int_mul_right n

@[simp] theorem cast_int_mul_self : commute ((n : R) * a) a := (commute.refl a).cast_int_mul_left n

theorem self_cast_int_mul_cast_int_mul : commute (m * a : R) (n * a : R) :=
(commute.refl a).cast_int_mul_cast_int_mul m n

end commute

section multiplicative

open multiplicative

@[simp] lemma nat.to_add_pow (a : multiplicative ℕ) (b : ℕ) : to_add (a ^ b) = to_add a * b :=
begin
  induction b with b ih,
  { erw [pow_zero, to_add_one, mul_zero] },
  { simp [*, pow_succ, add_comm, nat.mul_succ] }
end

@[simp] lemma nat.of_add_mul (a b : ℕ) : of_add (a * b) = of_add a ^ b :=
(nat.to_add_pow _ _).symm

@[simp] lemma int.to_add_pow (a : multiplicative ℤ) (b : ℕ) : to_add (a ^ b) = to_add a * b :=
by induction b; simp [*, mul_add, pow_succ, add_comm]

@[simp] lemma int.to_add_zpow (a : multiplicative ℤ) (b : ℤ) : to_add (a ^ b) = to_add a * b :=
int.induction_on b (by simp)
  (by simp [zpow_add, mul_add] {contextual := tt})
  (by simp [zpow_add, mul_add, sub_eq_add_neg, -int.add_neg_one] {contextual := tt})

@[simp] lemma int.of_add_mul (a b : ℤ) : of_add (a * b) = of_add a ^ b :=
(int.to_add_zpow _ _).symm

end multiplicative

namespace units

variables [monoid M]

lemma conj_pow (u : Mˣ) (x : M) (n : ℕ) : (↑u * x * ↑(u⁻¹))^n = u * x^n * ↑(u⁻¹) :=
(divp_eq_iff_mul_eq.2 ((u.mk_semiconj_by x).pow_right n).eq.symm).symm

lemma conj_pow' (u : Mˣ) (x : M) (n : ℕ) : (↑(u⁻¹) * x * u)^n = ↑(u⁻¹) * x^n * u:=
(u⁻¹).conj_pow x n

end units

namespace mul_opposite

/-- Moving to the opposite monoid commutes with taking powers. -/
@[simp] lemma op_pow [monoid M] (x : M) (n : ℕ) : op (x ^ n) = (op x) ^ n := rfl
@[simp] lemma unop_pow [monoid M] (x : Mᵐᵒᵖ) (n : ℕ) : unop (x ^ n) = (unop x) ^ n := rfl

/-- Moving to the opposite group or group_with_zero commutes with taking powers. -/
@[simp] lemma op_zpow [div_inv_monoid M] (x : M) (z : ℤ) : op (x ^ z) = (op x) ^ z := rfl
@[simp] lemma unop_zpow [div_inv_monoid M] (x : Mᵐᵒᵖ) (z : ℤ) : unop (x ^ z) = (unop x) ^ z := rfl

end mul_opposite


/-
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

! This file was ported from Lean 3 source module topology.order.hom.basic
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Hom.Basic
import Mathlib.Topology.ContinuousFunction.Basic

/-!
# Continuous order homomorphisms

This file defines continuous order homomorphisms, that is maps which are both continuous and
monotone. They are also called Priestley homomorphisms because they are the morphisms of the
category of Priestley spaces.

We use the `FunLike` design, so each type of morphisms has a companion typeclass which is meant to
be satisfied by itself and all stricter types.

## Types of morphisms

* `ContinuousOrderHom`: Continuous monotone functions, aka Priestley homomorphisms.

## Typeclasses

* `ContinuousOrderHomClass`
-/

open Function

variable {F α β γ δ : Type _}

/-- The type of continuous monotone maps from `α` to `β`, aka Priestley homomorphisms. -/
structure ContinuousOrderHom (α β : Type _) [Preorder α] [Preorder β] [TopologicalSpace α]
  [TopologicalSpace β] extends OrderHom α β where
  continuous_toFun : Continuous toFun
#align continuous_order_hom ContinuousOrderHom

-- mathport name: «expr →Co »
infixr:25 " →Co " => ContinuousOrderHom

section

-- porting note: extending `ContinuousMapClass` instead of `OrderHomClass`
/-- `ContinuousOrderHomClass F α β` states that `F` is a type of continuous monotone maps.

You should extend this class when you extend `ContinuousOrderHom`. -/
class ContinuousOrderHomClass (F : Type _) (α β : outParam <| Type _) [Preorder α] [Preorder β]
    [TopologicalSpace α] [TopologicalSpace β] extends
    ContinuousMapClass F α β where
  map_monotone (f : F) : Monotone f
#align continuous_order_hom_class ContinuousOrderHomClass

end

-- See note [lower instance priority]
instance (priority := 100) ContinuousOrderHomClass.toOrderHomClass {_ : Preorder α} {_ : Preorder β}
    {_ : TopologicalSpace α} {_ : TopologicalSpace β} [ContinuousOrderHomClass F α β] :
    OrderHomClass F α β :=
  { ‹ContinuousOrderHomClass F α β› with
    map_rel := ContinuousOrderHomClass.map_monotone }
#align continuous_order_hom_class.to_continuous_map_class ContinuousOrderHomClass.toContinuousMapClass

instance [Preorder α] [Preorder β] [TopologicalSpace α] [TopologicalSpace β]
    [ContinuousOrderHomClass F α β] : CoeTC F (α →Co β) :=
  ⟨fun f =>
    { toFun := f
      monotone' := ContinuousOrderHomClass.map_monotone f
      continuous_toFun := map_continuous f }⟩

/-! ### Top homomorphisms -/

namespace ContinuousOrderHom

variable [TopologicalSpace α] [Preorder α] [TopologicalSpace β]

section Preorder

variable [Preorder β] [TopologicalSpace γ] [Preorder γ] [TopologicalSpace δ] [Preorder δ]

/-- Reinterpret a `ContinuousOrderHom` as a `ContinuousMap`. -/
def toContinuousMap (f : α →Co β) : C(α, β) :=
  { f with }
#align continuous_order_hom.to_continuous_map ContinuousOrderHom.toContinuousMap

instance : ContinuousOrderHomClass (α →Co β) α β where
  coe f := f.toFun
  coe_injective' f g h := by
    obtain ⟨⟨_, _⟩, _⟩ := f
    obtain ⟨⟨_, _⟩, _⟩ := g
    congr
  map_monotone f := f.monotone'
  map_continuous f := f.continuous_toFun

-- porting note: new lemma
@[simp] theorem coe_toOrderHom (f : α →Co β) : ⇑f.toOrderHom = f := rfl

theorem toFun_eq_coe {f : α →Co β} : f.toFun = (f : α → β) := rfl
#align continuous_order_hom.to_fun_eq_coe ContinuousOrderHom.toFun_eq_coe

@[ext]
theorem ext {f g : α →Co β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align continuous_order_hom.ext ContinuousOrderHom.ext

/-- Copy of a `ContinuousOrderHom` with a new `ContinuousMap` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : α →Co β) (f' : α → β) (h : f' = f) : α →Co β :=
  ⟨f.toOrderHom.copy f' h, h.symm.subst f.continuous_toFun⟩
#align continuous_order_hom.copy ContinuousOrderHom.copy

@[simp]
theorem coe_copy (f : α →Co β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align continuous_order_hom.coe_copy ContinuousOrderHom.coe_copy

theorem copy_eq (f : α →Co β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align continuous_order_hom.copy_eq ContinuousOrderHom.copy_eq

variable (α)

/-- `id` as a `ContinuousOrderHom`. -/
protected def id : α →Co α :=
  ⟨OrderHom.id, continuous_id⟩
#align continuous_order_hom.id ContinuousOrderHom.id

instance : Inhabited (α →Co α) :=
  ⟨ContinuousOrderHom.id _⟩

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

variable {α}

@[simp]
theorem id_apply (a : α) : ContinuousOrderHom.id α a = a :=
  rfl
#align continuous_order_hom.id_apply ContinuousOrderHom.id_apply

/-- Composition of `ContinuousOrderHom`s as a `ContinuousOrderHom`. -/
def comp (f : β →Co γ) (g : α →Co β) : ContinuousOrderHom α γ :=
  ⟨f.toOrderHom.comp g.toOrderHom, f.continuous_toFun.comp g.continuous_toFun⟩
#align continuous_order_hom.comp ContinuousOrderHom.comp

@[simp]
theorem coe_comp (f : β →Co γ) (g : α →Co β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align continuous_order_hom.coe_comp ContinuousOrderHom.coe_comp

@[simp]
theorem comp_apply (f : β →Co γ) (g : α →Co β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align continuous_order_hom.comp_apply ContinuousOrderHom.comp_apply

@[simp]
theorem comp_assoc (f : γ →Co δ) (g : β →Co γ) (h : α →Co β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align continuous_order_hom.comp_assoc ContinuousOrderHom.comp_assoc

@[simp]
theorem comp_id (f : α →Co β) : f.comp (ContinuousOrderHom.id α) = f :=
  ext fun _ => rfl
#align continuous_order_hom.comp_id ContinuousOrderHom.comp_id

@[simp]
theorem id_comp (f : α →Co β) : (ContinuousOrderHom.id β).comp f = f :=
  ext fun _ => rfl
#align continuous_order_hom.id_comp ContinuousOrderHom.id_comp

theorem cancel_right {g₁ g₂ : β →Co γ} {f : α →Co β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun h => congr_arg₂ _ h rfl⟩
#align continuous_order_hom.cancel_right ContinuousOrderHom.cancel_right

theorem cancel_left {g : β →Co γ} {f₁ f₂ : α →Co β} (hg : 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 continuous_order_hom.cancel_left ContinuousOrderHom.cancel_left

instance : Preorder (α →Co β) :=
  Preorder.lift ((↑) : (α →Co β) → α → β)

end Preorder

instance [PartialOrder β] : PartialOrder (α →Co β) :=
  PartialOrder.lift ((↑) : (α →Co β) → α → β) FunLike.coe_injective

end ContinuousOrderHom


namespace prop_07

variable P : Prop

theorem prop_7 : P → ¬ ¬ P :=
assume h1: P,
assume h2: ¬ P,
show false, from h2 h1

-- end namespace
end prop_07


-- Definición del conjunto potencia
-- ================================

variable {U : Type}

def powerset (A : set U) : set (set U) :=
  {B : set U | B ⊆ A}

example
  (A B : set U)
  (h : B ∈ powerset A)
  : B ⊆ A :=
h


-- Producto dividible por seis
-- ===========================

import tactic

lemma six_div
  (n : ℤ)
  : 6 ∣ (n*(n-1)*(2*n-1)) :=
begin
  apply int.induction_on n; clear n,
  { simp },
  { rintro i ⟨m, hn⟩,
    use m+i^2,
    rw [mul_add (6 : ℤ), ← hn],
    ring },
  { rintro i ⟨m, hn⟩,
    use m-(i+1)^2,
    rw [mul_sub (6 : ℤ), ← hn],
    ring, },
end