/-
Copyright (c) 2015 Nathaniel Thomas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.basic
import Mathlib.algebra.group.hom
import Mathlib.algebra.ring.basic
import Mathlib.data.rat.cast
import Mathlib.group_theory.group_action.group
import Mathlib.tactic.nth_rewrite.default
import Mathlib.PostPort

universes u v l w x z u_1 u_2 u_3

namespace Mathlib

/-!
# Modules over a ring

In this file we define

* `semimodule R M` : an additive commutative monoid `M` is a `semimodule` over a
  `semiring` `R` if for `r : R` and `x : M` their "scalar multiplication `r • x : M` is defined, and
  the operation `•` satisfies some natural associativity and distributivity axioms similar to those
  on a ring.

* `module R M` : same as `semimodule R M` but assumes that `R` is a `ring` and `M` is an
  additive commutative group.

* `vector_space k M` : same as `semimodule k M` and `module k M` but assumes that `k` is a `field`
  and `M` is an additive commutative group.

* `linear_map R M M₂`, `M →ₗ[R] M₂` : a linear map between two R-`semimodule`s.

## Implementation notes

* `vector_space` and `module` are abbreviations for `semimodule R M`.

## Tags

semimodule, module, vector space
-/

/-- A semimodule is a generalization of vector spaces to a scalar semiring.
  It consists of a scalar semiring `R` and an additive monoid of "vectors" `M`,
  connected by a "scalar multiplication" operation `r • x : M`
  (where `r : R` and `x : M`) with some natural associativity and
  distributivity axioms similar to those on a ring. -/
class semimodule (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M]
extends distrib_mul_action R M
where
  add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x
  zero_smul : ∀ (x : M), 0 • x = 0

theorem add_smul {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (r : R) (s : R) (x : M) : (r + s) • x = r • x + s • x :=
  semimodule.add_smul r s x

@[simp] theorem zero_smul (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (x : M) : 0 • x = 0 :=
  semimodule.zero_smul x

theorem two_smul (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (x : M) : bit0 1 • x = x + x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (bit0 1 • x = x + x)) (bit0.equations._eqn_1 1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((1 + 1) • x = x + x)) (add_smul 1 1 x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 • x + 1 • x = x + x)) (one_smul R x))) (Eq.refl (x + x))))

theorem two_smul' (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (x : M) : bit0 1 • x = bit0 x :=
  two_smul R x

/-- Pullback a `semimodule` structure along an injective additive monoid homomorphism. -/
protected def function.injective.semimodule (R : Type u) {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M] [semimodule R M] [add_comm_monoid M₂] [has_scalar R M₂] (f : M₂ →+ M) (hf : function.injective ⇑f) (smul : ∀ (c : R) (x : M₂), coe_fn f (c • x) = c • coe_fn f x) : semimodule R M₂ :=
  semimodule.mk sorry sorry

/-- Pushforward a `semimodule` structure along a surjective additive monoid homomorphism. -/
protected def function.surjective.semimodule (R : Type u) {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M] [semimodule R M] [add_comm_monoid M₂] [has_scalar R M₂] (f : M →+ M₂) (hf : function.surjective ⇑f) (smul : ∀ (c : R) (x : M), coe_fn f (c • x) = c • coe_fn f x) : semimodule R M₂ :=
  semimodule.mk sorry sorry

/-- `(•)` as an `add_monoid_hom`. -/
def smul_add_hom (R : Type u) (M : Type w) [semiring R] [add_comm_monoid M] [semimodule R M] : R →+ M →+ M :=
  add_monoid_hom.mk (const_smul_hom M) sorry sorry

@[simp] theorem smul_add_hom_apply {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (r : R) (x : M) : coe_fn (coe_fn (smul_add_hom R M) r) x = r • x :=
  rfl

theorem semimodule.eq_zero_of_zero_eq_one {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (x : M) (zero_eq_one : 0 = 1) : x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x = 0)) (Eq.symm (one_smul R x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 • x = 0)) (Eq.symm zero_eq_one)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 • x = 0)) (zero_smul R x))) (Eq.refl 0)))

theorem list.sum_smul {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] {l : List R} {x : M} : list.sum l • x = list.sum (list.map (fun (r : R) => r • x) l) :=
  add_monoid_hom.map_list_sum (coe_fn (add_monoid_hom.flip (smul_add_hom R M)) x) l

theorem multiset.sum_smul {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] {l : multiset R} {x : M} : multiset.sum l • x = multiset.sum (multiset.map (fun (r : R) => r • x) l) :=
  add_monoid_hom.map_multiset_sum (coe_fn (add_monoid_hom.flip (smul_add_hom R M)) x) l

theorem finset.sum_smul {R : Type u} {M : Type w} {ι : Type z} [semiring R] [add_comm_monoid M] [semimodule R M] {f : ι → R} {s : finset ι} {x : M} : (finset.sum s fun (i : ι) => f i) • x = finset.sum s fun (i : ι) => f i • x :=
  add_monoid_hom.map_sum (coe_fn (add_monoid_hom.flip (smul_add_hom R M)) x) f s

/-- An `add_comm_monoid` that is a `semimodule` over a `ring` carries a natural `add_comm_group`
structure. -/
def semimodule.add_comm_monoid_to_add_comm_group (R : Type u) {M : Type w} [ring R] [add_comm_monoid M] [semimodule R M] : add_comm_group M :=
  add_comm_group.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry (fun (a : M) => -1 • a)
    (add_group.sub._default add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry fun (a : M) => -1 • a) sorry sorry

/-- A structure containing most informations as in a semimodule, except the fields `zero_smul`
and `smul_zero`. As these fields can be deduced from the other ones when `M` is an `add_comm_group`,
this provides a way to construct a semimodule structure by checking less properties, in
`semimodule.of_core`. -/
structure semimodule.core (R : Type u) (M : Type w) [semiring R] [add_comm_group M]
extends has_scalar R M
where
  smul_add : ∀ (r : R) (x y : M), r • (x + y) = r • x + r • y
  add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x
  mul_smul : ∀ (r s : R) (x : M), (r * s) • x = r • s • x
  one_smul : ∀ (x : M), 1 • x = x

/-- Define `semimodule` without proving `zero_smul` and `smul_zero` by using an auxiliary
structure `semimodule.core`, when the underlying space is an `add_comm_group`. -/
def semimodule.of_core {R : Type u} {M : Type w} [semiring R] [add_comm_group M] (H : semimodule.core R M) : semimodule R M :=
  semimodule.mk (semimodule.core.add_smul H) sorry

/--
Modules are defined as an `abbreviation` for semimodules,
if the base semiring is a ring.
(A previous definition made `module` a structure
defined to be `semimodule`.)
This has as advantage that modules are completely transparent
for type class inference, which means that all instances for semimodules
are immediately picked up for modules as well.
A cosmetic disadvantage is that one can not extend modules as such,
in definitions such as `normed_space`.
The solution is to extend `semimodule` instead.
-/
/-- A module is the same as a semimodule, except the scalar semiring is actually
  a ring.
  This is the traditional generalization of spaces like `ℤ^n`, which have a natural
  addition operation and a way to multiply them by elements of a ring, but no multiplication
  operation between vectors. -/
def module (R : Type u) (M : Type v) [ring R] [add_comm_group M] :=
  semimodule R M

/--
To prove two semimodule structures on a fixed `add_comm_monoid` agree,
it suffices to check the scalar multiplications agree.
-/
-- We'll later use this to show `semimodule ℕ M` and `module ℤ M` are subsingletons.

theorem semimodule_ext {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] (P : semimodule R M) (Q : semimodule R M) (w : ∀ (r : R) (m : M), r • m = r • m) : P = Q := sorry

@[simp] theorem neg_smul {R : Type u} {M : Type w} [ring R] [add_comm_group M] [module R M] (r : R) (x : M) : -r • x = -(r • x) := sorry

theorem neg_one_smul (R : Type u) {M : Type w} [ring R] [add_comm_group M] [module R M] (x : M) : -1 • x = -x := sorry

theorem sub_smul {R : Type u} {M : Type w} [ring R] [add_comm_group M] [module R M] (r : R) (s : R) (y : M) : (r - s) • y = r • y - s • y := sorry

theorem smul_eq_zero {R : Type u_1} {E : Type u_2} [division_ring R] [add_comm_group E] [module R E] {c : R} {x : E} : c • x = 0 ↔ c = 0 ∨ x = 0 := sorry

/-- A semimodule over a `subsingleton` semiring is a `subsingleton`. We cannot register this
as an instance because Lean has no way to guess `R`. -/
theorem semimodule.subsingleton (R : Type u_1) (M : Type u_2) [semiring R] [subsingleton R] [add_comm_monoid M] [semimodule R M] : subsingleton M := sorry

protected instance semiring.to_semimodule {R : Type u} [semiring R] : semimodule R R :=
  semimodule.mk sorry sorry

@[simp] theorem smul_eq_mul {R : Type u} [semiring R] {a : R} {a' : R} : a • a' = a * a' :=
  rfl

/-- A ring homomorphism `f : R →+* M` defines a module structure by `r • x = f r * x`. -/
def ring_hom.to_semimodule {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : semimodule R S :=
  semimodule.mk sorry sorry

/--
Vector spaces are defined as an `abbreviation` for semimodules,
if the base ring is a field.
(A previous definition made `vector_space` a structure
defined to be `module`.)
This has as advantage that vector spaces are completely transparent
for type class inference, which means that all instances for semimodules
are immediately picked up for vector spaces as well.
A cosmetic disadvantage is that one can not extend vector spaces as such,
in definitions such as `normed_space`.
The solution is to extend `semimodule` instead.
-/
/-- A vector space is the same as a module, except the scalar ring is actually
  a field. (This adds commutativity of the multiplication and existence of inverses.)
  This is the traditional generalization of spaces like `ℝ^n`, which have a natural
  addition operation and a way to multiply them by real numbers, but no multiplication
  operation between vectors. -/
def vector_space (R : Type u) (M : Type v) [field R] [add_comm_group M] :=
  semimodule R M

/-- The natural ℕ-semimodule structure on any `add_comm_monoid`. -/
-- We don't make this a global instance, as it results in too many instances,

-- and confusing ambiguity in the notation `n • x` when `n : ℕ`.

instance add_comm_monoid.nat_semimodule {M : Type w} [add_comm_monoid M] : semimodule ℕ M :=
  semimodule.mk sorry sorry

/-- `nsmul` is defined as the `smul` action of `add_comm_monoid.nat_semimodule`. -/
theorem nsmul_def {M : Type w} [add_comm_monoid M] (n : ℕ) (x : M) : n •ℕ x = n • x :=
  rfl

/-- `nsmul` is equal to any other semimodule structure via a cast. -/
theorem nsmul_eq_smul_cast (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (n : ℕ) (b : M) : n •ℕ b = ↑n • b := sorry

/-- `nsmul` is equal to any `ℕ`-semimodule structure. -/
theorem nsmul_eq_smul {M : Type w} [add_comm_monoid M] [semimodule ℕ M] (n : ℕ) (b : M) : n •ℕ b = n • b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ b = n • b)) (nsmul_eq_smul_cast ℕ n b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n • b = n • b)) (nat.cast_id n))) (Eq.refl (n • b)))

/-- All `ℕ`-semimodule structures are equal. -/
protected instance add_comm_monoid.nat_semimodule.subsingleton {M : Type w} [add_comm_monoid M] : subsingleton (semimodule ℕ M) :=
  subsingleton.intro
    fun (P Q : semimodule ℕ M) =>
      semimodule_ext P Q
        fun (n : ℕ) (m : M) =>
          eq.mpr (id (Eq._oldrec (Eq.refl (n • m = n • m)) (Eq.symm (nsmul_eq_smul n m))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ m = n • m)) (Eq.symm (nsmul_eq_smul n m)))) (Eq.refl (n •ℕ m)))

