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

! This file was ported from Lean 3 source module group_theory.subgroup.actions
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Subgroup.Basic

/-!
# Actions by `subgroup`s

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

These are just copies of the definitions about `submonoid` starting from `submonoid.mul_action`.

## Tags
subgroup, subgroups

-/

namespace Subgroup

variable {G : Type _} [Group G]

variable {α β : Type _}

/-- The action by a subgroup is the action by the underlying group. -/
@[to_additive "The additive action by an add_subgroup is the action by the underlying\nadd_group. "]
instance [MulAction G α] (S : Subgroup G) : MulAction S α :=
  S.toSubmonoid.MulAction

/- warning: subgroup.smul_def -> Subgroup.smul_def is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {α : Type.{u2}} [_inst_2 : MulAction.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] {S : Subgroup.{u1} G _inst_1} (g : coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (m : α), Eq.{succ u2} α (SMul.smul.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) α (MulAction.toHasSmul.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) α (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (Subgroup.toGroup.{u1} G _inst_1 S))) (Subgroup.mulAction.{u1, u2} G _inst_1 α _inst_2 S)) g m) (SMul.smul.{u1, u2} G α (MulAction.toHasSmul.{u1, u2} G α (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_2) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) G (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) G (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) G (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) G (coeSubtype.{succ u1} G (fun (x : G) => Membership.Mem.{u1, u1} G (Subgroup.{u1} G _inst_1) (SetLike.hasMem.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) x S))))) g) m)
but is expected to have type
  forall {G : Type.{u2}} [_inst_1 : Group.{u2} G] {α : Type.{u1}} [_inst_2 : MulAction.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_1))] {S : Subgroup.{u2} G _inst_1} (g : Subtype.{succ u2} G (fun (x : G) => Membership.mem.{u2, u2} G (Subgroup.{u2} G _inst_1) (SetLike.instMembership.{u2, u2} (Subgroup.{u2} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u2} G _inst_1)) x S)) (m : α), Eq.{succ u1} α (HSMul.hSMul.{u2, u1, u1} (Subtype.{succ u2} G (fun (x : G) => Membership.mem.{u2, u2} G (Subgroup.{u2} G _inst_1) (SetLike.instMembership.{u2, u2} (Subgroup.{u2} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u2} G _inst_1)) x S)) α α (instHSMul.{u2, u1} (Subtype.{succ u2} G (fun (x : G) => Membership.mem.{u2, u2} G (Subgroup.{u2} G _inst_1) (SetLike.instMembership.{u2, u2} (Subgroup.{u2} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u2} G _inst_1)) x S)) α (Submonoid.smul.{u2, u1} G α (Monoid.toMulOneClass.{u2} G (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_1))) (MulAction.toSMul.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_1)) _inst_2) (Subgroup.toSubmonoid.{u2} G _inst_1 S))) g m) (HSMul.hSMul.{u2, u1, u1} G α α (instHSMul.{u2, u1} G α (MulAction.toSMul.{u2, u1} G α (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_1)) _inst_2)) (Subtype.val.{succ u2} G (fun (x : G) => Membership.mem.{u2, u2} G (Set.{u2} G) (Set.instMembershipSet.{u2} G) x (SetLike.coe.{u2, u2} (Subgroup.{u2} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u2} G _inst_1) S)) g) m)
Case conversion may be inaccurate. Consider using '#align subgroup.smul_def Subgroup.smul_defₓ'. -/
@[to_additive]
theorem smul_def [MulAction G α] {S : Subgroup G} (g : S) (m : α) : g • m = (g : G) • m :=
  rfl
#align subgroup.smul_def Subgroup.smul_def
#align add_subgroup.vadd_def AddSubgroup.vadd_def

/- warning: subgroup.smul_comm_class_left -> Subgroup.smulCommClass_left is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {α : Type.{u2}} {β : Type.{u3}} [_inst_2 : MulAction.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] [_inst_3 : SMul.{u2, u3} α β] [_inst_4 : SMulCommClass.{u1, u2, u3} G α β (MulAction.toHasSmul.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_2) _inst_3] (S : Subgroup.{u1} G _inst_1), SMulCommClass.{u1, u2, u3} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) α β (MulAction.toHasSmul.{u1, u3} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) β (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (Subgroup.toGroup.{u1} G _inst_1 S))) (Subgroup.mulAction.{u1, u3} G _inst_1 β _inst_2 S)) _inst_3
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {α : Type.{u2}} {β : Type.{u3}} [_inst_2 : MulAction.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] [_inst_3 : SMul.{u2, u3} α β] [_inst_4 : SMulCommClass.{u1, u2, u3} G α β (MulAction.toSMul.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_2) _inst_3] (S : Subgroup.{u1} G _inst_1), SMulCommClass.{u1, u2, u3} (Subtype.{succ u1} G (fun (x : G) => Membership.mem.{u1, u1} G (Subgroup.{u1} G _inst_1) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u1} G _inst_1)) x S)) α β (Submonoid.smul.{u1, u3} G β (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (MulAction.toSMul.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_2) (Subgroup.toSubmonoid.{u1} G _inst_1 S)) _inst_3
Case conversion may be inaccurate. Consider using '#align subgroup.smul_comm_class_left Subgroup.smulCommClass_leftₓ'. -/
@[to_additive]
instance smulCommClass_left [MulAction G β] [SMul α β] [SMulCommClass G α β] (S : Subgroup G) :
    SMulCommClass S α β :=
  S.toSubmonoid.smulCommClass_left
#align subgroup.smul_comm_class_left Subgroup.smulCommClass_left
#align add_subgroup.vadd_comm_class_left AddSubgroup.vaddCommClass_left

/- warning: subgroup.smul_comm_class_right -> Subgroup.smulCommClass_right is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {α : Type.{u2}} {β : Type.{u3}} [_inst_2 : SMul.{u2, u3} α β] [_inst_3 : MulAction.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] [_inst_4 : SMulCommClass.{u2, u1, u3} α G β _inst_2 (MulAction.toHasSmul.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_3)] (S : Subgroup.{u1} G _inst_1), SMulCommClass.{u2, u1, u3} α (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) β _inst_2 (MulAction.toHasSmul.{u1, u3} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) β (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) S) (Subgroup.toGroup.{u1} G _inst_1 S))) (Subgroup.mulAction.{u1, u3} G _inst_1 β _inst_3 S))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {α : Type.{u2}} {β : Type.{u3}} [_inst_2 : SMul.{u2, u3} α β] [_inst_3 : MulAction.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] [_inst_4 : SMulCommClass.{u2, u1, u3} α G β _inst_2 (MulAction.toSMul.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_3)] (S : Subgroup.{u1} G _inst_1), SMulCommClass.{u2, u1, u3} α (Subtype.{succ u1} G (fun (x : G) => Membership.mem.{u1, u1} G (Subgroup.{u1} G _inst_1) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u1} G _inst_1)) x S)) β _inst_2 (Submonoid.smul.{u1, u3} G β (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (MulAction.toSMul.{u1, u3} G β (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_3) (Subgroup.toSubmonoid.{u1} G _inst_1 S))
Case conversion may be inaccurate. Consider using '#align subgroup.smul_comm_class_right Subgroup.smulCommClass_rightₓ'. -/
@[to_additive]
instance smulCommClass_right [SMul α β] [MulAction G β] [SMulCommClass α G β] (S : Subgroup G) :
    SMulCommClass α S β :=
  S.toSubmonoid.smulCommClass_right
#align subgroup.smul_comm_class_right Subgroup.smulCommClass_right
#align add_subgroup.vadd_comm_class_right AddSubgroup.vaddCommClass_right

/-- Note that this provides `is_scalar_tower S G G` which is needed by `smul_mul_assoc`. -/
instance [SMul α β] [MulAction G α] [MulAction G β] [IsScalarTower G α β] (S : Subgroup G) :
    IsScalarTower S α β :=
  S.toSubmonoid.IsScalarTower

instance [MulAction G α] [FaithfulSMul G α] (S : Subgroup G) : FaithfulSMul S α :=
  S.toSubmonoid.FaithfulSMul

/-- The action by a subgroup is the action by the underlying group. -/
instance [AddMonoid α] [DistribMulAction G α] (S : Subgroup G) : DistribMulAction S α :=
  S.toSubmonoid.DistribMulAction

/-- The action by a subgroup is the action by the underlying group. -/
instance [Monoid α] [MulDistribMulAction G α] (S : Subgroup G) : MulDistribMulAction S α :=
  S.toSubmonoid.MulDistribMulAction

/- warning: subgroup.center.smul_comm_class_left -> Subgroup.center.smulCommClass_left is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G], SMulCommClass.{u1, u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) G G (MulAction.toHasSmul.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) G (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) (Subgroup.toGroup.{u1} G _inst_1 (Subgroup.center.{u1} G _inst_1)))) (Subgroup.mulAction.{u1, u1} G _inst_1 G (Monoid.toMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (Subgroup.center.{u1} G _inst_1))) (Mul.toSMul.{u1} G (MulOneClass.toHasMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)))))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G], SMulCommClass.{u1, u1, u1} (Subtype.{succ u1} G (fun (x : G) => Membership.mem.{u1, u1} G (Subgroup.{u1} G _inst_1) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u1} G _inst_1)) x (Subgroup.center.{u1} G _inst_1))) G G (Submonoid.smul.{u1, u1} G G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (MulAction.toSMul.{u1, u1} G G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) (Monoid.toMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)))) (Subgroup.toSubmonoid.{u1} G _inst_1 (Subgroup.center.{u1} G _inst_1))) (MulAction.toSMul.{u1, u1} G G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) (Monoid.toMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))
Case conversion may be inaccurate. Consider using '#align subgroup.center.smul_comm_class_left Subgroup.center.smulCommClass_leftₓ'. -/
/-- The center of a group acts commutatively on that group. -/
instance center.smulCommClass_left : SMulCommClass (center G) G G :=
  Submonoid.center.smulCommClass_left
#align subgroup.center.smul_comm_class_left Subgroup.center.smulCommClass_left

/- warning: subgroup.center.smul_comm_class_right -> Subgroup.center.smulCommClass_right is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G], SMulCommClass.{u1, u1, u1} G (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) G (Mul.toSMul.{u1} G (MulOneClass.toHasMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) (MulAction.toHasSmul.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) G (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) (Subgroup.center.{u1} G _inst_1)) (Subgroup.toGroup.{u1} G _inst_1 (Subgroup.center.{u1} G _inst_1)))) (Subgroup.mulAction.{u1, u1} G _inst_1 G (Monoid.toMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (Subgroup.center.{u1} G _inst_1)))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G], SMulCommClass.{u1, u1, u1} G (Subtype.{succ u1} G (fun (x : G) => Membership.mem.{u1, u1} G (Subgroup.{u1} G _inst_1) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u1} G _inst_1)) x (Subgroup.center.{u1} G _inst_1))) G (MulAction.toSMul.{u1, u1} G G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) (Monoid.toMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)))) (Submonoid.smul.{u1, u1} G G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (MulAction.toSMul.{u1, u1} G G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) (Monoid.toMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)))) (Subgroup.toSubmonoid.{u1} G _inst_1 (Subgroup.center.{u1} G _inst_1)))
Case conversion may be inaccurate. Consider using '#align subgroup.center.smul_comm_class_right Subgroup.center.smulCommClass_rightₓ'. -/
/-- The center of a group acts commutatively on that group. -/
instance center.smulCommClass_right : SMulCommClass G (center G) G :=
  Submonoid.center.smulCommClass_right
#align subgroup.center.smul_comm_class_right Subgroup.center.smulCommClass_right

end Subgroup


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta, Adam Topaz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor_category
import Mathlib.PostPort

universes v₁ u₁ l

namespace Mathlib

namespace category_theory

