instance {T} {S : set T} [h : decidable_pred S]
  : decidable_pred (set.compl S) :=
  λ x, decidable.cases_on (h x)
          (λ h, is_true h)
          (λ h, is_false (λ h', h' h))

lemma and.distrib_left (P Q R : Prop) : P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) :=
iff.intro
  (assume h : P ∧ (Q ∨ R),
   have hp : P := and.left h,
   show (P ∧ Q) ∨ (P ∧ R),
   from h.right.cases_on
          (λ hq, or.inl (and.intro hp hq))
          (λ hr, or.inr (and.intro hp hr)))
  (assume h : (P ∧ Q) ∨ (P ∧ R),
   show P ∧ (Q ∨ R),
   from or.cases_on h
        (λ hpq : P ∧ Q, and.intro hpq.left (or.inl hpq.right))
        (λ hpr : P ∧ R, and.intro hpr.left (or.inr hpr.right)))

lemma and.distrib_right (P Q R : Prop) : (Q ∨ R) ∧ P ↔ (Q ∧ P) ∨ (R ∧ P) :=
by { rw and_comm, rw and.distrib_left,
     rw and_comm P Q, rw and_comm P R, }

lemma or.distrib_left (P Q R : Prop) : P ∨ (Q ∧ R) ↔ (P ∨ Q) ∧ (P ∨ R) :=
iff.intro
  (assume h : P ∨ (Q ∧ R),
   show (P ∨ Q) ∧ (P ∨ R),
   from h.cases_on
          (λ hp, and.intro (or.inl hp) (or.inl hp))
          (λ hqr, and.intro (or.inr hqr.left) (or.inr hqr.right)))
  (by {
    intro h,
    cases h,
    cases h_left,
    { exact or.inl h_left },
    { cases h_right,
      { exact or.inl h_right },
      { apply or.inr, constructor; assumption } } })

lemma or.distrib_right (P Q R : Prop) : (Q ∧ R) ∨ P ↔ (Q ∨ P) ∧ (R ∨ P) :=
by { rw or_comm, rw or.distrib_left,
     rw or_comm P Q, rw or_comm P R }

lemma not_or_iff_and_not (p q : Prop) : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
begin
  constructor; intro h,
  { constructor; intro h'; apply h,
    { apply or.inl, assumption }, { apply or.inr, assumption } },
  { intro h', cases h, cases h',
    { exact h_left h' }, { exact h_right h' } }
end

lemma and_not_and (p q : Prop) : p ∧ ¬(p ∧ q) ↔ p ∧ ¬q :=
begin
  constructor; intro h; cases h,
  { constructor, assumption,
    intro hp, apply h_right,
    constructor; assumption },
  { constructor, assumption,
    intro hpq, apply h_right, cases hpq, assumption }
end

lemma classical.exists_of_not_forall {T} {P : T → Prop}
  : (¬ ∀ x : T, P x) → ∃ x : T, ¬ P x :=
begin
  intro, apply classical.by_contradiction, intro h,
  apply a, intro x, cases classical.em (P x),
  { assumption },
  { exfalso, apply h, existsi x, assumption }
end

lemma classical.implies_iff_or {P Q : Prop} : (P → Q) ↔ (¬ P ∨ Q) :=
begin
  constructor,
  { intro h, cases classical.em P,
    exact or.inr (h h_1), exact or.inl h_1 },
  { intro h, cases h, exact false.elim ∘ h, exact λ _, h }
end

lemma classical.dne (P) : P ↔ ¬ ¬ P :=
iff.intro (λ h h', h' h)
  $ by { intro h, cases classical.em P, assumption, trivial }

lemma subset_of_empty_iff_empty {T} {A : set T}  : A ⊆ ∅ ↔ A = ∅ :=
by { simp [(⊆), set.subset], constructor,
     { intro h, funext, apply propext,
      constructor, { apply h }, { intro h, cases h } },
     { intro h, rw h, intro, exact id } }

lemma inter_subset_l {T} (A B : set T) : A ∩ B ⊆ A := λ _, and.left
lemma inter_subset_r {T} (A B : set T) : A ∩ B ⊆ B := λ _, and.right
lemma subset_union_l {T} (A B : set T) : A ⊆ A ∪ B := λ _, or.inl
lemma subset_union_r {T} (A B : set T) : B ⊆ A ∪ B := λ _, or.inr

def fun.im {A B : Type _} (f : A → B) :=
  { b : B | ∃ a : A, f a = b }

@[reducible]
def disjoint {T} (A B : set T) := A ∩ B = ∅

lemma mk_disjoint {T} (A B : set T)
  : (∀ x : T, ¬ (A x ∧ B x)) → disjoint A B :=
by { intro h, dunfold disjoint, rw ← subset_of_empty_iff_empty, exact h }

lemma elim_disjoint {T} {A B : set T}
  : disjoint A B → ∀ x : T, A x → B x → false :=
by { dunfold disjoint, intros h x ha hb,
     refine (_ : (∅ : set T) x), rw ← h,
     constructor; assumption }

lemma disjoint_compl {T} (A : set T) : disjoint A (-A) :=
by { apply mk_disjoint, intros x h, exact h.right h.left  }

lemma disjoint_implies_disjoint_subset {T} {A B A' : set T}
  : A' ⊆ A → disjoint A B → disjoint A' B :=
by { intros, apply mk_disjoint, intros x h,
     apply elim_disjoint a_1 x (a h.left) h.right }

lemma inter_comm {T} (A B : set T) : A ∩ B = B ∩ A :=
begin
  funext, apply propext,
  rw (_ : (A ∩ B) a ↔ A a ∧ B a),
  rw (_ : (B ∩ A) a ↔ B a ∧ A a),
  rw and_comm,
  all_goals {refl}
end

lemma disjoint_symm {T} (A B : set T) : disjoint A B ↔ disjoint B A :=
by { dunfold disjoint, rw inter_comm }

lemma union_comm {T} (A B : set T) : A ∪ B = B ∪ A :=
begin
  funext, apply propext,
  rw (_ : (A ∪ B) a ↔ A a ∨ B a),
  rw (_ : (B ∪ A) a ↔ B a ∨ A a),
  rw or_comm,
  all_goals {refl}
end

lemma inter_assoc {T} (A B C : set T) : (A ∩ B) ∩ C = A ∩ (B ∩ C) :=
begin
  funext, apply propext,
  rw (_ : ((A ∩ B) ∩ C) a ↔ (A a ∧ B a) ∧ C a),
  rw (_ : (A ∩ (B ∩ C)) a ↔ A a ∧ (B a ∧ C a)),
  rw and_assoc,
  all_goals {refl}
end

lemma union_assoc {T} (A B C : set T) : (A ∪ B) ∪ C = A ∪ (B ∪ C) :=
begin
  funext, apply propext,
  rw (_ : ((A ∪ B) ∪ C) a ↔ (A a ∨ B a) ∨ C a),
  rw (_ : (A ∪ (B ∪ C)) a ↔ A a ∨ (B a ∨ C a)),
  rw or_assoc,
  all_goals {refl}
end

lemma compl_union {T} (A B : set T) : -(A ∪ B) = -A ∩ -B :=
begin
  funext, apply propext,
  rw (_ : (-(A ∪ B)) a ↔ ¬ (A a ∨ B a)),
  rw (_ : (- A ∩ - B) a ↔ ¬ (A a) ∧ ¬ (B a)),
  rw not_or_iff_and_not,
  all_goals {refl}
end

lemma compl_inter {T} (A B : set T)
  [decidable_pred A] [decidable_pred B]
  : -(A ∩ B) = -A ∪ -B :=
begin
  funext, apply propext,
  rw (_ : (-(A ∩ B)) a ↔ ¬ (A a ∧ B a)),
  rw (_ : (- A ∪ - B) a ↔ ¬ (A a) ∨ ¬ (B a)),
  rw decidable.not_and_iff_or_not,
  all_goals {refl}
end

lemma union_empty {T} (A : set T) : A ∪ ∅ = A :=
begin
  funext, apply propext,
  rw (_ : (A ∪ ∅) a ↔ A a ∨ false),
  rw or_false,
  refl
end

lemma inter_univ {T} (A : set T) : A ∩ set.univ = A :=
begin
  funext, apply propext,
  rw (_ : (A ∩ set.univ) a ↔ A a ∧ true),
  rw and_true,
  refl
end

lemma inter_empty {T} (A : set T) : A ∩ ∅ = ∅ :=
begin
  funext, apply propext,
  rw (_ : (A ∩ ∅) a ↔ A a ∧ false),
  rw and_false, refl, refl,
end

lemma union_self {T} (A : set T) : A ∪ A = A :=
begin
  funext, apply propext, rw (_ : (A ∪ A) a ↔ A a ∨ A a),
  rw or_self, refl
end

lemma inter_self {T} (A : set T) : A ∩ A = A :=
begin
  funext, apply propext, rw (_ : (A ∩ A) a ↔ A a ∧ A a),
  rw and_self, refl
end

lemma elem_singleton {T} (x : T) : {x} = { y : T | y = x } :=
by { rw (_ : {x} = {y : T | y = x} ∪ ∅), apply union_empty, refl }

lemma compl_compl {T} (A : set T)
  [decidable_pred A]
  : - (- A) = A :=
begin
  funext, apply propext,
  rw (_ : (- (- A)) a = ¬ (¬ (A a))),
  rw decidable.not_not_iff,
  refl
end

lemma inter.distrib_left {T} (A B C : set T) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  funext, apply propext,
  rw (_ : (A ∩ (B ∪ C)) a ↔ A a ∧ (B a ∨ C a)),
  rw (_ : ((A ∩ B) ∪ (A ∩ C)) a ↔ (A a ∧ B a) ∨ (A a ∧ C a)),
  { rw and.distrib_left },
  all_goals {refl}
end

lemma inter.distrib_right {T} (A B C : set T) : (B ∪ C) ∩ A = (B ∩ A) ∪ (C ∩ A) :=
by { rw inter_comm, rw inter.distrib_left,
     rw inter_comm A B, rw inter_comm A C }

lemma union.distrib_left {T} (A B C : set T) : A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C) :=
begin
  funext, apply propext,
  rw (_ : (A ∪ (B ∩ C)) a ↔ A a ∨ (B a ∧ C a)),
  rw (_ : ((A ∪ B) ∩ (A ∪ C)) a ↔ (A a ∨ B a) ∧ (A a ∨ C a)),
  { rw or.distrib_left },
  all_goals {refl}
end

lemma union.distrib_right {T} (A B C : set T) : (B ∩ C) ∪ A = (B ∪ A) ∩ (C ∪ A) :=
by { rw union_comm, rw union.distrib_left,
     rw union_comm A B, rw union_comm A C }

lemma set.FOIL1 {T} (A B C D : set T)
  : (A ∪ B) ∩ (C ∪ D) = (A ∩ C) ∪ (B ∩ C) ∪ (A ∩ D) ∪ (B ∩ D) :=
begin
  rw inter.distrib_left,
  rw inter.distrib_right,
  rw inter.distrib_right,
  repeat { rw union_assoc },
end

lemma set.FOIL2 {T} (A B C D : set T)
  : (A ∩ B) ∪ (C ∩ D) = (A ∪ C) ∩ (B ∪ C) ∩ (A ∪ D) ∩ (B ∪ D) :=
begin
  rw union.distrib_left,
  rw union.distrib_right,
  rw union.distrib_right,
  repeat { rw inter_assoc },
end

def set_minus {T} (A B : set T) : set T := { x ∈ A | x ∉ B }
infix `∖`:80 := set_minus

lemma minus_is_subset {T} (A B : set T) : A ∖ B ⊆ A := λ _ h, h.left

lemma minus_eq_inter_compl {T} (A B : set T) : A ∖ B = A ∩ (-B) :=
begin
  funext, apply propext,
  rw (_ : (A ∖ B) a ↔ A a ∧ ¬ (B a)),
  rw (_ : (A ∩ -B) a ↔ A a ∧ ¬ (B a)),
  refl, refl,
end

lemma minus_disj {T} (A B : set T) : disjoint (A ∖ B) B :=
begin
  rw [minus_eq_inter_compl],
  apply disjoint_implies_disjoint_subset,
  apply inter_subset_r, rw disjoint_symm, apply disjoint_compl
end

lemma union_minus {T} (A B C : set T) : (A ∪ B) ∖ C = (A ∖ C) ∪ (B ∖ C) :=
begin
  funext, apply propext,
  rw (_ : (((A ∪ B)∖C) a ↔ (A a ∨ B a) ∧ ¬ (C a))),
  rw (_ : ((A∖C) ∪ (B∖C)) a ↔ (A a ∧ ¬(C a)) ∨ (B a ∧ ¬(C a))),
  apply and.distrib_right,
  all_goals {refl}
end

lemma minus_subset_union_subset {T} {A A' : set T}
  [decidable_pred A]
  : A ⊆ A' → (A' ∖ A) ∪ A = A' :=
