/-
Copyright (c) 2019 Abhimanyu Pallavi Sudhir. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Abhimanyu Pallavi Sudhir, Yury Kudryashov

! This file was ported from Lean 3 source module order.filter.filter_product
! leanprover-community/mathlib commit 2738d2ca56cbc63be80c3bd48e9ed90ad94e947d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Ultrafilter
import Mathlib.Order.Filter.Germ

/-!
# Ultraproducts

If `φ` is an ultrafilter, then the space of germs of functions `f : α → β` at `φ` is called
the *ultraproduct*. In this file we prove properties of ultraproducts that rely on `φ` being an
ultrafilter. Definitions and properties that work for any filter should go to `Order.Filter.Germ`.

## Tags

ultrafilter, ultraproduct
-/

universe u v

variable {α : Type u} {β : Type v} {φ : Ultrafilter α}

open Classical

namespace Filter

local notation3"∀* "(...)", "r:(scoped p => Filter.Eventually p φ) => r

namespace Germ

open Ultrafilter

local notation "β*" => Germ (φ : Filter α) β

instance divisionSemiring [DivisionSemiring β] : DivisionSemiring β* :=
  { Germ.semiring, Germ.divInvMonoid,
    Germ.nontrivial with
    mul_inv_cancel := fun f =>
      inductionOn f fun f hf =>
        coe_eq.2 <|
          (φ.em fun y => f y = 0).elim (fun H => (hf <| coe_eq.2 H).elim) fun H =>
            H.mono fun x => mul_inv_cancel
    inv_zero := coe_eq.2 <| by
       simp only [Function.comp, inv_zero]
       exact EventuallyEq.refl _ fun _ => 0}

instance divisionRing [DivisionRing β] : DivisionRing β* :=
  { Germ.ring, Germ.divisionSemiring with }

instance semifield [Semifield β] : Semifield β* :=
  { Germ.commSemiring, Germ.divisionSemiring with }

instance field [Field β] : Field β* :=
  { Germ.commRing, Germ.divisionRing with }

theorem coe_lt [Preorder β] {f g : α → β} : (f : β*) < g ↔ ∀* x, f x < g x := by
  simp only [lt_iff_le_not_le, eventually_and, coe_le, eventually_not, EventuallyLE]
#align filter.germ.coe_lt Filter.Germ.coe_lt

theorem coe_pos [Preorder β] [Zero β] {f : α → β} : 0 < (f : β*) ↔ ∀* x, 0 < f x :=
  coe_lt
#align filter.germ.coe_pos Filter.Germ.coe_pos

theorem const_lt [Preorder β] {x y : β} : x < y → (↑x : β*) < ↑y :=
  coe_lt.mpr ∘ liftRel_const
#align filter.germ.const_lt Filter.Germ.const_lt

@[simp, norm_cast]

theorem lt_def [Preorder β] : ((· < ·) : β* → β* → Prop) = LiftRel (· < ·) := by
  ext (⟨f⟩⟨g⟩)
  exact coe_lt
#align filter.germ.lt_def Filter.Germ.lt_def

instance sup [Sup β] : Sup β* :=
  ⟨map₂ (· ⊔ ·)⟩

instance inf [Inf β] : Inf β* :=
  ⟨map₂ (· ⊓ ·)⟩

@[simp, norm_cast]
theorem const_sup [Sup β] (a b : β) : ↑(a ⊔ b) = (↑a ⊔ ↑b : β*) :=
  rfl
#align filter.germ.const_sup Filter.Germ.const_sup

@[simp, norm_cast]
theorem const_inf [Inf β] (a b : β) : ↑(a ⊓ b) = (↑a ⊓ ↑b : β*) :=
  rfl
#align filter.germ.const_inf Filter.Germ.const_inf

instance semilatticeSup [SemilatticeSup β] : SemilatticeSup β* :=
  { Germ.partialOrder with
    sup := (· ⊔ ·)
    le_sup_left := fun f g =>
        inductionOn₂ f g fun _f _g => eventually_of_forall fun _x => le_sup_left
    le_sup_right := fun f g =>
      inductionOn₂ f g fun _f _g => eventually_of_forall fun _x => le_sup_right
    sup_le := fun f₁ f₂ g =>
      inductionOn₃ f₁ f₂ g fun _f₁ _f₂ _g h₁ h₂ => h₂.mp <| h₁.mono fun _x => sup_le }

instance semilatticeInf [SemilatticeInf β] : SemilatticeInf β* :=
  { Germ.partialOrder with
    inf := (· ⊓ ·)
    inf_le_left := fun f g =>
        inductionOn₂ f g fun _f _g => eventually_of_forall fun _x => inf_le_left
    inf_le_right := fun f g =>
      inductionOn₂ f g fun _f _g => eventually_of_forall fun _x => inf_le_right
    le_inf := fun f₁ f₂ g =>
      inductionOn₃ f₁ f₂ g fun _f₁ _f₂ _g h₁ h₂ => h₂.mp <| h₁.mono fun _x => le_inf }

instance lattice [Lattice β] : Lattice β* :=
  { Germ.semilatticeSup, Germ.semilatticeInf with }

instance distribLattice [DistribLattice β] : DistribLattice β* :=
  { Germ.semilatticeSup, Germ.semilatticeInf with
    le_sup_inf := fun f g h =>
      inductionOn₃ f g h fun _f _g _h => eventually_of_forall fun _ => le_sup_inf }

instance isTotal [LE β] [IsTotal β (· ≤ ·)] : IsTotal β* (· ≤ ·) :=
  ⟨fun f g =>
    inductionOn₂ f g fun _f _g => eventually_or.1 <| eventually_of_forall fun _x => total_of _ _ _⟩

/-- If `φ` is an ultrafilter then the ultraproduct is a linear order. -/
noncomputable instance linearOrder [LinearOrder β] : LinearOrder β* :=
  Lattice.toLinearOrder _