/--
The data of a monad on C consists of an endofunctor T together with natural transformations
η : 𝟭 C ⟶ T and μ : T ⋙ T ⟶ T satisfying three equations:
- T μ_X ≫ μ_X = μ_(TX) ≫ μ_X (associativity)
- η_(TX) ≫ μ_X = 1_X (left unit)
- Tη_X ≫ μ_X = 1_X (right unit)
-/
class monad {C : Type u₁} [category C] (T : C ⥤ C)
where
  η : 𝟭 ⟶ T
  μ : T ⋙ T ⟶ T
  assoc' : autoParam
  (∀ (X : C),
    functor.map T (nat_trans.app μ X) ≫ nat_trans.app μ X = nat_trans.app μ (functor.obj T X) ≫ nat_trans.app μ X)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  left_unit' : autoParam (∀ (X : C), nat_trans.app η (functor.obj T X) ≫ nat_trans.app μ X = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_unit' : autoParam (∀ (X : C), functor.map T (nat_trans.app η X) ≫ nat_trans.app μ X = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem monad.assoc {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) : functor.map T (nat_trans.app (monad.μ T) X) ≫ nat_trans.app (monad.μ T) X =
  nat_trans.app (monad.μ T) (functor.obj T X) ≫ nat_trans.app (monad.μ T) X := sorry

@[simp] theorem monad.left_unit {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) : nat_trans.app (monad.η T) (functor.obj T X) ≫ nat_trans.app (monad.μ T) X = 𝟙 := sorry

@[simp] theorem monad.right_unit {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) : functor.map T (nat_trans.app (monad.η T) X) ≫ nat_trans.app (monad.μ T) X = 𝟙 := sorry

@[simp] theorem monad.right_unit_assoc {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) {X' : C} (f' : functor.obj T X ⟶ X') : functor.map T (nat_trans.app (monad.η T) X) ≫ nat_trans.app (monad.μ T) X ≫ f' = f' := sorry

notation:1024 "η_" => Mathlib.category_theory.monad.η

notation:1024 "μ_" => Mathlib.category_theory.monad.μ

/--
The data of a comonad on C consists of an endofunctor G together with natural transformations
ε : G ⟶ 𝟭 C and δ : G ⟶ G ⋙ G satisfying three equations:
- δ_X ≫ G δ_X = δ_X ≫ δ_(GX) (coassociativity)
- δ_X ≫ ε_(GX) = 1_X (left counit)
- δ_X ≫ G ε_X = 1_X (right counit)
-/
class comonad {C : Type u₁} [category C] (G : C ⥤ C)
where
  ε : G ⟶ 𝟭
  δ : G ⟶ G ⋙ G
  coassoc' : autoParam
  (∀ (X : C),
    nat_trans.app δ X ≫ functor.map G (nat_trans.app δ X) = nat_trans.app δ X ≫ nat_trans.app δ (functor.obj G X))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  left_counit' : autoParam (∀ (X : C), nat_trans.app δ X ≫ nat_trans.app ε (functor.obj G X) = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_counit' : autoParam (∀ (X : C), nat_trans.app δ X ≫ functor.map G (nat_trans.app ε X) = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem comonad.coassoc {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G] (X : C) : nat_trans.app (comonad.δ G) X ≫ functor.map G (nat_trans.app (comonad.δ G) X) =
  nat_trans.app (comonad.δ G) X ≫ nat_trans.app (comonad.δ G) (functor.obj G X) := sorry

@[simp] theorem comonad.left_counit {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G] (X : C) : nat_trans.app (comonad.δ G) X ≫ nat_trans.app (comonad.ε G) (functor.obj G X) = 𝟙 := sorry

@[simp] theorem comonad.right_counit {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G] (X : C) : nat_trans.app (comonad.δ G) X ≫ functor.map G (nat_trans.app (comonad.ε G) X) = 𝟙 := sorry

@[simp] theorem comonad.left_counit_assoc {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G] (X : C) {X' : C} (f' : functor.obj G X ⟶ X') : nat_trans.app (comonad.δ G) X ≫ nat_trans.app (comonad.ε G) (functor.obj G X) ≫ f' = f' := sorry

notation:1024 "ε_" => Mathlib.category_theory.comonad.ε

notation:1024 "δ_" => Mathlib.category_theory.comonad.δ

/-- A morphisms of monads is a natural transformation compatible with η and μ. -/
structure monad_hom {C : Type u₁} [category C] (M : C ⥤ C) (N : C ⥤ C) [monad M] [monad N]
extends nat_trans M N
where
  app_η' : autoParam (∀ {X : C}, nat_trans.app η_ X ≫ nat_trans.app _to_nat_trans X = nat_trans.app η_ X)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  app_μ' : autoParam
  (∀ {X : C},
    nat_trans.app μ_ X ≫ nat_trans.app _to_nat_trans X =
      (functor.map M (nat_trans.app _to_nat_trans X) ≫ nat_trans.app _to_nat_trans (functor.obj N X)) ≫
        nat_trans.app μ_ X)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem monad_hom.app_η {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N] (c : monad_hom M N) {X : C} : nat_trans.app η_ X ≫ nat_trans.app (monad_hom.to_nat_trans c) X = nat_trans.app η_ X := sorry

@[simp] theorem monad_hom.app_μ {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N] (c : monad_hom M N) {X : C} : nat_trans.app μ_ X ≫ nat_trans.app (monad_hom.to_nat_trans c) X =
  (functor.map M (nat_trans.app (monad_hom.to_nat_trans c) X) ≫
      nat_trans.app (monad_hom.to_nat_trans c) (functor.obj N X)) ≫
    nat_trans.app μ_ X := sorry

@[simp] theorem monad_hom.app_η_assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N] (c : monad_hom M N) {X : C} {X' : C} (f' : functor.obj N X ⟶ X') : nat_trans.app η_ X ≫ nat_trans.app (monad_hom.to_nat_trans c) X ≫ f' = nat_trans.app η_ X ≫ f' := sorry

/-- A morphisms of comonads is a natural transformation compatible with η and μ. -/
structure comonad_hom {C : Type u₁} [category C] (M : C ⥤ C) (N : C ⥤ C) [comonad M] [comonad N]
extends nat_trans M N
where
  app_ε' : autoParam (∀ {X : C}, nat_trans.app _to_nat_trans X ≫ nat_trans.app ε_ X = nat_trans.app ε_ X)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  app_δ' : autoParam
  (∀ {X : C},
    nat_trans.app _to_nat_trans X ≫ nat_trans.app δ_ X =
      nat_trans.app δ_ X ≫
        nat_trans.app _to_nat_trans (functor.obj M X) ≫ functor.map N (nat_trans.app _to_nat_trans X))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem comonad_hom.app_ε {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N] (c : comonad_hom M N) {X : C} : nat_trans.app (comonad_hom.to_nat_trans c) X ≫ nat_trans.app ε_ X = nat_trans.app ε_ X := sorry

@[simp] theorem comonad_hom.app_δ {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N] (c : comonad_hom M N) {X : C} : nat_trans.app (comonad_hom.to_nat_trans c) X ≫ nat_trans.app δ_ X =
  nat_trans.app δ_ X ≫
    nat_trans.app (comonad_hom.to_nat_trans c) (functor.obj M X) ≫
      functor.map N (nat_trans.app (comonad_hom.to_nat_trans c) X) := sorry

@[simp] theorem comonad_hom.app_δ_assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N] (c : comonad_hom M N) {X : C} {X' : C} (f' : functor.obj N (functor.obj N X) ⟶ X') : nat_trans.app (comonad_hom.to_nat_trans c) X ≫ nat_trans.app δ_ X ≫ f' =
  nat_trans.app δ_ X ≫
    nat_trans.app (comonad_hom.to_nat_trans c) (functor.obj M X) ≫
      functor.map N (nat_trans.app (comonad_hom.to_nat_trans c) X) ≫ f' := sorry

namespace monad_hom

theorem ext {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N] (f : monad_hom M N) (g : monad_hom M N) : to_nat_trans f = to_nat_trans g → f = g := sorry

/-- The identity natural transformations is a morphism of monads. -/
def id {C : Type u₁} [category C] (M : C ⥤ C) [monad M] : monad_hom M M :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] {M : C ⥤ C} [monad M] : Inhabited (monad_hom M M) :=
  { default := id M }

/-- The composition of two morphisms of monads. -/
def comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} [monad M] [monad N] [monad L] (f : monad_hom M N) (g : monad_hom N L) : monad_hom M L :=
  mk (nat_trans.mk fun (X : C) => nat_trans.app (to_nat_trans f) X ≫ nat_trans.app (to_nat_trans g) X)

@[simp] theorem id_comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N] (f : monad_hom M N) : comp (id M) f = f :=
  ext (comp (id M) f) f
    (nat_trans.ext (to_nat_trans (comp (id M) f)) (to_nat_trans f)
      (funext fun (x : C) => category.id_comp (nat_trans.app (to_nat_trans f) x)))

@[simp] theorem comp_id {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N] (f : monad_hom M N) : comp f (id N) = f :=
  ext (comp f (id N)) f
    (nat_trans.ext (to_nat_trans (comp f (id N))) (to_nat_trans f)
      (funext fun (x : C) => category.comp_id (nat_trans.app (to_nat_trans f) x)))

/-- Note: `category_theory.monad.bundled` provides a category instance for bundled monads.-/
@[simp] theorem assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} {K : C ⥤ C} [monad M] [monad N] [monad L] [monad K] (f : monad_hom M N) (g : monad_hom N L) (h : monad_hom L K) : comp (comp f g) h = comp f (comp g h) := sorry

end monad_hom

namespace comonad_hom

theorem ext {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N] (f : comonad_hom M N) (g : comonad_hom M N) : to_nat_trans f = to_nat_trans g → f = g := sorry

/-- The identity natural transformations is a morphism of comonads. -/
def id {C : Type u₁} [category C] (M : C ⥤ C) [comonad M] : comonad_hom M M :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] {M : C ⥤ C} [comonad M] : Inhabited (comonad_hom M M) :=
  { default := id M }

/-- The composition of two morphisms of comonads. -/
def comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} [comonad M] [comonad N] [comonad L] (f : comonad_hom M N) (g : comonad_hom N L) : comonad_hom M L :=
  mk (nat_trans.mk fun (X : C) => nat_trans.app (to_nat_trans f) X ≫ nat_trans.app (to_nat_trans g) X)

@[simp] theorem id_comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N] (f : comonad_hom M N) : comp (id M) f = f :=
  ext (comp (id M) f) f
    (nat_trans.ext (to_nat_trans (comp (id M) f)) (to_nat_trans f)
      (funext fun (x : C) => category.id_comp (nat_trans.app (to_nat_trans f) x)))

@[simp] theorem comp_id {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N] (f : comonad_hom M N) : comp f (id N) = f :=
  ext (comp f (id N)) f
    (nat_trans.ext (to_nat_trans (comp f (id N))) (to_nat_trans f)
      (funext fun (x : C) => category.comp_id (nat_trans.app (to_nat_trans f) x)))

/-- Note: `category_theory.monad.bundled` provides a category instance for bundled comonads.-/
@[simp] theorem assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} {K : C ⥤ C} [comonad M] [comonad N] [comonad L] [comonad K] (f : comonad_hom M N) (g : comonad_hom N L) (h : comonad_hom L K) : comp (comp f g) h = comp f (comp g h) := sorry

end comonad_hom

namespace monad

protected instance category_theory.functor.id.monad {C : Type u₁} [category C] : monad 𝟭 :=
  mk 𝟙 𝟙

end monad

namespace comonad

protected instance category_theory.functor.id.comonad {C : Type u₁} [category C] : comonad 𝟭 :=
  mk 𝟙 𝟙


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

! This file was ported from Lean 3 source module algebra.direct_sum.internal
! leanprover-community/mathlib commit 9936c3dfc04e5876f4368aeb2e60f8d8358d095a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Operations
import Mathbin.Algebra.Algebra.Subalgebra.Basic
import Mathbin.Algebra.DirectSum.Algebra

/-!
# Internally graded rings and algebras

This module provides `gsemiring` and `gcomm_semiring` instances for a collection of subobjects `A`
when a `set_like.graded_monoid` instance is available:

* `set_like.gnon_unital_non_assoc_semiring`
* `set_like.gsemiring`
* `set_like.gcomm_semiring`

With these instances in place, it provides the bundled canonical maps out of a direct sum of
subobjects into their carrier type:

* `direct_sum.coe_ring_hom` (a `ring_hom` version of `direct_sum.coe_add_monoid_hom`)
* `direct_sum.coe_alg_hom` (an `alg_hom` version of `direct_sum.submodule_coe`)

Strictly the definitions in this file are not sufficient to fully define an "internal" direct sum;
to represent this case, `(h : direct_sum.is_internal A) [set_like.graded_monoid A]` is
needed. In the future there will likely be a data-carrying, constructive, typeclass version of
`direct_sum.is_internal` for providing an explicit decomposition function.

When `complete_lattice.independent (set.range A)` (a weaker condition than
`direct_sum.is_internal A`), these provide a grading of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

internally graded ring
-/

open DirectSum BigOperators

variable {ι : Type _} {σ S R : Type _}

instance AddCommMonoid.ofSubmonoidOnSemiring [Semiring R] [SetLike σ R] [AddSubmonoidClass σ R]
    (A : ι → σ) : ∀ i, AddCommMonoid (A i) := fun i => by infer_instance
#align add_comm_monoid.of_submonoid_on_semiring AddCommMonoid.ofSubmonoidOnSemiring

instance AddCommGroup.ofSubgroupOnRing [Ring R] [SetLike σ R] [AddSubgroupClass σ R] (A : ι → σ) :
    ∀ i, AddCommGroup (A i) := fun i => by infer_instance
#align add_comm_group.of_subgroup_on_ring AddCommGroup.ofSubgroupOnRing

