/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

! This file was ported from Lean 3 source module topology.algebra.ring.basic
! leanprover-community/mathlib commit 9a59dcb7a2d06bf55da57b9030169219980660cd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Prod
import Mathlib.RingTheory.Subring.Basic
import Mathlib.Topology.Algebra.Group.Basic

/-!

# Topological (semi)rings

A topological (semi)ring is a (semi)ring equipped with a topology such that all operations are
continuous. Besides this definition, this file proves that the topological closure of a subring
(resp. an ideal) is a subring (resp. an ideal) and defines products and quotients
of topological (semi)rings.

## Main Results

- `Subring.topologicalClosure`/`Subsemiring.topologicalClosure`: the topological closure of a
  `Subring`/`Subsemiring` is itself a `sub(semi)ring`.
- The product of two topological (semi)rings is a topological (semi)ring.
- The indexed product of topological (semi)rings is a topological (semi)ring.
-/

open Set Filter TopologicalSpace Function Topology Filter

section TopologicalSemiring

variable (α : Type _)

/-- a topological semiring is a semiring `R` where addition and multiplication are continuous.
We allow for non-unital and non-associative semirings as well.

The `TopologicalSemiring` class should *only* be instantiated in the presence of a
`NonUnitalNonAssocSemiring` instance; if there is an instance of `NonUnitalNonAssocRing`,
then `TopologicalRing` should be used. Note: in the presence of `NonAssocRing`, these classes are
mathematically equivalent (see `TopologicalSemiring.continuousNeg_of_mul` or
`TopologicalSemiring.toTopologicalRing`).  -/
class TopologicalSemiring [TopologicalSpace α] [NonUnitalNonAssocSemiring α] extends
  ContinuousAdd α, ContinuousMul α : Prop
#align topological_semiring TopologicalSemiring

/-- A topological ring is a ring `R` where addition, multiplication and negation are continuous.

If `R` is a (unital) ring, then continuity of negation can be derived from continuity of
multiplication as it is multiplication with `-1`. (See
`TopologicalSemiring.continuousNeg_of_mul` and
`topological_semiring.to_topological_add_group`) -/
class TopologicalRing [TopologicalSpace α] [NonUnitalNonAssocRing α] extends TopologicalSemiring α,
  ContinuousNeg α : Prop
#align topological_ring TopologicalRing

variable {α}

/-- If `R` is a ring with a continuous multiplication, then negation is continuous as well since it
is just multiplication with `-1`. -/
theorem TopologicalSemiring.continuousNeg_of_mul [TopologicalSpace α] [NonAssocRing α]
    [ContinuousMul α] : ContinuousNeg α where
  continuous_neg := by
    simpa using (continuous_const.mul continuous_id : Continuous fun x : α => -1 * x)
#align topological_semiring.has_continuous_neg_of_mul TopologicalSemiring.continuousNeg_of_mul

/-- If `R` is a ring which is a topological semiring, then it is automatically a topological
ring. This exists so that one can place a topological ring structure on `R` without explicitly
proving `continuous_neg`. -/
theorem TopologicalSemiring.toTopologicalRing [TopologicalSpace α] [NonAssocRing α]
    (_ : TopologicalSemiring α) : TopologicalRing α where
  toContinuousNeg := TopologicalSemiring.continuousNeg_of_mul
#align topological_semiring.to_topological_ring TopologicalSemiring.toTopologicalRing

-- See note [lower instance priority]
instance (priority := 100) TopologicalRing.to_topologicalAddGroup [NonUnitalNonAssocRing α]
    [TopologicalSpace α] [TopologicalRing α] : TopologicalAddGroup α := ⟨⟩
#align topological_ring.to_topological_add_group TopologicalRing.to_topologicalAddGroup

instance (priority := 50) DiscreteTopology.topologicalSemiring [TopologicalSpace α]
    [NonUnitalNonAssocSemiring α] [DiscreteTopology α] : TopologicalSemiring α := ⟨⟩
#align discrete_topology.topological_semiring DiscreteTopology.topologicalSemiring

instance (priority := 50) DiscreteTopology.topologicalRing [TopologicalSpace α]
    [NonUnitalNonAssocRing α] [DiscreteTopology α] : TopologicalRing α := ⟨⟩
#align discrete_topology.topological_ring DiscreteTopology.topologicalRing

section

variable [TopologicalSpace α] [Semiring α] [TopologicalSemiring α]

namespace Subsemiring

instance (S : Subsemiring α) : TopologicalSemiring S :=
  { S.toSubmonoid.continuousMul, S.toAddSubmonoid.continuousAdd with }

end Subsemiring

/-- The (topological-space) closure of a subsemiring of a topological semiring is
itself a subsemiring. -/
def Subsemiring.topologicalClosure (s : Subsemiring α) : Subsemiring α :=
  { s.toSubmonoid.topologicalClosure, s.toAddSubmonoid.topologicalClosure with
    carrier := _root_.closure (s : Set α) }
#align subsemiring.topological_closure Subsemiring.topologicalClosure

@[simp]
theorem Subsemiring.topologicalClosure_coe (s : Subsemiring α) :
    (s.topologicalClosure : Set α) = _root_.closure (s : Set α) :=
  rfl
#align subsemiring.topological_closure_coe Subsemiring.topologicalClosure_coe

theorem Subsemiring.le_topologicalClosure (s : Subsemiring α) : s ≤ s.topologicalClosure :=
  _root_.subset_closure
#align subsemiring.le_topological_closure Subsemiring.le_topologicalClosure

theorem Subsemiring.isClosed_topologicalClosure (s : Subsemiring α) :
    IsClosed (s.topologicalClosure : Set α) := isClosed_closure
#align subsemiring.is_closed_topological_closure Subsemiring.isClosed_topologicalClosure

theorem Subsemiring.topologicalClosure_minimal (s : Subsemiring α) {t : Subsemiring α} (h : s ≤ t)
    (ht : IsClosed (t : Set α)) : s.topologicalClosure ≤ t :=
  closure_minimal h ht
#align subsemiring.topological_closure_minimal Subsemiring.topologicalClosure_minimal

/-- If a subsemiring of a topological semiring is commutative, then so is its
topological closure. -/
def Subsemiring.commSemiringTopologicalClosure [T2Space α] (s : Subsemiring α)
    (hs : ∀ x y : s, x * y = y * x) : CommSemiring s.topologicalClosure :=
  { s.topologicalClosure.toSemiring, s.toSubmonoid.commMonoidTopologicalClosure hs with }
#align subsemiring.comm_semiring_topological_closure Subsemiring.commSemiringTopologicalClosure

end

section

variable {β : Type _} [TopologicalSpace α] [TopologicalSpace β]

/-- The product topology on the cartesian product of two topological semirings
  makes the product into a topological semiring. -/
instance [NonUnitalNonAssocSemiring α] [NonUnitalNonAssocSemiring β] [TopologicalSemiring α]
    [TopologicalSemiring β] : TopologicalSemiring (α × β) where

/-- The product topology on the cartesian product of two topological rings
  makes the product into a topological ring. -/
instance [NonUnitalNonAssocRing α] [NonUnitalNonAssocRing β] [TopologicalRing α]
    [TopologicalRing β] : TopologicalRing (α × β) where

end

instance {β : Type _} {C : β → Type _} [∀ b, TopologicalSpace (C b)]
    [∀ b, NonUnitalNonAssocSemiring (C b)] [∀ b, TopologicalSemiring (C b)] :
    TopologicalSemiring (∀ b, C b) where

instance {β : Type _} {C : β → Type _} [∀ b, TopologicalSpace (C b)]
    [∀ b, NonUnitalNonAssocRing (C b)] [∀ b, TopologicalRing (C b)] :
    TopologicalRing (∀ b, C b) := ⟨⟩

section MulOpposite

open MulOpposite

instance [NonUnitalNonAssocSemiring α] [TopologicalSpace α] [ContinuousAdd α] :
    ContinuousAdd αᵐᵒᵖ :=
  continuousAdd_induced opAddEquiv.symm

instance [NonUnitalNonAssocSemiring α] [TopologicalSpace α] [TopologicalSemiring α] :
    TopologicalSemiring αᵐᵒᵖ := ⟨⟩

instance [NonUnitalNonAssocRing α] [TopologicalSpace α] [ContinuousNeg α] : ContinuousNeg αᵐᵒᵖ :=
  opHomeomorph.symm.inducing.continuousNeg fun _ => rfl

instance [NonUnitalNonAssocRing α] [TopologicalSpace α] [TopologicalRing α] :
    TopologicalRing αᵐᵒᵖ := ⟨⟩

end MulOpposite

section AddOpposite

open AddOpposite

instance [NonUnitalNonAssocSemiring α] [TopologicalSpace α] [ContinuousMul α] :
    ContinuousMul αᵃᵒᵖ :=
  continuousMul_induced opMulEquiv.symm

instance [NonUnitalNonAssocSemiring α] [TopologicalSpace α] [TopologicalSemiring α] :
    TopologicalSemiring αᵃᵒᵖ := ⟨⟩

instance [NonUnitalNonAssocRing α] [TopologicalSpace α] [TopologicalRing α] :
    TopologicalRing αᵃᵒᵖ := ⟨⟩

end AddOpposite

section

variable {R : Type _} [NonUnitalNonAssocRing R] [TopologicalSpace R]

