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

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

/-!
# `ne_zero` typeclass

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

We create a typeclass `ne_zero n` which carries around the fact that `(n : R) ≠ 0`.

## Main declarations

* `ne_zero`: `n ≠ 0` as a typeclass.

-/

#print NeZero /-
/-- A type-class version of `n ≠ 0`.  -/
class NeZero {R} [Zero R] (n : R) : Prop where
  out : n ≠ 0
#align ne_zero NeZero
-/

#print NeZero.ne /-
theorem NeZero.ne {R} [Zero R] (n : R) [h : NeZero n] : n ≠ 0 :=
  h.out
#align ne_zero.ne NeZero.ne
-/

#print NeZero.ne' /-
theorem NeZero.ne' {R} [Zero R] (n : R) [h : NeZero n] : 0 ≠ n :=
  h.out.symm
#align ne_zero.ne' NeZero.ne'
-/

#print neZero_iff /-
theorem neZero_iff {R : Type _} [Zero R] {n : R} : NeZero n ↔ n ≠ 0 :=
  ⟨fun h => h.out, NeZero.mk⟩
#align ne_zero_iff neZero_iff
-/

#print not_neZero /-
theorem not_neZero {R : Type _} [Zero R] {n : R} : ¬NeZero n ↔ n = 0 := by simp [neZero_iff]
#align not_ne_zero not_neZero
-/

#print eq_zero_or_neZero /-
theorem eq_zero_or_neZero {α} [Zero α] (a : α) : a = 0 ∨ NeZero a :=
  (eq_or_ne a 0).imp_right NeZero.mk
#align eq_zero_or_ne_zero eq_zero_or_neZero
-/

section

variable {α : Type _} [Zero α] [One α]

#print zero_ne_one /-
@[simp]
theorem zero_ne_one [NeZero (1 : α)] : (0 : α) ≠ 1 :=
  NeZero.ne' (1 : α)
#align zero_ne_one zero_ne_one
-/

#print one_ne_zero /-
@[simp]
theorem one_ne_zero [NeZero (1 : α)] : (1 : α) ≠ 0 :=
  NeZero.ne (1 : α)
#align one_ne_zero one_ne_zero
-/

/- warning: two_ne_zero -> two_ne_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : One.{u1} α] [_inst_3 : Add.{u1} α] [_inst_4 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 2 (OfNat.mk.{u1} α 2 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2))))], Ne.{succ u1} α (OfNat.ofNat.{u1} α 2 (OfNat.mk.{u1} α 2 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : OfNat.{u1} α (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))] [_inst_3 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 2 _inst_2)], Ne.{succ u1} α (OfNat.ofNat.{u1} α 2 _inst_2) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align two_ne_zero two_ne_zeroₓ'. -/
theorem two_ne_zero [Add α] [NeZero (2 : α)] : (2 : α) ≠ 0 :=
  NeZero.ne (2 : α)
#align two_ne_zero two_ne_zero

/- warning: three_ne_zero -> three_ne_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : One.{u1} α] [_inst_3 : Add.{u1} α] [_inst_4 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 3 (OfNat.mk.{u1} α 3 (bit1.{u1} α _inst_2 _inst_3 (One.one.{u1} α _inst_2))))], Ne.{succ u1} α (OfNat.ofNat.{u1} α 3 (OfNat.mk.{u1} α 3 (bit1.{u1} α _inst_2 _inst_3 (One.one.{u1} α _inst_2)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : OfNat.{u1} α (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))] [_inst_3 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 3 _inst_2)], Ne.{succ u1} α (OfNat.ofNat.{u1} α 3 _inst_2) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align three_ne_zero three_ne_zeroₓ'. -/
theorem three_ne_zero [Add α] [NeZero (3 : α)] : (3 : α) ≠ 0 :=
  NeZero.ne (3 : α)
#align three_ne_zero three_ne_zero

/- warning: four_ne_zero -> four_ne_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : One.{u1} α] [_inst_3 : Add.{u1} α] [_inst_4 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 4 (OfNat.mk.{u1} α 4 (bit0.{u1} α _inst_3 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2)))))], Ne.{succ u1} α (OfNat.ofNat.{u1} α 4 (OfNat.mk.{u1} α 4 (bit0.{u1} α _inst_3 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2))))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : OfNat.{u1} α (OfNat.ofNat.{0} Nat 4 (instOfNatNat 4))] [_inst_3 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 4 _inst_2)], Ne.{succ u1} α (OfNat.ofNat.{u1} α 4 _inst_2) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align four_ne_zero four_ne_zeroₓ'. -/
theorem four_ne_zero [Add α] [NeZero (4 : α)] : (4 : α) ≠ 0 :=
  NeZero.ne (4 : α)
#align four_ne_zero four_ne_zero

#print ne_zero_of_eq_one /-
theorem ne_zero_of_eq_one [NeZero (1 : α)] {a : α} (h : a = 1) : a ≠ 0 :=
  calc
    a = 1 := h
    _ ≠ 0 := one_ne_zero

#align ne_zero_of_eq_one ne_zero_of_eq_one
-/

variable (α)

#print zero_ne_one' /-
theorem zero_ne_one' [NeZero (1 : α)] : (0 : α) ≠ 1 :=
  NeZero.ne' (1 : α)
#align zero_ne_one' zero_ne_one'
-/

#print one_ne_zero' /-
theorem one_ne_zero' [NeZero (1 : α)] : (1 : α) ≠ 0 :=
  NeZero.ne (1 : α)
#align one_ne_zero' one_ne_zero'
-/

/- warning: two_ne_zero' -> two_ne_zero' is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Zero.{u1} α] [_inst_2 : One.{u1} α] [_inst_3 : Add.{u1} α] [_inst_4 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 2 (OfNat.mk.{u1} α 2 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2))))], Ne.{succ u1} α (OfNat.ofNat.{u1} α 2 (OfNat.mk.{u1} α 2 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Zero.{u1} α] [_inst_2 : OfNat.{u1} α (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))] [_inst_3 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 2 _inst_2)], Ne.{succ u1} α (OfNat.ofNat.{u1} α 2 _inst_2) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align two_ne_zero' two_ne_zero'ₓ'. -/
theorem two_ne_zero' [Add α] [NeZero (2 : α)] : (2 : α) ≠ 0 :=
  NeZero.ne (2 : α)
#align two_ne_zero' two_ne_zero'

/- warning: three_ne_zero' -> three_ne_zero' is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Zero.{u1} α] [_inst_2 : One.{u1} α] [_inst_3 : Add.{u1} α] [_inst_4 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 3 (OfNat.mk.{u1} α 3 (bit1.{u1} α _inst_2 _inst_3 (One.one.{u1} α _inst_2))))], Ne.{succ u1} α (OfNat.ofNat.{u1} α 3 (OfNat.mk.{u1} α 3 (bit1.{u1} α _inst_2 _inst_3 (One.one.{u1} α _inst_2)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Zero.{u1} α] [_inst_2 : OfNat.{u1} α (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))] [_inst_3 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 3 _inst_2)], Ne.{succ u1} α (OfNat.ofNat.{u1} α 3 _inst_2) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align three_ne_zero' three_ne_zero'ₓ'. -/
theorem three_ne_zero' [Add α] [NeZero (3 : α)] : (3 : α) ≠ 0 :=
  NeZero.ne (3 : α)
#align three_ne_zero' three_ne_zero'

/- warning: four_ne_zero' -> four_ne_zero' is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Zero.{u1} α] [_inst_2 : One.{u1} α] [_inst_3 : Add.{u1} α] [_inst_4 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 4 (OfNat.mk.{u1} α 4 (bit0.{u1} α _inst_3 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2)))))], Ne.{succ u1} α (OfNat.ofNat.{u1} α 4 (OfNat.mk.{u1} α 4 (bit0.{u1} α _inst_3 (bit0.{u1} α _inst_3 (One.one.{u1} α _inst_2))))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Zero.{u1} α] [_inst_2 : OfNat.{u1} α (OfNat.ofNat.{0} Nat 4 (instOfNatNat 4))] [_inst_3 : NeZero.{u1} α _inst_1 (OfNat.ofNat.{u1} α 4 _inst_2)], Ne.{succ u1} α (OfNat.ofNat.{u1} α 4 _inst_2) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align four_ne_zero' four_ne_zero'ₓ'. -/
theorem four_ne_zero' [Add α] [NeZero (4 : α)] : (4 : α) ≠ 0 :=
  NeZero.ne (4 : α)
#align four_ne_zero' four_ne_zero'

end

namespace NeZero

variable {R S M F : Type _} {r : R} {x y : M} {n p : ℕ}

#print NeZero.succ /-
--{a : ℕ+}
instance succ : NeZero (n + 1) :=
  ⟨n.succ_ne_zero⟩
#align ne_zero.succ NeZero.succ
-/

#print NeZero.of_pos /-
theorem of_pos [Preorder M] [Zero M] (h : 0 < x) : NeZero x :=
  ⟨ne_of_gt h⟩
#align ne_zero.of_pos NeZero.of_pos
-/

instance coeTrans [Zero M] [Coe R S] [CoeTC S M] [h : NeZero (r : M)] : NeZero ((r : S) : M) :=
  ⟨h.out⟩
#align ne_zero.coe_trans NeZero.coeTrans

theorem trans [Zero M] [Coe R S] [CoeTC S M] (h : NeZero ((r : S) : M)) : NeZero (r : M) :=
  ⟨h.out⟩
#align ne_zero.trans NeZero.trans

end NeZero


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

import data.matrix.pequiv

noncomputable theory

open_locale big_operators matrix

namespace matrix

variables {n m α : Type*} [fintype n] [fintype m]

section

variables [has_zero α]

/-- A matrix as a finitely supported function -/
def finsupp (M : matrix n m α) : (n × m) →₀ α :=
  finsupp.of_support_finite (function.uncurry M) (set.to_finite _)

lemma finsupp_apply {M : matrix n m α} (i j) : M.finsupp (i, j) = M i j := rfl

end

lemma curry_finsupp_apply [add_comm_monoid α] (M : matrix n m α) (i j) :
  M.finsupp.curry i j = M i j :=
by rw [finsupp.curry_apply, finsupp_apply]

lemma mem_support_curry_finsupp [add_comm_monoid α] (M : matrix n m α) (i j) :
  j ∈ (M.finsupp.curry i).support ↔ M i j ≠ 0 :=
by rw [finsupp.mem_support_iff, curry_finsupp_apply]

lemma finsupp_smul [add_monoid α] {R : Type*} [smul_zero_class R α] (M : matrix n m α) (x : R) :
  (x • M).finsupp = x • M.finsupp :=
by ext ⟨i, j⟩; refl

namespace finsupp

variables [add_comm_monoid α] {M : matrix n m α}

lemma transpose :
  M.finsupp.map_domain prod.swap = Mᵀ.finsupp :=
begin
  ext ⟨j, i⟩,
  exact finsupp.map_domain_apply prod.swap_injective _ (i, j)
end

lemma transpose' :
  M.finsupp.equiv_map_domain (equiv.prod_comm n m) = Mᵀ.finsupp :=
begin
  ext ⟨j, i⟩,
  exact finsupp.equiv_map_domain_apply _ _ (j, i)
end

end finsupp

/-- The non-zero entries of `M` defined as the support of `M.finsupp`. -/
def support [has_zero α] (M : matrix n m α) : finset (n × m) := M.finsupp.support

section support

variable {M : matrix n m α}

section

variables [has_zero α]

lemma mem_support_iff' (a : n × m) : a ∈ M.support ↔ M a.1 a.2 ≠ 0 :=
  finsupp.mem_support_iff

lemma mem_support_iff (i j) : (i, j) ∈ M.support ↔ M i j ≠ 0 :=
  finsupp.mem_support_iff

lemma not_mem_support_iff (i j) : (i, j) ∉ M.support ↔ M i j = 0 :=
  finsupp.not_mem_support_iff

lemma mem_support_transpose (i j) : (i, j) ∈ Mᵀ.support ↔ M j i ≠ 0 :=
  mem_support_iff _ _

lemma support_transpose' :
  M.support.map (equiv.prod_comm n m).to_embedding = Mᵀ.support :=
begin
  ext ⟨i, j⟩,
  rw [finset.mem_map_equiv, equiv.prod_comm_symm, equiv.prod_comm_apply,
    prod.swap_prod_mk, mem_support_iff, mem_support_iff],
  refl
end

lemma card_support_transpose :
  Mᵀ.support.card = M.support.card :=
