/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.linear_ordered_comm_group_with_zero
import Mathlib.algebra.big_operators.ring
import Mathlib.data.real.basic
import Mathlib.data.indicator_function
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Nonnegative real numbers

In this file we define `nnreal` (notation: `ℝ≥0`) to be the type of non-negative real numbers,
a.k.a. the interval `[0, ∞)`. We also define the following operations and structures on `ℝ≥0`:

* the order on `ℝ≥0` is the restriction of the order on `ℝ`; these relations define a conditionally
  complete linear order with a bottom element, `conditionally_complete_linear_order_bot`;

* `a + b` and `a * b` are the restrictions of addition and multiplication of real numbers to `ℝ≥0`;
  these operations together with `0 = ⟨0, _⟩` and `1 = ⟨1, _⟩` turn `ℝ≥0` into a linear ordered
  archimedean commutative semifield; we have no typeclass for this in `mathlib` yet, so we define
  the following instances instead:

  - `linear_ordered_semiring ℝ≥0`;
  - `comm_semiring ℝ≥0`;
  - `canonically_ordered_comm_semiring ℝ≥0`;
  - `linear_ordered_comm_group_with_zero ℝ≥0`;
  - `archimedean ℝ≥0`.

* `nnreal.of_real x` is defined as `⟨max x 0, _⟩`, i.e. `↑(nnreal.of_real x) = x` when `0 ≤ x` and
  `↑(nnreal.of_real x) = 0` otherwise.

We also define an instance `can_lift ℝ ℝ≥0`. This instance can be used by the `lift` tactic to
replace `x : ℝ` and `hx : 0 ≤ x` in the proof context with `x : ℝ≥0` while replacing all occurences
of `x` with `↑x`. This tactic also works for a function `f : α → ℝ` with a hypothesis
`hf : ∀ x, 0 ≤ f x`.

## Notations

This file defines `ℝ≥0` as a localized notation for `nnreal`.
-/

/-- Nonnegative real numbers. -/
def nnreal :=
  Subtype fun (r : ℝ) => 0 ≤ r

namespace nnreal

protected instance real.has_coe : has_coe nnreal ℝ :=
  has_coe.mk subtype.val

/- Simp lemma to put back `n.val` into the normal form given by the coercion. -/

@[simp] theorem val_eq_coe (n : nnreal) : subtype.val n = ↑n :=
  rfl

protected instance can_lift : can_lift ℝ nnreal :=
  can_lift.mk coe (fun (r : ℝ) => 0 ≤ r) sorry

protected theorem eq {n : nnreal} {m : nnreal} : ↑n = ↑m → n = m :=
  subtype.eq

protected theorem eq_iff {n : nnreal} {m : nnreal} : ↑n = ↑m ↔ n = m :=
  { mp := nnreal.eq, mpr := congr_arg coe }

theorem ne_iff {x : nnreal} {y : nnreal} : ↑x ≠ ↑y ↔ x ≠ y :=
  not_iff_not_of_iff nnreal.eq_iff

/-- Reinterpret a real number `r` as a non-negative real number. Returns `0` if `r < 0`. -/
protected def of_real (r : ℝ) : nnreal :=
  { val := max r 0, property := sorry }

theorem coe_of_real (r : ℝ) (hr : 0 ≤ r) : ↑(nnreal.of_real r) = r :=
  max_eq_left hr

theorem le_coe_of_real (r : ℝ) : r ≤ ↑(nnreal.of_real r) :=
  le_max_left r 0

theorem coe_nonneg (r : nnreal) : 0 ≤ ↑r :=
  subtype.property r

theorem coe_mk (a : ℝ) (ha : 0 ≤ a) : ↑{ val := a, property := ha } = a :=
  rfl

protected instance has_zero : HasZero nnreal :=
  { zero := { val := 0, property := sorry } }

protected instance has_one : HasOne nnreal :=
  { one := { val := 1, property := zero_le_one } }

protected instance has_add : Add nnreal :=
  { add := fun (a b : nnreal) => { val := ↑a + ↑b, property := sorry } }

protected instance has_sub : Sub nnreal :=
  { sub := fun (a b : nnreal) => nnreal.of_real (↑a - ↑b) }

protected instance has_mul : Mul nnreal :=
  { mul := fun (a b : nnreal) => { val := ↑a * ↑b, property := sorry } }

protected instance has_inv : has_inv nnreal :=
  has_inv.mk fun (a : nnreal) => { val := subtype.val a⁻¹, property := sorry }

protected instance has_le : HasLessEq nnreal :=
  { LessEq := fun (r s : nnreal) => ↑r ≤ ↑s }

protected instance has_bot : has_bot nnreal :=
  has_bot.mk 0

protected instance inhabited : Inhabited nnreal :=
  { default := 0 }

protected theorem injective_coe : function.injective coe :=
  subtype.coe_injective

@[simp] protected theorem coe_eq {r₁ : nnreal} {r₂ : nnreal} : ↑r₁ = ↑r₂ ↔ r₁ = r₂ :=
  function.injective.eq_iff nnreal.injective_coe

@[simp] protected theorem coe_zero : ↑0 = 0 :=
  rfl

@[simp] protected theorem coe_one : ↑1 = 1 :=
  rfl

@[simp] protected theorem coe_add (r₁ : nnreal) (r₂ : nnreal) : ↑(r₁ + r₂) = ↑r₁ + ↑r₂ :=
  rfl

@[simp] protected theorem coe_mul (r₁ : nnreal) (r₂ : nnreal) : ↑(r₁ * r₂) = ↑r₁ * ↑r₂ :=
  rfl

@[simp] protected theorem coe_inv (r : nnreal) : ↑(r⁻¹) = (↑r⁻¹) :=
  rfl

@[simp] protected theorem coe_bit0 (r : nnreal) : ↑(bit0 r) = bit0 ↑r :=
  rfl

@[simp] protected theorem coe_bit1 (r : nnreal) : ↑(bit1 r) = bit1 ↑r :=
  rfl

@[simp] protected theorem coe_sub {r₁ : nnreal} {r₂ : nnreal} (h : r₂ ≤ r₁) : ↑(r₁ - r₂) = ↑r₁ - ↑r₂ := sorry

-- TODO: setup semifield!

@[simp] protected theorem coe_eq_zero (r : nnreal) : ↑r = 0 ↔ r = 0 := sorry

theorem coe_ne_zero {r : nnreal} : ↑r ≠ 0 ↔ r ≠ 0 := sorry

protected instance comm_semiring : comm_semiring nnreal :=
  comm_semiring.mk Add.add sorry 0 sorry sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry sorry

/-- Coercion `ℝ≥0 → ℝ` as a `ring_hom`. -/
def to_real_hom : nnreal →+* ℝ :=
  ring_hom.mk coe nnreal.coe_one nnreal.coe_mul nnreal.coe_zero nnreal.coe_add

@[simp] theorem coe_to_real_hom : ⇑to_real_hom = coe :=
  rfl

protected instance comm_group_with_zero : comm_group_with_zero nnreal :=
  comm_group_with_zero.mk comm_semiring.mul comm_semiring.mul_assoc comm_semiring.one comm_semiring.one_mul
    comm_semiring.mul_one comm_semiring.mul_comm comm_semiring.zero comm_semiring.zero_mul comm_semiring.mul_zero
    has_inv.inv
    (group_with_zero.div._default comm_semiring.mul comm_semiring.mul_assoc comm_semiring.one comm_semiring.one_mul
      comm_semiring.mul_one has_inv.inv)
    sorry sorry sorry

@[simp] theorem coe_indicator {α : Type u_1} (s : set α) (f : α → nnreal) (a : α) : ↑(set.indicator s f a) = set.indicator s (fun (x : α) => ↑(f x)) a :=
  add_monoid_hom.map_indicator (↑to_real_hom) s f a

@[simp] protected theorem coe_div (r₁ : nnreal) (r₂ : nnreal) : ↑(r₁ / r₂) = ↑r₁ / ↑r₂ :=
  rfl

@[simp] theorem coe_pow (r : nnreal) (n : ℕ) : ↑(r ^ n) = ↑r ^ n :=
  ring_hom.map_pow to_real_hom r n

theorem coe_list_sum (l : List nnreal) : ↑(list.sum l) = list.sum (list.map coe l) :=
  ring_hom.map_list_sum to_real_hom l

theorem coe_list_prod (l : List nnreal) : ↑(list.prod l) = list.prod (list.map coe l) :=
  ring_hom.map_list_prod to_real_hom l

theorem coe_multiset_sum (s : multiset nnreal) : ↑(multiset.sum s) = multiset.sum (multiset.map coe s) :=
  ring_hom.map_multiset_sum to_real_hom s

theorem coe_multiset_prod (s : multiset nnreal) : ↑(multiset.prod s) = multiset.prod (multiset.map coe s) :=
  ring_hom.map_multiset_prod to_real_hom s

theorem coe_sum {α : Type u_1} {s : finset α} {f : α → nnreal} : ↑(finset.sum s fun (a : α) => f a) = finset.sum s fun (a : α) => ↑(f a) :=
  ring_hom.map_sum to_real_hom (fun (a : α) => f a) s

theorem of_real_sum_of_nonneg {α : Type u_1} {s : finset α} {f : α → ℝ} (hf : ∀ (a : α), a ∈ s → 0 ≤ f a) : nnreal.of_real (finset.sum s fun (a : α) => f a) = finset.sum s fun (a : α) => nnreal.of_real (f a) := sorry

theorem coe_prod {α : Type u_1} {s : finset α} {f : α → nnreal} : ↑(finset.prod s fun (a : α) => f a) = finset.prod s fun (a : α) => ↑(f a) :=
  ring_hom.map_prod to_real_hom (fun (a : α) => f a) s

theorem of_real_prod_of_nonneg {α : Type u_1} {s : finset α} {f : α → ℝ} (hf : ∀ (a : α), a ∈ s → 0 ≤ f a) : nnreal.of_real (finset.prod s fun (a : α) => f a) = finset.prod s fun (a : α) => nnreal.of_real (f a) := sorry

theorem nsmul_coe (r : nnreal) (n : ℕ) : ↑(n •ℕ r) = n •ℕ ↑r :=
  add_monoid_hom.map_nsmul (ring_hom.to_add_monoid_hom to_real_hom) r n

@[simp] protected theorem coe_nat_cast (n : ℕ) : ↑↑n = ↑n :=
  ring_hom.map_nat_cast to_real_hom n

protected instance linear_order : linear_order nnreal :=
  linear_order.lift coe nnreal.injective_coe

@[simp] protected theorem coe_le_coe {r₁ : nnreal} {r₂ : nnreal} : ↑r₁ ≤ ↑r₂ ↔ r₁ ≤ r₂ :=
  iff.rfl

@[simp] protected theorem coe_lt_coe {r₁ : nnreal} {r₂ : nnreal} : ↑r₁ < ↑r₂ ↔ r₁ < r₂ :=
  iff.rfl

@[simp] protected theorem coe_pos {r : nnreal} : 0 < ↑r ↔ 0 < r :=
  iff.rfl

protected theorem coe_mono : monotone coe :=
  fun (_x _x_1 : nnreal) => iff.mpr nnreal.coe_le_coe

protected theorem of_real_mono : monotone nnreal.of_real :=
  fun (x y : ℝ) (h : x ≤ y) => max_le_max h (le_refl 0)

@[simp] theorem of_real_coe {r : nnreal} : nnreal.of_real ↑r = r :=
  nnreal.eq (max_eq_left (subtype.property r))

@[simp] theorem mk_coe_nat (n : ℕ) : { val := ↑n, property := nat.cast_nonneg n } = ↑n :=
  nnreal.eq (Eq.symm (nnreal.coe_nat_cast n))

@[simp] theorem of_real_coe_nat (n : ℕ) : nnreal.of_real ↑n = ↑n := sorry

/-- `nnreal.of_real` and `coe : ℝ≥0 → ℝ` form a Galois insertion. -/
protected def gi : galois_insertion nnreal.of_real coe :=
  galois_insertion.monotone_intro nnreal.coe_mono nnreal.of_real_mono le_coe_of_real sorry

protected instance order_bot : order_bot nnreal :=
  order_bot.mk ⊥ linear_order.le linear_order.lt linear_order.le_refl linear_order.le_trans linear_order.le_antisymm sorry

protected instance canonically_ordered_add_monoid : canonically_ordered_add_monoid nnreal :=
  canonically_ordered_add_monoid.mk comm_semiring.add comm_semiring.add_assoc comm_semiring.zero comm_semiring.zero_add
    comm_semiring.add_zero comm_semiring.add_comm order_bot.le order_bot.lt order_bot.le_refl order_bot.le_trans
    order_bot.le_antisymm sorry sorry order_bot.bot order_bot.bot_le sorry

protected instance distrib_lattice : distrib_lattice nnreal :=
  Mathlib.distrib_lattice_of_linear_order

protected instance semilattice_inf_bot : semilattice_inf_bot nnreal :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt order_bot.le_refl order_bot.le_trans
    order_bot.le_antisymm order_bot.bot_le distrib_lattice.inf distrib_lattice.inf_le_left distrib_lattice.inf_le_right
    distrib_lattice.le_inf

protected instance semilattice_sup_bot : semilattice_sup_bot nnreal :=
  semilattice_sup_bot.mk order_bot.bot order_bot.le order_bot.lt order_bot.le_refl order_bot.le_trans
    order_bot.le_antisymm order_bot.bot_le distrib_lattice.sup distrib_lattice.le_sup_left distrib_lattice.le_sup_right
    distrib_lattice.sup_le

protected instance linear_ordered_semiring : linear_ordered_semiring nnreal :=
  linear_ordered_semiring.mk canonically_ordered_add_monoid.add canonically_ordered_add_monoid.add_assoc
    canonically_ordered_add_monoid.zero canonically_ordered_add_monoid.zero_add canonically_ordered_add_monoid.add_zero
    canonically_ordered_add_monoid.add_comm comm_semiring.mul comm_semiring.mul_assoc comm_semiring.one
    comm_semiring.one_mul comm_semiring.mul_one comm_semiring.zero_mul comm_semiring.mul_zero comm_semiring.left_distrib
    comm_semiring.right_distrib sorry sorry linear_order.le linear_order.lt linear_order.le_refl linear_order.le_trans
    linear_order.le_antisymm canonically_ordered_add_monoid.add_le_add_left sorry zero_le_one sorry sorry
    linear_order.le_total linear_order.decidable_le linear_order.decidable_eq linear_order.decidable_lt sorry

