/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov
-/
import algebra.module.submodule
import algebra.punit_instances

/-!
# The lattice structure on `submodule`s

This file defines the lattice structure on submodules, `submodule.complete_lattice`, with `⊥`
defined as `{0}` and `⊓` defined as intersection of the underlying carrier.
If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`.

Many results about operations on this lattice structure are defined in `linear_algebra/basic.lean`,
most notably those which use `span`.

## Implementation notes

This structure should match the `add_submonoid.complete_lattice` structure, and we should try
to unify the APIs where possible.

-/

variables {R S M : Type*}

section add_comm_monoid
variables [semiring R] [semiring S] [add_comm_monoid M] [module R M] [module S M]
variables [has_scalar S R] [is_scalar_tower S R M]
variables {p q : submodule R M}

namespace submodule

/-- The set `{0}` is the bottom element of the lattice of submodules. -/
instance : has_bot (submodule R M) :=
⟨{ carrier := {0}, smul_mem' := by simp { contextual := tt }, .. (⊥ : add_submonoid M)}⟩

instance inhabited' : inhabited (submodule R M) := ⟨⊥⟩

@[simp] lemma bot_coe : ((⊥ : submodule R M) : set M) = {0} := rfl
@[simp] lemma bot_to_add_submonoid : (⊥ : submodule R M).to_add_submonoid = ⊥ := rfl

section
variables (R)
@[simp] lemma restrict_scalars_bot : restrict_scalars S (⊥ : submodule R M) = ⊥ := rfl

@[simp] lemma mem_bot {x : M} : x ∈ (⊥ : submodule R M) ↔ x = 0 := set.mem_singleton_iff
end

instance unique_bot : unique (⊥ : submodule R M) :=
⟨infer_instance, λ x, subtype.ext $ (mem_bot R).1 x.mem⟩

instance : order_bot (submodule R M) :=
{ bot := ⊥,
  bot_le := λ p x, by simp {contextual := tt} }

protected lemma eq_bot_iff (p : submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) :=
⟨ λ h, h.symm ▸ λ x hx, (mem_bot R).mp hx,
  λ h, eq_bot_iff.mpr (λ x hx, (mem_bot R).mpr (h x hx)) ⟩

@[ext] protected lemma bot_ext (x y : (⊥ : submodule R M)) : x = y :=
begin
  rcases x with ⟨x, xm⟩, rcases y with ⟨y, ym⟩, congr,
  rw (submodule.eq_bot_iff _).mp rfl x xm,
  rw (submodule.eq_bot_iff _).mp rfl y ym,
end

protected lemma ne_bot_iff (p : submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) :=
by { haveI := classical.prop_decidable, simp_rw [ne.def, p.eq_bot_iff, not_forall] }

lemma nonzero_mem_of_bot_lt {p : submodule R M} (bot_lt : ⊥ < p) : ∃ a : p, a ≠ 0 :=
let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp bot_lt.ne' in ⟨⟨b, hb₁⟩, hb₂ ∘ (congr_arg coe)⟩

lemma exists_mem_ne_zero_of_ne_bot {p : submodule R M} (h : p ≠ ⊥) : ∃ b : M, b ∈ p ∧ b ≠ 0 :=
let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp h in ⟨b, hb₁, hb₂⟩

/-- The bottom submodule is linearly equivalent to punit as an `R`-module. -/
@[simps] def bot_equiv_punit : (⊥ : submodule R M) ≃ₗ[R] punit :=
{ to_fun := λ x, punit.star,
  inv_fun := λ x, 0,
  map_add' := by { intros, ext, },
  map_smul' := by { intros, ext, },
  left_inv := by { intro x, ext, },
  right_inv := by { intro x, ext, }, }

lemma eq_bot_of_subsingleton (p : submodule R M) [subsingleton p] : p = ⊥ :=
begin
  rw eq_bot_iff,
  intros v hv,
  exact congr_arg coe (subsingleton.elim (⟨v, hv⟩ : p) 0)
end

/-- The universal set is the top element of the lattice of submodules. -/
instance : has_top (submodule R M) :=
⟨{ carrier := set.univ, smul_mem' := λ _ _ _, trivial, .. (⊤ : add_submonoid M)}⟩

@[simp] lemma top_coe : ((⊤ : submodule R M) : set M) = set.univ := rfl

@[simp] lemma top_to_add_submonoid : (⊤ : submodule R M).to_add_submonoid = ⊤ := rfl

@[simp] lemma mem_top {x : M} : x ∈ (⊤ : submodule R M) := trivial

section
variables (R)
@[simp] lemma restrict_scalars_top : restrict_scalars S (⊤ : submodule R M) = ⊤ := rfl
end

instance : order_top (submodule R M) :=
{ top := ⊤,
  le_top := λ p x _, trivial }

lemma eq_top_iff' {p : submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p :=
eq_top_iff.trans ⟨λ h x, h trivial, λ h x _, h x⟩

/-- The top submodule is linearly equivalent to the module. -/
@[simps] def top_equiv_self : (⊤ : submodule R M) ≃ₗ[R] M :=
{ to_fun := λ x, x,
  inv_fun := λ x, ⟨x, by simp⟩,
  map_add' := by { intros, refl, },
  map_smul' := by { intros, refl, },
  left_inv := by { intro x, ext, refl, },
  right_inv := by { intro x, refl, }, }

instance : has_Inf (submodule R M) :=
⟨λ S,
{ carrier   := ⋂ s ∈ S, (s : set M),
  zero_mem' := by simp,
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

private lemma Inf_le' {S : set (submodule R M)} {p} : p ∈ S → Inf S ≤ p :=
set.bInter_subset_of_mem

private lemma le_Inf' {S : set (submodule R M)} {p} : (∀q ∈ S, p ≤ q) → p ≤ Inf S :=
set.subset_bInter

instance : has_inf (submodule R M) :=
⟨λ p q,
{ carrier   := p ∩ q,
  zero_mem' := by simp,
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

instance : complete_lattice (submodule R M) :=
{ sup          := λ a b, Inf {x | a ≤ x ∧ b ≤ x},
  le_sup_left  := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, ha,
  le_sup_right := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, hb,
  sup_le       := λ a b c h₁ h₂, Inf_le' ⟨h₁, h₂⟩,
  inf          := (⊓),
  le_inf       := λ a b c, set.subset_inter,
  inf_le_left  := λ a b, set.inter_subset_left _ _,
  inf_le_right := λ a b, set.inter_subset_right _ _,
  Sup          := λtt, Inf {t | ∀t'∈tt, t' ≤ t},
  le_Sup       := λ s p hs, le_Inf' $ λ q hq, hq _ hs,
  Sup_le       := λ s p hs, Inf_le' hs,
  Inf          := Inf,
  le_Inf       := λ s a, le_Inf',
  Inf_le       := λ s a, Inf_le',
  ..submodule.order_top,
  ..submodule.order_bot,
  ..set_like.partial_order }

@[simp] theorem inf_coe : ↑(p ⊓ q) = (p ∩ q : set M) := rfl

@[simp] theorem mem_inf {p q : submodule R M} {x : M} :
  x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q := iff.rfl

@[simp] theorem Inf_coe (P : set (submodule R M)) : (↑(Inf P) : set M) = ⋂ p ∈ P, ↑p := rfl

@[simp] theorem finset_inf_coe {ι} (s : finset ι) (p : ι → submodule R M) :
  (↑(s.inf p) : set M) = ⋂ i ∈ s, ↑(p i) :=
begin
  letI := classical.dec_eq ι,
  refine s.induction_on _ (λ i s hi ih, _),
  { simp },
  { rw [finset.inf_insert, inf_coe, ih],
    simp },
end

@[simp] theorem infi_coe {ι} (p : ι → submodule R M) :
  (↑⨅ i, p i : set M) = ⋂ i, ↑(p i) :=
by rw [infi, Inf_coe]; ext a; simp; exact
⟨λ h i, h _ i rfl, λ h i x e, e ▸ h _⟩

@[simp] lemma mem_Inf {S : set (submodule R M)} {x : M} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
set.mem_bInter_iff

@[simp] theorem mem_infi {ι} (p : ι → submodule R M) {x} :
  x ∈ (⨅ i, p i) ↔ ∀ i, x ∈ p i :=
by rw [← set_like.mem_coe, infi_coe, set.mem_Inter]; refl

@[simp] theorem mem_finset_inf {ι} {s : finset ι} {p : ι → submodule R M} {x : M} :
  x ∈ s.inf p ↔ ∀ i ∈ s, x ∈ p i :=
by simp only [← set_like.mem_coe, finset_inf_coe, set.mem_Inter]

lemma mem_sup_left {S T : submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma add_mem_sup {S T : submodule R M} {s t : M} (hs : s ∈ S) (ht : t ∈ T) : s + t ∈ S ⊔ T :=
add_mem _ (mem_sup_left hs) (mem_sup_right ht)

lemma mem_supr_of_mem {ι : Sort*} {b : M} {p : ι → submodule R M} (i : ι) (h : b ∈ p i) :
  b ∈ (⨆i, p i) :=
have p i ≤ (⨆i, p i) := le_supr p i,
@this b h

open_locale big_operators

lemma sum_mem_supr {ι : Type*} [fintype ι] {f : ι → M} {p : ι → submodule R M}
  (h : ∀ i, f i ∈ p i) :
  ∑ i, f i ∈ ⨆ i, p i :=
sum_mem _ $ λ i hi, mem_supr_of_mem i (h i)

lemma sum_mem_bsupr {ι : Type*} {s : finset ι} {f : ι → M} {p : ι → submodule R M}
  (h : ∀ i ∈ s, f i ∈ p i) :
  ∑ i in s, f i ∈ ⨆ i ∈ s, p i :=
sum_mem _ $ λ i hi, mem_supr_of_mem i $ mem_supr_of_mem hi (h i hi)

/-! Note that `submodule.mem_supr` is provided in `linear_algebra/basic.lean`. -/

lemma mem_Sup_of_mem {S : set (submodule R M)} {s : submodule R M}
  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

end submodule

section nat_submodule

/-- An additive submonoid is equivalent to a ℕ-submodule. -/
def add_submonoid.to_nat_submodule : add_submonoid M ≃o submodule ℕ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, S.nsmul_mem hs _, ..S },
  inv_fun := submodule.to_add_submonoid,
  left_inv := λ ⟨S, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_submonoid.to_nat_submodule_symm :
  ⇑(add_submonoid.to_nat_submodule.symm : _ ≃o add_submonoid M) = submodule.to_add_submonoid := rfl

@[simp]
lemma add_submonoid.coe_to_nat_submodule (S : add_submonoid M) :
  (S.to_nat_submodule : set M) = S := rfl

@[simp]
lemma add_submonoid.to_nat_submodule_to_add_submonoid (S : add_submonoid M) :
  S.to_nat_submodule.to_add_submonoid = S :=
add_submonoid.to_nat_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_submonoid_to_nat_submodule (S : submodule ℕ M) :
  S.to_add_submonoid.to_nat_submodule = S :=
add_submonoid.to_nat_submodule.apply_symm_apply S

end nat_submodule

end add_comm_monoid

section int_submodule

variables [add_comm_group M]

/-- An additive subgroup is equivalent to a ℤ-submodule. -/
def add_subgroup.to_int_submodule : add_subgroup M ≃o submodule ℤ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, S.zsmul_mem hs _, ..S},
  inv_fun := submodule.to_add_subgroup,
  left_inv := λ ⟨S, _, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_subgroup.to_int_submodule_symm :
  ⇑(add_subgroup.to_int_submodule.symm : _ ≃o add_subgroup M) = submodule.to_add_subgroup := rfl

@[simp]
lemma add_subgroup.coe_to_int_submodule (S : add_subgroup M) :
  (S.to_int_submodule : set M) = S := rfl

@[simp]
lemma add_subgroup.to_int_submodule_to_add_subgroup (S : add_subgroup M) :
  S.to_int_submodule.to_add_subgroup = S :=
add_subgroup.to_int_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_subgroup_to_int_submodule (S : submodule ℤ M) :
  S.to_add_subgroup.to_int_submodule = S :=
add_subgroup.to_int_submodule.apply_symm_apply S

end int_submodule


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

/-!
# Erasure of duplicates in a list

This file proves basic results about `list.erase_dup` (definition in `data.list.defs`).
`erase_dup l` returns `l` without its duplicates. It keeps the earliest (that is, rightmost)
occurrence of each.

## Tags

duplicate, multiplicity, nodup, `nub`
-/

universes u

namespace list

variables {α : Type u} [decidable_eq α]

@[simp] theorem erase_dup_nil : erase_dup [] = ([] : list α) := rfl

theorem erase_dup_cons_of_mem' {a : α} {l : list α} (h : a ∈ erase_dup l) :
  erase_dup (a :: l) = erase_dup l :=
pw_filter_cons_of_neg $ by simpa only [forall_mem_ne] using h

theorem erase_dup_cons_of_not_mem' {a : α} {l : list α} (h : a ∉ erase_dup l) :
  erase_dup (a :: l) = a :: erase_dup l :=
pw_filter_cons_of_pos $ by simpa only [forall_mem_ne] using h

@[simp] theorem mem_erase_dup {a : α} {l : list α} : a ∈ erase_dup l ↔ a ∈ l :=
by simpa only [erase_dup, forall_mem_ne, not_not] using not_congr (@forall_mem_pw_filter α (≠) _
  (λ x y z xz, not_and_distrib.1 $ mt (and.rec eq.trans) xz) a l)

@[simp] theorem erase_dup_cons_of_mem {a : α} {l : list α} (h : a ∈ l) :
  erase_dup (a :: l) = erase_dup l :=
erase_dup_cons_of_mem' $ mem_erase_dup.2 h

@[simp] theorem erase_dup_cons_of_not_mem {a : α} {l : list α} (h : a ∉ l) :
  erase_dup (a :: l) = a :: erase_dup l :=
erase_dup_cons_of_not_mem' $ mt mem_erase_dup.1 h

theorem erase_dup_sublist : ∀ (l : list α), erase_dup l <+ l := pw_filter_sublist

theorem erase_dup_subset : ∀ (l : list α), erase_dup l ⊆ l := pw_filter_subset

theorem subset_erase_dup (l : list α) : l ⊆ erase_dup l :=
λ a, mem_erase_dup.2

theorem nodup_erase_dup : ∀ l : list α, nodup (erase_dup l) := pairwise_pw_filter

theorem erase_dup_eq_self {l : list α} : erase_dup l = l ↔ nodup l := pw_filter_eq_self

protected lemma nodup.erase_dup {l : list α} (h : l.nodup) : l.erase_dup = l :=
list.erase_dup_eq_self.2 h

@[simp] theorem erase_dup_idempotent {l : list α} : erase_dup (erase_dup l) = erase_dup l :=
pw_filter_idempotent

theorem erase_dup_append (l₁ l₂ : list α) : erase_dup (l₁ ++ l₂) = l₁ ∪ erase_dup l₂ :=
begin
  induction l₁ with a l₁ IH, {refl}, rw [cons_union, ← IH],
  show erase_dup (a :: (l₁ ++ l₂)) = insert a (erase_dup (l₁ ++ l₂)),
  by_cases a ∈ erase_dup (l₁ ++ l₂);
  [ rw [erase_dup_cons_of_mem' h, insert_of_mem h],
    rw [erase_dup_cons_of_not_mem' h, insert_of_not_mem h]]
end

end list


mutual
  def isEven : Nat → Bool
    | 0 => true
    | n+1 => isOdd n
  def isOdd : Nat → Bool
    | 0 => false
    | n+1 => isEven n
end
termination_by' measure fun
  | PSum.inl n => n
  | PSum.inr n => n
decreasing_by
  simp [measure, invImage, InvImage, Nat.lt_wfRel]
  apply Nat.lt_succ_self

theorem isEven_double (x : Nat) : isEven (2 * x) = true := by
  induction x with
  | zero => simp
  | succ x ih => simp [Nat.mul_succ, Nat.add_succ, isEven, isOdd, ih]


inductive Vec (α : Type u) : Nat → Type u
  | nil  : Vec α 0
  | cons : α → {n : Nat} → Vec α n → Vec α (n+1)

def Vec.repeat (a : α) (n : Nat) : Vec α n :=
  match n with
  | 0   => nil
  | n+1 => cons a (repeat a n)

instance [Inhabited α] : Inhabited (Vec α n) where
  default := Vec.repeat default n

def Vec.map (v : Vec α n) (f : α → β) : Vec β n :=
  match n, v with
  | _, nil       => nil
  | _, cons a as => cons (f a) (map as f)

def Vec.reverse (v : Vec α n) : Vec α n :=
  let rec loop : {n m : Nat} → Vec α n → Vec α m → Vec α (n + m)
    | _, _, nil,       w => Nat.zero_add .. ▸ w
    | _, _, cons a as, w => Nat.add_assoc .. ▸ loop as (Nat.add_comm .. ▸ cons a w)
  loop v nil

@[simp] theorem map_id (v : Vec α n) : v.map id = v := by
  induction v with
  | nil => rfl
  | cons a as ih => simp [Vec.map, ih]

def foo [Add α] (v w : Vec α n) (f : α → α) (a : α) : α :=
  match n, v.map f, w.map f with
  | _, Vec.nil,       Vec.nil       => a
  | _, Vec.cons a .., Vec.cons b .. => a + b

theorem ex1 (a b : Nat) (as : Vec Nat n) : foo (Vec.cons a as) (Vec.cons b as) id 0 = a + b := by
  simp [foo]

#print ex1

def bla (b : Bool) (f g : α → β) (a : α) : β :=
  (match b with
   | true => f | false => g) a

theorem ex2 (h : b = false) : bla b (fun x => x + 1) id 10 = 10 := by
  simp [bla, h]

#print ex2


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import data.list.basic
import data.nat.bits
import tactic.linarith

/-!
# Bitwise operations on natural numbers

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

In the first half of this file, we provide theorems for reasoning about natural numbers from their
bitwise properties. In the second half of this file, we show properties of the bitwise operations
`lor`, `land` and `lxor`, which are defined in core.

## Main results
* `eq_of_test_bit_eq`: two natural numbers are equal if they have equal bits at every position.
* `exists_most_significant_bit`: if `n ≠ 0`, then there is some position `i` that contains the most
  significant `1`-bit of `n`.
* `lt_of_test_bit`: if `n` and `m` are numbers and `i` is a position such that the `i`-th bit of
  of `n` is zero, the `i`-th bit of `m` is one, and all more significant bits are equal, then
  `n < m`.

## Future work

There is another way to express bitwise properties of natural number: `digits 2`. The two ways
should be connected.

## Keywords

bitwise, and, or, xor
-/

open function

namespace nat

@[simp] lemma bit_ff : bit ff = bit0 := rfl
@[simp] lemma bit_tt : bit tt = bit1 := rfl

@[simp] lemma bit_eq_zero {n : ℕ} {b : bool} : n.bit b = 0 ↔ n = 0 ∧ b = ff :=
by { cases b; simp [nat.bit0_eq_zero, nat.bit1_ne_zero] }

lemma zero_of_test_bit_eq_ff {n : ℕ} (h : ∀ i, test_bit n i = ff) : n = 0 :=
begin
  induction n using nat.binary_rec with b n hn,
  { refl },
  { have : b = ff := by simpa using h 0,
    rw [this, bit_ff, bit0_val, hn (λ i, by rw [←h (i + 1), test_bit_succ]), mul_zero] }
end

@[simp] lemma zero_test_bit (i : ℕ) : test_bit 0 i = ff :=
by simp [test_bit]

/-- The ith bit is the ith element of `n.bits`. -/

/-- Bitwise extensionality: Two numbers agree if they agree at every bit position. -/
lemma eq_of_test_bit_eq {n m : ℕ} (h : ∀ i, test_bit n i = test_bit m i) : n = m :=
begin
  induction n using nat.binary_rec with b n hn generalizing m,
  { simp only [zero_test_bit] at h,
    exact (zero_of_test_bit_eq_ff (λ i, (h i).symm)).symm },
  induction m using nat.binary_rec with b' m hm,
  { simp only [zero_test_bit] at h,
    exact zero_of_test_bit_eq_ff h },
  suffices h' : n = m,
  { rw [h', show b = b', by simpa using h 0] },
  exact hn (λ i, by convert h (i + 1) using 1; rw test_bit_succ)
end

lemma exists_most_significant_bit {n : ℕ} (h : n ≠ 0) :
  ∃ i, test_bit n i = tt ∧ ∀ j, i < j → test_bit n j = ff :=
begin
  induction n using nat.binary_rec with b n hn,
  { exact false.elim (h rfl) },
  by_cases h' : n = 0,
  { subst h',
    rw (show b = tt, by { revert h, cases b; simp }),
    refine ⟨0, ⟨by rw [test_bit_zero], λ j hj, _⟩⟩,
    obtain ⟨j', rfl⟩ := exists_eq_succ_of_ne_zero (ne_of_gt hj),
    rw [test_bit_succ, zero_test_bit] },
  { obtain ⟨k, ⟨hk, hk'⟩⟩ := hn h',
    refine ⟨k + 1, ⟨by rw [test_bit_succ, hk], λ j hj, _⟩⟩,
    obtain ⟨j', rfl⟩ := exists_eq_succ_of_ne_zero (show j ≠ 0, by linarith),
    exact (test_bit_succ _ _ _).trans (hk' _ (lt_of_succ_lt_succ hj)) }
end

lemma lt_of_test_bit {n m : ℕ} (i : ℕ) (hn : test_bit n i = ff) (hm : test_bit m i = tt)
  (hnm : ∀ j, i < j → test_bit n j = test_bit m j) : n < m :=
begin
  induction n using nat.binary_rec with b n hn' generalizing i m,
  { contrapose! hm,
    rw le_zero_iff at hm,
    simp [hm] },
  induction m using nat.binary_rec with b' m hm' generalizing i,
  { exact false.elim (bool.ff_ne_tt ((zero_test_bit i).symm.trans hm)) },
  by_cases hi : i = 0,
  { subst hi,
    simp only [test_bit_zero] at hn hm,
    have : n = m,
    { exact eq_of_test_bit_eq (λ i, by convert hnm (i + 1) dec_trivial using 1; rw test_bit_succ) },
    rw [hn, hm, this, bit_ff, bit_tt, bit0_val, bit1_val],
    exact lt_add_one _ },
  { obtain ⟨i', rfl⟩ := exists_eq_succ_of_ne_zero hi,
    simp only [test_bit_succ] at hn hm,
    have := hn' _ hn hm (λ j hj, by convert hnm j.succ (succ_lt_succ hj) using 1; rw test_bit_succ),
    cases b; cases b';
    simp only [bit_ff, bit_tt, bit0_val n, bit1_val n, bit0_val m, bit1_val m];
    linarith }
end

@[simp]
lemma test_bit_two_pow_self (n : ℕ) : test_bit (2 ^ n) n = tt :=
by rw [test_bit, shiftr_eq_div_pow, nat.div_self (pow_pos zero_lt_two n), bodd_one]

lemma test_bit_two_pow_of_ne {n m : ℕ} (hm : n ≠ m) : test_bit (2 ^ n) m = ff :=
begin
  rw [test_bit, shiftr_eq_div_pow],
  cases hm.lt_or_lt with hm hm,
  { rw [nat.div_eq_zero, bodd_zero],
    exact nat.pow_lt_pow_of_lt_right one_lt_two hm },
  { rw [pow_div hm.le zero_lt_two, ← tsub_add_cancel_of_le (succ_le_of_lt $ tsub_pos_of_lt hm)],
    simp [pow_succ] }
end

lemma test_bit_two_pow (n m : ℕ) : test_bit (2 ^ n) m = (n = m) :=
begin
  by_cases n = m,
  { cases h,
    simp },
  { rw test_bit_two_pow_of_ne h,
    simp [h] }
end

/-- If `f` is a commutative operation on bools such that `f ff ff = ff`, then `bitwise f` is also
    commutative. -/
lemma bitwise_comm {f : bool → bool → bool} (hf : ∀ b b', f b b' = f b' b)
  (hf' : f ff ff = ff) (n m : ℕ) : bitwise f n m = bitwise f m n :=
suffices bitwise f = swap (bitwise f), by conv_lhs { rw this },
calc bitwise f = bitwise (swap f) : congr_arg _ $ funext $ λ _, funext $ hf _
     ...       = swap (bitwise f) : bitwise_swap hf'

lemma lor_comm (n m : ℕ) : lor n m = lor m n := bitwise_comm bool.bor_comm rfl n m
lemma land_comm (n m : ℕ) : land n m = land m n := bitwise_comm bool.band_comm rfl n m
lemma lxor_comm (n m : ℕ) : lxor n m = lxor m n := bitwise_comm bool.bxor_comm rfl n m

@[simp] lemma zero_lxor (n : ℕ) : lxor 0 n = n := by simp [lxor]
@[simp] lemma lxor_zero (n : ℕ) : lxor n 0 = n := by simp [lxor]

@[simp] lemma zero_land (n : ℕ) : land 0 n = 0 := by simp [land]
@[simp] lemma land_zero (n : ℕ) : land n 0 = 0 := by simp [land]

@[simp] lemma zero_lor (n : ℕ) : lor 0 n = n := by simp [lor]
@[simp] lemma lor_zero (n : ℕ) : lor n 0 = n := by simp [lor]

/-- Proving associativity of bitwise operations in general essentially boils down to a huge case
    distinction, so it is shorter to use this tactic instead of proving it in the general case. -/
meta def bitwise_assoc_tac : tactic unit :=
`[induction n using nat.binary_rec with b n hn generalizing m k,
  { simp },
  induction m using nat.binary_rec with b' m hm,
  { simp },
  induction k using nat.binary_rec with b'' k hk;
  simp [hn]]

