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

! This file was ported from Lean 3 source module group_theory.perm.fin
! leanprover-community/mathlib commit 7e1c1263b6a25eb90bf16e80d8f47a657e403c4c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Perm.Cycle.Type
import Mathbin.GroupTheory.Perm.Option
import Mathbin.Logic.Equiv.Fin
import Mathbin.Logic.Equiv.Fintype

/-!
# Permutations of `fin n`
-/

open Equiv

/-- Permutations of `fin (n + 1)` are equivalent to fixing a single
`fin (n + 1)` and permuting the remaining with a `perm (fin n)`.
The fixed `fin (n + 1)` is swapped with `0`. -/
def Equiv.Perm.decomposeFin {n : ℕ} : Perm (Fin n.succ) ≃ Fin n.succ × Perm (Fin n) :=
  ((Equiv.permCongr <| finSuccEquiv n).trans Equiv.Perm.decomposeOption).trans
    (Equiv.prodCongr (finSuccEquiv n).symm (Equiv.refl _))
#align equiv.perm.decompose_fin Equiv.Perm.decomposeFin

@[simp]
theorem Equiv.Perm.decomposeFin_symm_of_refl {n : ℕ} (p : Fin (n + 1)) :
    Equiv.Perm.decomposeFin.symm (p, Equiv.refl _) = swap 0 p := by
  simp [Equiv.Perm.decomposeFin, Equiv.permCongr_def]
#align equiv.perm.decompose_fin_symm_of_refl Equiv.Perm.decomposeFin_symm_of_refl

@[simp]
theorem Equiv.Perm.decomposeFin_symm_of_one {n : ℕ} (p : Fin (n + 1)) :
    Equiv.Perm.decomposeFin.symm (p, 1) = swap 0 p :=
  Equiv.Perm.decomposeFin_symm_of_refl p
#align equiv.perm.decompose_fin_symm_of_one Equiv.Perm.decomposeFin_symm_of_one

@[simp]
theorem Equiv.Perm.decomposeFin_symm_apply_zero {n : ℕ} (p : Fin (n + 1)) (e : Perm (Fin n)) :
    Equiv.Perm.decomposeFin.symm (p, e) 0 = p := by simp [Equiv.Perm.decomposeFin]
#align equiv.perm.decompose_fin_symm_apply_zero Equiv.Perm.decomposeFin_symm_apply_zero

