import tactic.linarith

example {α : Type} (_inst : Π (a : Prop), decidable a)
  [linear_ordered_field α]
  {a b c : α}
  (ha : a < 0)
  (hb : ¬b = 0)
  (hc' : c = 0)
  (h : (1 - a) * (b * b) ≤ 0)
  (hc : 0 ≤ 0)
  (this : -(a * -b * -b + b * -b + 0) = (1 - a) * (b * b))
  (h : (1 - a) * (b * b) ≤ 0) :
  0 < 1 - a :=
begin
  linarith
end

example (e b c a v0 v1 : ℚ) (h1 : v0 = 5*a) (h2 : v1 = 3*b) (h3 : v0 + v1 + c = 10) :
  v0 + 5 + (v1 - 3) + (c - 2) = 10 :=
by linarith

example (u v r s t : ℚ) (h : 0 < u*(t*v + t*r + s)) : 0 < (t*(r + v) + s)*3*u :=
by linarith

example (A B : ℚ) (h : 0 < A * B) : 0 < 8*A*B :=
begin
  linarith
end

example (A B : ℚ) (h : 0 < A * B) : 0 < A*8*B :=
begin
  linarith
end

example (A B : ℚ) (h : 0 < A * B) : 0 < A*B/8 :=
begin
  linarith
end

example (A B : ℚ) (h : 0 < A * B) : 0 < A/8*B :=
begin
  linarith
end

example (ε : ℚ) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε :=
 by linarith

example (x y z : ℚ) (h1 : 2*x  < 3*y) (h2 : -4*x + z/2 < 0)
        (h3 : 12*y - z < 0)  : false :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 2 < ε :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 3 + ε / 3 + ε / 3 = ε :=
by linarith

example (a b c : ℚ)  (h2 : b + 2 > 3 + b) : false :=
by linarith {discharger := `[ring]}

example (a b c : ℚ)  (h2 : b + 2 > 3 + b) : false :=
by linarith

example (a b c : ℚ) (x y : ℤ) (h1 : x ≤ 3*y) (h2 : b + 2 > 3 + b) : false :=
by linarith {restrict_type := ℚ}

example (g v V c h : ℚ) (h1 : h = 0) (h2 : v = V) (h3 : V > 0) (h4 : g > 0)
        (h5 : 0 ≤ c) (h6 : c < 1) :
  v ≤ V :=
by linarith

constant nat.prime : ℕ → Prop

example (x y z : ℚ) (h1 : 2*x + ((-3)*y) < 0) (h2 : (-4)*x + 2*z < 0)
       (h3 : 12*y + (-4)* z < 0) (h4 : nat.prime 7) : false :=
by linarith

example (x y z : ℚ) (h1 : 2*1*x + (3)*(y*(-1)) < 0) (h2 : (-2)*x*2 < -(z + z))
       (h3 : 12*y + (-4)* z < 0) (h4 : nat.prime 7) : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0) (h3 : x*y < 5)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0) (h3 : x*y < 5) :
        ¬ 12*y - 4* z < 0 :=
by linarith

example (w x y z : ℤ) (h1 : 4*x + (-3)*y + 6*w ≤ 0) (h2 : (-1)*x < 0)
        (h3 : y < 0) (h4 : w ≥ 0) (h5 : nat.prime x.nat_abs) : false :=
by linarith

example (a b c : ℚ) (h1 : a > 0) (h2 : b > 5) (h3 : c < -10)
        (h4 : a + b - c < 3)  : false :=
by linarith

example (a b c : ℚ) (h2 : b > 0) (h3 : ¬ b ≥ 0) : false :=
by linarith

example (a b c : ℚ) (h2 : (2 : ℚ) > 3)  : a + b - c ≥ 3 :=
by linarith {exfalso := ff}

example (x : ℚ) (hx : x > 0) (h : x.num < 0) : false :=
by linarith [rat.num_pos_iff_pos.mpr hx, h]

example (x : ℚ) (hx : x > 0) (h : x.num < 0) : false :=
by linarith only [rat.num_pos_iff_pos.mpr hx, h]

example (x y z : ℚ) (hx : x ≤ 3*y) (h2 : y ≤ 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (x y z : ℕ) (hx : x ≤ 3*y) (h2 : y ≤ 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (x y z : ℚ) (hx : ¬ x > 3*y) (h2 : ¬ y > 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (h1 : (1 : ℕ) < 1) : false :=
by linarith

example (a b c : ℚ) (h2 : b > 0) (h3 : b < 0) : nat.prime 10 :=
by linarith

example (a b c : ℕ) : a + b ≥ a :=
by linarith

example (a b c : ℕ) : ¬ a + b < a :=
by linarith

example (x y : ℚ) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) (h' : (x + 4) * x ≥ 0)
  (h'' : (6 + 3 * y) * y ≥ 0)  : false :=
by linarith

example (x y : ℚ)
  (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3 ∧ (x + 4) * x ≥ 0 ∧ (6 + 3 * y) * y ≥ 0) : false :=
by linarith

example (a b i : ℕ) (h1 :  ¬ a < i) (h2 : b < i) (h3 : a ≤ b) : false :=
by linarith

example (n : ℕ) (h1 : n ≤ 3) (h2 : n > 2) : n = 3 := by linarith

example (z : ℕ) (hz : ¬ z ≥ 2) (h2 : ¬ z + 1 ≤ 2) : false :=
by linarith

example (z : ℕ) (hz : ¬ z ≥ 2) : z + 1 ≤ 2 :=
by linarith

example (a b c : ℚ) (h1 : 1 / a < b) (h2 : b < c) : 1 / a < c :=
by linarith

example
(N : ℕ) (n : ℕ) (Hirrelevant : n > N)
(A : ℚ) (l : ℚ) (h : A - l ≤ -(A - l)) (h_1 : ¬A ≤ -A) (h_2 : ¬l ≤ -l)
(h_3 : -(A - l) < 1) :  A < l + 1 := by linarith

example (d : ℚ) (q n : ℕ) (h1 : ((q : ℚ) - 1)*n ≥ 0) (h2 : d = 2/3*(((q : ℚ) - 1)*n)) :
  d ≤ ((q : ℚ) - 1)*n :=
by linarith

example (d : ℚ) (q n : ℕ) (h1 : ((q : ℚ) - 1)*n ≥ 0) (h2 : d = 2/3*(((q : ℚ) - 1)*n)) :
  ((q : ℚ) - 1)*n - d = 1/3 * (((q : ℚ) - 1)*n) :=
by linarith

example (a : ℚ) (ha : 0 ≤ a) : 0 * 0 ≤ 2 * a :=
by linarith

example (x : ℚ) : id x ≥ x :=
by success_if_fail {linarith}; linarith!

example (x y z : ℚ) (hx : x < 5) (hx2 : x > 5) (hy : y < 5000000000) (hz : z > 34*y) : false :=
by linarith only [hx, hx2]

example (x y z : ℚ) (hx : x < 5) (hy : y < 5000000000) (hz : z > 34*y) : x ≤ 5 :=
by linarith only [hx]

example (x y : ℚ) (h : x < y) : x ≠ y := by linarith

example (x y : ℚ) (h : x < y) : ¬ x = y := by linarith

example (u v x y A B : ℚ)
(a : 0 < A)
(a_1 : 0 <= 1 - A)
(a_2 : 0 <= B - 1)
(a_3 : 0 <= B - x)
(a_4 : 0 <= B - y)
(a_5 : 0 <= u)
(a_6 : 0 <= v)
(a_7 : 0 < A - u)
(a_8 : 0 < A - v) :
 u * y + v * x + u * v < 3 * A * B :=
 by nlinarith

example (u v x y A B : ℚ) : (0 < A) → (A ≤ 1) → (1 ≤ B)
→ (x ≤ B) → ( y ≤ B)
→ (0 ≤ u ) → (0 ≤ v )
→ (u < A) → ( v < A)
→ (u * y + v * x + u * v < 3 * A * B) :=
begin
  intros,
  nlinarith
end

example (a b c z : ℚ) (_ : a ≤ z) (E0 : b ≤ c) (E1 : c ≤ a) (E2 : 0 ≤ c) : b ≤ a + c := by linarith

example (u v x y A B : ℚ)
(a_7 : 0 < A - u)
(a_8 : 0 < A - v) :
(0 ≤ A * (1 - A))
→ (0 ≤ A * (B - 1))
→ (0 < A * (A - u))
→ (0 ≤ (B - 1) * (A - u))
→ (0 ≤ (B - 1) * (A - v))
→ (0 ≤ (B - x) * v)
→ (0 ≤ (B - y) * u)
→ (0 ≤ u * (A - v))
→ u * y + v * x + u * v < 3 * A * B :=
begin
  intros,
  linarith
end

example (u v x y A B : ℚ)
(a : 0 < A)
(a_1 : 0 <= 1 - A)
(a_2 : 0 <= B - 1)
(a_3 : 0 <= B - x)
(a_4 : 0 <= B - y)
(a_5 : 0 <= u)
(a_6 : 0 <= v)
(a_7 : 0 < A - u)
(a_8 : 0 < A - v) :
 (0 < A * A)
-> (0 <= A * (1 - A))
-> (0 <= A * (B - 1))
-> (0 <= A * (B - x))
-> (0 <= A * (B - y))
-> (0 <= A * u)
-> (0 <= A * v)
-> (0 < A * (A - u))
-> (0 < A * (A - v))
-> (0 <= (1 - A) * A)
-> (0 <= (1 - A) * (1 - A))
-> (0 <= (1 - A) * (B - 1))
-> (0 <= (1 - A) * (B - x))
-> (0 <= (1 - A) * (B - y))
-> (0 <= (1 - A) * u)
-> (0 <= (1 - A) * v)
-> (0 <= (1 - A) * (A - u))
-> (0 <= (1 - A) * (A - v))
-> (0 <= (B - 1) * A)
-> (0 <= (B - 1) * (1 - A))
-> (0 <= (B - 1) * (B - 1))
-> (0 <= (B - 1) * (B - x))
-> (0 <= (B - 1) * (B - y))
-> (0 <= (B - 1) * u)
-> (0 <= (B - 1) * v)
-> (0 <= (B - 1) * (A - u))
-> (0 <= (B - 1) * (A - v))
-> (0 <= (B - x) * A)
-> (0 <= (B - x) * (1 - A))
-> (0 <= (B - x) * (B - 1))
-> (0 <= (B - x) * (B - x))
-> (0 <= (B - x) * (B - y))
-> (0 <= (B - x) * u)
-> (0 <= (B - x) * v)
-> (0 <= (B - x) * (A - u))
-> (0 <= (B - x) * (A - v))
-> (0 <= (B - y) * A)
-> (0 <= (B - y) * (1 - A))
-> (0 <= (B - y) * (B - 1))
-> (0 <= (B - y) * (B - x))
-> (0 <= (B - y) * (B - y))
-> (0 <= (B - y) * u)
-> (0 <= (B - y) * v)
-> (0 <= (B - y) * (A - u))
-> (0 <= (B - y) * (A - v))
-> (0 <= u * A)
-> (0 <= u * (1 - A))
-> (0 <= u * (B - 1))
-> (0 <= u * (B - x))
-> (0 <= u * (B - y))
-> (0 <= u * u)
-> (0 <= u * v)
-> (0 <= u * (A - u))
-> (0 <= u * (A - v))
-> (0 <= v * A)
-> (0 <= v * (1 - A))
-> (0 <= v * (B - 1))
-> (0 <= v * (B - x))
-> (0 <= v * (B - y))
-> (0 <= v * u)
-> (0 <= v * v)
-> (0 <= v * (A - u))
-> (0 <= v * (A - v))
-> (0 < (A - u) * A)
-> (0 <= (A - u) * (1 - A))
-> (0 <= (A - u) * (B - 1))
-> (0 <= (A - u) * (B - x))
-> (0 <= (A - u) * (B - y))
-> (0 <= (A - u) * u)
-> (0 <= (A - u) * v)
-> (0 < (A - u) * (A - u))
-> (0 < (A - u) * (A - v))
-> (0 < (A - v) * A)
-> (0 <= (A - v) * (1 - A))
-> (0 <= (A - v) * (B - 1))
-> (0 <= (A - v) * (B - x))
-> (0 <= (A - v) * (B - y))
-> (0 <= (A - v) * u)
-> (0 <= (A - v) * v)
-> (0 < (A - v) * (A - u))
-> (0 < (A - v) * (A - v))
->
  u * y + v * x + u * v < 3 * A * B :=
begin
  intros,
  linarith
end

example (A B : ℚ) : (0 < A) → (1 ≤ B) → (0 < A / 8 * B) :=
begin
  intros, nlinarith
end

example (x y : ℚ) : 0 ≤ x ^2 + y ^2 :=
by nlinarith

example (x y : ℚ) : 0 ≤ x*x + y*y :=
by nlinarith

example (x y : ℚ) : x = 0 → y = 0 → x*x + y*y = 0 :=
by intros; nlinarith

lemma norm_eq_zero_iff {x y : ℚ} : x * x + y * y = 0 ↔ x = 0 ∧ y = 0 :=
begin
  split,
  { intro, split; nlinarith },
  { intro, nlinarith }
end

lemma norm_nonpos_right {x y : ℚ} (h1 : x * x + y * y ≤ 0) : y = 0 :=
by nlinarith

lemma norm_nonpos_left (x y : ℚ) (h1 : x * x + y * y ≤ 0) : x = 0 :=
by nlinarith

variables {E : Type*} [add_group E]
example (f : ℤ → E) (h : 0 = f 0) : 1 ≤ 2 := by nlinarith
example (a : E) (h : a = a) : 1 ≤ 2  := by nlinarith

-- test that the apply bug doesn't affect linarith preprocessing

constant α : Type
variable [fact false] -- we work in an inconsistent context below
def leα : α → α → Prop := λ a b, ∀ c : α, true

noncomputable instance : linear_ordered_field α :=
by refine_struct { le := leα }; exact (fact.out false).elim

example (a : α) (ha : a < 2) : a ≤ a :=
by linarith

example (p q r s t u v w : ℕ) (h1 : p + u = q + t) (h2 : r + w = s + v) :
  p * r + q * s + (t * w + u * v) = p * s + q * r + (t * v + u * w) :=
by nlinarith

-- Tests involving a norm, including that squares in a type where `sq_nonneg` does not apply
-- do not cause an exception
variables {R : Type*} [ring R] (abs : R → ℚ)

lemma abs_nonneg' : ∀ r, 0 ≤ abs r := (fact.out false).elim

example (t : R) (a b : ℚ) (h : a ≤ b) : abs (t^2) * a ≤ abs (t^2) * b :=
by nlinarith [abs_nonneg' abs (t^2)]

example (t : R)  (a b : ℚ) (h : a ≤ b) : a ≤ abs (t^2) + b :=
by linarith [abs_nonneg' abs (t^2)]

example (t : R) (a b : ℚ) (h : a ≤ b) : abs t * a ≤ abs t * b :=
by nlinarith [abs_nonneg' abs t]

constant T : Type

attribute [instance]
constant T_zero : ordered_ring T

namespace T

lemma zero_lt_one : (0 : T) < 1 := (fact.out false).elim

lemma works {a b : ℕ} (hab : a ≤ b) (h : b < a) : false :=
begin
  linarith,
end

end T

example (a b c : ℚ) (h : a ≠ b) (h3 : b ≠ c) (h2 : a ≥ b) : b ≠ c :=
by linarith {split_ne := tt}

example (a b c : ℚ) (h : a ≠ b) (h2 : a ≥ b) (h3 : b ≠ c) : a > b :=
by linarith {split_ne := tt}

example (x y : ℚ) (h₁ : 0 ≤ y) (h₂ : y ≤ x) : y * x ≤ x * x := by nlinarith

example (x y : ℚ) (h₁ : 0 ≤ y) (h₂ : y ≤ x) : y * x ≤ x ^ 2 := by nlinarith

axiom foo {x : int} : 1 ≤ x → 1 ≤ x*x
lemma bar (x y: int)(h : 0 ≤ y ∧ 1 ≤ x) : 1 ≤ y + x*x := by linarith [foo h.2]

-- issue #9822
lemma mytest (j : ℕ) (h : 0 < j) : j-1 < j:=
begin
  linarith,
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module geometry.manifold.instances.real
! leanprover-community/mathlib commit 6a033cb3d188a12ca5c509b33e2eaac1c61916cd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Geometry.Manifold.SmoothManifoldWithCorners
import Mathbin.Analysis.InnerProductSpace.PiL2

/-!
# Constructing examples of manifolds over ℝ

We introduce the necessary bits to be able to define manifolds modelled over `ℝ^n`, boundaryless
or with boundary or with corners. As a concrete example, we construct explicitly the manifold with
boundary structure on the real interval `[x, y]`.

More specifically, we introduce
* `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n)` for the model space
  used to define `n`-dimensional real manifolds with boundary
* `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_quadrant n)` for the model space used
  to define `n`-dimensional real manifolds with corners

## Notations

In the locale `manifold`, we introduce the notations
* `𝓡 n` for the identity model with corners on `euclidean_space ℝ (fin n)`
* `𝓡∂ n` for `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n)`.

For instance, if a manifold `M` is boundaryless, smooth and modelled on `euclidean_space ℝ (fin m)`,
and `N` is smooth with boundary modelled on `euclidean_half_space n`, and `f : M → N` is a smooth
map, then the derivative of `f` can be written simply as `mfderiv (𝓡 m) (𝓡∂ n) f` (as to why the
model with corners can not be implicit, see the discussion in `smooth_manifold_with_corners.lean`).

## Implementation notes

The manifold structure on the interval `[x, y] = Icc x y` requires the assumption `x < y` as a
typeclass. We provide it as `[fact (x < y)]`.
-/

noncomputable section

open Set Function

open Manifold

/-- The half-space in `ℝ^n`, used to model manifolds with boundary. We only define it when
`1 ≤ n`, as the definition only makes sense in this case.
-/
def EuclideanHalfSpace (n : ℕ) [Zero (Fin n)] : Type :=
  { x : EuclideanSpace ℝ (Fin n) // 0 ≤ x 0 }
#align euclidean_half_space EuclideanHalfSpace

/--
The quadrant in `ℝ^n`, used to model manifolds with corners, made of all vectors with nonnegative
coordinates.
-/
def EuclideanQuadrant (n : ℕ) : Type :=
  { x : EuclideanSpace ℝ (Fin n) // ∀ i : Fin n, 0 ≤ x i }
#align euclidean_quadrant EuclideanQuadrant

section

/- Register class instances for euclidean half-space and quadrant, that can not be noticed
without the following reducibility attribute (which is only set in this section). -/
attribute [local reducible] EuclideanHalfSpace EuclideanQuadrant

variable {n : ℕ}

instance [Zero (Fin n)] : TopologicalSpace (EuclideanHalfSpace n) := by infer_instance

instance : TopologicalSpace (EuclideanQuadrant n) := by infer_instance

instance [Zero (Fin n)] : Inhabited (EuclideanHalfSpace n) :=
  ⟨⟨0, le_rfl⟩⟩

instance : Inhabited (EuclideanQuadrant n) :=
  ⟨⟨0, fun i => le_rfl⟩⟩

theorem range_half_space (n : ℕ) [Zero (Fin n)] :
    (range fun x : EuclideanHalfSpace n => x.val) = { y | 0 ≤ y 0 } := by simp
#align range_half_space range_half_space

theorem range_quadrant (n : ℕ) :
    (range fun x : EuclideanQuadrant n => x.val) = { y | ∀ i : Fin n, 0 ≤ y i } := by simp
#align range_quadrant range_quadrant

end

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (i «expr ∈ » ({0} : set[set] (fin[fin] n))) -/
/--
Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_half_space n)`, used as
a model for manifolds with boundary. In the locale `manifold`, use the shortcut `𝓡∂ n`.
-/
def modelWithCornersEuclideanHalfSpace (n : ℕ) [Zero (Fin n)] :
    ModelWithCorners ℝ (EuclideanSpace ℝ (Fin n)) (EuclideanHalfSpace n)
    where
  toFun := Subtype.val
  invFun x := ⟨update x 0 (max (x 0) 0), by simp [le_refl]⟩
  source := univ
  target := { x | 0 ≤ x 0 }
  map_source' x hx := x.property
  map_target' x hx := mem_univ _
  left_inv' := fun ⟨xval, xprop⟩ hx =>
    by
    rw [Subtype.mk_eq_mk, update_eq_iff]
    exact ⟨max_eq_left xprop, fun i _ => rfl⟩
  right_inv' x hx := update_eq_iff.2 ⟨max_eq_left hx, fun i _ => rfl⟩
  source_eq := rfl
  unique_diff' :=
    by
    have this : UniqueDiffOn ℝ _ :=
      UniqueDiffOn.pi (Fin n) (fun _ => ℝ) _ _ fun i (_ : i ∈ ({0} : Set (Fin n))) =>
        uniqueDiffOn_Ici 0
    simpa only [singleton_pi] using this
  continuous_toFun := continuous_subtype_val
  continuous_invFun :=
    (continuous_id.update 0 <| (continuous_apply 0).max continuous_const).subtype_mk _
