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

! This file was ported from Lean 3 source module topology.algebra.order.group
! leanprover-community/mathlib commit 3dadefa3f544b1db6214777fe47910739b54c66a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Order.Basic
import Mathbin.Topology.Algebra.Group.Basic

/-!
# Topology on a linear ordered additive commutative group

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

In this file we prove that a linear ordered additive commutative group with order topology is a
topological group. We also prove continuity of `abs : G → G` and provide convenience lemmas like
`continuous_at.abs`.
-/

open Set Filter

open Topology Filter

variable {α G : Type _} [TopologicalSpace G] [LinearOrderedAddCommGroup G] [OrderTopology G]

variable {l : Filter α} {f g : α → G}

#print LinearOrderedAddCommGroup.topologicalAddGroup /-
-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedAddCommGroup.topologicalAddGroup : TopologicalAddGroup G
    where
  continuous_add := by
    refine' continuous_iff_continuousAt.2 _
    rintro ⟨a, b⟩
    refine' LinearOrderedAddCommGroup.tendsto_nhds.2 fun ε ε0 => _
    rcases dense_or_discrete 0 ε with (⟨δ, δ0, δε⟩ | ⟨h₁, h₂⟩)
    · -- If there exists `δ ∈ (0, ε)`, then we choose `δ`-nhd of `a` and `(ε-δ)`-nhd of `b`
      filter_upwards [(eventually_abs_sub_lt a δ0).prod_nhds
          (eventually_abs_sub_lt b (sub_pos.2 δε))]
      rintro ⟨x, y⟩ ⟨hx : |x - a| < δ, hy : |y - b| < ε - δ⟩
      rw [add_sub_add_comm]
      calc
        |x - a + (y - b)| ≤ |x - a| + |y - b| := abs_add _ _
        _ < δ + (ε - δ) := (add_lt_add hx hy)
        _ = ε := add_sub_cancel'_right _ _

    · -- Otherwise `ε`-nhd of each point `a` is `{a}`
      have hε : ∀ {x y}, |x - y| < ε → x = y :=
        by
        intro x y h
        simpa [sub_eq_zero] using h₂ _ h
      filter_upwards [(eventually_abs_sub_lt a ε0).prod_nhds (eventually_abs_sub_lt b ε0)]
      rintro ⟨x, y⟩ ⟨hx : |x - a| < ε, hy : |y - b| < ε⟩
      simpa [hε hx, hε hy]
  continuous_neg :=
    continuous_iff_continuousAt.2 fun a =>
      LinearOrderedAddCommGroup.tendsto_nhds.2 fun ε ε0 =>
        (eventually_abs_sub_lt a ε0).mono fun x hx => by rwa [neg_sub_neg, abs_sub_comm]
#align linear_ordered_add_comm_group.topological_add_group LinearOrderedAddCommGroup.topologicalAddGroup
-/

/- warning: continuous_abs -> continuous_abs is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))], Continuous.{u1, u1} G G _inst_1 _inst_1 (Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (SubNegMonoid.toHasNeg.{u1} G (AddGroup.toSubNegMonoid.{u1} G (AddCommGroup.toAddGroup.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))) (SemilatticeSup.toHasSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (LinearOrder.toLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2))))))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))], Continuous.{u1, u1} G G _inst_1 _inst_1 (Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))))
Case conversion may be inaccurate. Consider using '#align continuous_abs continuous_absₓ'. -/
@[continuity]
theorem continuous_abs : Continuous (abs : G → G) :=
  continuous_id.max continuous_neg
#align continuous_abs continuous_abs

/- warning: filter.tendsto.abs -> Filter.Tendsto.abs is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} G] [_inst_2 : LinearOrderedAddCommGroup.{u2} G] [_inst_3 : OrderTopology.{u2} G _inst_1 (PartialOrder.toPreorder.{u2} G (OrderedAddCommGroup.toPartialOrder.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))] {l : Filter.{u1} α} {f : α -> G} {a : G}, (Filter.Tendsto.{u1, u2} α G f l (nhds.{u2} G _inst_1 a)) -> (Filter.Tendsto.{u1, u2} α G (fun (x : α) => Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2))))) (f x)) l (nhds.{u2} G _inst_1 (Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2))))) a)))
but is expected to have type
  forall {α : Type.{u2}} {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))] {l : Filter.{u2} α} {f : α -> G} {a : G}, (Filter.Tendsto.{u2, u1} α G f l (nhds.{u1} G _inst_1 a)) -> (Filter.Tendsto.{u2, u1} α G (fun (x : α) => Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) (f x)) l (nhds.{u1} G _inst_1 (Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) a)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.abs Filter.Tendsto.absₓ'. -/
protected theorem Filter.Tendsto.abs {a : G} (h : Tendsto f l (𝓝 a)) :
    Tendsto (fun x => |f x|) l (𝓝 (|a|)) :=
  (continuous_abs.Tendsto _).comp h
#align filter.tendsto.abs Filter.Tendsto.abs

/- warning: tendsto_zero_iff_abs_tendsto_zero -> tendsto_zero_iff_abs_tendsto_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} G] [_inst_2 : LinearOrderedAddCommGroup.{u2} G] [_inst_3 : OrderTopology.{u2} G _inst_1 (PartialOrder.toPreorder.{u2} G (OrderedAddCommGroup.toPartialOrder.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))] {l : Filter.{u1} α} (f : α -> G), Iff (Filter.Tendsto.{u1, u2} α G f l (nhds.{u2} G _inst_1 (OfNat.ofNat.{u2} G 0 (OfNat.mk.{u2} G 0 (Zero.zero.{u2} G (AddZeroClass.toHasZero.{u2} G (AddMonoid.toAddZeroClass.{u2} G (SubNegMonoid.toAddMonoid.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))))))))))) (Filter.Tendsto.{u1, u2} α G (Function.comp.{succ u1, succ u2, succ u2} α G G (Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2)))))) f) l (nhds.{u2} G _inst_1 (OfNat.ofNat.{u2} G 0 (OfNat.mk.{u2} G 0 (Zero.zero.{u2} G (AddZeroClass.toHasZero.{u2} G (AddMonoid.toAddZeroClass.{u2} G (SubNegMonoid.toAddMonoid.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))))))))))
but is expected to have type
  forall {α : Type.{u2}} {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))] {l : Filter.{u2} α} (f : α -> G), Iff (Filter.Tendsto.{u2, u1} α G f l (nhds.{u1} G _inst_1 (OfNat.ofNat.{u1} G 0 (Zero.toOfNat0.{u1} G (NegZeroClass.toZero.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))))))) (Filter.Tendsto.{u2, u1} α G (Function.comp.{succ u2, succ u1, succ u1} α G G (Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2))))))) f) l (nhds.{u1} G _inst_1 (OfNat.ofNat.{u1} G 0 (Zero.toOfNat0.{u1} G (NegZeroClass.toZero.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))))))))))
Case conversion may be inaccurate. Consider using '#align tendsto_zero_iff_abs_tendsto_zero tendsto_zero_iff_abs_tendsto_zeroₓ'. -/
theorem tendsto_zero_iff_abs_tendsto_zero (f : α → G) :
    Tendsto f l (𝓝 0) ↔ Tendsto (abs ∘ f) l (𝓝 0) :=
  by
  refine' ⟨fun h => (abs_zero : |(0 : G)| = 0) ▸ h.abs, fun h => _⟩
  have : tendsto (fun a => -|f a|) l (𝓝 0) := (neg_zero : -(0 : G) = 0) ▸ h.neg
  exact
    tendsto_of_tendsto_of_tendsto_of_le_of_le this h (fun x => neg_abs_le_self <| f x) fun x =>
      le_abs_self <| f x
#align tendsto_zero_iff_abs_tendsto_zero tendsto_zero_iff_abs_tendsto_zero

variable [TopologicalSpace α] {a : α} {s : Set α}

/- warning: continuous.abs -> Continuous.abs is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} G] [_inst_2 : LinearOrderedAddCommGroup.{u2} G] [_inst_3 : OrderTopology.{u2} G _inst_1 (PartialOrder.toPreorder.{u2} G (OrderedAddCommGroup.toPartialOrder.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u1} α], (Continuous.{u1, u2} α G _inst_4 _inst_1 f) -> (Continuous.{u1, u2} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2))))) (f x)))
but is expected to have type
  forall {α : Type.{u2}} {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u2} α], (Continuous.{u2, u1} α G _inst_4 _inst_1 f) -> (Continuous.{u2, u1} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) (f x)))
Case conversion may be inaccurate. Consider using '#align continuous.abs Continuous.absₓ'. -/
protected theorem Continuous.abs (h : Continuous f) : Continuous fun x => |f x| :=
  continuous_abs.comp h
#align continuous.abs Continuous.abs

/- warning: continuous_at.abs -> ContinuousAt.abs is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} G] [_inst_2 : LinearOrderedAddCommGroup.{u2} G] [_inst_3 : OrderTopology.{u2} G _inst_1 (PartialOrder.toPreorder.{u2} G (OrderedAddCommGroup.toPartialOrder.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u1} α] {a : α}, (ContinuousAt.{u1, u2} α G _inst_4 _inst_1 f a) -> (ContinuousAt.{u1, u2} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2))))) (f x)) a)
but is expected to have type
  forall {α : Type.{u2}} {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u2} α] {a : α}, (ContinuousAt.{u2, u1} α G _inst_4 _inst_1 f a) -> (ContinuousAt.{u2, u1} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) (f x)) a)
Case conversion may be inaccurate. Consider using '#align continuous_at.abs ContinuousAt.absₓ'. -/
protected theorem ContinuousAt.abs (h : ContinuousAt f a) : ContinuousAt (fun x => |f x|) a :=
  h.abs
#align continuous_at.abs ContinuousAt.abs

/- warning: continuous_within_at.abs -> ContinuousWithinAt.abs is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} G] [_inst_2 : LinearOrderedAddCommGroup.{u2} G] [_inst_3 : OrderTopology.{u2} G _inst_1 (PartialOrder.toPreorder.{u2} G (OrderedAddCommGroup.toPartialOrder.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u1} α] {a : α} {s : Set.{u1} α}, (ContinuousWithinAt.{u1, u2} α G _inst_4 _inst_1 f s a) -> (ContinuousWithinAt.{u1, u2} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2))))) (f x)) s a)
but is expected to have type
  forall {α : Type.{u2}} {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u2} α] {a : α} {s : Set.{u2} α}, (ContinuousWithinAt.{u2, u1} α G _inst_4 _inst_1 f s a) -> (ContinuousWithinAt.{u2, u1} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) (f x)) s a)
Case conversion may be inaccurate. Consider using '#align continuous_within_at.abs ContinuousWithinAt.absₓ'. -/
protected theorem ContinuousWithinAt.abs (h : ContinuousWithinAt f s a) :
    ContinuousWithinAt (fun x => |f x|) s a :=
  h.abs
#align continuous_within_at.abs ContinuousWithinAt.abs

/- warning: continuous_on.abs -> ContinuousOn.abs is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} G] [_inst_2 : LinearOrderedAddCommGroup.{u2} G] [_inst_3 : OrderTopology.{u2} G _inst_1 (PartialOrder.toPreorder.{u2} G (OrderedAddCommGroup.toPartialOrder.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u1} α] {s : Set.{u1} α}, (ContinuousOn.{u1, u2} α G _inst_4 _inst_1 f s) -> (ContinuousOn.{u1, u2} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u2} G (Neg.toHasAbs.{u2} G (SubNegMonoid.toHasNeg.{u2} G (AddGroup.toSubNegMonoid.{u2} G (AddCommGroup.toAddGroup.{u2} G (OrderedAddCommGroup.toAddCommGroup.{u2} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u2} G _inst_2))))) (SemilatticeSup.toHasSup.{u2} G (Lattice.toSemilatticeSup.{u2} G (LinearOrder.toLattice.{u2} G (LinearOrderedAddCommGroup.toLinearOrder.{u2} G _inst_2))))) (f x)) s)
but is expected to have type
  forall {α : Type.{u2}} {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))] {f : α -> G} [_inst_4 : TopologicalSpace.{u2} α] {s : Set.{u2} α}, (ContinuousOn.{u2, u1} α G _inst_4 _inst_1 f s) -> (ContinuousOn.{u2, u1} α G _inst_4 _inst_1 (fun (x : α) => Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) (f x)) s)
Case conversion may be inaccurate. Consider using '#align continuous_on.abs ContinuousOn.absₓ'. -/
protected theorem ContinuousOn.abs (h : ContinuousOn f s) : ContinuousOn (fun x => |f x|) s :=
  fun x hx => (h x hx).abs
#align continuous_on.abs ContinuousOn.abs