theorem TopologicalRing.of_addGroup_of_nhds_zero [TopologicalAddGroup R]
    (hmul : Tendsto (uncurry ((· * ·) : R → R → R)) (𝓝 0 ×ᶠ 𝓝 0) <| 𝓝 0)
    (hmul_left : ∀ x₀ : R, Tendsto (fun x : R => x₀ * x) (𝓝 0) <| 𝓝 0)
    (hmul_right : ∀ x₀ : R, Tendsto (fun x : R => x * x₀) (𝓝 0) <| 𝓝 0) : TopologicalRing R where
  continuous_mul := by
    refine continuous_of_continuousAt_zero₂ (AddMonoidHom.mul (R := R)) ?_ ?_ ?_ <;>
      simpa only [ContinuousAt, mul_zero, zero_mul, nhds_prod_eq, AddMonoidHom.mul_apply]
#align topological_ring.of_add_group_of_nhds_zero TopologicalRing.of_addGroup_of_nhds_zero

theorem TopologicalRing.of_nhds_zero
    (hadd : Tendsto (uncurry ((· + ·) : R → R → R)) (𝓝 0 ×ᶠ 𝓝 0) <| 𝓝 0)
    (hneg : Tendsto (fun x => -x : R → R) (𝓝 0) (𝓝 0))
    (hmul : Tendsto (uncurry ((· * ·) : R → R → R)) (𝓝 0 ×ᶠ 𝓝 0) <| 𝓝 0)
    (hmul_left : ∀ x₀ : R, Tendsto (fun x : R => x₀ * x) (𝓝 0) <| 𝓝 0)
    (hmul_right : ∀ x₀ : R, Tendsto (fun x : R => x * x₀) (𝓝 0) <| 𝓝 0)
    (hleft : ∀ x₀ : R, 𝓝 x₀ = map (fun x => x₀ + x) (𝓝 0)) : TopologicalRing R :=
  have := TopologicalAddGroup.of_comm_of_nhds_zero hadd hneg hleft
  TopologicalRing.of_addGroup_of_nhds_zero hmul hmul_left hmul_right
#align topological_ring.of_nhds_zero TopologicalRing.of_nhds_zero

end

variable [TopologicalSpace α]

section

variable [NonUnitalNonAssocRing α] [TopologicalRing α]

/-- In a topological semiring, the left-multiplication `AddMonoidHom` is continuous. -/
theorem mulLeft_continuous (x : α) : Continuous (AddMonoidHom.mulLeft x) :=
  continuous_const.mul continuous_id
#align mul_left_continuous mulLeft_continuous

/-- In a topological semiring, the right-multiplication `AddMonoidHom` is continuous. -/
theorem mulRight_continuous (x : α) : Continuous (AddMonoidHom.mulRight x) :=
  continuous_id.mul continuous_const
#align mul_right_continuous mulRight_continuous

end

variable [Ring α] [TopologicalRing α]

instance (S : Subring α) : TopologicalRing S :=
  { S.toSubmonoid.continuousMul, inferInstanceAs (TopologicalAddGroup S.toAddSubgroup) with }

/-- The (topological-space) closure of a subring of a topological ring is
itself a subring. -/
def Subring.topologicalClosure (S : Subring α) : Subring α :=
  { S.toSubmonoid.topologicalClosure, S.toAddSubgroup.topologicalClosure with
    carrier := _root_.closure (S : Set α) }
#align subring.topological_closure Subring.topologicalClosure

theorem Subring.le_topologicalClosure (s : Subring α) : s ≤ s.topologicalClosure :=
  _root_.subset_closure
#align subring.le_topological_closure Subring.le_topologicalClosure

theorem Subring.isClosed_topologicalClosure (s : Subring α) :
    IsClosed (s.topologicalClosure : Set α) := isClosed_closure
#align subring.is_closed_topological_closure Subring.isClosed_topologicalClosure

theorem Subring.topologicalClosure_minimal (s : Subring α) {t : Subring α} (h : s ≤ t)
    (ht : IsClosed (t : Set α)) : s.topologicalClosure ≤ t :=
  closure_minimal h ht
#align subring.topological_closure_minimal Subring.topologicalClosure_minimal

/-- If a subring of a topological ring is commutative, then so is its topological closure. -/
def Subring.commRingTopologicalClosure [T2Space α] (s : Subring α) (hs : ∀ x y : s, x * y = y * x) :
    CommRing s.topologicalClosure :=
  { s.topologicalClosure.toRing, s.toSubmonoid.commMonoidTopologicalClosure hs with }
#align subring.comm_ring_topological_closure Subring.commRingTopologicalClosure

end TopologicalSemiring

/-!
### Lattice of ring topologies
We define a type class `RingTopology α` which endows a ring `α` with a topology such that all ring
operations are continuous.

Ring topologies on a fixed ring `α` are ordered, by reverse inclusion. They form a complete lattice,
with `⊥` the discrete topology and `⊤` the indiscrete topology.

Any function `f : α → β` induces `coinduced f : TopologicalSpace α → RingTopology β`. -/

universe u v

/-- A ring topology on a ring `α` is a topology for which addition, negation and multiplication
are continuous. -/
structure RingTopology (α : Type u) [Ring α] extends TopologicalSpace α, TopologicalRing α : Type u
#align ring_topology RingTopology

namespace RingTopology

variable {α : Type _} [Ring α]

instance inhabited {α : Type u} [Ring α] : Inhabited (RingTopology α) :=
  ⟨let _ : TopologicalSpace α := ⊤;
    { continuous_add := continuous_top
      continuous_mul := continuous_top
      continuous_neg := continuous_top }⟩
#align ring_topology.inhabited RingTopology.inhabited

theorem toTopologicalSpace_injective :
    Injective (toTopologicalSpace : RingTopology α → TopologicalSpace α) := by
  intro f g _; cases f; cases g; congr

@[ext]
theorem ext {f g : RingTopology α} (h : f.IsOpen = g.IsOpen) : f = g :=
  toTopologicalSpace_injective <| topologicalSpace_eq h
#align ring_topology.ext' RingTopology.ext

/-- The ordering on ring topologies on the ring `α`.
  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
instance : PartialOrder (RingTopology α) :=
  PartialOrder.lift RingTopology.toTopologicalSpace toTopologicalSpace_injective

private def def_infₛ (S : Set (RingTopology α)) : RingTopology α :=
  let _ := infₛ (toTopologicalSpace '' S)
  { toContinuousAdd := continuousAdd_infₛ <| ball_image_iff.2 fun t _ =>
      let _ := t.1; t.toContinuousAdd
    toContinuousMul := continuousMul_infₛ <| ball_image_iff.2 fun t _ =>
      let _ := t.1; t.toContinuousMul
    toContinuousNeg := continuousNeg_infₛ <| ball_image_iff.2 fun t _ =>
      let _ := t.1; t.toContinuousNeg }

/-- Ring topologies on `α` form a complete lattice, with `⊥` the discrete topology and `⊤` the
indiscrete topology.

The infimum of a collection of ring topologies is the topology generated by all their open sets
(which is a ring topology).

The supremum of two ring topologies `s` and `t` is the infimum of the family of all ring topologies
contained in the intersection of `s` and `t`. -/
instance : CompleteSemilatticeInf (RingTopology α) where
  infₛ := def_infₛ
  infₛ_le := fun _ a haS => infₛ_le (α := TopologicalSpace α) ⟨a, ⟨haS, rfl⟩⟩
  le_infₛ := fun _ _ h => le_infₛ (α := TopologicalSpace α) <| ball_image_iff.2 h

instance : CompleteLattice (RingTopology α) :=
  completeLatticeOfCompleteSemilatticeInf _

/-- Given `f : α → β` and a topology on `α`, the coinduced ring topology on `β` is the finest
topology such that `f` is continuous and `β` is a topological ring. -/
def coinduced {α β : Type _} [t : TopologicalSpace α] [Ring β] (f : α → β) : RingTopology β :=
  infₛ { b : RingTopology β | t.coinduced f ≤ b.toTopologicalSpace }
#align ring_topology.coinduced RingTopology.coinduced

theorem coinduced_continuous {α β : Type _} [t : TopologicalSpace α] [Ring β] (f : α → β) :
    Continuous[t, (coinduced f).toTopologicalSpace] f :=
  continuous_infₛ_rng.2 <| ball_image_iff.2 fun _ => continuous_iff_coinduced_le.2
#align ring_topology.coinduced_continuous RingTopology.coinduced_continuous

/-- The forgetful functor from ring topologies on `a` to additive group topologies on `a`. -/
def toAddGroupTopology (t : RingTopology α) : AddGroupTopology α where
  toTopologicalSpace := t.toTopologicalSpace
  toTopologicalAddGroup :=
    @TopologicalRing.to_topologicalAddGroup _ _ t.toTopologicalSpace t.toTopologicalRing
#align ring_topology.to_add_group_topology RingTopology.toAddGroupTopology

/-- The order embedding from ring topologies on `a` to additive group topologies on `a`. -/
def toAddGroupTopology.orderEmbedding : OrderEmbedding (RingTopology α) (AddGroupTopology α) :=
  OrderEmbedding.ofMapLEIff toAddGroupTopology fun _ _ => Iff.rfl
#align ring_topology.to_add_group_topology.order_embedding RingTopology.toAddGroupTopology.orderEmbedding

end RingTopology

section AbsoluteValue