#align model_with_corners_euclidean_half_space modelWithCornersEuclideanHalfSpace

/--
Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_quadrant n)`, used as a
model for manifolds with corners -/
def modelWithCornersEuclideanQuadrant (n : ℕ) :
    ModelWithCorners ℝ (EuclideanSpace ℝ (Fin n)) (EuclideanQuadrant n)
    where
  toFun := Subtype.val
  invFun x := ⟨fun i => max (x i) 0, fun i => by simp only [le_refl, or_true_iff, le_max_iff]⟩
  source := univ
  target := { x | ∀ i, 0 ≤ x i }
  map_source' x hx := by simpa only [Subtype.range_val] using x.property
  map_target' x hx := mem_univ _
  left_inv' := fun ⟨xval, xprop⟩ hx => by
    ext i
    simp only [Subtype.coe_mk, xprop i, max_eq_left]
  right_inv' x hx := by
    ext1 i
    simp only [hx i, max_eq_left]
  source_eq := rfl
  unique_diff' :=
    by
    have this : UniqueDiffOn ℝ _ :=
      UniqueDiffOn.univ_pi (Fin n) (fun _ => ℝ) _ fun i => uniqueDiffOn_Ici 0
    simpa only [pi_univ_Ici] using this
  continuous_toFun := continuous_subtype_val
  continuous_invFun :=
    Continuous.subtype_mk
      (continuous_pi fun i => (continuous_id.max continuous_const).comp (continuous_apply i)) _
#align model_with_corners_euclidean_quadrant modelWithCornersEuclideanQuadrant

-- mathport name: model_with_corners_self.euclidean
scoped[Manifold]
  notation "𝓡 " n =>
    (modelWithCornersSelf ℝ (EuclideanSpace ℝ (Fin n)) :
      ModelWithCorners ℝ (EuclideanSpace ℝ (Fin n)) (EuclideanSpace ℝ (Fin n)))

-- mathport name: model_with_corners_euclidean_half_space.euclidean
scoped[Manifold]
  notation "𝓡∂ " n =>
    (modelWithCornersEuclideanHalfSpace n :
      ModelWithCorners ℝ (EuclideanSpace ℝ (Fin n)) (EuclideanHalfSpace n))

/-- The left chart for the topological space `[x, y]`, defined on `[x,y)` and sending `x` to `0` in
`euclidean_half_space 1`.
-/
def iccLeftChart (x y : ℝ) [Fact (x < y)] : LocalHomeomorph (Icc x y) (EuclideanHalfSpace 1)
    where
  source := { z : Icc x y | z.val < y }
  target := { z : EuclideanHalfSpace 1 | z.val 0 < y - x }
  toFun := fun z : Icc x y => ⟨fun i => z.val - x, sub_nonneg.mpr z.property.1⟩
  invFun z := ⟨min (z.val 0 + x) y, by simp [le_refl, z.prop, le_of_lt (Fact.out (x < y))]⟩
  map_source' := by simp only [imp_self, sub_lt_sub_iff_right, mem_set_of_eq, forall_true_iff]
  map_target' := by
    simp only [min_lt_iff, mem_set_of_eq]
    intro z hz
    left
    dsimp [-Subtype.val_eq_coe] at hz
    linarith
  left_inv' := by
    rintro ⟨z, hz⟩ h'z
    simp only [mem_set_of_eq, mem_Icc] at hz h'z
    simp only [hz, min_eq_left, sub_add_cancel]
  right_inv' := by
    rintro ⟨z, hz⟩ h'z
    rw [Subtype.mk_eq_mk]
    funext
    dsimp at hz h'z
    have A : x + z 0 ≤ y := by linarith
    rw [Subsingleton.elim i 0]
    simp only [A, add_comm, add_sub_cancel', min_eq_left]
  open_source :=
    haveI : IsOpen { z : ℝ | z < y } := isOpen_Iio
    this.preimage continuous_subtype_val
  open_target := by
    have : IsOpen { z : ℝ | z < y - x } := isOpen_Iio
    have : IsOpen { z : EuclideanSpace ℝ (Fin 1) | z 0 < y - x } :=
      this.preimage (@continuous_apply (Fin 1) (fun _ => ℝ) _ 0)
    exact this.preimage continuous_subtype_val
  continuous_toFun := by
    apply Continuous.continuousOn
    apply Continuous.subtype_mk
    have : Continuous fun (z : ℝ) (i : Fin 1) => z - x :=
      Continuous.sub (continuous_pi fun i => continuous_id) continuous_const
    exact this.comp continuous_subtype_val
  continuous_invFun := by
    apply Continuous.continuousOn
    apply Continuous.subtype_mk
    have A : Continuous fun z : ℝ => min (z + x) y :=
      (continuous_id.add continuous_const).min continuous_const
    have B : Continuous fun z : EuclideanSpace ℝ (Fin 1) => z 0 := continuous_apply 0
    exact (A.comp B).comp continuous_subtype_val
#align Icc_left_chart iccLeftChart

/-- The right chart for the topological space `[x, y]`, defined on `(x,y]` and sending `y` to `0` in
`euclidean_half_space 1`.
-/
def iccRightChart (x y : ℝ) [Fact (x < y)] : LocalHomeomorph (Icc x y) (EuclideanHalfSpace 1)
    where
  source := { z : Icc x y | x < z.val }
  target := { z : EuclideanHalfSpace 1 | z.val 0 < y - x }
  toFun := fun z : Icc x y => ⟨fun i => y - z.val, sub_nonneg.mpr z.property.2⟩
  invFun z :=
    ⟨max (y - z.val 0) x, by simp [le_refl, z.prop, le_of_lt (Fact.out (x < y)), sub_eq_add_neg]⟩
  map_source' := by simp only [imp_self, mem_set_of_eq, sub_lt_sub_iff_left, forall_true_iff]
  map_target' := by
    simp only [lt_max_iff, mem_set_of_eq]
    intro z hz
    left
    dsimp [-Subtype.val_eq_coe] at hz
    linarith
  left_inv' := by
    rintro ⟨z, hz⟩ h'z
    simp only [mem_set_of_eq, mem_Icc] at hz h'z
    simp only [hz, sub_eq_add_neg, max_eq_left, add_add_neg_cancel'_right, neg_add_rev, neg_neg]
  right_inv' := by
    rintro ⟨z, hz⟩ h'z
    rw [Subtype.mk_eq_mk]
    funext
    dsimp at hz h'z
    have A : x ≤ y - z 0 := by linarith
    rw [Subsingleton.elim i 0]
    simp only [A, sub_sub_cancel, max_eq_left]
  open_source :=
    haveI : IsOpen { z : ℝ | x < z } := isOpen_Ioi
    this.preimage continuous_subtype_val
  open_target := by
    have : IsOpen { z : ℝ | z < y - x } := isOpen_Iio
    have : IsOpen { z : EuclideanSpace ℝ (Fin 1) | z 0 < y - x } :=
      this.preimage (@continuous_apply (Fin 1) (fun _ => ℝ) _ 0)
    exact this.preimage continuous_subtype_val
  continuous_toFun := by
    apply Continuous.continuousOn
    apply Continuous.subtype_mk
    have : Continuous fun (z : ℝ) (i : Fin 1) => y - z :=
      continuous_const.sub (continuous_pi fun i => continuous_id)
    exact this.comp continuous_subtype_val
  continuous_invFun := by
    apply Continuous.continuousOn
    apply Continuous.subtype_mk
    have A : Continuous fun z : ℝ => max (y - z) x :=
      (continuous_const.sub continuous_id).max continuous_const
    have B : Continuous fun z : EuclideanSpace ℝ (Fin 1) => z 0 := continuous_apply 0
    exact (A.comp B).comp continuous_subtype_val
#align Icc_right_chart iccRightChart

/-- Charted space structure on `[x, y]`, using only two charts taking values in
`euclidean_half_space 1`.
-/
instance iccManifold (x y : ℝ) [Fact (x < y)] : ChartedSpace (EuclideanHalfSpace 1) (Icc x y)
    where
  atlas := {iccLeftChart x y, iccRightChart x y}
  chartAt z := if z.val < y then iccLeftChart x y else iccRightChart x y
  mem_chart_source z := by
    by_cases h' : z.val < y
    · simp only [h', if_true]
      exact h'
    · simp only [h', if_false]
      apply lt_of_lt_of_le (Fact.out (x < y))
      simpa only [not_lt] using h'
  chart_mem_atlas z := by by_cases h' : (z : ℝ) < y <;> simp [h']
#align Icc_manifold iccManifold

/-- The manifold structure on `[x, y]` is smooth.
-/
instance Icc_smooth_manifold (x y : ℝ) [Fact (x < y)] :
    SmoothManifoldWithCorners (𝓡∂ 1) (Icc x y) :=
  by
  have M : ContDiffOn ℝ ∞ (fun z : EuclideanSpace ℝ (Fin 1) => -z + fun i => y - x) univ :=
    by
    rw [contDiffOn_univ]
    exact cont_diff_id.neg.add contDiff_const
  apply smoothManifoldWithCorners_of_contDiffOn
  intro e e' he he'
  simp only [atlas, mem_singleton_iff, mem_insert_iff] at he he'
  /- We need to check that any composition of two charts gives a `C^∞` function. Each chart can be
      either the left chart or the right chart, leaving 4 possibilities that we handle successively.
      -/
    rcases he with (rfl | rfl) <;>
    rcases he' with (rfl | rfl)
  ·-- `e = left chart`, `e' = left chart`
    exact (mem_groupoid_of_pregroupoid.mpr (symm_trans_mem_contDiffGroupoid _ _ _)).1
  · -- `e = left chart`, `e' = right chart`
    apply M.congr_mono _ (subset_univ _)
    rintro _ ⟨⟨hz₁, hz₂⟩, ⟨⟨z, hz₀⟩, rfl⟩⟩
    simp only [modelWithCornersEuclideanHalfSpace, iccLeftChart, iccRightChart, update_same,
      max_eq_left, hz₀, lt_sub_iff_add_lt, mfld_simps] at hz₁ hz₂
    rw [min_eq_left hz₁.le, lt_add_iff_pos_left] at hz₂
    ext i
    rw [Subsingleton.elim i 0]
    simp only [modelWithCornersEuclideanHalfSpace, iccLeftChart, iccRightChart, *, PiLp.add_apply,
      PiLp.neg_apply, max_eq_left, min_eq_left hz₁.le, update_same, mfld_simps]
    abel
  · -- `e = right chart`, `e' = left chart`
    apply M.congr_mono _ (subset_univ _)
    rintro _ ⟨⟨hz₁, hz₂⟩, ⟨z, hz₀⟩, rfl⟩
    simp only [modelWithCornersEuclideanHalfSpace, iccLeftChart, iccRightChart, max_lt_iff,
      update_same, max_eq_left hz₀, mfld_simps] at hz₁ hz₂
    rw [lt_sub_comm] at hz₁
    ext i
    rw [Subsingleton.elim i 0]
    simp only [modelWithCornersEuclideanHalfSpace, iccLeftChart, iccRightChart, PiLp.add_apply,
      PiLp.neg_apply, update_same, max_eq_left, hz₀, hz₁.le, mfld_simps]
    abel
  ·-- `e = right chart`, `e' = right chart`
    exact (mem_groupoid_of_pregroupoid.mpr (symm_trans_mem_contDiffGroupoid _ _ _)).1
