/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Aaron Anderson, Yakov Pechersky
-/
import data.finset.card
import data.fintype.basic
import group_theory.perm.basic

/-!
# Support of a permutation

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

## Main definitions

In the following, `f g : equiv.perm α`.

* `equiv.perm.disjoint`: two permutations `f` and `g` are `disjoint` if every element is fixed
  either by `f`, or by `g`.
  Equivalently, `f` and `g` are `disjoint` iff their `support` are disjoint.
* `equiv.perm.is_swap`: `f = swap x y` for `x ≠ y`.
* `equiv.perm.support`: the elements `x : α` that are not fixed by `f`.

-/

open equiv finset

namespace equiv.perm

variables {α : Type*}
section disjoint

/-- Two permutations `f` and `g` are `disjoint` if their supports are disjoint, i.e.,
every element is fixed either by `f`, or by `g`. -/
def disjoint (f g : perm α) := ∀ x, f x = x ∨ g x = x

variables {f g h : perm α}

@[symm] lemma disjoint.symm : disjoint f g → disjoint g f :=
by simp only [disjoint, or.comm, imp_self]

lemma disjoint.symmetric : symmetric (@disjoint α) :=
λ _ _, disjoint.symm

instance : is_symm (perm α) disjoint := ⟨disjoint.symmetric⟩

lemma disjoint_comm : disjoint f g ↔ disjoint g f :=
⟨disjoint.symm, disjoint.symm⟩

lemma disjoint.commute (h : disjoint f g) : commute f g :=
equiv.ext $ λ x, (h x).elim
  (λ hf, (h (g x)).elim (λ hg, by simp [mul_apply, hf, hg])
    (λ hg, by simp [mul_apply, hf, g.injective hg]))
  (λ hg, (h (f x)).elim (λ hf, by simp [mul_apply, f.injective hf, hg])
    (λ hf, by simp [mul_apply, hf, hg]))

@[simp] lemma disjoint_one_left (f : perm α) : disjoint 1 f := λ _, or.inl rfl

@[simp] lemma disjoint_one_right (f : perm α) : disjoint f 1 := λ _, or.inr rfl

lemma disjoint_iff_eq_or_eq : disjoint f g ↔ ∀ (x : α), f x = x ∨ g x = x := iff.rfl

@[simp] lemma disjoint_refl_iff : disjoint f f ↔ f = 1 :=
begin
  refine ⟨λ h, _, λ h, h.symm ▸ disjoint_one_left 1⟩,
  ext x,
  cases h x with hx hx;
  simp [hx]
end

lemma disjoint.inv_left (h : disjoint f g) : disjoint f⁻¹ g :=
begin
  intro x,
  rw [inv_eq_iff_eq, eq_comm],
  exact h x
end

lemma disjoint.inv_right (h : disjoint f g) : disjoint f g⁻¹ :=
h.symm.inv_left.symm

@[simp] lemma disjoint_inv_left_iff : disjoint f⁻¹ g ↔  disjoint f g :=
begin
  refine ⟨λ h, _, disjoint.inv_left⟩,
  convert h.inv_left,
  exact (inv_inv _).symm
end

@[simp] lemma disjoint_inv_right_iff : disjoint f g⁻¹ ↔ disjoint f g :=
by rw [disjoint_comm, disjoint_inv_left_iff, disjoint_comm]

lemma disjoint.mul_left (H1 : disjoint f h) (H2 : disjoint g h) :
  disjoint (f * g) h :=
λ x, by cases H1 x; cases H2 x; simp *

lemma disjoint.mul_right (H1 : disjoint f g) (H2 : disjoint f h) :
  disjoint f (g * h) :=
by { rw disjoint_comm, exact H1.symm.mul_left H2.symm }

lemma disjoint_prod_right (l : list (perm α))
  (h : ∀ g ∈ l, disjoint f g) : disjoint f l.prod :=
begin
  induction l with g l ih,
  { exact disjoint_one_right _ },
  { rw list.prod_cons,
    exact (h _ (list.mem_cons_self _ _)).mul_right (ih (λ g hg, h g (list.mem_cons_of_mem _ hg))) }
end

lemma disjoint_prod_perm {l₁ l₂ : list (perm α)} (hl : l₁.pairwise disjoint)
  (hp : l₁ ~ l₂) : l₁.prod = l₂.prod :=
hp.prod_eq' $ hl.imp $ λ f g, disjoint.commute

lemma pow_apply_eq_self_of_apply_eq_self {x : α} (hfx : f x = x) :
  ∀ n : ℕ, (f ^ n) x = x
| 0     := rfl
| (n+1) := by rw [pow_succ', mul_apply, hfx, pow_apply_eq_self_of_apply_eq_self]

lemma zpow_apply_eq_self_of_apply_eq_self {x : α} (hfx : f x = x) :
  ∀ n : ℤ, (f ^ n) x = x
| (n : ℕ) := pow_apply_eq_self_of_apply_eq_self hfx n
| -[1+ n] := by rw [zpow_neg_succ_of_nat, inv_eq_iff_eq, pow_apply_eq_self_of_apply_eq_self hfx]

lemma pow_apply_eq_of_apply_apply_eq_self {x : α} (hffx : f (f x) = x) :
  ∀ n : ℕ, (f ^ n) x = x ∨ (f ^ n) x = f x
| 0     := or.inl rfl
| (n+1) := (pow_apply_eq_of_apply_apply_eq_self n).elim
  (λ h, or.inr (by rw [pow_succ, mul_apply, h]))
  (λ h, or.inl (by rw [pow_succ, mul_apply, h, hffx]))

lemma zpow_apply_eq_of_apply_apply_eq_self {x : α} (hffx : f (f x) = x) :
  ∀ i : ℤ, (f ^ i) x = x ∨ (f ^ i) x = f x
| (n : ℕ) := pow_apply_eq_of_apply_apply_eq_self hffx n
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_eq_iff_eq, ← f.injective.eq_iff, ← mul_apply,
    ← pow_succ, eq_comm, inv_eq_iff_eq, ← mul_apply, ← pow_succ', @eq_comm _ x, or.comm],
  exact pow_apply_eq_of_apply_apply_eq_self hffx _ }

lemma disjoint.mul_apply_eq_iff {σ τ : perm α} (hστ : disjoint σ τ) {a : α} :
  (σ * τ) a = a ↔ σ a = a ∧ τ a = a :=
begin
  refine ⟨λ h, _, λ h, by rw [mul_apply, h.2, h.1]⟩,
  cases hστ a with hσ hτ,
  { exact ⟨hσ, σ.injective (h.trans hσ.symm)⟩ },
  { exact ⟨(congr_arg σ hτ).symm.trans h, hτ⟩ },
end

lemma disjoint.mul_eq_one_iff {σ τ : perm α} (hστ : disjoint σ τ) :
  σ * τ = 1 ↔ σ = 1 ∧ τ = 1 :=
by simp_rw [ext_iff, one_apply, hστ.mul_apply_eq_iff, forall_and_distrib]

lemma disjoint.zpow_disjoint_zpow {σ τ : perm α} (hστ : disjoint σ τ) (m n : ℤ) :
  disjoint (σ ^ m) (τ ^ n) :=
λ x, or.imp (λ h, zpow_apply_eq_self_of_apply_eq_self h m)
  (λ h, zpow_apply_eq_self_of_apply_eq_self h n) (hστ x)

lemma disjoint.pow_disjoint_pow {σ τ : perm α} (hστ : disjoint σ τ) (m n : ℕ) :
  disjoint (σ ^ m) (τ ^ n) :=
hστ.zpow_disjoint_zpow m n

end disjoint

section is_swap

variable [decidable_eq α]

/-- `f.is_swap` indicates that the permutation `f` is a transposition of two elements. -/
def is_swap (f : perm α) : Prop := ∃ x y, x ≠ y ∧ f = swap x y

@[simp] lemma of_subtype_swap_eq {p : α → Prop} [decidable_pred p]
  (x y : subtype p) :
  (equiv.swap x y).of_subtype = equiv.swap ↑x ↑y :=
equiv.ext $ λ z, begin
  by_cases hz : p z,
  { rw [swap_apply_def, of_subtype_apply_of_mem _ hz],
    split_ifs with hzx hzy,
    { simp_rw [hzx, subtype.coe_eta, swap_apply_left], },
    { simp_rw [hzy, subtype.coe_eta, swap_apply_right], },
    { rw swap_apply_of_ne_of_ne, refl,
      intro h, apply hzx, rw ← h, refl,
      intro h, apply hzy, rw ← h, refl, } },
  { rw [of_subtype_apply_of_not_mem _ hz, swap_apply_of_ne_of_ne],
    intro h, apply hz, rw h, exact subtype.prop x,
    intro h, apply hz, rw h, exact subtype.prop y, }
end

lemma is_swap.of_subtype_is_swap {p : α → Prop} [decidable_pred p]
  {f : perm (subtype p)} (h : f.is_swap) : (of_subtype f).is_swap :=
let ⟨⟨x, hx⟩, ⟨y, hy⟩, hxy⟩ := h in
⟨x, y, by { simp only [ne.def] at hxy, exact hxy.1 },
  by { simp only [hxy.2, of_subtype_swap_eq], refl, }⟩

lemma ne_and_ne_of_swap_mul_apply_ne_self {f : perm α} {x y : α}
  (hy : (swap x (f x) * f) y ≠ y) : f y ≠ y ∧ y ≠ x :=
begin
  simp only [swap_apply_def, mul_apply, f.injective.eq_iff] at *,
  by_cases h : f y = x,
  { split; intro; simp only [*, if_true, eq_self_iff_true, not_true, ne.def] at * },
  { split_ifs at hy; cc }
end

end is_swap

section support

section set

variables (p q : perm α)

lemma set_support_inv_eq :
  {x | p⁻¹ x ≠ x} = {x | p x ≠ x} :=
begin
  ext x,
  simp only [set.mem_set_of_eq, ne.def],
  rw [inv_def, symm_apply_eq, eq_comm]
end

lemma set_support_apply_mem {p : perm α} {a : α} :
  p a ∈ {x | p x ≠ x} ↔ a ∈ {x | p x ≠ x} :=