by rw [← support_transpose', finset.card_map]

lemma support_transpose [decidable_eq n] [decidable_eq m] :
  M.support.image prod.swap = Mᵀ.support :=
begin
  rw [← support_transpose', finset.map_eq_image], refl
end

end

variables [add_comm_monoid α]

lemma support_smul_eq {R : Type*} [semiring R] [module R α] [no_zero_smul_divisors R α]
  {x : R} (hx : x ≠ 0) :
  (x • M).support = M.support :=
by rw [support, finsupp_smul]; exact finsupp.support_smul_eq hx

lemma finsupp_eq_sum_row :
  M.finsupp = ∑ i, (M.finsupp.curry i).map_domain (prod.mk i) :=
begin
  classical,
  ext ⟨i, j⟩,
  have : ∑ i' in {i}ᶜ, (M.finsupp.curry i').map_domain (prod.mk i') (i, j) = 0,
  { apply finset.sum_eq_zero,
    intros _ hi',
    apply finsupp.map_domain_notin_range,
    rintro ⟨_, h⟩,
    rw [finset.mem_compl, finset.not_mem_singleton] at hi',
    exact hi' (prod.mk.inj h).1 },
  rw [finsupp.coe_finset_sum, finset.sum_apply, fintype.sum_eq_add_sum_compl i,
    finsupp.map_domain_apply (prod.mk.inj_left i), finsupp.curry_apply, this, add_zero]
end

lemma support_card_eq_sum_row :
  M.support.card = ∑ i, (M.finsupp.curry i).support.card :=
begin
  classical,
  conv_lhs { rw [support, finsupp_eq_sum_row] },
  have : ∀ i₁ i₂, i₁ ≠ i₂ → disjoint
    ((M.finsupp.curry i₁).map_domain (prod.mk i₁)).support
    ((M.finsupp.curry i₂).map_domain (prod.mk i₂)).support,
  { intros x y h,
    rw finset.disjoint_iff_ne,
    rintros ⟨i₁, j₁⟩ h₁ ⟨i₂, j₂⟩ h₂ h',
    rw [finsupp.map_domain_support_of_injective (prod.mk.inj_left _)] at h₁ h₂,
    all_goals { try { apply_instance } },
    rw [finset.mem_image] at h₁ h₂,
    rcases h₁ with ⟨a, _, ha⟩,
    rcases h₂ with ⟨b, _, hb⟩,
    rw [← ha, ← hb] at h',
    exact h (prod.mk.inj h').1 },
  rw [finsupp.support_sum_eq_bUnion _ this, finset.card_bUnion],
  apply finset.sum_congr rfl,
  intros i _,
  have h := prod.mk.inj_left i,
  rw [finsupp.map_domain_support_of_injective h, finset.card_image_of_injective _ h],
  { intros, apply this, assumption }
end

variables [has_one α] [ne_zero (1 : α)] [decidable_eq m] [decidable_eq n]

lemma _root_.equiv.card_support_to_matrix (σ : m ≃ n) :
  (σ.to_pequiv.to_matrix : matrix m n α).support.card = fintype.card m :=
begin
  suffices h : σ.to_pequiv.to_matrix.support = finset.univ.image (λ i, (i, σ i)),
  { rw [h, finset.card_image_of_injective, fintype.card],
    intros _ _ hp,
    exact (prod.mk.inj hp).1 },
  ext ⟨i, j⟩,
  rw [mem_support_iff, pequiv.to_matrix, equiv.to_pequiv_apply, finset.mem_image],
  simp_rw [option.mem_some_iff],
  rw [ne.ite_ne_right_iff (one_ne_zero' α)],
  simp_rw [prod.mk.inj_iff, finset.mem_univ, exists_true_left, exists_eq_left]
end

lemma _root_.equiv.card_support_to_matrix'
  [has_one α] [ne_zero (1 : α)] [decidable_eq n] (σ : m ≃ n) :
  (σ.to_pequiv.to_matrix : matrix m n α).support.card = fintype.card n :=
fintype.card_congr σ ▸ equiv.card_support_to_matrix σ

end support

end matrix


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import analysis.convex.function

/-!
# Quasiconvex and quasiconcave functions

This file defines quasiconvexity, quasiconcavity and quasilinearity of functions, which are
generalizations of unimodality and monotonicity. Convexity implies quasiconvexity, concavity implies
quasiconcavity, and monotonicity implies quasilinearity.

## Main declarations

* `quasiconvex_on 𝕜 s f`: Quasiconvexity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex.
* `quasiconcave_on 𝕜 s f`: Quasiconcavity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex.
* `quasilinear_on 𝕜 s f`: Quasilinearity of the function `f` on the set `s` with scalars `𝕜`. This
  means that `f` is both quasiconvex and quasiconcave.

## TODO

Prove that a quasilinear function between two linear orders is either monotone or antitone. This is
not hard but quite a pain to go about as there are many cases to consider.

## References

* https://en.wikipedia.org/wiki/Quasiconvex_function
-/

open function order_dual set

variables {𝕜 E F β : Type*}

section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section ordered_add_comm_monoid
variables (𝕜) [ordered_add_comm_monoid β] [has_smul 𝕜 E] (s : set E) (f : E → β)

/-- A function is quasiconvex if all its sublevels are convex.
This means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex. -/
def quasiconvex_on : Prop :=
∀ r, convex 𝕜 {x ∈ s | f x ≤ r}

/-- A function is quasiconcave if all its superlevels are convex.
This means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex. -/
def quasiconcave_on : Prop :=
∀ r, convex 𝕜 {x ∈ s | r ≤ f x}

/-- A function is quasilinear if it is both quasiconvex and quasiconcave.
This means that, for all `r`,
the sets `{x ∈ s | f x ≤ r}` and `{x ∈ s | r ≤ f x}` are `𝕜`-convex. -/
def quasilinear_on : Prop :=
quasiconvex_on 𝕜 s f ∧ quasiconcave_on 𝕜 s f

variables {𝕜 s f}

lemma quasiconvex_on.dual : quasiconvex_on 𝕜 s f → quasiconcave_on 𝕜 s (to_dual ∘ f) := id
lemma quasiconcave_on.dual : quasiconcave_on 𝕜 s f → quasiconvex_on 𝕜 s (to_dual ∘ f) := id
lemma quasilinear_on.dual : quasilinear_on 𝕜 s f → quasilinear_on 𝕜 s (to_dual ∘ f) := and.swap

lemma convex.quasiconvex_on_of_convex_le (hs : convex 𝕜 s) (h : ∀ r, convex 𝕜 {x | f x ≤ r}) :
  quasiconvex_on 𝕜 s f :=
λ r, hs.inter (h r)

lemma convex.quasiconcave_on_of_convex_ge (hs : convex 𝕜 s) (h : ∀ r, convex 𝕜 {x | r ≤ f x}) :
  quasiconcave_on 𝕜 s f :=
@convex.quasiconvex_on_of_convex_le 𝕜 E βᵒᵈ _ _ _ _ _ _ hs h

lemma quasiconvex_on.convex [is_directed β (≤)] (hf : quasiconvex_on 𝕜 s f) : convex 𝕜 s :=
λ x y hx hy a b ha hb hab,
  let ⟨z, hxz, hyz⟩ := exists_ge_ge (f x) (f y) in (hf _ ⟨hx, hxz⟩ ⟨hy, hyz⟩ ha hb hab).1

lemma quasiconcave_on.convex [is_directed β (≥)] (hf : quasiconcave_on 𝕜 s f) : convex 𝕜 s :=
hf.dual.convex

end ordered_add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid β]

section has_smul
variables [has_smul 𝕜 E] {s : set E} {f g : E → β}

lemma quasiconvex_on.sup (hf : quasiconvex_on 𝕜 s f) (hg : quasiconvex_on 𝕜 s g) :
  quasiconvex_on 𝕜 s (f ⊔ g) :=
begin
  intro r,
  simp_rw [pi.sup_def, sup_le_iff, ←set.sep_inter_sep],
  exact (hf r).inter (hg r),
end

lemma quasiconcave_on.inf (hf : quasiconcave_on 𝕜 s f) (hg : quasiconcave_on 𝕜 s g) :
  quasiconcave_on 𝕜 s (f ⊓ g) :=
hf.dual.sup hg

lemma quasiconvex_on_iff_le_max :
  quasiconvex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      f (a • x + b • y) ≤ max (f x) (f y) :=
⟨λ hf, ⟨hf.convex, λ x y hx hy a b ha hb hab,
  (hf _ ⟨hx, le_max_left _ _⟩ ⟨hy, le_max_right _ _⟩ ha hb hab).2⟩,
  λ hf r x y hx hy a b ha hb hab,
  ⟨hf.1 hx.1 hy.1 ha hb hab, (hf.2 hx.1 hy.1 ha hb hab).trans $ max_le hx.2 hy.2⟩⟩

lemma quasiconcave_on_iff_min_le :
  quasiconcave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      min (f x) (f y) ≤ f (a • x + b • y) :=
@quasiconvex_on_iff_le_max 𝕜 E βᵒᵈ _ _ _ _ _ _

lemma quasilinear_on_iff_mem_interval :
  quasilinear_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      f (a • x + b • y) ∈ interval (f x) (f y) :=
begin
  rw [quasilinear_on, quasiconvex_on_iff_le_max, quasiconcave_on_iff_min_le, and_and_and_comm,
    and_self],
  apply and_congr_right',
  simp_rw [←forall_and_distrib, interval, mem_Icc, and_comm],
end

lemma quasiconvex_on.convex_lt (hf : quasiconvex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x < r} :=
begin
  refine λ x y hx hy a b ha hb hab, _,
  have h := hf _ ⟨hx.1, le_max_left _ _⟩ ⟨hy.1, le_max_right _ _⟩ ha hb hab,
  exact ⟨h.1, h.2.trans_lt $ max_lt hx.2 hy.2⟩,
end

lemma quasiconcave_on.convex_gt (hf : quasiconcave_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | r < f x} :=
hf.dual.convex_lt r

end has_smul

section ordered_smul
variables [has_smul 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma convex_on.quasiconvex_on (hf : convex_on 𝕜 s f) : quasiconvex_on 𝕜 s f :=
hf.convex_le

lemma concave_on.quasiconcave_on (hf : concave_on 𝕜 s f) : quasiconcave_on 𝕜 s f :=
hf.convex_ge

end ordered_smul
end linear_ordered_add_comm_monoid
end add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E]
  [ordered_smul 𝕜 E] {s : set E} {f : E → β}

lemma monotone_on.quasiconvex_on (hf : monotone_on f s) (hs : convex 𝕜 s) : quasiconvex_on 𝕜 s f :=
hf.convex_le hs

lemma monotone_on.quasiconcave_on (hf : monotone_on f s) (hs : convex 𝕜 s) :
  quasiconcave_on 𝕜 s f :=
hf.convex_ge hs

lemma monotone_on.quasilinear_on (hf : monotone_on f s) (hs : convex 𝕜 s) : quasilinear_on 𝕜 s f :=
⟨hf.quasiconvex_on hs, hf.quasiconcave_on hs⟩

lemma antitone_on.quasiconvex_on (hf : antitone_on f s) (hs : convex 𝕜 s) : quasiconvex_on 𝕜 s f :=
hf.convex_le hs

lemma antitone_on.quasiconcave_on (hf : antitone_on f s) (hs : convex 𝕜 s) :
  quasiconcave_on 𝕜 s f :=
hf.convex_ge hs

lemma antitone_on.quasilinear_on (hf : antitone_on f s) (hs : convex 𝕜 s) : quasilinear_on 𝕜 s f :=
⟨hf.quasiconvex_on hs, hf.quasiconcave_on hs⟩

lemma monotone.quasiconvex_on (hf : monotone f) : quasiconvex_on 𝕜 univ f :=
(hf.monotone_on _).quasiconvex_on convex_univ

lemma monotone.quasiconcave_on (hf : monotone f) : quasiconcave_on 𝕜 univ f :=
(hf.monotone_on _).quasiconcave_on convex_univ

lemma monotone.quasilinear_on (hf : monotone f) : quasilinear_on 𝕜 univ f :=
⟨hf.quasiconvex_on, hf.quasiconcave_on⟩

lemma antitone.quasiconvex_on (hf : antitone f) : quasiconvex_on 𝕜 univ f :=
(hf.antitone_on _).quasiconvex_on convex_univ

lemma antitone.quasiconcave_on (hf : antitone f) : quasiconcave_on 𝕜 univ f :=
(hf.antitone_on _).quasiconcave_on convex_univ

lemma antitone.quasilinear_on (hf : antitone f) : quasilinear_on 𝕜 univ f :=
⟨hf.quasiconvex_on, hf.quasiconcave_on⟩

end linear_ordered_add_comm_monoid
end ordered_semiring


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

! This file was ported from Lean 3 source module algebra.regular.pow
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Hom.Iterate
import Mathbin.Algebra.Regular.Basic

/-!
# Regular elements

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

## Implementation details

Group powers and other definitions import a lot of the algebra hierarchy.
Lemmas about them are kept separate to be able to provide `is_regular` early in the
algebra hierarchy.

-/

variable {R : Type _} {a b : R}

section Monoid

variable [Monoid R]

/- warning: is_left_regular.pow -> IsLeftRegular.pow is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] (n : Nat), (IsLeftRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a) -> (IsLeftRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n))
but is expected to have type
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] (n : Nat), (IsLeftRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a) -> (IsLeftRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n))
Case conversion may be inaccurate. Consider using '#align is_left_regular.pow IsLeftRegular.powₓ'. -/
/-- Any power of a left-regular element is left-regular. -/
theorem IsLeftRegular.pow (n : ℕ) (rla : IsLeftRegular a) : IsLeftRegular (a ^ n) := by
  simp only [IsLeftRegular, ← mul_left_iterate, rla.iterate n]
#align is_left_regular.pow IsLeftRegular.pow

/- warning: is_right_regular.pow -> IsRightRegular.pow is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] (n : Nat), (IsRightRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a) -> (IsRightRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n))
but is expected to have type
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] (n : Nat), (IsRightRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a) -> (IsRightRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n))
Case conversion may be inaccurate. Consider using '#align is_right_regular.pow IsRightRegular.powₓ'. -/
/-- Any power of a right-regular element is right-regular. -/
theorem IsRightRegular.pow (n : ℕ) (rra : IsRightRegular a) : IsRightRegular (a ^ n) :=
  by
  rw [IsRightRegular, ← mul_right_iterate]
  exact rra.iterate n