#align Icc_smooth_manifold Icc_smooth_manifold

/-! Register the manifold structure on `Icc 0 1`, and also its zero and one. -/

section

attribute [local instance] Real.fact_zero_lt_one

instance : ChartedSpace (EuclideanHalfSpace 1) (Icc (0 : ℝ) 1) := by infer_instance

instance : SmoothManifoldWithCorners (𝓡∂ 1) (Icc (0 : ℝ) 1) := by infer_instance

end


import analysis.calculus.mean_value
import analysis.special_functions.pow_deriv

import math.rpow

open real

theorem deriv_within_div_pow
{C x : ℝ}
(hx : x ≠ 0)
(s : set ℝ)
(hu : unique_diff_within_at ℝ s x)
:
∀ n : ℕ, 1 < n →  deriv_within (λ y : ℝ, C/y^n) s x = -n*C/x^(n+1):=
begin
  intros n hn,
  conv {
    find (C) {rw show C = (λ y : ℝ, C) y, by simp},
  },
  rw deriv_within_div (differentiable_within_at_const C) (differentiable_within_at_pow n) (pow_ne_zero n hx) hu,
  field_simp [deriv_within_const x s C hu, deriv_within_pow n hu],
  rw [mul_assoc, mul_assoc, ← pow_add, add_comm n 1, ← add_assoc, nat.sub_add_cancel (le_of_lt hn), pow_two, ← pow_add, ← mul_assoc, mul_comm C _],
end

theorem has_deriv_at_div_pow
{C x : ℝ}
(hx : x ≠ 0)
:
∀ n : ℕ, 1 < n → has_deriv_at (λ y : ℝ, C/y^n) (-n*C/x^(n+1)) x :=
begin
  intros n hn,
  conv {
    find (C) {rw show C = (λ y : ℝ, C) y, by simp},
  },
  rw show -↑n * C / x ^ (n + 1) = (0*x^n-((λ y : ℝ, C) x)*(n*x^(n-1)))/(x^n)^2, by {field_simp, iterate 3 {rw [mul_assoc],},
  rw [← pow_add, add_comm n 1, ← add_assoc, nat.sub_add_cancel (le_of_lt hn), pow_two, ← pow_add], ring_exp,  },
  apply has_deriv_at.div (has_deriv_at_const x C) (has_deriv_at_pow n x),
  simp [pow_ne_zero n hx],
end

theorem differentiable_at_div_pow
{C x : ℝ}
(hx : x ≠ 0)
:
∀ n : ℕ, differentiable_at ℝ (λ y : ℝ, C/y^n) x :=
begin
  intro,
  conv {
    find (C) {rw show C = (λ y : ℝ, C) y, by simp},
  },
  apply differentiable_at.div (differentiable_at_const C) (differentiable_at_pow n) (pow_ne_zero n hx),
end

theorem deriv_div_pow
{C x : ℝ}
(hx : x ≠ 0)
:
∀ n : ℕ, 1 < n →  deriv (λ y : ℝ, C/y^n) x = -n*C/x^(n+1):=
begin
  intros n hn,
  apply has_deriv_at.deriv (has_deriv_at_div_pow hx _ hn),
end

theorem deriv_inv_rpow
{C z: ℝ} (hz : 0 < z)
:
∀ r:ℝ, 1 ≤ r →  deriv (λ x:ℝ, C/x^r) z = -r*C/z^(r+1):=
begin
  intros n hr,
  have h :  (λ x:ℝ, C/x^n) = λ x:ℝ, ((λ x:ℝ, C) x)/((λ x:ℝ, x^n) x) := by simp,
  rw [h, deriv_div],
  simp,
  have h2 : z^(n-1)/(z^n)^2 = 1/z^(n+1),
  { rw [rpow_sub, rpow_one, pow_two],
    field_simp,
    rw [← mul_assoc, div_mul_left, mul_comm z _, ← rpow_add_one],
    linarith,
    apply rpow_ne_zero hz,
    linarith,
    linarith,},
  have h3 : deriv (λ (x : ℝ), x ^ n) z = n*z^(n-1),
  { rw real.deriv_rpow_const, right, exact hr},
  rw [h3, ← mul_assoc, neg_div, mul_div_assoc, pow_two, ← rpow_add hz, ← rpow_sub hz,
  show n-1-(n+n) = -(n+1), by { rw ← sub_sub, simp, ring_nf}],
  have hz1 : 0 ≤ z, by linarith,
  rw [rpow_neg hz1 (n+1), mul_comm C n, neg_div],
  field_simp,
  simp,
  simp,
  apply has_deriv_at.differentiable_at,
  apply real.has_deriv_at_rpow_const (or.inr hr),
  simp,
  rw ← ne.def,
  apply rpow_ne_zero hz,
  linarith,
end

theorem differentiable_at_inv_rpow
{C z: ℝ} (hz : 0 < z)
:
∀ r:ℝ, 1 ≤ r →  differentiable_at ℝ (λ x:ℝ, C/x^r) z :=
begin
  intros n hr,
  have h :  (λ x:ℝ, C/x^n) = λ x:ℝ, ((λ x:ℝ, C) x)/((λ x:ℝ, x^n) x) := by simp,
  apply has_deriv_at.differentiable_at,
  rw h,
  apply has_deriv_at.div,
  apply has_deriv_at_const,
  apply has_deriv_at_rpow_const hr.inr,
  simp,
  rw ← ne.def,
  apply ne_of_gt,
  apply zero_lt_rpow hz,
  linarith,
end

lemma deriv_abs_of_nonneg_rpow
{z : ℝ} (hpos : ∀ x : ℝ, 0 ≤ x)
:
∀ r:ℝ, 1 ≤ r →  (deriv (λ x : ℝ, |x^r|) z) = r * z ^ (r - 1):=
begin
  intros r hr,
  conv {  find (|_^r|) {rw [abs_rpow_of_nonneg (hpos x), abs_of_nonneg (hpos x)],}},
  rw real.deriv_rpow_const,
  exact hr.inr,
end

lemma deriv_inv_abs_rpow
{C z: ℝ} (hz : 0 < z) (hC : 0 < C) (hpos : ∀ x : ℝ, 0 < x)
:
∀ r:ℝ, 1 ≤ r →  deriv (λ x : ℝ , |C|/|x^r|) z = -r*C/z^(r+1):=
begin
  intros r hr,
  simp only [abs_of_pos hC],
  have hnonneg : ∀ x : ℝ, 0 ≤ x := by {intro x, refine le_of_lt (hpos x)},
  conv {  find (|_^r|) {rw [abs_rpow_of_nonneg (hnonneg x), abs_of_nonneg (hnonneg x)],}},
  apply deriv_inv_rpow hz _ hr,
end

theorem differentiable_at_inv_abs_rpow
{C z: ℝ} (hz : 0 < z) (hC : 0 < C) (hpos : ∀ x : ℝ, 0 < x)
:
∀ r:ℝ, 1 ≤ r →  differentiable_at ℝ (λ x:ℝ, |C|/|x^r|) z :=
begin
  intros r hr,
  simp only [abs_of_pos hC],
  have hnonneg : ∀ x : ℝ, 0 ≤ x := by {intro x, refine le_of_lt (hpos x)},
  conv {  find (|_^r|) {rw [abs_rpow_of_nonneg (hnonneg x), abs_of_nonneg (hnonneg x)],}},
  apply differentiable_at_inv_rpow hz r hr,

end


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

! This file was ported from Lean 3 source module data.multiset.functor
! leanprover-community/mathlib commit e46da4e335b8671848ac711ccb34b42538c0d800
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Multiset.Bind
import Mathbin.Control.Traversable.Lemmas
import Mathbin.Control.Traversable.Instances

/-!
# Functoriality of `multiset`.

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

universe u

namespace Multiset

open List

instance : Functor Multiset where map := @map