/-- Note this does not depend on the `nat_semimodule` definition above, to avoid issues when
diamonds occur in finding `semimodule ℕ M` instances. -/
protected instance add_comm_monoid.nat_is_scalar_tower {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] [semimodule ℕ R] [semimodule ℕ M] : is_scalar_tower ℕ R M := sorry

protected instance add_comm_monoid.nat_smul_comm_class {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] [semimodule ℕ M] : smul_comm_class ℕ R M := sorry

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop

protected instance add_comm_monoid.nat_smul_comm_class' {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] [semimodule ℕ M] : smul_comm_class R ℕ M :=
  smul_comm_class.symm ℕ R M

/-- The natural ℤ-module structure on any `add_comm_group`. -/
-- We don't immediately make this a global instance, as it results in too many instances,

-- and confusing ambiguity in the notation `n • x` when `n : ℤ`.

-- We do turn it into a global instance, but only at the end of this file,

-- and I remain dubious whether this is a good idea.

instance add_comm_group.int_module {M : Type w} [add_comm_group M] : module ℤ M :=
  semimodule.mk sorry sorry

/-- `gsmul` is defined as the `smul` action of `add_comm_group.int_module`. -/
theorem gsmul_def {M : Type w} [add_comm_group M] (n : ℤ) (x : M) : n •ℤ x = n • x :=
  rfl

/-- `gsmul` is equal to any other module structure via a cast. -/
theorem gsmul_eq_smul_cast (R : Type u) {M : Type w} [ring R] [add_comm_group M] [semimodule R M] (n : ℤ) (b : M) : n •ℤ b = ↑n • b := sorry

/-- `gsmul` is equal to any `ℤ`-module structure. -/
theorem gsmul_eq_smul {M : Type w} [add_comm_group M] [semimodule ℤ M] (n : ℤ) (b : M) : n •ℤ b = n • b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ b = n • b)) (gsmul_eq_smul_cast ℤ n b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n • b = n • b)) (int.cast_id n))) (Eq.refl (n • b)))

/-- All `ℤ`-module structures are equal. -/
protected instance add_comm_group.int_module.subsingleton {M : Type w} [add_comm_group M] : subsingleton (semimodule ℤ M) :=
  subsingleton.intro
    fun (P Q : semimodule ℤ M) =>
      semimodule_ext P Q
        fun (n : ℤ) (m : M) =>
          eq.mpr (id (Eq._oldrec (Eq.refl (n • m = n • m)) (Eq.symm (gsmul_eq_smul n m))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ m = n • m)) (Eq.symm (gsmul_eq_smul n m)))) (Eq.refl (n •ℤ m)))

protected instance add_comm_group.int_is_scalar_tower {R : Type u} {M : Type w} [ring R] [add_comm_group M] [semimodule R M] [semimodule ℤ R] [semimodule ℤ M] : is_scalar_tower ℤ R M := sorry

protected instance add_comm_group.int_smul_comm_class {S : Type v} {M : Type w} [semiring S] [add_comm_group M] [semimodule S M] [semimodule ℤ M] : smul_comm_class ℤ S M := sorry

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop

protected instance add_comm_group.int_smul_comm_class' {S : Type v} {M : Type w} [semiring S] [add_comm_group M] [semimodule S M] [semimodule ℤ M] : smul_comm_class S ℤ M :=
  smul_comm_class.symm ℤ S M

namespace add_monoid_hom

-- We prove this without using the `add_comm_group.int_module` instance, so the `•`s here

-- come from whatever the local `module ℤ` structure actually is.

theorem map_int_module_smul {M : Type w} {M₂ : Type x} [add_comm_group M] [add_comm_group M₂] [module ℤ M] [module ℤ M₂] (f : M →+ M₂) (x : ℤ) (a : M) : coe_fn f (x • a) = x • coe_fn f a := sorry

theorem map_int_cast_smul {R : Type u} {M : Type w} {M₂ : Type x} [ring R] [add_comm_group M] [add_comm_group M₂] [module R M] [module R M₂] (f : M →+ M₂) (x : ℤ) (a : M) : coe_fn f (↑x • a) = ↑x • coe_fn f a := sorry

theorem map_nat_cast_smul {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : M →+ M₂) (x : ℕ) (a : M) : coe_fn f (↑x • a) = ↑x • coe_fn f a := sorry

theorem map_rat_cast_smul {R : Type u_1} [division_ring R] [char_zero R] {E : Type u_2} [add_comm_group E] [module R E] {F : Type u_3} [add_comm_group F] [module R F] (f : E →+ F) (c : ℚ) (x : E) : coe_fn f (↑c • x) = ↑c • coe_fn f x := sorry

theorem map_rat_module_smul {E : Type u_1} [add_comm_group E] [vector_space ℚ E] {F : Type u_2} [add_comm_group F] [module ℚ F] (f : E →+ F) (c : ℚ) (x : E) : coe_fn f (c • x) = c • coe_fn f x :=
  rat.cast_id c ▸ map_rat_cast_smul f c x

@[simp] theorem nat_smul_apply {M : Type w} {M₂ : Type x} [add_monoid M] [add_comm_monoid M₂] [semimodule ℕ (M →+ M₂)] [semimodule ℕ M₂] (n : ℕ) (f : M →+ M₂) (a : M) : coe_fn (n • f) a = n • coe_fn f a := sorry

@[simp] theorem int_smul_apply {M : Type w} {M₂ : Type x} [add_monoid M] [add_comm_group M₂] [module ℤ (M →+ M₂)] [module ℤ M₂] (n : ℤ) (f : M →+ M₂) (a : M) : coe_fn (n • f) a = n • coe_fn f a := sorry

end add_monoid_hom

/-! Some tests for the vanishing of elements in modules over division rings. -/

theorem smul_nat_eq_zero (R : Type u) {M : Type w} [division_ring R] [add_comm_group M] [module R M] [semimodule ℕ M] [char_zero R] {v : M} {n : ℕ} : n • v = 0 ↔ n = 0 ∨ v = 0 := sorry

theorem eq_zero_of_smul_two_eq_zero (R : Type u) {M : Type w} [division_ring R] [add_comm_group M] [module R M] [semimodule ℕ M] [char_zero R] {v : M} (hv : bit0 1 • v = 0) : v = 0 := sorry

theorem eq_zero_of_eq_neg (R : Type u) {M : Type w} [division_ring R] [add_comm_group M] [module R M] [char_zero R] {v : M} (hv : v = -v) : v = 0 := sorry

theorem ne_neg_of_ne_zero (R : Type u) [division_ring R] [char_zero R] {v : R} (hv : v ≠ 0) : v ≠ -v :=
  fun (h : v = -v) => (fun (this : semimodule ℕ R) => hv (eq_zero_of_eq_neg R h)) add_comm_monoid.nat_semimodule


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

Extends the theory on functors, applicatives and monads.
-/

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

notation a ` $< `:1 f:1 := f a

section functor
variables {f : Type u → Type v} [functor f] [is_lawful_functor f]

run_cmd mk_simp_attr `functor_norm
run_cmd tactic.add_doc_string `simp_attr.functor_norm "Simp set for functor_norm"

@[functor_norm] theorem functor.map_map (m : α → β) (g : β → γ) (x : f α) :
  g <$> (m <$> x) = (g ∘ m) <$> x :=
(comp_map _ _ _).symm

@[simp] theorem id_map' (x : f α) : (λa, a) <$> x = x := id_map _

end functor

section applicative
variables {F : Type u → Type v} [applicative F]

def mzip_with
  {α₁ α₂ φ : Type u}
  (f : α₁ → α₂ → F φ) :
  Π (ma₁ : list α₁) (ma₂: list α₂), F (list φ)
| (x :: xs) (y :: ys) := (::) <$> f x y <*> mzip_with xs ys
| _ _ := pure []

def mzip_with'  (f : α → β → F γ) : list α → list β → F punit
| (x :: xs) (y :: ys) := f x y *> mzip_with' xs ys
| [] _ := pure punit.star
| _ [] := pure punit.star

variables [is_lawful_applicative F]

attribute [functor_norm] seq_assoc pure_seq_eq_map

@[simp] theorem pure_id'_seq (x : F α) : pure (λx, x) <*> x = x :=
pure_id_seq x

attribute [functor_norm] seq_assoc pure_seq_eq_map

@[functor_norm] theorem seq_map_assoc (x : F (α → β)) (f : γ → α) (y : F γ) :
  (x <*> (f <$> y)) = (λ(m:α→β), m ∘ f) <$> x <*> y :=
begin
  simp [(pure_seq_eq_map _ _).symm],
  simp [seq_assoc, (comp_map _ _ _).symm, (∘)],
  simp [pure_seq_eq_map]
end

@[functor_norm] theorem map_seq (f : β → γ) (x : F (α → β)) (y : F α) :
  (f <$> (x <*> y)) = ((∘) f) <$> x <*> y :=
by simp [(pure_seq_eq_map _ _).symm]; simp [seq_assoc]

end applicative

-- TODO: setup `functor_norm` for `monad` laws
attribute [functor_norm] pure_bind bind_assoc bind_pure

section monad
variables {m : Type u → Type v} [monad m] [is_lawful_monad m]

open list

def list.mpartition {f : Type → Type} [monad f] {α : Type} (p : α → f bool) :
  list α → f (list α × list α)
| [] := pure ([],[])
| (x :: xs) :=
mcond (p x) (prod.map (cons x) id <$> list.mpartition xs)
            (prod.map id (cons x) <$> list.mpartition xs)

lemma map_bind (x : m α) {g : α → m β} {f : β → γ} : f <$> (x >>= g) = (x >>= λa, f <$> g a) :=
by rw [← bind_pure_comp_eq_map,bind_assoc]; simp [bind_pure_comp_eq_map]

lemma seq_bind_eq (x : m α) {g : β → m γ} {f : α → β} : (f <$> x) >>= g = (x >>= g ∘ f) :=
show bind (f <$> x) g = bind x (g ∘ f),
by rw [← bind_pure_comp_eq_map, bind_assoc]; simp [pure_bind]

lemma seq_eq_bind_map {x : m α} {f : m (α → β)} : f <*> x = (f >>= (<$> x)) :=
(bind_map_eq_seq f x).symm

/-- This is the Kleisli composition -/
@[reducible] def fish {m} [monad m] {α β γ} (f : α → m β) (g : β → m γ) := λ x, f x >>= g

-- >=> is already defined in the core library but it is unusable
-- because of its precedence (it is defined with precedence 2) and
-- because it is defined as a lambda instead of having a named
-- function
infix ` >=> `:55 := fish

@[functor_norm]
lemma fish_pure {α β} (f : α → m β) : f >=> pure = f :=
by simp only [(>=>)] with functor_norm

@[functor_norm]
lemma fish_pipe {α β} (f : α → m β) : pure >=> f = f :=
by simp only [(>=>)] with functor_norm

@[functor_norm]
lemma fish_assoc {α β γ φ} (f : α → m β) (g : β → m γ) (h : γ → m φ) :
  (f >=> g) >=> h = f >=> (g >=> h) :=
by simp only [(>=>)] with functor_norm

variables {β' γ' : Type v}
variables {m' : Type v → Type w} [monad m']