#align is_right_regular.pow IsRightRegular.pow

/- warning: is_regular.pow -> IsRegular.pow is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] (n : Nat), (IsRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a) -> (IsRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n))
but is expected to have type
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] (n : Nat), (IsRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a) -> (IsRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n))
Case conversion may be inaccurate. Consider using '#align is_regular.pow IsRegular.powₓ'. -/
/-- Any power of a regular element is regular. -/
theorem IsRegular.pow (n : ℕ) (ra : IsRegular a) : IsRegular (a ^ n) :=
  ⟨IsLeftRegular.pow n ra.left, IsRightRegular.pow n ra.right⟩
#align is_regular.pow IsRegular.pow

/- warning: is_left_regular.pow_iff -> IsLeftRegular.pow_iff is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] {n : Nat}, (LT.lt.{0} Nat Nat.hasLt (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) n) -> (Iff (IsLeftRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n)) (IsLeftRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a))
but is expected to have type
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] {n : Nat}, (LT.lt.{0} Nat instLTNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) n) -> (Iff (IsLeftRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n)) (IsLeftRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a))
Case conversion may be inaccurate. Consider using '#align is_left_regular.pow_iff IsLeftRegular.pow_iffₓ'. -/
/-- An element `a` is left-regular if and only if a positive power of `a` is left-regular. -/
theorem IsLeftRegular.pow_iff {n : ℕ} (n0 : 0 < n) : IsLeftRegular (a ^ n) ↔ IsLeftRegular a :=
  by
  refine' ⟨_, IsLeftRegular.pow n⟩
  rw [← Nat.succ_pred_eq_of_pos n0, pow_succ']
  exact IsLeftRegular.of_mul
#align is_left_regular.pow_iff IsLeftRegular.pow_iff

/- warning: is_right_regular.pow_iff -> IsRightRegular.pow_iff is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] {n : Nat}, (LT.lt.{0} Nat Nat.hasLt (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) n) -> (Iff (IsRightRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n)) (IsRightRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a))
but is expected to have type
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] {n : Nat}, (LT.lt.{0} Nat instLTNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) n) -> (Iff (IsRightRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n)) (IsRightRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a))
Case conversion may be inaccurate. Consider using '#align is_right_regular.pow_iff IsRightRegular.pow_iffₓ'. -/
/-- An element `a` is right-regular if and only if a positive power of `a` is right-regular. -/
theorem IsRightRegular.pow_iff {n : ℕ} (n0 : 0 < n) : IsRightRegular (a ^ n) ↔ IsRightRegular a :=
  by
  refine' ⟨_, IsRightRegular.pow n⟩
  rw [← Nat.succ_pred_eq_of_pos n0, pow_succ]
  exact IsRightRegular.of_mul
#align is_right_regular.pow_iff IsRightRegular.pow_iff

/- warning: is_regular.pow_iff -> IsRegular.pow_iff is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] {n : Nat}, (LT.lt.{0} Nat Nat.hasLt (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) n) -> (Iff (IsRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n)) (IsRegular.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a))
but is expected to have type
  forall {R : Type.{u1}} {a : R} [_inst_1 : Monoid.{u1} R] {n : Nat}, (LT.lt.{0} Nat instLTNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) n) -> (Iff (IsRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) a n)) (IsRegular.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) a))
Case conversion may be inaccurate. Consider using '#align is_regular.pow_iff IsRegular.pow_iffₓ'. -/
/-- An element `a` is regular if and only if a positive power of `a` is regular. -/
theorem IsRegular.pow_iff {n : ℕ} (n0 : 0 < n) : IsRegular (a ^ n) ↔ IsRegular a :=
  ⟨fun h => ⟨(IsLeftRegular.pow_iff n0).mp h.left, (IsRightRegular.pow_iff n0).mp h.right⟩, fun h =>
    ⟨IsLeftRegular.pow n h.left, IsRightRegular.pow n h.right⟩⟩
#align is_regular.pow_iff IsRegular.pow_iff

end Monoid


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

Prime numbers.
-/
import data.nat.sqrt data.nat.gcd data.list.basic data.list.perm
open bool subtype

namespace nat
open decidable

/-- `prime p` means that `p` is a prime number, that is, a natural number
  at least 2 whose only divisors are `p` and `1`. -/
def prime (p : ℕ) := p ≥ 2 ∧ ∀ m ∣ p, m = 1 ∨ m = p

theorem prime.ge_two {p : ℕ} : prime p → p ≥ 2 := and.left

theorem prime.gt_one {p : ℕ} : prime p → p > 1 := prime.ge_two

lemma prime.ne_one {p : ℕ} (hp : p.prime) : p ≠ 1 :=
ne.symm $ (ne_of_lt hp.gt_one)

theorem prime_def_lt {p : ℕ} : prime p ↔ p ≥ 2 ∧ ∀ m < p, m ∣ p → m = 1 :=
and_congr_right $ λ p2, forall_congr $ λ m,
⟨λ h l d, (h d).resolve_right (ne_of_lt l),
 λ h d, (decidable.lt_or_eq_of_le $
   le_of_dvd (le_of_succ_le p2) d).imp_left (λ l, h l d)⟩

theorem prime_def_lt' {p : ℕ} : prime p ↔ p ≥ 2 ∧ ∀ m, 2 ≤ m → m < p → ¬ m ∣ p :=
prime_def_lt.trans $ and_congr_right $ λ p2, forall_congr $ λ m,
⟨λ h m2 l d, not_lt_of_ge m2 ((h l d).symm ▸ dec_trivial),
λ h l d, begin
  rcases m with _|_|m,
  { rw eq_zero_of_zero_dvd d at p2, revert p2, exact dec_trivial },
  { refl },
  { exact (h dec_trivial l).elim d }
end⟩

theorem prime_def_le_sqrt {p : ℕ} : prime p ↔ p ≥ 2 ∧
  ∀ m, 2 ≤ m → m ≤ sqrt p → ¬ m ∣ p :=
prime_def_lt'.trans $ and_congr_right $ λ p2,
⟨λ a m m2 l, a m m2 $ lt_of_le_of_lt l $ sqrt_lt_self p2,
 λ a, have ∀ {m k}, m ≤ k → 1 < m → p ≠ m * k, from
  λ m k mk m1 e, a m m1
    (le_sqrt.2 (e.symm ▸ mul_le_mul_left m mk)) ⟨k, e⟩,
  λ m m2 l ⟨k, e⟩, begin
    cases (le_total m k) with mk km,
    { exact this mk m2 e },
    { rw [mul_comm] at e,
      refine this km (lt_of_mul_lt_mul_right _ (zero_le m)) e,
      rwa [one_mul, ← e] }
  end⟩

/--
  This instance is slower than the instance `decidable_prime` defined below,
  but has the advantage that it works in the kernel.

  If you need to prove that a particular number is prime, in any case
  you should not use `dec_trivial`, but rather `by norm_num`, which is
  much faster.
  -/
def decidable_prime_1 (p : ℕ) : decidable (prime p) :=
decidable_of_iff' _ prime_def_lt'
local attribute [instance] decidable_prime_1

lemma prime.ne_zero {n : ℕ} (h : prime n) : n ≠ 0 :=
assume hn : n = 0,
have h2 : ¬ prime 0, from dec_trivial,
h2 (hn ▸ h)

theorem prime.pos {p : ℕ} (pp : prime p) : p > 0 :=
lt_of_succ_lt pp.gt_one

theorem not_prime_zero : ¬ prime 0 := dec_trivial

theorem not_prime_one : ¬ prime 1 := dec_trivial

theorem prime_two : prime 2 := dec_trivial

theorem prime_three : prime 3 := dec_trivial

theorem prime.pred_pos {p : ℕ} (pp : prime p) : pred p > 0 :=
lt_pred_iff.2 pp.gt_one

theorem succ_pred_prime {p : ℕ} (pp : prime p) : succ (pred p) = p :=
succ_pred_eq_of_pos pp.pos

theorem dvd_prime {p m : ℕ} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p :=
⟨λ d, pp.2 m d, λ h, h.elim (λ e, e.symm ▸ one_dvd _) (λ e, e.symm ▸ dvd_refl _)⟩

theorem dvd_prime_ge_two {p m : ℕ} (pp : prime p) (H : m ≥ 2) : m ∣ p ↔ m = p :=
(dvd_prime pp).trans $ or_iff_right_of_imp $ not.elim $ ne_of_gt H

theorem prime.not_dvd_one {p : ℕ} (pp : prime p) : ¬ p ∣ 1
| d := (not_le_of_gt pp.gt_one) $ le_of_dvd dec_trivial d

theorem not_prime_mul {a b : ℕ} (a1 : 1 < a) (b1 : 1 < b) : ¬ prime (a * b) :=
λ h, ne_of_lt (nat.mul_lt_mul_of_pos_left b1 (lt_of_succ_lt a1)) $
by simpa using (dvd_prime_ge_two h a1).1 (dvd_mul_right _ _)