#print Multiset.fmap_def /-
@[simp]
theorem fmap_def {α' β'} {s : Multiset α'} (f : α' → β') : f <$> s = s.map f :=
  rfl
#align multiset.fmap_def Multiset.fmap_def
-/

instance : LawfulFunctor Multiset := by refine' { .. } <;> intros <;> simp

open IsLawfulTraversable CommApplicative

variable {F : Type u → Type u} [Applicative F] [CommApplicative F]

variable {α' β' : Type u} (f : α' → F β')

#print Multiset.traverse /-
def traverse : Multiset α' → F (Multiset β') :=
  Quotient.lift (Functor.map coe ∘ Traversable.traverse f)
    (by
      introv p; unfold Function.comp
      induction p
      case nil => rfl
      case
        cons =>
        have :
          Multiset.cons <$> f p_x <*> coe <$> traverse f p_l₁ =
            Multiset.cons <$> f p_x <*> coe <$> traverse f p_l₂ :=
          by rw [p_ih]
        simpa [functor_norm]
      case
        swap =>
        have :
          (fun a b (l : List β') => (↑(a :: b :: l) : Multiset β')) <$> f p_y <*> f p_x =
            (fun a b l => ↑(a :: b :: l)) <$> f p_x <*> f p_y :=
          by
          rw [CommApplicative.commutative_map]
          congr
          funext a b l
          simpa [flip] using perm.swap b a l
        simp [(· ∘ ·), this, functor_norm]
      case trans => simp [*])
#align multiset.traverse Multiset.traverse
-/

instance : Monad Multiset :=
  { Multiset.functor with
    pure := fun α x => {x}
    bind := @bind }

/- warning: multiset.pure_def -> Multiset.pure_def is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, Eq.{succ u1} (α -> (Multiset.{u1} α)) (Pure.pure.{u1, u1} (fun {α : Type.{u1}} => Multiset.{u1} α) (Applicative.toHasPure.{u1, u1} (fun {α : Type.{u1}} => Multiset.{u1} α) (Monad.toApplicative.{u1, u1} (fun {α : Type.{u1}} => Multiset.{u1} α) Multiset.monad.{u1})) α) (Singleton.singleton.{u1, u1} α (Multiset.{u1} α) (Multiset.hasSingleton.{u1} α))
but is expected to have type
  forall {α : Type.{u1}}, Eq.{succ u1} (α -> (Multiset.{u1} α)) (Pure.pure.{u1, u1} Multiset.{u1} (Applicative.toPure.{u1, u1} Multiset.{u1} (Monad.toApplicative.{u1, u1} Multiset.{u1} Multiset.instMonadMultiset.{u1})) α) (Singleton.singleton.{u1, u1} α (Multiset.{u1} α) (Multiset.instSingletonMultiset.{u1} α))
Case conversion may be inaccurate. Consider using '#align multiset.pure_def Multiset.pure_defₓ'. -/
@[simp]
theorem pure_def {α} : (pure : α → Multiset α) = singleton :=
  rfl
#align multiset.pure_def Multiset.pure_def

/- warning: multiset.bind_def -> Multiset.bind_def is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}}, Eq.{succ u1} ((Multiset.{u1} α) -> (α -> (Multiset.{u1} β)) -> (Multiset.{u1} β)) (Bind.bind.{u1, u1} Multiset.{u1} (Monad.toHasBind.{u1, u1} Multiset.{u1} Multiset.monad.{u1}) α β) (Multiset.bind.{u1, u1} α β)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}}, Eq.{succ u1} ((Multiset.{u1} α) -> (α -> (Multiset.{u1} β)) -> (Multiset.{u1} β)) (fun (x._@.Mathlib.Data.Multiset.Functor._hyg.720 : Multiset.{u1} α) (x._@.Mathlib.Data.Multiset.Functor._hyg.722 : α -> (Multiset.{u1} β)) => Bind.bind.{u1, u1} Multiset.{u1} (Monad.toBind.{u1, u1} Multiset.{u1} Multiset.instMonadMultiset.{u1}) α β x._@.Mathlib.Data.Multiset.Functor._hyg.720 x._@.Mathlib.Data.Multiset.Functor._hyg.722) (Multiset.bind.{u1, u1} α β)
Case conversion may be inaccurate. Consider using '#align multiset.bind_def Multiset.bind_defₓ'. -/
@[simp]
theorem bind_def {α β} : (· >>= ·) = @bind α β :=
  rfl
#align multiset.bind_def Multiset.bind_def

instance : LawfulMonad Multiset
    where
  bind_pure_comp_eq_map α β f s := Multiset.induction_on s rfl fun a s ih => by simp
  pure_bind α β x f := by simp [pure]
  bind_assoc := @bind_assoc

open Functor

open Traversable IsLawfulTraversable

/- warning: multiset.lift_coe -> Multiset.lift_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (x : List.{u1} α) (f : (List.{u1} α) -> β) (h : forall (a : List.{u1} α) (b : List.{u1} α), (HasEquivₓ.Equiv.{succ u1} (List.{u1} α) (setoidHasEquiv.{succ u1} (List.{u1} α) (List.isSetoid.{u1} α)) a b) -> (Eq.{succ u2} β (f a) (f b))), Eq.{succ u2} β (Quotient.lift.{succ u1, succ u2} (List.{u1} α) β (List.isSetoid.{u1} α) f h ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (List.{u1} α) (Multiset.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (coeBase.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (Multiset.hasCoe.{u1} α)))) x)) (f x)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (x : List.{u2} α) (f : (List.{u2} α) -> β) (h : forall (a : List.{u2} α) (b : List.{u2} α), (HasEquiv.Equiv.{succ u2, 0} (List.{u2} α) (instHasEquiv.{succ u2} (List.{u2} α) (List.isSetoid.{u2} α)) a b) -> (Eq.{succ u1} β (f a) (f b))), Eq.{succ u1} β (Quotient.lift.{succ u2, succ u1} (List.{u2} α) β (List.isSetoid.{u2} α) f h (Multiset.ofList.{u2} α x)) (f x)
Case conversion may be inaccurate. Consider using '#align multiset.lift_coe Multiset.lift_coeₓ'. -/
@[simp]
theorem lift_coe {α β : Type _} (x : List α) (f : List α → β)
    (h : ∀ a b : List α, a ≈ b → f a = f b) : Quotient.lift f h (x : Multiset α) = f x :=
  Quotient.lift_mk _ _ _
#align multiset.lift_coe Multiset.lift_coe

/- warning: multiset.map_comp_coe -> Multiset.map_comp_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} (h : α -> β), Eq.{succ u1} ((List.{u1} α) -> (Multiset.{u1} β)) (Function.comp.{succ u1, succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (Multiset.{u1} β) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => Multiset.{u1} β) Multiset.functor.{u1} α β h) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (List.{u1} α) (Multiset.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (coeBase.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (Multiset.hasCoe.{u1} α)))))) (Function.comp.{succ u1, succ u1, succ u1} (List.{u1} α) (List.{u1} β) (Multiset.{u1} β) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (List.{u1} β) (Multiset.{u1} β) (HasLiftT.mk.{succ u1, succ u1} (List.{u1} β) (Multiset.{u1} β) (CoeTCₓ.coe.{succ u1, succ u1} (List.{u1} β) (Multiset.{u1} β) (coeBase.{succ u1, succ u1} (List.{u1} β) (Multiset.{u1} β) (Multiset.hasCoe.{u1} β))))) (Functor.map.{u1, u1} List.{u1} (Traversable.toFunctor.{u1} List.{u1} List.traversable.{u1}) α β h))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} (h : α -> β), Eq.{succ u1} ((List.{u1} α) -> (Multiset.{u1} β)) (Function.comp.{succ u1, succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (Multiset.{u1} β) (Functor.map.{u1, u1} Multiset.{u1} Multiset.functor.{u1} α β h) (Coe.coe.{succ u1, succ u1} (List.{u1} α) (Multiset.{u1} α) (Multiset.instCoeListMultiset.{u1} α))) (Function.comp.{succ u1, succ u1, succ u1} (List.{u1} α) (List.{u1} β) (Multiset.{u1} β) (Coe.coe.{succ u1, succ u1} (List.{u1} β) (Multiset.{u1} β) (Multiset.instCoeListMultiset.{u1} β)) (Functor.map.{u1, u1} List.{u1} List.instFunctorList.{u1} α β h))
Case conversion may be inaccurate. Consider using '#align multiset.map_comp_coe Multiset.map_comp_coeₓ'. -/
@[simp]
theorem map_comp_coe {α β} (h : α → β) :
    Functor.map h ∘ coe = (coe ∘ Functor.map h : List α → Multiset β) := by
  funext <;> simp [Functor.map]
#align multiset.map_comp_coe Multiset.map_comp_coe

/- warning: multiset.id_traverse -> Multiset.id_traverse is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (x : Multiset.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Multiset.{u1} α)) (Multiset.traverse.{u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) id.commApplicative.{u1} α α (id.mk.{succ u1} α) x) x
but is expected to have type
  forall {α : Type.{u1}} (x : Multiset.{u1} α), Eq.{succ u1} (Id.{u1} (Multiset.{u1} α)) (Multiset.traverse.{u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) instCommApplicativeIdToApplicativeInstMonadId.{u1} α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) x) x
Case conversion may be inaccurate. Consider using '#align multiset.id_traverse Multiset.id_traverseₓ'. -/
theorem id_traverse {α : Type _} (x : Multiset α) : traverse id.mk x = x :=
  Quotient.inductionOn x (by intro ; simp [traverse]; rfl)
#align multiset.id_traverse Multiset.id_traverse

/- warning: multiset.comp_traverse -> Multiset.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1} -> Type.{u1}} {H : Type.{u1} -> Type.{u1}} [_inst_3 : Applicative.{u1, u1} G] [_inst_4 : Applicative.{u1, u1} H] [_inst_5 : CommApplicative.{u1, u1} G _inst_3] [_inst_6 : CommApplicative.{u1, u1} H _inst_4] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> (G β)) (h : β -> (H γ)) (x : Multiset.{u1} α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H (Multiset.{u1} γ)) (Multiset.traverse.{u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H) (Functor.Comp.applicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H _inst_3 _inst_4) (Functor.Comp.commApplicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H _inst_3 _inst_4 _inst_5 _inst_6) α γ (Function.comp.{succ u1, succ u1, succ u1} α (G (H γ)) (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H γ) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H γ) (Function.comp.{succ u1, succ u1, succ u1} α (G β) (G (H γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_3) β (H γ) h) g)) x) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) H (Multiset.{u1} γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_3) (Multiset.{u1} β) (H (Multiset.{u1} γ)) (Multiset.traverse.{u1} H _inst_4 _inst_6 β γ h) (Multiset.traverse.{u1} G _inst_3 _inst_5 α β g x)))
but is expected to have type
  forall {G : Type.{u1} -> Type.{u1}} {H : Type.{u1} -> Type.{u1}} [_inst_3 : Applicative.{u1, u1} G] [_inst_4 : Applicative.{u1, u1} H] [_inst_5 : CommApplicative.{u1, u1} G _inst_3] [_inst_6 : CommApplicative.{u1, u1} H _inst_4] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> (G β)) (h : β -> (H γ)) (x : Multiset.{u1} α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} G H (Multiset.{u1} γ)) (Multiset.traverse.{u1} (Functor.Comp.{u1, u1, u1} G H) (Functor.Comp.instApplicativeComp.{u1, u1, u1} G H _inst_3 _inst_4) (Functor.Comp.instCommApplicativeCompInstApplicativeComp.{u1, u1, u1} G H _inst_3 _inst_4 _inst_5 _inst_6) α γ (Function.comp.{succ u1, succ u1, succ u1} α (G (H γ)) (Functor.Comp.{u1, u1, u1} G H γ) (Functor.Comp.mk.{u1, u1, u1} G H γ) (Function.comp.{succ u1, succ u1, succ u1} α (G β) (G (H γ)) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_3) β (H γ) h) g)) x) (Functor.Comp.mk.{u1, u1, u1} G H (Multiset.{u1} γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_3) (Multiset.{u1} β) (H (Multiset.{u1} γ)) (Multiset.traverse.{u1} H _inst_4 _inst_6 β γ h) (Multiset.traverse.{u1} G _inst_3 _inst_5 α β g x)))
Case conversion may be inaccurate. Consider using '#align multiset.comp_traverse Multiset.comp_traverseₓ'. -/
theorem comp_traverse {G H : Type _ → Type _} [Applicative G] [Applicative H] [CommApplicative G]
    [CommApplicative H] {α β γ : Type _} (g : α → G β) (h : β → H γ) (x : Multiset α) :
    traverse (Comp.mk ∘ Functor.map h ∘ g) x = Comp.mk (Functor.map (traverse h) (traverse g x)) :=
  Quotient.inductionOn x
    (by
      intro <;> simp [traverse, comp_traverse, functor_norm] <;>
        simp [(· <$> ·), (· ∘ ·), functor_norm])
#align multiset.comp_traverse Multiset.comp_traverse

#print Multiset.map_traverse /-
theorem map_traverse {G : Type _ → Type _} [Applicative G] [CommApplicative G] {α β γ : Type _}
    (g : α → G β) (h : β → γ) (x : Multiset α) :
    Functor.map (Functor.map h) (traverse g x) = traverse (Functor.map h ∘ g) x :=
  Quotient.inductionOn x
    (by intro <;> simp [traverse, functor_norm] <;> rw [LawfulFunctor.comp_map, map_traverse])