begin
  intros hsub, funext, apply propext, constructor,
  { intro h, cases h,
    { exact h.left },
    { apply hsub, assumption } },
  { intro h, by_cases h' : A a,
    { exact or.inr h' },
    { exact or.inl ⟨h, h'⟩ } }
end

lemma minus_inter {T} (A B C : set T)
  [decidable_pred B] [decidable_pred C]
  : A ∖ (B ∩ C) = (A ∖ B) ∪ (A ∖ C) :=
begin
  funext, apply propext,
  rw (_ : (A∖(B ∩ C)) a ↔ A a ∧ ¬ (B a ∧ C a)),
  rw (_ : ((A∖B) ∪ (A∖C)) a ↔ (A a ∧ ¬ (B a)) ∨ (A a ∧ ¬ (C a))),
  { rw decidable.not_and_iff_or_not,
    apply and.distrib_left },
  all_goals {refl}
end

lemma minus_union {T} (A B C : set T)
  : A ∖ (B ∪ C) = (A ∖ B) ∩ (A ∖ C) :=
begin
  funext, apply propext,
  rw (_ : (A∖(B ∪ C)) a ↔ A a ∧ ¬ (B a ∨ C a)),
  rw (_ : ((A∖B) ∩ (A∖C)) a ↔ (A a ∧ ¬ (B a)) ∧ (A a ∧ ¬ (C a))),
  rw [not_or_iff_and_not
     , and_assoc
     , ← and_assoc (¬ (B a)) (A a)
     , and_comm (¬ (B a)) (A a)
     , and_assoc
     , ← and_assoc (A a) (A a)
     , and_self
     ],
  all_goals {refl}
end

lemma minus_eq_minus_inter {T} (A B : set T) : A ∖ B = A ∖ (A ∩ B) :=
begin
  funext, apply propext,
  rw (_ : (A∖B) a ↔ A a ∧ ¬ B a),
  rw (_ : (A∖(A ∩ B)) a ↔ A a ∧ ¬ (A a ∧ B a)),
  { constructor;
    intro h; cases h;
    apply and.intro h_left; intro h'; apply h_right,
    { exact h'.right },
    { exact and.intro h_left h' } },
  all_goals {refl}
end

lemma minus_self {T} (A : set T) : A ∖ A = ∅ :=
begin
  funext, apply propext, constructor;
  intro h; exfalso,
  { have : A a ∧ ¬ (A a) := h,
    exact this.right this.left },
  { exact h }
end

lemma minus_empty {T} (A : set T) : A∖∅ = A :=
begin
  funext, apply propext,
  rw (_ : (A ∖ ∅) a ↔ A a ∧ ¬ false),
  { rw [not_false_iff, and_true] }, refl
end

lemma minus_minus_eq_minus_union {T} (A B C : set T) : (A ∖ B) ∖ C = A ∖ (B ∪ C) :=
begin
  funext, apply propext,
  rw (_ : (A∖B∖C) a ↔ (A a ∧ ¬ (B a)) ∧ ¬ (C a)),
  rw (_ : (A ∖ (B ∪ C)) a ↔ A a ∧ ¬ (B a ∨ C a)),
  { rw and_assoc, rw not_or_iff_and_not },
  all_goals {refl}
end

lemma minus_of_minus {T} (A B C : set T)
  [decidable_pred B] [decidable_pred C]
  : A ∖ (B ∖ C) = (A ∖ B) ∪ (A ∩ C) :=
begin
  rw minus_eq_inter_compl A B,
  rw ← inter.distrib_left,
  rw minus_eq_inter_compl A,
  rw minus_eq_inter_compl B,
  rw compl_inter B (-C),
  rw compl_compl
end

def symm_diff {T} (A B : set T) : set T := (A ∪ B) ∖ (A ∩ B)
infix `Δ`:60 := symm_diff

lemma symm_diff_def2 {T} (A B : set T) : A Δ B = (A ∖ B) ∪ (B ∖ A) := by {
  dsimp [(Δ)],
  rw union_minus,
  apply congr,
  { apply congr_arg, rw ← minus_eq_minus_inter },
  { rw inter_comm, rw ← minus_eq_minus_inter }
}

lemma symm_diff_comm {T} (A B : set T) : A Δ B = B Δ A :=
  by dsimp [(Δ)]; rw [inter_comm, union_comm]

lemma minus_inter_inter_eq_empty {T} (A B : set T) : A∖B ∩ (A ∩ B) = ∅ :=
begin
  rw minus_eq_inter_compl,
  rw inter_assoc,
  rw ← inter_assoc (- B),
  rw inter_comm (-B),
  rw inter_assoc A (-B),
  rw inter_comm (-B),
  rw ← minus_eq_inter_compl,
  rw minus_self,
  rw inter_empty, rw inter_empty
end

lemma minus_of_symm_diff {T} (A B C : set T)
  [decidable_pred A] [decidable_pred B] [decidable_pred C]
  : C ∖ (A Δ B) = ((C ∖ A) ∩ (C ∖ B)) ∪ (C ∩ A ∩ B) :=
begin
  rw symm_diff_def2, rw ← minus_union,
  rw minus_union,
  rw [minus_of_minus, minus_of_minus],
  rw set.FOIL1,
  rw (_ : C ∩ B ∩ C∖B = ∅),
  rw (_ : C∖A ∩ (C ∩ A) = ∅),
  rw union_empty, rw union_empty,
  rw minus_union,
  have : C ∩ B ∩ (C ∩ A) = C ∩ A ∩ B,
  { rw ← inter_assoc,
    rw inter_comm C B,
    rw inter_assoc B C C,
    rw inter_self,
    rw inter_assoc,
    rw inter_comm },
  rw this,
  { apply minus_inter_inter_eq_empty },
  { rw inter_comm, apply minus_inter_inter_eq_empty }
end

lemma symm_diff_assoc {T} (A B C : set T)
  [decidable_pred A] [decidable_pred B] [decidable_pred C]
  : (A Δ B) Δ C = A Δ (B Δ C) :=
begin
  rw symm_diff_def2,
  rw minus_of_symm_diff,
  rw symm_diff_def2,
  rw symm_diff_def2,
  rw minus_of_symm_diff,
  rw symm_diff_def2,

  rw union_minus,
  rw minus_minus_eq_minus_union,
  rw minus_union,
  rw minus_minus_eq_minus_union,
  rw minus_union,

  rw union_minus,
  rw minus_minus_eq_minus_union,
  rw minus_union,
  rw minus_minus_eq_minus_union,
  rw minus_union,

  suffices : B∖A ∩ B∖C ∪ (C∖A ∩ C∖B ∪ C ∩ A ∩ B)
           = A ∩ B ∩ C ∪ (B∖C ∩ B∖A ∪ C∖B ∩ C∖A),
  { rw union_assoc, rw this, rw ← union_assoc },

  rw ← union_assoc,
  rw ← union_assoc,
  rw union_comm,
  rw ← union_assoc,
  rw (_ : C ∩ A ∩ B = A ∩ B ∩ C),
  rw (_ : B∖A ∩ B∖C = B∖C ∩ B∖A),
  rw (_ : C∖A ∩ C∖B = C∖B ∩ C∖A),
  rw inter_comm, rw inter_comm,
  rw inter_assoc, rw inter_comm
end

lemma empty_symm_diff {T} (A : set T) : ∅ Δ A = A :=
by { intros, simp [(Δ)],
     rw [union_comm, inter_comm],
     rw [union_empty, inter_empty, minus_empty] }

lemma symm_diff_self {T} (A : set T) : A Δ A = ∅ :=
by { dsimp [(Δ)], rw union_self, rw inter_self, apply minus_self }

lemma left_distrib_inter_symm_diff {T} (A B C : set T)
  : A ∩ (B Δ C) = (A ∩ B) Δ (A ∩ C) :=
begin
  rw symm_diff_def2, rw symm_diff_def2,
  rw inter.distrib_left,
  have : ∀ A' B' C' : set T, A' ∩ B'∖C' = (A' ∩ B')∖(A' ∩ C'),
  { intros, rw minus_eq_inter_compl,
    rw minus_eq_inter_compl,
    suffices : A' ∩ -C' = A' ∩ -(A' ∩ C'),
    { rw ← inter_assoc,
      rw inter_comm,
      rw ← inter_assoc,
      rw inter_comm (-C'),
      rw this,
      rw inter_assoc,
      rw inter_assoc,
      rw inter_comm B' },
    { funext, apply propext,
      rw (_ : (A' ∩ -C') a ↔ A' a ∧ ¬ (C' a)),
      rw (_ : (A' ∩ -(A' ∩ C')) a ↔ A' a ∧ ¬ (A' a ∧ C' a)),
      { rw and_not_and },
      all_goals {refl} } },
  rw ← this,
  rw ← this
end

lemma union_decomp_symm {T} (A B : set T)
  [decidable_pred A] [decidable_pred B]
 : A ∪ B = (A Δ B) ∪ (A ∩ B) :=
begin
  dsimp [(Δ)], symmetry,
  apply @minus_subset_union_subset _ _ _ _,
  exact λ _, or.inl ∘ and.left,
  intro x,
  by_cases h : A x; by_cases h' : B x,
  { apply decidable.is_true,
    constructor; assumption },
  { apply decidable.is_false,
    intro h'', cases h'',
    apply h', assumption },
  all_goals
  { apply decidable.is_false,
    intro h'', cases h'',
    apply h, assumption }
end

lemma union_decomp_l {T} (A B : set T)
  [decidable_pred A]
 : A ∪ B = A ∪ (B ∖ A) :=
begin
  funext x, apply propext,
  constructor; intro h,
  { by_cases h' : A x,
    { exact or.inl h' },
    { cases h, { exfalso, apply h', assumption },
      apply or.inr, constructor; assumption } },
  { cases h, exact or.inl h, exact or.inr (minus_is_subset _ _ h) }
end

lemma union_decomp_r {T} (A B : set T)
  [decidable_pred B]
 : A ∪ B = (A ∖ B) ∪ B :=
begin
  transitivity B ∪ A, apply union_comm,
  transitivity B ∪ (A ∖ B), apply union_decomp_l,
  apply union_comm
end

lemma symm_diff_disj_inter {T} (A B : set T)
  : disjoint (A Δ B) (A ∩ B) := minus_disj (A ∪ B) (A ∩ B)

lemma decomp {T} (A B : set T) [decidable_pred B]
  : A = (A ∖ B) ∪ (A ∩ B) :=
begin
  funext, apply propext,
  constructor,
  { intro h, by_cases h' : B x,
    { apply or.inr, constructor; assumption },
    { apply or.inl, constructor; assumption } },
  { intro h, cases h; cases h; assumption }
end

def subset_of_subtype_to_subset {A : Type _} {P : A → Prop}
  : set (subtype P) → set A :=
  λ S, { a : A | ∃ h : P a, S ⟨a, h⟩ }


import Lean

abbrev ℕ := Nat
abbrev BaseType := {n: Nat // n > 1}
abbrev PositionalNotation {b: BaseType} := {d: List (Fin b) // d ≠ []}
def PositionalNotation.toNat {b: BaseType} (pn: PositionalNotation) :=
  List.foldr (λ (a:Fin b) (n:Nat) => a + n * b) 0 pn.val

theorem nand_iff: ∀ p q, ¬(p ∧ q) ↔ (p → ¬q) := by {
  intro p q;
  apply Iff.intro;
  intro h1 wp wq;
  exact absurd ⟨wp, wq⟩ h1;
  intro h1 wpq;
  exact h1 wpq.left wpq.right;
}

theorem hodai1: ∀x y:Nat, x ≥ 2 → y ≥ 2 → y ≤ x → x - y + 1 < x := by {
  intro x;
  induction x;
  simp;
  case succ x x_ih => {
    intro y;
    induction y;
    simp;
    case succ y y_ih => {
      intro h1 h2 h3;
      specialize y_ih h1;
      simp [Nat.succ_sub_succ];
      by_cases h4: x = 1;
      all_goals by_cases h5: y = 1;
      simp_all;
      simp [h4] at h3;
      have h6 := Nat.le_antisymm h2 h3;
      have h7 := Eq.symm (Nat.succ.inj h6);
      contradiction;
      simp [h5];
      have h6 := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ h1) (Ne.symm h4);
      apply Nat.add_lt_add_right;
      apply Nat.sub_lt;
      apply @Nat.lt_trans 0 1;
      simp;
      assumption;
      simp;
      have h6 := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ h1) (Ne.symm h4);
      have h7 := Nat.succ_le_of_lt h6;
      have h8 := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ h2) (Ne.symm h5);
      have h9 := Nat.succ_le_of_lt h8;
      specialize x_ih y h7 h9 (Nat.le_of_succ_le_succ h3);
      apply @Nat.lt_trans (x - y + 1) x;
      assumption;
      exact Nat.lt.base x;
    }
  }
}

theorem hodai2: ∀n m: Nat,  n > 0 → m ≥ 2 → n / m < n := by {
  intros n m h0 h1;
  induction n, m using Nat.div.inductionOn;
  case ind x y h2 h3 => {
    have po := Nat.eq_or_lt_of_le h2.right;
    have h4 := Nat.div_eq x y;
    apply Or.elim po;
    intro pu;
    rw [←pu];
    have pi := Nat.div_eq y y;
    have pe: 0 < y := by {
      apply @Nat.lt_of_lt_of_le 0 2;
      simp;
      assumption;
    };
    have q := Nat.le_refl y;
    simp [pe, q, pi, Nat.sub_self];
    have w := Nat.div_eq 0 y;
    simp [pe];
    simp [(Nat.not_le_of_gt pe)];
    rw [w];
    simp [h2];
    have := Nat.not_eq_zero_of_lt pe;
    simp [this];
    exact Nat.lt_of_succ_le h1;
    intro hh;
    have hod := Nat.zero_lt_sub_of_lt hh;
    specialize h3 hod h1;
    simp [h4, h2];
    have h5 := Nat.add_lt_add_right h3 1;
    apply @Nat.lt_trans ((x - y) / y + 1) (x - y + 1);
    assumption;
    apply hodai1;
    exact Nat.le_trans h1 h2.right;
    assumption;
    exact h2.right;
  }
  case base x y h => {
    have h4 := Nat.div_eq x y;
    simp [h] at h4;
    rw [h4];
    assumption;
  }
}

theorem hodai3: ∀n: Nat, 0 / n = 0 := by {
  intro n;
  have h2 := Nat.div_eq 0 n;
  cases n;
  rw [h2];
  simp;
  case succ n => {
    rw [h2];
    have h3 := Nat.succ_pos n |> Nat.not_le_of_gt;
    simp [h3];
  }
}

theorem hodai4: ∀n: Nat, n > 0 → n / n = 1 := by {
  intro n h1;
  have h2 := Nat.div_eq n n;
  simp [h1, Nat.le_refl] at h2;
  simp [h2, Nat.sub_self, hodai3];
}

theorem hodai5: ∀n m k: Nat, m ≤ n → n + k - m = n - m + k := by {
  intro n m k;
  revert n m;
  induction k;
  simp;
  case succ k ih1 => {
    simp [Nat.add_succ];
    intro n m;
    revert n;
    induction m;
    simp;
    case succ m ih2 => {
      intro n;
      induction n;
      simp;
      --intro h1;
      --have h5 := Nat.eq_zero_of_le_zero h1;
      --contradiction;
      case succ n ih3 => {
        intro h1;
        simp [Nat.succ_sub_succ];
        have h2 := Nat.le_of_succ_le_succ h1;
        have h3 := ih1 (Nat.succ n) m (Nat.le_step h2);
        have h4 := ih2 n h2;
        simp [←h4, Nat.succ_add];

      };
    };
  };
}

theorem hodai6: ∀n b, b > 1 → n % b < b := by {
  intro n b h1;
  apply Nat.mod_lt;
  apply Nat.lt_of_le_and_ne;
  exact Nat.zero_le b;
  apply Ne.symm;
  intro h3;
  rw [h3] at h1;
  contradiction;
}

theorem hodai7: ∀n m: Nat, n ≥ m → ¬m > n := by {
  intro n m h1;
  apply Or.elim $ Nat.eq_or_lt_of_le h1;
  all_goals intro h2;
  rw [h2];
  exact Nat.lt_irrefl n;
  intro h3;
  exact absurd (Nat.lt_trans h2 h3) (Nat.lt_irrefl m);
}

theorem hodai8: ∀n m: Nat, n % m + n / m * m = n := by {
  intro n m;
  induction n, m using Nat.div.inductionOn;
  case ind x y ih1 ih2 => {
    have h1 := Nat.div_eq x y;
    simp [h1, ih1, Nat.mod_eq_sub_mod, Nat.add_mul, ←Nat.add_assoc, ih2, ←hodai5, Nat.add_sub_self_right];
  };
  case base x y ih1 => {
    have h1 := Nat.div_eq x y;
    simp [h1, ih1];
    have h2 := Nat.mod_eq x y;
    simp [h2, ih1];
  };
}

theorem hodai9: ∀n m k: Nat, (n + m) % k = ((n % k) + (m % k)) % k := by {
  intro n m k;
  revert m;
  induction n,k using Nat.mod.inductionOn;
  case ind x y prems ih => {
    intro m;
    have h1 := Nat.mod_eq x y;
    simp [prems] at h1;
    simp [h1, ←ih];
    have h2: y ≤ x + m := Nat.add_le_add prems.right (Nat.zero_le m);
    have h3 := Nat.mod_eq_sub_mod h2;
    simp [h3];
    have h4 := hodai5 x y m prems.right;
    simp [h4];
  };
  case base x y prems => {
    intro m;
    have h1 := Nat.mod_eq x y;
    simp [prems] at h1;
    simp [h1];
    induction m,y using Nat.mod.inductionOn;
    case ind x' y prems' ih => {
      have h2 := Nat.mod_eq x' y;
      simp [prems'] at h2;
      simp [h2];
      specialize ih prems h1;
      simp [←ih, Nat.add_comm x (x' - y)];
      have h3 := hodai5 x' y x prems'.right;
      simp [←h3];
      have h4 := Nat.add_le_add prems'.right (Nat.zero_le x);
      simp [Nat.add_comm] at h4;
      have h5 := Nat.mod_eq_sub_mod h4;
      simp [h5, Nat.add_comm];
    };
    case base x' y prems' => {
      have h1 := Nat.mod_eq x' y;
      simp [prems'] at h1;
      simp [h1];
    };
  };
}

theorem hodai10: ∀n, n / 1 = n := by {
  intro n;
  induction n;
  simp;
  case succ n ih => {
    have h1 := Nat.div_eq (Nat.succ n) 1;
    have h2: 1 ≤ Nat.succ n := Nat.succ_le_succ $ Nat.zero_le n;
    simp [h2, Nat.sub_succ, Nat.pred, ih] at h1;
    assumption;
  };
}

theorem hodai10_1: ∀n m k: Nat, m ≤ k → n - (k - m) = n + m - k := by {
  intro n m;
  revert n;
  induction m;
  simp;
  case succ m ih => {
    intro n k;
    revert n;
    induction k;
    intros n h;
    have h1 := Nat.not_succ_le_zero m h;
    contradiction;
    case succ k ih2 => {
      intro n h;
      simp [Nat.succ_sub_succ, Nat.add_succ];
      have h2 := Nat.le_of_succ_le_succ h;
      exact ih n k h2;
    };
  };
}

theorem hodai10_2: ∀ n m, n = n - m → n = 0 ∨ m = 0 := by {
  intro n m;
  revert n;
  induction m;
  simp;
  case succ m ih => {
    intro n h;
    induction n;
    simp;
    case succ n ih2 => {
      rw [Nat.succ_sub_succ] at h;
      have h1 := congrArg Nat.pred h;
      simp at h1;
      simp [Nat.sub_succ] at ih2;
      specialize ih2 h1;
      simp [ih2] at h;
    };
  };
}

theorem hodai10_3: ∀n m: Nat, n < n - m → False := by {
  intros n m;
  apply hodai7 n (n - m);
  exact Nat.sub_le n m;
}

theorem hodai10_5: ∀n m: Nat, n % m ≠ 0 → m - n % m = ((n / m * m + m) - n) % m := by {
  intro n m;
  induction n, m using Nat.mod.inductionOn;
  case ind x y prems ih => {
    have h1 := Nat.mod_eq x y;
    simp [prems] at h1;
    have h2 := Nat.div_eq x y;
    simp [prems] at h2;
    intro h;
    simp [h1, h2];
    simp [h1] at h;
    simp [ih h];
    rw [
      Nat.add_mul,
      Nat.one_mul,
      Nat.add_assoc _ y _,
      ←Nat.add_assoc];
      generalize h3: (x - y) / y * y + y = z;
      rw [hodai10_1];
      exact prems.right;
  };
  case base x y prems => {
    have h1 := Nat.mod_eq x y;
    simp [prems] at h1;
    have h2 := Nat.div_eq x y;
    simp [prems] at h2;
    simp [h1, h2];
    rw [nand_iff] at prems;
    apply Or.elim $ Nat.eq_or_lt_of_le $ Nat.zero_le y;
    intro a;
    simp [←a];
    intro a;
    specialize prems a;
    have h3 := Nat.mod_eq (y - x) y;
    have h4 := Nat.gt_of_not_le prems;
    by_cases h5: y ≤ y - x;
    apply Or.elim $ Nat.eq_or_lt_of_le h5;
    intro b;
    simp [←b];
    intro h;
    have h6: x = 0 := by {
      apply Or.elim $ hodai10_2 y x b;
      intro b;
      rw [b] at a;
      exact absurd a (Nat.lt_irrefl 0);
      intro;
      contradiction;
    };
    contradiction;
    intro b c;
    have := hodai10_3 y x b;
    contradiction;
    intro h6;
    simp [a, h5] at h3;
    rw [h3];
  };
}

theorem hodai10_6: ∀n m: Nat, n % m = 0 → m - n % m = m := by {
  intro n m h1;
  simp [*];
}

/-
theorem hodai11: ∀n m k: Nat, n > m → (n - m) % k = ((n % k) + (k - (m % k))) % k := by {
  intro n m k h1;
}

theorem hodai12: ∀n m k: Nat, (n * m) % k = ((n % k) * (m % k)) % k := by {
  intro n m k;
}
-/

theorem hodai12_1: ∀n m, m > 0 → n ≥ m → (n - m) % (m - 1) = (n - 1) % (m - 1) := by {
  intro n m h' h;
  have h1 := Nat.mod_eq (n - 1) (m - 1);
  by_cases h2: 0 < m - 1 ∧ m - 1 ≤ n - 1;
  simp [h2] at h1;
  simp [Nat.sub_sub] at h1;
  have h3: 1 + (m - 1) = m := by {
    simp [Nat.sub_succ];
    induction m;
    simp at h2;
    case succ m ih => {
      simp [Nat.add_comm];
    };
  };
  simp [h3] at h1;
  rw [h1];
  --
  simp [h2] at h1;
  rw [nand_iff] at h2;
  by_cases h3: 0 < m - 1;
  specialize h2 h3;
  have h6 := Nat.gt_of_not_le h2;
  have h7 := Nat.add_lt_add_right h6 1;
  have h10 := Nat.sub_add_cancel h';
  rw [h10] at h7;
  have h11: n > 0 := Nat.lt_of_lt_of_le h' h;
  have h12 := Nat.sub_add_cancel h11;
  rw [h12] at h7;
  apply Or.elim $ Nat.eq_or_lt_of_le h;
  intro a;
  simp [a];
  --
  intro a;
  have h13 := Nat.lt_trans a h7;
  exact absurd h13 $ Nat.lt_irrefl m;
  --
  have h4 := Nat.ge_of_not_lt h3 |> Nat.eq_zero_of_le_zero;
  simp [h4, Nat.mod_zero];
  have h5: m = 1 := by {
    have h6 := Nat.succ_le_of_lt h';
    have h7 := Nat.eq_add_of_sub_eq h6 h4;
    simp at h7;
    assumption;
  };
  simp [h5];
}

theorem hodai13: ∀n m k, m > 1 → (n + k) % (m - 1) = (n / m + n % m + k) % (m - 1) := by {
  intro n m;
  induction n,m using Nat.mod.inductionOn;
  case ind x y prems ih => {
    intro k h;
    specialize ih k h;
    have h1 := Nat.div_eq x y;
    have h2 := Nat.mod_eq x y;
    simp [prems] at h1;
    simp [prems] at h2;
    simp [h1, h2];
    simp [Nat.add_assoc, Nat.add_comm 1];
    simp [←Nat.add_assoc];
    rw [hodai9 _ 1, ←ih];
    by_cases h3: y > 2;
    have h4: y - 1 > 1 := by {
      have h5 := Nat.zero_lt_sub_of_lt h3;
      have h6 := Nat.succ_lt_succ h5;
      have h7 := hodai5 y 2 1 (Nat.le_of_lt h3);
      simp [Nat.add_succ] at h7;
      rw [←h7] at h6;
      simp [Nat.sub_succ];
      assumption;
    };
    have h5 := Nat.mod_eq_of_lt h4;
    rw [←hodai5 x y k prems.right];
    have h6 := hodai12_1 (x + k) y prems.left (Nat.add_le_add prems.right (Nat.zero_le k));
    simp [h6];
    rw [←hodai9];
    have h7 := Nat.lt_of_lt_of_le prems.left prems.right |> Nat.succ_le_of_lt;
    have h8 := Nat.add_le_add h7 (Nat.zero_le k);
    simp at h8;
    have h9 := hodai5 (x + k) 1 1 h8;
    rw [←h9, Nat.add_sub_self_right];
    --
    have h4 := Nat.ge_of_not_lt h3;
    have h5 := Nat.succ_le_of_lt h;
    have h6 := Nat.le_antisymm h4 h5;
    simp [h6, Nat.sub_succ, Nat.mod_one];
  };
  case base x y prems => {
    intro k h;
    have h1 := Nat.div_eq x y;
    simp [prems] at h1;
    simp [h1];
    have h2 := Nat.mod_eq x y;
    simp [prems] at h2;
    simp [h2];
  };
}

theorem ornot_then_nand: ∀p q, ¬p ∨ ¬q → ¬(p ∧ q) := by {
  intro p q wor wpq;
  apply Or.elim wor;
  all_goals {
    intros;
    have ⟨wp, wq⟩ := wpq;
    contradiction;
  }
}

def toPositionalNotation {base: BaseType} (n: ℕ) : @PositionalNotation base :=
  if h': n < base then
    by {
      let ret := [Fin.mk n h'];
      have h: ret ≠ [] := by simp;
      exact ⟨ret, h⟩;
    }
  else
    by {
      have h1 := hodai6 n base base.property;
      have h2: n / base < n := by {
        apply hodai2;
        apply Or.elim $ Nat.lt_or_ge n base;
        intro;
        contradiction;
        intro h3;
        apply @Nat.lt_of_lt_of_le 0 base;
        apply @Nat.lt_trans 0 1;
        simp;
        exact base.property;
        assumption;
        apply Nat.succ_le_of_lt;
        exact base.property;
      };
      let ret := Fin.mk (n % base.val) h1 :: (toPositionalNotation (n / base)).val;
      have h: ret ≠ [] := by {simp;};
      exact ⟨ret, h⟩;
    }
  termination_by _ n => n

theorem PositionalNotation.induction.F.{u} {b: BaseType}
  (C : Nat → Sort u)
  (ind: ∀n, n ≥ b.val → C (n / b) → C n)
  (base: ∀n, ¬n ≥ b.val → C n)
  (n: Nat) (f: ∀x', x' < n → C x') : C n :=
  if h: n ≥ b then
    have h1: n / b < n := by {
      apply hodai2;
      apply Or.elim $ Nat.lt_or_ge n b;
      intro a;
      exact absurd h (Nat.not_le_of_gt a);
      intro;
      apply @Nat.lt_of_lt_of_le 0 b;
      apply @Nat.lt_trans 0 1;
      simp;
      exact b.property;
      assumption;
      apply Nat.succ_le_of_lt;
      exact b.property;
    };
    ind n h (f (n / b) h1)
  else base n h

theorem PositionalNotation.inductionOn.{u}
  (motive: Nat → Sort u)
  (x: Nat)
  (b: BaseType) -- koko hontou ha implicit ni sitai
  (ind: ∀x, x ≥ b.val → motive (x / b) → motive x)
  (base: ∀x, ¬x ≥ b.val → motive x)
  : motive x :=
  WellFounded.fix (measure id).wf (PositionalNotation.induction.F motive ind base) x

theorem toNat_toPosNot_eq_Nat {b: BaseType} : ∀n, (@toPositionalNotation b n).toNat = n := by {
  intro n;
  induction n using PositionalNotation.inductionOn;
  assumption;
  case ind n ih1 ih2 => {
    unfold toPositionalNotation;
    apply Or.elim $ Nat.lt_or_ge n b;
    intro h2;
    simp [h2, PositionalNotation.toNat, List.foldr];
    intro h2;
    have h3 := hodai7 n b h2;
    simp [PositionalNotation.toNat] at ih2;
    simp [h3, PositionalNotation.toNat, List.foldr, ih2];
    simp [hodai8];
  };
  case base x prems => {
    unfold toPositionalNotation;
    have h1 := Nat.gt_of_not_le prems;
    simp [h1, PositionalNotation.toNat, List.foldr];
  };
}

theorem keta_no_wa_no_amari_eq_moto_no_kazu_no_amari {b: {n: Nat // n > 1}} : ∀n m, (n + m) % (b.val - 1) = (List.foldl (λ(a: Nat) (b: Fin b) => a + b) m (toPositionalNotation n).val) % (b.val - 1) := by {
  intro n;
  induction n using PositionalNotation.inductionOn;
  assumption;
  case ind x prems ih => {
    unfold toPositionalNotation;
    have h1 := hodai7 x b prems;
    all_goals simp [List.foldl, h1, Nat.add_comm];
    intro m;
    specialize ih (m + x % b.val);
    simp [←ih];
    rw [(Nat.add_comm m), ←Nat.add_assoc];
    have h2 := hodai13 x b m b.property;
    assumption;
  };
  case base x prems => {
    unfold toPositionalNotation;
    have h1 := Nat.gt_of_not_le prems;
    simp [h1, List.foldl];
    intro;
    simp [Nat.add_comm];
  };
}

#eval Lean.versionString


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

/-!
# UV-compressions

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

This file defines UV-compression. It is an operation on a set family that reduces its shadow.

UV-compressing `a : α` along `u v : α` means replacing `a` by `(a ⊔ u) \ v` if `a` and `u` are
disjoint and `v ≤ a`. In some sense, it's moving `a` from `v` to `u`.

UV-compressions are immensely useful to prove the Kruskal-Katona theorem. The idea is that
compressing a set family might decrease the size of its shadow, so iterated compressions hopefully
minimise the shadow.

## Main declarations

* `uv.compress`: `compress u v a` is `a` compressed along `u` and `v`.
* `uv.compression`: `compression u v s` is the compression of the set family `s` along `u` and `v`.
  It is the compressions of the elements of `s` whose compression is not already in `s` along with
  the element whose compression is already in `s`. This way of splitting into what moves and what
  does not ensures the compression doesn't squash the set family, which is proved by
  `uv.card_compress`.

## Notation

`𝓒` (typed with `\MCC`) is notation for `uv.compression` in locale `finset_family`.

## Notes

Even though our emphasis is on `finset α`, we define UV-compressions more generally in a generalized
boolean algebra, so that one can use it for `set α`.

## TODO

Prove that compressing reduces the size of shadow. This result and some more already exist on the
branch `combinatorics`.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf

## Tags

compression, UV-compression, shadow
-/

open finset

variable {α : Type*}

/-- UV-compression is injective on the elements it moves. See `uv.compress`. -/
lemma sup_sdiff_inj_on [generalized_boolean_algebra α] (u v : α) :
  {x | disjoint u x ∧ v ≤ x}.inj_on (λ x, (x ⊔ u) \ v) :=
begin
  rintro a ha b hb hab,
  have h : (a ⊔ u) \ v \ u ⊔ v = (b ⊔ u) \ v \ u ⊔ v,
  { dsimp at hab,
    rw hab },
  rwa [sdiff_sdiff_comm, ha.1.symm.sup_sdiff_cancel_right, sdiff_sdiff_comm,
    hb.1.symm.sup_sdiff_cancel_right, sdiff_sup_cancel ha.2, sdiff_sup_cancel hb.2] at h,
end

-- The namespace is here to distinguish from other compressions.
namespace uv

/-! ### UV-compression in generalized boolean algebras -/

section generalized_boolean_algebra
variables [generalized_boolean_algebra α] [decidable_rel (@disjoint α _ _)]
  [decidable_rel ((≤) : α → α → Prop)] {s : finset α} {u v a b : α}

local attribute [instance] decidable_eq_of_decidable_le

/-- To UV-compress `a`, if it doesn't touch `U` and does contain `V`, we remove `V` and
put `U` in. We'll only really use this when `|U| = |V|` and `U ∩ V = ∅`. -/
def compress (u v a : α) : α := if disjoint u a ∧ v ≤ a then (a ⊔ u) \ v else a

/-- To UV-compress a set family, we compress each of its elements, except that we don't want to
reduce the cardinality, so we keep all elements whose compression is already present. -/
def compression (u v : α) (s : finset α) :=
s.filter (λ a, compress u v a ∈ s) ∪ (s.image $ compress u v).filter (λ a, a ∉ s)

localized "notation (name := uv.compression) `𝓒 ` := uv.compression" in finset_family

/-- `is_compressed u v s` expresses that `s` is UV-compressed. -/
def is_compressed (u v : α) (s : finset α) := 𝓒 u v s = s

/-- `a` is in the UV-compressed family iff it's in the original and its compression is in the
original, or it's not in the original but it's the compression of something in the original. -/
lemma mem_compression :
  a ∈ 𝓒 u v s ↔ a ∈ s ∧ compress u v a ∈ s ∨ a ∉ s ∧ ∃ b ∈ s, compress u v b = a :=
by simp_rw [compression, mem_union, mem_filter, mem_image, and_comm (a ∉ s)]

@[simp] lemma compress_self (u a : α) : compress u u a = a :=
begin
  unfold compress,
  split_ifs,
  { exact h.1.symm.sup_sdiff_cancel_right },
  { refl }
end

@[simp] lemma compression_self (u : α) (s : finset α) : 𝓒 u u s = s :=
begin
  unfold compression,
  convert union_empty s,
  { ext a,
    rw [mem_filter, compress_self, and_self] },
  { refine eq_empty_of_forall_not_mem (λ a ha, _),
    simp_rw [mem_filter, mem_image, compress_self] at ha,
    obtain ⟨⟨b, hb, rfl⟩, hb'⟩ := ha,
    exact hb' hb }
end

/-- Any family is compressed along two identical elements. -/
lemma is_compressed_self (u : α) (s : finset α) : is_compressed u u s := compression_self u s

lemma compress_disjoint (u v : α) :
  disjoint (s.filter (λ a, compress u v a ∈ s)) ((s.image $ compress u v).filter (λ a, a ∉ s)) :=
disjoint_left.2 $ λ a ha₁ ha₂, (mem_filter.1 ha₂).2 (mem_filter.1 ha₁).1

/-- Compressing an element is idempotent. -/
@[simp] lemma compress_idem (u v a : α) : compress u v (compress u v a) = compress u v a :=
begin
  unfold compress,
  split_ifs with h h',
  { rw [le_sdiff_iff.1 h'.2, sdiff_bot, sdiff_bot, sup_assoc, sup_idem] },
  { refl },
  { refl }
end

lemma compress_mem_compression (ha : a ∈ s) : compress u v a ∈ 𝓒 u v s :=
begin
  rw mem_compression,
  by_cases compress u v a ∈ s,
  { rw compress_idem,
    exact or.inl ⟨h, h⟩ },
  { exact or.inr ⟨h, a, ha, rfl⟩ }
end

-- This is a special case of `compress_mem_compression` once we have `compression_idem`.
lemma compress_mem_compression_of_mem_compression (ha : a ∈ 𝓒 u v s) : compress u v a ∈ 𝓒 u v s :=
begin
  rw mem_compression at ⊢ ha,
  simp only [compress_idem, exists_prop],
  obtain ⟨_, ha⟩ | ⟨_, b, hb, rfl⟩ := ha,
  { exact or.inl ⟨ha, ha⟩ },
  { exact or.inr ⟨by rwa compress_idem, b, hb, (compress_idem _ _ _).symm⟩ }
end

/-- Compressing a family is idempotent. -/
@[simp] lemma compression_idem (u v : α) (s : finset α) : 𝓒 u v (𝓒 u v s) = 𝓒 u v s :=
begin
  have h : filter (λ a, compress u v a ∉ 𝓒 u v s) (𝓒 u v s) = ∅ :=
    filter_false_of_mem (λ a ha h, h $ compress_mem_compression_of_mem_compression ha),
  rw [compression, image_filter, h, image_empty, ←h],
  exact filter_union_filter_neg_eq _ (compression u v s),
end

/-- Compressing a family doesn't change its size. -/
lemma card_compression (u v : α) (s : finset α) : (𝓒 u v s).card = s.card :=
begin
  rw [compression, card_disjoint_union (compress_disjoint _ _), image_filter, card_image_of_inj_on,
    ←card_disjoint_union, filter_union_filter_neg_eq],
  { rw disjoint_iff_inter_eq_empty,
    exact filter_inter_filter_neg_eq _ _ _ },
  intros a ha b hb hab,
  dsimp at hab,
  rw [mem_coe, mem_filter, function.comp_app] at ha hb,
  rw compress at ha hab,
  split_ifs at ha hab with has,
  { rw compress at hb hab,
    split_ifs at hb hab with hbs,
    { exact sup_sdiff_inj_on u v has hbs hab },
    { exact (hb.2 hb.1).elim } },
  { exact (ha.2 ha.1).elim }
end

/-- If `a` is in the family compression and can be compressed, then its compression is in the
original family. -/
lemma sup_sdiff_mem_of_mem_compression (ha : a ∈ 𝓒 u v s) (hva : v ≤ a) (hua : disjoint u a) :
  (a ⊔ u) \ v ∈ s :=
begin
  rw [mem_compression, compress_of_disjoint_of_le hua hva] at ha,
  obtain ⟨_, ha⟩ | ⟨_, b, hb, rfl⟩ := ha,
  { exact ha },
  have hu : u = ⊥,
  { suffices : disjoint u (u \ v),
    { rwa [(hua.mono_right hva).sdiff_eq_left, disjoint_self] at this },
    refine hua.mono_right _,
    rw [←compress_idem, compress_of_disjoint_of_le hua hva],
    exact sdiff_le_sdiff_right le_sup_right },
  have hv : v = ⊥,
  { rw ←disjoint_self,
    apply disjoint.mono_right hva,
    rw [←compress_idem, compress_of_disjoint_of_le hua hva],
    exact disjoint_sdiff_self_right },
  rwa [hu, hv, compress_self, sup_bot_eq, sdiff_bot],
end

/-- If `a` is in the `u, v`-compression but `v ≤ a`, then `a` must have been in the original
family. -/
lemma mem_of_mem_compression (ha : a ∈ 𝓒 u v s) (hva : v ≤ a) (hvu : v = ⊥ → u = ⊥) : a ∈ s :=
begin
  rw mem_compression at ha,
  obtain ha | ⟨_, b, hb, h⟩ := ha,
  { exact ha.1 },
  unfold compress at h,
  split_ifs at h,
  { rw [←h, le_sdiff_iff] at hva,
    rw [hvu hva, hva, sup_bot_eq, sdiff_bot] at h,
    rwa ←h },
  { rwa ←h }
end

end generalized_boolean_algebra

/-! ### UV-compression on finsets -/

open_locale finset_family

variables [decidable_eq α] {𝒜 : finset (finset α)} {U V A : finset α}

/-- Compressing a finset doesn't change its size. -/
lemma card_compress (hUV : U.card = V.card) (A : finset α) : (compress U V A).card = A.card :=
begin
  unfold compress,
  split_ifs,
  { rw [card_sdiff (h.2.trans le_sup_left), sup_eq_union, card_disjoint_union h.1.symm, hUV,
    add_tsub_cancel_right] },
  { refl }
end

end uv


/-
Copyright (c) 2018 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl

Lipschitz functions and the Banach fixed-point theorem
-/
import topology.metric_space.basic analysis.specific_limits
open filter

variables {α : Type*} {β : Type*} {γ : Type*}

lemma fixed_point_of_tendsto_iterate [topological_space α] [t2_space α] {f : α → α} {x : α}
  (hf : tendsto f (nhds x) (nhds (f x))) (hx : ∃ x₀ : α, tendsto (λ n, f^[n] x₀) at_top (nhds x)) :
  f x = x :=
begin
  rcases hx with ⟨x₀, hx⟩,
  refine tendsto_nhds_unique at_top_ne_bot _ hx,
  rw [← tendsto_add_at_top_iff_nat 1, funext (assume n, nat.iterate_succ' f n x₀)],
  exact hx.comp hf
end

/-- A Lipschitz function is uniformly continuous -/
lemma uniform_continuous_of_lipschitz [metric_space α] [metric_space β] {K : ℝ}
  {f : α → β} (H : ∀x y, dist (f x) (f y) ≤ K * dist x y) : uniform_continuous f :=
begin
  have : 0 < max K 1 := lt_of_lt_of_le zero_lt_one (le_max_right K 1),
  refine metric.uniform_continuous_iff.2 (λε εpos, _),
  exact ⟨ε/max K 1, div_pos εpos this, assume y x Dyx, calc
    dist (f y) (f x) ≤ K * dist y x : H y x
    ... ≤ max K 1 * dist y x : mul_le_mul_of_nonneg_right (le_max_left K 1) (dist_nonneg)
    ... < max K 1 * (ε/max K 1) : mul_lt_mul_of_pos_left Dyx this
    ... = ε : mul_div_cancel' _ (ne_of_gt this)⟩
end

/-- A Lipschitz function is continuous -/
lemma continuous_of_lipschitz [metric_space α] [metric_space β] {K : ℝ}
  {f : α → β} (H : ∀x y, dist (f x) (f y) ≤ K * dist x y) : continuous f :=
uniform_continuous.continuous (uniform_continuous_of_lipschitz H)

lemma uniform_continuous_of_le_add [metric_space α] {f : α → ℝ} (K : ℝ)
  (h : ∀x y, f x ≤ f y + K * dist x y) : uniform_continuous f :=
begin
  have I : ∀ (x y : α), f x - f y ≤ K * dist x y := λx y, calc
    f x - f y ≤ (f y + K * dist x y) - f y : add_le_add (h x y) (le_refl _)
    ... = K * dist x y : by ring,
  refine @uniform_continuous_of_lipschitz _ _ _ _ K _ (λx y, _),
  rw real.dist_eq,
  refine abs_sub_le_iff.2 ⟨_, _⟩,
  { exact I x y },
  { rw dist_comm, exact I y x }
end

/-- `lipschitz_with K f`: the function `f` is Lipschitz continuous w.r.t. the Lipschitz
constant `K`. -/
def lipschitz_with [metric_space α] [metric_space β] (K : ℝ) (f : α → β) :=
0 ≤ K ∧ ∀x y, dist (f x) (f y) ≤ K * dist x y

namespace lipschitz_with

variables [metric_space α] [metric_space β] [metric_space γ] {K : ℝ}

protected lemma weaken (K' : ℝ) {f : α → β} (hf : lipschitz_with K f) (h : K ≤ K') :
  lipschitz_with K' f :=
⟨le_trans hf.1 h, assume x y, le_trans (hf.2 x y) $ mul_le_mul_of_nonneg_right h dist_nonneg⟩

protected lemma to_uniform_continuous {f : α → β} (hf : lipschitz_with K f) : uniform_continuous f :=
uniform_continuous_of_lipschitz hf.2

protected lemma to_continuous {f : α → β} (hf : lipschitz_with K f) : continuous f :=
continuous_of_lipschitz hf.2

protected lemma const (b : β) : lipschitz_with 0 (λa:α, b) :=
⟨le_refl 0, assume x y, by simp⟩

protected lemma id : lipschitz_with 1 (@id α) :=
⟨zero_le_one, by simp [le_refl]⟩

protected lemma comp {Kf Kg : ℝ} {f : β → γ} {g : α → β}
  (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : lipschitz_with (Kf * Kg) (f ∘ g) :=
⟨mul_nonneg hf.1 hg.1, assume x y,
  calc dist (f (g x)) (f (g y)) ≤ Kf * dist (g x) (g y) : hf.2 _ _
    ... ≤ Kf * (Kg * dist x y) : mul_le_mul_of_nonneg_left (hg.2 _ _) hf.1
    ... = (Kf * Kg) * dist x y : by rw mul_assoc⟩

protected lemma iterate {f : α → α} (hf : lipschitz_with K f) : ∀n, lipschitz_with (K ^ n) (f^[n])
| 0       := lipschitz_with.id
| (n + 1) := by rw [← nat.succ_eq_add_one, pow_succ, mul_comm]; exact (iterate n).comp hf

section contraction
variables {f : α → α} {x y : α}

lemma dist_inequality_of_contraction (hK₁ : K < 1) (hf : lipschitz_with K f) :
   dist x y ≤ (dist x (f x) + dist y (f y)) / (1 - K) :=
suffices dist x y ≤ dist x (f x) + (dist y (f y) + K * dist x y),
  by rwa [le_div_iff (sub_pos_of_lt hK₁), mul_comm, sub_mul, one_mul, sub_le_iff_le_add, add_assoc],
calc dist x y ≤ dist x (f x) + dist y (f x) :
    dist_triangle_right x y (f x)
  ... ≤ dist x (f x) + (dist y (f y) + dist (f x) (f y)) :
    add_le_add_left (dist_triangle_right y (f x) (f y)) _
  ... ≤ dist x (f x) + (dist y (f y) + K * dist x y) :
    add_le_add_left (add_le_add_left (hf.2 _ _) _) _

theorem fixed_point_unique_of_contraction (hK : K < 1) (hf : lipschitz_with K f)
  (hx : f x = x) (hy : f y = y) : x = y :=
dist_le_zero.1 $ le_trans (dist_inequality_of_contraction hK hf) $
  by rewrite [iff.mpr dist_eq_zero hx.symm, iff.mpr dist_eq_zero hy.symm]; simp

/-- Banach fixed-point theorem, contraction mapping theorem -/
theorem exists_fixed_point_of_contraction [hα : nonempty α] [complete_space α]
  (hK : K < 1) (hf : lipschitz_with K f) : ∃x, f x = x :=
let ⟨x₀⟩ := hα in
have cauchy_seq (λ n, f^[n] x₀) := begin
  refine cauchy_seq_of_le_geometric K (dist x₀ (f x₀)) hK (λn, _),
  rw [nat.iterate_succ f n x₀, mul_comm],
  exact and.right (hf.iterate n) x₀ (f x₀)
end,
let ⟨x, hx⟩ := cauchy_seq_tendsto_of_complete this in
⟨x, fixed_point_of_tendsto_iterate (hf.to_uniform_continuous.continuous.tendsto x) ⟨x₀, hx⟩⟩

end contraction

end lipschitz_with


import week_8.Part_A_G_modules

/-

# Making the API for H⁰(G,M)

If G is a group and M is a G-module then H⁰(G,M), or `H0 G M`, is the abelian
group of G-invariant elements of `M`. We make the definition so we have
to make the interface too. We show that `H0 G M` is an abelian group,
define a coercion to `M` sending `m` to `↑m`, and define `m.spec` to be
the statement that `↑m` is G-invariant.

Let's start by giving a preliminary definition of H⁰ as an additive
subgroup of `M`.

-/

open set

/-- `H0 G M` is the type of G-invariant elements of M. -/
def H0_subgroup (G M : Type)
  [monoid G] [add_comm_group M] [distrib_mul_action G M] : add_subgroup M :=
{ carrier := {m | ∀ g : G, g • m = m },
  -- Need to check it's a subgroup.
  -- Axiom 1: zero in ("closed under `0`")
  zero_mem' := begin
    -- you can start with this
    rw mem_set_of_eq, -- says that `a ∈ { x | p x}` is the same as `p a`.
    -- can you take it from there?
    sorry
  end,
  -- Axiom 2 : closed under `+`
  add_mem' := begin
    intros a b ha hb g,
    rw mem_set_of_eq at *, -- that's how I'd start
    sorry,
  end,
  -- Axiom 3 : closed under `-`
  neg_mem' := begin
    sorry
  end }

/-

This makes `H0_subgroup G M`, a term (an additive subgroup of `M`, and
hence a term of type `add_subgroup M`). But this is no good -- we want
to consider functions `H⁰(G,M) → H⁰(G,N)` so we need a *type* `H0 G M`.
We need to promote the term to a type. We do this by using Lean's
theory of subtypes, with notation `{ x // P x }` (a type) as oppposed to
the set-theoretic `{ x | P x }` (a term)

-/

/-- Group cohomology `H⁰(G,M)` as a type. -/
def H0 (G M : Type)
  [monoid G] [add_comm_group M] [distrib_mul_action G M] : Type :=
{m : M // ∀ g : G, g • m = m }

-- let's make an API and prove stuff about `H0 G M` in the `H0` namespace.
namespace H0

-- let `G` be a group (or a monoid) and let `M` be a `G`-module.
variables {G M : Type}
  [monoid G] [add_comm_group M] [distrib_mul_action G M]

/-
We have defined `H0 G M` to be a type, a so-called subtype of `M`,
but a type in its own right. It has terms of its own (unlike `S : set M`
or `A : sub_distrib_mul_action M`)

So how does this work? A term `m` of type `H0 G M` is a *package* consisting
of a term `m.1 : M` and a proof `m.2 : ∀ g, g • m.1 = m.1`. We do not
want to use these internal computer science terms for this package
of information, we want a nice interface. Below we use coercion, to turn
a term `m : H0 G M` into a term `↑m : M`.

-/

/-- set up coercion from `H⁰(G,M) to M`, sending `m` to `↑m` -/
instance : has_coe (H0 G M) M :=
-- this is the last time we see `m.1`
⟨λ m, m.1⟩

-- That's a definition, so we need to make a little API.

/-- If `a : M` then `↑⟨a, ha⟩ = a` -/
@[simp] lemma coe_def (a : M) (ha : ∀(g : G), g • a = a) :
  ((⟨a, ha⟩ : H0 G M) : M) = a := rfl

-- this is our nice interface
lemma spec (m : H0 G M) : ∀ (g : G), g • (m : M) = m :=
-- this is the last time we see `m.2`
m.2

/-

The idea now is that we should avoid `m.1` and `m.2` completely,
and use `m : M` or `↑m` for the element of the module, and `m.spec` for
the proof that it is `G`-invariant.

## Basic Infrastructure

We have made a new definition, `H0`, and now we need to make it easier
to use. Things we do here:

* We want to get (for free) that `H0 G M` is a group (so we need to put
  this fact into the type class mechanism).

* We want to know that two terms of type `H0 G M` are equal if
  and only if the corresponding terms of type `M` are equal (so we want to
  prove an extensionality lemma).

* We want to know that things like 0 and addition coincide in `M`
  and `H0 G M` (the coercion is a group homomorphism)

Let's start by making H⁰(G, M) a.k.a. `H0 G M` into a group. This is easy
because `H0 G M` is the type corresponding to the term `H0_subgroup G M`
which is a subgroup, hence a group.

-/

-- tell type class inference that `H0 G M` is a group
instance : add_comm_group (H0 G M) :=
add_subgroup.to_add_comm_group (H0_subgroup G M)

-- Let's now prove an ext_iff lemma (useful for rewriting)
lemma ext_iff (m₁ m₂ : H0 G M) : m₁ = m₂ ↔ (m₁ : M) = (m₂ : M) :=
begin
  split,
  { -- one way uses a rewrite
    rintro rfl, refl },
  { -- the other way is just set extensionality
    ext }
end

-- Let's tell the simplifier how the group structure (addition, 0, negation
-- and subtraction) works with respect to the coercion. All the proofs
-- are true by definition

@[simp] lemma coe_add (a b : H0 G M) :
  ((a + b : H0 G M) : M) = a + b :=
begin
  -- true by definition
  refl
end

@[simp] lemma coe_zero : ((0 : H0 G M) : M) = 0 := rfl -- true by definition

@[simp] lemma coe_neg (a : H0 G M) :
  ((-a : H0 G M) : M) = -a := rfl

@[simp] lemma coe_sub (a b : H0 G M) :
  ((a - b : H0 G M) : M) = a - b := rfl

-- try these
example (m₁ m₂ m₃ : H0 G M) : m₁ + (m₂ - m₁ + m₃) = m₃ + m₂ :=
begin
  -- which tactic?
  sorry
end

example (g : G) (m : H0 G M) : g • (m + m : M) = m + m :=
begin
  -- can you help the simplifier?
  sorry
end

end H0

/-

## Definition of `φ.H0 : H0 G M →+ H0 G N`

Now let's prove that a G-module map `φ : M →+[G] N` induces a natural
abelian group hom `φ.H0 : H⁰(G,M) →+ H⁰(G,N)`. I would rather do this in
`φ`'s namespace, which is `distrib_mul_action_hom`, because then
I can write `φ.H0` directly. This is definitions so it's a bit messy.
I left you one sorry -- prove that if `m ∈ H⁰(G,M)` then `φ(m)` is actually
`G`-invariant.
-/

namespace distrib_mul_action_hom

variables {G M N : Type}
  [monoid G] [add_comm_group M] [add_comm_group N]
  [distrib_mul_action G M] [distrib_mul_action G N]
  (a : M) (b : N)

-- Let's first define the group homomorphism `H0 G M →+ H0 G N` induced by `φ`.
-- Recall that the constructor of `H0 G N` needs as input a pair consisting
-- of `b : N` and `hb : ∀ g, g • b = b`, and we make the element of `H0 G N`
-- using the `⟨b, hb⟩` notation. I am playing with the idea of
-- distinguishing `n : H0 G N` and `b = ↑n` when we're taking these
-- things apart explicitly.

/- The function underlying the group homomorphism `H⁰(G,M) → H⁰(G,N)`
   induced by a `G`-equivariant group homomorphism `φ : M →+[G] N` -/
def H0_underlying_function (φ : M →+[G] N) (a : H0 G M) : H0 G N :=
⟨φ a, begin
  -- use φ.map_smul and a.spec to prove that this map is well-defined.
  -- Remember that `rw` doesn't work under binders, and ∀ is a binder, so start
  -- with `intros`.
  sorry
end⟩

/-- The group homomorphism  `H⁰(G,M) →+ H⁰(G,N)`
   induced by a `G`-equivariant group homomorphism `φ : M →+[G] N` -/
def H0 (φ : M →+[G] N) : H0 G M →+ H0 G N :=
-- to make a group homomorphism we need apply a constructor
add_monoid_hom.mk'
-- to the function we just made
(H0_underlying_function φ)
-- and then prove that this function preserves addition.
begin
  -- this is a bit of a mess, I'll do it.
  intros a b,
  simp only [H0_underlying_function],
  ext,
  simp,
end

end distrib_mul_action_hom

-- The API for `φ.H0` starts here

namespace H0

variables {G M N : Type}
  [monoid G] [add_comm_group M] [add_comm_group N]
  [distrib_mul_action G M] [distrib_mul_action G N]
  (a : M) (b : N)

/-

## An API for `φ.H0`

So now if `φ : M →+[G] N` is a G-module homomorphism, we can talk
about `φ.H0 : H0 G M →+ H0 G N`, an abelian group homomorphism
from H⁰(G,M) to H⁰(G,N).

As ever, this is a definition so we need to make a little API.
We start with the following handy fact:

Given a G-module map `φ : M →+[G] N`, The following diagram commutes:

            φ
  M ----------------> N
  /\                  /\
  | coercion ↑        | coercion ↑
  |                   |
  |                   |
H⁰(G,M) ---------> H⁰(G,N)
-/
@[simp] lemma coe_apply (m : H0 G M) (φ : M →+[G] N) :
  ((φ.H0 m) : N) = φ m :=
begin
  -- Look at the goal the way I have written it.
  -- Unfold the definitions. It's true by definition.
  -- Look at the goal the way Lean is displaying it
  -- right now. It's just coercions everywhere. Ignore them.
  sorry
end

open distrib_mul_action_hom

-- If you're in to that sort of thing, you can prove that `φ.H0`
-- is functorial. That's it and comp.
def id_apply (m : H0 G M) :
  (distrib_mul_action_hom.id G).H0 m = m :=
begin
  -- remember extensionality.
  sorry,
end

variables {P : Type} [add_comm_group P] [distrib_mul_action G P]

def comp (φ : M →+[G] N) (ψ : N →+[G] P) :
  (ψ ∘ᵍ φ).H0 = ψ.H0.comp φ.H0 :=
begin
  -- be sure to check out the proof in the solutions.
  sorry
end

end H0

/-

## First exactness result

If 0 → M → N → P → 0 is a short exact sequence, then there
is a long exact sequence

0 → H⁰(G,M) → H⁰(G,N) → H⁰(G,P)

and we can't go any further because we haven't defined H¹! This boils
down to two theorems; let's prove them.

-/
open function

open distrib_mul_action_hom

variables {G M N P : Type}
  [monoid G] [add_comm_group M] [add_comm_group N] [add_comm_group P]
  [distrib_mul_action G M] [distrib_mul_action G N] [distrib_mul_action G P]
  (a : M) (b : N)

-- 0 → H⁰(G,M) → H⁰(G,N) is exact, i.e. φ.H0 is injective
theorem H0_hom.left_exact (φ : M →+[G] N) (hφ : injective φ) :
  injective φ.H0 :=
begin
  sorry
end

-- H⁰(G,M) → H⁰(G,N) → H⁰(G,P) is exact, i.e. an image equals a kernel.
theorem H0_hom.middle_exact (φ : M →+[G] N)
  (ψ : N →+[G] P) (h : is_short_exact φ ψ) :
  φ.H0.range = ψ.H0.ker :=
begin
  sorry,
end

-- Do you think we should prove something weaker? I quite
-- like the API we have for short exact sequences.


import tactic

variables {α : Type*} [comm_ring α]

def sum_of_squares (x : α) := ∃ a b, x = a^2 + b^2

theorem sum_of_squares_mul {x y : α}
    (sosx : sum_of_squares x) (sosy : sum_of_squares y) :
  sum_of_squares (x * y) :=
begin
  rcases sosx with ⟨a, b, xeq⟩,
  rcases sosy with ⟨c, d, yeq⟩,
  rw [xeq, yeq],
  use [a*c - b*d, a*d + b*c],
  ring,
end

/- using the cases tactic recursively -/
example {x y : α}
    (sosx : sum_of_squares x) (sosy : sum_of_squares y) :
  sum_of_squares (x * y) :=
begin
  cases sosx with a xeq,
  cases xeq with b xeqab,
    cases sosy with c yeq,
    cases yeq with d yeqcd,
    rw [xeqab, yeqcd],
    use [a*c - b*d, a*d + b*c],
    ring,
end


import data.real.basic

variables a b c : ℝ

#check le_antisymm
#check le_min
#check le_trans
#check min_le_right a b
#check min_le_left b c

-- BEGIN

example : min (min a b) c = min a (min b c) :=
begin
  apply le_antisymm,
  { apply le_min,
    exact le_trans (min_le_left (min a b) c) (min_le_left a b),
    apply le_min,
    exact le_trans (min_le_left (min a b) c) (min_le_right a b),
    exact min_le_right (min a b) c,
  },
  { apply le_min,
    apply le_min,
    exact min_le_left a (min b c),
    exact le_trans (min_le_right a (min b c)) (min_le_left b c),
    exact le_trans (min_le_right a (min b c)) (min_le_right b c),
  },
end
-- END


import tactic
import data.finmap
open tactic

namespace start
inductive aexp
| ANum (n : ℕ)
| APlus (a₁ a₂ : aexp)
| AMinus (a₁ a₂ : aexp)
| AMult (a₁ a₂ : aexp)
open aexp

inductive bexp
| BTrue
| BFalse
| BEq (a₁ a₂ : aexp)
| BLe (a₂ a₂ : aexp)
| BNot (b : bexp)
| BAnd (b₁ b₂ : bexp)
open bexp

def aeval : aexp → ℕ
| (ANum n) := n
| (APlus a₁ a₂) := aeval a₁ + aeval a₂
| (AMinus a₁ a₂) := aeval a₁ - aeval a₂
| (AMult a₁ a₂) := aeval a₁ * aeval a₂

example : aeval (APlus (ANum 2) (ANum 2)) = 4 := rfl

def beval : bexp → bool
| BTrue := true
| BFalse := false
| (BEq a₁ a₂) := aeval a₁ = aeval a₂
| (BLe a₁ a₂) := aeval a₁ ≤ aeval a₂
| (BNot b₁) := ¬beval b₁
| (BAnd b₁ b₂) := beval b₁ ∧ beval b₂

def optimize_zero_plus : aexp → aexp
| (ANum n) := ANum n
| (APlus (ANum 0) e₂) := optimize_zero_plus e₂
| (APlus e₁ e₂) := APlus (optimize_zero_plus e₁) (optimize_zero_plus e₂)
| (AMinus e₁ e₂) := AMinus (optimize_zero_plus e₁) (optimize_zero_plus e₂)
| (AMult e₁ e₂) := AMult (optimize_zero_plus e₁) (optimize_zero_plus e₂)

example : optimize_zero_plus (APlus (ANum 2)
                                    (APlus (ANum 0)
                                           (APlus (ANum 0) (ANum 1))))
        = APlus (ANum 2) (ANum 1) := rfl

theorem optimize_zero_plus_sound : ∀ a, aeval (optimize_zero_plus a) = aeval a :=
begin
    intros a, induction a;
    try { simp [optimize_zero_plus, aeval, a_ih_a₁, a_ih_a₂] <|> refl },
    rcases a_a₁ with ⟨_|n⟩;
    simp [optimize_zero_plus, a_ih_a₂, a_ih_a₁, aeval] at *; assumption
end

inductive aevalR : aexp → ℕ → Prop
| E_ANum {n} : aevalR (ANum n) n
| E_APlus {e₁ e₂ n₁ n₂} :
    aevalR e₁ n₁ → aevalR e₂ n₂ → aevalR (APlus e₁ e₂) (n₁ + n₂)
| E_AMinus {e₁ e₂ n₁ n₂} :
    aevalR e₁ n₁ → aevalR e₂ n₂ → aevalR (AMinus e₁ e₂) (n₁ - n₂)
| E_AMult {e₁ e₂ n₁ n₂} :
    aevalR e₁ n₁ → aevalR e₂ n₂ → aevalR (AMult e₁ e₂) (n₁ * n₂)

local notation e ` \\ ` n := aevalR e n

theorem aeval_iff_aevalR : ∀ a n, (a \\ n) ↔ aeval a = n :=
begin
    intros, split,
    { intro h, induction h; subst_vars; refl },
    revert n, induction a; intros; subst_vars; constructor; simp only [a_ih_a₁, a_ih_a₂],
end

end start

namespace extended_aexp
inductive aexp
| ANum (n : ℕ)
| AId (x : string)
| APlus (a₁ a₂ : aexp)
| AMinus (a₁ a₂ : aexp)
| AMult (a₁ a₂ : aexp)
open aexp

inductive bexp
| BTrue
| BFalse
| BEq (a1 a2 : aexp)
| BLe (a1 a2 : aexp)
| BNot (b : bexp)
| BAnd (b1 b2 : bexp)
open bexp

inductive com
| CSkip
| CAss (x : string) (a : aexp)
| CSeq (c₁ c₂ : com)
| CIf (b : bexp) (c₁ c₂ : com)
| CWhile (b : bexp) (c : com)
open com

local infixr `;; `:40 := CSeq
local infix ` ::= `:60 := CAss
local notation ` SKIP ` := CSkip
local notation ` WHILE ` b ` DO ` c ` END ` := CWhile b c
local notation ` TEST ` c₁ ` THEN ` c₂ ` ELSE ` c₃ ` FI ` := CIf c₁ c₂ c₃

def W := "W"
def X := "X"
def Y := "Y"
def Z := "Z"

instance has_coe_str_aexp : has_coe string aexp := ⟨AId⟩
instance has_coe_nat_aexp : has_coe ℕ aexp := ⟨ANum⟩
instance has_one_aexp : has_one aexp := ⟨ANum 1⟩
instance has_zero_aexp : has_zero aexp := ⟨ANum 0⟩
instance has_add_aexp : has_add aexp := ⟨APlus⟩
instance has_mul_aexp : has_mul aexp := ⟨AMult⟩
instance has_sub_aexp : has_sub aexp := ⟨AMinus⟩
local prefix `!` := BNot
local infix ` === `:50 := BEq

def fact_in_lean :=
    Z ::= X;;
    Z ::= 1;;
    WHILE !Z === 0 DO
        Y ::= Y * Z;;
        Z ::= Z - 1
    END

def program_state := finmap (λ (v:string), ℕ)

local notation x ` ↦ `:50 y `; `:1 m := finmap.insert x y m

lemma program_state_insert_eq (x) (v : ℕ) (s : program_state) :
    (x ↦ v; s).lookup x = some v := by simp

lemma program_state_insert_neq (x₁ x₂) (v : ℕ) (s : program_state) (h : x₁ ≠ x₂) :
    (x₁ ↦ v; s).lookup x₂ = s.lookup x₂ := finmap.lookup_insert_of_ne s h.symm

lemma program_state_shadow (x) (v₁ v₂ : ℕ) (s : program_state) :
    (x ↦ v₁; x ↦ v₂; s) = (x ↦ v₁; s) := by simp

lemma program_state_insert_same (x) (s : program_state) {v} (h : s.lookup x = some v) :
    (x ↦ v; s) = s :=
begin
    apply finmap.ext_lookup, intro y,
    cases dec_em (x = y) with hxy hnxy,
    { rw ←hxy, symmetry, simpa, },
    apply program_state_insert_neq, assumption,
end

lemma program_state_permute (x₁ x₂) (v₁ v₂ : ℕ) (s : program_state) (h : x₁ ≠ x₂) :
    (x₁ ↦ v₁; x₂ ↦ v₂; s) = (x₂ ↦ v₂; x₁ ↦ v₁; s) := finmap.insert_insert_of_ne s h.symm

def aeval (st : program_state) : aexp → ℕ
| (ANum n) := n
| (AId x) := (st.lookup x).get_or_else 0
| (APlus a₁ a₂) := aeval a₁ + aeval a₂
| (AMinus a₁ a₂) := aeval a₁ - aeval a₂
| (AMult a₁ a₂) := aeval a₁ * aeval a₂

def beval (st : program_state) : bexp → bool
| BTrue := true
| BFalse := false
| (BEq a₁ a₂) := aeval st a₁ = aeval st a₂
| (BLe a₁ a₂) := aeval st a₁ ≤ aeval st a₂
| (BNot b₁) := ¬(beval b₁)
| (BAnd b₁ b₂) := beval b₁ && beval b₂

inductive ceval : com → program_state → program_state → Prop
| E_Skip {st} : ceval SKIP st st
| E_Ass {st a₁ n x} :
    aeval st a₁ = n →
    ceval (x ::= a₁) st (x ↦ n; st)
| E_Seq {c₁ c₂ st st' st''} :
    ceval c₁ st st' →
    ceval c₂ st' st'' →
    ceval (c₁;; c₂) st st''
| E_IfTrue {st st' b c₁ c₂} :
    beval st b = true →
    ceval c₁ st st' →
    ceval TEST b THEN c₁ ELSE c₂ FI st st'
| E_IfFalse {st st' b c₁ c₂} :
    beval st b = false →
    ceval c₂ st st' →
    ceval TEST b THEN c₁ ELSE c₂ FI st st'
| E_WhileFalse {b st c} :
    beval st b = false →
    ceval WHILE b DO c END st st
| E_WhileTrue {st st' st'' b c} :
    beval st b = true →
    ceval c st st' →
    ceval WHILE b DO c END st' st'' →
    ceval WHILE b DO c END st st''

notation st ` =[ ` c ` ]=> ` st' := ceval c st st'

theorem ceval_deterministic {c st st₁ st₂} (h₁ : st =[ c ]=> st₁) (h₂ : st =[ c ]=> st₂) : st₁ = st₂ :=
begin
    intros, revert st₂, induction h₁; intros; cases h₂; subst_vars; try {solve_by_elim},
    { apply_assumption, specialize h₁_ih_a h₂_a, subst_vars, assumption },
    all_goals { rw h₁_a at h₂_a, injections },
    specialize h₁_ih_a h₂_a_1, subst_vars, repeat {apply_assumption}
end

end extended_aexp


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import algebra.order.absolute_value
import algebra.field_power
import ring_theory.int.basic
import tactic.basic
import tactic.ring_exp
import number_theory.divisors
import data.nat.factorization

/-!
# p-adic norm

This file defines the p-adic valuation and the p-adic norm on ℚ.

The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on p.

The valuation induces a norm on ℚ. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

universe u

open nat

open_locale rat

open multiplicity

/--
For `p ≠ 1`, the p-adic valuation of an integer `z ≠ 0` is the largest natural number `n` such that
p^n divides z.

`padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
valuation of `q.denom`.
If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to 0.
-/
def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
if h : q ≠ 0 ∧ p ≠ 1
then (multiplicity (p : ℤ) q.num).get
    (multiplicity.finite_int_iff.2 ⟨h.2, rat.num_ne_zero_of_ne_zero h.1⟩) -
  (multiplicity (p : ℤ) q.denom).get
    (multiplicity.finite_int_iff.2 ⟨h.2, by exact_mod_cast rat.denom_ne_zero _⟩)
else 0

/--
A simplification of the definition of `padic_val_rat p q` when `q ≠ 0` and `p` is prime.
-/
lemma padic_val_rat_def (p : ℕ) [hp : fact p.prime] {q : ℚ} (hq : q ≠ 0) : padic_val_rat p q =
  (multiplicity (p : ℤ) q.num).get (finite_int_iff.2 ⟨hp.1.ne_one, rat.num_ne_zero_of_ne_zero hq⟩) -
  (multiplicity (p : ℤ) q.denom).get
    (finite_int_iff.2 ⟨hp.1.ne_one, by exact_mod_cast rat.denom_ne_zero _⟩) :=
dif_pos ⟨hq, hp.1.ne_one⟩

namespace padic_val_rat
open multiplicity
variables {p : ℕ}

/--
`padic_val_rat p q` is symmetric in `q`.
-/
@[simp] protected lemma neg (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q :=
begin
  unfold padic_val_rat,
  split_ifs,
  { simp [-add_comm]; refl },
  { exfalso, simp * at * },
  { exfalso, simp * at * },
  { refl }
end

/--
`padic_val_rat p 0` is 0 for any `p`.
-/
@[simp]
protected lemma zero (m : nat) : padic_val_rat m 0 = 0 := rfl

/--
`padic_val_rat p 1` is 0 for any `p`.
-/
@[simp] protected lemma one : padic_val_rat p 1 = 0 :=
by unfold padic_val_rat; split_ifs; simp *

/--
For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1.
-/
@[simp] lemma padic_val_rat_self (hp : 1 < p) : padic_val_rat p p = 1 :=
by unfold padic_val_rat; split_ifs; simp [*, nat.one_lt_iff_ne_zero_and_ne_one] at *

/--
The p-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`.
-/
lemma padic_val_rat_of_int (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) :
  padic_val_rat p (z : ℚ) = (multiplicity (p : ℤ) z).get
    (finite_int_iff.2 ⟨hp, hz⟩) :=
by rw [padic_val_rat, dif_pos]; simp *; refl

end padic_val_rat

/--
A convenience function for the case of `padic_val_rat` when both inputs are natural numbers.
-/
def padic_val_nat (p : ℕ) (n : ℕ) : ℕ :=
int.to_nat (padic_val_rat p n)

section padic_val_nat

/--
`padic_val_nat` is defined as an `int.to_nat` cast;
this lemma ensures that the cast is well-behaved.
-/
lemma zero_le_padic_val_rat_of_nat (p n : ℕ) : 0 ≤ padic_val_rat p n :=
begin
  unfold padic_val_rat,
  split_ifs,
  { simp, },
  { trivial, },
end

/--
`padic_val_rat` coincides with `padic_val_nat`.
-/
@[simp, norm_cast] lemma padic_val_rat_of_nat (p n : ℕ) :
  ↑(padic_val_nat p n) = padic_val_rat p n :=
begin
  unfold padic_val_nat,
  rw int.to_nat_of_nonneg (zero_le_padic_val_rat_of_nat p n),
end

/--
A simplification of `padic_val_nat` when one input is prime, by analogy with `padic_val_rat_def`.
-/
lemma padic_val_nat_def {p : ℕ} [hp : fact p.prime] {n : ℕ} (hn : n ≠ 0) :
  padic_val_nat p n =
  (multiplicity p n).get
    (multiplicity.finite_nat_iff.2 ⟨nat.prime.ne_one hp.1, bot_lt_iff_ne_bot.mpr hn⟩) :=
begin
  have n_nonzero : (n : ℚ) ≠ 0, by simpa only [cast_eq_zero, ne.def],
  -- Infinite loop with @simp padic_val_rat_of_nat unless we restrict the available lemmas here,
  -- hence the very long list
  simpa only
    [ int.coe_nat_multiplicity p n, rat.coe_nat_denom n, (padic_val_rat_of_nat p n).symm,
      int.coe_nat_zero, int.coe_nat_inj', sub_zero, get_one_right, int.coe_nat_succ, zero_add,
      rat.coe_nat_num ]
    using padic_val_rat_def p n_nonzero,
end

@[simp] lemma padic_val_nat_self (p : ℕ) [fact p.prime] : padic_val_nat p p = 1 :=
by simp [padic_val_nat_def (fact.out p.prime).ne_zero]

lemma one_le_padic_val_nat_of_dvd
  {n p : nat} [prime : fact p.prime] (nonzero : n ≠ 0) (div : p ∣ n) :
  1 ≤ padic_val_nat p n :=
begin
  rw @padic_val_nat_def _ prime _ nonzero,
  let one_le_mul : _ ≤ multiplicity p n :=
    @multiplicity.le_multiplicity_of_pow_dvd _ _ _ p n 1 (begin norm_num, exact div end),
  simp only [nat.cast_one] at one_le_mul,
  rcases one_le_mul with ⟨_, q⟩,
  dsimp at q,
  solve_by_elim,
end

@[simp]
lemma padic_val_nat_zero (m : nat) : padic_val_nat m 0 = 0 := rfl

@[simp]
lemma padic_val_nat_one (m : nat) : padic_val_nat m 1 = 0 := by simp [padic_val_nat]

end padic_val_nat

namespace padic_val_rat
open multiplicity
variables (p : ℕ) [p_prime : fact p.prime]
include p_prime

/--
The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`.
-/
lemma finite_int_prime_iff {p : ℕ} [p_prime : fact p.prime] {a : ℤ} : finite (p : ℤ) a ↔ a ≠ 0 :=
by simp [finite_int_iff, ne.symm (ne_of_lt (p_prime.1.one_lt))]

/--
A rewrite lemma for `padic_val_rat p q` when `q` is expressed in terms of `rat.mk`.
-/
protected lemma defn {q : ℚ} {n d : ℤ} (hqz : q ≠ 0) (qdf : q = n /. d) :
  padic_val_rat p q = (multiplicity (p : ℤ) n).get (finite_int_iff.2
    ⟨ne.symm $ ne_of_lt p_prime.1.one_lt, λ hn, by simp * at *⟩) -
  (multiplicity (p : ℤ) d).get (finite_int_iff.2 ⟨ne.symm $ ne_of_lt p_prime.1.one_lt,
    λ hd, by simp * at *⟩) :=
have hn : n ≠ 0, from rat.mk_num_ne_zero_of_ne_zero hqz qdf,
have hd : d ≠ 0, from rat.mk_denom_ne_zero_of_ne_zero hqz qdf,
let ⟨c, hc1, hc2⟩ := rat.num_denom_mk hn hd qdf in
by rw [padic_val_rat, dif_pos];
  simp [hc1, hc2, multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1),
    (ne.symm (ne_of_lt p_prime.1.one_lt)), hqz]

/--
A rewrite lemma for `padic_val_rat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected lemma mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r :=
have q*r = (q.num * r.num) /. (↑q.denom * ↑r.denom), by rw_mod_cast rat.mul_num_denom,
have hq' : q.num /. q.denom ≠ 0, by rw rat.num_denom; exact hq,
have hr' : r.num /. r.denom ≠ 0, by rw rat.num_denom; exact hr,
have hp' : _root_.prime (p : ℤ), from nat.prime_iff_prime_int.1 p_prime.1,
begin
  rw [padic_val_rat.defn p (mul_ne_zero hq hr) this],
  conv_rhs { rw [←(@rat.num_denom q), padic_val_rat.defn p hq',
    ←(@rat.num_denom r), padic_val_rat.defn p hr'] },
  rw [multiplicity.mul' hp', multiplicity.mul' hp']; simp [add_comm, add_left_comm, sub_eq_add_neg]
end

/--
A rewrite lemma for `padic_val_rat p (q^k)` with condition `q ≠ 0`.
-/
protected lemma pow {q : ℚ} (hq : q ≠ 0) {k : ℕ} :
    padic_val_rat p (q ^ k) = k * padic_val_rat p q :=
by induction k; simp [*, padic_val_rat.mul _ hq (pow_ne_zero _ hq),
  pow_succ, add_mul, add_comm]

/--
A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`.
-/
protected lemma inv {q : ℚ} (hq : q ≠ 0) :
  padic_val_rat p (q⁻¹) = -padic_val_rat p q :=
by rw [eq_neg_iff_add_eq_zero, ← padic_val_rat.mul p (inv_ne_zero hq) hq,
    inv_mul_cancel hq, padic_val_rat.one]

/--
A rewrite lemma for `padic_val_rat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected lemma div {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r :=
by rw [div_eq_mul_inv, padic_val_rat.mul p hq (inv_ne_zero hr),
    padic_val_rat.inv p hr, sub_eq_add_neg]

/--
A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂),
in terms of divisibility by `p^n`.
-/
lemma padic_val_rat_le_padic_val_rat_iff {n₁ n₂ d₁ d₂ : ℤ}
  (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
  padic_val_rat p (n₁ /. d₁) ≤ padic_val_rat p (n₂ /. d₂) ↔
  ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
have hf1 : finite (p : ℤ) (n₁ * d₂),
  from finite_int_prime_iff.2 (mul_ne_zero hn₁ hd₂),
have hf2 : finite (p : ℤ) (n₂ * d₁),
  from finite_int_prime_iff.2 (mul_ne_zero hn₂ hd₁),
  by conv
  { to_lhs,
    rw [padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₁ hd₁) rfl,
      padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₂ hd₂) rfl,
      sub_le_iff_le_add',
      ← add_sub_assoc,
      le_sub_iff_add_le],
    norm_cast,
    rw [← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf1, add_comm,
      ← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf2,
      enat.get_le_get, multiplicity_le_multiplicity_iff] }

/--
Sufficient conditions to show that the p-adic valuation of `q` is less than or equal to the
p-adic vlauation of `q + r`.
-/
theorem le_padic_val_rat_add_of_le {q r : ℚ}
  (hqr : q + r ≠ 0)
  (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_val_rat p q ≤ padic_val_rat p (q + r) :=
if hq : q = 0 then by simpa [hq] using h else
if hr : r = 0 then by simp [hr] else
have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hq,
have hqd : (q.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
have hrn : r.num ≠ 0, from rat.num_ne_zero_of_ne_zero hr,
have hrd : (r.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
have hqreq : q + r = (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)),
  from rat.add_num_denom _ _,
have hqrd : q.num * ↑(r.denom) + ↑(q.denom) * r.num ≠ 0,
  from rat.mk_num_ne_zero_of_ne_zero hqr hqreq,
begin
  conv_lhs { rw ←(@rat.num_denom q) },
  rw [hqreq, padic_val_rat_le_padic_val_rat_iff p hqn hqrd hqd (mul_ne_zero hqd hrd),
    ← multiplicity_le_multiplicity_iff, mul_left_comm,
    multiplicity.mul (nat.prime_iff_prime_int.1 p_prime.1), add_mul],
  rw [←(@rat.num_denom q), ←(@rat.num_denom r),
    padic_val_rat_le_padic_val_rat_iff p hqn hrn hqd hrd, ← multiplicity_le_multiplicity_iff] at h,
  calc _ ≤ min (multiplicity ↑p (q.num * ↑(r.denom) * ↑(q.denom)))
    (multiplicity ↑p (↑(q.denom) * r.num * ↑(q.denom))) : (le_min
    (by rw [@multiplicity.mul _ _ _ _ (_ * _) _ (nat.prime_iff_prime_int.1 p_prime.1), add_comm])
    (by rw [mul_assoc, @multiplicity.mul _ _ _ _ (q.denom : ℤ)
        (_ * _) (nat.prime_iff_prime_int.1 p_prime.1)];
      exact add_le_add_left h _))
    ... ≤ _ : min_le_multiplicity_add
end

/--
The minimum of the valuations of `q` and `r` is less than or equal to the valuation of `q + r`.
-/
theorem min_le_padic_val_rat_add {q r : ℚ} (hqr : q + r ≠ 0) :
  min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) :=
(le_total (padic_val_rat p q) (padic_val_rat p r)).elim
  (λ h, by rw [min_eq_left h]; exact le_padic_val_rat_add_of_le _ hqr h)
  (λ h, by rw [min_eq_right h, add_comm]; exact le_padic_val_rat_add_of_le _
    (by rwa add_comm) h)

open_locale big_operators

/-- A finite sum of rationals with positive p-adic valuation has positive p-adic valuation
  (if the sum is non-zero). -/
theorem sum_pos_of_pos {n : ℕ} {F : ℕ → ℚ}
  (hF : ∀ i, i < n → 0 < padic_val_rat p (F i)) (hn0 : ∑ i in finset.range n, F i ≠ 0) :
  0 < padic_val_rat p (∑ i in finset.range n, F i) :=
begin
  induction n with d hd,
  { exact false.elim (hn0 rfl) },
  { rw finset.sum_range_succ at hn0 ⊢,
    by_cases h : ∑ (x : ℕ) in finset.range d, F x = 0,
    { rw [h, zero_add],
      exact hF d (lt_add_one _) },
    { refine lt_of_lt_of_le _ (min_le_padic_val_rat_add p hn0),
      { refine lt_min (hd (λ i hi, _) h) (hF d (lt_add_one _)),
        exact hF _ (lt_trans hi (lt_add_one _)) }, } }
end

end padic_val_rat

namespace padic_val_nat

/--
A rewrite lemma for `padic_val_nat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected lemma mul (p : ℕ) [p_prime : fact p.prime] {q r : ℕ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_nat p (q * r) = padic_val_nat p q + padic_val_nat p r :=
begin
  apply int.coe_nat_inj,
  simp only [padic_val_rat_of_nat, nat.cast_mul],
  rw padic_val_rat.mul,
  norm_cast,
  exact cast_ne_zero.mpr hq,
  exact cast_ne_zero.mpr hr,
end

protected lemma div_of_dvd (p : ℕ) [hp : fact p.prime] {a b : ℕ} (h : b ∣ a) :
  padic_val_nat p (a / b) = padic_val_nat p a - padic_val_nat p b :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp },
  obtain ⟨k, rfl⟩ := h,
  obtain ⟨hb, hk⟩ := mul_ne_zero_iff.mp ha,
  rw [mul_comm, k.mul_div_cancel hb.bot_lt, padic_val_nat.mul p hk hb, nat.add_sub_cancel]
end

/--
Dividing out by a prime factor reduces the padic_val_nat by 1.
-/
protected lemma div {p : ℕ} [p_prime : fact p.prime] {b : ℕ} (dvd : p ∣ b) :
  (padic_val_nat p (b / p)) = (padic_val_nat p b) - 1 :=
begin
  convert padic_val_nat.div_of_dvd p dvd,
  rw padic_val_nat_self p
end

/-- A version of `padic_val_rat.pow` for `padic_val_nat` -/
protected lemma pow (p q n : ℕ) [fact p.prime] (hq : q ≠ 0) :
  padic_val_nat p (q ^ n) = n * padic_val_nat p q :=
begin
  apply @nat.cast_injective ℤ,
  push_cast,
  exact padic_val_rat.pow _ (cast_ne_zero.mpr hq),
end

@[simp] protected lemma prime_pow (p n : ℕ) [fact p.prime] : padic_val_nat p (p ^ n) = n :=
by rw [padic_val_nat.pow p _ _ (fact.out p.prime).ne_zero, padic_val_nat_self p, mul_one]

protected lemma div_pow {p : ℕ} [p_prime : fact p.prime] {b k : ℕ} (dvd : p ^ k ∣ b) :
  (padic_val_nat p (b / p ^ k)) = (padic_val_nat p b) - k :=
begin
  convert padic_val_nat.div_of_dvd p dvd,
  rw padic_val_nat.prime_pow
end

end padic_val_nat

section padic_val_nat

/--
If a prime doesn't appear in `n`, `padic_val_nat p n` is `0`.
-/
lemma padic_val_nat_of_not_dvd {p : ℕ} [fact p.prime] {n : ℕ} (not_dvd : ¬(p ∣ n)) :
  padic_val_nat p n = 0 :=
begin
  by_cases hn : n = 0,
  { subst hn, simp at not_dvd, trivial, },
  { rw padic_val_nat_def hn,
    exact (@multiplicity.unique' _ _ _ p n 0 (by simp) (by simpa using not_dvd)).symm,
    assumption, },
end

lemma dvd_of_one_le_padic_val_nat {n p : nat} [prime : fact p.prime] (hp : 1 ≤ padic_val_nat p n) :
  p ∣ n :=
begin
  by_contra h,
  rw padic_val_nat_of_not_dvd h at hp,
  exact lt_irrefl 0 (lt_of_lt_of_le zero_lt_one hp),
end

lemma pow_padic_val_nat_dvd {p n : ℕ} [fact (nat.prime p)] : p ^ (padic_val_nat p n) ∣ n :=
begin
  cases nat.eq_zero_or_pos n with hn hn,
  { rw hn, exact dvd_zero (p ^ padic_val_nat p 0) },
  { rw multiplicity.pow_dvd_iff_le_multiplicity,
    apply le_of_eq,
    rw padic_val_nat_def (ne_of_gt hn),
    { apply enat.coe_get },
    { apply_instance } }
end

lemma pow_succ_padic_val_nat_not_dvd {p n : ℕ} [hp : fact (nat.prime p)] (hn : 0 < n) :
  ¬ p ^ (padic_val_nat p n + 1) ∣ n :=
begin
  rw multiplicity.pow_dvd_iff_le_multiplicity,
  rw padic_val_nat_def (ne_of_gt hn),
  { rw [nat.cast_add, enat.coe_get],
    simp only [nat.cast_one, not_le],
    apply enat.lt_add_one (ne_top_iff_finite.2 (finite_nat_iff.2 ⟨hp.elim.ne_one, hn⟩)) },
  { apply_instance }
end

lemma padic_val_nat_primes {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_val_nat p q = 0 :=
@padic_val_nat_of_not_dvd p p_prime q $
(not_congr (iff.symm (prime_dvd_prime_iff_eq p_prime.1 q_prime.1))).mp neq

protected lemma padic_val_nat.div' {p : ℕ} [p_prime : fact p.prime] :
  ∀ {m : ℕ} (cpm : coprime p m) {b : ℕ} (dvd : m ∣ b), padic_val_nat p (b / m) = padic_val_nat p b
| 0 := λ cpm b dvd, by { rw zero_dvd_iff at dvd, rw [dvd, nat.zero_div], }
| (n + 1) :=
  λ cpm b dvd,
  begin
    rcases dvd with ⟨c, rfl⟩,
    rw [mul_div_right c (nat.succ_pos _)],by_cases hc : c = 0,
    { rw [hc, mul_zero] },
    { rw padic_val_nat.mul,
      { suffices : ¬ p ∣ (n+1),
        { rw [padic_val_nat_of_not_dvd this, zero_add] },
        contrapose! cpm,
        exact p_prime.1.dvd_iff_not_coprime.mp cpm },
      { exact nat.succ_ne_zero _ },
      { exact hc } },
  end

lemma padic_val_nat_eq_factorization (p n : ℕ) [hp : fact p.prime] :
  padic_val_nat p n = n.factorization p :=
begin
  by_cases hn : n = 0, { subst hn, simp },
  rw @padic_val_nat_def p _ n hn,
  simp [@multiplicity_eq_factorization n p hp.elim hn],
end

open_locale big_operators

lemma prod_pow_prime_padic_val_nat (n : nat) (hn : n ≠ 0) (m : nat) (pr : n < m) :
  ∏ p in finset.filter nat.prime (finset.range m), p ^ (padic_val_nat p n) = n :=
begin
  nth_rewrite_rhs 0 ←factorization_prod_pow_eq_self hn,
  rw eq_comm,
  apply finset.prod_subset_one_on_sdiff,
  { exact λ p hp, finset.mem_filter.mpr
      ⟨finset.mem_range.mpr (gt_of_gt_of_ge pr (le_of_mem_factorization hp)),
       prime_of_mem_factorization hp⟩ },
  { intros p hp,
    cases finset.mem_sdiff.mp hp with hp1 hp2,
    haveI := fact_iff.mpr (finset.mem_filter.mp hp1).2,
    rw padic_val_nat_eq_factorization p n,
    simp [finsupp.not_mem_support_iff.mp hp2] },
  { intros p hp,
    haveI := fact_iff.mpr (prime_of_mem_factorization hp),
    simp [padic_val_nat_eq_factorization] }
end

lemma range_pow_padic_val_nat_subset_divisors {n : ℕ} (p : ℕ) [fact p.prime] (hn : n ≠ 0) :
  (finset.range (padic_val_nat p n + 1)).image (pow p) ⊆ n.divisors :=
begin
  intros t ht,
  simp only [exists_prop, finset.mem_image, finset.mem_range] at ht,
  obtain ⟨k, hk, rfl⟩ := ht,
  rw nat.mem_divisors,
  exact ⟨(pow_dvd_pow p $ by linarith).trans pow_padic_val_nat_dvd, hn⟩
end

lemma range_pow_padic_val_nat_subset_divisors' {n : ℕ} (p : ℕ) [h : fact p.prime] :
  (finset.range (padic_val_nat p n)).image (λ t, p ^ (t + 1)) ⊆ (n.divisors \ {1}) :=
begin
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  intros t ht,
  simp only [exists_prop, finset.mem_image, finset.mem_range] at ht,
  obtain ⟨k, hk, rfl⟩ := ht,
  rw [finset.mem_sdiff, nat.mem_divisors],
  refine ⟨⟨(pow_dvd_pow p $ by linarith).trans pow_padic_val_nat_dvd, hn⟩, _⟩,
  rw [finset.mem_singleton],
  nth_rewrite 1 ←one_pow (k + 1),
  exact (nat.pow_lt_pow_of_lt_left h.1.one_lt $ nat.succ_pos k).ne',
end

end padic_val_nat

/--
If `q ≠ 0`, the p-adic norm of a rational `q` is `p ^ (-(padic_val_rat p q))`.
If `q = 0`, the p-adic norm of `q` is 0.
-/
def padic_norm (p : ℕ) (q : ℚ) : ℚ :=
if q = 0 then 0 else (↑p : ℚ) ^ (-(padic_val_rat p q))

namespace padic_norm

section padic_norm
open padic_val_rat
variables (p : ℕ)

/--
Unfolds the definition of the p-adic norm of `q` when `q ≠ 0`.
-/
@[simp] protected lemma eq_zpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
  padic_norm p q = p ^ (-(padic_val_rat p q)) :=
by simp [hq, padic_norm]

/--
The p-adic norm is nonnegative.
-/
protected lemma nonneg (q : ℚ) : 0 ≤ padic_norm p q :=
if hq : q = 0 then by simp [hq, padic_norm]
else
  begin
    unfold padic_norm; split_ifs,
    apply zpow_nonneg,
    exact_mod_cast nat.zero_le _
  end

/--
The p-adic norm of 0 is 0.
-/
@[simp] protected lemma zero : padic_norm p 0 = 0 := by simp [padic_norm]

/--
The p-adic norm of 1 is 1.
-/
@[simp] protected lemma one : padic_norm p 1 = 1 := by simp [padic_norm]

/--
The p-adic norm of `p` is `1/p` if `p > 1`.

See also `padic_norm.padic_norm_p_of_prime` for a version that assumes `p` is prime.
-/
lemma padic_norm_p {p : ℕ} (hp : 1 < p) : padic_norm p p = 1 / p :=
by simp [padic_norm, (show p ≠ 0, by linarith), padic_val_rat.padic_val_rat_self hp]

/--
The p-adic norm of `p` is `1/p` if `p` is prime.

See also `padic_norm.padic_norm_p` for a version that assumes `1 < p`.
-/
@[simp] lemma padic_norm_p_of_prime (p : ℕ) [fact p.prime] : padic_norm p p = 1 / p :=
padic_norm_p $ nat.prime.one_lt (fact.out _)

/-- The p-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
lemma padic_norm_of_prime_of_ne {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_norm p q = 1 :=
begin
  have p : padic_val_rat p q = 0,
  { exact_mod_cast @padic_val_nat_primes p q p_prime q_prime neq },
  simp [padic_norm, p, q_prime.1.1, q_prime.1.ne_zero],
end

/--
The p-adic norm of `p` is less than 1 if `1 < p`.

See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `prime p`.
-/
lemma padic_norm_p_lt_one {p : ℕ} (hp : 1 < p) : padic_norm p p < 1 :=
begin
  rw [padic_norm_p hp, div_lt_iff, one_mul],
  { exact_mod_cast hp },
  { exact_mod_cast zero_lt_one.trans hp },
end

/--
The p-adic norm of `p` is less than 1 if `p` is prime.

See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`.
-/
lemma padic_norm_p_lt_one_of_prime (p : ℕ) [fact p.prime] : padic_norm p p < 1 :=
padic_norm_p_lt_one $ nat.prime.one_lt (fact.out _)

/--
`padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`.
-/
protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padic_norm p q = p ^ (-z) :=
⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩

/--
`padic_norm p` is symmetric.
-/
@[simp] protected lemma neg (q : ℚ) : padic_norm p (-q) = padic_norm p q :=
if hq : q = 0 then by simp [hq]
else by simp [padic_norm, hq]

variable [hp : fact p.prime]
include hp

/--
If `q ≠ 0`, then `padic_norm p q ≠ 0`.
-/
protected lemma nonzero {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 :=
begin
  rw padic_norm.eq_zpow_of_nonzero p hq,
  apply zpow_ne_zero_of_ne_zero,
  exact_mod_cast ne_of_gt hp.1.pos
end

/--
If the p-adic norm of `q` is 0, then `q` is 0.
-/
lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm p q = 0) : q = 0 :=
begin
  apply by_contradiction, intro hq,
  unfold padic_norm at h, rw if_neg hq at h,
  apply absurd h,
  apply zpow_ne_zero_of_ne_zero,
  exact_mod_cast hp.1.ne_zero
end

/--
The p-adic norm is multiplicative.
-/
@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q*r) = padic_norm p q * padic_norm p r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else
  have q*r ≠ 0, from mul_ne_zero hq hr,
  have (↑p : ℚ) ≠ 0, by simp [hp.1.ne_zero],
  by simp [padic_norm, *, padic_val_rat.mul, zpow_add₀ this, mul_comm]

/--
The p-adic norm respects division.
-/
@[simp] protected theorem div (q r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
if hr : r = 0 then by simp [hr] else
eq_div_of_mul_eq (padic_norm.nonzero _ hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])

/--
The p-adic norm of an integer is at most 1.
-/
protected theorem of_int (z : ℤ) : padic_norm p ↑z ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one] else
begin
  unfold padic_norm,
  rw [if_neg _],
  { refine zpow_le_one_of_nonpos _ _,
    { exact_mod_cast le_of_lt hp.1.one_lt, },
    { rw [padic_val_rat_of_int _ hp.1.ne_one hz, neg_nonpos],
      norm_cast, simp }},
  exact_mod_cast hz
end

private lemma nonarchimedean_aux {q r : ℚ} (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _ _,
have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _ _,
if hq : q = 0 then
  by simp [hq, max_eq_right hnrp, le_max_right]
else if hr : r = 0 then
  by simp [hr, max_eq_left hnqp, le_max_left]
else if hqr : q + r = 0 then
  le_trans (by simpa [hqr] using hnqp) (le_max_left _ _)
else
  begin
    unfold padic_norm, split_ifs,
    apply le_max_iff.2,
    left,
    apply zpow_le_of_le,
    { exact_mod_cast le_of_lt hp.1.one_lt },
    { apply neg_le_neg,
      have : padic_val_rat p q =
              min (padic_val_rat p q) (padic_val_rat p r),
        from (min_eq_left h).symm,
      rw this,
      apply min_le_padic_val_rat_add; assumption }
  end

/--
The p-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p` and
the norm of `q`.
-/
protected theorem nonarchimedean {q r : ℚ} :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
begin
    wlog hle := le_total (padic_val_rat p q) (padic_val_rat p r) using [q r],
    exact nonarchimedean_aux p hle
end

/--
The p-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of `p`
plus the norm of `q`.
-/
theorem triangle_ineq (q r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean p
                       ... ≤ padic_norm p q + padic_norm p r :
                         max_le_add_of_nonneg (padic_norm.nonneg p _) (padic_norm.nonneg p _)

/--
The p-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the p-adic norm.
-/
protected theorem sub {q r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
by rw [sub_eq_add_neg, ←padic_norm.neg p r]; apply padic_norm.nonarchimedean

/--
If the p-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max of
the norms of `q` and `r`.
-/
lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) :
  padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
begin
  wlog hle := le_total (padic_norm p r) (padic_norm p q) using [q r],
  have hlt : padic_norm p r < padic_norm p q, from lt_of_le_of_ne hle hne.symm,
  have : padic_norm p q ≤ max (padic_norm p (q + r)) (padic_norm p r), from calc
   padic_norm p q = padic_norm p (q + r - r) : by congr; ring
               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean p
               ... = max (padic_norm p (q + r)) (padic_norm p r) : by simp,
  have hnge : padic_norm p r ≤ padic_norm p (q + r),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : padic_norm p q ≤ padic_norm p (q + r), by rwa [max_eq_left hnge] at this,
  apply _root_.le_antisymm,
  { apply padic_norm.nonarchimedean p },
  { rw max_eq_left_of_lt hlt,
    assumption }
end

/--
The p-adic norm is an absolute value: positive-definite and multiplicative, satisfying the triangle
inequality.
-/
instance : is_absolute_value (padic_norm p) :=
{ abv_nonneg := padic_norm.nonneg p,
  abv_eq_zero :=
    begin
      intros,
      constructor; intro,
      { apply zero_of_padic_norm_eq_zero p, assumption },
      { simp [*] }
    end,
  abv_add := padic_norm.triangle_ineq p,
  abv_mul := padic_norm.mul p }

variable {p}

lemma dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p^n) ∣ z ↔ padic_norm p z ≤ ↑p ^ (-n : ℤ) :=
begin
  unfold padic_norm, split_ifs with hz,
  { norm_cast at hz,
    have : 0 ≤ (p^n : ℚ), {apply pow_nonneg, exact_mod_cast le_of_lt hp.1.pos },
    simp [hz, this] },
  { rw [zpow_le_iff_le, neg_le_neg_iff, padic_val_rat_of_int _ hp.1.ne_one _],
    { norm_cast,
      rw [← enat.coe_le_coe, enat.coe_get, ← multiplicity.pow_dvd_iff_le_multiplicity],
      simp },
    { exact_mod_cast hz },
    { exact_mod_cast hp.1.one_lt } }
end

end padic_norm
end padic_norm


universes u v

namespace function

open classical

def inverse {X : Type u} {Y : Type v} (g : Y → X) (f : X → Y) := (f ∘ g = id) ∧ (g ∘ f = id)

section

local attribute [instance, priority 10] classical.prop_decidable

theorem injective_has_left_inverse {X :Type u} [inhabited X] {Y : Type v}  {f : X → Y}
  : injective f → has_left_inverse f :=
begin
  intro hf,
  let g := λ y : Y, if h : ∃ x, f x = y then some h else default,
  let hg  :  Π ( y : Y) ( h : ∃ x, f x = y), f (g y) = y,
    intros y hy,
    simp [g,dif_pos hy,some_spec hy],
  existsi g,
  intro x,
  apply hf,
  apply hg,
  exact ⟨x,rfl⟩,
end

end

theorem surjective_has_right_inverse {X : Type u} {Y : Type v} {f : X → Y}
  : surjective f → has_right_inverse f :=
begin
  intro hf,
  let g := λ y, some (hf y),
  let hg : ∀ y : Y , f (g y) = y := λ y, some_spec(hf y),
  existsi g,
  apply hg,
end

theorem left_inverse_equals_right_inverse {X : Type u} {Y : Type v} {f : X → Y}
  : ∀ g₁ g₂ : Y → X, right_inverse g₁ f → left_inverse g₂ f → g₁ = g₂ :=
begin
  intros g₁ g₂ hg₁ hg₂,
  apply funext,
  intro y,
  exact calc g₁ y = g₂ (f (g₁ y)) : by rw hg₂
              ... = g₂ y          : by rw hg₁,
end

theorem bijection_has_inverse {X: Type u} {Y : Type v} [inhabited X] {f : X → Y}
  : bijective f → ∃ g : Y → X, inverse g f :=
begin
  intro hf,
  cases hf with finj fsur,
  cases injective_has_left_inverse finj with g₂ hg₂,
  cases surjective_has_right_inverse fsur with g₁ hg₁,
  have hrw : g₁ = g₂,
    apply left_inverse_equals_right_inverse,
    exact hg₁,
    exact hg₂,
  existsi g₁,
  split,
  apply funext,
  apply hg₁,
  rw hrw,
  apply funext,
  apply hg₂,
end

theorem inverse.injective {X: Type u} {Y : Type v} {f : X → Y} {g : Y → X}
  : inverse g f → injective f :=
begin
  intro h,
  cases h with h₁ h₂,
  apply left_inverse.injective,
  have gli : left_inverse g f,
    intro y,
    rw [← comp_app g f, h₂],
    refl,
  exact gli,
end

end function


theorem le_antisymm (a b : mynat) (hab : a ≤ b) (hba : b ≤ a) : a = b :=
begin
cases hab with c hc,
cases hba with d hd,
rw hd at hc,
symmetry at hc,
rw add_assoc at hc,
have s := eq_zero_of_add_right_eq_self hc,
have t := add_right_eq_zero s,
rw t at hd,
exact hd,
end