by simp

lemma set_support_zpow_subset (n : ℤ) :
  {x | (p ^ n) x ≠ x} ⊆ {x | p x ≠ x} :=
begin
  intros x,
  simp only [set.mem_set_of_eq, ne.def],
  intros hx H,
  simpa [zpow_apply_eq_self_of_apply_eq_self H] using hx
end

lemma set_support_mul_subset :
  {x | (p * q) x ≠ x} ⊆ {x | p x ≠ x} ∪ {x | q x ≠ x} :=
begin
  intro x,
  simp only [perm.coe_mul, function.comp_app, ne.def, set.mem_union, set.mem_set_of_eq],
  by_cases hq : q x = x;
  simp [hq]
end

end set

variables [decidable_eq α] [fintype α] {f g : perm α}

/-- The `finset` of nonfixed points of a permutation. -/
def support (f : perm α) : finset α := univ.filter (λ x, f x ≠ x)

@[simp] lemma mem_support {x : α} : x ∈ f.support ↔ f x ≠ x :=
by rw [support, mem_filter, and_iff_right (mem_univ x)]

lemma not_mem_support {x : α} : x ∉ f.support ↔ f x = x := by simp

lemma coe_support_eq_set_support (f : perm α) :
  (f.support : set α) = {x | f x ≠ x} :=
by { ext, simp }

@[simp] lemma support_eq_empty_iff {σ : perm α} : σ.support = ∅ ↔ σ = 1 :=
by simp_rw [finset.ext_iff, mem_support, finset.not_mem_empty, iff_false, not_not,
  equiv.perm.ext_iff, one_apply]

@[simp] lemma support_one : (1 : perm α).support = ∅ :=
by rw support_eq_empty_iff

@[simp] lemma support_refl : support (equiv.refl α) = ∅ := support_one