#align multiset.map_traverse Multiset.map_traverse
-/

#print Multiset.traverse_map /-
theorem traverse_map {G : Type _ → Type _} [Applicative G] [CommApplicative G] {α β γ : Type _}
    (g : α → β) (h : β → G γ) (x : Multiset α) : traverse h (map g x) = traverse (h ∘ g) x :=
  Quotient.inductionOn x
    (by intro <;> simp [traverse] <;> rw [← Traversable.traverse_map h g] <;> [rfl, infer_instance])
#align multiset.traverse_map Multiset.traverse_map
-/

#print Multiset.naturality /-
theorem naturality {G H : Type _ → Type _} [Applicative G] [Applicative H] [CommApplicative G]
    [CommApplicative H] (eta : ApplicativeTransformation G H) {α β : Type _} (f : α → G β)
    (x : Multiset α) : eta (traverse f x) = traverse (@eta _ ∘ f) x :=
  Quotient.inductionOn x
    (by intro <;> simp [traverse, IsLawfulTraversable.naturality, functor_norm])
#align multiset.naturality Multiset.naturality
-/

end Multiset


/-
Copyright (c) 2023 Wojciech Nawrocki. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wojciech Nawrocki
-/

import Mathlib.Data.Set.Basic
import Mathlib.Order.BooleanAlgebra

import ProofChecker.Model.ToMathlib

/-! Formulas of propositional logic. -/

/-- A propositional formula over variables of type `ν`. -/
inductive PropForm (ν : Type u)
  | var (x : ν)
  | tr
  | fls
  | neg (φ : PropForm ν)
  | conj (φ₁ φ₂ : PropForm ν)
  | disj (φ₁ φ₂ : PropForm ν)
  | impl (φ₁ φ₂ : PropForm ν)
  | biImpl (φ₁ φ₂ : PropForm ν)
  deriving Repr, DecidableEq, Inhabited

namespace PropForm

-- HACK: a `let` doesn't work with structural recursion
local macro "go " n:ident : term =>
  `(let s := $(Lean.mkIdent `PropForm.toString) $n
    if s.contains ' ' then s!"({s})" else s)
protected def toString [ToString ν] : PropForm ν → String
  | var x        => toString x
  | tr           => "⊤"
  | fls          => "⊥"
  | neg φ        => s!"¬{go φ}"
  | conj φ₁ φ₂   => s!"{go φ₁} ∧ {go φ₂}"
  | disj φ₁ φ₂   => s!"{go φ₁} ∨ {go φ₂}"
  | impl φ₁ φ₂   => s!"{go φ₁} → {go φ₂}"
  | biImpl φ₁ φ₂ => s!"{go φ₁} ↔ {go φ₂}"

instance [ToString ν] : ToString (PropForm ν) :=
  ⟨PropForm.toString⟩

end PropForm

/-- An assignment of truth values to propositional variables. -/
def PropAssignment (ν : Type u) := ν → Bool

namespace PropAssignment

@[ext] theorem ext (v1 v2 : PropAssignment ν) (h : ∀ x, v1 x = v2 x) : v1 = v2 := funext h

def set [DecidableEq ν] (τ : PropAssignment ν) (x : ν) (v : Bool) :
    PropAssignment ν :=
  fun y => if y = x then v else τ y

@[simp]
theorem set_get [DecidableEq ν] (τ : PropAssignment ν) (x : ν) (v : Bool) :
    τ.set x v x = v := by
  simp [set]

theorem set_get_of_ne [DecidableEq ν] {x y : ν} (τ : PropAssignment ν) (v : Bool) :
    x ≠ y → τ.set x v y = τ y := by
  intro h
  simp [set, h.symm]