def list.mmap_accumr (f : α → β' → m' (β' × γ')) : β' → list α → m' (β' × list γ')
| a [] := pure (a,[])
| a (x :: xs) :=
  do (a',ys) ← list.mmap_accumr a xs,
     (a'',y) ← f x a',
     pure (a'',y::ys)

def list.mmap_accuml (f : β' → α → m' (β' × γ')) : β' → list α → m' (β' × list γ')
| a [] := pure (a,[])
| a (x :: xs) :=
  do (a',y) ← f a x,
     (a'',ys) ← list.mmap_accuml a' xs,
     pure (a'',y :: ys)

end monad

section
variables {m : Type u → Type u} [monad m] [is_lawful_monad m]

lemma mjoin_map_map {α β : Type u} (f : α → β) (a : m (m α)) :
  mjoin (functor.map f <$> a) = f <$> (mjoin a) :=
by simp only [mjoin, (∘), id.def,
  (bind_pure_comp_eq_map _ _).symm, bind_assoc, map_bind, pure_bind]

lemma mjoin_map_mjoin {α : Type u} (a : m (m (m α))) :
  mjoin (mjoin <$> a) = mjoin (mjoin a) :=
by simp only [mjoin, (∘), id.def,
  map_bind, (bind_pure_comp_eq_map _ _).symm, bind_assoc, pure_bind]

@[simp] lemma mjoin_map_pure {α : Type u} (a : m α) :
  mjoin (pure <$> a) = a :=
by simp only [mjoin, (∘), id.def,
  map_bind, (bind_pure_comp_eq_map _ _).symm, bind_assoc, pure_bind, bind_pure]

@[simp] lemma mjoin_pure {α : Type u} (a : m α) : mjoin (pure a) = a :=
is_lawful_monad.pure_bind a id

end

section alternative
variables {F : Type → Type v} [alternative F]

def succeeds {α} (x : F α) : F bool := (x $> tt) <|> pure ff

def mtry {α} (x : F α) : F unit := (x $> ()) <|> pure ()

@[simp] theorem guard_true {h : decidable true} :
  @guard F _ true h = pure () := by simp [guard]

@[simp] theorem guard_false {h : decidable false} :
  @guard F _ false h = failure := by simp [guard]

end alternative

namespace sum

variables {e : Type v}

protected def bind {α β} : e ⊕ α → (α → e ⊕ β) → e ⊕ β
| (inl x) _ := inl x
| (inr x) f := f x

instance : monad (sum.{v u} e) :=
{ pure := @sum.inr e,
  bind := @sum.bind e }

instance : is_lawful_functor (sum.{v u} e) :=
by refine { .. }; intros; casesm _ ⊕ _; refl

instance : is_lawful_monad (sum.{v u} e) :=
{ bind_assoc := by { intros, casesm _ ⊕ _; refl },
  pure_bind  := by { intros, refl },
  bind_pure_comp_eq_map := by { intros, casesm _ ⊕ _; refl },
  bind_map_eq_seq := by { intros, cases f; refl } }

end sum

class is_comm_applicative (m : Type* → Type*) [applicative m] extends is_lawful_applicative m :
  Prop :=
(commutative_prod : ∀{α β} (a : m α) (b : m β), prod.mk <$> a <*> b = (λb a, (a, b)) <$> b <*> a)

open functor

lemma is_comm_applicative.commutative_map
  {m : Type* → Type*} [applicative m] [is_comm_applicative m]
  {α β γ} (a : m α) (b : m β) {f : α → β → γ} :
  f <$> a <*> b = flip f <$> b <*> a :=
calc f <$> a <*> b = (λp:α×β, f p.1 p.2) <$> (prod.mk <$> a <*> b) :
    by simp [seq_map_assoc, map_seq, seq_assoc, seq_pure, map_map]
  ... = (λb a, f a b) <$> b <*> a :
    by rw [is_comm_applicative.commutative_prod];
        simp [seq_map_assoc, map_seq, seq_assoc, seq_pure, map_map]


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Joey van Langen, Casper Putz
-/
import tactic.apply_fun
import algebra.ring.equiv
import data.zmod.algebra
import linear_algebra.finite_dimensional
import ring_theory.integral_domain
import field_theory.separable

/-!
# Finite fields

This file contains basic results about finite fields.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

See `ring_theory.integral_domain` for the fact that the unit group of a finite field is a
cyclic group, as well as the fact that every finite integral domain is a field
(`fintype.field_of_domain`).

## Main results

1. `fintype.card_units`: The unit group of a finite field is has cardinality `q - 1`.
2. `sum_pow_units`: The sum of `x^i`, where `x` ranges over the units of `K`, is
   - `q-1` if `q-1 ∣ i`
   - `0`   otherwise
3. `finite_field.card`: The cardinality `q` is a power of the characteristic of `K`.
   See `card'` for a variant.

## Notation

Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

## Implementation notes

While `fintype Kˣ` can be inferred from `fintype K` in the presence of `decidable_eq K`,
in this file we take the `fintype Kˣ` argument directly to reduce the chance of typeclass
diamonds, as `fintype` carries data.

-/

variables {K : Type*} {R : Type*}
local notation `q` := fintype.card K

open_locale big_operators polynomial

namespace finite_field
open finset function

section polynomial

variables [comm_ring R] [is_domain R]

open polynomial

/-- The cardinality of a field is at most `n` times the cardinality of the image of a degree `n`
  polynomial -/
lemma card_image_polynomial_eval [decidable_eq R] [fintype R] {p : R[X]}
  (hp : 0 < p.degree) : fintype.card R ≤ nat_degree p * (univ.image (λ x, eval x p)).card :=
finset.card_le_mul_card_image _ _
  (λ a _, calc _ = (p - C a).roots.to_finset.card : congr_arg card
    (by simp [finset.ext_iff, mem_roots_sub_C hp])
    ... ≤ (p - C a).roots.card : multiset.to_finset_card_le _
    ... ≤ _ : card_roots_sub_C' hp)

/-- If `f` and `g` are quadratic polynomials, then the `f.eval a + g.eval b = 0` has a solution. -/
lemma exists_root_sum_quadratic [fintype R] {f g : R[X]} (hf2 : degree f = 2)
  (hg2 : degree g = 2) (hR : fintype.card R % 2 = 1) : ∃ a b, f.eval a + g.eval b = 0 :=
by letI := classical.dec_eq R; exact
suffices ¬ disjoint (univ.image (λ x : R, eval x f)) (univ.image (λ x : R, eval x (-g))),
begin
  simp only [disjoint_left, mem_image] at this,
  push_neg at this,
  rcases this with ⟨x, ⟨a, _, ha⟩, ⟨b, _, hb⟩⟩,
  exact ⟨a, b, by rw [ha, ← hb, eval_neg, neg_add_self]⟩
end,
assume hd : disjoint _ _,
lt_irrefl (2 * ((univ.image (λ x : R, eval x f)) ∪ (univ.image (λ x : R, eval x (-g)))).card) $
calc 2 * ((univ.image (λ x : R, eval x f)) ∪ (univ.image (λ x : R, eval x (-g)))).card
    ≤ 2 * fintype.card R : nat.mul_le_mul_left _ (finset.card_le_univ _)
... = fintype.card R + fintype.card R : two_mul _
... < nat_degree f * (univ.image (λ x : R, eval x f)).card +
      nat_degree (-g) * (univ.image (λ x : R, eval x (-g))).card :
    add_lt_add_of_lt_of_le
      (lt_of_le_of_ne
        (card_image_polynomial_eval (by rw hf2; exact dec_trivial))
        (mt (congr_arg (%2)) (by simp [nat_degree_eq_of_degree_eq_some hf2, hR])))
      (card_image_polynomial_eval (by rw [degree_neg, hg2]; exact dec_trivial))
... = 2 * (univ.image (λ x : R, eval x f) ∪ univ.image (λ x : R, eval x (-g))).card :
  by rw [card_disjoint_union hd]; simp [nat_degree_eq_of_degree_eq_some hf2,
    nat_degree_eq_of_degree_eq_some hg2, bit0, mul_add]

end polynomial

lemma prod_univ_units_id_eq_neg_one [comm_ring K] [is_domain K] [fintype Kˣ] :
  (∏ x : Kˣ, x) = (-1 : Kˣ) :=
begin
  classical,
  have : (∏ x in (@univ Kˣ _).erase (-1), x) = 1,
  from prod_involution (λ x _, x⁻¹) (by simp)
    (λ a, by simp [units.inv_eq_self_iff] {contextual := tt})
    (λ a, by simp [@inv_eq_iff_inv_eq _ _ a, eq_comm])
    (by simp),
  rw [← insert_erase (mem_univ (-1 : Kˣ)), prod_insert (not_mem_erase _ _),
      this, mul_one]
end

section
variables [group_with_zero K] [fintype K]

lemma pow_card_sub_one_eq_one (a : K) (ha : a ≠ 0) : a ^ (q - 1) = 1 :=
calc a ^ (fintype.card K - 1) = (units.mk0 a ha ^ (fintype.card K - 1) : Kˣ) :
    by rw [units.coe_pow, units.coe_mk0]
  ... = 1 : by { classical, rw [← fintype.card_units, pow_card_eq_one], refl }

lemma pow_card (a : K) : a ^ q = a :=
begin
  have hp : 0 < fintype.card K := lt_trans zero_lt_one fintype.one_lt_card,
  by_cases h : a = 0, { rw h, apply zero_pow hp },
  rw [← nat.succ_pred_eq_of_pos hp, pow_succ, nat.pred_eq_sub_one,
    pow_card_sub_one_eq_one a h, mul_one],
end

lemma pow_card_pow (n : ℕ) (a : K) : a ^ q ^ n = a :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, pow_mul, ih, pow_card], },
end

end

variables (K) [field K] [fintype K]

theorem card (p : ℕ) [char_p K p] : ∃ (n : ℕ+), nat.prime p ∧ q = p^(n : ℕ) :=
begin
  haveI hp : fact p.prime := ⟨char_p.char_is_prime K p⟩,
  letI : module (zmod p) K := { .. (zmod.cast_hom dvd_rfl K : zmod p →+* _).to_module },
  obtain ⟨n, h⟩ := vector_space.card_fintype (zmod p) K,
  rw zmod.card at h,
  refine ⟨⟨n, _⟩, hp.1, h⟩,
  apply or.resolve_left (nat.eq_zero_or_pos n),
  rintro rfl,
  rw pow_zero at h,
  have : (0 : K) = 1, { apply fintype.card_le_one_iff.mp (le_of_eq h) },
  exact absurd this zero_ne_one,
end

-- this statement doesn't use `q` because we want `K` to be an explicit parameter
theorem card' : ∃ (p : ℕ) (n : ℕ+), nat.prime p ∧ fintype.card K = p^(n : ℕ) :=
let ⟨p, hc⟩ := char_p.exists K in ⟨p, @finite_field.card K _ _ p hc⟩

@[simp] lemma cast_card_eq_zero : (q : K) = 0 :=
begin
  rcases char_p.exists K with ⟨p, _char_p⟩, resetI,
  rcases card K p with ⟨n, hp, hn⟩,
  simp only [char_p.cast_eq_zero_iff K p, hn],
  conv { congr, rw [← pow_one p] },
  exact pow_dvd_pow _ n.2,
end

lemma forall_pow_eq_one_iff (i : ℕ) :
  (∀ x : Kˣ, x ^ i = 1) ↔ q - 1 ∣ i :=
begin
  classical,
  obtain ⟨x, hx⟩ := is_cyclic.exists_generator Kˣ,
  rw [←fintype.card_units, ←order_of_eq_card_of_forall_mem_zpowers hx, order_of_dvd_iff_pow_eq_one],
  split,
  { intro h, apply h },
  { intros h y,
    simp_rw ← mem_powers_iff_mem_zpowers at hx,
    rcases hx y with ⟨j, rfl⟩,
    rw [← pow_mul, mul_comm, pow_mul, h, one_pow], }
end

/-- The sum of `x ^ i` as `x` ranges over the units of a finite field of cardinality `q`
is equal to `0` unless `(q - 1) ∣ i`, in which case the sum is `q - 1`. -/
lemma sum_pow_units [fintype Kˣ] (i : ℕ) :
  ∑ x : Kˣ, (x ^ i : K) = if (q - 1) ∣ i then -1 else 0 :=
begin
  let φ : Kˣ →* K :=
  { to_fun   := λ x, x ^ i,
    map_one' := by rw [units.coe_one, one_pow],
    map_mul' := by { intros, rw [units.coe_mul, mul_pow] } },
  haveI : decidable (φ = 1), { classical, apply_instance },
  calc ∑ x : Kˣ, φ x = if φ = 1 then fintype.card Kˣ else 0 : sum_hom_units φ
                      ... = if (q - 1) ∣ i then -1 else 0 : _,
  suffices : (q - 1) ∣ i ↔ φ = 1,
  { simp only [this],
    split_ifs with h h, swap, refl,
    rw [fintype.card_units, nat.cast_sub, cast_card_eq_zero, nat.cast_one, zero_sub],
    show 1 ≤ q, from fintype.card_pos_iff.mpr ⟨0⟩ },
  rw [← forall_pow_eq_one_iff, monoid_hom.ext_iff],
  apply forall_congr, intro x,
  rw [units.ext_iff, units.coe_pow, units.coe_one, monoid_hom.one_apply],
  refl,
end

/-- The sum of `x ^ i` as `x` ranges over a finite field of cardinality `q`
is equal to `0` if `i < q - 1`. -/
lemma sum_pow_lt_card_sub_one (i : ℕ) (h : i < q - 1) :
  ∑ x : K, x ^ i = 0 :=
begin
  by_cases hi : i = 0,
  { simp only [hi, nsmul_one, sum_const, pow_zero, card_univ, cast_card_eq_zero], },
  classical,
  have hiq : ¬ (q - 1) ∣ i, { contrapose! h,  exact nat.le_of_dvd (nat.pos_of_ne_zero hi) h },
  let φ : Kˣ ↪ K := ⟨coe, units.ext⟩,
  have : univ.map φ = univ \ {0},
  { ext x,
    simp only [true_and, embedding.coe_fn_mk, mem_sdiff, units.exists_iff_ne_zero,
               mem_univ, mem_map, exists_prop_of_true, mem_singleton] },
  calc ∑ x : K, x ^ i = ∑ x in univ \ {(0 : K)}, x ^ i :
    by rw [← sum_sdiff ({0} : finset K).subset_univ, sum_singleton,
           zero_pow (nat.pos_of_ne_zero hi), add_zero]
    ... = ∑ x : Kˣ, x ^ i : by { rw [← this, univ.sum_map φ], refl }
    ... = 0 : by { rw [sum_pow_units K i, if_neg], exact hiq, }
end

section is_splitting_field
open polynomial

section

variables (K' : Type*) [field K'] {p n : ℕ}

lemma X_pow_card_sub_X_nat_degree_eq (hp : 1 < p) :
  (X ^ p - X : K'[X]).nat_degree = p :=
begin
  have h1 : (X : K'[X]).degree < (X ^ p : K'[X]).degree,
  { rw [degree_X_pow, degree_X],
    exact_mod_cast hp },
  rw [nat_degree_eq_of_degree_eq (degree_sub_eq_left_of_degree_lt h1), nat_degree_X_pow],
end

lemma X_pow_card_pow_sub_X_nat_degree_eq (hn : n ≠ 0) (hp : 1 < p) :
  (X ^ p ^ n - X : K'[X]).nat_degree = p ^ n :=
X_pow_card_sub_X_nat_degree_eq K' $ nat.one_lt_pow _ _ (nat.pos_of_ne_zero hn) hp

lemma X_pow_card_sub_X_ne_zero (hp : 1 < p) : (X ^ p - X : K'[X]) ≠ 0 :=
ne_zero_of_nat_degree_gt $
calc 1 < _ : hp
... = _ : (X_pow_card_sub_X_nat_degree_eq K' hp).symm

lemma X_pow_card_pow_sub_X_ne_zero (hn : n ≠ 0) (hp : 1 < p) :
  (X ^ p ^ n - X : K'[X]) ≠ 0 :=
X_pow_card_sub_X_ne_zero K' $ nat.one_lt_pow _ _ (nat.pos_of_ne_zero hn) hp

end

variables (p : ℕ) [fact p.prime] [algebra (zmod p) K]
lemma roots_X_pow_card_sub_X : roots (X^q - X : K[X]) = finset.univ.val :=
begin
  classical,
  have aux : (X^q - X : K[X]) ≠ 0 := X_pow_card_sub_X_ne_zero K fintype.one_lt_card,
  have : (roots (X^q - X : K[X])).to_finset = finset.univ,
  { rw eq_univ_iff_forall,
    intro x,
    rw [multiset.mem_to_finset, mem_roots aux, is_root.def, eval_sub, eval_pow, eval_X, sub_eq_zero,
      pow_card] },
  rw [←this, multiset.to_finset_val, eq_comm, multiset.dedup_eq_self],
  apply nodup_roots,
  rw separable_def,
  convert is_coprime_one_right.neg_right using 1,
  { rw [derivative_sub, derivative_X, derivative_X_pow, ←C_eq_nat_cast,
    C_eq_zero.mpr (char_p.cast_card_eq_zero K), zero_mul, zero_sub], },
  end

instance (F : Type*) [field F] [algebra F K] : is_splitting_field F K (X^q - X) :=
{ splits :=
  begin
    have h : (X^q - X : K[X]).nat_degree = q :=
      X_pow_card_sub_X_nat_degree_eq K fintype.one_lt_card,
    rw [←splits_id_iff_splits, splits_iff_card_roots, polynomial.map_sub, polynomial.map_pow,
      map_X, h, roots_X_pow_card_sub_X K, ←finset.card_def, finset.card_univ],
  end,
  adjoin_roots :=
  begin
    classical,
    transitivity algebra.adjoin F ((roots (X^q - X : K[X])).to_finset : set K),
    { simp only [polynomial.map_pow, map_X, polynomial.map_sub], },
    { rw [roots_X_pow_card_sub_X, val_to_finset, coe_univ, algebra.adjoin_univ], }
  end }

end is_splitting_field

variables {K}

theorem frobenius_pow {p : ℕ} [fact p.prime] [char_p K p] {n : ℕ} (hcard : q = p^n) :
  (frobenius K p) ^ n = 1 :=
begin
  ext, conv_rhs { rw [ring_hom.one_def, ring_hom.id_apply, ← pow_card x, hcard], }, clear hcard,
  induction n, {simp},
  rw [pow_succ, pow_succ', pow_mul, ring_hom.mul_def, ring_hom.comp_apply, frobenius_def, n_ih]
end

open polynomial

lemma expand_card (f : K[X]) :
  expand K q f = f ^ q :=
begin
  cases char_p.exists K with p hp,
  letI := hp,
  rcases finite_field.card K p with ⟨⟨n, npos⟩, ⟨hp, hn⟩⟩,
  haveI : fact p.prime := ⟨hp⟩,
  dsimp at hn,
  rw [hn, ← map_expand_pow_char, frobenius_pow hn, ring_hom.one_def, map_id]
end

end finite_field

namespace zmod

open finite_field polynomial

lemma sq_add_sq (p : ℕ) [hp : fact p.prime] (x : zmod p) :
  ∃ a b : zmod p, a^2 + b^2 = x :=
begin
  cases hp.1.eq_two_or_odd with hp2 hp_odd,
  { substI p, change fin 2 at x, fin_cases x, { use 0, simp }, { use [0, 1], simp } },
  let f : (zmod p)[X] := X^2,
  let g : (zmod p)[X] := X^2 - C x,
  obtain ⟨a, b, hab⟩ : ∃ a b, f.eval a + g.eval b = 0 :=
    @exists_root_sum_quadratic _ _ _ _ f g
      (degree_X_pow 2) (degree_X_pow_sub_C dec_trivial _) (by rw [zmod.card, hp_odd]),
  refine ⟨a, b, _⟩,
  rw ← sub_eq_zero,
  simpa only [eval_C, eval_X, eval_pow, eval_sub, ← add_sub_assoc] using hab,
end

end zmod

namespace char_p

lemma sq_add_sq (R : Type*) [comm_ring R] [is_domain R]
  (p : ℕ) [fact (0 < p)] [char_p R p] (x : ℤ) :
  ∃ a b : ℕ, (a^2 + b^2 : R) = x :=
begin
  haveI := char_is_prime_of_pos R p,
  obtain ⟨a, b, hab⟩ := zmod.sq_add_sq p x,
  refine ⟨a.val, b.val, _⟩,
  simpa using congr_arg (zmod.cast_hom dvd_rfl R) hab
end

end char_p

open_locale nat
open zmod

/-- The **Fermat-Euler totient theorem**. `nat.modeq.pow_totient` is an alternative statement
  of the same theorem. -/
@[simp] lemma zmod.pow_totient {n : ℕ} [fact (0 < n)] (x : (zmod n)ˣ) : x ^ φ n = 1 :=
by rw [← card_units_eq_totient, pow_card_eq_one]

/-- The **Fermat-Euler totient theorem**. `zmod.pow_totient` is an alternative statement
  of the same theorem. -/
lemma nat.modeq.pow_totient {x n : ℕ} (h : nat.coprime x n) : x ^ φ n ≡ 1 [MOD n] :=
begin
  cases n, {simp},
  rw ← zmod.eq_iff_modeq_nat,
  let x' : units (zmod (n+1)) := zmod.unit_of_coprime _ h,
  have := zmod.pow_totient x',
  apply_fun (coe : units (zmod (n+1)) → zmod (n+1)) at this,
  simpa only [-zmod.pow_totient, nat.succ_eq_add_one, nat.cast_pow, units.coe_one,
    nat.cast_one, coe_unit_of_coprime, units.coe_pow],
end

section

variables {V : Type*} [fintype K] [division_ring K] [add_comm_group V] [module K V]

-- should this go in a namespace?
-- finite_dimensional would be natural,
-- but we don't assume it...
lemma card_eq_pow_finrank [fintype V] :
  fintype.card V = q ^ (finite_dimensional.finrank K V) :=
begin
  let b := is_noetherian.finset_basis K V,
  rw [module.card_fintype b, ← finite_dimensional.finrank_eq_card_basis b],
end

end

open finite_field
namespace zmod

/-- A variation on Fermat's little theorem. See `zmod.pow_card_sub_one_eq_one` -/
@[simp] lemma pow_card {p : ℕ} [fact p.prime] (x : zmod p) : x ^ p = x :=
by { have h := finite_field.pow_card x, rwa zmod.card p at h }

@[simp] lemma pow_card_pow {n p : ℕ} [fact p.prime] (x : zmod p) : x ^ p ^ n = x :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, pow_mul, ih, pow_card], },
end

@[simp] lemma frobenius_zmod (p : ℕ) [fact p.prime] :
  frobenius (zmod p) p = ring_hom.id _ :=
by { ext a, rw [frobenius_def, zmod.pow_card, ring_hom.id_apply] }

@[simp] lemma card_units (p : ℕ) [fact p.prime] : fintype.card ((zmod p)ˣ) = p - 1 :=
by rw [fintype.card_units, card]

/-- **Fermat's Little Theorem**: for every unit `a` of `zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem units_pow_card_sub_one_eq_one (p : ℕ) [fact p.prime] (a : (zmod p)ˣ) :
  a ^ (p - 1) = 1 :=
by rw [← card_units p, pow_card_eq_one]

/-- **Fermat's Little Theorem**: for all nonzero `a : zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem pow_card_sub_one_eq_one {p : ℕ} [fact p.prime] {a : zmod p} (ha : a ≠ 0) :
  a ^ (p - 1) = 1 :=
by { have h := pow_card_sub_one_eq_one a ha, rwa zmod.card p at h }

open polynomial

lemma expand_card {p : ℕ} [fact p.prime] (f : polynomial (zmod p)) :
  expand (zmod p) p f = f ^ p :=
by { have h := finite_field.expand_card f, rwa zmod.card p at h }

end zmod

/-- **Fermat's Little Theorem**: for all `a : ℤ` coprime to `p`, we have
`a ^ (p - 1) ≡ 1 [ZMOD p]`. -/
lemma int.modeq.pow_card_sub_one_eq_one {p : ℕ} (hp : nat.prime p) {n : ℤ} (hpn : is_coprime n p) :
  n ^ (p - 1) ≡ 1 [ZMOD p] :=
begin
  haveI : fact p.prime := ⟨hp⟩,
  have : ¬ (n : zmod p) = 0,
  { rw [char_p.int_cast_eq_zero_iff _ p, ← (nat.prime_iff_prime_int.mp hp).coprime_iff_not_dvd],
    { exact hpn.symm },
    exact zmod.char_p p },
  simpa [← zmod.int_coe_eq_int_coe_iff] using zmod.pow_card_sub_one_eq_one this
end

section

namespace finite_field

variables {F : Type*} [field F] [fintype F]

/-- In a finite field of characteristic `2`, all elements are squares. -/
lemma is_square_of_char_two (hF : ring_char F = 2) (a : F) : is_square a :=
begin
  haveI hF' : char_p F 2 := ring_char.of_eq hF,
  exact is_square_of_char_two' a,
end

/-- The finite field `F` has even cardinality iff it has characteristic `2`. -/
lemma even_card_iff_char_two : ring_char F = 2 ↔ fintype.card F % 2 = 0 :=
begin
  rcases finite_field.card F (ring_char F) with ⟨n, hp, h⟩,
  rw [h, nat.pow_mod],
  split,
  { intro hF,
    rw hF,
    simp only [nat.bit0_mod_two, zero_pow', ne.def, pnat.ne_zero, not_false_iff, nat.zero_mod], },
  { rw [← nat.even_iff, nat.even_pow],
    rintros ⟨hev, hnz⟩,
    rw [nat.even_iff, nat.mod_mod] at hev,
    exact (nat.prime.eq_two_or_odd hp).resolve_right (ne_of_eq_of_ne hev zero_ne_one), },
end

lemma even_card_of_char_two (hF : ring_char F = 2) : fintype.card F % 2 = 0 :=
even_card_iff_char_two.mp hF

lemma odd_card_of_char_ne_two (hF : ring_char F ≠ 2) : fintype.card F % 2 = 1 :=
nat.mod_two_ne_zero.mp (mt even_card_iff_char_two.mpr hF)

/-- If `F` has odd characteristic, then for nonzero `a : F`, we have that `a ^ (#F / 2) = ±1`. -/
lemma pow_dichotomy (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
  a ^ (fintype.card F / 2) = 1 ∨ a ^ (fintype.card F / 2) = -1 :=
begin
  have h₁ := finite_field.pow_card_sub_one_eq_one a ha,
  rw [← nat.two_mul_odd_div_two (finite_field.odd_card_of_char_ne_two hF),
      mul_comm, pow_mul, pow_two] at h₁,
  exact mul_self_eq_one_iff.mp h₁,
end

/-- A unit `a` of a finite field `F` of odd characteristic is a square
if and only if `a ^ (#F / 2) = 1`. -/
lemma unit_is_square_iff (hF : ring_char F ≠ 2) (a : Fˣ) :
  is_square a ↔ a ^ (fintype.card F / 2) = 1 :=
begin
  classical,
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator Fˣ,
  obtain ⟨n, hn⟩ : a ∈ submonoid.powers g, { rw mem_powers_iff_mem_zpowers, apply hg },
  have hodd := nat.two_mul_odd_div_two (finite_field.odd_card_of_char_ne_two hF),
  split,
  { rintro ⟨y, rfl⟩,
    rw [← pow_two, ← pow_mul, hodd],
    apply_fun (@coe Fˣ F _) using units.ext,
    { push_cast,
      exact finite_field.pow_card_sub_one_eq_one (y : F) (units.ne_zero y), }, },
  { subst a, assume h,
    have key : 2 * (fintype.card F / 2) ∣ n * (fintype.card F / 2),
    { rw [← pow_mul] at h,
      rw [hodd, ← fintype.card_units, ← order_of_eq_card_of_forall_mem_zpowers hg],
      apply order_of_dvd_of_pow_eq_one h },
    have : 0 < fintype.card F / 2 := nat.div_pos fintype.one_lt_card (by norm_num),
    obtain ⟨m, rfl⟩ := nat.dvd_of_mul_dvd_mul_right this key,
    refine ⟨g ^ m, _⟩,
    rw [mul_comm, pow_mul, pow_two], },
end

/-- A non-zero `a : F` is a square if and only if `a ^ (#F / 2) = 1`. -/
lemma is_square_iff (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
  is_square a ↔ a ^ (fintype.card F / 2) = 1 :=
begin
  apply (iff_congr _ (by simp [units.ext_iff])).mp
        (finite_field.unit_is_square_iff hF (units.mk0 a ha)),
  simp only [is_square, units.ext_iff, units.coe_mk0, units.coe_mul],
  split,
  { rintro ⟨y, hy⟩, exact ⟨y, hy⟩ },
  { rintro ⟨y, rfl⟩,
    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
    refine ⟨units.mk0 y hy, _⟩, simp, }
end

/-- In a finite field of odd characteristic, not every element is a square. -/
lemma exists_nonsquare (hF : ring_char F ≠ 2) : ∃ (a : F), ¬ is_square a :=
begin
  -- idea: the squaring map on `F` is not injetive, hence not surjective
  let sq : F → F := λ x, x ^ 2,
  have h : ¬ function.injective sq,
  { simp only [function.injective, not_forall, exists_prop],
    use [-1, 1],
    split,
    { simp only [sq, one_pow, neg_one_sq], },
    { exact ring.neg_one_ne_one_of_char_ne_two hF, }, },
  have h₁ := mt (fintype.injective_iff_surjective.mpr) h, -- sq not surjective
  push_neg at h₁,
  cases h₁ with a h₁,
  use a,
  simp only [is_square, sq, not_exists, ne.def] at h₁ ⊢,
  intros b hb,
  rw ← pow_two at hb,
  exact h₁ b hb.symm,
end

end finite_field

end


/-
A two's complement representation of signed integers, implemented as a struct pulling back
on the prelude's signed integer types. For example, the relationship between
unsigned (UInt8) and signed (Int8) is:

unsigned (UInt8) : 0, 1 ............ 127,  128 ............ 254, 255
signed   (Int8)  : 0, 1 ............ 127, -128 ............  -2, -1
-/
structure Int8 where
  val : UInt8
deriving DecidableEq

def Int8.ofNat (n : Nat) : Int8 := ⟨OfNat.ofNat n⟩

instance (n : Nat) : OfNat Int8 n := ⟨Int8.ofNat n⟩

def Int8.neg : Int8 -> Int8
| ⟨⟨a, isLt⟩⟩ => ⟨(UInt8.size - a) % UInt8.size, Nat.mod_lt _ (Nat.lt_of_le_of_lt (Nat.zero_le _) isLt)⟩

instance : Neg Int8 := ⟨Int8.neg⟩

def Int8.max : Int8 := 127
def Int8.min : Int8 := -128

theorem Int8.eq_of_val_eq : ∀ {a b : Int8}, a.val = b.val -> a = b
| ⟨_⟩, _, rfl => rfl

theorem Int8.ne_of_val_ne : ∀ {a b : Int8}, a.val ≠ b.val -> a ≠ b
| _, _, h => fun a_eq_b => Int8.noConfusion a_eq_b h

theorem Int8.val_eq_of_eq : ∀ {a b : Int8}, a = b -> a.val = b.val
| ⟨_⟩, _, rfl => rfl

theorem Int8.val_ne_of_ne : ∀ {a b : Int8}, a ≠ b -> a.val ≠ b.val
| _, _, h => fun h' => absurd (Int8.eq_of_val_eq h') h

def Int8.isPositive (a : Int8) : Bool := a.val.val < (UInt8.size / 2)

def Int8.isNegative (a : Int8) : Bool := ¬a.isPositive

def Int8.toInt (a : Int8) : Int :=
  if a.isPositive
  then Int.ofNat a.val.toNat
  else Int.subNatNat a.val.toNat UInt8.size

def Int8.toString (a : Int8) : String := s!"{a.toInt}"

instance : ToString Int8 := ⟨Int8.toString⟩

def Int8.ofInt : Int -> Int8
| Int.ofNat n => Int8.ofNat n
| Int.negSucc n => -(Int8.ofNat n.succ)

def Int8.modn (a : Int8) (n : Nat) : Int8 := Int8.ofInt <| a.toInt % (Int.ofNat n)

def Int8.shiftLeft (a b : Int8) : Int8 := ⟨a.val.shiftLeft b.val⟩

def Int8.shiftRight (a b : Int8) : Int8 := ⟨a.val.shiftRight b.val⟩

def Int8.land (a b : Int8) : Int8 := ⟨a.val.land b.val⟩

def Int8.lor (a b : Int8) : Int8 := ⟨a.val.lor b.val⟩

def Int8.xor (a b : Int8) : Int8 := ⟨a.val.xor b.val⟩

instance : HMod Int8 Nat Int8 := ⟨Int8.modn⟩
instance : AndOp Int8     := ⟨Int8.land⟩
instance : OrOp Int8      := ⟨Int8.lor⟩
instance : Xor Int8       := ⟨Int8.xor⟩
instance : ShiftLeft Int8  := ⟨Int8.shiftLeft⟩
instance : ShiftRight Int8 := ⟨Int8.shiftRight⟩

def Int8.add : Int8 -> Int8 -> Int8
| ⟨a⟩, ⟨b⟩ => ⟨a + b⟩

instance : Add Int8 := ⟨Int8.add⟩

def Int8.sub (a b : Int8) : Int8 := a + -b

def Int8.mul : Int8 -> Int8 -> Int8
| ⟨a⟩, ⟨b⟩ => ⟨a * b⟩

def Int8.mod (a m : Int8) : Int8 := Int8.ofInt (a.toInt % m.toInt)

def Int8.div (a b : Int8) : Int8 := Int8.ofInt (a.toInt / b.toInt)

instance : Sub Int8 := ⟨Int8.sub⟩

instance : Mul Int8 := ⟨Int8.mul⟩

instance : Mod Int8 := ⟨Int8.mod⟩

instance : Div Int8 := ⟨Int8.div⟩

def Int8.le (a b : Int8) : Prop := a.toInt <= b.toInt
def Int8.lt (a b : Int8) : Prop := a.toInt < b.toInt

instance : LE Int8 := ⟨Int8.le⟩

instance : LT Int8 := ⟨Int8.lt⟩

instance (a b : Int8) : Decidable (a <= b) :=
  dite (a.toInt <= b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

instance (a b : Int8) : Decidable (a < b) :=
  dite (a.toInt < b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

structure Int16 where
  val : UInt16
deriving DecidableEq

def Int16.ofNat (n : Nat) : Int16 := ⟨OfNat.ofNat n⟩

instance (n : Nat) : OfNat Int16 n := ⟨Int16.ofNat n⟩

def Int16.neg : Int16 -> Int16
| ⟨⟨a, isLt⟩⟩ => ⟨(UInt16.size - a) % UInt16.size, Nat.mod_lt _ (Nat.lt_of_le_of_lt (Nat.zero_le _) isLt)⟩

instance : Neg Int16 := ⟨Int16.neg⟩

def Int16.max : Int16 := -32767
def Int16.min : Int16 := -32768

theorem Int16.eq_of_val_eq : ∀ {a b : Int16}, a.val = b.val -> a = b
| ⟨_⟩, _, rfl => rfl

theorem Int16.ne_of_val_ne : ∀ {a b : Int16}, a.val ≠ b.val -> a ≠ b
| _, _, h => fun a_eq_b => Int16.noConfusion a_eq_b h

theorem Int16.val_eq_of_eq : ∀ {a b : Int16}, a = b -> a.val = b.val
| ⟨_⟩, _, rfl => rfl

theorem Int16.val_ne_of_ne : ∀ {a b : Int16}, a ≠ b -> a.val ≠ b.val
| _, _, h => fun h' => absurd (Int16.eq_of_val_eq h') h

def Int16.isPositive (a : Int16) : Bool := a.val.val < (UInt16.size / 2)

def Int16.isNegative (a : Int16) : Bool := ¬a.isPositive

def Int16.toInt (a : Int16) : Int :=
  if a.isPositive
  then Int.ofNat a.val.toNat
  else Int.subNatNat a.val.toNat UInt16.size

def Int16.toString (a : Int16) : String := s!"{a.toInt}"

instance : ToString Int16 := ⟨Int16.toString⟩

def Int16.ofInt : Int -> Int16
| Int.ofNat n => Int16.ofNat n
| Int.negSucc n => -(Int16.ofNat n.succ)

def Int16.modn (a : Int16) (n : Nat) : Int16 := Int16.ofInt <| a.toInt % (Int.ofNat n)

def Int16.shiftLeft (a b : Int16) : Int16 := ⟨a.val.shiftLeft b.val⟩

def Int16.shiftRight (a b : Int16) : Int16 := ⟨a.val.shiftRight b.val⟩

def Int16.land (a b : Int16) : Int16 := ⟨a.val.land b.val⟩

def Int16.lor (a b : Int16) : Int16 := ⟨a.val.lor b.val⟩

def Int16.xor (a b : Int16) : Int16 := ⟨a.val.xor b.val⟩

instance : HMod Int16 Nat Int16 := ⟨Int16.modn⟩
instance : AndOp Int16     := ⟨Int16.land⟩
instance : OrOp Int16      := ⟨Int16.lor⟩
instance : Xor Int16       := ⟨Int16.xor⟩
instance : ShiftLeft Int16  := ⟨Int16.shiftLeft⟩
instance : ShiftRight Int16 := ⟨Int16.shiftRight⟩

def Int16.add : Int16 -> Int16 -> Int16
| ⟨a⟩, ⟨b⟩ => ⟨a + b⟩

instance : Add Int16 := ⟨Int16.add⟩

def Int16.sub (a b : Int16) : Int16 := a + -b

instance : Sub Int16 := ⟨Int16.sub⟩

def Int16.mul : Int16 -> Int16 -> Int16
| ⟨a⟩, ⟨b⟩ => ⟨a * b⟩

def Int16.div (a b : Int16) : Int16 := Int16.ofInt (a.toInt / b.toInt)
def Int16.mod (a m : Int16) : Int16 := Int16.ofInt (a.toInt % m.toInt)

instance : Mul Int16 := ⟨Int16.mul⟩

instance : Mod Int16 := ⟨Int16.mod⟩

instance : Div Int16 := ⟨Int16.div⟩

def Int16.le (a b : Int16) : Prop := a.toInt <= b.toInt
def Int16.lt (a b : Int16) : Prop := a.toInt < b.toInt

instance : LE Int16 := ⟨Int16.le⟩

instance : LT Int16 := ⟨Int16.lt⟩

instance (a b : Int16) : Decidable (a <= b) :=
  dite (a.toInt <= b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

instance (a b : Int16) : Decidable (a < b) :=
  dite (a.toInt < b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

structure Int32 where
  val : UInt32
deriving DecidableEq

def Int32.ofNat (n : Nat) : Int32 := ⟨OfNat.ofNat n⟩

instance (n : Nat) : OfNat Int32 n := ⟨Int32.ofNat n⟩

def Int32.neg : Int32 -> Int32
| ⟨⟨a, isLt⟩⟩ => ⟨(UInt32.size - a) % UInt32.size, Nat.mod_lt _ (Nat.lt_of_le_of_lt (Nat.zero_le _) isLt)⟩

instance : Neg Int32 := ⟨Int32.neg⟩

def Int32.min : Int32 := -2147483648
def Int32.max : Int32 := 2147483647

theorem Int32.eq_of_val_eq : ∀ {a b : Int32}, a.val = b.val -> a = b
| ⟨_⟩, _, rfl => rfl

theorem Int32.ne_of_val_ne : ∀ {a b : Int32}, a.val ≠ b.val -> a ≠ b
| _, _, h => fun a_eq_b => Int32.noConfusion a_eq_b h

theorem Int32.val_eq_of_eq : ∀ {a b : Int32}, a = b -> a.val = b.val
| ⟨_⟩, _, rfl => rfl

theorem Int32.val_ne_of_ne : ∀ {a b : Int32}, a ≠ b -> a.val ≠ b.val
| _, _, h => fun h' => absurd (Int32.eq_of_val_eq h') h

def Int32.isPositive (a : Int32) : Bool := a.val.val < (UInt32.size / 2)

def Int32.isNegative (a : Int32) : Bool := ¬a.isPositive

def Int32.toInt (a : Int32) : Int :=
  if a.isPositive
  then Int.ofNat a.val.toNat
  else Int.subNatNat a.val.toNat UInt32.size

def Int32.toString (a : Int32) : String := s!"{a.toInt}"

instance : ToString Int32 := ⟨Int32.toString⟩

def Int32.ofInt : Int -> Int32
| Int.ofNat n => Int32.ofNat n
| Int.negSucc n => -(Int32.ofNat n.succ)

def Int32.modn (a : Int32) (n : Nat) : Int32 := Int32.ofInt <| a.toInt % (Int.ofNat n)

def Int32.shiftLeft (a b : Int32) : Int32 := ⟨a.val.shiftLeft b.val⟩

def Int32.shiftRight (a b : Int32) : Int32 := ⟨a.val.shiftRight b.val⟩

def Int32.land (a b : Int32) : Int32 := ⟨a.val.land b.val⟩

def Int32.lor (a b : Int32) : Int32 := ⟨a.val.lor b.val⟩

def Int32.xor (a b : Int32) : Int32 := ⟨a.val.xor b.val⟩

instance : HMod Int32 Nat Int32 := ⟨Int32.modn⟩
instance : AndOp Int32     := ⟨Int32.land⟩
instance : OrOp Int32      := ⟨Int32.lor⟩
instance : Xor Int32       := ⟨Int32.xor⟩
instance : ShiftLeft Int32  := ⟨Int32.shiftLeft⟩
instance : ShiftRight Int32 := ⟨Int32.shiftRight⟩

def Int32.add : Int32 -> Int32 -> Int32
| ⟨a⟩, ⟨b⟩ => ⟨a + b⟩

instance : Add Int32 := ⟨Int32.add⟩

def Int32.sub (a b : Int32) : Int32 := a + -b

instance : Sub Int32 := ⟨Int32.sub⟩

def Int32.mul : Int32 -> Int32 -> Int32
| ⟨a⟩, ⟨b⟩ => ⟨a * b⟩

def Int32.div (a b : Int32) : Int32 := Int32.ofInt (a.toInt / b.toInt)
def Int32.mod (a m : Int32) : Int32 := Int32.ofInt (a.toInt % m.toInt)

instance : Mul Int32 := ⟨Int32.mul⟩

instance : Mod Int32 := ⟨Int32.mod⟩

instance : Div Int32 := ⟨Int32.div⟩

def Int32.le (a b : Int32) : Prop := a.toInt <= b.toInt
def Int32.lt (a b : Int32) : Prop := a.toInt < b.toInt

instance : LE Int32 := ⟨Int32.le⟩

instance : LT Int32 := ⟨Int32.lt⟩

instance (a b : Int32) : Decidable (a <= b) :=
  dite (a.toInt <= b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

instance (a b : Int32) : Decidable (a < b) :=
  dite (a.toInt < b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

structure Int64 where
  val : UInt64
deriving DecidableEq

def Int64.ofNat (n : Nat) : Int64 := ⟨OfNat.ofNat n⟩

instance (n : Nat) : OfNat Int64 n := ⟨Int64.ofNat n⟩

theorem Int64.eq_of_val_eq : ∀ {a b : Int64}, a.val = b.val -> a = b
| ⟨_⟩, _, rfl => rfl

theorem Int64.ne_of_val_ne : ∀ {a b : Int64}, a.val ≠ b.val -> a ≠ b
| _, _, h => fun a_eq_b => Int64.noConfusion a_eq_b h

theorem Int64.val_eq_of_eq : ∀ {a b : Int64}, a = b -> a.val = b.val
| ⟨_⟩, _, rfl => rfl

theorem Int64.val_ne_of_ne : ∀ {a b : Int64}, a ≠ b -> a.val ≠ b.val
| _, _, h => fun h' => absurd (Int64.eq_of_val_eq h') h

def Int64.neg : Int64 -> Int64
| ⟨⟨a, isLt⟩⟩ => ⟨(UInt64.size - a) % UInt64.size, Nat.mod_lt _ (Nat.lt_of_le_of_lt (Nat.zero_le _) isLt)⟩

instance : Neg Int64 := ⟨Int64.neg⟩

abbrev Int64.min : Int64 := -9223372036854775808
abbrev Int64.max : Int64 := 9223372036854775807
/-
Fin.val <= 9223372036854775807
-/
/-
Not sure whether it's an issue to cast all the way to `nat` here.
-/
--def Int64.isPositive (a : Int64) : Bool := a.val.val.val < (UInt64.size / 2)
def Int64.isPositive (a : Int64) : Bool := a.val <= (9223372036854775807 : UInt64)

theorem Int64.isPositive_eq_true_iff (a : Int64) : a.isPositive = true ↔ a.val <= (9223372036854775807 : UInt64) := by
  simp [Int64.isPositive]

def Int64.isNegative (a : Int64) : Bool := ¬a.isPositive

/-
There's probably a better way to do this.
-/
def Int64.toInt (a : Int64) : Int :=
  if a.isPositive
  then Int.ofNat a.val.toNat
  else Int.subNatNat a.val.toNat UInt64.size

def Int64.toString (a : Int64) : String := s!"{a.toInt}"

instance : ToString Int64 := ⟨Int64.toString⟩

def Int64.ofInt : Int → Int64
| Int.ofNat n => Int64.ofNat n
| Int.negSucc n => -(Int64.ofNat n.succ)

def Int64.modn (a : Int64) (n : Nat) : Int64 := Int64.ofInt <| a.toInt % (Int.ofNat n)

def Int64.shiftLeft (a b : Int64) : Int64 := ⟨a.val.shiftLeft b.val⟩

def Int64.shiftRight (a b : Int64) : Int64 := ⟨a.val.shiftRight b.val⟩

def Int64.land (a b : Int64) : Int64 := ⟨a.val.land b.val⟩

def Int64.lor (a b : Int64) : Int64 := ⟨a.val.lor b.val⟩

def Int64.xor (a b : Int64) : Int64 := ⟨a.val.xor b.val⟩

instance : HMod Int64 Nat Int64 := ⟨Int64.modn⟩
instance : AndOp Int64     := ⟨Int64.land⟩
instance : OrOp Int64      := ⟨Int64.lor⟩
instance : Xor Int64       := ⟨Int64.xor⟩
instance : ShiftLeft Int64  := ⟨Int64.shiftLeft⟩
instance : ShiftRight Int64 := ⟨Int64.shiftRight⟩

def Int64.add : Int64 -> Int64 -> Int64
| ⟨a⟩, ⟨b⟩ => ⟨a + b⟩

instance : Add Int64 := ⟨Int64.add⟩

def Int64.sub (a b : Int64) : Int64 := a + -b

instance : Sub Int64 := ⟨Int64.sub⟩

def Int64.mul : Int64 -> Int64 -> Int64
| ⟨a⟩, ⟨b⟩ => ⟨a * b⟩

def Int64.div (a b : Int64) : Int64 := Int64.ofInt (a.toInt / b.toInt)
def Int64.mod (a m : Int64) : Int64 := Int64.ofInt (a.toInt % m.toInt)

instance : Mul Int64 := ⟨Int64.mul⟩

instance : Mod Int64 := ⟨Int64.mod⟩

instance : Div Int64 := ⟨Int64.div⟩

def Int64.le (a b : Int64) : Prop := a.toInt <= b.toInt
def Int64.lt (a b : Int64) : Prop := a.toInt < b.toInt

instance : LE Int64 := ⟨Int64.le⟩

instance : LT Int64 := ⟨Int64.lt⟩

instance (a b : Int64) : Decidable (a <= b) :=
  dite (a.toInt <= b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

instance (a b : Int64) : Decidable (a < b) :=
  dite (a.toInt < b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

/-
sameSign a b ∧ differentSign a out
-/
def Int64.wrappingAdd (a b : Int64) : (Bool × Int64) :=
  let sum := a + b
  let oob :=
    if a.isPositive
    then
      if b.isPositive
      then sum.isNegative
      else false
    else
      if b.isNegative
      then sum.isPositive
      else false
  (oob, sum)

def Int64.checkedAdd (a b : Int64) : Option Int64 :=
  match a.wrappingAdd b with
  | (true, _) => none
  | (false, sum) => some sum

structure ISize where
  val : USize
deriving DecidableEq

def ISize.ofNat (n : Nat) : ISize := ⟨OfNat.ofNat n⟩

instance (n : Nat) : OfNat ISize n := ⟨ISize.ofNat n⟩

theorem ISize.eq_of_val_eq : ∀ {a b : ISize}, a.val = b.val -> a = b
| _, _, h => congrArg ISize.mk h

theorem ISize.ne_of_val_ne : ∀ {a b : ISize}, a.val ≠ b.val -> a ≠ b
| _, _, h => fun a_eq_b => ISize.noConfusion a_eq_b h

theorem ISize.val_eq_of_eq : ∀ {a b : ISize}, a = b -> a.val = b.val
| _, _, h => congrArg ISize.val h

theorem ISize.val_ne_of_ne : ∀ {a b : ISize}, a ≠ b -> a.val ≠ b.val
| _, _, h => fun h' => absurd (ISize.eq_of_val_eq h') h

def ISize.isPositive (a : ISize) : Bool := a.val.val < (USize.size / 2)

def ISize.isNegative (a : ISize) : Bool := ¬a.isPositive

def ISize.toInt (a : ISize) : Int :=
  if a.isPositive
  then Int.ofNat a.val.toNat
  else Int.subNatNat a.val.toNat USize.size

def ISize.toString (a : ISize) : String := s!"{a.toInt}"

instance : ToString ISize := ⟨ISize.toString⟩

def ISize.neg : ISize -> ISize
| ⟨⟨a, isLt⟩⟩ => ⟨(USize.size - a) % USize.size, Nat.mod_lt _ (Nat.lt_of_le_of_lt (Nat.zero_le _) isLt)⟩

instance : Neg ISize := ⟨ISize.neg⟩

def ISize.ofInt : Int -> ISize
| Int.ofNat n => ISize.ofNat n
| Int.negSucc n => -(ISize.ofNat n.succ)

def ISize.modn (a : ISize) (n : Nat) : ISize := ISize.ofInt <| a.toInt % (Int.ofNat n)

def ISize.shiftLeft (a b : ISize) : ISize := ⟨a.val.shiftLeft b.val⟩

def ISize.shiftRight (a b : ISize) : ISize := ⟨a.val.shiftRight b.val⟩

def ISize.land (a b : ISize) : ISize := ⟨a.val.land b.val⟩

def ISize.lor (a b : ISize) : ISize := ⟨a.val.lor b.val⟩

def ISize.xor (a b : ISize) : ISize := ⟨a.val.xor b.val⟩

instance : HMod ISize Nat ISize := ⟨ISize.modn⟩
instance : AndOp ISize     := ⟨ISize.land⟩
instance : OrOp ISize      := ⟨ISize.lor⟩
instance : Xor ISize       := ⟨ISize.xor⟩
instance : ShiftLeft ISize  := ⟨ISize.shiftLeft⟩
instance : ShiftRight ISize := ⟨ISize.shiftRight⟩

def ISize.add : ISize -> ISize -> ISize
| ⟨a⟩, ⟨b⟩ => ⟨a + b⟩

instance : Add ISize := ⟨ISize.add⟩

def ISize.sub (a b : ISize) : ISize := a + -b

instance : Sub ISize := ⟨ISize.sub⟩

def ISize.mul : ISize -> ISize -> ISize
| ⟨a⟩, ⟨b⟩ => ⟨a * b⟩

def ISize.div (a b : ISize) : ISize := ISize.ofInt (a.toInt / b.toInt)
def ISize.mod (a m : ISize) : ISize := ISize.ofInt (a.toInt % m.toInt)

instance : Mul ISize := ⟨ISize.mul⟩

instance : Mod ISize := ⟨ISize.mod⟩

instance : Div ISize := ⟨ISize.div⟩

def ISize.le (a b : ISize) : Prop := a.toInt <= b.toInt
def ISize.lt (a b : ISize) : Prop := a.toInt < b.toInt

instance : LE ISize := ⟨ISize.le⟩

instance : LT ISize := ⟨ISize.lt⟩

instance : DecidableEq ISize
| a, b =>
  dite
    (a.val = b.val)
    (fun h => isTrue <| ISize.eq_of_val_eq h)
    (fun h => isFalse <| fun h' => absurd (ISize.val_eq_of_eq h') h)

instance (a b : ISize) : Decidable (a <= b) :=
  dite (a.toInt <= b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)

instance (a b : ISize) : Decidable (a < b) :=
  dite (a.toInt < b.toInt) isTrue (fun h => isFalse <| fun h' => absurd h' h)


-- VOCABULARY

import tactic.norm_num

import syntax
import setsimp

def vocabOfFormula : formula → finset char
| (⊥)      := set.to_finset { }
| ( (· c)) := { c }
| (~ φ)    := vocabOfFormula φ
| (φ ⋏ ψ ) := vocabOfFormula φ ∪ vocabOfFormula ψ
| (□ φ)    := vocabOfFormula φ

def vocabOfSetFormula : finset formula → finset char
| X := finset.bUnion X vocabOfFormula

class hasVocabulary (α : Type) := (voc : α → finset char)
open hasVocabulary
instance formula_hasVocabulary : hasVocabulary formula := hasVocabulary.mk vocabOfFormula
instance setFormula_hasVocabulary : hasVocabulary (finset formula) := hasVocabulary.mk vocabOfSetFormula

@[simp]
lemma vocOfNeg {ϕ} : vocabOfFormula (~ϕ) = vocabOfFormula ϕ := by split

lemma vocElem_subs_vocSet {ϕ X} : ϕ ∈ X → vocabOfFormula ϕ ⊆ vocabOfSetFormula X :=
begin
  apply finset.induction_on X,
  -- case ∅:
  intro phi_in_X, cases phi_in_X,
  -- case insert:
  intros ψ S psi_not_in_S IH psi_in_insert,
  unfold vocabOfSetFormula at *,
  simp,
  intros a aIn,
  simp at *,
  cases psi_in_insert,
  { subst psi_in_insert, left, exact aIn, },
  { tauto, },
end

lemma vocMonotone {X Y : finset formula} (hyp : X ⊆ Y) : voc X ⊆ voc Y :=
begin
  unfold voc, unfold vocabOfSetFormula at *,
  intros a aIn,
  unfold finset.bUnion at *,
  simp at *,
  tauto,
end

lemma vocErase {X : finset formula} {ϕ : formula} : voc (X \ {ϕ}) ⊆ voc X :=
begin
  apply vocMonotone,
  rw sdiff_singleton_is_erase,
  intros a aIn,
  exact finset.mem_of_mem_erase aIn,
end

lemma vocUnion {X Y : finset formula} : voc (X ∪ Y) = voc X ∪ voc Y :=
begin
  unfold voc vocabOfSetFormula,
  ext1,
  simp,
  split ; { intro _, finish, },
end

lemma vocPreserved (X : finset formula) (ψ ϕ) :
  ψ ∈ X → voc ϕ = voc ψ → voc X = voc (X \ {ψ} ∪ {ϕ}) :=
begin
  intros psi_in_X eq_voc,
  unfold voc at *,
  unfold vocabOfSetFormula,
  ext1,
  split,
  all_goals { intro a_in, norm_num at *, },
  { rcases a_in with ⟨θ,_,a_in_vocTheta⟩,
    by_cases h : θ = ψ,
    { left, rw eq_voc, rw ← h, exact a_in_vocTheta, },
    { right, use θ, tauto, },
  },
  { cases a_in,
    { use ψ, rw ← eq_voc, tauto, },
    { rcases a_in with ⟨θ,_,a_in_vocTheta⟩, use θ, tauto, }
  },
end

lemma vocPreservedTwo {X : finset formula} (ψ ϕ1 ϕ2) :
  ψ ∈ X → voc ({ϕ1,ϕ2} : finset formula) = voc ψ → voc X = voc (X \ {ψ} ∪ {ϕ1,ϕ2}) :=
begin
  intros psi_in_X eq_voc,
  rw vocUnion,
  unfold voc at *,
  unfold vocabOfSetFormula,
  ext1,
  split,
  all_goals { intro a_in, norm_num at *, },
  { rcases a_in with ⟨θ,theta_in_X,a_in_vocTheta⟩,
    by_cases h : θ = ψ,
    { right, subst h, unfold vocabOfSetFormula vocabOfFormula at *, simp at *, rw ← eq_voc at a_in_vocTheta, simp at a_in_vocTheta, tauto, },
    { use θ, itauto, },
  },
  cases a_in,
  { rcases a_in with ⟨θ,theta_in_X,a_in_vocTheta⟩, use θ, itauto, },
  { use ψ, split, itauto, rw ← eq_voc, unfold vocabOfSetFormula, simp, itauto, },
end

lemma vocPreservedSub {X : finset formula} (ψ ϕ) :
  ψ ∈ X → voc ϕ ⊆ voc ψ → voc (X \ {ψ} ∪ {ϕ}) ⊆ voc X :=
begin
  intros psi_in_X sub_voc,
  unfold voc at *,
  unfold vocabOfSetFormula,
  intros a a_in, norm_num at *,
  cases a_in,
  { use ψ, rw finset.subset_iff at sub_voc, tauto, },
  { rcases a_in with ⟨θ,_,a_in_vocTheta⟩, use θ, tauto, },
end


/-
Copyright (c) 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth

! This file was ported from Lean 3 source module order.complete_lattice_intervals
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.ConditionallyCompleteLattice.Basic
import Mathbin.Data.Set.Intervals.OrdConnected

/-! # Subtypes of conditionally complete linear orders

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

In this file we give conditions on a subset of a conditionally complete linear order, to ensure that
the subtype is itself conditionally complete.

We check that an `ord_connected` set satisfies these conditions.

## TODO

Add appropriate instances for all `set.Ixx`. This requires a refactor that will allow different
default values for `Sup` and `Inf`.
-/

open Classical

open Set

variable {α : Type _} (s : Set α)

section SupSet

variable [SupSet α]

#print subsetSupSet /-
/-- `has_Sup` structure on a nonempty subset `s` of an object with `has_Sup`. This definition is
non-canonical (it uses `default s`); it should be used only as here, as an auxiliary instance in the
construction of the `conditionally_complete_linear_order` structure. -/
noncomputable def subsetSupSet [Inhabited s] : SupSet s
    where supₛ t :=
    if ht : supₛ (coe '' t : Set α) ∈ s then ⟨supₛ (coe '' t : Set α), ht⟩ else default
#align subset_has_Sup subsetSupSet
-/

attribute [local instance] subsetSupSet

#print subset_supₛ_def /-
@[simp]
theorem subset_supₛ_def [Inhabited s] :
    @supₛ s _ = fun t =>
      if ht : supₛ (coe '' t : Set α) ∈ s then ⟨supₛ (coe '' t : Set α), ht⟩ else default :=
  rfl
#align subset_Sup_def subset_supₛ_def
-/

#print subset_supₛ_of_within /-
theorem subset_supₛ_of_within [Inhabited s] {t : Set s} (h : supₛ (coe '' t : Set α) ∈ s) :
    supₛ (coe '' t : Set α) = (@supₛ s _ t : α) := by simp [dif_pos h]
#align subset_Sup_of_within subset_supₛ_of_within
-/

end SupSet

section InfSet

variable [InfSet α]

#print subsetInfSet /-
/-- `has_Inf` structure on a nonempty subset `s` of an object with `has_Inf`. This definition is
non-canonical (it uses `default s`); it should be used only as here, as an auxiliary instance in the
construction of the `conditionally_complete_linear_order` structure. -/
noncomputable def subsetInfSet [Inhabited s] : InfSet s
    where infₛ t :=
    if ht : infₛ (coe '' t : Set α) ∈ s then ⟨infₛ (coe '' t : Set α), ht⟩ else default
#align subset_has_Inf subsetInfSet
-/

attribute [local instance] subsetInfSet

#print subset_infₛ_def /-
@[simp]
theorem subset_infₛ_def [Inhabited s] :
    @infₛ s _ = fun t =>
      if ht : infₛ (coe '' t : Set α) ∈ s then ⟨infₛ (coe '' t : Set α), ht⟩ else default :=
  rfl
#align subset_Inf_def subset_infₛ_def
-/

#print subset_infₛ_of_within /-
theorem subset_infₛ_of_within [Inhabited s] {t : Set s} (h : infₛ (coe '' t : Set α) ∈ s) :
    infₛ (coe '' t : Set α) = (@infₛ s _ t : α) := by simp [dif_pos h]
#align subset_Inf_of_within subset_infₛ_of_within
-/

end InfSet

variable [ConditionallyCompleteLinearOrder α]

attribute [local instance] subsetSupSet

attribute [local instance] subsetInfSet

/- warning: subset_conditionally_complete_linear_order -> subsetConditionallyCompleteLinearOrder is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (s : Set.{u1} α) [_inst_1 : ConditionallyCompleteLinearOrder.{u1} α] [_inst_2 : Inhabited.{succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)], (forall {t : Set.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)}, (Set.Nonempty.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) t) -> (BddAbove.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)) t) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (SupSet.supₛ.{u1} α (ConditionallyCompleteLattice.toHasSup.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)))))) t)) s)) -> (forall {t : Set.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)}, (Set.Nonempty.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) t) -> (BddBelow.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)) t) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (InfSet.infₛ.{u1} α (ConditionallyCompleteLattice.toHasInf.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)))))) t)) s)) -> (ConditionallyCompleteLinearOrder.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s))
but is expected to have type
  forall {α : Type.{u1}} (s : Set.{u1} α) [_inst_1 : ConditionallyCompleteLinearOrder.{u1} α] [_inst_2 : Inhabited.{succ u1} (Set.Elem.{u1} α s)], (forall {t : Set.{u1} (Set.Elem.{u1} α s)}, (Set.Nonempty.{u1} (Set.Elem.{u1} α s) t) -> (BddAbove.{u1} (Set.Elem.{u1} α s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (SupSet.supₛ.{u1} α (ConditionallyCompleteLattice.toSupSet.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (Set.Elem.{u1} α s) α (Subtype.val.{succ u1} α (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t)) s)) -> (forall {t : Set.{u1} (Set.Elem.{u1} α s)}, (Set.Nonempty.{u1} (Set.Elem.{u1} α s) t) -> (BddBelow.{u1} (Set.Elem.{u1} α s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (InfSet.infₛ.{u1} α (ConditionallyCompleteLattice.toInfSet.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (Set.Elem.{u1} α s) α (Subtype.val.{succ u1} α (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t)) s)) -> (ConditionallyCompleteLinearOrder.{u1} (Set.Elem.{u1} α s))
Case conversion may be inaccurate. Consider using '#align subset_conditionally_complete_linear_order subsetConditionallyCompleteLinearOrderₓ'. -/
/-- For a nonempty subset of a conditionally complete linear order to be a conditionally complete
linear order, it suffices that it contain the `Sup` of all its nonempty bounded-above subsets, and
the `Inf` of all its nonempty bounded-below subsets.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def subsetConditionallyCompleteLinearOrder [Inhabited s]
    (h_Sup : ∀ {t : Set s} (ht : t.Nonempty) (h_bdd : BddAbove t), supₛ (coe '' t : Set α) ∈ s)
    (h_Inf : ∀ {t : Set s} (ht : t.Nonempty) (h_bdd : BddBelow t), infₛ (coe '' t : Set α) ∈ s) :
    ConditionallyCompleteLinearOrder s :=
  {-- The following would be a more natural way to finish, but gives a "deep recursion" error:
      -- simpa [subset_Sup_of_within (h_Sup t)] using
      --   (strict_mono_coe s).monotone.le_cSup_image hct h_bdd,
      subsetSupSet
      s,
    subsetInfSet s, DistribLattice.toLattice s,
    (inferInstance :
      LinearOrder
        s) with
    le_cSup := by
      rintro t c h_bdd hct
      have := (Subtype.mono_coe s).le_csupₛ_image hct h_bdd
      rwa [subset_supₛ_of_within s (h_Sup ⟨c, hct⟩ h_bdd)] at this
    cSup_le := by
      rintro t B ht hB
      have := (Subtype.mono_coe s).csupₛ_image_le ht hB
      rwa [subset_supₛ_of_within s (h_Sup ht ⟨B, hB⟩)] at this
    le_cInf := by
      intro t B ht hB
      have := (Subtype.mono_coe s).le_cinfₛ_image ht hB
      rwa [subset_infₛ_of_within s (h_Inf ht ⟨B, hB⟩)] at this
    cInf_le := by
      rintro t c h_bdd hct
      have := (Subtype.mono_coe s).cinfₛ_image_le hct h_bdd
      rwa [subset_infₛ_of_within s (h_Inf ⟨c, hct⟩ h_bdd)] at this }
#align subset_conditionally_complete_linear_order subsetConditionallyCompleteLinearOrder

section OrdConnected

/- warning: Sup_within_of_ord_connected -> supₛ_within_of_ordConnected is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} α] {s : Set.{u1} α} [hs : Set.OrdConnected.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) s] {{t : Set.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)}}, (Set.Nonempty.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) t) -> (BddAbove.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)) t) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (SupSet.supₛ.{u1} α (ConditionallyCompleteLattice.toHasSup.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)))))) t)) s)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} α] {s : Set.{u1} α} [hs : Set.OrdConnected.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) s] {{t : Set.{u1} (Set.Elem.{u1} α s)}}, (Set.Nonempty.{u1} (Set.Elem.{u1} α s) t) -> (BddAbove.{u1} (Set.Elem.{u1} α s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (SupSet.supₛ.{u1} α (ConditionallyCompleteLattice.toSupSet.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (Set.Elem.{u1} α s) α (Subtype.val.{succ u1} α (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t)) s)
Case conversion may be inaccurate. Consider using '#align Sup_within_of_ord_connected supₛ_within_of_ordConnectedₓ'. -/
/-- The `Sup` function on a nonempty `ord_connected` set `s` in a conditionally complete linear
order takes values within `s`, for all nonempty bounded-above subsets of `s`. -/
theorem supₛ_within_of_ordConnected {s : Set α} [hs : OrdConnected s] ⦃t : Set s⦄ (ht : t.Nonempty)
    (h_bdd : BddAbove t) : supₛ (coe '' t : Set α) ∈ s :=
  by
  obtain ⟨c, hct⟩ : ∃ c, c ∈ t := ht
  obtain ⟨B, hB⟩ : ∃ B, B ∈ upperBounds t := h_bdd
  refine' hs.out c.2 B.2 ⟨_, _⟩
  · exact (Subtype.mono_coe s).le_csupₛ_image hct ⟨B, hB⟩
  · exact (Subtype.mono_coe s).csupₛ_image_le ⟨c, hct⟩ hB
#align Sup_within_of_ord_connected supₛ_within_of_ordConnected

/- warning: Inf_within_of_ord_connected -> infₛ_within_of_ordConnected is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} α] {s : Set.{u1} α} [hs : Set.OrdConnected.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) s] {{t : Set.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)}}, (Set.Nonempty.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) t) -> (BddBelow.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)) t) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (InfSet.infₛ.{u1} α (ConditionallyCompleteLattice.toHasInf.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s) α (coeSubtype.{succ u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s)))))) t)) s)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} α] {s : Set.{u1} α} [hs : Set.OrdConnected.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) s] {{t : Set.{u1} (Set.Elem.{u1} α s)}}, (Set.Nonempty.{u1} (Set.Elem.{u1} α s) t) -> (BddBelow.{u1} (Set.Elem.{u1} α s) (Subtype.preorder.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (ConditionallyCompleteLattice.toLattice.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1))))) (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (InfSet.infₛ.{u1} α (ConditionallyCompleteLattice.toInfSet.{u1} α (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} α _inst_1)) (Set.image.{u1, u1} (Set.Elem.{u1} α s) α (Subtype.val.{succ u1} α (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s)) t)) s)
Case conversion may be inaccurate. Consider using '#align Inf_within_of_ord_connected infₛ_within_of_ordConnectedₓ'. -/
/-- The `Inf` function on a nonempty `ord_connected` set `s` in a conditionally complete linear
order takes values within `s`, for all nonempty bounded-below subsets of `s`. -/
theorem infₛ_within_of_ordConnected {s : Set α} [hs : OrdConnected s] ⦃t : Set s⦄ (ht : t.Nonempty)
    (h_bdd : BddBelow t) : infₛ (coe '' t : Set α) ∈ s :=
  by
  obtain ⟨c, hct⟩ : ∃ c, c ∈ t := ht
  obtain ⟨B, hB⟩ : ∃ B, B ∈ lowerBounds t := h_bdd
  refine' hs.out B.2 c.2 ⟨_, _⟩
  · exact (Subtype.mono_coe s).le_cinfₛ_image ⟨c, hct⟩ hB
  · exact (Subtype.mono_coe s).cinfₛ_image_le hct ⟨B, hB⟩
#align Inf_within_of_ord_connected infₛ_within_of_ordConnected

#print ordConnectedSubsetConditionallyCompleteLinearOrder /-
/-- A nonempty `ord_connected` set in a conditionally complete linear order is naturally a
conditionally complete linear order. -/
noncomputable instance ordConnectedSubsetConditionallyCompleteLinearOrder [Inhabited s]
    [OrdConnected s] : ConditionallyCompleteLinearOrder s :=
  subsetConditionallyCompleteLinearOrder s supₛ_within_of_ordConnected infₛ_within_of_ordConnected
#align ord_connected_subset_conditionally_complete_linear_order ordConnectedSubsetConditionallyCompleteLinearOrder
-/

end OrdConnected