diff --git a/library/data/nat/default.lean b/library/data/nat/default.lean index 0ef7dd722..dcb1f4ec1 100644 --- a/library/data/nat/default.lean +++ b/library/data/nat/default.lean @@ -3,4 +3,4 @@ Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Jeremy Avigad -/ -import .basic .order .sub .div .bquant +import .basic .order .sub .div .bquant .sqrt diff --git a/library/data/nat/sqrt.lean b/library/data/nat/sqrt.lean new file mode 100644 index 000000000..7b3268ae6 --- /dev/null +++ b/library/data/nat/sqrt.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. + +Module: data.nat.sqrt +Authors: Leonardo de Moura + +Very simple (sqrt n) function that returns s s.t. + s*s ≤ n ≤ s*s + s + s +-/ +import data.nat.order + +namespace nat +open decidable + +-- This is the simplest possible function that just performs a linear search +definition sqrt_aux : nat → nat → nat +| 0 n := 0 +| (succ s) n := if (succ s)*(succ s) ≤ n then succ s else sqrt_aux s n + +theorem sqrt_aux_suc_of_pos {s n} : (succ s)*(succ s) ≤ n → sqrt_aux (succ s) n = (succ s) := +assume h, if_pos h + +theorem sqrt_aux_suc_of_neg {s n} : ¬ (succ s)*(succ s) ≤ n → sqrt_aux (succ s) n = sqrt_aux s n := +assume h, if_neg h + +definition sqrt (n : nat) : nat := +sqrt_aux n n + +theorem sqrt_aux_lower : ∀ {s n : nat}, s ≤ n → sqrt_aux s n * sqrt_aux s n ≤ n +| 0 n h := h +| (succ s) n h := by_cases + (λ h₁ : (succ s)*(succ s) ≤ n, by rewrite [sqrt_aux_suc_of_pos h₁]; exact h₁) + (λ h₂ : ¬ (succ s)*(succ s) ≤ n, + assert aux : s ≤ n, from lt.step (lt_of_succ_le h), + by rewrite [sqrt_aux_suc_of_neg h₂]; exact (sqrt_aux_lower aux)) + +theorem sqrt_lower (n : nat) : sqrt n * sqrt n ≤ n := +sqrt_aux_lower (le.refl n) + +theorem succ_squared (n : nat) : succ n * succ n = n*n + n + n + 1 := +calc succ n * succ n = (n+1)*(n+1) : by rewrite [add_one] + ... = n*n + n + n + 1 : by rewrite [mul.right_distrib, mul.left_distrib, one_mul, mul_one] + +theorem sqrt_aux_upper : ∀ {s n : nat}, n ≤ s*s + s + s → n ≤ sqrt_aux s n * sqrt_aux s n + sqrt_aux s n + sqrt_aux s n +| 0 n h := h +| (succ s) n h := by_cases + (λ h₁ : (succ s)*(succ s) ≤ n, + by rewrite [sqrt_aux_suc_of_pos h₁]; exact h) + (λ h₂ : ¬ (succ s)*(succ s) ≤ n, + assert h₃ : n < (succ s) * (succ s), from lt_of_not_le h₂, + assert h₄ : n ≤ s * s + s + s, by rewrite [succ_squared at h₃]; exact h₃, + by rewrite [sqrt_aux_suc_of_neg h₂]; exact (sqrt_aux_upper h₄)) + +theorem sqrt_upper (n : nat) : n ≤ sqrt n * sqrt n + sqrt n + sqrt n := +have aux : n ≤ n*n + n + n, from le_add_of_le_right (le_add_of_le_left (le.refl n)), +sqrt_aux_upper aux +end nat