@[simp]
theorem set_set [DecidableEq ν] (τ : PropAssignment ν) (x : ν) (v v' : Bool) :
    (τ.set x v).set x v' = τ.set x v' := by
  ext x'
  dsimp [set]; split <;> simp_all

@[simp]
theorem set_same [DecidableEq ν] (τ : PropAssignment ν) (x : ν) :
    τ.set x (τ x) = τ := by
  ext x'
  dsimp [set]; split <;> simp_all

end PropAssignment

namespace PropForm

/-- The unique evaluation function on formulas which extends `τ`. -/
@[simp]
def eval (τ : PropAssignment ν) : PropForm ν → Bool
  | var x => τ x
  | tr => true
  | fls => false
  | neg φ => !(eval τ φ)
  | conj φ₁ φ₂ => (eval τ φ₁) && (eval τ φ₂)
  | disj φ₁ φ₂ => (eval τ φ₁) || (eval τ φ₂)
  | impl φ₁ φ₂ => (eval τ φ₁) ⇨ (eval τ φ₂)
  | biImpl φ₁ φ₂ => eval τ φ₁ = eval τ φ₂

/-! Satisfying assignments -/

/-- An assignment satisfies a formula `φ` when `φ` evaluates to `⊤` at that assignment. -/
def satisfies (τ : PropAssignment ν) (φ : PropForm ν) : Prop :=
  φ.eval τ = true

/-- This instance is scoped so that `τ ⊨ φ : Prop` implies `φ : PropForm _` via the `outParam` only
when `PropForm` is open. -/
scoped instance : SemanticEntails (PropAssignment ν) (PropForm ν) where
  entails := PropForm.satisfies

open SemanticEntails renaming entails → sEntails

variable {τ : PropAssignment ν} {x : ν} {φ φ₁ φ₂ φ₃ : PropForm ν}

@[simp]
theorem satisfies_var : τ ⊨ var x ↔ τ x := by
  simp [sEntails, satisfies]

@[simp]
theorem satisfies_tr : τ ⊨ tr := by
  simp [sEntails, satisfies]

@[simp]
theorem not_satisfies_fls : τ ⊭ fls :=
  fun h => nomatch h

@[simp]
theorem satisfies_neg : τ ⊨ neg φ ↔ τ ⊭ φ := by
  simp [sEntails, satisfies]

@[simp]
theorem satisfies_conj : τ ⊨ conj φ₁ φ₂ ↔ τ ⊨ φ₁ ∧ τ ⊨ φ₂ := by
  simp [sEntails, satisfies]

@[simp]
theorem satisfies_disj : τ ⊨ disj φ₁ φ₂ ↔ τ ⊨ φ₁ ∨ τ ⊨ φ₂ := by
  simp [sEntails, satisfies]

@[simp]
theorem satisfies_impl : τ ⊨ impl φ₁ φ₂ ↔ (τ ⊨ φ₁ → τ ⊨ φ₂) := by
  simp only [sEntails, satisfies, eval]
  cases (eval τ φ₁) <;> simp [himp_eq]

theorem satisfies_impl' : τ ⊨ impl φ₁ φ₂ ↔ τ ⊭ φ₁ ∨ τ ⊨ φ₂ := by
  simp only [sEntails, satisfies, eval]
  cases (eval τ φ₁) <;> simp [himp_eq]

@[simp]
theorem satisfies_biImpl : τ ⊨ biImpl φ₁ φ₂ ↔ (τ ⊨ φ₁ ↔ τ ⊨ φ₂) := by
  simp [sEntails, satisfies]

theorem satisfies_biImpl' : τ ⊨ biImpl φ₁ φ₂ ↔ ((τ ⊨ φ₁ ∧ τ ⊨ φ₂) ∨ (τ ⊭ φ₁ ∧ τ ⊭ φ₂)) := by
  simp only [sEntails, satisfies, eval]
  cases (eval τ φ₁) <;> aesop

/-! Semantic entailment and equivalence. -/

/-- A formula `φ₁` semantically entails `φ₂` when `τ ⊨ φ₁` implies `τ ⊨ φ₂`.

This is actually defined in terms of the Boolean lattice and the above statement is a theorem.
Note that the two-valued Boolean model is universal, so this formulation of semantic entailment
is equivalent to entailment in every Boolean algebra, and also (by completeness) to provability. -/
def entails (φ₁ φ₂ : PropForm ν) : Prop :=
  ∀ (τ : PropAssignment ν), φ₁.eval τ ≤ φ₂.eval τ

/-- An equivalent formulation of semantic entailment in terms of satisfying assignments. -/
theorem entails_ext : entails φ₁ φ₂ ↔ (∀ (τ : PropAssignment ν), τ ⊨ φ₁ → τ ⊨ φ₂) := by
  have : ∀ τ, (φ₁.eval τ → φ₂.eval τ) ↔ φ₁.eval τ ≤ φ₂.eval τ := by
    intro τ
    cases (eval τ φ₁)
    . simp
    . simp only [true_implies]
      exact ⟨fun h => h ▸ le_rfl, top_unique⟩
  simp [sEntails, entails, satisfies, this]

theorem entails_refl (φ : PropForm ν) : entails φ φ :=
  fun _ => le_rfl
theorem entails.trans : entails φ₁ φ₂ → entails φ₂ φ₃ → entails φ₁ φ₃ :=
  fun h₁ h₂ τ => le_trans (h₁ τ) (h₂ τ)

theorem entails_tr (φ : PropForm ν) : entails φ tr :=
  fun _ => le_top
theorem fls_entails (φ : PropForm ν) : entails fls φ :=
  fun _ => bot_le

theorem entails_disj_left (φ₁ φ₂ : PropForm ν) : entails φ₁ (disj φ₁ φ₂) :=
  fun _ => le_sup_left
theorem entails_disj_right (φ₁ φ₂ : PropForm ν) : entails φ₂ (disj φ₁ φ₂) :=
  fun _ => le_sup_right
theorem disj_entails : entails φ₁ φ₃ → entails φ₂ φ₃ → entails (disj φ₁ φ₂) φ₃ :=
  fun h₁ h₂ τ => sup_le (h₁ τ) (h₂ τ)

theorem conj_entails_left (φ₁ φ₂ : PropForm ν) : entails (conj φ₁ φ₂) φ₁ :=
  fun _ => inf_le_left
theorem conj_entails_right (φ₁ φ₂ : PropForm ν) : entails (conj φ₁ φ₂) φ₂ :=
  fun _ => inf_le_right
theorem entails_conj : entails φ₁ φ₂ → entails φ₁ φ₃ → entails φ₁ (conj φ₂ φ₃) :=
  fun h₁ h₂ τ => le_inf (h₁ τ) (h₂ τ)

theorem entails_disj_conj (φ₁ φ₂ φ₃ : PropForm ν) :
    entails (conj (disj φ₁ φ₂) (disj φ₁ φ₃)) (disj φ₁ (conj φ₂ φ₃)) :=
  fun _ => le_sup_inf

theorem conj_neg_entails_fls (φ : PropForm ν) : entails (conj φ (neg φ)) fls :=
  fun τ => BooleanAlgebra.inf_compl_le_bot (eval τ φ)

theorem tr_entails_disj_neg (φ : PropForm ν) : entails tr (disj φ (neg φ)) :=
  fun τ => BooleanAlgebra.top_le_sup_compl (eval τ φ)

/-- Two formulas are semantically equivalent when they always evaluate to the same thing. -/
def equivalent (φ₁ φ₂ : PropForm ν) : Prop :=
  ∀ (τ : PropAssignment ν), φ₁.eval τ = φ₂.eval τ

theorem equivalent_iff_entails :
    equivalent φ₁ φ₂ ↔ (entails φ₁ φ₂ ∧ entails φ₂ φ₁) := by
  simp only [equivalent, entails]
  aesop (add safe le_antisymm)

theorem equivalent_ext :
    equivalent φ₁ φ₂ ↔ (∀ (τ : PropAssignment ν), τ ⊨ φ₁ ↔ τ ⊨ φ₂) := by
  simp only [equivalent_iff_entails, entails_ext]
  aesop

theorem equivalent_refl (φ : PropForm ν) : equivalent φ φ :=
  fun _ => rfl
theorem equivalent.symm : equivalent φ₁ φ₂ → equivalent φ₂ φ₁ :=
  fun h τ => (h τ).symm
theorem equivalent.trans : equivalent φ₁ φ₂ → equivalent φ₂ φ₃ → equivalent φ₁ φ₃ :=
  fun h₁ h₂ τ => (h₁ τ).trans (h₂ τ)
theorem entails.antisymm : entails φ₁ φ₂ → entails φ₂ φ₁ → equivalent φ₁ φ₂ :=
  fun h₁ h₂ => equivalent_iff_entails.mpr ⟨h₁, h₂⟩

-- Equivalently, when `impl φ₁ φ₂` always evaluates to `⊤`.

end PropForm


import breen_deligne.universal_map

/-

This file is a big slow mess

/-!

# Universality of universal maps

(Note: this file exists as a consistency check, but is not used in the rest of the project.)

A `universal_map m n` in this repo is a finite formal `ℤ`-linear combination
of `m × n` matrices (so-called `basic_universal_map`s). In this file we show that
to give a term of this type is to give a term of type `functorial_map m n`, which is
defined to be a collection of additive group homomorphisms `ℤ[A^m] →+ ℤ[A^n]`
for each abelian group `A`, functorial in `A`.

The dictionary: given an `m × n` matrix with integer coefficients,
it induces a map `A^m → A^n` in the obvious way and hence a group
homomorphism `ℤ[A^m] →+ ℤ[A^n]`; hence finite formal integer
combinations of these also give group homomorphisms.
It is not hard to check that homomorphisms obtained in this way are
functorial in `A`.

Conversely, we start by identifying `(ℤ^p)^q` with `q × p` matrices in
the obvious way. Now given a functorial collection of homomorphisms `ℤ[A^m] → ℤ[A^n]`,
evaluating at collection at the group `A=ℤ^m` and the element of `(ℤ^m)^m`
corresponding to the `m × m` identity matrix gives an element of `ℤ[(ℤ^m)^n]` which
can be thought of in a natural way as a finite ℤ-linear combination of
`m × n` matrices.

The proofs that these constructions are inverse to one another is relatively
straightforward, and is of course given in full below. To show that the
construction `functorial_map m n → universal_map m n → functorial_map m n`
is the identity, we observe that the value of a `functorial_map m n` at
an element `x : A^m` can be computed by using functoriality applied
to the map `ℤ^m → A` sending the i'th basis vector to `x i`.

-/

noncomputable theory

-- get some notation working:
open_locale big_operators direct_sum

local attribute [instance] type_pow
local notation `ℤ[` A `]` := free_abelian_group A

universes u

namespace breen_deligne

section functorial_map_section

open free_abelian_group

/-- A term `F : functorial_map m n` is a collection of group homomorphisms
  `F.f A : ℤ[A^m] →+ ℤ[A^n]`, functorial in the abelian group `A`. -/
@[ext] structure functorial_map (m n : ℕ) :=
(f (A : Type u) [add_comm_group A] : ℤ[A^m] →+ ℤ[A^n])
(functorial {A : Type u} [add_comm_group A] {B : Type u} [add_comm_group B] (φ : A →+ B) :
  (free_abelian_group.map (φ.pow n)).comp (f A) = (f B).comp (map (φ.pow m)))

variables {m n : ℕ}

namespace functorial_map

open add_monoid_hom

def add (F G : functorial_map m n) : functorial_map m n :=
{ f := λ A _, by exactI F.f A + G.f A,
  functorial := λ A _ B _ φ, by rw [comp_add, add_comp, F.functorial, G.functorial] }

instance : has_add (functorial_map m n) := ⟨add⟩

def zero : functorial_map m n :=
{ f := λ A _, 0,
  functorial := by intros; simp }

instance : has_zero (functorial_map m n) := ⟨zero⟩

def neg (F : functorial_map m n) : functorial_map m n :=
{ f := λ A _, by exactI -F.f A,
  functorial := λ A _ B _ φ, by rw [comp_neg, neg_comp, F.functorial]}

instance : has_neg (functorial_map m n) := ⟨neg⟩

instance : add_comm_group (functorial_map m n) :=
{ add := (+),
  add_assoc := λ _ _ _, ext _ _ $ funext (λ A, funext (λ _, by exactI add_assoc _ _ _)),
  zero := 0,
  zero_add := λ _, ext _ _ $ funext (λ A, funext (λ _, by exactI zero_add _)),
  add_zero := λ _, ext _ _ $ funext (λ A, funext (λ _, by exactI add_zero _)),
  neg := has_neg.neg,
  add_left_neg := λ _, ext _ _ $ funext (λ A, funext (λ _, by exactI add_left_neg _)),
  add_comm := λ F G, ext _ _ $ funext (λ A, funext (λ _, by exactI add_comm _ _)) }

end functorial_map

end functorial_map_section

section punit_stuff

open free_abelian_group

-- this is now on `free-abelian-group-equivs` branch
def punit_equiv : ℤ[punit] ≃+ ℤ :=
{ inv_fun := λ n, n • of (punit.star),
  to_fun := free_abelian_group.lift (λ _, (1 : ℤ)),
  left_inv := λ z, free_abelian_group.induction_on z
    (by {dsimp only, rw [add_monoid_hom.map_zero, zero_smul]})
    (λ x, punit.cases_on x (by simp))
    (λ x, punit.cases_on x (by simp))
    (λ x y hx hy, by { simp only [add_monoid_hom.map_add, add_smul] at *, rw [hx, hy]}),
  right_inv := λ n, by { rw [add_monoid_hom.map_zsmul, lift.of], exact zsmul_int_one n},
  map_add' := add_monoid_hom.map_add _ }

-- this is now on `free-abelian-group-equivs` branch
def equiv_of_equiv {α β : Type*} (f : α ≃ β) : free_abelian_group α ≃+ free_abelian_group β :=
{ to_fun := free_abelian_group.lift $ free_abelian_group.of ∘ f,
  inv_fun := free_abelian_group.lift $ free_abelian_group.of ∘ f.symm,
  left_inv := begin
    intros x,
    refine free_abelian_group.induction_on x
    (by simp only [add_monoid_hom.map_zero])
    (by simp only [equiv.symm_apply_apply, eq_self_iff_true, function.comp_app, lift.of, forall_true_iff])
    (by simp only [equiv.symm_apply_apply, eq_self_iff_true, function.comp_app,
      add_monoid_hom.map_neg, lift.of, forall_true_iff]) _,
    intros x y h,
    simp only [h, imp_self, add_right_inj, add_monoid_hom.map_add],
  end,
  right_inv := begin
    intros x,
    refine free_abelian_group.induction_on x
    (by simp only [add_monoid_hom.map_zero])
    (by simp only [eq_self_iff_true, function.comp_app, equiv.apply_symm_apply, lift.of, forall_true_iff])
    (by simp only [eq_self_iff_true, function.comp_app, equiv.apply_symm_apply,
      add_monoid_hom.map_neg, lift.of, forall_true_iff]) _,
    intros x y h,
    simp only [h, imp_self, add_right_inj, add_monoid_hom.map_add],
  end,
  map_add' := begin
     intros x y,
     simp only [add_monoid_hom.map_add],
  end }

end punit_stuff

lemma lift_smul_eq_lift {A : Type*} [add_comm_group A] (a : A) (c : ℤ[punit]) :
  (free_abelian_group.lift (λ _, (1 : ℤ))) c • a = free_abelian_group.lift (λ _, a) c :=
begin
  rw ← punit_equiv.left_inv c,
  generalize : punit_equiv.to_fun c = d,
  delta punit_equiv, dsimp only,
  apply int.induction_on d,
  { simp },
  { intros i hi,
    simp only [add_smul, ←hi, free_abelian_group.lift.of,
      add_monoid_hom.map_add, add_left_inj, one_zsmul], },
  { intros i hi,
    simp only [add_monoid_hom.map_neg, neg_inj, int.cast_neg, neg_smul, int.cast_sub] at *,
    simp only [sub_smul, ←hi, free_abelian_group.lift.of, one_zsmul,
      add_monoid_hom.map_neg, add_monoid_hom.map_sub, neg_inj, neg_smul, sub_left_inj] }
end

namespace universal_map
open add_monoid_hom

@[simps]
def to_functorial_map {m n : ℕ} (U : universal_map m n) :
  functorial_map.{u} m n :=
{ f := λ A _, by exactI eval A U,
  functorial :=
  λ A _ B _ φ, begin
    -- The proof that evaluation of universal maps is functorial for group homomorphisms.
    -- We start by unravelling what the question is.
    resetI,
    ext as,
    rw [comp_apply, comp_apply],
    -- free_abelian_group.map_of should be redefined now map is an add_group_hom not a map?
    -- Bhavik says make a dsimp lemma, I say make `map_of_apply` or `map_apply`
    change _ = ((eval B) U) ((φ.pow m) <$> (free_abelian_group.of as)),
    rw free_abelian_group.map_of,
    --  We need to prove that for all `as : A^m`, evaluating `U` then mapping with `φ`
    -- is the same as applying `φ` and then evaluating `U` on the corresponding element of
    -- `ℤ[B^m]`.
    -- By linearity, we can assume that `U` is a basic universal map `f`.
    apply free_abelian_group.induction_on U,
    { simp only [map_zero, zero_apply]},
    { intro f,
      -- Here is the proof for basic universal maps.
      simp only [basic_universal_map.eval_of, eval_of],
      -- We use the universal property
      convert free_abelian_group.map_of _ _,
      -- which boils the question down to checking that φ : A^n → B^n and φ : A^m → B^m
      -- commutes with the matrix action A^m → A^n
      ext i,
      -- and this just boils down to trivialities
      simp only [basic_universal_map.pre_eval_apply, pow_eval, add_monoid_hom.map_sum,
        map_zsmul], },
      -- the rest is just checking that the question about universal maps was linear
      -- so the reduction to the basic case was OK.
    { intros F hF,
      simp only [add_monoid_hom.map_neg, neg_inj, neg_apply, hF] },
    { intros F G hF hG, simp only [hF, hG, add_monoid_hom.map_add, add_apply]}
  end }

def from_functorial_map {m n : ℕ} (F : functorial_map.{u} m n) :
  universal_map m n :=
free_abelian_group.lift
  (λ x, free_abelian_group.of
    (λ i j, (punit_equiv ((x : (ℤ[punit] ^ m) ^ n) i j)) : basic_universal_map m n))
  (F.f
  -- We evaluate on ℤ^m (in universe `u`)
    (free_abelian_group (punit)^m)
  -- and on the identity matrix.
    (free_abelian_group.of (λ i j, if i = j then free_abelian_group.of punit.star else 0)))

lemma to_functorial_map_from_functorial_map
  {m n : ℕ} (F : functorial_map.{u} m n) :
  to_functorial_map (from_functorial_map F) = F :=
begin
  -- We check the two functorial maps agree on the abelian group `A` and on input `x : A^m`
  ext A inst x, resetI,
  -- Let φ be the map from ℤ^m to A sending the i'th basis vector to `x i`.
  let φ : ℤ[punit.{u+1}]^m →+ A := pow_hom (λ i, free_abelian_group.lift (λ _, x i)),
  -- Use the fact that the original functorial map is functorial for `φ`, and
  -- evaluate the corresponding commutative diagram at the identity matrix in `(ℤ^m)^m`.
  have h := F.functorial φ,
  set id_mat : (ℤ[punit]^m)^m :=
    λ i j, if i = j then free_abelian_group.of punit.star else 0,
  replace h := congr_fun h (free_abelian_group.of id_mat),
  -- The corresponding equation is almost what we have to prove.
  simp only [free_abelian_group.map_of_apply, function.comp_app, coe_comp] at h,
  convert h using 3,
  { clear h,
    -- Of the two things left to do, the first follows from the following assertion
    -- (letting t be the image of the identity map under φ)
    dsimp only [from_functorial_map, to_functorial_map],
    generalize : (F.f (ℤ[punit] ^ m)) (free_abelian_group.of id_mat) = t,
    -- show eval A (free_abelian_group.lift
    --   (λ (y : fin n → fin m → ℤ[punit]),
    --     free_abelian_group.of (λ (i : fin n) (j : fin m), punit_equiv (y i j))) _)
    --       (free_abelian_group.of x) = _,
    -- and by linearity this assertion only needs to be verified for `t` an `m × n`
    -- matrix (rather than a ℤ-linear combination of them)
    apply free_abelian_group.induction_on t,
    { simp only [map_zero, zero_apply]},
    { clear t, intro t,
      -- for which it follows by unravelling the definitions.
      rw free_abelian_group.lift.of,
      rw eval_of,
      convert (free_abelian_group.map_of _ _).symm,
      rw free_abelian_group.map_of,
      convert free_abelian_group.map_of _ _,
      ext i,
      simp only [φ, pow_hom, add_monoid_hom.pow, basic_universal_map.pre_eval_apply],
      apply finset.sum_congr rfl,
      rintro j -,
      apply lift_smul_eq_lift },
    { simp only [imp_self, forall_const, neg_inj, map_neg, neg_apply]},
    { intros x y hx hy, simp * at * } },
  { -- The second and final thing we need to check is that evaluating `φ` on
    -- the identity matrix gives us `x`, and this follows essentially immediately
    -- from the definitions.
    ext i,
    simp only [id_mat, add_monoid_hom.pow, φ, pow_hom, coe_mk, function.comp_app],
    convert (finset.sum_ite_eq (finset.univ : finset (fin m)) i x).symm using 2,
    { rw if_pos (finset.mem_univ _) },
    ext j,
    split_ifs; simp only [free_abelian_group.lift.of, map_zero] },
end

-- set_option pp.universes true

lemma from_functorial_map_to_functorial_map
  {m n : ℕ} (U : universal_map m n) :
  from_functorial_map (to_functorial_map U) = U :=
begin
  dsimp only [from_functorial_map, to_functorial_map],
  -- By linearity it suffices to check for basic universal maps.
  apply free_abelian_group.induction_on U,
  { simp only [map_zero, zero_apply] },
  { intro b,
    -- so let b be a basic universal map. Now unravel everything
    simp only [free_abelian_group.lift.of, basic_universal_map.eval_of, eval_of,
      basic_universal_map.pre_eval_apply],
    congr',
    ext i j',
    -- and it boils down to checking that a sum over j of `b i j` times `delta j j'` is b i j'.
    convert punit_equiv.right_inv (b i j'),
    simp only [add_equiv.neg_fun_eq_symm, add_equiv.to_fun_eq_coe, add_equiv.apply_symm_apply, zsmul_eq_mul],
    apply _root_.congr_arg,
    change _ = (b i j') • _,
    rw @fintype.sum_apply (fin m) _ (fin m) _ _ j'
      (λ j, b i j • (λ (j_1 : fin m), ite (j = j_1) (free_abelian_group.of punit.star) 0)),
    dsimp,
    simp only [finset.mem_univ, if_true, finset.sum_ite_eq', zsmul_eq_mul, mul_ite, mul_zero], },
  { simp },
  { intros u v hu hv,
    simp * at * }
end

/-- universal maps are equivalent to functorial maps. -/
@[simps]
def universal_map_equiv_functorial_map (m n : ℕ) : universal_map m n ≃+ functorial_map.{u} m n :=
{ -- The construction of a functorial map from a universal map.
  to_fun := λ U, to_functorial_map U,
  -- The construction of a universal map from a functorial map
  inv_fun := λ F, from_functorial_map F,
  -- We check that given a universal map, constructing a functorial map and then
  -- another universal map gives us the universal map we started with.
  left_inv := from_functorial_map_to_functorial_map,
  -- Finally we check that starting with a functorial map and then constructing the
  -- universal map and then the functorial map gets us back to where we started.
  right_inv := to_functorial_map_from_functorial_map,
  -- Note finally that this functorial constuction is an isomorphism of
  -- abelian groups, as can be easily checked.
  map_add' := begin
    intros u v,
    ext,
    resetI,
    simp,
    refl,
  end }

@[ext] lemma to_functorial_map_inj {m n : ℕ} (f g : universal_map m n)
  (h : to_functorial_map.{0} f = to_functorial_map.{0} g) :
  f = g :=
(universal_map_equiv_functorial_map m n).injective h

end universal_map

end breen_deligne

-/


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

! This file was ported from Lean 3 source module category_theory.functor.functorial
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Functor.Basic

/-!
# Unbundled functors, as a typeclass decorating the object-level function.

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

namespace CategoryTheory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universe v v₁ v₂ v₃ u u₁ u₂ u₃

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

#print CategoryTheory.Functorial /-
-- Perhaps in the future we could redefine `functor` in terms of this, but that isn't the
-- immediate plan.
/-- A unbundled functor. -/
class Functorial (F : C → D) : Type max v₁ v₂ u₁ u₂ where
  map : ∀ {X Y : C}, (X ⟶ Y) → (F X ⟶ F Y)
  map_id' : ∀ X : C, map (𝟙 X) = 𝟙 (F X) := by obviously
  map_comp' : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g := by obviously
#align category_theory.functorial CategoryTheory.Functorial
-/

#print CategoryTheory.map /-
/-- If `F : C → D` (just a function) has `[functorial F]`,
we can write `map F f : F X ⟶ F Y` for the action of `F` on a morphism `f : X ⟶ Y`.
-/
def map (F : C → D) [Functorial.{v₁, v₂} F] {X Y : C} (f : X ⟶ Y) : F X ⟶ F Y :=
  Functorial.map'.{v₁, v₂} f
#align category_theory.map CategoryTheory.map
-/

#print CategoryTheory.map'_as_map /-
@[simp]
theorem map'_as_map {F : C → D} [Functorial.{v₁, v₂} F] {X Y : C} {f : X ⟶ Y} :
    Functorial.map'.{v₁, v₂} f = map F f :=
  rfl
#align category_theory.map_as_map CategoryTheory.map'_as_map
-/

#print CategoryTheory.Functorial.map_id /-
@[simp]
theorem Functorial.map_id {F : C → D} [Functorial.{v₁, v₂} F] {X : C} : map F (𝟙 X) = 𝟙 (F X) :=
  Functorial.map'_id' X
#align category_theory.functorial.map_id CategoryTheory.Functorial.map_id
-/

#print CategoryTheory.Functorial.map_comp /-
@[simp]
theorem Functorial.map_comp {F : C → D} [Functorial.{v₁, v₂} F] {X Y Z : C} {f : X ⟶ Y}
    {g : Y ⟶ Z} : map F (f ≫ g) = map F f ≫ map F g :=
  Functorial.map'_comp' f g
#align category_theory.functorial.map_comp CategoryTheory.Functorial.map_comp
-/

namespace Functor

#print CategoryTheory.Functor.of /-
/-- Bundle a functorial function as a functor.
-/
def of (F : C → D) [I : Functorial.{v₁, v₂} F] : C ⥤ D :=
  { I with obj := F }
#align category_theory.functor.of CategoryTheory.Functor.of
-/

end Functor

instance (F : C ⥤ D) : Functorial.{v₁, v₂} F.obj :=
  { F with }

/- warning: category_theory.map_functorial_obj -> CategoryTheory.map_functorial_obj is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y), Eq.{succ u2} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y)) (CategoryTheory.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) (CategoryTheory.Functor.obj.functorial.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y f) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y f)
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y), Eq.{succ u2} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y)) (CategoryTheory.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F)) (CategoryTheory.instFunctorialObjToQuiverToCategoryStructToQuiverToCategoryStructToPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y f) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y f)
Case conversion may be inaccurate. Consider using '#align category_theory.map_functorial_obj CategoryTheory.map_functorial_objₓ'. -/
@[simp]
theorem map_functorial_obj (F : C ⥤ D) {X Y : C} (f : X ⟶ Y) : map F.obj f = F.map f :=
  rfl