protected instance linear_ordered_comm_group_with_zero : linear_ordered_comm_group_with_zero nnreal :=
  linear_ordered_comm_group_with_zero.mk linear_ordered_semiring.le linear_ordered_semiring.lt
    linear_ordered_semiring.le_refl linear_ordered_semiring.le_trans linear_ordered_semiring.le_antisymm
    linear_ordered_semiring.le_total linear_ordered_semiring.decidable_le linear_ordered_semiring.decidable_eq
    linear_ordered_semiring.decidable_lt linear_ordered_semiring.mul linear_ordered_semiring.mul_assoc
    linear_ordered_semiring.one linear_ordered_semiring.one_mul linear_ordered_semiring.mul_one
    comm_group_with_zero.mul_comm linear_ordered_semiring.zero linear_ordered_semiring.zero_mul
    linear_ordered_semiring.mul_zero sorry sorry sorry comm_group_with_zero.inv comm_group_with_zero.div
    linear_ordered_semiring.exists_pair_ne comm_group_with_zero.inv_zero comm_group_with_zero.mul_inv_cancel

protected instance canonically_ordered_comm_semiring : canonically_ordered_comm_semiring nnreal :=
  canonically_ordered_comm_semiring.mk canonically_ordered_add_monoid.add canonically_ordered_add_monoid.add_assoc
    canonically_ordered_add_monoid.zero canonically_ordered_add_monoid.zero_add canonically_ordered_add_monoid.add_zero
    canonically_ordered_add_monoid.add_comm canonically_ordered_add_monoid.le canonically_ordered_add_monoid.lt
    canonically_ordered_add_monoid.le_refl canonically_ordered_add_monoid.le_trans
    canonically_ordered_add_monoid.le_antisymm canonically_ordered_add_monoid.add_le_add_left
    canonically_ordered_add_monoid.lt_of_add_lt_add_left canonically_ordered_add_monoid.bot
    canonically_ordered_add_monoid.bot_le canonically_ordered_add_monoid.le_iff_exists_add comm_semiring.mul
    comm_semiring.mul_assoc comm_semiring.one comm_semiring.one_mul comm_semiring.mul_one comm_semiring.zero_mul
    comm_semiring.mul_zero comm_semiring.left_distrib comm_semiring.right_distrib comm_semiring.mul_comm sorry

protected instance densely_ordered : densely_ordered nnreal :=
  densely_ordered.mk fun (a b : nnreal) (h : ↑a < ↑b) => sorry

protected instance no_top_order : no_top_order nnreal :=
  no_top_order.mk fun (a : nnreal) => sorry

theorem bdd_above_coe {s : set nnreal} : bdd_above (coe '' s) ↔ bdd_above s := sorry

theorem bdd_below_coe (s : set nnreal) : bdd_below (coe '' s) := sorry

protected instance has_Sup : has_Sup nnreal :=
  has_Sup.mk fun (s : set nnreal) => { val := Sup (coe '' s), property := sorry }

protected instance has_Inf : has_Inf nnreal :=
  has_Inf.mk fun (s : set nnreal) => { val := Inf (coe '' s), property := sorry }

theorem coe_Sup (s : set nnreal) : ↑(Sup s) = Sup (coe '' s) :=
  rfl

theorem coe_Inf (s : set nnreal) : ↑(Inf s) = Inf (coe '' s) :=
  rfl

protected instance conditionally_complete_linear_order_bot : conditionally_complete_linear_order_bot nnreal :=
  conditionally_complete_linear_order_bot.mk lattice.sup linear_ordered_semiring.le linear_ordered_semiring.lt
    linear_ordered_semiring.le_refl linear_ordered_semiring.le_trans linear_ordered_semiring.le_antisymm sorry sorry sorry
    lattice.inf sorry sorry sorry Sup Inf sorry sorry sorry sorry linear_ordered_semiring.le_total
    (id fun (x y : nnreal) => classical.dec (x ≤ y)) linear_ordered_semiring.decidable_eq
    linear_ordered_semiring.decidable_lt order_bot.bot order_bot.bot_le sorry

protected instance archimedean : archimedean nnreal :=
  archimedean.mk fun (x y : nnreal) (pos_y : 0 < y) => sorry

theorem le_of_forall_pos_le_add {a : nnreal} {b : nnreal} (h : ∀ (ε : nnreal), 0 < ε → a ≤ b + ε) : a ≤ b := sorry

theorem lt_iff_exists_rat_btwn (a : nnreal) (b : nnreal) : a < b ↔ ∃ (q : ℚ), 0 ≤ q ∧ a < nnreal.of_real ↑q ∧ nnreal.of_real ↑q < b := sorry

theorem bot_eq_zero : ⊥ = 0 :=
  rfl

theorem mul_sup (a : nnreal) (b : nnreal) (c : nnreal) : a * (b ⊔ c) = a * b ⊔ a * c := sorry

theorem mul_finset_sup {α : Type u_1} {f : α → nnreal} {s : finset α} (r : nnreal) : r * finset.sup s f = finset.sup s fun (a : α) => r * f a := sorry

@[simp] theorem coe_max (x : nnreal) (y : nnreal) : ↑(max x y) = max ↑x ↑y := sorry

@[simp] theorem coe_min (x : nnreal) (y : nnreal) : ↑(min x y) = min ↑x ↑y := sorry

@[simp] theorem zero_le_coe {q : nnreal} : 0 ≤ ↑q :=
  subtype.property q

@[simp] theorem of_real_zero : nnreal.of_real 0 = 0 := sorry

@[simp] theorem of_real_one : nnreal.of_real 1 = 1 := sorry

@[simp] theorem of_real_pos {r : ℝ} : 0 < nnreal.of_real r ↔ 0 < r := sorry

@[simp] theorem of_real_eq_zero {r : ℝ} : nnreal.of_real r = 0 ↔ r ≤ 0 := sorry

theorem of_real_of_nonpos {r : ℝ} : r ≤ 0 → nnreal.of_real r = 0 :=
  iff.mpr of_real_eq_zero

@[simp] theorem of_real_le_of_real_iff {r : ℝ} {p : ℝ} (hp : 0 ≤ p) : nnreal.of_real r ≤ nnreal.of_real p ↔ r ≤ p := sorry

@[simp] theorem of_real_lt_of_real_iff' {r : ℝ} {p : ℝ} : nnreal.of_real r < nnreal.of_real p ↔ r < p ∧ 0 < p := sorry

theorem of_real_lt_of_real_iff {r : ℝ} {p : ℝ} (h : 0 < p) : nnreal.of_real r < nnreal.of_real p ↔ r < p :=
  iff.trans of_real_lt_of_real_iff' (and_iff_left h)

theorem of_real_lt_of_real_iff_of_nonneg {r : ℝ} {p : ℝ} (hr : 0 ≤ r) : nnreal.of_real r < nnreal.of_real p ↔ r < p :=
  iff.trans of_real_lt_of_real_iff'
    { mp := and.left, mpr := fun (h : r < p) => { left := h, right := lt_of_le_of_lt hr h } }

@[simp] theorem of_real_add {r : ℝ} {p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) : nnreal.of_real (r + p) = nnreal.of_real r + nnreal.of_real p := sorry

theorem of_real_add_of_real {r : ℝ} {p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) : nnreal.of_real r + nnreal.of_real p = nnreal.of_real (r + p) :=
  Eq.symm (of_real_add hr hp)

theorem of_real_le_of_real {r : ℝ} {p : ℝ} (h : r ≤ p) : nnreal.of_real r ≤ nnreal.of_real p :=
  nnreal.of_real_mono h

theorem of_real_add_le {r : ℝ} {p : ℝ} : nnreal.of_real (r + p) ≤ nnreal.of_real r + nnreal.of_real p :=
  iff.mp nnreal.coe_le_coe (max_le (add_le_add (le_max_left r 0) (le_max_left p 0)) zero_le_coe)

theorem of_real_le_iff_le_coe {r : ℝ} {p : nnreal} : nnreal.of_real r ≤ p ↔ r ≤ ↑p :=
  galois_insertion.gc nnreal.gi r p

theorem le_of_real_iff_coe_le {r : nnreal} {p : ℝ} (hp : 0 ≤ p) : r ≤ nnreal.of_real p ↔ ↑r ≤ p :=
  eq.mpr (id (Eq._oldrec (Eq.refl (r ≤ nnreal.of_real p ↔ ↑r ≤ p)) (Eq.symm (propext nnreal.coe_le_coe))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑r ≤ ↑(nnreal.of_real p) ↔ ↑r ≤ p)) (coe_of_real p hp))) (iff.refl (↑r ≤ p)))

theorem le_of_real_iff_coe_le' {r : nnreal} {p : ℝ} (hr : 0 < r) : r ≤ nnreal.of_real p ↔ ↑r ≤ p := sorry

theorem of_real_lt_iff_lt_coe {r : ℝ} {p : nnreal} (ha : 0 ≤ r) : nnreal.of_real r < p ↔ r < ↑p :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nnreal.of_real r < p ↔ r < ↑p)) (Eq.symm (propext nnreal.coe_lt_coe))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(nnreal.of_real r) < ↑p ↔ r < ↑p)) (coe_of_real r ha))) (iff.refl (r < ↑p)))

theorem lt_of_real_iff_coe_lt {r : nnreal} {p : ℝ} : r < nnreal.of_real p ↔ ↑r < p := sorry

theorem mul_eq_mul_left {a : nnreal} {b : nnreal} {c : nnreal} (h : a ≠ 0) : a * b = a * c ↔ b = c := sorry

theorem of_real_mul {p : ℝ} {q : ℝ} (hp : 0 ≤ p) : nnreal.of_real (p * q) = nnreal.of_real p * nnreal.of_real q := sorry

theorem sub_def {r : nnreal} {p : nnreal} : r - p = nnreal.of_real (↑r - ↑p) :=
  rfl

theorem sub_eq_zero {r : nnreal} {p : nnreal} (h : r ≤ p) : r - p = 0 := sorry

@[simp] theorem sub_self {r : nnreal} : r - r = 0 :=
  sub_eq_zero (le_refl r)

@[simp] theorem sub_zero {r : nnreal} : r - 0 = r := sorry

theorem sub_pos {r : nnreal} {p : nnreal} : 0 < r - p ↔ p < r :=
  iff.trans of_real_pos (iff.trans sub_pos nnreal.coe_lt_coe)

protected theorem sub_lt_self {r : nnreal} {p : nnreal} : 0 < r → 0 < p → r - p < r := sorry

@[simp] theorem sub_le_iff_le_add {r : nnreal} {p : nnreal} {q : nnreal} : r - p ≤ q ↔ r ≤ q + p := sorry

@[simp] theorem sub_le_self {r : nnreal} {p : nnreal} : r - p ≤ r :=
  iff.mpr sub_le_iff_le_add (le_add_right (le_refl r))

theorem add_sub_cancel {r : nnreal} {p : nnreal} : p + r - r = p := sorry

theorem add_sub_cancel' {r : nnreal} {p : nnreal} : r + p - r = p :=
  eq.mpr (id (Eq._oldrec (Eq.refl (r + p - r = p)) (add_comm r p)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (p + r - r = p)) add_sub_cancel)) (Eq.refl p))

theorem sub_add_eq_max {r : nnreal} {p : nnreal} : r - p + p = max r p := sorry

theorem add_sub_eq_max {r : nnreal} {p : nnreal} : p + (r - p) = max p r :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p + (r - p) = max p r)) (add_comm p (r - p))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (r - p + p = max p r)) sub_add_eq_max))
      (eq.mpr (id (Eq._oldrec (Eq.refl (max r p = max p r)) (max_comm r p))) (Eq.refl (max p r))))

@[simp] theorem sub_add_cancel_of_le {a : nnreal} {b : nnreal} (h : b ≤ a) : a - b + b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + b = a)) sub_add_eq_max))
    (eq.mpr (id (Eq._oldrec (Eq.refl (max a b = a)) (max_eq_left h))) (Eq.refl a))

theorem sub_sub_cancel_of_le {r : nnreal} {p : nnreal} (h : r ≤ p) : p - (p - r) = r := sorry

theorem lt_sub_iff_add_lt {p : nnreal} {q : nnreal} {r : nnreal} : p < q - r ↔ p + r < q := sorry

theorem sub_lt_iff_lt_add {a : nnreal} {b : nnreal} {c : nnreal} (h : b ≤ a) : a - b < c ↔ a < b + c := sorry

theorem sub_eq_iff_eq_add {a : nnreal} {b : nnreal} {c : nnreal} (h : b ≤ a) : a - b = c ↔ a = c + b := sorry

theorem sum_div {ι : Type u_1} (s : finset ι) (f : ι → nnreal) (b : nnreal) : (finset.sum s fun (i : ι) => f i) / b = finset.sum s fun (i : ι) => f i / b := sorry

@[simp] theorem inv_pos {r : nnreal} : 0 < (r⁻¹) ↔ 0 < r := sorry

theorem div_pos {r : nnreal} {p : nnreal} (hr : 0 < r) (hp : 0 < p) : 0 < r / p := sorry

protected theorem mul_inv {r : nnreal} {p : nnreal} : r * p⁻¹ = p⁻¹ * (r⁻¹) :=
  nnreal.eq (mul_inv_rev' ↑r ↑p)

theorem div_self_le (r : nnreal) : r / r ≤ 1 := sorry

@[simp] theorem inv_le {r : nnreal} {p : nnreal} (h : r ≠ 0) : r⁻¹ ≤ p ↔ 1 ≤ r * p :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (r⁻¹ ≤ p ↔ 1 ≤ r * p)) (Eq.symm (propext (mul_le_mul_left (iff.mpr pos_iff_ne_zero h))))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (r * (r⁻¹) ≤ r * p ↔ 1 ≤ r * p)) (mul_inv_cancel h))) (iff.refl (1 ≤ r * p)))

theorem inv_le_of_le_mul {r : nnreal} {p : nnreal} (h : 1 ≤ r * p) : r⁻¹ ≤ p := sorry

@[simp] theorem le_inv_iff_mul_le {r : nnreal} {p : nnreal} (h : p ≠ 0) : r ≤ (p⁻¹) ↔ r * p ≤ 1 := sorry

@[simp] theorem lt_inv_iff_mul_lt {r : nnreal} {p : nnreal} (h : p ≠ 0) : r < (p⁻¹) ↔ r * p < 1 := sorry

theorem mul_le_iff_le_inv {a : nnreal} {b : nnreal} {r : nnreal} (hr : r ≠ 0) : r * a ≤ b ↔ a ≤ r⁻¹ * b := sorry

theorem le_div_iff_mul_le {a : nnreal} {b : nnreal} {r : nnreal} (hr : r ≠ 0) : a ≤ b / r ↔ a * r ≤ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b / r ↔ a * r ≤ b)) div_eq_inv_mul))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ r⁻¹ * b ↔ a * r ≤ b)) (Eq.symm (propext (mul_le_iff_le_inv hr)))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (r * a ≤ b ↔ a * r ≤ b)) (mul_comm r a))) (iff.refl (a * r ≤ b))))

theorem div_le_iff {a : nnreal} {b : nnreal} {r : nnreal} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ b * r :=
  div_le_iff (iff.mpr pos_iff_ne_zero hr)

theorem lt_div_iff {a : nnreal} {b : nnreal} {r : nnreal} (hr : r ≠ 0) : a < b / r ↔ a * r < b :=
  lt_iff_lt_of_le_iff_le (div_le_iff hr)

