/-
Copyright (c) 2020 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison
-/
import topology.instances.real
import topology.algebra.field
import data.set.intervals.proj_Icc

/-!
# The unit interval, as a topological space

Use `open_locale unit_interval` to turn on the notation `I := set.Icc (0 : ℝ) (1 : ℝ)`.

We provide basic instances, as well as a custom tactic for discharging
`0 ≤ ↑x`, `0 ≤ 1 - ↑x`, `↑x ≤ 1`, and `1 - ↑x ≤ 1` when `x : I`.

-/

noncomputable theory
open_locale classical topological_space filter
open set int

/-! ### The unit interval -/

/-- The unit interval `[0,1]` in ℝ. -/
abbreviation unit_interval : set ℝ := set.Icc 0 1

localized "notation `I` := unit_interval" in unit_interval

namespace unit_interval

lemma zero_mem : (0 : ℝ) ∈ I := ⟨le_rfl, zero_le_one⟩

lemma one_mem : (1 : ℝ) ∈ I := ⟨zero_le_one, le_rfl⟩

lemma mul_mem {x y : ℝ} (hx : x ∈ I) (hy : y ∈ I) : x * y ∈ I :=
⟨mul_nonneg hx.1 hy.1, (mul_le_mul hx.2 hy.2 hy.1 zero_le_one).trans_eq $ one_mul 1⟩

lemma div_mem {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) (hxy : x ≤ y) : x / y ∈ I :=
⟨div_nonneg hx hy, div_le_one_of_le hxy hy⟩

lemma fract_mem (x : ℝ) : fract x ∈ I := ⟨fract_nonneg _, (fract_lt_one _).le⟩

lemma mem_iff_one_sub_mem {t : ℝ} : t ∈ I ↔ 1 - t ∈ I :=
begin
  rw [mem_Icc, mem_Icc],
  split ; intro ; split ; linarith
end

instance has_zero : has_zero I := ⟨⟨0, zero_mem⟩⟩

@[simp, norm_cast] lemma coe_zero : ((0 : I) : ℝ) = 0 := rfl

@[simp] lemma mk_zero (h : (0 : ℝ) ∈ Icc (0 : ℝ) 1) : (⟨0, h⟩ : I) = 0 := rfl

@[simp, norm_cast] lemma coe_eq_zero {x : I} : (x : ℝ) = 0 ↔ x = 0 :=
by { symmetry, exact subtype.ext_iff }

instance has_one : has_one I := ⟨⟨1, by split ; norm_num⟩⟩

@[simp, norm_cast] lemma coe_one : ((1 : I) : ℝ) = 1 := rfl

lemma coe_ne_zero {x : I} : (x : ℝ) ≠ 0 ↔ x ≠ 0 :=
not_iff_not.mpr coe_eq_zero

@[simp] lemma mk_one (h : (1 : ℝ) ∈ Icc (0 : ℝ) 1) : (⟨1, h⟩ : I) = 1 := rfl

@[simp, norm_cast] lemma coe_eq_one {x : I} : (x : ℝ) = 1 ↔ x = 1 :=
by { symmetry, exact subtype.ext_iff }

lemma coe_ne_one {x : I} : (x : ℝ) ≠ 1 ↔ x ≠ 1 :=
not_iff_not.mpr coe_eq_one

instance : nonempty I := ⟨0⟩

instance : has_mul I := ⟨λ x y, ⟨x * y, mul_mem x.2 y.2⟩⟩

@[simp, norm_cast] lemma coe_mul {x y : I} : ((x * y : I) : ℝ) = x * y := rfl

-- todo: we could set up a `linear_ordered_comm_monoid_with_zero I` instance

lemma mul_le_left {x y : I} : x * y ≤ x :=
subtype.coe_le_coe.mp $ (mul_le_mul_of_nonneg_left y.2.2 x.2.1).trans_eq $ mul_one x

lemma mul_le_right {x y : I} : x * y ≤ y :=
subtype.coe_le_coe.mp $ (mul_le_mul_of_nonneg_right x.2.2 y.2.1).trans_eq $ one_mul y

/-- Unit interval central symmetry. -/
def symm : I → I := λ t, ⟨1 - t, mem_iff_one_sub_mem.mp t.prop⟩

localized "notation `σ` := unit_interval.symm" in unit_interval

@[simp] lemma symm_zero : σ 0 = 1 :=
subtype.ext $ by simp [symm]

@[simp] lemma symm_one : σ 1 = 0 :=
subtype.ext $ by simp [symm]

@[simp] lemma symm_symm (x : I) : σ (σ x) = x :=
subtype.ext $ by simp [symm]

@[simp] lemma coe_symm_eq (x : I) : (σ x : ℝ) = 1 - x := rfl

@[continuity]
lemma continuous_symm : continuous σ :=
by continuity!

instance : connected_space I :=
subtype.connected_space ⟨nonempty_Icc.mpr zero_le_one, is_preconnected_Icc⟩

/-- Verify there is an instance for `compact_space I`. -/
example : compact_space I := by apply_instance

lemma nonneg (x : I) : 0 ≤ (x : ℝ) := x.2.1
lemma one_minus_nonneg (x : I) : 0 ≤ 1 - (x : ℝ) := by simpa using x.2.2
lemma le_one (x : I) : (x : ℝ) ≤ 1 := x.2.2
lemma one_minus_le_one (x : I) : 1 - (x : ℝ) ≤ 1 := by simpa using x.2.1

/-- like `unit_interval.nonneg`, but with the inequality in `I`. -/
lemma nonneg' {t : I} : 0 ≤ t := t.2.1
/-- like `unit_interval.le_one`, but with the inequality in `I`. -/
lemma le_one' {t : I} : t ≤ 1 := t.2.2

lemma mul_pos_mem_iff {a t : ℝ} (ha : 0 < a) : a * t ∈ I ↔ t ∈ set.Icc (0 : ℝ) (1/a) :=
begin
  split; rintros ⟨h₁, h₂⟩; split,
  { exact nonneg_of_mul_nonneg_left h₁ ha },
  { rwa [le_div_iff ha, mul_comm] },
  { exact mul_nonneg ha.le h₁ },
  { rwa [le_div_iff ha, mul_comm] at h₂ }
end

lemma two_mul_sub_one_mem_iff {t : ℝ} : 2 * t - 1 ∈ I ↔ t ∈ set.Icc (1/2 : ℝ) 1 :=
by split; rintros ⟨h₁, h₂⟩; split; linarith

end unit_interval

@[simp] lemma proj_Icc_eq_zero {x : ℝ} : proj_Icc (0 : ℝ) 1 zero_le_one x = 0 ↔ x ≤ 0 :=
proj_Icc_eq_left zero_lt_one

@[simp] lemma proj_Icc_eq_one {x : ℝ} : proj_Icc (0 : ℝ) 1 zero_le_one x = 1 ↔ 1 ≤ x :=
proj_Icc_eq_right zero_lt_one

namespace tactic.interactive

/-- A tactic that solves `0 ≤ ↑x`, `0 ≤ 1 - ↑x`, `↑x ≤ 1`, and `1 - ↑x ≤ 1` for `x : I`. -/
meta def unit_interval : tactic unit :=
`[apply unit_interval.nonneg] <|> `[apply unit_interval.one_minus_nonneg] <|>
`[apply unit_interval.le_one] <|> `[apply unit_interval.one_minus_le_one]

end tactic.interactive

section
variables {𝕜 : Type*} [linear_ordered_field 𝕜] [topological_space 𝕜] [topological_ring 𝕜]

/--
The image of `[0,1]` under the homeomorphism `λ x, a * x + b` is `[b, a+b]`.
-/
-- We only need the ordering on `𝕜` here to avoid talking about flipping the interval over.
-- At the end of the day I only care about `ℝ`, so I'm hesitant to put work into generalizing.
lemma affine_homeomorph_image_I (a b : 𝕜) (h : 0 < a) :
  affine_homeomorph a b h.ne.symm '' set.Icc 0 1 = set.Icc b (a + b) :=
by simp [h]

/--
The affine homeomorphism from a nontrivial interval `[a,b]` to `[0,1]`.
-/
def Icc_homeo_I (a b : 𝕜) (h : a < b) : set.Icc a b ≃ₜ set.Icc (0 : 𝕜) (1 : 𝕜) :=
begin
  let e := homeomorph.image (affine_homeomorph (b-a) a (sub_pos.mpr h).ne.symm) (set.Icc 0 1),
  refine (e.trans _).symm,
  apply homeomorph.set_congr,
  simp [sub_pos.mpr h],
end

@[simp] lemma Icc_homeo_I_apply_coe (a b : 𝕜) (h : a < b) (x : set.Icc a b) :
  ((Icc_homeo_I a b h) x : 𝕜) = (x - a) / (b - a) :=
rfl

@[simp] lemma Icc_homeo_I_symm_apply_coe (a b : 𝕜) (h : a < b) (x : set.Icc (0 : 𝕜) (1 : 𝕜)) :
  ((Icc_homeo_I a b h).symm x : 𝕜) = (b - a) * x + a :=
rfl

end


import .Funcion_inversa

universes u v
variables {α : Type u} [inhabited α]
variables {β : Type v}
variable  f : α → β
variable  g : β → α
variable  x : α

open set function

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que g es la inversa por la derecha de f syss
--    ∀ x, f (g x) = x :=
-- ----------------------------------------------------------------------

example : right_inverse g f ↔ ∀ x, f (g x) = x :=
begin
  rw function.right_inverse,
  rw left_inverse,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que las siguientes condiciones son equivalentes:
-- 1. f es suprayectiva
-- 2. right_inverse (inverse f) f
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : surjective f ↔ right_inverse (inverse f) f :=
begin
  split,
  { intros h y,
    apply inverse_spec,
    apply h },
  { intros h y,
    use (inverse f y),
    apply h },
end

-- Prueba
-- ======

/-
α : Type u,
_inst_1 : inhabited α,
β : Type v,
f : α → β
⊢ surjective f ↔ right_inverse (inverse f) f
  >> split,
| ⊢ surjective f → right_inverse (inverse f) f
|   >> { intros h y,
| h : surjective f,
| y : β
| ⊢ f (inverse f y) = y
|   >>   apply inverse_spec,
| ⊢ ∃ (x : α), f x = y
|   >>   apply h },
⊢ right_inverse (inverse f) f → surjective f
  >> { intros h y,
h : right_inverse (inverse f) f,
y : β
⊢ ∃ (a : α), f a = y
  >>   use (inverse f y),
⊢ f (inverse f y) = y
  >>   apply h },
no goals
-/

-- 2ª demostración
-- ===============

example : surjective f ↔ right_inverse (inverse f) f :=
⟨λ h y, inverse_spec _ (h _),
 λ h y, ⟨inverse f y, h _⟩⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que f es suprayectiva syss tiene una inversa por
-- la izquierda.
-- ----------------------------------------------------------------------

example : surjective f ↔ ∃ g, right_inverse g f :=
begin
  split,
  { intro h,
    dsimp [surjective] at h,
    choose g hg using h,
    use g,
    exact hg },
  { rintro ⟨g, hg⟩,
    intros b,
    use g b,
    exact hg b },
end

-- Prueba
-- ======

/-
α : Type u,
_inst_1 : inhabited α,
β : Type v,
f : α → β
⊢ surjective f ↔ ∃ (g : β → α), right_inverse g f
  >> split,
| ⊢ surjective f → (∃ (g : β → α), right_inverse g f)
|   >> { intro h,
| h : surjective f
| ⊢ ∃ (g : β → α), right_inverse g f
|   >>   dsimp [surjective] at h,
| h : ∀ (b : β), ∃ (a : α), f a = b
| ⊢ ∃ (g : β → α), right_inverse g f
|   >>   choose g hg using h,
| g : β → α,
| hg : ∀ (b : β), f (g b) = b
| ⊢ ∃ (g : β → α), right_inverse g f
|   >>   use g,
| ⊢ right_inverse g f
|   >>   exact hg },
⊢ (∃ (g : β → α), right_inverse g f) → surjective f
  >> { rintro ⟨g, hg⟩,
g : β → α,
hg : right_inverse g f
⊢ surjective f
  >>   intros b,
b : β
⊢ ∃ (a : α), f a = b
  >>   use g b,
⊢ f (g b) = b
  >>   exact hg b },
no goals
-/

-- Comentantarios:
-- 1. La táctica (dsimp [e] at h) simplifica la hipótesis h con la
--    definición de e.
-- 2. La táctica (choose g hg using h) si h es de la forma
--    (∀ (b : β), ∃ (a : α), f a = b) quita la hipótesis h y añade las
--     hipótesis (g : β → α) y (hg : ∀ (b : β), f (g b) = b).


import data.set.basic

import util.logic

namespace set

open function

universe variables u₀ u₁

lemma ne_empty_of_exists_mem {α} {s : set α}
  (h : ∃ x : α, x ∈ s)
: s ≠ ∅ :=
exists.elim h (@ne_empty_of_mem _ s)

variables {α : Type u₀} {β : Type u₀}
variables {s : set α}
variables {f : α → β}
variables {g : β → α}
variables (Hinj : injective f)

