diff --git a/library/init/data/list/lemmas.lean b/library/init/data/list/lemmas.lean index f179ebd805..e3080b2045 100644 --- a/library/init/data/list/lemmas.lean +++ b/library/init/data/list/lemmas.lean @@ -629,6 +629,59 @@ by simp [scanr] attribute [simp] repeat take drop +/- filter -/ +@[simp] theorem filter_nil (p : α → Prop) [h : decidable_pred p] : filter p [] = [] := rfl + +@[simp] theorem filter_cons_of_pos {p : α → Prop} [h : decidable_pred p] {a : α} : + ∀ l, p a → filter p (a::l) = a :: filter p l := +λ l pa, if_pos pa + +@[simp] theorem filter_cons_of_neg {p : α → Prop} [h : decidable_pred p] {a : α} : + ∀ l, ¬ p a → filter p (a::l) = filter p l := +λ l pa, if_neg pa + +@[simp] theorem filter_append {p : α → Prop} [h : decidable_pred p] : + ∀ (l₁ l₂ : list α), filter p (l₁++l₂) = filter p l₁ ++ filter p l₂ +| [] l₂ := rfl +| (a::l₁) l₂ := if pa : p a then by simp [pa, filter_append] else by simp [pa, filter_append] + +@[simp] theorem filter_sublist {p : α → Prop} [h : decidable_pred p] : Π (l : list α), filter p l <+ l +| [] := sublist.slnil +| (a::l) := if pa : p a + then by simp[pa]; apply sublist.cons2; apply filter_sublist l + else by simp[pa]; apply sublist.cons; apply filter_sublist l + +@[simp] theorem filter_subset {p : α → Prop} [h : decidable_pred p] (l : list α) : filter p l ⊆ l := +subset_of_sublist $ filter_sublist l + +theorem of_mem_filter {p : α → Prop} [h : decidable_pred p] {a : α} : ∀ {l}, a ∈ filter p l → p a +| [] ain := absurd ain (not_mem_nil a) +| (b::l) ain := + if pb : p b then + have a ∈ b :: filter p l, begin simp [pb] at ain, assumption end, + or.elim (eq_or_mem_of_mem_cons this) + (suppose a = b, begin rw -this at pb, exact pb end) + (suppose a ∈ filter p l, of_mem_filter this) + else + begin simp [pb] at ain, exact (of_mem_filter ain) end + +theorem mem_of_mem_filter {p : α → Prop} [h : decidable_pred p] {a : α} + {l} (h : a ∈ filter p l) : a ∈ l := +filter_subset l h + +theorem mem_filter_of_mem {p : α → Prop} [h : decidable_pred p] {a : α} : + ∀ {l}, a ∈ l → p a → a ∈ filter p l +| [] ain pa := absurd ain (not_mem_nil a) +| (b::l) ain pa := + if pb : p b then + or.elim (eq_or_mem_of_mem_cons ain) + (suppose a = b, by simp [pb, this]) + (suppose a ∈ l, begin simp [pb], exact (mem_cons_of_mem _ (mem_filter_of_mem this pa)) end) + else + or.elim (eq_or_mem_of_mem_cons ain) + (suppose a = b, begin simp [this] at pa, contradiction end) --absurd (this ▸ pa) pb) + (suppose a ∈ l, by simp [pa, pb, mem_filter_of_mem this]) + @[simp] lemma partition_eq_filter_filter (p : α → Prop) [decidable_pred p] : ∀ (l : list α), partition p l = (filter p l, filter (not ∘ p) l) | [] := rfl | (a::l) := by { by_cases p a with pa; simp [partition, filter, pa, partition_eq_filter_filter l], diff --git a/library/init/data/list/qsort.lean b/library/init/data/list/qsort.lean index c2f3a5432a..b81676a70b 100644 --- a/library/init/data/list/qsort.lean +++ b/library/init/data/list/qsort.lean @@ -4,19 +4,42 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: Leonardo de Moura -/ prelude -import init.data.list.basic +import init.data.list.lemmas init.wf namespace list -/- TODO(Leo): remove meta as soon as equation compiler has support for well founded recursion. +-- Note: we can't use the equation compiler here because +-- init.meta.well_founded_tactics uses this file +def qsort.F {α} (lt : α → α → bool) : Π (x : list α), + (Π (y : list α), length y < length x → list α) → list α +| [] IH := [] +| (h::t) IH := begin + ginduction partition (λ x, lt h x = tt) t with e large small, + have : length small < length (h::t) ∧ length large < length (h::t), + { rw partition_eq_filter_filter at e, + injection e, + subst large, subst small, + constructor; + exact nat.succ_le_succ (length_le_of_sublist (filter_sublist _)) }, + exact IH small this.left ++ h :: IH large this.right + end - This is based on the minimalist Haskell "quicksort". +/- This is based on the minimalist Haskell "quicksort". Remark: this is *not* really quicksort since it doesn't partition the elements in-place -/ -meta def qsort {α} (lt : α → α → bool) : list α → list α -| [] := [] -| (h::t) := - let (large, small) := partition (λ x, lt h x = tt) t - in qsort small ++ h :: qsort large +def qsort {α} (lt : α → α → bool) : list α → list α := +well_founded.fix (inv_image.wf length nat.lt_wf) (qsort.F lt) + +@[simp] theorem qsort_nil {α} (lt : α → α → bool) : qsort lt [] = [] := +by rw [qsort, well_founded.fix_eq, qsort.F] + +@[simp] theorem qsort_cons {α} (lt : α → α → bool) (h t) : qsort lt (h::t) = + let (large, small) := partition (λ x, lt h x = tt) t in + qsort lt small ++ h :: qsort lt large := +begin + rw [qsort, well_founded.fix_eq, qsort.F], + ginduction partition (λ x, lt h x = tt) t with e large small, + simp [e], dsimp, rw [e] +end end list