theorem mul_lt_of_lt_div {a : nnreal} {b : nnreal} {r : nnreal} (h : a < b / r) : a * r < b := sorry

theorem le_of_forall_lt_one_mul_le {x : nnreal} {y : nnreal} (h : ∀ (a : nnreal), a < 1 → a * x ≤ y) : x ≤ y := sorry

theorem div_add_div_same (a : nnreal) (b : nnreal) (c : nnreal) : a / c + b / c = (a + b) / c :=
  Eq.symm (right_distrib a b (c⁻¹))

theorem half_pos {a : nnreal} (h : 0 < a) : 0 < a / bit0 1 :=
  div_pos h zero_lt_two

theorem add_halves (a : nnreal) : a / bit0 1 + a / bit0 1 = a :=
  nnreal.eq (add_halves ↑a)

theorem half_lt_self {a : nnreal} (h : a ≠ 0) : a / bit0 1 < a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / bit0 1 < a)) (Eq.symm (propext nnreal.coe_lt_coe))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(a / bit0 1) < ↑a)) (nnreal.coe_div a (bit0 1))))
      (half_lt_self (iff.mpr bot_lt_iff_ne_bot h)))

theorem two_inv_lt_one : bit0 1⁻¹ < 1 := sorry

theorem div_lt_iff {a : nnreal} {b : nnreal} {c : nnreal} (hc : c ≠ 0) : b / c < a ↔ b < a * c :=
  lt_iff_lt_of_le_iff_le (le_div_iff_mul_le hc)

theorem div_lt_one_of_lt {a : nnreal} {b : nnreal} (h : a < b) : a / b < 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b < 1)) (propext (div_lt_iff (ne_of_gt (lt_of_le_of_lt (zero_le a) h))))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a < 1 * b)) (one_mul b))) h)

theorem div_add_div (a : nnreal) {b : nnreal} (c : nnreal) {d : nnreal} (hb : b ≠ 0) (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) := sorry

theorem add_div' (a : nnreal) (b : nnreal) (c : nnreal) (hc : c ≠ 0) : b + a / c = (b * c + a) / c := sorry

theorem div_add' (a : nnreal) (b : nnreal) (c : nnreal) (hc : c ≠ 0) : a / c + b = (a + b * c) / c := sorry

theorem of_real_inv {x : ℝ} : nnreal.of_real (x⁻¹) = (nnreal.of_real x⁻¹) := sorry

theorem of_real_div {x : ℝ} {y : ℝ} (hx : 0 ≤ x) : nnreal.of_real (x / y) = nnreal.of_real x / nnreal.of_real y := sorry

theorem of_real_div' {x : ℝ} {y : ℝ} (hy : 0 ≤ y) : nnreal.of_real (x / y) = nnreal.of_real x / nnreal.of_real y := sorry

@[simp] theorem abs_eq (x : nnreal) : abs ↑x = ↑x :=
  abs_of_nonneg (subtype.property x)

end nnreal

/-- The absolute value on `ℝ` as a map to `ℝ≥0`. -/
def real.nnabs (x : ℝ) : nnreal :=
  { val := abs x, property := abs_nonneg x }

@[simp] theorem nnreal.coe_nnabs (x : ℝ) : ↑(real.nnabs x) = abs x := sorry


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

import ring_theory.subring

variables {F : Type*} [field F] (S : set F)

class is_subfield extends is_subring S : Prop :=
(inv_mem : ∀ {x : F}, x ≠ 0 → x ∈ S → x⁻¹ ∈ S)

namespace field

def closure : set F :=
{ x | ∃ y ∈ ring.closure S, ∃ z ∈ ring.closure S, z ≠ 0 ∧ y / z = x }

variables {S}

theorem ring_closure_subset : ring.closure S ⊆ closure S :=
λ x hx, ⟨x, hx, 1, is_submonoid.one_mem _, one_ne_zero, div_one x⟩

instance closure.is_submonoid : is_submonoid (closure S) :=
{ mul_mem := by rintros _  _ ⟨p, hp, q, hq, hq0, rfl⟩ ⟨r, hr, s, hs, hs0, rfl⟩;
    exact ⟨p * r, is_submonoid.mul_mem hp hr, q * s, is_submonoid.mul_mem hq hs, mul_ne_zero hq0 hs0, (div_mul_div _ _ hq0 hs0).symm⟩,
  one_mem := ring_closure_subset $ is_submonoid.one_mem _ }

instance closure.is_subfield : is_subfield (closure S) :=
{ add_mem := begin
    rintros _ _ ⟨p, hp, q, hq, hq0, rfl⟩ ⟨r, hr, s, hs, hs0, rfl⟩,
    exact ⟨p * s + q * r, is_add_submonoid.add_mem (is_submonoid.mul_mem hp hs) (is_submonoid.mul_mem hq hr),
      q * s, is_submonoid.mul_mem hq hs, mul_ne_zero hq0 hs0, (div_add_div p r hq0 hs0).symm⟩
  end,
  zero_mem := ring_closure_subset $ is_add_submonoid.zero_mem _,
  neg_mem := begin
    rintros _ ⟨p, hp, q, hq, hq0, rfl⟩,
    exact ⟨-p, is_add_subgroup.neg_mem hp, q, hq, hq0, neg_div q p⟩
  end,
  inv_mem := begin
    rintros _ hp0 ⟨p, hp, q, hq, hq0, rfl⟩,
    exact ⟨q, hq, p, hp, (div_ne_zero_iff hq0).1 hp0, (inv_div ((div_ne_zero_iff hq0).1 hp0) hq0).symm⟩
  end }

theorem mem_closure {a : F} (ha : a ∈ S) : a ∈ closure S :=
ring_closure_subset $ ring.mem_closure ha

theorem subset_closure : S ⊆ closure S :=
λ _, mem_closure

theorem closure_subset {T : set F} [is_subfield T] (H : S ⊆ T) : closure S ⊆ T :=
by rintros _ ⟨p, hp, q, hq, hq0, rfl⟩; exact is_submonoid.mul_mem (ring.closure_subset H hp)
  (is_subfield.inv_mem hq0 $ ring.closure_subset H hq)

theorem closure_subset_iff (s t : set F) [is_subfield t] : closure s ⊆ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, closure_subset⟩

theorem closure_mono {s t : set F} (H : s ⊆ t) : closure s ⊆ closure t :=
closure_subset $ set.subset.trans H subset_closure

end field


import .love06_monads_demo

/-! # LoVe Exercise 6: Monads -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: A State Monad with Failure

We introduce a richer notion of lawful monad that provides an `orelse`
operator `<|>` satisfying some laws, given below. `emp` denotes failure.
`x <|> y` tries `x` first, falling back on `y` on failure. -/

@[class] structure lawful_monad_with_orelse (m : Type → Type)
  extends lawful_monad m, has_orelse m : Type 1 :=
(emp {} {α : Type} : m α)
(emp_orelse {α : Type} (a : m α) :
  (emp <|> a) = a)
(orelse_emp {α : Type} (a : m α) :
  (a <|> emp) = a)
(orelse_assoc {α : Type} (a b c : m α) :
  ((a <|> b) <|> c) = (a <|> (b <|> c)))
(emp_bind {α β : Type} (f : α → m β) :
  (emp >>= f) = emp)
(bind_emp {α β : Type} (f : m α) :
  (f >>= (λa, emp : α → m β)) = emp)

/-! 1.1. We set up the `option` type constructor to be a
`lawful_monad_with_orelse`. Complete the proofs. -/

def option.orelse {α : Type} : option α → option α → option α
| option.none     ma' := ma'
| (option.some a) _   := option.some a

@[instance] def lawful_monad_with_orelse_option :
  lawful_monad_with_orelse option :=
{ emp          := λα, option.none,
  orelse       := @option.orelse,
  emp_orelse   :=
    begin
      intros,
      cases a,
      { refl },
      { refl },
    end,
  orelse_emp   :=
    begin
      intros α a,
      cases a,
      { refl },
      { refl }
    end,
  orelse_assoc :=
    begin
      intros α a,
      cases a,
      {
        intros,
        refl,
      },
      {
        intros,
        refl,
      }
    end,
  emp_bind     :=
    begin
      intros α β f,
      refl
    end,
  bind_emp     :=
    begin
      intros α β f,
      cases f,
      {
        refl,
      },
      {
        refl,
      }
    end,
  .. option.lawful_monad
}

@[simp] lemma option.some_bind {α β : Type} (a : α) (g : α → option β) :
  (option.some a >>= g) = g a :=
begin
  refl,
end

/-! Let us enable some convenient pattern matching syntax, by instantiating
Lean's `monad_fail` type class. (Do not worry if you do not understand what
we are referring to.) -/

@[instance] def lawful_monad_with_orelse.monad_fail {m : Type → Type}
  [lawful_monad_with_orelse m] : monad_fail m :=
{ fail := λα msg, lawful_monad_with_orelse.emp }

/-! Now we can write definitions such as the following: -/