theorem SetLike.algebraMap_mem_graded [Zero ι] [CommSemiring S] [Semiring R] [Algebra S R]
    (A : ι → Submodule S R) [SetLike.GradedOne A] (s : S) : algebraMap S R s ∈ A 0 :=
  by
  rw [Algebra.algebraMap_eq_smul_one]
  exact (A 0).smul_mem s <| SetLike.one_mem_graded _
#align set_like.algebra_map_mem_graded SetLike.algebraMap_mem_graded

theorem SetLike.nat_cast_mem_graded [Zero ι] [AddMonoidWithOne R] [SetLike σ R]
    [AddSubmonoidClass σ R] (A : ι → σ) [SetLike.GradedOne A] (n : ℕ) : (n : R) ∈ A 0 :=
  by
  induction n
  · rw [Nat.cast_zero]
    exact zero_mem (A 0)
  · rw [Nat.cast_succ]
    exact add_mem n_ih (SetLike.one_mem_graded _)
#align set_like.nat_cast_mem_graded SetLike.nat_cast_mem_graded

theorem SetLike.int_cast_mem_graded [Zero ι] [AddGroupWithOne R] [SetLike σ R]
    [AddSubgroupClass σ R] (A : ι → σ) [SetLike.GradedOne A] (z : ℤ) : (z : R) ∈ A 0 :=
  by
  induction z
  · rw [Int.cast_ofNat]
    exact SetLike.nat_cast_mem_graded _ _
  · rw [Int.cast_negSucc]
    exact neg_mem (SetLike.nat_cast_mem_graded _ _)
#align set_like.int_cast_mem_graded SetLike.int_cast_mem_graded

section DirectSum

variable [DecidableEq ι]

/-! #### From `add_submonoid`s and `add_subgroup`s -/

namespace SetLike

/-- Build a `gnon_unital_non_assoc_semiring` instance for a collection of additive submonoids. -/
instance gnonUnitalNonAssocSemiring [Add ι] [NonUnitalNonAssocSemiring R] [SetLike σ R]
    [AddSubmonoidClass σ R] (A : ι → σ) [SetLike.GradedMul A] :
    DirectSum.GnonUnitalNonAssocSemiring fun i => A i :=
  {
    SetLike.gMul
      A with
    mul_zero := fun i j _ => Subtype.ext (MulZeroClass.mul_zero _)
    zero_mul := fun i j _ => Subtype.ext (MulZeroClass.zero_mul _)
    mul_add := fun i j _ _ _ => Subtype.ext (mul_add _ _ _)
    add_mul := fun i j _ _ _ => Subtype.ext (add_mul _ _ _) }
#align set_like.gnon_unital_non_assoc_semiring SetLike.gnonUnitalNonAssocSemiring

/-- Build a `gsemiring` instance for a collection of additive submonoids. -/
instance gsemiring [AddMonoid ι] [Semiring R] [SetLike σ R] [AddSubmonoidClass σ R] (A : ι → σ)
    [SetLike.GradedMonoid A] : DirectSum.Gsemiring fun i => A i :=
  {
    SetLike.gMonoid
      A with
    mul_zero := fun i j _ => Subtype.ext (MulZeroClass.mul_zero _)
    zero_mul := fun i j _ => Subtype.ext (MulZeroClass.zero_mul _)
    mul_add := fun i j _ _ _ => Subtype.ext (mul_add _ _ _)
    add_mul := fun i j _ _ _ => Subtype.ext (add_mul _ _ _)
    natCast := fun n => ⟨n, SetLike.nat_cast_mem_graded _ _⟩
    natCast_zero := Subtype.ext Nat.cast_zero
    natCast_succ := fun n => Subtype.ext (Nat.cast_succ n) }
#align set_like.gsemiring SetLike.gsemiring

/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/
instance gcommSemiring [AddCommMonoid ι] [CommSemiring R] [SetLike σ R] [AddSubmonoidClass σ R]
    (A : ι → σ) [SetLike.GradedMonoid A] : DirectSum.GcommSemiring fun i => A i :=
  { SetLike.gCommMonoid A, SetLike.gsemiring A with }
#align set_like.gcomm_semiring SetLike.gcommSemiring

/-- Build a `gring` instance for a collection of additive subgroups. -/
instance gring [AddMonoid ι] [Ring R] [SetLike σ R] [AddSubgroupClass σ R] (A : ι → σ)
    [SetLike.GradedMonoid A] : DirectSum.Gring fun i => A i :=
  {
    SetLike.gsemiring
      A with
    intCast := fun z => ⟨z, SetLike.int_cast_mem_graded _ _⟩
    intCast_ofNat := fun n => Subtype.ext <| Int.cast_ofNat _
    intCast_negSucc := fun n => Subtype.ext <| Int.cast_negSucc n }
#align set_like.gring SetLike.gring

/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/
instance gcommRing [AddCommMonoid ι] [CommRing R] [SetLike σ R] [AddSubgroupClass σ R] (A : ι → σ)
    [SetLike.GradedMonoid A] : DirectSum.GcommRing fun i => A i :=
  { SetLike.gCommMonoid A, SetLike.gring A with }
#align set_like.gcomm_ring SetLike.gcommRing

end SetLike

namespace DirectSum

section coe

variable [Semiring R] [SetLike σ R] [AddSubmonoidClass σ R] (A : ι → σ)

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
def coeRingHom [AddMonoid ι] [SetLike.GradedMonoid A] : (⨁ i, A i) →+* R :=
  DirectSum.toSemiring (fun i => AddSubmonoidClass.Subtype (A i)) rfl fun _ _ _ _ => rfl
#align direct_sum.coe_ring_hom DirectSum.coeRingHom

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
@[simp]
theorem coeRingHom_of [AddMonoid ι] [SetLike.GradedMonoid A] (i : ι) (x : A i) :
    (coeRingHom A : _ →+* R) (of (fun i => A i) i x) = x :=
  DirectSum.toSemiring_of _ _ _ _ _
