/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.group_power.basic
import algebra.ring.opposite
import group_theory.group_action.opposite
import group_theory.group_action.prod

/-!
# Introduce `smul_with_zero`

In analogy with the usual monoid action on a Type `M`, we introduce an action of a
`monoid_with_zero` on a Type with `0`.

In particular, for Types `R` and `M`, both containing `0`, we define `smul_with_zero R M` to
be the typeclass where the products `r • 0` and `0 • m` vanish for all `r : R` and all `m : M`.

Moreover, in the case in which `R` is a `monoid_with_zero`, we introduce the typeclass
`mul_action_with_zero R M`, mimicking group actions and having an absorbing `0` in `R`.
Thus, the action is required to be compatible with

* the unit of the monoid, acting as the identity;
* the zero of the monoid_with_zero, acting as zero;
* associativity of the monoid.

We also add an `instance`:

* any `monoid_with_zero` has a `mul_action_with_zero R R` acting on itself.

## Main declarations

* `smul_monoid_with_zero_hom`: Scalar multiplication bundled as a morphism of monoids with zero.
-/

variables {R R' M M' : Type*}

section has_zero

variables (R M)
/--  `smul_with_zero` is a class consisting of a Type `R` with `0 ∈ R` and a scalar multiplication
of `R` on a Type `M` with `0`, such that the equality `r • m = 0` holds if at least one among `r`
or `m` equals `0`. -/
class smul_with_zero [has_zero R] [has_zero M] extends has_scalar R M :=
(smul_zero : ∀ r : R, r • (0 : M) = 0)
(zero_smul : ∀ m : M, (0 : R) • m = 0)

instance mul_zero_class.to_smul_with_zero [mul_zero_class R] : smul_with_zero R R :=
{ smul := (*),
  smul_zero := mul_zero,
  zero_smul := zero_mul }

/-- Like `mul_zero_class.to_smul_with_zero`, but multiplies on the right. -/
instance mul_zero_class.to_opposite_smul_with_zero [mul_zero_class R] : smul_with_zero Rᵐᵒᵖ R :=
{ smul := (•),
  smul_zero := λ r, zero_mul _,
  zero_smul := mul_zero }

instance add_monoid.to_smul_with_zero [add_monoid M] : smul_with_zero ℕ M :=
{ smul_zero := nsmul_zero,
  zero_smul := zero_nsmul }

variables (R) {M} [has_zero R] [has_zero M] [smul_with_zero R M]

@[simp] lemma zero_smul (m : M) : (0 : R) • m = 0 := smul_with_zero.zero_smul m

variables {R} (M)
/-- Note that this lemma has different typeclass assumptions to `smul_zero`. -/
@[simp] lemma smul_zero' (r : R) : r • (0 : M) = 0 := smul_with_zero.smul_zero r