lemma mem_fmap_of_mem
  {x : α}
  (h : x ∈ s)
: f x ∈ f '' s :=
begin
  unfold functor.map image,
  rw mem_set_of,
  exact ⟨x,h,rfl⟩
end

include Hinj

lemma mem_of_mem_fmap
  {x : α}
  (h : f x ∈ f '' s)
: x ∈ s :=
begin
  unfold functor.map image at h,
  rw mem_set_of at h,
  cases h with y h₀, cases h₀ with h₀ h₁,
  rw ← Hinj h₁,
  apply h₀
end

lemma mem_fmap_iff_mem_of_inj
  {x : α}
: f x ∈ f '' s ↔ x ∈ s :=
⟨ mem_of_mem_fmap Hinj, mem_fmap_of_mem ⟩

lemma mem_fmap_iff_mem_of_bij
  (Hinv : left_inverse f g)
  {x : β}
: x ∈ f '' s ↔ g x ∈ s :=
begin
  have H : bijective f,
  { unfold bijective, split,
    { apply Hinj },
    { apply surjective_of_has_right_inverse,
      exact ⟨g,Hinv⟩ } },
  rw [← Hinv x,mem_fmap_iff_mem_of_inj Hinj,Hinv x]
end

omit Hinj
set_option pp.all true
lemma fmap_eq_empty_iff_eq_empty
: f '' s = ∅ ↔ s = ∅ :=
begin
  split
  ; intro h,
  { rw  eq_empty_iff_forall_not_mem,
    have h₁ := congr_fun h,
    intros x h₂,
    have h₃ := h₁ (f x),
    change (∅ : set β) (f x),
    rw ← iff_eq_eq at h₃,
    apply h₃.1, apply mem_fmap_of_mem h₂, },
  { rw h,
    rw eq_empty_iff_forall_not_mem,
    intros x h',
    unfold functor.map image at h',
    rw mem_set_of at h',
    cases h' with i h', cases h' with h₀ h₁,
    apply not_mem_empty _ h₀ },
end

end set


lemma add_right_eq_zero {a b : mynat} : a + b = 0 → a = 0 :=
begin
rw add_comm,
intro h,
exact add_left_eq_zero h,
end


import tactic
import data.int.parity
import data.int.modeq
import data.nat.factorization.basic
import number_theory.legendre_symbol.quadratic_reciprocity
import number_theory.zsqrtd.gaussian_int
import ring_theory.principal_ideal_domain

import Mordell.CongruencesMod4

local notation `ℤ[i]` := gaussian_int
local notation `i` := zsqrtd.sqrtd

--hard(ish)

instance : unique_factorization_monoid ℤ[i] := infer_instance

lemma y_pm_i_coprime (y : ℤ[i]) : is_coprime (y + i) (y - i):=
begin
unfold is_coprime,
sorry
end

example (x y : ℤ) (h : y^2 = x^3 -1) : x = 1 ∧ y =0 :=
begin
 have : (x^3 : ℤ[i]) = (y + (i : ℤ[i])) * (y - (i: ℤ[i])), by {ring_nf,
 nth_rewrite 1 pow_two,
 simp,
 norm_cast,
 simp [h] },
 have oddx: odd x,
  { by_contradiction evenx,
    rw ← int.even_iff_not_odd at evenx,
    rw even_iff_two_dvd at evenx,
    have hy2 : y^2 ≡ 7 [ZMOD 8],
    { rw h,
      rcases evenx with ⟨k, rfl⟩,
      apply int.modeq_of_dvd,
      exact dvd.intro (1-k^3) (by ring),
    },
    have h4:= int.square_ne_three_mod_four y,
    apply h4,
    have h6: (4 : ℤ ) ∣ 8:= by norm_num,
    have h5:= int.modeq.modeq_of_dvd h6 hy2,
    unfold int.modeq at h5 ⊢,
    rw h5,
    norm_num,
  },
