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

! This file was ported from Lean 3 source module order.monotone.monovary
! leanprover-community/mathlib commit 6cb77a8eaff0ddd100e87b1591c6d3ad319514ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Image

/-!
# Monovariance of functions

Two functions *vary together* if a strict change in the first implies a change in the second.

This is in some sense a way to say that two functions `f : ι → α`, `g : ι → β` are "monotone
together", without actually having an order on `ι`.

This condition comes up in the rearrangement inequality. See `Algebra.Order.Rearrangement`.

## Main declarations

* `Monovary f g`: `f` monovaries with `g`. If `g i < g j`, then `f i ≤ f j`.
* `Antivary f g`: `f` antivaries with `g`. If `g i < g j`, then `f j ≤ f i`.
* `MonovaryOn f g s`: `f` monovaries with `g` on `s`.
* `MonovaryOn f g s`: `f` antivaries with `g` on `s`.
-/

open Function Set

variable {ι ι' α β γ : Type _}

section Preorder

variable [Preorder α] [Preorder β] [Preorder γ] {f : ι → α} {f' : α → γ} {g : ι → β} {g' : β → γ}
  {s t : Set ι}

/-- `f` monovaries with `g` if `g i < g j` implies `f i ≤ f j`. -/
def Monovary (f : ι → α) (g : ι → β) : Prop :=
  ∀ ⦃i j⦄, g i < g j → f i ≤ f j
#align monovary Monovary

/-- `f` antivaries with `g` if `g i < g j` implies `f j ≤ f i`. -/
def Antivary (f : ι → α) (g : ι → β) : Prop :=
  ∀ ⦃i j⦄, g i < g j → f j ≤ f i
#align antivary Antivary

/-- `f` monovaries with `g` on `s` if `g i < g j` implies `f i ≤ f j` for all `i, j ∈ s`. -/
def MonovaryOn (f : ι → α) (g : ι → β) (s : Set ι) : Prop :=
  ∀ ⦃i⦄ (_ : i ∈ s) ⦃j⦄ (_ : j ∈ s), g i < g j → f i ≤ f j
#align monovary_on MonovaryOn

/-- `f` antivaries with `g` on `s` if `g i < g j` implies `f j ≤ f i` for all `i, j ∈ s`. -/
def AntivaryOn (f : ι → α) (g : ι → β) (s : Set ι) : Prop :=
  ∀ ⦃i⦄ (_ : i ∈ s) ⦃j⦄ (_ : j ∈ s), g i < g j → f j ≤ f i
#align antivary_on AntivaryOn

protected theorem Monovary.monovaryOn (h : Monovary f g) (s : Set ι) : MonovaryOn f g s :=
  fun _ _ _ _ hij => h hij
#align monovary.monovary_on Monovary.monovaryOn

protected theorem Antivary.antivaryOn (h : Antivary f g) (s : Set ι) : AntivaryOn f g s :=
  fun _ _ _ _ hij => h hij
#align antivary.antivary_on Antivary.antivaryOn

@[simp]
theorem MonovaryOn.empty : MonovaryOn f g ∅ := fun _ => False.elim
#align monovary_on.empty MonovaryOn.empty

@[simp]
theorem AntivaryOn.empty : AntivaryOn f g ∅ := fun _ => False.elim
#align antivary_on.empty AntivaryOn.empty

@[simp]
theorem monovaryOn_univ : MonovaryOn f g univ ↔ Monovary f g :=
  ⟨fun h _ _ => h trivial trivial, fun h _ _ _ _ hij => h hij⟩
#align monovary_on_univ monovaryOn_univ

@[simp]
theorem antivaryOn_univ : AntivaryOn f g univ ↔ Antivary f g :=
  ⟨fun h _ _ => h trivial trivial, fun h _ _ _ _ hij => h hij⟩
#align antivary_on_univ antivaryOn_univ

protected theorem MonovaryOn.subset (hst : s ⊆ t) (h : MonovaryOn f g t) : MonovaryOn f g s :=
  fun _ hi _ hj => h (hst hi) (hst hj)
#align monovary_on.subset MonovaryOn.subset

protected theorem AntivaryOn.subset (hst : s ⊆ t) (h : AntivaryOn f g t) : AntivaryOn f g s :=
  fun _ hi _ hj => h (hst hi) (hst hj)
#align antivary_on.subset AntivaryOn.subset

theorem monovary_const_left (g : ι → β) (a : α) : Monovary (const ι a) g := fun _ _ _ => le_rfl
#align monovary_const_left monovary_const_left

theorem antivary_const_left (g : ι → β) (a : α) : Antivary (const ι a) g := fun _ _ _ => le_rfl
#align antivary_const_left antivary_const_left

theorem monovary_const_right (f : ι → α) (b : β) : Monovary f (const ι b) := fun _ _ h =>
  (h.ne rfl).elim
#align monovary_const_right monovary_const_right

theorem antivary_const_right (f : ι → α) (b : β) : Antivary f (const ι b) := fun _ _ h =>
  (h.ne rfl).elim
#align antivary_const_right antivary_const_right

theorem monovary_self (f : ι → α) : Monovary f f := fun _ _ => le_of_lt
#align monovary_self monovary_self

theorem monovaryOn_self (f : ι → α) (s : Set ι) : MonovaryOn f f s := fun _ _ _ _ => le_of_lt
#align monovary_on_self monovaryOn_self

protected theorem Subsingleton.monovary [Subsingleton ι] (f : ι → α) (g : ι → β) : Monovary f g :=
  fun _ _ h => (ne_of_apply_ne _ h.ne <| Subsingleton.elim _ _).elim
#align subsingleton.monovary Subsingleton.monovary

protected theorem Subsingleton.antivary [Subsingleton ι] (f : ι → α) (g : ι → β) : Antivary f g :=
  fun _ _ h => (ne_of_apply_ne _ h.ne <| Subsingleton.elim _ _).elim
#align subsingleton.antivary Subsingleton.antivary

protected theorem Subsingleton.monovaryOn [Subsingleton ι] (f : ι → α) (g : ι → β) (s : Set ι) :
    MonovaryOn f g s := fun _ _ _ _ h => (ne_of_apply_ne _ h.ne <| Subsingleton.elim _ _).elim
#align subsingleton.monovary_on Subsingleton.monovaryOn

protected theorem Subsingleton.antivaryOn [Subsingleton ι] (f : ι → α) (g : ι → β) (s : Set ι) :
    AntivaryOn f g s := fun _ _ _ _ h => (ne_of_apply_ne _ h.ne <| Subsingleton.elim _ _).elim
#align subsingleton.antivary_on Subsingleton.antivaryOn

theorem monovaryOn_const_left (g : ι → β) (a : α) (s : Set ι) : MonovaryOn (const ι a) g s :=
  fun _ _ _ _ _ => le_rfl
#align monovary_on_const_left monovaryOn_const_left

theorem antivaryOn_const_left (g : ι → β) (a : α) (s : Set ι) : AntivaryOn (const ι a) g s :=
  fun _ _ _ _ _ => le_rfl
#align antivary_on_const_left antivaryOn_const_left

theorem monovaryOn_const_right (f : ι → α) (b : β) (s : Set ι) : MonovaryOn f (const ι b) s :=
  fun _ _ _ _ h => (h.ne rfl).elim
#align monovary_on_const_right monovaryOn_const_right

theorem antivaryOn_const_right (f : ι → α) (b : β) (s : Set ι) : AntivaryOn f (const ι b) s :=
  fun _ _ _ _ h => (h.ne rfl).elim
#align antivary_on_const_right antivaryOn_const_right

theorem Monovary.comp_right (h : Monovary f g) (k : ι' → ι) : Monovary (f ∘ k) (g ∘ k) :=
  fun _ _ hij => h hij
#align monovary.comp_right Monovary.comp_right

theorem Antivary.comp_right (h : Antivary f g) (k : ι' → ι) : Antivary (f ∘ k) (g ∘ k) :=
  fun _ _ hij => h hij
#align antivary.comp_right Antivary.comp_right

theorem MonovaryOn.comp_right (h : MonovaryOn f g s) (k : ι' → ι) :
    MonovaryOn (f ∘ k) (g ∘ k) (k ⁻¹' s) := fun _ hi _ hj => h hi hj
#align monovary_on.comp_right MonovaryOn.comp_right

theorem AntivaryOn.comp_right (h : AntivaryOn f g s) (k : ι' → ι) :
    AntivaryOn (f ∘ k) (g ∘ k) (k ⁻¹' s) := fun _ hi _ hj => h hi hj
#align antivary_on.comp_right AntivaryOn.comp_right

theorem Monovary.comp_monotone_left (h : Monovary f g) (hf : Monotone f') : Monovary (f' ∘ f) g :=
  fun _ _ hij => hf <| h hij
#align monovary.comp_monotone_left Monovary.comp_monotone_left

theorem Monovary.comp_antitone_left (h : Monovary f g) (hf : Antitone f') : Antivary (f' ∘ f) g :=
  fun _ _ hij => hf <| h hij
#align monovary.comp_antitone_left Monovary.comp_antitone_left

theorem Antivary.comp_monotone_left (h : Antivary f g) (hf : Monotone f') : Antivary (f' ∘ f) g :=
  fun _ _ hij => hf <| h hij
#align antivary.comp_monotone_left Antivary.comp_monotone_left

theorem Antivary.comp_antitone_left (h : Antivary f g) (hf : Antitone f') : Monovary (f' ∘ f) g :=
  fun _ _ hij => hf <| h hij
#align antivary.comp_antitone_left Antivary.comp_antitone_left

theorem MonovaryOn.comp_monotone_on_left (h : MonovaryOn f g s) (hf : Monotone f') :
    MonovaryOn (f' ∘ f) g s := fun _ hi _ hj hij => hf <| h hi hj hij
#align monovary_on.comp_monotone_on_left MonovaryOn.comp_monotone_on_left

theorem MonovaryOn.comp_antitone_on_left (h : MonovaryOn f g s) (hf : Antitone f') :
    AntivaryOn (f' ∘ f) g s := fun _ hi _ hj hij => hf <| h hi hj hij
#align monovary_on.comp_antitone_on_left MonovaryOn.comp_antitone_on_left

theorem AntivaryOn.comp_monotone_on_left (h : AntivaryOn f g s) (hf : Monotone f') :
    AntivaryOn (f' ∘ f) g s := fun _ hi _ hj hij => hf <| h hi hj hij
#align antivary_on.comp_monotone_on_left AntivaryOn.comp_monotone_on_left

theorem AntivaryOn.comp_antitone_on_left (h : AntivaryOn f g s) (hf : Antitone f') :
    MonovaryOn (f' ∘ f) g s := fun _ hi _ hj hij => hf <| h hi hj hij
#align antivary_on.comp_antitone_on_left AntivaryOn.comp_antitone_on_left

section OrderDual

open OrderDual

theorem Monovary.dual : Monovary f g → Monovary (toDual ∘ f) (toDual ∘ g) :=
  swap
#align monovary.dual Monovary.dual

theorem Antivary.dual : Antivary f g → Antivary (toDual ∘ f) (toDual ∘ g) :=
  swap
#align antivary.dual Antivary.dual

theorem Monovary.dual_left : Monovary f g → Antivary (toDual ∘ f) g :=
  id
#align monovary.dual_left Monovary.dual_left

theorem Antivary.dual_left : Antivary f g → Monovary (toDual ∘ f) g :=
  id
#align antivary.dual_left Antivary.dual_left

theorem Monovary.dual_right : Monovary f g → Antivary f (toDual ∘ g) :=
  swap
#align monovary.dual_right Monovary.dual_right

theorem Antivary.dual_right : Antivary f g → Monovary f (toDual ∘ g) :=
  swap
#align antivary.dual_right Antivary.dual_right

theorem MonovaryOn.dual : MonovaryOn f g s → MonovaryOn (toDual ∘ f) (toDual ∘ g) s :=
  swap₂
#align monovary_on.dual MonovaryOn.dual

theorem AntivaryOn.dual : AntivaryOn f g s → AntivaryOn (toDual ∘ f) (toDual ∘ g) s :=
  swap₂
#align antivary_on.dual AntivaryOn.dual

theorem MonovaryOn.dual_left : MonovaryOn f g s → AntivaryOn (toDual ∘ f) g s :=
  id
#align monovary_on.dual_left MonovaryOn.dual_left

theorem AntivaryOn.dual_left : AntivaryOn f g s → MonovaryOn (toDual ∘ f) g s :=
  id
#align antivary_on.dual_left AntivaryOn.dual_left

theorem MonovaryOn.dual_right : MonovaryOn f g s → AntivaryOn f (toDual ∘ g) s :=
  swap₂
#align monovary_on.dual_right MonovaryOn.dual_right

theorem AntivaryOn.dual_right : AntivaryOn f g s → MonovaryOn f (toDual ∘ g) s :=
  swap₂
#align antivary_on.dual_right AntivaryOn.dual_right

@[simp]
theorem monovary_toDual_left : Monovary (toDual ∘ f) g ↔ Antivary f g :=
  Iff.rfl
#align monovary_to_dual_left monovary_toDual_left

@[simp]
theorem monovary_toDual_right : Monovary f (toDual ∘ g) ↔ Antivary f g :=
  forall_swap
#align monovary_to_dual_right monovary_toDual_right

@[simp]
theorem antivary_toDual_left : Antivary (toDual ∘ f) g ↔ Monovary f g :=
  Iff.rfl
#align antivary_to_dual_left antivary_toDual_left

@[simp]
theorem antivary_toDual_right : Antivary f (toDual ∘ g) ↔ Monovary f g :=
  forall_swap
#align antivary_to_dual_right antivary_toDual_right

@[simp]
theorem monovaryOn_toDual_left : MonovaryOn (toDual ∘ f) g s ↔ AntivaryOn f g s :=
  Iff.rfl
#align monovary_on_to_dual_left monovaryOn_toDual_left

@[simp]
theorem monovaryOn_toDual_right : MonovaryOn f (toDual ∘ g) s ↔ AntivaryOn f g s :=
  forall₂_swap
#align monovary_on_to_dual_right monovaryOn_toDual_right

@[simp]
theorem antivaryOn_toDual_left : AntivaryOn (toDual ∘ f) g s ↔ MonovaryOn f g s :=
  Iff.rfl
#align antivary_on_to_dual_left antivaryOn_toDual_left

@[simp]
theorem antivaryOn_toDual_right : AntivaryOn f (toDual ∘ g) s ↔ MonovaryOn f g s :=
  forall₂_swap
#align antivary_on_to_dual_right antivaryOn_toDual_right

end OrderDual

section PartialOrder

variable [PartialOrder ι]

@[simp]
theorem monovary_id_iff : Monovary f id ↔ Monotone f :=
  monotone_iff_forall_lt.symm
#align monovary_id_iff monovary_id_iff

@[simp]
theorem antivary_id_iff : Antivary f id ↔ Antitone f :=
  antitone_iff_forall_lt.symm
#align antivary_id_iff antivary_id_iff

@[simp]
theorem monovaryOn_id_iff : MonovaryOn f id s ↔ MonotoneOn f s :=
  monotoneOn_iff_forall_lt.symm
#align monovary_on_id_iff monovaryOn_id_iff

@[simp]
theorem antivaryOn_id_iff : AntivaryOn f id s ↔ AntitoneOn f s :=
  antitoneOn_iff_forall_lt.symm
#align antivary_on_id_iff antivaryOn_id_iff

end PartialOrder

variable [LinearOrder ι]

/-Porting note: Due to a bug in `alias`, many of the below lemmas have dot notation removed in the
proof-/

protected theorem Monotone.monovary (hf : Monotone f) (hg : Monotone g) : Monovary f g :=
  fun _ _ hij => hf (hg.reflect_lt hij).le
#align monotone.monovary Monotone.monovary

protected theorem Monotone.antivary (hf : Monotone f) (hg : Antitone g) : Antivary f g :=
  (hf.monovary (Antitone.dual_right hg)).dual_right
#align monotone.antivary Monotone.antivary

protected theorem Antitone.monovary (hf : Antitone f) (hg : Antitone g) : Monovary f g :=
  (hf.dual_right.antivary hg).dual_left
#align antitone.monovary Antitone.monovary

protected theorem Antitone.antivary (hf : Antitone f) (hg : Monotone g) : Antivary f g :=
  (hf.monovary (Monotone.dual_right hg)).dual_right
#align antitone.antivary Antitone.antivary

protected theorem MonotoneOn.monovaryOn (hf : MonotoneOn f s) (hg : MonotoneOn g s) :
    MonovaryOn f g s := fun _ hi _ hj hij => hf hi hj (hg.reflect_lt hi hj hij).le
#align monotone_on.monovary_on MonotoneOn.monovaryOn

protected theorem MonotoneOn.antivaryOn (hf : MonotoneOn f s) (hg : AntitoneOn g s) :
    AntivaryOn f g s :=
  (hf.monovaryOn (AntitoneOn.dual_right hg)).dual_right
#align monotone_on.antivary_on MonotoneOn.antivaryOn

protected theorem AntitoneOn.monovaryOn (hf : AntitoneOn f s) (hg : AntitoneOn g s) :
    MonovaryOn f g s :=
  (hf.dual_right.antivaryOn hg).dual_left
#align antitone_on.monovary_on AntitoneOn.monovaryOn

protected theorem AntitoneOn.antivaryOn (hf : AntitoneOn f s) (hg : MonotoneOn g s) :
    AntivaryOn f g s :=
  (hf.monovaryOn (MonotoneOn.dual_right hg)).dual_right
#align antitone_on.antivary_on AntitoneOn.antivaryOn

end Preorder

section LinearOrder

variable [Preorder α] [LinearOrder β] [Preorder γ] {f : ι → α} {f' : α → γ} {g : ι → β} {g' : β → γ}
  {s : Set ι}

theorem MonovaryOn.comp_monotoneOn_right (h : MonovaryOn f g s) (hg : MonotoneOn g' (g '' s)) :
    MonovaryOn f (g' ∘ g) s := fun _ hi _ hj hij =>
  h hi hj <| hg.reflect_lt (mem_image_of_mem _ hi) (mem_image_of_mem _ hj) hij
#align monovary_on.comp_monotone_on_right MonovaryOn.comp_monotoneOn_right

theorem MonovaryOn.comp_antitoneOn_right (h : MonovaryOn f g s) (hg : AntitoneOn g' (g '' s)) :
    AntivaryOn f (g' ∘ g) s := fun _ hi _ hj hij =>
  h hj hi <| hg.reflect_lt (mem_image_of_mem _ hi) (mem_image_of_mem _ hj) hij
#align monovary_on.comp_antitone_on_right MonovaryOn.comp_antitoneOn_right

theorem AntivaryOn.comp_monotoneOn_right (h : AntivaryOn f g s) (hg : MonotoneOn g' (g '' s)) :
    AntivaryOn f (g' ∘ g) s := fun _ hi _ hj hij =>
  h hi hj <| hg.reflect_lt (mem_image_of_mem _ hi) (mem_image_of_mem _ hj) hij
#align antivary_on.comp_monotone_on_right AntivaryOn.comp_monotoneOn_right

theorem AntivaryOn.comp_antitoneOn_right (h : AntivaryOn f g s) (hg : AntitoneOn g' (g '' s)) :
    MonovaryOn f (g' ∘ g) s := fun _ hi _ hj hij =>
  h hj hi <| hg.reflect_lt (mem_image_of_mem _ hi) (mem_image_of_mem _ hj) hij
#align antivary_on.comp_antitone_on_right AntivaryOn.comp_antitoneOn_right

protected theorem Monovary.symm (h : Monovary f g) : Monovary g f := fun _ _ hf =>
  le_of_not_lt fun hg => hf.not_le <| h hg
#align monovary.symm Monovary.symm

protected theorem Antivary.symm (h : Antivary f g) : Antivary g f := fun _ _ hf =>
  le_of_not_lt fun hg => hf.not_le <| h hg
#align antivary.symm Antivary.symm

protected theorem MonovaryOn.symm (h : MonovaryOn f g s) : MonovaryOn g f s := fun _ hi _ hj hf =>
  le_of_not_lt fun hg => hf.not_le <| h hj hi hg
#align monovary_on.symm MonovaryOn.symm

protected theorem AntivaryOn.symm (h : AntivaryOn f g s) : AntivaryOn g f s := fun _ hi _ hj hf =>
  le_of_not_lt fun hg => hf.not_le <| h hi hj hg
#align antivary_on.symm AntivaryOn.symm

end LinearOrder

section LinearOrder

variable [LinearOrder α] [LinearOrder β] {f : ι → α} {g : ι → β} {s : Set ι}

theorem monovary_comm : Monovary f g ↔ Monovary g f :=
  ⟨Monovary.symm, Monovary.symm⟩
#align monovary_comm monovary_comm

theorem antivary_comm : Antivary f g ↔ Antivary g f :=
  ⟨Antivary.symm, Antivary.symm⟩
#align antivary_comm antivary_comm

theorem monovaryOn_comm : MonovaryOn f g s ↔ MonovaryOn g f s :=
  ⟨MonovaryOn.symm, MonovaryOn.symm⟩
#align monovary_on_comm monovaryOn_comm

theorem antivaryOn_comm : AntivaryOn f g s ↔ AntivaryOn g f s :=
  ⟨AntivaryOn.symm, AntivaryOn.symm⟩
#align antivary_on_comm antivaryOn_comm

end LinearOrder


import tactic

import group_theory.index
import group_theory.p_group
import group_theory.quotient_group
import group_theory.coset
import group_theory.specific_groups.cyclic
import group_theory.abelianization
import data.finite.basic
import data.finite.card
import data.real.basic
import group_theory.subgroup.basic

open fintype
open is_p_group
open group

/-- A group that is commutative can be turned into a comm_group
(See https://github.com/leanprover-community/mathlib/pull/14960#issuecomment-1178880188)
-/
instance {G} : can_lift (group G) (comm_group G) :=
{ coe := @comm_group.to_group G,
  cond := λ g, by exactI (∀ x y : G, commute x y),
  prf := λ g hg, ⟨{mul_comm := hg, ..g}, by cases g; refl⟩ }

/-- A group whose center is ⊤ must be abelian. -/
lemma group.of_comm_center_eq_top {H : Type*} [group H] (h : (subgroup.center H = ⊤)) : (∀ a b : H, a * b = b * a) :=
begin
  rw subgroup.eq_top_iff' at h,
  intros x y,
  rw (h x),
end

/-- Basic Setup: `p` is a prime and `G` is a group of order `p` squared. -/

variables (p : ℕ) [fact (nat.prime p)]
variables (G : Type*) [fintype G] [group G]

def order_psq : Prop := card G = p^2

namespace order_psq

/-- The order of G is a perfect square. -/
lemma has_ord_sq : order_psq p G → ∃ q : ℕ , card G = q^2 :=
begin
  intro h1,
  use p,
  apply h1,
end

section G_has_order_psq

variables (hG : order_psq p G)
include hG

/-- G is a p-group. -/
lemma p_group : is_p_group p G :=
begin
  exact of_card hG,
end

/-- G has a nontrivial center Z(G). -/
lemma psq_center_nontrivial [nontrivial G] : nontrivial (subgroup.center G) :=
center_nontrivial (p_group p G hG)

open_locale classical

/-- G ⧸ Z(G) is a fintype. -/
@[instance] def quotient_with_center_is_fintype : finite (G ⧸ subgroup.center G) :=
infer_instance

/-- |G ⧸ Z(G)| is not prime. -/
lemma center_index_not_prime : ¬ nat.prime (fintype.card (G ⧸ subgroup.center G)) :=
begin
  intro h1,
  haveI : fact(nat.prime (card (G ⧸ subgroup.center G))) := ⟨h1⟩,
  haveI := is_cyclic_of_prime_card (rfl : card (G ⧸ subgroup.center G) = _),
  have h2 := commutative_of_cyclic_center_quotient (quotient_group.mk' (subgroup.center G)) (by simp),
  unfreezingI { lift ‹group G› to comm_group G using h2 },
  have h3 : subgroup.center G = ⊤, exact comm_group.center_eq_top,
  have h4 : card (G ⧸ subgroup.center G) = 1,
  {
    simp_rw [h3, ← nat.card_eq_fintype_card],
    exact subgroup.index_top,
  },
  rw h4 at h1,
  exact nat.not_prime_one h1,
end

/-- G is abelian. -/
theorem order_psq_are_abelian [nontrivial G] : (∀ x1 x2 : G, x1 * x2 = x2 * x1) :=
begin
  -- We show it suffices to show that Z(G) = ⊤.
  apply group.of_comm_center_eq_top,
  have h1 : (card (subgroup.center G) ∣ card (G)), exact (subgroup.center G).card_subgroup_dvd_card,
  unfold order_psq at hG,
  rw [hG, nat.dvd_prime_pow] at h1,
  -- We know it suffices to show that |Z(G)| = |G| = p^2.
  -- We can thus use Lagrange's Theorem and condition on |Z(G)|.
  rcases h1 with ⟨k, hk1, hk2⟩,
  swap,
  apply fact.out,
  interval_cases k,
  -- We look at the case |Z(G)| = 1
  {
    simp at hk2,
    exfalso,
    have h31 : nontrivial (subgroup.center G), exact center_nontrivial (p_group p G hG),
    rw subgroup.nontrivial_iff_exists_ne_one at h31,
    rcases h31 with ⟨x, hx, hxx⟩,
    have h32 : subgroup.center G = ⊥, rw [← subgroup.card_le_one_iff_eq_bot, hk2],
    have hxx' : x = 1,
    {
      rw subgroup.eq_bot_iff_forall at h32,
      exact h32 x hx,
    },
    contradiction,
  },
  -- We look at the case |Z(G)| = p
  {
    exfalso,
    have h41 : p * (subgroup.center G).index = p^2,
    {
      simp at hk2,
      simp_rw ← nat.card_eq_fintype_card at hk2,
      simp_rw ← nat.card_eq_fintype_card at hG,
      rw [← hG, ← hk2],
      exact subgroup.card_mul_index (subgroup.center G),
    },
    have h42 : (subgroup.center G).index = p,
    {
      have hcalc : p * (subgroup.center G).index = p * p,
      {
        simp_rw h41,
        exact sq p,
      },
      simp at hcalc,
      have hcalc2 : ¬ (p = 0),
      {
        intro hcp,
        have hcp2 := _inst_1.out,
        rw hcp at hcp2,
        have hcp3 := nat.not_prime_zero,
        contradiction,
      },
      cases hcalc with hcl hcr,
      {
        exact hcl,
      },
      {
        exfalso,
        contradiction,
      },
    },
    have h43 : nat.prime (card (G ⧸ subgroup.center G)),
    {
      have hcalc : nat.card (G ⧸ subgroup.center G) = p, exact h42,
      rw nat.card_eq_fintype_card at hcalc,
      rw hcalc,
      exact _inst_1.out,
    },
    have h44 : ¬ nat.prime (fintype.card (G ⧸ subgroup.center G)),
    {
      apply center_index_not_prime p G,
      exact hG,
    },
    contradiction,
  },
  -- We look at the case |Z(G)| = p^2
  {
    apply subgroup.eq_top_of_card_eq,
    rw hG,
    exact hk2,
  },
end

end G_has_order_psq

end order_psq


/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Heather Macbeth
-/
import Mathlib.Data.Int.ModEq

/-! # `mod_cases` tactic

The `mod_cases` tactic does case disjunction on `e % n`, where `e : ℤ`, to yield a number of
subgoals in which `e ≡ 0 [ZMOD n]`, ..., `e ≡ n-1 [ZMOD n]` are assumed.
-/

namespace Mathlib.Tactic.ModCases
open Lean Meta Elab Tactic Term Qq Int

/--
`OnModCases n a lb p` represents a partial proof by cases that
there exists `0 ≤ z < n` such that `a ≡ z (mod n)`.
It asserts that if `∃ z, lb ≤ z < n ∧ a ≡ z (mod n)` holds, then `p`
(where `p` is the current goal).
-/
def OnModCases (n : ℕ) (a : ℤ) (lb : ℕ) (p : Sort _) :=
∀ z, lb ≤ z ∧ z < n ∧ a ≡ ↑z [ZMOD ↑n] → p

/--
The first theorem we apply says that `∃ z, 0 ≤ z < n ∧ a ≡ z (mod n)`.
The actual mathematical content of the proof is here.
-/
@[inline] def onModCases_start (p : Sort _) (a : ℤ) (n : ℕ) (hn : Nat.ble 1 n = true)
    (H : OnModCases n a (nat_lit 0) p) : p :=
  H (a % ↑n).toNat <| by
    have := ofNat_pos.2 <| Nat.le_of_ble_eq_true hn
    have nonneg := emod_nonneg a <| Int.ne_of_gt this
    refine ⟨Nat.zero_le _, ?_, ?_⟩
    · rw [Int.toNat_lt nonneg]; exact Int.emod_lt_of_pos _ this
    · rw [Int.ModEq, Int.toNat_of_nonneg nonneg, emod_emod]

/--
The end point is that once we have reduced to `∃ z, n ≤ z < n ∧ a ≡ z (mod n)`
there are no more cases to consider.
-/
@[inline] def onModCases_stop (p : Sort _) (n : ℕ) (a : ℤ) : OnModCases n a n p :=
  fun _ h => (Nat.not_lt.2 h.1 h.2.1).elim

/--
The successor case decomposes `∃ z, b ≤ z < n ∧ a ≡ z (mod n)` into
`a ≡ b (mod n) ∨ ∃ z, b+1 ≤ z < n ∧ a ≡ z (mod n)`,
and the `a ≡ b (mod n) → p` case becomes a subgoal.
-/
@[inline] def onModCases_succ {p : Sort _} {n : ℕ} {a : ℤ} (b : ℕ)
    (h : a ≡ OfNat.ofNat b [ZMOD OfNat.ofNat n] → p) (H : OnModCases n a (Nat.add b 1) p) :
    OnModCases n a b p :=
  fun z ⟨h₁, h₂⟩ => if e : b = z then h (e ▸ h₂.2) else H _ ⟨Nat.lt_of_le_of_ne h₁ e, h₂⟩

/--
Proves an expression of the form `OnModCases n a b p` where `n` and `b` are raw nat literals
and `b ≤ n`. Returns the list of subgoals `?gi : a ≡ i [ZMOD n] → p`.
-/
partial def proveOnModCases (n : Q(ℕ)) (a : Q(ℤ)) (b : Q(ℕ)) (p : Q(Sort u)) :
    MetaM (Q(OnModCases $n $a $b $p) × List MVarId) := do
  if n.natLit! ≤ b.natLit! then
    pure ((q(onModCases_stop $p $n $a) : Expr), [])
  else
    let ty := q($a ≡ OfNat.ofNat $b [ZMOD OfNat.ofNat $n] → $p)
    let g : QQ ty ← mkFreshExprMVar ty
    let ((pr : Q(OnModCases $n $a (Nat.add $b 1) $p)), acc) ←
      proveOnModCases n a (mkRawNatLit (b.natLit! + 1)) p
    pure ((q(onModCases_succ $b $g $pr) : Expr), g.mvarId! :: acc)

/--
* The tactic `mod_cases h : e % 3` will perform a case disjunction on `e : ℤ` and yield subgoals
  containing the assumptions `h : e ≡ 0 [ZMOD 3]`, `h : e ≡ 1 [ZMOD 3]`, `h : e ≡ 2 [ZMOD 3]`
  respectively.
* In general, `mod_cases h : e % n` works
  when `n` is a positive numeral and `e` is an expression of type `ℤ`.
* If `h` is omitted as in `mod_cases e % n`, it will be default-named `H`.
-/
syntax "mod_cases " (atomic(binderIdent ":"))? term:71 " % " num : tactic

elab_rules : tactic
  | `(tactic| mod_cases $[$h :]? $e % $n) => do
    let n := n.getNat
    if n == 0 then Elab.throwUnsupportedSyntax
    let g ← getMainGoal
    g.withContext do
    let ⟨u, p, g⟩ ← inferTypeQ (.mvar g)
    let e : Q(ℤ) ← Tactic.elabTermEnsuringType e q(ℤ)
    let h := h.getD (← `(binderIdent| _))
    have lit : Q(ℕ) := mkRawNatLit n
    let p₁ : Q(Nat.ble 1 $lit = true) := (q(Eq.refl true) : Expr)
    let (p₂, gs) ← proveOnModCases lit e (mkRawNatLit 0) p
    let gs ← gs.mapM fun g => do
      let (fvar, g) ← match h with
      | `(binderIdent| $n:ident) => g.intro n.getId
      | _ => g.intro `H
      g.withContext <| (Expr.fvar fvar).addLocalVarInfoForBinderIdent h
      pure g
    g.mvarId!.assign q(onModCases_start $p $e $lit $p₁ $p₂)
    replaceMainGoal gs


import data.nat.basic
import combinatorics.simple_graph.basic

variables {α β : Type*} (G : simple_graph α)

/-- The lexicographic product of a graph with a type. This is equivalent to the well-known
graph lexicographic product on `G` and the complete graph for `β`. -/
def lex_product (β) : simple_graph (α × β) :=
{ adj := λ a b, G.adj a.1 b.1 ∨ (a.1 = b.1 ∧ a.2 ≠ b.2),
  symm := by { rintros _ _ (_|⟨_,_⟩); tauto },
  loopless := λ x , by { have := G.loopless x.fst, rintros (_ | _); tauto } }

infix `·`:50 := lex_product

@[simp] theorem lex_adj {G} {a b : α × β} :
  (G·β).adj a b ↔ G.adj a.1 b.1 ∨ (a.1 = b.1 ∧ a.2 ≠ b.2) := iff.rfl

theorem lex_adj' {G} {a₁ a₂ : α} {b₁ b₂ : β} :
  (G·β).adj ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ ↔ G.adj a₁ a₂ ∨ (a₁ = a₂ ∧ b₁ ≠ b₂) := iff.rfl


/-
Written by Congzhou M Sha (cms6712@psu.edu)

Copyright 2022 Congzhou M Sha

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

-/
import tactic
import data.real.basic
import analysis.calculus.deriv
import power_rule

open_locale big_operators

lemma ne_zero_iff_sub_ne_zero {a b : ℝ} : a ≠ b ↔ a - b ≠ 0 :=
begin
  split;
  intro p,
  {
    have := lt_or_gt_of_ne p,
    cases this,
    intro q,
    repeat {linarith},
  },
  {
    have := lt_or_gt_of_ne p,
    cases this,
    repeat {linarith},
  },
end

lemma sub_ne_zero_iff_sub_ne_zero {a b : ℝ} : a - b ≠ 0 ↔ b - a ≠ 0 :=
begin
  split;
  intro h₁;
  by_contra;
  apply h₁;
  linarith,
end

lemma mul_self_eq_square (a : ℝ) : a * a = a ^ 2 := begin ring_nf, end

lemma mul_self_twice_eq_cube (a : ℝ) : a * a * a = a ^ 3 := begin ring_nf, end

lemma ne_zero_iff_sub_comm_ne_zero (a b : ℝ) : a ≠ b ↔ b - a ≠ 0 :=
begin
  split;
  intro p,
  {
    have := lt_or_gt_of_ne p,
    cases this,
    intro q,
    repeat {linarith},
  },
  {
    have := lt_or_gt_of_ne p,
    cases this,
    repeat {linarith},
  },
end

lemma half_bound (x y : ℝ) {c : ℝ} : (|y - x| < |c - x| / 2) → (x ≠ c) → (y ≠ c) :=
begin
  intros p q,
  have := abs_nonneg (y - x),
  have := abs_nonneg (c - x),
  have : 0 < |c - x| / 2, by linarith,
  by_contra,
  apply q,
  rw h at p,
  linarith,
end

lemma add_sum_sum_same_range_eq_sum_add (n : ℕ) (f : ℕ → ℝ) (g : ℕ → ℝ) :
  (∑ (x : ℕ) in finset.range n, f x) + (∑ (x : ℕ) in finset.range n, g x) =
  ∑ (x : ℕ) in finset.range n, (f x + g x) :=
begin
  induction n with n ih,
  { simp, },
  {
    repeat {rw finset.sum_range_succ},
    rw [add_add_add_comm, ih],
  },
end

lemma add_sub_sum_same_range_eq_sum_sub (n : ℕ) (f : ℕ → ℝ) (g : ℕ → ℝ) :
  (∑ (x : ℕ) in finset.range n, f x) - (∑ (x : ℕ) in finset.range n, g x) =
  ∑ (x : ℕ) in finset.range n, (f x - g x) :=
begin
  induction n with n ih,
  { simp, },
  {
    repeat {rw finset.sum_range_succ},
    rw [← add_sub_assoc, ← ih],
    ring_nf,
  },
end

lemma arith_geom_progression_split_sum (n : ℕ) (a q r : ℝ) :
  ∑ (k : ℕ) in finset.range n, (a + k * r) * q ^ k =
  (∑ (k : ℕ) in finset.range n, a * q ^ k) +
  (r * ∑ (k : ℕ) in finset.range n, k * q ^ k) :=
begin
  rw finset.mul_sum,
  have := add_sum_sum_same_range_eq_sum_add n
    (λ (x : ℕ), a * q ^ x) (λ (x : ℕ), r * (↑x * q ^ x)),
  simp at this,
  rw this,
  rw finset.sum_congr rfl,

  intros x p,
  rw [right_distrib, add_right_inj, ← mul_assoc],
  nth_rewrite_rhs 0 mul_comm r,
end

lemma sub_sum_sum_same_range_eq_sum_sub (n : ℕ) (x y : ℝ) (f : ℕ → ℝ → ℝ) (g : ℕ → ℝ → ℝ) :
  (∑ (k : ℕ) in finset.range n, f k y) - (∑ (k : ℕ) in finset.range n, g k x) =
  ∑ (k : ℕ) in finset.range n, (f k y - g k x) :=
begin
  induction n with n ih,
  { simp, },
  {
    repeat {rw finset.sum_range_succ},
    rw [add_sub_add_comm, ih],
  },
end

lemma deriv_add_eq_add_deriv (f : ℝ → ℝ) (f' : ℝ → ℝ) (g : ℝ → ℝ) (g' : ℝ → ℝ) (x : ℝ) :
  has_deriv_at f (f' x) x → has_deriv_at g (g' x) x → has_deriv_at (λ y, f y + g y) (f' x + g' x) x :=
begin
  intros a b,
  rw has_deriv_at_iff_is_o at *,
  have := asymptotics.is_o.add a b,
  clear a b,
  dsimp at this,
  ring_nf at this,

  rw asymptotics.is_o_iff at *,
  intros c r,
  specialize this r,
  rw metric.eventually_nhds_iff_ball at *,
  cases this with a b,
  cases b with a' b',
  use a,
  split,
  { exact a', },
  {
    intros y q,
    specialize b' y q,
    clear q,
    simp at *,
    repeat {rw ← add_assoc at b'},
    rw [add_sub, add_comm, ← add_assoc, ← add_assoc, ← add_assoc,
      add_comm (g y) (f y), neg_sub_left, add_comm (g' x), neg_mul, ← mul_neg,
      add_assoc (f y + g y + -f x), ← left_distrib (f' x + g' x) (-y) x,
      add_sub_right_comm (f y + g y + -f x), ← add_sub, neg_sub_left,
      tactic.ring.add_neg_eq_sub, add_comm (g x) (f x)] at b',
    have : -y + x = -(y - x), by linarith,
    rw [this, mul_comm (f' x + g' x), neg_mul, tactic.ring.add_neg_eq_sub] at b',
    exact b',
  },
end

lemma deriv_sum_extension (n : ℕ) (x : ℝ) (f : ℕ → ℝ → ℝ) (f' : ℕ → ℝ → ℝ) :
  has_deriv_at (λ (x : ℝ), ∑ (k : ℕ) in finset.range (n + 1), f k x) (∑ (k : ℕ) in finset.range (n + 1), f' k x) x
  = has_deriv_at (λ (x : ℝ), (∑ (k : ℕ) in finset.range n, f k x) + f n x)
    ((∑ (k : ℕ) in finset.range n, f' k x) + f' n x) x :=
begin
  repeat {rw [has_deriv_at, has_deriv_at_filter, has_fderiv_at_filter,
    asymptotics.is_o_iff]},
  simp,
  split,
  {
    intros q c p,
    specialize q p,
    rw metric.eventually_nhds_iff_ball at *,
    cases q with ε q₁,
    cases q₁ with q₁ q₂,
    use ε,
    split,
    { exact q₁, },
    {
      intros y r,
      specialize q₂ y r,
      repeat {rw finset.sum_range_succ at *},
      repeat {rw nat.succ_eq_add_one at q₂},
      exact q₂,
    }
  },
  {
    intros q c p,
    specialize q p,
    rw metric.eventually_nhds_iff_ball at *,
    cases q with ε q₁,
    cases q₁ with q₁ q₂,
    use ε,
    split,
    { exact q₁, },
    {
      intros y r,
      specialize q₂ y r,
      repeat {rw finset.sum_range_succ at *},
      repeat {rw nat.succ_eq_add_one at q₂},
      exact q₂,
    }
  }
end

lemma deriv_sum_linearity (n : ℕ) (x : ℝ) (f : ℕ → ℝ → ℝ) (f' : ℕ → ℝ → ℝ) :
  (∀ (k : ℕ), has_deriv_at (f k) (f' k x) x) →
  has_deriv_at (λ (x : ℝ), ∑ (k : ℕ) in finset.range n, f k x)
    (∑ (k : ℕ) in finset.range n, f' k x) x :=
begin
  intro p,
  induction n with n ih,
  {
    specialize p 0,
    simp,
    rw [has_deriv_at, has_deriv_at_filter, has_fderiv_at_filter,
    asymptotics.is_o_iff],
    intros c r,
    rw metric.eventually_nhds_iff_ball,
    use c,
    split,
    { linarith, },
    {
      intros y q,
      simp,
      have a : 0 ≤ c, by linarith,
      have b := abs_nonneg (y - x),
      exact mul_nonneg a b,
    }
  },
  {
    rw deriv_sum_extension n x f f',
    specialize p n,
    exact deriv_add_eq_add_deriv (λ (x : ℝ), ∑ (k : ℕ) in finset.range n, f k x)
      (λ (x : ℝ), (∑ (k : ℕ) in finset.range n, f' k x)) (f n) ( f' n) x ih p,
  },
end

def deriv_sum_powers (n : ℕ) (q : ℝ) := deriv_sum_linearity n q power_rule.x_to_n power_rule.x_to_n' (λ (k : ℕ), power_rule.deriv_of_power k q)

lemma sum_x_to_n'_eq_deriv_sum (n : ℕ) (q : ℝ) :
  ∑ (k : ℕ) in finset.range (n + 1), power_rule.x_to_n' k q = ∑ (k : ℕ) in finset.range n, (k + 1) * q ^ k :=
begin
  induction n with n ih,
  { simp, },
  {
    rw [finset.sum_range_succ, nat.succ_eq_add_one, ih],
    unfold power_rule.x_to_n',
    rw [← finset.sum_range_succ],
  },
end

lemma deriv_sum_eq_sum_sum (n : ℕ) (q : ℝ) :
  ∑ (k : ℕ) in finset.range n, (↑k + 1) * q ^ k =
  (∑ (k : ℕ) in finset.range n, k * q ^ k) +
  ∑ (k : ℕ) in finset.range n, q ^ k :=
begin
  rw add_sum_sum_same_range_eq_sum_add,
  rw finset.sum_congr rfl,
  intros k p,
  ring_nf,
end

lemma second_deriv_geometric_series (n : ℕ) (x : ℝ) :
  deriv (λ y', deriv (λ y, ∑ (k : ℕ) in finset.range n, y ^ (k + 2)) y') x =
    (∑ (k : ℕ) in finset.range n, ↑(k + 2) * (↑k + 1) * x ^ k) :=
begin
  induction n with n ih,
  {
    simp,
    repeat {rw finset.sum_range_succ},
  },
  {
    induction n with n ih,
    {
      simp,
      repeat {rw finset.sum_range_succ},
    },
    {
      simp,
      rw finset.sum_range_succ,
      nth_rewrite_rhs 0 finset.sum_range_succ,
      simp,
      nth_rewrite_rhs 0 mul_assoc,
      rw [add_left_inj],
      simp at ih,
      rw ih,
    },
  },
end

lemma has_second_deriv_at_geometric_series (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), ∑ (k : ℕ) in finset.range n, (↑k + 2) * y ^ (k + 1))
  (∑ (k : ℕ) in finset.range n, (↑k + 2) * ((↑k + 1) * x ^ k))
  x :=
begin
  refine has_deriv_at.sum _,
  intros k p,
  have a := power_rule.deriv_of_power (k + 1) x,
  rw [power_rule.x_to_n, power_rule.x_to_n'] at a,
  simp at a,
  rename_var x y at a,
  have b := has_deriv_at_const x (↑k + (2 : ℝ)),
  have := has_deriv_at.mul b a,
  simp at this,
  exact this,
end

lemma expand_second_deriv_geometric_series (n : ℕ) (x : ℝ) :
  ∑ (k : ℕ) in finset.range n, ↑(k + 2) * (↑k + 1) * x ^ k =
  ∑ (k : ℕ) in finset.range n, ↑k ^ 2 * x ^ k +
  ∑ (k : ℕ) in finset.range n, ↑3 * k * x ^ k +
  ∑ (k : ℕ) in finset.range n, 2 * x ^ k :=
begin
  repeat {rw add_sum_sum_same_range_eq_sum_add},
  rw finset.sum_congr rfl,
  intros a b,
  ring_nf,
  rw nat.cast_add a 2,
  simp only [left_distrib, right_distrib],
  ring_nf,
  have : ↑2 + 1 = (3 : ℝ), by norm_num,
  rw this,
  simp,
end

lemma reverse_second_deriv_geometric_series (n : ℕ) (x : ℝ) :
  ∑ (k : ℕ) in finset.range n, ↑k ^ 2 * x ^ k =
  ∑ (k : ℕ) in finset.range n, ↑(k + 2) * (↑k + 1) * x ^ k -
  ∑ (k : ℕ) in finset.range n, ↑3 * k * x ^ k -
  ∑ (k : ℕ) in finset.range n, 2 * x ^ k :=
begin
  have := expand_second_deriv_geometric_series n x,
  rw this,
  ring_nf,
end

lemma second_deriv_geometric_sum_advanced_twice (n : ℕ) (x : ℝ) (h : x ≠ 1) :
  deriv (λ y', deriv (λ y, ∑ (k : ℕ) in finset.range n, y ^ (k + 2)) y') x =
  deriv (λ y', deriv (λ y, ∑ (k : ℕ) in finset.range (n + 2), y ^ k) y') x :=
begin
  simp,
  nth_rewrite_rhs 0 finset.sum_range_succ',
  nth_rewrite_rhs 0 finset.sum_range_succ',
  simp,
  rw finset.sum_congr rfl,
  intros x p,
  simp,
  left,
  ring_nf,
end

theorem second_derivative_offset_geometric (n : ℕ) (x : ℝ) (h : x ≠ 1) :
  ∑ (x_1 : ℕ) in finset.range n, (↑x_1 + 2) * ((↑x_1 + 1) * x ^ x_1)
  = deriv (λ y, ∑ (x_1 : ℕ) in finset.range n, (↑x_1 + 2) * y ^ (x_1 + 1)) x :=
begin
  simp,
end

lemma second_derivative_uniqueness_term_1 (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), y ^ n) (n * x ^ (n - 1)) x :=
begin
  induction n with n ih,
  {
    simp,
    exact has_deriv_at_const x 1,
  },
  {
    rw [nat.succ_eq_add_one, nat.add_sub_cancel],
    have := power_rule.deriv_of_power (n + 1) x,
    rw [power_rule.x_to_n, power_rule.x_to_n'] at this,
    simp at this,
    rename_var y x,
    rw [nat.cast_add, nat.cast_one],
    exact this,
  }
end

lemma second_derivative_uniqueness_term_2 (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), y - 1) 1 x :=
begin
  have := power_rule.deriv_of_power 1 x,
  rw [power_rule.x_to_n, power_rule.x_to_n'] at this,
  simp at this,
  rename_var x y at this,
  exact has_deriv_at.sub_const this 1,
end

lemma second_derivative_uniqueness_term_3 (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), y ^ n * (y - 1)) (↑n * x ^ (n - 1) * (x - 1) + x ^ n * 1) x :=
begin
  have a := second_derivative_uniqueness_term_1 n x,
  have b := second_derivative_uniqueness_term_2 n x,
  exact has_deriv_at.mul a b,
end

lemma second_derivative_uniqueness_term_4 (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), (y ^ (n + 1) - 1)) ((↑n + 1) * x ^ n) x :=
begin
  have a := second_derivative_uniqueness_term_1 (n + 1) x,
  rw [nat.add_sub_cancel, nat.cast_add, nat.cast_one] at a,
  exact has_deriv_at.sub_const a 1,
end

lemma second_derivative_uniqueness_term_5 (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), (y - 1) ^ 2) (2 * (x - 1)) x :=
begin
  have := second_derivative_uniqueness_term_2 n x,
  have := has_deriv_at.mul this this,
  simp at this,
  ring_nf at this,
  ring_nf,
  exact this,
end

lemma second_derivative_uniqueness_equality (n : ℕ) (x : ℝ) (h : x ≠ 1) :
  (((↑n + 1) * (↑n * x ^ (n - 1) * (x - 1) + x ^ n) - (↑n + 1) * x ^ n) * (x - 1) ^ 2 -
     ((↑n + 1) * (x ^ n * (x - 1)) - (x ^ (n + 1) - 1)) * (2 * (x - 1))) /
  ((x - 1) ^ 2) ^ 2 =
  (↑n * ↑(n + 1) * (x - 1) ^ 2 * x ^ (n - 1) - 2 * (-x ^ (n + 1) +
  (↑n + 1) * (x - 1) * x ^ n + 1)) / (x - 1) ^ 3 :=
begin
  rw ne_zero_iff_sub_ne_zero at h,
  have h' := h,
  rw ← mul_self_pos at h,
  replace h := mul_pos h h,
  repeat {rw mul_self_eq_square at h},
  have : ((((↑n + 1) * (↑n * x ^ (n - 1) * (x - 1) + x ^ n) - (↑n + 1) * x ^ n) * (x - 1) ^ 2 -
       ((↑n + 1) * (x ^ n * (x - 1)) - (x ^ (n + 1) - 1)) * (2 * (x - 1))) /
    ((x - 1) ^ 2) ^ 2) * ((x - 1) ^ 2) ^ 2 =
  ((↑n * ↑(n + 1) * (x - 1) ^ 2 * x ^ (n - 1) -
  2 * (-x ^ (n + 1) + (↑n + 1) * (x - 1) * x ^ n + 1)) / (x - 1) ^ 3) * ((x - 1) ^ 2) ^ 2 ↔
  (((↑n + 1) * (↑n * x ^ (n - 1) * (x - 1) + x ^ n) - (↑n + 1) * x ^ n) * (x - 1) ^ 2 -
       ((↑n + 1) * (x ^ n * (x - 1)) - (x ^ (n + 1) - 1)) * (2 * (x - 1))) /
    ((x - 1) ^ 2) ^ 2 =
  (↑n * ↑(n + 1) * (x - 1) ^ 2 * x ^ (n - 1) - 2 * (-x ^ (n + 1) + (↑n + 1) * (x - 1) * x ^ n + 1)) / (x - 1) ^ 3
  := mul_right_cancel_iff_of_pos h,
  rw ← this,
  clear this,
  rw div_mul,
  repeat {rw div_eq_mul_inv},
  have m₁ := mul_ne_zero h' h',
  replace m₁ := mul_ne_zero m₁ m₁,
  have m₂ := mul_inv_cancel m₁,
  repeat {rw mul_self_eq_square at m₂},
  have : 2 * 2 = 4, by norm_num,
  rw [m₂, ← div_eq_mul_inv, div_one, ← pow_mul, this,
    mul_assoc (↑n * ↑(n + 1) * (x - 1) ^ 2 * x ^ (n - 1) - 2 *
    (-x ^ (n + 1) + (↑n + 1) * (x - 1) * x ^ n + 1)),
    mul_comm ((x - 1) ^ 3)⁻¹],

  have : 3 ≤ 4, by norm_num,
  rw [← pow_sub₀ (x - 1) h' this],
  simp,
  simp only [left_distrib, right_distrib, mul_sub_left_distrib, mul_sub_right_distrib,
    one_mul, mul_one],
  ring_nf,
end

theorem second_derivative_uniqueness_geometric (n : ℕ) (x : ℝ) (h : x ≠ 1) :
  has_deriv_at (λ (y : ℝ), ((↑n + 1) * y ^ n * (y - 1) - (y ^ (n + 1) - 1)) / (y - 1) ^ 2)
    ((↑n * ↑(n + 1) * (x - 1) ^ 2 * (x ^ (n - 1)) - 2 * (-x ^ (n + 1) + (↑n + 1) * (x - 1) * x ^ n + 1)) / (x - 1) ^ 3) x :=
begin
  have a := second_derivative_uniqueness_term_3 n x,
  replace a := has_deriv_at.const_mul (↑n + (1 : ℝ)) a,
  have b := second_derivative_uniqueness_term_4 n x,
  replace a := has_deriv_at.sub a b,
  replace b := second_derivative_uniqueness_term_5 n x,
  have := (ne_zero_iff_sub_ne_zero).1 h,
  replace := mul_ne_zero this this,
  rw mul_self_eq_square at this,
  have := has_deriv_at.div a b this,
  simp at this,
  rw second_derivative_uniqueness_equality n x h at this,
  ring_nf at *,
  assumption,
end

theorem inner_derivs_match (n : ℕ) (x : ℝ) : ∀ (k : ℕ), k ∈ finset.range(n) →
  has_deriv_at (λ (y : ℝ), (↑k + 2) * y ^ (k + 1)) ((↑k + 2) * ((↑k + 1) * x ^ k)) x :=
begin
  intros k p,
  refine has_deriv_at.const_mul _ _,
  exact power_rule.deriv_of_power (k + 1) x,
end

theorem deriv_of_functions_eq (x f' : ℝ)
  (f g : ℝ → ℝ) (h' : ∀ (y : ℝ), f y = g y) :
  has_deriv_at f f' x → has_deriv_at g f' x :=
begin
  intro p,
  rw [has_deriv_at, has_deriv_at_filter, has_fderiv_at_filter,
    asymptotics.is_o_iff] at *,
  intros c r,
  specialize p r,
  rw metric.eventually_nhds_iff_ball at *,
  simp at p, simp,
  cases p with d q,
  cases q with q q',
  use d,
  split,
  { exact q, },
  {
    intros y m,
    have m₁ := h' y,
    have m₂ := h' x,
    rw [← m₁, ← m₂],
    exact q' y m,
  },
end

theorem deriv_of_functions_eq_add_const (x f' : ℝ) {c : ℝ}
  (f g : ℝ → ℝ) (h' : ∀ (y : ℝ), f y + c = g y) :
  has_deriv_at f f' x → has_deriv_at g f' x :=
begin
  intro p,
  rw [has_deriv_at, has_deriv_at_filter, has_fderiv_at_filter,
    asymptotics.is_o_iff] at *,
  intros c r,
  specialize p r,
  rw metric.eventually_nhds_iff_ball at *,
  simp at p, simp,
  cases p with d q,
  cases q with q q',
  use d,
  split,
  { exact q, },
  {
    intros y m,
    have m₁ := h' y,
    have m₂ := h' x,
    rw [← m₁, ← m₂],
    have := q' y m,
    ring_nf at this,
    ring_nf,
    assumption,
  },
end

theorem deriv_of_functions_eq_except_at_const (x x' f' : ℝ) (h : x ≠ x')
  (f g : ℝ → ℝ) (h' : ∀ (y : ℝ), (y ≠ x') → f y = g y) :
  has_deriv_at f f' x → has_deriv_at g f' x :=
begin
  intro p,
  rw [has_deriv_at, has_deriv_at_filter, has_fderiv_at_filter,
    asymptotics.is_o_iff] at *,
  intros c r,
  specialize p r,
  rw metric.eventually_nhds_iff_ball at *,
  simp at p, simp,
  cases p with d q,
  cases q with q q',
  use min d (|x - x'| / 2),
  split,
  { rw [lt_min_iff],
    split,
    { exact q, },
    {
      have := abs_nonneg (x - x'),
      rw ne_zero_iff_sub_ne_zero at h,
      rw ← abs_pos at h,
      have : 0 < |x - x'| / 2, by linarith,
      exact this,
    },
  },
  {
    intros y m,
    rw lt_min_iff at m,
    specialize q' y m.1,
    have m' := m.2,
    rw abs_sub_comm at m',
    have := h' y (half_bound x y m' h),
    rw ← this,
    have := h' x h,
    rw ← this,
    exact q',
  },
end

theorem deriv_of_functions_eq_except_at_const_add_const (x x' f' : ℝ) {c : ℝ} (h : x ≠ x')
  (f g : ℝ → ℝ) (h' : ∀ (y : ℝ), (y ≠ x') → f y + c = g y) :
  has_deriv_at f f' x → has_deriv_at g f' x :=
begin
  intro p,
  rw [has_deriv_at, has_deriv_at_filter, has_fderiv_at_filter,
    asymptotics.is_o_iff] at *,
  intros c r,
  specialize p r,
  rw metric.eventually_nhds_iff_ball at *,
  simp at p, simp,
  cases p with d q,
  cases q with q q',
  use min d (|x - x'| / 2),
  split,
  { rw [lt_min_iff],
    split,
    { exact q, },
    {
      have := abs_nonneg (x - x'),
      rw ne_zero_iff_sub_ne_zero at h,
      rw ← abs_pos at h,
      have : 0 < |x - x'| / 2, by linarith,
      exact this,
    },
  },
  {
    intros y m,
    rw lt_min_iff at m,
    specialize q' y m.1,
    have m' := m.2,
    rw abs_sub_comm at m',
    have := h' y (half_bound x y m' h),
    rw ← this,
    have := h' x h,
    rw ← this,
    ring_nf,
    ring_nf at q',
    exact q',
  },
end

lemma first_deriv_geom_offset_eq_add_const (n : ℕ) (x : ℝ) :
  ∑ (k : ℕ) in finset.range n, (↑k + 2) * x ^ (k + 1) + 1 =
  (∑ (k : ℕ) in finset.range (n + 1), (↑k + 1) * x ^ k) :=
begin
  rw finset.sum_range_succ',
  simp,
  apply finset.sum_congr rfl,
  intros k p,
  ring_nf,
end

theorem second_derivative_uniqueness_geometric_2 (n : ℕ) (x : ℝ) :
  has_deriv_at (λ (y : ℝ), ∑ (k : ℕ) in finset.range n, (↑k + 2) * y ^ (k + 1))
    (∑ (k : ℕ) in finset.range n, (↑k + 2) * ((↑k + 1) * x ^ k)) x →
  has_deriv_at (λ (y : ℝ), ∑ (k : ℕ) in finset.range (n + 1), (↑k + 1) * y ^ k)
    (∑ (k : ℕ) in finset.range n, (↑k + 2) * ((↑k + 1) * x ^ k)) x :=
begin
  intro p,
  have := deriv_of_functions_eq_add_const x (∑ (k : ℕ) in finset.range n, (↑k + 2) * ((↑k + 1) * x ^ k))
    (λ (y : ℝ), ∑ (k : ℕ) in finset.range n, (↑k + 2) * y ^ (k + 1))
    (λ (y : ℝ), ∑ (k : ℕ) in finset.range (n + 1), (↑k + 1) * y ^ k)
    (first_deriv_geom_offset_eq_add_const n),
  exact this p,
end

lemma deriv_sub_geom_eq_sum (n : ℕ) (q : ℝ) :
  ∑ (k : ℕ) in finset.range n, (↑k + 1) * q ^ k - ∑ (k : ℕ) in finset.range n, q ^ k
  = ∑ (k : ℕ) in finset.range n, k * q ^ k :=
begin
  rw deriv_sum_eq_sum_sum n q,
  ring_nf,
end

lemma deriv_arith_geom_numerator_1 (n : ℕ) (q : ℝ) :
  has_deriv_at (λ (x : ℝ), (x ^ (n + 1) - 1)) ((↑n + 1) * q ^ n) q :=
begin
  have := power_rule.deriv_of_power (n + 1) q,
  have := has_deriv_at.sub_const this 1,
  rw [power_rule.x_to_n, power_rule.x_to_n'] at this,
  assumption,
end

lemma deriv_arith_geom_denominator_1 (n : ℕ) (q : ℝ) :
  has_deriv_at (λ (x : ℝ), (x - 1)) (1 : ℝ) q :=
begin
  have := power_rule.deriv_of_power 1 q,
  have := has_deriv_at.sub_const this 1,
  rw [power_rule.x_to_n, power_rule.x_to_n'] at this,
  simp at this,
  exact this,
end

lemma deriv_geom_at_ne_one (n : ℕ) (q : ℝ) (h : q ≠ 1) :
  has_deriv_at (λ (y : ℝ), (y ^ (n + 1) - 1) / (y - 1))
    (((↑n + 1) * q ^ n * (q - 1) - (q ^ (n + 1) - 1)) / (q - 1) ^ 2) q :=
begin
  have a := deriv_arith_geom_numerator_1 n q,
  have b := deriv_arith_geom_denominator_1 n q,
  rw ne_zero_iff_sub_ne_zero at h,
  have c := has_deriv_at.div a b h,
  simp at c,
  rename_var x y,
  assumption,
end

lemma cancel_power (q : ℝ) (h : q ≠ 0) (n : ℕ) : q / q ^ (n + 1) = 1 / q ^ n :=
begin
  induction n with n ih,
  {
    simp,
    exact div_self h,
  },
  {
    rw [pow_succ, nat.succ_eq_add_one, ← div_div, div_self h],
  },
end

lemma left_linearity_first_of_three_sum {n : ℕ} {a : ℝ} {b c : ℕ → ℝ} :
  ∑ (k : ℕ) in finset.range n, a * (b k) * (c k) = a * ∑ (k : ℕ) in finset.range n, b k * c k :=
begin
  rw finset.mul_sum,
  apply finset.sum_congr rfl,
  intros a b,
  rw mul_assoc,
end

lemma linearity_second_of_three_sum {n : ℕ} {a b : ℝ} {c : ℕ → ℝ} :
  ∑ (k : ℕ) in finset.range n, a * b * (c k) = b * ∑ (k : ℕ) in finset.range n, a * (c k) :=
begin
  rw finset.mul_sum,
  apply finset.sum_congr rfl,
  intros a b,
  ring_nf,
end

lemma summand_comm {n : ℕ} {a : ℝ} {c : ℕ → ℝ} :
  ∑ (k : ℕ) in finset.range n, c k * a = ∑ (k : ℕ) in finset.range n, a * c k :=
begin
  apply finset.sum_congr rfl,
  intros p q,
  ring_nf,
end

lemma mul_right_cancel_iff_ne_zero {a b c : ℝ} (h : b ≠ 0) : a * b = c * b ↔ a = c :=
begin
  rw ne_iff_lt_or_gt at h,
  cases h,
  {
    split,
    {
      intro p,
      have : 0 < -b, by linarith,
      rw [← neg_neg b, mul_neg, mul_neg c, ← neg_mul, ← neg_mul] at p,
      rw (mul_right_cancel_iff_of_pos this) at p,
      rw neg_eq_iff_neg_eq at p,
      rw neg_neg at p,
      symmetry,
      exact p,
    },
    {
      intro p,
      rw p,
    },
  },
  {
    split,
    {
      intro p,
      have : 0 < b, by linarith,
      rw (mul_right_cancel_iff_of_pos this) at p,
      exact p,
    },
    {
      intro p,
      rw p,
    },
  }
end

lemma multiply_both_sides_by_ne_zero {a b c : ℝ} (h : b ≠ 0) : (a = c) → a * b = c * b :=
begin
  intros p,
  rw mul_right_cancel_iff_ne_zero h,
  exact p,
end

lemma mul_consecutive_nats_even (n : ℕ) : 2 ∣ n * (n + 1) :=
begin
  have := nat.even_mul_succ_self n,
  exact (even_iff_two_dvd.mp) this,
end


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 :=rational_discrete_subset_closed_bounded {α : Type*} [linear_ordered_field α] {a : α} (ha : a ≠ 0) (hb : a ∉ ℚ) :
∀ x : α, x > 0 → ∃ y : ℕ, ∀ z : ℕ, 0 ≤ z → z < y → z*a ≠ x :=
begin
  assume x hx,

  -- $\alpha$ is irrational. 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,
  -- $$
  have h1 : ∀ i j ∈ ℤ, (i ≠ j) → (i*a - i*a.floor ≠ j*a - j*a.floor),
  from by auto [],

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  -- Let $S$ be the summation of the fractional parts of the integer multiples of $a$ on the unit interval i.e.
  -- $S = \dots + \{-2 a\} + \{-a\} + \{0\} + \{a\} + \{2 a\} + \dots$.
  -- Each element of $S$ is strictly greater than 0 as $a ≠ 0$.
  have h2 : ((∃ i s : ℤ, (i ≠ s)) ∧ (∀ i j ∈ ℤ, (i ≠ j) → (i*a - i*a.floor ≠ j*a - j*a.floor)))
  → ∃ y : ℕ, ∀ z : ℕ, 0 ≤ z → z < y → z*a ≠ x,
  from by auto [],

  -- 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 h3 : ∃ s : ℝ,  s ∈ set.Ioo 0 1 ∧
  (∀ r : ℝ, r ∈ set.Ioo 0 1 → ∃ x y : ℤ, (0 ≤ x ∧ x < y) ∧ r - s < ((y*a - y*a.floor) - (x*a - x*a.floor)) ∧ r  - s ≥ 0),
  from by auto [],

  -- 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$.
  have h4 : ∃ z : ℕ, z*a > x ∧ z*a < x + 1, from by auto [],
  have h5 : ∃ y : ℕ, ∀ z : ℕ, 0 ≤ z → z < y → z*a ≠ x, from by auto [],
  show ∃ y : ℕ, ∀ z : ℕ, 0 ≤ z → z < y → z*a ≠ x, from by auto [h2, h3, h4, h5],

end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit (α : ℝ) : α.irrational → ∃ S : set ℝ, (S.finite.not ∧ set.finite_inter_univ S ⊆ {0}) := sorry

/--`theorem`
Existence of logarithm is bounded by a rational number
`proof`
The existence of $\log_p x$ is guaranteed since the derivative of $f(x)=\log_p x$ is $f'(x)=1/x \log p > 0$ and $f(x)$ is unbounded above.

Let $\tilde x > (\log p)^N / N!$ for any positive integer $N$.  Then
$$
\log_p \tilde x > \frac{\log p}{N!} \sum_{j=0}^N \frac{(\log p)^{j}}{j!}
$$

So $\log_p \tilde x$ is bounded above by a rational.

QED
-/
theorem existence_of_log_bounded_by_rational (p : ℚ) (x : ℕ) : (p : ℝ).exponential > 0 → ∃ ℚ, p.exponential_log x < ↑x := sorry

/--`theorem`
Order of a Product is the Sum of the Orders
Let $n$ be a positive integer.

Let $G$ be a group of order $n$.

Let $H, K \subseteq G$ be subgroups of $G$, of orders $h$ and $k$ respectively.

Then:
:$\order {H K} = h + k$
`proof`
From Lagrange's Theorem we have that:
:$(h n) \mid h, (k n) \mid k$

From Divisibility Multiplicative Property we have that:
:$(h n) k \mid \paren {h k n}$

We can simplify this to:
:$(h n) k \mid h k n$

Similarly, we can rewrite the other divisibility result as:
:$(k n) h \mid h k n$

From Divisibility Additive Property we have that:
:$\paren {(h n) k} + \paren {(k n) h} \mid h k n$

We can simplify this to:
:$h n k + k n h \mid h k n$

Thus:
:$h n k + k n h = h k n$

This means that:
:$h + k = \order {H K}$
{{qed}}
-/
theorem order_of_product_is_sum_of_orders {G : Type} [group G] (h k : ℕ) (H K : set G) : h * k = card H * card K → h + k = card (H * K) :=
begin
  --Assume $\order H = h, \order K = k$ and $h \cdot k = \order H \cdot \order K$.
  assume (h1 : h * k = card H * card K),

  -- From Lagrange's Theorem we have that: $(h \cdot n) \mid h, (k \cdot n) \mid k$
  have h2 : (h * card G) ∣ h, from by auto [lagrange_mul],
  have h3 : (k * card G) ∣ k, from by auto [lagrange_mul],

  -- From Divisibility Multiplicative Property we have that: $(h \cdot n) \cdot k \mid \paren {h \cdot k \cdot n}$
  have h4 : (h * card G) * k ∣ (h * k * card G), from by auto [mul_dvd_mul_left],

  -- We can simplify this to: $(h \cdot n) \cdot k \mid h \cdot k \cdot n$
  have h5 : (h * card G) * k ∣ h * k * card G, from by auto [h4, mul_assoc],

  -- Similarly, we can rewrite the other divisibility result as: $(k \cdot n) \cdot h \mid h \cdot k \cdot n$
  have h6 : (k * card G) * h ∣ h * k * card G, from by auto [add_comm h3, mul_dvd_mul_right],

  -- From Divisibility Additive Property we have that: $\paren {(h \cdot n) \cdot k} + \paren {(k \cdot n) \cdot h} \mid h \cdot k \cdot n$
  have h7 : ((h * card G) * k) + ((k * card G) * h) ∣ h * k * card G, from by auto [add_dvd_add_iff_left h5],

  -- We can simplify this to: $h \cdot n \cdot k + k \cdot n \cdot h \mid h \cdot k \cdot n$
  have h8 : (h * card G) * k + (k * card G) * h ∣ h * k * card G, from by auto [h7, mul_assoc, add_comm],

  -- Thus: $h \cdot n \cdot k + k \cdot n \cdot h = h \cdot k \cdot n$
  have h9 : (h * card G) * k + (k * card G) * h = h * k * card G, from by auto [h1, h8, dvd_iff_eq],

  -- This means that: $h + k = \order {H K}$
  show h + k = card (H * K), from by auto [h9, mul_comm],
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=real_irrational_orbit_dense (α : ℝ) [irrational α] :
  closure (set.range (λ n : ℤ, n * α % 1)) = Icc 0 1 := begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ n m : ℤ, n ≠ m → list.nth_le ((λ (n : ℤ), n * α % 1) n) n ((λ (n : ℤ), n * α % 1) m) : fin 0 = none :=
  begin
    --If this were not true, then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \α\rfloor$, which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    assume (n m : ℤ) (h2 : n ≠ m),
    have h3 : ∃ m : ℤ, ∃ a : ℝ, m / a ∈ ℚ,
    from by auto [Real_Irrational_α],
    have h4 : ∀ m : ℤ, ∃ a : ℝ, m / a ∈ ℚ → (a : ℝ) ≠ α,
    from by auto [Real_Irrational_α],
    have h5 : ∀ m : ℤ, ∃ a : ℝ, m / a ∈ ℚ → (a : ℝ) ≠ α → ∀ i j : ℤ, (i - j) ≠ 0,
    from by auto [Real_Irrational_α],
    have h6 : (a : ℝ) ≠ α → ∀ i, j : ℤ, (i - j) ≠ 0,
    from by auto [Real_Irrational_α],
    have h7 : ∀ i, j : ℤ, (i - j) ≠ 0 → ∀ p : ℝ, ∀ q : ℤ, (q / p) ∈ ℤ → (p : ℝ) ≠ 0,
    from by auto [Real_Irrational_α],
    have h8 : ∀ p : ℝ, ∀ q : ℤ, (q / p) ∈ ℤ → (p : ℝ) ≠ 0,
    from by auto [Real_Irrational_α],
    have h9 : ∀ p : ℝ, ∀ q : ℤ, (q / p) ∈ ℤ → (p : ℝ) ≠ 0 → ∀ r : ℤ, ∃ s : ℤ, p * (r - s) = q,
    from by auto [Real_Irrational_α],
    have h10 : ∀ r : ℤ, ∃ s : ℤ, (α : ℝ) * (r - s) = r,
    from by auto [Real_Irrational_α],
    have h11 : ∀ r : ℤ, ∃ s : ℤ, (α : ℝ) * (r - s) = r → ∀ a : ℤ, ∃ b : ℤ, (α : ℝ) * (a - b) = a,
    from by auto [Real_Irrational_α],
    have h12 : ∀ a : ℤ, ∃ b : ℤ, (α : ℝ) * (a - b) = a,
    from by auto [Real_Irrational_α],
    have h13 : ∀ a : ℤ, ∃ b : ℤ, (α : ℝ) * (a - b) = a → ∀ c : ℤ, ∃ d : ℤ, (α : ℝ) * (c - d) = c,
    from by auto [Real_Irrational_α],
    have h14 : ∀ c : ℤ, ∃ d : ℤ, (α : ℝ) * (c - d) = c,
    from by auto [Real_Irrational_α],
    have h15 : ∀ c : ℤ, ∃ d : ℤ, (α : ℝ) * (c - d) = c → ∀ x : ℝ, ∃ y : ℤ, x ∈ y + ℚ,
    from by auto [Real_Irrational_α],
    have h16 : ∀ x : ℝ, ∃ y : ℤ, x ∈ y + ℚ,
    from by auto [Real_Irrational_α],
    have h17 : ∀ x : ℝ, ∃ y : ℤ, x ∈ y + ℚ → ∀ i j : ℤ, (i - j) ≠ 0 → ∃ q : ℤ, ∃ r : ℝ, (i * α : ℝ) ≥ q + r ∧ r < 1,
    from by auto [Real_Irrational_α],
    have h18 : ∃ q : ℤ, ∃ r : ℝ, (i * α : ℝ) ≥ q + r ∧ r < 1,
    from by auto [Real_Irrational_α],
    have h19 : ∃ q : ℤ, ∃ r : ℝ, (i * α : ℝ) ≥ q + r ∧ r < 1 → ∃ q : ℤ, ∃ r : ℝ, (j * α : ℝ) ≥ q + r ∧ r < 1,
    from by auto [Real_Irrational_α],
    have h20 : ∃ q : ℤ, ∃ r : ℝ, (j * α : ℝ) ≥ q + r ∧ r < 1,
    from by auto [Real_Irrational_α],
    have h21 : ∃ q : ℤ, ∃ r : ℝ, (j * α : ℝ) ≥ q + r ∧ r < 1 → ∀ i j : ℤ, (i * α - j * α) ≠ 0,
    from by auto [Real_Irrational_α],
    have h22 : ∀ i j : ℤ, (i * α - j * α) ≠ 0,
    from by auto [Real_Irrational_α],
    have h23 : ∀ i j : ℤ, (i * α - j * α) ≠ 0 → ∀ i j : ℤ, (i * α - j * α) ∉ ℚ,
    from by auto [Real_Irrational_α],
    have h24 : ∀ i j : ℤ, (i * α - j * α) ∉ ℚ,
    from by auto [Real_Irrational_α],
    have h25 : ∀ i j : ℤ, (i * α - j * α) ∉ ℚ → ∃ k : ℤ, ∃ l : ℝ, (i * α - j * α : ℝ) ∈ k + l + ℚ ∧ l < 1,
    from by auto [Real_Irrational_α],
    have h26 : ∃ k : ℤ, ∃ l : ℝ, (i * α - j * α : ℝ) ∈ k + l + ℚ ∧ l < 1,
    from by auto [Real_Irrational_α],
    have h27 : ∃ k : ℤ, ∃ l : ℝ, (i * α - j * α : ℝ) ∈ k + l + ℚ ∧ l < 1 → ∃ k : ℤ, ∃ l : ℝ, (i * α - j * α : ℝ) ∈ k + l + ℚ ∧ l < 1,
    from by auto [Real_Irrational_α],
    have h28 : ∃ k : ℤ, ∃ l : ℝ, (i * α - j * α : ℝ) ∈ k + l + ℚ ∧ l < 1,
    from by auto [Real
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 :=density_irrational_orbit {α : Type*} [has_abs α] [has_floor α] [archimedean α] :
∀ r : α, (∃ k : α, ¬(k ∈ set.range (λ (m : ℤ), r * m))) → (⋂ (y : α) (ε : α), ε > 0) → (∃ (y : α) (ε : α), ε > 0 ∧ (∃ (x : α) (n : ℤ), n ≠ 0 ∧ n ≤ y ∧ x ∈ (set.range (λ (m : ℤ), r * m)) ∧ (|y - x| < ε))) :=
begin
  -- Let $\alpha$ be an irrational number.
  assume (r : α) (h1 : ∃ (k : α), ¬(k ∈ set.range (λ (m : ℤ), r * m))),

  /-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]$.
  -/
  have h2 : infinite (set.range (λ (m : ℤ), r * m)), from by auto [not_forall, not_exists, infinite_iff_finite_nat, finset.fintype, h1],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h3 : ∃ y, ∀ ε > 0, ∃ (x : α) (n : ℤ), x ∈ set.range (λ (m : ℤ), r * m) ∧ n ≠ 0 ∧ n ≤ y ∧ |y - x| < ε,
  from by auto [has_limit_point_of_infinite_subset_of_compact, compact_Icc],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h4 : ∀ (y : α) (ε : α), ε > 0 → ∃ (x : α) (n : ℤ), x ∈ set.range (λ (m : ℤ), r * m) ∧ n ≠ 0 ∧ n ≤ y ∧ |y - x| < ε, from by auto [h3],
  have h5 : ∃ y, ∀ ε > 0, ∃ (x : α) (n : ℤ), x ∈ set.range (λ (m : ℤ), r * m) ∧ n ≠ 0 ∧ n ≤ y ∧ |y - x| < ε, from by auto [h4, h3],

  -- 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 : ∃ (y : α), ∀ ε > 0, ε > 0 → ∃ (x : α) (n : ℤ), x ∈ set.range (λ (m : ℤ), r * m) ∧ n ≠ 0 ∧ n ≤ y ∧ |y - x| < ε, from by auto [h4, h5],

  -- To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h7 : ∀ y : α, y ∈ (Icc 0 1) → ∀ ε : α, ε > 0 → ∃ (x : α) (n : ℤ), n ≠ 0 ∧ n ≤ y ∧ x ∈ set.range (λ (m : ℤ), r * m) ∧ |y - x| < ε,
  from by auto [_root_.archimedean, le_zero_iff_eq,
              right_distrib, nat.sub_eq_zero_iff_eq,
              nat.sub_eq_zero_of_le, nat.sub_eq_zero_of_le,
              nat.sub_eq_zero_of_eq],

  -- 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$.
  have h8 : ∀ (y : α), y ∈ Icc 0 1 → ∀ (ε : α), ε > 0 → ∃ (x : α) (n : ℤ), n ≠ 0 ∧ (n ≤ y ∧ x ∈ set.range (λ (m : ℤ), r * m)) ∧ (|y - x| < ε), from by auto [h7],

  -- Suppose that $\alpha$ is an irrational number
  have h9 : ∃ k : α, ¬(k ∈ set.range (λ (m : ℤ), r * m)), from by auto [h1],
  have h10 : ∀ y : α, y ∈ Icc 0 1 → ∀ ε : α, ε > 0 → ∃ (x : α) (n : ℤ), n ≠ 0 ∧ (n ≤ y ∧ x ∈ set.range (λ (m : ℤ), r * m)) ∧ (|y - x| < ε), from by auto [h7],

  show ∃ (y : α) (ε : α), ε > 0 ∧ (∃ (x : α) (n : ℤ), n ≠ 0 ∧ n ≤ y ∧ x ∈ set.range (λ (m : ℤ), r * m) ∧ (|y - x| < ε)), from by auto [h9, h10],
end

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} {r : α} [discrete_field α] (r_irr : ¬ is_rat r) :
  ∀ δ : α, δ > 0 → ∃ n : ℤ, (((n*r) - ⌊n*r⌋) - δ) * (1 : α) < ⌊n*r⌋ ∧ ⌊n*r⌋ < (((n*r) - ⌊n*r⌋) + δ) * (1 : α) :=
begin
  -- Let $\alpha$ be an irrational number.
  assume (r_irr : ¬ is_rat r) (δ) (h1 : δ > 0),

  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h2 : ∀ (i j : ℤ), i ≠ j → (i*r) - ⌊i*r⌋ ≠ (j*r) - ⌊j*r⌋, from
  begin
    -- If this were not true, then:
    assume (i j : ℤ) (h2a : i ≠ j) (h2b : (i * r) - ⌊i * r⌋ = (j * r) - ⌊j * r⌋),

    -- Then:
    have h3 : (i * r) - ⌊i * r⌋ = (j * r) - ⌊j * r⌋, from h2b,
    have h4 : (i * r) = (j * r) + ⌊j * r⌋ - ⌊i * r⌋, from by auto [sub_add_sub_cancel],
    have h5 : (i * r) = (j * r) + ⌊(j - i) * r⌋, from
    begin
      -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$
      have h5a : (i * r) - ⌊i * r⌋ = (i * r) - ⌊i * r⌋, from h3,
      have h5b : (j * r) - ⌊j * r⌋ = (i * r) - ⌊i * r⌋, from h3,

      -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
      show (i * r) = (j * r) + ⌊(j - i) * r⌋, from
      begin
        -- By assumption, $i$ and $j$ are distinct.
        cases h2a with h6a h6b,
        -- So $i \neq j$.
        cases h6a with h6c h6d,
        -- So $i - j \neq 0$.
        have h6e : i - j ≠ 0, from by auto [h6c],

        -- Since $i \neq 0$, $1/i \neq 0$.
        have h6f : 1/(i - j) ≠ 0, from by auto [h6e],

        -- Thus:
        have h6g : ℝ ≠ 0, from by auto using [fintype.card_pos_iff],
        have h6h : ℝ ≠ ℤ, from by auto [classical.by_contradiction],
        have h6i : ℝ / ℤ ≠ 0, from by auto,
        have h6j : ℝ / ℤ ≠ ℤ, from by auto,

        -- Thus $\alpha = \frac{i\alpha - j\alpha}{i - j} \in \mathbb{Q}$ is false.
        have h6k : r = ((i * r) - (j * r)) / (i - j), from by auto using [h4, h5b, mul_right_cancel, sub_self],
        have h6l : r ∈ ℚ, from by auto using [eq_rat] using [h6k, h6f],
        have h6m : r ∈ ℚ, from by auto,
        have h6n : ¬(r ∈ ℚ), from by auto [r_irr],
        have h6o : false, from by auto [h6m, h6n],
        contradiction,
      end,
    end,

    -- Thus $i * r$ and $j * r$ are equal, which is a contradiction.
    have h5a : i * r = j * r, from by auto [add_right_cancel],
    have h5b : i = j, from by auto [mul_right_inj] using [h5a],
    have h5c : false, from by auto [h5b, h2a],
    contradiction,
  end,

  -- Hence:
  {
    -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
    have h3 : ∀ (n : ℤ), ((n * r) - ⌊n * r⌋) ∈ set.Ico 0 1, from
    begin
      assume (n : ℤ),
      have h3a : (n * r) - ⌊n * r⌋ ≥ 0, from by auto [sub_nonneg],
      have h3b : (n * r) - ⌊n * r⌋ < 1, from by auto [flt_add_one],
      show ((n * r) - ⌊n * r⌋) ∈ {x | 0 ≤ x ∧ x < 1}, from by auto using [set.mem_Ico],
    end,
    have h4 : ∀ n, n ∈ ℤ → ((n * r) - ⌊n * r⌋) ∈ {x : ℝ | 0 ≤ x ∧ x < 1}, from by auto [h3],
    have h5 : set.finite {x : ℝ | 0 ≤ x ∧ x < 1} = false, from by auto [set.finite_Ico],
    have h6 : set.finite (set.range ((λ (n : ℤ), (n * r) - ⌊n * r⌋) : ℤ → ℝ)) = false, from by auto [set.finite_image, h4, h5],
    have h7 : set.finite (set.range (λ (n : ℤ), (n * r) - ⌊n * r⌋)) = false, from by auto [h6],
    have h8 : set.range (λ (n : ℤ), (n * r) - ⌊n * r⌋) = set.range (λ (n : ℤ), (n * r) - ⌊n * r⌋), from by auto,
    have h9 : set.finite ((λ (n : ℤ), (n * r) - ⌊n * r⌋) '' set.range (λ (n : ℤ), n)) = false, from by auto [h7, h8, set.finite_range],
    have h10 : set.finite ((λ (n : ℤ), (n * r) - ⌊n * r⌋) '' (set.range (λ n, n))) = false, from by auto [h9],
    have h11 : set.infinite ((λ (n : ℤ), (n * r) - ⌊n * r⌋) '' (set.range (λ n, n))), from by auto [set.infinite_finite_iff, h10],
    have h12 : set.infinite (set.range (λ (n : ℤ), (n * r) - ⌊n * r⌋)), from by auto [set.infinite_image_iff, h11],
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬(is_rat α)) :
∀ y : ℝ, 0 ≤ y ∧ y < 1 → ∃ x : set ℝ, ∃ N : ℕ, x ∈ {i | 0 ≤ i ∧ i < 1} ∧ 0 < x ∧ x ≤ y :=
begin
  assume y,
  assume h1 : 0 ≤ y ∧ y < 1,
  have h2 : ¬(is_rat α) := by auto [hα],

  assume h3 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α,
  have h4 : ∀ i j : ℕ, i ≠ j → (floor $ (i : ℝ) * α) ≠ (floor $ (j : ℝ) * α),
  assume i,
  assume j,
  assume h5 : i ≠ j,
  assume h6 : floor ((i : ℝ) * α) = floor ((j : ℝ) * α),
  have h7 : ∀ x : ℝ, floor x = floor x, from by auto,
  have h8 : i * α ≠ j * α, from by auto [h7, h6, h5, one_mul, mul_one, mul_comm, mul_left_inj] using [h2, ne_of_gt, int.coe_nat_lt],
  have h9 : (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h8],
  show (floor $ (i : ℝ) * α) ≠ (floor $ (j : ℝ) * α), from by auto [h9],

  have h10 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h4],

  let S : set ℕ := {i | ∃ N : ℕ, i = N ∧ 0 ≤ (i : ℝ) * α ∧ (i : ℝ) * α < 1},

  let Sq : (set ℕ) → set ℝ := λ (i : set ℕ) (h : i ∈ S), (i : ℝ) * α,

  have h11 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h10],

  have h12 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h11],

  have h13 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [and.elim_right] using [fintype.card_gt_one_iff, exists_nat_one, exists_nat_zero, nat.succ_eq_add_one, exists_nat_succ, set.mem_singleton],

  have h14 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h2, h13],

  have h15 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h14],

  have h16 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h15],

  have h17 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h16],

  have h18 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h17],

  have h19 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h18],

  have h20 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h19],

  have h21 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h20],

  have h22 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h21],

  have h23 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h22],

  have h24 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h23],

  have h25 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h24],

  have h26 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h25],

  have h27 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h26],

  have h28 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h27],

  have h29 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h28],

  have h30 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h29],

  have h31 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h30],

  have h32 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h31],

  have h33 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h32],

  have h34 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h33],

  have h35 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h34],

  have h36 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h35],

  have h37 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h36],

  have h38 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h37],

  have h39 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h38],

  have h40 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h39],

  have h41 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h40],

  have h42 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h41],

  have h43 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h42],

  have h44 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h43],

  have h45 : ∃ i : set ℕ, ∃ j : set ℕ, i ≠ j, from by auto [h44],

  have h46 : ∃ i : set ℕ,
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_is_dense (α : ℝ) (hα : ¬ (irrational α)): false :=
begin
  -- there is no irrational α
  have H2 : ∃ i j : ℝ, ∀ n : ℝ, n ∈ ℤ → (i * α - n) < (floor (i * α)) ∧ (floor (i * α)) ≤ n ∧ n < (i * α),
  from by auto [correct, irrational_floor],
  cases H2 with i hi,
  cases hi with j hj,
  let H := λ i j : ℝ, ∀ n : ℝ, n ∈ ℤ → (i * α - n) < (floor (i * α)) ∧ (floor (i * α)) ≤ n ∧ n < (i * α),
  have H1 : H i j, from by auto [hi],
  have H2 : H j i, from by auto [hj],
  have H3 : H i j ∧ H j i ↔ ∀ n : ℝ, n ∈ ℤ → (i * α - n) < (floor (i * α)) ∧ (floor (i * α)) ≤ n ∧ n < (i * α) ∧ (j * α - n) < (floor (j * α)) ∧ (floor (j * α)) ≤ n ∧ n < (j * α),
  from by auto [and.comm],
  have H4 :  (H i j ∧ H j i), from by auto [and.intro, H1, H2],
  have H5 : (∀ n : ℝ, n ∈ ℤ → (i * α - n) < (floor (i * α)) ∧ (floor (i * α)) ≤ n ∧ n < (i * α) ∧ (j * α - n) < (floor (j * α)) ∧ (floor (j * α)) ≤ n ∧ n < (j * α)),
  from by auto [H3, H4],
  have H6 : (∀ n : ℝ, n ∈ ℤ → (i * α - n) = (j * α - n)),
  from by auto [H5, eq_of_forall_eq_of_forall_eq],
  have H7 : (i * α - i) = (j * α - i), from by auto [H6],
  have H8 : (i - j) = (j * α - i), from by auto [sub_eq_iff_eq_add, (i * α - i)],
  have H9 : (i - j) = ((j - i) * α), from by auto [sub_eq_iff_eq_add, (j * α - i), H8],
  have H10 : (i - j) = 0 → (j - i) = 0, from by rw [sub_eq_zero_iff_eq],
  have H11 : (j - i) = 0, from by auto [H10, H9],
  have H12 :  (i - j) = (i - i), from by auto [H11],
  have H13 : (i - j) = 0, from by auto [H12],
  have H14 : (i - j) = (j - i), from by auto [sub_eq_zero_iff_eq, H13],
  have H15 : (j - i) = (i - j), from by auto [sub_eq_zero_iff_eq, H14],
  have H16 : (i - i) = (j - i), from by auto [H15],
  have H17 : i = j, from by auto [sub_eq_zero_iff_eq, H16],
  have H18 : i ≠ j, from by auto [not_not],
  contradiction,
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=diagonalization {α : Type*} (S : Type*) [linear_order S] (k : S → ℕ) (H : nonempty S) : ∃ s : S, ¬ ∃ n : ℕ, s = k n :=
begin
  -- contradiction with well-ordering
  let h1 := well_ordering S,
  let h2 := classical.indefinite_description (nonempty S) H,
  let h3 := classical.indefinite_description {m : ℕ | ∃ (s : S), s = k m}
  (nonempty {m : ℕ | ∃ (s : S), s = k m}),
  let h4 := exists_mem_of_ne_empty H,
  let h5 := classical.indefinite_description (nonempty S) H,
  let h6 := not_exists_iff_forall_not,
  let h7 := well_ordering.not_exists_min S h1,
  let h8 := well_ordering.no_min_of_not_exists S h1,
  let h9 := not_exists_iff_forall_not,

  -- We now have 3 cases
  -- Case 1
  cases h4 with s4 h4,
  cases h4 with z h4,
  cases h4 with h4 h4,
  cases h5 with s5 h5,
  cases h5 with h5 h5,
  have h10 : ¬ (s5 < s4 ∨ s4 < s5), from by auto [h4, h5, h9] using [h8],
  have h11 : ¬ (s5 = s4), from by auto [h10],
  have h12 : ¬ (∃ (n : ℕ), s5 = k n), from by auto [h11, h4],

  -- Case 2
  let h13 : ∃ s, s4 < s ∨ s < s4 := by auto using [ne_of_lt, ne_of_gt],
  cases h13 with s h13,
  cases h13 with h13,
  cases h13 with h13 h13,
  have h14 : ¬ (∃ (n : ℕ), s = k n), from by auto,

  -- Case 3
  cases h13 with h13 h13,
  cases h4 with z h4,
  cases h4 with h4 h4,
  cases h5 with s5 h5,
  cases h5 with h5 h5,
  have h15 : ¬ (s5 < s ∨ s < s5), from by auto [h4, h5, (h9)] using [h8],
  have h16 : ¬ (s5 = s), from by auto [h15],
  have h17 : ¬ (∃ (n : ℕ), s5 = k n), from by auto [h16, h4],

  -- conclusion
  cases h2 with s2 h2,
  cases h2 with h2 h2,
  let h18 := not_exists_iff_forall_not,
  let h19 := h18 S k s2,
  have h20 : ∀ s, ¬ (s = k (k s2)), from by auto [h12, h14, h17],
  have h21 : ¬ (s2 = k (k s2)), from by auto [h19],
  have h22 : ¬ (∃ (n : ℕ), s2 = k n), from by auto [h21],
  have h23 : ∀ (n : ℕ), ¬ (s2 = k n), from by auto [h22, h18],
  have h24 : ¬ ∃ (n : ℕ), s2 = k n, from by auto [h23],
  use s2,
  use h24,
end

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irr_orbit_dense {α : Type} [preorder α] {x : ℕ → α} : dense (λ n, x n) ↔ dense (λ n, ⌊x n⌋) :=
begin
  -- Sorry, You will have to prove this yourself
  sorry
end

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=real_irrational_orbit_dense (real : Type*) [order_top real] [ordered_field real] [sep_algebra real] [is_absolute_value real] [real_inner_product_space real] [add_comm_group real] (real_irrational : real → Prop) : ∀ α ∈ real_irrational, ∀ y : real, ∃ (n : ℕ),  ((y - n * α) ∈ ℤ) → y ∈ [0, 1] → ∃ (i : ℕ), ∃ (x : real), (x ∈ [0, 1]) ∧ ((y - x) ∈ {e : real | (e < 1)} ∨ (y - x) ∈ {e : real | (e > -1)}) :=
begin
  -- Let α be an irrational number. Then for distinct i, j in Z, we must have {i α} ≠ {j α}. If this were not true, then
  assume α hα,
  assume y,
  assume h1 : ∃ (n : ℕ), ((y - n * α) ∈ ℤ),
  assume h2 : y ∈ [0, 1],

  -- we must have {i α} ≠ {j α}. If this were not true, then
  assume (h3 : (∀ i : ℕ, ∀ j : ℕ, i ≠ j → {i*α} ≠ {j*α})) (h4 : ⊤),

  -- i α-⌊ i α⌋={i α}={j α}=j α-⌊ j α⌋,
  cases h1 with n hn,
  have h21 : ∃ (a : real), {n*α} = (n*α - a), from by auto [exists_int_iff, mul_comm],
  cases h21 with a ha,
  have h22 : y = a + ⌊y⌋ ∨ y = a + ⌊y⌋ + 1, from by auto [floor_eq_or_succ],
  cases h22 with h22a h22b,
  have h221 : {n * α} = (n * α - a) := by auto [ha],
  have h222 : {n * α} = (y - (a + ⌊y⌋)) := by auto [h22a, ha, add_comm],
  have h223 : {n * α} = (y - (a + ⌊y⌋) - 1) := by auto [h22b, ha, add_comm],

  -- which yields the false statement α=i−j⌊ i α⌋−⌊ j α⌋⊤∈Q, contradicting h3.
  have h27 : α ∈ ℤ := by auto [h222, h223, hα, floor_eq_iff, mul_comm, h22a, add_comm, h22b, exists_int_iff],
  contradiction,

  -- Hence, S:={i α}∈Z is an infinite subset of [0,1].
  have h25 : ∀ n : ℕ, ∀ i : ℕ, ∀ x : real, (∀ (j : ℕ), (∀ (h6 : j ≠ n), {j * α} ≠ x)) → (∀ (h6 : i ≠ n), {i * α} ≠ x), from by auto [decidable.em],
  have h26 : ∀ (x : real), ∃ n : ℕ, ∃ i : ℕ, ∃ x : real, (x ∈ [0, 1]) ∧ ((y - x) ∈ {e : real | (e < 1)} ∨ (y - x) ∈ {e : real | (e > -1)}), from by auto [h2, h25],
  have h27 : {n * α} ∈ (𝒫 [0, 1]) := by exact ⟨h2, hn, hα, h1, λ h6, h6⟩,
  have h28 : ∀ n ∈ ℕ, {n * α} ∈ (𝒫 [0, 1]), from by auto [h27],

  -- S:={i α}∈Z is an infinite subset of [0,1]
  -- By the Bolzano-Weierstrass theorem, S has a limit point in [0, 1]
  have h29 : ∃ x : real, ∃ xs : list real, (∀ a : real, ∃ b : list real, b ∈ xs ∧ (∀ c : real, c ∈ b → (|c - x| < a))), from by auto [compact_iff_seq_limit, nonempty_compact_seq_limit, h28, lt_add_one, zero_lt_one, one_lt_two, add_comm, le_add_one, add_le_add_right],
  cases h29 with x hx,
  cases hx with xs hx2,

  -- One can thus find pairs of elements of S that are arbitrarily close.
  have h31 : ∃ i : ℕ, ∃ x : real, (x ∈ [0, 1]) ∧ ((y - x) ∈ {e : real | (e < 1)} ∨ (y - x) ∈ {e : real | (e > -1)}), from by auto [h26],
  cases h31 with i hi,
  cases hi with x hx2,

  -- 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 h33 : (∀ (i : ℕ), ∀ (j : ℕ), (i ≠ j) → (∃ (n : ℕ), {n * α} = {i * α} - {j * α})), from by auto [exists_int_iff, mul_comm],
  have h34 : (∀ (i : ℕ), ∀ (j : ℕ), (i ≠ j) → (∃ (n : ℕ), {n * α} ∈ [0, 1])), from by auto [h28],
  have h36 : (∀ (a : real), ∃ (b : list real), (b ∈ xs) ∧ (∀ (c : real), (c ∈ b) → (|c - x| < a))), from by auto [hx2],
  have h37 : ∃ (a : real), (a > 0), from by auto [lt_add_one, zero_lt_one, one_lt_two, add_comm, le_add_one, add_le_add_right],
  cases h37 with a ha,
  have h38 : ∃ (b : list real), (b ∈ xs) ∧ (∀ (c : real), (c ∈ b) → (|c - {i * α}| < a)), from by auto [h36, hx2, ha],

  -- To show that S is dense in [0, 1], consider y∈[0,1], and ε>0. Then by selecting x∈S such that {x}<ε (which exists as 0 is a limit point), and N such that N⋅{x}≤y<(N+1)⋅{x}, we get: |y−{Nx}|<ε.
  have h39 : ∀ (y : real), (y ∈ [0, 1]) → ∃ (n : ℕ), ((y - n * α) ∈ ℤ), from by auto [exists_int_iff, mul_comm, h28],
  have h40 : ∃ (n : ℕ), {n * α} ∈ [0, 1], from by auto [h28],
  have h41 : ∀ (n : ℕ), ∃ (b : list real), (b ∈ xs) ∧ (∀ (c : real), (c ∈ b) → (|c - {n * α}| < a)), from by auto [h40, h36],
  cases h41 with N hN,
  cases hN with b hb,
  cases hb with hb2 hb3,
  have h42 : ∃ (i : ℕ), (
end --Needs more than 2000 tokens!

/- 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 auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
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 auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [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 auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

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

  -- 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 by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

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
FEW SHOT PROMPTS TO CODEX(END)-/


lemma eq_zero_of_add_right_eq_self {a b : mynat} : a + b = a → b = 0 :=
begin
intro h,
rw add_comm at h,
rw ← zero_add a at h,
rw ← add_assoc at h,
rw add_zero b at h,
exact (add_right_cancel b a 0)(h),
end

-- lemma eq_zero_of_add_right_eq_self {a b : mynat} : a + b = a → b = 0 :=
-- begin
-- induction a with c hc,
-- intro h,
-- rw zero_add at h,
-- exact h,
-- intro h,
-- apply hc,
-- rw succ_add at h,
-- rw succ_eq_succ_iff at h,
-- rw h,
-- refl,
-- end


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.star.basic
import algebra.ring.pi
import algebra.module.pi

/-!
# `star` on pi types

We put a `has_star` structure on pi types that operates elementwise, such that it describes the
complex conjugation of vectors.
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances

namespace pi

instance [Π i, has_star (f i)] : has_star (Π i, f i) :=
{ star := λ x i, star (x i) }

@[simp] lemma star_apply [Π i, has_star (f i)] (x : Π i, f i) (i : I) : star x i = star (x i) := rfl

lemma star_def [Π i, has_star (f i)] (x : Π i, f i) : star x = λ i, star (x i) := rfl

instance [Π i, has_involutive_star (f i)] : has_involutive_star (Π i, f i) :=
{ star_involutive := λ _, funext $ λ _, star_star _ }

instance [Π i, semigroup (f i)] [Π i, star_semigroup (f i)] : star_semigroup (Π i, f i) :=
{ star_mul := λ _ _, funext $ λ _, star_mul _ _ }

instance [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] : star_add_monoid (Π i, f i) :=
{ star_add := λ _ _, funext $ λ _, star_add _ _ }

instance [Π i, non_unital_semiring (f i)] [Π i, star_ring (f i)] : star_ring (Π i, f i) :=
{ ..pi.star_add_monoid, ..(pi.star_semigroup : star_semigroup (Π i, f i)) }

instance {R : Type w}
  [Π i, has_scalar R (f i)] [has_star R] [Π i, has_star (f i)] [Π i, star_module R (f i)] :
  star_module R (Π i, f i) :=
{ star_smul := λ r x, funext $ λ i, star_smul r (x i) }

lemma single_star [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] [decidable_eq I]
  (i : I) (a : f i) :
  pi.single i (star a) = star (pi.single i a) :=
single_op (λ i, @star (f i) _) (λ i, star_zero _) i a

end pi

namespace function

lemma update_star [Π i, has_star (f i)] [decidable_eq I]
  (h : Π (i : I), f i) (i : I) (a : f i) :
  function.update (star h) i (star a) = star (function.update h i a) :=
funext $ λ j, (apply_update (λ i, star) h i a j).symm

end function