#align category_theory.map_functorial_obj CategoryTheory.map_functorial_obj

#print CategoryTheory.functorial_id /-
instance functorial_id : Functorial.{v₁, v₁} (id : C → C) where map X Y f := f
#align category_theory.functorial_id CategoryTheory.functorial_id
-/

section

variable {E : Type u₃} [Category.{v₃} E]

#print CategoryTheory.functorial_comp /-
-- This is no longer viable as an instance in Lean 3.7,
-- #lint reports an instance loop
-- Will this be a problem?
/-- `G ∘ F` is a functorial if both `F` and `G` are.
-/
def functorial_comp (F : C → D) [Functorial.{v₁, v₂} F] (G : D → E) [Functorial.{v₂, v₃} G] :
    Functorial.{v₁, v₃} (G ∘ F) :=
  { Functor.of F ⋙ Functor.of G with }
#align category_theory.functorial_comp CategoryTheory.functorial_comp
-/

end

end CategoryTheory


import data.fin.basic
import data.nat.basic
import data.nat.dist
import data.real.basic
import data.vector.basic
import data.multiset.basic
import algebra.group.basic
import algebra.big_operators.multiset
import data.complex.basic
import order.basic
import .dists

/-- Bounded sum, known N. --/

variables {n m : ℕ} {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α → β)

@[reducible] def vector.fin_sum (v : vector (fin (n + 1)) m) : ℕ
  := multiset.sum ((v.to_list : multiset (fin (n + 1))).map nat_of_fin)

@[reducible] def vector.fin_bounded_sum (v : vector (fin (n + 1)) m) : fin ((n * m) + 1)
  := fin.of_nat' (vector.fin_sum v)

@[simp] lemma vector.cons_to_list (a : α) (v : vector α n) :
  (a ::ᵥ v).to_list = a :: v.to_list := by simp

lemma vector.cons_succ (v : vector α n.succ) :
  v = v.head ::ᵥ v.tail := by simp

lemma vector.cons_succ_to_list (v : vector α n.succ) :
  v.to_list = v.head :: v.tail.to_list := begin
    have h₁ : v.to_list = (v.head ::ᵥ v.tail).to_list := begin
      have : v = v.head ::ᵥ v.tail := vector.cons_succ _,
      simp
    end,
    rw h₁, simp only [vector.cons_to_list], simp
end

/- TODO: rewrite to follow from list.fin_sum_le and multiset.fin_sum_le. -/
@[simp] theorem vector.fin_sum_le (v : vector (fin (n + 1)) m) :
  vector.fin_sum v ≤ n * m :=
begin
  simp only [vector.fin_sum, multiset.sum],
  induction m with _ hd,
  have h₁ : v = vector.nil := by simp,
  rw h₁, simp,
  have h₂ : v.to_list = v.head :: v.tail.to_list
    := vector.cons_succ_to_list _,
  have h₃ : nat_of_fin v.head ≤ n := fin.is_le _,
  specialize hd v.tail, simp at *,
  have h₄ : n * m_n + n = n + n * m_n := nat.add_comm _ _,
  rw [nat.mul_succ, h₂, h₄], exact add_le_add h₃ hd
end

theorem list.fin_sum_le (l : list (fin (n + 1))) :
  (l.map nat_of_fin).sum ≤ n * l.length :=
begin
  induction l with d ih,
  simp,
  have h₁ : (list.map nat_of_fin (d :: ih)).sum
  = nat_of_fin d + (list.map nat_of_fin ih).sum := by simp,
  rw h₁,
  have h₃ : nat_of_fin d ≤ n := fin.is_le _,
  have h₄ : n * (d :: ih).length = n + ih.length * n
    := by { simp, rw [left_distrib, mul_one, add_comm, mul_comm] },
  rw [h₄, mul_comm], exact add_le_add h₃ l_ih
end

theorem multiset.fin_sum_le (m : multiset (fin (n + 1))) :
  (m.map nat_of_fin).sum ≤ n * m.card
:= by { induction m, simp [-nat_of_fin], exact list.fin_sum_le _, simp }

lemma nat.lt_succ_le (h : m ≤ n) : m < n.succ := nat.lt_succ_iff.mpr h

@[simp] lemma vector.fin_sum_le_mod (v : vector (fin (n + 1)) m) :
  (vector.fin_sum v) % ((n * m) + 1) = vector.fin_sum v :=
begin
  have   : vector.fin_sum v ≤ n * m       := vector.fin_sum_le _,
  have h : vector.fin_sum v < (n * m) + 1 := nat.lt_succ_le _,
  exact nat.mod_eq_of_lt h, simp
end

lemma multiset.nat_sum_map_sub_add_inter (s t : multiset α) (f : α → ℕ):
  (multiset.map f s).sum = (multiset.map f (s - t)).sum + (multiset.map f (s ∩ t)).sum :=
begin
  have h₁ : (multiset.map f s) = (multiset.map f ((s - t) + (s ∩ t)))
    := by { rw multiset.sub_add_inter },
  rw h₁,
  simp
end

lemma list.diff_length_multiset_sub_card (l₁ l₂ : list α) :
(l₁.diff l₂).length = ((l₁ : multiset α) - (l₂ : multiset α)).card := by simp

lemma nat.dist.triangle_inequality_zero (m n : ℕ) : m.dist n ≤ m + n := begin
  have h₁ : m.dist n ≤ m.dist 0 + nat.zero.dist n
    := nat.dist.triangle_inequality m 0 n,
  have h₂ : m.dist 0 = m := nat.dist_zero_right _,
  have h₃ : nat.zero.dist n = n := nat.dist_zero_left _,
  rw [h₂, h₃] at h₁, exact h₁
end

@[simp] def vector.fin_bounded_sum_dist (v₁ v₂ : vector (fin (n + 1)) m) : ℕ
  := nat.dist (vector.fin_bounded_sum v₁) (vector.fin_bounded_sum v₂)

theorem vector.bounded_sized_sum_stability (v₁ v₂ : vector (fin (n + 1)) m) :
vector.fin_bounded_sum_dist v₁ v₂ ≤ n * (v₁ |ΔV| v₂) := begin
  simp,
  simp only [vector.fin_sum],
  let l₁ := v₁.to_list,
  let l₂ := v₂.to_list,
  let m₁ := (l₁ : multiset (fin (n + 1))),
  let m₂ := (l₂ : multiset (fin (n + 1))),
  let fmap := multiset.map nat_of_fin,
  let mml := fmap (m₁ - m₂),
  let mmr := fmap (m₂ - m₁),
  have h₁ : (fmap m₁).sum = mml.sum + (fmap (m₁ ∩ m₂)).sum
    := multiset.nat_sum_map_sub_add_inter _ _ _,
  have h₂ : (fmap m₂).sum = mmr.sum + (fmap (m₂ ∩ m₁)).sum
    := multiset.nat_sum_map_sub_add_inter _ _ _,
  have h₃ : (l₁.diff l₂).length = (m₁ - m₂).card := list.diff_length_multiset_sub_card _ _,
  have h₄ : (l₂.diff l₁).length = (m₂ - m₁).card := list.diff_length_multiset_sub_card _ _,
  rw [left_distrib, h₁, h₂, h₃, h₄],
  simp only [nat.dist_add_add_right, multiset.inter_comm],
  have h₅ : mml.sum ≤ n * (m₁ - m₂).card := multiset.fin_sum_le _,
  have h₆ : mmr.sum ≤ n * (m₂ - m₁).card := multiset.fin_sum_le _,
  have h_tri : mml.sum.dist mmr.sum ≤ mml.sum + mmr.sum
    := nat.dist.triangle_inequality_zero _ _,
  have h_sym : mml.sum + mmr.sum ≤ n * (m₁ - m₂).card + n * (m₂ - m₁).card
    := add_le_add _ _,
  exact le_trans h_tri h_sym, exact h₅, exact h₆
end

theorem vector.bounded_sized_sum_neighbor_stability (v₁ v₂ : vector (fin (n + 1)) m) (hn : v₁ ~ v₂) :
  vector.fin_bounded_sum_dist v₁ v₂ ≤ n :=
begin
  simp [-vector.sym_dist] at hn,
  have h₁ : vector.fin_bounded_sum_dist v₁ v₂ ≤ n * (v₁ |ΔV| v₂)
    := vector.bounded_sized_sum_stability _ _,
  have h₂ : n * (v₁ |ΔV| v₂) ≤ n * 1 := nat.mul_le_mul_of_nonneg_left hn,
  rw mul_one at h₂,
  exact le_trans h₁ h₂
end


/-
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_24
  (x : ℝ)
  (h₀ : x / 50 = 40) :
  x = 2000 :=
begin
  nlinarith,
end


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Mathlib.CategoryTheory.Iso
import Mathlib.CategoryTheory.Functor.Category