have eveny: even y,
{ unfold odd at oddx,
  obtain ⟨k, rfl⟩ := oddx,
  norm_num at h,
  have htemp : even (y^2),
  { unfold even,
    use (4*k^3 + 6*k^2 + 3*k),
    rw h,
    ring,},
  have h2temp : 2 ≠ 0 := by norm_num,
  exact (int.even_pow' h2temp).mp htemp,},

sorry,
end

lemma test (a p : ℤ) (ha : 2^3 ∣ (2^2 * a^2)) : 2 ∣ a :=
begin
have h1 : (2 : ℤ)^2 ∣ 2^2 , by {exact dvd_rfl,},
have h2 : (2 : ℤ)^0 ∣ a^2 , by {norm_num},
have h3 : (2 : ℤ)^(2+0+1) ∣ (2^2 * a^2), by {apply ha,},
have := succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul (int.prime_two) h1 h2 h3,
cases this,
exfalso,
rw pow_add at this,
simp at this,
norm_num at this,
simp at this,
apply prime.dvd_of_dvd_pow int.prime_two this,

end


import linear_algebra.dimension
import missing_mathlib.set_theory.cardinal

universe variables u u' u'' v v' w w'

variables {α : Type u} {β γ δ ε : Type v}
variables {ι : Type w} {ι' : Type w'} {η : Type u''} {φ : η → Type u'}

section vector_space
variables [decidable_eq ι] [decidable_eq ι'] [field α] [decidable_eq α] [add_comm_group β] [vector_space α β]
include α
open submodule lattice function set
open vector_space

lemma submodule.bot_of_dim_zero (p : submodule α β) (h_dim : dim α p = 0) : p = ⊥ :=
begin
  haveI : decidable_eq β := classical.dec_eq β,
  obtain ⟨b, hb⟩ : ∃b : set p, is_basis α (λ i : b, i.val) := @exists_is_basis α p _ _ _,
  rw ←le_bot_iff,
  intros x hx,
  have : (⟨x, (submodule.mem_coe p).1 hx⟩ : p) = (0 : p),
  { rw ←@mem_bot α p _ _ _,
    rw [← @span_empty α p _ _ _, ←(@set.range_eq_empty p b (λ (i : b), i.val)).2, hb.2],
    apply mem_top,
    unfold_coes,
    rw [nonempty_subtype],
    push_neg,
    rw [←set.eq_empty_iff_forall_not_mem, ←cardinal.mk_zero_iff_empty_set],
    rwa cardinal.lift_inj.1 hb.mk_eq_dim },
  rw [mem_bot],
  rw <-coe_eq_zero at this,
  apply this,
end

lemma linear_independent.le_lift_dim [decidable_eq β] {v : ι → β} (hv : linear_independent α v) :
  cardinal.lift.{w v} (cardinal.mk ι) ≤ cardinal.lift.{v w} (dim α β) :=
calc
  cardinal.lift.{w v} (cardinal.mk ι)
      = cardinal.lift.{v w} (cardinal.mk (range v)) :
          by rw ←cardinal.mk_range_eq_of_injective (linear_independent.injective hv)
  ... = cardinal.lift.{v w} (dim α (span α (range v))) :
          by rw ←dim_span hv
  ... ≤ cardinal.lift.{v w} (dim α (⊤ : submodule α β)) :
          cardinal.lift_le.2 (dim_le_of_submodule (submodule.span α (set.range v)) ⊤ le_top)
  ... ≤ cardinal.lift.{v w} (dim α β) :
          by rw dim_top

lemma linear_independent_le_dim {α : Type u} {β : Type v} {ι : Type w}
  [field α] [decidable_eq β] [add_comm_group β] [vector_space α β] [decidable_eq ι]
  {v : ι → β} (hv : @linear_independent _ α _ v (@comm_ring.to_ring _ (field.to_comm_ring _)) _ _) :
  cardinal.lift.{w v} (cardinal.mk ι) ≤ cardinal.lift.{v w} (dim α β) :=
calc
  cardinal.lift.{w v} (cardinal.mk ι) = cardinal.lift.{v w} (cardinal.mk (set.range v)) :
     (cardinal.mk_range_eq_of_injective (linear_independent.injective hv)).symm
  ... = cardinal.lift.{v w} (dim α (submodule.span α (set.range v))) : by rw (dim_span hv).symm
  ... ≤ cardinal.lift.{v w} (dim α β) : cardinal.lift_le.2 (dim_submodule_le (submodule.span α _))

lemma powers_linear_dependent_of_dim_finite (α : Type v) (β : Type w)
  [field α] [decidable_eq β] [add_comm_group β] [vector_space α β]
  (f : β →ₗ[α] β) (h_dim : dim α β < cardinal.omega) (v : β) :
  ¬ linear_independent α (λ n : ℕ, (f ^ n) v) :=
begin
  intro hw,
  apply not_lt_of_le _ h_dim,
  rw [← cardinal.lift_id (dim α β), cardinal.lift_umax.{w 0}],
  apply linear_independent_le_dim hw
end

lemma exists_mem_ne_zero_of_dim_pos' {α : Type v} {β : Type w}
  [field α] [add_comm_group β] [vector_space α β]
  (h_dim : 0 < dim α β) : ∃ x : β, x ≠ 0 :=
begin
  obtain ⟨b, _, _⟩ : (∃ b : β, b ∈ (⊤ : submodule α β) ∧ b ≠ 0),
  { apply exists_mem_ne_zero_of_dim_pos,
    rw dim_top,
    apply h_dim },
  use b
end

lemma dim_pos_of_mem_ne_zero {α : Type v} {β : Type w}
  [field α] [add_comm_group β] [vector_space α β]
  (x : β) (h : x ≠ 0) : 0 < dim α β :=
begin
  classical,
  by_contra hc,
  rw [not_lt, cardinal.le_zero, ←dim_top] at hc,
  have x_mem_bot : x ∈ ⊥,
  { rw ← submodule.bot_of_dim_zero ⊤ hc,
    apply mem_top },
  exact h ((mem_bot α).1 x_mem_bot)
end

end vector_space


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_33
  (x y z : ℝ)
  (h₀ : x ≠ 0)
  (h₁ : 2 * x = 5 * y)
  (h₂ : 7 * y = 10 * z) :
  z / x = 7 / 25 :=
begin
  field_simp,
  nlinarith,
end


--stating theorem p and q are proposition
theorem and_commutative (p q : Prop) : p ∧ q → q ∧ p :=
--assumption hypothesis on pq
assume hpq : p ∧ q,
have hp : p, from and.left hpq,
have hq : q, from and.right hpq,
--show
show q ∧ p, from and.intro hq hp


import  data.real.basic data.finset  data.set.lattice data.nat.choose analysis.measure_theory.measurable_space analysis.measure_theory.measure_space

open  real

namespace inclusion_exclusion_finset
variables α β  : Type

instance :lattice.semilattice_inf_top (finset β)
:=
sorry

theorem inclusion_exclusion_usual [decidable_eq β] {s : finset α} {t : α → finset β}:
  (((s.bind t).card):ℝ) =
  ((finset.range (s.card + 1)).filter (λ k, k>0)).sum
  (λ k, (-1:ℝ)^( k+1) * ((finset.powerset s).filter (λ s₁:finset α, s₁.card=k)).sum
   (λ s₁:finset α, (s₁.inf t).card))
:=
sorry

instance  :decidable_pred (λ (s₁ : finset α), ¬s₁ = ∅):=
sorry

theorem inclusion_exclusion [decidable_eq β] {s : finset α} {t : α → finset β}:
  (((s.bind t).card):ℝ) =
  ((finset.powerset s).filter (λ s₁, (s₁ ≠  ∅))).sum
     (λ s₁:finset α, (-1:ℝ)^(s₁.card+1) * (s₁.inf t).card)
:=
sorry

theorem special_inclusion_exclusion [decidable_eq β] {s : finset α} {t : α → finset β}
(f:ℕ → ℕ) (h:∀ k A, A∈ (finset.powerset s).filter (λ s₁:finset α, s₁.card =k) → (A.inf t).card=f k):
(((s.bind t).card):ℝ) =
((finset.range (s.card + 1)).filter (λ k, k>0)).sum
(λ k, (-1:ℝ)^( k+1) * (choose (s.card) k) * (f k))
:=
sorry

theorem Mobius_inclusion_exclusion {g f:finset α → ℝ}
(h: ∀ A, g A= (finset.powerset A).sum (λ s, f s)):
∀ A, f A= (finset.powerset A).sum (λ s, (-1:ℝ)^(A.card -s.card) * g s)
:=
sorry

theorem inclusion_exclusion_sysmetric {g f:finset α → ℝ}
(h: ∀ A, g A= (finset.powerset A).sum (λ s, (-1)^(s.card)* f s)):
∀ A, f A= (finset.powerset A).sum (λ s, (-1:ℝ)^(s.card) * g s)
:=
sorry

end inclusion_exclusion_finset

namespace measure_inclusion_exclusion
variables α β  : Type
variables [measurable_space β ] {μ: measure_theory.measure β }
variables{s : finset α} {t : α → set β}
variables (h: ∀ i, i∈ s→ is_measurable (t i))
variables (hfin: ∀ i, i∈ s→  μ (t i)< ⊤)

theorem measure_inclusion_exclusion:
μ (⋃b∈s, t b)+
 ((finset.range (s.card + 1)).filter (λ n, n>0 ∧ n % 2=0)).sum
   (λ k, ((finset.powerset s).filter (λ s₁:finset α, s₁.card=k)).sum
       (λ s₁:finset α,μ (⋂b∈s₁, t b)))
=((finset.range (s.card + 1)).filter (λ n, n>0 ∧ n % 2=1)).sum
   (λ k, ((finset.powerset s).filter (λ s₁:finset α, s₁.card=k)).sum
       (λ s₁:finset α,μ (⋂b∈s₁, t b)))
:=
sorry

end measure_inclusion_exclusion


import number_theory.sum_four_squares

lemma t019 : ∀ n : ℕ, ∃ a b c d : ℕ, a^2 + b^2 + c^2 + d^2 = n
:= nat.sum_four_squares


/-
Copyright (c) 2021 Ashwin Iyengar. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Johan Commelin, Ashwin Iyengar, Patrick Massot
-/
import group_theory.subgroup.basic
import topology.algebra.open_subgroup
import topology.algebra.ring

/-!
# Nonarchimedean Topology

In this file we set up the theory of nonarchimedean topological groups and rings.

A nonarchimedean group is a topological group whose topology admits a basis of
open neighborhoods of the identity element in the group consisting of open subgroups.
A nonarchimedean ring is a topological ring whose underlying topological (additive)
group is nonarchimedean.

## Definitions

- `nonarchimedean_add_group`: nonarchimedean additive group.
- `nonarchimedean_group`: nonarchimedean multiplicative group.
- `nonarchimedean_ring`: nonarchimedean ring.

-/

open_locale pointwise

/-- An topological additive group is nonarchimedean if every neighborhood of 0
  contains an open subgroup. -/
class nonarchimedean_add_group (G : Type*)
  [add_group G] [topological_space G] extends topological_add_group G : Prop :=
(is_nonarchimedean : ∀ U ∈ nhds (0 : G), ∃ V : open_add_subgroup G, (V : set G) ⊆ U)

/-- A topological group is nonarchimedean if every neighborhood of 1 contains an open subgroup. -/
@[to_additive]
class nonarchimedean_group (G : Type*)
  [group G] [topological_space G] extends topological_group G : Prop :=
(is_nonarchimedean : ∀ U ∈ nhds (1 : G), ∃ V : open_subgroup G, (V : set G) ⊆ U)

/-- An topological ring is nonarchimedean if its underlying topological additive
  group is nonarchimedean. -/
class nonarchimedean_ring (R : Type*)
  [ring R] [topological_space R] extends topological_ring R : Prop :=
(is_nonarchimedean : ∀ U ∈ nhds (0 : R), ∃ V : open_add_subgroup R, (V : set R) ⊆ U)

/-- Every nonarchimedean ring is naturally a nonarchimedean additive group. -/
@[priority 100] -- see Note [lower instance priority]
instance nonarchimedean_ring.to_nonarchimedean_add_group
  (R : Type*) [ring R] [topological_space R] [t: nonarchimedean_ring R] :
nonarchimedean_add_group R := {..t}

namespace nonarchimedean_group

variables {G : Type*} [group G] [topological_space G] [nonarchimedean_group G]
variables {H : Type*} [group H] [topological_space H] [topological_group H]
variables {K : Type*} [group K] [topological_space K] [nonarchimedean_group K]

/-- If a topological group embeds into a nonarchimedean group, then it
  is nonarchimedean. -/
@[to_additive nonarchimedean_add_group.nonarchimedean_of_emb]
lemma nonarchimedean_of_emb (f : G →* H) (emb : open_embedding f) : nonarchimedean_group H :=
{ is_nonarchimedean := λ U hU, have h₁ : (f ⁻¹' U) ∈ nhds (1 : G), from
    by {apply emb.continuous.tendsto, rwa f.map_one},
  let ⟨V, hV⟩ := is_nonarchimedean (f ⁻¹' U) h₁ in
    ⟨{is_open' := emb.is_open_map _ V.is_open, ..subgroup.map f V},
      set.image_subset_iff.2 hV⟩ }

/-- An open neighborhood of the identity in the cartesian product of two nonarchimedean groups
  contains the cartesian product of an open neighborhood in each group. -/
@[to_additive nonarchimedean_add_group.prod_subset]
lemma prod_subset {U} (hU : U ∈ nhds (1 : G × K)) :
  ∃ (V : open_subgroup G) (W : open_subgroup K), (V : set G) ×ˢ (W : set K) ⊆ U :=
begin
  erw [nhds_prod_eq, filter.mem_prod_iff] at hU,
  rcases hU with ⟨U₁, hU₁, U₂, hU₂, h⟩,
  cases is_nonarchimedean _ hU₁ with V hV,
  cases is_nonarchimedean _ hU₂ with W hW,
  use V, use W,
  rw set.prod_subset_iff,
  intros x hX y hY,
  exact set.subset.trans (set.prod_mono hV hW) h (set.mem_sep hX hY),
end

/-- An open neighborhood of the identity in the cartesian square of a nonarchimedean group
  contains the cartesian square of an open neighborhood in the group. -/
@[to_additive nonarchimedean_add_group.prod_self_subset]
lemma prod_self_subset {U} (hU : U ∈ nhds (1 : G × G)) :
  ∃ (V : open_subgroup G), (V : set G) ×ˢ (V : set G) ⊆ U :=
let ⟨V, W, h⟩ := prod_subset hU in
  ⟨V ⊓ W, by {refine set.subset.trans (set.prod_mono _ _) ‹_›; simp}⟩

/-- The cartesian product of two nonarchimedean groups is nonarchimedean. -/
@[to_additive]
instance : nonarchimedean_group (G × K) :=
{ is_nonarchimedean := λ U hU, let ⟨V, W, h⟩ := prod_subset hU in ⟨V.prod W, ‹_›⟩ }

end nonarchimedean_group

namespace nonarchimedean_ring

open nonarchimedean_ring
open nonarchimedean_add_group

variables {R S : Type*}
variables [ring R] [topological_space R] [nonarchimedean_ring R]
variables [ring S] [topological_space S] [nonarchimedean_ring S]

/-- The cartesian product of two nonarchimedean rings is nonarchimedean. -/
instance : nonarchimedean_ring (R × S) :=
{ is_nonarchimedean := nonarchimedean_add_group.is_nonarchimedean }

/-- Given an open subgroup `U` and an element `r` of a nonarchimedean ring, there is an open
  subgroup `V` such that `r • V` is contained in `U`. -/
lemma left_mul_subset (U : open_add_subgroup R) (r : R) :
  ∃ V : open_add_subgroup R, r • (V : set R) ⊆ U :=
⟨U.comap (add_monoid_hom.mul_left r) (continuous_mul_left r),
  (U : set R).image_preimage_subset _⟩

/-- An open subgroup of a nonarchimedean ring contains the square of another one. -/
lemma mul_subset (U : open_add_subgroup R) :
  ∃ V : open_add_subgroup R, (V : set R) * V ⊆ U :=
let ⟨V, H⟩ := prod_self_subset (is_open.mem_nhds (is_open.preimage continuous_mul U.is_open)
  begin
    simpa only [set.mem_preimage, open_add_subgroup.mem_coe, prod.snd_zero, mul_zero]
      using U.zero_mem,
  end) in
begin
  use V,
  rintros v ⟨a, b, ha, hb, hv⟩,
  have hy := H (set.mk_mem_prod ha hb),
  simp only [set.mem_preimage, open_add_subgroup.mem_coe] at hy,
  rwa hv at hy
end

end nonarchimedean_ring


import lib.m154

open m154

section
/-
Avant d'aborder les exercices de cette section, il est important de bien
lire la dernière section du chapitre 4 du cours, intitulée
« Négation des conjonctions, disjonctions et énoncés quantifiés ».

L'objectif de cette première série de 4 exercices est de s'entraîner à
utiliser à la main la liste de formules de négation figurant dans cette
section du cours.

Le cœur de chacun de ces 4 exercices est de compléter l'énoncé,
en écrivant que des quantificateurs sans négation et sans utiliser
la définition limite_suite. On peut ensuite vérifier son énoncé en remplaçant
le « sorry » de la démonstration par « verifie ». La commande verifie
est uniquement destinée à cette série d'exercices, elle se contente de déplier
des définitions, d'appeler « On pousse la négation » et de faire un peu de nettoyage.

On rappelle aussi la définition de « u tend vers l » :

def limite_suite (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε
-/

-- Dans cette section, u désigne une suite de réels, f une fonction
-- de ℝ dans ℝ, et x₀ et l des réels.
variables (u : ℕ → ℝ) (f : ℝ → ℝ) (x₀ l : ℝ)

/- Négation de « u tend vers l » -/
example : ¬ (limite_suite u l) ↔
  sorry
:=
begin
  sorry
end

/- Négation de « f est continue en x₀ » -/
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ →  |f x - f x₀| ≤ ε) ↔
  sorry
:=
begin
  sorry
end

/-
Dans l'exercice suivant, il est utile de se souvenir que « ∀ x x', ... » est
l'abréviation de « ∀ x, ∀ x', ... ». De même « ∃ x x', ... » est
l'abréviation de « ∃ x, ∃ x', ... ».
-/

/- Négation de « f est uniformément continue sur ℝ » -/
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x x', |x' - x| ≤ δ →  |f x' - f x| ≤ ε) ↔
  sorry
:=
begin
  sorry
end

/- Négation de « f est séquentiellement continue en x₀ » -/
example : ¬ (∀ u : ℕ → ℝ, limite_suite u x₀ → limite_suite (f ∘ u) (f x₀))  ↔
  sorry
:=
begin
  sorry
end
end

/-
La suite de cette feuille explore des applications élémentaires de la négation
dans l'étude des convergences de suites de réels.

On rappelle que "On combine" peut débusquer des contradictions
faciles, comme dans l'exemple suivant.
-/

example (a b : ℝ) (h : a < b) (h' : b < a) : false :=
begin
  On combine [h, h'],
end

/-
On rappelle des lemmes potentiellement utiles :

abs_inferieur_ssi (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

superieur_max_ssi (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

inferieur_max_gauche p q : p ≤ max p q

inferieur_max_droite p q : q ≤ max p q
-/

/-- La suite `u` tend vers `+∞`. -/
def limite_infinie_suite (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

-- Si u tend vers +∞ alors u ne tend vers aucune limite finie
lemma limite_infinie_pas_finie {u : ℕ → ℝ} :
  limite_infinie_suite u → ∀ l, ¬ limite_suite u l :=
begin
  sorry
end

/-- La suite `u` est croissante. -/
def suite_croissante (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

-- Si u est croissante et tend vers l alors tous les u_n sont inférieurs à l.
example (u : ℕ → ℝ) (l : ℝ) (h : limite_suite u l) (h' : suite_croissante u) :
  ∀ n, u n ≤ l :=
begin
  sorry
end

/-
Dans les exercices suivants, « A : set ℝ » signifie que A est un ensemble de
nombres réels. On a la notation usuelle x ∈ A pour dire qu'un réel x est
dans l'ensemble de réels A.

La notation « ∀ x ∈ A, ...» est l'abréviation de « ∀ x, x ∈ A → ... »
(analogue à l'abréviation « ∀ ε > 0, ... »).
-/

/-- Le réel `x` est un majorant de l'ensemble de réels `A`. -/
def majorant (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

/-- Le réel `x` est une  borne supérieure de l'ensemble de réels `A`. -/
def borne_sup (A : set ℝ) (x : ℝ) := majorant A x ∧ ∀ y, majorant A y → x ≤ y

/-
Remarque : on peut montrer facilement qu'un ensemble de réels admet au plus
une borne supérieure, mais ce ne sera pas utile ici.
-/

-- Si un réel x est borne supérieure d'un ensemble de réels A alors,
-- pour tout y, si y < x alors il existe a dans A strictement plus grand que y.
lemma lt_sup {A : set ℝ} {x : ℝ} (hx : borne_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  sorry
end

/-
L'exercice suivant est une variante d'un exercice de la feuille 7.
Le but ici est de montrer son application à l'étude des limites de suites
dans le dernier exercice.
-/

-- Soit x et y deux réels. Si y ≤ x + ε pour tout ε > 0 alors y ≤ x.
lemma inferieur_si_inferieur_plus_eps {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  sorry
end

-- Si u tend vers x et u_n ≤ y pour tout n alors x ≤ y.
lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : limite_suite u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  sorry
end


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

import field_theory.finite.basic
import data.zmod.basic
import data.nat.parity

/-!
# Quadratic reciprocity.

This file contains results about quadratic residues modulo a prime number.

The main results are the law of quadratic reciprocity, `quadratic_reciprocity`, as well as the
interpretations in terms of existence of square roots depending on the congruence mod 4,
`exists_sq_eq_prime_iff_of_mod_four_eq_one`, and
`exists_sq_eq_prime_iff_of_mod_four_eq_three`.

Also proven are conditions for `-1` and `2` to be a square modulo a prime,
`exists_sq_eq_neg_one_iff_mod_four_ne_three` and
`exists_sq_eq_two_iff`

## Implementation notes

The proof of quadratic reciprocity implemented uses Gauss' lemma and Eisenstein's lemma
-/

open function finset nat finite_field zmod
open_locale big_operators nat

namespace zmod

variables (p q : ℕ) [fact p.prime] [fact q.prime]

/-- Euler's Criterion: A unit `x` of `zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
lemma euler_criterion_units (x : units (zmod p)) :
  (∃ y : units (zmod p), y ^ 2 = x) ↔ x ^ (p / 2) = 1 :=
begin
  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, refine iff_of_true ⟨1, _⟩ _; apply subsingleton.elim },
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator (units (zmod p)),
  obtain ⟨n, hn⟩ : x ∈ submonoid.powers g, { rw mem_powers_iff_mem_zpowers, apply hg },
  split,
  { rintro ⟨y, rfl⟩, rw [← pow_mul, two_mul_odd_div_two hp_odd, units_pow_card_sub_one_eq_one], },
  { subst x, assume h,
    have key : 2 * (p / 2) ∣ n * (p / 2),
    { rw [← pow_mul] at h,
      rw [two_mul_odd_div_two hp_odd, ← card_units, ← order_of_eq_card_of_forall_mem_zpowers hg],
      apply order_of_dvd_of_pow_eq_one h },
    have : 0 < p / 2 := nat.div_pos (fact.out (1 < p)) dec_trivial,
    obtain ⟨m, rfl⟩ := dvd_of_mul_dvd_mul_right this key,
    refine ⟨g ^ m, _⟩,
    rw [mul_comm, pow_mul], },
end

/-- Euler's Criterion: a nonzero `a : zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
lemma euler_criterion {a : zmod p} (ha : a ≠ 0) :
  (∃ y : zmod p, y ^ 2 = a) ↔ a ^ (p / 2) = 1 :=
begin
  apply (iff_congr _ (by simp [units.ext_iff])).mp (euler_criterion_units p (units.mk0 a ha)),
  simp only [units.ext_iff, sq, units.coe_mk0, units.coe_mul],
  split, { rintro ⟨y, hy⟩, exact ⟨y, hy⟩ },
  { rintro ⟨y, rfl⟩,
    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
    refine ⟨units.mk0 y hy, _⟩, simp, }
end

lemma exists_sq_eq_neg_one_iff_mod_four_ne_three :
  (∃ y : zmod p, y ^ 2 = -1) ↔ p % 4 ≠ 3 :=
begin
  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, exact dec_trivial },
  haveI := fact.mk hp_odd,
  have neg_one_ne_zero : (-1 : zmod p) ≠ 0, from mt neg_eq_zero.1 one_ne_zero,
  rw [euler_criterion p neg_one_ne_zero, neg_one_pow_eq_pow_mod_two],
  cases mod_two_eq_zero_or_one (p / 2) with p_half_even p_half_odd,
  { rw [p_half_even, pow_zero, eq_self_iff_true, true_iff],
    contrapose! p_half_even with hp,
    rw [← nat.mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp],
    exact dec_trivial },
  { rw [p_half_odd, pow_one,
        iff_false_intro (ne_neg_self p one_ne_zero).symm, false_iff, not_not],
    rw [← nat.mod_mul_right_div_self, show 2 * 2 = 4, from rfl] at p_half_odd,
    rw [← nat.mod_mul_left_mod _ 2, show 2 * 2 = 4, from rfl] at hp_odd,
    have hp : p % 4 < 4, from nat.mod_lt _ dec_trivial,
    revert hp hp_odd p_half_odd,
    generalize : p % 4 = k, dec_trivial! }
end

lemma pow_div_two_eq_neg_one_or_one {a : zmod p} (ha : a ≠ 0) :
  a ^ (p / 2) = 1 ∨ a ^ (p / 2) = -1 :=
begin
  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, revert a ha, exact dec_trivial },
  rw [← mul_self_eq_one_iff, ← pow_add, ← two_mul, two_mul_odd_div_two hp_odd],
  exact pow_card_sub_one_eq_one ha
end

/-- **Wilson's Lemma**: the product of `1`, ..., `p-1` is `-1` modulo `p`. -/
@[simp] lemma wilsons_lemma : ((p - 1)! : zmod p) = -1 :=
begin
  refine
  calc ((p - 1)! : zmod p) = (∏ x in Ico 1 (succ (p - 1)), x) :
    by rw [← finset.prod_Ico_id_eq_factorial, prod_nat_cast]
                               ... = (∏ x : units (zmod p), x) : _
                               ... = -1 : by simp_rw [← units.coe_hom_apply,
    ← (units.coe_hom (zmod p)).map_prod, prod_univ_units_id_eq_neg_one, units.coe_hom_apply,
    units.coe_neg, units.coe_one],
  have hp : 0 < p := (fact.out p.prime).pos,
  symmetry,
  refine prod_bij (λ a _, (a : zmod p).val) _ _ _ _,
  { intros a ha,
    rw [mem_Ico, ← nat.succ_sub hp, nat.succ_sub_one],
    split,
    { apply nat.pos_of_ne_zero, rw ← @val_zero p,
      assume h, apply units.ne_zero a (val_injective p h) },
    { exact val_lt _ } },
  { intros a ha, simp only [cast_id, nat_cast_val], },
  { intros _ _ _ _ h, rw units.ext_iff, exact val_injective p h },
  { intros b hb,
    rw [mem_Ico, nat.succ_le_iff, ← succ_sub hp, succ_sub_one, pos_iff_ne_zero] at hb,
    refine ⟨units.mk0 b _, finset.mem_univ _, _⟩,
    { assume h, apply hb.1, apply_fun val at h,
      simpa only [val_cast_of_lt hb.right, val_zero] using h },
    { simp only [val_cast_of_lt hb.right, units.coe_mk0], } }
end

@[simp] lemma prod_Ico_one_prime : (∏ x in Ico 1 p, (x : zmod p)) = -1 :=
begin
  conv in (Ico 1 p) { rw [← succ_sub_one p, succ_sub (fact.out p.prime).pos] },
  rw [← prod_nat_cast, finset.prod_Ico_id_eq_factorial, wilsons_lemma]
end

end zmod

/-- The image of the map sending a non zero natural number `x ≤ p / 2` to the absolute value
  of the element of interger in the interval `(-p/2, p/2]` congruent to `a * x` mod p is the set
  of non zero natural numbers `x` such that `x ≤ p / 2` -/
lemma Ico_map_val_min_abs_nat_abs_eq_Ico_map_id
  (p : ℕ) [hp : fact p.prime] (a : zmod p) (hap : a ≠ 0) :
  (Ico 1 (p / 2).succ).1.map (λ x, (a * x).val_min_abs.nat_abs) =
  (Ico 1 (p / 2).succ).1.map (λ a, a) :=
begin
  have he : ∀ {x}, x ∈ Ico 1 (p / 2).succ → x ≠ 0 ∧ x ≤ p / 2,
    by simp [nat.lt_succ_iff, nat.succ_le_iff, pos_iff_ne_zero] {contextual := tt},
  have hep : ∀ {x}, x ∈ Ico 1 (p / 2).succ → x < p,
    from λ x hx, lt_of_le_of_lt (he hx).2 (nat.div_lt_self hp.1.pos dec_trivial),
  have hpe : ∀ {x}, x ∈ Ico 1 (p / 2).succ → ¬ p ∣ x,
    from λ x hx hpx, not_lt_of_ge (le_of_dvd (nat.pos_of_ne_zero (he hx).1) hpx) (hep hx),
  have hmem : ∀ (x : ℕ) (hx : x ∈ Ico 1 (p / 2).succ),
    (a * x : zmod p).val_min_abs.nat_abs ∈ Ico 1 (p / 2).succ,
  { assume x hx,
    simp [hap, char_p.cast_eq_zero_iff (zmod p) p, hpe hx, lt_succ_iff, succ_le_iff,
        pos_iff_ne_zero, nat_abs_val_min_abs_le _], },
  have hsurj : ∀ (b : ℕ) (hb : b ∈ Ico 1 (p / 2).succ),
    ∃ x ∈ Ico 1 (p / 2).succ, b = (a * x : zmod p).val_min_abs.nat_abs,
  { assume b hb,
    refine ⟨(b / a : zmod p).val_min_abs.nat_abs, mem_Ico.mpr ⟨_, _⟩, _⟩,
    { apply nat.pos_of_ne_zero,
      simp only [div_eq_mul_inv, hap, char_p.cast_eq_zero_iff (zmod p) p, hpe hb, not_false_iff,
        val_min_abs_eq_zero, inv_eq_zero, int.nat_abs_eq_zero, ne.def, mul_eq_zero, or_self] },
    { apply lt_succ_of_le, apply nat_abs_val_min_abs_le },
    { rw nat_cast_nat_abs_val_min_abs,
      split_ifs,
      { erw [mul_div_cancel' _ hap, val_min_abs_def_pos, val_cast_of_lt (hep hb),
          if_pos (le_of_lt_succ (mem_Ico.1 hb).2), int.nat_abs_of_nat], },
      { erw [mul_neg_eq_neg_mul_symm, mul_div_cancel' _ hap, nat_abs_val_min_abs_neg,
          val_min_abs_def_pos, val_cast_of_lt (hep hb), if_pos (le_of_lt_succ (mem_Ico.1 hb).2),
          int.nat_abs_of_nat] } } },
  exact multiset.map_eq_map_of_bij_of_nodup _ _ (finset.nodup _) (finset.nodup _)
    (λ x _, (a * x : zmod p).val_min_abs.nat_abs) hmem (λ _ _, rfl)
    (inj_on_of_surj_on_of_card_le _ hmem hsurj (le_refl _)) hsurj
end

private lemma gauss_lemma_aux₁ (p : ℕ) [fact p.prime] [fact (p % 2 = 1)]
  {a : ℕ} (hap : (a : zmod p) ≠ 0) :
  (a^(p / 2) * (p / 2)! : zmod p) =
  (-1)^((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card * (p / 2)! :=
calc (a ^ (p / 2) * (p / 2)! : zmod p) =
    (∏ x in Ico 1 (p / 2).succ, a * x) :
  by rw [prod_mul_distrib, ← prod_nat_cast, ← prod_nat_cast, prod_Ico_id_eq_factorial,
      prod_const, card_Ico, succ_sub_one]; simp
... = (∏ x in Ico 1 (p / 2).succ, (a * x : zmod p).val) : by simp
... = (∏ x in Ico 1 (p / 2).succ,
    (if (a * x : zmod p).val ≤ p / 2 then 1 else -1) *
      (a * x : zmod p).val_min_abs.nat_abs) :
  prod_congr rfl $ λ _ _, begin
    simp only [nat_cast_nat_abs_val_min_abs],
    split_ifs; simp
  end
... = (-1)^((Ico 1 (p / 2).succ).filter
      (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card *
    (∏ x in Ico 1 (p / 2).succ, (a * x : zmod p).val_min_abs.nat_abs) :
  have (∏ x in Ico 1 (p / 2).succ,
        if (a * x : zmod p).val ≤ p / 2 then (1 : zmod p) else -1) =
      (∏ x in (Ico 1 (p / 2).succ).filter
        (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2), -1),
    from prod_bij_ne_one (λ x _ _, x)
      (λ x, by split_ifs; simp * at * {contextual := tt})
      (λ _ _ _ _ _ _, id)
      (λ b h _, ⟨b, by simp [-not_le, *] at *⟩)
      (by intros; split_ifs at *; simp * at *),
  by rw [prod_mul_distrib, this]; simp
... = (-1)^((Ico 1 (p / 2).succ).filter
      (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card * (p / 2)! :
  by rw [← prod_nat_cast, finset.prod_eq_multiset_prod,
      Ico_map_val_min_abs_nat_abs_eq_Ico_map_id p a hap,
      ← finset.prod_eq_multiset_prod, prod_Ico_id_eq_factorial]

private lemma gauss_lemma_aux₂ (p : ℕ) [hp : fact p.prime] [fact (p % 2 = 1)]
  {a : ℕ} (hap : (a : zmod p) ≠ 0) :
  (a^(p / 2) : zmod p) = (-1)^((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card :=
(mul_left_inj'
    (show ((p / 2)! : zmod p) ≠ 0,
      by rw [ne.def, char_p.cast_eq_zero_iff (zmod p) p, hp.1.dvd_factorial, not_le];
          exact nat.div_lt_self hp.1.pos dec_trivial)).1 $
  by simpa using gauss_lemma_aux₁ p hap

private lemma eisenstein_lemma_aux₁ (p : ℕ) [fact p.prime] [hp2 : fact (p % 2 = 1)]
  {a : ℕ} (hap : (a : zmod p) ≠ 0) :
  ((∑ x in Ico 1 (p / 2).succ, a * x : ℕ) : zmod 2) =
    ((Ico 1 (p / 2).succ).filter
      ((λ x : ℕ, p / 2 < (a * x : zmod p).val))).card +
      ∑ x in Ico 1 (p / 2).succ, x
    + (∑ x in Ico 1 (p / 2).succ, (a * x) / p : ℕ) :=
have hp2 : (p : zmod 2) = (1 : ℕ), from (eq_iff_modeq_nat _).2 hp2.1,
calc ((∑ x in Ico 1 (p / 2).succ, a * x : ℕ) : zmod 2)
    = ((∑ x in Ico 1 (p / 2).succ, ((a * x) % p + p * ((a * x) / p)) : ℕ) : zmod 2) :
  by simp only [mod_add_div]
... = (∑ x in Ico 1 (p / 2).succ, ((a * x : ℕ) : zmod p).val : ℕ) +
    (∑ x in Ico 1 (p / 2).succ, (a * x) / p : ℕ) :
  by simp only [val_nat_cast];
    simp [sum_add_distrib, mul_sum.symm, nat.cast_add, nat.cast_mul, nat.cast_sum, hp2]
... = _ : congr_arg2 (+)
  (calc ((∑ x in Ico 1 (p / 2).succ, ((a * x : ℕ) : zmod p).val : ℕ) : zmod 2)
      = ∑ x in Ico 1 (p / 2).succ,
          ((((a * x : zmod p).val_min_abs +
            (if (a * x : zmod p).val ≤ p / 2 then 0 else p)) : ℤ) : zmod 2) :
        by simp only [(val_eq_ite_val_min_abs _).symm]; simp [nat.cast_sum]
  ... = ((Ico 1 (p / 2).succ).filter
        (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card +
      ((∑ x in Ico 1 (p / 2).succ, (a * x : zmod p).val_min_abs.nat_abs) : ℕ) :
    by { simp [ite_cast, add_comm, sum_add_distrib, finset.sum_ite, hp2, nat.cast_sum], }
  ... = _ : by rw [finset.sum_eq_multiset_sum,
      Ico_map_val_min_abs_nat_abs_eq_Ico_map_id p a hap,
      ← finset.sum_eq_multiset_sum];
    simp [nat.cast_sum]) rfl

private lemma eisenstein_lemma_aux₂ (p : ℕ) [fact p.prime] [fact (p % 2 = 1)]
  {a : ℕ} (ha2 : a % 2 = 1) (hap : (a : zmod p) ≠ 0) :
  ((Ico 1 (p / 2).succ).filter
    ((λ x : ℕ, p / 2 < (a * x : zmod p).val))).card
  ≡ ∑ x in Ico 1 (p / 2).succ, (x * a) / p [MOD 2] :=
have ha2 : (a : zmod 2) = (1 : ℕ), from (eq_iff_modeq_nat _).2 ha2,
(eq_iff_modeq_nat 2).1 $ sub_eq_zero.1 $
  by simpa [add_left_comm, sub_eq_add_neg, finset.mul_sum.symm, mul_comm, ha2, nat.cast_sum,
            add_neg_eq_iff_eq_add.symm, neg_eq_self_mod_two, add_assoc]
    using eq.symm (eisenstein_lemma_aux₁ p hap)

lemma div_eq_filter_card {a b c : ℕ} (hb0 : 0 < b) (hc : a / b ≤ c) : a / b =
  ((Ico 1 c.succ).filter (λ x, x * b ≤ a)).card :=
calc a / b = (Ico 1 (a / b).succ).card : by simp
... = ((Ico 1 c.succ).filter (λ x, x * b ≤ a)).card :
  congr_arg _ $ finset.ext $ λ x,
    have x * b ≤ a → x ≤ c,
      from λ h, le_trans (by rwa [le_div_iff_mul_le _ _ hb0]) hc,
    by simp [lt_succ_iff, le_div_iff_mul_le _ _ hb0]; tauto

/-- The given sum is the number of integer points in the triangle formed by the diagonal of the
  rectangle `(0, p/2) × (0, q/2)`  -/
private lemma sum_Ico_eq_card_lt {p q : ℕ} :
  ∑ a in Ico 1 (p / 2).succ, (a * q) / p =
  (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
  (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q)).card :=
if hp0 : p = 0 then by simp [hp0, finset.ext_iff]
else
  calc ∑ a in Ico 1 (p / 2).succ, (a * q) / p =
    ∑ a in Ico 1 (p / 2).succ,
      ((Ico 1 (q / 2).succ).filter (λ x, x * p ≤ a * q)).card :
    finset.sum_congr rfl $ λ x hx,
      div_eq_filter_card (nat.pos_of_ne_zero hp0)
        (calc x * q / p ≤ (p / 2) * q / p :
            nat.div_le_div_right (mul_le_mul_of_nonneg_right
              (le_of_lt_succ $ by finish)
              (nat.zero_le _))
          ... ≤ _ : nat.div_mul_div_le_div _ _ _)
  ... = _ : by rw [← card_sigma];
    exact card_congr (λ a _, ⟨a.1, a.2⟩)
      (by simp only [mem_filter, mem_sigma, and_self, forall_true_iff, mem_product]
        {contextual := tt})
      (λ ⟨_, _⟩ ⟨_, _⟩, by simp only [prod.mk.inj_iff, eq_self_iff_true, and_self, heq_iff_eq,
        forall_true_iff] {contextual := tt})
      (λ ⟨b₁, b₂⟩ h, ⟨⟨b₁, b₂⟩,
        by revert h; simp only [mem_filter, eq_self_iff_true, exists_prop_of_true, mem_sigma,
          and_self, forall_true_iff, mem_product] {contextual := tt}⟩)

/-- Each of the sums in this lemma is the cardinality of the set integer points in each of the
  two triangles formed by the diagonal of the rectangle `(0, p/2) × (0, q/2)`. Adding them
  gives the number of points in the rectangle. -/
private lemma sum_mul_div_add_sum_mul_div_eq_mul (p q : ℕ) [hp : fact p.prime]
  (hq0 : (q : zmod p) ≠ 0) :
  ∑ a in Ico 1 (p / 2).succ, (a * q) / p +
  ∑ a in Ico 1 (q / 2).succ, (a * p) / q =
  (p / 2) * (q / 2) :=
begin
  have hswap : (((Ico 1 (q / 2).succ).product (Ico 1 (p / 2).succ)).filter
    (λ x : ℕ × ℕ, x.2 * q ≤ x.1 * p)).card =
  (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
    (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p)).card :=
  card_congr (λ x _, prod.swap x)
    (λ ⟨_, _⟩, by simp only [mem_filter, and_self, prod.swap_prod_mk, forall_true_iff, mem_product]
      {contextual := tt})
    (λ ⟨_, _⟩ ⟨_, _⟩, by simp only [prod.mk.inj_iff, eq_self_iff_true, and_self, prod.swap_prod_mk,
      forall_true_iff] {contextual := tt})
    (λ ⟨x₁, x₂⟩ h, ⟨⟨x₂, x₁⟩, by revert h; simp only [mem_filter, eq_self_iff_true, and_self,
      exists_prop_of_true, prod.swap_prod_mk, forall_true_iff, mem_product] {contextual := tt}⟩),
  have hdisj : disjoint
    (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q))
    (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p)),
  { apply disjoint_filter.2 (λ x hx hpq hqp, _),
    have hxp : x.1 < p, from lt_of_le_of_lt
      (show x.1 ≤ p / 2, by simp only [*, lt_succ_iff, mem_Ico, mem_product] at *; tauto)
      (nat.div_lt_self hp.1.pos dec_trivial),
    have : (x.1 : zmod p) = 0,
    { simpa [hq0] using congr_arg (coe : ℕ → zmod p) (le_antisymm hpq hqp) },
    apply_fun zmod.val at this,
    rw [val_cast_of_lt hxp, val_zero] at this,
    simpa only [this, nonpos_iff_eq_zero, mem_Ico, one_ne_zero, false_and, mem_product] using hx },
  have hunion : ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q) ∪
    ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p) =
    ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)),
  from finset.ext (λ x, by have := le_total (x.2 * p) (x.1 * q);
    simp only [mem_union, mem_filter, mem_Ico, mem_product]; tauto),
  rw [sum_Ico_eq_card_lt, sum_Ico_eq_card_lt, hswap, ← card_disjoint_union hdisj, hunion,
    card_product],
  simp only [card_Ico, tsub_zero, succ_sub_succ_eq_sub]
end

variables (p q : ℕ) [fact p.prime] [fact q.prime]

namespace zmod

/-- The Legendre symbol of `a` and `p` is an integer defined as

* `0` if `a` is `0` modulo `p`;
* `1` if `a ^ (p / 2)` is `1` modulo `p`
   (by `euler_criterion` this is equivalent to “`a` is a square modulo `p`”);
* `-1` otherwise.

-/
def legendre_sym (a p : ℕ) : ℤ :=
if      (a : zmod p) = 0           then  0
else if (a : zmod p) ^ (p / 2) = 1 then  1
                                   else -1

lemma legendre_sym_eq_pow (a p : ℕ) [hp : fact p.prime] :
  (legendre_sym a p : zmod p) = (a ^ (p / 2)) :=
begin
  rw legendre_sym,
  by_cases ha : (a : zmod p) = 0,
  { simp only [if_pos, ha, zero_pow (nat.div_pos (hp.1.two_le) (succ_pos 1)), int.cast_zero] },
  cases hp.1.eq_two_or_odd with hp2 hp_odd,
  { substI p,
    generalize : (a : (zmod 2)) = b, revert b, dec_trivial, },
  { haveI := fact.mk hp_odd,
    rw if_neg ha,
    have : (-1 : zmod p) ≠ 1, from (ne_neg_self p one_ne_zero).symm,
    cases pow_div_two_eq_neg_one_or_one p ha with h h,
    { rw [if_pos h, h, int.cast_one], },
    { rw [h, if_neg this, int.cast_neg, int.cast_one], } }
end

lemma legendre_sym_eq_one_or_neg_one (a p : ℕ) (ha : (a : zmod p) ≠ 0) :
  legendre_sym a p = -1 ∨ legendre_sym a p = 1 :=
by unfold legendre_sym; split_ifs; simp only [*, eq_self_iff_true, or_true, true_or] at *

lemma legendre_sym_eq_zero_iff (a p : ℕ) :
  legendre_sym a p = 0 ↔ (a : zmod p) = 0 :=
begin
  split,
  { classical, contrapose,
    assume ha, cases legendre_sym_eq_one_or_neg_one a p ha with h h,
    all_goals { rw h, norm_num } },
  { assume ha, rw [legendre_sym, if_pos ha] }
end

/-- Gauss' lemma. The legendre symbol can be computed by considering the number of naturals less
  than `p/2` such that `(a * x) % p > p / 2` -/
lemma gauss_lemma {a : ℕ} [fact (p % 2 = 1)] (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym a p = (-1) ^ ((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card :=
have (legendre_sym a p : zmod p) = (((-1)^((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card : ℤ) : zmod p),
  by rw [legendre_sym_eq_pow, gauss_lemma_aux₂ p ha0]; simp,
begin
  cases legendre_sym_eq_one_or_neg_one a p ha0;
  cases neg_one_pow_eq_or ℤ ((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card;
  simp [*, ne_neg_self p one_ne_zero, (ne_neg_self p one_ne_zero).symm] at *
end

lemma legendre_sym_eq_one_iff {a : ℕ} (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym a p = 1 ↔ (∃ b : zmod p, b ^ 2 = a) :=
begin
  rw [euler_criterion p ha0, legendre_sym, if_neg ha0],
  split_ifs,
  { simp only [h, eq_self_iff_true] },
  finish -- this is quite slow. I'm actually surprised that it can close the goal at all!
end

lemma eisenstein_lemma [fact (p % 2 = 1)] {a : ℕ} (ha1 : a % 2 = 1) (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym a p = (-1)^∑ x in Ico 1 (p / 2).succ, (x * a) / p :=
by rw [neg_one_pow_eq_pow_mod_two, gauss_lemma p ha0, neg_one_pow_eq_pow_mod_two,
    show _ = _, from eisenstein_lemma_aux₂ p ha1 ha0]

/-- **Quadratic reciprocity theorem** -/
theorem quadratic_reciprocity [hp1 : fact (p % 2 = 1)] [hq1 : fact (q % 2 = 1)] (hpq : p ≠ q) :
  legendre_sym p q * legendre_sym q p = (-1) ^ ((p / 2) * (q / 2)) :=
have hpq0 : (p : zmod q) ≠ 0, from prime_ne_zero q p hpq.symm,
have hqp0 : (q : zmod p) ≠ 0, from prime_ne_zero p q hpq,
by rw [eisenstein_lemma q hp1.1 hpq0, eisenstein_lemma p hq1.1 hqp0,
  ← pow_add, sum_mul_div_add_sum_mul_div_eq_mul q p hpq0, mul_comm]

local attribute [instance] nat.fact_prime_two

lemma legendre_sym_two [hp1 : fact (p % 2 = 1)] : legendre_sym 2 p = (-1) ^ (p / 4 + p / 2) :=
have hp2 : p ≠ 2, from mt (congr_arg (% 2)) (by simpa using hp1.1),
have hp22 : p / 2 / 2 = _ := div_eq_filter_card (show 0 < 2, from dec_trivial)
  (nat.div_le_self (p / 2) 2),
have hcard : (Ico 1 (p / 2).succ).card = p / 2, by simp,
have hx2 : ∀ x ∈ Ico 1 (p / 2).succ, (2 * x : zmod p).val = 2 * x,
  from λ x hx, have h2xp : 2 * x < p,
      from calc 2 * x ≤ 2 * (p / 2) : mul_le_mul_of_nonneg_left
        (le_of_lt_succ $ by finish) dec_trivial
      ... < _ : by conv_rhs {rw [← div_add_mod p 2, hp1.1]}; exact lt_succ_self _,
    by rw [← nat.cast_two, ← nat.cast_mul, val_cast_of_lt h2xp],
have hdisj : disjoint
    ((Ico 1 (p / 2).succ).filter (λ x, p / 2 < ((2 : ℕ) * x : zmod p).val))
    ((Ico 1 (p / 2).succ).filter (λ x, x * 2 ≤ p / 2)),
  from disjoint_filter.2 (λ x hx, by simp [hx2 _ hx, mul_comm]),
have hunion :
    ((Ico 1 (p / 2).succ).filter (λ x, p / 2 < ((2 : ℕ) * x : zmod p).val)) ∪
    ((Ico 1 (p / 2).succ).filter (λ x, x * 2 ≤ p / 2)) =
    Ico 1 (p / 2).succ,
  begin
    rw [filter_union_right],
    conv_rhs {rw [← @filter_true _ (Ico 1 (p / 2).succ)]},
    exact filter_congr (λ x hx, by simp [hx2 _ hx, lt_or_le, mul_comm])
  end,
begin
  rw [gauss_lemma p (prime_ne_zero p 2 hp2),
    neg_one_pow_eq_pow_mod_two, @neg_one_pow_eq_pow_mod_two _ _ (p / 4 + p / 2)],
  refine congr_arg2 _ rfl ((eq_iff_modeq_nat 2).1 _),
  rw [show 4 = 2 * 2, from rfl, ← nat.div_div_eq_div_mul, hp22, nat.cast_add,
    ← sub_eq_iff_eq_add', sub_eq_add_neg, neg_eq_self_mod_two,
    ← nat.cast_add, ← card_disjoint_union hdisj, hunion, hcard]
end

lemma exists_sq_eq_two_iff [hp1 : fact (p % 2 = 1)] :
  (∃ a : zmod p, a ^ 2 = 2) ↔ p % 8 = 1 ∨ p % 8 = 7 :=
have hp2 : ((2 : ℕ) : zmod p) ≠ 0,
  from prime_ne_zero p 2 (λ h, by simpa [h] using hp1.1),
have hpm4 : p % 4 = p % 8 % 4, from (nat.mod_mul_left_mod p 2 4).symm,
have hpm2 : p % 2 = p % 8 % 2, from (nat.mod_mul_left_mod p 4 2).symm,
begin
  rw [show (2 : zmod p) = (2 : ℕ), by simp, ← legendre_sym_eq_one_iff p hp2,
    legendre_sym_two p, neg_one_pow_eq_one_iff_even (show (-1 : ℤ) ≠ 1, from dec_trivial),
    even_add, even_div, even_div],
  have := nat.mod_lt p (show 0 < 8, from dec_trivial),
  resetI, rw fact_iff at hp1,
  revert this hp1,
  erw [hpm4, hpm2],
  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
  dec_trivial!,
end

lemma exists_sq_eq_prime_iff_of_mod_four_eq_one (hp1 : p % 4 = 1) [hq1 : fact (q % 2 = 1)] :
  (∃ a : zmod p, a ^ 2 = q) ↔ ∃ b : zmod q, b ^ 2 = p :=
if hpq : p = q then by substI hpq else
have h1 : ((p / 2) * (q / 2)) % 2 = 0,
  from (dvd_iff_mod_eq_zero _ _).1
    (dvd_mul_of_dvd_left ((dvd_iff_mod_eq_zero _ _).2 $
    by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp1]; refl) _),
begin
  haveI hp_odd : fact (p % 2 = 1) := ⟨odd_of_mod_four_eq_one hp1⟩,
  have hpq0 : (p : zmod q) ≠ 0 := prime_ne_zero q p (ne.symm hpq),
  have hqp0 : (q : zmod p) ≠ 0 := prime_ne_zero p q hpq,
  have := quadratic_reciprocity p q hpq,
  rw [neg_one_pow_eq_pow_mod_two, h1, legendre_sym, legendre_sym,
    if_neg hqp0, if_neg hpq0] at this,
  rw [euler_criterion q hpq0, euler_criterion p hqp0],
  split_ifs at this; simp *; contradiction,
end

lemma exists_sq_eq_prime_iff_of_mod_four_eq_three (hp3 : p % 4 = 3)
  (hq3 : q % 4 = 3) (hpq : p ≠ q) : (∃ a : zmod p, a ^ 2 = q) ↔ ¬∃ b : zmod q, b ^ 2 = p :=
have h1 : ((p / 2) * (q / 2)) % 2 = 1,
  from nat.odd_mul_odd
    (by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp3]; refl)
    (by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hq3]; refl),
begin
  haveI hp_odd : fact (p % 2 = 1) := ⟨odd_of_mod_four_eq_three hp3⟩,
  haveI hq_odd : fact (q % 2 = 1) := ⟨odd_of_mod_four_eq_three hq3⟩,
  have hpq0 : (p : zmod q) ≠ 0 := prime_ne_zero q p (ne.symm hpq),
  have hqp0 : (q : zmod p) ≠ 0 := prime_ne_zero p q hpq,
  have := quadratic_reciprocity p q hpq,
  rw [neg_one_pow_eq_pow_mod_two, h1, legendre_sym, legendre_sym,
    if_neg hpq0, if_neg hqp0] at this,
  rw [euler_criterion q hpq0, euler_criterion p hqp0],
  split_ifs at this; simp *; contradiction
end

end zmod


/- Even more induction! -/

variable (r : α → α → Prop)

-- The reflexive transitive closure of `r` as an inductive predicate
inductive RTC : α → α → Prop where
  -- Notice how declaring `r` as a `variable` instead of as a parameter instead of declaring it
  -- directly as a parameter of `RTC` means we don't have to write `RTC r a a` inside the
  -- declaration of `RTC`. This also works with recursive `def`s!
  | refl : RTC a a
  | trans : r a b → RTC b c → RTC a c

-- We have arbitrarily chosen a "left-biased" definition of `RTC.trans`, but can easily show the
-- mirror version by induction on the predicate
theorem RTC.trans' : RTC r a b → r b c → RTC r a c := by
  intros hab hbc
  induction hab with
  | refl => exact RTC.trans hbc RTC.refl
  -- `a/b/c` in the constructor `RTC.trans` are marked as *implicit* because we didn't specify them
  -- explicitly.
  -- Just like in other contexts, we can use `@` to specify/match implicit parameters in `induction`.
  | @trans a a' b haa' ha'b ih => exact RTC.trans haa' (ih hbc)

open Nat

-- By the way, we can leave out `:= fun p1 ... => match p1, ... with` at `def`
def double : Nat → Nat
  | zero   => 0
  | succ n => succ (succ (double n))

theorem double.inj : double n = double m → n = m := by
  intro h
  -- Try to finish this proof. You might find that the inductive case is impossible to solve!
  -- Do you see a different approach? If not, read on!
  induction n generalizing m with/-SOL-/
  | zero => cases m <;> trivial
  | succ n ih =>
    cases m with
    | zero => contradiction
    | succ m =>
      rw [double] at h
      injection h with h
      injection h with h
      rw [ih h]
      -- alternatively:
      --apply congrArg
      --apply ih
      -- -- with `simp_all` we sometimes have to exclude "problematic" assumptions such as `ih` from fixpoint simplification
      --simp_all [-ih, double]

-- The issue with the above approach is that our inductive hypothesis is not sufficiently general!
-- When we begin induction, we have already fixed (introduced) a particular `m`, but for the inductive
-- step we need the inductive hypothesis for a *different* m.
-- We could avoid this by carefully introducing `m` (and `h`, which depends on it) only after `induction`:
-- ```
-- theorem double.inj : ∀ m, double n = double m → n = m := by
--   induction n with
--   | zero => intro m h; ...
--   ...
-- ```
-- `induction` even allows us to apply a tactic before *each* case:
-- ```
-- theorem double.inj : ∀ m, double n = double m → n = m := by
--   induction n with
--       intro m h
--   | zero => ...
--   ...
-- ```
-- However, it turns out that we do not have to change the theorem statement at all: if we simply say
-- ```
-- induction n generalizing m with
-- ```
-- then `induction` will automatically `revert` (yes, that's also a tactic) and re`intro`duce the variable(s)
-- before/after induction for us! So add `generalizing m` above, see how the inductive hypothesis is
-- affected, and then go finish that proof!

/- Partial & dependent maps -/

-- *Partial maps* are a useful data type for the semantics project and many other topics.
-- They map *some* keys of one type to values of another type.
abbrev Map (α β : Type) := α → Option β
-- We express partiality via the `Option` type, which either holds `some b` for `b : β`, or `none`.
-- Ctrl+click it for the whole definition.

namespace Map

def empty : Map α β := fun k => none

-- If we wanted a partial map for programming, we might choose a more efficient implementation such
-- as a search tree or a hash map. If, on the other hand, we are only interested in using it in a
-- formalization, a simple function like above is usually the better solution. For example, a
-- simple typing context `Γ` can be formalized as a partial map from variable names to their types.

-- The function-based definition makes defining operations such as a map update quite easy:

/-- Set the entry `k` of the map `m` to the value `v`. All other entries are unchanged. -/
def update [DecidableEq α] (m : Map α β) (k : α) (v : Option β) : Map α β :=
  fun k' => if k = k' then v else m k'

-- A `scoped` notation is activated only when opening/inside the current namespace
scoped notation:max m "[" k " ↦ " v "]" => update m k v

theorem apply_update [DecidableEq α] (m : Map α β) : m[k ↦ v] k = v := by simp [update]

-- hint: use function extensionality (`apply funext`)
theorem update_self [DecidableEq α] (m : Map α β) : m[k ↦ m k] = m := by
  funext k'  -- an abbreviation for `apply funext; intro k'`
  by_cases h : k = k' <;> simp [update, h]

end Map

-- One interesting generalization of partial maps we can express in Lean are *dependent maps* where
-- the *type* of the value may depend on the key:
abbrev DepMap (α : Type) (β : α → Type) := (k : α) → Option (β k)

namespace DepMap

def empty : DepMap α β := fun k => none

-- If we try to define `update` as above, it turns out that we run into a type error!
-- You may want to use the "dependent if" `if h : p then t else e` that makes a *proof* of
-- the condition `p` available in each branch: `h : p` in the `then` branch and `h : ¬p` in the
-- `else` branch. You should then be able to use rewriting (e.g. `▸`) to fix the type error.
def update [DecidableEq α] (m : DepMap α β) (k : α) (v : Option (β k)) : DepMap α β :=
  fun k' => if h : k = k' then h ▸ v else m k'

scoped notation:max m "[" k " ↦ " v "]" => update m k v

-- This one should be as before...
theorem apply_update [DecidableEq α] (m : DepMap α β) : m[k ↦ v] k = v := by simp [update]

-- ...but this one is where the fun starts: try replicating the corresponding `Map` proof...
theorem update_self [DecidableEq α] (m : DepMap α β) : m[k ↦ m k] = m := by
  funext k'
  by_cases h : k = k'
  case inl =>
    rw [h]
    simp [update]
  case inr =>
    simp [update, h]
-- and you should end up with an unsolved goal containing a subterm of the shape `(_ : a = b) ▸ c`. This
-- is the rewrite from `update`; the proof is elided as `_` by default because, as we said in week 1, Lean
-- considers all proofs of a proposition as equal, so we really don't care what proof is displayed there.
-- So how do we get rid of the `▸`? We know it is something like a match  on `Eq.refl`; more formally,
-- both `▸` and such a match compile down to an application of `Eq`'s *recursor* (week 3).
-- We know matches/recursors reduce ("go away") when applied to a matching constructor application,
-- i.e. for `▸` we have `(rfl ▸ c) ≡ c`.
-- So why didn't `simp` reduce away `(_ : a = b) ▸` if it works for `rfl` and all proofs are the same?
-- Well, all proofs of a *single* proposition are the same, but `rfl` is not a proof of `a = b` unless
-- `a` and `b` are in fact the same term! Thus the general way to get rid of `(_ : a = b) ▸` is to
-- first rewrite the goal with a proof of the very equality `a = b`. After that, `simp`, or definitional
-- equality in general, will get rid of the `▸`.
-- Now, for technical reasons we should use `rw` instead of `simp` itself to do this rewrite. The short
-- answer as to why that is is that `simp` tries to be *too clever* in this case: it will rewrite `a = b`
-- on both sides of the `▸` individually, which usually makes it more flexible (week 4, slide pages 17 & 21),
-- but in this case unfortunately leads to a type-incorrect proof. The "naive" strategy of `rw`, which will
-- simply replace all `a` with `b` everywhere simultaneously by applying the `Eq` recursor once at the root,
-- turns out to be the better approach in this case.
-- Phew, that was a lot of typing (in the theoretic sense and on my keyboard). If you can't get the proof to
-- work, don't worry about it, we will not bother you with this kind of "esoteric" proof again. If, on the
-- other hand, you are interested in this kind of strong dependent typing, we may have an interesting variant
-- of the semantics project to offer you next week!

end DepMap

open List Nat

/- Insertion Sort -/

-- Let's implement insertion sort in Lean and show that the resulting `List` is indeed sorted.
-- To that end, we first assume that the type `α` is of the type class `LE`, meaning that we can use
-- the symbol `≤` (\le) as notation.
-- We also assume (notice that cool dot notation) that this relation is decidable:
variable [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)]

-- First, we want to define a predicate that holds if a list is sorted.
-- The predicate should have three constructors:
-- The empty list `[]` and the single element list `[a]` are sorted,
-- and we can add `a` to the front of a sorted list `b :: l`, if `a ≤ b`.
inductive Sorted : List α → Prop where
  | nil : Sorted []
  | single : Sorted [a]
  | cons_cons : a ≤ b → Sorted (b::l) → Sorted (a::b::l)

-- The main ingredient to insertion sort is a function `insertInOrder` which inserts
-- a single element `a` before the first entry `x` of a list for which `a ≤ x` holds.
-- Define that function by recursion on the list. Remember that `≤` is decidable.
def insertInOrder (a : α) (xs : List α) : List α :=
  match xs with
  | [] => [a]
  | x :: xs =>
    if a ≤ x then
      a :: x :: xs
    else
      x :: insertInOrder a xs

-- Now, check whether the function actually does what it should do.
#eval insertInOrder 4 [1, 3, 4, 6, 7]
#eval insertInOrder 4 [1, 2, 3]

-- Defining `insertionSort` itself is now an easy recursion.
def insertionSort (xs : List α) : List α :=
  match xs with
  | []      => []
  | x :: xs => insertInOrder x (insertionSort xs)

-- Let's test the sorting algorithm next.
#eval insertionSort [6, 2, 4, 4, 1, 3, 64]
#eval insertionSort [1, 2, 3]
#eval insertionSort (Nat.repeat (fun xs => xs.length :: xs) 500 [])

-- Now we want to move on to actually verify that the algorithm does what it claims to do!
-- To prove this, we don't need the relation to be transitive, but we need to assume the following property:
variable (antisymm : ∀ {x y : α}, ¬ (x ≤ y) → y ≤ x)

-- Okay, now prove the statement itself!
-- Hints:
--   * You might at one point have the choice to either apply induction on a list or on a witness of `Sorted`.
--     Choose wisely.
--   * Remember the tactic `by_cases` from the fifth exercise!
theorem sorted_insertInOrder {xs : List α} (h : Sorted xs) : Sorted (insertInOrder x xs) := by
  induction h with
  | nil => exact Sorted.single
  | @single a =>
    simp only [insertInOrder]
    by_cases hxa : x ≤ a <;> simp only [hxa]
    case inl => exact Sorted.cons_cons hxa Sorted.single
    case inr => exact Sorted.cons_cons (antisymm hxa) Sorted.single
  | @cons_cons a b l hab hbl ih =>
    simp only [insertInOrder]
    by_cases hxa : x ≤ a <;> simp only [hxa]
    case inl => exact Sorted.cons_cons hxa (Sorted.cons_cons hab hbl)
    case inr =>
      by_cases hxb : x ≤ b <;> simp only [hxb]
      case inl => exact Sorted.cons_cons (antisymm hxa) (Sorted.cons_cons hxb hbl)
      case inr =>
        simp only [insertInOrder, hxb] at ih
        exact Sorted.cons_cons hab ih

theorem sorted_insertionSort (as : List α) : Sorted (insertionSort as) :=
  match as with
  | []      => Sorted.nil
  | x :: xs => sorted_insertInOrder antisymm (sorted_insertionSort xs)

-- Here's a "soft" question: Have we now fully verified that `insertionSort` is a sorting algorithm?
-- What other property would be an obvious one to verify (which you don't have to do here)?

/-
We need to show that the resulting list is a permutation of the input.
Otherwise, `insertionSort (as : List α) := []` would be a valid sorting algorithm.
-/


/-
Copyright (c) 2022 Yaël Dillies, Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Kexing Ying
-/
import combinatorics.hall.basic
import combinatorics.simple_graph.acyclic
import combinatorics.simple_graph.clique
import data.real.sqrt
import set_theory.cardinal.basic

/-!
# Graph Theory, example sheet 1

Here are the statements (and hopefully soon proofs!) of the questions from the first example sheet
of the Cambridge Part II course Graph Theory.

If you solve a question in Lean, feel free to open a Pull Request on Github!
-/

open fintype (card) function simple_graph
open_locale big_operators cardinal

namespace graph_theory
namespace es1

variables {ι α β γ : Type*}

/-!
### Question 1

Show that a graph $$G$$ which contains an odd circuit, contains an odd cycle.
-/

lemma q1 (G : simple_graph α) (a : α) (w : G.walk a a) (hw : odd w.length) :
  ∃ b (p : G.path b b), odd (p : G.walk b b).length :=
sorry

/-!
### Question 2

Show there are infinitely many planar graphs for which $$e(G) = 3(|G| − 2)$$. Can you give a nice
description of all graphs that satisfy this equality?
-/

-- PLanarity is hard

/-!
### Question 3

Show that every graph $$G$$, with $$|G| > 2$$, has two vertices of the same degree.
-/

lemma q3 [fintype α] (G : simple_graph α) [decidable_rel G.adj] :
  ∃ a b, a ≠ b ∧ G.degree a = G.degree b :=
sorry

/-!
### Question 4

Show that in every connected graph with $$|G| ≥ 2$$ there exists a vertex $$v$$ so that $$G − v$$ is
connected.
-/

-- This looks a bit painful as a translation. Probably better stated using connectivity on a set.
lemma q4 [finite α] [nontrivial α] (G : simple_graph α) (hG : G.connected) :
  ∃ a, ((⊤ : G.subgraph).delete_verts {a}).coe.connected :=
begin
  casesI nonempty_fintype α,
  sorry
end

/-!
### Question 5

Show that if $$G$$ is acyclic and $$|G| ≥ 1$$, then $$e(G) ≤ n − 1$$.
-/

-- Note: The statement is true without `nonempty α` due to nat subtraction.
lemma q5 [fintype α] [decidable_eq α] (G : simple_graph α) [decidable_rel G.adj]
  (hG : G.is_acyclic) :
  G.edge_finset.card ≤ card α - 1 :=
begin
  casesI is_empty_or_nonempty α,
  { simp },
  sorry
end

/-!
### Question 6

The degree sequence of a graph $$G = ({x_1, . . . , x_n}, E)$$ is the sequence
$$d(x_1), . . . , d(x_n)$$.
For $$n ≥ 2$$, let $$1 ≤ d_1 ≤ d_2 ≤ \dots ≤ d_n$$ be integers. Show that $$(d_i)_{i = 1}^n$$ is a
degree sequence of a tree if and only if $$\sum_{i=1}^n d_i = 2n − 2$$.
-/

/-- The finset of degrees of a finite graph. -/
def degree_sequence [fintype α] (G : simple_graph α) [decidable_rel G.adj] : multiset ℕ :=
finset.univ.val.map $ λ a, G.degree a

lemma q6 [fintype α] (s : multiset ℕ) (hs : s.card = card α) (h₀ : 0 ∉ s) :
  s.sum = 2 * card α - 2 ↔
    ∃ (G : simple_graph α) [decidable_rel G.adj], by exactI degree_sequence G = s :=
sorry

/-!
### Question 7

Let $$T_1, \dots, T_k$$ be subtrees of a tree $$T$$. Show that if $$V(T_i) ∩ V(T_j) ≠ ∅$$ for all
$$i, j ∈ [k]$$ then $$V(T_1) ∩ \dots ∩ V(T_k) ≠ ∅$$.
-/

lemma q7 (G : simple_graph α) (hG : G.is_acyclic) (s : finset ι) (f : ι → G.subgraph)
  (hf : ∀ i ∈ s, (f i).coe.is_acyclic) (h : ∀ i j ∈ s, f i ⊓ f j ≠ ⊥) :
  s.inf f ≠ ⊥ :=
sorry

/-!
### Question 8

The average degree of a graph $$G = (V, E)$$ is $$n^{-1} \sum_{x ∈ V} d(x)$$. Show that if the
average degree of $$G$$ is $$d$$ then $$G$$ contains a subgraph with minimum degree $≥ d/2$$.
-/

/-- The average degree of a simple graph is the average of its degrees. -/
def average_degree [fintype α] (G : simple_graph α) [decidable_rel G.adj] : ℚ :=
∑ a, G.degree a / card α

lemma q8 [fintype α] (G : simple_graph α) [decidable_rel G.adj] :
  ∃ (H : subgraph G) [decidable_rel H.adj], ∀ a, by exactI average_degree G / 2 ≤ H.degree a :=
sorry

/-!
### Question 9

Say that a graph $$G = (V, E)$$ can be decomposed into cycles if $$E$$ can be partitioned
$$E = E_1 ∪ \dots ∪ E_k$$, where each $$E_i$$ is the edge set of a cycle. Show that $$G$$ can be
decomposed into cycles if and only if all degrees of $$G$$ are even.
-/

-- This looks painful as a translation. It will likely get better once we have Kyle's eulerian paths
lemma q9 [fintype α] (G : simple_graph α) [decidable_rel G.adj] :
  (∃ 𝒜 : finset (Σ a, G.path a a),
    (∀ p q : Σ a, G.path a a, (p.2 : G.walk p.1 p.1).edges.disjoint (q.2 : G.walk q.1 q.1).edges) ∧
      ∀ e, ∃ p : Σ a, G.path a a, p ∈ 𝒜 ∧ e ∈ (p.2 : G.walk p.1 p.1).edges)
        ↔ ∀ a, even (G.degree a) :=
sorry

/-!
### Question 10

The clique number of a graph $$G$$ is the largest $$t$$ so that $$G$$ contains a complete graph on
$$t$$ vertices.
Show that the possible clique numbers for a regular graph on $$n$$ vertices are
$$1, 2, \dots, n/2$$ and $$n$$.
-/

/-- The clique number of a graph is the size of its largest clique. -/
def clique_number [fintype α] [decidable_eq α] (G : simple_graph α) [decidable_rel G.adj] : ℕ :=
nat.find_greatest (λ n, ∃ s, G.is_n_clique n s) $ card α

lemma q10 [fintype α] [decidable_eq α] (n : ℕ) :
  (∃ (G : simple_graph α) [decidable_rel G.adj] k, by exactI G.is_regular_of_degree k
    ∧ clique_number G = n)
      ↔ n ≤ card α / 2 ∨ n = card α :=
sorry

/-!
### Question 11

Show that the Petersen graph is non-planar.
-/

-- PLanarity is hard

/-!
### Question 12

Let $$G = (V, E)$$ be a graph. Show that there is a partition $$V = A ∪ B$$ so all the vertices in
the graphs $$G[A]$$ and $$G[B]$$ are of even degree.
-/

-- Note: This is a bit general than the statement, because we allow partitioning any set of vertices
lemma q12 [decidable_eq α] (G : simple_graph α) [decidable_rel G.adj] (s : finset α) :
  ∃ u v, disjoint u v ∧ u ∪ v = s ∧
    (∀ a ∈ u, even (u.filter $ G.adj a).card) ∧ (∀ a ∈ v, even (v.filter $ G.adj a).card) :=
sorry

/-!
### Question 13

A $$m × n$$ Latin rectangle is a $$m × n$$ matrix, with each entry from $${1, . . . , n}$$, such
that no two entries in the same row or column are the same. Prove that every $$m × n$$ Latin
rectangle may be extended to a $$n × n$$ Latin square.
-/

/-- A Latin rectangle is a binary function whose transversals are all injective. -/
def is_latin (f : α → β → γ) : Prop := (∀ a, injective (f a)) ∧ ∀ b, injective $ λ a, f a b

lemma q13 [finite α] (g : β ↪ α) (f : β → α → α) (hf : is_latin f) :
  ∃ f', f' ∘ g = f ∧ is_latin f :=
sorry

/-!
### Question 14

Let $$G = (X ∪ Y, E)$$ be a countably infinite bipartite graph with the property that
$$|N(A)| ≥ |A|$$ for all $$A ⊆ X$$. Give an example to show that $$G$$ need not contain a matching
from $$X$$ to $$Y$$ . On the other hand, show that if all of the degrees of $$G$$ are finite then
$$G$$ does contain a matching from $$X$$ to $$Y$$. Does this remain true if $$G$$ is uncountable and
all degrees of $$X$$ are finite (while degrees in $$Y$$ have no restriction)?
-/

-- This translation looks slightly painful because of the `cardinal`.
lemma q14_part1 :
  ∃ r : ℕ → ℕ → Prop, (∀ A : finset ℕ, (A.card : cardinal) ≤ #(rel.image r A))
    ∧ ∀ f : ℕ → ℕ, injective f → ∃ n, ¬ r n (f n) :=
sorry

lemma q14_part2 [decidable_eq β] [countable α] [countable β] (r : α → β → Prop)
  [Π a, fintype (rel.image r {a})] (hr : ∀ A : finset α, A.card ≤ card ↥(rel.image r A)) :
  ∃ f : α → β, injective f ∧ ∀ a, r a (f a) :=
sorry

lemma q14_part3 [decidable_eq β] (r : α → β → Prop) [Π a, fintype (rel.image r {a})]
  (hr : ∀ A : finset α, A.card ≤ card ↥(rel.image r A)) :
  ∃ f : α → β, injective f ∧ ∀ a, r a (f a) :=
sorry

/-!
### Question 15

Let $$(X, d_X)$$ be a metric space. We say that a function $$f : X → ℝ^2$$ has distortion
$$≤ D$$ if there exists an $$r > 0$$ so that
$$rd_X(x, y) ≤ ‖f(x) − f(y)‖_2 ≤ Drd_X(x, y)$$.
Show that there is some constant $$c > 0$$ such that for all $$n$$ there is a metric space
$$M = ({x_1, \dots, x_n}, d_M)$$ on $$n$$ points so that every function $$f : M → ℝ^2$$ has
distortion $$> cn^{1/2}$$. Does there exist some constant $$c > 0$$ such that for all $$n$$ there is
a metric space $$M = ({x_1, \dots, x_n}, d_M)$$ on $$n$$ points so that every function
$$f : M → ℝ^2$$ has distortion $$> cn$$?
-/

/-- The distortion of a function `f` between metric spaces is the ratio between the maximum and
minimum of `dist (f a) (f b) / dist a b`. -/
noncomputable def distortion [pseudo_metric_space α] [pseudo_metric_space β] (f : α → β) : ℝ :=
(⨆ a b, dist (f a) (f b) / dist a b) / ⨅ a b, dist (f a) (f b) / dist a b

lemma q15_part1 :
  ∃ (ε : ℝ), 0 < ε ∧ ∀ α [fintype α], ∃ (_ : metric_space α),
    by exactI ∀ f : α → ℝ × ℝ, ε * real.sqrt (card α) ≤ distortion f :=
sorry

lemma q15_part2 :
  ∃ (ε : ℝ), 0 < ε ∧ ∀ α [fintype α], ∃ (_ : metric_space α),
    by exactI ∀ f : α → ℝ × ℝ, ε * card α ≤ distortion f :=
sorry

end es1
end graph_theory


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

! This file was ported from Lean 3 source module analysis.special_functions.log.monotone
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Log.Basic
import Mathbin.Analysis.SpecialFunctions.Pow

/-!
# Logarithm Tonality

In this file we describe the tonality of the logarithm function when multiplied by functions of the
form `x ^ a`.

## Tags

logarithm, tonality
-/

open Set Filter Function

open Topology

noncomputable section

namespace Real

variable {x y : ℝ}

theorem log_mul_self_monotoneOn : MonotoneOn (fun x : ℝ => log x * x) { x | 1 ≤ x } :=
  by
  -- TODO: can be strengthened to exp (-1) ≤ x
  simp only [MonotoneOn, mem_set_of_eq]
  intro x hex y hey hxy
  have x_pos : 0 < x := lt_of_lt_of_le zero_lt_one hex
  have y_pos : 0 < y := lt_of_lt_of_le zero_lt_one hey
  refine' mul_le_mul ((log_le_log x_pos y_pos).mpr hxy) hxy (le_of_lt x_pos) _
  rwa [le_log_iff_exp_le y_pos, Real.exp_zero]
#align real.log_mul_self_monotone_on Real.log_mul_self_monotoneOn

theorem log_div_self_antitoneOn : AntitoneOn (fun x : ℝ => log x / x) { x | exp 1 ≤ x } :=
  by
  simp only [AntitoneOn, mem_set_of_eq]
  intro x hex y hey hxy
  have x_pos : 0 < x := (exp_pos 1).trans_le hex
  have y_pos : 0 < y := (exp_pos 1).trans_le hey
  have hlogx : 1 ≤ log x := by rwa [le_log_iff_exp_le x_pos]
  have hyx : 0 ≤ y / x - 1 := by rwa [le_sub_iff_add_le, le_div_iff x_pos, zero_add, one_mul]
  rw [div_le_iff y_pos, ← sub_le_sub_iff_right (log x)]
  calc
    log y - log x = log (y / x) := by rw [log_div y_pos.ne' x_pos.ne']
    _ ≤ y / x - 1 := (log_le_sub_one_of_pos (div_pos y_pos x_pos))
    _ ≤ log x * (y / x - 1) := (le_mul_of_one_le_left hyx hlogx)
    _ = log x / x * y - log x := by ring

#align real.log_div_self_antitone_on Real.log_div_self_antitoneOn

theorem log_div_self_rpow_antitoneOn {a : ℝ} (ha : 0 < a) :
    AntitoneOn (fun x : ℝ => log x / x ^ a) { x | exp (1 / a) ≤ x } :=
  by
  simp only [AntitoneOn, mem_set_of_eq]
  intro x hex y hey hxy
  have x_pos : 0 < x := lt_of_lt_of_le (exp_pos (1 / a)) hex
  have y_pos : 0 < y := by linarith
  have x_nonneg : 0 ≤ x := le_trans (le_of_lt (exp_pos (1 / a))) hex
  have y_nonneg : 0 ≤ y := by linarith
  nth_rw 1 [← rpow_one y]
  nth_rw 1 [← rpow_one x]
  rw [← div_self (ne_of_lt ha).symm, div_eq_mul_one_div a a, rpow_mul y_nonneg, rpow_mul x_nonneg,
    log_rpow (rpow_pos_of_pos y_pos a), log_rpow (rpow_pos_of_pos x_pos a), mul_div_assoc,
    mul_div_assoc, mul_le_mul_left (one_div_pos.mpr ha)]
  · refine' log_div_self_antitone_on _ _ _
    · simp only [Set.mem_setOf_eq]
      convert rpow_le_rpow _ hex (le_of_lt ha)
      rw [← exp_mul]
      simp only [Real.exp_eq_exp]
      field_simp [(ne_of_lt ha).symm]
      exact le_of_lt (exp_pos (1 / a))
    · simp only [Set.mem_setOf_eq]
      convert rpow_le_rpow _ (trans hex hxy) (le_of_lt ha)
      rw [← exp_mul]
      simp only [Real.exp_eq_exp]
      field_simp [(ne_of_lt ha).symm]
      exact le_of_lt (exp_pos (1 / a))
    exact rpow_le_rpow x_nonneg hxy (le_of_lt ha)
#align real.log_div_self_rpow_antitone_on Real.log_div_self_rpow_antitoneOn

theorem log_div_sqrt_antitoneOn : AntitoneOn (fun x : ℝ => log x / sqrt x) { x | exp 2 ≤ x } :=
  by
  simp_rw [sqrt_eq_rpow]
  convert@log_div_self_rpow_antitone_on (1 / 2) (by norm_num)
  norm_num
#align real.log_div_sqrt_antitone_on Real.log_div_sqrt_antitoneOn

end Real


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

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, sheet 6 : equality of sets

Sets are extensional objects to mathematicians, which means that
if two sets have the same elements, then they are equal.

## Tactics

Tactics you will need to know for this sheet:

* `ext`

### The `ext` tactic

If the goal is `⊢ A = B` where `A` and `B` are subsets of `X`, then
the tactic `ext x,` will create a hypothesis `x : X` and change
the goal to `x ∈ A ↔ x ∈ B`.

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : A ⊆ B → B ⊆ A → A = B :=
begin
  rintro h1 h2,
  ext x,
  split,
  intro h,
  specialize h1 h, exact h1,
  intro h,
  specialize h2 h, exact h2,
end

example : A ∪ A = A :=
begin
  ext,
  split,
  {intro h,
  change x ∈ A ∨ x ∈ A at h,
  cases h, exact h, exact h,},
  intro h,
  change x ∈ A ∨ x ∈ A,
  left, exact h,
end

example : A ∩ A = A :=
begin
  ext,
  split,
  intro h,
  change x ∈ A ∧ x ∈ A at h,
  exact h.1,
  intro h,
  change x ∈ A ∧ x ∈ A,
  exact ⟨h, h⟩,
end

example : A ∩ B = B ∩ A :=
begin
  ext,
  split,
  intro h,
  change x ∈ A ∧ x ∈ B at h,
  change x ∈ B ∧ x ∈ A,
  rcases h with ⟨hA, hB⟩,
  exact ⟨hB, hA⟩,
  intro h,
  change x ∈ B ∧ x ∈ A at h,
  change x ∈ A ∧ x ∈ B,
  rcases h with ⟨hB, hA⟩,
  exact ⟨hA, hB⟩,
end

example : A ∩ (B ∩ C) = (A ∩ B) ∩ C :=
begin
  ext,
  split,
  intro h,
  rcases h with ⟨hA, hB, hC⟩,
  change x ∈ (A ∩ B) ∧ x ∈ C,
  change (x ∈ A ∧ x ∈ B) ∧ (x ∈ C),
  exact ⟨⟨hA, hB⟩, hC⟩,
  intro h,
  rcases h with ⟨hAB, hC⟩,
  rcases hAB with ⟨hA, hB⟩,
  exact ⟨hA, ⟨hB, hC⟩⟩,
end

example : A ∪ (B ∪ C) = (A ∪ B) ∪ C :=
begin
  ext,
  split,
  {intro h,
  change (x ∈ A ∪ B) ∨ x ∈ C,
  change x ∈ A ∨ (x ∈ B ∪ C) at h,
  cases h,
  left, left, exact h,
  cases h,
  left, right, exact h,
  right, exact h,},
  intro h,
  cases h, cases h,
  left, exact h,
  right, left, exact h,
  right, right, exact h,
end


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

! This file was ported from Lean 3 source module data.nat.sqrt_norm_num
! leanprover-community/mathlib commit ca80c8b003dcb3f7dbe0017d2e951bc687b9ad3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.NormNum
import Mathbin.Data.Nat.Sqrt

/-! ### `norm_num` plugin for `sqrt`

The `norm_num` plugin evaluates `sqrt` by bounding it between consecutive integers.
-/

namespace NormNum

open Tactic Nat

theorem is_sqrt {n a a2 b : ℕ} (ha2 : a * a = a2) (hb : a2 + b = n) (hle : b ≤ bit0 a) :
    sqrt n = a := by
  rw [← hb, ← ha2, ← pow_two]
  exact sqrt_add_eq' _ hle
#align norm_num.is_sqrt NormNum.is_sqrt

/-- Given `n` provides `(a, ⊢ nat.sqrt n = a)`. -/
unsafe def prove_sqrt (ic : instance_cache) (n : expr) : tactic (instance_cache × expr × expr) := do
  let nn ← n.toNat
  let na := nn.sqrt
  let (ic, a) ← ic.ofNat na
  let (ic, a2, ha2) ← prove_mul_nat ic a a
  let (ic, b) ← ic.ofNat (nn - na * na)
  let (ic, hb) ← prove_add_nat ic a2 b n
  let (ic, hle) ← prove_le_nat ic b (q((bit0 : ℕ → ℕ)).mk_app [a])
  pure (ic, a, q(@is_sqrt).mk_app [n, a, a2, b, ha2, hb, hle])
#align norm_num.prove_sqrt norm_num.prove_sqrt

/-- A `norm_num` plugin for `sqrt n` when `n` is a numeral. -/
@[norm_num]
unsafe def eval_sqrt : expr → tactic (expr × expr)
  | q(sqrt $(en)) => do
    let n ← en.toNat
    match n with
      | 0 => pure (q((0 : ℕ)), q(sqrt_zero))
      | _ => do
        let c ← mk_instance_cache q(ℕ)
        Prod.snd <$> prove_sqrt c en
  | _ => failed
#align norm_num.eval_sqrt norm_num.eval_sqrt

end NormNum


import betweenness_world.level01 --hide
open IncidencePlane --hide

/- Axiom :
different_of_between : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C)
-/

/-
# Betweenness World

## Level 2: don't try to break a point into two pieces...

In this level, we are asked to show that points cannot be splitted. You may want to use the first axiom of order `different_of_between`.
You will find it in the list of theorem statements. In case you get stuck, click right below for a hint.
-/

/- Hint : Click here for a hint, in case you get stuck.
You can add the hypothesis `hAx : A ≠ x ∧ A ≠ A ∧ x ≠ A` and use the theorem statement commented above to prove it. Then, the `tauto` tactic may help you
to close the goal. Still bewildered? click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
A point cannot be between one point.
-/
lemma no_point_between_a_point (A x : Ω) : (A * x * A) ↔ false :=
begin
    split,
    {
      intro h,
      have hAx : A ≠ x ∧ A ≠ A ∧ x ≠ A,
      apply different_of_between,
      exact h,
      cases hAx with hA hB,
      cases hB with hC hD,
      apply hC,
      refl,
    },
    tauto,
end