lemma support_congr (h : f.support ⊆ g.support)
  (h' : ∀ x ∈ g.support, f x = g x) : f = g :=
begin
  ext x,
  by_cases hx : x ∈ g.support,
  { exact h' x hx },
  { rw [not_mem_support.mp hx, ←not_mem_support],
    exact λ H, hx (h H) }
end

lemma support_mul_le (f g : perm α) :
  (f * g).support ≤ f.support ⊔ g.support :=
λ x, begin
  rw [sup_eq_union, mem_union, mem_support, mem_support,
    mem_support, mul_apply, ←not_and_distrib, not_imp_not],
  rintro ⟨hf, hg⟩,
  rw [hg, hf]
end

lemma exists_mem_support_of_mem_support_prod {l : list (perm α)} {x : α}
  (hx : x ∈ l.prod.support) :
  ∃ f : perm α, f ∈ l ∧ x ∈ f.support :=
begin
  contrapose! hx,
  simp_rw [mem_support, not_not] at hx ⊢,
  induction l with f l ih generalizing hx,
  { refl },
  { rw [list.prod_cons, mul_apply, ih (λ g hg, hx g (or.inr hg)), hx f (or.inl rfl)] },
end

lemma support_pow_le (σ : perm α) (n : ℕ) :
  (σ ^ n).support ≤ σ.support :=
λ x h1, mem_support.mpr (λ h2, mem_support.mp h1 (pow_apply_eq_self_of_apply_eq_self h2 n))

@[simp] lemma support_inv (σ : perm α) : support (σ⁻¹) = σ.support :=
by simp_rw [finset.ext_iff, mem_support, not_iff_not,
  (inv_eq_iff_eq).trans eq_comm, iff_self, imp_true_iff]

@[simp]
lemma apply_mem_support {x : α} :
  f x ∈ f.support ↔ x ∈ f.support :=
by rw [mem_support, mem_support, ne.def, ne.def, not_iff_not, apply_eq_iff_eq]

@[simp]
lemma pow_apply_mem_support {n : ℕ} {x : α} :
  (f ^ n) x ∈ f.support ↔ x ∈ f.support :=
begin
  induction n with n ih,
  { refl },
  rw [pow_succ, perm.mul_apply, apply_mem_support, ih]
end

@[simp]
lemma zpow_apply_mem_support {n : ℤ} {x : α} :
  (f ^ n) x ∈ f.support ↔ x ∈ f.support :=
begin
  cases n,
  { rw [int.of_nat_eq_coe, zpow_coe_nat, pow_apply_mem_support] },
  { rw [zpow_neg_succ_of_nat, ← support_inv, ← inv_pow, pow_apply_mem_support] }
end

lemma pow_eq_on_of_mem_support (h : ∀ (x ∈ f.support ∩ g.support), f x = g x)
  (k : ℕ) : ∀ (x ∈ f.support ∩ g.support), (f ^ k) x = (g ^ k) x :=
begin
  induction k with k hk,
  { simp },
  { intros x hx,
    rw [pow_succ', mul_apply, pow_succ', mul_apply, h _ hx, hk],
    rwa [mem_inter, apply_mem_support, ←h _ hx, apply_mem_support, ←mem_inter] }
end

lemma disjoint_iff_disjoint_support :
  disjoint f g ↔ _root_.disjoint f.support g.support :=
by simp [disjoint_iff_eq_or_eq, disjoint_iff, finset.ext_iff, not_and_distrib]

lemma disjoint.disjoint_support (h : disjoint f g) :
  _root_.disjoint f.support g.support :=
disjoint_iff_disjoint_support.1 h

lemma disjoint.support_mul (h : disjoint f g) :
  (f * g).support = f.support ∪ g.support :=
begin
  refine le_antisymm (support_mul_le _ _) (λ a, _),
  rw [mem_union, mem_support, mem_support, mem_support, mul_apply, ←not_and_distrib, not_imp_not],
  exact (h a).elim (λ hf h, ⟨hf, f.apply_eq_iff_eq.mp (h.trans hf.symm)⟩)
    (λ hg h, ⟨(congr_arg f hg).symm.trans h, hg⟩),
end

lemma support_prod_of_pairwise_disjoint (l : list (perm α)) (h : l.pairwise disjoint) :
  l.prod.support = (l.map support).foldr (⊔) ⊥ :=
begin
  induction l with hd tl hl,
  { simp },
  { rw [list.pairwise_cons] at h,
    have : disjoint hd tl.prod := disjoint_prod_right _ h.left,
    simp [this.support_mul, hl h.right] }
end

lemma support_prod_le (l : list (perm α)) :
  l.prod.support ≤ (l.map support).foldr (⊔) ⊥ :=
begin
  induction l with hd tl hl,
  { simp },
  { rw [list.prod_cons, list.map_cons, list.foldr_cons],
    refine (support_mul_le hd tl.prod).trans _,
    exact sup_le_sup le_rfl hl }
end

lemma support_zpow_le (σ : perm α) (n : ℤ) :
  (σ ^ n).support ≤ σ.support :=
λ x h1, mem_support.mpr (λ h2, mem_support.mp h1 (zpow_apply_eq_self_of_apply_eq_self h2 n))

@[simp] lemma support_swap {x y : α} (h : x ≠ y) : support (swap x y) = {x, y} :=
begin
  ext z,
  by_cases hx : z = x,
  any_goals { simpa [hx] using h.symm },
  by_cases hy : z = y;
  { simp [swap_apply_of_ne_of_ne, hx, hy]; cc }
end

lemma support_swap_iff (x y : α) :
  support (swap x y) = {x, y} ↔ x ≠ y :=
begin
  refine ⟨λ h H, _, support_swap⟩,
  subst H,
  simp only [swap_self, support_refl, pair_eq_singleton] at h,
  have : x ∈ ∅,
  { rw h,
    exact mem_singleton.mpr rfl },
  simpa
end

lemma support_swap_mul_swap {x y z : α} (h : list.nodup [x, y, z]) :
  support (swap x y * swap y z) = {x, y, z} :=
begin
  simp only [list.not_mem_nil, and_true, list.mem_cons_iff, not_false_iff, list.nodup_cons,
             list.mem_singleton, and_self, list.nodup_nil] at h,
  push_neg at h,
  apply le_antisymm,
  { convert support_mul_le _ _,
    rw [support_swap h.left.left, support_swap h.right],
    ext,
    simp [or.comm, or.left_comm] },
  { intro,
    simp only [mem_insert, mem_singleton],
    rintro (rfl | rfl | rfl | _);
    simp [swap_apply_of_ne_of_ne, h.left.left, h.left.left.symm, h.left.right, h.left.right.symm,
          h.right.symm] }
end

lemma support_swap_mul_ge_support_diff (f : perm α) (x y : α) :
  f.support \ {x, y} ≤ (swap x y * f).support :=
begin
  intro,
  simp only [and_imp, perm.coe_mul, function.comp_app, ne.def, mem_support, mem_insert, mem_sdiff,
             mem_singleton],
  push_neg,
  rintro ha ⟨hx, hy⟩ H,
  rw [swap_apply_eq_iff, swap_apply_of_ne_of_ne hx hy] at H,
  exact ha H
end

lemma support_swap_mul_eq (f : perm α) (x : α) (h : f (f x) ≠ x) :
  (swap x (f x) * f).support = f.support \ {x} :=
begin
  by_cases hx : f x = x,
  { simp [hx, sdiff_singleton_eq_erase, not_mem_support.mpr hx, erase_eq_of_not_mem] },
  ext z,
  by_cases hzx : z = x,
  { simp [hzx] },
  by_cases hzf : z = f x,
  { simp [hzf, hx, h, swap_apply_of_ne_of_ne], },
  by_cases hzfx : f z = x,
  { simp [ne.symm hzx, hzx, ne.symm hzf, hzfx] },
  { simp [ne.symm hzx, hzx, ne.symm hzf, hzfx, f.injective.ne hzx, swap_apply_of_ne_of_ne] }
end

lemma mem_support_swap_mul_imp_mem_support_ne {x y : α}
  (hy : y ∈ support (swap x (f x) * f)) : y ∈ support f ∧ y ≠ x :=
begin
  simp only [mem_support, swap_apply_def, mul_apply, f.injective.eq_iff] at *,
  by_cases h : f y = x,
  { split; intro; simp only [*, if_true, eq_self_iff_true, not_true, ne.def] at * },
  { split_ifs at hy; cc }
end

lemma disjoint.mem_imp (h : disjoint f g) {x : α} (hx : x ∈ f.support) :
  x ∉ g.support :=
disjoint_left.mp h.disjoint_support hx

lemma eq_on_support_mem_disjoint {l : list (perm α)} (h : f ∈ l) (hl : l.pairwise disjoint) :
  ∀ (x ∈ f.support), f x = l.prod x :=
begin
  induction l with hd tl IH,
  { simpa using h },
  { intros x hx,
    rw list.pairwise_cons at hl,
    rw list.mem_cons_iff at h,
    rcases h with rfl|h,
    { rw [list.prod_cons, mul_apply, not_mem_support.mp
          ((disjoint_prod_right tl hl.left).mem_imp hx)] },
    { rw [list.prod_cons, mul_apply, ←IH h hl.right _ hx, eq_comm, ←not_mem_support],
      refine (hl.left _ h).symm.mem_imp _,
      simpa using hx } }
end

lemma disjoint.mono {x y : perm α} (h : disjoint f g)
  (hf : x.support ≤ f.support) (hg : y.support ≤ g.support) :
  disjoint x y :=
begin
  rw disjoint_iff_disjoint_support at h ⊢,
  exact h.mono hf hg,
end

lemma support_le_prod_of_mem {l : list (perm α)} (h : f ∈ l) (hl : l.pairwise disjoint) :
  f.support ≤ l.prod.support :=
begin
  intros x hx,
  rwa [mem_support, ←eq_on_support_mem_disjoint h hl _ hx, ←mem_support],
end

section extend_domain
variables {β : Type*} [decidable_eq β] [fintype β] {p : β → Prop} [decidable_pred p]

@[simp]
lemma support_extend_domain (f : α ≃ subtype p) {g : perm α} :
  support (g.extend_domain f) = g.support.map f.as_embedding :=
begin
  ext b,
  simp only [exists_prop, function.embedding.coe_fn_mk, to_embedding_apply, mem_map, ne.def,
    function.embedding.trans_apply, mem_support],
  by_cases pb : p b,
  { rw [extend_domain_apply_subtype _ _ pb],
    split,
    { rintro h,
      refine ⟨f.symm ⟨b, pb⟩, _, by simp⟩,
      contrapose! h,
      simp [h] },
    { rintro ⟨a, ha, hb⟩,
      contrapose! ha,
      obtain rfl : a = f.symm ⟨b, pb⟩,
      { rw eq_symm_apply,
        exact subtype.coe_injective hb },
      rw eq_symm_apply,
      exact subtype.coe_injective ha } },
  { rw [extend_domain_apply_not_subtype _ _ pb],
    simp only [not_exists, false_iff, not_and, eq_self_iff_true, not_true],
    rintros a ha rfl,
    exact pb (subtype.prop _) }
end

lemma card_support_extend_domain (f : α ≃ subtype p) {g : perm α} :
  (g.extend_domain f).support.card = g.support.card :=
by simp

end extend_domain

section card

@[simp]
lemma card_support_eq_zero {f : perm α} :
  f.support.card = 0 ↔ f = 1 :=
by rw [finset.card_eq_zero, support_eq_empty_iff]

lemma one_lt_card_support_of_ne_one {f : perm α} (h : f ≠ 1) :
  1 < f.support.card :=
begin
  simp_rw [one_lt_card_iff, mem_support, ←not_or_distrib],
  contrapose! h,
  ext a,
  specialize h (f a) a,
  rwa [apply_eq_iff_eq, or_self, or_self] at h,
end

lemma card_support_ne_one (f : perm α) : f.support.card ≠ 1 :=
begin
  by_cases h : f = 1,
  { exact ne_of_eq_of_ne (card_support_eq_zero.mpr h) zero_ne_one },
  { exact ne_of_gt (one_lt_card_support_of_ne_one h) },
end

@[simp] lemma card_support_le_one {f : perm α} : f.support.card ≤ 1 ↔ f = 1 :=
by rw [le_iff_lt_or_eq, nat.lt_succ_iff, le_zero_iff, card_support_eq_zero,
  or_iff_not_imp_right, imp_iff_right f.card_support_ne_one]

lemma two_le_card_support_of_ne_one {f : perm α} (h : f ≠ 1) :
  2 ≤ f.support.card :=
one_lt_card_support_of_ne_one h

lemma card_support_swap_mul {f : perm α} {x : α}
  (hx : f x ≠ x) : (swap x (f x) * f).support.card < f.support.card :=
finset.card_lt_card
  ⟨λ z hz, (mem_support_swap_mul_imp_mem_support_ne hz).left,
    λ h, absurd (h (mem_support.2 hx)) (mt mem_support.1 (by simp))⟩

lemma card_support_swap {x y : α} (hxy : x ≠ y) : (swap x y).support.card = 2 :=
show (swap x y).support.card = finset.card ⟨x ::ₘ y ::ₘ 0, by simp [hxy]⟩,
from congr_arg card $ by simp [support_swap hxy, *, finset.ext_iff]

@[simp]
lemma card_support_eq_two {f : perm α} : f.support.card = 2 ↔ is_swap f :=
begin
  split; intro h,
  { obtain ⟨x, t, hmem, hins, ht⟩ := card_eq_succ.1 h,
    obtain ⟨y, rfl⟩ := card_eq_one.1 ht,
    rw mem_singleton at hmem,
    refine ⟨x, y, hmem, _⟩,
    ext a,
    have key : ∀ b, f b ≠ b ↔ _ := λ b, by rw [←mem_support, ←hins, mem_insert, mem_singleton],
    by_cases ha : f a = a,
    { have ha' := not_or_distrib.mp (mt (key a).mpr (not_not.mpr ha)),
      rw [ha, swap_apply_of_ne_of_ne ha'.1 ha'.2] },
    { have ha' := (key (f a)).mp (mt f.apply_eq_iff_eq.mp ha),
      obtain rfl | rfl := ((key a).mp ha),
      { rw [or.resolve_left ha' ha, swap_apply_left] },
      { rw [or.resolve_right ha' ha, swap_apply_right] } } },
  { obtain ⟨x, y, hxy, rfl⟩ := h,
    exact card_support_swap hxy }
end

lemma disjoint.card_support_mul (h : disjoint f g) :
  (f * g).support.card = f.support.card + g.support.card :=
begin
  rw ←finset.card_disjoint_union,
  { congr,
    ext,
    simp [h.support_mul] },
  { simpa using h.disjoint_support }
end

lemma card_support_prod_list_of_pairwise_disjoint {l : list (perm α)}
  (h : l.pairwise disjoint) :
  l.prod.support.card = (l.map (finset.card ∘ support)).sum :=
begin
  induction l with a t ih,
  { exact card_support_eq_zero.mpr rfl, },
  { obtain ⟨ha, ht⟩ := list.pairwise_cons.1 h,
    rw [list.prod_cons, list.map_cons, list.sum_cons, ←ih ht],
    exact (disjoint_prod_right _ ha).card_support_mul }
end

end card

end support

@[simp] lemma support_subtype_perm [decidable_eq α] {s : finset α} (f : perm α) (h) :
  (f.subtype_perm h : perm {x // x ∈ s}).support = s.attach.filter (λ x, f x ≠ x) :=
by { ext, simp [subtype.ext_iff] }

end equiv.perm


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Eric Wieser
-/

import linear_algebra.quadratic_form.basic

/-!
# Isometries with respect to quadratic forms

## Main definitions

* `quadratic_form.isometry`: `linear_equiv`s which map between two different quadratic forms
* `quadratic_form.equvialent`: propositional version of the above

## Main results

* `equivalent_weighted_sum_squares`: in finite dimensions, any quadratic form is equivalent to a
  parametrization of `quadratic_form.weighted_sum_squares`.
-/

variables {ι R K M M₁ M₂ M₃ V : Type*}

namespace quadratic_form

variables [semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [module R M] [module R M₁] [module R M₂] [module R M₃]

/-- An isometry between two quadratic spaces `M₁, Q₁` and `M₂, Q₂` over a ring `R`,
is a linear equivalence between `M₁` and `M₂` that commutes with the quadratic forms. -/
@[nolint has_inhabited_instance] structure isometry
  (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) extends M₁ ≃ₗ[R] M₂ :=
(map_app' : ∀ m, Q₂ (to_fun m) = Q₁ m)

/-- Two quadratic forms over a ring `R` are equivalent
if there exists an isometry between them:
a linear equivalence that transforms one quadratic form into the other. -/
def equivalent (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) := nonempty (Q₁.isometry Q₂)

namespace isometry

variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}

instance : has_coe (Q₁.isometry Q₂) (M₁ ≃ₗ[R] M₂) := ⟨isometry.to_linear_equiv⟩

@[simp] lemma to_linear_equiv_eq_coe (f : Q₁.isometry Q₂) : f.to_linear_equiv = f := rfl

instance : has_coe_to_fun (Q₁.isometry Q₂) (λ _, M₁ → M₂) := ⟨λ f, ⇑(f : M₁ ≃ₗ[R] M₂)⟩

@[simp] lemma coe_to_linear_equiv (f : Q₁.isometry Q₂) : ⇑(f : M₁ ≃ₗ[R] M₂) = f := rfl

@[simp] lemma map_app (f : Q₁.isometry Q₂) (m : M₁) : Q₂ (f m) = Q₁ m := f.map_app' m

/-- The identity isometry from a quadratic form to itself. -/
@[refl]
def refl (Q : quadratic_form R M) : Q.isometry Q :=
{ map_app' := λ m, rfl,
  .. linear_equiv.refl R M }

/-- The inverse isometry of an isometry between two quadratic forms. -/
@[symm]
def symm (f : Q₁.isometry Q₂) : Q₂.isometry Q₁ :=
{ map_app' := by { intro m, rw ← f.map_app, congr, exact f.to_linear_equiv.apply_symm_apply m },
  .. (f : M₁ ≃ₗ[R] M₂).symm }

/-- The composition of two isometries between quadratic forms. -/
@[trans]
def trans (f : Q₁.isometry Q₂) (g : Q₂.isometry Q₃) : Q₁.isometry Q₃ :=
{ map_app' := by { intro m, rw [← f.map_app, ← g.map_app], refl },
  .. (f : M₁ ≃ₗ[R] M₂).trans (g : M₂ ≃ₗ[R] M₃) }

end isometry

namespace equivalent

variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}

@[refl]
lemma refl (Q : quadratic_form R M) : Q.equivalent Q := ⟨isometry.refl Q⟩

@[symm]
lemma symm (h : Q₁.equivalent Q₂) : Q₂.equivalent Q₁ := h.elim $ λ f, ⟨f.symm⟩

@[trans]
lemma trans (h : Q₁.equivalent Q₂) (h' : Q₂.equivalent Q₃) : Q₁.equivalent Q₃ :=
h'.elim $ h.elim $ λ f g, ⟨f.trans g⟩

end equivalent

variables [fintype ι] {v : basis ι R M}

/-- A quadratic form composed with a `linear_equiv` is isometric to itself. -/
def isometry_of_comp_linear_equiv (Q : quadratic_form R M) (f : M₁ ≃ₗ[R] M) :
  Q.isometry (Q.comp (f : M₁ →ₗ[R] M)) :=
{ map_app' :=
  begin
    intro,
    simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.to_fun_eq_coe,
               linear_equiv.apply_symm_apply, f.apply_symm_apply],
  end,
  .. f.symm }

/-- A quadratic form is isometric to its bases representations. -/
noncomputable def isometry_basis_repr (Q : quadratic_form R M) (v : basis ι R M) :
  isometry Q (Q.basis_repr v) :=
isometry_of_comp_linear_equiv Q v.equiv_fun.symm

variables [field K] [invertible (2 : K)] [add_comm_group V] [module K V]

/-- Given an orthogonal basis, a quadratic form is isometric with a weighted sum of squares. -/
noncomputable def isometry_weighted_sum_squares (Q : quadratic_form K V)
  (v : basis (fin (finite_dimensional.finrank K V)) K V)
  (hv₁ : (associated Q).is_Ortho v) :
  Q.isometry (weighted_sum_squares K (λ i, Q (v i))) :=
begin
  let iso := Q.isometry_basis_repr v,
  refine ⟨iso, λ m, _⟩,
  convert iso.map_app m,
  rw basis_repr_eq_of_is_Ortho _ _ hv₁,
end

variables [finite_dimensional K V]

open bilin_form

lemma equivalent_weighted_sum_squares (Q : quadratic_form K V) :
  ∃ w : fin (finite_dimensional.finrank K V) → K, equivalent Q (weighted_sum_squares K w) :=
let ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q) in
  ⟨_, ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩

lemma equivalent_weighted_sum_squares_units_of_nondegenerate'
  (Q : quadratic_form K V) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank K V) → Kˣ,
    equivalent Q (weighted_sum_squares K w) :=
begin
  obtain ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q),
  have hv₂ := hv₁.not_is_ortho_basis_self_of_nondegenerate hQ,
  simp_rw [is_ortho, associated_eq_self_apply] at hv₂,
  exact ⟨λ i, units.mk0 _ (hv₂ i), ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩,
end

end quadratic_form


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.measure_space
import Mathlib.order.filter.ennreal
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Essential supremum and infimum
We define the essential supremum and infimum of a function `f : α → β` with respect to a measure
`μ` on `α`. The essential supremum is the infimum of the constants `c : β` such that `f x ≤ c`
almost everywhere.

TODO: The essential supremum of functions `α → ennreal` is used in particular to define the norm in
the `L∞` space (see measure_theory/lp_space.lean).

There is a different quantity which is sometimes also called essential supremum: the least
upper-bound among measurable functions of a family of measurable functions (in an almost-everywhere
sense). We do not define that quantity here, which is simply the supremum of a map with values in
`α →ₘ[μ] β` (see measure_theory/ae_eq_fun.lean).

## Main definitions

* `ess_sup f μ := μ.ae.limsup f`
* `ess_inf f μ := μ.ae.liminf f`
-/

/-- Essential supremum of `f` with respect to measure `μ`: the smallest `c : β` such that
`f x ≤ c` a.e. -/
def ess_sup {α : Type u_1} {β : Type u_2} [measurable_space α] [conditionally_complete_lattice β]
    (f : α → β) (μ : measure_theory.measure α) : β :=
  filter.limsup (measure_theory.measure.ae μ) f

/-- Essential infimum of `f` with respect to measure `μ`: the greatest `c : β` such that
`c ≤ f x` a.e. -/
def ess_inf {α : Type u_1} {β : Type u_2} [measurable_space α] [conditionally_complete_lattice β]
    (f : α → β) (μ : measure_theory.measure α) : β :=
  filter.liminf (measure_theory.measure.ae μ) f

theorem ess_sup_congr_ae {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [conditionally_complete_lattice β] {f : α → β} {g : α → β}
    (hfg : filter.eventually_eq (measure_theory.measure.ae μ) f g) : ess_sup f μ = ess_sup g μ :=
  filter.limsup_congr hfg

theorem ess_inf_congr_ae {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [conditionally_complete_lattice β] {f : α → β} {g : α → β}
    (hfg : filter.eventually_eq (measure_theory.measure.ae μ) f g) : ess_inf f μ = ess_inf g μ :=
  ess_sup_congr_ae hfg

@[simp] theorem ess_sup_measure_zero {α : Type u_1} {β : Type u_2} [measurable_space α]
    [complete_lattice β] {f : α → β} : ess_sup f 0 = ⊥ :=
  sorry

@[simp] theorem ess_inf_measure_zero {α : Type u_1} {β : Type u_2} [measurable_space α]
    [complete_lattice β] {f : α → β} : ess_inf f 0 = ⊤ :=
  ess_sup_measure_zero

theorem ess_sup_mono_ae {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_lattice β] {f : α → β} {g : α → β}
    (hfg : filter.eventually_le (measure_theory.measure.ae μ) f g) : ess_sup f μ ≤ ess_sup g μ :=
  filter.limsup_le_limsup hfg

theorem ess_inf_mono_ae {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_lattice β] {f : α → β} {g : α → β}
    (hfg : filter.eventually_le (measure_theory.measure.ae μ) f g) : ess_inf f μ ≤ ess_inf g μ :=
  filter.liminf_le_liminf hfg

theorem ess_sup_const {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_lattice β] (c : β) (hμ : μ ≠ 0) :
    ess_sup (fun (x : α) => c) μ = c :=
  filter.limsup_const c

theorem ess_inf_const {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_lattice β] (c : β) (hμ : μ ≠ 0) :
    ess_inf (fun (x : α) => c) μ = c :=
  ess_sup_const c hμ

theorem ess_sup_const_bot {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_lattice β] : ess_sup (fun (x : α) => ⊥) μ = ⊥ :=
  filter.limsup_const_bot

theorem ess_inf_const_top {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_lattice β] : ess_inf (fun (x : α) => ⊤) μ = ⊤ :=
  filter.liminf_const_top

theorem order_iso.ess_sup_apply {α : Type u_1} {β : Type u_2} [measurable_space α]
    [complete_lattice β] {γ : Type u_3} [complete_lattice γ] (f : α → β)
    (μ : measure_theory.measure α) (g : β ≃o γ) :
    coe_fn g (ess_sup f μ) = ess_sup (fun (x : α) => coe_fn g (f x)) μ :=
  order_iso.limsup_apply g

theorem order_iso.ess_inf_apply {α : Type u_1} {β : Type u_2} [measurable_space α]
    [complete_lattice β] {γ : Type u_3} [complete_lattice γ] (f : α → β)
    (μ : measure_theory.measure α) (g : β ≃o γ) :
    coe_fn g (ess_inf f μ) = ess_inf (fun (x : α) => coe_fn g (f x)) μ :=
  order_iso.ess_sup_apply f μ (order_iso.dual g)

theorem ae_lt_of_ess_sup_lt {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_linear_order β] {f : α → β} {x : β}
    (hf : ess_sup f μ < x) :
    filter.eventually (fun (y : α) => f y < x) (measure_theory.measure.ae μ) :=
  filter.eventually_lt_of_limsup_lt hf

theorem ae_lt_of_lt_ess_inf {α : Type u_1} {β : Type u_2} [measurable_space α]
    {μ : measure_theory.measure α} [complete_linear_order β] {f : α → β} {x : β}
    (hf : x < ess_inf f μ) :
    filter.eventually (fun (y : α) => x < f y) (measure_theory.measure.ae μ) :=
  ae_lt_of_ess_sup_lt hf

namespace ennreal

theorem ae_le_ess_sup {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α}
    (f : α → ennreal) :
    filter.eventually (fun (y : α) => f y ≤ ess_sup f μ) (measure_theory.measure.ae μ) :=
  eventually_le_limsup f

theorem ess_sup_eq_zero_iff {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α}
    {f : α → ennreal} : ess_sup f μ = 0 ↔ filter.eventually_eq (measure_theory.measure.ae μ) f 0 :=
  limsup_eq_zero_iff

theorem ess_sup_const_mul {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α}
    {f : α → ennreal} {a : ennreal} : ess_sup (fun (x : α) => a * f x) μ = a * ess_sup f μ :=
  limsup_const_mul

theorem ess_sup_add_le {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α}
    (f : α → ennreal) (g : α → ennreal) : ess_sup (f + g) μ ≤ ess_sup f μ + ess_sup g μ :=
  limsup_add_le f g

end Mathlib


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

/-!
# Some facts about finite rings
-/

open_locale classical

lemma card_units_lt (M₀ : Type*) [monoid_with_zero M₀] [nontrivial M₀] [fintype M₀] :
  fintype.card (units M₀) < fintype.card M₀ :=
fintype.card_lt_of_injective_of_not_mem (coe : units M₀ → M₀) units.ext not_is_unit_zero


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.metric_space.lipschitz
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Antilipschitz functions

We say that a map `f : α → β` between two (extended) metric spaces is
`antilipschitz_with K`, `K ≥ 0`, if for all `x, y` we have `edist x y ≤ K * edist (f x) (f y)`.
For a metric space, the latter inequality is equivalent to `dist x y ≤ K * dist (f x) (f y)`.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ennreal`. We do not require `0 < K` in the definition, mostly because
we do not have a `posreal` type.
-/

/-- We say that `f : α → β` is `antilipschitz_with K` if for any two points `x`, `y` we have
`K * edist x y ≤ edist (f x) (f y)`. -/
def antilipschitz_with {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] (K : nnreal) (f : α → β) :=
  ∀ (x y : α), edist x y ≤ ↑K * edist (f x) (f y)

theorem antilipschitz_with_iff_le_mul_dist {α : Type u_1} {β : Type u_2} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} : antilipschitz_with K f ↔ ∀ (x y : α), dist x y ≤ ↑K * dist (f x) (f y) := sorry

theorem antilipschitz_with.of_le_mul_dist {α : Type u_1} {β : Type u_2} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} : (∀ (x y : α), dist x y ≤ ↑K * dist (f x) (f y)) → antilipschitz_with K f :=
  iff.mpr antilipschitz_with_iff_le_mul_dist

theorem antilipschitz_with.mul_le_dist {α : Type u_1} {β : Type u_2} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) (x : α) (y : α) : ↑(K⁻¹) * dist x y ≤ dist (f x) (f y) := sorry

namespace antilipschitz_with

/-- Extract the constant from `hf : antilipschitz_with K f`. This is useful, e.g.,
if `K` is given by a long formula, and we want to reuse this value. -/
protected def K {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) : nnreal :=
  K

protected theorem injective {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) : function.injective f := sorry

theorem mul_le_edist {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) (x : α) (y : α) : ↑(K⁻¹) * edist x y ≤ edist (f x) (f y) := sorry

protected theorem id {α : Type u_1} [emetric_space α] : antilipschitz_with 1 id := sorry

theorem comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [emetric_space α] [emetric_space β] [emetric_space γ] {Kg : nnreal} {g : β → γ} (hg : antilipschitz_with Kg g) {Kf : nnreal} {f : α → β} (hf : antilipschitz_with Kf f) : antilipschitz_with (Kf * Kg) (g ∘ f) := sorry

theorem restrict {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) (s : set α) : antilipschitz_with K (set.restrict f s) :=
  fun (x y : ↥s) => hf ↑x ↑y

theorem cod_restrict {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) {s : set β} (hs : ∀ (x : α), f x ∈ s) : antilipschitz_with K (set.cod_restrict f s hs) :=
  fun (x y : α) => hf x y

theorem to_right_inv_on' {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} {s : set α} (hf : antilipschitz_with K (set.restrict f s)) {g : β → α} {t : set β} (g_maps : set.maps_to g t s) (g_inv : set.right_inv_on g f t) : lipschitz_with K (set.restrict g t) := sorry

theorem to_right_inv_on {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) {g : β → α} {t : set β} (h : set.right_inv_on g f t) : lipschitz_with K (set.restrict g t) :=
  to_right_inv_on' (restrict hf set.univ) (set.maps_to_univ g t) h

theorem to_right_inverse {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) : lipschitz_with K g := sorry

theorem uniform_embedding {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) : uniform_embedding f := sorry

theorem subtype_coe {α : Type u_1} [emetric_space α] (s : set α) : antilipschitz_with 1 coe :=
  restrict antilipschitz_with.id s

theorem of_subsingleton {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {f : α → β} [subsingleton α] {K : nnreal} : antilipschitz_with K f := sorry

end antilipschitz_with

theorem lipschitz_with.to_right_inverse {α : Type u_1} {β : Type u_2} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) : antilipschitz_with K g := sorry


import data.fintype.basic
import data.int.interval

def mod_two (a : ℤ) : bool :=
a % 2 = 1

structure propagate_struc (arity : Type) : Type 1 :=
( init_carry : ℤ )
( max_carry : ℤ )
( min_carry : ℤ )
( carry : (arity → bool) → bool → ℤ )
( carry_le : ∀ x b, carry x b ≤ max_carry )
( le_carry : ∀ x b, min_carry ≤ carry x b )
( init_carry_le : init_carry ≤ max_carry )
( le_init_carry : min_carry ≤ init_carry )
( output : (arity → bool) → bool → bool )

variables {arity : Type}
  (p : propagate_struc arity)
  {p₁ p₂ : propagate_struc arity}

namespace propagate_struc

def next_carry (x : arity → bool) (c : ℤ) : ℤ :=
(c + p.carry x (mod_two c)) / 2

@[simp] def nth_carry (x : ℕ → arity → bool) : ℕ → ℤ
| 0     := p.init_carry
| (n+1) := next_carry p (x n) (nth_carry n)

lemma nth_carry_le (x : ℕ → arity → bool) (n : ℕ) :
  p.nth_carry x n ≤ p.max_carry :=
begin
  induction n with n ih,
  { exact p.init_carry_le },
  { have h₁ : p.nth_carry x n ≤ p.max_carry,
    { exact ih },
    have h₂ : p.carry (x n) (mod_two (p.nth_carry x n)) ≤ p.max_carry,
    { exact p.carry_le (x n) (mod_two (p.nth_carry x n)) },
    have h₃ : p.nth_carry x n + p.carry (x n) (mod_two (p.nth_carry x n)) ≤ p.max_carry + p.max_carry,
    { exact add_le_add h₁ h₂ },
    rw nth_carry,
    exact int.div_le_of_le_mul (by norm_num) (by rwa mul_two) }
end

lemma le_nth_carry (x : ℕ → arity → bool) (n : ℕ) :
  p.min_carry ≤ p.nth_carry x n :=
begin
  induction n with n ih,
  { exact p.le_init_carry },
  { have h₁ : p.min_carry ≤ p.nth_carry x n,
    { exact ih },
    have h₂ : p.min_carry ≤ p.carry (x n) (mod_two (p.nth_carry x n)),
    { exact p.le_carry (x n) (mod_two (p.nth_carry x n)) },
    have h₃ : p.min_carry + p.min_carry ≤ p.nth_carry x n + p.carry (x n) (mod_two (p.nth_carry x n)),
    { exact add_le_add h₁ h₂ },
    rw nth_carry,
    exact int.le_div_of_mul_le (by norm_num) (by rwa [mul_two]) }
end

@[simp] def nth_output (x : ℕ → arity → bool) (n : ℕ) : bool :=
p.output (x n) (mod_two (p.nth_carry x n))

lemma nth_carry_eq_of_nth_carry_eq
  {m n : ℕ}
  {x₁ x₂ : ℕ → arity → bool} : ∀ (i : ℕ)
  (hs : p₁.nth_carry x₁ m = p₂.nth_carry x₂ n)
  (hc : p₁.carry = p₂.carry)
  (hx : ∀ (j), j ≤ i → x₁ (m + j) = x₂ (n + j)),
  p₁.nth_carry x₁ (m + i) = p₂.nth_carry x₂ (n + i)
| 0 hs ht hx := hs
| (i+1) hs hc hx := begin
  rw [← add_assoc, ← add_assoc, nth_carry, nth_carry, next_carry, next_carry,
    hc, hx _ (nat.le_succ _),
    nth_carry_eq_of_nth_carry_eq _ _ hc (λ j hj, hx j (nat.le_succ_of_le hj))],
  { simpa [add_comm, add_assoc, add_left_comm] using hs }
end

lemma nth_output_eq_of_nth_carry_eq
  {m n : ℕ}
  {x₁ x₂ : ℕ → arity → bool} (i : ℕ)
  (hs : p₁.nth_carry x₁ m = p₂.nth_carry x₂ n)
  (hc : p₁.carry = p₂.carry)
  (ho : p₁.output = p₂.output)
  (hx : ∀ (j), j ≤ i → x₁ (m + j) = x₂ (n + j)) :
  p₁.nth_output x₁ (m + i) = p₂.nth_output x₂ (n + i) :=
begin
  have := nth_carry_eq_of_nth_carry_eq i (by simpa using hs) hc hx,
  rw [nth_output, nth_output, ho, this, hx _ (le_refl _)]
end

inductive reachable_in : ℕ → ℤ → ℤ → Prop
| init (i : ℤ) : reachable_in 0 i i
| succ {n i j} (x : arity → bool) (h : reachable_in n i j) :
  reachable_in (n + 1) i ((j + p.carry x (mod_two j)) / 2)

def reachable_from (b : bool) : ∀ (n : ℕ), set (finset.Icc p.min_carry p.max_carry)
| 0     := (mod_two ∘ coe) ⁻¹' {b}
| (n+1) := ⋃ (x : arity → bool), (p.next_carry x ∘ coe) ⁻¹' (coe '' reachable_from n)

#print set.image_union

end propagate_struc


syntax:max "fn " ident "=>" term : term
syntax:(lead+1) "function " ident "=>" term : term

macro_rules
  | `(fn $x:ident => $b) => `(fun $x:ident => $b)
  | `(function $x:ident => $b) => `(fun $x:ident => $b)

#check id fn x => x + 1
#check id function x => x + 1

macro "addPrec" : prec => `(prec| 65)
macro "mulPrec" : prec => `(prec| 70)

infix:addPrec " +' " => Nat.add
infix:mulPrec " *' " => Nat.mul

#eval 10 +' 2 *' 3

theorem ex1 : 10 +' 2 *' 3 = 16 :=
  rfl

theorem ex2 : 10 + 2 * 3 = 16 :=
  rfl

infix:(addPrec-1) " *'' " => Nat.mul

theorem ex3 : 10 +' 2 *'' 3 = 36 :=
  rfl


/-
Copyright (c) 2019 Joe Cool. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Hoang Le Truong.

-/
import manifold.field basis
import linear_algebra.dual
open topological_space set vector  euclidean

noncomputable theory
universe u

variables {α : Type}  {n : ℕ}
variable [normed_field α]

instance discrete: discrete_field α:= normed_field.to_discrete_field α

structure cartesian (α : Type*) :=
   (carrier : Type*)
   (dim : ℕ)
  (equiv : carrier  ≃ (Π(i:fin dim),α ))

namespace cartesian
variable (E:cartesian α )

def to_vector (E:cartesian α):  E.carrier  ≃ vector α (E.dim) := equiv.trans (E.equiv) (@fun_vector α _ E.dim)

instance : has_coe_to_sort (cartesian α)  := ⟨_, @cartesian.carrier α⟩
instance to_topological_space (E : cartesian α  ) :   topological_space E := induced (to_vector E) (by apply_instance)

def to_Top (E : cartesian α  ) : Top :=⟨E, by apply_instance⟩
instance : has_coe (cartesian α)  Top :=⟨to_Top⟩

def cartesian_space (n : ℕ) : cartesian α  :=⟨vector α  n, n, (fun_vector n).symm ⟩
notation `α^` := cartesian_space

instance   : add_comm_group (E:cartesian α) := equiv.add_comm_group E.equiv

instance : has_scalar α E :=  @equiv.has_scalar _ _ α E.equiv euclidean.has_scalar

instance : mul_action α E:= equiv.mul_action E.equiv

instance :distrib_mul_action α E:=
{ distrib_mul_action.
   smul_add  := by {repeat{intro},simp[equiv.smul_def,equiv.add_def],by library_search },
   smul_zero := by {repeat{intro},simp[equiv.smul_def,equiv.zero_def]}}

instance : semimodule α E:=
{ semimodule.
   zero_smul := by{ repeat {intro},simp[equiv.smul_def], simp[equiv.zero_def]},
   add_smul  := by {repeat {intro},simp[equiv.smul_def, equiv.add_def, semimodule.add_smul]}}

instance : module α E:={ .}
instance : vector_space α E:={.}

section dual

lemma equiv_vec: E ≃ₗ[α] (Π (i: fin(E.dim)), α):=
{ add:= by{simp[equiv.add_def],
 repeat {intro},
 have h:= equiv.apply_symm_apply E.equiv (E.equiv x + E.equiv y), by library_search },
  smul:= by{simp[equiv.smul_def],repeat {intro},
  have h:= equiv.apply_symm_apply E.equiv (c •(E.equiv) x), by library_search},
  .. E.equiv}

lemma dim_eq :  vector_space.dim α E = E.dim:=
by{  have h:= @dim_fun α (fin E.dim) _ _ α _ _,
  have h1:= @dim_of_field α _,
  rw[h1, mul_one,fintype.card_fin] at h,
  have H :=linear_equiv.dim_eq_lift (@equiv_vec α _ E),
  simp[h] at H,
  simp[H] }

lemma dim_lt: vector_space.dim α E <  cardinal.omega :=by { simp[dim_eq,cardinal.nat_lt_omega]}

lemma dual_equiv :E ≃ₗ[α] module.dual α E:=
begin
  have H:=classical.some_spec (exists_is_basis α  E) ,
  have Hy:=@is_basis.mk_eq_dim α E _ _ _ (classical.some(exists_is_basis α  E)) H,
  have H1:=@dim_lt α _ E,
  rw[Hy.symm,cardinal.lt_omega_iff_finite] at H1,
  have Hyp:= @finite.fintype _ (classical.some(exists_is_basis α  E)) H1,
  have h:=@is_basis.to_dual_equiv α E _ _ _ (classical.some(exists_is_basis α  E)) H Hyp,
  apply h
end

def dual_equiv_std :module.dual α E ≃ₗ[α] (Π (i: fin(E.dim)), α)  :=
begin
  have h:= @dual_equiv α _ E,
  have H:= @equiv_vec α _ E,
  have hy:=@linear_equiv.trans α (module.dual α E)  E (Π (i: fin(E.dim)), α) _ _ _ _ _ _ _ h.symm H,
  apply hy
end

def dual:cartesian α  := ⟨(E →ₗ[α] α), E.dim, (@dual_equiv_std α _ E).to_equiv ⟩

end dual

def field (α) [normed_field α] : cartesian α  :=⟨α , 1, fun_one_equiv.symm⟩

def proj (E:cartesian α ) (i:fin (E.dim)) : E →ₗ[α] α  := (linear_map.proj i).comp ((equiv_vec E).to_linear_map)

def std_basis (E:cartesian α) (i:fin E.dim): E := E.equiv.inv_fun (@euclidean.std_basis α E.dim _ i)

instance has_norm : has_norm (E:cartesian α) :=⟨λ  x,  ∥E.equiv x∥⟩

instance : has_dist (E:cartesian α )  := ⟨ λ x y, @has_dist.dist _ _ (E.equiv x) (E.equiv y)   ⟩

 instance metric_space  :metric_space (E:cartesian α ) :=
{ metric_space.
  dist_self:= by {intro, simp[dist],
    have h:= (@euclidean.normed_space α E.dim _).dist_self,
    have h1:=@h (E.equiv x),
    simp [dist] at h1, apply h1  },
  dist_comm := by { simp[dist], repeat{intro},
  have h:=(@euclidean.normed_space α E.dim _).dist_comm,
  simp [dist] at h,apply h  },
  dist_triangle:= by { simp[dist], repeat{intro},
  have h:=(@euclidean.normed_space α E.dim _).dist_triangle,
  simp [dist] at h,  apply h},
  eq_of_dist_eq_zero:= by { simp[dist], intro, intro,
  have h:=(@euclidean.normed_space α E.dim _).eq_of_dist_eq_zero,
  simp [dist] at h, intro,
  have heq:=@equiv.apply_eq_iff_eq _ _ E.equiv x y,
  rwa[iff.comm] at heq,
  rw [heq], apply h, apply a }}

instance normed_group : normed_group (E:cartesian α) :=
{normed_group.
 dist_eq:= by {simp[norm,dist,equiv.add_def,equiv.neg_def], repeat{intro},
 have h:= (@euclidean.normed_space α E.dim _).dist_eq,
 simp[norm,dist] at h, apply h}}

instance :normed_space α (E:cartesian α):=
{normed_space.
  norm_smul:= by {simp[norm,equiv.smul_def], repeat {intro},
  have h:= (@euclidean.normed_space α E.dim _).norm_smul,
  simp[norm,equiv.smul_def] at h,  apply h}}

end cartesian


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.nat.form
import Mathlib.PostPort

namespace Mathlib

/-
Subtraction elimination for linear natural number arithmetic.
Works by repeatedly rewriting goals of the preform `P[t-s]` into
`P[x] ∧ (t = s + x ∨ (t ≤ s ∧ x = 0))`, where `x` is fresh.
-/

namespace omega

namespace nat

namespace preterm

/-- Find subtraction inside preterm and return its operands -/
def sub_terms : preterm → Option (preterm × preterm) := sorry

/-- Find (t - s) inside a preterm and replace it with variable k -/
def sub_subst (t : preterm) (s : preterm) (k : ℕ) : preterm → preterm := sorry

theorem val_sub_subst {k : ℕ} {x : preterm} {y : preterm} {v : ℕ → ℕ} {t : preterm} :
    fresh_index t ≤ k → val (update k (val v x - val v y) v) (sub_subst x y k t) = val v t :=
  sorry

end preterm

namespace preform

/-- Find subtraction inside preform and return its operands -/
def sub_terms : preform → Option (preterm × preterm) := sorry

/-- Find (t - s) inside a preform and replace it with variable k -/
@[simp] def sub_subst (x : preterm) (y : preterm) (k : ℕ) : preform → preform := sorry

end preform

/-- Preform which asserts that the value of variable k is
    the truncated difference between preterms t and s -/
def is_diff (t : preterm) (s : preterm) (k : ℕ) : preform :=
  preform.or (preform.eq t (preterm.add s (preterm.var 1 k)))
    (preform.and (preform.le t s) (preform.eq (preterm.var 1 k) (preterm.cst 0)))

theorem holds_is_diff {t : preterm} {s : preterm} {k : ℕ} {v : ℕ → ℕ} :
    v k = preterm.val v t - preterm.val v s → preform.holds v (is_diff t s k) :=
  sorry

/-- Helper function for sub_elim -/
def sub_elim_core (t : preterm) (s : preterm) (k : ℕ) (p : preform) : preform :=
  preform.and (preform.sub_subst t s k p) (is_diff t s k)

/-- Return de Brujin index of fresh variable that does not occur
    in any of the arguments -/
def sub_fresh_index (t : preterm) (s : preterm) (p : preform) : ℕ :=
  max (preform.fresh_index p) (max (preterm.fresh_index t) (preterm.fresh_index s))

/-- Return a new preform with all subtractions eliminated -/
def sub_elim (t : preterm) (s : preterm) (p : preform) : preform :=
  sub_elim_core t s (sub_fresh_index t s p) p

theorem sub_subst_equiv {k : ℕ} {x : preterm} {y : preterm} {v : ℕ → ℕ} (p : preform) :
    preform.fresh_index p ≤ k →
        (preform.holds (update k (preterm.val v x - preterm.val v y) v)
            (preform.sub_subst x y k p) ↔
          preform.holds v p) :=
  sorry

theorem sat_sub_elim {t : preterm} {s : preterm} {p : preform} :
    preform.sat p → preform.sat (sub_elim t s p) :=
  sorry

theorem unsat_of_unsat_sub_elim (t : preterm) (s : preterm) (p : preform) :
    preform.unsat (sub_elim t s p) → preform.unsat p :=
  mt sat_sub_elim

end Mathlib


import data.list.perm
import data.list.sort

/-!
-------------------------------------
          Project comments
-------------------------------------

Ran out of time to finish all of the formalization and lemmas.
Would have also liked to have cleaned up, factored out aspects,
and tried out different styles if I had had more time with it.

Overall this was a fun way to get more comfortable with Lean!
-/

/-!
-------------------------------------
              Helpers
-------------------------------------
-/

@[elab_as_eliminator]
lemma list.strong_length_induction {α} {C : list α → Sort*}
    (rec : ∀ xs : list α, (∀ ys : list α, ys.length < xs.length → C ys) → C xs) :
  ∀ xs, C xs
| xs := rec xs (λ ys len, list.strong_length_induction ys)
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩] }

def first_half_helper : ℕ -> list ℕ -> list ℕ
| count []        := []
| count (x :: xs) :=
    match count with
    | 0       := []
    | (c + 1) := (x :: first_half_helper c xs)
    end

def first_half : list ℕ -> list ℕ
| [] := []
| xs := first_half_helper ((list.length xs) / 2) xs

-- BAD: this isn't always true, but we right now use second_half in
-- situations with at least 2 elements, in which case it will be true.
-- Should instead be: xs.length > 1 → (first_half xs).length < xs.length
lemma first_half_is_smaller (xs : list ℕ) :
  (first_half xs).length < (xs.length) :=
sorry

def second_half_helper : ℕ -> list ℕ -> list ℕ
| count []        := []
| count (x :: xs) :=
    match count with
    | 0       := (x :: xs)
    | (c + 1) := second_half_helper c xs
    end

def second_half : list ℕ -> list ℕ
| [] := []
| xs := second_half_helper ((list.length xs) / 2) xs

lemma second_half_is_smaller (xs : list ℕ) :
  (second_half xs).length < xs.length :=
sorry

def list_is_whole_of_halves (xs : list ℕ) :
  xs = (first_half xs) ++ (second_half xs) :=
sorry

/-!
-------------------------------------
             Algorithm
-------------------------------------
-/

def merge : list ℕ -> list ℕ -> list ℕ
| [] ys               := ys
| xs []               := xs
| (x :: xs) (y :: ys) :=
    if x < y then x :: merge xs (y :: ys)
    else y :: merge (x :: xs) ys

def merge_sort : list ℕ -> list ℕ
| []        := []
| (x :: []) := [x]
| xs@(x :: y :: ys)        :=
    have (first_half xs).length < xs.length, from first_half_is_smaller xs,
    have (second_half xs).length < xs.length, from second_half_is_smaller xs,
    merge (merge_sort (first_half xs))
          (merge_sort (second_half xs))
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩]}

#eval merge_sort [5,1,4,3,5,7,3,7]

/-!
-------------------------------------
              Proofs
-------------------------------------
-/

def sorted (xs : list ℕ) : Prop := @list.sorted ℕ (λ a b, a <= b) xs

-- Can't understand why this was causing problems.
lemma empty_merge (xs : list ℕ) :
  (merge list.nil xs = xs) ∧ (merge xs list.nil = xs) :=
sorry

lemma merge_of_sorted_is_sorted :
    ∀xs : list ℕ, ∀ys :
  list ℕ, sorted xs ∧ sorted ys → sorted (merge xs ys)
| [] ys :=
  begin
    intro h1,
    have h2 : sorted ys := by exact and.elim_right h1,
    simp [empty_merge, h2],
  end
| xs [] :=
  begin
    intro h1,
    have h2 : sorted xs := by exact and.elim_left h1,
    simp [empty_merge, h2],
  end
| (x :: xs) (y :: ys) :=
  begin
    intro t,
    have sorted_xs : sorted xs := list.sorted.tail (and.elim_left t),
    have sorted_ys : sorted ys := list.sorted.tail (and.elim_right t),
    by_cases (x < y),
    -- Really should factor some of this out
    { have h1 : sorted (merge xs (y :: ys)) :=
        begin
          apply merge_of_sorted_is_sorted xs (y::ys),
          exact and.intro sorted_xs (and.elim_right t),
        end,
      let merge_tl : list ℕ := (merge xs (y :: ys)),
      -- Need to use assumptions, transitivity of <=, ...
      have h2 : (∀ (b : ℕ), b ∈ merge_tl → x <= b) := sorry,
      have h3 : (∀ (b : ℕ), b ∈ merge_tl → x <= b) ∧ sorted merge_tl :=
        by exact and.intro h2 h1,
      have h4 : sorted (x :: merge_tl) :=
        by exact iff.elim_right list.sorted_cons h3,
      have res : merge (x :: xs) (y :: ys) = x :: merge xs (y :: ys) :=
        -- This is just the definition of merge under this case.
        -- Not sure how to get it to work here.
        sorry,
      simp [h4, res] },
    { have h1 : sorted (merge (x :: xs) ys) :=
        begin
          apply merge_of_sorted_is_sorted (x :: xs) ys,
          exact and.intro (and.elim_left t) sorted_ys,
        end,
      let merge_tl : list ℕ := (merge (x :: xs) ys),
      have h2 : (∀ (b : ℕ), b ∈ merge_tl → y <= b) := sorry,
      have h3 : (∀ (b : ℕ), b ∈ merge_tl → y <= b) ∧ sorted merge_tl :=
        by exact and.intro h2 h1,
      have h4 : sorted (y :: merge_tl) :=
        by exact iff.elim_right list.sorted_cons h3,
      have res : merge (x :: xs) (y :: ys) = y :: merge (x :: xs) ys := sorry,
      simp [h4, res] }
  end

lemma merge_sort_is_sorted :
  ∀xs : list ℕ, sorted (merge_sort xs) :=
begin
  intro xs,
  induction xs using list.strong_length_induction with xs ih,
  cases xs with x xs,
  { simp [sorted, merge_sort, list.sorted_nil] },
  { cases xs with y xs,
    { simp [sorted, merge_sort, list.sorted_singleton] },
    { have s1 : sorted (merge_sort (first_half (x::y::xs))) :=
        begin
          apply ih,
          exact first_half_is_smaller (x::y::xs),
        end,
      have s2 : sorted (merge_sort (second_half (x::y::xs))) :=
        begin
          apply ih,
          exact second_half_is_smaller (x::y::xs),
        end,
      have e : merge_sort (x::y::xs) = merge (merge_sort (first_half (x::y::xs)))
                                             (merge_sort (second_half (x::y::xs))) :=
        by rw merge_sort,
      simp [e, s1, s2, merge_of_sorted_is_sorted] } }
end

lemma merge_is_perm_of_app :
  ∀xs : list ℕ, ∀ys : list ℕ, list.perm (merge xs ys) (xs ++ ys)
| [] ys               := by simp [list.append, empty_merge]
| xs []               := by simp [list.append, empty_merge]
| (x :: xs) (y :: ys) :=
  begin
    simp [list.append],
    by_cases (x < y),
    { have h2 : x :: (xs ++ y :: ys) ~ (x :: xs) ++ (y :: ys) :=
        by simp [list.perm.cons],
      sorry },
    sorry,
  end

lemma merge_sort_is_perm_of_list :
  ∀xs : list ℕ, list.perm (merge_sort xs) xs :=
begin
  intro xs,
  induction xs using list.strong_length_induction with xs ih,
  cases xs with x xs,
  { simp [merge_sort] },
  { cases xs with y xs,
    { simp [merge_sort] },
    { let lst := (x::y::xs),
      let l1 := first_half lst,
      let l2 := second_half lst,

      have p1 : list.perm (merge_sort l1) l1 :=
        begin
          apply ih,
          exact first_half_is_smaller (x::y::xs),
        end,
      have p2 : list.perm (merge_sort l2) l2 :=
        begin
          apply ih,
          exact second_half_is_smaller (x::y::xs),
        end,

      have h1 : list.perm lst (l1 ++ l2) :=
        by rw list_is_whole_of_halves lst,
      have h2 : list.perm (merge l1 l2) (l1 ++ l2) :=
        by apply merge_is_perm_of_app,
      have h3 : list.perm (l1 ++ l2) (merge l1 l2) :=
        by apply list.perm.symm h2,

      have h4 : list.perm (merge l1 l2) (merge (merge_sort l1) (merge_sort l2)) :=
        sorry, -- Follows from p1 and p2 with a few more steps.
      have h5 : merge_sort (x::y::xs) = merge (merge_sort l1) (merge_sort l2) :=
        by rw merge_sort,

      have h6 : list.perm lst (merge l1 l2) :=
        by apply list.perm.trans h1 h3, -- Better way to chain these trans?
      have h7 : list.perm lst (merge (merge_sort l1) (merge_sort l2)) :=
        by apply list.perm.trans h6 h4,

      have g : list.perm (merge_sort lst)
          (merge (merge_sort l1) (merge_sort l2)) :=
        by simp [h5, list.perm.refl],
      exact list.perm.trans g (list.perm.symm h7)
    } }
end

theorem merge_sort_verified (xs : list ℕ) :
  sorted (merge_sort xs) ∧ list.perm (merge_sort xs) xs :=
by simp [merge_sort_is_perm_of_list, merge_sort_is_sorted]


import data.int.basic
import tactic.ring

/-
Bulgarian Mathematical Olympiad 1998, Problem 6

Prove that the equation

     x²y² = z²(z² - x² - y²)

has no solutions in positive integers.

-/

lemma lemma_0
  (a b c x : ℤ)
  (h : a * x^2 + b * x + c = 0) :
  (∃ d : ℤ, d^2 = b^2 - 4 * a * c) :=
begin
  sorry
end

lemma lemma_1
  (s t u : ℤ)
  (hs : 0 < s)
  (ht : 0 < t)
  (hu : 0 < u)
  (h : s^4 - t^4 = u^2) :
  false :=
begin
  sorry
end

theorem bulgaria1998_q6
  (x y z : ℤ)
  (hx : 0 < x)
  (hy : 0 < y)
  (hz : 0 < z)
  (h : x^2 * y^2 = z^2 * (z^2 - x^2 - y^2)) :
  false :=
begin
  have : 0 = (z^2)^2 - z^2 * (x^2 + y^2) - x^2 * y^2 := by {rw[h], ring},
  sorry
end


import defs.syntax
import defs.fv
import util.list.append

theorem var_fv (x: var):
  fv (exp.var x) = [x]
  := by simp [fv]

theorem if_fv (e1 e2 e3: exp):
  fv (exp.if_ e1 e2 e3) = fv e1 ++ (fv e2 ++ fv e3)
  := by simp [fv]

theorem app_fv (e1 e2: exp):
  fv (exp.app e1 e2) = fv e1 ++ fv e2
  := by simp [fv]

theorem fn_fv (x: var) (τ: typ) (e: exp):
  fv (exp.fn x τ e) = list.filter (ne x) (fv e)
  := by simp [fv]

theorem pair_fv (e1 e2: exp):
  fv (exp.pair e1 e2) = fv e1 ++ fv e2
  := by simp [fv]

theorem pair_left_fv (e: exp):
  fv (exp.pair_left e) = fv e
  := by simp [fv]

theorem pair_right_fv (e: exp):
  fv (exp.pair_right e) = fv e
  := by simp [fv]

theorem either_left_fv {τ: typ} (e: exp):
  fv (exp.either_left τ e) = fv e
  := by simp [fv]

theorem either_right_fv {τ: typ} (e: exp):
  fv (exp.either_right τ e) = fv e
  := by simp [fv]

theorem case_never_fv {τ: typ} (e: exp):
  fv (exp.case_never τ e) = fv e
  := by simp [fv]

theorem case_fv (eh e1 e2: exp) (x1 x2: var):
  fv (exp.case eh x1 e1 x2 e2) =
    fv eh ++
    list.filter (ne x1) (fv e1) ++
    list.filter (ne x2) (fv e2)
  := by simp [fv]

theorem if_fv_empty
  (e1 e2 e3: exp)
  : fv (exp.if_ e1 e2 e3) = [] ↔ (fv e1 = [] ∧ fv e2 = [] ∧ fv e3 = []) :=
begin
  split,
  intro h,
  rw if_fv e1 e2 e3 at h,
  let ap := iff.elim_left append_nil_both h,
  split,
  exact ap.left,
  exact iff.elim_left append_nil_both ap.right,
  intro h,
  cases h,
  cases h_right,
  rw if_fv e1 e2 e3 at *,
  rw h_left,
  rw h_right_left,
  rw h_right_right,
  simp [list.append],
end

theorem app_fv_empty
  (e1 e2: exp)
  : fv (exp.app e1 e2) = [] ↔ (fv e1 = [] ∧ fv e2 = []) :=
begin
  split,
  intro h,
  rw app_fv e1 e2 at h,
  exact iff.elim_left append_nil_both h,
  intro h,
  cases h,
  rw app_fv e1 e2 at *,
  rw h_left,
  rw h_right,
  simp [list.append],
end

theorem pair_fv_empty
  (e1 e2: exp)
  : fv (exp.pair e1 e2) = [] ↔ (fv e1 = [] ∧ fv e2 = []) :=
begin
  split,
  intro h,
  rw pair_fv e1 e2 at h,
  exact iff.elim_left append_nil_both h,
  intro h,
  cases h,
  rw pair_fv e1 e2 at *,
  rw h_left,
  rw h_right,
  simp [list.append],
end


/-
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
-/
import Mathlib.Init.Function
import Mathlib.Logic.Basic
import Mathlib.Logic.Function.Basic
import Mathlib.Tactic.Basic
import Mathlib.Tactic.Ext

/-!
# Extra facts about `Prod`

This file defines `Prod.swap : α × β → β × α` and proves various simple lemmas about `Prod`.
-/

variable {α : Type _} {β : Type _} {γ : Type _} {δ : Type _}

@[simp] lemma prod_map (f : α → γ) (g : β → δ) (p : α × β) : Prod.map f g p = (f p.1, g p.2) := by
  cases p; rfl

namespace Prod

@[simp] theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ (∀ a b, p (a, b)) :=
⟨λ h a b => h (a, b), λ h ⟨a, b⟩ => h a b⟩

@[simp] theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ (∃ a b, p (a, b)) :=
⟨λ ⟨⟨a, b⟩, h⟩ => ⟨a, b, h⟩, λ ⟨a, b, h⟩ => ⟨⟨a, b⟩, h⟩⟩

theorem forall' {p : α → β → Prop} : (∀ x : α × β, p x.1 x.2) ↔ ∀ a b, p a b :=
Prod.forall

theorem exists' {p : α → β → Prop} : (∃ x : α × β, p x.1 x.2) ↔ ∃ a b, p a b :=
Prod.exists

lemma map_mk (f : α → γ) (g : β → δ) (a : α) (b : β) : map f g (a, b) = (f a, g b) := rfl

lemma map_fst (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).1 = f (p.1) := by simp

lemma map_snd (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).2 = g (p.2) := by simp

lemma map_fst' (f : α → γ) (g : β → δ) : (Prod.fst ∘ map f g) = f ∘ Prod.fst :=
funext $ map_fst f g

lemma map_snd' (f : α → γ) (g : β → δ) : (Prod.snd ∘ map f g) = g ∘ Prod.snd :=
funext $ map_snd f g

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions.
-/
lemma map_comp_map {ε ζ : Type _}
  (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
  Prod.map g g' ∘ Prod.map f f' = Prod.map (g ∘ f) (g' ∘ f') :=
by ext x; simp

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions, fully applied.
-/
lemma map_map {ε ζ : Type _}
  (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
  Prod.map g g' (Prod.map f f' x) = Prod.map (g ∘ f) (g' ∘ f') x := by simp

theorem mk.inj_iff {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) = (a₂, b₂) ↔ (a₁ = a₂ ∧ b₁ = b₂) :=
⟨Prod.mk.inj,
 by intro hab; rw [hab.left, hab.right]⟩

lemma mk.inj_left {α β : Type _} (a : α) :
  Function.injective (Prod.mk a : β → α × β) :=
fun _ _ h => (Prod.mk.inj h).right

lemma mk.inj_right {α β : Type _} (b : β) :
  Function.injective (λ a => Prod.mk a b : α → α × β) :=
fun _ _ h => (Prod.mk.inj h).left

-- Port note: this lemma comes from lean3/library/init/data/prod.lean.
@[simp] lemma mk.eta : ∀{p : α × β}, (p.1, p.2) = p
| (a,b) => rfl

lemma ext_iff {p q : α × β} : p = q ↔ p.1 = q.1 ∧ p.2 = q.2 :=
by rw [← @mk.eta _ _ p, ← @mk.eta _ _ q, mk.inj_iff]

-- Port note: in mathlib this is named `ext`, but Lean4 has already defined that to be something
-- with a slightly different signature.
@[ext]
lemma ext' {α β} {p q : α × β} (h₁ : p.1 = q.1) (h₂ : p.2 = q.2) : p = q :=
ext_iff.2 ⟨h₁, h₂⟩

lemma map_def {f : α → γ} {g : β → δ} : Prod.map f g = λ p => (f p.1, g p.2) :=
by ext <;> simp

lemma id_prod : (λ (p : α × α) => (p.1, p.2)) = id :=
funext $ λ ⟨a, b⟩ => rfl

lemma fst_surjective [h : Nonempty β] : Function.surjective (@fst α β) :=
λ x => h.elim $ λ y => ⟨⟨x, y⟩, rfl⟩

lemma snd_surjective [h : Nonempty α] : Function.surjective (@snd α β) :=
λ y => h.elim $ λ x => ⟨⟨x, y⟩, rfl⟩

lemma fst_injective [Subsingleton β] : Function.injective (@fst α β) :=
λ {x y} h => ext' h (Subsingleton.elim x.snd y.snd)

lemma snd_injective [Subsingleton α] : Function.injective (@snd α β) :=
λ {x y} h => ext' (Subsingleton.elim _ _) h

/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
def swap : α × β → β × α := λp => (p.2, p.1)

@[simp] lemma swap_swap : ∀ x : α × β, swap (swap x) = x
| ⟨a, b⟩ => rfl

@[simp] lemma fst_swap {p : α × β} : (swap p).1 = p.2 := rfl

@[simp] lemma snd_swap {p : α × β} : (swap p).2 = p.1 := rfl

@[simp] lemma swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) := rfl

@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α × β) :=
funext swap_swap

lemma swap_LeftInverse : Function.LeftInverse (@swap α β) swap :=
swap_swap

lemma swap_RightInverse : Function.RightInverse (@swap α β) swap :=
swap_swap

lemma swap_injective : Function.injective (@swap α β) :=
swap_LeftInverse.injective

lemma swap_surjective : Function.surjective (@swap α β) :=
Function.RightInverse.surjective swap_LeftInverse

lemma swap_bijective : Function.bijective (@swap α β) :=
⟨swap_injective, swap_surjective⟩

@[simp] lemma swap_inj {p q : α × β} : swap p = swap q ↔ p = q :=
swap_injective.eq_iff

lemma eq_iff_fst_eq_snd_eq : ∀{p q : α × β}, p = q ↔ (p.1 = q.1 ∧ p.2 = q.2)
| ⟨p₁, p₂⟩, ⟨q₁, q₂⟩ => by simp

lemma fst_eq_iff : ∀ {p : α × β} {x : α}, p.1 = x ↔ p = (x, p.2)
| ⟨a, b⟩, x => by simp

lemma snd_eq_iff : ∀ {p : α × β} {x : β}, p.2 = x ↔ p = (p.1, x)
| ⟨a, b⟩, x => by simp

theorem lex_def (r : α → α → Prop) (s : β → β → Prop)
  {p q : α × β} : Prod.Lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 :=
⟨(λ h => match h with
    | Lex.left b1 b2 h1 => by simp [h1]
    | Lex.right a h1 => by simp [h1] ),
 λ h => match p, q, h with
 | (a, b), (c, d), Or.inl h => Lex.left _ _ h
 | (a, b), (c, d), Or.inr ⟨e, h⟩ =>
   by subst e; exact Lex.right _ h ⟩

instance Lex.decidable [DecidableEq α]
  (r : α → α → Prop) (s : β → β → Prop) [DecidableRel r] [DecidableRel s] :
  DecidableRel (Prod.Lex r s) :=
λ p q => decidable_of_decidable_of_iff (lex_def r s).symm

end Prod

open Function

lemma Function.injective.prod_map {f : α → γ} {g : β → δ} (hf : injective f) (hg : injective g) :
  injective (Prod.map f g) :=
by intros x y h
   have h1 := (Prod.ext_iff.1 h).1
   rw [Prod.map_fst, Prod.map_fst] at h1
   have h2 := (Prod.ext_iff.1 h).2
   rw [Prod.map_snd, Prod.map_snd] at h2
   exact Prod.ext' (hf h1) (hg h2)

lemma Function.surjective.prod_map {f : α → γ} {g : β → δ} (hf : surjective f) (hg : surjective g) :
  surjective (Prod.map f g) :=
λ p => let ⟨x, hx⟩ := hf p.1
       let ⟨y, hy⟩ := hg p.2
       ⟨(x, y), Prod.ext' hx hy⟩