/-- Construct an absolute value on a semiring `T` from an absolute value on a semiring `R`
and an injective ring homomorphism `f : T →+* R` -/
def AbsoluteValue.comp {R S T : Type _} [Semiring T] [Semiring R] [OrderedSemiring S]
    (v : AbsoluteValue R S) {f : T →+* R} (hf : Function.Injective f) : AbsoluteValue T S where
  toMulHom := v.1.comp f
  nonneg' _ := v.nonneg _
  eq_zero' _ := v.eq_zero.trans (map_eq_zero_iff f hf)
  add_le' _ _ := (congr_arg v (map_add f _ _)).trans_le (v.add_le _ _)
#align absolute_value.comp AbsoluteValue.comp

end AbsoluteValue


/-
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
-/
import algebra.group.hom
import algebra.order.with_zero
import order.hom.basic

/-!
# Ordered monoid and group homomorphisms

This file defines morphisms between (additive) ordered monoids.

## Types of morphisms

* `order_add_monoid_hom`: Ordered additive monoid homomorphisms.
* `order_monoid_hom`: Ordered monoid homomorphisms.
* `order_monoid_with_zero_hom`: Ordered monoid with zero homomorphisms.

## Typeclasses

* `order_add_monoid_hom_class`
* `order_monoid_hom_class`
* `order_monoid_with_zero_hom_class`

## Notation

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

## Implementation notes

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

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

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

## Tags

ordered monoid, ordered group, monoid with zero
-/

open function

variables {F α β γ δ : Type*}

section add_monoid

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

`order_add_monoid_hom` is also used for ordered group homomorphisms.

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

When you extend this structure, make sure to extend `order_add_monoid_hom_class`. -/
structure order_add_monoid_hom (α β : Type*) [ordered_add_comm_monoid α] [ordered_add_comm_monoid β]
  extends α →+ β :=