lemma lxor_assoc (n m k : ℕ) : lxor (lxor n m) k = lxor n (lxor m k) := by bitwise_assoc_tac
lemma land_assoc (n m k : ℕ) : land (land n m) k = land n (land m k) := by bitwise_assoc_tac
lemma lor_assoc (n m k : ℕ) : lor (lor n m) k = lor n (lor m k) := by bitwise_assoc_tac

@[simp] lemma lxor_self (n : ℕ) : lxor n n = 0 :=
zero_of_test_bit_eq_ff $ λ i, by simp

-- These lemmas match `mul_inv_cancel_right` and `mul_inv_cancel_left`.

lemma lxor_cancel_right (n m : ℕ) : lxor (lxor m n) n = m :=
by rw [lxor_assoc, lxor_self, lxor_zero]

lemma lxor_cancel_left (n m : ℕ) : lxor n (lxor n m) = m :=
by rw [←lxor_assoc, lxor_self, zero_lxor]

lemma lxor_right_injective {n : ℕ} : function.injective (lxor n) :=
λ m m' h, by rw [←lxor_cancel_left n m, ←lxor_cancel_left n m', h]

lemma lxor_left_injective {n : ℕ} : function.injective (λ m, lxor m n) :=
λ m m' (h : lxor m n = lxor m' n), by rw [←lxor_cancel_right n m, ←lxor_cancel_right n m', h]

@[simp] lemma lxor_right_inj {n m m' : ℕ} : lxor n m = lxor n m' ↔ m = m' :=
lxor_right_injective.eq_iff

@[simp] lemma lxor_left_inj {n m m' : ℕ} : lxor m n = lxor m' n ↔ m = m' :=
lxor_left_injective.eq_iff

@[simp] lemma lxor_eq_zero {n m : ℕ} : lxor n m = 0 ↔ n = m :=
by rw [←lxor_self n, lxor_right_inj, eq_comm]

lemma lxor_ne_zero {n m : ℕ} : lxor n m ≠ 0 ↔ n ≠ m := lxor_eq_zero.not

lemma lxor_trichotomy {a b c : ℕ} (h : a ≠ lxor b c) :
  lxor b c < a ∨ lxor a c < b ∨ lxor a b < c :=
begin
  set v := lxor a (lxor b c) with hv,

  -- The xor of any two of `a`, `b`, `c` is the xor of `v` and the third.
  have hab : lxor a b = lxor c v,
  { rw hv, conv_rhs { rw lxor_comm, simp [lxor_assoc] } },
  have hac : lxor a c = lxor b v,
  { rw hv,
    conv_rhs { congr, skip, rw lxor_comm },
    rw [←lxor_assoc, ←lxor_assoc, lxor_self, zero_lxor, lxor_comm] },
  have hbc : lxor b c = lxor a v,
  { simp [hv, ←lxor_assoc] },

  -- If `i` is the position of the most significant bit of `v`, then at least one of `a`, `b`, `c`
  -- has a one bit at position `i`.
  obtain ⟨i, ⟨hi, hi'⟩⟩ := exists_most_significant_bit (lxor_ne_zero.2 h),
  have : test_bit a i = tt ∨ test_bit b i = tt ∨ test_bit c i = tt,
  { contrapose! hi,
    simp only [eq_ff_eq_not_eq_tt, ne, test_bit_lxor] at ⊢ hi,
    rw [hi.1, hi.2.1, hi.2.2, bxor_ff, bxor_ff] },

  -- If, say, `a` has a one bit at position `i`, then `a xor v` has a zero bit at position `i`, but
  -- the same bits as `a` in positions greater than `j`, so `a xor v < a`.
  rcases this with h|h|h;
  [{ left, rw hbc }, { right, left, rw hac }, { right, right, rw hab }];
  exact lt_of_test_bit i (by simp [h, hi]) h (λ j hj, by simp [hi' _ hj])
end

lemma lt_lxor_cases {a b c : ℕ} (h : a < lxor b c) : lxor a c < b ∨ lxor a b < c :=
(or_iff_right $ λ h', (h.asymm h').elim).1 $ lxor_trichotomy h.ne

end nat


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import data.fintype.basic

/-!
# Finite types

This module defines a finiteness predicate on types called `finite`.
A type is `finite` if it is equivalent to `fin n` for some `n`, and
otherwise it is `infinite` (see `finite_or_infinite`). This predicate is
a `class`, and finiteness proofs are given as instances.

The `finite` predicate has no computational relevance and, being
`Prop`-valued, gets to enjoy proof irrelevance -- it represents the mere fact
that the type is finite.
While the `fintype` class also represents finiteness of a type, a key
difference is that a `fintype` instance represents finiteness in a
computable way: it gives a concrete algorithm to produce a `finset` whose
elements enumerate the terms of the given type. As such, one generally
relies on congruence lemmas when rewriting expressions involving
`fintype` instances.

Every `fintype` instance automatically gives a `finite` instance, but not
vice versa. Every `fintype` instance should be computable since they are meant
for computation. If it's not possible to write a computable `fintype` instance,
one should prefer writing a `finite` instance instead.

## Main definitions

* `finite α` denotes that `α` is a finite type.
* `finite.of_fintype` creates a `finite` instance from a `fintype` instance.
* `fintype.of_finite` noncomputably creates a `fintype` instance from a `finite` instance.
* `finite_or_infinite` is that every type is either `finite` or `infinite`.

## Implementation notes

The definition of `finite α` is not just `nonempty (fintype α)` since `fintype` requires
that `α : Type*`, and the definition in this module allows for `α : Sort*`. This means
we can write the instance `finite.prop`.

There is an apparent duplication of many `fintype` instances in this module,
however they follow a pattern: if a `fintype` instance depends on `decidable`
instances or other `fintype` instances, then we need to "lower" the instance
to be a `finite` instance by removing the `decidable` instances and switching
the `fintype` instances to `finite` instances. These are precisely the ones
that cannot be inferred using `finite.of_fintype'`. (However, when using
`open_locale classical` or the `classical` tactic the instances relying only
on `decidable` instances will give `finite` instances.) In the future we might
consider writing automation to create these "lowered" instances.

## Tags

finiteness, finite types

-/

noncomputable theory
open_locale classical

variables {α β γ : Type*}

/-- A type is `finite` if it is in bijective correspondence to some
`fin n`.

While this could be defined as `nonempty (fintype α)`, it is defined
in this way to allow there to be `finite` instances for propositions.
-/
class inductive finite (α : Sort*) : Prop
| intro {n : ℕ} : α ≃ fin n → finite

lemma finite.exists_equiv_fin (α : Sort*) [h : finite α] : ∃ (n : ℕ), nonempty (α ≃ fin n) :=
by { casesI h with n f, exact ⟨n, ⟨f⟩⟩ }

lemma finite.of_equiv (α : Sort*) {β : Sort*} [h : finite α] (f : α ≃ β) : finite β :=
by { casesI h with n e, exact finite.intro (f.symm.trans e) }

lemma equiv.finite_iff {α β : Sort*} (f : α ≃ β) : finite α ↔ finite β :=
⟨λ _, by exactI finite.of_equiv _ f, λ _, by exactI finite.of_equiv _ f.symm⟩

lemma finite.of_fintype {α : Type*} (h : fintype α) : finite α := ⟨fintype.equiv_fin α⟩

/-- For efficiency reasons, we want `finite` instances to have higher
priority than ones coming from `fintype` instances. -/
@[priority 900]
instance finite.of_fintype' (α : Type*) [fintype α] : finite α := finite.of_fintype ‹_›

/-- Noncomputably get a `fintype` instance from a `finite` instance. This is not an
instance because we want `fintype` instances to be useful for computations. -/
def fintype.of_finite (α : Type*) [finite α] : fintype α :=
nonempty.some $ let ⟨n, ⟨e⟩⟩ := finite.exists_equiv_fin α in ⟨fintype.of_equiv _ e.symm⟩

lemma finite_iff_nonempty_fintype (α : Type*) :
  finite α ↔ nonempty (fintype α) :=
⟨λ h, let ⟨k, ⟨e⟩⟩ := @finite.exists_equiv_fin α h in ⟨fintype.of_equiv _ e.symm⟩,
  λ ⟨_⟩, by exactI infer_instance⟩

lemma not_finite_iff_infinite {α : Type*} : ¬ finite α ↔ infinite α :=
by rw [← is_empty_fintype, finite_iff_nonempty_fintype, not_nonempty_iff]

lemma finite_or_infinite (α : Type*) :
  finite α ∨ infinite α :=
begin
  rw ← not_finite_iff_infinite,
  apply em
end

lemma not_finite (α : Type*) [h1 : infinite α] [h2 : finite α] : false :=
not_finite_iff_infinite.mpr h1 h2

lemma finite.of_not_infinite {α : Type*} (h : ¬ infinite α) : finite α :=
by rwa [← not_finite_iff_infinite, not_not] at h

lemma infinite.of_not_finite {α : Type*} (h : ¬ finite α) : infinite α :=
not_finite_iff_infinite.mp h

lemma not_infinite_iff_finite {α : Type*} : ¬ infinite α ↔ finite α :=
not_finite_iff_infinite.not_right.symm

lemma of_subsingleton {α : Sort*} [subsingleton α] : finite α := finite.of_equiv _ equiv.plift

@[nolint instance_priority]
instance finite.prop (p : Prop) : finite p := of_subsingleton

namespace finite

lemma exists_max [finite α] [nonempty α] [linear_order β] (f : α → β) :
  ∃ x₀ : α, ∀ x, f x ≤ f x₀ :=
by { haveI := fintype.of_finite α, exact fintype.exists_max f }

lemma exists_min [finite α] [nonempty α] [linear_order β] (f : α → β) :
  ∃ x₀ : α, ∀ x, f x₀ ≤ f x :=
by { haveI := fintype.of_finite α, exact fintype.exists_min f }

instance {α : Sort*} [finite α] : finite (plift α) := finite.of_equiv _ equiv.plift.symm

lemma of_bijective {α β : Sort*} [finite α] (f : α → β) (H : function.bijective f) : finite β :=
finite.of_equiv _ (equiv.of_bijective _ H)

lemma of_injective {α β : Sort*} [finite β] (f : α → β) (H : function.injective f) : finite α :=
begin
  haveI := fintype.of_finite (plift β),
  rw [← equiv.injective_comp equiv.plift f, ← equiv.comp_injective _ equiv.plift.symm] at H,
  haveI := fintype.of_injective _ H,
  exact finite.of_equiv _ equiv.plift,
end

lemma of_surjective {α β : Sort*} [finite α] (f : α → β) (H : function.surjective f) : finite β :=
of_injective _ $ function.injective_surj_inv H

@[priority 100] -- see Note [lower instance priority]
instance of_is_empty {α : Sort*} [is_empty α] : finite α := finite.of_equiv _ equiv.plift

instance [finite α] [finite β] : finite (α × β) :=
by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, apply_instance }

instance {α β : Sort*} [finite α] [finite β] : finite (pprod α β) :=
of_equiv _ equiv.pprod_equiv_prod_plift.symm

lemma prod_right (α) [finite (α × β)] [nonempty α] : finite β :=
of_surjective (prod.snd : α × β → β) prod.snd_surjective

instance [finite α] : finite (ulift α) :=
by { haveI := fintype.of_finite α, apply_instance }

instance [finite α] [finite β] : finite (α ⊕ β) :=
by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, apply_instance }

lemma sum_left (β) [finite (α ⊕ β)] : finite α :=
of_injective (sum.inl : α → α ⊕ β) sum.inl_injective

lemma sum_right (α) [finite (α ⊕ β)] : finite β :=
of_injective (sum.inr : β → α ⊕ β) sum.inr_injective

instance {β : α → Type*} [finite α] [Π a, finite (β a)] : finite (Σ a, β a) :=
by { letI := fintype.of_finite α, letI := λ a, fintype.of_finite (β a), apply_instance }

instance {ι : Sort*} {π : ι → Sort*} [finite ι] [Π i, finite (π i)] : finite (Σ' i, π i) :=
of_equiv _ (equiv.psigma_equiv_sigma_plift π).symm

end finite

/-- This instance also provides `[finite s]` for `s : set α`. -/
instance subtype.finite {α : Sort*} [finite α] {p : α → Prop} : finite {x // p x} :=
finite.of_injective coe subtype.coe_injective

instance pi.finite {α : Sort*} {β : α → Sort*} [finite α] [∀ a, finite (β a)] : finite (Π a, β a) :=
begin
  haveI := fintype.of_finite (plift α),
  haveI := λ a, fintype.of_finite (plift (β a)),
  exact finite.of_equiv (Π (a : plift α), plift (β (equiv.plift a)))
    (equiv.Pi_congr equiv.plift (λ _, equiv.plift)),
end

instance vector.finite {α : Type*} [finite α] {n : ℕ} : finite (vector α n) :=
by { haveI := fintype.of_finite α, apply_instance }

instance quot.finite {α : Sort*} [finite α] (r : α → α → Prop) : finite (quot r) :=
finite.of_surjective _ (surjective_quot_mk r)

instance quotient.finite {α : Sort*} [finite α] (s : setoid α) : finite (quotient s) :=
quot.finite _

instance function.embedding.finite {α β : Sort*} [finite β] : finite (α ↪ β) :=
begin
  casesI is_empty_or_nonempty (α ↪ β) with _ h,
  { apply_instance, },
  { refine h.elim (λ f, _),
    haveI : finite α := finite.of_injective _ f.injective,
    exact finite.of_injective _ fun_like.coe_injective },
end

instance equiv.finite_right {α β : Sort*} [finite β] : finite (α ≃ β) :=
finite.of_injective equiv.to_embedding $ λ e₁ e₂ h, equiv.ext $
  by convert fun_like.congr_fun h

instance equiv.finite_left {α β : Sort*} [finite α] : finite (α ≃ β) :=
finite.of_equiv _ ⟨equiv.symm, equiv.symm, equiv.symm_symm, equiv.symm_symm⟩

instance [finite α] {n : ℕ} : finite (sym α n) :=
by { haveI := fintype.of_finite α, apply_instance }


import basic
open IncidencePlane

noncomputable theory
open_locale classical

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

lemma same_side_trans_of_noncollinear (h : ¬ collinear ({A, C, B} : set Ω)):
    same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
  sorry
end

-- our lemma :D
lemma collinear_iff_on_line_through (X Y Z : Ω ) (h: X ≠ Y) : (collinear({X, Y, Z} : set Ω )) ↔  Z ∈ line_through X Y :=
begin
sorry,
end

-- our other lemma
lemma not_same_line_different_points (X Y :  Ω) (h : X ≠ Y) : (line_through({X, Y}))
begin
sorry,
end
-- added
lemma line_through_from_and (P Q : Ω) (ℓ : Line Ω) (h1 : P ≠ Q)
(h2 : P ∈ ℓ ∧ Q ∈ ℓ) : ℓ = line_through P Q :=
begin
cases h2 with hP hQ,
exact incidence h1 hP hQ,
end

-- added
lemma point_in_line_not_point {P Q: Ω} {r : Line Ω} (hP : P ∈ r) (hQ : Q ∉ r): P ≠ Q :=
begin
  intro h1,
  apply hQ,
  rw ← h1,
  exact hP,
end

lemma exists_point_not_in_line (ℓ : Line Ω) : ∃ (P : Ω), P ∉ ℓ :=
begin
rcases (existence Ω) with ⟨A : Ω, B, C, ⟨h1, h2, h3, h4⟩⟩,
by_cases h: line_through A B = ℓ,
{ use C,
  rw ← h,
  exact h4 },
{ by_cases a: A ∈ ℓ, { use B,
    intro p,
    apply h,
    rw incidence h1 a p },
  { use A }, },
end

lemma auxiliary_point (ℓ : Line Ω) (h : collinear ({A, B, C} : set Ω)) (hA : A ∉ ℓ) (hB : B ∉ ℓ)
  (hC : C ∉ ℓ) (hAB : A ≠ B) (hAC : A ≠ C) (hBC : B ≠ C)  :
  ∃ (D E : Ω), D ∈ ℓ ∧ ¬ E ∈ ℓ ∧ same_side ℓ A E ∧ (D * A * E) ∧
  ¬ collinear ({A, B, E} : set Ω) ∧
  ¬ collinear ({E, C, B} : set Ω) ∧
  ¬ collinear ({A, C, E} : set Ω)  :=
begin
    -- define what a b c line is, m
    set m := line_through A B with hm,

    have hAM: A ∈ m,
    exact line_through_left A B,

    have hBM: B ∈ m,
    exact line_through_right A B,

    have hCM:= (collinear_iff_on_line_through A B C hAB).1 h,

    --rcases (line_contains_two_points ℓ) with ⟨D1, D2, hD1,l⟩,
--    cases h with h h2,

    --l is not m

    by_cases fdg: D1 ∈ m,
    {
      use D1,
    },
    {
      sorry
    },

    --there is point in l, not in m, D

    --D*A*E w point on ray

    -- D A E are collinear collinear of between, meaning there is a line s. Have to get a line

    -- l is different s

    -- E is not in l.

    -- A E same side of l

    -- E is not in m.
    --

--  rcases (exists_point_on_line ℓ) with ⟨F, hF⟩,
  --have g:= point_in_line_not_point hE hD,

end

lemma same_side_trans_of_collinear (h : collinear ({A, C, B} : set Ω)):
    same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
  sorry
end

lemma same_side_trans_general : same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
  sorry
end

lemma at_least_two_classes (ℓ : Line Ω):
      ∃ A B : Ω, (A ∉ ℓ) ∧ (B ∉ ℓ) ∧ (¬ same_side ℓ A B) :=
begin
  sorry
end

lemma at_most_two_classes_of_noncollinear (hA : A ∉ ℓ) (hB : B ∉ ℓ) (hC : C ∉ ℓ)
    (hBneqC : B ≠ C) (hAB: ¬ same_side ℓ A B) (hAC: ¬ same_side ℓ A C)
    (h : ¬ collinear ({A, B, C} : set Ω)) : same_side ℓ B C :=
begin
  sorry
end

lemma at_most_two_classes_of_collinear (hA : A ∉ ℓ) (hB : B ∉ ℓ) (hC : C ∉ ℓ)
    (hBneqC : B ≠ C) (hAB: ¬ same_side ℓ A B) (hAC: ¬ same_side ℓ A C)
    (h : collinear ({A, B, C} : set Ω)) : same_side ℓ B C :=
begin
  sorry
end

lemma at_most_two_classes_general (hA : A ∉ ℓ) (hB : B ∉ ℓ) (hC : C ∉ ℓ)
    (hBneqC : B ≠ C) (hAB: ¬ same_side ℓ A B) (hAC: ¬ same_side ℓ A C): same_side ℓ B C :=
begin
  sorry
end


import tactic.ring
import data.nat.prime
import data.nat.modeq data.int.modeq
import analysis.real
import tactic.norm_num
import algebra.group_power
import M3P14.order
import chris_hughes_various.zmod
import M3P14.Problem_sheets.sheet1
import tactic.ring
import logic.basic
import data.int.basic

open nat

definition prime_int (p : ℤ) := prime(int.nat_abs p)
theorem prime_int_to_nat {p : ℤ} (h : prime_int p) : prime (int.nat_abs p) :=
begin
exact (show prime(int.nat_abs p), from h),
end

definition quadratic_res (a n : ℤ) := ∃ x : ℤ, a ≡ x^2 [ZMOD (int.nat_abs n)]
--definition quadratic_res' (p : ℤ) (hp : prime_int p ∧ p ≠ 2) (a n : zmod p) := ∃ x : ℕ, a ≡ x^2 [ZMOD n]

attribute [instance, priority 0] classical.prop_decidable
noncomputable definition legendre_sym {p : ℤ} (a : ℤ) (H1 : prime_int p ∧ (int.nat_abs p) ≠ 2) : ℤ :=
if quadratic_res a p ∧ ¬ ((p : ℤ) ∣ a) then 1 else
if ¬ quadratic_res a p then -1
else 0

theorem law_of_quadratic_reciprocity {p q : ℤ} (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) (hq : prime_int q ∧ (int.nat_abs q) ≠ 2) : (legendre_sym p hq)*(legendre_sym q hp) = (-1)^(int.nat_abs(((p-1)/2)*((q-1)/2))) := sorry

theorem law_of_quadratic_reciprocity' {p q : ℤ} (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) (hq : prime_int q ∧ (int.nat_abs q) ≠ 2) : (legendre_sym p hq) = (legendre_sym q hp) * (-1)^(int.nat_abs(((p-1)/2)*((q-1)/2))):= sorry

theorem legendre_sym_mul {p : ℤ} (a b : ℤ) (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) : legendre_sym (a*b) hp = (legendre_sym a hp)*(legendre_sym b hp) := sorry

theorem legendre_sym_refl {p : ℤ} (a b : ℤ) (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) :  (a ≡ b [ZMOD p] → legendre_sym a hp = legendre_sym b hp) := sorry

theorem LQR_supplementary_2 {p : ℤ} (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) : legendre_sym 2 hp = (-1:ℤ)^(int.nat_abs((p^2-1)/8)) := sorry

theorem legendre_one {p : ℤ} (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) : legendre_sym 1 hp = 1 := sorry

theorem legendre_neg_one {p : ℤ} (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) : legendre_sym (-1) hp = (-1)^(int.nat_abs((p-1)/2)) := sorry

theorem pow_two_eq_mul_self (x : ℕ) : x^2 = x * x := begin show 1*x*x=x*x,rw one_mul end

theorem factorization_x_square_minus_one(x : ℕ) : x^2-1 = (x+1)*(x-1):= begin
  rw pow_two_eq_mul_self,
  cases x with t,
  norm_num,
  show (t+1) * (t+1) - 1 = (succ t + 1) * t,
  ring,
end

--theorem num_of_quad_res {p : ℕ} (hp : prime_int p ∧ p ≠ 2) : ∃ (A : set ℕ) [finset A], ∀ x : [1, (p-1)], (legendre_sym x hp = 1 ↔ x ∈ A) ∧ finset.card A = (p-1)/2

lemma int.mod_two_eq_zero_or_one (n : ℤ): n % 2 = 0 ∨ n % 2 = 1 :=
have h: n % 2 < 2 := abs_of_nonneg (show (2 : ℤ) ≥ 0, from dec_trivial) ▸
int.mod_lt _ dec_trivial,
have h1 : n % 2 ≥ 0 := int.mod_nonneg _ dec_trivial,
match (n % 2), h, h1 with
| (0 : ℕ) := λ _ _, or.inl rfl
| (1 : ℕ) := λ _ _, or.inr rfl
| (k+2 : ℕ) := λ h _, absurd h dec_trivial
|(-[1+ a]) := λ _ h1, absurd h1 dec_trivial
end

lemma int.modeq.mod_modeq : ∀ (a n : ℤ), a % n ≡ a [ZMOD (int.nat_abs n)] := sorry

lemma int.add_sub_cancel_left (n m : ℤ) : n + m - n = m := add_sub_cancel' n m

lemma yet_to_prove (x : ℤ) (p : ℤ) (hp : prime_int p ∧ int.nat_abs p ≠ 2) : (x ^ int.nat_abs (p - 1)) = (int.nat_abs x) ^ (int.nat_abs p - 1)  := sorry

lemma odd_prime_int_is_odd {p : ℤ} (hp : prime_int p ∧ int.nat_abs p ≠ 2) : p % 2 = 1 :=
begin
unfold prime_int at hp,
have h1 : ¬ (p % 2  = 0),
begin
  unfold prime at hp,
  intro,
  have h2 := int.dvd_of_mod_eq_zero a,
  have h3 := int.dvd_nat_abs.2 h2,
  have h4 : 2 ∣ (int.nat_abs p), from int.coe_nat_dvd.1 h3,
  have h5 := hp.1.2 2 h4,
  have h6 := or_iff_not_imp_left.1 h5 (show ¬ 2=1, by norm_num),
  have h7 : ¬ 2 = int.nat_abs p, rw eq_comm,
  exact hp.2,
  contradiction,
end,
have h2 : (p % 2 = 0) ∨ (p % 2 = 1), from int.mod_two_eq_zero_or_one p,
exact or_iff_not_imp_left.1 h2 h1,
end

lemma p_minus_one_over_two (p : ℤ) (q : 2 ∣ int.nat_abs (p - 1)) :
int.nat_abs ((p - 1) / 2) = int.nat_abs (p - 1) / 2 :=
begin
  cases q with d hd,
  have H : ∃ e, (p - 1) = 2 * e,
  cases (int.nat_abs_eq (p - 1)),
    existsi (d : ℤ),
    rw [h,hd],
    refl,
  existsi (- (d : ℤ)),
    rw [h,hd],
  rw int.coe_nat_mul,
  rw mul_neg_eq_neg_mul_symm,refl,

  cases H with e He,
  rw He,
  rw int.nat_abs_mul,
  rw int.mul_div_cancel_left,
  show _ = 2 * _ / _,
  rw nat.mul_div_cancel_left,
  exact dec_trivial,
  exact dec_trivial,
end

lemma two_dvd_p_minus_one {p : ℤ} (hp: prime_int p ∧ int.nat_abs p ≠ 2) : 2 ∣ int.nat_abs (p-1) :=
begin
  cases nat.mod_two_eq_zero_or_one (int.nat_abs p),
  have : (int.nat_abs p) % 2 ≡ int.nat_abs p [MOD 2], from nat.modeq.mod_modeq (int.nat_abs p) 2,
  have : 0 ≡ int.nat_abs p [MOD 2], from eq.subst h this,
  have : int.nat_abs p ≡ 0 [MOD 2], from nat.modeq.symm this,
  rw ← nat.modeq.modeq_zero_iff,
  exfalso,
  have h1 := hp.1.2 _ (nat.modeq.modeq_zero_iff.1 this),
  cases h1 with h3 h4,
  have h2: 2 ≠ 1, by norm_num,
  exact h2 h3,
  exact hp.2.symm h4,
  rw ← int.coe_nat_dvd,
  rw int.dvd_nat_abs,
  rw ← int.mod_add_div p 2,
  have : p % 2 = 1, from odd_prime_int_is_odd hp,
  rw this, rw int.add_sub_cancel_left,
  have r: 2 ≠ 0, by norm_num,
  exact dvd_mul_right _ _,
end

theorem euler_c_1 (a p : ℤ) (hp : prime_int p ∧ int.nat_abs p ≠ 2) (ha : ¬ p ∣ a) : quadratic_res a p → a^int.nat_abs((p-1)/2) ≡ 1 [ZMOD (int.nat_abs p)] :=
begin
intro Hqr,
cases Hqr with x hx,
haveI : prime_int p := hp.1,
haveI : pos_nat(int.nat_abs p) := sorry,
rw ← zmod.eq_iff_modeq_int,
rw ← zmod.eq_iff_modeq_int at hx,
have q: 2 ∣ int.nat_abs(p-1), from two_dvd_p_minus_one hp,
have h5 : int.nat_abs ((p-1)/2) = (int.nat_abs (p-1))/2, from p_minus_one_over_two p q,
rw int.cast_pow, rw hx, rw int.cast_pow, rw ← pow_mul, rw h5, rw nat.mul_div_cancel' q,
have h : prime (int.nat_abs p),{unfold prime_int at _inst; exact _inst},
have h1 : (int.nat_abs x)^((int.nat_abs p) -1) ≡ 1 [MOD (int.nat_abs p)], from fermat_little_theorem_extension (int.nat_abs x) (int.nat_abs p) h,
have h2 : ↑(int.nat_abs x ^ (int.nat_abs p - 1)) ≡ ↑1 [ZMOD ↑(int.nat_abs p)], from int.modeq.coe_nat_modeq_iff.2 h1,
have h3 : ↑(↑(int.nat_abs x ^ (int.nat_abs p - 1))) = ↑1, from zmod.eq_iff_modeq_int.2 h2,
rw ← int.cast_pow,
simp at h3,
rw yet_to_prove _ _ hp,
simp [h3],
end

lemma euler_c_2 (a p : ℤ) (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) (ha : ¬ p ∣ a) : ¬ (quadratic_res a p) → a^int.nat_abs((p-1)/2) ≡ -1 [ZMOD (int.nat_abs p)] := sorry

theorem euler_criterion (p : ℤ) (a : ℤ) (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) (ha : ¬ p ∣ a) :
  a^int.nat_abs((p - 1) / 2) ≡ legendre_sym a hp [ZMOD (int.nat_abs p)] :=
begin
  unfold legendre_sym,
  split_ifs,
  exact euler_c_1 a p hp ha h.1,
  exfalso,
  have h8 : ¬quadratic_res a p, from not_and'.1 h (show ¬p ∣ a, from ha),
  from absurd h_1 h8,
  exact euler_c_2 a p hp ha h_1,
end

theorem not_prime_int_one : ¬(prime_int 1) :=
by unfold prime_int; exact dec_trivial

theorem LQR_supplementary_1 {p : ℤ} (hp : prime_int p ∧ (int.nat_abs p) ≠ 2) (hpp : p ≥ 0): legendre_sym (-1:ℤ) hp = (-1:ℤ)^int.nat_abs((p-1)/2) :=
begin
have h1 : ¬ ((p:ℤ)∣(-1:ℤ)),
{
  intro h,
  have h2 : p = 1, from int.eq_one_of_dvd_one hpp (show ((p:ℤ)∣1), from int.dvd_nat_abs.2 h),
  exact not_prime_int_one (show prime_int 1, from eq.subst h2 hp.1),
},
have h3 : (-1)^int.nat_abs((p - 1) / 2) ≡ legendre_sym (-1) hp [ZMOD (int.nat_abs p)] , from euler_criterion p (-1) hp h1,
haveI : pos_nat(int.nat_abs p) := sorry,
have h4:= zmod.eq_iff_modeq_int.2 h3,
rw eq_comm,
--exact ((int.coe_nat_eq_coe_nat_iff ((-1) ^ int.nat_abs ((p - 1) / 2)) (legendre_sym (-1) hp)).2 eq.symm(zmod.eq_iff_modeq_int.2 h6)),
sorry,
end

#check int.coe_nat_eq
#check int.coe_nat_eq_coe_nat_iff
--theorem Jason_and_partly_Guy_did_it {p : ℕ} (hp : prime_int p ∧ p ≠ 2) : ∃ A : finset (zmod p), ∀ a : zmod p, (quadratic_res' a p ↔ a ∈ A) ∧ finset.card A = (p-1)/2 := sorry
#check zmod.eq_iff_modeq_int
theorem Guy_suggested_this_but_i_am_not_sure {p : ℕ} (hp : prime_int p ∧ p ≠ 2) : ∃ A : finset ℕ, ∀ a : ℕ, (¬quadratic_res a p ↔ a ∈ A) ∧ finset.card A = (p-1)/2 := sorry
--Let p be an odd prime_int. Then there are exactly (p - 1) /2 quadratic residues modulo p and exactly (p - 1) /2 nonresidues modulo p.
--theorem quad_res_sol {p : ℕ} (hp : prime_int p) :

theorem minus_one_quad_res_of_p {p : ℕ} (hp : prime_int p ∧ p ≠ 2) : (p ≡ 1 [MOD 4] ↔ legendre_sym (-1 : ℤ) hp = 1) ∧ (p ≡ 3 [MOD 4] ↔ legendre_sym (-1 : ℤ) hp = (-1 : ℤ)) := sorry

theorem quad_res_two (n : ℕ) : n % 8 = 1 ∨ n % 8 = 7 → ((n ^ 2 - 1) / 8 % 2 = 0) :=
begin
  intro H,
  have H2 := nat.mod_add_div n 8,
  cases H,
  { rw H at H2,
    rw ←H2,
    rw ←nat.dvd_iff_mod_eq_zero,
    suffices : ∀ t, 2 ∣ ((1 + 8 * t) ^ 2 - 1) / 8,
      exact this (n/8),
    intro t,
    existsi t+4*t*t,
    show (1 * (1 + 8 * t) * (1 + 8 * t) - 1) / 8 = 2 * (t + 4 * t * t),
    rw (show 1 * (1 + 8 * t) * (1 + 8 * t) = 8 * (2 * t + 8 * t * t) + 1, by ring),
    rw nat.add_sub_cancel,
    rw nat.mul_div_cancel_left _ (show 8 > 0, from dec_trivial),
    ring
  },
  { rw H at H2,
    rw ←H2,
    rw ←nat.dvd_iff_mod_eq_zero,
    suffices : ∀ t, 2 ∣ ((7 + 8 * t) ^ 2 - 1) / 8,
      exact this (n/8),
    intro t,
    existsi 3+7*t+4*t*t,
    show (1 * (7 + 8 * t) * (7 + 8 * t) - 1) / 8 = 2 * (3 + 7 * t + 4 * t * t),
    rw (show 1 * (7 + 8 * t) * (7 + 8 * t) = 8 * (6 + 14 * t + 8 * t * t) + 1, by ring),
    rw nat.add_sub_cancel,
    rw nat.mul_div_cancel_left _ (show 8 > 0, from dec_trivial),
    ring
  }
end

theorem quad_nonres_two (n : ℕ) : n % 8 = 3 ∨ n % 8 = 5 → ((n ^ 2 - 1) / 8 % 2 = 1) :=
begin
  intro H,
  have H2 := nat.mod_add_div n 8,
  cases H,
  { rw H at H2,
    rw ←H2,
    suffices : ∀ t : ℕ, ((3 + 8 * t) ^ 2 - 1) / 8 % 2 = 1,
      exact this (n/8),
    intro t,
    have H3 : (1 + 2 * (4*t^2 + 3*t)) % 2 = 1,
      rw nat.add_mul_mod_self_left,exact dec_trivial,
    suffices : ((3 + 8 * t) ^ 2 - 1) / 8 = (1 + 2 * (4 * t ^ 2 + 3 * t)),
      rwa this,
    suffices : ((3 + 8 * t) ^ 2 - 1) = 8 * (1 + 2 * (4 * t ^ 2 + 3 * t)),
      rw this,
    rw nat.mul_div_cancel_left _ (show 8 > 0, from dec_trivial),
    ring
  },
  { rw H at H2,
    rw ←H2,
    suffices : ∀ t : ℕ, ((5 + 8 * t) ^ 2 - 1) / 8 % 2 = 1,
      exact this (n/8),
    intro t,
    have H3 : (1 + 2 * (4*t^2 + 5*t + 1)) % 2 = 1,
      rw nat.add_mul_mod_self_left,exact dec_trivial,
    suffices : ((5 + 8 * t) ^ 2 - 1) / 8 = (1 + 2 * (4 * t ^ 2 + 5 * t + 1)),
      rwa this,
    suffices : ((5 + 8 * t) ^ 2 - 1) = 8 * (1 + 2 * (4 * t ^ 2 + 5 * t + 1)),
      rw this,
    rw nat.mul_div_cancel_left _ (show 8 > 0, from dec_trivial),
    ring
  }
end

theorem quad_res_two_int (n : ℤ) : n % 8 = (1:ℤ) ∨ n % 8 = (7:ℤ) → ((n ^ 2 - 1) / 8 % 2 = (0:ℤ)) :=
begin
  intro H,
  have H2 := int.mod_add_div n 8,
  cases H,
  { rw H at H2,
     rw ←H2,
     rw ←int.dvd_iff_mod_eq_zero,
     suffices : ∀ t, (2:ℤ) ∣ ((1 + 8 * t) ^ 2 - 1) / (8:ℤ),
        exact this (n/(8:ℤ)),
    intro t,
    existsi t+4*t*t,
    unfold has_pow.pow, unfold monoid.pow,
    rw (show (1 + 8 * t) * ((1 + 8 * t) * 1)= 8 * (2 * t + 8 * t * t) + 1, by ring),
    rw add_sub_cancel,
    rw int.mul_div_cancel_left _ (show (8:ℤ) ≠ 0, from dec_trivial),
    ring
  },
  { rw H at H2,
    rw ←H2,
    rw ←int.dvd_iff_mod_eq_zero,
    suffices : ∀ t, (2:ℤ) ∣ ((7 + 8 * t) ^ 2 - 1) / 8,
      exact this (n/(8:ℤ)),
    intro t,
    existsi 3+7*t+4*t*t,
    unfold has_pow.pow, unfold monoid.pow,
    rw (show (7 + 8 * t) * ((7 + 8 * t) * 1)  = 8 * (6 + 14 * t + 8 * t * t) + 1, by ring),
    rw add_sub_cancel,
    rw int.mul_div_cancel_left _ (show (8:ℤ) ≠ 0, from dec_trivial),
    ring,
  }
end

theorem quad_nonres_two_int (n : ℤ) : n % 8 = (3:ℤ) ∨ n % 8 = (5:ℤ) → ((n ^ 2 - 1) / 8 % 2 = (1:ℤ)) :=
begin
  intro H,
  have H2 := int.mod_add_div n (8:ℤ),
  cases H,
  { rw H at H2,
    rw ←H2,
     suffices : ∀ t : ℤ, ((3 + 8 * t) ^ 2 - 1) / 8 % 2 = (1:ℤ),
       exact this (n/(8:ℤ)),
     intro t,
     have H3 : (1 + 2 * (4*t^2 + 3*t)) % 2 = (1:ℤ),
       rw int.add_mul_mod_self_left,exact dec_trivial,
     suffices : ((3 + 8 * t) ^ 2 - 1) / 8 = (1 + 2 * (4 * t ^ 2 + 3 * t)),
       rwa this,
     suffices : ((3 + 8 * t) ^ 2 - 1) = 8 * (1 + 2 * (4 * t ^ 2 + 3 * t)),
       rw this,
     rw int.mul_div_cancel_left _ (show (8:ℤ) ≠ 0, from dec_trivial),
     ring
  },
   { rw H at H2,
     rw ←H2,
     suffices : ∀ t : ℤ, ((5 + 8 * t) ^ 2 - 1) / 8 % 2 = (1:ℤ),
       exact this (n/(8:ℤ)),
     intro t,
     have H3 : (1 + 2 * (4*t^2 + 5*t + 1)) % 2 = 1,
       rw int.add_mul_mod_self_left,exact dec_trivial,
     suffices : ((5 + 8 * t) ^ 2 - 1) / 8 = (1 + 2 * (4 * t ^ 2 + 5 * t + 1)),
       rwa this,
     suffices : ((5 + 8 * t) ^ 2 - 1) = 8 * (1 + 2 * (4 * t ^ 2 + 5 * t + 1)),
       rw this,
     rw int.mul_div_cancel_left _ (show (8:ℤ) ≠ 0, from dec_trivial),
     ring
   }
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finsupp.basic
import Mathlib.algebra.ordered_group
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4

namespace Mathlib

/-!
# Lattice structure on finsupps

This file provides instances of ordered structures on finsupps.

-/

namespace finsupp

protected instance order_bot {α : Type u_1} {μ : Type u_3} [canonically_ordered_add_monoid μ] : order_bot (α →₀ μ) :=
  order_bot.mk 0 partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance semilattice_inf {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_inf β] : semilattice_inf (α →₀ β) :=
  semilattice_inf.mk (zip_with has_inf.inf sorry) partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

@[simp] theorem inf_apply {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_inf β] {a : α} {f : α →₀ β} {g : α →₀ β} : coe_fn (f ⊓ g) a = coe_fn f a ⊓ coe_fn g a :=
  rfl

@[simp] theorem support_inf {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ] {f : α →₀ γ} {g : α →₀ γ} : support (f ⊓ g) = support f ∩ support g := sorry

protected instance semilattice_sup {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_sup β] : semilattice_sup (α →₀ β) :=
  semilattice_sup.mk (zip_with has_sup.sup sorry) partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

@[simp] theorem sup_apply {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_sup β] {a : α} {f : α →₀ β} {g : α →₀ β} : coe_fn (f ⊔ g) a = coe_fn f a ⊔ coe_fn g a :=
  rfl

@[simp] theorem support_sup {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ] {f : α →₀ γ} {g : α →₀ γ} : support (f ⊔ g) = support f ∪ support g := sorry

protected instance lattice {α : Type u_1} {β : Type u_2} [HasZero β] [lattice β] : lattice (α →₀ β) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance semilattice_inf_bot {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ] : semilattice_inf_bot (α →₀ γ) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry lattice.inf sorry sorry sorry

theorem bot_eq_zero {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ] : ⊥ = 0 :=
  rfl

theorem disjoint_iff {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ] {x : α →₀ γ} {y : α →₀ γ} : disjoint x y ↔ disjoint (support x) (support y) := sorry

/-- The order on `finsupp`s over a partial order embeds into the order on functions -/
def order_embedding_to_fun {α : Type u_1} {β : Type u_2} [HasZero β] [partial_order β] : (α →₀ β) ↪o (α → β) :=
  rel_embedding.mk (function.embedding.mk (fun (f : α →₀ β) (a : α) => coe_fn f a) sorry) sorry

@[simp] theorem order_embedding_to_fun_apply {α : Type u_1} {β : Type u_2} [HasZero β] [partial_order β] {f : α →₀ β} {a : α} : coe_fn order_embedding_to_fun f a = coe_fn f a :=
  rfl

theorem monotone_to_fun {α : Type u_1} {β : Type u_2} [HasZero β] [partial_order β] : monotone to_fun :=
  fun (f g : α →₀ β) (h : f ≤ g) (a : α) => iff.mp le_def h a