@[to_additive]
instance orderedCommMonoid [OrderedCommMonoid β] : OrderedCommMonoid β* :=
  { Germ.partialOrder, Germ.commMonoid with
    mul_le_mul_left := fun f g =>
      inductionOn₂ f g fun _f _g H h =>
        inductionOn h fun _h => H.mono fun _x H => mul_le_mul_left' H _ }

@[to_additive]
instance orderedCancelCommMonoid [OrderedCancelCommMonoid β]  :
    OrderedCancelCommMonoid β* :=
  { Germ.orderedCommMonoid with
    le_of_mul_le_mul_left := fun f g h =>
      inductionOn₃ f g h fun _f _g _h H => H.mono fun _x => le_of_mul_le_mul_left' }

@[to_additive]
instance orderedCommGroup [OrderedCommGroup β] : OrderedCommGroup β* :=
  { Germ.orderedCancelCommMonoid, Germ.commGroup with }

@[to_additive]
noncomputable instance linearOrderedCommGroup [LinearOrderedCommGroup β] :
    LinearOrderedCommGroup β* :=
  { Germ.orderedCommGroup, Germ.linearOrder with }

instance orderedSemiring [OrderedSemiring β] : OrderedSemiring β* :=
  { Germ.semiring,
    Germ.orderedAddCommMonoid with
    zero_le_one := const_le zero_le_one
    mul_le_mul_of_nonneg_left := fun x y z =>
      inductionOn₃ x y z fun _f _g _h hfg hh =>
          hh.mp <| hfg.mono fun _a => mul_le_mul_of_nonneg_left
    mul_le_mul_of_nonneg_right := fun x y z =>
      inductionOn₃ x y z fun _f _g _h hfg hh =>
          hh.mp <| hfg.mono fun _a => mul_le_mul_of_nonneg_right }

instance orderedCommSemiring [OrderedCommSemiring β] : OrderedCommSemiring β* :=
  { Germ.orderedSemiring, Germ.commSemiring with }

instance orderedRing [OrderedRing β] : OrderedRing β* :=
  { Germ.ring,
    Germ.orderedAddCommGroup with
    zero_le_one := const_le zero_le_one
    mul_nonneg := fun x y =>
      inductionOn₂ x y fun _f _g hf hg => hg.mp <| hf.mono fun _a => mul_nonneg }

instance orderedCommRing [OrderedCommRing β] : OrderedCommRing β* :=
  { Germ.orderedRing, Germ.orderedCommSemiring with }

instance strictOrderedSemiring [StrictOrderedSemiring β] : StrictOrderedSemiring β* :=
  { Germ.orderedSemiring, Germ.orderedAddCancelCommMonoid,
    Germ.nontrivial with
    mul_lt_mul_of_pos_left := fun x y z =>
      inductionOn₃ x y z fun _f _g _h hfg hh =>
        coe_lt.2 <| (coe_lt.1 hh).mp <| (coe_lt.1 hfg).mono fun _a => mul_lt_mul_of_pos_left
    mul_lt_mul_of_pos_right := fun x y z =>
      inductionOn₃ x y z fun _f _g _h hfg hh =>
        coe_lt.2 <| (coe_lt.1 hh).mp <| (coe_lt.1 hfg).mono fun _a => mul_lt_mul_of_pos_right }

instance strictOrderedCommSemiring [StrictOrderedCommSemiring β] : StrictOrderedCommSemiring β* :=
  { Germ.strictOrderedSemiring, Germ.orderedCommSemiring with }

instance strictOrderedRing [StrictOrderedRing β] : StrictOrderedRing β* :=
  { Germ.ring,
    Germ.strictOrderedSemiring with
    zero_le_one := const_le zero_le_one
    mul_pos := fun x y =>
      inductionOn₂ x y fun _f _g hf hg =>
        coe_pos.2 <| (coe_pos.1 hg).mp <| (coe_pos.1 hf).mono fun _x => mul_pos }

instance strictOrderedCommRing [StrictOrderedCommRing β] : StrictOrderedCommRing β* :=
  { Germ.strictOrderedRing, Germ.orderedCommRing with }

noncomputable instance linearOrderedRing [LinearOrderedRing β] : LinearOrderedRing β* :=
  { Germ.strictOrderedRing, Germ.linearOrder with }

noncomputable instance linearOrderedField [LinearOrderedField β] : LinearOrderedField β* :=
  { Germ.linearOrderedRing, Germ.field with }

noncomputable instance linearOrderedCommRing [LinearOrderedCommRing β] : LinearOrderedCommRing β* :=
  { Germ.linearOrderedRing, Germ.commMonoid with }

theorem max_def [LinearOrder β] (x y : β*) : max x y = map₂ max x y :=
  inductionOn₂ x y fun a b => by
    cases' le_total (a : β*) b with h h
    · rw [max_eq_right h, map₂_coe, coe_eq]
      exact h.mono fun i hi => (max_eq_right hi).symm
    · rw [max_eq_left h, map₂_coe, coe_eq]
      exact h.mono fun i hi => (max_eq_left hi).symm
#align filter.germ.max_def Filter.Germ.max_def

theorem min_def [K : LinearOrder β] (x y : β*) : min x y = map₂ min x y :=
  inductionOn₂ x y fun a b => by
    cases' le_total (a : β*) b with h h
    · rw [min_eq_left h, map₂_coe, coe_eq]
      exact h.mono fun i hi => (min_eq_left hi).symm
    · rw [min_eq_right h, map₂_coe, coe_eq]
      exact h.mono fun i hi => (min_eq_right hi).symm
#align filter.germ.min_def Filter.Germ.min_def

theorem abs_def [LinearOrderedAddCommGroup β] (x : β*) : |x| = map abs x :=
  inductionOn x fun _a => rfl
#align filter.germ.abs_def Filter.Germ.abs_def

@[simp]
theorem const_max [LinearOrder β] (x y : β) : (↑(max x y : β) : β*) = max ↑x ↑y := by
  rw [max_def, map₂_const]
#align filter.germ.const_max Filter.Germ.const_max

@[simp]
theorem const_min [LinearOrder β] (x y : β) : (↑(min x y : β) : β*) = min ↑x ↑y := by
  rw [min_def, map₂_const]
#align filter.germ.const_min Filter.Germ.const_min

@[simp]
theorem const_abs [LinearOrderedAddCommGroup β] (x : β) : (↑(|x|) : β*) = |↑x| := by
  rw [abs_def, map_const]
#align filter.germ.const_abs Filter.Germ.const_abs

end Germ

end Filter


import Sets.Basic

open Set

variable {α : Type}
variable (X Y : Set α)

-- Fill in the three sorries

theorem problem1 : X ∩ Xᶜ = ∅ := by
  set_extensionality a
  · intro ⟨g₁,g₂⟩
    exact sorry
  · intro h
    exact False.elim h

theorem problem2 : X ∪ Xᶜ = Univ := by
  set_extensionality a
  · intro h
    exact sorry
  · exact fun _ => Classical.em (a ∈ X)

theorem problem3 : Xᶜ ∪ X = Univ := by
  rw [comm_union]
  exact sorry


import Project.Main
universe u

namespace project

variable {le : α → α → Bool}
(not_le_le : ∀ x y, ¬ le x y → le y x)

theorem empty_heap_merge_left : mergeNodes le [] h = h := by
  unfold mergeNodes
  split
  . rfl
  . rfl
  . rename_i heq
    cases heq

theorem empty_heap_merge_right : mergeNodes le h [] = h := by
  unfold mergeNodes
  split
  . rfl
  . rfl
  . rename_i heq
    cases heq

theorem IsHeapForest'_weaken : IsHeapForest' n xs → m ≤ n → IsHeapForest' m xs := by
  intros hf hle
  cases hf with
  | nil => constructor
  | cons hlt _ _ =>
    constructor <;> try assumption
    . apply Nat.lt_of_le_of_lt hle hlt

theorem rank_combine : t₁.rank = t₂.rank → (combine le t₁ t₂).rank = t₁.rank + 1:= by
intro
unfold combine
split
. dsimp
  simp
  simp_all
. dsimp

theorem IsHeapForest'_strengthen_pred (hf : IsHeapForest' r (t :: ts)) (hpos : t.rank > 0) : IsHeapForest' (t.rank - 1) (t :: ts) := by
  cases hf
  constructor <;> try assumption
  . apply Nat.sub_lt_self
    . decide
    . assumption

theorem IsHeapForest'_strengthen : IsHeapForest' rx ts → ry < hRank ts → IsHeapForest' ry ts := by
intros hf _
cases hf
. constructor
. constructor
  repeat assumption

theorem hrank_of_cons : hRank (t :: ts) = t.rank := rfl

theorem Nat.min_eq (x y : Nat) : min x y = if x ≤ y then x else y := rfl

theorem Bool.not_eq_false' (x : Bool) : (!x) = false ↔ x = true := by
  cases x <;> simp

theorem min_hRank_mergeNodes (ht₁ : IsHeapForest' r xs) (ht₂ : IsHeapForest' r ys) : min (hRank xs) (hRank ys) ≤ hRank (mergeNodes le xs ys) :=
match xs, ys with
| [], h  => by
  rw[Nat.min_eq]
  split
  . rw[empty_heap_merge_left]
    assumption
  . rw[empty_heap_merge_left]
| h,  [] => by
  rw[empty_heap_merge_right, Nat.min_eq]
  split
  . rfl
  . simp at *
    apply Nat.le_of_lt
    assumption
| (h₁ :: t₁), (h₂ :: t₂) => by
  unfold mergeNodes
  split
  . repeat rw[hrank_of_cons]
    rw[Nat.min_eq]
    split
    . rfl
    . simp at *
      apply Nat.le_of_lt
      assumption
  . split
    . repeat rw[hrank_of_cons]
      rw[Nat.min_eq]
      split
      . assumption
      . rfl
    . dsimp
      split
      . split
        . simp at *
          have heq : h₁.rank = h₂.rank := by
            apply Nat.le_antisymm <;> assumption
          repeat rw[hrank_of_cons]
          rw[rank_combine heq]
          rw[Nat.min_eq]
          split <;> apply Nat.le_succ
        . repeat rw[hrank_of_cons]
          have hf : IsHeapForest' r (combine le h₁ h₂ :: t₁) := by
            simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            constructor
            . rw[rank_combine heq] at *
              cases ht₁
              apply Nat.lt_succ_of_lt
              assumption
            . cases ht₁
              cases ht₂
              apply combine_trees_IsBinTree <;> assumption
            . cases ht₁ with | cons _ _ hf =>
                rw[rank_combine heq] at *
                match hf with
                | .nil =>
                  constructor
                | .cons (t := t) (ts := ts) lt _ _ =>
                  constructor
                  . rw[hrank_of_cons] at *
                    rename_i neq
                    unfold bne at neq
                    rw[Nat.not_beq_eq_true_eq] at neq
                    have : h₁.rank + 1 ≤  t.rank := by
                      apply Nat.succ_le_of_lt lt
                    apply lt_of_le_of_ne <;> assumption
                  repeat assumption
          have hf₂ : IsHeapForest' r t₂ := by
            cases ht₂
            apply IsHeapForest'_weaken
            . assumption
            . apply Nat.le_of_lt
              assumption
          have ih := min_hRank_mergeNodes hf hf₂
          transitivity (min (hRank (combine le h₁ h₂ :: t₁)) (hRank t₂))
          . rw[hrank_of_cons] at *
            simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            rw[rank_combine heq] at *
            repeat rw[Nat.min_eq]
            split
            . split
              . apply Nat.le_succ
              . simp at *
                rename_i heq₂ _ hlt
                unfold bne at heq₂
                rw [Bool.not_eq_false', beq_iff_eq] at heq₂
                simp [← heq₂] at hlt
            . split
              . apply Nat.le_succ
              . rename_i heq₂ _ hnle
                unfold bne at heq₂
                rw [Bool.not_eq_false', beq_iff_eq] at heq₂
                simp [← heq₂] at hnle
          . apply ih
      . split
        . repeat rw[hrank_of_cons]
          have hf : IsHeapForest' r t₁ := by
            cases ht₁
            apply IsHeapForest'_weaken
            . assumption
            . apply Nat.le_of_lt
              assumption
          have hf₂ : IsHeapForest' r (combine le h₁ h₂ :: t₂) := by
            simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            constructor
            . cases ht₁
              rw[rank_combine heq] at *
              apply Nat.lt_succ_of_lt
              assumption
            . cases ht₁
              cases ht₂
              apply combine_trees_IsBinTree <;> assumption
            . rw[rank_combine heq] at *
              cases ht₂ with | cons _ _ hf₂ =>
                match hf₂ with
                | .nil =>
                  constructor
                | .cons (t := t) (ts := ts) lt _ _ =>
                  rename_i hneq
                  rw[hrank_of_cons] at *
                  constructor
                  . rw[← heq] at lt
                    unfold bne at hneq
                    rw[Nat.not_beq_eq_true_eq] at hneq
                    apply lt_of_le_of_ne <;> assumption
                  repeat assumption
          have ih := min_hRank_mergeNodes hf hf₂
          transitivity (min (hRank t₁) (hRank (combine le h₁ h₂ :: t₂)))
          . rw[hrank_of_cons] at *
            simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            rw[rank_combine heq] at *
            repeat rw[Nat.min_eq]
            split
            . split
              . cases ht₁ with | cons _ _ hf₃ =>
                  cases hf₃
                  . contradiction
                  . rw[hrank_of_cons]
                    apply Nat.le_of_lt
                    assumption
              . apply Nat.le_succ
            . split
              . cases ht₁ with | cons _ _ hf₃ =>
                  cases hf₃
                  . contradiction
                  . rw[hrank_of_cons]
                    apply Nat.le_of_lt
                    assumption
              . apply Nat.le_succ
          . apply ih
        . repeat rw[hrank_of_cons]
          simp at *
          have heq : h₁.rank = h₂.rank := by
            apply Nat.le_antisymm <;> assumption
          rw[rank_combine heq]
          rw[Nat.min_eq]
          split <;> apply Nat.le_succ
termination_by _  => xs.length + ys.length
decreasing_by simp_wf; simp_arith [*]

theorem hRank_mergeNodes_cons (ht₁ : IsHeapForest' r (u :: y)) (ht₂ : IsHeapForest' r (c :: z)) : u.rank = c.rank → u.rank + 1 ≤ hRank (mergeNodes le (u :: y) (c :: z)) := by
intros heq
unfold mergeNodes
split
. have : u.rank ≠ c.rank := by
    apply ne_of_lt
    assumption
  contradiction
. split
  . have hneq : c.rank ≠ u.rank := by
      apply ne_of_lt
      assumption
    have : c.rank = u.rank := by
      apply Eq.symm heq
    contradiction
  . dsimp
    split
    . split
      . rw[hrank_of_cons]
        rw[rank_combine heq] at *
      . have hf : IsHeapForest' r (combine le u c :: y) := by
          constructor
          . rw[rank_combine heq] at *
            cases ht₁ with | cons lt _ _ =>
              apply Nat.lt_succ_of_lt lt
          . cases ht₁
            cases ht₂
            apply combine_trees_IsBinTree <;> assumption
          . cases ht₁ with | cons _ _ hf =>
              cases ht₂ with | cons =>
                match hf with
                | .nil =>
                   constructor
                | .cons (t := t) (ts := ts) lt _ _ =>
                  rename_i neq
                  rw[rank_combine heq, hrank_of_cons] at *
                  unfold bne at neq
                  rw[Nat.not_beq_eq_true_eq] at neq
                  have : u.rank + 1 ≤ t.rank := by
                    apply Nat.succ_le_of_lt lt
                  constructor
                  . apply lt_of_le_of_ne <;> assumption
                  . assumption
                  . assumption
        have hf₂ : IsHeapForest' r z := by
          cases ht₂
          apply IsHeapForest'_weaken
          . assumption
          . apply Nat.le_of_lt
            assumption
        have min_le : min (hRank (combine le u c :: y)) (hRank z) ≤ hRank (mergeNodes le (combine le u c :: y) z) := by
          apply min_hRank_mergeNodes hf hf₂
        repeat rw[hrank_of_cons] at *
        rw[Nat.min_eq] at min_le
        rw[rank_combine heq] at *
        split at min_le
        . assumption
        . unfold bne at *
          rw[Nat.not_beq_eq_true_eq] at *
          simp_all
    . split
      . have hf : IsHeapForest' r (combine le u c :: z) := by
          constructor
          . rw[rank_combine heq] at *
            cases ht₂ with | cons lt _ _ =>
              rw[← heq] at lt
              apply Nat.lt_succ_of_lt lt
          . cases ht₁
            cases ht₂
            apply combine_trees_IsBinTree <;> assumption
          . cases ht₁ with | cons =>
              cases ht₂ with  | cons _ _ hf =>
                match hf with
                | .nil =>
                  constructor
                | .cons (t := t) (ts := ts) lt _ _ =>
                  rename_i neq
                  rw[rank_combine heq, hrank_of_cons] at *
                  unfold bne at neq
                  rw[Nat.not_beq_eq_true_eq] at neq
                  have hle : c.rank + 1 ≤ t.rank := by
                    apply Nat.succ_le_of_lt lt
                  constructor
                  . rw[← heq] at hle
                    apply lt_of_le_of_ne <;> assumption
                  . assumption
                  . assumption
        have hf₂ : IsHeapForest' r y := by
          cases ht₁
          apply IsHeapForest'_weaken
          . assumption
          . apply Nat.le_of_lt
            assumption
        have min_le : min (hRank y) (hRank (combine le u c :: z)) ≤ hRank (mergeNodes le y (combine le u c :: z)) := by
          apply min_hRank_mergeNodes hf₂ hf
        repeat rw[hrank_of_cons] at *
        rw[Nat.min_eq] at min_le
        rw[rank_combine heq] at *
        split at min_le
        . unfold bne at *
          rw[Nat.not_beq_eq_true_eq] at *
          simp_all
        . assumption
      . rw[hrank_of_cons, rank_combine heq]

theorem IsHeapForest'_of_IsHeapForest' : IsBinTree r → y < r.rank → IsHeapForest' r.rank x → IsHeapForest' y (r :: x) := by
intros
constructor <;> assumption

theorem IsHeap_merge (hxs : IsHeapForest' rx xs) (hys : IsHeapForest' ry ys) :  IsHeapForest' (min rx ry) (mergeNodes le xs ys) :=
  match xs, ys with
  | [], h  => by
    rw [empty_heap_merge_left]
    apply IsHeapForest'_weaken hys
    apply min_le_right
  | h,  [] =>  by
    rw[empty_heap_merge_right]
    apply IsHeapForest'_weaken hxs
    apply min_le_left
  | (h₁ :: t₁), (h₂ :: t₂) => by
    unfold mergeNodes
    split
    . constructor
      . cases hxs
        rw[Nat.min_eq]
        split
        . assumption
        . rename_i nle
          simp at nle
          apply Nat.lt_trans nle
          assumption
      . cases hxs
        assumption
      . cases hxs with | cons hlt bt hf =>
          rename_i hlt₂
          have : h₁.rank = min h₁.rank (h₂.rank - 1) := by
            have hle : h₁.rank ≤ (h₂.rank - 1) := by
              apply Nat.le_pred_of_lt hlt₂
            have : min h₁.rank (h₂.rank - 1) = h₁.rank := by
              apply min_eq_left hle
            rw[this]
          rw [this]; clear this
          apply IsHeap_merge
          . assumption
          . apply IsHeapForest'_strengthen_pred
            . assumption
            . cases bt with | mk =>
                have hge : h₁.rank ≥ 0 := by
                  cases h₁.rank
                  . simp
                  . simp
                have hle : 0 ≤ h₁.rank := by
                  apply hge
                have : 0 < h₂.rank := by
                  apply lt_of_le_of_lt hle hlt₂
                assumption
    . split
      . constructor
        . rw[Nat.min_eq]
          split
          . cases hys
            apply Nat.lt_of_le_of_lt <;> assumption
          . cases hys
            assumption
        . cases hys
          assumption
        . have heq : min h₂.rank (h₁.rank -1) = h₂.rank := by
            have : h₂.rank ≤ (h₁.rank - 1) := by
              apply Nat.le_pred_of_lt
              assumption
            apply min_eq_left
            assumption
          rw[← heq]
          apply IsHeap_merge
          . cases hys
            assumption
          . constructor
            . cases hxs
              apply Nat.pred_lt
              simp
              cases rx <;> apply Nat.not_eq_zero_of_lt; repeat assumption
            . cases hxs
              assumption
            . cases hxs
              assumption
      . dsimp
        split
        . split
          . rename_i hneq hneq₂
            simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            constructor
            . have : (combine le h₁ h₂).rank = h₁.rank + 1 := by
                apply rank_combine heq
              rw[this]; clear this
              rw[Nat.min_eq]
              split
              . cases hxs
                apply Nat.lt_succ_of_lt
                assumption
              . cases hys
                rw[heq]
                apply Nat.lt_succ_of_lt
                assumption
            . cases hxs
              cases hys
              apply combine_trees_IsBinTree <;> assumption
            . rw[rank_combine heq] at *
              cases hxs with | cons _ _ ht₁ =>
              cases hys with | cons _ _ ht₂ =>
              have ih := IsHeap_merge ht₁ ht₂
              have min_le : min (hRank t₁) (hRank t₂) ≤ hRank (mergeNodes le t₁ t₂) := by
                rw[← heq] at ht₂
                apply min_hRank_mergeNodes ht₁ ht₂
              by_cases (t₁ = [] ∧ t₂ = [])
              . have (And.intro he₁ he₂) := h
                simp[he₁, he₂]
                constructor
              . apply IsHeapForest'_strengthen
                . apply ih
                . rw[Nat.min_eq] at min_le
                  split at min_le
                  . match ht₁ with
                    | .nil =>
                      rw[empty_heap_merge_left] at *
                      match ht₂ with
                      | .nil => simp at h
                      | .cons (t := bt) hlt _ _ =>
                        rw[hrank_of_cons] at *
                        rw[← heq] at hlt
                        unfold bne at hneq₂
                        rw[Nat.not_beq_eq_true_eq] at hneq₂
                        have n : h₁.rank + 1 ≤ bt.rank := by
                          apply Nat.succ_le_of_lt hlt
                        apply lt_of_le_of_ne <;> assumption
                    | .cons (t := t) (ts := ts) hlt _ _ =>
                      rw[hrank_of_cons] at *
                      have : h₁.rank < hRank (mergeNodes le (t :: ts) t₂) := by
                        apply lt_of_lt_of_le <;> assumption
                      unfold bne at hneq
                      rw[Nat.not_beq_eq_true_eq] at hneq
                      have : h₁.rank + 1 ≤ t.rank := by
                        apply Nat.succ_le_of_lt hlt
                      have : h₁.rank + 1 < t.rank := by
                        apply lt_of_le_of_ne <;> assumption
                      apply lt_of_lt_of_le <;> assumption
                  . match ht₂ with
                    | .nil =>
                      rw[empty_heap_merge_right] at *
                      match ht₁ with
                      | .nil =>
                        simp at h
                      | .cons (t := t) (ts := ts) lt _ _ =>
                        rw[hrank_of_cons] at *
                        unfold bne at hneq
                        rw[Nat.not_beq_eq_true_eq] at hneq
                        have : h₁.rank + 1 ≤ t.rank := by
                          apply Nat.succ_le_of_lt lt
                        apply lt_of_le_of_ne <;> assumption
                    | .cons (t := t) (ts := ts) lt _ _ =>
                      rw[hrank_of_cons] at *
                      rw[← heq] at lt
                      have : h₁.rank + 1 ≤ t.rank := by
                        apply Nat.succ_le_of_lt lt
                      unfold bne at hneq₂
                      rw[Nat.not_beq_eq_true_eq] at hneq₂
                      have : h₁.rank + 1 < t.rank := by
                        apply lt_of_le_of_ne <;> assumption
                      apply lt_of_lt_of_le <;> assumption
          . apply IsHeap_merge
            simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            . constructor
              . cases hxs with | cons lt _ _ =>
                  rw[rank_combine heq]
                  have : h₁.rank < h₁.rank + 1 := by
                    apply Nat.lt_succ_self
                  apply lt_trans lt this
              . cases hxs
                cases hys
                apply combine_trees_IsBinTree <;> assumption
              . match hxs with
                | .cons _ _ hf =>
                  have : (combine le h₁ h₂).rank = h₁.rank + 1 := by
                    apply rank_combine heq
                  simp only [this] at *; clear this
                  match hf with
                  | .nil =>
                    constructor
                  | .cons (t := t) (ts := ts) lt _ _ =>
                    constructor
                    . have : h₁.rank + 1 ≤ t.rank := by
                        apply Nat.succ_le_of_lt lt
                      apply lt_of_le_of_ne this
                      rw[hrank_of_cons] at *
                      unfold bne at *
                      rw[Nat.not_beq_eq_true_eq] at *
                      assumption
                    . assumption
                    . assumption
            . cases hys with | cons lt _ hf =>
                have : ry ≤ h₂.rank := by
                    apply le_of_lt lt
                apply IsHeapForest'_weaken hf this
        . split
          . apply IsHeap_merge
            . cases hxs with | cons lt _ hf =>
                have : rx ≤ h₁.rank := by
                    apply le_of_lt lt
                apply IsHeapForest'_weaken hf this
            . constructor
              . simp at *
                have heq : h₁.rank = h₂.rank := by
                  apply Nat.le_antisymm <;> assumption
                rw[rank_combine heq] at *
                cases hys
                rw[heq]
                apply Nat.lt_succ_of_lt
                assumption
              . cases hxs with | cons =>
                  cases hys with | cons =>
                    simp at *
                    have : h₁.rank = h₂.rank := by
                      apply Nat.le_antisymm <;> assumption
                    apply combine_trees_IsBinTree <;> assumption
              . simp at *
                have heq : h₁.rank = h₂.rank := by
                  apply Nat.le_antisymm <;> assumption
                rw[rank_combine heq] at *
                cases hys with | cons _ _ hf =>
                  match hf with
                  | .nil =>
                    constructor
                  | .cons (t := t) (ts := ts) lt _ _ =>
                    rw[← heq] at lt
                    have b : h₁.rank + 1 ≤ t.rank := by
                      apply Nat.succ_le_of_lt lt
                    rw[hrank_of_cons] at *
                    constructor
                    . unfold bne at *
                      rw[Nat.not_beq_eq_true_eq] at *
                      apply lt_of_le_of_ne <;> assumption
                    repeat assumption
          . simp at *
            have heq : h₁.rank = h₂.rank := by
              apply Nat.le_antisymm <;> assumption
            constructor
            . rw[Nat.min_eq]
              split
              . rw[rank_combine heq] at *
                cases hxs
                apply Nat.lt_succ_of_lt
                assumption
              . rw[rank_combine heq] at *
                cases hys
                rw[heq]
                apply Nat.lt_succ_of_lt
                assumption
            . cases hxs
              cases hys
              apply combine_trees_IsBinTree <;> assumption
            . rw[rank_combine heq] at *
              cases hxs with | cons _ _ hf =>
              cases hys with | cons _ _ hf₂ =>
              have ih := IsHeap_merge hf hf₂
              have hle : min (hRank t₁) (hRank t₂) ≤ hRank (mergeNodes le t₁ t₂) := by
                rw[← heq] at hf₂
                apply min_hRank_mergeNodes hf hf₂
              by_cases (t₁ = [] ∧ t₂ = [])
              . have he₁ := h.left
                have he₂ := h.right
                simp[he₁, he₂]
                constructor
              . apply IsHeapForest'_strengthen
                . apply ih
                . rw[Nat.min_eq] at hle
                  split at hle
                  . match hf₂ with
                    | .nil =>
                      rw[empty_heap_merge_right] at *
                      match hf with
                      | .nil =>
                        contradiction
                      | .cons (t := t) (ts := ts) _ _ _ =>
                        rw[hrank_of_cons] at *
                        unfold bne at *
                        rw[Bool.not_eq_false', beq_iff_eq] at *
                        simp at *
                        contradiction
                    | .cons (t := t) (ts := ts) _ _ _ =>
                      match hf with
                      | .nil =>
                        rw[empty_heap_merge_left] at *
                        rw[hrank_of_cons] at *
                        unfold bne at *
                        rw[Bool.not_eq_false', beq_iff_eq] at *
                        simp at *
                        contradiction
                      | .cons (t := t₂) (ts := ts₂) _ _ _ =>
                        repeat rw[hrank_of_cons] at *
                        unfold bne at *
                        rw[Bool.not_eq_false', beq_iff_eq] at *
                        simp at *
                        have ht₁ : IsHeapForest' h₁.rank (t₂ :: ts₂) := by
                          apply IsHeapForest'_of_IsHeapForest' <;> assumption
                        have ht₂ : IsHeapForest' h₁.rank (t :: ts) := by
                          rw[← heq] at *
                          apply IsHeapForest'_of_IsHeapForest' <;> assumption
                        have : t₂.rank + 1 ≤ hRank (mergeNodes le (t₂ :: ts₂) (t :: ts)) := by
                          apply hRank_mergeNodes_cons ht₁ ht₂
                          simp_all
                        rename_i heq₂ _
                        rw[heq₂]
                        apply Nat.lt_of_succ_le this
                  . match hf₂ with
                    | .nil =>
                      rw[empty_heap_merge_right] at *
                      cases hf
                      . contradiction
                      . rw[hrank_of_cons] at *
                        unfold bne at *
                        rw[Bool.not_eq_false', beq_iff_eq] at *
                        simp at *
                        contradiction
                    | .cons (t := t) (ts := ts) _ _ _ =>
                      rw[hrank_of_cons] at *
                      unfold bne at *
                      rw[Bool.not_eq_false', beq_iff_eq] at *
                      simp at *
                      match hf with
                      | .nil =>
                        contradiction
                      | .cons (t := t₂) (ts := ts₂) _ _ _ =>
                        rw[hrank_of_cons] at *
                        simp at *
                        have ht₁ : IsHeapForest' h₁.rank (t₂ :: ts₂) := by
                          apply IsHeapForest'_of_IsHeapForest' <;> assumption
                        have ht₂ : IsHeapForest' h₁.rank (t :: ts) := by
                          rw[← heq] at *
                          apply IsHeapForest'_of_IsHeapForest' <;> assumption
                        have : t₂.rank + 1 ≤ hRank (mergeNodes le (t₂ :: ts₂) (t :: ts)) := by
                          apply hRank_mergeNodes_cons ht₁ ht₂
                          simp_all
                        rename_i heq₂ _
                        rw[heq₂]
                        apply Nat.lt_of_succ_le this
termination_by _  => xs.length + ys.length
decreasing_by simp_wf; simp_arith [*]

theorem IsMinHeap_merge : IsMinHeap le (.heap hx) → IsMinHeap le (.heap hy) → IsMinHeap le (.heap (mergeNodes le hx hy)) :=
  match hx, hy with
  | [], h => by
    intros _ hys
    cases hys
    . simp[mergeNodes]
      constructor
    . constructor <;> assumption
  | h, [] => by
    intros hxs _
    cases hxs
    . simp[mergeNodes]
      constructor
    . constructor <;> assumption
  | (h₁ :: t₁), (h₂ :: t₂) => by
    intros hxs hys
    unfold mergeNodes
    split
    . constructor
      . cases hxs
        assumption
      . cases hxs
        apply IsMinHeap_merge <;> assumption
    . split
      . constructor
        . cases hys
          assumption
        . cases hys
          apply IsMinHeap_merge <;> assumption
      . dsimp
        split
        . split
          . constructor
            . apply combine_trees_IsSearchTree
              . assumption
              . cases hxs
                assumption
              . cases hys
                assumption
            . apply IsMinHeap_merge
              . cases hxs
                assumption
              . cases hys
                assumption
          . apply IsMinHeap_merge
            . constructor
              . apply combine_trees_IsSearchTree
                . assumption
                . cases hxs
                  assumption
                . cases hys
                  assumption
              . cases hxs
                assumption
            . cases hys
              assumption
        . split
          . apply IsMinHeap_merge
            . cases hxs
              assumption
            . constructor
              . apply combine_trees_IsSearchTree
                . assumption
                . cases hxs
                  assumption
                . cases hys
                  assumption
              . cases hys
                assumption
          . constructor
            . apply combine_trees_IsSearchTree
              . assumption
              . cases hxs
                assumption
              . cases hys
                assumption
            . apply IsMinHeap_merge
              . cases hxs
                assumption
              . cases hys
                assumption
  termination_by _  => hx.length + hy.length
  decreasing_by simp_wf; simp_arith [*]


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura

Definitions prod properties of div prod mod. Much of the development follows Isabelle's library.
-/
#exit
import .sub
universes u v w
hott_theory
namespace hott

open hott.algebra
-- open well_founded decidable prod algebra

namespace nat

/- div -/

-- auxiliary lemma used to justify div
private @[hott] def div_rec_lemma {x y : nat} : 0 < y × y ≤ x → x - y < x :=
prod.rec (λ ypos ylex, sub_lt (lt_of_lt_of_le ypos ylex) ypos)

private @[hott] def div.F (x : nat) (f : Π x₁, x₁ < x → nat → nat) (y : nat) : nat :=
if H : 0 < y × y ≤ x then f (x - y) (div_rec_lemma H) y + 1 else zero

@[hott] protected def div := fix div.F

@[hott] def nat_has_divide [reducible] [instance] [priority nat.prio] : has_div nat :=
has_div.mk nat.div

@[hott] theorem div_def (x y : nat) : div x y = if 0 < y × y ≤ x then div (x - y) y + 1 else 0 :=
congr_fun (fix_eq div.F x) y

@[hott] protected theorem div_zero [simp] (a : ℕ) : a / 0 = 0 :=
div_def a 0 ⬝ if_neg (!not_prod_of_not_left (lt.irrefl 0))

@[hott] theorem div_eq_zero_of_lt {a b : ℕ} (h : a < b) : a / b = 0 :=
div_def a b ⬝ if_neg (!not_prod_of_not_right (not_le_of_gt h))

@[hott] protected theorem zero_div [simp] (b : ℕ) : 0 / b = 0 :=
div_def 0 b ⬝ if_neg (prod.rec not_le_of_gt)

@[hott] theorem div_eq_succ_sub_div {a b : ℕ} (h₁ : b > 0) (h₂ : a ≥ b) : a / b = succ ((a - b) / b) :=
div_def a b ⬝ if_pos (pair h₁ h₂)

@[hott] theorem add_div_self (x : ℕ) {z : ℕ} (H : z > 0) : (x + z) / z = succ (x / z) :=
calc
  (x + z) / z = if 0 < z × z ≤ x + z then (x + z - z) / z + 1 else 0 : !div_def
            ... = (x + z - z) / z + 1 : if_pos (pair H (le_add_left z x))
            ... = succ (x / z)        : {!nat.add_sub_cancel}

@[hott] theorem add_div_self_left {x : ℕ} (z : ℕ) (H : x > 0) : (x + z) / x = succ (z / x) :=
by rewrite add.comm; exact !add_div_self H

local attribute succ_mul [simp]

@[hott] theorem add_mul_div_self {x y z : ℕ} (H : z > 0) : (x + y * z) / z = x / z + y :=
nat.rec_on y
  (by rewrite [zero_mul])
  (take y,
    assume IH : (x + y * z) / z = x / z + y, calc
      (x + succ y * z) / z = (x + y * z + z) / z    : by rewrite [succ_mul, add.assoc]
                       ... = succ ((x + y * z) / z) : !add_div_self H
                       ... = succ (x / z + y)       : IH)

@[hott] theorem add_mul_div_self_left (x z : ℕ) {y : ℕ} (H : y > 0) : (x + y * z) / y = x / y + z :=
!mul.comm ▸ add_mul_div_self H

@[hott] protected theorem mul_div_cancel (m : ℕ) {n : ℕ} (H : n > 0) : m * n / n = m :=
calc
  m * n / n = (0 + m * n) / n : by rewrite [zero_add]
          ... = 0 / n + m     : add_mul_div_self H
          ... = m             : by rewrite [nat.zero_div, zero_add]

@[hott] protected theorem mul_div_cancel_left {m : ℕ} (n : ℕ) (H : m > 0) : m * n / m = n :=
!mul.comm ▸ !nat.mul_div_cancel H

/- mod -/

private @[hott] def mod.F (x : nat) (f : Π x₁, x₁ < x → nat → nat) (y : nat) : nat :=
if H : 0 < y × y ≤ x then f (x - y) (div_rec_@[hott] lemma H) y else x

@[hott] protected def mod := fix mod.F

@[hott] def nat_has_mod [reducible] [instance] [priority nat.prio] : has_mod nat :=
has_mod.mk nat.mod

notation [priority nat.prio] a ≡ b `[mod `:0 c:0 `]` := a % c = b % c

@[hott] theorem mod_def (x y : nat) : mod x y = if 0 < y × y ≤ x then mod (x - y) y else x :=
congr_fun (fix_eq mod.F x) y

@[hott] theorem mod_zero [simp] (a : ℕ) : a % 0 = a :=
mod_def a 0 ⬝ if_neg (!not_prod_of_not_left (lt.irrefl 0))

@[hott] theorem mod_eq_of_lt {a b : ℕ} (h : a < b) : a % b = a :=
mod_def a b ⬝ if_neg (!not_prod_of_not_right (not_le_of_gt h))

@[hott] theorem zero_mod [simp] (b : ℕ) : 0 % b = 0 :=
mod_def 0 b ⬝ if_neg (λ h, prod.rec_on h (λ l r, absurd (lt_of_lt_of_le l r) (lt.irrefl 0)))

@[hott] theorem mod_eq_sub_mod {a b : ℕ} (h₁ : b > 0) (h₂ : a ≥ b) : a % b = (a - b) % b :=
mod_def a b ⬝ if_pos (pair h₁ h₂)

@[hott] theorem add_mod_self [simp] (x z : ℕ) : (x + z) % z = x % z :=
by_cases_zero_pos z
  (by rewrite add_zero)
  (take z, assume H : z > 0,
    calc
      (x + z) % z = if 0 < z × z ≤ x + z then (x + z - z) % z else _ : mod_def
                ... = (x + z - z) % z   : if_pos (pair H (le_add_left z x))
                ... = x % z             : nat.add_sub_cancel)

@[hott] theorem add_mod_self_left [simp] (x z : ℕ) : (x + z) % x = z % x :=
by rewrite add.comm; apply add_mod_self

local attribute succ_mul [simp]

@[hott] theorem add_mul_mod_self [simp] (x y z : ℕ) : (x + y * z) % z = x % z :=
nat.rec_on y (by rewrite [zero_mul, add_zero])
             (by intros y IH; rewrite [succ_mul, -add.assoc, add_mod_self, IH])

@[hott] theorem add_mul_mod_self_left [simp] (x y z : ℕ) : (x + y * z) % y = x % y :=
by rewrite [mul.comm, add_mul_mod_self]

@[hott] theorem mul_mod_left [simp] (m n : ℕ) : (m * n) % n = 0 :=
calc (m * n) % n = (0 + m * n) % n : by rewrite [zero_add]
            ...  = 0               : by rewrite [add_mul_mod_self, zero_mod]

@[hott] theorem mul_mod_right [simp] (m n : ℕ) : (m * n) % m = 0 :=
by rewrite [mul.comm, mul_mod_left]

@[hott] theorem mod_lt (x : ℕ) {y : ℕ} (H : y > 0) : x % y < y :=
nat.case_strong_rec_on x
  (show 0 % y < y, from !zero_mod⁻¹ ▸ H)
  (take x,
    assume IH : Πx', x' ≤ x → x' % y < y,
    show succ x % y < y, from
      by_cases -- (succ x < y)
        (assume H1 : succ x < y,
          have succ x % y = succ x, from mod_eq_of_lt H1,
          show succ x % y < y, from this⁻¹ ▸ H1)
        (assume H1 : ¬ succ x < y,
          have y ≤ succ x, from le_of_not_gt H1,
          have h : succ x % y = (succ x - y) % y, from mod_eq_sub_mod H this,
          have succ x - y < succ x, from sub_lt !succ_pos H,
          have succ x - y ≤ x, from le_of_lt_succ this,
          show succ x % y < y, from h⁻¹ ▸ IH _ this))

@[hott] theorem mod_one (n : ℕ) : n % 1 = 0 :=
have H1 : n % 1 < 1, from !mod_lt !succ_pos,
eq_zero_of_le_zero (le_of_lt_succ H1)

/- properties of div prod mod -/

-- the quotient - remainder theorem
@[hott] theorem eq_div_mul_add_mod (x y : ℕ) : x = x / y * y + x % y :=
begin
  eapply by_cases_zero_pos y,
  show x = x / 0 * 0 + x % 0, from
    (calc
      x / 0 * 0 + x % 0 = 0 + x % 0 : mul_zero
        ... = x % 0                 : zero_add
        ... = x                     : mod_zero)⁻¹,
  intros y H,
  show x = x / y * y + x % y,
  begin
    eapply nat.case_strong_rec_on x,
    show 0 = (0 / y) * y + 0 % y, by rewrite [zero_mod, add_zero, nat.zero_div, zero_mul],
    intros x IH,
    show succ x = succ x / y * y + succ x % y, from
      if H1 : succ x < y then
         have H2 : succ x / y = 0, from div_eq_zero_of_lt H1,
         have H3 : succ x % y = succ x, from mod_eq_of_lt H1,
         begin rewrite [H2, H3, zero_mul, zero_add] end
      else
         have H2 : y ≤ succ x, from le_of_not_gt H1,
         have H3 : succ x / y = succ ((succ x - y) / y), from div_eq_succ_sub_div H H2,
         have H4 : succ x % y = (succ x - y) % y, from mod_eq_sub_mod H H2,
         have H5 : succ x - y < succ x, from sub_lt !succ_pos H,
         have H6 : succ x - y ≤ x, from le_of_lt_succ H5,
         (calc
             succ x / y * y + succ x % y =
                  succ ((succ x - y) / y) * y + succ x % y      : by rewrite H3
            ... = ((succ x - y) / y) * y + y + succ x % y       : by rewrite succ_mul
            ... = ((succ x - y) / y) * y + y + (succ x - y) % y : by rewrite H4
            ... = ((succ x - y) / y) * y + (succ x - y) % y + y : add.right_comm
            ... = succ x - y + y                                : by rewrite -(IH _ H6)
            ... = succ x                                        : nat.sub_add_cancel H2)⁻¹
  end
end

@[hott] theorem mod_eq_sub_div_mul (x y : ℕ) : x % y = x - x / y * y :=
nat.eq_sub_of_add_eq (!add.comm ▸ !eq_div_mul_add_mod)⁻¹

@[hott] theorem mod_add_mod (m n k : ℕ) : (m % n + k) % n = (m + k) % n :=
by rewrite [eq_div_mul_add_mod m n at {2}, add.assoc, add.comm (m / n * n), add_mul_mod_self]

@[hott] theorem add_mod_mod (m n k : ℕ) : (m + n % k) % k = (m + n) % k :=
by rewrite [add.comm, mod_add_mod, add.comm]

@[hott] theorem add_mod_eq_add_mod_right {m n k : ℕ} (i : ℕ) (H : m % n = k % n) :
  (m + i) % n = (k + i) % n :=
by rewrite [-mod_add_mod, -mod_add_mod k, H]

@[hott] theorem add_mod_eq_add_mod_left {m n k : ℕ} (i : ℕ) (H : m % n = k % n) :
  (i + m) % n = (i + k) % n :=
by rewrite [add.comm, add_mod_eq_add_mod_right _ H, add.comm]

@[hott] theorem mod_eq_mod_of_add_mod_eq_add_mod_right {m n k i : ℕ} :
  (m + i) % n = (k + i) % n → m % n = k % n :=
by_cases_zero_pos n
  (by rewrite [*mod_zero]; apply eq_of_add_eq_add_right)
  (take n,
    assume npos : n > 0,
    assume H1 : (m + i) % n = (k + i) % n,
    have H2 : (m + i % n) % n = (k + i % n) % n, by rewrite [*add_mod_mod, H1],
    have H3 : (m + i % n + (n - i % n)) % n = (k + i % n + (n - i % n)) % n,
      from add_mod_eq_add_mod_right _ H2,
    begin
      revert H3,
      rewrite [*add.assoc, add_sub_of_le (le_of_lt (!mod_lt npos)), *add_mod_self],
      intros, assumption
    end)

@[hott] theorem mod_eq_mod_of_add_mod_eq_add_mod_left {m n k i : ℕ} :
  (i + m) % n = (i + k) % n → m % n = k % n :=
by rewrite [add.comm i m, add.comm i k]; apply mod_eq_mod_of_add_mod_eq_add_mod_right

@[hott] theorem mod_le {x y : ℕ} : x % y ≤ x :=
!eq_div_mul_add_mod⁻¹ ▸ !le_add_left

@[hott] theorem eq_remainder {q1 r1 q2 r2 y : ℕ} (H1 : r1 < y) (H2 : r2 < y)
  (H3 : q1 * y + r1 = q2 * y + r2) : r1 = r2 :=
calc
  r1 = r1 % y               : mod_eq_of_lt H1
    ... = (r1 + q1 * y) % y : !add_mul_mod_self⁻¹
    ... = (q1 * y + r1) % y : add.comm
    ... = (r2 + q2 * y) % y : by rewrite [H3, add.comm]
    ... = r2 % y            : !add_mul_mod_self
    ... = r2                : mod_eq_of_lt H2

@[hott] theorem eq_quotient {q1 r1 q2 r2 y : ℕ} (H1 : r1 < y) (H2 : r2 < y)
  (H3 : q1 * y + r1 = q2 * y + r2) : q1 = q2 :=
have H4 : q1 * y + r2 = q2 * y + r2, from (eq_remainder H1 H2 H3) ▸ H3,
have H5 : q1 * y = q2 * y, from add.right_cancel H4,
have H6 : y > 0, from lt_of_le_of_lt !zero_le H1,
show q1 = q2, from eq_of_mul_eq_mul_right H6 H5

@[hott] protected theorem mul_div_mul_left {z : ℕ} (x y : ℕ) (zpos : z > 0) :
  (z * x) / (z * y) = x / y :=
if H : y = 0 then
  by rewrite [H, mul_zero, *nat.div_zero]
else
  have ypos : y > 0, from pos_of_ne_zero H,
  have zypos : z * y > 0, from mul_pos zpos ypos,
  have H1 : (z * x) % (z * y) < z * y, from !mod_lt zypos,
  have H2 : z * (x % y) < z * y, from mul_lt_mul_of_pos_left (!mod_lt ypos) zpos,
  eq_quotient H1 H2
    (calc
      ((z * x) / (z * y)) * (z * y) + (z * x) % (z * y) = z * x : eq_div_mul_add_mod
        ... = z * (x / y * y + x % y)                           : eq_div_mul_add_mod
        ... = z * (x / y * y) + z * (x % y)                     : left_distrib
        ... = (x / y) * (z * y) + z * (x % y)                   : mul.left_comm)

@[hott] protected theorem mul_div_mul_right {x z y : ℕ} (zpos : z > 0) : (x * z) / (y * z) = x / y :=
!mul.comm ▸ !mul.comm ▸ !nat.mul_div_mul_left zpos

@[hott] theorem mul_mod_mul_left (z x y : ℕ) : (z * x) % (z * y) = z * (x % y) :=
sum.elim (eq_zero_sum_pos z)
  (assume H : z = 0, H⁻¹ ▸ calc
      (0 * x) % (z * y) = 0 % (z * y)   : zero_mul
                      ... = 0           : zero_mod
                      ... = 0 * (x % y) : zero_mul)
  (assume zpos : z > 0,
    sum.elim (eq_zero_sum_pos y)
      (assume H : y = 0, by rewrite [H, mul_zero, *mod_zero])
      (assume ypos : y > 0,
        have zypos : z * y > 0, from mul_pos zpos ypos,
        have H1 : (z * x) % (z * y) < z * y, from !mod_lt zypos,
        have H2 : z * (x % y) < z * y, from mul_lt_mul_of_pos_left (!mod_lt ypos) zpos,
        eq_remainder H1 H2
          (calc
            ((z * x) / (z * y)) * (z * y) + (z * x) % (z * y) = z * x : eq_div_mul_add_mod
              ... = z * (x / y * y + x % y)                           : eq_div_mul_add_mod
              ... = z * (x / y * y) + z * (x % y)                     : left_distrib
              ... = (x / y) * (z * y) + z * (x % y)                   : mul.left_comm)))

@[hott] theorem mul_mod_mul_right (x z y : ℕ) : (x * z) % (y * z) = (x % y) * z :=
mul.comm z x ▸ mul.comm z y ▸ !mul.comm ▸ !mul_mod_mul_left

@[hott] theorem mod_self (n : ℕ) : n % n = 0 :=
nat.cases_on n (by rewrite zero_mod)
  (take n, by rewrite [-zero_add (succ n) at {1}, add_mod_self])

@[hott] theorem mul_mod_eq_mod_mul_mod (m n k : nat) : (m * n) % k = ((m % k) * n) % k :=
calc
  (m * n) % k = (((m / k) * k + m % k) * n) % k : eq_div_mul_add_mod
            ... = ((m % k) * n) % k             :
                    by rewrite [right_distrib, mul.right_comm, add.comm, add_mul_mod_self]

@[hott] theorem mul_mod_eq_mul_mod_mod (m n k : nat) : (m * n) % k = (m * (n % k)) % k :=
!mul.comm ▸ !mul.comm ▸ !mul_mod_eq_mod_mul_mod

@[hott] protected theorem div_one (n : ℕ) : n / 1 = n :=
have n / 1 * 1 + n % 1 = n, from !eq_div_mul_add_mod⁻¹,
begin rewrite [-this at {2}, mul_one, mod_one] end

@[hott] protected theorem div_self {n : ℕ} (H : n > 0) : n / n = 1 :=
have (n * 1) / (n * 1) = 1 / 1, from !nat.mul_div_mul_left H,
by rewrite [nat.div_one at this, -this, *mul_one]

@[hott] theorem div_mul_cancel_of_mod_eq_zero {m n : ℕ} (H : m % n = 0) : m / n * n = m :=
by rewrite [eq_div_mul_add_mod m n at {2}, H, add_zero]

@[hott] theorem mul_div_cancel_of_mod_eq_zero {m n : ℕ} (H : m % n = 0) : n * (m / n) = m :=
!mul.comm ▸ div_mul_cancel_of_mod_eq_zero H

/- dvd -/

@[hott] theorem dvd_of_mod_eq_zero {m n : ℕ} (H : n % m = 0) : m ∣ n :=
dvd.intro (!mul.comm ▸ div_mul_cancel_of_mod_eq_zero H)

@[hott] theorem mod_eq_zero_of_dvd {m n : ℕ} (H : m ∣ n) : n % m = 0 :=
dvd.elim H (take z, assume H1 : n = m * z, H1⁻¹ ▸ !mul_mod_right)

@[hott] theorem dvd_iff_mod_eq_zero (m n : ℕ) : m ∣ n ↔ n % m = 0 :=
iff.intro mod_eq_zero_of_dvd dvd_of_mod_eq_zero

@[hott] def dvd.decidable_rel [instance] : decidable_rel dvd :=
take m n, decidable_of_decidable_of_iff _ (iff.symm !dvd_iff_mod_eq_zero)

@[hott] protected theorem div_mul_cancel {m n : ℕ} (H : n ∣ m) : m / n * n = m :=
div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H)

@[hott] protected theorem mul_div_cancel' {m n : ℕ} (H : n ∣ m) : n * (m / n) = m :=
!mul.comm ▸ nat.div_mul_cancel H

@[hott] theorem dvd_of_dvd_add_left {m n₁ n₂ : ℕ} (H₁ : m ∣ n₁ + n₂) (H₂ : m ∣ n₁) : m ∣ n₂ :=
obtain (c₁ : nat) (Hc₁ : n₁ + n₂ = m * c₁), from H₁,
obtain (c₂ : nat) (Hc₂ : n₁ = m * c₂), from H₂,
have   aux : m * (c₁ - c₂) = n₂, from calc
  m * (c₁ - c₂) = m * c₁  - m * c₂ : nat.mul_sub_left_distrib
           ...  = n₁ + n₂ - m * c₂ : Hc₁
           ...  = n₁ + n₂ - n₁     : Hc₂
           ...  = n₂               : nat.add_sub_cancel_left,
dvd.intro aux

@[hott] theorem dvd_of_dvd_add_right {m n₁ n₂ : ℕ} (H : m ∣ n₁ + n₂) : m ∣ n₂ → m ∣ n₁ :=
nat.dvd_of_dvd_add_left (!add.comm ▸ H)

@[hott] theorem dvd_sub {m n₁ n₂ : ℕ} (H1 : m ∣ n₁) (H2 : m ∣ n₂) : m ∣ n₁ - n₂ :=
by_cases
  (assume H3 : n₁ ≥ n₂,
    have H4 : n₁ = n₁ - n₂ + n₂, from (nat.sub_add_cancel H3)⁻¹,
    show m ∣ n₁ - n₂, from nat.dvd_of_dvd_add_right (H4 ▸ H1) H2)
  (assume H3 : ¬ (n₁ ≥ n₂),
    have H4 : n₁ - n₂ = 0, from sub_eq_zero_of_le (le_of_lt (lt_of_not_ge H3)),
    show m ∣ n₁ - n₂, from H4⁻¹ ▸ dvd_zero _)

@[hott] theorem dvd.antisymm {m n : ℕ} : m ∣ n → n ∣ m → m = n :=
by_cases_zero_pos n
  (assume H1, assume H2 : 0 ∣ m, eq_zero_of_zero_dvd H2)
  (take n,
    assume Hpos : n > 0,
    assume H1 : m ∣ n,
    assume H2 : n ∣ m,
    obtain k (Hk : n = m * k), from exists_eq_mul_right_of_dvd H1,
    obtain l (Hl : m = n * l), from exists_eq_mul_right_of_dvd H2,
    have n * (l * k) = n, from !mul.assoc ▸ Hl ▸ Hk⁻¹,
    have l * k = 1,       from eq_one_of_mul_eq_self_right Hpos this,
    have k = 1,           from eq_one_of_mul_eq_one_left this,
    show m = n,           from (mul_one m)⁻¹ ⬝ (this ▸ Hk⁻¹))

@[hott] protected theorem mul_div_assoc (m : ℕ) {n k : ℕ} (H : k ∣ n) : m * n / k = m * (n / k) :=
sum.elim (eq_zero_sum_pos k)
  (assume H1 : k = 0,
    calc
      m * n / k = m * n / 0     : H1
              ... = 0           : nat.div_zero
              ... = m * 0       : mul_zero m
              ... = m * (n / 0) : nat.div_zero
              ... = m * (n / k) : H1)
  (assume H1 : k > 0,
    have H2 : n = n / k * k, from (nat.div_mul_cancel H)⁻¹,
      calc
        m * n / k = m * (n / k * k) / k   : H2
                ... = m * (n / k) * k / k : mul.assoc
                ... = m * (n / k)         : nat.mul_div_cancel _ H1)

@[hott] theorem dvd_of_mul_dvd_mul_left {m n k : ℕ} (kpos : k > 0) (H : k * m ∣ k * n) : m ∣ n :=
dvd.elim H
  (take l,
    assume H1 : k * n = k * m * l,
    have H2 : n = m * l, from eq_of_mul_eq_mul_left kpos (H1 ⬝ !mul.assoc),
    dvd.intro H2⁻¹)

@[hott] theorem dvd_of_mul_dvd_mul_right {m n k : ℕ} (kpos : k > 0) (H : m * k ∣ n * k) : m ∣ n :=
nat.dvd_of_mul_dvd_mul_left kpos (!mul.comm ▸ !mul.comm ▸ H)

@[hott] lemma dvd_of_eq_mul (i j n : nat) : n = j*i → j ∣ n :=
begin intros, subst n, apply dvd_mul_right end

@[hott] theorem div_dvd_div {k m n : ℕ} (H1 : k ∣ m) (H2 : m ∣ n) : m / k ∣ n / k :=
have H3 : m = m / k * k, from (nat.div_mul_cancel H1)⁻¹,
have H4 : n = n / k * k, from (nat.div_mul_cancel (dvd.trans H1 H2))⁻¹,
sum.elim (eq_zero_sum_pos k)
  (assume H5 : k = 0,
    have H6: n / k = 0, from (ap _ H5 ⬝ !nat.div_zero),
      H6⁻¹ ▸ !dvd_zero)
  (assume H5 : k > 0,
    nat.dvd_of_mul_dvd_mul_right H5 (H3 ▸ H4 ▸ H2))

@[hott] protected theorem div_eq_iff_eq_mul_right {m n : ℕ} (k : ℕ) (H : n > 0) (H' : n ∣ m) :
  m / n = k ↔ m = n * k :=
iff.intro
  (assume H1, by rewrite [-H1, nat.mul_div_cancel' H'])
  (assume H1, by rewrite [H1, !nat.mul_div_cancel_left H])

@[hott] protected theorem div_eq_iff_eq_mul_left {m n : ℕ} (k : ℕ) (H : n > 0) (H' : n ∣ m) :
  m / n = k ↔ m = k * n :=
!mul.comm ▸ !nat.div_eq_iff_eq_mul_right H H'

@[hott] protected theorem eq_mul_of_div_eq_right {m n k : ℕ} (H1 : n ∣ m) (H2 : m / n = k) :
  m = n * k :=
calc
  m     = n * (m / n) : nat.mul_div_cancel' H1
    ... = n * k       : H2

@[hott] protected theorem div_eq_of_eq_mul_right {m n k : ℕ} (H1 : n > 0) (H2 : m = n * k) :
  m / n = k :=
calc
  m / n = n * k / n : H2
      ... = k       : !nat.mul_div_cancel_left H1

@[hott] protected theorem eq_mul_of_div_eq_left {m n k : ℕ} (H1 : n ∣ m) (H2 : m / n = k) :
  m = k * n :=
!mul.comm ▸ !nat.eq_mul_of_div_eq_right H1 H2

@[hott] protected theorem div_eq_of_eq_mul_left {m n k : ℕ} (H1 : n > 0) (H2 : m = k * n) :
  m / n = k :=
!nat.div_eq_of_eq_mul_right H1 (!mul.comm ▸ H2)

@[hott] lemma add_mod_eq_of_dvd (i j n : nat) : n ∣ j → (i + j) % n = i % n :=
assume h,
obtain k (hk : j = n * k), from exists_eq_mul_right_of_dvd h,
begin
  subst j, rewrite mul.comm,
  apply add_mul_mod_self
end

/- / prod ordering -/

@[hott] lemma le_of_dvd {m n : nat} : n > 0 → m ∣ n → m ≤ n :=
assume (h₁ : n > 0) (h₂ : m ∣ n),
have h₃ : n % m = 0, from mod_eq_zero_of_dvd h₂,
by_contradiction
 (λ nle : ¬ m ≤ n,
   have   h₄ : m > n, from lt_of_not_ge nle,
   have h₅ : n % m = n, from mod_eq_of_lt h₄,
   begin
     rewrite h₃ at h₅, subst n,
     exact absurd h₁ (lt.irrefl 0)
   end)

@[hott] theorem div_mul_le (m n : ℕ) : m / n * n ≤ m :=
calc
  m = m / n * n + m % n : eq_div_mul_add_mod
    ... ≥ m / n * n       : le_add_right

@[hott] protected theorem div_le_of_le_mul {m n k : ℕ} (H : m ≤ n * k) : m / k ≤ n :=
sum.elim (eq_zero_sum_pos k)
  (assume H1 : k = 0,
    calc
      m / k = m / 0 : H1
          ... = 0       : nat.div_zero
          ... ≤ n       : zero_le)
  (assume H1 : k > 0,
    le_of_mul_le_mul_right (calc
      m / k * k ≤ m / k * k + m % k : le_add_right
        ... = m                     : eq_div_mul_add_mod
        ... ≤ n * k                 : H) H1)

@[hott] protected theorem div_le_self (m n : ℕ) : m / n ≤ m :=
nat.cases_on n (!nat.div_zero⁻¹ ▸ !zero_le)
  take n,
  have H : m ≤ m * succ n, from calc
        m = m * 1      : mul_one
      ... ≤ m * succ n : !mul_le_mul_left (succ_le_succ !zero_le),
  nat.div_le_of_le_mul H

@[hott] protected theorem mul_le_of_le_div {m n k : ℕ} (H : m ≤ n / k) : m * k ≤ n :=
calc
  m * k ≤ n / k * k : !mul_le_mul_right H
    ... ≤ n           : div_mul_le

@[hott] protected theorem le_div_of_mul_le {m n k : ℕ} (H1 : k > 0) (H2 : m * k ≤ n) : m ≤ n / k :=
have H3 : m * k < (succ (n / k)) * k, from
  calc
    m * k ≤ n                  : H2
      ... = n / k * k + n % k  : eq_div_mul_add_mod
      ... < n / k * k + k      : add_lt_add_left (!mod_lt H1)
      ... = (succ (n / k)) * k : succ_mul,
le_of_lt_succ (lt_of_mul_lt_mul_right H3)

@[hott] protected theorem le_div_iff_mul_le {m n k : ℕ} (H : k > 0) : m ≤ n / k ↔ m * k ≤ n :=
iff.intro !nat.mul_le_of_le_div (!nat.le_div_of_mul_le H)

@[hott] protected theorem div_le_div {m n : ℕ} (k : ℕ) (H : m ≤ n) : m / k ≤ n / k :=
by_cases_zero_pos k
  (by rewrite [*nat.div_zero])
  (take k, assume H1 : k > 0, nat.le_div_of_mul_le H1 (le.trans !div_mul_le H))

@[hott] protected theorem div_lt_of_lt_mul {m n k : ℕ} (H : m < n * k) : m / k < n :=
lt_of_mul_lt_mul_right (calc
  m / k * k ≤ m / k * k + m % k : le_add_right
    ... = m                     : eq_div_mul_add_mod
    ... < n * k                 : H)

@[hott] protected theorem lt_mul_of_div_lt {m n k : ℕ} (H1 : k > 0) (H2 : m / k < n) : m < n * k :=
have H3 : succ (m / k) * k ≤ n * k, from !mul_le_mul_right (succ_le_of_lt H2),
have H4 : m / k * k + k ≤ n * k, by rewrite [succ_mul at H3]; apply H3,
calc
  m     = m / k * k + m % k : eq_div_mul_add_mod
    ... < m / k * k + k     : add_lt_add_left (!mod_lt H1)
    ... ≤ n * k             : H4

@[hott] protected theorem div_lt_iff_lt_mul {m n k : ℕ} (H : k > 0) : m / k < n ↔ m < n * k :=
iff.intro (!nat.lt_mul_of_div_lt H) !nat.div_lt_of_lt_mul

@[hott] protected theorem div_le_iff_le_mul_of_div {m n : ℕ} (k : ℕ) (H : n > 0) (H' : n ∣ m) :
  m / n ≤ k ↔ m ≤ k * n :=
by refine iff.trans (!le_iff_mul_le_mul_right H) _; rewrite [!nat.div_mul_cancel H']

@[hott] protected theorem le_mul_of_div_le_of_div {m n k : ℕ} (H1 : n > 0) (H2 : n ∣ m) (H3 : m / n ≤ k) :
  m ≤ k * n :=
iff.mp (!nat.div_le_iff_le_mul_of_div H1 H2) H3

-- needed for integer division
@[hott] theorem mul_sub_div_of_lt {m n k : ℕ} (H : k < m * n) :
  (m * n - (k + 1)) / m = n - k / m - 1 :=
begin
  have H1 : k / m < n, from nat.div_lt_of_lt_mul (!mul.comm ▸ H),
  have H2 : n - k / m ≥ 1, from
    nat.le_sub_of_add_le (calc
       1 + k / m = succ (k / m) : add.comm
               ... ≤ n          : succ_le_of_lt H1),
  have H3 : n - k / m = n - k / m - 1 + 1, from (nat.sub_add_cancel H2)⁻¹,
  have H4 : m > 0, from pos_of_ne_zero (assume H': m = 0, not_lt_zero k (begin rewrite [H' at H, zero_mul at H], exact H end)),
  have H5   : k % m + 1 ≤ m, from succ_le_of_lt (!mod_lt H4),
  have H6 : m - (k % m + 1) < m, from nat.sub_lt_self H4 !succ_pos,
calc
  (m * n - (k + 1)) / m = (m * n - (k / m * m + k % m + 1)) / m : eq_div_mul_add_mod
     ... = (m * n - k / m * m - (k % m + 1)) / m                  : by rewrite [*nat.sub_sub]
     ... = ((n - k / m) * m - (k % m + 1)) / m                    :
               by rewrite [mul.comm m, nat.mul_sub_right_distrib]
     ... = ((n - k / m - 1) * m + m - (k % m + 1)) / m            :
               by rewrite [H3 at {1}, right_distrib, nat.one_mul]
     ... = ((n - k / m - 1) * m + (m - (k % m + 1))) / m          : {nat.add_sub_assoc H5 _}
     ... = (m - (k % m + 1)) / m + (n - k / m - 1)                :
               by rewrite [add.comm, (add_mul_div_self H4)]
     ... = n - k / m - 1                                          :
               by rewrite [div_eq_zero_of_lt H6, zero_add]
end

private @[hott] lemma div_div_aux (a b c : nat) : b > 0 → c > 0 → (a / b) / c = a / (b * c) :=
suppose b > 0, suppose c > 0,
nat.strong_rec_on a
(λ a ih,
  let k₁ := a / (b*c) in
  let k₂ := a %(b*c) in
  have bc_pos : b*c > 0, from mul_pos `b > 0` `c > 0`,
  have k₂ < b * c,       from mod_lt _ bc_pos,
  have k₂ ≤ a,           from !mod_le,
  sum.elim (eq_sum_lt_of_le this)
    (suppose k₂ = a,
     have i₁ : a < b * c,   by rewrite -this; assumption,
     have k₁ = 0,           from div_eq_zero_of_lt i₁,
     have a / b < c,      by rewrite [mul.comm at i₁]; exact nat.div_lt_of_lt_mul i₁,
     begin
       rewrite [`k₁ = 0`],
       show (a / b) / c = 0, from div_eq_zero_of_lt `a / b < c`
     end)
    (suppose k₂ < a,
     have a = k₁*(b*c) + k₂,         from eq_div_mul_add_mod a (b*c),
     have a / b = k₁*c + k₂ / b, by
       rewrite [this at {1}, mul.comm b c at {2}, -mul.assoc,
                add.comm, add_mul_div_self `b > 0`, add.comm],
     have e₁ : (a / b) / c = k₁ + (k₂ / b) / c, by
       rewrite [this, add.comm, add_mul_div_self `c > 0`, add.comm],
     have e₂ : (k₂ / b) / c = k₂ / (b * c), from ih k₂ `k₂ < a`,
     have e₃ : k₂ / (b * c)   = 0,              from div_eq_zero_of_lt `k₂ < b * c`,
     have (k₂ / b) / c      = 0,              by rewrite [e₂, e₃],
     show (a / b) / c = k₁,                     by rewrite [e₁, this]))

@[hott] protected lemma div_div_eq_div_mul (a b c : nat) : (a / b) / c = a / (b * c) :=
begin
 cases b with b,
   rewrite [zero_mul, *nat.div_zero, nat.zero_div],
   cases c with c,
     rewrite [mul_zero, *nat.div_zero],
     apply div_div_aux a (succ b) (succ c) dec_star dec_star
end

@[hott] lemma div_lt_of_ne_zero : Π {n : nat}, n ≠ 0 → n / 2 < n
| 0        h := absurd rfl h
| (succ n) h :=
  begin
    apply nat.div_lt_of_lt_mul,
    rewrite [-add_one, right_distrib],
    change n + 1 < (n * 1 + n) + (1 + 1),
    rewrite [mul_one, -add.assoc],
    apply add_lt_add_right,
    show n < n + n + 1,
    begin
      rewrite [add.assoc, -add_zero n at {1}],
      apply add_lt_add_left,
      apply zero_lt_succ
    end
  end
end nat
end hott


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.finsupp
import Mathlib.linear_algebra.direct_sum.tensor_product
import Mathlib.PostPort

universes u u_1 v u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# Results on direct sums and finitely supported functions.

1. The linear equivalence between finitely supported functions `ι →₀ M` and
the direct sum of copies of `M` indexed by `ι`.

2. The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N).
-/

/-- The finitely supported functions ι →₀ M are in linear equivalence with the direct sum of
copies of M indexed by ι. -/
def finsupp_lequiv_direct_sum (R : Type u) (M : Type v) [ring R] [add_comm_group M] [module R M]
    (ι : Type u_1) [DecidableEq ι] : linear_equiv R (ι →₀ M) (direct_sum ι fun (i : ι) => M) :=
  linear_equiv.of_linear
    (coe_fn finsupp.lsum
      ((fun (this : ι → linear_map R M (direct_sum ι fun (i : ι) => M)) => this)
        (direct_sum.lof R ι fun (i : ι) => M)))
    (direct_sum.to_module R ι (ι →₀ M) finsupp.lsingle) sorry sorry

@[simp] theorem finsupp_lequiv_direct_sum_single (R : Type u) (M : Type v) [ring R]
    [add_comm_group M] [module R M] (ι : Type u_1) [DecidableEq ι] (i : ι) (m : M) :
    coe_fn (finsupp_lequiv_direct_sum R M ι) (finsupp.single i m) =
        coe_fn (direct_sum.lof R ι (fun (i : ι) => M) i) m :=
  finsupp.sum_single_index
    (linear_map.map_zero
      ((fun (this : ι → linear_map R M (direct_sum ι fun (i : ι) => M)) => this)
        (direct_sum.lof R ι fun (i : ι) => M) i))

@[simp] theorem finsupp_lequiv_direct_sum_symm_lof (R : Type u) (M : Type v) [ring R]
    [add_comm_group M] [module R M] (ι : Type u_1) [DecidableEq ι] (i : ι) (m : M) :
    coe_fn (linear_equiv.symm (finsupp_lequiv_direct_sum R M ι))
          (coe_fn (direct_sum.lof R ι (fun (i : ι) => M) i) m) =
        finsupp.single i m :=
  direct_sum.to_module_lof R i m

/-- The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N). -/
def finsupp_tensor_finsupp (R : Type u_1) (M : Type u_2) (N : Type u_3) (ι : Type u_4)
    (κ : Type u_5) [comm_ring R] [add_comm_group M] [module R M] [add_comm_group N] [module R N] :
    linear_equiv R (tensor_product R (ι →₀ M) (κ →₀ N)) (ι × κ →₀ tensor_product R M N) :=
  linear_equiv.trans
    (tensor_product.congr (finsupp_lequiv_direct_sum R M ι) (finsupp_lequiv_direct_sum R N κ))
    (linear_equiv.trans (tensor_product.direct_sum R ι κ (fun (i : ι) => M) fun (i : κ) => N)
      (linear_equiv.symm (finsupp_lequiv_direct_sum R (tensor_product R M N) (ι × κ))))

@[simp] theorem finsupp_tensor_finsupp_single (R : Type u_1) (M : Type u_2) (N : Type u_3)
    (ι : Type u_4) (κ : Type u_5) [comm_ring R] [add_comm_group M] [module R M] [add_comm_group N]
    [module R N] (i : ι) (m : M) (k : κ) (n : N) :
    coe_fn (finsupp_tensor_finsupp R M N ι κ)
          (tensor_product.tmul R (finsupp.single i m) (finsupp.single k n)) =
        finsupp.single (i, k) (tensor_product.tmul R m n) :=
  sorry

@[simp] theorem finsupp_tensor_finsupp_symm_single (R : Type u_1) (M : Type u_2) (N : Type u_3)
    (ι : Type u_4) (κ : Type u_5) [comm_ring R] [add_comm_group M] [module R M] [add_comm_group N]
    [module R N] (i : ι × κ) (m : M) (n : N) :
    coe_fn (linear_equiv.symm (finsupp_tensor_finsupp R M N ι κ))
          (finsupp.single i (tensor_product.tmul R m n)) =
        tensor_product.tmul R (finsupp.single (prod.fst i) m) (finsupp.single (prod.snd i) n) :=
  sorry

end Mathlib


variables p q : Prop

example (h : p ∨ q) : q ∨ p :=
  or.elim h (λ hp, or.inr hp) (λ hq, or.inl hq)


import analysis.normed_space.basic
import topology.instances.ennreal
import analysis.normed_space.basic
import topology.instances.ennreal
import algebra.archimedean algebra.geom_sum
import data.nat.choose data.complex.basic
import tactic.linarith
import analysis.calculus.deriv
import data.complex.exponential

open finset
open cau_seq
namespace complex
noncomputable theory

def sin' (z : ℂ) : cau_seq ℂ complex.abs := ⟨λ n, (range n).sum (λ m, ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1), is_cau_exp z⟩
def sin_series (z : ℂ) : ℂ := lim (sin' z)

def cos' (z : ℂ) : cau_seq ℂ complex.abs := ⟨λ n, (range n).sum (λ m, (-1) ^ m * z ^ (2 * m) / nat.fact 2 * m), is_cau_exp z⟩
def cos_series (z : ℂ) : ℂ := lim (cos' z)

lemma series_arith : --maybe take the first few terms and conjecture that the rest of the series follows?
(λ n)(λ m)

theorem euler : exp (x * I) = cos x + sin x * I := rw → linarith

end complex


/-
# Function world.

## Level 7: `(P → Q) → ((Q → F) → (P → F))`

Have you noticed that, in stark contrast to earlier worlds,
we are not amassing a large collection of useful theorems?
We really are just constructing abstract levels with sets and
functions, and then solving them and never using the results
ever again. Here's another one, which should hopefully be
very easy for you now. Advanced mathematician viewers will
know it as contravariance of $\operatorname{Hom}(\cdot,F)$
functor.
-/

/- Definition
Whatever the sets $P$ and $Q$ and $F$ are, we
make an element of $\operatorname{Hom}(\operatorname{Hom}(P,Q),
\operatorname{Hom}(\operatorname{Hom}(Q,F),\operatorname{Hom}(P,F)))$.
-/
example (P Q F : Type) : (P → Q) → ((Q → F) → (P → F)) :=
begin
  intro f,
  intro h,
  intro p,
  apply h,
  apply f,
  exact p,

end