/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_with_zero.default
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Divisibility

This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s
`(_with_zero)`.

## Main definitions

 * `monoid.has_dvd`

## Implementation notes

The divisibility relation is defined for all monoids, and as such, depends on the order of
  multiplication if the monoid is not commutative. There are two possible conventions for
  divisibility in the noncommutative context, and this relation follows the convention for ordinals,
  so `a | b` is defined as `∃ c, b = a * c`.

## Tags

divisibility, divides
-/

/-- There are two possible conventions for divisibility, which coincide in a `comm_monoid`.
    This matches the convention for ordinals. -/
protected instance monoid_has_dvd {α : Type u_1} [monoid α] : has_dvd α :=
  has_dvd.mk fun (a b : α) => ∃ (c : α), b = a * c

-- TODO: this used to not have c explicit, but that seems to be important

--       for use with tactics, similar to exist.intro

theorem dvd.intro {α : Type u_1} [monoid α] {a : α} {b : α} (c : α) (h : a * c = b) : a ∣ b :=
  exists.intro c (Eq.symm h)

theorem dvd_of_mul_right_eq {α : Type u_1} [monoid α] {a : α} {b : α} (c : α) (h : a * c = b) : a ∣ b :=
  dvd.intro

theorem exists_eq_mul_right_of_dvd {α : Type u_1} [monoid α] {a : α} {b : α} (h : a ∣ b) : ∃ (c : α), b = a * c :=
  h

theorem dvd.elim {α : Type u_1} [monoid α] {P : Prop} {a : α} {b : α} (H₁ : a ∣ b) (H₂ : ∀ (c : α), b = a * c → P) : P :=
  exists.elim H₁ H₂

@[simp] theorem dvd_refl {α : Type u_1} [monoid α] (a : α) : a ∣ a := sorry

theorem dvd_trans {α : Type u_1} [monoid α] {a : α} {b : α} {c : α} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := sorry

theorem dvd.trans {α : Type u_1} [monoid α] {a : α} {b : α} {c : α} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
  dvd_trans

theorem one_dvd {α : Type u_1} [monoid α] (a : α) : 1 ∣ a := sorry

@[simp] theorem dvd_mul_right {α : Type u_1} [monoid α] (a : α) (b : α) : a ∣ a * b :=
  dvd.intro b rfl

theorem dvd_mul_of_dvd_left {α : Type u_1} [monoid α] {a : α} {b : α} (h : a ∣ b) (c : α) : a ∣ b * c := sorry

theorem dvd_of_mul_right_dvd {α : Type u_1} [monoid α] {a : α} {b : α} {c : α} (h : a * b ∣ c) : a ∣ c := sorry

theorem dvd.intro_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} (c : α) (h : c * a = b) : a ∣ b :=
  dvd.intro c (eq.mp (Eq._oldrec (Eq.refl (c * a = b)) (mul_comm c a)) h)

theorem dvd_of_mul_left_eq {α : Type u_1} [comm_monoid α] {a : α} {b : α} (c : α) (h : c * a = b) : a ∣ b :=
  dvd.intro_left

theorem exists_eq_mul_left_of_dvd {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : a ∣ b) : ∃ (c : α), b = c * a :=
  dvd.elim h fun (c : α) (H1 : b = a * c) => exists.intro c (Eq.trans H1 (mul_comm a c))

theorem dvd.elim_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} {P : Prop} (h₁ : a ∣ b) (h₂ : ∀ (c : α), b = c * a → P) : P :=
  exists.elim (exists_eq_mul_left_of_dvd h₁) fun (c : α) (h₃ : b = c * a) => h₂ c h₃

@[simp] theorem dvd_mul_left {α : Type u_1} [comm_monoid α] (a : α) (b : α) : a ∣ b * a :=
  dvd.intro b (mul_comm a b)

theorem dvd_mul_of_dvd_right {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : a ∣ b) (c : α) : a ∣ c * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ c * b)) (mul_comm c b))) (dvd_mul_of_dvd_left h c)

theorem mul_dvd_mul {α : Type u_1} [comm_monoid α] {a : α} {b : α} {c : α} {d : α} : a ∣ b → c ∣ d → a * c ∣ b * d := sorry

theorem mul_dvd_mul_left {α : Type u_1} [comm_monoid α] (a : α) {b : α} {c : α} (h : b ∣ c) : a * b ∣ a * c :=
  mul_dvd_mul (dvd_refl a) h

theorem mul_dvd_mul_right {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : a ∣ b) (c : α) : a * c ∣ b * c :=
  mul_dvd_mul h (dvd_refl c)

theorem dvd_of_mul_left_dvd {α : Type u_1} [comm_monoid α] {a : α} {b : α} {c : α} (h : a * b ∣ c) : b ∣ c := sorry

theorem eq_zero_of_zero_dvd {α : Type u_1} [monoid_with_zero α] {a : α} (h : 0 ∣ a) : a = 0 :=
  dvd.elim h fun (c : α) (H' : a = 0 * c) => Eq.trans H' (zero_mul c)

/-- Given an element `a` of a commutative monoid with zero, there exists another element whose
    product with zero equals `a` iff `a` equals zero. -/
@[simp] theorem zero_dvd_iff {α : Type u_1} [monoid_with_zero α] {a : α} : 0 ∣ a ↔ a = 0 :=
  { mp := eq_zero_of_zero_dvd, mpr := fun (h : a = 0) => eq.mpr (id (Eq._oldrec (Eq.refl (0 ∣ a)) h)) (dvd_refl 0) }

@[simp] theorem dvd_zero {α : Type u_1} [monoid_with_zero α] (a : α) : a ∣ 0 := sorry

/-- Given two elements `b`, `c` of a `cancel_monoid_with_zero` and a nonzero element `a`,
 `a*b` divides `a*c` iff `b` divides `c`. -/
theorem mul_dvd_mul_iff_left {α : Type u_1} [cancel_monoid_with_zero α] {a : α} {b : α} {c : α} (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c := sorry

/-- Given two elements `a`, `b` of a commutative `cancel_monoid_with_zero` and a nonzero
  element `c`, `a*c` divides `b*c` iff `a` divides `b`. -/
theorem mul_dvd_mul_iff_right {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : α} {b : α} {c : α} (hc : c ≠ 0) : a * c ∣ b * c ↔ a ∣ b := sorry

/-!
### Units in various monoids
-/

namespace units

/-- Elements of the unit group of a monoid represented as elements of the monoid
    divide any element of the monoid. -/
theorem coe_dvd {α : Type u_1} [monoid α] {a : α} {u : units α} : ↑u ∣ a := sorry

/-- In a monoid, an element `a` divides an element `b` iff `a` divides all
    associates of `b`. -/
theorem dvd_mul_right {α : Type u_1} [monoid α] {a : α} {b : α} {u : units α} : a ∣ b * ↑u ↔ a ∣ b := sorry

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
theorem mul_right_dvd {α : Type u_1} [monoid α] {a : α} {b : α} {u : units α} : a * ↑u ∣ b ↔ a ∣ b := sorry

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
theorem dvd_mul_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} {u : units α} : a ∣ ↑u * b ↔ a ∣ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ ↑u * b ↔ a ∣ b)) (mul_comm (↑u) b))) dvd_mul_right

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
theorem mul_left_dvd {α : Type u_1} [comm_monoid α] {a : α} {b : α} {u : units α} : ↑u * a ∣ b ↔ a ∣ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑u * a ∣ b ↔ a ∣ b)) (mul_comm (↑u) a))) mul_right_dvd

end units

namespace is_unit

/-- Units of a monoid divide any element of the monoid. -/
@[simp] theorem dvd {α : Type u_1} [monoid α] {a : α} {u : α} (hu : is_unit u) : u ∣ a :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.coe_dvd hu_h

@[simp] theorem dvd_mul_right {α : Type u_1} [monoid α] {a : α} {b : α} {u : α} (hu : is_unit u) : a ∣ b * u ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.dvd_mul_right hu_h

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
@[simp] theorem mul_right_dvd {α : Type u_1} [monoid α] {a : α} {b : α} {u : α} (hu : is_unit u) : a * u ∣ b ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.mul_right_dvd hu_h

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
@[simp] theorem dvd_mul_left {α : Type u_1} [comm_monoid α] (a : α) (b : α) (u : α) (hu : is_unit u) : a ∣ u * b ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.dvd_mul_left hu_h

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
@[simp] theorem mul_left_dvd {α : Type u_1} [comm_monoid α] (a : α) (b : α) (u : α) (hu : is_unit u) : u * a ∣ b ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.mul_left_dvd hu_h

end is_unit

/-- `dvd_not_unit a b` expresses that `a` divides `b` "strictly", i.e. that `b` divided by `a` is not a unit. -/
def dvd_not_unit {α : Type u_1} [comm_monoid_with_zero α] (a : α) (b : α) :=
  a ≠ 0 ∧ ∃ (x : α), ¬is_unit x ∧ b = a * x

theorem dvd_not_unit_of_dvd_of_not_dvd {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} (hd : a ∣ b) (hnd : ¬b ∣ a) : dvd_not_unit a b := sorry


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

! This file was ported from Lean 3 source module algebra.order.nonneg.field
! leanprover-community/mathlib commit b3f4f007a962e3787aa0f3b5c7942a1317f7d88e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Field.Basic
import Mathlib.Algebra.Order.Field.Canonical.Defs
import Mathlib.Algebra.Order.Field.InjSurj
import Mathlib.Algebra.Order.Nonneg.Ring

/-!
# Semifield structure on the type of nonnegative elements

This file defines instances and prove some properties about the nonnegative elements
`{x : α // 0 ≤ x}` of an arbitrary type `α`.

This is used to derive algebraic structures on `ℝ≥0` and `ℚ≥0` automatically.

## Main declarations

* `{x : α // 0 ≤ x}` is a `CanonicallyLinearOrderedSemifield` if `α` is a `LinearOrderedField`.
-/

open Set

variable {α : Type _}

namespace Nonneg

section LinearOrderedSemifield

variable [LinearOrderedSemifield α] {x y : α}