@[simp]
theorem Equiv.Perm.decomposeFin_symm_apply_succ {n : ℕ} (e : Perm (Fin n)) (p : Fin (n + 1))
    (x : Fin n) : Equiv.Perm.decomposeFin.symm (p, e) x.succ = swap 0 p (e x).succ :=
  by
  refine' Fin.cases _ _ p
  · simp [Equiv.Perm.decomposeFin, EquivFunctor.map]
  · intro i
    by_cases h : i = e x
    · simp [h, Equiv.Perm.decomposeFin, EquivFunctor.map]
    · have h' : some (e x) ≠ some i := fun H => h (Option.some_injective _ H).symm
      have h'' : (e x).succ ≠ i.succ := fun H => h (Fin.succ_injective _ H).symm
      simp [h, h'', Fin.succ_ne_zero, Equiv.Perm.decomposeFin, EquivFunctor.map,
        swap_apply_of_ne_of_ne, swap_apply_of_ne_of_ne (Option.some_ne_none (e x)) h']
#align equiv.perm.decompose_fin_symm_apply_succ Equiv.Perm.decomposeFin_symm_apply_succ

@[simp]
theorem Equiv.Perm.decomposeFin_symm_apply_one {n : ℕ} (e : Perm (Fin (n + 1))) (p : Fin (n + 2)) :
    Equiv.Perm.decomposeFin.symm (p, e) 1 = swap 0 p (e 0).succ := by
  rw [← Fin.succ_zero_eq_one, Equiv.Perm.decomposeFin_symm_apply_succ e p 0]
#align equiv.perm.decompose_fin_symm_apply_one Equiv.Perm.decomposeFin_symm_apply_one

@[simp]
theorem Equiv.Perm.decomposeFin.symm_sign {n : ℕ} (p : Fin (n + 1)) (e : Perm (Fin n)) :
    Perm.sign (Equiv.Perm.decomposeFin.symm (p, e)) = ite (p = 0) 1 (-1) * Perm.sign e := by
  refine' Fin.cases _ _ p <;> simp [Equiv.Perm.decomposeFin, Fin.succ_ne_zero]
#align equiv.perm.decompose_fin.symm_sign Equiv.Perm.decomposeFin.symm_sign

/-- The set of all permutations of `fin (n + 1)` can be constructed by augmenting the set of
permutations of `fin n` by each element of `fin (n + 1)` in turn. -/
theorem Finset.univ_perm_fin_succ {n : ℕ} :
    @Finset.univ (Perm <| Fin n.succ) _ =
      (Finset.univ : Finset <| Fin n.succ × Perm (Fin n)).map
        Equiv.Perm.decomposeFin.symm.toEmbedding :=
  (Finset.univ_map_equiv_to_embedding _).symm
#align finset.univ_perm_fin_succ Finset.univ_perm_fin_succ

section CycleRange

/-! ### `cycle_range` section

Define the permutations `fin.cycle_range i`, the cycle `(0 1 2 ... i)`.
-/

open Equiv.Perm

#print finRotate_succ /-
theorem finRotate_succ {n : ℕ} : finRotate n.succ = decomposeFin.symm (1, finRotate n) :=
  by
  ext i
  cases n; · simp
  refine' Fin.cases _ (fun i => _) i
  · simp
  rw [coe_finRotate, decompose_fin_symm_apply_succ, if_congr i.succ_eq_last_succ rfl rfl]
  split_ifs with h
  · simp [h]
  ·
    rw [Fin.val_succ, Function.Injective.map_swap Fin.val_injective, Fin.val_succ, coe_finRotate,
      if_neg h, Fin.val_zero, Fin.val_one,
      swap_apply_of_ne_of_ne (Nat.succ_ne_zero _) (Nat.succ_succ_ne_one _)]
#align fin_rotate_succ finRotate_succ
-/

@[simp]
theorem sign_finRotate (n : ℕ) : Perm.sign (finRotate (n + 1)) = (-1) ^ n :=
  by
  induction' n with n ih
  · simp
  · rw [finRotate_succ]
    simp [ih, pow_succ]
#align sign_fin_rotate sign_finRotate

@[simp]
theorem support_finRotate {n : ℕ} : support (finRotate (n + 2)) = Finset.univ :=
  by
  ext
  simp
#align support_fin_rotate support_finRotate

theorem support_finRotate_of_le {n : ℕ} (h : 2 ≤ n) : support (finRotate n) = Finset.univ :=
  by
  obtain ⟨m, rfl⟩ := exists_add_of_le h
  rw [add_comm, support_finRotate]
#align support_fin_rotate_of_le support_finRotate_of_le

theorem isCycle_finRotate {n : ℕ} : IsCycle (finRotate (n + 2)) :=
  by
  refine' ⟨0, by decide, fun x hx' => ⟨x, _⟩⟩
  clear hx'
  cases' x with x hx
  rw [coe_coe, zpow_ofNat, Fin.ext_iff, Fin.val_mk]
  induction' x with x ih; · rfl
  rw [pow_succ, perm.mul_apply, coe_finRotate_of_ne_last, ih (lt_trans x.lt_succ_self hx)]
  rw [Ne.def, Fin.ext_iff, ih (lt_trans x.lt_succ_self hx), Fin.val_last]
  exact ne_of_lt (Nat.lt_of_succ_lt_succ hx)
#align is_cycle_fin_rotate isCycle_finRotate

theorem isCycle_finRotate_of_le {n : ℕ} (h : 2 ≤ n) : IsCycle (finRotate n) :=
  by
  obtain ⟨m, rfl⟩ := exists_add_of_le h
  rw [add_comm]
  exact isCycle_finRotate
#align is_cycle_fin_rotate_of_le isCycle_finRotate_of_le

@[simp]
theorem cycleType_finRotate {n : ℕ} : cycleType (finRotate (n + 2)) = {n + 2} :=
  by
  rw [is_cycle_fin_rotate.cycle_type, support_finRotate, ← Fintype.card, Fintype.card_fin]
  rfl
#align cycle_type_fin_rotate cycleType_finRotate

theorem cycleType_finRotate_of_le {n : ℕ} (h : 2 ≤ n) : cycleType (finRotate n) = {n} :=
  by
  obtain ⟨m, rfl⟩ := exists_add_of_le h
  rw [add_comm, cycleType_finRotate]
#align cycle_type_fin_rotate_of_le cycleType_finRotate_of_le

namespace Fin

/-- `fin.cycle_range i` is the cycle `(0 1 2 ... i)` leaving `(i+1 ... (n-1))` unchanged. -/
def cycleRange {n : ℕ} (i : Fin n) : Perm (Fin n) :=
  (finRotate (i + 1)).extendDomain
    (Equiv.ofLeftInverse' (Fin.castLe (Nat.succ_le_of_lt i.is_lt)).toEmbedding coe
      (by
        intro x
        ext
        simp))
#align fin.cycle_range Fin.cycleRange

theorem cycleRange_of_gt {n : ℕ} {i j : Fin n.succ} (h : i < j) : cycleRange i j = j :=
  by
  rw [cycle_range, of_left_inverse'_eq_of_injective, ←
    Function.Embedding.toEquivRange_eq_ofInjective, ← via_fintype_embedding,
    via_fintype_embedding_apply_not_mem_range]
  simpa
#align fin.cycle_range_of_gt Fin.cycleRange_of_gt

theorem cycleRange_of_le {n : ℕ} {i j : Fin n.succ} (h : j ≤ i) :
    cycleRange i j = if j = i then 0 else j + 1 :=
  by
  cases n
  · simp
  have :
    j =
      (Fin.castLe (Nat.succ_le_of_lt i.is_lt)).toEmbedding
        ⟨j, lt_of_le_of_lt h (Nat.lt_succ_self i)⟩ :=
    by simp
  ext
  rw [this, cycle_range, of_left_inverse'_eq_of_injective, ←
    Function.Embedding.toEquivRange_eq_ofInjective, ← via_fintype_embedding,
    via_fintype_embedding_apply_image, RelEmbedding.coeFn_toEmbedding, coe_cast_le, coe_finRotate]
  simp only [Fin.ext_iff, coe_last, coe_mk, coe_zero, Fin.eta, apply_ite coe, cast_le_mk]
  split_ifs with heq
  · rfl
  · rw [Fin.val_add_one_of_lt]
    exact lt_of_lt_of_le (lt_of_le_of_ne h (mt (congr_arg coe) HEq)) (le_last i)
#align fin.cycle_range_of_le Fin.cycleRange_of_le

theorem coe_cycleRange_of_le {n : ℕ} {i j : Fin n.succ} (h : j ≤ i) :
    (cycleRange i j : ℕ) = if j = i then 0 else j + 1 :=
  by
  rw [cycle_range_of_le h]
  split_ifs with h'
  · rfl
  exact
    coe_add_one_of_lt
      (calc
        (j : ℕ) < i := fin.lt_iff_coe_lt_coe.mp (lt_of_le_of_ne h h')
        _ ≤ n := nat.lt_succ_iff.mp i.2
        )
#align fin.coe_cycle_range_of_le Fin.coe_cycleRange_of_le

theorem cycleRange_of_lt {n : ℕ} {i j : Fin n.succ} (h : j < i) : cycleRange i j = j + 1 := by
  rw [cycle_range_of_le h.le, if_neg h.ne]
#align fin.cycle_range_of_lt Fin.cycleRange_of_lt

theorem coe_cycleRange_of_lt {n : ℕ} {i j : Fin n.succ} (h : j < i) :
    (cycleRange i j : ℕ) = j + 1 := by rw [coe_cycle_range_of_le h.le, if_neg h.ne]
#align fin.coe_cycle_range_of_lt Fin.coe_cycleRange_of_lt

theorem cycleRange_of_eq {n : ℕ} {i j : Fin n.succ} (h : j = i) : cycleRange i j = 0 := by
  rw [cycle_range_of_le h.le, if_pos h]
#align fin.cycle_range_of_eq Fin.cycleRange_of_eq

@[simp]
theorem cycleRange_self {n : ℕ} (i : Fin n.succ) : cycleRange i i = 0 :=
  cycleRange_of_eq rfl
#align fin.cycle_range_self Fin.cycleRange_self

theorem cycleRange_apply {n : ℕ} (i j : Fin n.succ) :
    cycleRange i j = if j < i then j + 1 else if j = i then 0 else j :=
  by
  split_ifs with h₁ h₂
  · exact cycle_range_of_lt h₁
  · exact cycle_range_of_eq h₂
  · exact cycle_range_of_gt (lt_of_le_of_ne (le_of_not_gt h₁) (Ne.symm h₂))
#align fin.cycle_range_apply Fin.cycleRange_apply

@[simp]
theorem cycleRange_zero (n : ℕ) : cycleRange (0 : Fin n.succ) = 1 :=
  by
  ext j
  refine' Fin.cases _ (fun j => _) j
  · simp
  · rw [cycle_range_of_gt (Fin.succ_pos j), one_apply]
#align fin.cycle_range_zero Fin.cycleRange_zero

@[simp]
theorem cycleRange_last (n : ℕ) : cycleRange (last n) = finRotate (n + 1) :=
  by
  ext i
  rw [coe_cycle_range_of_le (le_last _), coe_finRotate]
#align fin.cycle_range_last Fin.cycleRange_last

@[simp]
theorem cycleRange_zero' {n : ℕ} (h : 0 < n) : cycleRange ⟨0, h⟩ = 1 :=
  by
  cases' n with n
  · cases h
  exact cycle_range_zero n
#align fin.cycle_range_zero' Fin.cycleRange_zero'

@[simp]
theorem sign_cycleRange {n : ℕ} (i : Fin n) : Perm.sign (cycleRange i) = (-1) ^ (i : ℕ) := by
  simp [cycle_range]
#align fin.sign_cycle_range Fin.sign_cycleRange

@[simp]
theorem succAbove_cycleRange {n : ℕ} (i j : Fin n) :
    i.succ.succAbove (i.cycleRange j) = swap 0 i.succ j.succ :=
  by
  cases n
  · rcases j with ⟨_, ⟨⟩⟩
  rcases lt_trichotomy j i with (hlt | heq | hgt)
  · have : (j + 1).cast_succ = j.succ := by
      ext
      rw [coe_cast_succ, coe_succ, Fin.val_add_one_of_lt (lt_of_lt_of_le hlt i.le_last)]
    rw [Fin.cycleRange_of_lt hlt, Fin.succAbove_below, this, swap_apply_of_ne_of_ne]
    · apply Fin.succ_ne_zero
    · exact (Fin.succ_injective _).Ne hlt.ne
    · rw [Fin.lt_iff_val_lt_val]
      simpa [this] using hlt
  · rw [HEq, Fin.cycleRange_self, Fin.succAbove_below, swap_apply_right, Fin.castSucc_zero]
    · rw [Fin.castSucc_zero]
      apply Fin.succ_pos
  · rw [Fin.cycleRange_of_gt hgt, Fin.succAbove_above, swap_apply_of_ne_of_ne]
    · apply Fin.succ_ne_zero
    · apply (Fin.succ_injective _).Ne hgt.ne.symm
    · simpa [Fin.le_iff_val_le_val] using hgt
#align fin.succ_above_cycle_range Fin.succAbove_cycleRange

@[simp]
theorem cycleRange_succAbove {n : ℕ} (i : Fin (n + 1)) (j : Fin n) :
    i.cycleRange (i.succAbove j) = j.succ :=
  by
  cases' lt_or_ge j.cast_succ i with h h
  · rw [Fin.succAbove_below _ _ h, Fin.cycleRange_of_lt h, Fin.coeSucc_eq_succ]
  · rw [Fin.succAbove_above _ _ h, Fin.cycleRange_of_gt (fin.le_cast_succ_iff.mp h)]
#align fin.cycle_range_succ_above Fin.cycleRange_succAbove

@[simp]
theorem cycleRange_symm_zero {n : ℕ} (i : Fin (n + 1)) : i.cycleRange.symm 0 = i :=
  i.cycleRange.Injective (by simp)
#align fin.cycle_range_symm_zero Fin.cycleRange_symm_zero

@[simp]
theorem cycleRange_symm_succ {n : ℕ} (i : Fin (n + 1)) (j : Fin n) :
    i.cycleRange.symm j.succ = i.succAbove j :=
  i.cycleRange.Injective (by simp)
#align fin.cycle_range_symm_succ Fin.cycleRange_symm_succ

theorem isCycle_cycleRange {n : ℕ} {i : Fin (n + 1)} (h0 : i ≠ 0) : IsCycle (cycleRange i) :=
  by
  cases' i with i hi
  cases i
  · exact (h0 rfl).elim
  exact is_cycle_fin_rotate.extend_domain _
#align fin.is_cycle_cycle_range Fin.isCycle_cycleRange

@[simp]
theorem cycleType_cycleRange {n : ℕ} {i : Fin (n + 1)} (h0 : i ≠ 0) :
    cycleType (cycleRange i) = {i + 1} :=
  by
  cases' i with i hi
  cases i
  · exact (h0 rfl).elim
  rw [cycle_range, cycle_type_extend_domain]
  exact cycleType_finRotate
#align fin.cycle_type_cycle_range Fin.cycleType_cycleRange

theorem isThreeCycle_cycleRange_two {n : ℕ} : IsThreeCycle (cycleRange 2 : Perm (Fin (n + 3))) := by
  rw [is_three_cycle, cycle_type_cycle_range] <;> decide
#align fin.is_three_cycle_cycle_range_two Fin.isThreeCycle_cycleRange_two

end Fin

end CycleRange


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

import number_theory.zsqrtd.gaussian_int

/-!
# Sums of two squares

Proof of Fermat's theorem on the sum of two squares. Every prime congruent to 1 mod 4 is the sum
of two squares.

# Todo

Fully characterize the natural numbers that are the sum of two squares: those such that for every
prime p congruent to 3 mod 4, the largest power of p dividing them is even.
-/

open gaussian_int

/-- **Fermat's theorem on the sum of two squares**. Every prime congruent to 1 mod 4 is the sum
of two squares. Also known as **Fermat's Christmas theorem**. -/
lemma nat.prime.sq_add_sq {p : ℕ} [fact p.prime] (hp : p % 4 = 1) :
  ∃ a b : ℕ, a ^ 2 + b ^ 2 = p :=
begin
  apply sq_add_sq_of_nat_prime_of_not_irreducible p,
  rw [principal_ideal_ring.irreducible_iff_prime, prime_iff_mod_four_eq_three_of_nat_prime p, hp],
  norm_num
end


theorem ex1 (n m : Nat) : 0 + (n, m).1 = n := by
  simp only
  rw [Nat.zero_add]

theorem ex2 (n m : Nat) : 0 + (n, m).1 = n := by
  simp

theorem ex3 (n m : Nat) : 0 + (n, m).1 + 0 = n := by
  simp only [Nat.add_zero]
  rw [Nat.zero_add]

theorem ex4 (n m : Nat) : 0 + (n, m).1 + 0 = n := by
  simp


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth
-/
import analysis.convex.cone
import analysis.normed_space.is_R_or_C
import analysis.normed_space.extend

/-!
# Hahn-Banach theorem

In this file we prove a version of Hahn-Banach theorem for continuous linear
functions on normed spaces over `ℝ` and `ℂ`.

In order to state and prove its corollaries uniformly, we prove the statements for a field `𝕜`
satisfying `is_R_or_C 𝕜`.

In this setting, `exists_dual_vector` states that, for any nonzero `x`, there exists a continuous
linear form `g` of norm `1` with `g x = ∥x∥` (where the norm has to be interpreted as an element
of `𝕜`).

-/

universes u v

namespace real
variables {E : Type*} [semi_normed_group E] [normed_space ℝ E]

/-- Hahn-Banach theorem for continuous linear functions over `ℝ`. -/
theorem exists_extension_norm_eq (p : subspace ℝ E) (f : p →L[ℝ] ℝ) :
  ∃ g : E →L[ℝ] ℝ, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  rcases exists_extension_of_le_sublinear ⟨p, f⟩ (λ x, ∥f∥ * ∥x∥)
    (λ c hc x, by simp only [norm_smul c x, real.norm_eq_abs, abs_of_pos hc, mul_left_comm])
    (λ x y, _) (λ x, le_trans (le_abs_self _) (f.le_op_norm _))
    with ⟨g, g_eq, g_le⟩,
  set g' := g.mk_continuous (∥f∥)
    (λ x, abs_le.2 ⟨neg_le.1 $ g.map_neg x ▸ norm_neg x ▸ g_le (-x), g_le x⟩),
  { refine ⟨g', g_eq, _⟩,
    { apply le_antisymm (g.mk_continuous_norm_le (norm_nonneg f) _),
      refine f.op_norm_le_bound (norm_nonneg _) (λ x, _),
      dsimp at g_eq,
      rw ← g_eq,
      apply g'.le_op_norm } },
  { simp only [← mul_add],
    exact mul_le_mul_of_nonneg_left (norm_add_le x y) (norm_nonneg f) }
end

end real

section is_R_or_C
open is_R_or_C

variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [normed_space 𝕜 F]

/-- Hahn-Banach theorem for continuous linear functions over `𝕜` satisyfing `is_R_or_C 𝕜`. -/
theorem exists_extension_norm_eq (p : subspace 𝕜 F) (f : p →L[𝕜] 𝕜) :
  ∃ g : F →L[𝕜] 𝕜, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  letI : module ℝ F := restrict_scalars.module ℝ 𝕜 F,
  letI : is_scalar_tower ℝ 𝕜 F := restrict_scalars.is_scalar_tower _ _ _,
  letI : normed_space ℝ F := normed_space.restrict_scalars _ 𝕜 _,
  -- Let `fr: p →L[ℝ] ℝ` be the real part of `f`.
  let fr := re_clm.comp (f.restrict_scalars ℝ),
  have fr_apply : ∀ x, fr x = re (f x), by { assume x, refl },
  -- Use the real version to get a norm-preserving extension of `fr`, which
  -- we'll call `g : F →L[ℝ] ℝ`.
  rcases real.exists_extension_norm_eq (p.restrict_scalars ℝ) fr with ⟨g, ⟨hextends, hnormeq⟩⟩,
  -- Now `g` can be extended to the `F →L[𝕜] 𝕜` we need.
  refine ⟨g.extend_to_𝕜, _⟩,
  -- It is an extension of `f`.
  have h : ∀ x : p, g.extend_to_𝕜 x = f x,
  { assume x,
    rw [continuous_linear_map.extend_to_𝕜_apply, ←submodule.coe_smul, hextends, hextends],
    have : (fr x : 𝕜) - I * ↑(fr (I • x)) = (re (f x) : 𝕜) - (I : 𝕜) * (re (f ((I : 𝕜) • x))),
      by refl,
    rw this,
    apply ext,
    { simp only [add_zero, algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add,
        zero_sub, I_im', zero_mul, of_real_re, eq_self_iff_true, sub_zero, mul_neg_eq_neg_mul_symm,
        of_real_neg, mul_re, mul_zero, sub_neg_eq_add, continuous_linear_map.map_smul] },
    { simp only [algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, zero_sub, I_im',
        zero_mul, of_real_re, mul_neg_eq_neg_mul_symm, mul_im, zero_add, of_real_neg, mul_re,
        sub_neg_eq_add, continuous_linear_map.map_smul] } },
  -- And we derive the equality of the norms by bounding on both sides.
  refine ⟨h, le_antisymm _ _⟩,
  { calc ∥g.extend_to_𝕜∥
        ≤ ∥g∥ : g.extend_to_𝕜.op_norm_le_bound g.op_norm_nonneg (norm_bound _)
    ... = ∥fr∥ : hnormeq
    ... ≤ ∥re_clm∥ * ∥f∥ : continuous_linear_map.op_norm_comp_le _ _
    ... = ∥f∥ : by rw [re_clm_norm, one_mul] },
  { exact f.op_norm_le_bound g.extend_to_𝕜.op_norm_nonneg (λ x, h x ▸ g.extend_to_𝕜.le_op_norm x) }
end

end is_R_or_C

section dual_vector
variables (𝕜 : Type v) [is_R_or_C 𝕜]
variables {E : Type u} [normed_group E] [normed_space 𝕜 E]

open continuous_linear_equiv submodule
open_locale classical

lemma coord_norm' {x : E} (h : x ≠ 0) : ∥(∥x∥ : 𝕜) • coord 𝕜 x h∥ = 1 :=
by rw [norm_smul, is_R_or_C.norm_coe_norm, coord_norm, mul_inv_cancel (mt norm_eq_zero.mp h)]

/-- Corollary of Hahn-Banach.  Given a nonzero element `x` of a normed space, there exists an
    element of the dual space, of norm `1`, whose value on `x` is `∥x∥`. -/
theorem exists_dual_vector (x : E) (h : x ≠ 0) : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = ∥x∥ :=
begin
  let p : submodule 𝕜 E := 𝕜 ∙ x,
  let f := (∥x∥ : 𝕜) • coord 𝕜 x h,
  obtain ⟨g, hg⟩ := exists_extension_norm_eq p f,
  refine ⟨g, _, _⟩,
  { rw [hg.2, coord_norm'] },
  { calc g x = g (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw coe_mk
    ... = ((∥x∥ : 𝕜) • coord 𝕜 x h) (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw ← hg.1
    ... = ∥x∥ : by simp }
end

/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, and choosing
    the dual element arbitrarily when `x = 0`. -/
theorem exists_dual_vector' [nontrivial E] (x : E) :
  ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = ∥x∥ :=
begin
  by_cases hx : x = 0,
  { obtain ⟨y, hy⟩ := exists_ne (0 : E),
    obtain ⟨g, hg⟩ : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g y = ∥y∥ := exists_dual_vector 𝕜 y hy,
    refine ⟨g, hg.left, _⟩,
    simp [hx] },
  { exact exists_dual_vector 𝕜 x hx }
end

/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, but only ensuring that
    the dual element has norm at most `1` (this can not be improved for the trivial
    vector space). -/
theorem exists_dual_vector'' (x : E) :
  ∃ g : E →L[𝕜] 𝕜, ∥g∥ ≤ 1 ∧ g x = ∥x∥ :=
begin
  by_cases hx : x = 0,
  { refine ⟨0, by simp, _⟩,
    symmetry,
    simp [hx], },
  { rcases exists_dual_vector 𝕜 x hx with ⟨g, g_norm, g_eq⟩,
    exact ⟨g, g_norm.le, g_eq⟩ }
end

end dual_vector


import ring_theory.noetherian

variables {R M : Type*} [semiring R] [add_comm_monoid M] [module R M]

namespace submodule

noncomputable
def min_generator_card (p : submodule R M) : ℕ :=
⨅ s : { s : set M // s.finite ∧ span R s = p}, s.2.1.to_finset.card

noncomputable
def spanrank (p : submodule R M) : with_top ℕ :=
⨅ s : { s : set M // s.finite ∧ span R s = p}, s.2.1.to_finset.card

lemma spanrank_ne_top_iff {p : submodule R M} :
  p.spanrank ≠ ⊤ ↔ p.fg :=
begin
  simp [spanrank, submodule.fg_def],
end

lemma fg_iff_card_finset_nonempty {p : submodule R M} :
  p.fg ↔ set.nonempty (finset.card '' { s : finset M | span R (s : set M) = p }) :=
set.nonempty_image_iff.symm

lemma fg_iff_spanrank_eq {p : submodule R M} :
  p.fg ↔ p.spanrank = p.min_generator_card :=
begin
  split,
  { intro h,
    haveI : nonempty {s : set M // s.finite ∧ span R s = p},
    { rwa [nonempty_subtype, ← fg_def] },
    exact (with_top.coe_infi _).symm },
  { intro e, rw [← spanrank_ne_top_iff, e], exact with_top.coe_ne_top }
end

alias fg_iff_spanrank_eq ↔ fg.spanrank_eq _

lemma fg.exists_generator_eq_min_generator_card {p : submodule R M} (h : p.fg) :
  ∃ f : fin p.min_generator_card → M, span R (set.range f) = p :=
begin
  obtain ⟨⟨s, h₁, h₂⟩, h₃ : h₁.to_finset.card = _⟩ : p.min_generator_card ∈ _ := nat.Inf_mem _,
  { rw ← h₃,
    refine ⟨subtype.val ∘ h₁.to_finset.equiv_fin.symm, _⟩,
    rw [set.range_comp, set.range_iff_surjective.mpr (equiv.surjective _), set.image_univ,
      subtype.range_val, ← h₂],
    congr' 1,
    ext, exact h₁.mem_to_finset },
  { rwa [set.range_nonempty_iff_nonempty, nonempty_subtype, ← submodule.fg_def] }
end

lemma fg.min_generator_card_le_iff_exists {p : submodule R M} {n : ℕ} :
  p.spanrank ≤ n ↔ ∃ f : fin n → M, span R (set.range f) = p :=
begin
  classical,
  split,
  { intro e,
    have h := spanrank_ne_top_iff.mp (e.trans_lt (with_top.coe_lt_top n)).ne,
    rw [h.spanrank_eq, with_top.coe_le_coe] at e,
    obtain ⟨f, hf⟩ := h.exists_generator_eq_min_generator_card,
    let f' : fin n → M := λ i, if h : i.1 < p.min_generator_card then f (fin.cast_lt i h) else 0,
    use f',
    rw ← hf,
    apply le_antisymm; rw submodule.span_le; rintros _ ⟨x, rfl⟩,
    { dsimp only [f'],
      split_ifs,
      { apply submodule.subset_span, exact set.mem_range_self _ },
      { exact (span R (set.range f)).zero_mem } },
    { apply submodule.subset_span, use fin.cast_le e x, dsimp [f'], rw dif_pos x.is_lt, congr' 1,
      ext, refl } },
  { rintros ⟨f, hf⟩,
    let s : { s : set M // s.finite ∧ span R s = p} :=
      ⟨set.range f, set.finite.intro infer_instance, hf⟩,
    calc p.spanrank
        ≤ s.2.1.to_finset.card : cInf_le (order_bot.bdd_below _) (set.mem_range_self _)
    ... = (finset.univ.image f).card : by { congr' 2, ext, simp }
    ... ≤ n : by { rw with_top.coe_le_coe, convert finset.card_image_le,
                    rw [finset.card_univ, fintype.card_fin] } }
end

noncomputable
def fg.min_generator {p : submodule R M} (h : p.fg) : fin p.min_generator_card → M :=
h.exists_generator_eq_min_generator_card.some

lemma fg.span_min_generator_range {p : submodule R M} (h : p.fg) :
  span R (set.range h.min_generator) = p :=
h.exists_generator_eq_min_generator_card.some_spec

lemma fg.min_generator_mem {p : submodule R M} (h : p.fg) (i) : h.min_generator i ∈ p :=
by { conv_rhs { rw ← h.span_min_generator_range }, exact subset_span (set.mem_range_self i) }

end submodule


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/

import data.mv_polynomial.variables
import algebra.module.basic
import tactic.ring

/-!
# Partial derivatives of polynomials

This file defines the notion of the formal *partial derivative* of a polynomial,
the derivative with respect to a single variable.
This derivative is not connected to the notion of derivative from analysis.
It is based purely on the polynomial exponents and coefficients.

## Main declarations

* `mv_polynomial.pderiv i p` : the partial derivative of `p` with respect to `i`.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_ring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u
variables {R : Type u}

namespace mv_polynomial
variables {σ : Type*} {a a' a₁ a₂ : R} {s : σ →₀ ℕ}

section pderiv

variables {R} [comm_semiring R]

/-- `pderiv i p` is the partial derivative of `p` with respect to `i` -/
def pderiv (i : σ) : mv_polynomial σ R →ₗ[R] mv_polynomial σ R :=
{ to_fun := λ p, p.sum (λ A B, monomial (A - single i 1) (B * (A i))),
  map_smul' := begin
    intros c x,
    rw [sum_smul_index', smul_sum],
    { simp_rw [monomial, smul_single, smul_eq_mul, mul_assoc] },
    { intros s,
      simp only [monomial_zero, zero_mul] }
  end,
  map_add' := λ f g, sum_add_index (by simp only [monomial_zero, forall_const, zero_mul])
    (by simp only [add_mul, forall_const, eq_self_iff_true, monomial_add]), }

@[simp]
lemma pderiv_monomial {i : σ} :
  pderiv i (monomial s a) = monomial (s - single i 1) (a * (s i)) :=
by simp only [pderiv, monomial_zero, sum_monomial, zero_mul, linear_map.coe_mk]

@[simp]
lemma pderiv_C {i : σ} : pderiv i (C a) = 0 :=
suffices pderiv i (monomial 0 a) = 0, by simpa,
by simp only [monomial_zero, pderiv_monomial, nat.cast_zero, mul_zero, zero_apply]

@[simp]
lemma pderiv_one {i : σ} : pderiv i (1 : mv_polynomial σ R) = 0 := pderiv_C

lemma pderiv_eq_zero_of_not_mem_vars {i : σ} {f : mv_polynomial σ R} (h : i ∉ f.vars) :
  pderiv i f = 0 :=
begin
  change (pderiv i) f = 0,
  rw [f.as_sum, linear_map.map_sum],
  apply finset.sum_eq_zero,
  intros x H,
  simp [mem_support_not_mem_vars_zero H h],
end

lemma pderiv_X {i j : σ} : pderiv i (X j : mv_polynomial σ R) = if i = j then 1 else 0 :=
begin
  dsimp [pderiv],
  erw finsupp.sum_single_index,
  simp only [mul_boole, if_congr, finsupp.single_apply, nat.cast_zero, nat.cast_one, nat.cast_ite],
  by_cases h : i = j,
  { rw [if_pos h, if_pos h.symm],
    subst h,
    congr,
    ext j,
    simp, },
  { rw [if_neg h, if_neg (ne.symm h)],
    simp, },
  { simp, },
end

@[simp] lemma pderiv_X_self {i : σ} : pderiv i (X i : mv_polynomial σ R) = 1 :=
by simp [pderiv_X]

lemma pderiv_monomial_single {i : σ} {n : ℕ} :
  pderiv i (monomial (single i n) a) = monomial (single i (n-1)) (a * n) :=
by simp

private lemma monomial_sub_single_one_add {i : σ} {s' : σ →₀ ℕ} :
  monomial (s - single i 1 + s') (a * (s i) * a') =
    monomial (s + s' - single i 1) (a * (s i) * a') :=
by by_cases h : s i = 0; simp [h, sub_single_one_add]

private lemma monomial_add_sub_single_one {i : σ} {s' : σ →₀ ℕ} :
  monomial (s + (s' - single i 1)) (a * (a' * (s' i))) =
    monomial (s + s' - single i 1) (a * (a' * (s' i))) :=
by by_cases h : s' i = 0; simp [h, add_sub_single_one]

lemma pderiv_monomial_mul {i : σ} {s' : σ →₀ ℕ} :
  pderiv i (monomial s a * monomial s' a') =
    pderiv i (monomial s a) * monomial s' a' + monomial s a * pderiv i (monomial s' a') :=
begin
  simp [monomial_sub_single_one_add, monomial_add_sub_single_one],
  congr,
  ring,
end

@[simp]
lemma pderiv_mul {i : σ} {f g : mv_polynomial σ R} :
  pderiv i (f * g) = pderiv i f * g + f * pderiv i g :=
begin
  apply induction_on' f,
  { apply induction_on' g,
    { intros u r u' r', exact pderiv_monomial_mul },
    { intros p q hp hq u r,
      rw [mul_add, linear_map.map_add, hp, hq, mul_add, linear_map.map_add],
      ring } },
  { intros p q hp hq,
    simp [add_mul, hp, hq],
    ring, }
end

@[simp]
lemma pderiv_C_mul {f : mv_polynomial σ R} {i : σ} :
  pderiv i (C a * f) = C a * pderiv i f :=
by convert linear_map.map_smul (pderiv i) a f; rw C_mul'

@[simp]
lemma pderiv_pow {i : σ} {f : mv_polynomial σ R} {n : ℕ} :
  pderiv i (f^n) = n * pderiv i f * f^(n-1) :=
begin
  induction n with n ih,
  { simp, },
  { simp only [nat.succ_sub_succ_eq_sub, nat.cast_succ, nat.sub_zero, mv_polynomial.pderiv_mul,
      pow_succ, ih],
    cases n,
    { simp, },
    { simp only [nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, nat.cast_add, nat.cast_one,
        pow_succ],
      ring, }, },
end

@[simp]
lemma pderiv_nat_cast {i : σ} {n : ℕ} : pderiv i (n : mv_polynomial σ R) = 0 :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih], },
end

end pderiv

end mv_polynomial


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

import data.nat.fib
import tactic.linarith

/-!
# IMO 1981 Q3

Determine the maximum value of `m ^ 2 + n ^ 2`, where `m` and `n` are integers in
`{1, 2, ..., 1981}` and `(n ^ 2 - m * n - m ^ 2) ^ 2 = 1`.

The trick to this problem is that `m` and `n` have to be consecutive Fibonacci numbers,
because you can reduce any solution to a smaller one using the Fibonacci recurrence.
-/

/-
First, define the problem in terms of finding the maximum of a set.

We first generalize the problem to `{1, 2, ..., N}` and specialize to `N = 1981` at the very end.
-/

open int nat set
section
variable (N : ℕ) -- N = 1981

@[mk_iff] structure problem_predicate (m n : ℤ) : Prop :=
(m_range : m ∈ Ioc 0 (N : ℤ))
(n_range : n ∈ Ioc 0 (N : ℤ))
(eq_one : (n ^ 2 - m * n - m ^ 2) ^ 2 = 1)

def specified_set : set ℤ :=
{k : ℤ | ∃ m : ℤ, ∃ n : ℤ, k = m ^ 2 + n ^ 2 ∧ problem_predicate N m n}

/-
We want to reduce every solution to a smaller solution. Specifically,
we show that when `(m, n)` is a solution, `(n - m, m)` is also a solution,
except for the base case of `(1, 1)`.
-/
namespace problem_predicate
variable {N}

lemma m_le_n {m n : ℤ} (h1 : problem_predicate N m n) : m ≤ n :=
begin
  by_contradiction h2,
  have h3 : 1 = (n * (n - m) - m ^ 2) ^ 2,
  { calc 1 = (n ^ 2 - m * n - m ^ 2) ^ 2 : h1.eq_one.symm
       ... = (n * (n - m) - m ^ 2) ^ 2   : by ring },
  have h4 : n * (n - m) - m ^ 2 < -1, by nlinarith [h1.n_range.left],
  have h5 : 1 < (n * (n - m) - m ^ 2) ^ 2, by nlinarith,
  exact h5.ne h3
end

lemma eq_imp_1 {n : ℤ} (h1 : problem_predicate N n n) : n = 1 :=
begin
  have : n * (n * (n * n)) = 1,
  { calc _ = (n ^ 2 - n * n - n ^ 2) ^ 2 : by simp [sq, mul_assoc]
       ... = 1                           : h1.eq_one },
  exact eq_one_of_mul_eq_one_right h1.m_range.left.le this,
end

lemma reduction {m n : ℤ} (h1 : problem_predicate N m n) (h2 : 1 < n) :
problem_predicate N (n - m) m :=
begin
  obtain (rfl : m = n) | (h3 : m < n) := h1.m_le_n.eq_or_lt,
  { have h4 : m = 1, from h1.eq_imp_1,
    exact absurd h4.symm h2.ne },
  refine_struct { n_range := h1.m_range, .. },
  -- m_range:
  { have h5 : 0 < n - m, from sub_pos.mpr h3,
    have h6 : n - m < N,
    { calc _ < n : sub_lt_self n h1.m_range.left
         ... ≤ N : h1.n_range.right },
    exact ⟨h5, h6.le⟩ },
  -- eq_one:
  { calc _ = (n ^ 2 - m * n - m ^ 2) ^ 2 : by ring
       ... = 1                           : h1.eq_one },
end

end problem_predicate

/-
It will be convenient to have the lemmas above in their natural number form.
Most of these can be proved with the `norm_cast` family of tactics.
-/

def nat_predicate (m n : ℕ) : Prop := problem_predicate N ↑m ↑n

namespace nat_predicate
variable {N}

lemma m_le_n {m n : ℕ} (h1 : nat_predicate N m n) : m ≤ n :=
by exact_mod_cast h1.m_le_n

lemma eq_imp_1 {n : ℕ} (h1 : nat_predicate N n n) : n = 1 :=
by exact_mod_cast h1.eq_imp_1

lemma reduction {m n : ℕ} (h1 : nat_predicate N m n) (h2 : 1 < n) :
  nat_predicate N (n - m) m :=
have m ≤ n, from h1.m_le_n,
by exact_mod_cast h1.reduction (by exact_mod_cast h2)

lemma n_pos {m n : ℕ} (h1 : nat_predicate N m n) : 0 < n :=
by exact_mod_cast h1.n_range.left

lemma m_pos {m n : ℕ} (h1 : nat_predicate N m n) : 0 < m :=
by exact_mod_cast h1.m_range.left

lemma n_le_N {m n : ℕ} (h1 : nat_predicate N m n) : n ≤ N :=
by exact_mod_cast h1.n_range.right

/-
Now we can use induction to show that solutions must be Fibonacci numbers.
-/
lemma imp_fib {n : ℕ} : ∀ m : ℕ, nat_predicate N m n →
  ∃ k : ℕ, m = fib k ∧ n = fib (k + 1) :=
begin
  apply nat.strong_induction_on n _,
  intros n h1 m h2,
  have h3 : m ≤ n, from h2.m_le_n,
  obtain (rfl : 1 = n) | (h4 : 1 < n) := (succ_le_iff.mpr h2.n_pos).eq_or_lt,
  { use 1,
    have h5 : 1 ≤ m, from succ_le_iff.mpr h2.m_pos,
    simpa [fib_one, fib_two] using (h3.antisymm h5 : m = 1) },
  { obtain (rfl : m = n) | (h6 : m < n) := h3.eq_or_lt,
    { exact absurd h2.eq_imp_1 (ne_of_gt h4) },
    { have h7 : nat_predicate N (n - m) m, from h2.reduction h4,
      obtain ⟨k : ℕ, hnm : n - m = fib k, rfl : m = fib (k+1)⟩ := h1 m h6 (n - m) h7,
      use [k + 1, rfl],
      rw [fib_succ_succ, ← hnm, nat.sub_add_cancel h3] } }
end

end nat_predicate

/-
Next, we prove that if `N < fib K + fib (K+1)`, then the largest `m` and `n`
satisfying `nat_predicate m n N` are `fib K` and `fib (K+1)`, respectively.
-/

variables {K : ℕ} (HK : N < fib K + fib (K+1)) {N}
include HK

lemma m_n_bounds {m n : ℕ} (h1 : nat_predicate N m n) : m ≤ fib K ∧ n ≤ fib (K+1) :=
begin
  obtain ⟨k : ℕ, hm : m = fib k, hn : n = fib (k+1)⟩ := h1.imp_fib m,
  by_cases h2 : k < K + 1,
  { have h3 : k ≤ K, from lt_succ_iff.mp h2,
    split,
    { calc m = fib k : hm
         ... ≤ fib K : fib_mono h3, },
    { have h6 : k + 1 ≤ K + 1, from succ_le_succ h3,
      calc n = fib (k+1) : hn
         ... ≤ fib (K+1) : fib_mono h6 } },
  { have h7 : N < n,
    { have h8 : K + 2 ≤ k + 1, from succ_le_succ (not_lt.mp h2),
      calc N < fib (K+2) : HK
         ... ≤ fib (k+1) : fib_mono h8
         ... = n         : hn.symm, },
    have h9 : n ≤ N, from h1.n_le_N,
    exact absurd h7 h9.not_lt }
end

/-
We spell out the consequences of this result for `specified_set N` here.
-/

variables {M : ℕ} (HM : M = (fib K) ^ 2 + (fib (K+1)) ^ 2)
include HM

lemma k_bound {m n : ℤ} (h1 : problem_predicate N m n) : m ^ 2 + n ^ 2 ≤ M :=
begin
  have h2 : 0 ≤ m, from h1.m_range.left.le,
  have h3 : 0 ≤ n, from h1.n_range.left.le,
  rw [← nat_abs_of_nonneg h2, ← nat_abs_of_nonneg h3] at h1, clear h2 h3,
  obtain ⟨h4 : m.nat_abs ≤ fib K, h5 : n.nat_abs ≤ fib (K+1)⟩ := m_n_bounds HK h1,
  have h6 : m ^ 2 ≤ (fib K) ^ 2, from nat_abs_le_iff_sq_le.mp h4,
  have h7 : n ^ 2 ≤ (fib (K+1)) ^ 2, from nat_abs_le_iff_sq_le.mp h5,
  linarith
end

lemma solution_bound : ∀ {k : ℤ}, k ∈ specified_set N → k ≤ M
| _ ⟨_, _, rfl, h⟩ := k_bound HK HM h

theorem solution_greatest (H : problem_predicate N (fib K) (fib (K + 1))) :
  is_greatest (specified_set N) M :=
⟨⟨fib K, fib (K+1), by simp [HM], H⟩, λ k h, solution_bound HK HM h⟩

end

/-
Now we just have to demonstrate that 987 and 1597 are in fact the largest Fibonacci
numbers in this range, and thus provide the maximum of `specified_set`.
-/

theorem imo1981_q3 : is_greatest (specified_set 1981) 3524578 :=
begin
  have := λ h, @solution_greatest 1981 16 h 3524578,
  simp only [show fib (16:ℕ) = 987 ∧ fib (16+1:ℕ) = 1597,
    by norm_num [fib_succ_succ]] at this,
  apply_mod_cast this; norm_num [problem_predicate_iff],
end


import Category.Init

/-!
# Category **FPL**

`Fpl` is the **FPL** category:
- objects are all `int`, `real`, `bool` and `unit`, and
- arrows are the following operations:
  - identity on all four objects
  - `isZero : int → bool`
  - `not : bool → bool`
  - `succᵢ : int → int`
  - `succᵣ : real → real`
  - `toReal : int → real`
  - `zero : unit → int`
  - `true : unit → Bool`
  - `false : unit → Bool`
  - `unit : unit → unit`
-/

namespace Fpl

open Lean (Rat)

inductive Obj : Type 1
  --- Naturals.
  | N
  --- Rationals.
  | R
  --- Bool.
  | B
  --- Unit.
  | U
deriving Inhabited, BEq

abbrev nat :=
  Obj.N
abbrev rat :=
  Obj.R
abbrev bool :=
  Obj.B
abbrev unit :=
  Obj.U

abbrev Obj.concrete : Obj → Type
  | N => Nat
  | R => Rat
  | B => Bool
  | U => Unit

inductive Val
  | N : Obj.N.concrete → Val
  | R : Obj.R.concrete → Val
  | B : Obj.B.concrete → Val
  | U : Obj.U.concrete → Val
deriving Inhabited, BEq

abbrev Val.type : Val → Obj
  | N _ => Obj.N
  | R _ => Obj.R
  | B _ => Obj.B
  | U _ => Obj.U

abbrev F (α β : Obj) : Type :=
  α.concrete → β.concrete

infix:min " ⇒ " => F

abbrev F.id (α : Obj) : α ⇒ α :=
  fun val => val

abbrev F.tru : unit ⇒ bool :=
  𝕂 true

abbrev F.fls : unit ⇒ bool :=
  𝕂 false

abbrev F.not : bool ⇒ bool :=
  fun b => !b

abbrev F.isZero : nat ⇒ bool :=
  fun
    | 0 => true
    | _ + 1 => false

abbrev F.succᵢ : nat ⇒ nat :=
  (· + 1)

abbrev F.zero : unit ⇒ nat :=
  𝕂 0

abbrev F.toRat : nat ⇒ rat :=
  (Lean.mkRat · 1)

abbrev F.succᵣ : rat ⇒ rat :=
  (· + 1)

@[reducible]
inductive A : Obj → Obj → Type 1
  | id : {γ : Obj} → A γ γ
  | tru : A unit bool
  | fls : A unit bool
  | not : A bool bool
  | isZero : A nat bool
  | succᵢ : A nat nat
  | zero : A unit nat
  | toRat : A nat rat
  | succᵣ : A rat rat
  | comp : (A β γ) → (A α β) → A α γ

abbrev A.concrete : A α β → (α ⇒ β)
  | id => F.id α
  | tru => F.tru
  | fls => F.fls
  | not => F.not
  | isZero => F.isZero
  | succᵢ => F.succᵢ
  | zero => F.zero
  | toRat => F.toRat
  | succᵣ => F.succᵣ
  | comp f g => f.concrete ∘ g.concrete
abbrev A.χ :=
  @A.concrete

theorem A.concrete_comp
  (f : A β γ)
  (g : A α β)
: f.χ ∘ g.χ = (f.comp g).χ
:=
  rfl

theorem A.concrete_comp_assoc
  (f : A γ δ)
  (g : A β γ)
  (h : A α β)
: (f.comp (g.comp h)).χ = ((f.comp g).comp h).χ
:=
  rfl

theorem A.id_comp
  (f : A α β)
: (id.comp f).χ = f.χ
:=
  rfl
theorem A.comp_id
  (f : A α β)
: (f.comp id).χ = f.χ
:=
  rfl

theorem A.comp_not_not
: (not.comp not).χ = id.χ
:=
  funext (by simp)
theorem A.comp_not_tru
: (not.comp tru).χ = fls.χ
:=
  rfl
theorem A.comp_not_fls
: (not.comp fls).χ = tru.χ
:=
  rfl

theorem A.comp_isZero_zero
: (isZero.comp zero).χ = tru.χ
:=
  rfl

theorem A.comp_isZero_succᵢ
: (isZero.comp (succᵢ.comp f)).χ = fls.χ
:=
  rfl

end Fpl

/-! ## FPL is a category -/

def Cat.Fpl : Cat Fpl.Obj Fpl.Obj.concrete Fpl.A Fpl.F where
  aConcrete :=
    Fpl.A.concrete

  compose :=
    Fpl.A.comp
  compose_assoc :=
    Fpl.A.concrete_comp_assoc

  id :=
    Fpl.A.id
  id_compose :=
    Fpl.A.id_comp
  compose_id :=
    Fpl.A.comp_id


import game.world10.level7 -- hide
namespace mynat -- hide
/-

# Inequality world.

## Level 8: `succ_le_succ`

Another straightforward one.
-/

/- Lemma
For all naturals $a$ and $b$, if $a\le b$, then $\operatorname{succ}(a)\le\operatorname{succ}(b)$.
-/
lemma succ_le_succ (a b : mynat) (h : a ≤ b) : succ a ≤ succ b :=
begin [nat_num_game]
  cases h with c hc,
  use c,
  rw hc,
  rw succ_add,
  refl,

end

end mynat -- hide


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

! This file was ported from Lean 3 source module number_theory.divisors
! leanprover-community/mathlib commit 68d1483e8a718ec63219f0e227ca3f0140361086
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Order
import Mathbin.Data.Nat.Interval
import Mathbin.Data.Nat.Factors

/-!
# Divisor finsets

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

This file defines sets of divisors of a natural number. This is particularly useful as background
for defining Dirichlet convolution.

## Main Definitions
Let `n : ℕ`. All of the following definitions are in the `nat` namespace:
 * `divisors n` is the `finset` of natural numbers that divide `n`.
 * `proper_divisors n` is the `finset` of natural numbers that divide `n`, other than `n`.
 * `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
 * `perfect n` is true when `n` is positive and the sum of `proper_divisors n` is `n`.

## Implementation details
 * `divisors 0`, `proper_divisors 0`, and `divisors_antidiagonal 0` are defined to be `∅`.

## Tags
divisors, perfect numbers

-/

open Classical

open BigOperators

open Finset

namespace Nat

variable (n : ℕ)

#print Nat.divisors /-
/-- `divisors n` is the `finset` of divisors of `n`. As a special case, `divisors 0 = ∅`. -/
def divisors : Finset ℕ :=
  Finset.filter (fun x : ℕ => x ∣ n) (Finset.Ico 1 (n + 1))
#align nat.divisors Nat.divisors
-/

#print Nat.properDivisors /-
/-- `proper_divisors n` is the `finset` of divisors of `n`, other than `n`.
  As a special case, `proper_divisors 0 = ∅`. -/
def properDivisors : Finset ℕ :=
  Finset.filter (fun x : ℕ => x ∣ n) (Finset.Ico 1 n)
#align nat.proper_divisors Nat.properDivisors
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Nat.divisorsAntidiagonal /-
/-- `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
  As a special case, `divisors_antidiagonal 0 = ∅`. -/
def divisorsAntidiagonal : Finset (ℕ × ℕ) :=
  (Ico 1 (n + 1) ×ˢ Ico 1 (n + 1)).filterₓ fun x => x.fst * x.snd = n
#align nat.divisors_antidiagonal Nat.divisorsAntidiagonal
-/

variable {n}

/- warning: nat.filter_dvd_eq_divisors -> Nat.filter_dvd_eq_divisors is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} (Finset.{0} Nat) (Finset.filter.{0} Nat (fun (_x : Nat) => Dvd.Dvd.{0} Nat Nat.hasDvd _x n) (fun (a : Nat) => Nat.decidableDvd a n) (Finset.range (Nat.succ n))) (Nat.divisors n))
but is expected to have type
  forall {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} (Finset.{0} Nat) (Finset.filter.{0} Nat (fun (_x : Nat) => Dvd.dvd.{0} Nat Nat.instDvdNat _x n) (fun (a : Nat) => Nat.decidable_dvd a n) (Finset.range (Nat.succ n))) (Nat.divisors n))
Case conversion may be inaccurate. Consider using '#align nat.filter_dvd_eq_divisors Nat.filter_dvd_eq_divisorsₓ'. -/
@[simp]
theorem filter_dvd_eq_divisors (h : n ≠ 0) : (Finset.range n.succ).filterₓ (· ∣ n) = n.divisors :=
  by
  ext
  simp only [divisors, mem_filter, mem_range, mem_Ico, and_congr_left_iff, iff_and_self]
  exact fun ha _ => succ_le_iff.mpr (pos_of_dvd_of_pos ha h.bot_lt)
#align nat.filter_dvd_eq_divisors Nat.filter_dvd_eq_divisors

/- warning: nat.filter_dvd_eq_proper_divisors -> Nat.filter_dvd_eq_properDivisors is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} (Finset.{0} Nat) (Finset.filter.{0} Nat (fun (_x : Nat) => Dvd.Dvd.{0} Nat Nat.hasDvd _x n) (fun (a : Nat) => Nat.decidableDvd a n) (Finset.range n)) (Nat.properDivisors n))
but is expected to have type
  forall {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} (Finset.{0} Nat) (Finset.filter.{0} Nat (fun (_x : Nat) => Dvd.dvd.{0} Nat Nat.instDvdNat _x n) (fun (a : Nat) => Nat.decidable_dvd a n) (Finset.range n)) (Nat.properDivisors n))
Case conversion may be inaccurate. Consider using '#align nat.filter_dvd_eq_proper_divisors Nat.filter_dvd_eq_properDivisorsₓ'. -/
@[simp]
theorem filter_dvd_eq_properDivisors (h : n ≠ 0) :
    (Finset.range n).filterₓ (· ∣ n) = n.properDivisors :=
  by
  ext
  simp only [proper_divisors, mem_filter, mem_range, mem_Ico, and_congr_left_iff, iff_and_self]
  exact fun ha _ => succ_le_iff.mpr (pos_of_dvd_of_pos ha h.bot_lt)
#align nat.filter_dvd_eq_proper_divisors Nat.filter_dvd_eq_properDivisors

#print Nat.properDivisors.not_self_mem /-
theorem properDivisors.not_self_mem : ¬n ∈ properDivisors n := by simp [proper_divisors]
#align nat.proper_divisors.not_self_mem Nat.properDivisors.not_self_mem
-/

#print Nat.mem_properDivisors /-
@[simp]
theorem mem_properDivisors {m : ℕ} : n ∈ properDivisors m ↔ n ∣ m ∧ n < m :=
  by
  rcases eq_or_ne m 0 with (rfl | hm); · simp [proper_divisors]
  simp only [and_comm', ← filter_dvd_eq_proper_divisors hm, mem_filter, mem_range]
#align nat.mem_proper_divisors Nat.mem_properDivisors
-/

/- warning: nat.insert_self_proper_divisors -> Nat.insert_self_properDivisors is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} (Finset.{0} Nat) (Insert.insert.{0, 0} Nat (Finset.{0} Nat) (Finset.hasInsert.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b)) n (Nat.properDivisors n)) (Nat.divisors n))
but is expected to have type
  forall {n : Nat}, (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} (Finset.{0} Nat) (Insert.insert.{0, 0} Nat (Finset.{0} Nat) (Finset.instInsertFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b)) n (Nat.properDivisors n)) (Nat.divisors n))
Case conversion may be inaccurate. Consider using '#align nat.insert_self_proper_divisors Nat.insert_self_properDivisorsₓ'. -/
theorem insert_self_properDivisors (h : n ≠ 0) : insert n (properDivisors n) = divisors n := by
  rw [divisors, proper_divisors, Ico_succ_right_eq_insert_Ico (one_le_iff_ne_zero.2 h),
    Finset.filter_insert, if_pos (dvd_refl n)]
#align nat.insert_self_proper_divisors Nat.insert_self_properDivisors

#print Nat.cons_self_properDivisors /-
theorem cons_self_properDivisors (h : n ≠ 0) :
    cons n (properDivisors n) properDivisors.not_self_mem = divisors n := by
  rw [cons_eq_insert, insert_self_proper_divisors h]
#align nat.cons_self_proper_divisors Nat.cons_self_properDivisors
-/

#print Nat.mem_divisors /-
@[simp]
theorem mem_divisors {m : ℕ} : n ∈ divisors m ↔ n ∣ m ∧ m ≠ 0 :=
  by
  rcases eq_or_ne m 0 with (rfl | hm); · simp [divisors]
  simp only [hm, Ne.def, not_false_iff, and_true_iff, ← filter_dvd_eq_divisors hm, mem_filter,
    mem_range, and_iff_right_iff_imp, lt_succ_iff]
  exact le_of_dvd hm.bot_lt
#align nat.mem_divisors Nat.mem_divisors
-/

#print Nat.one_mem_divisors /-
theorem one_mem_divisors : 1 ∈ divisors n ↔ n ≠ 0 := by simp
#align nat.one_mem_divisors Nat.one_mem_divisors
-/

#print Nat.mem_divisors_self /-
theorem mem_divisors_self (n : ℕ) (h : n ≠ 0) : n ∈ n.divisors :=
  mem_divisors.2 ⟨dvd_rfl, h⟩
#align nat.mem_divisors_self Nat.mem_divisors_self
-/

#print Nat.dvd_of_mem_divisors /-
theorem dvd_of_mem_divisors {m : ℕ} (h : n ∈ divisors m) : n ∣ m :=
  by
  cases m
  · apply dvd_zero
  · simp [mem_divisors.1 h]
#align nat.dvd_of_mem_divisors Nat.dvd_of_mem_divisors
-/

#print Nat.mem_divisorsAntidiagonal /-
@[simp]
theorem mem_divisorsAntidiagonal {x : ℕ × ℕ} :
    x ∈ divisorsAntidiagonal n ↔ x.fst * x.snd = n ∧ n ≠ 0 :=
  by
  simp only [divisors_antidiagonal, Finset.mem_Ico, Ne.def, Finset.mem_filter, Finset.mem_product]
  rw [and_comm']
  apply and_congr_right
  rintro rfl
  constructor <;> intro h
  · contrapose! h
    simp [h]
  · rw [Nat.lt_add_one_iff, Nat.lt_add_one_iff]
    rw [mul_eq_zero, Decidable.not_or_iff_and_not] at h
    simp only [succ_le_of_lt (Nat.pos_of_ne_zero h.1), succ_le_of_lt (Nat.pos_of_ne_zero h.2),
      true_and_iff]
    exact
      ⟨le_mul_of_pos_right (Nat.pos_of_ne_zero h.2), le_mul_of_pos_left (Nat.pos_of_ne_zero h.1)⟩
#align nat.mem_divisors_antidiagonal Nat.mem_divisorsAntidiagonal
-/

variable {n}

#print Nat.divisor_le /-
theorem divisor_le {m : ℕ} : n ∈ divisors m → n ≤ m :=
  by
  cases m
  · simp
  simp only [mem_divisors, m.succ_ne_zero, and_true_iff, Ne.def, not_false_iff]
  exact Nat.le_of_dvd (Nat.succ_pos m)
#align nat.divisor_le Nat.divisor_le
-/

#print Nat.divisors_subset_of_dvd /-
theorem divisors_subset_of_dvd {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) : divisors m ⊆ divisors n :=
  Finset.subset_iff.2 fun x hx => Nat.mem_divisors.mpr ⟨(Nat.mem_divisors.mp hx).1.trans h, hzero⟩
#align nat.divisors_subset_of_dvd Nat.divisors_subset_of_dvd
-/

#print Nat.divisors_subset_properDivisors /-
theorem divisors_subset_properDivisors {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) (hdiff : m ≠ n) :
    divisors m ⊆ properDivisors n := by
  apply Finset.subset_iff.2
  intro x hx
  exact
    Nat.mem_properDivisors.2
      ⟨(Nat.mem_divisors.1 hx).1.trans h,
        lt_of_le_of_lt (divisor_le hx)
          (lt_of_le_of_ne (divisor_le (Nat.mem_divisors.2 ⟨h, hzero⟩)) hdiff)⟩
#align nat.divisors_subset_proper_divisors Nat.divisors_subset_properDivisors
-/

#print Nat.divisors_zero /-
@[simp]
theorem divisors_zero : divisors 0 = ∅ := by
  ext
  simp
#align nat.divisors_zero Nat.divisors_zero
-/

#print Nat.properDivisors_zero /-
@[simp]
theorem properDivisors_zero : properDivisors 0 = ∅ :=
  by
  ext
  simp
#align nat.proper_divisors_zero Nat.properDivisors_zero
-/

#print Nat.properDivisors_subset_divisors /-
theorem properDivisors_subset_divisors : properDivisors n ⊆ divisors n :=
  filter_subset_filter _ <| Ico_subset_Ico_right n.le_succ
#align nat.proper_divisors_subset_divisors Nat.properDivisors_subset_divisors
-/

#print Nat.divisors_one /-
@[simp]
theorem divisors_one : divisors 1 = {1} := by
  ext
  simp
#align nat.divisors_one Nat.divisors_one
-/

#print Nat.properDivisors_one /-
@[simp]
theorem properDivisors_one : properDivisors 1 = ∅ := by rw [proper_divisors, Ico_self, filter_empty]
#align nat.proper_divisors_one Nat.properDivisors_one
-/

#print Nat.pos_of_mem_divisors /-
theorem pos_of_mem_divisors {m : ℕ} (h : m ∈ n.divisors) : 0 < m :=
  by
  cases m
  · rw [mem_divisors, zero_dvd_iff] at h
    cases h.2 h.1
  apply Nat.succ_pos
#align nat.pos_of_mem_divisors Nat.pos_of_mem_divisors
-/

#print Nat.pos_of_mem_properDivisors /-
theorem pos_of_mem_properDivisors {m : ℕ} (h : m ∈ n.properDivisors) : 0 < m :=
  pos_of_mem_divisors (properDivisors_subset_divisors h)
#align nat.pos_of_mem_proper_divisors Nat.pos_of_mem_properDivisors
-/

#print Nat.one_mem_properDivisors_iff_one_lt /-
theorem one_mem_properDivisors_iff_one_lt : 1 ∈ n.properDivisors ↔ 1 < n := by
  rw [mem_proper_divisors, and_iff_right (one_dvd _)]
#align nat.one_mem_proper_divisors_iff_one_lt Nat.one_mem_properDivisors_iff_one_lt
-/

#print Nat.divisorsAntidiagonal_zero /-
@[simp]
theorem divisorsAntidiagonal_zero : divisorsAntidiagonal 0 = ∅ :=
  by
  ext
  simp
#align nat.divisors_antidiagonal_zero Nat.divisorsAntidiagonal_zero
-/

#print Nat.divisorsAntidiagonal_one /-
@[simp]
theorem divisorsAntidiagonal_one : divisorsAntidiagonal 1 = {(1, 1)} :=
  by
  ext
  simp [Nat.mul_eq_one_iff, Prod.ext_iff]
#align nat.divisors_antidiagonal_one Nat.divisorsAntidiagonal_one
-/

#print Nat.swap_mem_divisorsAntidiagonal /-
@[simp]
theorem swap_mem_divisorsAntidiagonal {x : ℕ × ℕ} :
    x.symm ∈ divisorsAntidiagonal n ↔ x ∈ divisorsAntidiagonal n := by
  rw [mem_divisors_antidiagonal, mem_divisors_antidiagonal, mul_comm, Prod.swap]
#align nat.swap_mem_divisors_antidiagonal Nat.swap_mem_divisorsAntidiagonal
-/

#print Nat.fst_mem_divisors_of_mem_antidiagonal /-
theorem fst_mem_divisors_of_mem_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisorsAntidiagonal n) :
    x.fst ∈ divisors n := by
  rw [mem_divisors_antidiagonal] at h
  simp [Dvd.intro _ h.1, h.2]
#align nat.fst_mem_divisors_of_mem_antidiagonal Nat.fst_mem_divisors_of_mem_antidiagonal
-/

#print Nat.snd_mem_divisors_of_mem_antidiagonal /-
theorem snd_mem_divisors_of_mem_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisorsAntidiagonal n) :
    x.snd ∈ divisors n := by
  rw [mem_divisors_antidiagonal] at h
  simp [Dvd.intro_left _ h.1, h.2]
#align nat.snd_mem_divisors_of_mem_antidiagonal Nat.snd_mem_divisors_of_mem_antidiagonal
-/

#print Nat.map_swap_divisorsAntidiagonal /-
@[simp]
theorem map_swap_divisorsAntidiagonal :
    (divisorsAntidiagonal n).map (Equiv.prodComm _ _).toEmbedding = divisorsAntidiagonal n :=
  by
  rw [← coe_inj, coe_map, Equiv.coe_toEmbedding, Equiv.coe_prodComm,
    Set.image_swap_eq_preimage_swap]
  ext
  exact swap_mem_divisors_antidiagonal
#align nat.map_swap_divisors_antidiagonal Nat.map_swap_divisorsAntidiagonal
-/

/- warning: nat.image_fst_divisors_antidiagonal -> Nat.image_fst_divisorsAntidiagonal is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, Eq.{1} (Finset.{0} Nat) (Finset.image.{0, 0} (Prod.{0, 0} Nat Nat) Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Prod.fst.{0, 0} Nat Nat) (Nat.divisorsAntidiagonal n)) (Nat.divisors n)
but is expected to have type
  forall {n : Nat}, Eq.{1} (Finset.{0} Nat) (Finset.image.{0, 0} (Prod.{0, 0} Nat Nat) Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Prod.fst.{0, 0} Nat Nat) (Nat.divisorsAntidiagonal n)) (Nat.divisors n)
Case conversion may be inaccurate. Consider using '#align nat.image_fst_divisors_antidiagonal Nat.image_fst_divisorsAntidiagonalₓ'. -/
@[simp]
theorem image_fst_divisorsAntidiagonal : (divisorsAntidiagonal n).image Prod.fst = divisors n :=
  by
  ext
  simp [Dvd.Dvd, @eq_comm _ n (_ * _)]
#align nat.image_fst_divisors_antidiagonal Nat.image_fst_divisorsAntidiagonal

/- warning: nat.image_snd_divisors_antidiagonal -> Nat.image_snd_divisorsAntidiagonal is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, Eq.{1} (Finset.{0} Nat) (Finset.image.{0, 0} (Prod.{0, 0} Nat Nat) Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Prod.snd.{0, 0} Nat Nat) (Nat.divisorsAntidiagonal n)) (Nat.divisors n)
but is expected to have type
  forall {n : Nat}, Eq.{1} (Finset.{0} Nat) (Finset.image.{0, 0} (Prod.{0, 0} Nat Nat) Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Prod.snd.{0, 0} Nat Nat) (Nat.divisorsAntidiagonal n)) (Nat.divisors n)
Case conversion may be inaccurate. Consider using '#align nat.image_snd_divisors_antidiagonal Nat.image_snd_divisorsAntidiagonalₓ'. -/
@[simp]
theorem image_snd_divisorsAntidiagonal : (divisorsAntidiagonal n).image Prod.snd = divisors n :=
  by
  rw [← map_swap_divisors_antidiagonal, map_eq_image, image_image]
  exact image_fst_divisors_antidiagonal
#align nat.image_snd_divisors_antidiagonal Nat.image_snd_divisorsAntidiagonal

#print Nat.map_div_right_divisors /-
theorem map_div_right_divisors :
    n.divisors.map ⟨fun d => (d, n / d), fun p₁ p₂ => congr_arg Prod.fst⟩ =
      n.divisorsAntidiagonal :=
  by
  ext ⟨d, nd⟩
  simp only [mem_map, mem_divisors_antidiagonal, Function.Embedding.coeFn_mk, mem_divisors,
    Prod.ext_iff, exists_prop, and_left_comm, exists_eq_left]
  constructor
  · rintro ⟨⟨⟨k, rfl⟩, hn⟩, rfl⟩
    rw [Nat.mul_div_cancel_left _ (left_ne_zero_of_mul hn).bot_lt]
    exact ⟨rfl, hn⟩
  · rintro ⟨rfl, hn⟩
    exact ⟨⟨dvd_mul_right _ _, hn⟩, Nat.mul_div_cancel_left _ (left_ne_zero_of_mul hn).bot_lt⟩
#align nat.map_div_right_divisors Nat.map_div_right_divisors
-/

#print Nat.map_div_left_divisors /-
theorem map_div_left_divisors :
    n.divisors.map ⟨fun d => (n / d, d), fun p₁ p₂ => congr_arg Prod.snd⟩ =
      n.divisorsAntidiagonal :=
  by
  apply Finset.map_injective (Equiv.prodComm _ _).toEmbedding
  rw [map_swap_divisors_antidiagonal, ← map_div_right_divisors, Finset.map_map]
  rfl
#align nat.map_div_left_divisors Nat.map_div_left_divisors
-/

#print Nat.sum_divisors_eq_sum_properDivisors_add_self /-
theorem sum_divisors_eq_sum_properDivisors_add_self :
    (∑ i in divisors n, i) = (∑ i in properDivisors n, i) + n :=
  by
  rcases Decidable.eq_or_ne n 0 with (rfl | hn)
  · simp
  · rw [← cons_self_proper_divisors hn, Finset.sum_cons, add_comm]
#align nat.sum_divisors_eq_sum_proper_divisors_add_self Nat.sum_divisors_eq_sum_properDivisors_add_self
-/

#print Nat.Perfect /-
/-- `n : ℕ` is perfect if and only the sum of the proper divisors of `n` is `n` and `n`
  is positive. -/
def Perfect (n : ℕ) : Prop :=
  (∑ i in properDivisors n, i) = n ∧ 0 < n
#align nat.perfect Nat.Perfect
-/

#print Nat.perfect_iff_sum_properDivisors /-
theorem perfect_iff_sum_properDivisors (h : 0 < n) : Perfect n ↔ (∑ i in properDivisors n, i) = n :=
  and_iff_left h
#align nat.perfect_iff_sum_proper_divisors Nat.perfect_iff_sum_properDivisors
-/

#print Nat.perfect_iff_sum_divisors_eq_two_mul /-
theorem perfect_iff_sum_divisors_eq_two_mul (h : 0 < n) :
    Perfect n ↔ (∑ i in divisors n, i) = 2 * n :=
  by
  rw [perfect_iff_sum_proper_divisors h, sum_divisors_eq_sum_proper_divisors_add_self, two_mul]
  constructor <;> intro h
  · rw [h]
  · apply add_right_cancel h
#align nat.perfect_iff_sum_divisors_eq_two_mul Nat.perfect_iff_sum_divisors_eq_two_mul
-/

#print Nat.mem_divisors_prime_pow /-
theorem mem_divisors_prime_pow {p : ℕ} (pp : p.Prime) (k : ℕ) {x : ℕ} :
    x ∈ divisors (p ^ k) ↔ ∃ (j : ℕ)(H : j ≤ k), x = p ^ j := by
  rw [mem_divisors, Nat.dvd_prime_pow pp, and_iff_left (ne_of_gt (pow_pos pp.pos k))]
#align nat.mem_divisors_prime_pow Nat.mem_divisors_prime_pow
-/

/- warning: nat.prime.divisors -> Nat.Prime.divisors is a dubious translation:
lean 3 declaration is
  forall {p : Nat}, (Nat.Prime p) -> (Eq.{1} (Finset.{0} Nat) (Nat.divisors p) (Insert.insert.{0, 0} Nat (Finset.{0} Nat) (Finset.hasInsert.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b)) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))) (Singleton.singleton.{0, 0} Nat (Finset.{0} Nat) (Finset.hasSingleton.{0} Nat) p)))
but is expected to have type
  forall {p : Nat}, (Nat.Prime p) -> (Eq.{1} (Finset.{0} Nat) (Nat.divisors p) (Insert.insert.{0, 0} Nat (Finset.{0} Nat) (Finset.instInsertFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b)) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (Singleton.singleton.{0, 0} Nat (Finset.{0} Nat) (Finset.instSingletonFinset.{0} Nat) p)))
Case conversion may be inaccurate. Consider using '#align nat.prime.divisors Nat.Prime.divisorsₓ'. -/
theorem Prime.divisors {p : ℕ} (pp : p.Prime) : divisors p = {1, p} :=
  by
  ext
  rw [mem_divisors, dvd_prime pp, and_iff_left pp.ne_zero, Finset.mem_insert, Finset.mem_singleton]
#align nat.prime.divisors Nat.Prime.divisors

#print Nat.Prime.properDivisors /-
theorem Prime.properDivisors {p : ℕ} (pp : p.Prime) : properDivisors p = {1} := by
  rw [← erase_insert proper_divisors.not_self_mem, insert_self_proper_divisors pp.ne_zero,
    pp.divisors, pair_comm, erase_insert fun con => pp.ne_one (mem_singleton.1 Con)]
#align nat.prime.proper_divisors Nat.Prime.properDivisors
-/

#print Nat.divisors_prime_pow /-
theorem divisors_prime_pow {p : ℕ} (pp : p.Prime) (k : ℕ) :
    divisors (p ^ k) = (Finset.range (k + 1)).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
  by
  ext
  simp [mem_divisors_prime_pow, pp, Nat.lt_succ_iff, @eq_comm _ a]
#align nat.divisors_prime_pow Nat.divisors_prime_pow
-/

#print Nat.eq_properDivisors_of_subset_of_sum_eq_sum /-
theorem eq_properDivisors_of_subset_of_sum_eq_sum {s : Finset ℕ} (hsub : s ⊆ n.properDivisors) :
    ((∑ x in s, x) = ∑ x in n.properDivisors, x) → s = n.properDivisors :=
  by
  cases n
  · rw [proper_divisors_zero, subset_empty] at hsub
    simp [hsub]
  classical
    rw [← sum_sdiff hsub]
    intro h
    apply subset.antisymm hsub
    rw [← sdiff_eq_empty_iff_subset]
    contrapose h
    rw [← Ne.def, ← nonempty_iff_ne_empty] at h
    apply ne_of_lt
    rw [← zero_add (∑ x in s, x), ← add_assoc, add_zero]
    apply add_lt_add_right
    have hlt :=
      sum_lt_sum_of_nonempty h fun x hx => pos_of_mem_proper_divisors (sdiff_subset _ _ hx)
    simp only [sum_const_zero] at hlt
    apply hlt
#align nat.eq_proper_divisors_of_subset_of_sum_eq_sum Nat.eq_properDivisors_of_subset_of_sum_eq_sum
-/

#print Nat.sum_properDivisors_dvd /-
theorem sum_properDivisors_dvd (h : (∑ x in n.properDivisors, x) ∣ n) :
    (∑ x in n.properDivisors, x) = 1 ∨ (∑ x in n.properDivisors, x) = n :=
  by
  cases n
  · simp
  cases n
  · contrapose! h
    simp
  rw [or_iff_not_imp_right]
  intro ne_n
  have hlt : (∑ x in n.succ.succ.proper_divisors, x) < n.succ.succ :=
    lt_of_le_of_ne (Nat.le_of_dvd (Nat.succ_pos _) h) ne_n
  symm
  rw [← mem_singleton,
    eq_proper_divisors_of_subset_of_sum_eq_sum
      (singleton_subset_iff.2 (mem_proper_divisors.2 ⟨h, hlt⟩)) sum_singleton,
    mem_proper_divisors]
  refine' ⟨one_dvd _, Nat.succ_lt_succ (Nat.succ_pos _)⟩
#align nat.sum_proper_divisors_dvd Nat.sum_properDivisors_dvd
-/

#print Nat.Prime.prod_properDivisors /-
@[simp, to_additive]
theorem Prime.prod_properDivisors {α : Type _} [CommMonoid α] {p : ℕ} {f : ℕ → α} (h : p.Prime) :
    (∏ x in p.properDivisors, f x) = f 1 := by simp [h.proper_divisors]
#align nat.prime.prod_proper_divisors Nat.Prime.prod_properDivisors
#align nat.prime.sum_proper_divisors Nat.Prime.sum_properDivisors
-/

/- warning: nat.prime.prod_divisors -> Nat.Prime.prod_divisors is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CommMonoid.{u1} α] {p : Nat} {f : Nat -> α}, (Nat.Prime p) -> (Eq.{succ u1} α (Finset.prod.{u1, 0} α Nat _inst_1 (Nat.divisors p) (fun (x : Nat) => f x)) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (f p) (f (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CommMonoid.{u1} α] {p : Nat} {f : Nat -> α}, (Nat.Prime p) -> (Eq.{succ u1} α (Finset.prod.{u1, 0} α Nat _inst_1 (Nat.divisors p) (fun (x : Nat) => f x)) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (f p) (f (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))
Case conversion may be inaccurate. Consider using '#align nat.prime.prod_divisors Nat.Prime.prod_divisorsₓ'. -/
@[simp, to_additive]
theorem Prime.prod_divisors {α : Type _} [CommMonoid α] {p : ℕ} {f : ℕ → α} (h : p.Prime) :
    (∏ x in p.divisors, f x) = f p * f 1 := by
  rw [← cons_self_proper_divisors h.ne_zero, prod_cons, h.prod_proper_divisors]
#align nat.prime.prod_divisors Nat.Prime.prod_divisors
#align nat.prime.sum_divisors Nat.Prime.sum_divisors

#print Nat.properDivisors_eq_singleton_one_iff_prime /-
theorem properDivisors_eq_singleton_one_iff_prime : n.properDivisors = {1} ↔ n.Prime :=
  ⟨fun h => by
    have h1 := mem_singleton.2 rfl
    rw [← h, mem_proper_divisors] at h1
    refine' nat.prime_def_lt''.mpr ⟨h1.2, fun m hdvd => _⟩
    rw [← mem_singleton, ← h, mem_proper_divisors]
    have hle := Nat.le_of_dvd (lt_trans (Nat.succ_pos _) h1.2) hdvd
    exact Or.imp_left (fun hlt => ⟨hdvd, hlt⟩) hle.lt_or_eq, Prime.properDivisors⟩
#align nat.proper_divisors_eq_singleton_one_iff_prime Nat.properDivisors_eq_singleton_one_iff_prime
-/

#print Nat.sum_properDivisors_eq_one_iff_prime /-
theorem sum_properDivisors_eq_one_iff_prime : (∑ x in n.properDivisors, x) = 1 ↔ n.Prime :=
  by
  cases n
  · simp [Nat.not_prime_zero]
  cases n
  · simp [Nat.not_prime_one]
  rw [← proper_divisors_eq_singleton_one_iff_prime]
  refine' ⟨fun h => _, fun h => h.symm ▸ sum_singleton⟩
  rw [@eq_comm (Finset ℕ) _ _]
  apply
    eq_proper_divisors_of_subset_of_sum_eq_sum
      (singleton_subset_iff.2
        (one_mem_proper_divisors_iff_one_lt.2 (succ_lt_succ (Nat.succ_pos _))))
      (Eq.trans sum_singleton h.symm)
#align nat.sum_proper_divisors_eq_one_iff_prime Nat.sum_properDivisors_eq_one_iff_prime
-/

#print Nat.mem_properDivisors_prime_pow /-
theorem mem_properDivisors_prime_pow {p : ℕ} (pp : p.Prime) (k : ℕ) {x : ℕ} :
    x ∈ properDivisors (p ^ k) ↔ ∃ (j : ℕ)(H : j < k), x = p ^ j :=
  by
  rw [mem_proper_divisors, Nat.dvd_prime_pow pp, ← exists_and_right]
  simp only [exists_prop, and_assoc']
  apply exists_congr
  intro a
  constructor <;> intro h
  · rcases h with ⟨h_left, rfl, h_right⟩
    rwa [pow_lt_pow_iff pp.one_lt] at h_right
    simpa
  · rcases h with ⟨h_left, rfl⟩
    rwa [pow_lt_pow_iff pp.one_lt]
    simp [h_left, le_of_lt]
#align nat.mem_proper_divisors_prime_pow Nat.mem_properDivisors_prime_pow
-/

#print Nat.properDivisors_prime_pow /-
theorem properDivisors_prime_pow {p : ℕ} (pp : p.Prime) (k : ℕ) :
    properDivisors (p ^ k) = (Finset.range k).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
  by
  ext
  simp [mem_proper_divisors_prime_pow, pp, Nat.lt_succ_iff, @eq_comm _ a]
#align nat.proper_divisors_prime_pow Nat.properDivisors_prime_pow
-/

#print Nat.prod_properDivisors_prime_pow /-
@[simp, to_additive]
theorem prod_properDivisors_prime_pow {α : Type _} [CommMonoid α] {k p : ℕ} {f : ℕ → α}
    (h : p.Prime) : (∏ x in (p ^ k).properDivisors, f x) = ∏ x in range k, f (p ^ x) := by
  simp [h, proper_divisors_prime_pow]
#align nat.prod_proper_divisors_prime_pow Nat.prod_properDivisors_prime_pow
#align nat.sum_proper_divisors_prime_nsmul Nat.sum_properDivisors_prime_nsmul
-/

#print Nat.prod_divisors_prime_pow /-
@[simp, to_additive sum_divisors_prime_pow]
theorem prod_divisors_prime_pow {α : Type _} [CommMonoid α] {k p : ℕ} {f : ℕ → α} (h : p.Prime) :
    (∏ x in (p ^ k).divisors, f x) = ∏ x in range (k + 1), f (p ^ x) := by
  simp [h, divisors_prime_pow]
#align nat.prod_divisors_prime_pow Nat.prod_divisors_prime_pow
#align nat.sum_divisors_prime_pow Nat.sum_divisors_prime_pow
-/

#print Nat.prod_divisorsAntidiagonal /-
@[to_additive]
theorem prod_divisorsAntidiagonal {M : Type _} [CommMonoid M] (f : ℕ → ℕ → M) {n : ℕ} :
    (∏ i in n.divisorsAntidiagonal, f i.1 i.2) = ∏ i in n.divisors, f i (n / i) :=
  by
  rw [← map_div_right_divisors, Finset.prod_map]
  rfl
#align nat.prod_divisors_antidiagonal Nat.prod_divisorsAntidiagonal
#align nat.sum_divisors_antidiagonal Nat.sum_divisorsAntidiagonal
-/

#print Nat.prod_divisorsAntidiagonal' /-
@[to_additive]
theorem prod_divisorsAntidiagonal' {M : Type _} [CommMonoid M] (f : ℕ → ℕ → M) {n : ℕ} :
    (∏ i in n.divisorsAntidiagonal, f i.1 i.2) = ∏ i in n.divisors, f (n / i) i :=
  by
  rw [← map_swap_divisors_antidiagonal, Finset.prod_map]
  exact prod_divisors_antidiagonal fun i j => f j i
#align nat.prod_divisors_antidiagonal' Nat.prod_divisorsAntidiagonal'
#align nat.sum_divisors_antidiagonal' Nat.sum_divisorsAntidiagonal'
-/

/- warning: nat.prime_divisors_eq_to_filter_divisors_prime -> Nat.prime_divisors_eq_to_filter_divisors_prime is a dubious translation:
lean 3 declaration is
  forall (n : Nat), Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (Nat.factors n)) (Finset.filter.{0} Nat Nat.Prime (fun (a : Nat) => Nat.decidablePrime a) (Nat.divisors n))
but is expected to have type
  forall (n : Nat), Eq.{1} (Finset.{0} Nat) (List.toFinset.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (Nat.factors n)) (Finset.filter.{0} Nat Nat.Prime (fun (a : Nat) => Nat.decidablePrime a) (Nat.divisors n))
Case conversion may be inaccurate. Consider using '#align nat.prime_divisors_eq_to_filter_divisors_prime Nat.prime_divisors_eq_to_filter_divisors_primeₓ'. -/
/-- The factors of `n` are the prime divisors -/
theorem prime_divisors_eq_to_filter_divisors_prime (n : ℕ) :
    n.factors.toFinset = (divisors n).filterₓ Prime :=
  by
  rcases n.eq_zero_or_pos with (rfl | hn)
  · simp
  · ext q
    simpa [hn, hn.ne', mem_factors] using and_comm' (Prime q) (q ∣ n)
#align nat.prime_divisors_eq_to_filter_divisors_prime Nat.prime_divisors_eq_to_filter_divisors_prime

/- warning: nat.image_div_divisors_eq_divisors -> Nat.image_div_divisors_eq_divisors is a dubious translation:
lean 3 declaration is
  forall (n : Nat), Eq.{1} (Finset.{0} Nat) (Finset.image.{0, 0} Nat Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (fun (x : Nat) => HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) n x) (Nat.divisors n)) (Nat.divisors n)
but is expected to have type
  forall (n : Nat), Eq.{1} (Finset.{0} Nat) (Finset.image.{0, 0} Nat Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (fun (x : Nat) => HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) n x) (Nat.divisors n)) (Nat.divisors n)
Case conversion may be inaccurate. Consider using '#align nat.image_div_divisors_eq_divisors Nat.image_div_divisors_eq_divisorsₓ'. -/
@[simp]
theorem image_div_divisors_eq_divisors (n : ℕ) :
    image (fun x : ℕ => n / x) n.divisors = n.divisors :=
  by
  by_cases hn : n = 0; · simp [hn]
  ext
  constructor
  · rw [mem_image]
    rintro ⟨x, hx1, hx2⟩
    rw [mem_divisors] at *
    refine' ⟨_, hn⟩
    rw [← hx2]
    exact div_dvd_of_dvd hx1.1
  · rw [mem_divisors, mem_image]
    rintro ⟨h1, -⟩
    exact ⟨n / a, mem_divisors.mpr ⟨div_dvd_of_dvd h1, hn⟩, Nat.div_div_self h1 hn⟩
#align nat.image_div_divisors_eq_divisors Nat.image_div_divisors_eq_divisors

#print Nat.prod_div_divisors /-
@[simp, to_additive sum_div_divisors]
theorem prod_div_divisors {α : Type _} [CommMonoid α] (n : ℕ) (f : ℕ → α) :
    (∏ d in n.divisors, f (n / d)) = n.divisors.Prod f :=
  by
  by_cases hn : n = 0; · simp [hn]
  rw [← prod_image]
  · exact prod_congr (image_div_divisors_eq_divisors n) (by simp)
  · intro x hx y hy h
    rw [mem_divisors] at hx hy
    exact (div_eq_iff_eq_of_dvd_dvd hn hx.1 hy.1).mp h
#align nat.prod_div_divisors Nat.prod_div_divisors
#align nat.sum_div_divisors Nat.sum_div_divisors
-/

end Nat


/-
This file defines the boolean XOR constraint on n variables.

Authors: Cayden Codel, Marijn Heule, Jeremy Avigad
Carnegie Mellon University
-/

import basic
import cnf.literal cnf.assignment cnf.clause cnf.cnf cnf.explode
import data.list.basic data.finset.basic

universe u

-- Represents the type of the variable stored in the literal
variables {V : Type u}

/- An n-variable XOR constraint is a map from a list of bools to an output bool -/
def Xor (l : list bool) : bool := l.foldr bxor ff

namespace Xor

open clause
open nat list

/-! # eval -/
section eval

variables (τ : assignment V) (l l₁ l₂ : list (literal V)) (lit : literal V)

/- Evaluate the variables under the assignment according to typical XOR -/
protected def eval : bool := Xor (l.map (literal.eval τ))

@[simp] theorem eval_nil : Xor.eval τ [] = ff := rfl

@[simp] theorem eval_singleton : Xor.eval τ [lit] = lit.eval τ :=
by simp only [Xor.eval, Xor, map, bool.bxor_ff_right, foldr]

theorem eval_cons : Xor.eval τ (lit :: l) = bxor (lit.eval τ) (Xor.eval τ l) :=
by simp only [Xor.eval, Xor, foldr, foldr_map]

theorem eval_append :
  Xor.eval τ (l₁ ++ l₂) = bxor (Xor.eval τ l₁) (Xor.eval τ l₂) :=
begin
  induction l₁ with l ls ih,
  { simp only [bool.bxor_ff_left, eval_nil, nil_append] },
  { simp only [eval_cons, ih, cons_append, bool.bxor_assoc] }
end

/- Evaluates to true if an odd number of literals evaluates to true -/
theorem eval_eq_bodd_count_tt : Xor.eval τ l = bodd (clause.count_tt τ l) :=
begin
  induction l with l ls ih,
  { simp only [bodd_zero, eval_nil, count_tt_nil] },
  { cases h : (l.eval τ); { simp [Xor.eval_cons, count_tt_cons, h, ih] } }
end

theorem eval_eq_of_perm {l₁ l₂ : list (literal V)} : l₁ ~ l₂ →
  ∀ (τ : assignment V), Xor.eval τ l₁ = Xor.eval τ l₂ :=
begin
  intros hp τ,
  induction hp with x l₂ l₂' p IH  x y l₂  l₂ m₂ r₂ p₁ p₂ IH₁ IH₂,
  { refl },
  { simp [eval_cons, IH] },
  { simp [eval_cons, ← bool.bxor_assoc],
    rw bool.bxor_comm (literal.eval τ y) (literal.eval τ x) },
  { exact eq.trans IH₁ IH₂ }
end

open assignment

theorem eval_eq_of_eqod [decidable_eq V] {τ₁ τ₂ : assignment V} {l : list (literal V)} :
  (eqod τ₁ τ₂ (clause.vars l)) → Xor.eval τ₁ l = Xor.eval τ₂ l :=
begin
  induction l with l ls ih,
  { simp only [eqod_nil, Xor.eval_nil, forall_true_left, clause.vars_nil] },
  { intro h,
    simp only [Xor.eval_cons],
    rw eval_eq_of_eqod_of_var_mem h (mem_vars_of_mem (mem_cons_self l ls)),
    rw ih (eqod_subset (vars_subset_of_vars_cons l ls) h) }
end

end eval

end Xor


open classical

namespace classical.tools

variables p q : Prop
variables (α : Type) (r s : α → Prop)
variables a : α

lemma neg_imp_as_conj : ¬(p → q) → p ∧ ¬q :=
λ (h : ¬(p → q)),
  or.cases_on (em q)
    (λ (hq : q), absurd (λ (hhh : p), hq) h)
    (λ (hnq : ¬q),
       or.cases_on (em p)
         (λ (hp : p), ⟨hp, hnq⟩)
         (λ (hnp : ¬p), absurd (λ (hp : p), absurd hp hnp) h))

lemma conj_as_neg_imp : p ∧ ¬q → ¬(p → q):=
  λ (h : p ∧ ¬q), id (λ (c : p → q), absurd (c (h.left)) (h.right))

lemma rev_imp : (p → q) → ¬ q → ¬ p :=
  λ (hpq : p → q) (hnq : ¬q), id (λ (hp : p), absurd (hpq hp) hnq)

lemma dne (h : ¬ ¬ p) : p :=
  by_contradiction (assume h1: ¬ p, show false, from h h1)

lemma neg_universal_as_ex : ¬ (∀ x, ¬ r x) → ∃ x, r x :=
  λ (h : ¬∀ (x : α), ¬r x),
    by_contradiction
      (λ (c : ¬∃ (x : α), r x),
        rev_imp (¬∃ (x : α), r x) (∀ (x : α), ¬r x) forall_not_of_not_exists h c)

lemma dne_under_univ : (∀ z, ¬ ¬ r z) → (∀ z, r z) :=
  λ (h : ∀ (z : α), ¬¬r z) (z : α), dne (r z) (h z)

lemma contra_pos : (¬q → ¬p) → (p → q) :=
  λ (cp : ¬q → ¬p) (hp : p), dne q (id (λ (hnq : ¬q), absurd hp (cp hnq)))

lemma demorgan_or : ¬ (p ∨ q) → ¬ p ∧ ¬ q :=
  assume h : ¬ (p ∨ q),
    ⟨λ hp : p, h (or.inl hp), λ hq : q, h (or.inr hq)⟩

end classical.tools