def first_of_three {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  [n, _, _] ← c,
  pure n

#eval first_of_three (option.some [1])
#eval first_of_three (option.some [1, 2, 3])
#eval first_of_three (option.some [1, 2, 3, 4])

/-! Using `lawful_monad_with_orelse` and the `monad_fail` syntax, we can give a
concise definition for the `sum_2_5_7` function seen in the lecture. -/

def sum_2_5_7₇ {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  (_ :: n2 :: _ :: _ :: n5 :: _ :: n7 :: _) ← c,
  pure (n2 + n5 + n7)

/-! 1.2. Now we are ready to define `faction σ` ("eff action"): a monad with an
internal state of type `σ` that can fail (unlike `action σ`).

We start with defining `faction σ α`, where `σ` is the type of the internal
state, and `α` is the type of the value stored in the monad. We use `option` to
model failure. This means we can also use the monadic behavior of `option` when
defining the monadic operations on `faction`.

Hints:

* Remember that `faction σ α` is an alias for a function type, so you can use
  pattern matching and `λs, …` to define values of type `faction σ α`.

* `faction` is very similar to `action` from the lecture's demo. You can look
  there for inspiration. -/

def faction (σ : Type) (α : Type) :=
σ → option (α × σ)

/-! 1.3. Define the `get` and `set` function for `faction`, where `get` returns
the state passed along the state monad and `set s` changes the state to `s`. -/

def get {σ : Type} : faction σ σ :=
sorry

def set {σ : Type} (s : σ) : faction σ unit :=
sorry

/-! 1.4. Define the monadic operator `pure` for `faction`, in such a way that it
will satisfy the monad laws. -/

def faction.bind {σ α β : Type} (f : faction σ α) (g : α → faction σ β) :
  faction σ β
| s := f s >>= (λas, g (prod.fst as) (prod.snd as))

/-! We set up the `>>=` syntax on `faction`: -/

@[instance] def faction.has_bind {σ : Type} : has_bind (faction σ) :=
{ bind := @faction.bind σ }

lemma faction.bind_apply {σ α β : Type} (f : faction σ α) (g : α → faction σ β)
    (s : σ) :
  (f >>= g) s = (f s >>= (λas, g (prod.fst as) (prod.snd as))) :=
by refl

def faction.pure {σ α : Type} (a : α) : faction σ α :=
sorry

/-! We set up the syntax for `pure` on `faction`: -/

@[instance] def faction.has_pure {σ : Type} : has_pure (faction σ) :=
{ pure := @faction.pure σ }

lemma faction.pure_apply {σ α : Type} (a : α) (s : σ) :
  (pure a : faction σ α) s = option.some (a, s) :=
by refl

/-! 1.3. Register `faction` as a monad.

Hints:

* The `funext` lemma is useful when you need to prove equality between two
  functions.

* `cases f s` only works when `f s` appears in your goal, so you may need to
  unfold some constants before you can invoke `cases`. -/

@[instance] def faction.lawful_monad {σ : Type} : lawful_monad (faction σ) :=
{ pure_bind  :=
    begin
      intros α β a f,
      apply funext,
      intro s,
      refl
    end,
  bind_pure  :=
    sorry,
  bind_assoc :=
    sorry,
  .. faction.has_bind,
  .. faction.has_pure }

/-! ## Question 2: Kleisli Operator

The Kleisli operator `>=>` (not to be confused with `>>=`) is useful for
pipelining monadic operations. Note that `λa, f a >>= g` is to be parsed as
`λa, (f a >>= g)`, not as `(λa, f a) >>= g`. -/

def kleisli {m : Type → Type} [lawful_monad m] {α β γ : Type} (f : α → m β)
  (g : β → m γ) : α → m γ :=
λa, f a >>= g

infixr ` >=> ` : 90 := kleisli

/-! 2.1. Prove that `pure` is a left and right unit for the Kleisli operator. -/

lemma pure_kleisli {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (pure >=> f) = f :=
sorry

lemma kleisli_pure {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (f >=> pure) = f :=
sorry

/-! 2.2. Prove associativity of the Kleisli operator. -/

lemma kleisli_assoc {m : Type → Type} [lawful_monad m] {α β γ δ : Type}
    (f : α → m β) (g : β → m γ) (h : γ → m δ) :
  ((f >=> g) >=> h) = (f >=> (g >=> h)) :=
sorry

end LoVe


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

Finite types.
-/
import data.finset algebra.big_operators data.array.lemmas data.vector2 data.equiv.encodable
universes u v

variables {α : Type*} {β : Type*} {γ : Type*}

/-- `fintype α` means that `α` is finite, i.e. there are only
  finitely many distinct elements of type `α`. The evidence of this
  is a finset `elems` (a list up to permutation without duplicates),
  together with a proof that everything of type `α` is in the list. -/
class fintype (α : Type*) :=
(elems : finset α)
(complete : ∀ x : α, x ∈ elems)

namespace finset
variable [fintype α]

/-- `univ` is the universal finite set of type `finset α` implied from
  the assumption `fintype α`. -/
def univ : finset α := fintype.elems α

@[simp] theorem mem_univ (x : α) : x ∈ (univ : finset α) :=
fintype.complete x

@[simp] theorem mem_univ_val : ∀ x, x ∈ (univ : finset α).1 := mem_univ

@[simp] lemma coe_univ : ↑(univ : finset α) = (set.univ : set α) :=
by ext; simp

theorem subset_univ (s : finset α) : s ⊆ univ := λ a _, mem_univ a

theorem eq_univ_iff_forall {s : finset α} : s = univ ↔ ∀ x, x ∈ s :=
by simp [ext]

end finset

open finset function

namespace fintype

instance decidable_pi_fintype {α} {β : α → Type*} [fintype α] [∀a, decidable_eq (β a)] :
  decidable_eq (Πa, β a) :=
assume f g, decidable_of_iff (∀ a ∈ fintype.elems α, f a = g a)
  (by simp [function.funext_iff, fintype.complete])

instance decidable_forall_fintype [fintype α] {p : α → Prop} [decidable_pred p] :
  decidable (∀ a, p a) :=
decidable_of_iff (∀ a ∈ @univ α _, p a) (by simp)

instance decidable_exists_fintype [fintype α] {p : α → Prop} [decidable_pred p] :
  decidable (∃ a, p a) :=
decidable_of_iff (∃ a ∈ @univ α _, p a) (by simp)

instance decidable_eq_equiv_fintype [fintype α] [decidable_eq β] :
  decidable_eq (α ≃ β) :=
λ a b, decidable_of_iff (a.1 = b.1) ⟨λ h, equiv.ext _ _ (congr_fun h), congr_arg _⟩

instance decidable_injective_fintype [fintype α] [decidable_eq α] [decidable_eq β] :
  decidable_pred (injective : (α → β) → Prop) := λ x, by unfold injective; apply_instance

instance decidable_surjective_fintype [fintype α] [decidable_eq α] [fintype β] [decidable_eq β] :
  decidable_pred (surjective : (α → β) → Prop) := λ x, by unfold surjective; apply_instance

instance decidable_bijective_fintype [fintype α] [decidable_eq α] [fintype β] [decidable_eq β] :
  decidable_pred (bijective : (α → β) → Prop) := λ x, by unfold bijective; apply_instance

instance decidable_left_inverse_fintype [fintype α] [decidable_eq α] (f : α → β) (g : β → α) :
  decidable (function.right_inverse f g) :=
show decidable (∀ x, g (f x) = x), by apply_instance

instance decidable_right_inverse_fintype [fintype β] [decidable_eq β] (f : α → β) (g : β → α) :
  decidable (function.left_inverse f g) :=
show decidable (∀ x, f (g x) = x), by apply_instance

/-- Construct a proof of `fintype α` from a universal multiset -/
def of_multiset [decidable_eq α] (s : multiset α)
  (H : ∀ x : α, x ∈ s) : fintype α :=
⟨s.to_finset, by simpa using H⟩

/-- Construct a proof of `fintype α` from a universal list -/
def of_list [decidable_eq α] (l : list α)
  (H : ∀ x : α, x ∈ l) : fintype α :=
⟨l.to_finset, by simpa using H⟩

theorem exists_univ_list (α) [fintype α] :
  ∃ l : list α, l.nodup ∧ ∀ x : α, x ∈ l :=
let ⟨l, e⟩ := quotient.exists_rep (@univ α _).1 in
by have := and.intro univ.2 mem_univ_val;
   exact ⟨_, by rwa ← e at this⟩

/-- `card α` is the number of elements in `α`, defined when `α` is a fintype. -/
def card (α) [fintype α] : ℕ := (@univ α _).card

/-- There is (computably) a bijection between `α` and `fin n` where
  `n = card α`. Since it is not unique, and depends on which permutation
  of the universe list is used, the bijection is wrapped in `trunc` to
  preserve computability.  -/
def equiv_fin (α) [fintype α] [decidable_eq α] : trunc (α ≃ fin (card α)) :=
by unfold card finset.card; exact
quot.rec_on_subsingleton (@univ α _).1
  (λ l (h : ∀ x:α, x ∈ l) (nd : l.nodup), trunc.mk
   ⟨λ a, ⟨_, list.index_of_lt_length.2 (h a)⟩,
    λ i, l.nth_le i.1 i.2,
    λ a, by simp,
    λ ⟨i, h⟩, fin.eq_of_veq $ list.nodup_iff_nth_le_inj.1 nd _ _
      (list.index_of_lt_length.2 (list.nth_le_mem _ _ _)) h $ by simp⟩)
  mem_univ_val univ.2

theorem exists_equiv_fin (α) [fintype α] : ∃ n, nonempty (α ≃ fin n) :=
by haveI := classical.dec_eq α; exact ⟨card α, nonempty_of_trunc (equiv_fin α)⟩

instance (α : Type*) : subsingleton (fintype α) :=
⟨λ ⟨s₁, h₁⟩ ⟨s₂, h₂⟩, by congr; simp [finset.ext, h₁, h₂]⟩

protected def subtype {p : α → Prop} (s : finset α)
  (H : ∀ x : α, x ∈ s ↔ p x) : fintype {x // p x} :=
⟨⟨multiset.pmap subtype.mk s.1 (λ x, (H x).1),
  multiset.nodup_pmap (λ a _ b _, congr_arg subtype.val) s.2⟩,
λ ⟨x, px⟩, multiset.mem_pmap.2 ⟨x, (H x).2 px, rfl⟩⟩

theorem subtype_card {p : α → Prop} (s : finset α)
  (H : ∀ x : α, x ∈ s ↔ p x) :
  @card {x // p x} (fintype.subtype s H) = s.card :=
multiset.card_pmap _ _ _

theorem card_of_subtype {p : α → Prop} (s : finset α)
  (H : ∀ x : α, x ∈ s ↔ p x) [fintype {x // p x}] :
  card {x // p x} = s.card :=
by rw ← subtype_card s H; congr

/-- If `f : α → β` is a bijection and `α` is a fintype, then `β` is also a fintype. -/
def of_bijective [fintype α] (f : α → β) (H : function.bijective f) : fintype β :=
⟨univ.map ⟨f, H.1⟩,
λ b, let ⟨a, e⟩ := H.2 b in e ▸ mem_map_of_mem _ (mem_univ _)⟩

/-- If `f : α → β` is a surjection and `α` is a fintype, then `β` is also a fintype. -/
def of_surjective [fintype α] [decidable_eq β] (f : α → β) (H : function.surjective f) : fintype β :=
⟨univ.image f, λ b, let ⟨a, e⟩ := H b in e ▸ mem_image_of_mem _ (mem_univ _)⟩

noncomputable def of_injective [fintype β] (f : α → β) (H : function.injective f) : fintype α :=
by letI := classical.dec; exact
if hα : nonempty α then by letI := classical.inhabited_of_nonempty hα;
  exact of_surjective (inv_fun f) (inv_fun_surjective H)
else ⟨∅, λ x, (hα ⟨x⟩).elim⟩

/-- If `f : α ≃ β` and `α` is a fintype, then `β` is also a fintype. -/
def of_equiv (α : Type*) [fintype α] (f : α ≃ β) : fintype β := of_bijective _ f.bijective

theorem of_equiv_card [fintype α] (f : α ≃ β) :
  @card β (of_equiv α f) = card α :=
multiset.card_map _ _

theorem card_congr {α β} [fintype α] [fintype β] (f : α ≃ β) : card α = card β :=
by rw ← of_equiv_card f; congr

theorem card_eq {α β} [F : fintype α] [G : fintype β] : card α = card β ↔ nonempty (α ≃ β) :=
⟨λ e, match F, G, e with ⟨⟨s, nd⟩, h⟩, ⟨⟨s', nd'⟩, h'⟩, e' := begin
  change multiset.card s = multiset.card s' at e',
  revert nd nd' h h' e',
  refine quotient.induction_on₂ s s' (λ l₁ l₂
    (nd₁ : l₁.nodup) (nd₂ : l₂.nodup)
    (h₁ : ∀ x, x ∈ l₁) (h₂ : ∀ x, x ∈ l₂)
    (e' : l₁.length = l₂.length), _),
  haveI := classical.dec_eq α,
  refine ⟨equiv.of_bijective ⟨_, _⟩⟩,
  { refine λ a, l₂.nth_le (l₁.index_of a) _,
    rw ← e', exact list.index_of_lt_length.2 (h₁ a) },
  { intros a b h, simpa [h₁] using congr_arg l₁.nth
      (list.nodup_iff_nth_le_inj.1 nd₂ _ _ _ _ h) },
  { have := classical.dec_eq β,
    refine λ b, ⟨l₁.nth_le (l₂.index_of b) _, _⟩,
    { rw e', exact list.index_of_lt_length.2 (h₂ b) },
    { simp [nd₁] } }
end end, λ ⟨f⟩, card_congr f⟩

def of_subsingleton (a : α) [subsingleton α] : fintype α :=
⟨finset.singleton a, λ b, finset.mem_singleton.2 (subsingleton.elim _ _)⟩

@[simp] theorem fintype.univ_of_subsingleton (a : α) [subsingleton α] :
  @univ _ (of_subsingleton a) = finset.singleton a := rfl

@[simp] theorem fintype.card_of_subsingleton (a : α) [subsingleton α] :
  @fintype.card _ (of_subsingleton a) = 1 := rfl

end fintype

lemma finset.card_univ [fintype α] : (finset.univ : finset α).card = fintype.card α :=
rfl

lemma finset.card_univ_diff [fintype α] [decidable_eq α] (s : finset α) :
  (finset.univ \ s).card = fintype.card α - s.card :=
finset.card_sdiff (subset_univ s)

instance (n : ℕ) : fintype (fin n) :=
⟨⟨list.pmap fin.mk (list.range n) (λ a, list.mem_range.1),
  list.nodup_pmap (λ a _ b _, congr_arg fin.val) (list.nodup_range _)⟩,
λ ⟨m, h⟩, list.mem_pmap.2 ⟨m, list.mem_range.2 h, rfl⟩⟩

@[simp] theorem fintype.card_fin (n : ℕ) : fintype.card (fin n) = n :=
by rw [fin.fintype]; simp [fintype.card, card, univ]

instance : fintype empty := ⟨∅, empty.rec _⟩

@[simp] theorem fintype.univ_empty : @univ empty _ = ∅ := rfl

@[simp] theorem fintype.card_empty : fintype.card empty = 0 := rfl

instance : fintype pempty := ⟨∅, pempty.rec _⟩

@[simp] theorem fintype.univ_pempty : @univ pempty _ = ∅ := rfl

@[simp] theorem fintype.card_pempty : fintype.card pempty = 0 := rfl

instance : fintype unit := fintype.of_subsingleton ()

@[simp] theorem fintype.univ_unit : @univ unit _ = {()} := rfl

@[simp] theorem fintype.card_unit : fintype.card unit = 1 := rfl

instance : fintype punit := fintype.of_subsingleton punit.star

@[simp] theorem fintype.univ_punit : @univ punit _ = {punit.star} := rfl

@[simp] theorem fintype.card_punit : fintype.card punit = 1 := rfl

instance : fintype bool := ⟨⟨tt::ff::0, by simp⟩, λ x, by cases x; simp⟩

@[simp] theorem fintype.univ_bool : @univ bool _ = {ff, tt} := rfl

instance units_int.fintype : fintype (units ℤ) :=
⟨{1, -1}, λ x, by cases int.units_eq_one_or x; simp *⟩

instance additive.fintype : Π [fintype α], fintype (additive α) := id

instance multiplicative.fintype : Π [fintype α], fintype (multiplicative α) := id

@[simp] theorem fintype.card_units_int : fintype.card (units ℤ) = 2 := rfl

@[simp] theorem fintype.card_bool : fintype.card bool = 2 := rfl

def finset.insert_none (s : finset α) : finset (option α) :=
⟨none :: s.1.map some, multiset.nodup_cons.2
  ⟨by simp, multiset.nodup_map (λ a b, option.some.inj) s.2⟩⟩

@[simp] theorem finset.mem_insert_none {s : finset α} : ∀ {o : option α},
  o ∈ s.insert_none ↔ ∀ a ∈ o, a ∈ s
| none     := iff_of_true (multiset.mem_cons_self _ _) (λ a h, by cases h)
| (some a) := multiset.mem_cons.trans $ by simp; refl

theorem finset.some_mem_insert_none {s : finset α} {a : α} :
  some a ∈ s.insert_none ↔ a ∈ s := by simp

instance {α : Type*} [fintype α] : fintype (option α) :=
⟨univ.insert_none, λ a, by simp⟩

@[simp] theorem fintype.card_option {α : Type*} [fintype α] :
  fintype.card (option α) = fintype.card α + 1 :=
(multiset.card_cons _ _).trans (by rw multiset.card_map; refl)

instance {α : Type*} (β : α → Type*)
  [fintype α] [∀ a, fintype (β a)] : fintype (sigma β) :=
⟨univ.sigma (λ _, univ), λ ⟨a, b⟩, by simp⟩

@[simp] theorem fintype.card_sigma {α : Type*} (β : α → Type*)
  [fintype α] [∀ a, fintype (β a)] :
  fintype.card (sigma β) = univ.sum (λ a, fintype.card (β a)) :=
card_sigma _ _

instance (α β : Type*) [fintype α] [fintype β] : fintype (α × β) :=
⟨univ.product univ, λ ⟨a, b⟩, by simp⟩

@[simp] theorem fintype.card_prod (α β : Type*) [fintype α] [fintype β] :
  fintype.card (α × β) = fintype.card α * fintype.card β :=
card_product _ _

def fintype.fintype_prod_left {α β} [decidable_eq α] [fintype (α × β)] [nonempty β] : fintype α :=
⟨(fintype.elems (α × β)).image prod.fst,
  assume a, let ⟨b⟩ := ‹nonempty β› in by simp; exact ⟨b, fintype.complete _⟩⟩

def fintype.fintype_prod_right {α β} [decidable_eq β] [fintype (α × β)] [nonempty α] : fintype β :=
⟨(fintype.elems (α × β)).image prod.snd,
  assume b, let ⟨a⟩ := ‹nonempty α› in by simp; exact ⟨a, fintype.complete _⟩⟩

instance (α : Type*) [fintype α] : fintype (ulift α) :=
fintype.of_equiv _ equiv.ulift.symm

@[simp] theorem fintype.card_ulift (α : Type*) [fintype α] :
  fintype.card (ulift α) = fintype.card α :=
fintype.of_equiv_card _

instance (α : Type u) (β : Type v) [fintype α] [fintype β] : fintype (α ⊕ β) :=
@fintype.of_equiv _ _ (@sigma.fintype _
    (λ b, cond b (ulift α) (ulift.{(max u v) v} β)) _
    (λ b, by cases b; apply ulift.fintype))
  ((equiv.sum_equiv_sigma_bool _ _).symm.trans
    (equiv.sum_congr equiv.ulift equiv.ulift))

@[simp] theorem fintype.card_sum (α β : Type*) [fintype α] [fintype β] :
  fintype.card (α ⊕ β) = fintype.card α + fintype.card β :=
by rw [sum.fintype, fintype.of_equiv_card]; simp

lemma fintype.card_le_of_injective [fintype α] [fintype β] (f : α → β)
  (hf : function.injective f) : fintype.card α ≤ fintype.card β :=
by haveI := classical.prop_decidable; exact
finset.card_le_card_of_inj_on f (λ _ _, finset.mem_univ _) (λ _ _ _ _ h, hf h)

lemma fintype.card_eq_one_iff [fintype α] : fintype.card α = 1 ↔ (∃ x : α, ∀ y, y = x) :=
by rw [← fintype.card_unit, fintype.card_eq]; exact
⟨λ ⟨a⟩, ⟨a.symm (), λ y, a.injective (subsingleton.elim _ _)⟩,
  λ ⟨x, hx⟩, ⟨⟨λ _, (), λ _, x, λ _, (hx _).trans (hx _).symm,
    λ _, subsingleton.elim _ _⟩⟩⟩

lemma fintype.card_eq_zero_iff [fintype α] : fintype.card α = 0 ↔ (α → false) :=
⟨λ h a, have e : α ≃ empty := classical.choice (fintype.card_eq.1 (by simp [h])), (e a).elim,
  λ h, have e : α ≃ empty := ⟨λ a, (h a).elim, λ a, a.elim, λ a, (h a).elim, λ a, a.elim⟩,
    by simp [fintype.card_congr e]⟩

lemma fintype.card_pos_iff [fintype α] : 0 < fintype.card α ↔ nonempty α :=
⟨λ h, classical.by_contradiction (λ h₁,
  have fintype.card α = 0 := fintype.card_eq_zero_iff.2 (λ a, h₁ ⟨a⟩),
  lt_irrefl 0 $ by rwa this at h),
λ ⟨a⟩, nat.pos_of_ne_zero (mt fintype.card_eq_zero_iff.1 (λ h, h a))⟩

lemma fintype.card_le_one_iff [fintype α] : fintype.card α ≤ 1 ↔ (∀ a b : α, a = b) :=
let n := fintype.card α in
have hn : n = fintype.card α := rfl,
match n, hn with
| 0 := λ ha, ⟨λ h, λ a, (fintype.card_eq_zero_iff.1 ha.symm a).elim, λ _, ha ▸ nat.le_succ _⟩
| 1 := λ ha, ⟨λ h, λ a b, let ⟨x, hx⟩ := fintype.card_eq_one_iff.1 ha.symm in
  by rw [hx a, hx b],
    λ _, ha ▸ le_refl _⟩
| (n+2) := λ ha, ⟨λ h, by rw ← ha at h; exact absurd h dec_trivial,
  (λ h, fintype.card_unit ▸ fintype.card_le_of_injective (λ _, ())
    (λ _ _ _, h _ _))⟩
end

lemma fintype.exists_ne_of_card_gt_one [fintype α] (h : fintype.card α > 1) (a : α) :
  ∃ b : α, b ≠ a :=
let ⟨b, hb⟩ := classical.not_forall.1 (mt fintype.card_le_one_iff.2 (not_le_of_gt h)) in
let ⟨c, hc⟩ := classical.not_forall.1 hb in
by haveI := classical.dec_eq α; exact
if hba : b = a then ⟨c, by cc⟩ else ⟨b, hba⟩

lemma fintype.injective_iff_surjective [fintype α] {f : α → α} : injective f ↔ surjective f :=
by haveI := classical.prop_decidable; exact
have ∀ {f : α → α}, injective f → surjective f,
from λ f hinj x,
  have h₁ : image f univ = univ := eq_of_subset_of_card_le (subset_univ _)
    ((card_image_of_injective univ hinj).symm ▸ le_refl _),
  have h₂ : x ∈ image f univ := h₁.symm ▸ mem_univ _,
  exists_of_bex (mem_image.1 h₂),
⟨this,
  λ hsurj, injective_of_has_left_inverse
    ⟨surj_inv hsurj, left_inverse_of_surjective_of_right_inverse
      (this (injective_surj_inv _)) (right_inverse_surj_inv _)⟩⟩

lemma fintype.injective_iff_bijective [fintype α] {f : α → α} : injective f ↔ bijective f :=
by simp [bijective, fintype.injective_iff_surjective]

lemma fintype.surjective_iff_bijective [fintype α] {f : α → α} : surjective f ↔ bijective f :=
by simp [bijective, fintype.injective_iff_surjective]

lemma fintype.injective_iff_surjective_of_equiv [fintype α] {f : α → β} (e : α ≃ β) :
  injective f ↔ surjective f :=
have injective (e.symm ∘ f) ↔ surjective (e.symm ∘ f), from fintype.injective_iff_surjective,
⟨λ hinj, by simpa [function.comp] using
  surjective_comp e.surjective (this.1 (injective_comp e.symm.injective hinj)),
λ hsurj, by simpa [function.comp] using
  injective_comp e.injective (this.2 (surjective_comp e.symm.surjective hsurj))⟩

instance list.subtype.fintype [decidable_eq α] (l : list α) : fintype {x // x ∈ l} :=
fintype.of_list l.attach l.mem_attach

instance multiset.subtype.fintype [decidable_eq α] (s : multiset α) : fintype {x // x ∈ s} :=
fintype.of_multiset s.attach s.mem_attach

instance finset.subtype.fintype (s : finset α) : fintype {x // x ∈ s} :=
⟨s.attach, s.mem_attach⟩

instance finset_coe.fintype (s : finset α) : fintype (↑s : set α) :=
finset.subtype.fintype s

@[simp] lemma fintype.card_coe (s : finset α) :
  fintype.card (↑s : set α) = s.card := card_attach

instance plift.fintype (p : Prop) [decidable p] : fintype (plift p) :=
⟨if h : p then finset.singleton ⟨h⟩ else ∅, λ ⟨h⟩, by simp [h]⟩

instance Prop.fintype : fintype Prop :=
⟨⟨true::false::0, by simp [true_ne_false]⟩,
 classical.cases (by simp) (by simp)⟩

def set_fintype {α} [fintype α] (s : set α) [decidable_pred s] : fintype s :=
fintype.subtype (univ.filter (∈ s)) (by simp)

instance pi.fintype {α : Type*} {β : α → Type*}
  [fintype α] [decidable_eq α] [∀a, fintype (β a)] : fintype (Πa, β a) :=
@fintype.of_equiv _ _
  ⟨univ.pi $ λa:α, @univ (β a) _,
    λ f, finset.mem_pi.2 $ λ a ha, mem_univ _⟩
  ⟨λ f a, f a (mem_univ _), λ f a _, f a, λ f, rfl, λ f, rfl⟩

@[simp] lemma fintype.card_pi {β : α → Type*} [fintype α] [decidable_eq α]
  [f : Π a, fintype (β a)] : fintype.card (Π a, β a) = univ.prod (λ a, fintype.card (β a)) :=
by letI f' : fintype (Πa∈univ, β a) :=
  ⟨(univ.pi $ λa, univ), assume f, finset.mem_pi.2 $ assume a ha, mem_univ _⟩;
exact calc fintype.card (Π a, β a) = fintype.card (Π a ∈ univ, β a) : fintype.card_congr
  ⟨λ f a ha, f a, λ f a, f a (mem_univ a), λ _, rfl, λ _, rfl⟩
... = univ.prod (λ a, fintype.card (β a)) : finset.card_pi _ _

@[simp] lemma fintype.card_fun [fintype α] [decidable_eq α] [fintype β] :
  fintype.card (α → β) = fintype.card β ^ fintype.card α :=
by rw [fintype.card_pi, finset.prod_const, nat.pow_eq_pow]; refl

instance d_array.fintype {n : ℕ} {α : fin n → Type*}
  [∀n, fintype (α n)] : fintype (d_array n α) :=
fintype.of_equiv _ (equiv.d_array_equiv_fin _).symm

instance array.fintype {n : ℕ} {α : Type*} [fintype α] : fintype (array n α) :=
d_array.fintype

instance vector.fintype {α : Type*} [fintype α] {n : ℕ} : fintype (vector α n) :=
fintype.of_equiv _ (equiv.vector_equiv_fin _ _).symm

@[simp] lemma card_vector [fintype α] (n : ℕ) :
  fintype.card (vector α n) = fintype.card α ^ n :=
by rw fintype.of_equiv_card; simp

instance quotient.fintype [fintype α] (s : setoid α)
  [decidable_rel ((≈) : α → α → Prop)] : fintype (quotient s) :=
fintype.of_surjective quotient.mk (λ x, quotient.induction_on x (λ x, ⟨x, rfl⟩))

instance finset.fintype [fintype α] : fintype (finset α) :=
⟨univ.powerset, λ x, finset.mem_powerset.2 (finset.subset_univ _)⟩

instance subtype.fintype [fintype α] (p : α → Prop) [decidable_pred p] : fintype {x // p x} :=
set_fintype _

instance set.fintype [fintype α] [decidable_eq α] : fintype (set α) :=
pi.fintype

instance pfun_fintype (p : Prop) [decidable p] (α : p → Type*)
  [Π hp, fintype (α hp)] : fintype (Π hp : p, α hp) :=
if hp : p then fintype.of_equiv (α hp) ⟨λ a _, a, λ f, f hp, λ _, rfl, λ _, rfl⟩
          else ⟨singleton (λ h, (hp h).elim), by simp [hp, function.funext_iff]⟩

def quotient.fin_choice_aux {ι : Type*} [decidable_eq ι]
  {α : ι → Type*} [S : ∀ i, setoid (α i)] :
  ∀ (l : list ι), (∀ i ∈ l, quotient (S i)) → @quotient (Π i ∈ l, α i) (by apply_instance)
| []     f := ⟦λ i, false.elim⟧
| (i::l) f := begin
  refine quotient.lift_on₂ (f i (list.mem_cons_self _ _))
    (quotient.fin_choice_aux l (λ j h, f j (list.mem_cons_of_mem _ h)))
    _ _,
  exact λ a l, ⟦λ j h,
    if e : j = i then by rw e; exact a else
    l _ (h.resolve_left e)⟧,
  refine λ a₁ l₁ a₂ l₂ h₁ h₂, quotient.sound (λ j h, _),
  by_cases e : j = i; simp [e],
  { subst j, exact h₁ },
  { exact h₂ _ _ }
end

theorem quotient.fin_choice_aux_eq {ι : Type*} [decidable_eq ι]
  {α : ι → Type*} [S : ∀ i, setoid (α i)] :
  ∀ (l : list ι) (f : ∀ i ∈ l, α i), quotient.fin_choice_aux l (λ i h, ⟦f i h⟧) = ⟦f⟧
| []     f := quotient.sound (λ i h, h.elim)
| (i::l) f := begin
  simp [quotient.fin_choice_aux, quotient.fin_choice_aux_eq l],
  refine quotient.sound (λ j h, _),
  by_cases e : j = i; simp [e],
  subst j, refl
end

def quotient.fin_choice {ι : Type*} [fintype ι] [decidable_eq ι]
  {α : ι → Type*} [S : ∀ i, setoid (α i)]
  (f : ∀ i, quotient (S i)) : @quotient (Π i, α i) (by apply_instance) :=
quotient.lift_on (@quotient.rec_on _ _ (λ l : multiset ι,
    @quotient (Π i ∈ l, α i) (by apply_instance))
    finset.univ.1
    (λ l, quotient.fin_choice_aux l (λ i _, f i))
    (λ a b h, begin
      have := λ a, quotient.fin_choice_aux_eq a (λ i h, quotient.out (f i)),
      simp [quotient.out_eq] at this,
      simp [this],
      let g := λ a:multiset ι, ⟦λ (i : ι) (h : i ∈ a), quotient.out (f i)⟧,
      refine eq_of_heq ((eq_rec_heq _ _).trans (_ : g a == g b)),
      congr' 1, exact quotient.sound h,
    end))
  (λ f, ⟦λ i, f i (finset.mem_univ _)⟧)
  (λ a b h, quotient.sound $ λ i, h _ _)

theorem quotient.fin_choice_eq {ι : Type*} [fintype ι] [decidable_eq ι]
  {α : ι → Type*} [∀ i, setoid (α i)]
  (f : ∀ i, α i) : quotient.fin_choice (λ i, ⟦f i⟧) = ⟦f⟧ :=
begin
  let q, swap, change quotient.lift_on q _ _ = _,
  have : q = ⟦λ i h, f i⟧,
  { dsimp [q],
    exact quotient.induction_on
      (@finset.univ ι _).1 (λ l, quotient.fin_choice_aux_eq _ _) },
  simp [this], exact setoid.refl _
end

@[simp, to_additive finset.sum_attach_univ]
lemma finset.prod_attach_univ [fintype α] [comm_monoid β] (f : {a : α // a ∈ @univ α _} → β) :
  univ.attach.prod (λ x, f x) = univ.prod (λ x, f ⟨x, (mem_univ _)⟩) :=
prod_bij (λ x _, x.1) (λ _ _, mem_univ _) (λ _ _ , by simp) (by simp) (λ b _, ⟨⟨b, mem_univ _⟩, by simp⟩)

section equiv

open list equiv equiv.perm

variables [decidable_eq α] [decidable_eq β]

def perms_of_list : list α → list (perm α)
| []       := [1]
| (a :: l) := perms_of_list l ++ l.bind (λ b, (perms_of_list l).map (λ f, swap a b * f))

lemma length_perms_of_list : ∀ l : list α, length (perms_of_list l) = l.length.fact
| []       := rfl
| (a :: l) := by rw [length_cons, nat.fact_succ];
  simp [perms_of_list, length_bind, length_perms_of_list, function.comp, nat.succ_mul]

lemma mem_perms_of_list_of_mem : ∀ {l : list α} {f : perm α} (h : ∀ x, f x ≠ x → x ∈ l), f ∈ perms_of_list l
| []     f h := list.mem_singleton.2 $ equiv.ext _ _$ λ x, by simp [imp_false, *] at *
| (a::l) f h :=
if hfa : f a = a
then
  mem_append_left _ $ mem_perms_of_list_of_mem
    (λ x hx, mem_of_ne_of_mem (λ h, by rw h at hx; exact hx hfa) (h x hx))
else
have hfa' : f (f a) ≠ f a, from mt (λ h, f.injective h) hfa,
have ∀ (x : α), (swap a (f a) * f) x ≠ x → x ∈ l,
  from λ x hx, have hxa : x ≠ a, from λ h, by simpa [h, mul_apply] using hx,
    have hfxa : f x ≠ f a, from mt (λ h, f.injective h) hxa,
    list.mem_of_ne_of_mem hxa
      (h x (λ h, by simp [h, mul_apply, swap_apply_def] at hx; split_ifs at hx; cc)),
suffices f ∈ perms_of_list l ∨ ∃ (b : α), b ∈ l ∧ ∃ g : perm α, g ∈ perms_of_list l ∧ swap a b * g = f,
  by simpa [perms_of_list],
(@or_iff_not_imp_left _ _ (classical.prop_decidable _)).2
  (λ hfl, ⟨f a,
    if hffa : f (f a) = a then mem_of_ne_of_mem hfa (h _ (mt (λ h, f.injective h) hfa))
      else this _ $ by simp [mul_apply, swap_apply_def]; split_ifs; cc,
    ⟨swap a (f a) * f, mem_perms_of_list_of_mem this,
      by rw [← mul_assoc, mul_def (swap a (f a)) (swap a (f a)), swap_swap, ← equiv.perm.one_def, one_mul]⟩⟩)

lemma mem_of_mem_perms_of_list : ∀ {l : list α} {f : perm α}, f ∈ perms_of_list l → ∀ {x}, f x ≠ x → x ∈ l
| []     f h := have f = 1 := by simpa [perms_of_list] using h, by rw this; simp
| (a::l) f h :=
(mem_append.1 h).elim
  (λ h x hx, mem_cons_of_mem _ (mem_of_mem_perms_of_list h hx))
  (λ h x hx,
    let ⟨y, hy, hy'⟩ := list.mem_bind.1 h in
    let ⟨g, hg₁, hg₂⟩ := list.mem_map.1 hy' in
    if hxa : x = a then by simp [hxa]
    else if hxy : x = y then mem_cons_of_mem _ $ by rwa hxy
    else mem_cons_of_mem _ $
    mem_of_mem_perms_of_list hg₁ $
      by rw [eq_inv_mul_iff_mul_eq.2 hg₂, mul_apply, swap_inv, swap_apply_def];
        split_ifs; cc)

lemma mem_perms_of_list_iff {l : list α} {f : perm α} : f ∈ perms_of_list l ↔ ∀ {x}, f x ≠ x → x ∈ l :=
⟨mem_of_mem_perms_of_list, mem_perms_of_list_of_mem⟩

lemma nodup_perms_of_list : ∀ {l : list α} (hl : l.nodup), (perms_of_list l).nodup
| []     hl := by simp [perms_of_list]
| (a::l) hl :=
have hl' : l.nodup, from nodup_of_nodup_cons hl,
have hln' : (perms_of_list l).nodup, from nodup_perms_of_list hl',
have hmeml : ∀ {f : perm α}, f ∈ perms_of_list l → f a = a,
  from λ f hf, not_not.1 (mt (mem_of_mem_perms_of_list hf) (nodup_cons.1 hl).1),
by rw [perms_of_list, list.nodup_append, list.nodup_bind, pairwise_iff_nth_le]; exact
⟨hln', ⟨λ _ _, nodup_map (λ _ _, (mul_left_inj _).1) hln',
  λ i j hj hij x hx₁ hx₂,
    let ⟨f, hf⟩ := list.mem_map.1 hx₁ in
    let ⟨g, hg⟩ := list.mem_map.1 hx₂ in
    have hix : x a = nth_le l i (lt_trans hij hj),
      by rw [← hf.2, mul_apply, hmeml hf.1, swap_apply_left],
    have hiy : x a = nth_le l j hj,
      by rw [← hg.2, mul_apply, hmeml hg.1, swap_apply_left],
    absurd (hf.2.trans (hg.2.symm)) $
      λ h, ne_of_lt hij $ nodup_iff_nth_le_inj.1 hl' i j (lt_trans hij hj) hj $
        by rw [← hix, hiy]⟩,
  λ f hf₁ hf₂,
    let ⟨x, hx, hx'⟩ := list.mem_bind.1 hf₂ in
    let ⟨g, hg⟩ := list.mem_map.1 hx' in
    have hgxa : g⁻¹ x = a, from f.injective $
      by rw [hmeml hf₁, ← hg.2]; simp,
    have hxa : x ≠ a, from λ h, (list.nodup_cons.1 hl).1 (h ▸ hx),
    (list.nodup_cons.1 hl).1 $
      hgxa ▸ mem_of_mem_perms_of_list hg.1 (by rwa [apply_inv_self, hgxa])⟩

def perms_of_finset (s : finset α) : finset (perm α) :=
quotient.hrec_on s.1 (λ l hl, ⟨perms_of_list l, nodup_perms_of_list hl⟩)
  (λ a b hab, hfunext (congr_arg _ (quotient.sound hab))
    (λ ha hb _, heq_of_eq $ finset.ext.2 $
      by simp [mem_perms_of_list_iff,mem_of_perm hab]))
  s.2

lemma mem_perms_of_finset_iff : ∀ {s : finset α} {f : perm α},
  f ∈ perms_of_finset s ↔ ∀ {x}, f x ≠ x → x ∈ s :=
by rintros ⟨⟨l⟩, hs⟩ f; exact mem_perms_of_list_iff

lemma card_perms_of_finset : ∀ (s : finset α),
  (perms_of_finset s).card = s.card.fact :=
by rintros ⟨⟨l⟩, hs⟩; exact length_perms_of_list l

def fintype_perm [fintype α] : fintype (perm α) :=
⟨perms_of_finset (@finset.univ α _), by simp [mem_perms_of_finset_iff]⟩

instance [fintype α] [fintype β] : fintype (α ≃ β) :=
if h : fintype.card β = fintype.card α
then trunc.rec_on_subsingleton (fintype.equiv_fin α)
  (λ eα, trunc.rec_on_subsingleton (fintype.equiv_fin β)
    (λ eβ, @fintype.of_equiv _ (perm α) fintype_perm
      (equiv_congr (equiv.refl α) (eα.trans (eq.rec_on h eβ.symm)) : (α ≃ α) ≃ (α ≃ β))))
else ⟨∅, λ x, false.elim (h (fintype.card_eq.2 ⟨x.symm⟩))⟩

lemma fintype.card_perm [fintype α] : fintype.card (perm α) = (fintype.card α).fact :=
subsingleton.elim (@fintype_perm α _ _) (@equiv.fintype α α _ _ _ _) ▸
card_perms_of_finset _

lemma fintype.card_equiv [fintype α] [fintype β] (e : α ≃ β) :
  fintype.card (α ≃ β) = (fintype.card α).fact :=
fintype.card_congr (equiv_congr (equiv.refl α) e) ▸ fintype.card_perm

end equiv

namespace fintype

section choose
open fintype
open equiv

variables [fintype α] [decidable_eq α] (p : α → Prop) [decidable_pred p]

def choose_x (hp : ∃! a : α, p a) : {a // p a} :=
⟨finset.choose p univ (by simp; exact hp), finset.choose_property _ _ _⟩

def choose (hp : ∃! a, p a) : α := choose_x p hp

lemma choose_spec (hp : ∃! a, p a) : p (choose p hp) :=
(choose_x p hp).property

end choose

section bijection_inverse
open function

variables [fintype α] [decidable_eq α]
variables [fintype β] [decidable_eq β]
variables {f : α → β}

/-- `
`bij_inv f` is the unique inverse to a bijection `f`. This acts
  as a computable alternative to `function.inv_fun`. -/
def bij_inv (f_bij : bijective f) (b : β) : α :=
fintype.choose (λ a, f a = b)
begin
  rcases f_bij.right b with ⟨a', fa_eq_b⟩,
  rw ← fa_eq_b,
  exact ⟨a', ⟨rfl, (λ a h, f_bij.left h)⟩⟩
end

lemma left_inverse_bij_inv (f_bij : bijective f) : left_inverse (bij_inv f_bij) f :=
λ a, f_bij.left (choose_spec (λ a', f a' = f a) _)

lemma right_inverse_bij_inv (f_bij : bijective f) : right_inverse (bij_inv f_bij) f :=
λ b, choose_spec (λ a', f a' = b) _

lemma bijective_bij_inv (f_bij : bijective f) : bijective (bij_inv f_bij) :=
⟨injective_of_left_inverse (right_inverse_bij_inv _),
    surjective_of_has_right_inverse ⟨f, left_inverse_bij_inv _⟩⟩

end bijection_inverse

end fintype


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-

Note that `X ≃ Y` is not an equivalence relation, for the stupid
reason that it's not even a true-false statement! It doesn't
say "there exists a bijection from X to Y" (which would be an
equivalence relation), it is the *type* of bijections between
`X` and `Y`, and in particular it can have more than one term
(indeed we just saw two distinct terms of type `ℚ ≃ ℚ` on the
previous sheet). However we can make some equivalence-relation-y
type constructions with `≃`. Here are definitions (not theorems!)
called `equiv.refl`, `equiv.symm` and `equiv.trans`.

-/

-- this is called `equiv.refl` in `mathlib`
example (X : Type) : X ≃ X :=
{ to_fun := λ x, x, -- x ↦ x
  inv_fun := λ y, y,-- y ↦ y
  left_inv := begin
    sorry,
  end,
  right_inv := begin
    sorry,
  end }

-- now let's see you define `equiv.symm` and `equiv.trans`.
-- Let's start with `equiv.symm`.
-- Note that if `e : X ≃ Y` then `e.to_fun : X → Y`
-- and `e.left_inv` is a proof of `∀ x : X, e.inv_fun (e.to_fun x) = x` etc

-- This is `equiv.symm`. Can you fill in the proofs?
example (X Y : Type) (e : X ≃ Y) : Y ≃ X :=
{ to_fun := e.inv_fun, -- you could write `λ x, e.inv_fun x` instead
  inv_fun := e.to_fun, -- this is data -- don't use tactic mode
  left_inv := begin
    sorry,
  end,
  right_inv := begin
    sorry,
  end }

-- Actually, you're not supposed to write `e.to_fun` and `e.inv_fun`
-- directly, because `X ≃ Y` has got a coercion to `X → Y`,
-- so you can (and should) do it like this:

-- `equiv.symm` again
example (X Y : Type) (e : X ≃ Y) : Y ≃ X :=
{ to_fun := e.symm, -- using `equiv.symm` and dot notation
  inv_fun := e, -- using the coercion to function
  left_inv := e.right_inv,
  right_inv := e.left_inv, }

-- `equiv.trans`
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
{ to_fun := λ x, eYZ (eXY x),
  inv_fun := λ z, eXY.symm (eYZ.symm z),
  left_inv := begin
    sorry,
  end,
  right_inv := begin
    sorry,
  end }

-- Because `equiv.trans` is already there, we can just use it
-- directly:
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
equiv.trans eXY eYZ

-- here it is again using dot notation
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
eXY.trans eYZ

-- See if you can make the following bijection using dot notation
example (A B C X : Type) (eAX : A ≃ X) (eBX : B ≃ X) : A ≃ B :=
sorry -- can you just make the term directly using `equiv.symm`
-- and `equiv.trans`?

/-

Note that `equiv` is *data* -- `X ≃ Y` doesn't say "`X` bijects with `Y`";
that statement is a true-false statement. A term of type `X ≃ Y`
is *explicit functions* `X → Y` and `Y → X`, together with proofs
that they're inverse bijections.

Clearly there's an equivalence relation going on *somewhere* though:
here it is.

If `X : Type` then `∃ x : X, true` is just the statement that `X`
is nonempty. It's a proposition. So this works:

-/

-- Two types `X` and `Y` satisfy `R X Y` iff there *exists*
-- a bijection `X ≃ Y`.
def R (X Y : Type) : Prop := ∃ e : X ≃ Y, true

example : equivalence R :=
begin
  sorry
end

-- Remark: the equivalence classes of `R` are called *cardinals*.


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

/-
Linear natural number arithmetic terms in pre-normalized form.
-/

import tactic.omega.term

open tactic

namespace omega
namespace nat

/-- The shadow syntax for arithmetic terms. All constants are reified to `cst`
(e.g., `5` is reified to `cst 5`) and all other atomic terms are reified to
`exp` (e.g., `5 * (list.length l)` is reified to `exp 5 \`(list.length l)`).
`exp` accepts a coefficient of type `nat` as its first argument because
multiplication by constant is allowed by the omega test. -/
meta inductive exprterm : Type
| cst : nat → exprterm
| exp : nat → expr → exprterm
| add : exprterm → exprterm → exprterm
| sub : exprterm → exprterm → exprterm

/-- Similar to `exprterm`, except that all exprs are now replaced with
de Brujin indices of type `nat`. This is akin to generalizing over
the terms represented by the said exprs. -/
@[derive has_reflect, derive decidable_eq, derive inhabited]
inductive preterm : Type
| cst : nat → preterm
| var : nat → nat → preterm
| add : preterm → preterm → preterm
| sub : preterm → preterm → preterm

localized "notation (name := preterm.cst) `&` k := omega.nat.preterm.cst k" in omega.nat
localized "infix (name := preterm.var) ` ** `:300 := omega.nat.preterm.var" in omega.nat
localized "notation (name := preterm.add) t ` +* ` s := omega.nat.preterm.add t s" in omega.nat
localized "notation (name := preterm.sub) t ` -* ` s := omega.nat.preterm.sub t s" in omega.nat

namespace preterm

/-- Helper tactic for proof by induction over preterms -/
meta def induce (tac : tactic unit := tactic.skip) : tactic unit :=
`[ intro t, induction t with m m n t s iht ihs t s iht ihs; tac]

/-- Preterm evaluation -/
def val (v : nat → nat) : preterm → nat
| (& i) := i
| (i ** n) :=
  if i = 1
  then v n
  else (v n) * i
| (t1 +* t2) := t1.val + t2.val
| (t1 -* t2) := t1.val - t2.val

@[simp] lemma val_const {v : nat → nat} {m : nat} :
  (& m).val v = m := rfl

@[simp] lemma val_var {v : nat → nat} {m n : nat} :
  (m ** n).val v = m * (v n) :=
begin
  simp only [val], by_cases h1 : m = 1,
  rw [if_pos h1, h1, one_mul],
  rw [if_neg h1, mul_comm],
end

@[simp] lemma val_add {v : nat → nat} {t s : preterm} :
  (t +* s).val v = t.val v + s.val v := rfl

@[simp] lemma val_sub {v : nat → nat} {t s : preterm} :
  (t -* s).val v = t.val v - s.val v := rfl

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preterm → nat
| (& _)      := 0
| (i ** n)   := n + 1
| (t1 +* t2) := max t1.fresh_index t2.fresh_index
| (t1 -* t2) := max t1.fresh_index t2.fresh_index

/-- If variable assignments `v` and `w` agree on all variables that occur
in term `t`, the value of `t` under `v` and `w` are identical. -/
lemma val_constant (v w : nat → nat) :
  ∀ t : preterm, (∀ x < t.fresh_index, v x = w x) →
  t.val v = t.val w
| (& n)      h1 := rfl
| (m ** n)   h1 :=
  begin
    simp only [val_var],
    apply congr_arg (λ y, m * y),
    apply h1 _ (lt_add_one _)
  end
| (t +* s) h1 :=
  begin
    simp only [val_add],
    have ht := val_constant t
      (λ x hx, h1 _ (lt_of_lt_of_le hx (le_max_left _ _))),
    have hs := val_constant s
      (λ x hx, h1 _ (lt_of_lt_of_le hx (le_max_right _ _))),
    rw [ht, hs]
  end
| (t -* s) h1 :=
  begin
    simp only [val_sub],
    have ht := val_constant t
      (λ x hx, h1 _ (lt_of_lt_of_le hx (le_max_left _ _))),
    have hs := val_constant s
      (λ x hx, h1 _ (lt_of_lt_of_le hx (le_max_right _ _))),
    rw [ht, hs]
  end

def repr : preterm → string
| (& i)      := i.repr
| (i ** n)   := i.repr ++ "*x" ++ n.repr
| (t1 +* t2) := "(" ++ t1.repr ++ " + " ++ t2.repr ++ ")"
| (t1 -* t2) := "(" ++ t1.repr ++ " - " ++ t2.repr ++ ")"

@[simp] def add_one (t : preterm) : preterm := t +* (&1)

/-- Preterm is free of subtractions -/
def sub_free : preterm → Prop
| (& m)    := true
| (m ** n) := true
| (t +* s) := t.sub_free ∧ s.sub_free
| (_ -* _) := false

end preterm

open_locale list.func -- get notation for list.func.set

/-- Return a term (which is in canonical form by definition)
    that is equivalent to the input preterm -/
@[simp] def canonize : preterm → term
| (& m)    := ⟨↑m, []⟩
| (m ** n) := ⟨0, [] {n ↦ ↑m}⟩
| (t +* s) := term.add (canonize t) (canonize s)
| (_ -* _) := ⟨0, []⟩

@[simp] lemma val_canonize {v : nat → nat} :
  ∀ {t : preterm}, t.sub_free →
  (canonize t).val (λ x, ↑(v x)) = t.val v
| (& i) h1 :=
  by simp only [canonize, preterm.val_const,
     term.val, coeffs.val_nil, add_zero]
| (i ** n) h1 :=
  by simp only [preterm.val_var, coeffs.val_set,
      term.val, zero_add, int.coe_nat_mul, canonize]
| (t +* s) h1 :=
  by simp only [val_canonize h1.left,
     val_canonize h1.right, int.coe_nat_add,
     canonize, term.val_add, preterm.val_add]

end nat

end omega


import data.real.sqrt
import tactic
import data.int.parity -- even and odd

lemma part_a : real.sqrt 6 - real.sqrt 2 > 1 :=
begin
  sorry
end

lemma part_b (n : ℤ) : even (n^2) → even n :=
begin
  sorry
end

lemma part_c (n : ℤ) (h : ∃ m : ℤ, n = m^3 - m) : 6 ∣ n :=
begin
  sorry
end


/- Homework 2.4: Functional Programming — Metaprogramming -/

open expr
open tactic
open declaration

/- Question 1: A `safe` tactic -/

/- We develop a tactic that applies all safe introduction and elimination rules for the connectives
and quantifiers exhaustively. A rule is said to be _safe_ if it always gives rise to provable
subgoals. In addition, we will require that safe rules do not introduce metavariables (which can
easily be instantiated accidentally with the wrong terms.) We proceed in three steps. -/

/- 1.1. Develop a `safe_intros` tactic that applies the introduction rules for `true', `¬`, `∧`,
`↔`, and `→`/`∀`. (Hint: You can use `tactic.intro` or `tactic.intro1` for some of these.) -/

meta def safe_intros : tactic unit :=
do
tactic.intros,
repeat (applyc `and.intro),
tactic.intro `a2,
repeat (applyc `iff.intro)

example {a b c d e f : Prop} {p : ℕ → Prop} : a → ¬ b ∧ (c ↔ d) :=
begin
  safe_intros,
  /- The proof state should be roughly as follows:

  a b c d e f : Prop,
  p : ℕ → Prop,
  a_1 : a,
  a_2 : b
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  a_1 : a,
  a_2 : c
  ⊢ d

  a b c d e f : Prop,
  p : ℕ → Prop,
  a_1 : a,
  a_2 : d
  ⊢ c -/
  repeat { sorry }
end

/- 1.2. Develop a `safe_destructs` tactic that eliminates `false`, `∧`, `∨`, `↔`, and `∃`. -/

meta def safe_destructs : tactic unit :=
(do
  hs ← local_context,
  h ← hs.mfirst (λh, do `(false ) ← infer_type h, pure h),
  cases h,
  safe_destructs,
  skip)
<|>
(do
  hs ← local_context,
  h ← hs.mfirst (λh, do `(_ ∧ _) ← infer_type h, pure h),
  cases h,
  safe_destructs,
  skip)
<|> (do hs ← local_context,
  h ← hs.mfirst (λh, do `(_ ∨ _) ← infer_type h, pure h),
  cases h,
  safe_destructs,
  skip)
<|> repeat(do hs ← local_context,
  h ← hs.mfirst (λh, do `(_ ↔ _) ← infer_type h, pure h),
  cases h,
  safe_destructs,
  skip)
<|> skip

example {a b c d e f : Prop} {p : ℕ → Prop}
  (hneg: ¬ a) (hand : a ∧ b ∧ c) (hor : c ∨ d) (himp : b → e) (hiff : e ↔ f) (hex : ∃x, p x) :
  false :=
begin
  safe_destructs,
  /- The proof state should be roughly as follows:

  2 goals
  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  hand_left : a,
  hor : d,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false -/
  repeat { sorry }
end

/- 1.3. Implement a `safe` tactic that first performs introduction, then elimination, and finally
proves all the subgoals that can be discharged directly by `assumption`.

Hint: The `try` tactic combinator might come in handy. -/

meta def safe : tactic unit :=
do
applyc (`safe_intros),
applyc (`safe_destructs),
assumption

example {a b c d e f : Prop} {p : ℕ → Prop}
(hneg: ¬ a) (hand : a ∧ b ∧ c) (hor : c ∨ d) (himp : b → e) (hiff : e ↔ f) (hex : ∃x, p x) :
  a → ¬ b ∧ (c ↔ d) :=
begin
  safe,
  /- The proof state should be roughly as follows:

  3 goals
  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : b,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : b,
  hand_left : a,
  hor : d,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : c,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ d -/
  repeat { sorry }
end

/- Question 2: A `solve_direct` advisor -/

/- It often happens that a user states a new lemma, proves it, and later realizes that the lemma
already exists in the library. To help prevent this, we want to implement a `solve_direct` tactic,
which goes through all lemmas in the database and checks whether one of them can be used to fully
solve the statement. We implement it in steps. -/

/- 2.1. Develop a function that returns `tt` if a `declaration` is a theorem (`declaration.thm`) or
an axiom (`declaration.ax`) and `ff` otherwise. -/

meta def is_theorem : declaration → bool
 | (declaration.thm s us ty body) := tt
 | (declaration.ax n us ty) := tt
 | otherwise := ff

/- 2.2. Develop a function that returns the list of all theorem names (theorem in the sense of
`is_theorem`).

Here `get_env` and `environment.fold` are very helpful. See also Question 3 of the exercise. -/

meta def get_all_theorems : tactic (list name) := do
 env ← get_env,
  opts ← get_options,
  environment.fold env [] $ λdecl lst,
  if term_contains_all ns decl.type then decl.to_name :: lst else lst
)
/- 2.3. Develop a tactic that (fully) solves the goal using a theorem `n`.

Hints:

* `mk_const n` can be used to produce an `expr` (representing the proof) from a name `n` (the
theorem name).

* `apply` applies an `expr` to the current goal. For speed reasons one might want to add the
c onfiguration `apply c { md := transparency.reducible, unify := ff }`, where `c : expr` is the
current theorem, and the parameters in `{ ... }` tell `apply` to apply less computational unfolding.

* `all_goals` in combination with `assumption` can be used to ensure that the hypothesis from the
local context are used to fill in all remaining subgoals.

* `done` can be used to check that no subgoal is left. -/

meta def solve (n : name) : tactic unit :=
sorry

/- 2.4. Implement `solve_direct`.

Now `solve_direct` should go through `get_all_theorems` and succeed with the first theorem solving
the current goal.

You can use `list.mfirst` to apply a tactic to each element of a list until one application
succeeds. Use `trace` to output the successful theorem to the user. -/

meta def solve_direct : tactic unit :=
sorry

/- 2.5. Develop a version of `solve_direct` that also looks for equalities stated in symmetric form
(e.g., if the goal is `l = r` but the theorem is `r = l`). -/

#check eq.symm

meta def solve_direct_symm : tactic unit :=
sorry

example {n : ℕ} : n + 0 = n := by solve_direct_symm
example {n : ℕ} : n = n + 0 := by solve_direct_symm

/- Question 3 **optional**: An `auto` tactic -/

/- 3.1. Develop an Isabelle-style `auto` tactic.

This tactic would apply all safe introduction and elimination rules. In addition, it would try
unsafe rules (such as `or.intro_left` and `false.elim`) but backtrack at some point
(or try several possibilities in parallel). Iterative deepening may be a valid approach, or
best-first search, or breadth-first search. The tactic should also attempt to apply assumptions
whose conclusion matches the goal, but backtrack if necessary.

See also "Automatic Proof and Disproof in Isabelle/HOL"
(https://www.cs.vu.nl/~jbe248/frocos2011-dis-proof.pdf) by Blanchette, Bulwahn, and Nipkow, and the
references they give. -/

/- 3.2. Test your tactic on some benchmarks.

You can try your tactic on logical puzzles of the kinds we proved in exercise 1.3 and howework 1.3.
Please include these below. -/


/-
Copyright (c) 2022 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import algebra.associated
import number_theory.divisors

/-!
# Prime powers

This file deals with prime powers: numbers which are positive integer powers of a single prime.
-/

variables {R : Type*} [comm_monoid_with_zero R] (n p : R) (k : ℕ)

/-- `n` is a prime power if there is a prime `p` and a positive natural `k` such that `n` can be
written as `p^k`. -/
def is_prime_pow : Prop :=
∃ (p : R) (k : ℕ), prime p ∧ 0 < k ∧ p ^ k = n

lemma is_prime_pow_def :
  is_prime_pow n ↔ ∃ (p : R) (k : ℕ), prime p ∧ 0 < k ∧ p ^ k = n := iff.rfl

/-- An equivalent definition for prime powers: `n` is a prime power iff there is a prime `p` and a
natural `k` such that `n` can be written as `p^(k+1)`. -/
lemma is_prime_pow_iff_pow_succ :
  is_prime_pow n ↔ ∃ (p : R) (k : ℕ), prime p ∧ p ^ (k + 1) = n :=
(is_prime_pow_def _).trans
⟨λ ⟨p, k, hp, hk, hn⟩, ⟨_, _, hp, by rwa [nat.sub_add_cancel hk]⟩,
  λ ⟨p, k, hp, hn⟩, ⟨_, _, hp, nat.succ_pos', hn⟩⟩

lemma not_is_prime_pow_zero [no_zero_divisors R] :
  ¬ is_prime_pow (0 : R) :=
begin
  simp only [is_prime_pow_def, not_exists, not_and', and_imp],
  intros x n hn hx,
  rw pow_eq_zero hx,
  simp,
end

lemma not_is_prime_pow_one : ¬ is_prime_pow (1 : R) :=
begin
  simp only [is_prime_pow_def, not_exists, not_and', and_imp],
  intros x n hn hx ht,
  exact ht.not_unit (is_unit_of_pow_eq_one x n hx hn),
end

lemma prime.is_prime_pow {p : R} (hp : prime p) : is_prime_pow p :=
⟨p, 1, hp, zero_lt_one, by simp⟩

lemma is_prime_pow.pow {n : R} (hn : is_prime_pow n)
  {k : ℕ} (hk : k ≠ 0) : is_prime_pow (n ^ k) :=
let ⟨p, k', hp, hk', hn⟩ := hn in ⟨p, k * k', hp, mul_pos hk.bot_lt hk', by rw [pow_mul', hn]⟩

theorem is_prime_pow.ne_zero [no_zero_divisors R] {n : R} (h : is_prime_pow n) : n ≠ 0 :=
λ t, eq.rec not_is_prime_pow_zero t.symm h

lemma is_prime_pow.ne_one {n : R} (h : is_prime_pow n) : n ≠ 1 :=
λ t, eq.rec not_is_prime_pow_one t.symm h

section unique_units

lemma eq_of_prime_pow_eq {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R}
  {k₁ k₂ : ℕ} (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₁) (h : p₁ ^ k₁ = p₂ ^ k₂) :
  p₁ = p₂ :=
by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime hp₁ hp₂ hk₁ }

lemma eq_of_prime_pow_eq' {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R}
  {k₁ k₂ : ℕ} (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₂) (h : p₁ ^ k₁ = p₂ ^ k₂) :
  p₁ = p₂ :=
by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime' hp₁ hp₂ hk₁ }

end unique_units

section nat

lemma is_prime_pow_nat_iff (n : ℕ) :
  is_prime_pow n ↔ ∃ (p k : ℕ), nat.prime p ∧ 0 < k ∧ p ^ k = n :=
by simp only [is_prime_pow_def, nat.prime_iff]

lemma nat.prime.is_prime_pow {p : ℕ} (hp : p.prime) : is_prime_pow p :=
(nat.prime_iff.mp hp).is_prime_pow

lemma is_prime_pow_nat_iff_bounded (n : ℕ) :
  is_prime_pow n ↔ ∃ (p : ℕ), p ≤ n ∧ ∃ (k : ℕ), k ≤ n ∧ p.prime ∧ 0 < k ∧ p ^ k = n :=
begin
  rw is_prime_pow_nat_iff,
  refine iff.symm ⟨λ ⟨p, _, k, _, hp, hk, hn⟩, ⟨p, k, hp, hk, hn⟩, _⟩,
  rintro ⟨p, k, hp, hk, rfl⟩,
  refine ⟨p, _, k, (nat.lt_pow_self hp.one_lt _).le, hp, hk, rfl⟩,
  simpa using nat.pow_le_pow_of_le_right hp.pos hk,
end

instance {n : ℕ} : decidable (is_prime_pow n) :=
decidable_of_iff' _ (is_prime_pow_nat_iff_bounded n)

lemma is_prime_pow.dvd {n m : ℕ} (hn : is_prime_pow n) (hm : m ∣ n) (hm₁ : m ≠ 1) :
  is_prime_pow m :=
begin
  rw is_prime_pow_nat_iff at hn ⊢,
  rcases hn with ⟨p, k, hp, hk, rfl⟩,
  obtain ⟨i, hik, rfl⟩ := (nat.dvd_prime_pow hp).1 hm,
  refine ⟨p, i, hp, _, rfl⟩,
  apply nat.pos_of_ne_zero,
  rintro rfl,
  simpa using hm₁,
end

lemma nat.disjoint_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) :
  disjoint (a.divisors.filter is_prime_pow) (b.divisors.filter is_prime_pow) :=
begin
  simp only [finset.disjoint_left, finset.mem_filter, and_imp, nat.mem_divisors, not_and],
  rintro n han ha hn hbn hb -,
  exact hn.ne_one (nat.eq_one_of_dvd_coprimes hab han hbn),
end

lemma is_prime_pow.two_le : ∀ {n : ℕ}, is_prime_pow n → 2 ≤ n
| 0 h := (not_is_prime_pow_zero h).elim
| 1 h := (not_is_prime_pow_one h).elim
| (n+2) _ := le_add_self

theorem is_prime_pow.pos {n : ℕ} (hn : is_prime_pow n) : 0 < n := pos_of_gt hn.two_le

theorem is_prime_pow.one_lt {n : ℕ} (h : is_prime_pow n) : 1 < n := h.two_le

end nat


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.integral.set_integral

/-!
# Uniform integrability

This file will be used in the future to define uniform integrability. Uniform integrability
is an important notion in both measure theory as well as probability theory. So far this file
only contains the Egorov theorem which will be used to prove the Vitali convergence theorem
which is one of the main results about uniform integrability.

## Main results

* `measure_theory.egorov`: Egorov's theorem which shows that a sequence of almost everywhere
  convergent functions converges uniformly except on an arbitrarily small set.

-/

noncomputable theory
open_locale classical measure_theory nnreal ennreal topological_space

namespace measure_theory

open set filter topological_space

variables {α β ι : Type*} {m : measurable_space α} [metric_space β] {μ : measure α}

section

/-! We will in this section prove Egorov's theorem. -/

namespace egorov

/-- Given a sequence of functions `f` and a function `g`, `not_convergent_seq f g i j` is the
set of elements such that `f k x` and `g x` are separated by at least `1 / (i + 1)` for some
`k ≥ j`.

This definition is useful for Egorov's theorem. -/
def not_convergent_seq (f : ℕ → α → β) (g : α → β) (i j : ℕ) : set α :=
⋃ k (hk : j ≤ k), {x | (1 / (i + 1 : ℝ)) < dist (f k x) (g x)}

variables {i j : ℕ} {s : set α} {ε : ℝ} {f : ℕ → α → β} {g : α → β}

lemma mem_not_convergent_seq_iff {x : α} : x ∈ not_convergent_seq f g i j ↔
  ∃ k (hk : j ≤ k), (1 / (i + 1 : ℝ)) < dist (f k x) (g x) :=
by { simp_rw [not_convergent_seq, mem_Union], refl }

lemma not_convergent_seq_antitone :
  antitone (not_convergent_seq f g i) :=
λ j k hjk, Union₂_mono' $ λ l hl, ⟨l, le_trans hjk hl, subset.rfl⟩

lemma measure_inter_not_convergent_seq_eq_zero
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) (i : ℕ) :
  μ (s ∩ ⋂ j, not_convergent_seq f g i j) = 0 :=
begin
  simp_rw [metric.tendsto_at_top, ae_iff] at hfg,
  rw [← nonpos_iff_eq_zero, ← hfg],
  refine measure_mono (λ x, _),
  simp only [mem_inter_eq, mem_Inter, ge_iff_le, mem_not_convergent_seq_iff],
  push_neg,
  rintro ⟨hmem, hx⟩,
  refine ⟨hmem, 1 / (i + 1 : ℝ), nat.one_div_pos_of_nat, λ N, _⟩,
  obtain ⟨n, hn₁, hn₂⟩ := hx N,
  exact ⟨n, hn₁, hn₂.le⟩
end

variables [second_countable_topology β] [measurable_space β] [borel_space β]

lemma not_convergent_seq_measurable_set
  (hf : ∀ n, measurable[m] (f n)) (hg : measurable g) :
  measurable_set (not_convergent_seq f g i j) :=
measurable_set.Union (λ k, measurable_set.Union_Prop $ λ hk,
  measurable_set_lt measurable_const $ (hf k).dist hg)

lemma measure_not_convergent_seq_tendsto_zero
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) (i : ℕ) :
  tendsto (λ j, μ (s ∩ not_convergent_seq f g i j)) at_top (𝓝 0) :=
begin
  rw [← measure_inter_not_convergent_seq_eq_zero hfg, inter_Inter],
  exact tendsto_measure_Inter (λ n, hsm.inter $ not_convergent_seq_measurable_set hf hg)
    (λ k l hkl, inter_subset_inter_right _ $ not_convergent_seq_antitone hkl)
    ⟨0, (lt_of_le_of_lt (measure_mono $ inter_subset_left _ _) (lt_top_iff_ne_top.2 hs)).ne⟩
end

lemma exists_not_convergent_seq_lt (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) (i : ℕ) :
  ∃ j : ℕ, μ (s ∩ not_convergent_seq f g i j) ≤ ennreal.of_real (ε * 2⁻¹ ^ i) :=
begin
  obtain ⟨N, hN⟩ := (ennreal.tendsto_at_top ennreal.zero_ne_top).1
    (measure_not_convergent_seq_tendsto_zero hf hg hsm hs hfg i)
    (ennreal.of_real (ε * 2⁻¹ ^ i)) _,
  { rw zero_add at hN,
    exact ⟨N, (hN N le_rfl).2⟩ },
  { rw [gt_iff_lt, ennreal.of_real_pos],
    exact mul_pos hε (pow_pos (by norm_num) _) }
end

/-- Given some `ε > 0`, `not_convergent_seq_lt_index` provides the index such that
`not_convergent_seq` (intersected with a set of finite measure) has measure less than
`ε * 2⁻¹ ^ i`.

This definition is useful for Egorov's theorem. -/
def not_convergent_seq_lt_index (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) (i : ℕ) : ℕ :=
classical.some $ exists_not_convergent_seq_lt hε hf hg hsm hs hfg i

lemma not_convergent_seq_lt_index_spec (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) (i : ℕ) :
  μ (s ∩ not_convergent_seq f g i (not_convergent_seq_lt_index hε hf hg hsm hs hfg i)) ≤
  ennreal.of_real (ε * 2⁻¹ ^ i) :=
classical.some_spec $ exists_not_convergent_seq_lt hε hf hg hsm hs hfg i

/-- Given some `ε > 0`, `Union_not_convergent_seq` is the union of `not_convergent_seq` with
specific indicies such that `Union_not_convergent_seq` has measure less equal than `ε`.

This definition is useful for Egorov's theorem. -/
def Union_not_convergent_seq (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) : set α :=
⋃ i, s ∩ not_convergent_seq f g i (not_convergent_seq_lt_index (half_pos hε) hf hg hsm hs hfg i)

lemma Union_not_convergent_seq_measurable_set (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  measurable_set $ Union_not_convergent_seq hε hf hg hsm hs hfg :=
measurable_set.Union (λ n, hsm.inter $ not_convergent_seq_measurable_set hf hg)

lemma measure_Union_not_convergent_seq (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  μ (Union_not_convergent_seq hε hf hg hsm hs hfg) ≤ ennreal.of_real ε :=
begin
  refine le_trans (measure_Union_le _)
    (le_trans (ennreal.tsum_le_tsum $ not_convergent_seq_lt_index_spec
    (half_pos hε) hf hg hsm hs hfg) _),
  simp_rw [ennreal.of_real_mul (half_pos hε).le],
  rw [ennreal.tsum_mul_left, ← ennreal.of_real_tsum_of_nonneg, inv_eq_one_div,
      tsum_geometric_two, ← ennreal.of_real_mul (half_pos hε).le, div_mul_cancel ε two_ne_zero],
  { exact le_rfl },
  { exact λ n, pow_nonneg (by norm_num) _ },
  { rw [inv_eq_one_div],
    exact summable_geometric_two },
end

lemma Union_not_convergent_seq_subset (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  Union_not_convergent_seq hε hf hg hsm hs hfg ⊆ s :=
begin
  rw [Union_not_convergent_seq, ← inter_Union],
  exact inter_subset_left _ _,
end

lemma tendsto_uniformly_on_diff_Union_not_convergent_seq (hε : 0 < ε)
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  tendsto_uniformly_on f g at_top (s \ egorov.Union_not_convergent_seq hε hf hg hsm hs hfg) :=
begin
  rw metric.tendsto_uniformly_on_iff,
  intros δ hδ,
  obtain ⟨N, hN⟩ := exists_nat_one_div_lt hδ,
  rw eventually_at_top,
  refine ⟨egorov.not_convergent_seq_lt_index (half_pos hε) hf hg hsm hs hfg N, λ n hn x hx, _⟩,
  simp only [mem_diff, egorov.Union_not_convergent_seq, not_exists, mem_Union, mem_inter_eq,
    not_and, exists_and_distrib_left] at hx,
  obtain ⟨hxs, hx⟩ := hx,
  specialize hx hxs N,
  rw egorov.mem_not_convergent_seq_iff at hx,
  push_neg at hx,
  rw dist_comm,
  exact lt_of_le_of_lt (hx n hn) hN,
end

end egorov

variables [second_countable_topology β] [measurable_space β] [borel_space β]
  {f : ℕ → α → β} {g : α → β} {s : set α}

/-- **Egorov's theorem**: If `f : ℕ → α → β` is a sequence of measurable functions that converges
to `g : α → β` almost everywhere on a measurable set `s` of finite measure, then for all `ε > 0`,
there exists a subset `t ⊆ s` such that `μ t ≤ ε` and `f` converges to `g` uniformly on `s \ t`.

In other words, a sequence of almost everywhere convergent functions converges uniformly except on
an arbitrarily small set. -/
theorem tendsto_uniformly_on_of_ae_tendsto
  (hf : ∀ n, measurable (f n)) (hg : measurable g) (hsm : measurable_set s) (hs : μ s ≠ ∞)
  (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) {ε : ℝ} (hε : 0 < ε) :
  ∃ t ⊆ s, measurable_set t ∧ μ t ≤ ennreal.of_real ε ∧ tendsto_uniformly_on f g at_top (s \ t) :=
⟨egorov.Union_not_convergent_seq hε hf hg hsm hs hfg,
 egorov.Union_not_convergent_seq_subset hε hf hg hsm hs hfg,
 egorov.Union_not_convergent_seq_measurable_set hε hf hg hsm hs hfg,
 egorov.measure_Union_not_convergent_seq hε hf hg hsm hs hfg,
 egorov.tendsto_uniformly_on_diff_Union_not_convergent_seq hε hf hg hsm hs hfg⟩

/-- Egorov's theorem for finite measure spaces. -/
lemma tendsto_uniformly_on_of_ae_tendsto' [is_finite_measure μ]
  (hf : ∀ n, measurable (f n)) (hg : measurable g)
  (hfg : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) {ε : ℝ} (hε : 0 < ε) :
  ∃ t, measurable_set t ∧ μ t ≤ ennreal.of_real ε ∧ tendsto_uniformly_on f g at_top tᶜ :=
begin
  obtain ⟨t, _, ht, htendsto⟩ :=
    tendsto_uniformly_on_of_ae_tendsto hf hg measurable_set.univ (measure_ne_top μ univ) _ hε,
  { refine ⟨_, ht, _⟩,
    rwa compl_eq_univ_diff },
  { filter_upwards [hfg] with _ htendsto _ using htendsto, },
end

end

end measure_theory


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

! This file was ported from Lean 3 source module category_theory.preadditive.opposite
! leanprover-community/mathlib commit f8d8465c3c392a93b9ed226956e26dee00975946
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Preadditive.AdditiveFunctor
import Mathbin.Logic.Equiv.TransferInstance

/-!
# If `C` is preadditive, `Cᵒᵖ` has a natural preadditive structure.

-/

open Opposite

namespace CategoryTheory

variable (C : Type _) [Category C] [Preadditive C]

instance : Preadditive Cᵒᵖ
    where
  homGroup X Y := Equiv.addCommGroup (opEquiv X Y)
  add_comp X Y Z f f' g :=
    congr_arg Quiver.Hom.op (Preadditive.comp_add _ _ _ g.unop f.unop f'.unop)
  comp_add X Y Z f g g' :=
    congr_arg Quiver.Hom.op (Preadditive.add_comp _ _ _ g.unop g'.unop f.unop)

instance moduleEndLeft {X : Cᵒᵖ} {Y : C} : Module (End X) (unop X ⟶ Y)
    where
  smul_add r f g := Preadditive.comp_add _ _ _ _ _ _
  smul_zero r := Limits.comp_zero
  add_smul r s f := Preadditive.add_comp _ _ _ _ _ _
  zero_smul f := Limits.zero_comp
#align category_theory.module_End_left CategoryTheory.moduleEndLeft

@[simp]
theorem unop_zero (X Y : Cᵒᵖ) : (0 : X ⟶ Y).unop = 0 :=
  rfl
#align category_theory.unop_zero CategoryTheory.unop_zero

@[simp]
theorem unop_add {X Y : Cᵒᵖ} (f g : X ⟶ Y) : (f + g).unop = f.unop + g.unop :=
  rfl
#align category_theory.unop_add CategoryTheory.unop_add

@[simp]
theorem unop_zsmul {X Y : Cᵒᵖ} (k : ℤ) (f : X ⟶ Y) : (k • f).unop = k • f.unop :=
  rfl
#align category_theory.unop_zsmul CategoryTheory.unop_zsmul

@[simp]
theorem unop_neg {X Y : Cᵒᵖ} (f : X ⟶ Y) : (-f).unop = -f.unop :=
  rfl
#align category_theory.unop_neg CategoryTheory.unop_neg

@[simp]
theorem op_zero (X Y : C) : (0 : X ⟶ Y).op = 0 :=
  rfl
#align category_theory.op_zero CategoryTheory.op_zero

@[simp]
theorem op_add {X Y : C} (f g : X ⟶ Y) : (f + g).op = f.op + g.op :=
  rfl
#align category_theory.op_add CategoryTheory.op_add

@[simp]
theorem op_zsmul {X Y : C} (k : ℤ) (f : X ⟶ Y) : (k • f).op = k • f.op :=
  rfl
#align category_theory.op_zsmul CategoryTheory.op_zsmul

@[simp]
theorem op_neg {X Y : C} (f : X ⟶ Y) : (-f).op = -f.op :=
  rfl
#align category_theory.op_neg CategoryTheory.op_neg

variable {C}

/-- `unop` induces morphisms of monoids on hom groups of a preadditive category -/
@[simps]
def unopHom (X Y : Cᵒᵖ) : (X ⟶ Y) →+ (Opposite.unop Y ⟶ Opposite.unop X) :=
  AddMonoidHom.mk' (fun f => f.unop) fun f g => unop_add _ f g
#align category_theory.unop_hom CategoryTheory.unopHom

@[simp]
theorem unop_sum (X Y : Cᵒᵖ) {ι : Type _} (s : Finset ι) (f : ι → (X ⟶ Y)) :
    (s.Sum f).unop = s.Sum fun i => (f i).unop :=
  (unopHom X Y).map_sum _ _
#align category_theory.unop_sum CategoryTheory.unop_sum

/-- `op` induces morphisms of monoids on hom groups of a preadditive category -/
@[simps]
def opHom (X Y : C) : (X ⟶ Y) →+ (Opposite.op Y ⟶ Opposite.op X) :=
  AddMonoidHom.mk' (fun f => f.op) fun f g => op_add _ f g
#align category_theory.op_hom CategoryTheory.opHom

@[simp]
theorem op_sum (X Y : C) {ι : Type _} (s : Finset ι) (f : ι → (X ⟶ Y)) :
    (s.Sum f).op = s.Sum fun i => (f i).op :=
  (opHom X Y).map_sum _ _
#align category_theory.op_sum CategoryTheory.op_sum

variable {D : Type _} [Category D] [Preadditive D]

instance Functor.op_additive (F : C ⥤ D) [F.Additive] : F.op.Additive where
#align category_theory.functor.op_additive CategoryTheory.Functor.op_additive

instance Functor.rightOp_additive (F : Cᵒᵖ ⥤ D) [F.Additive] : F.rightOp.Additive where
#align category_theory.functor.right_op_additive CategoryTheory.Functor.rightOp_additive

instance Functor.leftOp_additive (F : C ⥤ Dᵒᵖ) [F.Additive] : F.leftOp.Additive where
#align category_theory.functor.left_op_additive CategoryTheory.Functor.leftOp_additive

instance Functor.unop_additive (F : Cᵒᵖ ⥤ Dᵒᵖ) [F.Additive] : F.unop.Additive where
#align category_theory.functor.unop_additive CategoryTheory.Functor.unop_additive

end CategoryTheory