section min_fac
  private lemma min_fac_lemma (n k : ℕ) (h : ¬ k * k > n) :
    sqrt n - k < sqrt n + 2 - k :=
  (nat.sub_lt_sub_right_iff $ le_sqrt.2 $ le_of_not_gt h).2 $
  nat.lt_add_of_pos_right dec_trivial

  def min_fac_aux (n : ℕ) : ℕ → ℕ | k :=
  if h : n < k * k then n else
  if k ∣ n then k else
  have _, from min_fac_lemma n k h,
  min_fac_aux (k + 2)
  using_well_founded {rel_tac :=
    λ _ _, `[exact ⟨_, measure_wf (λ k, sqrt n + 2 - k)⟩]}

  /-- Returns the smallest prime factor of `n ≠ 1`. -/
  def min_fac : ℕ → ℕ
  | 0 := 2
  | 1 := 1
  | (n+2) := if 2 ∣ n then 2 else min_fac_aux (n + 2) 3

  @[simp] theorem min_fac_zero : min_fac 0 = 2 := rfl
  @[simp] theorem min_fac_one : min_fac 1 = 1 := rfl

  theorem min_fac_eq : ∀ n, min_fac n = if 2 ∣ n then 2 else min_fac_aux n 3
  | 0     := rfl
  | 1     := by simp [show 2≠1, from dec_trivial]; rw min_fac_aux; refl
  | (n+2) :=
    have 2 ∣ n + 2 ↔ 2 ∣ n, from
      (nat.dvd_add_iff_left (by refl)).symm,
    by simp [min_fac, this]; congr

  private def min_fac_prop (n k : ℕ) :=
    k ≥ 2 ∧ k ∣ n ∧ ∀ m ≥ 2, m ∣ n → k ≤ m

  theorem min_fac_aux_has_prop {n : ℕ} (n2 : n ≥ 2) (nd2 : ¬ 2 ∣ n) :
    ∀ k i, k = 2*i+3 → (∀ m ≥ 2, m ∣ n → k ≤ m) → min_fac_prop n (min_fac_aux n k)
  | k := λ i e a, begin
    rw min_fac_aux,
    by_cases h : n < k*k; simp [h],
    { have pp : prime n :=
        prime_def_le_sqrt.2 ⟨n2, λ m m2 l d,
          not_lt_of_ge l $ lt_of_lt_of_le (sqrt_lt.2 h) (a m m2 d)⟩,
      from ⟨n2, dvd_refl _, λ m m2 d, le_of_eq
        ((dvd_prime_ge_two pp m2).1 d).symm⟩ },
    have k2 : 2 ≤ k, { subst e, exact dec_trivial },
    by_cases dk : k ∣ n; simp [dk],
    { exact ⟨k2, dk, a⟩ },
    { refine have _, from min_fac_lemma n k h,
        min_fac_aux_has_prop (k+2) (i+1)
          (by simp [e, left_distrib]) (λ m m2 d, _),
      cases nat.eq_or_lt_of_le (a m m2 d) with me ml,
      { subst me, contradiction },
      apply (nat.eq_or_lt_of_le ml).resolve_left, intro me,
      rw [← me, e] at d, change 2 * (i + 2) ∣ n at d,
      have := dvd_of_mul_right_dvd d, contradiction }
  end
  using_well_founded {rel_tac :=
    λ _ _, `[exact ⟨_, measure_wf (λ k, sqrt n + 2 - k)⟩]}

  theorem min_fac_has_prop {n : ℕ} (n1 : n ≠ 1) :
    min_fac_prop n (min_fac n) :=
  begin
    by_cases n0 : n = 0, {simp [n0, min_fac_prop, ge]},
    have n2 : 2 ≤ n, { revert n0 n1, rcases n with _|_|_; exact dec_trivial },
    simp [min_fac_eq],
    by_cases d2 : 2 ∣ n; simp [d2],
    { exact ⟨le_refl _, d2, λ k k2 d, k2⟩ },
    { refine min_fac_aux_has_prop n2 d2 3 0 rfl
        (λ m m2 d, (nat.eq_or_lt_of_le m2).resolve_left (mt _ d2)),
      exact λ e, e.symm ▸ d }
  end

  theorem min_fac_dvd (n : ℕ) : min_fac n ∣ n :=
  by by_cases n1 : n = 1;
     [exact n1.symm ▸ dec_trivial, exact (min_fac_has_prop n1).2.1]

  theorem min_fac_prime {n : ℕ} (n1 : n ≠ 1) : prime (min_fac n) :=
  let ⟨f2, fd, a⟩ := min_fac_has_prop n1 in
  prime_def_lt'.2 ⟨f2, λ m m2 l d, not_le_of_gt l (a m m2 (dvd_trans d fd))⟩

  theorem min_fac_le_of_dvd {n : ℕ} : ∀ {m : ℕ}, m ≥ 2 → m ∣ n → min_fac n ≤ m :=
  by by_cases n1 : n = 1;
    [exact λ m m2 d, n1.symm ▸ le_trans dec_trivial m2,
     exact (min_fac_has_prop n1).2.2]

  theorem min_fac_pos (n : ℕ) : min_fac n > 0 :=
  by by_cases n1 : n = 1;
     [exact n1.symm ▸ dec_trivial, exact (min_fac_prime n1).pos]

  theorem min_fac_le {n : ℕ} (H : n > 0) : min_fac n ≤ n :=
  le_of_dvd H (min_fac_dvd n)

  theorem prime_def_min_fac {p : ℕ} : prime p ↔ p ≥ 2 ∧ min_fac p = p :=
  ⟨λ pp, ⟨pp.ge_two,
    let ⟨f2, fd, a⟩ := min_fac_has_prop $ ne_of_gt pp.gt_one in
    ((dvd_prime pp).1 fd).resolve_left (ne_of_gt f2)⟩,
   λ ⟨p2, e⟩, e ▸ min_fac_prime (ne_of_gt p2)⟩

  /--
  This instance is faster in the virtual machine than `decidable_prime_1`,
  but slower in the kernel.

  If you need to prove that a particular number is prime, in any case
  you should not use `dec_trivial`, but rather `by norm_num`, which is
  much faster.
  -/
  instance decidable_prime (p : ℕ) : decidable (prime p) :=
  decidable_of_iff' _ prime_def_min_fac

  theorem not_prime_iff_min_fac_lt {n : ℕ} (n2 : n ≥ 2) : ¬ prime n ↔ min_fac n < n :=
  (not_congr $ prime_def_min_fac.trans $ and_iff_right n2).trans $
    (lt_iff_le_and_ne.trans $ and_iff_right $ min_fac_le $ le_of_succ_le n2).symm

end min_fac

theorem exists_dvd_of_not_prime {n : ℕ} (n2 : n ≥ 2) (np : ¬ prime n) :
  ∃ m, m ∣ n ∧ m ≠ 1 ∧ m ≠ n :=
⟨min_fac n, min_fac_dvd _, ne_of_gt (min_fac_prime (ne_of_gt n2)).gt_one,
  ne_of_lt $ (not_prime_iff_min_fac_lt n2).1 np⟩

theorem exists_dvd_of_not_prime2 {n : ℕ} (n2 : n ≥ 2) (np : ¬ prime n) :
  ∃ m, m ∣ n ∧ m ≥ 2 ∧ m < n :=
⟨min_fac n, min_fac_dvd _, (min_fac_prime (ne_of_gt n2)).ge_two,
  (not_prime_iff_min_fac_lt n2).1 np⟩

theorem exists_prime_and_dvd {n : ℕ} (n2 : n ≥ 2) : ∃ p, prime p ∧ p ∣ n :=
⟨min_fac n, min_fac_prime (ne_of_gt n2), min_fac_dvd _⟩

theorem exists_infinite_primes (n : ℕ) : ∃ p, p ≥ n ∧ prime p :=
let p := min_fac (fact n + 1) in
have f1 : fact n + 1 ≠ 1, from ne_of_gt $ succ_lt_succ $ fact_pos _,
have pp : prime p, from min_fac_prime f1,
have np : n ≤ p, from le_of_not_ge $ λ h,
  have h₁ : p ∣ fact n, from dvd_fact (min_fac_pos _) h,
  have h₂ : p ∣ 1, from (nat.dvd_add_iff_right h₁).2 (min_fac_dvd _),
  pp.not_dvd_one h₂,
⟨p, np, pp⟩

lemma prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = 2 ∨ p % 2 = 1 :=
(nat.mod_two_eq_zero_or_one p).elim
  (λ h, or.inl ((hp.2 2 (dvd_of_mod_eq_zero h)).resolve_left dec_trivial).symm)
  or.inr

theorem factors_lemma {k} : (k+2) / min_fac (k+2) < k+2 :=
div_lt_self dec_trivial (min_fac_prime dec_trivial).gt_one

/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → list ℕ
| 0 := []
| 1 := []
| n@(k+2) :=
  let m := min_fac n in have n / m < n := factors_lemma,
  m :: factors (n / m)

lemma mem_factors : ∀ {n p}, p ∈ factors n → prime p
| 0       := λ p, false.elim
| 1       := λ p, false.elim
| n@(k+2) := λ p h,
  let m := min_fac n in have n / m < n := factors_lemma,
  have h₁ : p = m ∨ p ∈ (factors (n / m)) :=
    (list.mem_cons_iff _ _ _).1 h,
  or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial)
    mem_factors

lemma prod_factors : ∀ {n}, 0 < n → list.prod (factors n) = n
| 0       := (lt_irrefl _).elim
| 1       := λ h, rfl
| n@(k+2) := λ h,
  let m := min_fac n in have n / m < n := factors_lemma,
  show list.prod (m :: factors (n / m)) = n, from
  have h₁ : 0 < n / m :=
    nat.pos_of_ne_zero $ λ h,
    have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h,
    by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this,
  by rw [list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)]

theorem prime.coprime_iff_not_dvd {p n : ℕ} (pp : prime p) : coprime p n ↔ ¬ p ∣ n :=
⟨λ co d, pp.not_dvd_one $ co.dvd_of_dvd_mul_left (by simp [d]),
 λ nd, coprime_of_dvd $ λ m m2 mp, ((dvd_prime_ge_two pp m2).1 mp).symm ▸ nd⟩

theorem prime.dvd_iff_not_coprime {p n : ℕ} (pp : prime p) : p ∣ n ↔ ¬ coprime p n :=
iff_not_comm.2 pp.coprime_iff_not_dvd

theorem prime.dvd_mul {p m n : ℕ} (pp : prime p) : p ∣ m * n ↔ p ∣ m ∨ p ∣ n :=
⟨λ H, or_iff_not_imp_left.2 $ λ h,
  (pp.coprime_iff_not_dvd.2 h).dvd_of_dvd_mul_left H,
 or.rec (λ h, dvd_mul_of_dvd_left h _) (λ h, dvd_mul_of_dvd_right h _)⟩

theorem prime.not_dvd_mul {p m n : ℕ} (pp : prime p)
  (Hm : ¬ p ∣ m) (Hn : ¬ p ∣ n) : ¬ p ∣ m * n :=
mt pp.dvd_mul.1 $ by simp [Hm, Hn]

theorem prime.dvd_of_dvd_pow {p m n : ℕ} (pp : prime p) (h : p ∣ m^n) : p ∣ m :=
by induction n with n IH;
   [exact pp.not_dvd_one.elim h,
    exact (pp.dvd_mul.1 h).elim IH id]

lemma prime.mul_eq_prime_pow_two_iff {x y p : ℕ} (hp : p.prime) (hx : x ≠ 1) (hy : y ≠ 1) :
  x * y = p ^ 2 ↔ x = p ∧ y = p :=
⟨λ h, have pdvdxy : p ∣ x * y, by rw h; simp [nat.pow_two],
begin
  wlog := hp.dvd_mul.1 pdvdxy using x y,
  cases case with a ha,
  have hap : a ∣ p, from ⟨y, by rwa [ha, nat.pow_two,
        mul_assoc, nat.mul_left_inj hp.pos, eq_comm] at h⟩,
  exact ((nat.dvd_prime hp).1 hap).elim
    (λ _, by clear_aux_decl; simp [*, nat.pow_two, nat.mul_left_inj hp.pos] at *
      {contextual := tt})
    (λ _, by clear_aux_decl; simp [*, nat.pow_two, mul_comm, mul_assoc,
      nat.mul_left_inj hp.pos, nat.mul_right_eq_self_iff hp.pos] at *
      {contextual := tt})
end,
λ ⟨h₁, h₂⟩, h₁.symm ▸ h₂.symm ▸ (nat.pow_two _).symm⟩

lemma prime.dvd_fact : ∀ {n p : ℕ} (hp : prime p), p ∣ n.fact ↔ p ≤ n
| 0 p hp := iff_of_false hp.not_dvd_one (not_le_of_lt hp.pos)
| (n+1) p hp := begin
  rw [fact_succ, hp.dvd_mul, prime.dvd_fact hp],
  exact ⟨λ h, h.elim (le_of_dvd (succ_pos _)) le_succ_of_le,
    λ h, (_root_.lt_or_eq_of_le h).elim (or.inr ∘ le_of_lt_succ)
      (λ h, or.inl $ by rw h)⟩
end

theorem prime.coprime_pow_of_not_dvd {p m a : ℕ} (pp : prime p) (h : ¬ p ∣ a) : coprime a (p^m) :=
(pp.coprime_iff_not_dvd.2 h).symm.pow_right _

theorem coprime_primes {p q : ℕ} (pp : prime p) (pq : prime q) : coprime p q ↔ p ≠ q :=
pp.coprime_iff_not_dvd.trans $ not_congr $ dvd_prime_ge_two pq pp.ge_two

theorem coprime_pow_primes {p q : ℕ} (n m : ℕ) (pp : prime p) (pq : prime q) (h : p ≠ q) :
  coprime (p^n) (q^m) :=
((coprime_primes pp pq).2 h).pow _ _

theorem coprime_or_dvd_of_prime {p} (pp : prime p) (i : ℕ) : coprime p i ∨ p ∣ i :=
by rw [pp.dvd_iff_not_coprime]; apply em

theorem dvd_prime_pow {p : ℕ} (pp : prime p) {m i : ℕ} : i ∣ (p^m) ↔ ∃ k ≤ m, i = p^k :=
begin
  induction m with m IH generalizing i, {simp [pow_succ, le_zero_iff] at *},
  by_cases p ∣ i,
  { cases h with a e, subst e,
    rw [pow_succ, mul_comm (p^m) p, nat.mul_dvd_mul_iff_left pp.pos, IH],
    split; intro h; rcases h with ⟨k, h, e⟩,
    { exact ⟨succ k, succ_le_succ h, by rw [mul_comm, e]; refl⟩ },
    cases k with k,
    { apply pp.not_dvd_one.elim,
      simp at e, rw ← e, apply dvd_mul_right },
    { refine ⟨k, le_of_succ_le_succ h, _⟩,
      rwa [mul_comm, pow_succ, nat.mul_right_inj pp.pos] at e } },
  { split; intro d,
    { rw (pp.coprime_pow_of_not_dvd h).eq_one_of_dvd d,
      exact ⟨0, zero_le _, rfl⟩ },
    { rcases d with ⟨k, l, e⟩,
      rw e, exact pow_dvd_pow _ l } }