instance inv : Inv { x : α // 0 ≤ x } :=
  ⟨fun x => ⟨x⁻¹, inv_nonneg.2 x.2⟩⟩
#align nonneg.has_inv Nonneg.inv

@[simp, norm_cast]
protected theorem coe_inv (a : { x : α // 0 ≤ x }) : ((a⁻¹ : { x : α // 0 ≤ x }) : α) = (a : α)⁻¹ :=
  rfl
#align nonneg.coe_inv Nonneg.coe_inv

@[simp]
theorem inv_mk (hx : 0 ≤ x) : (⟨x, hx⟩ : { x : α // 0 ≤ x })⁻¹ = ⟨x⁻¹, inv_nonneg.2 hx⟩ :=
  rfl
#align nonneg.inv_mk Nonneg.inv_mk

instance div : Div { x : α // 0 ≤ x } :=
  ⟨fun x y => ⟨x / y, div_nonneg x.2 y.2⟩⟩
#align nonneg.has_div Nonneg.div

@[simp, norm_cast]
protected theorem coe_div (a b : { x : α // 0 ≤ x }) : ((a / b : { x : α // 0 ≤ x }) : α) = a / b :=
  rfl
#align nonneg.coe_div Nonneg.coe_div

@[simp]
theorem mk_div_mk (hx : 0 ≤ x) (hy : 0 ≤ y) :
    (⟨x, hx⟩ : { x : α // 0 ≤ x }) / ⟨y, hy⟩ = ⟨x / y, div_nonneg hx hy⟩ :=
  rfl
#align nonneg.mk_div_mk Nonneg.mk_div_mk

instance zpow : Pow { x : α // 0 ≤ x } ℤ :=
  ⟨fun a n => ⟨(a : α) ^ n, zpow_nonneg a.2 _⟩⟩
#align nonneg.has_zpow Nonneg.zpow

@[simp, norm_cast]
protected theorem coe_zpow (a : { x : α // 0 ≤ x }) (n : ℤ) :
    ((a ^ n : { x : α // 0 ≤ x }) : α) = (a : α) ^ n :=
  rfl
#align nonneg.coe_zpow Nonneg.coe_zpow

@[simp]
theorem mk_zpow (hx : 0 ≤ x) (n : ℤ) :
    (⟨x, hx⟩ : { x : α // 0 ≤ x }) ^ n = ⟨x ^ n, zpow_nonneg hx n⟩ :=
  rfl
#align nonneg.mk_zpow Nonneg.mk_zpow

instance linearOrderedSemifield : LinearOrderedSemifield { x : α // 0 ≤ x } :=
  Subtype.coe_injective.linearOrderedSemifield _ Nonneg.coe_zero Nonneg.coe_one Nonneg.coe_add
    Nonneg.coe_mul Nonneg.coe_inv Nonneg.coe_div (fun _ _ => rfl) Nonneg.coe_pow Nonneg.coe_zpow
    Nonneg.coe_nat_cast (fun _ _ => rfl) fun _ _ => rfl
#align nonneg.linear_ordered_semifield Nonneg.linearOrderedSemifield

end LinearOrderedSemifield

instance canonicallyLinearOrderedSemifield [LinearOrderedField α] :
    CanonicallyLinearOrderedSemifield { x : α // 0 ≤ x } :=
  { Nonneg.linearOrderedSemifield, Nonneg.canonicallyOrderedCommSemiring with }
#align nonneg.canonically_linear_ordered_semifield Nonneg.canonicallyLinearOrderedSemifield

instance linearOrderedCommGroupWithZero [LinearOrderedField α] :
    LinearOrderedCommGroupWithZero { x : α // 0 ≤ x } :=
  inferInstance
#align nonneg.linear_ordered_comm_group_with_zero Nonneg.linearOrderedCommGroupWithZero

end Nonneg


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

Characteristic of semirings.
-/

import data.padics.padic_norm data.nat.choose

universes u v

/-- The generator of the kernel of the unique homomorphism ℤ → α for a semiring α -/
class char_p (α : Type u) [semiring α] (p : ℕ) : Prop :=
(cast_eq_zero_iff : ∀ x:ℕ, (x:α) = 0 ↔ p ∣ x)

theorem char_p.cast_eq_zero (α : Type u) [semiring α] (p : ℕ) [char_p α p] : (p:α) = 0 :=
(char_p.cast_eq_zero_iff α p p).2 (dvd_refl p)

theorem char_p.eq (α : Type u) [semiring α] {p q : ℕ} (c1 : char_p α p) (c2 : char_p α q) : p = q :=
nat.dvd_antisymm
  ((char_p.cast_eq_zero_iff α p q).1 (char_p.cast_eq_zero _ _))
  ((char_p.cast_eq_zero_iff α q p).1 (char_p.cast_eq_zero _ _))

instance char_p.of_char_zero (α : Type u) [semiring α] [char_zero α] : char_p α 0 :=
⟨λ x, by rw [zero_dvd_iff, ← nat.cast_zero, nat.cast_inj]⟩

theorem char_p.exists (α : Type u) [semiring α] : ∃ p, char_p α p :=
by letI := classical.dec_eq α; exact
classical.by_cases
  (assume H : ∀ p:ℕ, (p:α) = 0 → p = 0, ⟨0,
    ⟨λ x, by rw [zero_dvd_iff]; exact ⟨H x, by rintro rfl; refl⟩⟩⟩)
  (λ H, ⟨nat.find (classical.not_forall.1 H), ⟨λ x,
    ⟨λ H1, nat.dvd_of_mod_eq_zero (by_contradiction $ λ H2,
      nat.find_min (classical.not_forall.1 H)
        (nat.mod_lt x $ nat.pos_of_ne_zero $ not_of_not_imp $
          nat.find_spec (classical.not_forall.1 H))
        (not_imp_of_and_not ⟨by rwa [← nat.mod_add_div x (nat.find (classical.not_forall.1 H)),
          nat.cast_add, nat.cast_mul, of_not_not (not_not_of_not_imp $ nat.find_spec (classical.not_forall.1 H)),
          zero_mul, add_zero] at H1, H2⟩)),
    λ H1, by rw [← nat.mul_div_cancel' H1, nat.cast_mul,
      of_not_not (not_not_of_not_imp $ nat.find_spec (classical.not_forall.1 H)), zero_mul]⟩⟩⟩)

theorem char_p.exists_unique (α : Type u) [semiring α] : ∃! p, char_p α p :=
let ⟨c, H⟩ := char_p.exists α in ⟨c, H, λ y H2, char_p.eq α H2 H⟩

/-- Noncomuptable function that outputs the unique characteristic of a semiring. -/
noncomputable def ring_char (α : Type u) [semiring α] : ℕ :=
classical.some (char_p.exists_unique α)

theorem ring_char.spec (α : Type u) [semiring α] : ∀ x:ℕ, (x:α) = 0 ↔ ring_char α ∣ x :=
by letI := (classical.some_spec (char_p.exists_unique α)).1;
unfold ring_char; exact char_p.cast_eq_zero_iff α (ring_char α)

theorem ring_char.eq (α : Type u) [semiring α] {p : ℕ} (C : char_p α p) : p = ring_char α :=
(classical.some_spec (char_p.exists_unique α)).2 p C

theorem add_pow_char (α : Type u) [comm_ring α] {p : ℕ} (hp : nat.prime p)
  [char_p α p] (x y : α) : (x + y)^p = x^p + y^p :=
begin
  rw [add_pow, finset.sum_range_succ, nat.sub_self, pow_zero, choose_self],
  rw [nat.cast_one, mul_one, mul_one, add_left_inj],
  transitivity,
  { refine finset.sum_eq_single 0 _ _,
    { intros b h1 h2,
      have := nat.prime.dvd_choose (nat.pos_of_ne_zero h2) (finset.mem_range.1 h1) hp,
      rw [← nat.div_mul_cancel this, nat.cast_mul, char_p.cast_eq_zero α p],
      simp only [mul_zero] },
    { intro H, exfalso, apply H, exact finset.mem_range.2 hp.pos } },
  rw [pow_zero, nat.sub_zero, one_mul, choose_zero_right, nat.cast_one, mul_one]
end

/-- The frobenius map that sends x to x^p -/
def frobenius (α : Type u) [monoid α] (p : ℕ) (x : α) : α := x^p

theorem frobenius_def (α : Type u) [monoid α] (p : ℕ) (x : α) : frobenius α p x = x ^ p := rfl

theorem frobenius_mul (α : Type u) [comm_monoid α] (p : ℕ) (x y : α) :
  frobenius α p (x * y) = frobenius α p x * frobenius α p y := mul_pow x y p
theorem frobenius_one (α : Type u) [monoid α] (p : ℕ) :
  frobenius α p 1 = 1 := one_pow _

theorem is_monoid_hom.map_frobenius {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α → β) [is_monoid_hom f]
  (p : ℕ) (x : α) : f (frobenius α p x) = frobenius β p (f x) :=
by unfold frobenius; induction p; simp only [pow_zero, pow_succ,
  is_monoid_hom.map_one f, is_monoid_hom.map_mul f, *]

instance {α : Type u} [comm_ring α] (p : ℕ) [hp : nat.prime p] [char_p α p] : is_ring_hom (frobenius α p) :=
{ map_one := frobenius_one α p,
  map_mul := frobenius_mul α p,
  map_add := add_pow_char α hp }

section
variables (α : Type u) [comm_ring α] (p : ℕ) [hp : nat.prime p]
theorem frobenius_zero : frobenius α p 0 = 0 := zero_pow hp.pos
variables [char_p α p] (x y : α)
include hp
theorem frobenius_add : frobenius α p (x + y) = frobenius α p x + frobenius α p y := is_ring_hom.map_add _
theorem frobenius_neg : frobenius α p (-x) = -frobenius α p x := is_ring_hom.map_neg _
theorem frobenius_sub : frobenius α p (x - y) = frobenius α p x - frobenius α p y := is_ring_hom.map_sub _
end

theorem frobenius_inj (α : Type u) [integral_domain α] (p : ℕ) [nat.prime p] [char_p α p] (x y : α)
  (H : frobenius α p x = frobenius α p y) : x = y :=
by rw ← sub_eq_zero at H ⊢; rw ← frobenius_sub at H; exact pow_eq_zero H

theorem frobenius_nat_cast (α : Type u) [comm_ring α] (p : ℕ) [nat.prime p] [char_p α p] (x : ℕ) :
  frobenius α p x = x :=
by induction x; simp only [nat.cast_zero, nat.cast_succ, frobenius_zero, frobenius_one, frobenius_add, *]


import data.list.basic
open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

attribute [simp]
theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
  by simp [mk_symm]

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
  by simp

example (xs ys : list ℕ) (p : list ℕ → Prop) (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
  by simp at h; assumption


import data.equiv.basic
import group_theory.subgroup
import set_theory.cardinal
import for_mathlib.subrel
import for_mathlib.option_inj

universes u v

class linear_ordered_comm_monoid (α : Type*) extends comm_monoid α, linear_order α :=
(mul_le_mul_left : ∀ {a b : α}, a ≤ b → ∀ c : α, c * a ≤ c * b)

class linear_ordered_comm_group (α : Type*) extends comm_group α, linear_order α :=
(mul_le_mul_left : ∀ {a b : α}, a ≤ b → ∀ c : α, c * a ≤ c * b)

namespace linear_ordered_comm_monoid

variables {α : Type u} [linear_ordered_comm_monoid α] {x y z : α}
variables {β : Type v} [linear_ordered_comm_monoid β]

class is_hom (f : α → β) extends is_monoid_hom f : Prop :=
(ord : ∀ {a b : α}, a ≤ b → f a ≤ f b)

structure equiv extends equiv α β :=
(is_hom : is_hom to_fun)

lemma mul_le_mul_right (H : x ≤ y) : ∀ z : α, x * z ≤ y * z :=
λ z, mul_comm z x ▸ mul_comm z y ▸ mul_le_mul_left H z

end linear_ordered_comm_monoid

namespace linear_ordered_comm_group

variables {α : Type u} [linear_ordered_comm_group α] {x y z : α}
variables {β : Type v} [linear_ordered_comm_group β]

class is_hom (f : α → β) extends is_group_hom f : Prop :=
(ord : ∀ {a b : α}, a ≤ b → f a ≤ f b)

structure equiv extends equiv α β :=
(is_hom : is_hom to_fun)

lemma mul_le_mul_right (H : x ≤ y) : ∀ z : α, x * z ≤ y * z :=
λ z, mul_comm z x ▸ mul_comm z y ▸ mul_le_mul_left H z

lemma one_le_mul_of_one_le_of_one_le (Hx : 1 ≤ x) (Hy : 1 ≤ y) : 1 ≤ x * y :=
have h1 : x * 1 ≤ x * y, from mul_le_mul_left Hy x,
have h2 : x ≤ x * y, by rwa mul_one x at h1,
le_trans Hx h2

lemma one_le_pow_of_one_le {n : ℕ} (H : 1 ≤ x) : 1 ≤ x^n :=
begin
  induction n with n ih,
  { exact le_refl 1 },
  { exact one_le_mul_of_one_le_of_one_le H ih }
end

lemma mul_le_one_of_le_one_of_le_one (Hx : x ≤ 1) (Hy : y ≤ 1) : x * y ≤ 1 :=
have h1 : x * y ≤ x * 1, from mul_le_mul_left Hy x,
have h2 : x * y ≤ x, by rwa mul_one x at h1,
le_trans h2 Hx

lemma pow_le_one_of_le_one {n : ℕ} (H : x ≤ 1) : x^n ≤ 1 :=
begin
  induction n with n ih,
  { exact le_refl 1 },
  { exact mul_le_one_of_le_one_of_le_one H ih }
end

/-- Wedhorn Remark 1.6 (3) -/
lemma eq_one_of_pow_eq_one {n : ℕ} (H : x ^ (n+1) = 1) : x = 1 :=
begin
  induction n with n ih,
  { simpa using H },
  { cases le_total x 1,
  all_goals { have h1 := mul_le_mul_right h (x ^ (n+1)),
      rw pow_succ at H,
      rw [H, one_mul] at h1 },
    { have h2 := pow_le_one_of_le_one h,
      exact ih (le_antisymm h2 h1) },
    { have h2 := one_le_pow_of_one_le h,
      exact ih (le_antisymm h1 h2) } }
end

lemma inv_le_one_of_one_le (H : 1 ≤ x) : x⁻¹ ≤ 1 :=
by simpa using mul_le_mul_left H (x⁻¹)

lemma inv_le_inv_of_le (H : x ≤ y) : y⁻¹ ≤ x⁻¹ :=
have h1 : _ := mul_le_mul_left H (x⁻¹ * y⁻¹),
by rwa [inv_mul_cancel_right, mul_comm x⁻¹, inv_mul_cancel_right] at h1

lemma le_one_or_inv_le_one (x : α) : x ≤ 1 ∨ x⁻¹ ≤ 1 :=
or.imp id inv_le_one_of_one_le (le_total x 1)

lemma le_or_inv_le_inv (x y : α) : x ≤ y ∨ x⁻¹ ≤ y⁻¹ :=
or.imp id inv_le_inv_of_le (le_total x y)

class is_convex (S : set α) : Prop :=
(one_mem : (1:α) ∈ S)
(mul_mem : ∀ {x y}, x ∈ S → y ∈ S → x * y ∈ S)
(inv_mem : ∀ {x}, x ∈ S → x⁻¹ ∈ S)
(mem_of_between : ∀ {x y}, x ≤ y → y ≤ (1:α) → x ∈ S → y ∈ S)

class is_proper_convex (S : set α) extends is_convex S : Prop :=
(exists_ne : ∃ (x y : α) (hx : x ∈ S) (hy : y ∈ S), x ≠ y)

definition convex_linear_order : linear_order {S : set α // is_convex S} :=
{ le_total := λ ⟨x, hx⟩ ⟨y, hy⟩, classical.by_contradiction $ λ h,
    let ⟨h1, h2⟩ := not_or_distrib.1 h,
        ⟨m, hmx, hmny⟩ := set.not_subset.1 h1,
        ⟨n, hny, hnnx⟩ := set.not_subset.1 h2 in
    begin
      cases le_total m n with hmn hnm,
      { cases le_one_or_inv_le_one n with hn1 hni1,
        { exact hnnx (@@is_convex.mem_of_between _ hx hmn hn1 hmx) },
        { cases le_total m (n⁻¹) with hmni hnim,
          { exact hnnx (inv_inv n ▸ (@@is_convex.inv_mem _ hx $ @@is_convex.mem_of_between _ hx hmni hni1 hmx)) },
          { cases le_one_or_inv_le_one m with hm1 hmi1,
            { exact hmny (@@is_convex.mem_of_between _ hy hnim hm1 $ @@is_convex.inv_mem _ hy hny) },
            { exact hmny (inv_inv m ▸ (@@is_convex.inv_mem _ hy $ @@is_convex.mem_of_between _ hy (inv_le_inv_of_le hmn) hmi1 $ @@is_convex.inv_mem _ hy hny)) } } } },
      { cases le_one_or_inv_le_one m with hm1 hmi1,
        { exact hmny (@@is_convex.mem_of_between _ hy hnm hm1 hny) },
        { cases le_total n (m⁻¹) with hnni hmim,
          { exact hmny (inv_inv m ▸ (@@is_convex.inv_mem _ hy $ @@is_convex.mem_of_between _ hy hnni hmi1 hny)) },
          { cases le_one_or_inv_le_one n with hn1 hni1,
            { exact hnnx (@@is_convex.mem_of_between _ hx hmim hn1 $ @@is_convex.inv_mem _ hx hmx) },
            { exact hnnx (inv_inv n ▸ (@@is_convex.inv_mem _ hx $ @@is_convex.mem_of_between _ hx (inv_le_inv_of_le hnm) hni1 $ @@is_convex.inv_mem _ hx hmx)) } } } }
    end,
  .. subrel.partial_order }

def ker (f : α → β) (hf : is_hom f) : set α :=
{ x | f x = 1 }

theorem ker.is_convex (f : α → β) (hf : is_hom f) : is_convex (ker f hf) :=
{ one_mem := is_group_hom.one f,
  mul_mem := λ x y hx hy, show f (x * y) = 1, by dsimp [ker] at hx hy; rw [(hf.1).mul, hx, hy, mul_one],
  inv_mem := λ x hx, show f x⁻¹ = 1, by dsimp [ker] at hx; rw [@is_group_hom.inv _ _ _ _ f (hf.1) x, hx, one_inv],
  mem_of_between := λ x y hxy hy1 hx, le_antisymm (is_group_hom.one f ▸ is_hom.ord _ hy1) (hx ▸ is_hom.ord _ hxy) }

def height (α : Type) [linear_ordered_comm_group α] : cardinal :=
cardinal.mk {S : set α // is_proper_convex S}

end linear_ordered_comm_group

namespace with_zero

variables {α : Type u} {β : Type v}

instance : has_zero (with_zero α) := ⟨none⟩

@[simp] theorem zero_le [partial_order α] {x : with_zero α} : 0 ≤ x :=
begin
  cases x,
  exact le_refl 0,
  exact le_of_lt (with_bot.bot_lt_some x)
end

@[simp] theorem none_le [partial_order α] {x : with_zero α} :
@has_le.le (with_zero α) _ none x := zero_le

@[simp] theorem not_some_le_zero [partial_order α] {x : α} :
¬ @has_le.le (with_zero α) _ (some x) 0 :=
λ h, option.no_confusion (le_antisymm h zero_le)

@[simp] theorem not_some_le_none [partial_order α] {x : α} :
¬ @has_le.le (with_zero α) _ (some x) none :=
λ h, option.no_confusion (le_antisymm h zero_le)
def map (f : α → β) : with_zero α → with_zero β := option.map f

@[simp] theorem le_zero_iff_eq_zero [partial_order α] {x : with_zero α} : x ≤ 0 ↔ x = 0 :=
by cases x; simp; try {refl}; {intro h, exact option.no_confusion h}

@[simp] lemma map_zero {f : α → β} : map f 0 = 0 := option.map_none'
@[simp] lemma map_none {f : α → β} : map f none = 0 := option.map_none'

@[simp] lemma map_some {f : α → β} {a : α} : map f (some a) = some (f a) := option.map_some'

theorem map_inj {f : α → β} (H : function.injective f) :
function.injective (map f) := option.map_inj H

@[simp] theorem map_le [partial_order α] [partial_order β] {f : α → β}
(H : ∀ a b : α, a ≤ b ↔ f a ≤ f b) :
∀ x y : with_zero α, x ≤ y ↔ map f x ≤ map f y :=
begin
  intros x y,
  cases x; cases y; intros; try {simp},
  { intro oops, exact option.no_confusion oops },
  { exact H x y }
end

variables [linear_ordered_comm_group α] [linear_ordered_comm_group β]

theorem map_mul (f : α → β) [is_group_hom f] (x y : with_zero α) :
map f (x * y) = option.map f x * option.map f y :=
begin
  cases hx : x; cases hy : y; try {refl},
  show some (f (val * val_1)) = some ((f val) * (f val_1)),
  apply option.some_inj.2,
  exact is_group_hom.mul f val val_1
end

lemma mul_le_mul_left : ∀ a b : with_zero α, a ≤ b → ∀ c : with_zero α, c * a ≤ c * b
| (some x) (some y) hxy (some z) := begin
    rw with_bot.some_le_some at hxy,
    change @has_le.le (with_zero α) _ (some (z * x)) (some (z * y)),
    simp,
    exact linear_ordered_comm_group.mul_le_mul_left hxy z,
  end
| _        _        hxy 0        := by simp
| (some x) 0        hxy _        := by simp [le_antisymm hxy (le_of_lt (with_bot.bot_lt_some x))]
| 0        _        hxy (some _) := by simp

instance : linear_ordered_comm_monoid (with_zero α) :=
{ mul_le_mul_left := mul_le_mul_left,
  .. with_zero.comm_monoid,
  .. with_zero.linear_order }

theorem eq_zero_or_eq_zero_of_mul_eq_zero : ∀ x y : with_zero α, x * y = 0 → x = 0 ∨ y = 0
| (some x) (some y) hxy := false.elim $ option.no_confusion hxy
| 0        _        hxy := or.inl rfl
| _        0        hxy := or.inr rfl

end with_zero


import data.finset data.multiset
import tactic
import init.classical
noncomputable theory
open_locale classical
local attribute [instance, priority 100000] classical.prop_decidable -- avoid decidability hell

namespace list
def ihead {α : Type} : Π l : list α, l ≠ [] → α
| []       h := absurd rfl h
| (a :: t) h := a
end list

structure multigraph (α : Type) :=
(V : finset α)
(E : multiset (α × α))
(valid_edges : ∀ e : α × α, e ∈ E → e.1 ∈ V ∧ e.2 ∈ V)
(no_self_loops : ∀ {u v}, (u, v) ∈ E → u ≠ v)
namespace multigraph
variable {α : Type}

@[simp]
instance : has_mem (α × α) (multigraph α) := ⟨λ e g, e ∈ g.E⟩

def walk_vertices_match (g : multigraph α) : list (α × α) → Prop
| []  := true
| [e] := true
| (e :: f :: t) := e.2 = f.1 ∧ walk_vertices_match t

def is_walk (g : multigraph α) (l : list (α × α)): Prop :=
(∀{e}, e ∈ l → e ∈ g) ∧  walk_vertices_match g l

inductive walk (g : multigraph α) : α → α → Type
| nil : Π (v ∈ g.V), walk v v
| cons : Π (u v w : α) (hmem : (u, v) ∈ g) (l : walk v w), walk u w

namespace walk
variables {g : multigraph α}

@[simp]
def edges : Π {s t : α} (w : walk g s t), list (α × α)
| _ _ (nil g t) := []
| _ _ (cons s t w hmem l) := (s, t) :: (@edges t w l)

def append : Π {s t u : α} (wst : walk g s t) (wtu : walk g t u), walk g s u
| _ _ _ (nil g _) w := w
| _ _ u (cons s v t hmem w1) w2 := cons s v u hmem (append w1 w2)

def s_mem : Π {s t : α} (w : walk g s t), s ∈ g.V
| _ _ (nil g t) := t
| _ _ (cons s v t hmem l) := (g.valid_edges _ hmem).left

def t_mem : Π {s t : α} (w : walk g s t), t ∈ g.V
| _ _ (nil g t) := t
| _ _ (cons s v t hmem l) := t_mem l

def length {u v : α} : walk g u v → ℕ := λ w, w.edges.length

variables {s t : α}
variable w : walk g s t

lemma valid_edge_of_mem_walk (e : α × α) : e ∈ w.edges → e ∈ g :=
begin
  intro hmem,
  induction w with _ _ u v w hemem l ih,
  { simp at hmem, exfalso, exact hmem },
  simp at hmem,
  cases hmem with hl hr,
  { rw ← hl at hemem,
    exact hemem, },
  exact ih hr,
end

@[reducible]
def is_eulerian : Prop :=
∀ u v : α, g.E.countp (λ e, e = (u, v) ∨ e = (v, u)) = w.edges.countp (λ e, e = (u, v) ∨ e = (v, u))
def is_cycle : Prop := s = t
end walk

variable (g : multigraph α)
def degree (v : α) : ℕ := g.E.countp (λ e, ∃ u, e = (u, v) ∨ e = (v, u))

def reachable : α → α → Prop := relation.refl_trans_gen (λ u v, (u, v) ∈ g)
@[reducible]
def is_connected : Prop := ∀ u v ∈ g.V, reachable g u v

@[reducible]
def is_eulerian : Prop := ∃ (s t : α) (w : walk g s t), w.is_eulerian
end multigraph

open multigraph

variable {α : Type}
variable (g : multigraph α)
variable (hcon : g.is_connected)

@[simp]
lemma fun_abstract {α β : Type} (f : α → β) : f = (λ x : α, f x) := rfl

namespace list
universe u
variable (a : α)
variable (l : list α)

theorem countp_cons (p : α → Prop) [∀ a, decidable (p a)] :
    countp p (a :: l) = ite (p a) 1 0 +  countp p l :=
    by {by_cases p a; rw countp; simp [h], ring,}

theorem length_filter_eq_sum_map {α : Type} (l : list α) (p : α → Prop) : length (filter p l) = sum (map (λ x, ite (p x) 1 0) l) :=
begin
  induction l with x l ih; simp,
  by_cases hx : p x,
  all_goals {
    rw filter_cons_of_pos _ hx <|> rw filter_cons_of_neg _ hx,
    simp [length_cons, ih, hx],},
end

theorem not_mem_of_countp_eq_zero {α : Type} (l : list α) (p : α → Prop) : l.countp p = 0 ↔ ∀ a ∈ l, ¬ p a :=
begin
  split,
  { intros hzero a hmem hp,
    induction l with x l ih,
    { simp at hmem, exact hmem, },
    simp [countp_cons] at *,
    cases hmem with hx hl,
    { rw ← hx at hzero, simp [hp] at hzero, exact hzero, },
    exact ih hzero.left hl,},
  intros h,
  induction l with x l ih,
  { simp, },
  simp [countp_cons],
  split,
  { rw ih,
    intros a hmem,
    exact h a (by simp [hmem]), },
  simp [h x],
end

theorem countp_split {α : Type} {l : list α} {p q : α → Prop} : l.countp p = (l.filter q).countp p + (l.filter (λ a, ¬ q a)).countp p :=
begin
  induction l with x l ih,
  { simp, },
  simp [countp_cons],
  by_cases p x,
  { by_cases q x; simp *, },
  simp [h, ih],
end

theorem countp_le_length {α : Type} {l : list α} {p : α → Prop} : l.countp p ≤ l.length :=
begin
  induction l with x l ih,
  simp,
  by_cases p x; simp [h, ih],
  linarith,
end

theorem length_lt_of_filter_of_mem {α : Type} (l : list α) (p : α → Prop) :
    (∃ a ∈ l, ¬ p a) → (l.filter p).length < l.length :=
begin
  intro h,
  cases h with a h,
  cases h with hmem ha,
  induction l with x l ih,
  { simp at ⊢ hmem,
    exfalso,
    exact hmem, },
  rw ← list.countp_eq_length_filter,
  simp [list.countp_cons],
  by_cases heq : a = x,
  { rw ← heq,
    simp [ha],
    have : countp p l ≤ length l, from countp_le_length,
    linarith,
  },
  have : a ∈ l,
  { simp at hmem,
    cases hmem,
    exact absurd hmem heq,
    exact hmem,
  },
  have : l.countp p < length l, by simp [list.countp_eq_length_filter, ih this],
  have hleite : ite (p x) 1 0 ≤ 1, by by_cases p x; simp *,
  linarith,
end

theorem countp_false_eq_zero {l : list α} : l.countp (λ x, false) = 0 :=
    by {induction l with x l ih, simp, simp [ih]}
end list

namespace multiset
theorem countp_cons (s : multiset α) (a : α) (p : α → Prop) [∀ a, decidable (p a)] : countp p (a :: s) = ite (p a) 1 0 + countp p s :=
    by {by_cases p a; simp [h]}

theorem countp_false_eq_zero {s : multiset α} : s.countp (λ x, false) = 0 :=
    by {induction s; simp, induction s with x l ih, simp, simp [ih]}

theorem countp_eq_zero_of_false_of_mem {s : multiset α} {p : α → Prop} (h : ∀ x ∈ s, ¬ p x) : s.countp p = 0 :=
begin
  rcases s with s,
  simp * at *,
  revert h,
  induction s with x l ih; simp [list.countp_cons],
  intros hx hl,
  split,
  { exact ih hl, },
  { simp [hx], },
end

theorem countp_eq_card_of_true_of_mem {s : multiset α} {p : α → Prop} (h : ∀ x ∈ s, p x) : s.countp p = s.card :=
begin
  rcases s with l,
  simp * at *,
  revert h,
  induction l with x l ih; simp [list.countp_cons],
  intros hx hl,
  simp [hx, ih hl],
end

theorem countp_split {α : Type} (s : multiset α) {p : α → Prop} (q : α → Prop) : s.countp p = (s.filter q).countp p + (s.filter (λ a, ¬ q a)).countp p :=
begin
  rcases s with l,
  exact list.countp_split,
end

theorem not_mem_of_countp_eq_zero {α : Type} (s : multiset α) (p : α → Prop) : s.countp p = 0 ↔ ∀ a ∈ s, ¬ p a :=
begin
  rcases s with l,
  simp [list.not_mem_of_countp_eq_zero],
end
end multiset

namespace finset

@[simp]
def countp (p : α → Prop) [decidable_pred p] (s : finset α) : ℕ := s.val.countp p

theorem filter_eq_multiset_filter (p : α → Prop) [decidable_pred p] (s : finset α) : (s.filter p).val = s.val.filter p := by {rcases s, simp}

theorem multiset_card_eq_card (s : finset α) : s.val.card = s.card :=
by {rcases s, simp [card] }

lemma eq_of_subset_of_subset {s t : finset α} (h₁ : s ⊆ t) (h₂ : t ⊆ s) : s = t :=
(eq_of_subset_of_card_le h₁ (card_le_of_subset h₂))

end finset

namespace nat
@[simp]
theorem eq_of_succ_eq_succ (n m : ℕ) : n.succ = m.succ ↔ n = m := by {split, intro h, injection h, intro h, apply_fun nat.succ at h, exact h, }
@[simp]
theorem not_succ_eq_zero (n : ℕ) : n.succ ≠ 0 := by {intro h, injection h }
@[simp]
theorem not_zero_eq_succ (n : ℕ) : 0 ≠ n.succ := by {intro h, injection h }

@[simp]
theorem add_mul_mod (a b m : ℕ) : (a + m * b) % m = a % m := by simp

@[simp]
theorem add_mod_mod (a b m : ℕ) : (a + b % m) % m = (a + b) % m :=
begin
  conv in (a + b) {
    rw ← nat.mod_add_div b m,
  },
  rw ← nat.add_assoc,
  rw add_mul_mod,
end

@[simp]
theorem mod_add_mod (a b m : ℕ) : (a % m + b) % m = (a + b) % m :=
begin
  simp,
end

@[simp]
theorem even_of_not_odd (n : ℕ) : ¬ n % 2 = 1 ↔ n % 2 = 0 :=
begin
  have := nat.mod_two_eq_zero_or_one n,
  split; intro h; finish,
end

@[simp]
theorem odd_of_not_even (n : ℕ) : ¬ n % 2 = 0 ↔ n % 2 = 1 :=
begin
  have := nat.mod_two_eq_zero_or_one n,
  split; intro h; finish,
end

@[simp]
theorem one_mod_two_eq_one : 1 % 2 = 1 := nat.mod_eq_of_lt (by linarith)
@[simp]
theorem zero_mod_two_eq_zero : 0 % 2 = 0 := nat.mod_eq_of_lt (by linarith)

@[simp]
theorem even_of_succ_odd (n : ℕ) : (n + 1) % 2 = 1 ↔ n % 2 = 0 :=
begin
  rw ← mod_add_mod,
  split; intro h,
  { by_contradiction hn,
    simp at hn,
    simp [hn] at h,
    exact h, },
  simp [h],
end

@[simp]
theorem odd_of_succ_even (n : ℕ) : (n + 1) % 2 = 0 ↔ n % 2 = 1 :=
begin
  rw ← mod_add_mod,
  split; intro h,
  { by_contradiction hn,
    simp at hn,
    simp [hn] at h,
    exact h, },
  simp [h],
end
end nat

open multigraph
variable {β : Type}
lemma vert_in_walk (x : α) : ∀ (s t : α) (wlk : walk g s t),
    wlk.edges.countp (λ e, ∃ u, e = (x, u)) + ite (t = x) 1 0 =
    wlk.edges.countp (λ e, ∃ u, e = (u, x)) + ite (s = x) 1 0
| _ _ (walk.nil g s)           := by simp
| _ _ (walk.cons s v t hmem w) :=
have hdec : @list.length (α × α) (@walk.edges α g v t w) < 1 + @list.length (α × α) (@walk.edges α g v t w), by linarith,
begin
  have indrw := vert_in_walk v t w,
  by_cases (s = x),
  { have hne : v ≠ x,
    { rw h at hmem,
      have this := g.no_self_loops hmem,
      symmetry,
      exact this,
    },
    simp [list.countp_cons, h, hne] at ⊢ indrw,
    exact indrw,
  },
  by_cases hcase: v = x;
  { simp [list.countp_cons, h, hcase] at ⊢ indrw,
    exact indrw,
  },
end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ psig, psig.2.2.edges.length)⟩], dec_tac := well_founded_tactics.default_dec_tac'}

@[simp]
lemma exists_and (a : α) (p : α → Prop) : (∃ x, p x) ∧ p a ↔ p a :=
by { split; simp, intro hp, split, exact ⟨a, hp⟩, exact hp, }

lemma injective_count_aux (len : ℕ) {r : α → β → Prop} (nodup : ∀ (x y : α) (b : β),
    x ≠ y → ¬ (r x b ∧ r y b)) : ∀ l1 l2 : list β, l1.length ≤ len → (∀ a : α, l1.countp (r a) = l2.countp (r a)) →
    l1.countp (λ b, ∃ a, r a b) = l2.countp (λ b, ∃ a, r a b) :=
begin
  induction len with len,
  { intros l1 l2 hlen hp,
    simp at hlen,
    have : l1 = list.nil, by rw list.eq_nil_of_length_eq_zero hlen,
    rw this at hp ⊢,
    simp at hp ⊢,
    have : ∀ b ∈ l2, ¬ ∃ a, r a b,
    { intros b hmem h,
      cases h with a ha,
      have : ∀ c ∈ l2, ¬ r a c,
      rw ← list.not_mem_of_countp_eq_zero,
      { symmetry,
        exact hp a, },
      exact absurd ha (this b hmem),
    },
    symmetry,
    rw list.not_mem_of_countp_eq_zero,
    exact this, },
  intros l1 l2 hlen h,
  by_cases hex : ∃ a, ∃ b ∈ l1, r a b,
  { cases hex with a ha,
    rw @list.countp_split _ l1 _ (λ b, r a b),
    rw @list.countp_split _ l2 _ (λ b, r a b),
    repeat {rw @list.countp_filter _ _ _ (λ (b : β), r a b) _ _},
    simp [-list.countp_filter],
    suffices : list.countp (λ (b : β), ∃ (a : α), r a b) (list.filter (λ (a_1 : β), ¬r a a_1) l1) + list.countp (r a) l1 =
    list.countp (λ (b : β), ∃ (a : α), r a b) (list.filter (λ (a_1 : β), ¬r a a_1) l2) + list.countp (r a) l2,
    { convert this }, -- decidability hell
    simp [h a, -list.countp_filter],
    set l1' := (list.filter (λ (a_1 : β), ¬r a a_1) l1),
    set l2' := (list.filter (λ (a_1 : β), ¬r a a_1) l2),

    have hlen' : l1'.length ≤ len,
    { have : l1'.length < l1.length,
      { apply list.length_lt_of_filter_of_mem,
        simp at ⊢ ha,
        exact ha,
      },
      have : nat.succ l1'.length ≤ nat.succ len,
      { apply nat.succ_le_of_lt,
        apply nat.lt_of_lt_of_le this hlen, },
      exact nat.le_of_succ_le_succ this,
    },

    have heqcountp : ∀ l (a' : α) (hne : a' ≠ a), (list.filter (λ (b : β), ¬r a b) l).countp (r a') = l.countp (r a'),
    { intros l a' hne,
      induction l with x l ih,
      simp,
      simp at ih,
      simp [list.countp_cons, ih],
      by_cases r a' x,
      { have : ¬ r a x, { have not_and := nodup a' a x hne, finish [nodup a' a x hne], },
        simp *, },
      simp *,
    },

    have h' : ∀ (a : α), list.countp (r a) l1' = list.countp (r a) l2',
    { intro a',
      by_cases hcase : a' = a,
      { rw hcase,
        simp,
        suffices : list.countp (λ (a : β), false) l1 = list.countp (λ (a : β), false) l2,
        { convert this, }, -- more decidability hell
        simp [list.countp_false_eq_zero],
      },
      rw heqcountp l1 _ hcase,
      rw heqcountp l2 _ hcase,
      exact h a',
    },
    exact len_ih l1' l2' (by simp [hlen']) h', },
  have : ∀ b ∈ l1, ¬ ∃ a, r a b,
  { intros b hmem h,
    cases h with a ha,
    have : ∃ (a : α) (b : β) (H : b ∈ l1), r a b,
    exact ⟨a, ⟨b, ⟨hmem, ha⟩⟩⟩,
    exact absurd this hex, },
  rw list.countp_eq_length_filter,
  rw list.countp_eq_length_filter,
  have : ∀ b, b ∉ list.filter (λ (b : β), ∃ (a : α), r a b) l1,
  { intros b h,
    simp at h,
    exact absurd h.right (this b h.left), },
  rw list.eq_nil_iff_forall_not_mem.mpr this,
  have : ∀ b, b ∉ list.filter (λ (b : β), ∃ (a : α), r a b) l2,
  { intros b h,
    simp at h,
    cases h with hmem hr,
    cases hr with a hr,
    have : list.countp (r a) l2 = 0,
    { rw ← h a,
      have : ∀ b, b ∉ list.filter (r a) l1,
      { intros b h,
        simp at h,
        cases h with hmem hr,
        have : ∃ (a : α) (b : β) (H : b ∈ l1), r a b,
        exact ⟨a, ⟨b, ⟨hmem, hr⟩⟩⟩,
        exact absurd this hex, },
      rw list.countp_eq_length_filter,
      rw list.eq_nil_iff_forall_not_mem.mpr this,
      simp, },
    rw list.countp_eq_length_filter at this,
    have : l2.filter (r a) = [], from list.eq_nil_of_length_eq_zero this,
    have hfilter_mem : b ∈ l2.filter (r a),
    { rw list.mem_filter,
      exact ⟨hmem, hr⟩, },
    rw list.eq_nil_iff_forall_not_mem at this,
    exact absurd hfilter_mem (this b), },
  rw list.eq_nil_iff_forall_not_mem.mpr this,
end

lemma injective_count {l1 l2 : list β} {r : α → β → Prop} (nodup : ∀ (x y : α) (b : β),
    x ≠ y → ¬ (r x b ∧ r y b)) : (∀ a : α, l1.countp (r a) = l2.countp (r a)) →
    l1.countp (λ b, ∃ a, r a b) = l2.countp (λ b, ∃ a, r a b) :=
begin
  set len := l1.length,
  exact injective_count_aux len nodup l1 l2 (by simp [len]),
end

lemma count_plus (l : list α) (p q : α → Prop) (nodup : ∀ a ∈ l, ¬ (p a ∧ q a)) :
l.countp p + l.countp q = l.countp (λ a, p a ∨ q a) :=
begin
  induction l with a l1 ih,
  { simp },
  simp [list.count_cons', list.countp_cons],
  by_cases p a ∨ q a,
  { cases h,
    { have : ¬ q a, by finish,
      simp [h, this], rw ih,
      intros a hmem, exact nodup a (by simp [hmem]),},
    { have : ¬ p a, by finish,
      simp [h, this], rw ih,
      intros a hmem, exact nodup a (by simp [hmem]),} },
  { have hane : ¬ p a, by finish,
    have hbne : ¬ q a, by finish,
    simp [hane, hbne], rw ih,
    intros a hmem, exact nodup a (by simp [hmem]),}
end

lemma degree_of_eulerian_walk {s t : α} {w : walk g s t} (he : w.is_eulerian) {v : α} :
g.degree v =  list.countp (λ (a : α × α), ∃ (x : α), a = (x, v)) (walk.edges w) +
              list.countp (λ (a : α × α), ∃ (x : α), a = (v, x)) (walk.edges w) :=
begin
  have : g.degree v = w.edges.countp (λ e, ∃ u, e = (u, v) ∨ e = (v, u)),
  { rw degree,
    have he := (λ u, he u v),
    revert he,
    induction g.E with l;
    intro he; simp at *,
    apply injective_count (by finish) he },
  rw this,
  simp [exists_or_distrib],
  suffices :
  list.countp (λ (e : α × α), (∃ (x : α), e = (x, v)) ∨ ∃ (x : α), e = (v, x)) (walk.edges w) =
    list.countp (λ (a : α × α), ∃ (x : α), a = (x, v)) (walk.edges w) +
      list.countp (λ (a : α × α), ∃ (x : α), a = (v, x)) (walk.edges w),
  { convert this, },
  rw ← count_plus,
  intros e hmem h,
  cases h with hl hr,
  cases hl with xl hl,
  cases hr with xr hr,
  rw hr at hl,
  have hmem := w.valid_edge_of_mem_walk _ hmem,
  rw hr at hmem,
  have hv_ne_xr := g.no_self_loops hmem,
  simp at hl,
  finish,
end

lemma degree_constraint_of_eulerian (h : g.is_eulerian) :
g.V.countp (λ v, g.degree v % 2 = 1) = 0 ∨ g.V.countp (λ v, g.degree v % 2 = 1) = 2 :=
begin
  rw is_eulerian at h,
  cases h with s h,
  cases h with t h,
  cases h with w he,
  unfold finset.countp,
  by_cases hcase : s = t,
  { left,
    have : ∀ v ∈ g.V, g.degree v % 2 = 0,
    { intros v hmem,
      have hcnt := vert_in_walk g v _ _ w,
      simp [hcase] at hcnt,
      rw degree_of_eulerian_walk _ he,
      by_cases htv : t = v; simp [htv] at hcnt; rw hcnt; ring; simp, },
      conv at this in (_ = 0) { rw ← nat.even_of_not_odd, },
      exact multiset.countp_eq_zero_of_false_of_mem this,
  },
  right,
  rw multiset.countp_split g.V.val (λ x, s = x ∨ t = x),
  simp,
  have : ∀ v ∈ g.V, ¬ (s = v ∨ t = v) → g.degree v % 2 = 0,
  { intros v hmem hne,
    rw not_or_distrib at hne,
    cases hne with hnes hnet,
    have hcnt := vert_in_walk g v _ _ w,
    rw degree_of_eulerian_walk _ he,
    simp [hnes, hnet] at hcnt,
    simp [hcnt],
    ring, simp, },
  have : ∀ v ∈ g.V, ¬ (degree g v % 2 = 1 ∧ ¬(s = v ∨ t = v)),
  { intros v hmem h,
    cases h with h hne,
    rw ← nat.odd_of_not_even at h,
    exact absurd (this v hmem hne) h,
  },
  suffices : multiset.countp (λ (a : α), degree g a % 2 = 1 ∧ (s = a ∨ t = a)) g.V.val +
      multiset.countp (λ (a : α), degree g a % 2 = 1 ∧ ¬(s = a ∨ t = a)) g.V.val =
    2,
  { convert this, },
  simp [multiset.countp_eq_zero_of_false_of_mem this],
  rw multiset.countp_eq_card_filter,
  rw ← finset.filter_eq_multiset_filter,

  have hsdeg : g.degree s % 2 = 1,
  { have hcnt := vert_in_walk g s _ _ w,
    simp [ne.symm hcase] at hcnt,
    rw degree_of_eulerian_walk _ he,
    simp [hcnt],
    ring, simp, },
  have htdeg : g.degree t % 2 = 1,
  { have hcnt := vert_in_walk g t _ _ w,
    simp [hcase] at hcnt,
    rw degree_of_eulerian_walk _ he,
    simp [eq.symm hcnt],
    ring, simp, },

  have : finset.filter (λ (a : α), degree g a % 2 = 1 ∧ (s = a ∨ t = a)) g.V = {s, t},
  { apply finset.eq_of_subset_of_subset; rw finset.subset_iff; intros x hmem,
    { rw finset.mem_filter at hmem,
    rcases hmem with ⟨hmem, hdeg, hcase | hcase⟩; simp [hcase],},
    { simp at hmem,
      cases hmem; rw hmem,
      { simp [htdeg, w.t_mem], },
      { simp [hsdeg, w.s_mem], }, },
  },
  rw this,
  rw finset.multiset_card_eq_card,
  simp,
  change s ≠ t at hcase,
  rw @finset.card_insert_of_not_mem _ _ t (finset.singleton s) (by simp [ne_comm.mp hcase]),
  simp [hcase],
end

namespace konigsberg

@[simp]
def V : finset ℕ := {0, 1, 2, 3}
@[simp]
def E : multiset (ℕ × ℕ) :=
    (0, 1) :: (0, 1) :: (1, 2) :: (1, 2) :: (0, 3) :: (1, 3) :: (2, 3) :: {}

lemma valid_edges : ∀ e : ℕ × ℕ, e ∈ E → e.1 ∈ V ∧ e.2 ∈ V :=
begin
  intros e hmem,
  rw V,
  rw E at hmem,
  fin_cases hmem; simp,
end

lemma no_self_loops : ∀ u v : ℕ, (u, v) ∈ E → u ≠ v :=
begin
  intros u v hmem heq,
  rw heq at hmem,
  rw E at hmem,
  fin_cases hmem; simp at hmem; finish,
end

@[simp]
def G := multigraph.mk V E valid_edges no_self_loops

lemma all_degrees_odd : ∀ v ∈ G.V, G.degree v % 2 = 1 :=
begin
  intros v hmem,
  simp at hmem,
  rcases hmem with rfl | rfl | rfl | rfl; unfold degree; simp,
end

lemma four_odd_degree_verts : G.V.countp (λ v, G.degree v % 2 = 1) = 4 :=
begin
  unfold finset.countp,
  rw multiset.countp_eq_card_of_true_of_mem,
  { simp, },
  exact all_degrees_odd,
end

theorem no_euler_walk_in_konigsberg_bridge : ¬ G.is_eulerian :=
begin
  intro h,
  have hdeg := degree_constraint_of_eulerian _ h,
  rw four_odd_degree_verts at hdeg,
  simp at hdeg,
  exact hdeg,
end

end konigsberg


/-
Copyright (c) 2021 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu
-/
import algebraic_geometry.Scheme
import category_theory.adjunction.limits
import category_theory.adjunction.reflective

/-!
# Adjunction between `Γ` and `Spec`

We define the adjunction `Γ_Spec.adjunction : Γ ⊣ Spec` by defining the unit (`to_Γ_Spec`,
in multiple steps in this file) and counit (done in Spec.lean) and checking that they satisfy
the left and right triangle identities. The constructions and proofs make use of
maps and lemmas defined and proved in structure_sheaf.lean extensively.

Notice that since the adjunction is between contravariant functors, you get to choose
one of the two categories to have arrows reversed, and it is equally valid to present
the adjunction as `Spec ⊣ Γ` (`Spec.to_LocallyRingedSpace.right_op ⊣ Γ`), in which
case the unit and the counit would switch to each other.

## Main definition

* `algebraic_geometry.identity_to_Γ_Spec` : The natural transformation `𝟭 _ ⟶ Γ ⋙ Spec`.
* `algebraic_geometry.Γ_Spec.LocallyRingedSpace_adjunction` : The adjunction `Γ ⊣ Spec` from
  `CommRingᵒᵖ` to `LocallyRingedSpace`.
* `algebraic_geometry.Γ_Spec.adjunction` : The adjunction `Γ ⊣ Spec` from
  `CommRingᵒᵖ` to `Scheme`.

-/

noncomputable theory
universes u

open prime_spectrum

namespace algebraic_geometry
open opposite
open category_theory
open structure_sheaf
open topological_space
open algebraic_geometry.LocallyRingedSpace
open Top.presheaf
open Top.presheaf.sheaf_condition

namespace LocallyRingedSpace

variable (X : LocallyRingedSpace.{u})

/-- The map from the global sections to a stalk. -/
def Γ_to_stalk (x : X) : Γ.obj (op X) ⟶ X.presheaf.stalk x :=
X.presheaf.germ (⟨x,trivial⟩ : (⊤ : opens X))

/-- The canonical map from the underlying set to the prime spectrum of `Γ(X)`. -/
def to_Γ_Spec_fun : X → prime_spectrum (Γ.obj (op X)) :=
λ x, comap (X.Γ_to_stalk x) (local_ring.closed_point (X.presheaf.stalk x))

lemma not_mem_prime_iff_unit_in_stalk (r : Γ.obj (op X)) (x : X) :
  r ∉ (X.to_Γ_Spec_fun x).as_ideal ↔ is_unit (X.Γ_to_stalk x r) :=
by erw [local_ring.mem_maximal_ideal, not_not]

/-- The preimage of a basic open in `Spec Γ(X)` under the unit is the basic
open in `X` defined by the same element (they are equal as sets). -/
lemma to_Γ_Spec_preim_basic_open_eq (r : Γ.obj (op X)) :
  X.to_Γ_Spec_fun⁻¹' (basic_open r).1 = (X.to_RingedSpace.basic_open r).1 :=
by { ext, erw X.to_RingedSpace.mem_top_basic_open, apply not_mem_prime_iff_unit_in_stalk }

/-- `to_Γ_Spec_fun` is continuous. -/
lemma to_Γ_Spec_continuous : continuous X.to_Γ_Spec_fun :=
begin
  apply is_topological_basis_basic_opens.continuous,
  rintro _ ⟨r, rfl⟩,
  erw X.to_Γ_Spec_preim_basic_open_eq r,
  exact (X.to_RingedSpace.basic_open r).2,
end

/-- The canonical (bundled) continuous map from the underlying topological
space of `X` to the prime spectrum of its global sections. -/
@[simps]
def to_Γ_Spec_base : X.to_Top ⟶ Spec.Top_obj (Γ.obj (op X)) :=
{ to_fun := X.to_Γ_Spec_fun,
  continuous_to_fun := X.to_Γ_Spec_continuous }

variable (r : Γ.obj (op X))

/-- The preimage in `X` of a basic open in `Spec Γ(X)` (as an open set). -/
abbreviation to_Γ_Spec_map_basic_open : opens X :=
(opens.map X.to_Γ_Spec_base).obj (basic_open r)

/-- The preimage is the basic open in `X` defined by the same element `r`. -/
lemma to_Γ_Spec_map_basic_open_eq : X.to_Γ_Spec_map_basic_open r = X.to_RingedSpace.basic_open r :=
subtype.eq (X.to_Γ_Spec_preim_basic_open_eq r)

/-- The map from the global sections `Γ(X)` to the sections on the (preimage of) a basic open. -/
abbreviation to_to_Γ_Spec_map_basic_open :
  X.presheaf.obj (op ⊤) ⟶ X.presheaf.obj (op $ X.to_Γ_Spec_map_basic_open r) :=
X.presheaf.map (X.to_Γ_Spec_map_basic_open r).le_top.op

/-- `r` is a unit as a section on the basic open defined by `r`. -/
lemma is_unit_res_to_Γ_Spec_map_basic_open :
  is_unit (X.to_to_Γ_Spec_map_basic_open r r) :=
begin
  convert (X.presheaf.map $ (eq_to_hom $ X.to_Γ_Spec_map_basic_open_eq r).op)
    .is_unit_map (X.to_RingedSpace.is_unit_res_basic_open r),
  rw ← comp_apply,
  erw ← functor.map_comp,
  congr
end

/-- Define the sheaf hom on individual basic opens for the unit. -/
def to_Γ_Spec_c_app :
  (structure_sheaf $ Γ.obj $ op X).val.obj (op $ basic_open r) ⟶
    X.presheaf.obj (op $ X.to_Γ_Spec_map_basic_open r) :=
is_localization.away.lift r (is_unit_res_to_Γ_Spec_map_basic_open _ r)

/-- Characterization of the sheaf hom on basic opens,
    direction ← (next lemma) is used at various places, but → is not used in this file. -/
lemma to_Γ_Spec_c_app_iff
  (f : (structure_sheaf $ Γ.obj $ op X).val.obj (op $ basic_open r) ⟶
    X.presheaf.obj (op $ X.to_Γ_Spec_map_basic_open r)) :
  to_open _ (basic_open r) ≫ f = X.to_to_Γ_Spec_map_basic_open r ↔ f = X.to_Γ_Spec_c_app r :=
begin
  rw ← (is_localization.away.away_map.lift_comp r
    (X.is_unit_res_to_Γ_Spec_map_basic_open r)),
  swap 5, exact is_localization.to_basic_open _ r,
  split,
  { intro h, refine is_localization.ring_hom_ext _ _,
    swap 5, exact is_localization.to_basic_open _ r, exact h },
  apply congr_arg,
end

lemma to_Γ_Spec_c_app_spec :
  to_open _ (basic_open r) ≫ X.to_Γ_Spec_c_app r = X.to_to_Γ_Spec_map_basic_open r :=
(X.to_Γ_Spec_c_app_iff r _).2 rfl

/-- The sheaf hom on all basic opens, commuting with restrictions. -/
def to_Γ_Spec_c_basic_opens :
  (induced_functor basic_open).op ⋙ (structure_sheaf (Γ.obj (op X))).1 ⟶
  (induced_functor basic_open).op ⋙ ((Top.sheaf.pushforward X.to_Γ_Spec_base).obj X.𝒪).1 :=
{ app := λ r, X.to_Γ_Spec_c_app r.unop,
  naturality' := λ r s f, begin
    apply (structure_sheaf.to_basic_open_epi (Γ.obj (op X)) r.unop).1,
    simp only [← category.assoc],
    erw X.to_Γ_Spec_c_app_spec r.unop,
    convert X.to_Γ_Spec_c_app_spec s.unop,
    symmetry,
    apply X.presheaf.map_comp
  end }

/-- The canonical morphism of sheafed spaces from `X` to the spectrum of its global sections. -/
@[simps]
def to_Γ_Spec_SheafedSpace : X.to_SheafedSpace ⟶ Spec.to_SheafedSpace.obj (op (Γ.obj (op X))) :=
{ base := X.to_Γ_Spec_base,
  c := Top.sheaf.restrict_hom_equiv_hom (structure_sheaf (Γ.obj (op X))).1 _
    is_basis_basic_opens X.to_Γ_Spec_c_basic_opens }

lemma to_Γ_Spec_SheafedSpace_app_eq :
  X.to_Γ_Spec_SheafedSpace.c.app (op (basic_open r)) = X.to_Γ_Spec_c_app r :=
Top.sheaf.extend_hom_app _ _ _ _ _

lemma to_Γ_Spec_SheafedSpace_app_spec (r : Γ.obj (op X)) :
  to_open _ (basic_open r) ≫ X.to_Γ_Spec_SheafedSpace.c.app (op (basic_open r)) =
    X.to_to_Γ_Spec_map_basic_open r :=
(X.to_Γ_Spec_SheafedSpace_app_eq r).symm ▸ X.to_Γ_Spec_c_app_spec r

/-- The map on stalks induced by the unit commutes with maps from `Γ(X)` to
    stalks (in `Spec Γ(X)` and in `X`). -/
lemma to_stalk_stalk_map_to_Γ_Spec (x : X) : to_stalk _ _ ≫
  PresheafedSpace.stalk_map X.to_Γ_Spec_SheafedSpace x = X.Γ_to_stalk x :=
begin
  rw PresheafedSpace.stalk_map,
  erw ← to_open_germ _ (basic_open (1 : Γ.obj (op X)))
    ⟨X.to_Γ_Spec_fun x, by rw basic_open_one; trivial⟩,
  rw [← category.assoc, category.assoc (to_open _ _)],
  erw stalk_functor_map_germ,
  rw [← category.assoc (to_open _ _), X.to_Γ_Spec_SheafedSpace_app_spec 1],
  unfold Γ_to_stalk,
  rw ← stalk_pushforward_germ _ X.to_Γ_Spec_base X.presheaf ⊤,
  congr' 1,
  change (X.to_Γ_Spec_base _* X.presheaf).map le_top.hom.op ≫ _ = _,
  apply germ_res,
end

/-- The canonical morphism from `X` to the spectrum of its global sections. -/
@[simps coe_base]
def to_Γ_Spec : X ⟶ Spec.LocallyRingedSpace_obj (Γ.obj (op X)) :=
{ val := X.to_Γ_Spec_SheafedSpace,
  property :=
  begin
    intro x,
    let p : prime_spectrum (Γ.obj (op X)) := X.to_Γ_Spec_fun x,
    constructor, /- show stalk map is local hom ↓ -/
    let S := (structure_sheaf _).val.stalk p,
    rintros (t : S) ht,
    obtain ⟨⟨r, s⟩, he⟩ := is_localization.surj p.as_ideal.prime_compl t,
    dsimp at he,
    apply is_unit_of_mul_is_unit_left,
    rw he,
    refine is_localization.map_units S (⟨r, _⟩ : p.as_ideal.prime_compl),
    apply (not_mem_prime_iff_unit_in_stalk _ _ _).mpr,
    rw [← to_stalk_stalk_map_to_Γ_Spec, comp_apply],
    erw ← he,
    rw ring_hom.map_mul,
    exact ht.mul ((is_localization.map_units S s : _).map
      (PresheafedSpace.stalk_map X.to_Γ_Spec_SheafedSpace x).to_monoid_hom)
  end }

lemma comp_ring_hom_ext {X : LocallyRingedSpace} {R : CommRing}
  {f : R ⟶ Γ.obj (op X)} {β : X ⟶ Spec.LocallyRingedSpace_obj R}
  (w : X.to_Γ_Spec.1.base ≫ (Spec.LocallyRingedSpace_map f).1.base = β.1.base)
  (h : ∀ r : R,
    f ≫ X.presheaf.map (hom_of_le le_top : (opens.map β.1.base).obj (basic_open r) ⟶ _).op =
      to_open R (basic_open r) ≫ β.1.c.app (op (basic_open r))) :
  X.to_Γ_Spec ≫ Spec.LocallyRingedSpace_map f = β :=
begin
  ext1,
  apply Spec.basic_open_hom_ext,
  { intros r _,
    rw LocallyRingedSpace.comp_val_c_app,
    erw to_open_comp_comap_assoc,
    rw category.assoc,
    erw [to_Γ_Spec_SheafedSpace_app_spec, ← X.presheaf.map_comp],
    convert h r },
  exact w,
end

/-- `to_Spec_Γ _` is an isomorphism so these are mutually two-sided inverses. -/
lemma Γ_Spec_left_triangle : to_Spec_Γ (Γ.obj (op X)) ≫ X.to_Γ_Spec.1.c.app (op ⊤) = 𝟙 _ :=
begin
  unfold to_Spec_Γ,
  rw ← to_open_res _ (basic_open (1 : Γ.obj (op X))) ⊤ (eq_to_hom basic_open_one.symm),
  erw category.assoc,
  rw [nat_trans.naturality, ← category.assoc],
  erw [X.to_Γ_Spec_SheafedSpace_app_spec 1, ← functor.map_comp],
  convert eq_to_hom_map X.presheaf _, refl,
end

end LocallyRingedSpace

/-- The unit as a natural transformation. -/
def identity_to_Γ_Spec : 𝟭 LocallyRingedSpace.{u} ⟶ Γ.right_op ⋙ Spec.to_LocallyRingedSpace :=
{ app := LocallyRingedSpace.to_Γ_Spec,
  naturality' := λ X Y f, begin
    symmetry,
    apply LocallyRingedSpace.comp_ring_hom_ext,
    { ext1 x,
      dsimp [Spec.Top_map, LocallyRingedSpace.to_Γ_Spec_fun],
      rw [← subtype.val_eq_coe, ← local_ring.comap_closed_point (PresheafedSpace.stalk_map _ x),
        ← prime_spectrum.comap_comp_apply, ← prime_spectrum.comap_comp_apply],
      congr' 2,
      exact (PresheafedSpace.stalk_map_germ f.1 ⊤ ⟨x,trivial⟩).symm,
      apply_instance },
    { intro r,
      rw [LocallyRingedSpace.comp_val_c_app, ← category.assoc],
      erw [Y.to_Γ_Spec_SheafedSpace_app_spec, f.1.c.naturality],
      refl },
  end }

namespace Γ_Spec

/-- `Spec_Γ_identity` is iso so these are mutually two-sided inverses. -/
lemma right_triangle (R : CommRing) :
  identity_to_Γ_Spec.app (Spec.to_LocallyRingedSpace.obj $ op R) ≫
  Spec.to_LocallyRingedSpace.map (Spec_Γ_identity.inv.app R).op = 𝟙 _ :=
begin
  apply LocallyRingedSpace.comp_ring_hom_ext,
  { ext (p : prime_spectrum R) x,
    erw ← is_localization.at_prime.to_map_mem_maximal_iff
      ((structure_sheaf R).val.stalk p) p.as_ideal x,
    refl },
  { intro r, apply to_open_res },
end

-- Removing this makes the following definition time out.
local attribute [irreducible] Spec_Γ_identity identity_to_Γ_Spec Spec.to_LocallyRingedSpace

/-- The adjunction `Γ ⊣ Spec` from `CommRingᵒᵖ` to `LocallyRingedSpace`. -/
@[simps unit counit] def LocallyRingedSpace_adjunction : Γ.right_op ⊣ Spec.to_LocallyRingedSpace :=
adjunction.mk_of_unit_counit
{ unit := identity_to_Γ_Spec,
  counit := (nat_iso.op Spec_Γ_identity).inv,
  left_triangle' := by { ext X, erw category.id_comp,
    exact congr_arg quiver.hom.op (left_triangle X) },
  right_triangle' := by { ext1, ext1 R, erw category.id_comp,
    exact right_triangle R.unop } }

local attribute [semireducible] Spec.to_LocallyRingedSpace

/-- The adjunction `Γ ⊣ Spec` from `CommRingᵒᵖ` to `Scheme`. -/
def adjunction : Scheme.Γ.right_op ⊣ Scheme.Spec :=
LocallyRingedSpace_adjunction.restrict_fully_faithful
  Scheme.forget_to_LocallyRingedSpace (𝟭 _)
  (nat_iso.of_components (λ X, iso.refl _) (λ _ _ f, by simpa))
  (nat_iso.of_components (λ X, iso.refl _) (λ _ _ f, by simpa))

lemma adjunction_hom_equiv_apply {X : Scheme} {R : CommRingᵒᵖ}
  (f : (op $ Scheme.Γ.obj $ op X) ⟶ R) :
  Γ_Spec.adjunction.hom_equiv X R f =
    LocallyRingedSpace_adjunction.hom_equiv X.1 R f :=
by { dsimp [adjunction, adjunction.restrict_fully_faithful], simp }

local attribute [irreducible] LocallyRingedSpace_adjunction Γ_Spec.adjunction

lemma adjunction_hom_equiv (X : Scheme) (R : CommRingᵒᵖ) :
  Γ_Spec.adjunction.hom_equiv X R = LocallyRingedSpace_adjunction.hom_equiv X.1 R :=
equiv.ext $ λ f, adjunction_hom_equiv_apply f

lemma adjunction_hom_equiv_symm_apply {X : Scheme} {R : CommRingᵒᵖ}
  (f : X ⟶ Scheme.Spec.obj R) :
  (Γ_Spec.adjunction.hom_equiv X R).symm f =
    (LocallyRingedSpace_adjunction.hom_equiv X.1 R).symm f :=
by { congr' 2, exact adjunction_hom_equiv _ _ }

@[simp] lemma adjunction_counit_app {R : CommRingᵒᵖ} :
  Γ_Spec.adjunction.counit.app R = LocallyRingedSpace_adjunction.counit.app R :=
by { rw [← adjunction.hom_equiv_symm_id, ← adjunction.hom_equiv_symm_id,
  adjunction_hom_equiv_symm_apply], refl }

@[simp] lemma adjunction_unit_app {X : Scheme} :
  Γ_Spec.adjunction.unit.app X = LocallyRingedSpace_adjunction.unit.app X.1 :=
by { rw [← adjunction.hom_equiv_id, ← adjunction.hom_equiv_id, adjunction_hom_equiv_apply], refl }

local attribute [semireducible] LocallyRingedSpace_adjunction Γ_Spec.adjunction

instance is_iso_LocallyRingedSpace_adjunction_counit :
  is_iso LocallyRingedSpace_adjunction.counit :=
is_iso.of_iso_inv _

instance is_iso_adjunction_counit : is_iso Γ_Spec.adjunction.counit :=
begin
  apply_with nat_iso.is_iso_of_is_iso_app { instances := ff },
  intro R,
  rw adjunction_counit_app,
  apply_instance,
end

-- This is just
-- `(Γ_Spec.adjunction.unit.app X).1.c.app (op ⊤) = Spec_Γ_identity.hom.app (X.presheaf.obj (op ⊤))`
-- But lean times out when trying to unify the types of the two sides.
lemma adjunction_unit_app_app_top (X : Scheme) :
  @eq ((Scheme.Spec.obj (op $ X.presheaf.obj (op ⊤))).presheaf.obj (op ⊤) ⟶
    ((Γ_Spec.adjunction.unit.app X).1.base _* X.presheaf).obj (op ⊤))
  ((Γ_Spec.adjunction.unit.app X).val.c.app (op ⊤))
    (Spec_Γ_identity.hom.app (X.presheaf.obj (op ⊤))) :=
begin
  have := congr_app Γ_Spec.adjunction.left_triangle X,
  dsimp at this,
  rw ← is_iso.eq_comp_inv at this,
  simp only [Γ_Spec.LocallyRingedSpace_adjunction_counit, nat_trans.op_app, category.id_comp,
    Γ_Spec.adjunction_counit_app] at this,
  rw [← op_inv, nat_iso.inv_inv_app, quiver.hom.op_inj.eq_iff] at this,
  exact this
end

end Γ_Spec

/-! Immediate consequences of the adjunction. -/

/-- Spec preserves limits. -/
instance : limits.preserves_limits Spec.to_LocallyRingedSpace :=
Γ_Spec.LocallyRingedSpace_adjunction.right_adjoint_preserves_limits
instance Spec.preserves_limits : limits.preserves_limits Scheme.Spec :=
Γ_Spec.adjunction.right_adjoint_preserves_limits

/-- Spec is a full functor. -/
instance : full Spec.to_LocallyRingedSpace :=
R_full_of_counit_is_iso Γ_Spec.LocallyRingedSpace_adjunction
instance Spec.full : full Scheme.Spec :=
R_full_of_counit_is_iso Γ_Spec.adjunction

/-- Spec is a faithful functor. -/
instance : faithful Spec.to_LocallyRingedSpace :=
R_faithful_of_counit_is_iso Γ_Spec.LocallyRingedSpace_adjunction
instance Spec.faithful : faithful Scheme.Spec :=
R_faithful_of_counit_is_iso Γ_Spec.adjunction

instance : is_right_adjoint Spec.to_LocallyRingedSpace := ⟨_, Γ_Spec.LocallyRingedSpace_adjunction⟩
instance : is_right_adjoint Scheme.Spec := ⟨_, Γ_Spec.adjunction⟩

instance : reflective Spec.to_LocallyRingedSpace := ⟨⟩
instance Spec.reflective : reflective Scheme.Spec := ⟨⟩

end algebraic_geometry


/-
Copyright (c) 2020 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/
import data.list.range

/-!
# Lemmas about list.*_with_index functions.

Some specification lemmas for `list.map_with_index`, `list.mmap_with_index`, `list.foldl_with_index`
and `list.foldr_with_index`.
-/

universes u v

open function

namespace list

variables {α : Type u} {β : Type v}

section map_with_index

@[simp] lemma map_with_index_nil {α β} (f : ℕ → α → β) :
  map_with_index f [] = [] := rfl

lemma map_with_index_core_eq (l : list α) (f : ℕ → α → β) (n : ℕ) :
  l.map_with_index_core f n = l.map_with_index (λ i a, f (i + n) a) :=
begin
  induction l with hd tl hl generalizing f n,
  { simpa },
  { rw [map_with_index],
    simp [map_with_index_core, hl, add_left_comm, add_assoc, add_comm] }
end

lemma map_with_index_eq_enum_map (l : list α) (f : ℕ → α → β) :
  l.map_with_index f = l.enum.map (function.uncurry f) :=
begin
  induction l with hd tl hl generalizing f,
  { simp [list.enum_eq_zip_range] },
  { rw [map_with_index, map_with_index_core, map_with_index_core_eq, hl],
    simp [enum_eq_zip_range, range_succ_eq_map, zip_with_map_left,
    map_uncurry_zip_eq_zip_with] }
end

@[simp] lemma map_with_index_cons {α β} (l : list α) (f : ℕ → α → β) (a : α) :
  map_with_index f (a :: l) = f 0 a :: map_with_index (λ i, f (i + 1)) l :=
by simp [map_with_index_eq_enum_map, enum_eq_zip_range, map_uncurry_zip_eq_zip_with,
         range_succ_eq_map, zip_with_map_left]

@[simp] lemma length_map_with_index {α β} (l : list α) (f : ℕ → α → β) :
  (l.map_with_index f).length = l.length :=
begin
  induction l with hd tl IH generalizing f,
  { simp },
  { simp [IH] }
end

@[simp] lemma nth_le_map_with_index {α β} (l : list α) (f : ℕ → α → β) (i : ℕ) (h : i < l.length)
  (h' : i < (l.map_with_index f).length := h.trans_le (l.length_map_with_index f).ge):
  (l.map_with_index f).nth_le i h' = f i (l.nth_le i h) :=
by simp [map_with_index_eq_enum_map, enum_eq_zip_range]

lemma map_with_index_eq_of_fn {α β} (l : list α) (f : ℕ → α → β) :
  l.map_with_index f = of_fn (λ (i : fin l.length), f (i : ℕ) (l.nth_le i i.is_lt)) :=
begin
  induction l with hd tl IH generalizing f,
  { simp },
  { simpa [IH] }
end

end map_with_index

section foldr_with_index

/-- Specification of `foldr_with_index_aux`. -/
def foldr_with_index_aux_spec (f : ℕ → α → β → β) (start : ℕ) (b : β)
  (as : list α) : β :=
foldr (uncurry f) b $ enum_from start as

theorem foldr_with_index_aux_spec_cons (f : ℕ → α → β → β) (start b a as) :
  foldr_with_index_aux_spec f start b (a :: as) =
  f start a (foldr_with_index_aux_spec f (start + 1) b as) :=
rfl

theorem foldr_with_index_aux_eq_foldr_with_index_aux_spec (f : ℕ → α → β → β)
  (start b as) :
  foldr_with_index_aux f start b as = foldr_with_index_aux_spec f start b as :=
begin
  induction as generalizing start,
  { refl },
  { simp only [foldr_with_index_aux, foldr_with_index_aux_spec_cons, *] }
end

theorem foldr_with_index_eq_foldr_enum (f : ℕ → α → β → β) (b : β) (as : list α) :
  foldr_with_index f b as = foldr (uncurry f) b (enum as) :=
by simp only
    [foldr_with_index, foldr_with_index_aux_spec,
     foldr_with_index_aux_eq_foldr_with_index_aux_spec, enum]

end foldr_with_index

theorem indexes_values_eq_filter_enum (p : α → Prop) [decidable_pred p]
  (as : list α) :
  indexes_values p as = filter (p ∘ prod.snd) (enum as) :=
by simp [indexes_values, foldr_with_index_eq_foldr_enum, uncurry, filter_eq_foldr]

theorem find_indexes_eq_map_indexes_values (p : α → Prop) [decidable_pred p]
  (as : list α) :
  find_indexes p as = map prod.fst (indexes_values p as) :=
by simp only
    [indexes_values_eq_filter_enum, map_filter_eq_foldr, find_indexes,
     foldr_with_index_eq_foldr_enum, uncurry]

section foldl_with_index

/-- Specification of `foldl_with_index_aux`. -/
def foldl_with_index_aux_spec (f : ℕ → α → β → α) (start : ℕ) (a : α)
  (bs : list β) : α :=
foldl (λ a (p : ℕ × β), f p.fst a p.snd) a $ enum_from start bs

theorem foldl_with_index_aux_spec_cons (f : ℕ → α → β → α) (start a b bs) :
  foldl_with_index_aux_spec f start a (b :: bs) =
  foldl_with_index_aux_spec f (start + 1) (f start a b) bs :=
rfl

theorem foldl_with_index_aux_eq_foldl_with_index_aux_spec (f : ℕ → α → β → α)
  (start a bs) :
  foldl_with_index_aux f start a bs = foldl_with_index_aux_spec f start a bs :=
begin
  induction bs generalizing start a,
  { refl },
  { simp [foldl_with_index_aux, foldl_with_index_aux_spec_cons, *] }
end

theorem foldl_with_index_eq_foldl_enum (f : ℕ → α → β → α) (a : α) (bs : list β) :
  foldl_with_index f a bs =
  foldl (λ a (p : ℕ × β), f p.fst a p.snd) a (enum bs) :=
by simp only
    [foldl_with_index, foldl_with_index_aux_spec,
     foldl_with_index_aux_eq_foldl_with_index_aux_spec, enum]

end foldl_with_index

section mfold_with_index

variables {m : Type u → Type v} [monad m]

theorem mfoldr_with_index_eq_mfoldr_enum {α β} (f : ℕ → α → β → m β) (b : β) (as : list α) :
  mfoldr_with_index f b as = mfoldr (uncurry f) b (enum as) :=
by simp only
    [mfoldr_with_index, mfoldr_eq_foldr, foldr_with_index_eq_foldr_enum, uncurry]

theorem mfoldl_with_index_eq_mfoldl_enum [is_lawful_monad m] {α β}
  (f : ℕ → β → α → m β) (b : β) (as : list α) :
  mfoldl_with_index f b as =
    mfoldl (λ b (p : ℕ × α), f p.fst b p.snd) b (enum as) :=
by rw [mfoldl_with_index, mfoldl_eq_foldl, foldl_with_index_eq_foldl_enum]

end mfold_with_index

section mmap_with_index

variables {m : Type u → Type v} [applicative m]

/-- Specification of `mmap_with_index_aux`. -/
def mmap_with_index_aux_spec {α β} (f : ℕ → α → m β) (start : ℕ) (as : list α) :
  m (list β) :=
list.traverse (uncurry f) $ enum_from start as
-- Note: `traverse` the class method would require a less universe-polymorphic
-- `m : Type u → Type u`.

theorem mmap_with_index_aux_spec_cons {α β} (f : ℕ → α → m β) (start : ℕ)
  (a : α) (as : list α) :
  mmap_with_index_aux_spec f start (a :: as) =
    list.cons <$> f start a <*> mmap_with_index_aux_spec f (start + 1) as :=
rfl

theorem mmap_with_index_aux_eq_mmap_with_index_aux_spec {α β} (f : ℕ → α → m β)
  (start : ℕ) (as : list α) :
  mmap_with_index_aux f start as = mmap_with_index_aux_spec f start as :=
begin
  induction as generalizing start,
  { refl },
  { simp [mmap_with_index_aux, mmap_with_index_aux_spec_cons, *] }
end

theorem mmap_with_index_eq_mmap_enum {α β} (f : ℕ → α → m β) (as : list α) :
  mmap_with_index f as = list.traverse (uncurry f) (enum as) :=
by simp only
    [mmap_with_index, mmap_with_index_aux_spec,
     mmap_with_index_aux_eq_mmap_with_index_aux_spec, enum ]

end mmap_with_index

section mmap_with_index'

variables {m : Type u → Type v} [applicative m] [is_lawful_applicative m]

theorem mmap_with_index'_aux_eq_mmap_with_index_aux {α} (f : ℕ → α → m punit)
  (start : ℕ) (as : list α) :
  mmap_with_index'_aux f start as =
  mmap_with_index_aux f start as *> pure punit.star :=
by induction as generalizing start;
    simp [mmap_with_index'_aux, mmap_with_index_aux, *, seq_right_eq, const, -comp_const]
      with functor_norm

theorem mmap_with_index'_eq_mmap_with_index {α} (f : ℕ → α → m punit) (as : list α) :
  mmap_with_index' f as = mmap_with_index f as *> pure punit.star :=
by apply mmap_with_index'_aux_eq_mmap_with_index_aux

end mmap_with_index'

end list


import .simp_omega .list tactic.ring
  .valuation .logic .int

@[reducible] def coeffs : Type := list int

namespace coeffs

@[omega] def val_btw (v : nat → int) (as : coeffs) (l : nat) : nat → int
| 0     := 0
| (o+1) := (val_btw o) + (as.get (l+o) * v (l+o))

@[omega] lemma val_btw_nil {v l} :
  ∀ m, val_btw v [] l m = 0
| 0 := by simp_omega
| (m+1) := by simp_omega [val_btw_nil m]

def val (v as) : int := val_btw v as 0 as.length

@[omega] lemma val_nil {v} : val v [] = 0 := rfl

lemma val_btw_eq_of_le {as : coeffs} {v l} :
  ∀ m, as.length ≤ l + m →
  val_btw v as l m = val_btw v as l (as.length - l)
| 0 h1 :=
  begin rw (nat.sub_eq_zero_iff_le.elim_right _), apply h1 end
| (m+1) h1 :=
  begin
    rw le_iff_eq_or_lt at h1, cases h1,
    { rw [h1, add_comm l, nat.add_sub_cancel] },
    { simp only [val_btw],
      have h2 :  list.length as ≤ l + m,
      { rw ← nat.lt_succ_iff, apply h1 },
      rw [list.get_eq_zero_of_le _ h2, zero_mul, add_zero],
      apply val_btw_eq_of_le _ h2 }
  end

lemma val_eq_of_le {as : coeffs} {v k} :
  as.length ≤ k → val v as = val_btw v as 0 k :=
begin
  intro h1, simp only [val],
  rw [val_btw_eq_of_le k _], refl,
  rw zero_add, exact h1
end

lemma val_btw_eq_val_btw {v w : nat → int} {as bs : coeffs} {l} :
  ∀ {m}, (∀ x, l ≤ x → x < l + m → v x = w x) →
    (∀ x, l ≤ x → x < l + m → as.get x = bs.get x) →
    val_btw v as l m = val_btw w bs l m
| 0 h1 h2 := rfl
| (m+1) h1 h2 :=
  begin
    simp only [val_btw],
    have h3 : l + m < l + (m + 1),
    { rw ← add_assoc, apply lt_add_one },
    apply fun_mono_2,
    apply val_btw_eq_val_btw; intros x h4 h5,
    { apply h1 _ h4 (lt_trans h5 h3) },
    { apply h2 _ h4 (lt_trans h5 h3) },
    rw [h1 _ _ h3, h2 _ _ h3];
    apply nat.le_add_right
  end

def val_btw_set {v a l n} :
  ∀ {m}, l ≤ n → n < l + m → val_btw v ([]{n ↦ a}) l m = a * v n
| 0 h1 h2 :=
  begin exfalso, apply lt_irrefl l (lt_of_le_of_lt h1 h2) end
| (m+1) h1 h2 :=
  begin
    rw [← add_assoc, nat.lt_succ_iff, le_iff_eq_or_lt] at h2,
    cases h2; simp_omega,
    { rw h2, simp,
      have h3 : val_btw v ([]{l + m↦a}) l m = 0,
      { apply @eq.trans _ _ (val_btw v [] l m),
        { apply val_btw_eq_val_btw,
          { intros, refl },
          { intros x h4 h5, rw [list.get_nil,
            list.get_set_eq_of_ne, list.get_nil],
            apply ne_of_lt h5 } },
        apply val_btw_nil },
      rw [h3, list.get_set, zero_add] },
    { rw [@val_btw_set m h1 h2, list.get_set_eq_of_ne],
      simp_omega, apply ne_of_gt, apply h2 }
  end

@[omega] def val_set {v m a} :
  val v ([]{m ↦ a}) = a * v m :=
begin
  apply val_btw_set, apply zero_le,
  simp_omega [list.length_set],
  apply lt_of_lt_of_le (lt_add_one _),
  apply le_max_right
end

lemma val_btw_neg {as v l} :
  ∀ {o}, val_btw v (list.neg as) l o = -(val_btw v as l o)
| 0 := rfl
| (o+1) :=
  begin
    simp only [val_btw],
    rw [neg_add, neg_mul_eq_neg_mul],
    apply fun_mono_2, apply val_btw_neg,
    apply fun_mono_2 _ rfl, apply list.get_neg
  end

@[omega] lemma val_neg {as v} :
   val v (list.neg as) = -(val v as) := begin
  simp only [val, list.length_neg],
  apply val_btw_neg
end

lemma val_btw_add {is js v l} :
  ∀ m, val_btw v (list.add is js) l m =
  (val_btw v is l m) + (val_btw v js l m)
| 0 := rfl
| (m+1) := begin simp_omega [val_btw_add m], ring end

@[omega] lemma val_add {v} {is js : coeffs} :
  val v (list.add is js) = (val v is) + (val v js) :=
begin
  simp only [val],
   rw val_btw_add, apply fun_mono_2;
  apply val_btw_eq_of_le;
  rw [zero_add, list.length_add],
  apply le_max_left, apply le_max_right
end

lemma val_btw_sub {is js v l} :
  ∀ m, val_btw v (list.sub is js) l m =
  (val_btw v is l m) - (val_btw v js l m)
| 0 := rfl
| (m+1) := begin simp_omega [val_btw_sub m], ring end

@[omega] lemma val_sub {v} {is js : coeffs} :
  val v (list.sub is js) = (val v is) - (val v js) :=
begin
  simp only [val],
   rw val_btw_sub, apply fun_mono_2;
  apply val_btw_eq_of_le;
  rw [zero_add, list.length_sub],
  apply le_max_left, apply le_max_right
end

def val_except (n v as) :=
val_btw v as 0 n + val_btw v as (n+1) (as.length - (n+1))

lemma val_except_eq_val_except
  {k : nat} {is js : coeffs} {v w : nat → int} :
  (∀ x ≠ k, v x = w x) → (∀ x ≠ k, is.get x = js.get x) →
  val_except k v is = val_except k w js :=
begin
  intros h1 h2, simp only [val_except],
  apply fun_mono_2,
  { apply val_btw_eq_val_btw; intros x h3 h4;
    [ {apply h1}, {apply h2} ]; apply ne_of_lt;
    rw zero_add at h4; apply h4 },
  { repeat { rw ← val_btw_eq_of_le
      ((max is.length js.length) - (k+1)) },
    { apply val_btw_eq_val_btw; intros x h3 h4;
      [ {apply h1}, {apply h2} ]; apply ne.symm;
        apply ne_of_lt; rw nat.lt_iff_add_one_le; exact h3 },
    repeat { rw add_comm, apply le_trans _ (nat.le_sub_add _ _),
      { apply le_max_right <|> apply le_max_left } } }
end

lemma val_except_update_set {n v as i j} :
  val_except n (v⟨n ↦ i⟩) (as{n ↦ j}) = val_except n v as :=
by rw val_except_eq_val_except update_eq_of_ne list.get_set_eq_of_ne

lemma val_btw_add_val_btw {v as l m} :
  ∀ {n}, val_btw v as l m + val_btw v as (l+m) n =
  val_btw v as l (m+n)
| 0 := by simp_omega
| (n+1) :=
  begin
    rw ← add_assoc, simp_omega, rw add_assoc,
    rw ← @val_btw_add_val_btw n, ring
  end

def val_except_add_eq (n) {v as} :
  (val_except n v as) + ((as.get n) * (v n)) = val v as :=
begin
  simp only [val_except, val],
  by_cases h1 : n + 1 ≤ as.length,
  { have h4 := @val_btw_add_val_btw v as 0 (n+1) (as.length - (n+1)),
    have h5 : n + 1 + (as.length - (n + 1)) = as.length,
    { rw [add_comm, nat.sub_add_cancel h1] },
    rw h5 at h4, apply eq.trans _ h4,
     simp only [val_btw, zero_add], ring },
  { rw not_lt at h1,
    have h2 : (list.length as - (n + 1)) = 0,
    { apply nat.sub_eq_zero_of_le
      (le_trans h1 (nat.le_add_right _ _)) },
    rw h2, simp only [val_btw, add_zero],
    have h3 := @val_eq_of_le as v (n+1) _,
    simp only [val] at h3, rw h3,
    simp only [val_btw, zero_add],
    apply le_trans h1, apply nat.le_add_right }
end

@[omega] lemma val_btw_map_mul {v i as l} :
  ∀ {m}, val_btw v (list.map ((*) i) as) l m = i * val_btw v as l m
| 0     := by simp_omega
| (m+1) :=
  begin
    simp_omega [@val_btw_map_mul m, mul_add],
    apply fun_mono_2 rfl,
    by_cases h1 : l + m < as.length,
    { rw [list.get_map h1, mul_assoc] },
    { rw not_lt at h1,
      rw [list.get_eq_zero_of_le,
          list.get_eq_zero_of_le];
      try {simp_omega}; apply h1 }
  end

lemma forall_val_dvd_of_forall_mem_dvd {i} {as : coeffs} :
  (∀ x ∈ as, i ∣ x) → (∀ n, i ∣ as.get n) | h1 n :=
begin apply list.forall_val_of_forall_mem (dvd_zero _) h1 end

lemma dvd_val_btw {i v as l} :
  ∀ {m}, (∀ x ∈ as, i ∣ x) → (i ∣ val_btw v as l m)
| 0 h1 := dvd_zero _
| (m+1) h1 :=
  begin
    simp_omega, apply dvd_add,
    apply dvd_val_btw h1,
    apply dvd_mul_of_dvd_left,
    by_cases h2 : as.get (l+m) = 0,
    { rw h2, apply dvd_zero },
    { apply h1, apply list.mem_get_of_ne_zero h2 }
  end

lemma dvd_val {i v as} :
  (∀ x ∈ as, i ∣ x) → (i ∣ val v as) := by apply dvd_val_btw

@[omega] lemma val_btw_map_div {v i as l} (h1 : ∀ x ∈ as, i ∣ x) :
  ∀ {m}, val_btw v (list.map (λ x, x / i) as) l m = (val_btw v as l m) / i
| 0     := by simp_omega [int.zero_div]
| (m+1) :=
  begin
    simp_omega [@val_btw_map_div m],
    rw [int.add_div (dvd_val_btw h1)],
    apply fun_mono_2 rfl,

    apply calc list.get (l + m) (list.map (λ (x : ℤ), x / i) as) * v (l + m)
        = ((as.get (l + m)) / i) * v (l + m) :
          begin
            apply fun_mono_2 _ rfl,
            rw list.get_map', apply int.zero_div
          end
    ... =  list.get (l + m) as * v (l + m) / i :
          begin
            repeat {rw mul_comm _ (v (l+m))},
            rw int.mul_div_assoc,
            apply forall_val_dvd_of_forall_mem_dvd h1
          end,
    apply dvd_mul_of_dvd_left,
    apply forall_val_dvd_of_forall_mem_dvd h1,
  end

@[omega] lemma val_map_div {v i as} :
  (∀ x ∈ as, i ∣ x) →
  val v (list.map (λ x, x / i) as) = (val v as) / i :=
begin
  intro h1, simp only [val, list.length_map],
  apply val_btw_map_div h1
end

lemma val_btw_eq_zero {v as l} :
  ∀ {m}, (∀ x : int, x ∈ as → x = 0) → val_btw v as l m = 0
| 0 h1 := rfl
| (m+1) h1 :=
  begin
    have h2 := list.forall_val_of_forall_mem _ h1,
    simp_omega [h2 (l+m)], apply @val_btw_eq_zero m h1, refl,
  end

lemma val_eq_zero {v is} :
  (∀ x : int, x ∈ is → x = 0) → val v is = 0 :=
by apply val_btw_eq_zero

end coeffs


/-
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

! This file was ported from Lean 3 source module combinatorics.simple_graph.clique
! leanprover-community/mathlib commit cd7f0626a0b04be1dda223a26123313514a55fb4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SimpleGraph.Basic
import Mathlib.Data.Finset.Pairwise

/-!
# Graph cliques

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

## Main declarations

* `SimpleGraph.IsClique`: Predicate for a set of vertices to be a clique.
* `SimpleGraph.IsNClique`: Predicate for a set of vertices to be a `n`-clique.
* `SimpleGraph.cliqueFinset`: Finset of `n`-cliques of a graph.
* `SimpleGraph.CliqueFree`: Predicate for a graph to have no `n`-cliques.

## TODO

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

open Finset Fintype

namespace SimpleGraph

variable {α : Type _} (G H : SimpleGraph α)

/-! ### Cliques -/

section Clique

variable {s t : Set α}

/-- A clique in a graph is a set of vertices that are pairwise adjacent. -/
abbrev IsClique (s : Set α) : Prop :=
  s.Pairwise G.Adj
#align simple_graph.is_clique SimpleGraph.IsClique

theorem isClique_iff : G.IsClique s ↔ s.Pairwise G.Adj :=
  Iff.rfl
#align simple_graph.is_clique_iff SimpleGraph.isClique_iff

/-- A clique is a set of vertices whose induced graph is complete. -/
theorem isClique_iff_induce_eq : G.IsClique s ↔ G.induce s = ⊤ := by
  rw [isClique_iff]
  constructor
  · 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⟩
  · intro h v hv w hw hne
    have h2 : (G.induce s).Adj ⟨v, hv⟩ ⟨w, hw⟩ = _ := rfl
    conv_lhs at h2 => rw [h]
    simp only [top_adj, ne_eq, Subtype.mk.injEq, eq_iff_iff] at h2
    exact h2.1 hne
#align simple_graph.is_clique_iff_induce_eq SimpleGraph.isClique_iff_induce_eq

instance [DecidableEq α] [DecidableRel G.Adj] {s : Finset α} : Decidable (G.IsClique s) :=
  decidable_of_iff' _ G.isClique_iff

variable {G H}

theorem IsClique.mono (h : G ≤ H) : G.IsClique s → H.IsClique s := by
  simp_rw [isClique_iff]
  exact Set.Pairwise.mono' h
#align simple_graph.is_clique.mono SimpleGraph.IsClique.mono

theorem IsClique.subset (h : t ⊆ s) : G.IsClique s → G.IsClique t := by
  simp_rw [isClique_iff]
  exact Set.Pairwise.mono h
#align simple_graph.is_clique.subset SimpleGraph.IsClique.subset

@[simp]
theorem isClique_bot_iff : (⊥ : SimpleGraph α).IsClique s ↔ (s : Set α).Subsingleton :=
  Set.pairwise_bot_iff
#align simple_graph.is_clique_bot_iff SimpleGraph.isClique_bot_iff

alias isClique_bot_iff ↔ IsClique.subsingleton _
#align simple_graph.is_clique.subsingleton SimpleGraph.IsClique.subsingleton

end Clique

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

section NClique

variable {n : ℕ} {s : Finset α}

/-- A `n`-clique in a graph is a set of `n` vertices which are pairwise connected. -/
structure IsNClique (n : ℕ) (s : Finset α) : Prop where
  clique : G.IsClique s
  card_eq : s.card = n
#align simple_graph.is_n_clique SimpleGraph.IsNClique

theorem isNClique_iff : G.IsNClique n s ↔ G.IsClique s ∧ s.card = n :=
  ⟨fun h ↦ ⟨h.1, h.2⟩, fun h ↦ ⟨h.1, h.2⟩⟩
#align simple_graph.is_n_clique_iff SimpleGraph.isNClique_iff

instance [DecidableEq α] [DecidableRel G.Adj] {n : ℕ} {s : Finset α} :
    Decidable (G.IsNClique n s) :=
  decidable_of_iff' _ G.isNClique_iff

variable {G H}

theorem IsNClique.mono (h : G ≤ H) : G.IsNClique n s → H.IsNClique n s := by
  simp_rw [isNClique_iff]
  exact And.imp_left (IsClique.mono h)
#align simple_graph.is_n_clique.mono SimpleGraph.IsNClique.mono

@[simp]
theorem isNClique_bot_iff : (⊥ : SimpleGraph α).IsNClique n s ↔ n ≤ 1 ∧ s.card = n := by
  rw [isNClique_iff, isClique_bot_iff]
  refine' and_congr_left _
  rintro rfl
  exact card_le_one.symm
#align simple_graph.is_n_clique_bot_iff SimpleGraph.isNClique_bot_iff

variable [DecidableEq α] {a b c : α}

theorem is3Clique_triple_iff : G.IsNClique 3 {a, b, c} ↔ G.Adj a b ∧ G.Adj a c ∧ G.Adj b c := by
  simp only [isNClique_iff, isClique_iff, Set.pairwise_insert_of_symmetric G.symm, coe_insert]
  by_cases hab : a = b <;> by_cases hbc : b = c <;> by_cases hac : a = c <;> subst_vars <;>
    simp [G.ne_of_adj, and_rotate, *]
#align simple_graph.is_3_clique_triple_iff SimpleGraph.is3Clique_triple_iff

theorem is3Clique_iff :
    G.IsNClique 3 s ↔ ∃ a b c, G.Adj a b ∧ G.Adj a c ∧ G.Adj b c ∧ s = {a, b, c} := by
  refine' ⟨fun h ↦ _, _⟩
  · obtain ⟨a, b, c, -, -, -, hs⟩ := card_eq_three.1 h.card_eq
    refine' ⟨a, b, c, _⟩
    rwa [hs, eq_self_iff_true, and_true, is3Clique_triple_iff.symm, ← hs]
  · rintro ⟨a, b, c, hab, hbc, hca, rfl⟩
    exact is3Clique_triple_iff.2 ⟨hab, hbc, hca⟩
#align simple_graph.is_3_clique_iff SimpleGraph.is3Clique_iff

end NClique

/-! ### Graphs without cliques -/

section CliqueFree

variable {m n : ℕ}

/-- `G.clique_free n` means that `G` has no `n`-cliques. -/
def CliqueFree (n : ℕ) : Prop :=
  ∀ t, ¬G.IsNClique n t
#align simple_graph.clique_free SimpleGraph.CliqueFree

variable {G H} {s : Finset α}

theorem IsNClique.not_cliqueFree (hG : G.IsNClique n s) : ¬G.CliqueFree n :=
  fun h ↦ h _ hG
#align simple_graph.is_n_clique.not_clique_free SimpleGraph.IsNClique.not_cliqueFree

theorem not_cliqueFree_of_top_embedding {n : ℕ} (f : (⊤ : SimpleGraph (Fin n)) ↪g G) :
    ¬G.CliqueFree n := by
  simp only [CliqueFree, isNClique_iff, isClique_iff_induce_eq, not_forall, Classical.not_not]
  use Finset.univ.map f.toEmbedding
  simp only [card_map, Finset.card_fin, eq_self_iff_true, and_true_iff]
  ext ⟨v, hv⟩ ⟨w, hw⟩
  simp only [coe_map, Set.mem_image, coe_univ, Set.mem_univ, true_and_iff] at hv hw
  obtain ⟨v', rfl⟩ := hv
  obtain ⟨w', rfl⟩ := hw
  simp only [f.map_adj_iff, comap_Adj, Function.Embedding.coe_subtype, top_adj, Ne.def,
    Subtype.mk_eq_mk]
  exact (Function.Embedding.apply_eq_iff_eq _ _ _).symm.not
#align simple_graph.not_clique_free_of_top_embedding SimpleGraph.not_cliqueFree_of_top_embedding

/-- An embedding of a complete graph that witnesses the fact that the graph is not clique-free. -/
noncomputable def topEmbeddingOfNotCliqueFree {n : ℕ} (h : ¬G.CliqueFree n) :
    (⊤ : SimpleGraph (Fin n)) ↪g G := by
  simp only [CliqueFree, isNClique_iff, isClique_iff_induce_eq, not_forall, Classical.not_not] at h
  obtain ⟨ha, hb⟩ := h.choose_spec
  have : (⊤ : SimpleGraph (Fin h.choose.card)) ≃g (⊤ : SimpleGraph h.choose) := by
    apply Iso.completeGraph
    simpa using (Fintype.equivFin h.choose).symm
  rw [← ha] at this
  convert (Embedding.induce ↑h.choose.toSet).comp this.toEmbedding
  exact hb.symm
#align simple_graph.top_embedding_of_not_clique_free SimpleGraph.topEmbeddingOfNotCliqueFree

theorem not_cliqueFree_iff (n : ℕ) : ¬G.CliqueFree n ↔ Nonempty ((⊤ : SimpleGraph (Fin n)) ↪g G) :=
  ⟨fun h ↦ ⟨topEmbeddingOfNotCliqueFree h⟩, fun ⟨f⟩ ↦ not_cliqueFree_of_top_embedding f⟩
#align simple_graph.not_clique_free_iff SimpleGraph.not_cliqueFree_iff

theorem cliqueFree_iff {n : ℕ} : G.CliqueFree n ↔ IsEmpty ((⊤ : SimpleGraph (Fin n)) ↪g G) := by
  rw [← not_iff_not, not_cliqueFree_iff, not_isEmpty_iff]
#align simple_graph.clique_free_iff SimpleGraph.cliqueFree_iff

theorem not_cliqueFree_card_of_top_embedding [Fintype α] (f : (⊤ : SimpleGraph α) ↪g G) :
    ¬G.CliqueFree (card α) := by
  rw [not_cliqueFree_iff]
  exact ⟨(Iso.completeGraph (Fintype.equivFin α)).symm.toEmbedding.trans f⟩
#align simple_graph.not_clique_free_card_of_top_embedding SimpleGraph.not_cliqueFree_card_of_top_embedding

theorem cliqueFree_bot (h : 2 ≤ n) : (⊥ : SimpleGraph α).CliqueFree n := by
  intro t ht
  have := le_trans h (isNClique_bot_iff.1 ht).1
  simp only at this
#align simple_graph.clique_free_bot SimpleGraph.cliqueFree_bot

theorem CliqueFree.mono (h : m ≤ n) : G.CliqueFree m → G.CliqueFree n := by
  intro hG s hs
  obtain ⟨t, hts, ht⟩ := s.exists_smaller_set _ (h.trans hs.card_eq.ge)
  exact hG _ ⟨hs.clique.subset hts, ht⟩
#align simple_graph.clique_free.mono SimpleGraph.CliqueFree.mono

theorem CliqueFree.anti (h : G ≤ H) : H.CliqueFree n → G.CliqueFree n :=
  forall_imp fun _ ↦ mt <| IsNClique.mono h
#align simple_graph.clique_free.anti SimpleGraph.CliqueFree.anti

/-- See `simple_graph.clique_free_chromatic_number_succ` for a tighter bound. -/
theorem cliqueFree_of_card_lt [Fintype α] (hc : card α < n) : G.CliqueFree n := by
  by_contra h
  refine' Nat.lt_le_antisymm hc _
  rw [cliqueFree_iff, not_isEmpty_iff] at h
  simpa only [Fintype.card_fin] using Fintype.card_le_of_embedding h.some.toEmbedding
#align simple_graph.clique_free_of_card_lt SimpleGraph.cliqueFree_of_card_lt

end CliqueFree

/-! ### Set of cliques -/

section CliqueSet

variable {n : ℕ} {a b c : α} {s : Finset α}

/-- The `n`-cliques in a graph as a set. -/
def cliqueSet (n : ℕ) : Set (Finset α) :=
  { s | G.IsNClique n s }
#align simple_graph.clique_set SimpleGraph.cliqueSet

theorem mem_cliqueSet_iff : s ∈ G.cliqueSet n ↔ G.IsNClique n s :=
  Iff.rfl
#align simple_graph.mem_clique_set_iff SimpleGraph.mem_cliqueSet_iff

@[simp]
theorem cliqueSet_eq_empty_iff : G.cliqueSet n = ∅ ↔ G.CliqueFree n := by
  simp_rw [CliqueFree, Set.eq_empty_iff_forall_not_mem, mem_cliqueSet_iff]
#align simple_graph.clique_set_eq_empty_iff SimpleGraph.cliqueSet_eq_empty_iff

alias cliqueSet_eq_empty_iff ↔ _ CliqueFree.cliqueSet
#align simple_graph.clique_free.clique_set SimpleGraph.CliqueFree.cliqueSet

--attribute [protected] CliqueFree.cliqueSet -- porting note: removed

variable {G H}

@[mono]
theorem cliqueSet_mono (h : G ≤ H) : G.cliqueSet n ⊆ H.cliqueSet n :=
  fun _ ↦ IsNClique.mono h
#align simple_graph.clique_set_mono SimpleGraph.cliqueSet_mono

theorem cliqueSet_mono' (h : G ≤ H) : G.cliqueSet ≤ H.cliqueSet :=
  fun _ ↦ cliqueSet_mono h
#align simple_graph.clique_set_mono' SimpleGraph.cliqueSet_mono'

end CliqueSet

/-! ### Finset of cliques -/

section CliqueFinset

variable [Fintype α] [DecidableEq α] [DecidableRel G.Adj] {n : ℕ} {a b c : α} {s : Finset α}

/-- The `n`-cliques in a graph as a finset. -/
def cliqueFinset (n : ℕ) : Finset (Finset α) :=
  univ.filter <| G.IsNClique n
#align simple_graph.clique_finset SimpleGraph.cliqueFinset

theorem mem_cliqueFinset_iff : s ∈ G.cliqueFinset n ↔ G.IsNClique n s :=
  mem_filter.trans <| and_iff_right <| mem_univ _
#align simple_graph.mem_clique_finset_iff SimpleGraph.mem_cliqueFinset_iff

@[simp]
theorem coe_cliqueFinset (n : ℕ) : (G.cliqueFinset n : Set (Finset α)) = G.cliqueSet n :=
  Set.ext fun _ ↦ mem_cliqueFinset_iff _
#align simple_graph.coe_clique_finset SimpleGraph.coe_cliqueFinset

@[simp]
theorem cliqueFinset_eq_empty_iff : G.cliqueFinset n = ∅ ↔ G.CliqueFree n := by
  simp_rw [CliqueFree, eq_empty_iff_forall_not_mem, mem_cliqueFinset_iff]
#align simple_graph.clique_finset_eq_empty_iff SimpleGraph.cliqueFinset_eq_empty_iff

alias cliqueFinset_eq_empty_iff ↔ _ CliqueFree.cliqueFinset
#align simple_graph.clique_free.clique_finset SimpleGraph.CliqueFree.cliqueFinset

--attribute [protected] CliqueFree.cliqueFinset -- porting note: removed

variable {G} [DecidableRel H.Adj]

@[mono]

end CliqueFinset

end SimpleGraph