/-!
The file contains definitions and theorems based on those from `Mathbin/CategoryTheory/Whiskering.lean` file in the repository of [mathlib3port](https://github.com/leanprover-community/mathlib3port) project.
The original copyright notice following:

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

/-!
# Whiskering
Given a functor `F  : C ⥤ D` and functors `G H : D ⥤ E` and a natural transformation `α : G ⟶ H`,
we can construct a new natural transformation `F ⋙ G ⟶ F ⋙ H`,
called `whisker_left F α`. This is the same as the horizontal composition of `𝟙 F` with `α`.
This operation is functorial in `F`, and we package this as `whiskering_left`. Here
`(whiskering_left.obj F).obj G` is `F ⋙ G`, and
`(whiskering_left.obj F).map α` is `whisker_left F α`.
(That is, we might have alternatively named this as the "left composition functor".)
We also provide analogues for composition on the right, and for these operations on isomorphisms.
At the end of the file, we provide the left and right unitors, and the associator,
for functor composition.
(In fact functor composition is definitionally associative, but very often relying on this causes
extremely slow elaboration, so it is better to insert it explicitly.)
We also show these natural isomorphisms satisfy the triangle and pentagon identities.
-/

namespace CategoryTheory

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

section

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D] {E : Type u₃}
  [Category.{v₃} E]

/-- If `α : G ⟶ H` then
`whisker_left F α : (F ⋙ G) ⟶ (F ⋙ H)` has components `α.app (F.obj X)`.
-/
@[simps]
def whiskerLeft (F : C ⥤ D) {G H : D ⥤ E} (α : G ⟶ H) :
    F ⋙ G ⟶ F ⋙ H where
  app X := α.app (F.obj X)
  naturality X Y f := by
    rw [Functor.comp_map, Functor.comp_map, α.naturality]
#align category_theory.whisker_left CategoryTheory.whiskerLeft

/-- If `α : G ⟶ H` then
`whisker_right α F : (G ⋙ F) ⟶ (G ⋙ F)` has components `F.map (α.app X)`.
-/
@[simps]
def whiskerRight {G H : C ⥤ D} (α : G ⟶ H) (F : D ⥤ E) :
    G ⋙ F ⟶ H ⋙ F where
  app X := F.map (α.app X)
  naturality X Y f := by
    rw [Functor.comp_map, Functor.comp_map, ← F.map_comp, ← F.map_comp, α.naturality]
#align category_theory.whisker_right CategoryTheory.whiskerRight

variable (C D E)

/-- Left-composition gives a functor `(C ⥤ D) ⥤ ((D ⥤ E) ⥤ (C ⥤ E))`.
`(whiskering_left.obj F).obj G` is `F ⋙ G`, and
`(whiskering_left.obj F).map α` is `whisker_left F α`.
-/
@[simps]
def whiskeringLeft :
    (C ⥤ D) ⥤
      (D ⥤ E) ⥤
        C ⥤
          E where
  obj F := { obj := λ G => F ⋙ G, map := λ α => whiskerLeft F α }
  map τ :=
    { app := fun H =>
        { app := fun c => H.map (τ.app c),
          naturality := fun X Y f => by dsimp; rw [← H.map_comp, ← H.map_comp, ← τ.naturality] },
      naturality := fun X Y f => by ext; dsimp; rw [f.naturality] }
#align category_theory.whiskering_left CategoryTheory.whiskeringLeft

/-- Right-composition gives a functor `(D ⥤ E) ⥤ ((C ⥤ D) ⥤ (C ⥤ E))`.
`(whiskering_right.obj H).obj F` is `F ⋙ H`, and
`(whiskering_right.obj H).map α` is `whisker_right α H`.
-/
@[simps]
def whiskeringRight :
    (D ⥤ E) ⥤
      (C ⥤ D) ⥤
        C ⥤
          E where
  obj H := { obj := fun F => F ⋙ H, map := fun α => whiskerRight α H }
  map τ :=
    { app := fun F =>
        { app := fun c => τ.app (F.obj c),
          naturality := fun X Y f => by dsimp; rw [τ.naturality] },
      naturality := fun X Y f => by ext; dsimp; rw [← NatTrans.naturality] }
#align category_theory.whiskering_right CategoryTheory.whiskeringRight

variable {C} {D} {E}

/-
-- This instance not yet available as `Mathlib.CategoryTheory.Functor.Fullyfaithful` is in WIP.

instance faithful_whiskering_right_obj {F : D ⥤ E} [Faithful F] :
    Faithful
      ((whiskeringRight C D E).obj
        F) where map_injective' G H α β hαβ :=
    NatTrans.ext _ _ <|
      funext fun X => Functor.map_injective _ <| congr_fun (congr_arg NatTrans.app hαβ) X
#align category_theory.faithful_whiskering_right_obj CategoryTheory.faithful_whiskering_right_obj

-/

@[simp]
theorem whisker_left_id (F : C ⥤ D) {G : D ⥤ E} :
    whiskerLeft F (NatTrans.id G) = NatTrans.id (F.comp G) :=
  rfl
#align category_theory.whisker_left_id CategoryTheory.whisker_left_id

@[simp]
theorem whisker_left_id' (F : C ⥤ D) {G : D ⥤ E} : whiskerLeft F (𝟙 G) = 𝟙 (F.comp G) :=
  rfl
#align category_theory.whisker_left_id' CategoryTheory.whisker_left_id'

@[simp]
theorem whisker_right_id {G : C ⥤ D} (F : D ⥤ E) :
    whiskerRight (NatTrans.id G) F = NatTrans.id (G.comp F) :=
  ((whiskeringRight C D E).obj F).map_id _
#align category_theory.whisker_right_id CategoryTheory.whisker_right_id

@[simp]
theorem whisker_right_id' {G : C ⥤ D} (F : D ⥤ E) : whiskerRight (𝟙 G) F = 𝟙 (G.comp F) :=
  ((whiskeringRight C D E).obj F).map_id _
#align category_theory.whisker_right_id' CategoryTheory.whisker_right_id'

@[simp]
theorem whisker_left_comp (F : C ⥤ D) {G H K : D ⥤ E} (α : G ⟶ H) (β : H ⟶ K) :
    whiskerLeft F (α ≫ β) = whiskerLeft F α ≫ whiskerLeft F β :=
  rfl
#align category_theory.whisker_left_comp CategoryTheory.whisker_left_comp

@[simp]
theorem whisker_right_comp {G H K : C ⥤ D} (α : G ⟶ H) (β : H ⟶ K) (F : D ⥤ E) :
    whiskerRight (α ≫ β) F = whiskerRight α F ≫ whiskerRight β F :=
  ((whiskeringRight C D E).obj F).map_comp α β
#align category_theory.whisker_right_comp CategoryTheory.whisker_right_comp

/-- If `α : G ≅ H` is a natural isomorphism then
`iso_whisker_left F α : (F ⋙ G) ≅ (F ⋙ H)` has components `α.app (F.obj X)`.
-/
def isoWhiskerLeft (F : C ⥤ D) {G H : D ⥤ E} (α : G ≅ H) : F ⋙ G ≅ F ⋙ H :=
  ((whiskeringLeft C D E).obj F).mapIso α
#align category_theory.iso_whisker_left CategoryTheory.isoWhiskerLeft

@[simp]
theorem iso_whisker_left_hom (F : C ⥤ D) {G H : D ⥤ E} (α : G ≅ H) :
    (isoWhiskerLeft F α).hom = whiskerLeft F α.hom :=
  rfl
#align category_theory.iso_whisker_left_hom CategoryTheory.iso_whisker_left_hom

@[simp]
theorem iso_whisker_left_inv (F : C ⥤ D) {G H : D ⥤ E} (α : G ≅ H) :
    (isoWhiskerLeft F α).inv = whiskerLeft F α.inv :=
  rfl
#align category_theory.iso_whisker_left_inv CategoryTheory.iso_whisker_left_inv

/-- If `α : G ≅ H` then
`iso_whisker_right α F : (G ⋙ F) ≅ (H ⋙ F)` has components `F.map_iso (α.app X)`.
-/
def isoWhiskerRight {G H : C ⥤ D} (α : G ≅ H) (F : D ⥤ E) : G ⋙ F ≅ H ⋙ F :=
  ((whiskeringRight C D E).obj F).mapIso α
#align category_theory.iso_whisker_right CategoryTheory.isoWhiskerRight

@[simp]
theorem iso_whisker_right_hom {G H : C ⥤ D} (α : G ≅ H) (F : D ⥤ E) :
    (isoWhiskerRight α F).hom = whiskerRight α.hom F :=
  rfl
#align category_theory.iso_whisker_right_hom CategoryTheory.iso_whisker_right_hom

@[simp]
theorem iso_whisker_right_inv {G H : C ⥤ D} (α : G ≅ H) (F : D ⥤ E) :
    (isoWhiskerRight α F).inv = whiskerRight α.inv F :=
  rfl
#align category_theory.iso_whisker_right_inv CategoryTheory.iso_whisker_right_inv

instance is_iso_whisker_left (F : C ⥤ D) {G H : D ⥤ E} (α : G ⟶ H) [IsIso α] :
    IsIso (whiskerLeft F α) :=
  IsIso.of_iso (isoWhiskerLeft F (asIso α))
#align category_theory.is_iso_whisker_left CategoryTheory.is_iso_whisker_left

instance is_iso_whisker_right {G H : C ⥤ D} (α : G ⟶ H) (F : D ⥤ E) [IsIso α] :
    IsIso (whiskerRight α F) :=
  IsIso.of_iso (isoWhiskerRight (asIso α) F)
#align category_theory.is_iso_whisker_right CategoryTheory.is_iso_whisker_right

variable {B : Type u₄} [Category.{v₄} B]

-- attribute [local elab_without_expected_type] whiskerLeft whiskerRight

@[simp]
theorem whisker_left_twice (F : B ⥤ C) (G : C ⥤ D) {H K : D ⥤ E} (α : H ⟶ K) :
    whiskerLeft F (whiskerLeft G α) = whiskerLeft (F ⋙ G) α :=
  rfl
#align category_theory.whisker_left_twice CategoryTheory.whisker_left_twice

@[simp]
theorem whisker_right_twice {H K : B ⥤ C} (F : C ⥤ D) (G : D ⥤ E) (α : H ⟶ K) :
    whiskerRight (whiskerRight α F) G = whiskerRight α (F ⋙ G) :=
  rfl
#align category_theory.whisker_right_twice CategoryTheory.whisker_right_twice

theorem whisker_right_left (F : B ⥤ C) {G H : C ⥤ D} (α : G ⟶ H) (K : D ⥤ E) :
    whiskerRight (whiskerLeft F α) K = whiskerLeft F (whiskerRight α K) :=
  rfl
#align category_theory.whisker_right_left CategoryTheory.whisker_right_left

end

namespace Functor

universe u₅ v₅

variable {A : Type u₁} [Category.{v₁} A]

variable {B : Type u₂} [Category.{v₂} B]

/-- The left unitor, a natural isomorphism `((𝟭 _) ⋙ F) ≅ F`.
-/
@[simps]
def leftUnitor (F : A ⥤ B) :
    𝟭 A ⋙ F ≅ F where
  hom := { app := fun X => 𝟙 (F.obj X) }
  inv := { app := fun X => 𝟙 (F.obj X) }
#align category_theory.functor.left_unitor CategoryTheory.Functor.leftUnitor

/-- The right unitor, a natural isomorphism `(F ⋙ (𝟭 B)) ≅ F`.
-/
@[simps]
def rightUnitor (F : A ⥤ B) :
    F ⋙ 𝟭 B ≅ F where
  hom := { app := fun X => 𝟙 (F.obj X) }
  inv := { app := fun X => 𝟙 (F.obj X) }
#align category_theory.functor.right_unitor CategoryTheory.Functor.rightUnitor

variable {C : Type u₃} [Category.{v₃} C]

variable {D : Type u₄} [Category.{v₄} D]

/-- The associator for functors, a natural isomorphism `((F ⋙ G) ⋙ H) ≅ (F ⋙ (G ⋙ H))`.
(In fact, `iso.refl _` will work here, but it tends to make Lean slow later,
and it's usually best to insert explicit associators.)
-/
@[simps]
def associator (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) :
    (F ⋙ G) ⋙ H ≅ F ⋙ G ⋙ H where
  hom := { app := fun _ => 𝟙 _ }
  inv := { app := fun _ => 𝟙 _ }
#align category_theory.functor.associator CategoryTheory.Functor.associator

protected
theorem assoc (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) : (F ⋙ G) ⋙ H = F ⋙ G ⋙ H :=
  rfl
#align category_theory.functor.assoc CategoryTheory.Functor.assoc

theorem triangle (F : A ⥤ B) (G : B ⥤ C) :
    (associator F (𝟭 B) G).hom ≫ whiskerLeft F (leftUnitor G).hom =
      whiskerRight (rightUnitor F).hom G :=
  by
  ext
  dsimp
  simp
#align category_theory.functor.triangle CategoryTheory.Functor.triangle

-- See note [dsimp, simp].
variable {E : Type u₅} [Category.{v₅} E]

variable (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) (K : D ⥤ E)

theorem pentagon :
    whiskerRight (associator F G H).hom K ≫
        (associator F (G ⋙ H) K).hom ≫ whiskerLeft F (associator G H K).hom =
      (associator (F ⋙ G) H K).hom ≫ (associator F G (H ⋙ K)).hom :=
  by
  ext
  dsimp
  simp
#align category_theory.functor.pentagon CategoryTheory.Functor.pentagon

end Functor

end CategoryTheory