end

section
open list

lemma mem_list_primes_of_dvd_prod {p : ℕ} (hp : prime p) :
  ∀ {l : list ℕ}, (∀ p ∈ l, prime p) → p ∣ prod l → p ∈ l
| []       := λ h₁ h₂, absurd h₂ (prime.not_dvd_one hp)
| (q :: l) := λ h₁ h₂,
  have h₃ : p ∣ q * prod l := @prod_cons _ _ l q ▸ h₂,
  have hq : prime q := h₁ q (mem_cons_self _ _),
  or.cases_on ((prime.dvd_mul hp).1 h₃)
    (λ h, by rw [prime.dvd_iff_not_coprime hp, coprime_primes hp hq, ne.def, not_not] at h;
      exact h ▸ mem_cons_self _ _)
    (λ h, have hl : ∀ p ∈ l, prime p := λ p hlp, h₁ p ((mem_cons_iff _ _ _).2 (or.inr hlp)),
    (mem_cons_iff _ _ _).2 (or.inr (mem_list_primes_of_dvd_prod hl h)))

lemma mem_factors_iff_dvd {n p : ℕ} (hn : 0 < n) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
⟨λ h, prod_factors hn ▸ list.dvd_prod h,
 λ h, mem_list_primes_of_dvd_prod hp (@mem_factors n) ((prod_factors hn).symm ▸ h)⟩

lemma perm_of_prod_eq_prod : ∀ {l₁ l₂ : list ℕ}, prod l₁ = prod l₂ →
  (∀ p ∈ l₁, prime p) → (∀ p ∈ l₂, prime p) → l₁ ~ l₂
| []        []        _  _  _  := perm.nil
| []        (a :: l)  h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil ℕ _ ▸ h₁.symm ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₃ a (mem_cons_self _ _)))
| (a :: l)  []        h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil ℕ _ ▸ h₁ ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₂ a (mem_cons_self _ _)))
| (a :: l₁) (b :: l₂) h hl₁ hl₂ :=
  have hl₁' : ∀ p ∈ l₁, prime p := λ p hp, hl₁ p (mem_cons_of_mem _ hp),
  have hl₂' : ∀ p ∈ (b :: l₂).erase a, prime p := λ p hp, hl₂ p (mem_of_mem_erase hp),
  have ha : a ∈ (b :: l₂) := mem_list_primes_of_dvd_prod (hl₁ a (mem_cons_self _ _)) hl₂
    (h ▸ by rw prod_cons; exact dvd_mul_right _ _),
  have hb : b :: l₂ ~ a :: (b :: l₂).erase a := perm_erase ha,
  have hl : prod l₁ = prod ((b :: l₂).erase a) :=
  (nat.mul_left_inj (prime.pos (hl₁ a (mem_cons_self _ _)))).1 $
    by rwa [← prod_cons, ← prod_cons, ← prod_eq_of_perm hb],
  perm.trans (perm.skip _ (perm_of_prod_eq_prod hl hl₁' hl₂')) hb.symm

lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) : l ~ factors n :=
have hn : 0 < n := nat.pos_of_ne_zero $ λ h, begin
  rw h at *, clear h,
  induction l with a l hi,
  { exact absurd h₁ dec_trivial },
  { rw prod_cons at h₁,
    exact nat.mul_ne_zero (ne_of_lt (prime.pos (h₂ a (mem_cons_self _ _)))).symm
      (hi (λ p hp, h₂ p (mem_cons_of_mem _ hp))) h₁ }
end,
perm_of_prod_eq_prod (by rwa prod_factors hn) h₂ (@mem_factors _)

end

lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : prime p) {m n k l : ℕ}
      (hpm : p ^ k ∣ m) (hpn : p ^ l ∣ n) (hpmn : p ^ (k+l+1) ∣ m*n) :
      p ^ (k+1) ∣ m ∨ p ^ (l+1) ∣ n :=
have hpd : p^(k+l) * p ∣ m*n, from hpmn,
have hpd2 : p ∣ (m*n) / p ^ (k+l), from dvd_div_of_mul_dvd hpd,
have hpd3 : p ∣ (m*n) / (p^k * p^l), by simpa [nat.pow_add] using hpd2,
have hpd4 : p ∣ (m / p^k) * (n / p^l), by simpa [nat.div_mul_div hpm hpn] using hpd3,
have hpd5 : p ∣ (m / p^k) ∨ p ∣ (n / p^l), from (prime.dvd_mul p_prime).1 hpd4,
show p^k*p ∣ m ∨ p^l*p ∣ n, from
  hpd5.elim
    (assume : p ∣ m / p ^ k, or.inl $ mul_dvd_of_dvd_div hpm this)
    (assume : p ∣ n / p ^ l, or.inr $ mul_dvd_of_dvd_div hpn this)

end nat


/- Introduces a commutative semiring of zero-one-many. -/

import metastuff

@[derive decidable_eq]
inductive mult: Type
/- Zero represents assumptions which cannot be computed with,
   but could be used for typing, were I to implement dependent
   types in the embedded language. Since I didn't, zero is basically
   useless. -/
| Zero: mult
/- A one-multiplicity assumption can be used once in computation,
   i.e is linear. -/
| One: mult
/- A many-multiplicity assumption is non-linear and can be used
   multiple times. -/
| Many: mult

notation `ω` := mult.Many

namespace mult

instance : has_zero mult :=
  ⟨mult.Zero⟩

instance : has_one mult :=
  ⟨mult.One⟩

protected def add: mult → mult → mult
| 0 π := π
| π 0 := π
| 1 1 := ω
| ω _ := ω
| _ ω := ω

instance : has_add mult :=
  ⟨mult.add⟩

/- addition makes a commutative monoid -/

@[simp] lemma zero_add (π: mult)
  : 0 + π = π := by { cases π; refl }

@[simp] lemma add_zero (π: mult)
  : π + 0 = π := by { cases π; refl }

lemma zeros_left {π₁ π₂: mult}
  (h: π₁ + π₂ = 0)
  : π₁ = 0 := begin
  cases π₁; cases π₂; cases h,
  refl
end

lemma zeros_right {π₁ π₂: mult}
  (h: π₁ + π₂ = 0)
  : π₂ = 0 :=
begin
  cases π₁; cases π₂; cases h,
  refl
end

lemma add_comm (π₁ π₂: mult)
  : π₁ + π₂ = π₂ + π₁ :=
by { cases π₁; cases π₂; refl }

lemma add_assoc (π₁ π₂ π₃: mult)
  : π₁ + π₂ + π₃ = π₁ + (π₂ + π₃) :=
by { cases π₁; cases π₂; cases π₃; refl }

instance : add_comm_monoid mult :=
{ add := mult.add,
  zero := mult.Zero,
  zero_add := zero_add,
  add_zero := add_zero,
  add_comm := add_comm,
  add_assoc := add_assoc }

protected def mul: mult → mult → mult
| _ 0 := 0
| 0 _ := 0
| π 1 := π
| _ ω := ω

instance : has_mul mult :=
  ⟨mult.mul⟩

/- multiplication makes a commutative monoid -/

@[simp] lemma one_mul (π: mult)
  : 1 * π = π := by { cases π; refl }

@[simp] lemma mul_one (π: mult)
  : π * 1 = π := by { cases π; refl }

lemma mul_comm (π₁ π₂: mult)
  : π₁ * π₂ = π₂ * π₁ :=
by { cases π₁; cases π₂; refl }

lemma mul_assoc (π₁ π₂ π₃: mult)
  : π₁ * π₂ * π₃ = π₁ * (π₂ * π₃) :=
by { cases π₁; cases π₂; cases π₃; refl }

instance : comm_monoid mult :=
{ mul := mult.mul,
  one := mult.One,
  one_mul := one_mul,
  mul_one := mul_one,
  mul_comm := mul_comm,
  mul_assoc := mul_assoc }

/- mult with + and * makes a commutative semiring -/

@[simp] lemma zero_mul (π: mult)
  : 0 * π = 0 :=
by { cases π; refl }

@[simp] lemma mul_zero (π: mult)
  : π * 0 = 0 :=
by { cases π; refl }

@[sop_form] lemma left_distrib (π₁ π₂ π₃: mult)
  : π₁ * (π₂ + π₃) = π₁ * π₂ + π₁ * π₃ :=
by { cases π₁; cases π₂; cases π₃; refl }

@[sop_form] lemma right_distrib (π₁ π₂ π₃: mult)
  : (π₁ + π₂) * π₃ = π₁ * π₃ + π₂ * π₃ :=
by { cases π₁; cases π₂; cases π₃; refl }

instance : comm_semiring mult :=
{ zero_mul := zero_mul,
  mul_zero := mul_zero,
  left_distrib := left_distrib,
  right_distrib := right_distrib,
  ..mult.add_comm_monoid,
  ..mult.comm_monoid }

end mult


open interactive (parse)
open lean.parser (ident tk)
open tactic.interactive («have»)
open tactic (get_local infer_type to_expr)
open interactive.types (texpr location)

-- Using type class inference (carrier only):

class solution_type (α : Type) :=
(carrier : Type*)
(uncurry : α → carrier → ℕ)

instance base_case : solution_type ℕ :=
{ carrier := unit,
  uncurry := λ x _, x, }

instance rec_case (β : Type*) [g : solution_type β]: solution_type (ℕ → β) :=
{ carrier := ℕ × g.carrier,
  uncurry := λ (f : ℕ → β) (c : ℕ × g.carrier), solution_type.uncurry (f c.1) c.2  }