(monotone' : monotone to_fun)

infixr ` →+o `:25 := order_add_monoid_hom

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

You should also extend this typeclass when you extend `order_add_monoid_hom`. -/
class order_add_monoid_hom_class (F : Type*) (α β : out_param $ Type*)
  [ordered_add_comm_monoid α] [ordered_add_comm_monoid β]
  extends add_monoid_hom_class F α β :=
(monotone (f : F) : monotone f)

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

end add_monoid

section monoid
variables [ordered_comm_monoid α] [ordered_comm_monoid β]

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

`order_monoid_hom` is also used for ordered group homomorphisms.

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

When you extend this structure, make sure to extend `order_monoid_hom_class`. -/
@[to_additive]
structure order_monoid_hom (α β : Type*) [ordered_comm_monoid α] [ordered_comm_monoid β]
  extends α →* β :=
(monotone' : monotone to_fun)

infixr ` →*o `:25 := order_monoid_hom

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

You should also extend this typeclass when you extend `order_monoid_hom`. -/
@[to_additive]
class order_monoid_hom_class (F : Type*) (α β : out_param $ Type*)
  [ordered_comm_monoid α] [ordered_comm_monoid β]
  extends monoid_hom_class F α β :=
(monotone (f : F) : monotone f)

@[priority 100, to_additive] -- See note [lower instance priority]
instance order_monoid_hom_class.to_order_hom_class [order_monoid_hom_class F α β] :
  order_hom_class F α β :=
{ map_rel := order_monoid_hom_class.monotone }

@[to_additive]
instance [order_monoid_hom_class F α β] : has_coe_t F (α →*o β) :=
⟨λ f, { to_fun := f, map_one' := map_one f, map_mul' := map_mul f,
  monotone' := order_monoid_hom_class.monotone _ }⟩

end monoid

section monoid_with_zero
variables [linear_ordered_comm_monoid_with_zero α] [linear_ordered_comm_monoid_with_zero β]

/-- `order_monoid_with_zero_hom α β` is the type of functions `α → β` that preserve
the `monoid_with_zero` structure.

`order_monoid_with_zero_hom` is also used for group homomorphisms.

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

When you extend this structure, make sure to extend `order_monoid_with_zero_hom_class`. -/
structure order_monoid_with_zero_hom (α β : Type*)
  [linear_ordered_comm_monoid_with_zero α] [linear_ordered_comm_monoid_with_zero β]
  extends α →*₀ β :=
(monotone' : monotone to_fun)

infixr ` →*₀o `:25 := order_monoid_with_zero_hom

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

You should also extend this typeclass when you extend `order_monoid_with_zero_hom`. -/
class order_monoid_with_zero_hom_class (F : Type*) (α β : out_param $ Type*)
  [linear_ordered_comm_monoid_with_zero α] [linear_ordered_comm_monoid_with_zero β]
  extends monoid_with_zero_hom_class F α β :=
(monotone (f : F) : monotone f)

@[priority 100] -- See note [lower instance priority]
instance order_monoid_with_zero_hom_class.to_order_monoid_hom_class
  [order_monoid_with_zero_hom_class F α β] : order_monoid_hom_class F α β :=
{ .. ‹order_monoid_with_zero_hom_class F α β› }

instance [order_monoid_with_zero_hom_class F α β] : has_coe_t F (α →*₀o β) :=
⟨λ f, { to_fun := f, map_one' := map_one f, map_zero' := map_zero f, map_mul' := map_mul f,
  monotone' := order_monoid_with_zero_hom_class.monotone _ }⟩

end monoid_with_zero

namespace order_monoid_hom
section
variables [ordered_comm_monoid α] [ordered_comm_monoid β] [ordered_comm_monoid γ]
  [ordered_comm_monoid δ] {f g : α →*o β}

@[to_additive]
instance : order_monoid_hom_class (α →*o β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  monotone := λ f, f.monotone' }

-- Other lemmas should be accessed through the `fun_like` API
@[ext, to_additive] lemma ext (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
@[to_additive] lemma to_fun_eq_coe (f : α →*o β) : f.to_fun = (f : α → β) := rfl
@[simp, to_additive] lemma coe_mk (f : α →* β) (h) : (order_monoid_hom.mk f h : α → β) = f := rfl
@[simp, to_additive] lemma mk_coe (f : α →*o β) (h) : order_monoid_hom.mk (f :  α →* β) h = f :=
by { ext, refl }

/-- Reinterpret an ordered monoid homomorphism as an order homomorphism. -/
@[to_additive "Reinterpret an ordered additive monoid homomorphism as an order homomorphism."]
def to_order_hom (f : α →*o β) : α →o β := { ..f }

@[simp, to_additive] lemma coe_monoid_hom (f : α →*o β) : ((f : α →* β) : α → β) = f := rfl
@[simp, to_additive] lemma coe_order_hom (f : α →*o β) : ((f : α →o β) : α → β) = f := rfl

@[to_additive] lemma to_monoid_hom_injective : injective (to_monoid_hom : _ → α →* β) :=
λ f g h, order_monoid_hom.ext $ by convert fun_like.ext_iff.1 h

@[to_additive] lemma to_order_hom_injective : injective (to_order_hom : _ → α →o β) :=
λ f g h, order_monoid_hom.ext $ by convert fun_like.ext_iff.1 h

/-- Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
@[to_additive "Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities."]
protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β :=
{ to_fun := f',
  monotone' := h.symm.subst f.monotone',
  ..f.to_monoid_hom.copy f' $ by exact h }

variables (α)

/-- The identity map as an ordered monoid homomorphism. -/
@[to_additive "The identity map as an ordered additive monoid homomorphism."]
protected def id : α →*o α := { ..monoid_hom.id α, ..order_hom.id }

@[simp, to_additive] lemma coe_id : ⇑(order_monoid_hom.id α) = id := rfl

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

variables {α}

/-- Composition of `order_monoid_hom`s as an `order_monoid_hom`. -/
@[to_additive "Composition of `order_add_monoid_hom`s as an `order_add_monoid_hom`"]
def comp (f : β →*o γ) (g : α →*o β) : α →*o γ :=
{ ..f.to_monoid_hom.comp (g : α →* β), ..f.to_order_hom.comp (g : α →o β) }

@[simp, to_additive] lemma coe_comp (f : β →*o γ) (g : α →*o β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp, to_additive] lemma comp_apply (f : β →*o γ) (g : α →*o β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp, to_additive] lemma coe_comp_monoid_hom (f : β →*o γ) (g : α →*o β) :
  (f.comp g : α →* γ) = (f : β →* γ).comp g := rfl
@[simp, to_additive] lemma coe_comp_order_hom (f : β →*o γ) (g : α →*o β) :
  (f.comp g : α →o γ) = (f : β →o γ).comp g := rfl
@[simp, to_additive] lemma comp_assoc (f : γ →*o δ) (g : β →*o γ) (h : α →*o β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp, to_additive] lemma comp_id (f : α →*o β) : f.comp (order_monoid_hom.id α) = f :=
order_monoid_hom.ext $ λ a, rfl
@[simp, to_additive] lemma id_comp (f : α →*o β) : (order_monoid_hom.id β).comp f = f :=
order_monoid_hom.ext $ λ a, rfl

@[to_additive]
lemma cancel_right {g₁ g₂ : β →*o γ} {f : α →*o β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, order_monoid_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

@[to_additive]
lemma cancel_left {g : β →*o γ} {f₁ f₂ : α →*o β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, order_monoid_hom.ext $ λ a, hg $
  by rw [←order_monoid_hom.comp_apply, h, order_monoid_hom.comp_apply], congr_arg _⟩

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

@[simp, to_additive]

@[simp, to_additive] lemma one_comp (f : α →*o β) : (1 : β →*o γ).comp f = 1 := rfl
@[simp, to_additive] lemma comp_one (f : β →*o γ) : f.comp (1 : α →*o β) = 1 :=
by { ext, exact map_one f }

section mul

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

@[simp, to_additive] lemma coe_mul (f g : α →*o β) : ⇑(f * g) = f * g := rfl
@[simp, to_additive] lemma mul_apply (f g : α →*o β) (a : α) : (f * g) a = f a * g a := rfl

@[to_additive] lemma mul_comp (g₁ g₂ : β →*o γ) (f : α →*o β) :
  (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
@[to_additive] lemma comp_mul (g : β →*o γ) (f₁ f₂ : α →*o β) :
  g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ := by { ext, exact map_mul g _ _ }

end mul
end

section ordered_comm_monoid
variables {hα : ordered_comm_monoid α} {hβ : ordered_comm_monoid β}
include hα hβ

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α →*o β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp, to_additive] lemma to_monoid_hom_eq_coe (f : α →*o β) : f.to_monoid_hom = f :=
by { ext, refl }
@[simp, to_additive] lemma to_order_hom_eq_coe (f : α →*o β) : f.to_order_hom = f := rfl

end ordered_comm_monoid

section ordered_comm_group
variables {hα : ordered_comm_group α} {hβ : ordered_comm_group β}
include hα hβ

/-- Makes an ordered group homomorphism from a proof that the map preserves multiplication. -/
@[to_additive "Makes an ordered additive group homomorphism from a proof that the map preserves
addition.",
  simps {fully_applied := ff}]
def mk' (f : α → β) (hf : monotone f) (map_mul : ∀ a b : α, f (a * b) = f a * f b) : α →*o β :=
{ monotone' := hf,
  ..monoid_hom.mk' f map_mul }

end ordered_comm_group
end order_monoid_hom

namespace order_monoid_with_zero_hom
section
variables [linear_ordered_comm_monoid_with_zero α] [linear_ordered_comm_monoid_with_zero β]
  [linear_ordered_comm_monoid_with_zero γ] [linear_ordered_comm_monoid_with_zero δ] {f g : α →*₀o β}

instance : order_monoid_with_zero_hom_class (α →*₀o β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  map_zero := λ f, f.map_zero',
  monotone := λ f, f.monotone' }

-- Other lemmas should be accessed through the `fun_like` API
@[ext] lemma ext (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
lemma to_fun_eq_coe (f : α →*₀o β) : f.to_fun = (f : α → β) := rfl
@[simp] lemma coe_mk (f : α →*₀ β) (h) : (order_monoid_with_zero_hom.mk f h : α → β) = f := rfl
@[simp] lemma mk_coe (f : α →*₀o β) (h) : order_monoid_with_zero_hom.mk (f :  α →*₀ β) h = f :=
by { ext, refl }

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

@[simp] lemma coe_monoid_with_zero_hom (f : α →*₀o β) : ((f : α →*₀ β) : α → β) = f := rfl
@[simp] lemma coe_order_monoid_hom (f : α →*₀o β) : ((f : α →*o β) : α → β) = f := rfl

lemma to_order_monoid_hom_injective : injective (to_order_monoid_hom : _ → α →*o β) :=
λ f g h, order_monoid_with_zero_hom.ext $ by convert fun_like.ext_iff.1 h

lemma to_monoid_with_zero_hom_injective : injective (to_monoid_with_zero_hom : _ → α →*₀ β) :=
λ f g h, order_monoid_with_zero_hom.ext $ by convert fun_like.ext_iff.1 h

/-- Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β :=
{ to_fun := f',
  monotone' := h.symm.subst f.monotone',
  ..f.to_monoid_hom.copy f' (by exact h) }

variables (α)

/-- The identity map as an ordered monoid with zero homomorphism. -/
protected def id : α →*₀o α := { ..monoid_with_zero_hom.id α, ..order_hom.id }

@[simp] lemma coe_id : ⇑(order_monoid_with_zero_hom.id α) = id := rfl

instance : inhabited (α →*₀o α) := ⟨order_monoid_with_zero_hom.id α⟩

variables {α}

/-- Composition of `order_monoid_with_zero_hom`s as an `order_monoid_with_zero_hom`. -/
def comp (f : β →*₀o γ) (g : α →*₀o β) : α →*₀o γ :=
{ ..f.to_monoid_with_zero_hom.comp (g : α →*₀ β), ..f.to_order_monoid_hom.comp (g : α →*o β) }

@[simp] lemma coe_comp (f : β →*₀o γ) (g : α →*₀o β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : β →*₀o γ) (g : α →*₀o β) (a : α) : (f.comp g) a = f (g a) := rfl
@[simp] lemma coe_comp_monoid_with_zero_hom (f : β →*₀o γ) (g : α →*₀o β) :
  (f.comp g : α →*₀ γ) = (f : β →*₀ γ).comp g := rfl
@[simp] lemma coe_comp_order_monoid_hom (f : β →*₀o γ) (g : α →*₀o β) :
  (f.comp g : α →*o γ) = (f : β →*o γ).comp g := rfl
@[simp] lemma comp_assoc (f : γ →*₀o δ) (g : β →*₀o γ) (h : α →*₀o β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : α →*₀o β) : f.comp (order_monoid_with_zero_hom.id α) = f :=
order_monoid_with_zero_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : α →*₀o β) : (order_monoid_with_zero_hom.id β).comp f = f :=
order_monoid_with_zero_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : β →*₀o γ} {f : α →*₀o β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, order_monoid_with_zero_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : β →*₀o γ} {f₁ f₂ : α →*₀o β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, order_monoid_with_zero_hom.ext $ λ a, hg $ by rw [←order_monoid_with_zero_hom.comp_apply, h,
  order_monoid_with_zero_hom.comp_apply], congr_arg _⟩

section mul

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

@[simp] lemma coe_mul (f g : α →*₀o β) : ⇑(f * g) = f * g := rfl
@[simp] lemma mul_apply (f g : α →*₀o β) (a : α) : (f * g) a = f a * g a := rfl

lemma mul_comp (g₁ g₂ : β →*₀o γ) (f : α →*₀o β) : (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
lemma comp_mul (g : β →*₀o γ) (f₁ f₂ : α →*₀o β) : g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ :=
by { ext, exact map_mul g _ _ }

end mul
end

section linear_ordered_comm_monoid_with_zero
variables {hα : linear_ordered_comm_monoid_with_zero α}
  {hβ : linear_ordered_comm_monoid_with_zero β}
include hα hβ

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α →*₀o β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_monoid_with_zero_hom_eq_coe (f : α →*₀o β) : f.to_monoid_with_zero_hom = f :=
by { ext, refl }
@[simp] lemma to_order_monoid_hom_eq_coe (f : α →*₀o β) : f.to_order_monoid_hom = f := rfl

end linear_ordered_comm_monoid_with_zero
end order_monoid_with_zero_hom


/-
Question: is weak induction enough to prove strong induction?
Answer: yes!
-/

import order.bounded_lattice  -- For the has_bot / has_top notation classes.

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

section API

-- The operations needed on the boolalg A.
def A : Type := sorry

instance A_has_bot : has_bot A := sorry
instance A_has_top : has_top A := sorry
instance A_has_subset : has_subset A := sorry
instance A_has_inter : has_inter A := sorry
instance A_has_union : has_union A := sorry
def singlet : A → Prop := sorry  -- The property of being a singleton.

/-
subset_singlet is the crucial property, and should be provable as a
consequence of the fact that singletons have size 1 and there are no
integers between 0 and 1.
-/
lemma subset_singlet (X e : A) : (singlet e) → (X ⊆ e) → (X = ⊥ ∨ X = e) := sorry

/-
Decidable equality, which is true classically even without assuming
that one of the subsets is contained in the other, but should also
be provable directly by checking whether (size X) = (size Y).
-/
lemma subset_dec_eq (X Y : A) : (X ⊆ Y) → (X = Y) ∨ (X ≠ Y) := sorry

-- The lemmas needed about boolalg elements. Not that many!
lemma bot_union (X : A) : ⊥ ∪ X = X := sorry
lemma subset_bot (X : A) : (X ⊆ ⊥) → (X = ⊥) := sorry
lemma inter_subset_right (X Y : A) : (X ∩ Y) ⊆ Y := sorry
lemma inter_eq_left (X Y : A) : (X ⊆ Y) → (X ∩ Y = X) := sorry
lemma inter_distrib_union_right (X Y Z : A) : X ∩ (Y ∪ Z) = (X ∩ Y) ∪ (X ∩ Z) := sorry

end /-section-/ API

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

section weak_induction

/-
A formulation of weak induction, which crawls up the poset,
singleton by singleton. Provable from the axiom that every
nonempty subset of the boolalg contains a singleton.
-/
lemma weak_induction (P : A → Prop) :
  (P ⊥) →  -- Base case.
  (forall (e Y : A), (singlet e) → (P Y) → P (e ∪ Y)) →  -- Induction step.
  (forall (Z : A), P Z) :=
sorry

end /-section-/ weak_induction

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

section strong_induction

-- (below P Y) says that property P is true everywhere strictly below Y.
def below (P : A → Prop) (Y : A) : Prop :=
  forall (X : A), (X ⊆ Y) → (X ≠ Y) → (P X)

-- (augment P) says that (below P Y) can be upgraded to (P Y), for all Y.
def augment (P : A → Prop) : Prop :=
  forall (Y : A), (below P Y) → (P Y)

-- The statement of strong induction, specialized to a single position in the boolalg.
def strong_at (Y : A) : Prop :=
  forall (P : A → Prop), (augment P) → (P Y)

/-
The crucial part of the proof that weak induction implies strong induction.

Consider the subalg of elements below Y, and the subalg of elements below (e ∪ Y).
Because of subset_singlet, we know that (subalg (e ∪ Y)) is covered by two
copies of (subalg Y) : the elements of the form X ⊆ Y, and the elements of
the form (e ∪ X) for X ⊆ Y.

So, we package up the pair of propositions (P X) and (P (e ∪ X)) as a new
proposition on (subalg Y), and call it (Q X).

This will allow us to use strong induction at position Y, for Q, to prove
that strong induction works at position (e ∪ Y), for P.
-/
lemma pair_up (P : A → Prop) (e : A) : (singlet e) →
  let Q : (A → Prop) := fun Y, (P Y) ∧ P (e ∪ Y) in
  (augment P) → (augment Q) :=
fun h_singlet h_augment Y h_below,
/-
First use (augment P) to upgrade (below P Y) to (P Y).
The fact that (below Q Y) implies (below P Y) is almost immediate.
-/
let h_Y : (P Y) := h_augment Y (fun X h_ss h_ne, and.left (h_below X h_ss h_ne)) in
and.intro h_Y
/-
Then use (augment P) to upgrade (below P (e ∪ Y)) to (P (e ∪ Y)).
The fact that (below Q Y) implies (below P (e ∪ Y)) is *not* immediate.
There are three cases to consider:

1. Elements of the form X ⊆ Y with X ≠ Y:
   (P X) is directly implied by (Q X).

2. The element Y:
   we proved above that (augment P) works to prove (P Y).

3. Elements of the form (e ∪ X) with X ⊆ Y and X ≠ Y:
   (P (e ∪ X)) is directly implied by (Q X).
-/
(h_augment (e ∪ Y) (fun X h_ss h_ne,
-- Break up X ⊆ (e ∪ Y) into the part under e and the part under Y.
let h_union :=
  calc X = X ∩ (e ∪ Y)       : (inter_eq_left X (e ∪ Y) h_ss).symm
  ...    = (X ∩ {e}) ∪ (X ∩ Y) : inter_distrib_union_right X e Y
in or.elim (subset_dec_eq (X ∩ Y) Y (inter_subset_right X Y))
(or.elim (subset_singlet (X ∩ {e}) e h_singlet (inter_subset_right X e))
  -- Case 2 described above: X = Y.
  (fun (h₁ : X ∩ {e} = ⊥) (h₂ : X ∩ Y = Y),
    @eq.rec A Y P h_Y X (
    calc Y = X ∩ Y             : h₂.symm
    ...    = ⊥ ∪ (X ∩ Y)       : (bot_union (X ∩ Y)).symm
    ...    = (X ∩ {e}) ∪ (X ∩ Y) : by rw [h₁]
    ...    = X                 : h_union.symm))
  -- Case impossible, because X ≠ (e ∪ Y)
  (fun (h₁ : X ∩ {e} = e) (h₂ : X ∩ Y = Y),
    false.elim (h_ne (
    calc X = (X ∩ {e}) ∪ (X ∩ Y) : h_union
    ...    = e ∪ Y             : by rw [h₁, h₂]))))
(or.elim (subset_singlet (X ∩ {e}) e h_singlet (inter_subset_right X e))
  -- Case 1 described above: X ⊂ Y.
  (fun (h₁ : X ∩ {e} = ⊥) (h₂ : X ∩ Y ≠ Y),
    let h₃ :=
      calc X = (X ∩ {e}) ∪ (X ∩ Y) : h_union
      ...    = ⊥ ∪ (X ∩ Y)       : by rw [h₁]
      ...    = X ∩ Y             : bot_union (X ∩ Y)
    in and.left (h_below X
    (calc X = X ∩ Y : h₃ ... ⊆ Y : inter_subset_right X Y)
    (calc X = X ∩ Y : h₃ ... ≠ Y : h₂)))
  -- Case 3 described above: X = e ∪ X' with X' ⊂ Y.
  (fun (h₁ : X ∩ {e} = e) (h₂ : X ∩ Y ≠ Y),
    @eq.rec A (e ∪ (X ∩ Y)) P
    (and.right (h_below (X ∩ Y) (inter_subset_right X Y) h₂))
    X (
    calc e ∪ (X ∩ Y) = (X ∩ {e}) ∪ (X ∩ Y) : by rw [h₁]
    ...              = X                 : h_union.symm)))
))

/-
Strong induction works at position ⊥, vacuously.
-/
lemma strong_base :
  strong_at ⊥ :=
fun P aug, aug ⊥ (fun X h_ss h_ne, false.elim (h_ne (subset_bot X h_ss)))

/-
As explained above, strong induction at position Y
implies strong induction at position (e ∪ Y).
-/
lemma strong_step (e Y : A) :
  (singlet e) → (strong_at Y) → (strong_at (e ∪ Y)) :=
fun h_singlet h_strong P h_augment,
let Q : (A → Prop) := fun Y, (P Y) ∧ P (e ∪ Y) in
and.right (h_strong Q (pair_up P e h_singlet h_augment))

/-
So weak induction implies strong induction at every position.
-/
lemma strong_induction (P : A → Prop) :
  (augment P) →
  (forall (Z : A), P Z) :=
fun h_augment Z, weak_induction strong_at strong_base strong_step Z P h_augment

end /-section-/ strong_induction


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.group.type_tags
import algebra.group.units_hom
import algebra.ring.basic
import data.equiv.mul_add

/-!
# Unbundled monoid and group homomorphisms (deprecated)

This file defines typeclasses for unbundled monoid and group homomorphisms. Though these classes are
deprecated, they are still widely used in mathlib, and probably will not go away before Lean 4
because Lean 3 often fails to coerce a bundled homomorphism to a function.

## main definitions

is_monoid_hom (deprecated), is_group_hom (deprecated)

## implementation notes

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

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

## Tags

is_group_hom, is_monoid_hom, monoid_hom

-/

/--
We have lemmas stating that the composition of two morphisms is again a morphism.
Since composition is reducible, type class inference will always succeed in applying these
instances. For example when the goal is just `⊢ is_mul_hom f` the instance `is_mul_hom.comp`
will still succeed, unifying `f` with `f ∘ (λ x, x)`.  This causes type class inference to loop.
To avoid this, we do not make these lemmas instances.
-/
library_note "no instance on morphisms"

universes u v
variables {α : Type u} {β : Type v}

/-- Predicate for maps which preserve an addition. -/
class is_add_hom {α β : Type*} [has_add α] [has_add β] (f : α → β) : Prop :=
(map_add [] : ∀ x y, f (x + y) = f x + f y)

/-- Predicate for maps which preserve a multiplication. -/
@[to_additive]
class is_mul_hom {α β : Type*} [has_mul α] [has_mul β] (f : α → β) : Prop :=
(map_mul [] : ∀ x y, f (x * y) = f x * f y)

namespace is_mul_hom
variables [has_mul α] [has_mul β] {γ : Type*} [has_mul γ]

/-- The identity map preserves multiplication. -/
@[to_additive "The identity map preserves addition"]
instance id : is_mul_hom (id : α → α) := {map_mul := λ _ _, rfl}

/-- The composition of maps which preserve multiplication, also preserves multiplication. -/
-- see Note [no instance on morphisms]
@[to_additive "The composition of addition preserving maps also preserves addition"]
lemma comp (f : α → β) (g : β → γ) [is_mul_hom f] [hg : is_mul_hom g] : is_mul_hom (g ∘ f) :=
{ map_mul := λ x y, by simp only [function.comp, map_mul f, map_mul g] }

/-- A product of maps which preserve multiplication,
preserves multiplication when the target is commutative. -/
@[instance, priority 10, to_additive]
lemma mul {α β} [semigroup α] [comm_semigroup β]
  (f g : α → β) [is_mul_hom f] [is_mul_hom g] :
  is_mul_hom (λa, f a * g a) :=
{ map_mul := assume a b, by simp only [map_mul f, map_mul g, mul_comm, mul_assoc, mul_left_comm] }

/-- The inverse of a map which preserves multiplication,
preserves multiplication when the target is commutative. -/
@[instance, to_additive]
lemma inv {α β} [has_mul α] [comm_group β] (f : α → β) [is_mul_hom f] :
  is_mul_hom (λa, (f a)⁻¹) :=
{ map_mul := assume a b, (map_mul f a b).symm ▸ mul_inv _ _ }

end is_mul_hom

/-- Predicate for add_monoid homomorphisms (deprecated -- use the bundled `monoid_hom` version). -/
class is_add_monoid_hom [add_zero_class α] [add_zero_class β] (f : α → β)
  extends is_add_hom f : Prop :=
(map_zero [] : f 0 = 0)

/-- Predicate for monoid homomorphisms (deprecated -- use the bundled `monoid_hom` version). -/
@[to_additive]
class is_monoid_hom [mul_one_class α] [mul_one_class β] (f : α → β) extends is_mul_hom f : Prop :=
(map_one [] : f 1 = 1)

namespace monoid_hom

/-!
Throughout this section, some `monoid` arguments are specified with `{}` instead of `[]`.
See note [implicit instance arguments].
-/
variables {M : Type*} {N : Type*} {P : Type*} [mM : monoid M] [mN : monoid N] {mP : monoid P}
variables {G : Type*} {H : Type*} [group G] [comm_group H]

include mM mN
/-- Interpret a map `f : M → N` as a homomorphism `M →* N`. -/
@[to_additive "Interpret a map `f : M → N` as a homomorphism `M →+ N`."]
def of (f : M → N) [h : is_monoid_hom f] : M →* N :=
{ to_fun := f,
  map_one' := h.2,
  map_mul' := h.1.1 }

variables {mM mN mP}
@[simp, to_additive]
lemma coe_of (f : M → N) [is_monoid_hom f] : ⇑ (monoid_hom.of f) = f :=
rfl

@[to_additive]
instance (f : M →* N) : is_monoid_hom (f : M → N) :=
{ map_mul := f.map_mul,
  map_one := f.map_one }

end monoid_hom

namespace mul_equiv

variables {M : Type*} {N : Type*} [monoid M] [monoid N]

/-- A multiplicative isomorphism preserves multiplication (deprecated). -/
@[to_additive]
instance (h : M ≃* N) : is_mul_hom h := ⟨h.map_mul⟩

/-- A multiplicative bijection between two monoids is a monoid hom
  (deprecated -- use to_monoid_hom). -/
@[to_additive]
instance {M N} [monoid M] [monoid N] (h : M ≃* N) : is_monoid_hom h :=
⟨h.map_one⟩

end mul_equiv

namespace is_monoid_hom
variables [monoid α] [monoid β] (f : α → β) [is_monoid_hom f]

/-- A monoid homomorphism preserves multiplication. -/
@[to_additive]
lemma map_mul (x y) : f (x * y) = f x * f y :=
is_mul_hom.map_mul f x y

end is_monoid_hom

/-- A map to a group preserving multiplication is a monoid homomorphism. -/
@[to_additive]
theorem is_monoid_hom.of_mul [monoid α] [group β] (f : α → β) [is_mul_hom f] :
  is_monoid_hom f :=
{ map_one := mul_right_eq_self.1 $ by rw [← is_mul_hom.map_mul f, one_mul] }

namespace is_monoid_hom
variables [monoid α] [monoid β] (f : α → β) [is_monoid_hom f]

/-- The identity map is a monoid homomorphism. -/
@[to_additive]
instance id : is_monoid_hom (@id α) := { map_one := rfl }

/-- The composite of two monoid homomorphisms is a monoid homomorphism. -/
@[to_additive] -- see Note [no instance on morphisms]
lemma comp {γ} [monoid γ] (g : β → γ) [is_monoid_hom g] :
  is_monoid_hom (g ∘ f) :=
{ map_one := show g _ = 1, by rw [map_one f, map_one g], ..is_mul_hom.comp _ _ }

end is_monoid_hom

namespace is_add_monoid_hom

/-- Left multiplication in a ring is an additive monoid morphism. -/
instance is_add_monoid_hom_mul_left {γ : Type*} [semiring γ] (x : γ) :
  is_add_monoid_hom (λ y : γ, x * y) :=
{ map_zero := mul_zero x, map_add := λ y z, mul_add x y z }

/-- Right multiplication in a ring is an additive monoid morphism. -/
instance is_add_monoid_hom_mul_right {γ : Type*} [semiring γ] (x : γ) :
  is_add_monoid_hom (λ y : γ, y * x) :=
{ map_zero := zero_mul x, map_add := λ y z, add_mul y z x }

end is_add_monoid_hom

/-- Predicate for additive group homomorphism (deprecated -- use bundled `monoid_hom`). -/
class is_add_group_hom [add_group α] [add_group β] (f : α → β) extends is_add_hom f : Prop

/-- Predicate for group homomorphisms (deprecated -- use bundled `monoid_hom`). -/
@[to_additive]
class is_group_hom [group α] [group β] (f : α → β) extends is_mul_hom f : Prop

@[to_additive]
instance monoid_hom.is_group_hom {G H : Type*} {_ : group G} {_ : group H} (f : G →* H) :
  is_group_hom (f : G → H) :=
{ map_mul := f.map_mul }

@[to_additive]
instance mul_equiv.is_group_hom {G H : Type*} {_ : group G} {_ : group H} (h : G ≃* H) :
  is_group_hom h := { map_mul := h.map_mul }

/-- Construct `is_group_hom` from its only hypothesis. The default constructor tries to get
`is_mul_hom` from class instances, and this makes some proofs fail. -/
@[to_additive]
lemma is_group_hom.mk' [group α] [group β] {f : α → β} (hf : ∀ x y, f (x * y) = f x * f y) :
  is_group_hom f :=
{ map_mul := hf }

namespace is_group_hom
variables [group α] [group β] (f : α → β) [is_group_hom f]
open is_mul_hom (map_mul)

/-- A group homomorphism is a monoid homomorphism. -/
@[priority 100, to_additive] -- see Note [lower instance priority]
instance to_is_monoid_hom : is_monoid_hom f :=
is_monoid_hom.of_mul f

/-- A group homomorphism sends 1 to 1. -/
@[to_additive]
lemma map_one : f 1 = 1 := is_monoid_hom.map_one f

/-- A group homomorphism sends inverses to inverses. -/
@[to_additive]
theorem map_inv (a : α) : f a⁻¹ = (f a)⁻¹ :=
eq_inv_of_mul_eq_one $ by rw [← map_mul f, inv_mul_self, map_one f]

/-- The identity is a group homomorphism. -/
@[to_additive]
instance id : is_group_hom (@id α) := { }

/-- The composition of two group homomorphisms is a group homomorphism. -/
@[to_additive] -- see Note [no instance on morphisms]
lemma comp {γ} [group γ] (g : β → γ) [is_group_hom g] : is_group_hom (g ∘ f) :=
{ ..is_mul_hom.comp _ _ }

/-- A group homomorphism is injective iff its kernel is trivial. -/
@[to_additive]
lemma injective_iff (f : α → β) [is_group_hom f] :
  function.injective f ↔ (∀ a, f a = 1 → a = 1) :=
⟨λ h _, by rw ← is_group_hom.map_one f; exact @h _ _,
  λ h x y hxy, by rw [← inv_inv (f x), inv_eq_iff_mul_eq_one, ← map_inv f,
      ← map_mul f] at hxy;
    simpa using inv_eq_of_mul_eq_one (h _ hxy)⟩

/-- The product of group homomorphisms is a group homomorphism if the target is commutative. -/
@[instance, priority 10, to_additive]
lemma mul {α β} [group α] [comm_group β]
  (f g : α → β) [is_group_hom f] [is_group_hom g] :
  is_group_hom (λa, f a * g a) :=
{ }

/-- The inverse of a group homomorphism is a group homomorphism if the target is commutative. -/
@[instance, to_additive]
lemma inv {α β} [group α] [comm_group β] (f : α → β) [is_group_hom f] :
  is_group_hom (λa, (f a)⁻¹) :=
{ }

end is_group_hom

namespace ring_hom
/-!
These instances look redundant, because `deprecated.ring` provides `is_ring_hom` for a `→+*`.
Nevertheless these are harmless, and helpful for stripping out dependencies on `deprecated.ring`.
-/
variables {R : Type*} {S : Type*}

section
variables [semiring R] [semiring S]

instance (f : R →+* S) : is_monoid_hom f :=
{ map_one := f.map_one,
  map_mul := f.map_mul }

instance (f : R →+* S) : is_add_monoid_hom f :=
{ map_zero := f.map_zero,
  map_add := f.map_add }
end

section
variables [ring R] [ring S]

instance (f : R →+* S) : is_add_group_hom f :=
{ map_add := f.map_add }
end

end ring_hom

/-- Inversion is a group homomorphism if the group is commutative. -/
@[instance, to_additive neg.is_add_group_hom
"Negation is an `add_group` homomorphism if the `add_group` is commutative."]
lemma inv.is_group_hom [comm_group α] : is_group_hom (has_inv.inv : α → α) :=
{ map_mul := mul_inv }

namespace is_add_group_hom
variables [add_group α] [add_group β] (f : α → β) [is_add_group_hom f]

/-- Additive group homomorphisms commute with subtraction. -/
lemma map_sub (a b) : f (a - b) = f a - f b :=
calc f (a - b) = f (a + -b)   : congr_arg f (sub_eq_add_neg a b)
           ... = f a + f (-b) : is_add_hom.map_add f _ _
           ... = f a + -f b   : by rw [map_neg f]
           ... = f a - f b    : (sub_eq_add_neg _ _).symm

end is_add_group_hom

/-- The difference of two additive group homomorphisms is an additive group
homomorphism if the target is commutative. -/
@[instance]
lemma is_add_group_hom.sub {α β} [add_group α] [add_comm_group β]
  (f g : α → β) [is_add_group_hom f] [is_add_group_hom g] :
  is_add_group_hom (λa, f a - g a) :=
by { simp only [sub_eq_add_neg], exact is_add_group_hom.add f (λa, - g a) }

namespace units

variables {M : Type*} {N : Type*} [monoid M] [monoid N]

/-- The group homomorphism on units induced by a multiplicative morphism. -/
@[reducible] def map' (f : M → N) [is_monoid_hom f] : units M →* units N :=
  map (monoid_hom.of f)

@[simp] lemma coe_map' (f : M → N) [is_monoid_hom f] (x : units M) :
  ↑((map' f : units M → units N) x) = f x :=
rfl

instance coe_is_monoid_hom : is_monoid_hom (coe : units M → M) := (coe_hom M).is_monoid_hom

end units

namespace is_unit

variables {M : Type*} {N : Type*} [monoid M] [monoid N] {x : M}

lemma map' (f : M → N) {x : M} (h : is_unit x) [is_monoid_hom f] :
  is_unit (f x) :=
h.map (monoid_hom.of f)

end is_unit

lemma additive.is_add_hom [has_mul α] [has_mul β] (f : α → β) [is_mul_hom f] :
  @is_add_hom (additive α) (additive β) _ _ f :=
{ map_add := @is_mul_hom.map_mul α β _ _ f _ }

lemma multiplicative.is_mul_hom [has_add α] [has_add β] (f : α → β) [is_add_hom f] :
  @is_mul_hom (multiplicative α) (multiplicative β) _ _ f :=
{ map_mul := @is_add_hom.map_add α β _ _ f _ }

lemma additive.is_add_monoid_hom [monoid α] [monoid β] (f : α → β) [is_monoid_hom f] :
  @is_add_monoid_hom (additive α) (additive β) _ _ f :=
{ map_zero := @is_monoid_hom.map_one α β _ _ f _,
  ..additive.is_add_hom f }

lemma multiplicative.is_monoid_hom [add_monoid α] [add_monoid β] (f : α → β) [is_add_monoid_hom f] :
  @is_monoid_hom (multiplicative α) (multiplicative β) _ _ f :=
{ map_one := @is_add_monoid_hom.map_zero α β _ _ f _,
  ..multiplicative.is_mul_hom f }

lemma additive.is_add_group_hom [group α] [group β] (f : α → β) [is_group_hom f] :
  @is_add_group_hom (additive α) (additive β) _ _ f :=
{ map_add := @is_mul_hom.map_mul α β _ _ f _ }

lemma multiplicative.is_group_hom [add_group α] [add_group β] (f : α → β) [is_add_group_hom f] :
  @is_group_hom (multiplicative α) (multiplicative β) _ _ f :=
{ map_mul := @is_add_hom.map_add α β _ _ f _ }


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_284
  (a b : ℕ)
  (h₀ : 1 ≤ a ∧ a ≤ 9 ∧ b ≤ 9)
  (h₁ : 10 * a + b = 2 * (a + b)) :
  10 * a + b = 18 :=
begin
  cases nat.eq_or_lt_of_le h₀.1 with h₁ h₁,
  all_goals { linarith },
end


theorem ex1 (n : Nat) : 0 + n = n := by
  let m := n
  have h : ∃ k, id k = m := ⟨m, rfl⟩
  cases h with
  | intro a e =>
    trace_state
    subst e
    trace_state
    apply Nat.zero_add

theorem ex2 (n : Nat) : 0 + n = n := by
  let m := n
  have h : ∃ k, m = id k := ⟨m, rfl⟩
  cases h with
  | intro a e =>
    trace_state
    subst e
    trace_state
    apply Nat.zero_add

theorem ex3 (n : Nat) (h : n = 0) : 0 + n = 0 := by
  let m := n + 1
  let v := m + 1
  have : v = n + 2 := rfl
  subst v -- error
  done


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.zero

/-!
# Shift

A `shift` on a category is nothing more than an automorphism of the category. An example to
keep in mind might be the category of complexes ⋯ → C_{n-1} → C_n → C_{n+1} → ⋯ with the shift
operator re-indexing the terms, so the degree `n` term of `shift C` would be the degree `n+1`
term of `C`.

-/
namespace category_theory

universes v u

variables (C : Type u) [category.{v} C]

/-- A category has a shift, or translation, if it is equipped with an automorphism. -/
class has_shift :=
(shift : C ≌ C)

variables [has_shift C]

/-- The shift autoequivalence, moving objects and morphisms 'up'. -/
def shift : C ≌ C := has_shift.shift

-- Any better notational suggestions?
notation X`⟦`n`⟧`:20 := ((shift _)^(n : ℤ)).functor.obj X
notation f`⟦`n`⟧'`:80 := ((shift _)^(n : ℤ)).functor.map f

example {X Y : C} (f : X ⟶ Y) : X⟦1⟧ ⟶ Y⟦1⟧ := f⟦1⟧'
example {X Y : C} (f : X ⟶ Y) : X⟦-2⟧ ⟶ Y⟦-2⟧ := f⟦-2⟧'

open category_theory.limits
variables [has_zero_morphisms C]

@[simp]
lemma shift_zero_eq_zero (X Y : C) (n : ℤ) : (0 : X ⟶ Y)⟦n⟧' = (0 : X⟦n⟧ ⟶ Y⟦n⟧) :=
by apply equivalence_preserves_zero_morphisms

end category_theory


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

! This file was ported from Lean 3 source module ring_theory.ring_hom.finite
! leanprover-community/mathlib commit b5aecf07a179c60b6b37c1ac9da952f3b565c785
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.RingHomProperties

/-!

# The meta properties of finite ring homomorphisms.

-/

namespace RingHom

open TensorProduct

open TensorProduct Algebra.TensorProduct

theorem finite_stableUnderComposition : StableUnderComposition @Finite :=
  by
  introv R hf hg
  exact hg.comp hf
#align ring_hom.finite_stable_under_composition RingHom.finite_stableUnderComposition

theorem finite_respectsIso : RespectsIso @Finite :=
  by
  apply finite_stable_under_composition.respects_iso
  intros
  exact Finite.of_surjective _ e.to_equiv.surjective
#align ring_hom.finite_respects_iso RingHom.finite_respectsIso

theorem finite_stableUnderBaseChange : StableUnderBaseChange @Finite :=
  by
  refine' stable_under_base_change.mk _ finite_respects_iso _
  classical
    introv h
    skip
    replace h : Module.Finite R T := by
      convert h
      ext
      rw [Algebra.smul_def]
      rfl
    suffices Module.Finite S (S ⊗[R] T)
      by
      change Module.Finite _ _
      convert this
      ext
      rw [Algebra.smul_def]
      rfl
    exact inferInstance
#align ring_hom.finite_stable_under_base_change RingHom.finite_stableUnderBaseChange

end RingHom


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

/-! # Group actions on and by `Mˣ`

This file provides the action of a unit on a type `α`, `has_smul Mˣ α`, in the presence of
`has_smul M α`, with the obvious definition stated in `units.smul_def`. This definition preserves
`mul_action` and `distrib_mul_action` structures too.

Additionally, a `mul_action G M` for some group `G` satisfying some additional properties admits a
`mul_action G Mˣ` structure, again with the obvious definition stated in `units.coe_smul`.
These instances use a primed name.

The results are repeated for `add_units` and `has_vadd` where relevant.
-/

variables {G H M N : Type*} {α : Type*}

namespace units

/-! ### Action of the units of `M` on a type `α` -/

@[to_additive]
instance [monoid M] [has_smul M α] : has_smul Mˣ α :=
{ smul := λ m a, (m : M) • a }

@[to_additive]
lemma smul_def [monoid M] [has_smul M α] (m : Mˣ) (a : α) :
  m • a = (m : M) • a := rfl

@[simp] lemma smul_is_unit [monoid M] [has_smul M α] {m : M} (hm : is_unit m) (a : α) :
  hm.unit • a = m • a :=
rfl

lemma _root_.is_unit.inv_smul [monoid α] {a : α} (h : is_unit a) :
  (h.unit)⁻¹ • a = 1 :=
h.coe_inv_mul

@[to_additive]
instance [monoid M] [has_smul M α] [has_faithful_smul M α] : has_faithful_smul Mˣ α :=
{ eq_of_smul_eq_smul := λ u₁ u₂ h, units.ext $ eq_of_smul_eq_smul h, }

@[to_additive]
instance [monoid M] [mul_action M α] : mul_action Mˣ α :=
{ one_smul := (one_smul M : _),
  mul_smul := λ m n, mul_smul (m : M) n, }

instance [monoid M] [add_monoid α] [distrib_mul_action M α] : distrib_mul_action Mˣ α :=
{ smul_add := λ m, smul_add (m : M),
  smul_zero := λ m, smul_zero m, }

instance [monoid M] [monoid α] [mul_distrib_mul_action M α] : mul_distrib_mul_action Mˣ α :=
{ smul_mul := λ m, smul_mul' (m : M),
  smul_one := λ m, smul_one m, }

instance smul_comm_class_left [monoid M] [has_smul M α] [has_smul N α]
  [smul_comm_class M N α] : smul_comm_class Mˣ N α :=
{ smul_comm := λ m n, (smul_comm (m : M) n : _)}

instance smul_comm_class_right [monoid N] [has_smul M α] [has_smul N α]
  [smul_comm_class M N α] : smul_comm_class M Nˣ α :=
{ smul_comm := λ m n, (smul_comm m (n : N) : _)}

instance [monoid M] [has_smul M N] [has_smul M α] [has_smul N α] [is_scalar_tower M N α] :
  is_scalar_tower Mˣ N α :=
{ smul_assoc := λ m n, (smul_assoc (m : M) n : _)}

/-! ### Action of a group `G` on units of `M` -/

/-- If an action `G` associates and commutes with multiplication on `M`, then it lifts to an
action on `Mˣ`. Notably, this provides `mul_action Mˣ Nˣ` under suitable
conditions.
-/
instance mul_action' [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] : mul_action G Mˣ :=
{ smul := λ g m, ⟨g • (m : M), g⁻¹ • ↑(m⁻¹),
    by rw [smul_mul_smul, units.mul_inv, mul_right_inv, one_smul],
    by rw [smul_mul_smul, units.inv_mul, mul_left_inv, one_smul]⟩,
  one_smul := λ m, units.ext $ one_smul _ _,
  mul_smul := λ g₁ g₂ m, units.ext $ mul_smul _ _ _ }

@[simp] lemma coe_smul [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] (g : G) (m : Mˣ) : ↑(g • m) = g • (m : M) := rfl

/-- Note that this lemma exists more generally as the global `smul_inv` -/
@[simp] lemma smul_inv [group G] [monoid M] [mul_action G M] [smul_comm_class G M M]
  [is_scalar_tower G M M] (g : G) (m : Mˣ) : (g • m)⁻¹ = g⁻¹ • m⁻¹ := ext rfl

/-- Transfer `smul_comm_class G H M` to `smul_comm_class G H Mˣ` -/
instance smul_comm_class' [group G] [group H] [monoid M]
  [mul_action G M] [smul_comm_class G M M]
  [mul_action H M] [smul_comm_class H M M]
  [is_scalar_tower G M M] [is_scalar_tower H M M]
  [smul_comm_class G H M] : smul_comm_class G H Mˣ :=
{ smul_comm := λ g h m, units.ext $ smul_comm g h (m : M) }

/-- Transfer `is_scalar_tower G H M` to `is_scalar_tower G H Mˣ` -/
instance is_scalar_tower' [has_smul G H] [group G] [group H] [monoid M]
  [mul_action G M] [smul_comm_class G M M]
  [mul_action H M] [smul_comm_class H M M]
  [is_scalar_tower G M M] [is_scalar_tower H M M]
  [is_scalar_tower G H M] : is_scalar_tower G H Mˣ :=
{ smul_assoc := λ g h m, units.ext $ smul_assoc g h (m : M) }

/-- Transfer `is_scalar_tower G M α` to `is_scalar_tower G Mˣ α` -/
instance is_scalar_tower'_left [group G] [monoid M] [mul_action G M] [has_smul M α]
  [has_smul G α] [smul_comm_class G M M] [is_scalar_tower G M M]
  [is_scalar_tower G M α] :
  is_scalar_tower G Mˣ α :=
{ smul_assoc := λ g m, (smul_assoc g (m : M) : _)}

-- Just to prove this transfers a particularly useful instance.
example [monoid M] [monoid N] [mul_action M N] [smul_comm_class M N N]
  [is_scalar_tower M N N] : mul_action Mˣ Nˣ := units.mul_action'

/-- A stronger form of `units.mul_action'`. -/
instance mul_distrib_mul_action' [group G] [monoid M] [mul_distrib_mul_action G M]
  [smul_comm_class G M M] [is_scalar_tower G M M] : mul_distrib_mul_action G Mˣ :=
{ smul := (•),
  smul_one := λ m, units.ext $ smul_one _,
  smul_mul := λ g m₁ m₂, units.ext $ smul_mul' _ _ _,
  .. units.mul_action' }

end units

lemma is_unit.smul [group G] [monoid M] [mul_action G M]
  [smul_comm_class G M M] [is_scalar_tower G M M] {m : M} (g : G) (h : is_unit m) :
  is_unit (g • m) :=
let ⟨u, hu⟩ := h in hu ▸ ⟨g • u, units.coe_smul _ _⟩


import tutorial_world.level11_cases2_or --hide
open set IncidencePlane --hide

variables {Ω : Type} [IncidencePlane Ω] --hide

/-
Suppose now that your hypothesis says there is some element `x` satisfying a certain
property `P`. That is, you have `h : ∃ x, P x`. Then `cases h with x hx` will
replace `h` with `x : X` and `hx : P x`. That is, from the fact that you know that
some `x` exists, it will give you one such `x` with the property that it is supposed
to satisfy.

-/

/- Lemma : no-side-bar
A line through 4 points given lines through two subsets of three
-/
lemma exists_line_example (P Q R S : Ω) (h : Q ≠ R) (h1 : ∃ ℓ : Line Ω, P ∈ ℓ ∧ Q ∈ ℓ ∧ R ∈ ℓ)
(h2 : ∃ ℓ : Line Ω, Q ∈ ℓ ∧ R ∈ ℓ ∧ S ∈ ℓ) :
∃ ℓ : Line Ω, P ∈ ℓ ∧ Q ∈ ℓ ∧ R ∈ ℓ ∧ S ∈ ℓ :=
begin
  cases h1 with r hr,
  cases h2 with s hs,
  have H : r = s,
  {
    exact equal_lines_of_contain_two_points h hr.2.1 hs.1 hr.2.2 hs.2.1,
  },
  use r,
  split,
  exact hr.1,
  split,
  exact hr.2.1,
  split,
  exact hr.2.2,
  rw H,
  exact hs.2.2,

end


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

Denumerable (countably infinite) types, as a typeclass extending
encodable. This is used to provide explicit encode/decode functions
from nat, where the functions are known inverses of each other.
-/
import data.equiv.encodable data.sigma
open nat

/-- A denumerable type is one which is (constructively) bijective with ℕ.
  Although we already have a name for this property, namely `α ≃ ℕ`,
  we are here interested in using it as a typeclass. -/
class denumerable (α : Type*) extends encodable α :=
(decode_inv : ∀ n, ∃ a ∈ decode n, encode a = n)

namespace denumerable

section
variables {α : Type*} {β : Type*} [denumerable α] [denumerable β]
open encodable

@[simp] theorem decode_is_some (α) [denumerable α] (n : ℕ) :
  (decode α n).is_some :=
option.is_some_iff_exists.2 $
(decode_inv α n).imp $ λ a, Exists.fst

def of_nat (α) [f : denumerable α] (n : ℕ) : α :=
option.get (decode_is_some α n)

@[simp] theorem decode_eq_of_nat (α) [denumerable α] (n : ℕ) :
  decode α n = some (of_nat α n) :=
option.eq_some_of_is_some _

@[simp] theorem of_nat_of_decode {n b}
  (h : decode α n = some b) : of_nat α n = b :=
option.some.inj $ (decode_eq_of_nat _ _).symm.trans h

@[simp] theorem encode_of_nat (n) : encode (of_nat α n) = n :=
let ⟨a, h, e⟩ := decode_inv α n in
by rwa [of_nat_of_decode h]

@[simp] theorem of_nat_encode (a) : of_nat α (encode a) = a :=
of_nat_of_decode (encodek _)

def eqv (α) [denumerable α] : α ≃ ℕ :=
⟨encode, of_nat α, of_nat_encode, encode_of_nat⟩

def mk' {α} (e : α ≃ ℕ) : denumerable α :=
{ encode := e,
  decode := some ∘ e.symm,
  encodek := λ a, congr_arg some (e.symm_apply_apply _),
  decode_inv := λ n, ⟨_, rfl, e.apply_symm_apply _⟩ }

def of_equiv (α) {β} [denumerable α] (e : β ≃ α) : denumerable β :=
{ decode_inv := λ n, by simp,
  ..encodable.of_equiv _ e }

@[simp] theorem of_equiv_of_nat (α) {β} [denumerable α] (e : β ≃ α)
  (n) : @of_nat β (of_equiv _ e) n = e.symm (of_nat α n) :=
by apply of_nat_of_decode; show option.map _ _ = _; simp

def equiv₂ (α β) [denumerable α] [denumerable β] : α ≃ β := (eqv α).trans (eqv β).symm

instance nat : denumerable nat := ⟨λ n, ⟨_, rfl, rfl⟩⟩

@[simp] theorem of_nat_nat (n) : of_nat ℕ n = n := rfl

instance option : denumerable (option α) := ⟨λ n, by cases n; simp⟩

instance sum : denumerable (α ⊕ β) :=
⟨λ n, begin
  suffices : ∃ a ∈ @decode_sum α β _ _ n,
    encode_sum a = bit (bodd n) (div2 n), {simpa [bit_decomp]},
  simp [decode_sum]; cases bodd n; simp [decode_sum, bit, encode_sum]
end⟩

section sigma
variables {γ : α → Type*} [∀ a, denumerable (γ a)]

instance sigma : denumerable (sigma γ) :=
⟨λ n, by simp [decode_sigma]; exact ⟨_, _, ⟨rfl, heq.rfl⟩, by simp⟩⟩

@[simp] theorem sigma_of_nat_val (n : ℕ) :
  of_nat (sigma γ) n = ⟨of_nat α (unpair n).1, of_nat (γ _) (unpair n).2⟩ :=
option.some.inj $
by rw [← decode_eq_of_nat, decode_sigma_val]; simp; refl

end sigma

instance prod : denumerable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

@[simp] theorem prod_of_nat_val (n : ℕ) :
  of_nat (α × β) n = (of_nat α (unpair n).1, of_nat β (unpair n).2) :=
by simp; refl

@[simp] theorem prod_nat_of_nat : of_nat (ℕ × ℕ) = unpair :=
by funext; simp

instance int : denumerable ℤ := of_equiv _ equiv.int_equiv_nat

instance ulift : denumerable (ulift α) := of_equiv _ equiv.ulift

instance plift : denumerable (plift α) := of_equiv _ equiv.plift

def pair : (α × α) ≃ α := equiv₂ _ _

end
end denumerable