variables {R M} [has_zero R'] [has_zero M'] [has_scalar R M']

/-- Pullback a `smul_with_zero` structure along an injective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.smul_with_zero
  (f : zero_hom M' M) (hf : function.injective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  smul_with_zero R M' :=
{ smul := (•),
  zero_smul := λ a, hf $ by simp [smul],
  smul_zero := λ a, hf $ by simp [smul]}

/-- Pushforward a `smul_with_zero` structure along a surjective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.smul_with_zero
  (f : zero_hom M M') (hf : function.surjective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  smul_with_zero R M' :=
{ smul := (•),
  zero_smul := λ m, by { rcases hf m with ⟨x, rfl⟩, simp [←smul] },
  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero'] }

variables (M)

/-- Compose a `smul_with_zero` with a `zero_hom`, with action `f r' • m` -/
def smul_with_zero.comp_hom (f : zero_hom R' R) : smul_with_zero R' M :=
{ smul := (•) ∘ f,
  smul_zero := λ m, by simp,
  zero_smul := λ m, by simp }

end has_zero

section monoid_with_zero

variables [monoid_with_zero R] [monoid_with_zero R'] [has_zero M]

variables (R M)
/--  An action of a monoid with zero `R` on a Type `M`, also with `0`, extends `mul_action` and
is compatible with `0` (both in `R` and in `M`), with `1 ∈ R`, and with associativity of
multiplication on the monoid `M`. -/
class mul_action_with_zero extends mul_action R M :=
-- these fields are copied from `smul_with_zero`, as `extends` behaves poorly
(smul_zero : ∀ r : R, r • (0 : M) = 0)
(zero_smul : ∀ m : M, (0 : R) • m = 0)

@[priority 100] -- see Note [lower instance priority]
instance mul_action_with_zero.to_smul_with_zero [m : mul_action_with_zero R M] :
  smul_with_zero R M :=
{..m}

/-- See also `semiring.to_module` -/
instance monoid_with_zero.to_mul_action_with_zero : mul_action_with_zero R R :=
{ ..mul_zero_class.to_smul_with_zero R,
  ..monoid.to_mul_action R }

/-- Like `monoid_with_zero.to_mul_action_with_zero`, but multiplies on the right. See also
`semiring.to_opposite_module` -/
instance monoid_with_zero.to_opposite_mul_action_with_zero : mul_action_with_zero Rᵐᵒᵖ R :=
{ ..mul_zero_class.to_opposite_smul_with_zero R,
  ..monoid.to_opposite_mul_action R }

variables {R M} [mul_action_with_zero R M] [has_zero M'] [has_scalar R M']

/-- Pullback a `mul_action_with_zero` structure along an injective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_action_with_zero
  (f : zero_hom M' M) (hf : function.injective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  mul_action_with_zero R M' :=
{ ..hf.mul_action f smul, ..hf.smul_with_zero f smul }

/-- Pushforward a `mul_action_with_zero` structure along a surjective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_action_with_zero
  (f : zero_hom M M') (hf : function.surjective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  mul_action_with_zero R M' :=
{ ..hf.mul_action f smul, ..hf.smul_with_zero f smul }

variables (M)

/-- Compose a `mul_action_with_zero` with a `monoid_with_zero_hom`, with action `f r' • m` -/
def mul_action_with_zero.comp_hom (f : R' →*₀ R) : mul_action_with_zero R' M :=
{ smul := (•) ∘ f,
  mul_smul := λ r s m, by simp [mul_smul],
  one_smul := λ m, by simp,
  .. smul_with_zero.comp_hom M f.to_zero_hom}

end monoid_with_zero

section group_with_zero
variables {α β : Type*} [group_with_zero α] [group_with_zero β] [mul_action_with_zero α β]

lemma smul_inv₀ [smul_comm_class α β β] [is_scalar_tower α β β] (c : α) (x : β) :
  (c • x)⁻¹ = c⁻¹ • x⁻¹ :=
begin
  obtain rfl | hc := eq_or_ne c 0,
  { simp only [inv_zero, zero_smul] },
  obtain rfl | hx := eq_or_ne x 0,
  { simp only [inv_zero, smul_zero'] },
  { refine (eq_inv_of_mul_left_eq_one _).symm,
    rw [smul_mul_smul, inv_mul_cancel hc, inv_mul_cancel hx, one_smul] }
end

end group_with_zero

/-- Scalar multiplication as a monoid homomorphism with zero. -/
@[simps]
def smul_monoid_with_zero_hom {α β : Type*} [monoid_with_zero α] [mul_zero_one_class β]
  [mul_action_with_zero α β] [is_scalar_tower α β β] [smul_comm_class α β β] :
  α × β →*₀ β :=
{ map_zero' := smul_zero' _ _,
  .. smul_monoid_hom }


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import tactic.basic
import logic.is_empty

/-!
# Types with a unique term

In this file we define a typeclass `unique`,
which expresses that a type has a unique term.
In other words, a type that is `inhabited` and a `subsingleton`.

## Main declaration

* `unique`: a typeclass that expresses that a type has a unique term.

## Main statements

* `unique.mk'`: an inhabited subsingleton type is `unique`. This can not be an instance because it
  would lead to loops in typeclass inference.

* `function.surjective.unique`: if the domain of a surjective function is `unique`, then its
  codomain is `unique` as well.

* `function.injective.subsingleton`: if the codomain of an injective function is `subsingleton`,
  then its domain is `subsingleton` as well.

* `function.injective.unique`: if the codomain of an injective function is `subsingleton` and its
  domain is `inhabited`, then its domain is `unique`.

## Implementation details

The typeclass `unique α` is implemented as a type,
rather than a `Prop`-valued predicate,
for good definitional properties of the default term.

-/

universes u v w

variables {α : Sort u} {β : Sort v} {γ : Sort w}

/-- `unique α` expresses that `α` is a type with a unique term `default`.

This is implemented as a type, rather than a `Prop`-valued predicate,
for good definitional properties of the default term. -/
@[ext]
structure unique (α : Sort u) extends inhabited α :=
(uniq : ∀ a : α, a = default)

attribute [class] unique

lemma unique_iff_exists_unique (α : Sort u) : nonempty (unique α) ↔ ∃! a : α, true :=
⟨λ ⟨u⟩, ⟨u.default, trivial, λ a _, u.uniq a⟩, λ ⟨a,_,h⟩, ⟨⟨⟨a⟩, λ _, h _ trivial⟩⟩⟩

lemma unique_subtype_iff_exists_unique {α} (p : α → Prop) :
  nonempty (unique (subtype p)) ↔ ∃! a, p a :=
⟨λ ⟨u⟩, ⟨u.default.1, u.default.2, λ a h, congr_arg subtype.val (u.uniq ⟨a,h⟩)⟩,
 λ ⟨a,ha,he⟩, ⟨⟨⟨⟨a,ha⟩⟩, λ ⟨b,hb⟩, by { congr, exact he b hb }⟩⟩⟩

/-- Given an explicit `a : α` with `[subsingleton α]`, we can construct
a `[unique α]` instance. This is a def because the typeclass search cannot
arbitrarily invent the `a : α` term. Nevertheless, these instances are all
equivalent by `unique.subsingleton.unique`.

See note [reducible non-instances]. -/
@[reducible] def unique_of_subsingleton {α : Sort*} [subsingleton α] (a : α) : unique α :=
{ default := a,
  uniq := λ _, subsingleton.elim _ _ }

instance punit.unique : unique punit.{u} :=
{ default := punit.star,
  uniq := λ x, punit_eq x _ }

/-- Every provable proposition is unique, as all proofs are equal. -/
def unique_prop {p : Prop} (h : p) : unique p :=
{ default := h, uniq := λ x, rfl }

instance : unique true := unique_prop trivial

lemma fin.eq_zero : ∀ n : fin 1, n = 0
| ⟨n, hn⟩ := fin.eq_of_veq (nat.eq_zero_of_le_zero (nat.le_of_lt_succ hn))

instance {n : ℕ} : inhabited (fin n.succ) := ⟨0⟩
instance inhabited_fin_one_add (n : ℕ) : inhabited (fin (1 + n)) := ⟨⟨0, nat.zero_lt_one_add n⟩⟩

@[simp] lemma fin.default_eq_zero (n : ℕ) : (default : fin n.succ) = 0 := rfl

instance fin.unique : unique (fin 1) :=
{ uniq := fin.eq_zero, .. fin.inhabited }

namespace unique
open function

section

variables [unique α]

@[priority 100] -- see Note [lower instance priority]
instance : inhabited α := to_inhabited ‹unique α›

lemma eq_default (a : α) : a = default := uniq _ a

lemma default_eq (a : α) : default = a := (uniq _ a).symm

@[priority 100] -- see Note [lower instance priority]
instance : subsingleton α := subsingleton_of_forall_eq _ eq_default

lemma forall_iff {p : α → Prop} : (∀ a, p a) ↔ p default :=
⟨λ h, h _, λ h x, by rwa [unique.eq_default x]⟩

lemma exists_iff {p : α → Prop} : Exists p ↔ p default :=
⟨λ ⟨a, ha⟩, eq_default a ▸ ha, exists.intro default⟩

end

@[ext] protected lemma subsingleton_unique' : ∀ (h₁ h₂ : unique α), h₁ = h₂
| ⟨⟨x⟩, h⟩ ⟨⟨y⟩, _⟩ := by congr; rw [h x, h y]

instance subsingleton_unique : subsingleton (unique α) :=
⟨unique.subsingleton_unique'⟩

/-- Construct `unique` from `inhabited` and `subsingleton`. Making this an instance would create
a loop in the class inheritance graph. -/
@[reducible] def mk' (α : Sort u) [h₁ : inhabited α] [subsingleton α] : unique α :=
{ uniq := λ x, subsingleton.elim _ _, .. h₁ }

end unique

@[simp] lemma pi.default_def {β : Π a : α, Sort v} [Π a, inhabited (β a)] :
  @default (Π a, β a) _ = λ a : α, @default (β a) _ := rfl

lemma pi.default_apply {β : Π a : α, Sort v} [Π a, inhabited (β a)] (a : α) :
  @default (Π a, β a) _ a = default := rfl

instance pi.unique {β : Π a : α, Sort v} [Π a, unique (β a)] : unique (Π a, β a) :=
{ uniq := λ f, funext $ λ x, unique.eq_default _,
  .. pi.inhabited α }

/-- There is a unique function on an empty domain. -/
instance pi.unique_of_is_empty [is_empty α] (β : Π a : α, Sort v) :
  unique (Π a, β a) :=
{ default := is_empty_elim,
  uniq := λ f, funext is_empty_elim }

namespace function

variable {f : α → β}

/-- If the domain of a surjective function is a singleton,
then the codomain is a singleton as well. -/
protected def surjective.unique (hf : surjective f) [unique α] : unique β :=
{ default := f default,
  uniq := λ b, let ⟨a, ha⟩ := hf b in ha ▸ congr_arg f (unique.eq_default _) }

/-- If the codomain of an injective function is a subsingleton, then the domain
is a subsingleton as well. -/
protected lemma injective.subsingleton (hf : injective f) [subsingleton β] :
  subsingleton α :=
⟨λ x y, hf $ subsingleton.elim _ _⟩

/-- If `α` is inhabited and admits an injective map to a subsingleton type, then `α` is `unique`. -/
protected def injective.unique [inhabited α] [subsingleton β] (hf : injective f) : unique α :=
@unique.mk' _ _ hf.subsingleton

end function

namespace option

/-- `option α` is a `subsingleton` if and only if `α` is empty. -/
lemma subsingleton_iff_is_empty {α} : subsingleton (option α) ↔ is_empty α :=
⟨λ h, ⟨λ x, option.no_confusion $ @subsingleton.elim _ h x none⟩,
  λ h, ⟨λ x y, option.cases_on x (option.cases_on y rfl (λ x, h.elim x)) (λ x, h.elim x)⟩⟩

instance {α} [is_empty α] : unique (option α) := @unique.mk' _ _ (subsingleton_iff_is_empty.2 ‹_›)

end option

section subtype

instance unique.subtype_eq (y : α) : unique {x // x = y} :=
{ default := ⟨y, rfl⟩,
  uniq := λ ⟨x, hx⟩, by simpa using hx }

instance unique.subtype_eq' (y : α) : unique {x // y = x} :=
{ default := ⟨y, rfl⟩,
  uniq := λ ⟨x, hx⟩, by simpa using hx.symm }

end subtype


import Mandlebrah.Complex

def step (c z : Complex) : Complex := z ^ 2 + c

def mandel (c : Complex) (bound : Float := 2.0) (maxSteps : Nat := 20) : Nat :=
  let rec iterate : Complex → Nat → Nat → Nat := λ
  | _, 0, _ => 0
  | z, maxSteps + 1, currStep =>
      match (Complex.Abs z ≥ bound : Bool) with
        | true => currStep
        | false => iterate (step c z) maxSteps currStep.succ
  iterate 0 maxSteps 0

def twoDeeRange (default: a) (x y: Nat) : Array (Array a) :=
  Array.mkArray y <| Array.mkArray x default

def buildDimToComplex (xMax yMax : Nat) (cMin cMax : Complex) : Nat → Nat → Complex :=
  let xScalar : Float := (cMax.real - cMin.real) / Float.ofNat xMax
  let yScalar : Float := (cMax.i - cMin.i) / Float.ofNat yMax
  fun (px py : Nat) => cMin + Complex.mk ((Float.ofNat px) * xScalar) ((Float.ofNat py) * yScalar)

section x
  variable (size : Nat)
  variable (hpx hpy: Nat)
  variable (hcMin hcMax : Complex)
  variable (hp: hpx < size ∧  hpy < size ∧ hpx >0 ∧ hpy > 0 )
  variable (hc: hcMin < hcMax)
  variable (hsize: size > 0)
  def ap: Nat → Nat → Complex :=
    (buildDimToComplex  size size hcMin hcMax)

#check ap

  theorem BDimIdAtZero : hcMin = (buildDimToComplex size size hcMin hcMax 0 0 ) := by
    apply Eq.symm
    sorry

  theorem existsAIncrement : ∃ x : Float, ∀ p : Nat, ∀ q: Nat,
                                            (buildDimToComplex size size hcMin hcMax p q) -
                                            (buildDimToComplex size size hcMin hcMax (p+1) (q+1)) * x = 0 :=

                                            sorry

  theorem DimInBounds : hcMin < (buildDimToComplex size size hcMin hcMax hpy hpx) ∧
             hcMax > (buildDimToComplex size size hcMin hcMax hpy hpx) := by sorry

 #check size < hpx
--  theorem dimToComplexBounded : hcomp := by

  sorry

end x

def newScene (px py : Nat) (cMin cMax : Complex) (maxSteps : Nat) : Array (Array Nat) := do
  let mut scene : Array (Array Complex) := twoDeeRange (Complex.mk 0 0) px py
  let dimToComplex := buildDimToComplex px py cMin cMax
  Array.mapIdx scene λ idy dimx =>
    Array.mapIdx dimx λ idx elem =>
      (dimToComplex idx idy) |> mandel

@[inline] def Float.max (x y : Float) : Float := if x ≤ y then y else x
@[inline] def Float.min (x y : Float) : Float := if x ≤ y then x else y

open Float in
  def Float.clampToUInt8 (x : Float) : UInt8 :=
    toUInt8 <| min 255 <| max 0 x

def IO.FS.Handle.writeColor (handle : IO.FS.Handle) (cMax : Nat) (c : Nat) : IO Unit := do
  let r := Float.clampToUInt8 (Float.ofNat c / (Float.ofNat cMax) * 255)
  let g := Float.clampToUInt8 (Float.ofNat c / (Float.ofNat cMax) * 255)
  let b := Float.clampToUInt8 (Float.ofNat c / (Float.ofNat cMax) * 255)
  handle.putStrLn s!"{r} {g} {b}"

def writeFile (filename : String) (maxSteps := 50) (width := 500)  (height := 500)  : IO Unit := do
  IO.println "boop"
  let pixels := newScene height width (Complex.mk (-1) (-1)) (Complex.mk 1 1) maxSteps

  IO.FS.withFile filename IO.FS.Mode.write λ handle => do
    handle.putStrLn "P3"
    handle.putStrLn s!"{width} {height} 255"
    for i in [0:width] do
      for j in [0:height] do
        let pixel := pixels[i][j]
        handle.writeColor maxSteps pixel

-- #eval newScene 10 10 (Complex.mk (-1) (-1)) (Complex.mk 1 1)
-- #eval Nat.succ 1
-- #eval x
-- #eval Complex.add (Complex.mk 1 1) (Complex.mk 1 2)
-- #eval Complex.mul (Complex.mk 1 1) (Complex.mk 1 2)
-- #eval Complex.mk 1 1 + Complex.mk 11 2
-- #eval x * y
-- #eval x ^ 2
-- #eval Complex.Abs y
-- #eval stepIn 1000000.0 1000000 y 0
-- #eval writeFile "out.ppm"
def main : List String → IO Unit
  | [] => writeFile "out.ppm"
  | (x::xs) => writeFile x


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis

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

/-!

# Truncated Witt vectors

The ring of truncated Witt vectors (of length `n`) is a quotient of the ring of Witt vectors.
It retains the first `n` coefficients of each Witt vector.
In this file, we set up the basic quotient API for this ring.

The ring of Witt vectors is the projective limit of all the rings of truncated Witt vectors.

## Main declarations

- `truncated_witt_vector`: the underlying type of the ring of truncated Witt vectors
- `truncated_witt_vector.comm_ring`: the ring structure on truncated Witt vectors
- `witt_vector.truncate`: the quotient homomorphism that truncates a Witt vector,
  to obtain a truncated Witt vector
- `truncated_witt_vector.truncate`: the homomorphism that truncates
  a truncated Witt vector of length `n` to one of length `m` (for some `m ≤ n`)
- `witt_vector.lift`: the unique ring homomorphism into the ring of Witt vectors
  that is compatible with a family of ring homomorphisms to the truncated Witt vectors:
  this realizes the ring of Witt vectors as projective limit of the rings of truncated Witt vectors

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

open Function (Injective Surjective)

noncomputable section

variable {p : ℕ} [hp : Fact p.Prime] (n : ℕ) (R : Type _)

-- mathport name: expr𝕎
local notation "𝕎" => WittVector p

-- type as `\bbW`
/-- A truncated Witt vector over `R` is a vector of elements of `R`,
i.e., the first `n` coefficients of a Witt vector.
We will define operations on this type that are compatible with the (untruncated) Witt
vector operations.

`truncated_witt_vector p n R` takes a parameter `p : ℕ` that is not used in the definition.
In practice, this number `p` is assumed to be a prime number,
and under this assumption we construct a ring structure on `truncated_witt_vector p n R`.
(`truncated_witt_vector p₁ n R` and `truncated_witt_vector p₂ n R` are definitionally
equal as types but will have different ring operations.)
-/
@[nolint unused_arguments]
def TruncatedWittVector (p : ℕ) (n : ℕ) (R : Type _) :=
  Fin n → R
#align truncated_witt_vector TruncatedWittVector

instance (p n : ℕ) (R : Type _) [Inhabited R] : Inhabited (TruncatedWittVector p n R) :=
  ⟨fun _ => default⟩

variable {n R}

namespace TruncatedWittVector

variable (p)

/-- Create a `truncated_witt_vector` from a vector `x`. -/
def mk (x : Fin n → R) : TruncatedWittVector p n R :=
  x
#align truncated_witt_vector.mk TruncatedWittVector.mk

variable {p}

/-- `x.coeff i` is the `i`th entry of `x`. -/
def coeff (i : Fin n) (x : TruncatedWittVector p n R) : R :=
  x i
#align truncated_witt_vector.coeff TruncatedWittVector.coeff

@[ext]
theorem ext {x y : TruncatedWittVector p n R} (h : ∀ i, x.coeff i = y.coeff i) : x = y :=
  funext h
#align truncated_witt_vector.ext TruncatedWittVector.ext

theorem ext_iff {x y : TruncatedWittVector p n R} : x = y ↔ ∀ i, x.coeff i = y.coeff i :=
  ⟨fun h i => by rw [h], ext⟩
#align truncated_witt_vector.ext_iff TruncatedWittVector.ext_iff

@[simp]
theorem coeff_mk (x : Fin n → R) (i : Fin n) : (mk p x).coeff i = x i :=
  rfl
#align truncated_witt_vector.coeff_mk TruncatedWittVector.coeff_mk

@[simp]
theorem mk_coeff (x : TruncatedWittVector p n R) : (mk p fun i => x.coeff i) = x :=
  by
  ext i
  rw [coeff_mk]
#align truncated_witt_vector.mk_coeff TruncatedWittVector.mk_coeff

variable [CommRing R]

/-- We can turn a truncated Witt vector `x` into a Witt vector
by setting all coefficients after `x` to be 0.
-/
def out (x : TruncatedWittVector p n R) : 𝕎 R :=
  WittVector.mk p fun i => if h : i < n then x.coeff ⟨i, h⟩ else 0
#align truncated_witt_vector.out TruncatedWittVector.out

@[simp]
theorem coeff_out (x : TruncatedWittVector p n R) (i : Fin n) : x.out.coeff i = x.coeff i := by
  rw [out, WittVector.coeff_mk, dif_pos i.is_lt, Fin.eta]
#align truncated_witt_vector.coeff_out TruncatedWittVector.coeff_out

theorem out_injective : Injective (@out p n R _) :=
  by
  intro x y h
  ext i
  rw [WittVector.ext_iff] at h
  simpa only [coeff_out] using h ↑i
#align truncated_witt_vector.out_injective TruncatedWittVector.out_injective

end TruncatedWittVector

namespace WittVector

variable {p} (n)

section

/-- `truncate_fun n x` uses the first `n` entries of `x` to construct a `truncated_witt_vector`,
which has the same base `p` as `x`.
This function is bundled into a ring homomorphism in `witt_vector.truncate` -/
def truncateFun (x : 𝕎 R) : TruncatedWittVector p n R :=
  TruncatedWittVector.mk p fun i => x.coeff i
#align witt_vector.truncate_fun WittVector.truncateFun

end

variable {n}

@[simp]
theorem coeff_truncateFun (x : 𝕎 R) (i : Fin n) : (truncateFun n x).coeff i = x.coeff i := by
  rw [truncate_fun, TruncatedWittVector.coeff_mk]
#align witt_vector.coeff_truncate_fun WittVector.coeff_truncateFun

variable [CommRing R]

@[simp]
theorem out_truncateFun (x : 𝕎 R) : (truncateFun n x).out = init n x :=
  by
  ext i
  dsimp [TruncatedWittVector.out, init, select]
  split_ifs with hi; swap; · rfl
  rw [coeff_truncate_fun, Fin.val_mk]
#align witt_vector.out_truncate_fun WittVector.out_truncateFun

end WittVector

namespace TruncatedWittVector

variable [CommRing R]

@[simp]
theorem truncateFun_out (x : TruncatedWittVector p n R) : x.out.truncateFun n = x := by
  simp only [WittVector.truncateFun, coeff_out, mk_coeff]
#align truncated_witt_vector.truncate_fun_out TruncatedWittVector.truncateFun_out

open WittVector

variable (p n R)

include hp

instance : Zero (TruncatedWittVector p n R) :=
  ⟨truncateFun n 0⟩

instance : One (TruncatedWittVector p n R) :=
  ⟨truncateFun n 1⟩

instance : NatCast (TruncatedWittVector p n R) :=
  ⟨fun i => truncateFun n i⟩

instance : IntCast (TruncatedWittVector p n R) :=
  ⟨fun i => truncateFun n i⟩

instance : Add (TruncatedWittVector p n R) :=
  ⟨fun x y => truncateFun n (x.out + y.out)⟩

instance : Mul (TruncatedWittVector p n R) :=
  ⟨fun x y => truncateFun n (x.out * y.out)⟩

instance : Neg (TruncatedWittVector p n R) :=
  ⟨fun x => truncateFun n (-x.out)⟩

instance : Sub (TruncatedWittVector p n R) :=
  ⟨fun x y => truncateFun n (x.out - y.out)⟩

instance hasNatScalar : SMul ℕ (TruncatedWittVector p n R) :=
  ⟨fun m x => truncateFun n (m • x.out)⟩
#align truncated_witt_vector.has_nat_scalar TruncatedWittVector.hasNatScalar

instance hasIntScalar : SMul ℤ (TruncatedWittVector p n R) :=
  ⟨fun m x => truncateFun n (m • x.out)⟩
#align truncated_witt_vector.has_int_scalar TruncatedWittVector.hasIntScalar

instance hasNatPow : Pow (TruncatedWittVector p n R) ℕ :=
  ⟨fun x m => truncateFun n (x.out ^ m)⟩
#align truncated_witt_vector.has_nat_pow TruncatedWittVector.hasNatPow

@[simp]
theorem coeff_zero (i : Fin n) : (0 : TruncatedWittVector p n R).coeff i = 0 :=
  by
  show coeff i (truncate_fun _ 0 : TruncatedWittVector p n R) = 0
  rw [coeff_truncate_fun, WittVector.zero_coeff]
#align truncated_witt_vector.coeff_zero TruncatedWittVector.coeff_zero

end TruncatedWittVector

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- A macro tactic used to prove that `truncate_fun` respects ring operations. -/
unsafe def tactic.interactive.witt_truncate_fun_tac : tactic Unit :=
  sorry
#align tactic.interactive.witt_truncate_fun_tac tactic.interactive.witt_truncate_fun_tac

namespace WittVector

variable (p n R)

variable [CommRing R]

theorem truncateFun_surjective : Surjective (@truncateFun p n R) :=
  Function.RightInverse.surjective TruncatedWittVector.truncateFun_out
#align witt_vector.truncate_fun_surjective WittVector.truncateFun_surjective

include hp

@[simp]
theorem truncateFun_zero : truncateFun n (0 : 𝕎 R) = 0 :=
  rfl
#align witt_vector.truncate_fun_zero WittVector.truncateFun_zero

@[simp]
theorem truncateFun_one : truncateFun n (1 : 𝕎 R) = 1 :=
  rfl
#align witt_vector.truncate_fun_one WittVector.truncateFun_one

variable {p R}

@[simp]
theorem truncateFun_add (x y : 𝕎 R) : truncateFun n (x + y) = truncateFun n x + truncateFun n y :=
  by
  witt_truncate_fun_tac
  rw [init_add]
#align witt_vector.truncate_fun_add WittVector.truncateFun_add

@[simp]
theorem truncateFun_mul (x y : 𝕎 R) : truncateFun n (x * y) = truncateFun n x * truncateFun n y :=
  by
  witt_truncate_fun_tac
  rw [init_mul]
#align witt_vector.truncate_fun_mul WittVector.truncateFun_mul

theorem truncateFun_neg (x : 𝕎 R) : truncateFun n (-x) = -truncateFun n x :=
  by
  witt_truncate_fun_tac
  rw [init_neg]
#align witt_vector.truncate_fun_neg WittVector.truncateFun_neg

theorem truncateFun_sub (x y : 𝕎 R) : truncateFun n (x - y) = truncateFun n x - truncateFun n y :=
  by
  witt_truncate_fun_tac
  rw [init_sub]
#align witt_vector.truncate_fun_sub WittVector.truncateFun_sub

theorem truncateFun_nsmul (x : 𝕎 R) (m : ℕ) : truncateFun n (m • x) = m • truncateFun n x :=
  by
  witt_truncate_fun_tac
  rw [init_nsmul]
#align witt_vector.truncate_fun_nsmul WittVector.truncateFun_nsmul

theorem truncateFun_zsmul (x : 𝕎 R) (m : ℤ) : truncateFun n (m • x) = m • truncateFun n x :=
  by
  witt_truncate_fun_tac
  rw [init_zsmul]
#align witt_vector.truncate_fun_zsmul WittVector.truncateFun_zsmul

theorem truncateFun_pow (x : 𝕎 R) (m : ℕ) : truncateFun n (x ^ m) = truncateFun n x ^ m :=
  by
  witt_truncate_fun_tac
  rw [init_pow]
#align witt_vector.truncate_fun_pow WittVector.truncateFun_pow

theorem truncateFun_nat_cast (m : ℕ) : truncateFun n (m : 𝕎 R) = m :=
  rfl
#align witt_vector.truncate_fun_nat_cast WittVector.truncateFun_nat_cast

theorem truncateFun_int_cast (m : ℤ) : truncateFun n (m : 𝕎 R) = m :=
  rfl
#align witt_vector.truncate_fun_int_cast WittVector.truncateFun_int_cast

end WittVector

namespace TruncatedWittVector

open WittVector

variable (p n R)

variable [CommRing R]

include hp

instance : CommRing (TruncatedWittVector p n R) :=
  (truncateFun_surjective p n R).CommRing _ (truncateFun_zero p n R) (truncateFun_one p n R)
    (truncateFun_add n) (truncateFun_mul n) (truncateFun_neg n) (truncateFun_sub n)
    (truncateFun_nsmul n) (truncateFun_zsmul n) (truncateFun_pow n) (truncateFun_nat_cast n)
    (truncateFun_int_cast n)

end TruncatedWittVector

namespace WittVector

open TruncatedWittVector

variable (n)

variable [CommRing R]

include hp

/-- `truncate n` is a ring homomorphism that truncates `x` to its first `n` entries
to obtain a `truncated_witt_vector`, which has the same base `p` as `x`. -/
noncomputable def truncate : 𝕎 R →+* TruncatedWittVector p n R
    where
  toFun := truncateFun n
  map_zero' := truncateFun_zero p n R
  map_add' := truncateFun_add n
  map_one' := truncateFun_one p n R
  map_mul' := truncateFun_mul n
#align witt_vector.truncate WittVector.truncate

variable (p n R)

theorem truncate_surjective : Surjective (truncate n : 𝕎 R → TruncatedWittVector p n R) :=
  truncateFun_surjective p n R
#align witt_vector.truncate_surjective WittVector.truncate_surjective

variable {p n R}

@[simp]
theorem coeff_truncate (x : 𝕎 R) (i : Fin n) : (truncate n x).coeff i = x.coeff i :=
  coeff_truncateFun _ _
#align witt_vector.coeff_truncate WittVector.coeff_truncate

variable (n)

theorem mem_ker_truncate (x : 𝕎 R) : x ∈ (@truncate p _ n R _).ker ↔ ∀ i < n, x.coeff i = 0 :=
  by
  simp only [RingHom.mem_ker, truncate, truncate_fun, RingHom.coe_mk, TruncatedWittVector.ext_iff,
    TruncatedWittVector.coeff_mk, coeff_zero]
  exact Fin.forall_iff
#align witt_vector.mem_ker_truncate WittVector.mem_ker_truncate

variable (p)

@[simp]
theorem truncate_mk (f : ℕ → R) : truncate n (mk p f) = TruncatedWittVector.mk _ fun k => f k :=
  by
  ext i
  rw [coeff_truncate, coeff_mk, TruncatedWittVector.coeff_mk]
#align witt_vector.truncate_mk WittVector.truncate_mk

end WittVector

namespace TruncatedWittVector

variable [CommRing R]

include hp

/-- A ring homomorphism that truncates a truncated Witt vector of length `m` to
a truncated Witt vector of length `n`, for `n ≤ m`.
-/
def truncate {m : ℕ} (hm : n ≤ m) : TruncatedWittVector p m R →+* TruncatedWittVector p n R :=
  RingHom.liftOfRightInverse (WittVector.truncate m) out truncateFun_out
    ⟨WittVector.truncate n, by
      intro x
      simp only [WittVector.mem_ker_truncate]
      intro h i hi
      exact h i (lt_of_lt_of_le hi hm)⟩
#align truncated_witt_vector.truncate TruncatedWittVector.truncate

@[simp]
theorem truncate_comp_wittVector_truncate {m : ℕ} (hm : n ≤ m) :
    (@truncate p _ n R _ m hm).comp (WittVector.truncate m) = WittVector.truncate n :=
  RingHom.liftOfRightInverse_comp _ _ _ _
#align truncated_witt_vector.truncate_comp_witt_vector_truncate TruncatedWittVector.truncate_comp_wittVector_truncate

@[simp]
theorem truncate_wittVector_truncate {m : ℕ} (hm : n ≤ m) (x : 𝕎 R) :
    truncate hm (WittVector.truncate m x) = WittVector.truncate n x :=
  RingHom.liftOfRightInverse_comp_apply _ _ _ _ _
#align truncated_witt_vector.truncate_witt_vector_truncate TruncatedWittVector.truncate_wittVector_truncate

@[simp]
theorem truncate_truncate {n₁ n₂ n₃ : ℕ} (h1 : n₁ ≤ n₂) (h2 : n₂ ≤ n₃)
    (x : TruncatedWittVector p n₃ R) : (truncate h1) (truncate h2 x) = truncate (h1.trans h2) x :=
  by
  obtain ⟨x, rfl⟩ := WittVector.truncate_surjective p n₃ R x
  simp only [truncate_witt_vector_truncate]
#align truncated_witt_vector.truncate_truncate TruncatedWittVector.truncate_truncate

@[simp]
theorem truncate_comp {n₁ n₂ n₃ : ℕ} (h1 : n₁ ≤ n₂) (h2 : n₂ ≤ n₃) :
    (@truncate p _ _ R _ _ h1).comp (truncate h2) = truncate (h1.trans h2) := by ext1 x;
  simp only [truncate_truncate, Function.comp_apply, RingHom.coe_comp]
#align truncated_witt_vector.truncate_comp TruncatedWittVector.truncate_comp

theorem truncate_surjective {m : ℕ} (hm : n ≤ m) : Surjective (@truncate p _ _ R _ _ hm) :=
  by
  intro x
  obtain ⟨x, rfl⟩ := WittVector.truncate_surjective p _ R x
  exact ⟨WittVector.truncate _ x, truncate_witt_vector_truncate _ _⟩
#align truncated_witt_vector.truncate_surjective TruncatedWittVector.truncate_surjective

@[simp]
theorem coeff_truncate {m : ℕ} (hm : n ≤ m) (i : Fin n) (x : TruncatedWittVector p m R) :
    (truncate hm x).coeff i = x.coeff (Fin.castLe hm i) :=
  by
  obtain ⟨y, rfl⟩ := WittVector.truncate_surjective p _ _ x
  simp only [truncate_witt_vector_truncate, WittVector.coeff_truncate, Fin.coe_castLe]
#align truncated_witt_vector.coeff_truncate TruncatedWittVector.coeff_truncate

section Fintype

omit hp

instance {R : Type _} [Fintype R] : Fintype (TruncatedWittVector p n R) :=
  Pi.fintype

variable (p n R)

theorem card {R : Type _} [Fintype R] :
    Fintype.card (TruncatedWittVector p n R) = Fintype.card R ^ n := by
  simp only [TruncatedWittVector, Fintype.card_fin, Fintype.card_fun]
#align truncated_witt_vector.card TruncatedWittVector.card

end Fintype

theorem infᵢ_ker_truncate : (⨅ i : ℕ, (@WittVector.truncate p _ i R _).ker) = ⊥ :=
  by
  rw [Submodule.eq_bot_iff]
  intro x hx
  ext
  simp only [WittVector.mem_ker_truncate, Ideal.mem_infᵢ, WittVector.zero_coeff] at hx⊢
  exact hx _ _ (Nat.lt_succ_self _)
#align truncated_witt_vector.infi_ker_truncate TruncatedWittVector.infᵢ_ker_truncate

end TruncatedWittVector

namespace WittVector

open TruncatedWittVector hiding truncate coeff

section lift

variable [CommRing R]

variable {S : Type _} [Semiring S]

variable (f : ∀ k : ℕ, S →+* TruncatedWittVector p k R)

variable
  (f_compat : ∀ (k₁ k₂ : ℕ) (hk : k₁ ≤ k₂), (TruncatedWittVector.truncate hk).comp (f k₂) = f k₁)

variable {p R}

variable (n)

/-- Given a family `fₖ : S → truncated_witt_vector p k R` and `s : S`, we produce a Witt vector by
defining the `k`th entry to be the final entry of `fₖ s`.
-/
def liftFun (s : S) : 𝕎 R :=
  WittVector.mk p fun k => TruncatedWittVector.coeff (Fin.last k) (f (k + 1) s)
#align witt_vector.lift_fun WittVector.liftFun

variable {f}

include f_compat

@[simp]
theorem truncate_liftFun (s : S) : WittVector.truncate n (liftFun f s) = f n s :=
  by
  ext i
  simp only [lift_fun, TruncatedWittVector.coeff_mk, WittVector.truncate_mk]
  rw [← f_compat (i + 1) n i.is_lt, RingHom.comp_apply, TruncatedWittVector.coeff_truncate]
  -- this is a bit unfortunate
  congr with _
  simp only [Fin.val_last, Fin.coe_castLe]
#align witt_vector.truncate_lift_fun WittVector.truncate_liftFun

variable (f)

/--
Given compatible ring homs from `S` into `truncated_witt_vector n` for each `n`, we can lift these
to a ring hom `S → 𝕎 R`.

`lift` defines the universal property of `𝕎 R` as the inverse limit of `truncated_witt_vector n`.
-/
def lift : S →+* 𝕎 R := by
  refine_struct { toFun := lift_fun f } <;>
    · intros
      rw [← sub_eq_zero, ← Ideal.mem_bot, ← infi_ker_truncate, Ideal.mem_infᵢ]
      simp [RingHom.mem_ker, f_compat]
#align witt_vector.lift WittVector.lift

variable {f}

@[simp]
theorem truncate_lift (s : S) : WittVector.truncate n (lift _ f_compat s) = f n s :=
  truncate_liftFun _ f_compat s
#align witt_vector.truncate_lift WittVector.truncate_lift

@[simp]
theorem truncate_comp_lift : (WittVector.truncate n).comp (lift _ f_compat) = f n :=
  by
  ext1
  rw [RingHom.comp_apply, truncate_lift]
#align witt_vector.truncate_comp_lift WittVector.truncate_comp_lift

/-- The uniqueness part of the universal property of `𝕎 R`. -/
theorem lift_unique (g : S →+* 𝕎 R) (g_compat : ∀ k, (WittVector.truncate k).comp g = f k) :
    lift _ f_compat = g := by
  ext1 x
  rw [← sub_eq_zero, ← Ideal.mem_bot, ← infi_ker_truncate, Ideal.mem_infᵢ]
  intro i
  simp only [RingHom.mem_ker, g_compat, ← RingHom.comp_apply, truncate_comp_lift, RingHom.map_sub,
    sub_self]
#align witt_vector.lift_unique WittVector.lift_unique

omit f_compat

include hp

/-- The universal property of `𝕎 R` as projective limit of truncated Witt vector rings. -/
@[simps]
def liftEquiv :
    { f : ∀ k, S →+* TruncatedWittVector p k R //
        ∀ (k₁ k₂) (hk : k₁ ≤ k₂), (TruncatedWittVector.truncate hk).comp (f k₂) = f k₁ } ≃
      (S →+* 𝕎 R)
    where
  toFun f := lift f.1 f.2
  invFun g :=
    ⟨fun k => (truncate k).comp g, by
      intro _ _ h
      simp only [← RingHom.comp_assoc, truncate_comp_witt_vector_truncate]⟩
  left_inv := by
    rintro ⟨f, hf⟩
    simp only [truncate_comp_lift]
  right_inv g := lift_unique _ _ fun _ => rfl
#align witt_vector.lift_equiv WittVector.liftEquiv

theorem hom_ext (g₁ g₂ : S →+* 𝕎 R) (h : ∀ k, (truncate k).comp g₁ = (truncate k).comp g₂) :
    g₁ = g₂ :=
  liftEquiv.symm.Injective <| Subtype.ext <| funext h
#align witt_vector.hom_ext WittVector.hom_ext

end lift

end WittVector


/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import .henkin

local attribute [instance, priority 0] classical.prop_decidable

open fol fol.Lhom

lemma satisfied_of_provable {L : Language} (T : Theory L) (ψ : sentence L) : T ⊢' ψ → T ⊨ ψ :=
λ _, soundness $ classical.choice ‹_›

lemma completeness_for_inconsistent_theories {L : Language} (T : Theory L) (ψ : sentence L) (h_inconsis : ¬ is_consistent T) : T ⊢' ψ ↔ T ⊨ ψ :=
⟨satisfied_of_provable _ _, λ _, exfalso' $ classical.by_contradiction ‹_›⟩

/- T is consistent iff there is a nonempty model of T -/
theorem model_existence {L : Language} (T : Theory L) : is_consistent T ↔ (∃ M : Structure L, (nonempty M) ∧ M ⊨ T) :=
begin
  refine ⟨_,_⟩; intro H,
    { refine ⟨reduct (@henkin_language_over L T H)
        (term_model $ completion_of_henkinization H), ⟨_,_⟩⟩,
      { exact reduct_nonempty_of_nonempty (by simp[fol.nonempty_term_model]) },
      { exact reduct_of_complete_henkinization_models_T _ } },
    { rcases H with ⟨M, ⟨H_nonempty, H_sat⟩⟩,
      exact λ _, false_of_satisfied_false (satisfied_of_provable _ _ ‹_› ‹_› ‹_›) }
end

noncomputable def nonempty_model_of_consis {L : Language} {T : Theory L} (hT : is_consistent T) : Σ' M : Model T, nonempty M.fst.carrier :=
begin
  have := (model_existence T).mp hT, apply classical.psigma_of_exists,
  rcases this with ⟨M, hM, h_satisfied⟩,
  apply exists.intro, swap, exact ⟨M, h_satisfied⟩, exact hM
end

/-- model_existence is implied by completeness --/
theorem model_existence_of_completeness {L : Language} (T : Theory L) (h_completeness : ∀ (T : Theory L) (ψ : sentence L), T ⊢' ψ ↔ T ⊨ ψ) : is_consistent T ↔ (∃ M : Structure L, (nonempty M) ∧ M ⊨ T) :=
begin
  refine ⟨_,_⟩; intro H,
    { by_contra H', push_neg at H', apply H, finish },
    { intro H', rcases H with ⟨_,_,_⟩, rw[h_completeness] at H',
      exact false_of_satisfied_false (H' ‹_› ‹_›) }
end

theorem completeness {L : Language} (T : Theory L) (ψ : sentence L) : T ⊢' ψ ↔ T ⊨ ψ :=
begin
  refine ⟨λ _, satisfied_of_provable _ _ ‹_›, _⟩, by_contra H, push_neg at H,
  rcases nonempty_model_of_consis (consis_not_of_not_provable H.right) with ⟨⟨M,HM⟩, H_nonempty⟩,
  refine absurd H.left (not_satisfied_of_model_not _ _ _), swap,
  exact ((by simp at HM; simp*) : (⟨M, by tidy⟩ : Model T) ⊨ _), from ‹_›
end

theorem compactness {L : Language} {T : Theory L} {f : sentence L} :
  T ⊨ f ↔ ∃ fs : finset (sentence L), (↑fs : Theory L) ⊨ (f : sentence L) ∧ ↑fs ⊆ T :=
begin
  rw [<-(completeness T f), theory_proof_compactness_iff], simp only [completeness]
end


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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.gamma_comp_n
! leanprover-community/mathlib commit 5f68029a863bdf76029fa0f7a519e6163c14152e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.FunctorGamma
import Mathbin.CategoryTheory.Idempotents.HomologicalComplex

/-! The counit isomorphism of the Dold-Kan equivalence

The purpose of this file is to construct natural isomorphisms
`N₁Γ₀ : Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ)`
and `N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ))`.

-/

noncomputable section

open
  CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Idempotents Opposite SimplicialObject

open Simplicial

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C] [HasFiniteCoproducts C]

/-- The isomorphism  `(Γ₀.splitting K).nondeg_complex ≅ K` for all `K : chain_complex C ℕ`. -/
@[simps]
def Γ₀NondegComplexIso (K : ChainComplex C ℕ) : (Γ₀.splitting K).nondegComplex ≅ K :=
  HomologicalComplex.Hom.isoOfComponents (fun n => Iso.refl _)
    (by
      rintro _ n (rfl : n + 1 = _)
      dsimp
      simp only [id_comp, comp_id, alternating_face_map_complex.obj_d_eq, preadditive.sum_comp,
        preadditive.comp_sum]
      rw [Fintype.sum_eq_single (0 : Fin (n + 2))]
      · simp only [Fin.val_zero, pow_zero, one_zsmul]
        erw [Γ₀.obj.map_mono_on_summand_id_assoc, Γ₀.obj.termwise.map_mono_δ₀,
          splitting.ι_π_summand_eq_id, comp_id]
      · intro i hi
        dsimp
        simp only [preadditive.zsmul_comp, preadditive.comp_zsmul, assoc]
        erw [Γ₀.obj.map_mono_on_summand_id_assoc, Γ₀.obj.termwise.map_mono_eq_zero, zero_comp,
          zsmul_zero]
        · intro h
          replace h := congr_arg SimplexCategory.len h
          change n + 1 = n at h
          linarith
        · simpa only [is_δ₀.iff] using hi)
#align algebraic_topology.dold_kan.Γ₀_nondeg_complex_iso AlgebraicTopology.DoldKan.Γ₀NondegComplexIso

/-- The natural isomorphism `(Γ₀.splitting K).nondeg_complex ≅ K` for `K : chain_complex C ℕ`. -/
def Γ₀'CompNondegComplexFunctor : Γ₀' ⋙ Split.nondegComplexFunctor ≅ 𝟭 (ChainComplex C ℕ) :=
  NatIso.ofComponents Γ₀NondegComplexIso fun X Y f =>
    by
    ext n
    dsimp
    simp only [comp_id, id_comp]
#align algebraic_topology.dold_kan.Γ₀'_comp_nondeg_complex_functor AlgebraicTopology.DoldKan.Γ₀'CompNondegComplexFunctor

/-- The natural isomorphism `Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ)`. -/
def n₁Γ₀ : Γ₀ ⋙ n₁ ≅ toKaroubi (ChainComplex C ℕ) :=
  calc
    Γ₀ ⋙ n₁ ≅ Γ₀' ⋙ Split.forget C ⋙ n₁ := Functor.associator _ _ _
    _ ≅ Γ₀' ⋙ Split.nondegComplexFunctor ⋙ toKaroubi _ :=
      (isoWhiskerLeft Γ₀' Split.toKaroubiNondegComplexFunctorIsoN₁.symm)
    _ ≅ (Γ₀' ⋙ Split.nondegComplexFunctor) ⋙ toKaroubi _ := (Functor.associator _ _ _).symm
    _ ≅ 𝟭 _ ⋙ toKaroubi (ChainComplex C ℕ) := (isoWhiskerRight Γ₀'CompNondegComplexFunctor _)
    _ ≅ toKaroubi (ChainComplex C ℕ) := Functor.leftUnitor _

#align algebraic_topology.dold_kan.N₁Γ₀ AlgebraicTopology.DoldKan.n₁Γ₀

theorem n₁Γ₀_app (K : ChainComplex C ℕ) :
    n₁Γ₀.app K =
      (Γ₀.splitting K).toKaroubiNondegComplexIsoN₁.symm ≪≫
        (toKaroubi _).mapIso (Γ₀NondegComplexIso K) :=
  by
  ext1
  dsimp [N₁Γ₀]
  erw [id_comp, comp_id, comp_id]
  rfl
#align algebraic_topology.dold_kan.N₁Γ₀_app AlgebraicTopology.DoldKan.n₁Γ₀_app

theorem n₁Γ₀_hom_app (K : ChainComplex C ℕ) :
    n₁Γ₀.Hom.app K =
      (Γ₀.splitting K).toKaroubiNondegComplexIsoN₁.inv ≫
        (toKaroubi _).map (Γ₀NondegComplexIso K).Hom :=
  by
  change (N₁Γ₀.app K).Hom = _
  simpa only [N₁Γ₀_app]
#align algebraic_topology.dold_kan.N₁Γ₀_hom_app AlgebraicTopology.DoldKan.n₁Γ₀_hom_app

theorem n₁Γ₀_inv_app (K : ChainComplex C ℕ) :
    n₁Γ₀.inv.app K =
      (toKaroubi _).map (Γ₀NondegComplexIso K).inv ≫
        (Γ₀.splitting K).toKaroubiNondegComplexIsoN₁.Hom :=
  by
  change (N₁Γ₀.app K).inv = _
  simpa only [N₁Γ₀_app]
#align algebraic_topology.dold_kan.N₁Γ₀_inv_app AlgebraicTopology.DoldKan.n₁Γ₀_inv_app

@[simp]
theorem n₁Γ₀_hom_app_f_f (K : ChainComplex C ℕ) (n : ℕ) :
    (n₁Γ₀.Hom.app K).f.f n = (Γ₀.splitting K).toKaroubiNondegComplexIsoN₁.inv.f.f n :=
  by
  rw [N₁Γ₀_hom_app]
  apply comp_id
#align algebraic_topology.dold_kan.N₁Γ₀_hom_app_f_f AlgebraicTopology.DoldKan.n₁Γ₀_hom_app_f_f

@[simp]
theorem n₁Γ₀_inv_app_f_f (K : ChainComplex C ℕ) (n : ℕ) :
    (n₁Γ₀.inv.app K).f.f n = (Γ₀.splitting K).toKaroubiNondegComplexIsoN₁.Hom.f.f n :=
  by
  rw [N₁Γ₀_inv_app]
  apply id_comp
#align algebraic_topology.dold_kan.N₁Γ₀_inv_app_f_f AlgebraicTopology.DoldKan.n₁Γ₀_inv_app_f_f

theorem N₂Γ₂_toKaroubi : toKaroubi (ChainComplex C ℕ) ⋙ Γ₂ ⋙ n₂ = Γ₀ ⋙ n₁ :=
  by
  have h :=
    functor.congr_obj
      (functor_extension₂_comp_whiskering_left_to_karoubi (ChainComplex C ℕ) (simplicial_object C))
      Γ₀
  have h' :=
    functor.congr_obj
      (functor_extension₁_comp_whiskering_left_to_karoubi (simplicial_object C) (ChainComplex C ℕ))
      N₁
  dsimp [N₂, Γ₂, functor_extension₁] at h h'⊢
  rw [← functor.assoc, h, functor.assoc, h']
#align algebraic_topology.dold_kan.N₂Γ₂_to_karoubi AlgebraicTopology.DoldKan.N₂Γ₂_toKaroubi

/-- Compatibility isomorphism between `to_karoubi _ ⋙ Γ₂ ⋙ N₂` and `Γ₀ ⋙ N₁` which
are functors `chain_complex C ℕ ⥤ karoubi (chain_complex C ℕ)`. -/
@[simps]
def n₂Γ₂ToKaroubiIso : toKaroubi (ChainComplex C ℕ) ⋙ Γ₂ ⋙ n₂ ≅ Γ₀ ⋙ n₁ :=
  eqToIso N₂Γ₂_toKaroubi
#align algebraic_topology.dold_kan.N₂Γ₂_to_karoubi_iso AlgebraicTopology.DoldKan.n₂Γ₂ToKaroubiIso

/-- The counit isomorphism of the Dold-Kan equivalence for additive categories. -/
def n₂Γ₂ : Γ₂ ⋙ n₂ ≅ 𝟭 (Karoubi (ChainComplex C ℕ)) :=
  ((whiskeringLeft _ _ _).obj (toKaroubi (ChainComplex C ℕ))).preimageIso (n₂Γ₂ToKaroubiIso ≪≫ n₁Γ₀)
#align algebraic_topology.dold_kan.N₂Γ₂ AlgebraicTopology.DoldKan.n₂Γ₂

theorem n₂Γ₂_compatible_with_n₁Γ₀ (K : ChainComplex C ℕ) :
    n₂Γ₂.Hom.app ((toKaroubi _).obj K) = n₂Γ₂ToKaroubiIso.Hom.app K ≫ n₁Γ₀.Hom.app K :=
  congr_app
    (((whiskeringLeft _ _ (Karoubi (ChainComplex C ℕ))).obj
          (toKaroubi (ChainComplex C ℕ))).image_preimage
      (n₂Γ₂ToKaroubiIso.Hom ≫ n₁Γ₀.Hom : _ ⟶ toKaroubi _ ⋙ 𝟭 _))
    K
#align algebraic_topology.dold_kan.N₂Γ₂_compatible_with_N₁Γ₀ AlgebraicTopology.DoldKan.n₂Γ₂_compatible_with_n₁Γ₀

@[simp]
theorem n₂Γ₂_inv_app_f_f (X : Karoubi (ChainComplex C ℕ)) (n : ℕ) :
    (n₂Γ₂.inv.app X).f.f n =
      X.p.f n ≫ (Γ₀.splitting X.pt).ιSummand (Splitting.IndexSet.id (op [n])) :=
  by
  dsimp only [N₂Γ₂, functor.preimage_iso, iso.trans]
  simp only [whiskering_left_obj_preimage_app, N₂Γ₂_to_karoubi_iso_inv, functor.id_map,
    nat_trans.comp_app, eq_to_hom_app, functor.comp_map, assoc, karoubi.comp_f, karoubi.eq_to_hom_f,
    eq_to_hom_refl, comp_id, karoubi.comp_p_assoc, N₂_map_f_f, HomologicalComplex.comp_f,
    N₁Γ₀_inv_app_f_f, P_infty_on_Γ₀_splitting_summand_eq_self_assoc,
    splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f, Γ₂_map_f_app, karoubi.decomp_id_p_f]
  dsimp [to_karoubi]
  rw [splitting.ι_desc]
  dsimp [splitting.index_set.id]
  rw [karoubi.homological_complex.p_idem_assoc]
#align algebraic_topology.dold_kan.N₂Γ₂_inv_app_f_f AlgebraicTopology.DoldKan.n₂Γ₂_inv_app_f_f

end DoldKan

end AlgebraicTopology


import data.real.basic

open rat

lemma mul_own_denom (q : ℚ) : q * q.denom = q.num :=
begin
    rw [num_denom q],
    ring,
    have k₁ : (mk (q.num) ↑(q.denom)).denom = q.denom := by sorry,
    rw [k₁],
    have k₂ : ((mk (q.num) ↑(q.denom)).num) = q.num := by sorry,
    rw [k₂],
    sorry,
end

lemma div_2_of_sqr_div_2 (a : ℤ) (h : 2 ∣ a * a) : 2 ∣ a :=
begin
    by_contradiction k,
    dsimp [(∣)] at *,
    simp at k,
    cases h with c h,
    sorry,
end

theorem sqrt2nonintegral : ∀ (z : ℤ), z^2 ≠ 2 :=
begin
    intros z,
    by_contradiction h,
    rw [ne.def, not_not] at h,
    sorry,
end

theorem sqrt2irrational : ∀ (q : ℚ), q^2 ≠ 2 :=
begin
    intros q,
    by_contradiction h,
    rw [ne.def, not_not] at h,
    have pos := q.pos,
    have cop := q.cop,
    rw [pow_two] at h,
    have h₁ := congr_arg (λ (p : ℚ), p * q.denom * q.denom) h,
    simp at h₁,
    rw [mul_comm, mul_assoc, mul_own_denom, ←mul_assoc, mul_comm _ q,
        mul_own_denom, mul_assoc] at h₁,
    have w := dvd.intro (↑(q.denom) * ↑(q.denom)) h₁.symm,
    dsimp [(∣)] at w,
    sorry,
end


import data.mv_polynomial
import data.mv_polynomial.comm_ring
import Rings.ToMathlib.list
import Rings.ToMathlib.finset

namespace mv_polynomial

lemma support_le_total_degree
  {A σ : Type*} [comm_ring A]
  {p : mv_polynomial σ A} (x : σ)
  (f : σ →₀ ℕ) (hf : f ∈ p.support) :
  f x ≤ mv_polynomial.total_degree p :=
begin
  apply le_trans _ (finset.le_sup hf),
  simp only [finsupp.sum],
  apply finsupp.le_sum,
end

lemma total_degree_sum
  {A : Type*} {ι : Type*} {σ} [comm_semiring A] (s : finset ι)
  [decidable_eq ι]
  (ps : ι → mv_polynomial σ A) :
  (finset.sum s ps).total_degree
  ≤
  finset.sup s (mv_polynomial.total_degree ∘ ps) :=
finset.induction_on s (zero_le _)
(λ a s has hind, by rw finset.sum_insert has;
  exact le_trans (mv_polynomial.total_degree_add _ _)
    ( by rw [max_le_iff, finset.sup_insert];
      exact ⟨ le_sup_iff.mpr $ or.inl (le_of_eq rfl) , le_sup_iff.mpr $ or.inr hind ⟩))

lemma total_degree_monomial
  {A : Type*} [comm_semiring A] [decidable_eq A]
  {σ : Type*} (f : σ →₀ ℕ) (a : A) :
  (mv_polynomial.monomial f a).total_degree
  =
  ite (a = 0) ⊥ (f.sum (λ _ n, n)) :=
dite (a = 0)
(λ h, by rw [mv_polynomial.total_degree, mv_polynomial.support_monomial,
  if_pos h, if_pos h, finset.sup_empty])
(λ h, by rw [mv_polynomial.total_degree, mv_polynomial.support_monomial,
  if_neg h, if_neg h, finset.sup_singleton])

noncomputable def finsupp_coeff_add_zero_hom
  (A : Type*) [comm_semiring A] {σ} (f : σ →₀ ℕ) :
  add_zero_hom (mv_polynomial σ A) A :=
⟨ (λ p, mv_polynomial.coeff f p) , rfl , λ a b, rfl ⟩

lemma finsupp_coeff_sumr
  {A : Type*} [comm_semiring A] {σ} (f : σ →₀ ℕ)
  (ps : list (mv_polynomial σ A)) :
  mv_polynomial.coeff f ps.sumr
  =
  list.sumr (list.map (λ p : mv_polynomial σ A, mv_polynomial.coeff f p) ps) :=
list.add_zero_hom_sumr (mv_polynomial.finsupp_coeff_add_zero_hom A f) ps

-- variables
--   {σ S₁ R : Type*}
--   [comm_semiring R] [comm_semiring S₁]
--   {p q : mv_polynomial σ R}

-- lemma sum_support_eq_sumr {n : ℕ} (p : mv_polynomial (fin n) R) {as : (fin n → ℕ) → R} :
-- (p).support.sum
--       (λ f, as f) =
--     (list.mapr as
--        -- (λ (f : fin n → ℕ),
--        --    (ys.append (xs.append (poly_map_data.coeffs_dvector' d ps))).nth
--        --        (list.index_of' f (n_var_monom_of_deg_le_d_finset n d).to_list +
--        --           (↑i * (n_var_monom_of_deg_le_d_finset n d).to_list.length + n + n))
--        --        _ *
--        --      n.non_comm_prod
--        --        (λ (i : fin n),
--        --           (ys.append (xs.append (poly_map_data.coeffs_dvector' d ps))).nth (↑i + 0) inj_formula_aux3 ^ f i))
--        (n_var_monom_of_deg_le n d)).sumr

end mv_polynomial


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

! This file was ported from Lean 3 source module data.finset.order
! leanprover-community/mathlib commit e04043d6bf7264a3c84bc69711dc354958ca4516
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Basic

/-!
# Finsets of ordered types

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

universe u v w

variable {α : Type u}

/- warning: directed.finset_le -> Directed.finset_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} [_inst_1 : IsTrans.{u1} α r] {ι : Type.{u2}} [hι : Nonempty.{succ u2} ι] {f : ι -> α}, (Directed.{u1, succ u2} α ι r f) -> (forall (s : Finset.{u2} ι), Exists.{succ u2} ι (fun (z : ι) => forall (i : ι), (Membership.Mem.{u2, u2} ι (Finset.{u2} ι) (Finset.hasMem.{u2} ι) i s) -> (r (f i) (f z))))
but is expected to have type
  forall {α : Type.{u2}} {r : α -> α -> Prop} [_inst_1 : IsTrans.{u2} α r] {ι : Type.{u1}} [hι : Nonempty.{succ u1} ι] {f : ι -> α}, (Directed.{u2, succ u1} α ι r f) -> (forall (s : Finset.{u1} ι), Exists.{succ u1} ι (fun (z : ι) => forall (i : ι), (Membership.mem.{u1, u1} ι (Finset.{u1} ι) (Finset.instMembershipFinset.{u1} ι) i s) -> (r (f i) (f z))))
Case conversion may be inaccurate. Consider using '#align directed.finset_le Directed.finset_leₓ'. -/
theorem Directed.finset_le {r : α → α → Prop} [IsTrans α r] {ι} [hι : Nonempty ι] {f : ι → α}
    (D : Directed r f) (s : Finset ι) : ∃ z, ∀ i ∈ s, r (f i) (f z) :=
  show ∃ z, ∀ i ∈ s.1, r (f i) (f z) from
    Multiset.induction_on s.1
      (let ⟨z⟩ := hι
      ⟨z, fun _ => False.elim⟩)
      fun i s ⟨j, H⟩ =>
      let ⟨k, h₁, h₂⟩ := D i j
      ⟨k, fun a h =>
        Or.cases_on (Multiset.mem_cons.1 h) (fun h => h.symm ▸ h₁) fun h => trans (H _ h) h₂⟩
#align directed.finset_le Directed.finset_le

#print Finset.exists_le /-
theorem Finset.exists_le [Nonempty α] [Preorder α] [IsDirected α (· ≤ ·)] (s : Finset α) :
    ∃ M, ∀ i ∈ s, i ≤ M :=
  directed_id.finset_le _
#align finset.exists_le Finset.exists_le
-/


-- definitions copied from mathlib.hedetniemi/graph_theory/basic.lean & paths.lean

import data.equiv.basic
import logic.relation
import data.fintype.basic
import data.set.finite
import tactic

noncomputable theory

/-!
# Definitions of graphs
-/

universe variables v v₁ v₂ v₃ u u₁ u₂ u₃ u₄

structure directed_multigraph (V : Type u) :=
(edge : V → V → Sort v)

def directed_multigraph.vertices {V : Type u} (G : directed_multigraph V) := V

structure multigraph (V : Type u) extends directed_multigraph.{v} V :=
(inv : Π (x y), edge x y ≃ edge y x)

def multigraph_of_edges {n : ℕ} (e : list (fin n × fin n)) : multigraph (fin n) :=
{ edge := λ x y, fin (e.countp (λ p, p = (x, y) ∨ p = (y, x))),
  inv := λ x y, by { dsimp, convert equiv.refl _, funext, rw or_comm, } }

structure directed_graph (V : Type u) extends directed_multigraph.{0} V.

def directed_graph.vertices {V : Type u} (G : directed_graph V) := V

structure graph (V : Type u) extends multigraph.{0} V :=
(symm {} : symmetric edge)
(inv := λ x y, equiv.of_iff ⟨@symm _ _, @symm _ _⟩)

notation x `~[`G`]` y := G.edge x y

namespace graph
variables {V : Type u}
variables (G : graph V)
variables [fintype V]

def vertices (G : graph V) := V

def edge.symm {G : graph V} {x y : V} (e : x ~[G] y) : y ~[G] x := G.symm e

def is_linked (G : graph V) (x y : V) : Prop :=
relation.refl_trans_gen G.edge x y

def is_connected (G : graph V) : Prop :=
∀ ⦃x y⦄, G.is_linked x y

def is_loopless (G : graph V) : Prop :=
∀ ⦃x⦄, ¬ (x ~[G] x)

def neighbours (G : graph V) (v: V) : set V :=
begin
  have nbrs := {w : V | G.edge v w},
  exact nbrs,
end

def out_degree (G: graph V) (v : V) : ℕ :=
begin
  have nbrs := neighbours G v,
  have x : nbrs.finite,
  exact set.finite.of_fintype(nbrs),
  have fin_nbrs := set.finite.to_finset x,
  exact fin_nbrs.card,
end

def in_degree (G: graph V) (v : V) : ℕ :=
begin
  have out_nbrs := {w : V | G.edge w v},
  have x : out_nbrs.finite,
  exact set.finite.of_fintype(out_nbrs),
  exact (set.finite.to_finset x).card,
end

lemma ne_of_edge {G : graph V} (h : G.is_loopless) {x y : V} (e : x ~[G] y) :
  x ≠ y :=
by { rintro rfl, exact h e }
end graph

variables {V : Type u} (G : directed_multigraph.{v} V)
variables [fintype V]

namespace directed_multigraph

inductive path : V → V → Type (max v u)
| nil  : Π (h : V), path h h
| cons : Π {h s t : V} (e : G.edge h s) (l : path s t), path h t

notation a :: b := path.cons a b
notation `p[` l:(foldr `, ` (h t, path.cons h t) path.nil _ `]`) := l

abbreviation tour (x : V) : Type (max v u) := path G x x

end directed_multigraph

namespace multigraph

abbreviation path (H : multigraph.{v} V) := directed_multigraph.path H.to_directed_multigraph

end multigraph

namespace graph

abbreviation path (H : graph V) := multigraph.path H.to_multigraph

end graph

open directed_multigraph

namespace path

variables {H : multigraph.{v} V}

inductive mem : Π {w x y z : V} (e : H.edge x y) (p : H.path w z), Prop
| head : ∀ {x y z} (e : H.edge x y) (p : H.path y z), mem e (e :: p)
| head_symm : ∀ {x y z} (e : H.edge x y) (p : H.path y z), mem (H.inv x y e) (e :: p)
| tail : ∀ {v w x y z} (e : H.edge v w) (e' : H.edge x y) (p : H.path w z) (m : mem e' p), mem e' (e :: p)

inductive is_trail : Π {x y} (p : H.path x y), Prop
| nil : ∀ (x), is_trail (path.nil x)
| cons : ∀ {x y z} (e : H.edge x y) (p : H.path y z) (h : ¬ mem e p), is_trail (e :: p)

def is_Eulerian {x y} (p : H.path x y) : Prop :=
is_trail p ∧ ∀ {x' y'} (e : H.edge x' y'), mem e p

end path

open path

open graph

variables (H : multigraph.{v} V)


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

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_22 :
  real.log (5^4) / real.log (5^2) = 2 :=
begin
  field_simp [two_mul],
  rw div_eq_iff,
  ring,
  norm_num,
end


-- Author: Chris Hughes
import data.nat.modeq data.set.finite
open nat
local attribute [instance, priority 0] classical.prop_decidable
namespace set
open function
universe u
variable α : Type u

-- Two lemmas courtesy of Johannes Hölzl via gitter, due to be added to mathlib
lemma infinite_univ_nat : infinite (univ : set ℕ) :=
 assume (h : finite (univ : set ℕ)),
 let ⟨n, hn⟩ := finset.exists_nat_subset_range h.to_finset in
 have n ∈ finset.range n, from finset.subset_iff.mpr hn $ by simp,
 by simp * at *

lemma not_injective_nat_fintype [fintype α] [decidable_eq α] {f : ℕ → α} : ¬ injective f :=
 assume (h : injective f),
 have finite (f '' univ),
   from finite_subset (finset.finite_to_set $ fintype.elems α) (assume a h, fintype.complete a),
 have finite (univ : set ℕ), from finite_of_finite_image h this,
 infinite_univ_nat this

end set

noncomputable instance subtype.fintype_le_nat (n : ℕ) : fintype {i : ℕ // i ≤ n} :=
  classical.choice $ set.finite_le_nat n

theorem sheet_7_2e (f : ℕ → ℕ) (d) : d > 0 → ∃ a b, a ≠ b ∧ f a ≡ f b [MOD d]:=begin
  assume hd,
  unfold modeq,
  apply by_contradiction,
  assume h,
  let f' : ℕ → {i // i ≤ d} := λ n, ⟨f n % d, le_of_lt (mod_lt (f n) hd)⟩,
  have h_inj : function.injective f',
   assume a b,
   simp[f'],
   rw not_exists at h, have := h a, rw not_exists at this,
   have := this b,
   rwa [not_and',not_not] at this,
  exact set.not_injective_nat_fintype {i // i ≤ d} h_inj,
end


import data.real.basic
import data.real.nnreal
import data.real.ennreal
import data.pnat.factors
import data.pnat.prime
import data.finset.basic
import data.finset.pointwise
import data.multiset.basic
import data.multiset.fintype
import data.multiset.bind
import order.filter.basic
import order.filter.at_top_bot
import group_theory.submonoid.membership
import analysis.specific_limits.basic
import topology.basic
import topology.algebra.infinite_sum
import topology.instances.ennreal
import logic.equiv.defs
import algebra.group.basic  -- inv_inj
import algebra.group_power.basic  -- inv_pow
import algebra.big_operators.basic  -- finset.prod_inv_distrib

import .factors_le

open real filter
open_locale big_operators

variables {n : ℕ}

def primes_le (n : ℕ) : finset nat.primes := (finset.range (n+1)).subtype nat.prime

-- def all_factors_le (n k : ℕ) : Prop := ∀ (p : ℕ), p ∈ k.factors → p ≤ n

-- Define (commutative) submonoid of pnat using only primes_le n (closed under mul).
-- Later: Establish equivalence of (pnat_fac_le n) and finset.pi (for prod_sum).
def pnat_fac_le (n : ℕ) : submonoid ℕ+ := {
  carrier := {x : ℕ+ | all_factors_le n ↑x},  -- Doesn't need decidable?
  mul_mem' := by {
    simp [all_factors_le],
    intros a b ha hb p,
    specialize ha p,
    specialize hb p,
    rw nat.mem_factors_mul (ne_zero_of_lt a.prop) (ne_zero_of_lt b.prop),
    intro hp,
    exact or.elim hp ha hb, },
  one_mem' := by { simp [all_factors_le], },
}

namespace pnat_fac_le

instance ordered_comm_monoid : _root_.ordered_comm_monoid ↥(pnat_fac_le n) :=
  submonoid.to_ordered_comm_monoid _

instance has_one_pnat_fac_le : has_one (pnat_fac_le n) :=
{ one := ⟨1, show all_factors_le n (1 : ℕ+), by simp [all_factors_le]⟩, }

-- Necessary to define this? Seems to be needed below.
-- (`prime_multiset` is defined equal to `multiset nat.primes`)
instance has_mem_prime_multiset : has_mem nat.primes prime_multiset := { mem := multiset.mem, }

-- Switch to/from `nat.factors` representation (more results available?).
lemma mem_factor_multiset_iff {x : ℕ+} {p : nat.primes} :
  p ∈ pnat.factor_multiset x ↔ ↑p ∈ nat.factors ↑x :=
begin
  simp [pnat.factor_multiset, prime_multiset.of_nat_list, prime_multiset.of_nat_multiset],
  apply iff.intro,
  { intro h, cases h with q hq, cases hq with hq hq', simp [← hq'], exact hq, },
  { cases p with p hp, simp, },
end

-- Need to add has_mem to prime_multiset for this?
lemma mem_primes_le_of_mem_factor_multiset {x : pnat_fac_le n} {p : nat.primes} :
  p ∈ pnat.factor_multiset ↑x → p ∈ primes_le n :=
begin
  cases x with x hx,
  cases x with x hx',
  simp,
  intro hp,
  simp [pnat_fac_le, ← submonoid.mem_carrier, all_factors_le] at hx,
  simp [mem_factor_multiset_iff] at hp,
  specialize hx p hp,
  simp [primes_le, nat.lt_succ_iff],
  exact hx,
end

-- Is use of attach here neat? Or does it make things messier later?
def factor_multiset (x : pnat_fac_le n) : multiset ↥(primes_le n) :=
  (pnat.factor_multiset ↑x).attach.map
  (λ p, ⟨p.val, (mem_primes_le_of_mem_factor_multiset p.property)⟩)

end pnat_fac_le

namespace primes_le

lemma mem_pnat_fac_le_of_mem_primes_le {p : nat.primes} : p ∈ primes_le n → ↑p ∈ pnat_fac_le n :=
begin
  simp [primes_le, nat.lt_succ_iff],
  simp [pnat_fac_le, all_factors_le],
  cases p with p hp,
  simp [← coe_coe],
  simp [nat.factors_prime hp],
end

-- Enable cast from (primes_le n) to (pnat_fac_le n).
instance has_coe_pnat_fac_le : has_coe ↥(primes_le n) (pnat_fac_le n) :=
{ coe := λ p, ⟨↑(p.val), mem_pnat_fac_le_of_mem_primes_le p.property⟩, }

instance has_coe_multiset_pnat_fac_le : has_coe (multiset ↥(primes_le n)) (multiset (pnat_fac_le n)) :=
{ coe := λ s, s.map coe, }

instance has_coe_prime_multiset : has_coe (multiset ↥(primes_le n)) prime_multiset :=
{ coe := λ s, s.map coe, }

lemma injective_coe_prime_multiset : function.injective (coe : multiset ↥(primes_le n) → prime_multiset) :=
begin
  intros a b,
  unfold_coes,
  rw multiset.map_eq_map, { cc, },
  simp,
  exact subtype.coe_injective,
end

def multiset_prod : multiset ↥(primes_le n) → pnat_fac_le n := λ s, multiset.prod ↑s

end primes_le

namespace pnat_fac_le

-- lemma prod_factors_eq_self' (x : ↥(pnat_fac_le n)) : ↑(multiset_prod (factor_multiset x)) = (↑x : ℕ+) :=
-- begin
--   simp [multiset_prod, factor_multiset],
--   unfold_coes,
--   simp,
--   rw (_ : (λ u, ⟨↑↑u, _⟩ : {a // a ∈ pnat.factor_multiset ↑x} → ℕ+) = (coe : nat.primes → ℕ+) ∘ coe),
--   rotate, { ext, norm_cast, },
--   simp,
--   have h := pnat.prod_factor_multiset ↑x,
--   rw prime_multiset.prod at h,
--   unfold_coes at h,
--   simp [prime_multiset.to_pnat_multiset] at h,
--   exact h,
-- end

lemma prod_factors_eq_self (x : ↥(pnat_fac_le n)) :
  primes_le.multiset_prod (pnat_fac_le.factor_multiset x) = x :=
begin
  -- Easier to work with ℕ+?
  rw ← subtype.coe_inj,
  simp [primes_le.multiset_prod, pnat_fac_le.factor_multiset],
  unfold_coes,
  simp,
  rw (_ : (λ u, ⟨↑↑u, _⟩ : {a // a ∈ pnat.factor_multiset ↑x} → ℕ+) = (coe : nat.primes → ℕ+) ∘ coe),
  rotate, { ext, norm_cast, },
  simp,
  have h := pnat.prod_factor_multiset ↑x,
  rw prime_multiset.prod at h,
  unfold_coes at h,
  simp [prime_multiset.to_pnat_multiset] at h,
  exact h,
end

lemma factor_prod_primes_eq_self (s : multiset ↥(primes_le n)) : pnat_fac_le.factor_multiset (primes_le.multiset_prod s) = s :=
begin
  -- Easier to work with prime_multiset?
  rw ← primes_le.injective_coe_prime_multiset.eq_iff,
  simp [primes_le.multiset_prod, pnat_fac_le.factor_multiset],
  unfold_coes,
  simp,
  rw multiset.attach_map_coe,
  rw (_ : ↑((↑s : multiset ↥(pnat_fac_le n)).prod) = (s : prime_multiset).prod),
  { rw prime_multiset.factor_multiset_prod, unfold_coes, },
  { push_cast,
    unfold_coes,
    simp,
    rw (_ : (λ (x : ↥(primes_le n)), (⟨(↑(↑x : nat.primes) : ℕ), _⟩ : ℕ+)) = (coe : ↥(primes_le n) → ℕ+)),
    rotate, { unfold_coes, },
    rw prime_multiset.prod,
    rw (_ : ↑(multiset.map coe s) = (multiset.map coe s)),
    unfold_coes,
    simp [prime_multiset.to_pnat_multiset],
    apply multiset.map_congr rfl,
    intros p hp,
    unfold_coes, },
end

def equiv_multiset : pnat_fac_le n ≃ multiset (primes_le n) :=
{ to_fun    := pnat_fac_le.factor_multiset,
  inv_fun   := primes_le.multiset_prod,
  left_inv  := prod_factors_eq_self,
  right_inv := factor_prod_primes_eq_self, }

end pnat_fac_le

-- Another trivial coe...
instance multiset_primes_le_has_coe : has_coe (multiset (primes_le n)) prime_multiset :=
{ coe := λ s, s.map coe }

/- Show equivalence between (with_pnat_fac_le n) and finset.pi so that we can equate to geometric sum. -/

def multiset_to_finset_pi {α : Type*} [decidable_eq α] {s : finset α}
  (f : multiset ↥s) : Π (x : α), x ∈ s → ℕ := λ x hx, f.count ⟨x, hx⟩

def finset_pi_to_multiset {α : Type*} {s : finset α}
  (f : Π (x : α), x ∈ s → ℕ) : multiset ↥s :=
  (finset.univ : finset ↥s).val.bind (λ x, multiset.replicate (f x.val x.property) x)

lemma pi_to_multiset_to_pi {α : Type*} [decidable_eq α] {s : finset α} (f : multiset ↥s) :
  finset_pi_to_multiset (multiset_to_finset_pi f) = f :=
begin
  simp [multiset_to_finset_pi, finset_pi_to_multiset],
  ext x,
  rw multiset.count_bind,
  simp_rw multiset.count_replicate,
  rw ← finset.attach_val,
  rw ← finset.sum,  -- finset.sum f s = multiset.sum (multiset.map f s.val)
  rw finset.sum_ite_eq,
  simp [ite_eq_left_iff],
end

lemma multiset_to_pi_to_multiset {α : Type*} [decidable_eq α] {s : finset α} (f : Π (x : α), x ∈ s → ℕ) :
  multiset_to_finset_pi (finset_pi_to_multiset f) = f :=
begin
  simp [multiset_to_finset_pi, finset_pi_to_multiset],
  ext x hx,
  simp [multiset.count_bind, multiset.count_replicate],
  rw ← finset.attach_val,
  rw ← finset.sum,  -- finset.sum f s = multiset.sum (multiset.map f s.val)
  rw finset.sum_ite_eq,
  rw ite_eq_left_iff.mpr, { simp, },
  intro h, exfalso, apply h,
  exact finset.mem_attach _ _,
end

def equiv_multiset_finset_pi {α : Type*} [decidable_eq α] {s : finset α} :
  multiset ↥s ≃ (Π (x : α), x ∈ s → ℕ) :=
{ to_fun    := multiset_to_finset_pi,
  inv_fun   := finset_pi_to_multiset,
  left_inv  := pi_to_multiset_to_pi,
  right_inv := multiset_to_pi_to_multiset, }

def equiv_pnat_fac_le_finset_pi : pnat_fac_le n ≃ (Π (p : nat.primes), p ∈ primes_le n → ℕ) :=
  equiv.trans pnat_fac_le.equiv_multiset equiv_multiset_finset_pi

def finset_pi_range (n : ℕ) : ℕ → finset (Π (p : nat.primes), p ∈ primes_le n → ℕ) :=
  λ m, (primes_le n).pi (λ (p : nat.primes), finset.range m)

lemma mono_finset_pi_range : monotone (finset_pi_range n) :=
begin
  rw monotone,
  intros a b h,
  simp [finset_pi_range],
  apply finset.pi_subset,
  intros p hp,
  -- mono,  -- no good match found
  exact finset.range_mono h,
end

-- Make use of the fact that (⊥ : ℕ) = 0.
def pi_sup (f : Π (p : nat.primes), p ∈ primes_le n → ℕ) : ℕ :=
  finset.sup (primes_le n).attach (λ p, f p.val p.property : ↥(primes_le n) → ℕ)

lemma primes_le_nonempty (h : 2 ≤ n) : (primes_le n).nonempty :=
begin
  rw finset.nonempty,
  existsi (⟨2, nat.prime_two⟩ : nat.primes),
  simp [primes_le],
  linarith,
end

lemma subset_of_finset_pi_range_of_le_max {fs : finset (Π (p : nat.primes), p ∈ primes_le n → ℕ)} {m : ℕ} :
  finset.sup fs pi_sup < m → fs ⊆ finset_pi_range n m :=
begin
  intros hm,
  simp [finset_pi_range],
  intros f hf,
  simp,
  intros p hp,
  apply lt_of_le_of_lt _ hm,
  apply le_trans _ (finset.le_sup hf),
  simp [pi_sup],
  -- TODO: Some cleaner way to do this?
  have h : f p hp = (λ (q : ↥(primes_le n)), f (↑q : nat.primes) q.prop) ⟨p, hp⟩ := by simp,
  rw h, clear h,
  apply finset.le_sup,
  simp,
end

-- Can this be proven more simply? By relation to multiset or finsupp?
lemma tendsto_pi_range_at_top_at_top : tendsto (finset_pi_range n) at_top at_top :=
begin
  rw monotone.tendsto_at_top_at_top_iff mono_finset_pi_range,
  intro fs,
  existsi (finset.sup fs pi_sup).succ,
  apply subset_of_finset_pi_range_of_le_max,
  exact nat.lt_succ_self _,
end

noncomputable def prod_sum_inv_primes_le (n : ℕ) : ℕ → nnreal :=
  λ m, ∏ p in primes_le n, ∑ k in finset.range m, (↑p)⁻¹ ^ k

lemma tendsto_prod_sum_inv_prod_geom_series (n : ℕ) :
  tendsto (prod_sum_inv_primes_le n) at_top
  (nhds (∏ p in primes_le n, (1 - (↑p)⁻¹)⁻¹)) :=
begin
  apply tendsto_finset_prod,
  intros p hp,
  apply has_sum.tendsto_sum_nat,
  refine nnreal.has_sum_geometric _,
  rw inv_lt_one_iff,
  apply or.inr,
  norm_cast,
  exact nat.prime.one_lt p.prop,
end

instance has_coe_submonoid_pnat_set_nat : has_coe (submonoid ℕ+) (set ℕ) :=
{ coe := λ sm, coe '' sm.carrier, }  -- Any better way to do this? coe is injective...

lemma prod_geom_to_ennreal {s : finset nat.primes} :
  (↑(∏ p in s, (1 - (↑p : nnreal)⁻¹))⁻¹ : ennreal) = ∏ p in s, (↑(1 - (↑p : nnreal)⁻¹)⁻¹ : ennreal) :=
begin
  rw ← finset.prod_inv_distrib,
  push_cast,
end

theorem sum_inv_pnat_fac_le_eq_prod_geom_series (n : ℕ) :
  has_sum
  (λ p, (↑p)⁻¹ : ↥(pnat_fac_le n) → nnreal)
  (∏ p in primes_le n, (1 - (↑p)⁻¹)⁻¹) :=
begin
  -- Convert from sum over pnat_fac_le to sum over finset.pi.
  rw ← equiv.has_sum_iff equiv_pnat_fac_le_finset_pi.symm,
  simp [equiv_pnat_fac_le_finset_pi, equiv_multiset_finset_pi, pnat_fac_le.equiv_multiset, equiv.trans],

  -- Switch to ennreal to work with ∑' and ⨆.
  rw ← ennreal.has_sum_coe,
  simp,
  rw summable.has_sum_iff ennreal.summable,  -- Shorter version exists?
  rw ennreal.tsum_eq_supr_sum,

  have h := tendsto_prod_sum_inv_prod_geom_series n,
  rw prod_sum_inv_primes_le at h,
  simp_rw finset.prod_sum at h,

  -- Sum of nnreal will be equal to supremum over subsets.
  -- And limit over a sequence of subsets that approaches at_top will be supremum.
  -- Need to show that the limit we have gives the supremum.

  -- Change range of summation.
  -- TODO: Is there an identity for this? finset.image?
  rw (by { simp [finset_pi_range], } :
    ∀ {f : (Π (p : nat.primes), p ∈ primes_le n → ℕ) → nnreal},
    (λ (m : ℕ), ∑ ks in (primes_le n).pi (λ (a : nat.primes), finset.range m), f ks) =
    (λ (s : finset (Π (p : nat.primes), p ∈ primes_le n → ℕ)), ∑ ks in s, f ks) ∘ finset_pi_range n)
    at h,

  rw ← tendsto_iff_tendsto_subseq_of_monotone
    (_ : monotone
      (λ (s : finset (Π (p : nat.primes), p ∈ primes_le n → ℕ)),
        ∑ p in s, ∏ x in (primes_le n).attach, (↑(x.val) : nnreal)⁻¹ ^ p x.val x.property))
    tendsto_pi_range_at_top_at_top
    at h,
  rotate,
  { rw monotone,
    intros a b h',
    apply finset.sum_le_sum_of_subset,
    exact h', },

  -- Switch to ennreal (need complete_linear_order).
  rw ← ennreal.tendsto_coe at h,
  push_cast at h,  -- Move coe for supr_eq_of_tendsto.
  replace h := supr_eq_of_tendsto _ h,
  rotate,
  { rw monotone,
    intros a b h',
    norm_cast,
    apply finset.sum_le_sum_of_subset,
    exact h', },

  -- Make the RHS match.
  push_cast,
  simp_rw ← coe_coe,
  rw prod_geom_to_ennreal,
  rw ← h,
  clear h,

  apply supr_congr,
  intro s,
  apply finset.sum_congr rfl,
  intros ks hks,

  simp [primes_le.multiset_prod, finset_pi_to_multiset],
  norm_cast,
  simp,
  -- Now need to get the ennreal out from inside the ⁻¹?
  rw (by simp : ∀ {x : ℕ}, (↑x : ennreal) =  ↑(↑x : nnreal)),
  rw ← ennreal.coe_inv _,
  rotate, { simp, },
  -- Timeout with simp here.
  rw ennreal.coe_eq_coe,
  rw inv_inj,
  rw ← submonoid.coe_multiset_prod,
  rw (_ : ∀ {s : multiset ↥(primes_le n)}, (↑s : multiset ↥(pnat_fac_le n)) = multiset.map coe s),
  rotate, { unfold_coes, simp, },
  simp [multiset.map_bind],
  rw ← pnat.coe_coe_monoid_hom,  -- replace coe : ℕ+ → ℕ with ⇑pnat.coe_monoid_hom
  rw monoid_hom.map_multiset_prod, -- convert prod ℕ+ to prod ℕ
  simp [finset.prod_eq_multiset_prod],
  rw multiset.map_congr rfl,
  intros p hp,
  -- Timeout with simp here.
  repeat { rw ← coe_coe, },
end