def solution {α : Type*} (objfun: α) [t : solution_type α] :=
{ x : t.carrier // let f := solution_type.uncurry objfun in ∀ x' : t.carrier, f x' ≤ f x}

set_option pp.implicit true

#reduce solution 3 -- unit; λ _, 3
#reduce solution (λ x, x + 3) -- nat x unit; λ z, z.1 + 3
#reduce solution (λ x y : ℕ, x + y) -- nat x nat x unit; λ z, z.1.1 + z.1.2

-- Using type class inference (carrier only):

class solution_type (α : Type) :=
(carrier : Type*)

instance base_case : solution_type ℕ :=
{ carrier := unit,}

instance rec_case (β : Type*) [g : solution_type β]: solution_type (ℕ → β) :=
{ carrier := ℕ × g.carrier  }

def solution {α : Type*} (objfun: α) [t : solution_type α] := t

set_option pp.implicit true

#reduce solution 3 -- unit
#reduce solution (λ x, x + 3) -- nat x unit
#reduce solution (λ x y : ℕ, x + y) -- nat x nat x unit

-- Using type class inference:

class solution_type {α : Type} (x : α) :=
(carrier : Type*)
(objfun : carrier → ℕ)

instance base_case (x : ℕ) : solution_type x :=
{ carrier := unit,
  objfun := λ _, x }

instance rec_case {β : Type*} (f : ℕ → β) [g : Π x : ℕ, solution_type (f x)]: solution_type f :=
{ carrier := unit,
  objfun := λ _, x }

def solution {α : Type*} (objfun: α) [t : solution_type objfun] := t

set_option pp.implicit true

#check solution 3
#check solution (λ x, x + 3)

-- Using tactics:

-- meta def tactic.blah (i: pexpr) (e : pexpr) : tactic unit :=
--  to_expr ``(∀ (x : %%i), %%e) >>= tactic.exact

meta def tactic.blah (i: pexpr) (e : pexpr) : tactic unit :=
do
 s <- to_expr (expr.pi `x binder_info.default ``(ℕ) ``(%%e)),
 tactic.exact  s

meta def tactic.interactive.blah  (i : parse texpr) (q : parse (tk "with" *> texpr)) : tactic unit :=
tactic.blah i q

lemma ss : begin blah (ℕ) with (x = 0), end := begin sorry end

example (a b j k : ℤ) (h₁ : a = b) (h₂ : j = k) :
  a + j = b + k :=
begin
  add_eq h₁ h₂,
  exact this
end

def foo {α : Type} (P Q : α → Prop) : Prop := (∃ x, P x) ∧ (∀ x, (P x → Q x))

notation `𝔽` binders `, ` s:(scoped Q, Q) ` >>' ` r:(scoped P, P) := foo s r

variables {α : Type} (P Q : α → Prop)

#check 𝔽 x, P x >>' Q x

def blah {α : Type*} : α → Prop := sorry

notation [parsing_only] `over` binders
`maximize` f:(scoped P, P)
`subject` s:(scoped P, P) := (f, s)

#check over (x y : ℕ) maximize x + y subject x - y > 0

#print notation

#check subtype

def problem := subtype (λ x, subtype (λ y, x + y > 0))

def x : problem := ⟨ 1, by simp⟩

def problem1 := @psigma ℕ (λ (x : ℕ), x>0)

def problem2 := Σ' (x : ℕ), Σ' (y : ℕ), ∀ x' y', x - y ≥ x' - y'

def objfun := λ (x : ℕ), λ (y : ℕ), x + y

def largest {β : Type*} [has_le β] (f : ℕ → β) := Σ' (x : ℕ), ∀ x', f x' ≤ f x

def problem3 := largest (λ (x : ℕ), largest (λ (y : ℕ), x + y))


import .cau_seq
import ..logic

namespace hidden

open myring
open ordered_myring
open myfield
open ordered_myfield

namespace cau_seq

private lemma class_setoid (f g : cau_seq) :
⟦f⟧ = ⟦g⟧ ↔ f ≈ g := iff.intro quotient.exact quotient.sound

theorem class_equiv {f g : cau_seq} :
⟦f⟧ = ⟦g⟧ ↔ cau_seq.equivalent f g  :=
begin
  split; assume h,
    rwa [←cau_seq.setoid_equiv, ←class_setoid],
  rwa [class_setoid, cau_seq.setoid_equiv],
end

variables f g : cau_seq

theorem neg_is_cauchy : is_cau_seq $ λ n, -f.val n :=
begin
  have hf := f.property,
  dsimp only [is_cau_seq] at *,
  intro ε,
  assume hε,
  cases hf ε hε with N hN,
  existsi N,
  intros n m,
  assume hn hm,
  have h := hN n m hn hm,
  rwa [sub_def, neg_neg, add_comm, ←sub_def, ←abs_neg, neg_sub],
end

def neg : cau_seq → cau_seq :=
λ f, ⟨λ n, -f.val n, neg_is_cauchy f⟩

instance : has_neg cau_seq := ⟨neg⟩

def neg_val {n : mynat}: (-f).val n = - f.val n := rfl

theorem neg_well_defined : f ≈ g → ⟦-f⟧ = ⟦-g⟧ :=
begin
  assume hfg,
  rw setoid_equiv at hfg,
  rw class_equiv,
  dsimp only [equivalent] at *,
  intros ε hε,
  cases hfg ε hε with N hN,
  existsi N,
  intros n hn,
  have h := hN n hn,
  rw [neg_val, neg_val],
  rwa [sub_def, neg_neg, add_comm, ←sub_def, ←abs_neg, neg_sub],
end

end cau_seq

def real := quotient cau_seq.real_setoid

namespace real

def coe_myrat (a : myrat) : real := ⟦⟨λ n, a, cau_seq.constant_cauchy a⟩⟧

instance : has_coe myrat real := ⟨coe_myrat⟩

theorem coe_def (a : myrat) : (↑a : real) = ⟦⟨λ n, a, cau_seq.constant_cauchy a⟩⟧ := rfl

instance : has_zero real := ⟨↑(0 : myrat)⟩

theorem real_zero : (0 : real) = ↑(0 : myrat) := rfl

instance : has_one real := ⟨↑(1 : myrat)⟩

theorem real_one : (1 : real) = ↑(1 : myrat) := rfl

def neg : real → real := quotient.lift (λ f, ⟦-f⟧) cau_seq.neg_well_defined

instance : has_neg real := ⟨neg⟩

theorem neg_eq_cls {x : real} {f : cau_seq} : x = ⟦f⟧ → -x = ⟦-f⟧ :=
λ hxf, by rw hxf; refl

theorem neg_val (f : cau_seq) (n : mynat): (-f).val n = -f.val n := rfl

-- Use this to prove things which hold
-- "trivially because there is a myrat theorem showing the sequences are the same"
theorem seq_eq_imp_real_eq {x y : real} {f g : cau_seq}: x = ⟦f⟧ → y = ⟦g⟧ →
(∀ n, f.val n = g.val n) → x = y :=
begin
  assume hxf hyg,
  subst hxf, subst hyg,
  assume heq,
  rw cau_seq.class_equiv,
  rw ←cau_seq.setoid_equiv,
  apply cau_seq.seq_eq_impl_cau_seq_equiv,
  assumption,
end

theorem coe_neg (a : myrat) : -↑a = (↑(-a) : real) :=
begin
  rw coe_def,
  rw coe_def,
  rw neg_eq_cls rfl,
  apply seq_eq_imp_real_eq rfl rfl,
  intros n,
  rw cau_seq.neg_val,
end

open classical

theorem eq_iff_coe_eq (a b : myrat) : (↑a : real) = ↑b ↔ a = b :=
begin
  rw [coe_def, coe_def, cau_seq.class_equiv],
  split; assume h, {
    unfold cau_seq.equivalent at h,
    rw ←sub_to_zero_iff_eq,
    rw ←abs_zero_iff_zero,
    apply ordered_myring.le_antisymm, {
      rw le_iff_lt_impl_lt,
      intros ε hε,
      cases h ε hε with N hN,
      apply hN N (@mynat.le_refl N),
    }, {
      exact abs_nonneg _,
    },
  }, {
    intros ε hε,
    existsi (0 : mynat),
    intros n hn,
    dsimp,
    rwa [h, sub_self, abs_zero],
  },
end

theorem nontrivial : (0 : real) ≠ 1 :=
begin
  rw [real_zero, real_one],
  assume hydroxide,
  rw eq_iff_coe_eq at hydroxide,
  exact myrat.nontrivial hydroxide,
end

end real

end hidden


open Lean

partial def mkBigAnd (n : Nat) (p : Syntax) : MacroM Syntax :=
  loop 0 n
where
  loop (low high : Nat) : MacroM Syntax := do
    if low == high then
      `($p[natLit! $(quote low)])
    else
      let mid := (low + high)/2
      `($(← loop low mid) ∧ $(← loop (mid + 1) high))

macro "bigAnd! " n:num p:ident : term => mkBigAnd n.toNat p

partial def mkBigOrNot (n : Nat) (p : Syntax) : MacroM Syntax :=
  loop 0 n
where
  loop (low high : Nat) : MacroM Syntax := do
    if low == high then
      `(¬ $p[natLit! $(quote low)])
    else
      let mid := (low + high)/2
      `($(← loop low mid) ∨ $(← loop (mid + 1) high))

macro "bigOrNot! " n:num p:ident : term => mkBigOrNot n.toNat p

@[simp] axiom not_and (p q : Prop) : (¬ (p ∧ q)) = (¬ p ∨ ¬ q)

theorem ex (p : Array Prop) : (¬ bigAnd! 2000 p) = bigOrNot! 2000 p := by
  simp only [not_and]
  rfl

-- #print ex


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simple_graph.basic
import data.finset.pairwise

/-!
# Graph cliques

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

This file defines cliques in simple graphs. A clique is a set of vertices that are pairwise
adjacent.

## Main declarations

* `simple_graph.is_clique`: Predicate for a set of vertices to be a clique.
* `simple_graph.is_n_clique`: Predicate for a set of vertices to be a `n`-clique.
* `simple_graph.clique_finset`: Finset of `n`-cliques of a graph.
* `simple_graph.clique_free`: Predicate for a graph to have no `n`-cliques.

## TODO

* Clique numbers
* Do we need `clique_set`, a version of `clique_finset` for infinite graphs?
-/

open finset fintype

namespace simple_graph
variables {α : Type*} (G H : simple_graph α)

/-! ### Cliques -/

section clique
variables {s t : set α}

/-- A clique in a graph is a set of vertices that are pairwise adjacent. -/
abbreviation is_clique (s : set α) : Prop := s.pairwise G.adj

lemma is_clique_iff : G.is_clique s ↔ s.pairwise G.adj := iff.rfl

/-- A clique is a set of vertices whose induced graph is complete. -/
lemma is_clique_iff_induce_eq : G.is_clique s ↔ G.induce s = ⊤ :=
begin
  rw is_clique_iff,
  split,
  { intro h,
    ext ⟨v, hv⟩ ⟨w, hw⟩,
    simp only [comap_adj, subtype.coe_mk, top_adj, ne.def, subtype.mk_eq_mk],
    exact ⟨adj.ne, h hv hw⟩, },
  { intros h v hv w hw hne,
    have : (G.induce s).adj ⟨v, hv⟩ ⟨w, hw⟩ = _ := rfl,
    conv_lhs at this { rw h },
    simpa [hne], }
end

instance [decidable_eq α] [decidable_rel G.adj] {s : finset α} : decidable (G.is_clique s) :=
decidable_of_iff' _ G.is_clique_iff

variables {G H}

lemma is_clique.mono (h : G ≤ H) : G.is_clique s → H.is_clique s :=
by { simp_rw is_clique_iff, exact set.pairwise.mono' h }

lemma is_clique.subset (h : t ⊆ s) : G.is_clique s → G.is_clique t :=
by { simp_rw is_clique_iff, exact set.pairwise.mono h }

@[simp] lemma is_clique_bot_iff : (⊥ : simple_graph α).is_clique s ↔ (s : set α).subsingleton :=
set.pairwise_bot_iff

alias is_clique_bot_iff ↔ is_clique.subsingleton _

end clique

/-! ### `n`-cliques -/

section n_clique
variables {n : ℕ} {s : finset α}

/-- A `n`-clique in a graph is a set of `n` vertices which are pairwise connected. -/
structure is_n_clique (n : ℕ) (s : finset α) : Prop :=
(clique : G.is_clique s)
(card_eq : s.card = n)

lemma is_n_clique_iff : G.is_n_clique n s ↔ G.is_clique s ∧ s.card = n :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

instance [decidable_eq α] [decidable_rel G.adj] {n : ℕ} {s : finset α} :
  decidable (G.is_n_clique n s) :=
decidable_of_iff' _ G.is_n_clique_iff

variables {G H}

lemma is_n_clique.mono (h : G ≤ H) : G.is_n_clique n s → H.is_n_clique n s :=
by { simp_rw is_n_clique_iff, exact and.imp_left (is_clique.mono h) }

@[simp] lemma is_n_clique_bot_iff : (⊥ : simple_graph α).is_n_clique n s ↔ n ≤ 1 ∧ s.card = n :=
begin
  rw [is_n_clique_iff, is_clique_bot_iff],
  refine and_congr_left _,
  rintro rfl,
  exact card_le_one.symm,
end

variables [decidable_eq α] {a b c : α}

lemma is_3_clique_triple_iff : G.is_n_clique 3 {a, b, c} ↔ G.adj a b ∧ G.adj a c ∧ G.adj b c :=
begin
  simp only [is_n_clique_iff, is_clique_iff, set.pairwise_insert_of_symmetric G.symm, coe_insert],
  have : ¬ 1 + 1 = 3 := by norm_num,
  by_cases hab : a = b; by_cases hbc : b = c; by_cases hac : a = c;
  subst_vars; simp [G.ne_of_adj, and_rotate, *],
end

lemma is_3_clique_iff :
  G.is_n_clique 3 s ↔ ∃ a b c, G.adj a b ∧ G.adj a c ∧ G.adj b c ∧ s = {a, b, c} :=
begin
  refine ⟨λ h, _, _⟩,
  { obtain ⟨a, b, c, -, -, -, rfl⟩ := card_eq_three.1 h.card_eq,
    refine ⟨a, b, c, _⟩,
    rw is_3_clique_triple_iff at h,
    tauto },
  { rintro ⟨a, b, c, hab, hbc, hca, rfl⟩,
    exact is_3_clique_triple_iff.2 ⟨hab, hbc, hca⟩ }
end

end n_clique

/-! ### Graphs without cliques -/

section clique_free
variables {m n : ℕ}

/-- `G.clique_free n` means that `G` has no `n`-cliques. -/
def clique_free (n : ℕ) : Prop := ∀ t, ¬ G.is_n_clique n t

variables {G H} {s : finset α}

lemma is_n_clique.not_clique_free (hG : G.is_n_clique n s) : ¬ G.clique_free n := λ h, h _ hG

lemma not_clique_free_of_top_embedding {n : ℕ}
  (f : (⊤ : simple_graph (fin n)) ↪g G) : ¬ G.clique_free n :=
begin
  simp only [clique_free, is_n_clique_iff, is_clique_iff_induce_eq, not_forall, not_not],
  use finset.univ.map f.to_embedding,
  simp only [card_map, finset.card_fin, eq_self_iff_true, and_true],
  ext ⟨v, hv⟩ ⟨w, hw⟩,
  simp only [coe_map, rel_embedding.coe_fn_to_embedding, set.mem_image,
    coe_univ, set.mem_univ, true_and] at hv hw,
  obtain ⟨v', rfl⟩ := hv,
  obtain ⟨w', rfl⟩ := hw,
  simp only [f.map_adj_iff, comap_adj, function.embedding.coe_subtype, subtype.coe_mk, top_adj,
    ne.def, subtype.mk_eq_mk],
  exact (function.embedding.apply_eq_iff_eq _ _ _).symm.not,
end

/-- An embedding of a complete graph that witnesses the fact that the graph is not clique-free. -/
noncomputable
def top_embedding_of_not_clique_free {n : ℕ} (h : ¬ G.clique_free n) :
  (⊤ : simple_graph (fin n)) ↪g G :=
begin
  simp only [clique_free, is_n_clique_iff, is_clique_iff_induce_eq, not_forall, not_not] at h,
  obtain ⟨ha, hb⟩ := h.some_spec,
  have : (⊤ : simple_graph (fin h.some.card)) ≃g (⊤ : simple_graph h.some),
  { apply iso.complete_graph,
    simpa using (fintype.equiv_fin h.some).symm },
  rw ← ha at this,
  convert (embedding.induce ↑h.some).comp this.to_embedding;
  exact hb.symm,
end

lemma not_clique_free_iff (n : ℕ) :
  ¬ G.clique_free n ↔ nonempty ((⊤ : simple_graph (fin n)) ↪g G) :=
begin
  split,
  { exact λ h, ⟨top_embedding_of_not_clique_free h⟩ },
  { rintro ⟨f⟩,
    exact not_clique_free_of_top_embedding f },
end

lemma clique_free_iff {n : ℕ} :
  G.clique_free n ↔ is_empty ((⊤ : simple_graph (fin n)) ↪g G) :=
by rw [← not_iff_not, not_clique_free_iff, not_is_empty_iff]

lemma clique_free_bot (h : 2 ≤ n) : (⊥ : simple_graph α).clique_free n :=
begin
  rintro t ht,
  rw is_n_clique_bot_iff at ht,
  linarith,
end

lemma clique_free.mono (h : m ≤ n) : G.clique_free m → G.clique_free n :=
begin
  rintro hG s hs,
  obtain ⟨t, hts, ht⟩ := s.exists_smaller_set _ (h.trans hs.card_eq.ge),
  exact hG _ ⟨hs.clique.subset hts, ht⟩,
end

lemma clique_free.anti (h : G ≤ H) : H.clique_free n → G.clique_free n :=
forall_imp $ λ s, mt $ is_n_clique.mono h

/-- See `simple_graph.clique_free_chromatic_number_succ` for a tighter bound. -/
lemma clique_free_of_card_lt [fintype α] (hc : card α < n) : G.clique_free n :=
begin
  by_contra h,
  refine nat.lt_le_antisymm hc _,
  rw [clique_free_iff, not_is_empty_iff] at h,
  simpa using fintype.card_le_of_embedding h.some.to_embedding,
end

end clique_free

/-! ### Set of cliques -/

section clique_set
variables (G) {n : ℕ} {a b c : α} {s : finset α}

/-- The `n`-cliques in a graph as a set. -/
def clique_set (n : ℕ) : set (finset α) := {s | G.is_n_clique n s}

lemma mem_clique_set_iff : s ∈ G.clique_set n ↔ G.is_n_clique n s := iff.rfl

@[simp] lemma clique_set_eq_empty_iff : G.clique_set n = ∅ ↔ G.clique_free n :=
by simp_rw [clique_free, set.eq_empty_iff_forall_not_mem, mem_clique_set_iff]

alias clique_set_eq_empty_iff ↔ _ clique_free.clique_set

attribute [protected] clique_free.clique_set

variables {G H}

@[mono] lemma clique_set_mono (h : G ≤ H) : G.clique_set n ⊆ H.clique_set n :=
λ _, is_n_clique.mono h

lemma clique_set_mono' (h : G ≤ H) : G.clique_set ≤ H.clique_set := λ _, clique_set_mono h

end clique_set

/-! ### Finset of cliques -/

section clique_finset
variables (G) [fintype α] [decidable_eq α] [decidable_rel G.adj] {n : ℕ} {a b c : α} {s : finset α}

/-- The `n`-cliques in a graph as a finset. -/
def clique_finset (n : ℕ) : finset (finset α) := univ.filter $ G.is_n_clique n

lemma mem_clique_finset_iff : s ∈ G.clique_finset n ↔ G.is_n_clique n s :=
mem_filter.trans $ and_iff_right $ mem_univ _

@[simp] lemma coe_clique_finset (n : ℕ) : (G.clique_finset n : set (finset α)) = G.clique_set n :=
set.ext $ λ _, mem_clique_finset_iff _

@[simp] lemma clique_finset_eq_empty_iff : G.clique_finset n = ∅ ↔ G.clique_free n :=
by simp_rw [clique_free, eq_empty_iff_forall_not_mem, mem_clique_finset_iff]

alias clique_finset_eq_empty_iff ↔ _ _root_.simple_graph.clique_free.clique_finset

attribute [protected] clique_free.clique_finset

variables {G} [decidable_rel H.adj]

@[mono] lemma clique_finset_mono (h : G ≤ H) : G.clique_finset n ⊆ H.clique_finset n :=
monotone_filter_right _ $ λ _, is_n_clique.mono h

end clique_finset
end simple_graph


import .higman
open nat function prod set fin classical subtype

namespace list
section

-- Suml

variables {A : Type}

definition Suml (f : A → ℕ) : list A → ℕ
| [] := 0
| (a :: ls) := f a + Suml ls

theorem le_add_of_le {a b c : ℕ} : a ≤ b → a ≤ b + c :=
begin
induction c with n ih, intro,super, intro h2,
apply le_succ_of_le, exact ih h2
end

theorem le_of_mem_Suml {f : A → ℕ} {a : A} {l : list A} :
a ∈ l → f a ≤ Suml f l :=
begin
induction l with b ls ih, intro h, exact absurd h (not_mem_nil _),
dsimp [Suml], intro h, assert h' : a = b ∨ a ∈ ls, exact h,
cases h' with l r, rw l, apply le_add_right,
rw add_comm,apply le_add_of_le, exact ih r
end

end

def upto : nat → list nat
| 0     := []
| (n+1) := n :: upto n

def dmap {α β : Type} (p : α → Prop) [h : decidable_pred p] (f : Π a, p a → β) : list α → list β
| []       := []
| (a::l)   := if P : (p a) then cons (f a P) (dmap l) else (dmap l)

theorem mem_upto_succ_of_mem_upto {n i : nat} : i ∈ upto n → i ∈ upto (succ n) :=
assume i, mem_cons_of_mem _ i
theorem mem_upto_of_lt : ∀ ⦃n i : nat⦄, i < n → i ∈ upto n
| 0        := λ i h, absurd h (not_lt_zero i)
| (succ n) := λ i h,
begin
  cases nat.lt_or_eq_of_le (le_of_lt_succ h) with ilt ieq,
  { apply mem_upto_succ_of_mem_upto, apply mem_upto_of_lt ilt },
  simp [ieq], super
end

section dmap
variables {α β : Type}
variable {p : α → Prop}
variable [h : decidable_pred p]
include h
variable {f : Π a, p a → β}

lemma dmap_nil : dmap p f [] = [] := rfl
lemma dmap_cons_of_pos {a : α} (P : p a) : ∀ l, dmap p f (a::l) = (f a P) :: dmap p f l :=
      λ l, dif_pos P
lemma dmap_cons_of_neg {a : α} (P : ¬ p a) : ∀ l, dmap p f (a::l) = dmap p f l :=
      λ l, dif_neg P

lemma mem_dmap : ∀ {l : list α} {a} (Pa : p a), a ∈ l → (f a Pa) ∈ dmap p f l
| []     := take a Pa Pinnil, absurd Pinnil (not_mem_nil _)
| (a::l) := take b Pb Pbin, or.elim (eq_or_mem_of_mem_cons Pbin)
              (assume Pbeqa, begin
                rw [eq.symm Pbeqa, dmap_cons_of_pos Pb],
                apply mem_cons_self
              end)
              (assume Pbinl,
                if pa : p a then
                  begin
                    rw [dmap_cons_of_pos pa],
                    apply mem_cons_of_mem,
                    exact mem_dmap Pb Pbinl
                  end
                else
                  begin
                    rw [dmap_cons_of_neg pa],
                    exact mem_dmap Pb Pbinl
                   end)

end dmap

end list

namespace fin
open list
attribute [simp]
private theorem length_nil {A : Type} : length (@nil A) = 0 :=
rfl

lemma val_mk (n i : nat) (Plt : i < n) : fin.val (fin.mk i Plt) = i := rfl

def upto (n : ℕ) : list (fin n) :=
dmap (λ i, i < n) fin.mk (list.upto n)

lemma mem_upto (n : nat) : ∀ (i : fin n), i ∈ upto n :=
take i, fin.rec_on i
  (take ival Piltn,
    have ival ∈ list.upto n, from mem_upto_of_lt Piltn,
mem_dmap Piltn this)

end fin

namespace kruskal

-- universe u

inductive finite_tree (Q : Type): Type
| cons : Q → list finite_tree → finite_tree

open finite_tree

-- def embeds' {Q : Type} [has_le Q] : finite_tree Q → finite_tree Q → Prop
-- | (cons a l) (cons b l') := sorry -- ∃ l₁, l₁ ∈ l' ∧ embeds' (cons a l) l₁

open finite_tree list function

#check @sublist'

inductive embeds {Q : Type} [has_le Q] : finite_tree Q → finite_tree Q → Prop
| embeds_subtree (t t' : finite_tree Q) (a : Q) (l' : list (finite_tree Q)) :
      t' ∈ l' → embeds t t' → embeds t (cons a l')
| embeds_par (a a' : Q) (l l' : list (finite_tree Q)) : a ≤ a' →  @sublist' _ ⟨embeds⟩ l l' → embeds (cons a l) (cons a' l')

-- def size' {Q : Type} : finite_tree Q → ℕ
-- | (cons a l) :=

end kruskal

-- inductive finite_tree (Q : Type): Type
-- | cons : Π {n : ℕ},  Q → (fin n → finite_tree) → finite_tree

-- open finite_tree

-- def size {Q : Type} : finite_tree Q → ℕ
-- | (@cons ._ n _ ts) := list.Suml (λ i, size (ts i)) (fin.upto n) + 1

-- theorem lt_of_size_branches_aux {Q : Type} {n : ℕ} (ts : fin n → finite_tree Q) (k : fin n) :
-- size (ts k) < list.Suml (λ i, size (ts i)) (fin.upto n) + 1 :=
-- begin
-- assert kin : k ∈ fin.upto n, exact fin.mem_upto n k,
-- assert h : size (ts k) ≤ list.Suml (λ i, size (ts i)) (fin.upto n),
-- apply list.le_of_mem_Suml kin,
-- apply lt_succ_of_le, assumption
-- end

-- def embeds {Q : Type} [has_le Q] : finite_tree Q → finite_tree Q → Prop
-- | (@cons ._ n a ts) (@cons ._ m b us) :=  (∃ j, embeds (cons a ts) (us j)) ∨                                             (a ≤ b ∧ ∃ f, injective f ∧ ∀ i, embeds (ts i) (us (f i)))

-- infix ` ≼ `:50 := embeds  -- \preceq

-- def {u} fin_zero_absurd {α : Sort u} (i : fin 0) : α :=
-- absurd i.2 (not_lt_zero i.1)

-- -- def branches_aux {Q : Type} {n : ℕ} (ts : fin n → finite_tree Q) : set (finite_tree Q × ℕ) :=
-- -- {x : finite_tree Q × ℕ | ∃ a : fin n, ts a = x.1 ∧ val a = x.2}

-- def branches_aux {Q : Type} {n : ℕ} (ts : fin n → finite_tree Q) : list (finite_tree Q) :=
-- list.map ts (fin.upto n)

-- definition branches {Q : Type} : finite_tree Q → list (finite_tree Q)
-- | (@cons ._ n _ ts) := branches_aux ts

-- -- definition branches {Q : Type} : finite_tree Q → set (finite_tree Q × ℕ)
-- -- | (@cons ._ n _ ts) := branches_aux ts

-- section
-- variable {Q : Type}
-- variable [quasiorder Q]

-- theorem cons_embeds_cons_left {m n : ℕ} {a b : Q} {ss : fin m → finite_tree Q} {ts : fin n → finite_tree Q}
--     {j : fin n} (H : cons a ss ≼ ts j) :
--   cons a ss ≼ cons b ts :=
-- begin
-- dsimp [embeds], apply or.inl,existsi j, exact H
-- end

-- theorem cons_embeds_cons_right {m n : ℕ} {a b : Q} {ss : fin m → finite_tree Q} {ts : fin n → finite_tree Q}
--     {f : fin m → fin n} (H : a ≤ b) (injf : injective f) (Hf : ∀ i, ss i ≼ ts (f i)) :
--   cons a ss ≼ cons b ts :=
-- begin
-- dsimp [embeds], apply or.inr, split, exact H,
-- existsi f, apply (and.intro injf Hf)
-- end

-- theorem embeds_refl (t : finite_tree Q) : t ≼ t :=
-- begin
-- induction t with n b ts ih,
-- dsimp [embeds], apply or.inr, split, apply quasiorder.refl,
-- existsi id, apply and.intro, exact injective_id, exact ih
-- end

-- theorem embeds_trans_aux : ∀ {u s t : finite_tree Q}, t ≼ u → s ≼ t → s ≼ u :=
-- begin
-- intro u,
-- induction u with ul ua us ihu,
--   intros s t, cases s with sl sa ss,
--   cases t with tl ta ts,
-- intro H₁, dsimp [embeds] at H₁, cases H₁ with H₁₁ H₁₂,
-- cases H₁₁ with i H₁₁, intro H₂,
--   apply cons_embeds_cons_left (ihu _ H₁₁ H₂),
--   cases H₁₂ with hab H₁₂r, cases H₁₂r with f Hf,
--   cases Hf with injf Hf,
-- intro H₂, dsimp [embeds] at H₂, cases H₂ with H₂₁ H₂₂,
-- cases H₂₁ with j H₂₁,
-- apply cons_embeds_cons_left (ihu _ (Hf j) H₂₁),
-- cases H₂₂ with Hab H₂₂r, cases H₂₂r with g Hg,
-- cases Hg with injg Hg,
-- apply cons_embeds_cons_right,
-- apply quasiorder.trans Hab hab,
-- apply injective_comp injf injg,
-- intro i, apply ihu _ (Hf (g i)) (Hg i)
-- end

-- theorem embeds_trans {s t u : finite_tree Q} (H₁ : s ≼ t) (H₂ : t ≼ u) : s ≼ u :=
-- embeds_trans_aux H₂ H₁

-- theorem embeds_of_branches {t : finite_tree Q} {T : finite_tree Q} : t ∈ (branches T) → t ≼ T :=
-- begin
-- cases T with n a ts,
-- cases t with tn ta tss,
-- intro H, dsimp [embeds],
-- dsimp [branches] at H,
-- dsimp [branches_aux] at H,
-- end

-- end

-- theorem lt_of_size_of_branches {Q : Type} {t : finite_tree Q × ℕ} {T : finite_tree Q} : t ∈ branches T → size t.1 < size T :=
-- begin
-- cases T with n a ts,
-- intro h,
-- assert h' : ∃ i, ts i = t.1, cases h with b hb,
--  {exact exists.intro b hb^.left},
-- cases h' with c hc, rw -hc, apply lt_of_size_branches_aux
-- end

-- noncomputable theory

-- section
-- parameter {Q : Type}
-- parameter [wqo Q]
-- parameter H : ∃ f : ℕ → finite_tree Q, ¬ is_good f embeds

-- def mbs_of_finite_tree := minimal_bad_seq size H

-- theorem bad_mbs_finite_tree : ¬ is_good mbs_of_finite_tree embeds := badness_of_mbs size H

-- def seq_branches_of_mbs_tree (n : ℕ) : set (finite_tree Q × ℕ) := branches (mbs_of_finite_tree n)

-- def mbs_tree : Type := {t : finite_tree Q × ℕ // ∃ i, t ∈ seq_branches_of_mbs_tree i}

-- def embeds' (t : mbs_tree) (s : mbs_tree) : Prop := t.val.1 ≼ s.val.1

-- theorem embeds'_refl (t : mbs_tree) : embeds' t t := embeds_refl t.val.1

-- theorem embeds'_trans (a b c : mbs_tree) : embeds' a b → embeds' b c → embeds' a c :=
-- λ H₁ H₂, embeds_trans H₁ H₂

--   section

--   parameter H' : ∃ f, ¬ is_good f embeds'

--   def R : ℕ → mbs_tree := some H'

--   definition family_index (n : ℕ) : ℕ := some ((R n).2)

--   definition index_set_of_mbs_tree : set ℕ := image family_index  univ

--   lemma index_ne_empty : index_set_of_mbs_tree ≠ ∅ := ne_empty_of_image_on_univ family_index

--   definition least_family_index := least index_set_of_mbs_tree index_ne_empty

--   lemma exists_least : ∃ i, family_index i = least_family_index :=
--   have least_family_index ∈ index_set_of_mbs_tree, from least_is_mem index_set_of_mbs_tree index_ne_empty,
--   let ⟨i,h⟩ := this in
--   ⟨i, h^.right⟩

--   definition least_index : ℕ := some exists_least

--   definition Kruskal's_g (n : ℕ) : mbs_tree := R (least_index + n)

--   definition Kruskal's_h (n : ℕ) : ℕ :=  family_index (least_index + n)

--   theorem bad_Kruskal's_g : ¬ is_good Kruskal's_g embeds' :=
--   suppose is_good Kruskal's_g embeds',
--   let ⟨i,j,hij⟩ := this in
--   have Hr : embeds' (Kruskal's_g i) (Kruskal's_g j), from hij^.right,
--   have least_index + i < least_index + j, from add_lt_add_left hij^.left _,
--   have is_good R embeds', from ⟨least_index + i, ⟨least_index + j,⟨this, Hr⟩⟩⟩,
--   (some_spec H') this

--   theorem Kruskal's_Hg : ¬ is_good (fst ∘ (val ∘ Kruskal's_g)) embeds := bad_Kruskal's_g

--   theorem trans_of_Kruskal's_g {i j : ℕ} (H1 : mbs_of_finite_tree i ≼ (Kruskal's_g j).val.1) :
--   mbs_of_finite_tree i ≼ mbs_of_finite_tree (Kruskal's_h j) :=
--   have (Kruskal's_g j).val ∈ branches (mbs_of_finite_tree (Kruskal's_h j)), from some_spec (Kruskal's_g j).2,
--   have (Kruskal's_g j).val.1 ≼ mbs_of_finite_tree (Kruskal's_h j), from embeds_of_branches this,
--   embeds_trans H1 this

--   theorem size_elt_Kruskal's_g_lt_mbs_finite_tree (n : ℕ) : size (Kruskal's_g n).val.1 < size (mbs_of_finite_tree (Kruskal's_h n)) :=
--   lt_of_size_of_branches (some_spec (Kruskal's_g n).2)

--   theorem Kruskal's_Hbp : size (Kruskal's_g 0).val.1 < size (mbs_of_finite_tree (Kruskal's_h 0)) := size_elt_Kruskal's_g_lt_mbs_finite_tree 0

--   lemma family_index_in_index_of_mbs_tree (n : ℕ) : Kruskal's_h n ∈ index_set_of_mbs_tree :=
--   have Kruskal's_h n = family_index (least_index + n), from rfl,
--   ⟨(least_index + n),⟨trivial,rfl⟩⟩

--   theorem Kruskal's_Hh (n : ℕ) : Kruskal's_h 0 ≤ Kruskal's_h n :=
--   have Kruskal's_h 0 = family_index least_index, from rfl,--by simph,
--   have family_index least_index = least_family_index, from some_spec exists_least,
--   have Kruskal's_h 0 = least_family_index, by simph,
--   begin rw this, apply minimality, apply family_index_in_index_of_mbs_tree end

--   theorem Kruskal's_H : ∀ i j, mbs_of_finite_tree i ≼ (Kruskal's_g (j - Kruskal's_h 0)).val.1 → mbs_of_finite_tree i ≼ mbs_of_finite_tree (Kruskal's_h (j - Kruskal's_h 0)) := λ i j, λ H1, trans_of_Kruskal's_g H1

--   definition Kruskal's_comb_seq (n : ℕ) : finite_tree Q := @comb_seq_with_mbs _ embeds (fst ∘ (val ∘ Kruskal's_g)) Kruskal's_h size H n

--   theorem Kruskal's_local_contradiction : false := local_contra_of_comb_seq_with_mbs Kruskal's_h size Kruskal's_Hh H Kruskal's_Hg Kruskal's_H Kruskal's_Hbp

--   end

-- theorem embeds'_is_good : ∀ f, is_good f embeds' :=
-- by_contradiction
-- (suppose ¬ ∀ f, is_good f embeds',
--  have ∃ f, ¬ is_good f embeds', from classical.exists_not_of_not_forall this,
--  Kruskal's_local_contradiction this)

-- instance wqo_mbs_tree : wqo mbs_tree :=
-- ⟨⟨⟨embeds'⟩,embeds'_refl,embeds'_trans⟩,embeds'_is_good⟩

-- def wqo_list_mbs_tree : wqo (list mbs_tree) := wqo_list

-- def sub : list mbs_tree → list mbs_tree → Prop := wqo_list_mbs_tree.le

-- theorem good_list_mbs_tree : ∀ f, is_good f sub := wqo_list_mbs_tree.is_good

-- definition elt_mirror (n : ℕ) : set mbs_tree := {x : mbs_tree | x.1 ∈ seq_branches_of_mbs_tree n}

-- theorem mirror_refl_left (x : mbs_tree) (n : ℕ) : x ∈ elt_mirror n → x.1 ∈ seq_branches_of_mbs_tree n := λ Hx, Hx

-- theorem mirror_refl_right (x : mbs_tree) (n : ℕ) : x.1 ∈ seq_branches_of_mbs_tree n → x ∈ elt_mirror n := λ Hx, Hx

-- definition mirror (n : ℕ) : list mbs_tree := _

-- #check list

-- end

-- end kruskal


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons

namespace tup
variables {α : Type*} {β : Type*} {γ : Type*} {n : ℕ}

@[reducible]
definition map : (α → β) → α ^ n → β ^ n :=
λ f xs i, f xs[i]

@[reducible]
definition map₂ : (α → β → γ) → α ^ n → β ^ n → γ ^n :=
λ f xs ys i, f xs[i] ys[i]

@[simp]
lemma map_nil (f : α → β) : map f nil = nil := eq_nil _

@[simp]
lemma map_cons (f : α → β) (x : α) (xs : α ^ n) :
map f (x :: xs) = f x :: map f xs :=
ext (λ i, match i with
| ⟨0, _⟩ := rfl
| ⟨i+1, _⟩ := rfl
end)

lemma map_head (f : α → β) (xs : α ^ (n+1)) :
head (map f xs) = f (head xs) :=
calc
head (map f xs)
    = head (map f (head xs :: tail xs))     : by rw cons_head_tail
... = head (f (head xs) :: map f (tail xs)) : by rw map_cons
... = f (head xs)                           : by rw head_cons

lemma map_tail (f : α → β) (xs : α ^ (n+1)) :
tail (map f xs) = map f (tail xs) :=
calc
tail (map f xs)
    = tail (map f (head xs :: tail xs))     : by rw cons_head_tail
... = tail (f (head xs) :: map f (tail xs)) : by rw map_cons
... = map f (tail xs)                       : by rw tail_cons

@[simp]
lemma map_map (g : β → γ) (f : α → β) {n : ℕ} (xs : α ^ n) :
map g (map f xs) = map (g ∘ f) xs := rfl

@[simp]
lemma map₂_nil (f : α → β → γ) : map₂ f nil nil = nil := eq_nil _

@[simp]
lemma map₂_cons (f : α → β → γ) (x : α) (xs : α ^ n) (y : β) (ys : β ^ n) :
map₂ f (x :: xs) (y :: ys) = f x y :: map₂ f xs ys :=
ext (λ i, match i with
| ⟨0, _⟩ := rfl
| ⟨i+1, _⟩ := rfl
end)

lemma map₂_head (f : α → β → γ) (xs : α ^ (n+1)) (ys : β ^ (n+1)) :
head (map₂ f xs ys) = f (head xs) (head ys) :=
calc
head (map₂ f xs ys)
    = head (map₂ f (head xs :: tail xs) (head ys :: tail ys))    : by rw [cons_head_tail, cons_head_tail]
... = head (f (head xs) (head ys) :: map₂ f (tail xs) (tail ys)) : by rw map₂_cons
... = f (head xs) (head ys)                                      : by rw head_cons

lemma map₂_tail (f : α → β → γ) (xs : α ^ (n+1)) (ys : β ^ (n+1)) :
tail (map₂ f xs ys) = map₂ f (tail xs) (tail ys) :=
calc
tail (map₂ f xs ys)
    = tail (map₂ f (head xs :: tail xs) (head ys :: tail ys))    : by rw [cons_head_tail, cons_head_tail]
... = tail (f (head xs) (head ys) :: map₂ f (tail xs) (tail ys)) : by rw map₂_cons
... = map₂ f (tail xs) (tail ys)                                 : by rw tail_cons

end tup