#align direct_sum.coe_ring_hom_of DirectSum.coeRingHom_of

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem coe_mul_apply [AddMonoid ι] [SetLike.GradedMonoid A]
    [∀ (i : ι) (x : A i), Decidable (x ≠ 0)] (r r' : ⨁ i, A i) (n : ι) :
    ((r * r') n : R) =
      ∑ ij in (r.support ×ˢ r'.support).filterₓ fun ij : ι × ι => ij.1 + ij.2 = n,
        r ij.1 * r' ij.2 :=
  by
  rw [mul_eq_sum_support_ghas_mul, Dfinsupp.finset_sum_apply, AddSubmonoidClass.coe_finset_sum]
  simp_rw [coe_of_apply, ← Finset.sum_filter, SetLike.coe_gMul]
#align direct_sum.coe_mul_apply DirectSum.coe_mul_apply

theorem coe_mul_apply_eq_dfinsupp_sum [AddMonoid ι] [SetLike.GradedMonoid A]
    [∀ (i : ι) (x : A i), Decidable (x ≠ 0)] (r r' : ⨁ i, A i) (n : ι) :
    ((r * r') n : R) = r.Sum fun i ri => r'.Sum fun j rj => if i + j = n then ri * rj else 0 :=
  by
  simp only [mul_eq_dfinsupp_sum, Dfinsupp.sum_apply]
  iterate 2 rw [Dfinsupp.sum, AddSubmonoidClass.coe_finset_sum]; congr ; ext
  dsimp only; split_ifs
  · subst h
    rw [of_eq_same]
    rfl
  · rw [of_eq_of_ne _ _ _ _ h]
    rfl
#align direct_sum.coe_mul_apply_eq_dfinsupp_sum DirectSum.coe_mul_apply_eq_dfinsupp_sum

theorem coe_of_mul_apply_aux [AddMonoid ι] [SetLike.GradedMonoid A] {i : ι} (r : A i)
    (r' : ⨁ i, A i) {j n : ι} (H : ∀ x : ι, i + x = n ↔ x = j) :
    ((of _ i r * r') n : R) = r * r' j := by
  classical
    rw [coe_mul_apply_eq_dfinsupp_sum]
    apply (Dfinsupp.sum_single_index _).trans
    swap
    · simp_rw [ZeroMemClass.coe_zero, MulZeroClass.zero_mul, if_t_t]
      exact Dfinsupp.sum_zero
    simp_rw [Dfinsupp.sum, H, Finset.sum_ite_eq']
    split_ifs
    rfl
    rw [dfinsupp.not_mem_support_iff.mp h, ZeroMemClass.coe_zero, MulZeroClass.mul_zero]
#align direct_sum.coe_of_mul_apply_aux DirectSum.coe_of_mul_apply_aux

theorem coe_mul_of_apply_aux [AddMonoid ι] [SetLike.GradedMonoid A] (r : ⨁ i, A i) {i : ι}
    (r' : A i) {j n : ι} (H : ∀ x : ι, x + i = n ↔ x = j) : ((r * of _ i r') n : R) = r j * r' := by
  classical
    rw [coe_mul_apply_eq_dfinsupp_sum, Dfinsupp.sum_comm]
    apply (Dfinsupp.sum_single_index _).trans
    swap
    · simp_rw [ZeroMemClass.coe_zero, MulZeroClass.mul_zero, if_t_t]
      exact Dfinsupp.sum_zero
    simp_rw [Dfinsupp.sum, H, Finset.sum_ite_eq']
    split_ifs
    rfl
    rw [dfinsupp.not_mem_support_iff.mp h, ZeroMemClass.coe_zero, MulZeroClass.zero_mul]
#align direct_sum.coe_mul_of_apply_aux DirectSum.coe_mul_of_apply_aux

theorem coe_of_mul_apply_add [AddLeftCancelMonoid ι] [SetLike.GradedMonoid A] {i : ι} (r : A i)
    (r' : ⨁ i, A i) (j : ι) : ((of _ i r * r') (i + j) : R) = r * r' j :=
  coe_of_mul_apply_aux _ _ _ fun x => ⟨fun h => add_left_cancel h, fun h => h ▸ rfl⟩
#align direct_sum.coe_of_mul_apply_add DirectSum.coe_of_mul_apply_add

theorem coe_mul_of_apply_add [AddRightCancelMonoid ι] [SetLike.GradedMonoid A] (r : ⨁ i, A i)
    {i : ι} (r' : A i) (j : ι) : ((r * of _ i r') (j + i) : R) = r j * r' :=
  coe_mul_of_apply_aux _ _ _ fun x => ⟨fun h => add_right_cancel h, fun h => h ▸ rfl⟩
#align direct_sum.coe_mul_of_apply_add DirectSum.coe_mul_of_apply_add

end coe

section CanonicallyOrderedAddMonoid

variable [Semiring R] [SetLike σ R] [AddSubmonoidClass σ R] (A : ι → σ)

variable [CanonicallyOrderedAddMonoid ι] [SetLike.GradedMonoid A]

theorem coe_of_mul_apply_of_not_le {i : ι} (r : A i) (r' : ⨁ i, A i) (n : ι) (h : ¬i ≤ n) :
    ((of _ i r * r') n : R) = 0 := by
  classical
    rw [coe_mul_apply_eq_dfinsupp_sum]
    apply (Dfinsupp.sum_single_index _).trans
    swap
    · simp_rw [ZeroMemClass.coe_zero, MulZeroClass.zero_mul, if_t_t]
      exact Dfinsupp.sum_zero
    · rw [Dfinsupp.sum, Finset.sum_ite_of_false _ _ fun x _ H => _, Finset.sum_const_zero]
      exact h ((self_le_add_right i x).trans_eq H)
#align direct_sum.coe_of_mul_apply_of_not_le DirectSum.coe_of_mul_apply_of_not_le

theorem coe_mul_of_apply_of_not_le (r : ⨁ i, A i) {i : ι} (r' : A i) (n : ι) (h : ¬i ≤ n) :
    ((r * of _ i r') n : R) = 0 := by
  classical
    rw [coe_mul_apply_eq_dfinsupp_sum, Dfinsupp.sum_comm]
    apply (Dfinsupp.sum_single_index _).trans
    swap
    · simp_rw [ZeroMemClass.coe_zero, MulZeroClass.mul_zero, if_t_t]
      exact Dfinsupp.sum_zero
    · rw [Dfinsupp.sum, Finset.sum_ite_of_false _ _ fun x _ H => _, Finset.sum_const_zero]
      exact h ((self_le_add_left i x).trans_eq H)
#align direct_sum.coe_mul_of_apply_of_not_le DirectSum.coe_mul_of_apply_of_not_le

variable [Sub ι] [OrderedSub ι] [ContravariantClass ι ι (· + ·) (· ≤ ·)]

/- The following two lemmas only require the same hypotheses as `eq_tsub_iff_add_eq_of_le`, but we
  state them for `canonically_ordered_add_monoid` + the above three typeclasses for convenience. -/
theorem coe_mul_of_apply_of_le (r : ⨁ i, A i) {i : ι} (r' : A i) (n : ι) (h : i ≤ n) :
    ((r * of _ i r') n : R) = r (n - i) * r' :=
  coe_mul_of_apply_aux _ _ _ fun x => (eq_tsub_iff_add_eq_of_le h).symm
#align direct_sum.coe_mul_of_apply_of_le DirectSum.coe_mul_of_apply_of_le

theorem coe_of_mul_apply_of_le {i : ι} (r : A i) (r' : ⨁ i, A i) (n : ι) (h : i ≤ n) :
    ((of _ i r * r') n : R) = r * r' (n - i) :=
  coe_of_mul_apply_aux _ _ _ fun x => by rw [eq_tsub_iff_add_eq_of_le h, add_comm]
#align direct_sum.coe_of_mul_apply_of_le DirectSum.coe_of_mul_apply_of_le

theorem coe_mul_of_apply (r : ⨁ i, A i) {i : ι} (r' : A i) (n : ι) [Decidable (i ≤ n)] :
    ((r * of _ i r') n : R) = if i ≤ n then r (n - i) * r' else 0 :=
  by
  split_ifs
  exacts[coe_mul_of_apply_of_le _ _ _ n h, coe_mul_of_apply_of_not_le _ _ _ n h]
#align direct_sum.coe_mul_of_apply DirectSum.coe_mul_of_apply

theorem coe_of_mul_apply {i : ι} (r : A i) (r' : ⨁ i, A i) (n : ι) [Decidable (i ≤ n)] :
    ((of _ i r * r') n : R) = if i ≤ n then r * r' (n - i) else 0 :=
  by
  split_ifs
  exacts[coe_of_mul_apply_of_le _ _ _ n h, coe_of_mul_apply_of_not_le _ _ _ n h]
#align direct_sum.coe_of_mul_apply DirectSum.coe_of_mul_apply

end CanonicallyOrderedAddMonoid

end DirectSum

/-! #### From `submodule`s -/

namespace Submodule

/-- Build a `galgebra` instance for a collection of `submodule`s. -/
instance galgebra [AddMonoid ι] [CommSemiring S] [Semiring R] [Algebra S R] (A : ι → Submodule S R)
    [SetLike.GradedMonoid A] : DirectSum.Galgebra S fun i => A i
    where
  toFun :=
    ((Algebra.linearMap S R).codRestrict (A 0) <| SetLike.algebraMap_mem_graded A).toAddMonoidHom
  map_one := Subtype.ext <| (algebraMap S R).map_one
  map_mul x y := Sigma.subtype_ext (add_zero 0).symm <| (algebraMap S R).map_mul _ _
  commutes := fun r ⟨i, xi⟩ =>
    Sigma.subtype_ext ((zero_add i).trans (add_zero i).symm) <| Algebra.commutes _ _
  smul_def := fun r ⟨i, xi⟩ => Sigma.subtype_ext (zero_add i).symm <| Algebra.smul_def _ _
#align submodule.galgebra Submodule.galgebra

@[simp]
theorem setLike.coe_galgebra_toFun [AddMonoid ι] [CommSemiring S] [Semiring R] [Algebra S R]
    (A : ι → Submodule S R) [SetLike.GradedMonoid A] (s : S) :
    ↑(@DirectSum.Galgebra.toFun _ S (fun i => A i) _ _ _ _ _ _ _ s) = (algebraMap S R s : R) :=
  rfl
#align submodule.set_like.coe_galgebra_to_fun Submodule.setLike.coe_galgebra_toFun

/-- A direct sum of powers of a submodule of an algebra has a multiplicative structure. -/
instance nat_power_gradedMonoid [CommSemiring S] [Semiring R] [Algebra S R] (p : Submodule S R) :
    SetLike.GradedMonoid fun i : ℕ => p ^ i
    where
  one_mem := by
    rw [← one_le, pow_zero]
    exact le_rfl
  mul_mem i j p q hp hq := by
    rw [pow_add]
    exact Submodule.mul_mem_mul hp hq
#align submodule.nat_power_graded_monoid Submodule.nat_power_gradedMonoid

end Submodule

/-- The canonical algebra isomorphism between `⨁ i, A i` and `R`. -/
def DirectSum.coeAlgHom [AddMonoid ι] [CommSemiring S] [Semiring R] [Algebra S R]
    (A : ι → Submodule S R) [SetLike.GradedMonoid A] : (⨁ i, A i) →ₐ[S] R :=
  DirectSum.toAlgebra S _ (fun i => (A i).Subtype) rfl (fun _ _ _ _ => rfl) fun _ => rfl
#align direct_sum.coe_alg_hom DirectSum.coeAlgHom

/-- The supremum of submodules that form a graded monoid is a subalgebra, and equal to the range of
`direct_sum.coe_alg_hom`. -/
theorem Submodule.supᵢ_eq_toSubmodule_range [AddMonoid ι] [CommSemiring S] [Semiring R]
    [Algebra S R] (A : ι → Submodule S R) [SetLike.GradedMonoid A] :
    (⨆ i, A i) = (DirectSum.coeAlgHom A).range.toSubmodule :=
  (Submodule.supᵢ_eq_range_dfinsupp_lsum A).trans <| SetLike.coe_injective rfl
#align submodule.supr_eq_to_submodule_range Submodule.supᵢ_eq_toSubmodule_range

@[simp]
theorem DirectSum.coeAlgHom_of [AddMonoid ι] [CommSemiring S] [Semiring R] [Algebra S R]
    (A : ι → Submodule S R) [SetLike.GradedMonoid A] (i : ι) (x : A i) :
    DirectSum.coeAlgHom A (DirectSum.of (fun i => A i) i x) = x :=
  DirectSum.toSemiring_of _ rfl (fun _ _ _ _ => rfl) _ _
#align direct_sum.coe_alg_hom_of DirectSum.coeAlgHom_of

end DirectSum

section HomogeneousElement

theorem SetLike.homogeneous_zero_submodule [Zero ι] [Semiring S] [AddCommMonoid R] [Module S R]
    (A : ι → Submodule S R) : SetLike.Homogeneous A (0 : R) :=
  ⟨0, Submodule.zero_mem _⟩
#align set_like.is_homogeneous_zero_submodule SetLike.homogeneous_zero_submodule

theorem SetLike.Homogeneous.smul [CommSemiring S] [Semiring R] [Algebra S R] {A : ι → Submodule S R}
    {s : S} {r : R} (hr : SetLike.Homogeneous A r) : SetLike.Homogeneous A (s • r) :=
  let ⟨i, hi⟩ := hr
  ⟨i, Submodule.smul_mem _ _ hi⟩
#align set_like.is_homogeneous.smul SetLike.Homogeneous.smul

end HomogeneousElement


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $α$ be an irrational number
  assume α : ℝ,
  assume hα_irrat : irrational α,
  -- show the fractional parts of the integer multiples of $α$ form a dense subset of the unit interval
  have Icc_subset : ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from --assume m : ℤ, by {rw int.fract_eq,
    assume m : ℤ, by {rw int.fract_eq, simp [int.fract_bound_eq], },
  have closure_subset_eq : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from by {rw ← Icc_subset, exact closure_subset _ _},
  have h1 : ∀ x, x ∈ set.Icc 0 1 → x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from begin
    assume (x : ℝ),
    assume : x ∈ set.Icc 0 1,
    have h2 : ∀ n : ℤ, ∃ (m : ℤ), ∃ (M : ℤ), (M ≥ 0 ∧ M ≤ n) ∧
      (int.fract (α * ↑m) - int.fract (α * ↑n)) < x ∧ int.fract (α * ↑m) ∈ set.Icc 0 1, from begin
      assume n : ℤ,
      have h3 : ∃ m : ℤ, int.fract (α * ↑m) < x, from begin
        have exists_nat : ∃ n : ℕ, (n : ℝ) ≥ x, from exists_nat_ge x,
        show ∃ m : ℤ, int.fract (α * ↑m) < x, from exists.elim exists_nat
          (assume n, assume h4 : n ∈ ℕ, assume h5 : (↑n : ℝ) ≥ x,
          exists.elim h5 (assume h6 : ↑n = x,
            obtain (m : ℕ) (h7 : ↑n = ↑m * α)
                     (h8 : ↑n > (↑m : ℝ) * α → abs (↑n - ↑m * α) ≤ 1), from hα_irrat x,
            have h9 : m ∈ ℤ, from exists.elim h8 (assume m : ℤ, assume h10 : ↑n = ↑m * α,
              have h11 : ↑m ∈ ℕ, from (nat.of_int_eq_coe.mp h10).symm ▸ h4,
              show m ∈ ℤ, from int.coe_nat_of_nat h11),
            have h10 : ↑(nat.fract m) = x, from nat.fract_eq_of_eq h7,
            have h11 : 1 ≥ 0, from trivial,
            have h12 : int.fract ↑m = int.fract (α * ↑m), from begin
              show int.fract ↑m = int.fract ↑m * α - int.fract ↑m + int.fract (α * ↑m), by ring,
            end,
            have h13 : int.fract ↑m = int.fract (α * ↑m), from by {rw nat.fract_eq (by {have h14 : ↑m ∈ ℤ, from exists.elim h8 (assume m : ℤ,
              assume h15 : ↑n = ↑m * α, show ↑m ∈ ℤ, from int.coe_nat_of_nat h4), rw nat.fract_eq}), rw nat.fract_eq at h12,
            rw h10 at h12, rw ← h12, simp [int.fract_bound_eq], assumption,},
            have h14 : int.fract ↑m < x, from by {rw ← h10, rw int.fract_eq,
            simp [int.fract_bound_eq], assumption,},
            have h15 : int.fract (α * ↑m) = int.fract ↑m, from by rw [h13, mul_comm],
            have h16 : int.fract (α * ↑m) < x, from by rw ← h15 at h14,
            show _, from ⟨↑m, h9, h16⟩)),
        have h7 : ∃ (m : ℤ), int.fract (α * ↑m) < x, from exists.elim h3 (assume m : ℤ,
          assume h8 : int.fract (α * ↑m) < x, show _, from ⟨m, h8⟩),
        show ∃ (m : ℤ), ∃ (M : ℤ), (M ≥ 0 ∧ M ≤ n) ∧
          (int.fract (α * ↑m) - int.fract (α * ↑n)) < x ∧ int.fract (α * ↑m) ∈ set.Icc 0 1, from exists.elim h7 (assume m : ℤ,
          assume h9 : int.fract (α * ↑m) < x, exists.elim h9 (assume h10 : int.fract (α * ↑m) < x,
          exists.elim (le_iff_exists_add.mp (le_of_lt h10)) (assume M : ℤ, assume h11 : int.fract (α * ↑m) + (↑M : ℝ) = x,
          exists.elim h11 (assume h12 : int.fract (α * ↑m) + ↑M = x,
          exists.elim h12 (assume h13 : int.fract (α * ↑m) + ↑M = x,
          show _, from ⟨int.of_nat (nat.fract m), by {have h14 : ↑m = ↑m * α, from mul_one_eq_of_irrational hα_irrat,
          rw h14 at h13, rw mul_comm at h13, rw nat.fract_eq at h13, rw ← nat.fract_eq at h13, rw ← h13, rw mul_comm,
          rw int.of_nat_eq_coe, simp}, h13 ▸ le_refl _, by {rw int.fract_eq at h13, rw mul_comm at h13, simp at h13, rw [← h13,int.fract_add], ring,},
          by {have m_bound : ↑m ∈ ℤ, from nat.le.dest (nat.fract_le_nat h10) ▸ h9.1,
          show int.fract (α * ↑m) ∈ set.Icc 0 1, from by {rw int.fract_eq, simp [int.fract_bound_eq],
          have h14 : ↑m < ↑m + 1, from exists.elim h10 (assume h15 : α > 0, by linarith [h15]) ,
          have h15 : (↑m : ℝ) ≥ 0, from nat.succ_le_iff.mp h14, rw [int.fract_eq, mul_comm] at h10,
          have h16 : (α * ↑m) - ↑m < α, from
            begin
              have h17 : (α * ↑m) - ↑m < ↑m + 1 - ↑m, from ← h10,
              have h18 : (α * ↑m) - ↑m < ↑m, from h17 ▸ nat.cast_succ_le_self h14,
              have h19 : (α * ↑m) - ↑m + ↑m = ↑m * α, from by ring, rw ← h19 at h18,
              have h20 : (α * ↑m) - ↑m + ↑m < ↑m * α, from h18, have h21 : (α * ↑m) - ↑
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number
  assume hα_irrat : irrational α,

  --Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$
  have h1 : ∀ (i j : ℤ) (h_ij_distinct : i ≠ j), int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume (i j : ℤ) (h_ij_distinct : i ≠ j), by
  {
    have h1_1 : α * ↑i - (α * ↑i) ≠ α * ↑j - (α * ↑j), from
    begin
      rw int.fract,
      rw int.fract,
      assume h : α * ↑i - (α * ↑i) = α * ↑j - (α * ↑j),
      rw [h,← int.cast_mul,← int.cast_mul i,← int.cast_mul j,← int.cast_mul (i-j),← int.cast_mul i] at h,
      have h1_1_1 : rational (α * ↑j - (α * ↑j)), from by {rw ← h, apply rat_of_real_fract_of_real,},
      have h1_1_2 : rational (α * ↑i - (α * ↑i)), by {apply rat_of_real_fract_of_real,},
      have h1_1_3 : rational ((↑i-j) * (α * ↑i - (α * ↑i))), from rat.mul_self h1_1_2,
      have h1_1_4 : (↑i-j) * (α * ↑i - (α * ↑i)) = (1 : ℝ), from by {rw ← int.cast_mul (i-j),rw ← h,rw ← int.cast_one,ring,},
      have h1_1_5 : rational ((1 : ℝ)), from h1_1_3,
      have h1_1_6 : ((1 : ℝ)) = (1 : ℚ), by {apply rat.eq_of_mul_self_eq_one h1_1_5,},
      have h1_1_7 : ((1 : ℝ)) = rat.cast ((1 : ℚ)), by {rw h1_1_6,rw rat.cast_one,},
      have h1_1_8 : ((1 : ℝ)) = 1, by {rw ← h1_1_7,apply rat.cast_injective,},
      have h1_1_9 : 1 ≠ 0, from by {unfold has_zero.zero,rw h1_1_8,refl,},
      have h1_1_10 : ↑i - j ≠ 0, from by {contradiction,},
      rw [h1_1_4,← int.cast_mul (↑i-j),← int.cast_mul (↑i-j),← int.cast_mul (↑i-j),int.cast_one] at h1_1_1,
      rw [← int.cast_mul (↑i-j)] at h1_1_3,
      have h1_1_11 : (1 : ℚ) * ((↑i-j) * α) = (1 : ℚ), from by {rw ← int.cast_mul (↑i-j),rw ← rat.cast_one,rw ← h,rw ← rat.cast_mul,rw ← rat.cast_mul,ring,},
      have h1_1_12 : (1 : ℚ) * ((↑i-j) * α) = (1 : ℚ), from by {rw ← rat.cast_one,rw ← h1_1_1,rw rat.cast_mul,rw rat.cast_mul,},
      have h1_1_13 : (1 : ℚ) = rat.cast ((↑i-j) * α), from by {rw h1_1_12,rw h1_1_11,},
      have h1_1_14 : (1 : ℝ) = (↑i-j) * α, from by {rw ← rat.cast_one,rw ← h1_1_13,apply rat.cast_injective,},
      have h1_1_15 : (1 : ℝ) = ((↑i-j) : ℚ) * α, from by {rw ← int.cast_mul (i-j),rw h1_1_14,},
      have h1_1_16 : (1 : ℝ) = ((↑i-j) : ℚ) * α, from by {rw ← rat.cast_one,rw ← h1_1_15,apply rat.cast_injective,},
      have h1_1_17 : (1 : ℚ) = ((↑i-j) : ℚ) * α, from by ring at h1_1_16,
      exact hα_irrat h1_1_17,
    end,
    exact ne_of_lt (abs_int_fract_lt_one (α * ↑i)) (abs_int_fract_lt_one (α * ↑j)) h1_1,
  },

  --If this were not true, then
  --$$
  --i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  --$$
  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h2 : ∀ (i j : ℤ) (h_ij_distinct : i ≠ j), rat.cast (α) ≠ (((rat.cast (α * ↑i)) - (rat.cast (α * ↑j))) / (↑i - ↑j)), from
  assume (i j : ℤ) (h_ij_distinct : i ≠ j),
  begin
    assume h : rat.cast (α) = (((rat.cast (α * ↑i)) - (rat.cast (α * ↑j))) / (↑i - ↑j)),
    rw [rat.cast_mul,rat.cast_mul] at h,
    have h1 : (rat.cast (α * ↑i)) - (rat.cast (α * ↑j)) = (rat.cast (α)) * (↑i - ↑j), from by {rw ← h,ring,},
    have h2 : rat.cast (α * ↑i) - rat.cast (α * ↑j) = rat.cast (α) * (↑i - ↑j), from by rw [rat.cast_mul] at h1,
    have h3 : rat.cast (α * ↑i) = rat.cast (α) * ↑i, from by {apply rat.mul_self,},
    have h4 : rat.cast (α * ↑j) = rat.cast (α) * ↑j, from by {apply rat.mul_self,},
    have h5 : rat.cast (α) = rat.cast (α) * ↑i, from by {apply rat.cast_injective,},
    have h6 : rat.cast (α) = rat.cast (((↑i) : ℚ) * α), from by rw [← h5,← rat.cast_one,← rat.cast_mul,← rat.cast_mul],
    have h7 : rat.cast (α) = rat.cast (((↑i) : ℚ) * α), from by ring at h3,
    have h8 : rational (rat.cast (α)), from by {apply rat.cast_ne_zero,},
    have h9 : rat.cast (((↑i) : ℚ) * α) ≠ rat.cast 0, from by {contradiction,},
    have h10 : rat.cast (α) ≠ 0,
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then
  assume hα_irrat : irrational α,
  -- for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from
  assume (i j : ℤ) (hne : i ≠ j),
  -- If this were not true, then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
  have h2a : (α * ↑i) - (int.to_nat (α * ↑i)) = (int.fract (α * ↑i)) := by {rw fract_eq_sub_floor,ring},
  have h2b : (α * ↑j) - (int.to_nat (α * ↑j)) = (int.fract (α * ↑j)) := by {rw fract_eq_sub_floor,ring},
  assume h2c : (int.fract (α * ↑i)) = (int.fract (α * ↑j)),
  rw h2c at h2a h2b,
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h2d : (α - int.fract α) + (int.fract α) = α := by ring,
  have h2e : (int.fract α) = α - (α - int.fract α) := by ring,
  have h2f : (α - int.fract α) = (α * ↑i) - (int.to_nat (α * ↑i)) := by rw h2a,
  have h2g : (int.fract α) = (α * ↑j) - (int.to_nat (α * ↑j)) := by rw h2b,
  have h2h : (α - int.fract α) = (α * ↑j) - (int.to_nat (α * ↑j)) := by rw h2e h2g,
  have h2i : (α - int.fract α) - ((α * ↑j) - (int.to_nat (α * ↑j))) = 0 := by rw h2f h2h,
  have h2j : (α * ↑i) - (int.to_nat (α * ↑i)) - ((α * ↑j) - (int.to_nat (α * ↑j))) = 0 := by rw ← nat.cast_sub h2i,
  have h2k : (int.to_nat (α * ↑i)) - (int.to_nat (α * ↑j)) = 0 := by rw ← int.coe_nat_sub h2j,
  have h2l : (int.to_nat (α * ↑i)) = (int.to_nat (α * ↑j)) := by rw nat.eq_zero_iff_zero_eq h2k,
  have h2m : (α * ↑i) = (α * ↑j) := by {rw ← int.cast_mul,repeat {rw ← int.coe_nat_eq_coe_nat_iff},exact h2l},
  have h2n : (α * (↑i - ↑j)) = 0 := by rw h2m,
  have h2o : α = 0 := by rw int.cast_mul h2n,
  have h2p : (α - int.fract α) + (int.fract α) = α := by ring,
  have h2q : (int.fract α) = α - (α - int.fract α) := by ring,
  have h2r : (α - int.fract α) = (α * ↑i) - (int.to_nat (α * ↑i)) := by rw h2a,
  have h2s : (int.fract α) = (α * ↑j) - (int.to_nat (α * ↑j)) := by rw h2b,
  have h2t : (α - int.fract α) = (α * ↑j) - (int.to_nat (α * ↑j)) := by rw h2q h2s,
  have h2u : (α - int.fract α) - ((α * ↑j) - (int.to_nat (α * ↑j))) = 0 := by rw h2r h2t,
  have h2v : (α * ↑i) - (int.to_nat (α * ↑i)) - ((α * ↑j) - (int.to_nat (α * ↑j))) = 0 := by rw ← nat.cast_sub h2u,
  have h2w : (int.to_nat (α * ↑i)) - (int.to_nat (α * ↑j)) = 0 := by rw ← int.coe_nat_sub h2v,
  have h2x : (int.to_nat (α * ↑i)) = (int.to_nat (α * ↑j)) := by rw nat.eq_zero_iff_zero_eq h2w,
  have h2y : (α * ↑i) = (α * ↑j) := by {rw ← int.cast_mul,repeat {rw ← int.coe_nat_eq_coe_nat_iff},exact h2x},
  have h2z : (α * (↑i - ↑j)) = 0 := by rw h2y,
  have h2aa : α = 0 := by rw int.cast_mul h2z,
  have h2ab : false := by {apply hα_irrat h2aa,},
  exact absurd h2ab (show (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from h2ab),

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  have h3 : univ ⊆ (Π (m : ℤ), (int.fract (α * ↑m))), from by {
    assume (n : ℤ),
    existsi n, simp, },

  -- is an infinite subset of $\left[0,1\right]$
  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from
    assume (i j : ℤ) (hne : i ≠ j), h2 i j hne,
  have h5 : ((λ m : ℤ, (int.fract (α * ↑m))) '' univ) = univ, from by rw set.eq_univ_of_forall h4,

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h6 : closure ((λ m : ℤ, (int.fract (α * ↑m))) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from
    by rw ← h5.symm; apply closure_subset,

  -- To show that $S$ is dense in $[0, 1]$,
  have h7 : ∀ y : ℝ, 0 ≤ y → y ≤ 1 → ∃ z : ℤ, 0 < (int.fract (α * ↑z)) ∧ (int.fract (α * ↑z)) ≤ y, from
    by {
      -- consider $y \in[0,1]$, and $\epsilon>0$.
      assume (y : ℝ) (hy_pos : 0 ≤ y) (hy_le_one : y ≤ 1),
      --
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --let S := {x : ℝ | ∃ m : ℤ, x = α * (↑m)},

  -- let $S := \{\{x\} \mid x \in \R \}$
  let S : set ℝ := {int.fract x | x : ℝ},
  -- S is an infinite subset of $[0,1]$, by the comment above
  have hS_infinite : infinite S, from by
    { -- (the fractional parts of) the integer multiples of an irrational number form an infinite set
    -- hence S is an infinite set, as required
    exact @set.infinite_of_injective_to_univ ℝ _ ℤ (λ (x : ℝ), int.fract x)
      (λ x y, int.fract_eq_fract) (λ (m : ℤ), int.fract (α * ↑m))
      (mt (int.fract_eq_of_irrational_of_eq hα_irrat))
      (λ m x, begin
        { assume hx : x = α * ↑m,
        have h1 : (int.fract (α * ↑m)) = int.fract x, from by {rw hx, refl,},
        apply @exists_of_mem ℝ _ _ _ _ _ h1, },
        end)
      (λ x, int.fract_ne_zero),
  },
  -- The set of integers is bounded
  let Z : set ℤ := set.Icc (int.of_nat 0) (int.of_nat 0),
  have hZ_bounded : is_bounded_above Z, from by {exact set.bounded_univ,},

  -- The fractional parts of the integer multiples of an irrational number is a subset of the unit interval
  have h1 : ((λ (m : ℤ), int.fract (α * ↑m) ) '' (@set.univ ℤ)) ⊆ S, from @set.subset.trans ((λ (m : ℤ), int.fract (α * ↑m)) '' Z) _ _ (set.image_subset_iff.mpr ⟨by obviously, by obviously⟩),
  -- The fractional parts of the integer multiples of an irrational number is dense in the unit interval
  have h2 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from
    begin
    have h3 : ∀ (x : ℝ) (hx : x ∈ closure (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), ∃ (n : ℤ), n * (((int.fract (α * ↑n) : ℝ)) - x) > 0, from
      begin
        assume (x : ℝ) (hx : x ∈ closure (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)),
        show ∃ (n : ℤ), n * (((int.fract (α * ↑n) : ℝ)) - x) > 0, from by
        { -- There exists a limit point of $S$ in $[0,1]$, by the Bolzano-Weierstrass theorem
        -- Hence there exists an $x$ such that $(int.fract (α * ↑(int.of_nat 0)) : ℝ) < x < (int.fract (α * ↑(int.of_nat 1)) : ℝ)$
        -- Hence there exists an $n$ such that $n * (((int.fract (α * ↑n) : ℝ)) - x) > 0$
        have h4 : ∃ (n : ℤ), n * (((int.fract (α * ↑n) : ℝ)) - x) > 0, from by
          {
          have h5 : interval.is_open (set.Icc (int.fract (α * ↑(int.of_nat 0))) (int.fract (α * ↑(int.of_nat 1)))) :=
            interval.is_open_Ioo (int.fract (α * ↑(int.of_nat 0))) (int.fract (α * ↑(int.of_nat 1))),
          have h6 : x ∈ closure (λ (m : ℤ), int.fract (α * ↑m) ) '' (@set.univ ℤ), from hx,
          have h7 : ∃ (n : ℤ), n * (((int.fract (α * ↑n) : ℝ)) - x) > 0, from @exists_nat_gt _ _
            (λ (n : ℤ), (int.fract (α * ↑n) : ℝ) - x) 0
            (mt (by {exact int.fract_lt_one (α * ↑(int.of_nat 1)),}) x) h4,
          exact h7, },
        exact h4, },
      end,
      show closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from
      begin
      have h5 : ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from
        begin
        have h6 : (int.fract (α * ↑(int.of_nat 0)) : ℝ) = 0, from by
          {
          have h7 : (int.fract (α * ↑(int.of_nat 0)) : ℝ) = int.fract (int.of_nat 0), from by
            {
            have h8 : (int.fract (α * ↑(int.of_nat 0)) : ℝ) = int.fract (int.of_nat 0), from by
              {
              have h9 : ∀ (m : ℤ), int.fract (α * ↑m) = int.fract (int.of_nat (int.nat_abs m)), from
                begin
                have h10 : ∀ (m : ℤ), int.fract (α * ↑m) = int.fract (int.of_nat (int.nat_abs m)), from begin
                    assume (m : ℤ),
                    have h11 : int.fract (α * ↑m) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from
                    by apply @set.mem_image _ _ ℤ _ _ _ _ (int.fract (α * ↑m)) m,
                    have h12 : (int.fract (α * ↑m)) ∈ closure (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from h11,
                    have h13 : (int.fract (α * ↑m)) ∈ set.Icc 0 ((int.fract (α * ↑(int.of_nat 1))) : ℝ), from @mem_of_mem_closure ℝ _ _ (λ (m : ℤ), int.fract (α * ↑m)) h5
                    (int.fract (α * ↑m)) h12,
                    show int.fract (α * ↑m) = int.fract (int.of_nat (int.nat_abs m)), from begin
                      show int.fract (α * ↑m) = int.fract (int.of_nat (int.nat_abs m)), from by
                      {
                      have h14 : (int.fract (α * ↑m) : ℝ) < ((int.fract (α * ↑(int.of_nat 1)) : ℝ)), from by
                        {
                        exact @show (int.fract (α * ↑(int.of_nat 0))) < (int.fract (α * ↑(int.of_nat 1))), from
                        begin
                        have h15 : int.fract (int.of_nat (int.nat_abs (int.of_nat 1))) = int.fract (α * ↑(int.
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- don't know how to prove this yet, but it's true
  obviously,
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Lebesgue measure theory, one can show that the set (irrationals) has measure $1$.
  have h1 : measure_theory.measure (set.Icc 0 1) = 1, from by {
    rw [measure_theory.measure_Icc, measure_theory.measure_Icc_self],
    norm_num, },
  have h2 : measure_theory.is_measurable (closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))), from by {
    rw ← (measure_set_closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))),
    rw ← measure_theory.measure_univ, exact measure_theory.is_measurable_univ,
  },
  -- Then one can show that the closure of rationals has measure $1$.
  have h3 : measure_theory.measure (closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))) = 1, from by {
    rw measure_set_closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)),
    -- By the Axiom of Choice, the set of rationals is countable.
    have h4 : fintype.card ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ≤ ℕ, from by {
      apply fintype.card_image_le,
      have h5 : fintype.card (set.univ) ≤ ℕ, { exact fintype.card_le_nat (fintype.card_univ : fintype.card (set.univ) ≤ ℕ) },
      rw ← fintype.card_fintype at h5, show fintype.card (λ (m : ℤ), int.fract (α * ↑m)) ≤ ℕ, from by {exact h5, },
    },
    rw ← ← card_set_closed_fract,
    show fintype.card ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ≤ fintype.card (set.univ), from by {
      rw ← fintype.card_fintype, exact h4, },
    norm_num, },
  have h6 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc 0 1, from by {
    show (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc (0 : ℝ) 1, from
    eq.symm (eq_of_measure_eq_of_measurable h1 h2 h3), },
  exact h6,
end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  /-
    The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
  -/
  sorry
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  let α_set := (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),
  have h1 : (α_set : set ℝ) = (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {obviously},
  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h2 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)), from assume (i j : ℤ) (hij : i ≠ j), by {
    -- Then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
    have hij2 : int.fract (α * ↑i) = int.fract (α * ↑j), from int.fract_mul_cancel_left hij,
    -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have hα_rat : ℚ/1 = (α * ↑i - ↑i * int.fract (α * ↑i) - α * ↑j + ↑j * int.fract (α * ↑j)) / (↑i - ↑j), from by {rw [hij2, add_sub_cancel'],norm_cast, ring,},
    have hα_rat2 : ℚ/1 = (α * ↑i - α * ↑j - ↑i * int.fract (α * ↑i) + ↑j * int.fract (α * ↑j)) / (↑i - ↑j), from by {ring,},
    -- Then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$, which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have hα_rat3 : ℚ/1 = (α * ↑i - α * ↑j) / (↑i - ↑j), from by {ring,},
    have hα_rat4 : ℚ/1 = α * (↑i - ↑j) / (↑i - ↑j), from by {ring,},
    -- hence, we must have $\{i \alpha\} \neq\{j \alpha\}$
    have hα_rat5 : α ≠ ℚ/1, from by {apply hα_irrat, rw ←hα_rat4,},
    have hα_rat6 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {ring at hα_rat5,exact hα_rat5,},
    show int.fract (α * ↑i) ≠ int.fract (α * ↑j) end,

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h3 : α_set.finite = ff, from by {
    have h3 : ∀ i : ℤ, (i : ℝ) ≠ 0, from assume i : ℤ, by {
      assume h : (i : ℝ) = 0,
      from show i ≠ 0, from dec_trivial,},
    have h4 : ∀ i : ℤ, int.fract (α * ↑i) ≠ 0, from assume i : ℤ, by {
      assume h : int.fract (α * ↑i) = 0,
      have h5 : int.fract (α * ↑i) = int.fract (↑i * (α : ℤ)), from by {
        rw ← int.fract_mul_cancel_left,norm_cast,ring,},
      -- have h5 : int.fract (α * i) = 0, from by {rw ← int.fract_mul_cancel_left,norm_cast,ring,},
      show int.fract (α * i) ≠ 0, from by {rw h5 at h, exact h3 i h,},},
    have h5 : ∀ i : ℤ, (int.fract (α * ↑i) : ℝ) ≠ 0, from assume i : ℤ, by {
      assume h : (int.fract (α * ↑i) : ℝ) = 0,
      from show int.fract (α * ↑i) ≠ 0, from by { rw ← show (int.fract (α * ↑i) : ℝ) = ((int.fract (α * ↑i) : ℝ) * (1 : ℝ)) / (1 : ℝ), from by { norm_cast, ring }, },},

    show α_set.finite = ff, from by {
      unfold α_set,
      rw ← set.finite_univ,
      apply infinite.infinite_iff_fintype_nonempty,
      apply by { existsi ℤ, split,apply fintype.of_injective_of_not_mem_empty (λ x y, by {
        assume h : x ≠ y, exact h2 x y h}) h5, apply nonempty.intro (0 : ℤ),}
      },},
  have h4 : ∀ (j : ℤ), ∃! (i : ℤ), i ≠ j ∧ int.fract (α * ↑i) = int.fract (α * ↑j), from by {
    assume j : ℤ,
    -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
    have h4 : ∃! (i : ℤ), (int.fract (α * ↑i) : ℝ) = 0, from by {
      have h4 : ∀ (i : ℤ), (int.fract (α * ↑i) : ℝ) = 0 → i = 0, from by {
        assume i : ℤ, assume h : (int.fract (α * ↑i) : ℝ) = 0,
        have h5 : int.fract (α * ↑i) = 0, from by {
          have h5 : (int.fract (α * ↑i) : ℝ) = 0, from by {rw ← show ((int.fract (α * ↑i) : ℝ) : ℤ) = (int.fract (α * ↑i) : ℤ), from by {norm_cast,},},
          show int.fract (α * ↑i) = 0, from by {rw h5 at h, exact h,},},
        show i = 0, from by {rw h5, ring,},},
      have h5 : ∃ i : ℤ, (int.fract (α * ↑i) : ℝ) = 0, from by {
        have h5 : ∀ i : ℤ, (i : ℤ) ≠ 0 → (int.fract (α * ↑i) : ℝ) ≠ 0, from by {
          assume i : ℤ, assume hi : (i : ℤ) ≠ 0,
          have hi2 : (int.fract (α * ↑i) : ℝ) ≠ 0, from by {
            have hi2 : int.fract (α * ↑i) ≠ 0, from by {
              have hi2 : int.fract (α * ↑i) ≠ 0, from by {
                have hi2 : (i : ℝ) ≠ 0, from by {rw ← show (i : ℤ) ≠ (0 : ℤ), from hi,},
                show
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    -- Consider $S$
    let S : set ℝ := λ i : ℤ, has_fract.fract i α,

    -- $S$ is an infinite subset of $\left[0,1\right]$
    have h1 : S ⊆ Icc 0 1 ∧ infinite S, from by {
      split,
      have h2 : ∀ i : ℤ, (0 ≤ has_fract.fract i α) ∧ (has_fract.fract i α < 1), from by {
        assume i : ℤ,
        have l : 0 ≤ has_fract.fract i α, from by {
              rw ← int.coe_nat_add, rw int.coe_nat_zero, rw int.fract_eq, ring,
              from int.fract_nonneg},
        have r : has_fract.fract i α < 1, from by {
              rw int.fract_eq, ring, rw int.coe_nat_zero, rw int.coe_nat_one,ring,
              from int.fract_lt_one},
        show (0 ≤ has_fract.fract i α) ∧ (has_fract.fract i α < 1), from ⟨l, r⟩,
      },
      from set.subset.antisymm (λ i : ℤ, (h2 i).left) (λ i : ℤ, (h2 i).right),
      have h3 : ∀ i j : ℤ, i ≠ j → has_fract.fract i α ≠ has_fract.fract j α, from by {
        assume i j : ℤ, assume h : i ≠ j,
        have h1 : i * α ≠ j * α, from by {
          assume h2 : i * α = j * α,
          have h3 : α = (i-j)*⁻¹*(i*α - j*α), from by {
            rw [h2, int.neg_mul_eq_neg_mul_symm, sub_eq_neg_add], rw add_comm, rw add_mul, ring,
          },
          have h4 : (i-j)*⁻¹*(i*α - j*α) ∈ ℤ, from by {
            rw h3, apply int.coe_nat_div_int, intros h4, exact h4.elim (λ h5 : j = 0, by {
              calc
                i = i*1 : by {rw mul_one}
                ... = i * (j+j) : by {rw h5, rw zero_add}
                ... = j* (i+i) : by {rw mul_comm, ring}
                ... = 0 : zero_mul,
              apply h.symm,
            }), intros h5, have h6 := h5.symm, have h7 : i - j ≠ 0, from h.symm,
            apply int.ne_of_nat_ne_nat (int.coe_nat_ne_coe_nat_of_ne h7),
          },
          have h5 : irrational α, from hα_irrat,
          show false, from h5 h4,
        },
        have h2 : i * α - j * α ≠ 0, from (int.ne_of_mul_ne_zero h1),
        have h3 : (i-j)*⁻¹ ≠ 0, from by {
          intros h4, exact absurd h4 ((int.coe_nat_ne_coe_nat_of_ne h).symm),
        },
        have h4 : (i * α - j * α) * (i-j)⁻¹ ≠ 0, from
          by {rw ← inv_eq_iff_mul_eq_one, apply mul_ne_zero, exact h2, exact h3},
        have h5 : i*α-j*α ≠ 0, from
          by {rw ← mul_inv_cancel h4, rw mul_one},
        have h6 : i * α - j * α ∈ ℤ, from by {
          rw ← int.fract_eq, ring, exact int.fract_nonneg, exact int.fract_lt_one,
        },
        have h7 : int.fract (i * α) ≠ int.fract (j * α), from by {
          rw int.fract_eq, ring, rw int.coe_nat_zero, rw int.coe_nat_zero, ring,
          from h5,
        },
        show has_fract.fract i α ≠ has_fract.fract j α, from h7,
      },
      from ⟨infinite_int, h3⟩,
    },

    -- So, $S$ has a limit point in $[0, 1]$
    have h2 : limit_point S (Icc 0 1), from by {
      have h3 : limit_point S (closure (Icc 0 1)), from by {
        rw ← closure_Icc,
        rw ← closure_eq_of_is_closed (is_closed_Icc 0 1),
        apply h1.right.limit_point,
      },
      show limit_point S (Icc 0 1), from by {
        apply limit_point_of_limit_point_of_closed h3, from is_closed_Icc 0 1,
      },
    },
    -- Show that $S$ is dense in $[0, 1]$
    have h3 : dense S (Icc 0 1), from by {
      assume y : ℝ, assume hi : y ∈ Icc 0 1, assume ε : ℝ, assume hε : 0 < ε,
      have h4 : ∃ x : ℝ, x ∈ S ∧ x < ε, from h2.mem_of_lt_ne hi hε,
      obtain (x : ℝ) (hx : x ∈ S ∧ x < ε), from h4,
      have h5 : y - x ∈ set.Icc (-ε) ε, from by {
        calc
          y - x ∈ set.Icc 0 1 : by {
            rw ← hi, rw ← sub_zero,
            from set.sub_mem_iff.mp hx.right,
          }
          ... = set.Icc (-ε) ε : by {
            rw ← sub_eq_add_neg, rw ← Icc_eq_Ico,
            rw ← sub_eq_add_neg, rw ← Icc_eq_Ico,
            rw ← sub_zero, rw ← add_neg_cancel'_left ε,
            rw ← add_comm, rw ← add_zero, rw ← Ico_neg_Ico,
            rw ← one_add_one, rw ← Ico_eq_Ioo,
            rw ← sub_neg_eq_add, ring,
          },
      have h6 : abs (y - x) ∈ set.Icc 0 ε, from set.mem_Icc_of_mem_Icc h5 (hε),
      from set.Icc_mem_Icc.mp (h2.exists_of_mem_of_ne_of_lt h6 hε (λ h, by {
        show false, from begin
          rw ← hi, rw ← sub_zero,
          from or.elim (lt_or_gt 0 x) (λ h1, by {
            have h2 : 0 < ε - x, from sub_pos_of_lt hε,
            have h3 : y < ε - x, from by {
              have h4 : y < ε, from by {
                apply set.mem_Icc.mp h6, simp,
              },
              rw ← hi, rw ← sub_zero,
              from lt_of_lt_of_le h4 hx.right,
            },
            show false, from absurd h3 ((lt_irrefl ε) h2),
          }) (λ h1, by {
            have
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  apply le_antisymm,
  {
    intros x hx hxstd,
    rcases set.mem_closure_iff.1 hx with ⟨d, hd⟩ | ⟨n, hn, hnstd⟩,
    {
      use [d, hd],
      rw ← sub_nonneg,
      unfold set.mem,
      split,
      {
        exact lt_of_le_of_lt (int.fract_nonneg d) (hnstd),
      },
      {
        rw le_iff_not_lt,
        intro hlt,
        apply hlt,
        rw ← lt_sub_iff_add_lt,
        apply trans_rel_left,
        apply le_of_lt,
        apply int.lt_add_one_of_fract_lt,
        assumption,
      },
    },
    {
      use [n, hn],
      exact hnstd,
    },
  },
  {
    intros x hx,
    cases exists_lt_of_lt_one hx with y hy,
    cases exists_lt_of_lt_one hy with z hz,
    by_contradiction hzstd,
    rw <- hzstd at hz,
    apply lt_irrefl _ hz,
    rw [← int.fract_eq_iff_lt_one, ← lt_sub_iff_add_lt, ← int.lt_add_one_iff_fract_lt],
    apply le_of_lt,
    rw ← set.mem_image_iff,
    apply hx,
    use [z, hz],
    intro hnz,
    apply hnzstd,
    rw ← hnz,
    assumption,
  },
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


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

A collection of limit properties.
-/
import algebra.big_operators algebra.group_power tactic.norm_num
  analysis.ennreal analysis.topology.infinite_sum tidy.tidy
noncomputable theory
open classical finset function filter
local attribute [instance] prop_decidable

section real

lemma has_sum_of_absolute_convergence {f : ℕ → ℝ}
  (hf : ∃r, tendsto (λn, (range n).sum (λi, abs (f i))) at_top (nhds r)) : has_sum f :=
let f' := λs:finset ℕ, s.sum (λi, abs (f i)) in
suffices cauchy (map (λs:finset ℕ, s.sum f) at_top),
  from complete_space.complete this,
cauchy_iff.mpr $ and.intro (map_ne_bot at_top_ne_bot) $
assume s hs,
let ⟨ε, hε, hsε⟩ := mem_uniformity_dist.mp hs, ⟨r, hr⟩ := hf in
have hε' : {p : ℝ × ℝ | dist p.1 p.2 < ε / 2} ∈ (@uniformity ℝ _).sets,
  from mem_uniformity_dist.mpr ⟨ε / 2, div_pos_of_pos_of_pos hε two_pos, assume a b h, h⟩,
have cauchy (at_top.map $ λn, f' (range n)),
  from cauchy_downwards cauchy_nhds (map_ne_bot at_top_ne_bot) hr,
have ∃n, ∀{n'}, n ≤ n' → dist (f' (range n)) (f' (range n')) < ε / 2,
  by simp [cauchy_iff, mem_at_top_sets] at this;
  from let ⟨t, ⟨u, hu⟩, ht⟩ := this _ hε' in
    ⟨u, assume n' hn, ht $ set.prod_mk_mem_set_prod_eq.mpr ⟨hu _ (le_refl _), hu _ hn⟩⟩,
let ⟨n, hn⟩ := this in
have ∀{s}, range n ⊆ s → abs ((s \ range n).sum f) < ε / 2,
  from assume s hs,
  let ⟨n', hn'⟩ := @exists_nat_subset_range s in
  have range n ⊆ range n', from finset.subset.trans hs hn',
  have f'_nn : 0 ≤ f' (range n' \ range n), from zero_le_sum $ assume _ _, abs_nonneg _,
  calc abs ((s \ range n).sum f) ≤ f' (s \ range n) : abs_sum_le_sum_abs
    ... ≤ f' (range n' \ range n) : sum_le_sum_of_subset_of_nonneg
      (finset.sdiff_subset_sdiff hn' (finset.subset.refl _))
      (assume _ _ _, abs_nonneg _)
    ... = abs (f' (range n' \ range n)) : (abs_of_nonneg f'_nn).symm
    ... = abs (f' (range n') - f' (range n)) :
      by simp [f', (sum_sdiff ‹range n ⊆ range n'›).symm]
    ... = abs (f' (range n) - f' (range n')) : abs_sub _ _
    ... < ε / 2 : hn $ range_subset.mp this,
have ∀{s t}, range n ⊆ s → range n ⊆ t → dist (s.sum f) (t.sum f) < ε,
  from assume s t hs ht,
  calc abs (s.sum f - t.sum f) = abs ((s \ range n).sum f + - (t \ range n).sum f) :
      by rw [←sum_sdiff hs, ←sum_sdiff ht]; simp
    ... ≤ abs ((s \ range n).sum f) + abs ((t \ range n).sum f) :
      le_trans (abs_add_le_abs_add_abs _ _) $ by rw [abs_neg]; exact le_refl _
    ... < ε / 2 + ε / 2 : add_lt_add (this hs) (this ht)
    ... = ε : by rw [←add_div, add_self_div_two],
⟨(λs:finset ℕ, s.sum f) '' {s | range n ⊆ s}, image_mem_map $ mem_at_top (range n),
  assume ⟨a, b⟩ ⟨⟨t, ht, ha⟩, ⟨s, hs, hb⟩⟩, by simp at ha hb; exact ha ▸ hb ▸ hsε (this ht hs)⟩

lemma is_sum_iff_tendsto_nat_of_nonneg {f : ℕ → ℝ} {r : ℝ} (hf : ∀n, 0 ≤ f n) :
  is_sum f r ↔ tendsto (λn, (range n).sum f) at_top (nhds r) :=
⟨tendsto_sum_nat_of_is_sum,
  assume hr,
  have tendsto (λn, (range n).sum (λn, abs (f n))) at_top (nhds r),
    by simp [(λi, abs_of_nonneg (hf i)), hr],
  let ⟨p, h⟩ := has_sum_of_absolute_convergence ⟨r, this⟩ in
  have hp : tendsto (λn, (range n).sum f) at_top (nhds p), from tendsto_sum_nat_of_is_sum h,
  have p = r, from tendsto_nhds_unique at_top_ne_bot hp hr,
  this ▸ h⟩

end real

lemma mul_add_one_le_pow {r : ℝ} (hr : 0 ≤ r) : ∀{n:ℕ}, (n:ℝ) * r + 1 ≤ (r + 1) ^ n
| 0       := by simp; exact le_refl 1
| (n + 1) :=
  let h : (n:ℝ) ≥ 0 := nat.cast_nonneg n in
  calc ↑(n + 1) * r + 1 ≤ ((n + 1) * r + 1) + r * r * n :
      le_add_of_le_of_nonneg (le_refl _) (mul_nonneg (mul_nonneg hr hr) h)
    ... = (r + 1) * (n * r + 1) : by simp [mul_add, add_mul, mul_comm, mul_assoc]
    ... ≤ (r + 1) * (r + 1) ^ n : mul_le_mul (le_refl _) mul_add_one_le_pow
      (add_nonneg (mul_nonneg h hr) zero_le_one) (add_nonneg hr zero_le_one)

lemma tendsto_pow_at_top_at_top_of_gt_1 {r : ℝ} (h : r > 1) : tendsto (λn:ℕ, r ^ n) at_top at_top :=
tendsto_infi.2 $ assume p, tendsto_principal.2 $
  let ⟨n, hn⟩ := exists_nat_gt (p / (r - 1)) in
  have hn_nn : (0:ℝ) ≤ n, from nat.cast_nonneg n,
  have r - 1 > 0, from sub_lt_iff_lt_add.mp $ by simp; assumption,
  have p ≤ r ^ n,
    from calc p = (p / (r - 1)) * (r - 1) : (div_mul_cancel _ $ ne_of_gt this).symm
      ... ≤ n * (r - 1) : mul_le_mul (le_of_lt hn) (le_refl _) (le_of_lt this) hn_nn
      ... ≤ n * (r - 1) + 1 : le_add_of_le_of_nonneg (le_refl _) zero_le_one
      ... ≤ ((r - 1) + 1) ^ n : mul_add_one_le_pow $ le_of_lt this
      ... ≤ r ^ n : by simp; exact le_refl _,
  show {n | p ≤ r ^ n} ∈ at_top.sets,
    from mem_at_top_sets.mpr ⟨n, assume m hnm, le_trans this (pow_le_pow (le_of_lt h) hnm)⟩

lemma tendsto_inverse_at_top_nhds_0 : tendsto (λr:ℝ, r⁻¹) at_top (nhds 0) :=
tendsto_orderable_unbounded (no_top 0) (no_bot 0) $ assume l u hl hu,
  mem_at_top_sets.mpr ⟨u⁻¹ + 1, assume b hb,
    have u⁻¹ < b, from lt_of_lt_of_le (lt_add_of_pos_right _ zero_lt_one) hb,
    ⟨lt_trans hl $ inv_pos $ lt_trans (inv_pos hu) this,
    lt_of_one_div_lt_one_div hu $
    begin
      rw [inv_eq_one_div],
      simp [-one_div_eq_inv, div_div_eq_mul_div, div_one],
      simp [this]
    end⟩⟩

lemma map_succ_at_top_eq : map nat.succ at_top = at_top :=
le_antisymm
  (assume s hs,
    let ⟨b, hb⟩ := mem_at_top_sets.mp hs in
    mem_at_top_sets.mpr ⟨b, assume c hc, hb (c + 1) $ le_trans hc $ nat.le_succ _⟩)
  (assume s hs,
    let ⟨b, hb⟩ := mem_at_top_sets.mp hs in
    mem_at_top_sets.mpr ⟨b + 1, assume c,
    match c with
    | 0     := assume h,
      have 0 > 0, from lt_of_lt_of_le (lt_add_of_le_of_pos (nat.zero_le _) zero_lt_one) h,
      (lt_irrefl 0 this).elim
    | (c+1) := assume h, hb _ (nat.le_of_succ_le_succ h)
    end⟩)

lemma tendsto_comp_succ_at_top_iff {α : Type*} {f : ℕ → α} {x : filter α} :
  tendsto (λn, f (nat.succ n)) at_top x ↔ tendsto f at_top x :=
calc tendsto (f ∘ nat.succ) at_top x ↔ tendsto f (map nat.succ at_top) x : by simp [tendsto, filter.map_map]
 ... ↔ _ : by rw [map_succ_at_top_eq]

lemma tendsto_pow_at_top_nhds_0_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) :
  tendsto (λn:ℕ, r^n) at_top (nhds 0) :=
by_cases
  (assume : r = 0, tendsto_comp_succ_at_top_iff.mp $ by simp [pow_succ, this, tendsto_const_nhds])
  (assume : r ≠ 0,
    have tendsto (λn, (r⁻¹ ^ n)⁻¹) at_top (nhds 0),
      from (tendsto_pow_at_top_at_top_of_gt_1 $ one_lt_inv (lt_of_le_of_ne h₁ this.symm) h₂).comp
        tendsto_inverse_at_top_nhds_0,
    tendsto_cong this $ univ_mem_sets' $ by simp *)

lemma sum_geometric' {r : ℝ} (h : r ≠ 0) :
  ∀{n}, (finset.range n).sum (λi, (r + 1) ^ i) = ((r + 1) ^ n - 1) / r
| 0     := by simp [zero_div]
| (n+1) :=
  by simp [@sum_geometric' n, h, pow_succ, add_div_eq_mul_add_div, add_mul, mul_comm, mul_assoc]

lemma sum_geometric {r : ℝ} {n : ℕ} (h : r ≠ 1) :
  (range n).sum (λi, r ^ i) = (r ^ n - 1) / (r - 1) :=
calc (range n).sum (λi, r ^ i) = (range n).sum (λi, ((r - 1) + 1) ^ i) :
    by simp
  ... = (((r - 1) + 1) ^ n - 1) / (r - 1) :
    sum_geometric' $ by simp [sub_eq_iff_eq_add, -sub_eq_add_neg, h]
  ... = (r ^ n - 1) / (r - 1) :
    by simp

lemma is_sum_geometric {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) :
  is_sum (λn:ℕ, r ^ n) (1 / (1 - r)) :=
have r ≠ 1, from ne_of_lt h₂,
have r + -1 ≠ 0,
  by rw [←sub_eq_add_neg, ne, sub_eq_iff_eq_add]; simp; assumption,
have tendsto (λn, (r ^ n - 1) * (r - 1)⁻¹) at_top (nhds ((0 - 1) * (r - 1)⁻¹)),
  from tendsto_mul
    (tendsto_sub (tendsto_pow_at_top_nhds_0_of_lt_1 h₁ h₂) tendsto_const_nhds) tendsto_const_nhds,
(is_sum_iff_tendsto_nat_of_nonneg $ pow_nonneg h₁).mpr $
  by simp [neg_inv, sum_geometric, div_eq_mul_inv, *] at *

lemma is_sum_geometric_two (a : ℝ) : is_sum (λn:ℕ, (a / 2) / 2 ^ n) a :=
begin
  convert is_sum_mul_left (a / 2) (is_sum_geometric
    (le_of_lt one_half_pos) one_half_lt_one),
  { funext n, simp,
    rw ← pow_inv; [refl, exact two_ne_zero] },
  { norm_num, rw div_mul_cancel _ two_ne_zero }
end

def pos_sum_of_encodable {ε : ℝ} (hε : 0 < ε)
  (ι) [encodable ι] : {ε' : ι → ℝ // (∀ i, 0 < ε' i) ∧ ∃ c, is_sum ε' c ∧ c ≤ ε} :=
begin
  let f := λ n, (ε / 2) / 2 ^ n,
  have hf : is_sum f ε := is_sum_geometric_two _,
  have f0 : ∀ n, 0 < f n := λ n, div_pos (half_pos hε) (pow_pos two_pos _),
  refine ⟨f ∘ encodable.encode, λ i, f0 _, _⟩,
  let g : ℕ → ℝ := λ n, option.cases_on (encodable.decode2 ι n) 0 (f ∘ encodable.encode),
  have : ∀ n, g n = 0 ∨ g n = f n,
  { intro n, dsimp [g], cases e : encodable.decode2 ι n with a,
    { exact or.inl rfl },
    { simp [encodable.mem_decode2.1 e] } },
  cases has_sum_of_has_sum_of_sub ⟨_, hf⟩ this with c hg,
  have cε : c ≤ ε,
  { refine is_sum_le (λ n, _) hg hf,
    cases this n; rw h, exact le_of_lt (f0 _) },
  have hs : ∀ n, g n ≠ 0 → (encodable.decode2 ι n).is_some,
  { intros n h, dsimp [g] at h,
    cases encodable.decode2 ι n,
    exact (h rfl).elim, exact rfl },
  refine ⟨c, _, cε⟩,
  refine is_sum_of_is_sum_ne_zero
    (λ n h, option.get (hs n h)) (λ n _, ne_of_gt (f0 _))
    (λ i _, encodable.encode i) (λ n h, ne_of_gt _)
    (λ n h, _) (λ i _, _) (λ i _, _) hg,
  { dsimp [g], rw encodable.encodek2, exact f0 _ },
  { exact encodable.mem_decode2.1 (option.get_mem _) },
  { exact option.get_of_mem _ (encodable.encodek2 _) },
  { dsimp [g], rw encodable.encodek2 }
end

namespace nnreal

theorem exists_pos_sum_of_encodable {ε : nnreal} (hε : 0 < ε) (ι) [encodable ι] :
  ∃ ε' : ι → nnreal, (∀ i, 0 < ε' i) ∧ ∃c, is_sum ε' c ∧ c < ε :=
let ⟨a, a0, aε⟩ := dense hε in
let ⟨ε', hε', c, hc, hcε⟩ := pos_sum_of_encodable a0 ι in
⟨ λi, ⟨ε' i, le_of_lt $ hε' i⟩, assume i, (nnreal.coe_lt _ _).2 $ hε' i,
  ⟨c, is_sum_le (assume i, le_of_lt $ hε' i) is_sum_zero hc ⟩, nnreal.is_sum_coe.1 hc,
   lt_of_le_of_lt ((nnreal.coe_le _ _).1 hcε) aε ⟩

end nnreal

namespace ennreal

theorem exists_pos_sum_of_encodable {ε : ennreal} (hε : 0 < ε) (ι) [encodable ι] :
  ∃ ε' : ι → nnreal, (∀ i, 0 < ε' i) ∧ (∑ i, (ε' i : ennreal)) < ε :=
begin
  rcases dense hε with ⟨r, h0r, hrε⟩,
  rcases lt_iff_exists_coe.1 hrε with ⟨x, rfl, hx⟩,
  rcases nnreal.exists_pos_sum_of_encodable (coe_lt_coe.1 h0r) ι with ⟨ε', hp, c, hc, hcr⟩,
  exact ⟨ε', hp, (ennreal.tsum_coe_eq hc).symm ▸ lt_trans (coe_lt_coe.2 hcr) hrε⟩
end

end ennreal


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import data.rbtree.basic
universe u

namespace rbnode
variables {α : Type u}

@[elab_simple]
lemma find.induction {p : rbnode α → Prop} (lt) [decidable_rel lt]
   (t x)
   (h₁ : p leaf)
   (h₂ : ∀ l y r (h : cmp_using lt x y = ordering.lt) (ih : p l), p (red_node l y r))
   (h₃ : ∀ l y r (h : cmp_using lt x y = ordering.eq),            p (red_node l y r))
   (h₄ : ∀ l y r (h : cmp_using lt x y = ordering.gt) (ih : p r), p (red_node l y r))
   (h₅ : ∀ l y r (h : cmp_using lt x y = ordering.lt) (ih : p l), p (black_node l y r))
   (h₆ : ∀ l y r (h : cmp_using lt x y = ordering.eq),            p (black_node l y r))
   (h₇ : ∀ l y r (h : cmp_using lt x y = ordering.gt) (ih : p r), p (black_node l y r))
   : p t :=
begin
  induction t,
  case leaf { assumption },
  case red_node : l y r
   { cases h : cmp_using lt x y,
     case ordering.lt { apply h₂, assumption, assumption },
     case ordering.eq { apply h₃, assumption },
     case ordering.gt { apply h₄, assumption, assumption }, },
  case black_node : l y r
   { cases h : cmp_using lt x y,
     case ordering.lt { apply h₅, assumption, assumption },
     case ordering.eq { apply h₆, assumption },
     case ordering.gt { apply h₇, assumption, assumption }, }
end

lemma find_correct {t : rbnode α} {lt x} [decidable_rel lt] [is_strict_weak_order α lt] :
  ∀ {lo hi} (hs : is_searchable lt t lo hi), mem lt x t ↔ ∃ y, find lt t x = some y ∧ x ≈[lt] y :=
begin
  apply find.induction lt t x; intros; simp only [mem, find, *],
  { simp },
  iterate 2 { -- red and black cases are identical

    { cases hs,
      apply iff.intro,

      { intro hm, blast_disjs,
        { exact iff.mp (ih hs_hs₁) hm },
        { simp at h, cases hm, contradiction },

        { have hyx : lift lt (some y) (some x) := (range hs_hs₂ hm).1,
          simp [lift] at hyx,
          have hxy : lt x y, { simp [cmp_using] at h, assumption },
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x) } },
      { intro hc, left, exact iff.mpr (ih hs_hs₁) hc }, },
    { simp at h, simp [h, strict_weak_order.equiv] },

    { cases hs,
      apply iff.intro,

      { intro hm, blast_disjs,

        { have hxy : lift lt (some x) (some y) := (range hs_hs₁ hm).2,
          simp [lift] at hxy,
          have hyx : lt y x, { simp [cmp_using] at h, exact h.2 },
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x) },
        { simp at h, cases hm, contradiction },
        { exact iff.mp (ih hs_hs₂) hm } },
      { intro hc, right, right, exact iff.mpr (ih hs_hs₂) hc }, } }
end

lemma find_correct_exact {t : rbnode α} {lt x} [decidable_rel lt] [is_strict_weak_order α lt] :
  ∀ {lo hi} (hs : is_searchable lt t lo hi), mem_exact x t ↔ find lt t x = some x :=
begin
  apply find.induction lt t x; intros; simp only [mem_exact, find, *],
  iterate 2

  { { cases hs,
      apply iff.intro,

      { intro hm, blast_disjs,
        { exact iff.mp (ih hs_hs₁) hm },
        { simp at h, subst x, exact absurd h (irrefl y) },
        { have hyx : lift lt (some y) (some x) := (range hs_hs₂ (mem_of_mem_exact hm)).1,
          simp [lift] at hyx,
          have hxy : lt x y, { simp [cmp_using] at h, assumption },
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x) } },
      { intro hc, left, exact iff.mpr (ih hs_hs₁) hc }, },
    { simp at h,
      cases hs,
      apply iff.intro,

      { intro hm, blast_disjs,
        { have hxy : lift lt (some x) (some y) := (range hs_hs₁ (mem_of_mem_exact hm)).2,
          simp [lift] at hxy,
          exact absurd hxy h.1 },
        { subst hm },
        { have hyx : lift lt (some y) (some x) := (range hs_hs₂ (mem_of_mem_exact hm)).1,
          simp [lift] at hyx,
          exact absurd hyx h.2 } },
      { intro hm, simp [*] } },

    { cases hs,
      apply iff.intro,

      { intro hm, blast_disjs,

        { have hxy : lift lt (some x) (some y) := (range hs_hs₁ (mem_of_mem_exact hm)).2,
          simp [lift] at hxy,
          have hyx : lt y x, { simp [cmp_using] at h, exact h.2 },
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x) },
        { simp at h, subst x, exact absurd h (irrefl y) },
        { exact iff.mp (ih hs_hs₂) hm } },
      { intro hc, right, right, exact iff.mpr (ih hs_hs₂) hc } } }
end

lemma eqv_of_find_some {t : rbnode α} {lt x y} [decidable_rel lt] :
  ∀ {lo hi} (hs : is_searchable lt t lo hi) (he : find lt t x = some y), x ≈[lt] y :=
begin
  apply find.induction lt t x; intros; simp only [mem, find, *] at *,
  iterate 2
  { { cases hs, exact ih hs_hs₁ rfl },
    { subst y, simp at h, exact h },
    { cases hs, exact ih hs_hs₂ rfl } }
end

lemma find_eq_find_of_eqv {lt a b} [decidable_rel lt] [is_strict_weak_order α lt] {t : rbnode α} :
  ∀ {lo hi} (hs : is_searchable lt t lo hi) (heqv : a ≈[lt] b), find lt t a = find lt t b :=
begin
  apply find.induction lt t a; intros;
    simp [mem, find, strict_weak_order.equiv, *, true_implies_iff] at *,
  iterate 2
  { { have : lt b y := lt_of_incomp_of_lt heqv.swap h,
      simp [cmp_using, find, *], cases hs, apply ih hs_hs₁ },
    { have := incomp_trans_of lt heqv.swap h, simp [cmp_using, find, *] },
    { have := lt_of_lt_of_incomp h heqv,
      have := not_lt_of_lt this,
      simp [cmp_using, find, *], cases hs, apply ih hs_hs₂ } }
end

end rbnode