/- warning: tendsto_abs_nhds_within_zero -> tendsto_abs_nhdsWithin_zero is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))], Filter.Tendsto.{u1, u1} G G (Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (SubNegMonoid.toHasNeg.{u1} G (AddGroup.toSubNegMonoid.{u1} G (AddCommGroup.toAddGroup.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))) (SemilatticeSup.toHasSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (LinearOrder.toLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2)))))) (nhdsWithin.{u1} G _inst_1 (OfNat.ofNat.{u1} G 0 (OfNat.mk.{u1} G 0 (Zero.zero.{u1} G (AddZeroClass.toHasZero.{u1} G (AddMonoid.toAddZeroClass.{u1} G (SubNegMonoid.toAddMonoid.{u1} G (AddGroup.toSubNegMonoid.{u1} G (AddCommGroup.toAddGroup.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))))))))) (HasCompl.compl.{u1} (Set.{u1} G) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} G) (Set.booleanAlgebra.{u1} G)) (Singleton.singleton.{u1, u1} G (Set.{u1} G) (Set.hasSingleton.{u1} G) (OfNat.ofNat.{u1} G 0 (OfNat.mk.{u1} G 0 (Zero.zero.{u1} G (AddZeroClass.toHasZero.{u1} G (AddMonoid.toAddZeroClass.{u1} G (SubNegMonoid.toAddMonoid.{u1} G (AddGroup.toSubNegMonoid.{u1} G (AddCommGroup.toAddGroup.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))))))))) (nhdsWithin.{u1} G _inst_1 (OfNat.ofNat.{u1} G 0 (OfNat.mk.{u1} G 0 (Zero.zero.{u1} G (AddZeroClass.toHasZero.{u1} G (AddMonoid.toAddZeroClass.{u1} G (SubNegMonoid.toAddMonoid.{u1} G (AddGroup.toSubNegMonoid.{u1} G (AddCommGroup.toAddGroup.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))))))))) (Set.Ioi.{u1} G (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))) (OfNat.ofNat.{u1} G 0 (OfNat.mk.{u1} G 0 (Zero.zero.{u1} G (AddZeroClass.toHasZero.{u1} G (AddMonoid.toAddZeroClass.{u1} G (SubNegMonoid.toAddMonoid.{u1} G (AddGroup.toSubNegMonoid.{u1} G (AddCommGroup.toAddGroup.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))))))))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} G] [_inst_2 : LinearOrderedAddCommGroup.{u1} G] [_inst_3 : OrderTopology.{u1} G _inst_1 (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))], Filter.Tendsto.{u1, u1} G G (Abs.abs.{u1} G (Neg.toHasAbs.{u1} G (NegZeroClass.toNeg.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))) (SemilatticeSup.toSup.{u1} G (Lattice.toSemilatticeSup.{u1} G (DistribLattice.toLattice.{u1} G (instDistribLattice.{u1} G (LinearOrderedAddCommGroup.toLinearOrder.{u1} G _inst_2))))))) (nhdsWithin.{u1} G _inst_1 (OfNat.ofNat.{u1} G 0 (Zero.toOfNat0.{u1} G (NegZeroClass.toZero.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))))) (HasCompl.compl.{u1} (Set.{u1} G) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} G) (Set.instBooleanAlgebraSet.{u1} G)) (Singleton.singleton.{u1, u1} G (Set.{u1} G) (Set.instSingletonSet.{u1} G) (OfNat.ofNat.{u1} G 0 (Zero.toOfNat0.{u1} G (NegZeroClass.toZero.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))))))))))) (nhdsWithin.{u1} G _inst_1 (OfNat.ofNat.{u1} G 0 (Zero.toOfNat0.{u1} G (NegZeroClass.toZero.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))))))))) (Set.Ioi.{u1} G (PartialOrder.toPreorder.{u1} G (OrderedAddCommGroup.toPartialOrder.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2))) (OfNat.ofNat.{u1} G 0 (Zero.toOfNat0.{u1} G (NegZeroClass.toZero.{u1} G (SubNegZeroMonoid.toNegZeroClass.{u1} G (SubtractionMonoid.toSubNegZeroMonoid.{u1} G (SubtractionCommMonoid.toSubtractionMonoid.{u1} G (AddCommGroup.toDivisionAddCommMonoid.{u1} G (OrderedAddCommGroup.toAddCommGroup.{u1} G (LinearOrderedAddCommGroup.toOrderedAddCommGroup.{u1} G _inst_2)))))))))))
Case conversion may be inaccurate. Consider using '#align tendsto_abs_nhds_within_zero tendsto_abs_nhdsWithin_zeroₓ'. -/
theorem tendsto_abs_nhdsWithin_zero : Tendsto (abs : G → G) (𝓝[≠] 0) (𝓝[>] 0) :=
  (continuous_abs.tendsto' (0 : G) 0 abs_zero).inf <|
    tendsto_principal_principal.2 fun x => abs_pos.2
#align tendsto_abs_nhds_within_zero tendsto_abs_nhdsWithin_zero


import misc.rationals.order

namespace manifold

structure rational_cauchy :=
(seq : ℕ → ℚ)
(cauchy : ∀ {ε : ℚ}, ε > 0 → ∃ N : ℕ, ∀ {n m : ℕ}, n ≥ N  → m ≥ N →
  rational.abs (seq n - seq m) < ε)

def is_rational_cauchy : (ℕ → ℚ) → Prop := λ seq,  ∀ {ε : ℚ}, ε > 0 → ∃ N : ℕ, ∀ {n m : ℕ},
  n ≥ N  → m ≥ N → rational.abs (seq n - seq m) < ε

def same_limit : rational_cauchy → rational_cauchy → Prop := λ f₁ f₂, ∀ {ε : ℚ}, ε > 0 → ∃ N : ℕ,
  ∀ {n : ℕ}, n ≥ N → rational.abs (f₁.seq n - f₂.seq n) < ε

theorem same_limit_refl : ∀ f : rational_cauchy, same_limit f f :=
begin
  intros f ε hε,
  existsi 0,
  intros n hn,
  simp[comm_ring.minus_inverse,rational.abs_zero],
  assumption,
end

theorem same_limit_symm : ∀ f₁ f₂ : rational_cauchy, same_limit f₁ f₂ → same_limit f₂ f₁ :=
begin
  intros f₁ f₂ h ε hε,
  cases h hε with Nε hNε,
  existsi Nε,
  intro,
  rw [rational.sub_antisymm, rational.abs_minus],
  apply hNε,
end

theorem same_limit_trans : ∀ f₁ f₂ f₃ : rational_cauchy, same_limit f₁ f₂ → same_limit f₂ f₃
  → same_limit f₁ f₃ :=
begin
  intros f₁ f₂ f₃ h12 h23,
  intros ε hε,
  cases hε with hε nε,
  cases hε with n hε,
  cases hε with m hε,
  simp[comm_ring.minus_zero_zero, comm_ring.add_zero] at hε,
  cases h12 (rational.scale_pos_rat 2 nε hε) with N₁ hN₁,
  cases h23 (rational.scale_pos_rat 2 nε hε) with N₂ hN₂,
  existsi max N₁ N₂,
  intros n hn,
  simp,
  rw comm_ring.add_midpoint (f₂.seq n),
  rw [hε, rational.mul_two_div_rat_by_two],
  apply rational.le_then_lt_lt,
  apply rational.triangle_inequality,
  apply rational.lt_add,
  apply hN₁,
  apply le_trans,
  apply le_max_left,
  exact N₂,
  assumption,
  apply hN₂,
  apply le_trans,
  apply le_max_right,
  exact N₁,
  assumption,
end

instance rational_cauchy_setiod : setoid rational_cauchy
  := ⟨same_limit, same_limit_refl, same_limit_symm, same_limit_trans⟩

@[simp]
theorem rational_cauchy_eqv_concrete_char : ∀ f₁ f₂ : rational_cauchy, f₁ ≈ f₂ ↔ ∀ {ε : ℚ}, ε > 0 →
  ∃ N : ℕ, ∀ {n : ℕ}, n ≥ N → rational.abs (f₁.seq n - f₂.seq n) < ε := λ _ _, by refl

def real : Type := quotient manifold.rational_cauchy_setiod

notation `ℝ` := real

def rational_cauchy_add : rational_cauchy → rational_cauchy → rational_cauchy := λ f₁ f₂,
{
  seq := λ n : ℕ, f₁.seq n + f₂.seq n,
  cauchy :=
    begin
      intros ε hε,
      cases hε with hε nε,
      cases hε with n hε,
      cases hε with m hε,
      simp[comm_ring.minus_zero_zero,comm_ring.add_zero] at hε,
      cases f₁.cauchy ((rational.scale_pos_rat 2 nε hε)) with N₁ hN₁,
      cases f₂.cauchy ((rational.scale_pos_rat 2 nε hε)) with N₂ hN₂,
      existsi max N₁ N₂,
      intros n' m' hn hm,
      simp[comm_ring.minus_dis,comm_ring.add_assoc₄,comm_ring.add_comm (f₂.seq n')],
      rw [← comm_ring.add_assoc₄,hε,rational.mul_two_div_rat_by_two],
      apply rational.le_then_lt_lt,
      apply rational.triangle_inequality,
      apply rational.lt_add,
      apply hN₁,
      apply le_trans,
      apply le_max_left,
      exact N₂,
      assumption,
      apply le_trans,
      apply le_max_left,
      exact N₂,
      assumption,
      apply hN₂,
      apply le_trans,
      apply le_max_right,
      exact N₁,
      assumption,
      apply le_trans,
      apply le_max_right,
      exact N₁,
      assumption,
    end,
}

instance rational_cauchy_has_add : has_add rational_cauchy := ⟨rational_cauchy_add⟩

@[simp]
theorem rational_cauchy_add_concrete_char : ∀ (f₁ f₂ : rational_cauchy) (n : ℕ) ,
  (f₁ + f₂).seq n = f₁.seq n + f₂.seq n := λ f₁ f₂ n, rfl

def real_add : ℝ → ℝ → ℝ :=
begin
  apply quotient.lift₂ (λ f₁ f₂ : rational_cauchy, ⟦f₁ + f₂⟧),
  simp,
  intros f₁ f₂ g₁ g₂ h₁ h₂,
  apply quotient.sound,
  simp,
  intros ε hε,
  cases hε with hε nε,
  cases hε with n hε,
  cases hε with m hε,
  simp[comm_ring.minus_zero_zero,comm_ring.add_zero] at hε,
  cases h₁ ((rational.scale_pos_rat 2 nε hε)) with N₁ hN₁,
  cases h₂ ((rational.scale_pos_rat 2 nε hε)) with N₂ hN₂,
  existsi max N₁ N₂,
  intros n' hn',
  rw [hε,rational.mul_two_div_rat_by_two],
  rw [comm_ring.minus_dis, comm_ring.add_assoc₄, comm_ring.add_comm (f₂.seq n')],
  rw ← comm_ring.add_assoc₄,
  apply rational.le_then_lt_lt,
  apply rational.triangle_inequality,
  apply rational.lt_add,
  apply hN₁,
  apply le_trans,
  apply le_max_left,
  exact N₂,
  assumption,
  apply hN₂,
  apply le_trans,
  apply le_max_right,
  exact N₁,
  assumption,
end

instance real_has_add : has_add ℝ := ⟨real_add⟩

theorem real_add_concrete_char : ∀ x y : rational_cauchy, (⟦x⟧ + ⟦y⟧ : ℝ) = ⟦x + y⟧ := λ _ _, rfl

end manifold


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

! This file was ported from Lean 3 source module algebra.category.Module.adjunctions
! leanprover-community/mathlib commit 6e492fdbed778ea815798a5a0c6cb83df8486265
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Module.Monoidal
import Mathbin.CategoryTheory.Monoidal.Functorial
import Mathbin.CategoryTheory.Monoidal.Types
import Mathbin.LinearAlgebra.DirectSum.Finsupp
import Mathbin.CategoryTheory.Linear.LinearFunctor

/-!
The functor of forming finitely supported functions on a type with values in a `[ring R]`
is the left adjoint of
the forgetful functor from `R`-modules to types.
-/

noncomputable section

open CategoryTheory

namespace ModuleCat

universe u

open Classical

variable (R : Type u)

section

variable [Ring R]

/-- The free functor `Type u ⥤ Module R` sending a type `X` to the
free `R`-module with generators `x : X`, implemented as the type `X →₀ R`.
-/
@[simps]
def free : Type u ⥤ ModuleCat R
    where
  obj X := ModuleCat.of R (X →₀ R)
  map X Y f := Finsupp.lmapDomain _ _ f
  map_id' := by
    intros
    exact Finsupp.lmapDomain_id _ _
  map_comp' := by
    intros
    exact Finsupp.lmapDomain_comp _ _ _ _
#align Module.free ModuleCat.free

/-- The free-forgetful adjunction for R-modules.
-/
def adj : free R ⊣ forget (ModuleCat.{u} R) :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun X M => (Finsupp.lift M R X).toEquiv.symm
      homEquiv_naturality_left_symm := fun _ _ M f g =>
        Finsupp.lhom_ext' fun x =>
          LinearMap.ext_ring
            (Finsupp.sum_mapDomain_index_addMonoidHom fun y => (smulAddHom R M).flip (g y)).symm }
#align Module.adj ModuleCat.adj

instance : IsRightAdjoint (forget (ModuleCat.{u} R)) :=
  ⟨_, adj R⟩

end

namespace Free

variable [CommRing R]

attribute [local ext] TensorProduct.ext

/-- (Implementation detail) The unitor for `free R`. -/
def ε : 𝟙_ (ModuleCat.{u} R) ⟶ (free R).obj (𝟙_ (Type u)) :=
  Finsupp.lsingle PUnit.unit
#align Module.free.ε ModuleCat.free.ε

@[simp]
theorem ε_apply (r : R) : ε R r = Finsupp.single PUnit.unit r :=
  rfl
#align Module.free.ε_apply ModuleCat.free.ε_apply

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- (Implementation detail) The tensorator for `free R`. -/
def μ (α β : Type u) : (free R).obj α ⊗ (free R).obj β ≅ (free R).obj (α ⊗ β) :=
  (finsuppTensorFinsupp' R α β).toModuleIso
#align Module.free.μ ModuleCat.free.μ

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem μ_natural {X Y X' Y' : Type u} (f : X ⟶ Y) (g : X' ⟶ Y') :
    ((free R).map f ⊗ (free R).map g) ≫ (μ R Y Y').Hom = (μ R X X').Hom ≫ (free R).map (f ⊗ g) :=
  by
  intros
  ext (x x'⟨y, y'⟩)
  dsimp [μ]
  simp_rw [Finsupp.mapDomain_single, finsuppTensorFinsupp'_single_tmul_single, mul_one,
    Finsupp.mapDomain_single, CategoryTheory.tensor_apply]
#align Module.free.μ_natural ModuleCat.free.μ_natural

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem left_unitality (X : Type u) :
    (λ_ ((free R).obj X)).Hom =
      (ε R ⊗ 𝟙 ((free R).obj X)) ≫ (μ R (𝟙_ (Type u)) X).Hom ≫ map (free R).obj (λ_ X).Hom :=
  by
  intros
  ext
  dsimp [ε, μ]
  simp_rw [finsuppTensorFinsupp'_single_tmul_single,
    ModuleCat.monoidalCategory.leftUnitor_hom_apply, Finsupp.smul_single', mul_one,
    Finsupp.mapDomain_single, CategoryTheory.leftUnitor_hom_apply]
#align Module.free.left_unitality ModuleCat.free.left_unitality

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem right_unitality (X : Type u) :
    (ρ_ ((free R).obj X)).Hom =
      (𝟙 ((free R).obj X) ⊗ ε R) ≫ (μ R X (𝟙_ (Type u))).Hom ≫ map (free R).obj (ρ_ X).Hom :=
  by
  intros
  ext
  dsimp [ε, μ]
  simp_rw [finsuppTensorFinsupp'_single_tmul_single,
    ModuleCat.monoidalCategory.rightUnitor_hom_apply, Finsupp.smul_single', mul_one,
    Finsupp.mapDomain_single, CategoryTheory.rightUnitor_hom_apply]
#align Module.free.right_unitality ModuleCat.free.right_unitality

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem associativity (X Y Z : Type u) :
    ((μ R X Y).Hom ⊗ 𝟙 ((free R).obj Z)) ≫ (μ R (X ⊗ Y) Z).Hom ≫ map (free R).obj (α_ X Y Z).Hom =
      (α_ ((free R).obj X) ((free R).obj Y) ((free R).obj Z)).Hom ≫
        (𝟙 ((free R).obj X) ⊗ (μ R Y Z).Hom) ≫ (μ R X (Y ⊗ Z)).Hom :=
  by
  intros
  ext
  dsimp [μ]
  simp_rw [finsuppTensorFinsupp'_single_tmul_single, Finsupp.mapDomain_single, mul_one,
    CategoryTheory.associator_hom_apply]
#align Module.free.associativity ModuleCat.free.associativity

-- In fact, it's strong monoidal, but we don't yet have a typeclass for that.
/-- The free R-module functor is lax monoidal. -/
@[simps]
instance : LaxMonoidal.{u} (free R).obj
    where
  -- Send `R` to `punit →₀ R`
  ε := ε R
  -- Send `(α →₀ R) ⊗ (β →₀ R)` to `α × β →₀ R`
  μ X Y := (μ R X Y).Hom
  μ_natural' X Y X' Y' f g := μ_natural R f g
  left_unitality' := left_unitality R
  right_unitality' := right_unitality R
  associativity' := associativity R

instance : IsIso (LaxMonoidal.ε (free R).obj) :=
  ⟨⟨Finsupp.lapply PUnit.unit,
      ⟨by
        ext
        simp, by
        ext (⟨⟩⟨⟩)
        simp⟩⟩⟩

end Free

variable [CommRing R]

/-- The free functor `Type u ⥤ Module R`, as a monoidal functor. -/
def monoidalFree : MonoidalFunctor (Type u) (ModuleCat.{u} R) :=
  {
    LaxMonoidalFunctor.of
      (free R).obj with
    ε_isIso := by
      dsimp
      infer_instance
    μ_isIso := fun X Y => by
      dsimp
      infer_instance }
#align Module.monoidal_free ModuleCat.monoidalFree

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example (X Y : Type u) : (free R).obj (X × Y) ≅ (free R).obj X ⊗ (free R).obj Y :=
  ((monoidalFree R).μIso X Y).symm

end ModuleCat

namespace CategoryTheory

universe v u

/-- `Free R C` is a type synonym for `C`, which, given `[comm_ring R]` and `[category C]`,
we will equip with a category structure where the morphisms are formal `R`-linear combinations
of the morphisms in `C`.
-/
@[nolint unused_arguments has_nonempty_instance]
def Free (R : Type _) (C : Type u) :=
  C
#align category_theory.Free CategoryTheory.Free

/-- Consider an object of `C` as an object of the `R`-linear completion.

It may be preferable to use `(Free.embedding R C).obj X` instead;
this functor can also be used to lift morphisms.
-/
def Free.of (R : Type _) {C : Type u} (X : C) : Free R C :=
  X
#align category_theory.Free.of CategoryTheory.Free.of

variable (R : Type _) [CommRing R] (C : Type u) [Category.{v} C]

open Finsupp

-- Conceptually, it would be nice to construct this via "transport of enrichment",
-- using the fact that `Module.free R : Type ⥤ Module R` and `Module.forget` are both lax monoidal.
-- This still seems difficult, so we just do it by hand.
instance categoryFree : Category (Free R C)
    where
  Hom := fun X Y : C => (X ⟶ Y) →₀ R
  id := fun X : C => Finsupp.single (𝟙 X) 1
  comp (X Y Z : C) f g := f.Sum fun f' s => g.Sum fun g' t => Finsupp.single (f' ≫ g') (s * t)
  assoc' W X Y Z f g h := by
    dsimp
    -- This imitates the proof of associativity for `monoid_algebra`.
    simp only [sum_sum_index, sum_single_index, single_zero, single_add, eq_self_iff_true,
      forall_true_iff, forall₃_true_iff, add_mul, mul_add, category.assoc, mul_assoc,
      MulZeroClass.zero_mul, MulZeroClass.mul_zero, sum_zero, sum_add]
#align category_theory.category_Free CategoryTheory.categoryFree

namespace Free

section

attribute [local reducible] CategoryTheory.categoryFree

instance : Preadditive (Free R C)
    where
  homGroup X Y := Finsupp.addCommGroup
  add_comp X Y Z f f' g := by
    dsimp
    rw [Finsupp.sum_add_index'] <;> · simp [add_mul]
  comp_add X Y Z f g g' := by
    dsimp
    rw [← Finsupp.sum_add]
    congr ; ext (r h)
    rw [Finsupp.sum_add_index'] <;> · simp [mul_add]

instance : Linear R (Free R C)
    where
  homModule X Y := Finsupp.module (X ⟶ Y) R
  smul_comp' X Y Z r f g := by
    dsimp
    rw [Finsupp.sum_smul_index] <;> simp [Finsupp.smul_sum, mul_assoc]
  comp_smul' X Y Z f r g := by
    dsimp
    simp_rw [Finsupp.smul_sum]
    congr ; ext (h s)
    rw [Finsupp.sum_smul_index] <;> simp [Finsupp.smul_sum, mul_left_comm]

theorem single_comp_single {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (r s : R) :
    (single f r ≫ single g s : Free.of R X ⟶ Free.of R Z) = single (f ≫ g) (r * s) :=
  by
  dsimp
  simp
#align category_theory.Free.single_comp_single CategoryTheory.Free.single_comp_single

end

attribute [local simp] single_comp_single

/-- A category embeds into its `R`-linear completion.
-/
@[simps]
def embedding : C ⥤ Free R C where
  obj X := X
  map X Y f := Finsupp.single f 1
  map_id' X := rfl
  map_comp' X Y Z f g := by simp
#align category_theory.Free.embedding CategoryTheory.Free.embedding

variable (R) {C} {D : Type u} [Category.{v} D] [Preadditive D] [Linear R D]

open Preadditive Linear

/-- A functor to an `R`-linear category lifts to a functor from its `R`-linear completion.
-/
@[simps]
def lift (F : C ⥤ D) : Free R C ⥤ D where
  obj X := F.obj X
  map X Y f := f.Sum fun f' r => r • F.map f'
  map_id' := by
    dsimp [CategoryTheory.categoryFree]
    simp
  map_comp' X Y Z f g := by
    apply Finsupp.induction_linear f
    · simp only [limits.zero_comp, sum_zero_index]
    · intro f₁ f₂ w₁ w₂
      rw [add_comp]
      rw [Finsupp.sum_add_index', Finsupp.sum_add_index']
      · simp only [w₁, w₂, add_comp]
      · intros
        rw [zero_smul]
      · intros
        simp only [add_smul]
      · intros
        rw [zero_smul]
      · intros
        simp only [add_smul]
    · intro f' r
      apply Finsupp.induction_linear g
      · simp only [limits.comp_zero, sum_zero_index]
      · intro f₁ f₂ w₁ w₂
        rw [comp_add]
        rw [Finsupp.sum_add_index', Finsupp.sum_add_index']
        · simp only [w₁, w₂, comp_add]
        · intros
          rw [zero_smul]
        · intros
          simp only [add_smul]
        · intros
          rw [zero_smul]
        · intros
          simp only [add_smul]
      · intro g' s
        erw [single_comp_single]
        simp [mul_comm r s, mul_smul]
#align category_theory.Free.lift CategoryTheory.Free.lift

@[simp]
theorem lift_map_single (F : C ⥤ D) {X Y : C} (f : X ⟶ Y) (r : R) :
    (lift R F).map (single f r) = r • F.map f := by simp
#align category_theory.Free.lift_map_single CategoryTheory.Free.lift_map_single

instance lift_additive (F : C ⥤ D) : (lift R F).Additive
    where map_add' X Y f g := by
    dsimp
    rw [Finsupp.sum_add_index'] <;> simp [add_smul]
#align category_theory.Free.lift_additive CategoryTheory.Free.lift_additive

instance lift_linear (F : C ⥤ D) : (lift R F).Linear R
    where map_smul' X Y f r := by
    dsimp
    rw [Finsupp.sum_smul_index] <;> simp [Finsupp.smul_sum, mul_smul]
#align category_theory.Free.lift_linear CategoryTheory.Free.lift_linear

/-- The embedding into the `R`-linear completion, followed by the lift,
is isomorphic to the original functor.
-/
def embeddingLiftIso (F : C ⥤ D) : embedding R C ⋙ lift R F ≅ F :=
  NatIso.ofComponents (fun X => Iso.refl _) (by tidy)
#align category_theory.Free.embedding_lift_iso CategoryTheory.Free.embeddingLiftIso

/-- Two `R`-linear functors out of the `R`-linear completion are isomorphic iff their
compositions with the embedding functor are isomorphic.
-/
@[ext]
def ext {F G : Free R C ⥤ D} [F.Additive] [F.Linear R] [G.Additive] [G.Linear R]
    (α : embedding R C ⋙ F ≅ embedding R C ⋙ G) : F ≅ G :=
  NatIso.ofComponents (fun X => α.app X)
    (by
      intro X Y f
      apply Finsupp.induction_linear f
      · simp
      · intro f₁ f₂ w₁ w₂
        simp only [F.map_add, G.map_add, add_comp, comp_add, w₁, w₂]
      · intro f' r
        rw [iso.app_hom, iso.app_hom, ← smul_single_one, F.map_smul, G.map_smul, smul_comp,
          comp_smul]
        change r • (Embedding R C ⋙ F).map f' ≫ _ = r • _ ≫ (Embedding R C ⋙ G).map f'
        rw [α.hom.naturality f']
        infer_instance
        -- Why are these not picked up automatically when we rewrite?
        infer_instance)
#align category_theory.Free.ext CategoryTheory.Free.ext

/-- `Free.lift` is unique amongst `R`-linear functors `Free R C ⥤ D`
which compose with `embedding ℤ C` to give the original functor.
-/
def liftUnique (F : C ⥤ D) (L : Free R C ⥤ D) [L.Additive] [L.Linear R]
    (α : embedding R C ⋙ L ≅ F) : L ≅ lift R F :=
  ext R (α.trans (embeddingLiftIso R F).symm)
#align category_theory.Free.lift_unique CategoryTheory.Free.liftUnique

end Free

end CategoryTheory


@[simp]
def Periodic_with_period (f: Nat → Nat) (p: Nat): Prop := p > 0 ∧ ∀n, f (n + p) = f n
@[simp]
def Periodic (f: Nat → Nat) : Prop := ∃p, Periodic_with_period f p
@[simp]
def QuasiPeriodic_with_period (f: Nat → Nat) (p: Nat): Prop := ∃n0, ∀n, n ≥ n0 → f (n + p) = f n
@[simp]
def QuasiPeriodic (f: Nat → Nat) : Prop := ∃p, QuasiPeriodic_with_period f p

theorem mod_mod_eq_mod : ∀n m: Nat, n % m % m = n % m := by {
  intro n m;
  cases m;
  simp [Nat.mod_zero];
  case succ m => {
    have := Nat.mod_lt n (Nat.succ_pos m);
    simp [Nat.mod_eq_of_lt this];
  };
}

theorem add_mod_eq_mod : ∀n m: Nat, (n + m) % m = n % m := by {
  intro n m;
  have h1 := Nat.mod_eq (n + m) m;
  induction m;
  simp;
  simp [Nat.zero_lt_succ, Nat.le_add_left, Nat.add_sub_cancel] at h1;
  assumption;
}

theorem mul_mod_eq_zero : ∀n m: Nat, (n * m) % m = 0 := by {
  intro n m;
  induction n;
  simp;
  simp [Nat.succ_mul, add_mod_eq_mod];
  assumption;
}

theorem add_left_mod : ∀m n k: Nat, (k + m) % n = (k + m % n) % n := by {
  intro m n;
  induction m, n using Nat.mod.inductionOn with
  | ind x y ih1 ih2 => {
    intro k;
    rw [Nat.mod_eq x y];
    simp [ih1, ←ih2];
    rw [Nat.mod_eq];
    simp [ih1];
    have h1 := Nat.add_le_add  (Nat.zero_le k) (ih1.right);
    simp at h1;
    simp [h1, Nat.add_sub_assoc ih1.right];
  }
  | base x y h1 => {
    simp [Nat.mod_eq x y, h1];
  }
}

theorem add_right_mod : ∀m n k: Nat, (m + k) % n = (m % n + k) % n := by {
  intro m n;
  induction m, n using Nat.mod.inductionOn with
  | ind x y ih1 ih2 => {
    intro k;
    rw [Nat.mod_eq x y];
    simp [ih1, ←(ih2 k)];
    generalize h2 : x - y = z;
    have := Nat.eq_add_of_sub_eq ih1.right h2;
    rw [this, Nat.add_assoc, Nat.add_comm y, ←Nat.add_assoc, add_mod_eq_mod];
  }
  | base x y h1 => {
    simp [Nat.mod_eq x y, h1];
  }
}

theorem add_mod : ∀l m n: Nat, (l + m) % n = (l % n + m % n) % n := by {
  intro l m n;
  have h1 := add_left_mod m n (l % n);
  rw [←h1];
  exact add_right_mod l n m;
}

theorem mul_left_mod : ∀m n k: Nat, (k * m) % n = (k * (m % n)) % n := by {
  intro m n;
  induction m, n using Nat.mod.inductionOn with
  | ind x y ih1 ih2 => {
    rw [Nat.mod_eq];
    simp [*];
    intro k;
    rw [←ih2, Nat.mul_sub_left_distrib];
    induction k;
    simp;
    case succ k ih => {
      rw [Nat.succ_mul k x, Nat.succ_mul k y];
      rw [←Nat.sub_sub, Nat.add_comm, Nat.add_sub_assoc (Nat.mul_le_mul_left k ih1.right)];
      rw [Nat.add_comm x (k * x - _), Nat.add_sub_assoc ih1.right];
      rw [@add_mod _ (x - y), ←ih, ←add_mod, Nat.add_comm];
      rw [Nat.mod_eq];
      have := Nat.add_le_add (Nat.zero_le (k * x)) ih1.right;
      simp_all
      simp [Nat.add_sub_assoc ih1.right];
    };
  }
  | base x y h1 => {
    intro k;
    rw [Nat.mod_eq x y];
    simp [h1];
  }
}

theorem mul_right_mod : ∀m n k: Nat, (m * k) % n = ((m % n) * k) % n := by {
  intro m n;
  induction m, n using Nat.mod.inductionOn with
  | ind x y ih1 ih2 => {
    rw [Nat.mod_eq];
    simp [*];
    intro k;
    rw [←ih2, Nat.mul_sub_right_distrib];
    induction k;
    simp;
    case succ k ih => {
      rw [Nat.mul_comm, Nat.succ_mul k x, Nat.mul_comm y, Nat.succ_mul k y];
      rw [←Nat.sub_sub, Nat.add_comm, Nat.add_sub_assoc (Nat.mul_le_mul_left k ih1.right)];
      rw [Nat.add_comm x (k * x - _), Nat.add_sub_assoc ih1.right];
      rw [Nat.mul_comm k x, Nat.mul_comm k y];
      rw [add_mod _ (x - y), ←ih, ←add_mod, Nat.add_comm];
      rw [Nat.mod_eq];
      have := Nat.add_le_add (Nat.zero_le (x * k)) ih1.right;
      simp_all
      simp [Nat.add_sub_assoc ih1.right];
    };
  }
  | base x y h1 => {
    intro k;
    rw [Nat.mod_eq x y];
    simp [h1];
  }
}

theorem mul_mod : ∀l m n: Nat, (l * m) % n = ((l % n) * (m % n)) % n := by {
  intro l m n;
  have h1 := mul_left_mod m n (l % n);
  rw [←h1];
  exact mul_right_mod l n m;
}

theorem lt_of_add_const {m n} : ∀k: Nat, m < n → m < n + k := by {
  intro k h1;
  induction k;
  simp;
  assumption;
  case succ k ih => {
    have := Nat.add_lt_add ih Nat.zero_lt_one;
    assumption;
  };
}

theorem hoge {p q: Prop} : p → ¬(p ∧ q) → ¬q := by {
  intro ph nphqh qh;
  have : p ∧ q := ⟨ph, qh⟩;
  contradiction;
}

theorem odd_mod_even_is_odd : ∀m n, ((2 * m + 1) % (2 * n)) % 2 = 1 := by {
  intro m n;

  induction m, n using Nat.mod.inductionOn with
  | ind x y ih1 ih2 => {
    rw [Nat.mod_eq _ (2 * y)];
    have : 0 < 2 := by simp;
    have h1 := Nat.mul_lt_mul_of_pos_left ih1.left this;
    simp at h1;
    simp [h1];
    have h2 := Nat.mul_le_mul_left 2 ih1.right;
    have h3 := Nat.add_le_add h2 (Nat.zero_le 1);
    simp at h3;
    simp [h3];
    simp [Nat.mul_sub_left_distrib] at ih2;
    rw [Nat.add_comm, Nat.add_sub_assoc h2, Nat.add_comm];
    assumption;
  }
  | base x y h1 => {
    rw [Nat.mod_eq _ (2 * y)];
    cases y;
    simp;
    rw [add_right_mod, Nat.mul_comm, mul_mod_eq_zero];
    simp;
    case succ y => {
      have h2 := hoge (Nat.zero_lt_succ y) h1;
      have h3: ¬2 * Nat.succ y ≤ 2 * x + 1 := by {
        have h4 := Nat.gt_of_not_le h2;
        have h5 := Nat.le_of_lt_succ h4 |> Nat.succ_le_succ;
        have h6 := Nat.mul_le_mul_left 2 h5;
        rw [Nat.mul_comm, Nat.succ_mul, Nat.add_comm, Nat.succ_add] at h6;
        have h7 := Nat.lt_of_succ_le h6;
        rw [Nat.add_comm, Nat.mul_comm x] at h7;
        exact Nat.not_le_of_gt h7;
      };
      simp [h3];
      rw [add_right_mod, Nat.mul_comm, mul_mod_eq_zero];
      simp;
    };
  }
}

theorem mod_eq_zero_of_add_mod : ∀{m n k}, (k + m) % n = m % n → k % n = 0 := by {
  intro m n k h1;
  rw [add_mod] at h1;
  induction k, n using Nat.mod.inductionOn with
  | ind x y ih1 ih2 => {
    rw [Nat.mod_eq];
    simp [ih1];
    rw [Nat.mod_eq x y] at h1;
    simp [ih1] at h1;
    specialize ih2 h1;
    assumption;
  }
  | base x y h2 => {
    rw [Nat.mod_eq];
    simp [h2];
    rw [Nat.mod_eq x y] at h1;
    simp [h2] at h1;
    rw [←add_left_mod m y x] at h1;
    induction m, y using Nat.mod.inductionOn with
    | ind x1 y1 ih1 ih2 => {
      rw [Nat.mod_eq] at h1;
      have := Nat.add_le_add (Nat.zero_le x) ih1.right;
      simp at this;
      simp [ih1, this, Nat.add_sub_assoc, Nat.mod_eq x1 y1] at h1;
      specialize ih2 h2 h1;
      assumption;
    }
    | base x1 y1 h3 => {
      simp [Nat.mod_eq x1 y1, h3] at h1;
      cases y1;
      simp [Nat.mod_zero] at h1;
      apply Nat.add_right_cancel;
      case m => {exact x1};
      simp;
      assumption;
      case succ n => {
        have h4 := Nat.zero_lt_succ n;
        have h5 := hoge h4 h2 |> Nat.gt_of_not_le;
        have h6 := hoge h4 h3 |> Nat.gt_of_not_le;
        cases x;
        simp;
        case succ x => {
          simp_all;
          rw [Nat.mod_eq] at h1;
          simp [h4] at h1;
          by_cases h8: Nat.succ n ≤ Nat.succ x + x1;
          simp [h8] at h1;
          rw [Nat.mod_eq] at h1;
          simp [h4] at h1;
          have : ¬Nat.succ n ≤ Nat.succ x + x1 - Nat.succ n := by {
            intro nh;
            have h9 := Nat.le_of_lt_succ h6;
            have h10 := Nat.le_of_lt_succ h5;
            have h11 := Nat.add_le_add h9 h10;
            have h12 := Nat.add_le_of_le_sub h8 nh;
            rw [Nat.add_comm] at h11;
            have h13 := Nat.le_trans (Nat.le_trans h12 h11) (Nat.le_succ (n + n));
            simp [Nat.succ_add, Nat.add_comm n] at h13;
            have h14 := Nat.not_succ_le_self (Nat.succ (n + n));
            contradiction;
          };
          simp [this] at h1;
          have := congrArg (λx => Nat.succ n + x) h1;
          simp [←Nat.add_sub_assoc h8, Nat.add_sub_cancel_left] at this;
          have h9 := Nat.add_right_cancel this;
          simp at h9;
          have h10 := Nat.lt_of_succ_lt_succ h5;
          rw [h9] at h10;
          have := Nat.lt_irrefl n;
          contradiction;
          simp [*] at h1;
          conv at h1 => {
            rhs
            rw [←Nat.zero_add x1]
          };
          have h11 := Nat.add_right_cancel h1;
          simp at h11;
        };
      };
    }
  }
}

def f1 n := n % 3
theorem t1 : Periodic f1 := by {
  rw [Periodic];
  exists 3;
  simp [f1, add_mod_eq_mod];
}

def f2
| 0 => 4
| n + 1 => (3 * f2 n) % 7

theorem t2 : Periodic f2 := by {
  simp;
  exists 6;
  simp;
  intro n;
  simp [f2];
  rw [←mul_left_mod (3 * f2 n) 7 3];
  rw [←mul_left_mod (3 * (3 * f2 n)) 7 3];
  rw [←mul_left_mod (3 * (3 * (3 * f2 n))) 7 3];
  rw [←mul_left_mod (3 * (3 * (3 * (3 * f2 n)))) 7 3];
  rw [←mul_left_mod (3 * (3 * (3 * (3 * (3 * f2 n))))) 7 3];
  rw [←Nat.mul_assoc];
  rw [←Nat.mul_assoc];
  rw [←Nat.mul_assoc];
  rw [←Nat.mul_assoc];
  rw [←Nat.mul_assoc];
  have : 3 * 3 * 3 * 3 * 3 * 3 = 729 := rfl;
  rw [this, mul_mod];
  have : 729 % 7 = 1 := rfl;
  simp [this, mod_mod_eq_mod];
  cases n;
  simp;
  simp [f2, mod_mod_eq_mod];
}

theorem t3 : ∀l m n, let f := (λx: Nat => (x * (4 * l + 1) + (2 * m + 1)) % (2^n)); Periodic_with_period f (2^n) ∧ ∀ M, M < (2^n) → ¬Periodic_with_period f M := by {
  intro l m n;
  simp;
  generalize hM : 2 ^ n = M;
  generalize ha : 4 * l = A;
  generalize hc : 2 * m + 1 = c;

  have hoge: ∀n: Nat, 2 ^ n > 0 := by {
    intro n;
    induction n;
    simp;
    case succ n ih => {
      have := Nat.mul_lt_mul_of_pos_right ih (Nat.zero_lt_succ 1);
      simp at this;
      simp[Nat.pow_succ, this];
    };
  };

  apply And.intro;
  case left => {
    cases M;
    simp;
    specialize hoge n;
    simp [hM] at hoge;
    simp [Nat.zero_lt_succ];
    intro x;
    rw [Nat.add_mul, Nat.add_assoc, Nat.add_comm _ c, ←Nat.add_assoc, Nat.mul_comm (Nat.succ _), add_mod, mul_mod_eq_zero];
    simp [mod_mod_eq_mod];
  };
  case right => {
    intro M0 h1 ⟨h2l, h2r⟩;
    have h3 := h2r 0;
    simp at h3;
    rw [←ha, ←hc, ←hM] at h3;
    cases n;
    simp [Nat.pow_zero, Nat.mod_one] at h3;
    simp [Nat.pow_zero] at hM;
    rw [←hM] at h1;
    have a := Nat.le_of_lt_succ h1;
    simp [Nat.le_zero_eq M0] at a;
    rw [a] at h2l;
    contradiction;
    case succ n => {
      simp [Nat.pow_succ] at h3;
      have h4 := odd_mod_even_is_odd m (2 ^ n);
      rw [add_mod] at h3;
      conv at h3 => {
        rhs;
        rw [←mod_mod_eq_mod];
      };
      have h5 := mod_eq_zero_of_add_mod h3;
      rw [mod_mod_eq_mod] at h5;
     };
  };
}


/-
Copyright (c) 2020. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import tactic.ring
import tactic.doc_commands

/-!
# `group`

Normalizes expressions in the language of groups. The basic idea is to use the simplifier
to put everything into a product of group powers (`zpow` which takes a group element and an
integer), then simplify the exponents using the `ring` tactic. The process needs to be repeated
since `ring` can normalize an exponent to zero, leading to a factor that can be removed
before collecting exponents again. The simplifier step also uses some extra lemmas to avoid
some `ring` invocations.

## Tags

group_theory
-/

-- The next four lemmas are not general purpose lemmas, they are intended for use only by
-- the `group` tactic.

@[to_additive]
lemma tactic.group.zpow_trick {G : Type*} [group G] (a b : G) (n m : ℤ) : a*b^n*b^m = a*b^(n+m) :=
by rw [mul_assoc, ← zpow_add]

@[to_additive]
lemma tactic.group.zpow_trick_one {G : Type*} [group G] (a b : G) (m : ℤ) : a*b*b^m = a*b^(m+1) :=
by rw [mul_assoc, mul_self_zpow]

@[to_additive]
lemma tactic.group.zpow_trick_one' {G : Type*} [group G] (a b : G) (n : ℤ) : a*b^n*b = a*b^(n+1) :=
by rw [mul_assoc, mul_zpow_self]

@[to_additive]
lemma tactic.group.zpow_trick_sub {G : Type*} [group G] (a b : G) (n m : ℤ) :
  a*b^n*b^(-m) = a*b^(n-m) :=
by rw [mul_assoc, ← zpow_add] ; refl

namespace tactic

setup_tactic_parser

open tactic.simp_arg_type interactive tactic.group

/-- Auxiliary tactic for the `group` tactic. Calls the simplifier only. -/
meta def aux_group₁ (locat : loc) : tactic unit :=
  simp_core {} skip tt [
  expr ``(commutator_element_def),
  expr ``(mul_one),
  expr ``(one_mul),
  expr ``(one_pow),
  expr ``(one_zpow),
  expr ``(sub_self),
  expr ``(add_neg_self),
  expr ``(neg_add_self),
  expr ``(neg_neg),
  expr ``(tsub_self),
  expr ``(int.coe_nat_add),
  expr ``(int.coe_nat_mul),
  expr ``(int.coe_nat_zero),
  expr ``(int.coe_nat_one),
  expr ``(int.coe_nat_bit0),
  expr ``(int.coe_nat_bit1),
  expr ``(int.mul_neg_eq_neg_mul_symm),
  expr ``(int.neg_mul_eq_neg_mul_symm),
  symm_expr ``(zpow_coe_nat),
  symm_expr ``(zpow_neg_one),
  symm_expr ``(zpow_mul),
  symm_expr ``(zpow_add_one),
  symm_expr ``(zpow_one_add),
  symm_expr ``(zpow_add),
  expr ``(mul_zpow_neg_one),
  expr ``(zpow_zero),
  expr ``(mul_zpow),
  symm_expr ``(mul_assoc),
  expr ``(zpow_trick),
  expr ``(zpow_trick_one),
  expr ``(zpow_trick_one'),
  expr ``(zpow_trick_sub),
  expr ``(tactic.ring.horner)]
  [] locat >> skip

/-- Auxiliary tactic for the `group` tactic. Calls `ring_nf` to normalize exponents. -/
meta def aux_group₂ (locat : loc) : tactic unit :=
ring_nf none tactic.ring.normalize_mode.raw locat
end tactic

namespace tactic.interactive
setup_tactic_parser
open tactic

/--
Tactic for normalizing expressions in multiplicative groups, without assuming
commutativity, using only the group axioms without any information about which group
is manipulated.

(For additive commutative groups, use the `abel` tactic instead.)

Example:
```lean
example {G : Type} [group G] (a b c d : G) (h : c = (a*b^2)*((b*b)⁻¹*a⁻¹)*d) : a*c*d⁻¹ = a :=
begin
  group at h, -- normalizes `h` which becomes `h : c = d`
  rw h,       -- the goal is now `a*d*d⁻¹ = a`
  group,      -- which then normalized and closed
end
```
-/
meta def group (locat : parse location) : tactic unit :=
do when locat.include_goal `[rw ← mul_inv_eq_one],
   try (aux_group₁ locat),
   repeat (aux_group₂ locat ; aux_group₁ locat)

end tactic.interactive

add_tactic_doc
{ name := "group",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.group],
  tags := ["decision procedure", "simplification"] }


import number_theory.class_number_bound
import number_theory.ideal_inert
import number_theory.legendre_symbol.norm_num

namespace quad_ring

open_locale quad_ring

local attribute [instance] fact_not_square'_of_eq_two_or_three_mod_four

open number_field

section one_calc

lemma neg_one_mod_four : fact $ (-1 : ℤ) % 4 = 3 := ⟨by norm_num⟩
lemma squarefree_neg_one : fact $ squarefree (-1 : ℤ) :=
⟨by norm_num [int.squarefree_iff_squarefree_nat_abs]⟩

local attribute [instance] neg_one_mod_four squarefree_neg_one

lemma sqrt_2_neg_one : (sqrt_2 (-1) : ideal (quad_ring ℤ 0 (-1))) = ideal.span {⟨1, 1⟩} :=
begin
  rw [sqrt_2, if_neg, subtype.coe_mk, set.pair_comm, ideal.span_insert_eq_span],
  { refine ideal.mem_span_singleton'.mpr ⟨⟨1, -1⟩, _⟩,
    calc_tac },
  norm_num
end

lemma card_class_group_one : fintype.card (class_group ℤ[√-1]) = 1 :=
begin
  rw [← finset.card_univ, univ_eq, finset.card_insert_of_mem, finset.card_singleton],
  { rw [finset.mem_singleton, eq_comm, class_group.sqrt_2, sqrt_2],
    exact (class_group.mk0_eq_one_iff _).mpr ⟨⟨_, sqrt_2_neg_one⟩⟩ },
  { norm_num },
  { norm_num }
end

lemma class_number_eq_one : class_number (quad_ring ℚ 0 (-1)) = 1 :=
by rw [class_number_eq (quad_ring ℤ 0 (-1)) (quad_ring ℚ 0 (-1)), card_class_group_one]

end one_calc

section two_calc

lemma neg_two_mod_four : fact $ (-2 : ℤ) % 4 = 2 := ⟨by norm_num⟩
lemma squarefree_neg_two : fact $ squarefree (-2 : ℤ) :=
⟨by norm_num [int.squarefree_iff_squarefree_nat_abs]⟩

local attribute [instance] neg_two_mod_four squarefree_neg_two

lemma sqrt_2_neg_two : (sqrt_2 (-2) : ideal (quad_ring ℤ 0 (-2))) = ideal.span {⟨0, 1⟩} :=
begin
  rw [sqrt_2, if_pos, subtype.coe_mk, set.pair_comm, ideal.span_insert_eq_span],
  { refine ideal.mem_span_singleton'.mpr ⟨⟨0, -1⟩, _⟩,
    calc_tac },
  norm_num
end

lemma card_class_group_two : fintype.card (class_group ℤ[√-2]) = 1 :=
begin
  rw [← finset.card_univ, univ_eq, finset.card_insert_of_mem, finset.card_singleton],
  { rw [finset.mem_singleton, eq_comm, class_group.sqrt_2, sqrt_2],
    exact (class_group.mk0_eq_one_iff _).mpr ⟨⟨_, sqrt_2_neg_two⟩⟩ },
  { norm_num },
  { norm_num }
end

lemma class_number_eq_two : class_number (quad_ring ℚ 0 (-2)) = 1 :=
by rw [class_number_eq (quad_ring ℤ 0 (-2)) (quad_ring ℚ 0 (-2)), card_class_group_two]

end two_calc

section six_calc

lemma neg_six_mod_four : fact $ (-6 : ℤ) % 4 = 2 := ⟨by norm_num⟩
lemma squarefree_neg_six : fact $ squarefree (-6 : ℤ) :=
⟨by norm_num [int.squarefree_iff_squarefree_nat_abs]⟩
local attribute [instance] neg_six_mod_four squarefree_neg_six

local attribute [instance] fact_not_square'_of_eq_three_mod_four
lemma card_class_group_six : fintype.card (class_group ℤ[√-6]) = 2 :=
begin
  rw [← finset.card_univ, univ_eq, finset.card_insert_of_not_mem, finset.card_singleton],
  { rw finset.mem_singleton,
    apply_fun order_of,
    rw [order_of_sqrt2, order_of_one],
    repeat { norm_num } },
  { norm_num },
  { norm_num }
end

lemma class_number_eq_six : class_number (quad_ring ℚ 0 (-6)) = 2 :=
by rw [class_number_eq (quad_ring ℤ 0 (-6)) (quad_ring ℚ 0 (-6)), card_class_group_six]

end six_calc

section five_calc

lemma neg_five_mod_four : fact $ (-5 : ℤ) % 4 = 3 := ⟨by norm_num⟩
lemma squarefree_neg_five : fact $ squarefree (-5 : ℤ) :=
⟨by norm_num [int.squarefree_iff_squarefree_nat_abs]⟩
local attribute [instance] neg_five_mod_four squarefree_neg_five

local attribute [instance] fact_not_square'_of_eq_three_mod_four
lemma card_class_group_five : fintype.card (class_group ℤ[√-5]) = 2 :=
begin
  rw [← finset.card_univ, univ_eq, finset.card_insert_of_not_mem, finset.card_singleton],
  { rw finset.mem_singleton,
    apply_fun order_of,
    rw [order_of_sqrt2, order_of_one],
    repeat { norm_num } },
  { norm_num },
  { norm_num }
end

lemma class_number_eq_five : class_number (quad_ring ℚ 0 (-5)) = 2 :=
by rw [class_number_eq (quad_ring ℤ 0 (-5)) (quad_ring ℚ 0 (-5)), card_class_group_five]

end five_calc

section thirteen_calc

lemma neg_thirteen_mod_four : fact $ (-13 : ℤ) % 4 = 3 := ⟨by norm_num⟩
lemma squarefree_neg_thirteen : fact $ squarefree (-13 : ℤ) :=
⟨by norm_num [int.squarefree_iff_squarefree_nat_abs]⟩
local attribute [instance] neg_thirteen_mod_four squarefree_neg_thirteen
-- local attribute [instance] fact_not_square'_of_eq_three_mod_four
local attribute [-instance] algebra''
-- set_option pp.implicit true

-- complete hack to avoid diamonds

def algebra''' (R S : Type*) [comm_ring R] [field S] [algebra R S] (a b : R)
  (a' b' : S) [fact (algebra_map R S a = a')] [fact (algebra_map R S b = b')] :
  algebra (quad_ring R a b) (quad_ring S a' b') :=
((quad_ring.congr (ring_equiv.refl S)
    (show _, from fact.out (algebra_map R S a = a'))
    (show _, from fact.out (algebra_map R S b = b'))).to_ring_hom.comp
  (map (algebra_map R S) a b)).to_algebra

local attribute [instance] algebra'''

open_locale non_zero_divisors

-- theorem zsqrtneg13.exists_q_r (γ : quad_ring ℚ 0 (-13)) :
--   ∃ (q : quad_ring ℤ 0 (-13)) (r ∈ ({1, 2, 3} : finset ℤ)),
--     absolute_value.abs (algebra.norm ℚ (r • γ - algebra_map ℤ[√-13] ℚ(√-13) q)) < 1 :=
-- sorry

/-- Every class in the class group contains an ideal which includes `12`. -/
lemma zsqrtneg13.exists_J
  (I : (ideal (quad_ring ℤ 0 (-13)))⁰) :
  ∃ (J : (ideal (quad_ring ℤ 0 (-13)))⁰),
    class_group.mk0 I = class_group.mk0 J ∧ ((12 : ℤ[√-13]) ∈ (J : ideal (quad_ring ℤ 0 (-13)))) :=
begin
  convert exists_mk0_eq_mk0'' absolute_value.abs I ({1, 2, 3, 4} : finset ℤ) 12 _ _ _,
  { intros m hm,
    fin_cases hm; norm_num, },
  { norm_num, },
  rw exists_lt_norm_iff_exists_le_one ℚ ℚ(√-13) absolute_value.abs (quad_ring.basis ℤ 0 (-13))
    absolute_value.abs _ _,
  { exact quad_ring.exists_q_r_thirteen },
  { intros x, rw [absolute_value.coe_abs, absolute_value.coe_abs, int.cast_abs, eq_int_cast] },
end

/-- Every class in the class group contains an ideal which includes `12`. -/
lemma zsqrtneg13.exists_J'
  (I : class_group (quad_ring ℤ 0 (-13))) :
  ∃ (J : (ideal (quad_ring ℤ 0 (-13)))⁰),
    I = class_group.mk0 J ∧ (12 : ℤ[√-13]) ∈ (J : ideal (quad_ring ℤ 0 (-13))) :=
begin
  obtain ⟨I, rfl⟩ := class_group.mk0_surjective I,
  exact zsqrtneg13.exists_J I,
end

lemma minpoly_int_root_eq {d : ℤ} [fact (¬ is_square d)] :
  minpoly ℤ (root ℤ 0 d) = minpoly_a_add_b_sqrt_d d 0 1 :=
begin
  rcases minpoly_int_eq (root ℤ 0 d) with ⟨x, hx⟩ | h,
  { simpa only [coe_b2, one_ne_zero, and_false, root, quad_ring.ext_iff] using hx, },
  exact h,
end

example : prime (3 : ℤ) := by norm_num [int.prime_iff_nat_abs_prime] -- TODO

@[simp] -- PRed
lemma is_unit_neg_iff_is_unit {α : Type*} [monoid α] [has_distrib_neg α] {a : α} :
  is_unit (-a) ↔ is_unit a :=
by erw [neg_eq_neg_one_mul, units.is_unit_units_mul ⟨(-1 : α), -1, by simp, by simp⟩]

section poly_lemmas -- all PRed
open_locale polynomial
open polynomial

variables {R: Type*} [ring R] (p q : polynomial R)
lemma polynomial.nat_degree_sub_eq_left_of_nat_degree_lt (h : nat_degree q < nat_degree p) :
  nat_degree (p - q) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_sub_eq_left_of_degree_lt (degree_lt_degree h))

lemma polynomial.nat_degree_sub_eq_right_of_nat_degree_lt (h : nat_degree p < nat_degree q) :
  nat_degree (p - q) = nat_degree q :=
nat_degree_eq_of_degree_eq (degree_sub_eq_right_of_degree_lt (degree_lt_degree h))

lemma polynomial.card_roots_le_map_of_injective {A B : Type*} [comm_ring A] [comm_ring B] [is_domain A] [is_domain B]
  {p : A[X]} {f : A →+* B} (hf : function.injective f) :
  p.roots.card ≤ (p.map f).roots.card :=
begin
  by_cases hp0 : p = 0, { simp only [hp0, roots_zero, polynomial.map_zero, multiset.card_zero], },
  exact card_roots_le_map ((polynomial.map_ne_zero_iff hf).mpr hp0),
end
end poly_lemmas

@[simp] -- PRed
lemma nth_roots_two_eq_zero_iff {R : Type*} [comm_ring R] [is_domain R] {x : R} :
  polynomial.nth_roots 2 x = 0 ↔ ¬ is_square x :=
begin
  simp only [polynomial.nth_roots, multiset.eq_zero_iff_forall_not_mem, is_square,
    polynomial.mem_roots (polynomial.X_pow_sub_C_ne_zero (by norm_num: 0 < 2) x),
    sub_eq_zero, polynomial.is_root.def,
    polynomial.eval_sub, polynomial.eval_pow,
    polynomial.eval_X, polynomial.eval_C, not_exists],
  simp [eq_comm, pow_two],
end

lemma irred_span_singleton_of_prime_not_is_square (p d : ℤ) [fact (¬ is_square d)]
  [is_dedekind_domain (quad_ring ℤ 0 d)] [is_integral_closure (quad_ring ℤ 0 d) ℤ (quad_ring ℚ 0 d)]
  (hp : prime p) (hpd : ¬ is_square (d : zmod p.nat_abs)) :
  irreducible (ideal.span ({p} : set (quad_ring ℤ 0 d))) :=
begin
  have : (ideal.span ({p} : set ℤ)).is_maximal,
  { haveI : (ideal.span ({p} : set ℤ)).is_prime,
    { rwa [ideal.span_singleton_prime hp.ne_zero], },
    apply is_prime.to_maximal_ideal,
    simpa using hp.ne_zero, },
  letI : field (ℤ ⧸ ideal.span ({p} : set ℤ)) := @@ideal.quotient.field _ _ this,
  haveI : nontrivial (ℤ ⧸ ideal.span ({p} : set ℤ)),
  { refine ideal.quotient.nontrivial (λ h, _),
    apply hp.not_unit,
    simpa [ideal.span_singleton_eq_top, int.is_unit_iff, hp.ne_one] using h, },
  have := ideal.irreducible_map_of_irreducible_minpoly (quad_ring.power_basis ℤ 0 d) this _ _ _,
  { simpa [ideal.map_span], },
  { simp only [hp.ne_zero, ideal.map_span, eq_int_cast, set.image_singleton, ne.def,
      ideal.span_singleton_eq_bot, coe_eq_zero, not_false_iff], },
  { simp only [power_basis_gen, ne.def],
    exact polynomial.map_monic_ne_zero
      (minpoly.monic (is_integral_closure.is_integral ℤ (quad_ring ℚ 0 d) _)), },
  rw [power_basis_gen, minpoly_int_root_eq, minpoly_a_add_b_sqrt_d],
  simp only [mul_zero, eq_int_cast, int.cast_zero, zero_mul, sub_zero, zero_pow', ne.def,
    bit0_eq_zero, nat.one_ne_zero, not_false_iff, one_pow, mul_one, polynomial.map_add,
    polynomial.map_pow, polynomial.map_X, zero_sub, int.cast_neg,
    polynomial.map_neg, polynomial.map_int_cast],
  have hdge : 2 ≤ (polynomial.X ^ 2 - polynomial.C (↑d) : polynomial (ℤ ⧸ ideal.span ({p} : set ℤ))).nat_degree,
  { rw polynomial.nat_degree_sub_eq_left_of_nat_degree_lt;
    simp only [polynomial.nat_degree_pow, polynomial.nat_degree_X, mul_one,
      polynomial.C_eq_int_cast, polynomial.nat_degree_int_cast, nat.succ_pos'], },
  rw [← polynomial.C_eq_int_cast, ← sub_eq_add_neg],
  rw polynomial.irreducible_iff_roots_empty_of_degree_le_three (by compute_degree_le) hdge,
  rw ← multiset.card_eq_zero,
  apply nat.eq_zero_of_le_zero,
  haveI : fact p.nat_abs.prime := fact.mk (int.prime_iff_nat_abs_prime.mp hp),
  convert polynomial.card_roots_le_map_of_injective
    (int.quotient_span_equiv_zmod p).to_ring_hom.injective,

  simp only [polynomial.map_pow, polynomial.map_X, polynomial.map_sub,
    polynomial.map_int_cast, map_int_cast],
  symmetry,
  change multiset.card (polynomial.nth_roots 2 (d : zmod p.nat_abs)) = 0,
  rw multiset.card_eq_zero,
  simpa,
end

lemma prime.left_dvd_or_dvd_right_iff_dvd_mul {α : Type*} [cancel_comm_monoid_with_zero α] {p : α}
  (hp : prime p) {a b : α} : a ∣ p * b ↔ (p ∣ a ∧ a ∣ p * b) ∨ a ∣ b :=
begin
  split,
  intro h,
  simp only [h, and_true],
  exact hp.left_dvd_or_dvd_right_of_dvd_mul h,
  intro h,
  rcases h with h | h,
  exact h.2,
  exact dvd_mul_of_dvd_right h p,
end

-- TODO clean up this monstrosity
-- TODO see if there is better form that puts less dups in the goal
lemma factors_prime_mul --left_dvd_or_dvd_right_of_dvd_mul
  {α : Type*} [cancel_comm_monoid_with_zero α] {p : α}
  (hp : prime p) {b : α} : {a | a ∣ p * b} = (((*) p) '' {a | a ∣ b}) ∪ {a | a ∣ b} :=
begin
  ext a,
  simp only [set.mem_set_of_eq, set.mem_union, set.mem_image],
  conv_lhs {rw hp.left_dvd_or_dvd_right_iff_dvd_mul, },
  rw dvd_iff_exists_eq_mul_left,
  apply or_congr_left,
  intro h,
  rw ← exists_and_distrib_right,
  rw exists_congr,
  intro c,
  split; intro hh; cases hh with hh₁ hh₂,
  rw hh₁ at *,
  rw mul_comm at ⊢ hh₂,
  simp only [eq_self_iff_true, and_true],
  rwa mul_dvd_mul_iff_left hp.1 at hh₂,
  rw ← hh₂ at *,
  simp only [mul_comm, eq_self_iff_true, true_and],
  rwa mul_dvd_mul_iff_left hp.1,
end

lemma factors_prime --left_dvd_or_dvd_right_of_dvd_mul
  {α : Type*} [cancel_comm_monoid_with_zero α] [unique αˣ] {p : α}
  (hp : prime p) : {a | a ∣ p} = {1, p} :=
begin
  ext a,
  simp only [hp, set.mem_set_of_eq, set.mem_insert_iff, set.mem_singleton_iff],
  rw dvd_iff_exists_eq_mul_left,
  split; intro h,
  { rcases h with ⟨h_w, h⟩,
    have := hp.irreducible.is_unit_or_is_unit h,
    simp only [is_unit_iff_eq_one] at this,
    rcases this with rfl | rfl,
    simp * at *,
    simp, },
  { rcases h with rfl | rfl,
    use p, simp,
    use 1, simp, },
end

@[simp]
lemma class_group.mk0_span_singleton_eq_one {R : Type*} [comm_ring R] [is_domain R]
  [is_dedekind_domain R] {I : R} {h} :
  class_group.mk0 ⟨ideal.span ({I} : set R), h⟩ = 1 :=
(class_group.mk0_eq_one_iff h).mpr ⟨⟨I, rfl⟩⟩

local attribute [irreducible] non_zero_divisors

-- TODO: directly using the proof of two lemmas causes timeouts
lemma mem_of_mul_mem_non_zero_divisors_left {R : Type*} [comm_ring R]
  {I J : ideal R} (h : I * J ∈ (ideal R)⁰) :
  I ∈ (ideal R)⁰ :=
(mul_mem_non_zero_divisors.mp h).1

lemma mem_of_mul_mem_non_zero_divisors_right {R : Type*} [comm_ring R]
  {I J : ideal R} (h : I * J ∈ (ideal R)⁰) :
  J ∈ (ideal R)⁰ :=
(mul_mem_non_zero_divisors.mp h).2

@[simp]
lemma class_group.mk0_mul {R : Type*} [comm_ring R] [is_domain R] [is_dedekind_domain R]
  (I J : ideal R) (h : I * J ∈ (ideal R)⁰) :
  class_group.mk0 ⟨I * J, h⟩ = class_group.mk0 ⟨I, mem_of_mul_mem_non_zero_divisors_left h⟩
                          * class_group.mk0 ⟨J, mem_of_mul_mem_non_zero_divisors_right h⟩ :=
by rw ← map_mul; congr

open_locale classical

/-- the class group of `ℚ(√-13)` consists of at most two elements. -/
theorem thirteen_class_group_eq (I : class_group (quad_ring ℤ 0 (-13))) :
  I ∈ ({1, class_group.sqrt_2 (-13)} : finset (class_group ℤ[√-13])) :=
begin
  simp only [finset.mem_insert, finset.mem_singleton],
  obtain ⟨⟨J, hJ0⟩, rfl, hJ⟩ := zsqrtneg13.exists_J' I,
  have hJ2 : J ∣ ideal.span {12}, -- TODO extract this whole calculation as lemma
  { simpa only [set_like.coe_mk, ideal.dvd_iff_le, ideal.span_singleton_le_iff] using hJ },
  rw show (12 : ℤ[√-13]) = 3 * 2 * 2, by refl at hJ2, -- TODO norm_num fails??! maybe should ext first?
  rw [← ideal.span_singleton_mul_span_singleton, ← ideal.span_singleton_mul_span_singleton,
      ← sqrt_2_pow_two, pow_two, mul_assoc, mul_assoc] at hJ2,
  simp_rw ← set.mem_set_of_eq at hJ2,
  have : J ∈ {I : ideal ℤ[√-13] |
    I ∣ ideal.span ({3} : set ℤ[√-13]) * (sqrt_2 (-13) * (sqrt_2 (-13) * (sqrt_2 (-13) * sqrt_2 (-13))))},
  { rwa set.mem_set_of_eq, },
  have irred_three := irred_span_singleton_of_prime_not_is_square 3 (-13)
    (by norm_num [int.prime_iff_nat_abs_prime]) _,
  { simp only [int.cast_bit1, coe_one] at irred_three,
    -- TODO simplify this with a prime pow version
    simp only [factors_prime_mul (gcd_monoid.prime_of_irreducible irred_three),
      factors_prime_mul (sqrt_2_prime (-13)),
      factors_prime (gcd_monoid.prime_of_irreducible irred_three),
      factors_prime (sqrt_2_prime (-13))] at this,
    simp only [ideal.one_eq_top, set.image_insert, ideal.mul_top, set.image_singleton,
      set.union_insert, set.union_singleton, set.insert_eq_of_mem, set.mem_insert_iff,
      eq_self_iff_true, true_or, set.mem_singleton_iff, or_true] at this,
    have helper : sqrt_2 (-13) * sqrt_2 (-13) = ⟨ideal.span ({2} : set ℤ[√-13]),
      by norm_num [mem_non_zero_divisors_iff_ne_zero]⟩,
    { rw ← pow_two, ext1, push_cast, rw sqrt_2_pow_two (-13), },
    have helper' := subtype.ext_iff.mp helper,
    simp only [submonoid.coe_mul, set_like.coe_mk] at helper',
    rcases this with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl;
    simp only [
      eq_self_iff_true, true_or, or_true, -quotient_group.eq_one_iff,
      class_group.sqrt_2, helper, helper', map_bit0, map_one, mul_one, one_mul,
      set_like.eta, eq_self_iff_true, or_true, ← mul_assoc,
      class_group.mk0_span_singleton_eq_one, class_group.mk0_top] {fail_if_unchanged := ff};
    simp only [set_like.eta, class_group.mk0_mul, mul_one, one_mul, eq_self_iff_true,
      class_group.mk0_span_singleton_eq_one, or_true, true_or] {fail_if_unchanged := ff}, },
  { haveI : fact (nat.prime (int.nat_abs 3)) := ⟨by norm_num⟩,
    rw ← legendre_sym.eq_neg_one_iff,
    norm_num, }
end

-- noncomputable instance thirteen_fintype : fintype (class_group (quad_ring ℤ 0 (-13)) (quad_ring ℚ 0 (-13))) :=
-- class_group.fintype_of_admissible_of_finite ℚ _ absolute_value.abs_is_admissible

lemma thirteen_univ_eq : finset.univ =
  ({1, class_group.sqrt_2 (-13)} : finset (class_group (quad_ring ℤ 0 (-13)))) :=
symm $ eq_top_iff.mpr $ λ I _, thirteen_class_group_eq I

lemma card_class_group_thirteen : fintype.card (class_group ℤ[√-13]) = 2 :=
begin
  rw [← finset.card_univ, thirteen_univ_eq, finset.card_insert_of_not_mem, finset.card_singleton],
  { rw finset.mem_singleton,
    apply_fun order_of,
    rw [order_of_sqrt2, order_of_one],
    repeat { norm_num } },
end

lemma class_number_eq_thirteen : class_number (quad_ring ℚ 0 (-13)) = 2 :=
by rw [class_number_eq (quad_ring ℤ 0 (-13)) (quad_ring ℚ 0 (-13)), card_class_group_thirteen]

end thirteen_calc

end quad_ring


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.finset.lattice
import data.multiset.powerset

/-!
# The powerset of a finset

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

namespace finset
open function multiset

variables {α : Type*} {s t : finset α}

/-! ### powerset -/
section powerset

/-- When `s` is a finset, `s.powerset` is the finset of all subsets of `s` (seen as finsets). -/
def powerset (s : finset α) : finset (finset α) :=
⟨s.1.powerset.pmap finset.mk $ λ t h, nodup_of_le (mem_powerset.1 h) s.nodup,
 s.nodup.powerset.pmap $ λ a ha b hb, congr_arg finset.val⟩

@[simp] theorem mem_powerset {s t : finset α} : s ∈ powerset t ↔ s ⊆ t :=
by cases s; simp only [powerset, mem_mk, mem_pmap, mem_powerset, exists_prop, exists_eq_right];
  rw ← val_le_iff

@[simp, norm_cast] lemma coe_powerset (s : finset α) :
  (s.powerset : set (finset α)) = coe ⁻¹' (s : set α).powerset :=
by { ext, simp }

@[simp] theorem empty_mem_powerset (s : finset α) : ∅ ∈ powerset s :=
mem_powerset.2 (empty_subset _)

@[simp] lemma mem_powerset_self (s : finset α) : s ∈ powerset s := mem_powerset.2 subset.rfl

lemma powerset_nonempty (s : finset α) : s.powerset.nonempty := ⟨∅, empty_mem_powerset _⟩

@[simp] theorem powerset_mono {s t : finset α} : powerset s ⊆ powerset t ↔ s ⊆ t :=
⟨λ h, (mem_powerset.1 $ h $ mem_powerset_self _),
 λ st u h, mem_powerset.2 $ subset.trans (mem_powerset.1 h) st⟩

lemma powerset_injective : injective (powerset : finset α → finset (finset α)) :=
injective_of_le_imp_le _ $ λ s t, powerset_mono.1

@[simp] lemma powerset_inj : powerset s = powerset t ↔ s = t := powerset_injective.eq_iff

@[simp] lemma powerset_empty : (∅ : finset α).powerset = {∅} := rfl

@[simp] lemma powerset_eq_singleton_empty : s.powerset = {∅} ↔ s = ∅ :=
by rw [←powerset_empty, powerset_inj]

/-- **Number of Subsets of a Set** -/
@[simp] theorem card_powerset (s : finset α) :
  card (powerset s) = 2 ^ card s :=
(card_pmap _ _ _).trans (card_powerset s.1)

lemma not_mem_of_mem_powerset_of_not_mem {s t : finset α} {a : α}
  (ht : t ∈ s.powerset) (h : a ∉ s) : a ∉ t :=
by { apply mt _ h, apply mem_powerset.1 ht }

lemma powerset_insert [decidable_eq α] (s : finset α) (a : α) :
  powerset (insert a s) = s.powerset ∪ s.powerset.image (insert a) :=
begin
  ext t,
  simp only [exists_prop, mem_powerset, mem_image, mem_union, subset_insert_iff],
  by_cases h : a ∈ t,
  { split,
    { exact λH, or.inr ⟨_, H, insert_erase h⟩ },
    { intros H,
      cases H,
      { exact subset.trans (erase_subset a t) H },
      { rcases H with ⟨u, hu⟩,
        rw ← hu.2,
        exact subset.trans (erase_insert_subset a u) hu.1 } } },
  { have : ¬ ∃ (u : finset α), u ⊆ s ∧ insert a u = t,
      by simp [ne.symm (ne_insert_of_not_mem _ _ h)],
    simp [finset.erase_eq_of_not_mem h, this] }
end

/-- For predicate `p` decidable on subsets, it is decidable whether `p` holds for any subset. -/
instance decidable_exists_of_decidable_subsets {s : finset α} {p : Π t ⊆ s, Prop}
  [Π t (h : t ⊆ s), decidable (p t h)] : decidable (∃ t (h : t ⊆ s), p t h) :=
decidable_of_iff (∃ t (hs : t ∈ s.powerset), p t (mem_powerset.1 hs))
⟨(λ ⟨t, _, hp⟩, ⟨t, _, hp⟩), (λ ⟨t, hs, hp⟩, ⟨t, mem_powerset.2 hs, hp⟩)⟩

/-- For predicate `p` decidable on subsets, it is decidable whether `p` holds for every subset. -/
instance decidable_forall_of_decidable_subsets {s : finset α} {p : Π t ⊆ s, Prop}
  [Π t (h : t ⊆ s), decidable (p t h)] : decidable (∀ t (h : t ⊆ s), p t h) :=
decidable_of_iff (∀ t (h : t ∈ s.powerset), p t (mem_powerset.1 h))
⟨(λ h t hs, h t (mem_powerset.2 hs)), (λ h _ _, h _ _)⟩

/-- A version of `finset.decidable_exists_of_decidable_subsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_exists_of_decidable_subsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊆ s), decidable (p t)) : decidable (∃ t (h : t ⊆ s), p t) :=
@finset.decidable_exists_of_decidable_subsets _ _ _ hu

/-- A version of `finset.decidable_forall_of_decidable_subsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_forall_of_decidable_subsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊆ s), decidable (p t)) : decidable (∀ t (h : t ⊆ s), p t) :=
@finset.decidable_forall_of_decidable_subsets _ _ _ hu

end powerset

section ssubsets
variables [decidable_eq α]

/-- For `s` a finset, `s.ssubsets` is the finset comprising strict subsets of `s`. -/
def ssubsets (s : finset α) : finset (finset α) :=
erase (powerset s) s

@[simp] lemma mem_ssubsets {s t : finset α} : t ∈ s.ssubsets ↔ t ⊂ s :=
by rw [ssubsets, mem_erase, mem_powerset, ssubset_iff_subset_ne, and.comm]

lemma empty_mem_ssubsets {s : finset α} (h : s.nonempty) : ∅ ∈ s.ssubsets :=
by { rw [mem_ssubsets, ssubset_iff_subset_ne], exact ⟨empty_subset s, h.ne_empty.symm⟩, }

/-- For predicate `p` decidable on ssubsets, it is decidable whether `p` holds for any ssubset. -/
instance decidable_exists_of_decidable_ssubsets {s : finset α} {p : Π t ⊂ s, Prop}
  [Π t (h : t ⊂ s), decidable (p t h)] : decidable (∃ t h, p t h) :=
decidable_of_iff (∃ t (hs : t ∈ s.ssubsets), p t (mem_ssubsets.1 hs))
⟨(λ ⟨t, _, hp⟩, ⟨t, _, hp⟩), (λ ⟨t, hs, hp⟩, ⟨t, mem_ssubsets.2 hs, hp⟩)⟩

/-- For predicate `p` decidable on ssubsets, it is decidable whether `p` holds for every ssubset. -/
instance decidable_forall_of_decidable_ssubsets {s : finset α} {p : Π t ⊂ s, Prop}
  [Π t (h : t ⊂ s), decidable (p t h)] : decidable (∀ t h, p t h) :=
decidable_of_iff (∀ t (h : t ∈ s.ssubsets), p t (mem_ssubsets.1 h))
⟨(λ h t hs, h t (mem_ssubsets.2 hs)), (λ h _ _, h _ _)⟩

/-- A version of `finset.decidable_exists_of_decidable_ssubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_exists_of_decidable_ssubsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊂ s), decidable (p t)) : decidable (∃ t (h : t ⊂ s), p t) :=
@finset.decidable_exists_of_decidable_ssubsets _ _ _ _ hu

/-- A version of `finset.decidable_forall_of_decidable_ssubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidable_forall_of_decidable_ssubsets' {s : finset α} {p : finset α → Prop}
  (hu : Π t (h : t ⊂ s), decidable (p t)) : decidable (∀ t (h : t ⊂ s), p t) :=
@finset.decidable_forall_of_decidable_ssubsets _ _ _ _ hu

end ssubsets

section powerset_len

/-- Given an integer `n` and a finset `s`, then `powerset_len n s` is the finset of subsets of `s`
of cardinality `n`. -/
def powerset_len (n : ℕ) (s : finset α) : finset (finset α) :=
⟨(s.1.powerset_len n).pmap finset.mk $ λ t h, nodup_of_le (mem_powerset_len.1 h).1 s.2,
 s.2.powerset_len.pmap $ λ a ha b hb, congr_arg finset.val⟩

/-- **Formula for the Number of Combinations** -/
theorem mem_powerset_len {n} {s t : finset α} :
  s ∈ powerset_len n t ↔ s ⊆ t ∧ card s = n :=
by cases s; simp [powerset_len, val_le_iff.symm]; refl

@[simp] theorem powerset_len_mono {n} {s t : finset α} (h : s ⊆ t) :
  powerset_len n s ⊆ powerset_len n t :=
λ u h', mem_powerset_len.2 $
  and.imp (λ h₂, subset.trans h₂ h) id (mem_powerset_len.1 h')

/-- **Formula for the Number of Combinations** -/
@[simp] theorem card_powerset_len (n : ℕ) (s : finset α) :
  card (powerset_len n s) = nat.choose (card s) n :=
(card_pmap _ _ _).trans (card_powerset_len n s.1)

@[simp] lemma powerset_len_zero (s : finset α) : finset.powerset_len 0 s = {∅} :=
begin
  ext, rw [mem_powerset_len, mem_singleton, card_eq_zero],
  refine ⟨λ h, h.2, λ h, by { rw h, exact ⟨empty_subset s, rfl⟩ }⟩,
end

@[simp] theorem powerset_len_empty (n : ℕ) {s : finset α} (h : s.card < n) :
  powerset_len n s = ∅ :=
finset.card_eq_zero.mp (by rw [card_powerset_len, nat.choose_eq_zero_of_lt h])

theorem powerset_len_eq_filter {n} {s : finset α} :
  powerset_len n s = (powerset s).filter (λ x, x.card = n) :=
by { ext, simp [mem_powerset_len] }

lemma powerset_len_succ_insert [decidable_eq α] {x : α} {s : finset α} (h : x ∉ s) (n : ℕ) :
  powerset_len n.succ (insert x s) = powerset_len n.succ s ∪ (powerset_len n s).image (insert x) :=
begin
  rw [powerset_len_eq_filter, powerset_insert, filter_union, ←powerset_len_eq_filter],
  congr,
  rw [powerset_len_eq_filter, image_filter],
  congr' 1,
  ext t,
  simp only [mem_powerset, mem_filter, function.comp_app, and.congr_right_iff],
  intro ht,
  have : x ∉ t := λ H, h (ht H),
  simp [card_insert_of_not_mem this, nat.succ_inj']
end

lemma powerset_len_nonempty {n : ℕ} {s : finset α} (h : n ≤ s.card) :
  (powerset_len n s).nonempty :=
begin
  classical,
  induction s using finset.induction_on with x s hx IH generalizing n,
  { rw [card_empty, le_zero_iff] at h,
    rw [h, powerset_len_zero],
    exact finset.singleton_nonempty _,  },
  { cases n,
    { simp },
    { rw [card_insert_of_not_mem hx, nat.succ_le_succ_iff] at h,
      rw powerset_len_succ_insert hx,
      refine nonempty.mono _ ((IH h).image (insert x)),
      convert (subset_union_right _ _) } }
end

@[simp] lemma powerset_len_self (s : finset α) :
  powerset_len s.card s = {s} :=
begin
  ext,
  rw [mem_powerset_len, mem_singleton],
  split,
  { exact λ ⟨hs, hc⟩, eq_of_subset_of_card_le hs hc.ge },
  { rintro rfl,
    simp }
end

lemma pairwise_disjoint_powerset_len (s : finset α) :
  _root_.pairwise (λ i j, disjoint (s.powerset_len i) (s.powerset_len j)) :=
λ i j hij, finset.disjoint_left.mpr $ λ x hi hj, hij $
  (mem_powerset_len.mp hi).2.symm.trans (mem_powerset_len.mp hj).2

lemma powerset_card_disj_Union (s : finset α) :
  finset.powerset s =
    (range (s.card + 1)).disj_Union (λ i, powerset_len i s)
      (s.pairwise_disjoint_powerset_len.set_pairwise _) :=
begin
  refine ext (λ a, ⟨λ ha, _, λ ha, _ ⟩),
  { rw mem_disj_Union,
    exact ⟨a.card, mem_range.mpr (nat.lt_succ_of_le (card_le_of_subset (mem_powerset.mp ha))),
      mem_powerset_len.mpr ⟨mem_powerset.mp ha, rfl⟩⟩ },
  { rcases mem_disj_Union.mp ha with ⟨i, hi, ha⟩,
    exact mem_powerset.mpr (mem_powerset_len.mp ha).1, }
end

lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) :
  finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) :=
by simpa only [disj_Union_eq_bUnion] using powerset_card_disj_Union s

lemma powerset_len_sup [decidable_eq α] (u : finset α) (n : ℕ) (hn : n < u.card) :
  (powerset_len n.succ u).sup id = u :=
begin
  apply le_antisymm,
  { simp_rw [finset.sup_le_iff, mem_powerset_len],
    rintros x ⟨h, -⟩,
    exact h },
  { rw [sup_eq_bUnion, le_iff_subset, subset_iff],
    cases (nat.succ_le_of_lt hn).eq_or_lt with h' h',
    { simp [h'] },
    { intros x hx,
      simp only [mem_bUnion, exists_prop, id.def],
      obtain ⟨t, ht⟩ : ∃ t, t ∈ powerset_len n (u.erase x) := powerset_len_nonempty _,
      { refine ⟨insert x t, _, mem_insert_self _ _⟩,
        rw [←insert_erase hx, powerset_len_succ_insert (not_mem_erase _ _)],
        exact mem_union_right _ (mem_image_of_mem _ ht) },
      { rw [card_erase_of_mem hx],
        exact nat.le_pred_of_lt hn, } } }
end

@[simp]
lemma powerset_len_card_add (s : finset α) {i : ℕ} (hi : 0 < i) :
  s.powerset_len (s.card + i) = ∅ :=
finset.powerset_len_empty _ (lt_add_of_pos_right (finset.card s) hi)

@[simp] theorem map_val_val_powerset_len (s : finset α) (i : ℕ) :
  (s.powerset_len i).val.map finset.val = s.1.powerset_len i :=
by simp [finset.powerset_len, map_pmap, pmap_eq_map, map_id']

theorem powerset_len_map {β : Type*} (f : α ↪ β) (n : ℕ) (s : finset α) :
  powerset_len n (s.map f) = (powerset_len n s).map (map_embedding f).to_embedding :=
eq_of_veq $ multiset.map_injective (@eq_of_veq _) $
  by simp_rw [map_val_val_powerset_len, map_val, multiset.map_map, function.comp,
      rel_embedding.coe_fn_to_embedding, map_embedding_apply, map_val, ←multiset.map_map _ val,
      map_val_val_powerset_len, multiset.powerset_len_map]

end powerset_len
end finset


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

Theory of complete Boolean algebras.
-/
import order.complete_lattice order.boolean_algebra data.set.basic

set_option old_structure_cmd true

universes u v w
variables {α : Type u} {β : Type v} {ι : Sort w}

namespace lattice

/-- A complete distributive lattice is a bit stronger than the name might
  suggest; perhaps completely distributive lattice is more descriptive,
  as this class includes a requirement that the lattice join
  distribute over *arbitrary* infima, and similarly for the dual. -/
class complete_distrib_lattice α extends complete_lattice α :=
(infi_sup_le_sup_Inf : ∀a s, (⨅ b ∈ s, a ⊔ b) ≤ a ⊔ Inf s)
(inf_Sup_le_supr_inf : ∀a s, a ⊓ Sup s ≤ (⨆ b ∈ s, a ⊓ b))

section complete_distrib_lattice
variables [complete_distrib_lattice α] {a : α} {s : set α}

theorem sup_Inf_eq : a ⊔ Inf s = (⨅ b ∈ s, a ⊔ b) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume h, sup_le_sup (le_refl _) (Inf_le h))
  (complete_distrib_lattice.infi_sup_le_sup_Inf _ _)

theorem inf_Sup_eq : a ⊓ Sup s = (⨆ b ∈ s, a ⊓ b) :=
le_antisymm
  (complete_distrib_lattice.inf_Sup_le_supr_inf _ _)
  (supr_le $ assume i, supr_le $ assume h, inf_le_inf (le_refl _) (le_Sup h))

end complete_distrib_lattice

instance [d : complete_distrib_lattice α] : bounded_distrib_lattice α :=
{ le_sup_inf := assume x y z,
    calc (x ⊔ y) ⊓ (x ⊔ z) ≤ (⨅ b ∈ ({z, y} : set α), x ⊔ b) :
        by simp [or_imp_distrib] {contextual := tt}
      ... = x ⊔ Inf {z, y} : sup_Inf_eq.symm
      ... = x ⊔ y ⊓ z : by rw insert_of_has_insert; simp,
  ..d }

/-- A complete boolean algebra is a completely distributive boolean algebra. -/
class complete_boolean_algebra α extends boolean_algebra α, complete_distrib_lattice α

section complete_boolean_algebra
variables [complete_boolean_algebra α] {a b : α} {s : set α} {f : ι → α}

theorem neg_infi : - infi f = (⨆i, - f i) :=
le_antisymm
  (neg_le_of_neg_le $ le_infi $ assume i, neg_le_of_neg_le $ le_supr (λi, - f i) i)
  (supr_le $ assume i, neg_le_neg $ infi_le _ _)

theorem neg_supr : - supr f = (⨅i, - f i) :=
neg_eq_neg_of_eq (by simp [neg_infi])

theorem neg_Inf : - Inf s = (⨆i∈s, - i) :=
by simp [Inf_eq_infi, neg_infi]

theorem neg_Sup : - Sup s = (⨅i∈s, - i) :=
by simp [Sup_eq_supr, neg_supr]

end complete_boolean_algebra

end lattice


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

! This file was ported from Lean 3 source module data.bool.set
! leanprover-community/mathlib commit ed60ee25ed00d7a62a0d1e5808092e1324cee451
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Bool.Basic
import Mathlib.Data.Set.Image

/-!
# Booleans and set operations

This file contains two trivial lemmas about `Bool`, `Set.univ`, and `Set.range`.
-/

open Set

namespace Bool

@[simp]
theorem univ_eq : (univ : Set Bool) = {false, true} :=
  (eq_univ_of_forall Bool.dichotomy).symm
#align bool.univ_eq Bool.univ_eq

@[simp]
theorem range_eq {α : Type _} (f : Bool → α) : range f = {f false, f true} := by
  rw [← image_univ, univ_eq, image_pair]
#align bool.range_eq Bool.range_eq

@[simp] theorem compl_singleton (b : Bool) : ({b}ᶜ : Set Bool) = {!b} :=
  Set.ext fun _ => eq_not_iff.symm
#align bool.compl_singleton Bool.compl_singleton

end Bool


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

! This file was ported from Lean 3 source module linear_algebra.coevaluation
! leanprover-community/mathlib commit d6814c584384ddf2825ff038e868451a7c956f31
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Contraction
import Mathbin.LinearAlgebra.FiniteDimensional
import Mathbin.LinearAlgebra.Dual

/-!
# The coevaluation map on finite dimensional vector spaces

Given a finite dimensional vector space `V` over a field `K` this describes the canonical linear map
from `K` to `V ⊗ dual K V` which corresponds to the identity function on `V`.

## Tags

coevaluation, dual module, tensor product

## Future work

* Prove that this is independent of the choice of basis on `V`.
-/

noncomputable section

section coevaluation

open TensorProduct FiniteDimensional

open TensorProduct BigOperators

universe u v

variable (K : Type u) [Field K]

variable (V : Type v) [AddCommGroup V] [Module K V] [FiniteDimensional K V]

/-- The coevaluation map is a linear map from a field `K` to a finite dimensional
  vector space `V`. -/
def coevaluation : K →ₗ[K] V ⊗[K] Module.Dual K V :=
  let bV := Basis.ofVectorSpace K V
  (Basis.singleton Unit K).constr K fun _ =>
    ∑ i : Basis.ofVectorSpaceIndex K V, bV i ⊗ₜ[K] bV.Coord i
#align coevaluation coevaluation

theorem coevaluation_apply_one :
    (coevaluation K V) (1 : K) =
      let bV := Basis.ofVectorSpace K V
      ∑ i : Basis.ofVectorSpaceIndex K V, bV i ⊗ₜ[K] bV.Coord i :=
  by
  simp only [coevaluation, id]
  rw [(Basis.singleton Unit K).constr_apply_fintype K]
  simp only [Fintype.univ_punit, Finset.sum_const, one_smul, Basis.singleton_repr,
    Basis.equivFun_apply, Basis.coe_ofVectorSpace, one_nsmul, Finset.card_singleton]
#align coevaluation_apply_one coevaluation_apply_one

open TensorProduct

/-- This lemma corresponds to one of the coherence laws for duals in rigid categories, see
  `category_theory.monoidal.rigid`. -/
theorem contractLeft_assoc_coevaluation :
    (contractLeft K V).rtensor _ ∘ₗ
        (TensorProduct.assoc K _ _ _).symm.toLinearMap ∘ₗ
          (coevaluation K V).ltensor (Module.Dual K V) =
      (TensorProduct.lid K _).symm.toLinearMap ∘ₗ (TensorProduct.rid K _).toLinearMap :=
  by
  letI := Classical.decEq (Basis.ofVectorSpaceIndex K V)
  apply TensorProduct.ext
  apply (Basis.ofVectorSpace K V).dualBasis.ext; intro j; apply LinearMap.ext_ring
  rw [LinearMap.compr₂_apply, LinearMap.compr₂_apply, TensorProduct.mk_apply]
  simp only [LinearMap.coe_comp, Function.comp_apply, LinearEquiv.coe_toLinearMap]
  rw [rid_tmul, one_smul, lid_symm_apply]
  simp only [LinearEquiv.coe_toLinearMap, LinearMap.ltensor_tmul, coevaluation_apply_one]
  rw [TensorProduct.tmul_sum, LinearEquiv.map_sum]; simp only [assoc_symm_tmul]
  rw [LinearMap.map_sum]; simp only [LinearMap.rtensor_tmul, contractLeft_apply]
  simp only [Basis.coe_dualBasis, Basis.coord_apply, Basis.repr_self_apply, TensorProduct.ite_tmul]
  rw [Finset.sum_ite_eq']; simp only [Finset.mem_univ, if_true]
#align contract_left_assoc_coevaluation contractLeft_assoc_coevaluation

/-- This lemma corresponds to one of the coherence laws for duals in rigid categories, see
  `category_theory.monoidal.rigid`. -/
theorem contractLeft_assoc_coevaluation' :
    (contractLeft K V).ltensor _ ∘ₗ
        (TensorProduct.assoc K _ _ _).toLinearMap ∘ₗ (coevaluation K V).rtensor V =
      (TensorProduct.rid K _).symm.toLinearMap ∘ₗ (TensorProduct.lid K _).toLinearMap :=
  by
  letI := Classical.decEq (Basis.ofVectorSpaceIndex K V)
  apply TensorProduct.ext
  apply LinearMap.ext_ring; apply (Basis.ofVectorSpace K V).ext; intro j
  rw [LinearMap.compr₂_apply, LinearMap.compr₂_apply, TensorProduct.mk_apply]
  simp only [LinearMap.coe_comp, Function.comp_apply, LinearEquiv.coe_toLinearMap]
  rw [lid_tmul, one_smul, rid_symm_apply]
  simp only [LinearEquiv.coe_toLinearMap, LinearMap.rtensor_tmul, coevaluation_apply_one]
  rw [TensorProduct.sum_tmul, LinearEquiv.map_sum]; simp only [assoc_tmul]
  rw [LinearMap.map_sum]; simp only [LinearMap.ltensor_tmul, contractLeft_apply]
  simp only [Basis.coord_apply, Basis.repr_self_apply, TensorProduct.tmul_ite]
  rw [Finset.sum_ite_eq]; simp only [Finset.mem_univ, if_true]
#align contract_left_assoc_coevaluation' contractLeft_assoc_coevaluation'

end coevaluation