diff options
Diffstat (limited to 'books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly')
25 files changed, 9437 insertions, 0 deletions
diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/certify.lsp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/certify.lsp new file mode 100644 index 0000000..85bfd85 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/certify.lsp @@ -0,0 +1,329 @@ + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(certify-book "coe-fld" + 2 + nil ;;compile-flg + ) + +:u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FUTER" + *import-symbols*) + +(certify-book "futermino" + 2 + nil ;;compile-flg + ) + +:u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(certify-book "fumonomio" + 4 + nil ;;compile-flg + ) + +:u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fupolinomio" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuforma-normal" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fusuma" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fucongruencias-suma" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuopuesto" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuproducto" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fucongruencias-producto" + 5 + nil ;;compile-flg + ) + +:u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(defpkg "FUNPOL" + (set-difference-eq *import-symbols* + '(rem))) + +(certify-book "fupolinomio-normalizado" + 6 + nil ;;compile-flg + ) + +:u :u :u :u :u :u :u + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(defpkg "FUNPOL" + (set-difference-eq *import-symbols* + '(rem))) + +(certify-book "fuquot-rem" + 6 + nil ;;compile-flg + ) + +:u :u :u :u :u :u :u diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.acl2 new file mode 100644 index 0000000..5b249f4 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.acl2 @@ -0,0 +1,14 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(certify-book "coe-fld" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.lisp new file mode 100644 index 0000000..cc8c336 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.lisp @@ -0,0 +1,1066 @@ +; ACL2 Univariate Polynomials over a Field books -- Coefficients + +;; The ACL2 Coeficientes abstractos book, in coeficiente.lisp, is modified +;; by replacing equality between coefficients with an equivalence relation +;; which satisfies the appropriate congruence theorems. Also the axioms for +;; a Ring are replaced with the axioms for a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by +;; John Cowles +;; Department of Computer Science +;; University of Wyoming +;; Laramie, WY 82071-3682 U.S.A. + +;; Modified June 2006. +;; Last modified July 2006 (for ACL2 Version 3.0). + +; Modified by Matt Kaufmann for ACL2 Version 3.1 because +; SBCL complains about LISP::. + +;; Based on +;;; ------------------------------------------------------------------ +;;; Coeficientes abstractos +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Anillo abeliano de coeficientes. El conjunto de los coeficientes +;;; se representa como un anillo abeliano abstracto mediante un +;;; encapsulado. El conjunto de los números de ACL2 con su +;;; interpretación habitual sirve como modelo de la teoría generada. +;;; +;;; Notas generales: +;;; +;;; Puede ser interesante comparar esta formalización con la que +;;; aparece en los libros sobre aritmética de Kaufmann, Brock y +;;; Cowles. +;;; +;;; Se han incluido algunos teoremas que se deducen inmediatamente de +;;; otros por aplicación directa de la conmutatividad. Estos teoremas +;;; son innecesarios desde un punto de vista lógico, pero evitan el +;;; abuso de la conmutatividad. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following package: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(certify-book "coe-fld" + 2 + nil ;;compile-flg + ) +|# +(in-package "FLD") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; A Field is a nonempty set with two binary operations, addition and +;; multiplication, two unary operations, minus and inverse, and two field +;; elements, zero and one, such that + +;; (1) the binary operations are commutative and associative, +;; (2) multiplication distributes over addition, +;; (3) zero is an identity for addition, +;; (4) minus produces an additive inverse, +;; (5) one is an identity for addition, and +;; (6) inverse produces a multiplicative inverse +;; for non-zero field elements. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Equality between ring elements is replaced with an equivalence relation +;; that satisfies the appropriate congruence theorems. + +;; There is also a ``choice'' function on the equivalence classes that +;; chooses an element from each equivalence class. In case new operations +;; on the field are defined by future users of this book, this choice +;; function may aid in defining these new operations, so as to ensure that +;; the congruence theorems for the new operations hold. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(encapsulate + + ;;; --------- + ;;; Signatura + ;;; --------- + +;; ((coeficientep (a) boolean) +;; (+ (a b) coeficiente) +;; (* (a b) coeficiente) +;; (- (a) coeficiente) +;; (nulo () coeficiente) +;; (identidad () coeficiente)) + + ((fdp (x) x) ; x is in the field iff (fdg x). + (+ (a b) f) ; Addition in Field. + (* (a b) f) ; Multiplication in Field. + (- (f) f) ; Unary minus in Field. + (/ (f) f) ; Unary recipical in Field + (0_f () f) ; 0 element in Field. + (1_f () f) ; 1 element in Field. + (= (a b) Boolean) ; Equality predicate for Field elements. + (C_= (f) f)) ; Choose unique equivalence class representative for =. + + ;;; ---------------- + ;;; Testigos locales + ;;; ---------------- + + ;;; Reconocedor + +;; (local +;; (defun coeficientep (a) +;; (acl2-numberp a))) + + (local (defun + fdp (a) + (acl2-numberp a))) + + ;;; Primera operación + + (local + (defun + (a b) +; (declare (xargs :guard (and (coeficientep a) (coeficientep b)))) + (ACL2::+ a b))) + + ;;; Segunda operación + + (local + (defun * (a b) +; (declare (xargs :guard (and (coeficientep a) (coeficientep b)))) + (ACL2::* a b))) + + ;;; Inverso de la primera operación + + (local + (defun - (a) +; (declare (xargs :guard (coeficientep a))) + (ACL2::- a))) + + (local + (defun / (a) +; (declare (xargs :guard (coeficientep a))) + (ACL2::/ a))) + + ;;; Neutro de la primera operación + +;; (local +;; (defun nulo () +;; 0)) + + (local (defun 0_f () + 0)) + + ;;; Neutro de la segunda operación + +;; (local +;; (defun identidad () +;; 1)) + + (local (defun 1_f () + 1)) + + ;;; Igualdad sintáctica + +;; (defmacro = (a b) +;; `(equal ,a ,b)) + + (local (defun = (a b) + (equal a b))) + + (local (defun C_= (x) + (identity x))) + + ;;; ------- + ;;; Axiomas + ;;; ------- + ;;; Field Axioms: + + ;;; El reconocedor es una función booleana + +;; (defthm booleanp-coeficientep +;; (booleanp (coeficientep a)) +;; :rule-classes :type-prescription) + + (defthm booleanp-fdp + (booleanp (fdp a)) + :rule-classes :type-prescription) + + ;;; Clausura de las operaciones + + (defthm + Closure-Laws + (and (implies (fdp a) + (and (implies (fdp b) + (and (fdp (+ a b)) + (fdp (* a b)))) + (fdp (- a)) + (fdp (C_= a)) + (implies (not (= a (0_f))) + (fdp (/ a))))) + (fdp (0_f)) + (fdp (1_f))) + :rule-classes nil) + + (defthm + Equivalence-Law + (and (booleanp (= x y)) + (= x x) + (implies (= x y) + (= y x)) + (implies (and (= x y) + (= y z)) + (= x z))) + :rule-classes :equivalence) + + (defthm + Congruence-Laws + (implies (= y1 y2) + (and (iff (fdp y1) + (fdp y2)) + (= (+ x y1) + (+ x y2)) + (= (* x y1) + (* x y2)) + (= (+ y1 z) + (+ y2 z)) + (= (* y1 z) + (* y2 z)) + (= (- y1) + (- y2)) + (= (/ y1) + (/ y2)))) + :rule-classes nil) + + (defthm + Equivalence-class-Laws + (and (implies (fdp x) + (= (C_= x) x)) + (implies (= y1 y2) + (equal (C_= y1) + (C_= y2)))) + :rule-classes nil) + +;; (defthm |0 != 1| +;; (not (equal (nulo) (identidad)))) + + (defthm |0 != 1| + (not (= (0_f)(1_f)))) + + (defthm + Commutativity-Laws + (implies (and (fdp a) + (fdp b)) + (and (= (+ a b) + (+ b a)) + (= (* a b) + (* b a)))) + :rule-classes nil) + + (defthm + Associativity-Laws + (implies (and (fdp a) + (fdp b) + (fdp c)) + (and (= (+ (+ a b) c) + (+ a (+ b c))) + (= (* (* a b) c) + (* a (* b c))))) + :rule-classes nil) + + (defthm + Left-Distributivity-Law + (implies (and (fdp a) + (fdp b) + (fdp c)) + (= (* a (+ b c)) + (+ (* a b) + (* a c)))) + :rule-classes nil) + + (defthm + Left-Unicity-Laws + (implies (fdp a) + (and (= (+ (0_f) a) + a) + (= (* (1_f) a) + a))) + :rule-classes nil) + + (defthm + Right-Inverse-Laws + (implies (fdp a) + (and (= (+ a (- a)) + (0_f)) + (implies (not (= a (0_f))) + (= (* a (/ a)) + (1_f))))) + :rule-classes nil) + ) ;;end encapsulate + +;; (defthm coeficientep-+ +;; (implies (and (coeficientep a) (coeficientep b)) +;; (coeficientep (+ a b))) +;; :rule-classes :type-prescription) + +(defthm + Fdp-+ + (implies (and (fdp a)(fdp b)) + (fdp (+ a b))) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +;; (defthm coeficientep-* +;; (implies (and (coeficientep a) (coeficientep b)) +;; (coeficientep (* a b))) +;; :rule-classes :type-prescription) + +(defthm + Fdp-* + (implies (and (fdp a)(fdp b)) + (fdp (* a b))) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +;; (defthm coeficientep-- +;; (implies (coeficientep a) +;; (coeficientep (- a))) +;; :rule-classes :type-prescription) + +(defthm + Fdp_- + (implies (fdp a) + (fdp (- a))) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +(defthm + Fdp-/ + (implies (and (fdp a) + (not (= a (0_f)))) + (fdp (/ a))) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +;; (defthm coeficientep-nulo +;; (coeficientep (nulo)) +;; :rule-classes :type-prescription) + +(defthm + Fdp-0_f + (fdp (0_f)) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +;; (defthm coeficientep-identidad +;; (coeficientep (identidad)) +;; :rule-classes :type-prescription) + +(defthm + Fdp-1_f + (fdp (1_f)) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +(defthm + Fdp-C_= + (implies (fdp a) + (fdp (C_= a))) + :rule-classes :type-prescription + :hints (("Goal" + :use Closure-Laws))) + +(defthm + =-implies-iff-fdp + (implies (= y1 y2) + (iff (fdp y1) + (fdp y2))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + +(defthm + =-implies-=-+-1 + (implies (= y1 y2) + (= (+ y1 z) + (+ y2 z))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + +(defthm + =-implies-=-+-2 + (implies (= y1 y2) + (= (+ x y1) + (+ x y2))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + +(defthm + =-implies-=-*-1 + (implies (= y1 y2) + (= (* y1 z) + (* y2 z))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + +(defthm + =-implies-=-*-2 + (implies (= y1 y2) + (= (* x y1) + (* x y2))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + +(defthm + =-implies-=_- + (implies (= y1 y2) + (= (- y1) + (- y2))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + +(defthm + =-implies-=-/ + (implies (= y1 y2) + (= (/ y1) + (/ y2))) + :rule-classes :congruence + :hints (("Goal" + :use Congruence-Laws))) + + ;;; Conmutatividad de la primera operación + +;; (defthm |a + b = b + a| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (+ a b) (+ b a)))) + +(defthm |a + b = b + a| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (+ a b) (+ b a))) + :hints (("Goal" + :use Commutativity-Laws))) + + ;;; Asociatividad de la primera operación + +;; (defthm |(a + b) + c = a + (b + c)| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (= (+ (+ a b) c) (+ a (+ b c))))) + +(defthm |(a + b) + c = a + (b + c)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c))) + (= (+ (+ a b) c) (+ a (+ b c)))) + :hints (("Goal" + :use Associativity-Laws))) + + ;;; Neutro de la primera operación + +;; (defthm |0 + a = a| +;; (implies (coeficientep a) +;; (= (+ (nulo) a) a))) + +(defthm |0 + a = a| + (implies (fdp (double-rewrite a)) + (= (+ (0_f) a) a)) + :hints (("Goal" + :use Left-Unicity-Laws))) + + ;;; Conmutatividad de la segunda operación + +;; (defthm |a * b = b * a| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (* a b) (* b a)))) + +(defthm |a * b = b * a| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (* a b) (* b a))) + :hints (("Goal" + :use Commutativity-Laws))) + + ;;; Asociatividad de la segunda operación + +;; (defthm |(a * b) * c = a * (b * c)| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (= (* (* a b) c) (* a (* b c))))) + +(defthm |(a * b) * c = a * (b * c)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c))) + (= (* (* a b) c) (* a (* b c)))) + :hints (("Goal" + :use Associativity-Laws))) + + ;;; Neutro de la segunda operación + +;; (defthm |1 * a = a| +;; (implies (coeficientep a) +;; (= (* (identidad) a) a))) + +(defthm |1 * a = a| + (implies (fdp (double-rewrite a)) + (= (* (1_f) a) a)) + :hints (("Goal" + :use Left-Unicity-Laws))) + + ;;; Inverso de la primera operación + +;; (defthm |a + (- a) = 0| +;; (implies (coeficientep a) +;; (= (+ a (- a)) (nulo)))) + +(defthm |a + (- a) = 0| + (implies (fdp (double-rewrite a)) + (= (+ a (- a)) (0_f))) + :hints (("Goal" + :use Right-Inverse-Laws))) + +(defthm |a * (/ a) = 1| + (implies (and (fdp (double-rewrite a)) + (not (= (double-rewrite a) (0_f)))) + (= (* a (/ a)) (1_f))) + :hints (("Goal" + :use Right-Inverse-Laws))) + + ;;; Distributividad de la segunda operación respecto a la primera + +;; (defthm |a * (b + c) = (a * b) + (a * c)| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (= (* a (+ b c)) (+ (* a b) (* a c)))))) + +(defthm |a * (b + c) = (a * b) + (a * c)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c))) + (= (* a (+ b c)) (+ (* a b) (* a c)))) + :hints (("Goal" + :use Left-Distributivity-Law))) + +;;; ----------------------------------------------------------------------- +;;; El inverso debe ser invisible para la primera operación y para sí mismo +;;; ----------------------------------------------------------------------- + +;; (ACL2::set-invisible-fns-table ((+ -) (- -))) +(set-invisible-fns-table ((+ -) (- -) (* /) (/ /))) + +;;; -------- +;;; Teoremas +;;; -------- + +(defthm + =-C_= + (implies (fdp (double-rewrite x)) + (= (C_= x) x)) + :hints (("Goal" + :use Equivalence-class-Laws))) + +(defthm + =-implies-equal-C_= + (implies (= y1 y2) + (equal (C_= y1) + (C_= y2))) + :rule-classes :congruence + :hints (("Goal" + :use Equivalence-class-Laws))) + +;;; Teoremas que resultan de aplicar la conmutatividad a los axiomas + +;; (defthm |a + 0 = a| +;; (implies (coeficientep a) +;; (= (+ a (nulo)) a))) + +(defthm |a + 0 = a| + (implies (fdp (double-rewrite a)) + (= (+ a (0_f)) a))) + +;; (defthm |a * 1 = a| +;; (implies (coeficientep a) +;; (= (* a (identidad)) a))) + +(defthm |a * 1 = a| + (implies (fdp (double-rewrite a)) + (= (* a (1_f)) a))) + +;; (defthm |(- a) + a = 0| +;; (implies (coeficientep a) +;; (= (+ (- a) a) (nulo)))) + +(defthm |(- a) + a = 0| + (implies (fdp (double-rewrite a)) + (= (+ (- a) a) (0_f)))) + +(defthm |(/ a) * a = 1| + (implies (and (fdp (double-rewrite a)) + (not (= (double-rewrite a) (0_f)))) + (= (* (/ a) a) (1_f)))) + +;; (defthm |(a + b) * c = (a * c) + (b * c)| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (= (* (+ a b) c) (+ (* a c) (* b c))))) + +(defthm |(a + b) * c = (a * c) + (b * c)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c))) + (= (* (+ a b) c) (+ (* a c) (* b c))))) + +;;; Teorema de cancelación + +;; (defthm |a + c = b + c <=> a = b| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (iff (= (+ a c) (+ b c)) (= a b))) +;; :hints (("Goal" +;; :in-theory (disable |a + b = b + a| |a + 0 = a|) +;; :use ((:instance |a + b = b + a| (a (+ a c)) (b (- c))) +;; (:instance |a + b = b + a| (a (- c)) (b (+ b c))) +;; (:instance |a + 0 = a| (a b)) +;; |a + 0 = a|)))) + +(defthm |a + c = b + c <=> a = b| + (implies (and (fdp a) (fdp b) (fdp c)) + (iff (= (+ a c) (+ b c)) (= a b))) + :hints (("Goal" + :in-theory (disable |a + b = b + a| |a + 0 = a|) + :use ((:instance |a + b = b + a| (a (+ a c)) (b (- c))) + (:instance |a + b = b + a| (a (- c)) (b (+ b c))) + (:instance |a + 0 = a| (a b)) + |a + 0 = a|)))) + +;;; NOTA: +;;; +;;; Estos teoremas son innecesarios desde un punto de vista lógico +;;; pero son útiles en las subsecuentes demostraciones. + +;; (local +;; (defthm |a + b = b <=> a = 0| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (iff (= (+ a b) b) (= a (nulo)))) +;; :hints (("Goal" +;; :in-theory (disable |a + c = b + c <=> a = b|) +;; :use (:instance |a + c = b + c <=> a = b| (b (nulo)) (c b)))))) + +(local + (defthm |a + b = b <=> a = 0| + (implies (and (fdp a) (fdp b)) + (iff (= (+ a b) b) (= a (0_f)))) + :hints (("Goal" + :in-theory (disable |a + c = b + c <=> a = b|) + :use (:instance |a + c = b + c <=> a = b| (b (0_f)) (c b)))))) + +;; (local +;; (defthm |a + b = 0 <=> b = - a| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (iff (= (+ a b) (nulo)) (= b (- a)))) +;; :hints (("Goal" +;; :in-theory (disable |a + c = b + c <=> a = b|) +;; :use (:instance |a + c = b + c <=> a = b| (a b) (b (- a)) (c a)))))) + +(local + (defthm |a + b = 0 <=> b = - a| + (implies (and (fdp a) (fdp b)) + (iff (= (+ a b) (0_f)) (= b (- a)))) + :hints (("Goal" + :in-theory (disable |a + c = b + c <=> a = b|) + :use (:instance |a + c = b + c <=> a = b| (a b) (b (- a)) (c a)))))) + +;;; Complemento a la conmutatividad y la asociatividad de la primera operación + +;;; NOTA: +;;; +;;; Dada una operación, las reglas generadas por este teorema y los +;;; axiomas de conmutatividad y asociatividad permiten decidir una +;;; igualdad de dos términos en los que sólo intervienen símbolos sin +;;; interpretación y dicha operación. Esto se debe a que ACL2 emplea +;;; un sistema de reescritura ordenada. Véase «Ordered Rewriting and +;;; Confluence», por Martin y Nipkow. + +;; (defthm |a + (b + c) = b + (a + c)| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (= (+ a (+ b c)) (+ b (+ a c)))) +;; :hints (("Goal" +;; :in-theory (disable |(a + b) + c = a + (b + c)|) +;; :use (|(a + b) + c = a + (b + c)| +;; (:instance |(a + b) + c = a + (b + c)| (a b) (b a)))))) + +(defthm |a + (b + c) = b + (a + c)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c))) + (= (+ a (+ b c)) (+ b (+ a c)))) + :hints (("Goal" + :in-theory (disable |(a + b) + c = a + (b + c)|) + :use (|(a + b) + c = a + (b + c)| + (:instance |(a + b) + c = a + (b + c)| (a b) (b a)))))) + +;;; Complemento a la conmutatividad y la asociatividad de la segunda operación + +;;; NOTA: +;;; +;;; Se aplican comentarios análogos a los del caso anterior. + +;; (defthm |a * (b * c) = b * (a * c)| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c)) +;; (= (* a (* b c)) (* b (* a c)))) +;; :hints (("Goal" +;; :in-theory (disable |(a * b) * c = a * (b * c)|) +;; :use (|(a * b) * c = a * (b * c)| +;; (:instance |(a * b) * c = a * (b * c)| (a b) (b a)))))) + +(defthm |a * (b * c) = b * (a * c)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c))) + (= (* a (* b c)) (* b (* a c)))) + :hints (("Goal" + :in-theory (disable |(a * b) * c = a * (b * c)|) + :use (|(a * b) * c = a * (b * c)| + (:instance |(a * b) * c = a * (b * c)| (a b) (b a)))))) + +;;; Idempotencia del inverso + +;; (defthm |- (- a) = a| +;; (implies (coeficientep a) +;; (= (- (- a)) a)) +;; :hints (("Goal" +;; :in-theory (disable |a + b = 0 <=> b = - a|) +;; :use (:instance |a + b = 0 <=> b = - a| (a (- a)) (b a))))) + +(defthm |- (- a) = a| + (implies (fdp (double-rewrite a)) + (= (- (- a)) a)) + :hints (("Goal" + :in-theory (disable |a + b = 0 <=> b = - a|) + :use (:instance |a + b = 0 <=> b = - a| (a (- a)) (b a))))) + +;;; Distributividad de la inversa sobre la primera operación + +;; (defthm |- (a + b) = (- a) + (- b)| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (- (+ a b)) (+ (- a) (- b)))) +;; :hints (("Goal" +;; :in-theory (disable |a + b = 0 <=> b = - a|) +;; :use (:instance |a + b = 0 <=> b = - a| (a (+ a b)) (b (+ (- a) (- b))))))) + +(defthm |- (a + b) = (- a) + (- b)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (- (+ a b)) (+ (- a) (- b)))) + :hints (("Goal" + :in-theory (disable |a + b = 0 <=> b = - a|) + :use (:instance |a + b = 0 <=> b = - a| + (a (+ a b)) (b (+ (- a) (- b))))))) + +;;; Inverso del neutro de la primera operación + +;; (defthm |- 0 = 0| +;; (= (- (nulo)) (nulo)) +;; :hints (("Goal" +;; :in-theory (disable |a + b = 0 <=> b = - a|) +;; :use (:instance |a + b = 0 <=> b = - a| (a (nulo)) (b (nulo)))))) + +(defthm |- 0 = 0| + (= (- (0_f)) (0_f)) + :hints (("Goal" + :in-theory (disable |a + b = 0 <=> b = - a|) + :use (:instance |a + b = 0 <=> b = - a| (a (0_f)) (b (0_f)))))) + +;;; Generalización de |a + (- a) = 0| + +;; (defthm |a + ((- a) + b) = b| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (+ a (+ (- a) b)) b)) +;; :hints (("Goal" +;; :in-theory (disable |a + (b + c) = b + (a + c)|) +;; :use (:instance |a + (b + c) = b + (a + c)| (c (- a)))))) + +(defthm |a + ((- a) + b) = b| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (+ a (+ (- a) b)) b)) + :hints (("Goal" + :in-theory (disable |a + (b + c) = b + (a + c)|) + :use (:instance |a + (b + c) = b + (a + c)| (c (- a)))))) + +;; (defthm |a + (b + (- a)) = b| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (+ a (+ b (- a))) b))) + +(defthm |a + (b + (- a)) = b| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (+ a (+ b (- a))) b))) + +;;; Elemento cancelador de la segunda operación + +;; (defthm |0 * a = 0| +;; (implies (coeficientep a) +;; (= (* (nulo) a) (nulo))) +;; :hints (("Goal" +;; :in-theory (disable |a * (b + c) = (a * b) + (a * c)|) +;; :use (:instance |a * (b + c) = (a * b) + (a * c)| +;; (b (nulo)) (c (nulo)))))) + +(defthm |0 * a = 0| + (implies (fdp (double-rewrite a)) + (= (* (0_f) a) (0_f))) + :hints (("Goal" + :in-theory (disable |a * (b + c) = (a * b) + (a * c)| + |a + b = b <=> a = 0|) + :use ((:instance |a * (b + c) = (a * b) + (a * c)| + (b (0_f)) (c (0_f))) + (:instance |a + b = b <=> a = 0| + (a (* a (0_f)))(b (* a (0_f)))))))) + +;; (defthm |a * 0 = 0| +;; (implies (coeficientep a) +;; (= (* a (nulo)) (nulo)))) + +(defthm |a * 0 = 0| + (implies (fdp (double-rewrite a)) + (= (* a (0_f)) (0_f)))) + +;;; Extracción del inverso + +;; (defthm |a * (- b) = - (a * b)| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (* a (- b)) (- (* a b)))) +;; :hints (("Goal" +;; :in-theory (disable |a * (b + c) = (a * b) + (a * c)|) +;; :use (:instance |a * (b + c) = (a * b) + (a * c)| (b (- b)) (c b))))) + +(defthm |a * (- b) = - (a * b)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (* a (- b)) (- (* a b)))) + :hints (("Goal" + :in-theory (disable |a * (b + c) = (a * b) + (a * c)| + |a + b = 0 <=> b = - a|) + :use ((:instance |a * (b + c) = (a * b) + (a * c)| (b (- b)) (c b)) + (:instance |a + b = 0 <=> b = - a| (a (* a b))(b (* a (- b)))))))) + +;; (defthm |(- a) * b = - (a * b)| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (= (* (- a) b) (- (* a b))))) + +(defthm |(- a) * b = - (a * b)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b))) + (= (* (- a) b) (- (* a b))))) + +;;; Generalización de |- 0 = 0| + +;; (defthm |- a = 0 <=> a = 0| +;; (implies (coeficientep a) +;; (iff (= (- a) (nulo)) (= a (nulo)))) +;; :hints (("Goal" +;; :in-theory (disable |a + b = 0 <=> b = - a|) +;; :use (:instance |a + b = 0 <=> b = - a| (b (nulo)))))) + +(defthm |- a = 0 <=> a = 0| + (implies (fdp a) + (iff (= (- a) (0_f)) (= a (0_f)))) + :hints (("Goal" + :in-theory (disable |a + b = 0 <=> b = - a|) + :use (:instance |a + b = 0 <=> b = - a| (b (0_f)))))) + +(defthm |a * c = b * c <=> a = b or c = 0| + (implies (and (fdp a) + (fdp b) + (fdp c)) + (iff (= (* a c) (* b c)) + (or (= a b) + (= c (0_f))))) + :hints (("Subgoal 3" + :in-theory (disable =-implies-=-*-1) + :use (:instance + =-implies-=-*-1 + (y1 (* a c)) + (y2 (* b c)) + (z (/ c)))))) + +(local + (defthm |a * b = b <=> a = 1| + (implies (and (fdp a) + (fdp b) + (not (= b (0_f)))) + (iff (= (* a b) b) + (= a (1_f)))) + :hints (("Goal" + :in-theory (disable |a * c = b * c <=> a = b or c = 0|) + :use (:instance |a * c = b * c <=> a = b or c = 0| + (b (1_f)) (c b)))))) + +(local + (defthm |a != 0 implies a * b = 1 <=> b = (/ a)| + (implies (and (fdp a) + (fdp b) + (not (= a (0_f)))) + (iff (= (* a b) (1_f)) (= b (/ a)))) + :hints (("Goal" + :in-theory (disable |a * c = b * c <=> a = b or c = 0|) + :use (:instance |a * c = b * c <=> a = b or c = 0| + (a b) (b (/ a)) (c a)))))) + +(defthm + |/ a != 0| + (implies (and (fdp a) + (not (= a (0_f)))) + (not (= (/ a)(0_f)))) + :hints (("Goal" + :in-theory (disable |a * 0 = 0| + |a * (/ a) = 1|) + :use (|a * 0 = 0| + |a * (/ a) = 1|)))) + +(defthm |/ (/ a) = a| + (implies (and (fdp (double-rewrite a)) + (not (= (double-rewrite a) (0_f)))) + (= (/ (/ a)) a)) + :hints (("Goal" + :in-theory (disable |a != 0 implies a * b = 1 <=> b = (/ a)|) + :use (:instance |a != 0 implies a * b = 1 <=> b = (/ a)| + (a (/ a)) (b a))))) + +(defthm + |a * b = 0 iff a = 0 or b = 0| + (implies (and (fdp a) + (fdp b)) + (equal (= (* a b)(0_f)) + (or (= a (0_f)) + (= b (0_f))))) + :hints (("Subgoal 1" + :in-theory (disable |a * c = b * c <=> a = b or c = 0|) + :use (:instance + |a * c = b * c <=> a = b or c = 0| + (a b)(b (0_f))(c a))))) + +(defthm |/ (a * b) = (/ a) * (/ b)| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (not (= (double-rewrite a)(0_f))) + (not (= (double-rewrite b)(0_f)))) + (= (/ (* a b)) (* (/ a) (/ b)))) + :hints (("Goal" + :in-theory (disable |a != 0 implies a * b = 1 <=> b = (/ a)|) + :use (:instance |a != 0 implies a * b = 1 <=> b = (/ a)| + (a (* a b)) (b (* (/ a) (/ b))))))) + +(defthm + |1 != 0| + (not (= (1_f)(0_f))) + :hints (("Goal" + :use |0 != 1|))) + +(defthm |/ 1 = 1| + (= (/ (1_f))(1_f)) + :hints (("Goal" + :in-theory (disable |a != 0 implies a * b = 1 <=> b = (/ a)|) + :use (:instance |a != 0 implies a * b = 1 <=> b = (/ a)| + (a (1_f)) (b (1_f)))))) + +(defthm |a * ((/ a) * b) = b| + (implies (and (fdp (double-rewrite a)) + (not (= (double-rewrite a)(0_f))) + (fdp (double-rewrite b))) + (= (* a (* (/ a) b)) b)) + :hints (("Goal" + :in-theory (disable |a * (b * c) = b * (a * c)|) + :use (:instance |a * (b * c) = b * (a * c)| (c (/ a)))))) + +(defthm |a * (b * (/ a)) = b| + (implies (and (fdp (double-rewrite a)) + (not (= (double-rewrite a)(0_f))) + (fdp (double-rewrite b))) + (= (* a (* b (/ a))) b))) + +(defthm |/ a = 1 <=> a = 1| + (implies (and (fdp a) + (not (= a (0_f)))) + (iff (= (/ a)(1_f))(= a (1_f)))) + :hints (("Goal" + :in-theory (disable |a != 0 implies a * b = 1 <=> b = (/ a)|) + :use (:instance |a != 0 implies a * b = 1 <=> b = (/ a)| + (b (1_f)))))) + +;;; ----------------- +;;; Otras propiedades +;;; ----------------- + +;;; NOTA: +;;; +;;; El lado izquierdo puede aparecer por varias razones, sin +;;; descartar una aplicación de |- (a + b) = (- a) + (- b)| en un +;;; contexto en el que aparece |- (a + b) = c| y posteriormente se +;;; establece que |c = 0|. Esto podría evitarse postponiendo la +;;; definición de dicha regla. + +;; (defthm |(- a) + (- b) = 0 <=> a + b = 0| +;; (implies (and (coeficientep a) (coeficientep b)) +;; (iff (= (+ (- a) (- b)) (nulo)) (= (+ a b) (nulo))))) + +(defthm |(- a) + (- b) = 0 <=> a + b = 0| + (implies (and (fdp a) (fdp b)) + (iff (= (+ (- a) (- b))(0_f))(= (+ a b)(0_f))))) + +(defthm |(/ a) * (/ b) = 1 <=> a * b = 1| + (implies (and (fdp a) + (not (= a (0_f))) + (fdp b) + (not (= b (0_f)))) + (iff (= (* (/ a)(/ b))(1_f))(= (* a b)(1_f))))) + +;;; NOTA: +;;; +;;; En un anillo el recíproco no es, en general, cierto. + +;; (defthm |b + c = 0 => (a * b) + (a * c) = 0| +;; (implies (and (coeficientep a) (coeficientep b) (coeficientep c) +;; (= (+ b c) (nulo))) +;; (= (+ (* a b) (* a c)) (nulo)))) + +(defthm |b + c = 0 => (a * b) + (a * c) = 0| + (implies (and (fdp (double-rewrite a)) + (fdp (double-rewrite b)) + (fdp (double-rewrite c)) + (= (+ (double-rewrite b) + (double-rewrite c)) + (0_f))) + (= (+ (* a b) (* a c))(0_f)))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.acl2 new file mode 100644 index 0000000..6db7605 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fucongruencias-producto" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.lisp new file mode 100644 index 0000000..eff8fac --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.lisp @@ -0,0 +1,430 @@ +; ACL2 Univariate Polynomials over a Field books -- Product Congruences +;; Congruences for Products of Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ----------------------------------------------------------------- +;;; Congruencias de la igualdad con el producto de polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Demostración de las congruencias de la igualdad de polinomios con +;;; el producto externo y el producto. +;;; ----------------------------------------------------------------- +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fucongruencias-producto" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;; (include-book "producto") +(include-book "fuproducto" + :load-compiled-file nil) + +;;; -------------------------------------------------------- +;;; Éstas son las propiedades de "polinomio" que lo abstraen +;;; -------------------------------------------------------- + +(defthm |m +M p != 0| + (implies (monomiop m) + (consp (+M m p))) + :rule-classes :type-prescription) + +(defthm |mp(m +M p) = m| + (implies (monomiop (double-rewrite m)) + (equal (primero (+M m p)) m))) + +(defthm |resto(m +M p) = p| + (implies (and (monomiop (double-rewrite m)) + (polinomiop (double-rewrite p))) + (equal (resto (+M m p)) p))) + +;;; ++++++++++++++++++++++++++ +;;; + Barrera de abstracción + +;;; ++++++++++++++++++++++++++ + +(in-theory (disable +M)) + +;;; --------------------------------------------------------------- +;;; Distributividad del producto externo respecto a la suma externa +;;; --------------------------------------------------------------- + +;;; Propiedades sintácticas de la suma de monomio y polinomio y la +;;; normalización. + +;; (defthm |fn(m +Mo fn(p)) = fn(m +Mo p)| +;; (equal (fn (+-monomio m (fn p))) +;; (fn (+-monomio m p)))) + +(defthm |fn(m +Mo fn(p)) =P fn(m +Mo p)| + (=P (fn (+-monomio m (fn p))) + (fn (+-monomio m p))) + :hints (("Subgoal *1/8" + :in-theory (enable +M)))) + +;; (defthm |(m +Mo fn(p)) = fn(m +Mo p)| +;; (equal (+-monomio m (fn p)) +;; (fn (+-monomio m p)))) + +(defthm |(m +Mo fn(p)) =P fn(m +Mo p)| + (=P (+-monomio m (fn p)) + (fn (+-monomio m p))) + :hints (("Subgoal *1/8" + :in-theory (enable +M)))) + +;;; Este es un caso particular de la definición de "+-monomio". + +(defthm |n +Mo p = p_p +M (n +Mo p_r)| + (implies (and (monomiop (double-rewrite n)) + (polinomiop (double-rewrite p)) + (not (nulop p)) + (FUTER::< (termino n) (termino (primero p)))) + (equal (+-monomio n p) + (+M (primero p) (+-monomio n (resto p))))) + :hints (("Goal" :do-not '(generalize)))) + +;;; Esta propiedad sintáctica establece la relación entre La suma de +;;; monomios y polinomios, el constructor de los polinomios y la +;;; función de normalización. + +(defthm |m +Mo fn(p) = fn(m +M p)| + (implies (and (monomiop (double-rewrite m)) + (polinomiop (double-rewrite p))) + (equal (+-monomio m (fn p)) + (fn (+M m p))))) + +(in-theory (disable |m +Mo fn(p) = fn(m +M p)| + FLD::|b + c = 0 => (a * b) + (a * c) = 0|)) + +;;; NOTA: +;;; +;;; Este teorema es tremendamente complicado. Nótese que la igualdad a +;;; la que apela es sintáctica. El problema es una explosión +;;; combinatoria en el número de casos debido, principalmente, a la +;;; gran cantidad de casos existente en la definición de +;;; "+-monomio". Por otro lado, no parece factible simplificar dicha +;;; definición, ya que esto obligaría a añadir hipótesis a muchos +;;; teoremas que son necesarios para demostrar la congruencia +;;; (recuérdese que las congruencias son incondicionales). La +;;; consecuencia es una prueba muy extensa, poco automatizada y muy +;;; sensible al entorno. + +(defun esquema-de-induccion-1 (n p) + (declare (xargs :verify-guards nil)) + (if (and (not (nulop p)) (FUTER::< (termino n) (termino (primero p)))) + (esquema-de-induccion-1 n (resto p)) + t)) + +(in-theory (enable FUMON::*)) + +;; (defthm |fn(m *M (n +Mo p)) = fn((m * n) +Mo (m *M p))| +;; (implies (and (monomiop m) (monomiop n) (polinomiop p)) +;; (equal (fn (*-monomio m (+-monomio n p))) +;; (fn (+-monomio (UMON::* m n) (*-monomio m p))))) +;; :hints (("Goal" +;; :do-not '(eliminate-destructors generalize) +;; :induct (esquema-de-induccion-1 n p)) +;; ;;; Caso base +;; ("Subgoal *1/2.1" +;; :expand (+-monomio n p)) +;; ("Subgoal *1/2.1.1" +;; :in-theory (disable MON::monomio-coeficiente-termino) +;; :use ((:instance COE::|b + c = 0 => (a * b) + (a * c) = 0| +;; (COE::a (coeficiente m)) (COE::b (coeficiente n)) +;; (COE::c (coeficiente (primero p)))))) +;; ;;; Caso inductivo +;; ("Subgoal *1/1" +;; :in-theory (disable +-monomio +;; UMON::* +;; fnp-fn fn +;; |fn(m +Mo fn(p)) = fn(m +Mo p)| +;; |(m +Mo fn(p)) = fn(m +Mo p)| +;; |m1 +Mo (m2 +Mo p) =e m2 +Mo (m1 +Mo p)| +;; fn-ordenado fnp-iff-ordenadop ordenadop-fn) +;; :use (:instance fnp-fn (p (*-monomio m (+-monomio n p))))) +;; ("Subgoal *1/1'5'" +;; :expand (fn (+M (UMON::* m (primero p)) +;; (*-monomio m (+-monomio n (resto p)))))) +;; ("Subgoal *1/1'7'" +;; :use (:instance |(m +Mo fn(p)) = fn(m +Mo p)| +;; (m (UMON::* M N)) +;; (p (*-monomio m (resto p))))) +;; ("Subgoal *1/1'9'" +;; :use ((:instance ordenadop-fn +;; (p (*-monomio m (resto p)))) +;; (:instance |m1 +Mo (m2 +Mo p) =e m2 +Mo (m1 +Mo p)| +;; (m1 (MON::* m (primero p))) +;; (m2 (MON::* m n)) +;; (p (fn (*-monomio m (resto p))))))) +;; ("Subgoal *1/1'11'" +;; :use ((:instance |m +Mo fn(p) = fn(m +M p)| +;; (m (MON::* M (primero p))) +;; (p (*-monomio m (resto p)))))) +;; ("Subgoal *1/1'14'" +;; :use ((:instance |fn(m +Mo fn(p)) = fn(m +Mo p)| +;; (m (MON::* m n)) +;; (p (+M (MON::* M (primero P)) +;; (*-monomio m (resto p))))))))) +;; ) + +(defthm |fn(m *M (n +Mo p)) =P fn((m * n) +Mo (m *M p))| + (implies (and (monomiop (double-rewrite m)) + (monomiop (double-rewrite n)) + (polinomiop (double-rewrite p))) + (=P (fn (*-monomio m (+-monomio n p))) + (fn (+-monomio (FUMON::* m n) (*-monomio m p))))) + :hints (("Goal" + :do-not '(eliminate-destructors generalize) + :induct (esquema-de-induccion-1 n p)) +;;; Caso base + ("Subgoal *1/2.1" + :expand (+-monomio n p)) + ("Subgoal *1/2.1.1" + :in-theory (disable FUMON::monomio-coeficiente-termino) + :use ((:instance FLD::|b + c = 0 => (a * b) + (a * c) = 0| + (FLD::a (coeficiente m)) (FLD::b (coeficiente n)) + (FLD::c (coeficiente (primero p)))))) +;;; Caso inductivo + ("Subgoal *1/1" + :in-theory (disable +-monomio + FUMON::* + fnp-fn fn + |fn(m +Mo fn(p)) =P fn(m +Mo p)| + |(m +Mo fn(p)) =P fn(m +Mo p)| + |m1 +Mo (m2 +Mo p) =P m2 +Mo (m1 +Mo p)| + |m1 +Mo (m2 +Mo p) = m2 +Mo (m1 +Mo p)| + fn-ordenado fnp-iff-ordenadop ordenadop-fn) + :use (:instance fnp-fn (p (*-monomio m (+-monomio n p))))) + ("Subgoal *1/1'5'" + :expand (fn (+M (FUMON::* m (primero p)) + (*-monomio m (+-monomio n (resto p)))))) + ("Subgoal *1/1'6'" + :use (:instance |(m +Mo fn(p)) =P fn(m +Mo p)| + (m (FUMON::* M N)) + (p (*-monomio m (resto p))))) + ("Subgoal *1/1'8'" + :use ((:instance ordenadop-fn + (p (*-monomio m (resto p)))) + (:instance |m1 +Mo (m2 +Mo p) = m2 +Mo (m1 +Mo p)| + (m1 (FUMON::* m (primero p))) + (m2 (FUMON::* m n)) + (p (fn (*-monomio m (resto p))))))) + ("Subgoal *1/1'11'" + :use ((:instance |m +Mo fn(p) = fn(m +M p)| + (m (FUMON::* M (primero p))) + (p (*-monomio m (resto p)))))) + ("Subgoal *1/1'14'" + :use ((:instance |fn(m +Mo fn(p)) =P fn(m +Mo p)| + (m (FUMON::* m n)) + (p (+M (FUMON::* M (primero P)) + (*-monomio m (resto p))))))) + ("Subgoal *1/1'19'" + :in-theory (disable =P-implies-=P-+-monomio-2b) + :use ((:instance ordenadop-fn + (p (*-monomio m (+-monomio n (cdr p))))) + (:instance + =P-implies-=P-+-monomio-2b + (m (FUMON::* m (car p))) + (p1 (+-monomio (FUMON::* m n)(fn (*-monomio m (cdr p))))) + (p2 (fn (*-monomio m (+-monomio n (cdr p)))))))))) + +(in-theory (disable FUMON::* + |fn(m +Mo fn(p)) =P fn(m +Mo p)| + |(m +Mo fn(p)) =P fn(m +Mo p)| + |n +Mo p = p_p +M (n +Mo p_r)|)) + +;;; NOTA: +;;; +;;; En realidad, este es el teorema que realmente queremos demostrar +;;; pero, para ello, hemos necesitado el anterior. Se emplea en la +;;; demostración de que "m *M p = m *M fn(p)", que permite establecer +;;; la congruencia con el producto externo. + +(in-theory (disable |fn(m *M (n +Mo p)) =P fn((m * n) +Mo (m *M p))|)) + +(defthm |m *M (n +Mo p) = (m * n) +Mo (m *M p)| + (implies (and (monomiop (double-rewrite m)) + (monomiop (double-rewrite n)) + (polinomiop (double-rewrite p))) + (= (*-monomio m (+-monomio n p)) + (+-monomio (FUMON::* m n) (*-monomio m p)))) + :hints (("Goal" + :use |fn(m *M (n +Mo p)) =P fn((m * n) +Mo (m *M p))|))) + +;; (in-theory (disable |fn(m *M (n +Mo p)) = fn((m * n) +Mo (m *M p))|)) + +;;; ++++++++++++++++++++++++++ +;;; + Barrera de abstracción + +;;; ++++++++++++++++++++++++++ + +(in-theory (disable = (=))) + +;;; ----------------------------------------------------------------- +;;; Congruencias de la igualdad de polinomios con el producto externo +;;; ----------------------------------------------------------------- + +;;; Primer parámetro + +;; (defcong MON::= = (*-monomio m p) 1 +;; :hints (("Goal" :in-theory (enable MON::=)))) + +(defthm + |FUMON::=-implies-=-*-monomio-1| + (implies (FUMON::= m1 m2) + (= (*-monomio m1 p) + (*-monomio m2 p))) + :rule-classes :congruence) + +;;; Segundo parámetro + +;;; NOTA: +;;; +;;; Esta propiedad es expansiva; restringimos su aplicación sintácticamente + +(local + (defthm |m +M p = m +Mo p| + (implies (and (monomiop (double-rewrite m)) + (polinomiop (double-rewrite p))) + (= (+M m p) (+-monomio m p))) + :hints (("Goal" :in-theory (enable =) + :use (|m +Mo fn(p) = fn(m +M p)| + |(m +Mo fn(p)) =P fn(m +Mo p)|))))) + +(local + (defthm |m *M p = m *M fn(p)| + (implies (syntaxp (not (and (consp p) (eq (primero p) 'fn)))) + (= (*-monomio m p) (*-monomio m (fn p)))))) + +(local + (in-theory (disable |m *M p = m *M fn(p)|))) + +(defthm + =P-implies-=P-*-monomio-2 + (implies (=P p1 p2) + (=P (*-monomio m p1) + (*-monomio m p2))) + :rule-classes :congruence) + +(defthm + =-implies-=-*-monomio-fn-2 + (implies (= (double-rewrite p1) + (double-rewrite p2)) + (equal (= (*-monomio m (fn p1)) + (*-monomio m (fn p2))) + t)) + :hints (("Goal" + :in-theory (enable =)))) + +(local + (in-theory (enable |m *M p = m *M fn(p)|))) + +;; (defcong = = (*-monomio m p) 2) + +(defthm + =-implies-*-monomio-2 + (implies (= p1 p2) + (= (*-monomio m p1) + (*-monomio m p2))) + :rule-classes :congruence) + +;;; -------------------------------------------------------- +;;; Congruencia de la igualdad de polinomios con el producto +;;; -------------------------------------------------------- + +;;; Segundo parámetro + +(defthm |p * fn(q) = p * q| + (= (* p (fn q)) (* p q))) + +;; (defcong = = (* p q) 2) +(defthm + =-implies-=-*-2 + (implies (= q1 q2) + (= (* p q1) + (* p q2))) + :rule-classes :congruence) + +;;; Primer parámetro + +(defthm |fn(p) * q = p * q| + (= (* (fn p) q) (* p q))) + +;; (defcong = = (* p q) 1 +;; :hints (("Goal" +;; :in-theory (disable |p * q = q * p|) +;; :use (|p * q = q * p| +;; (:instance |p * q = q * p| (p p-equiv)))))) +(defthm + =-implies-=-*-1 + (implies (= p1 p2) + (= (* p1 q) + (* p2 q))) + :rule-classes :congruence + :hints (("Goal" + :in-theory (disable |p * q = q * p|) + :use ((:instance |p * q = q * p| (p p1)) + (:instance |p * q = q * p| (p p2)))))) + +;;; NOTA: +;;; +;;; Esta propiedad es consecuencia inmediata de las dos propiedades +;;; auxiliares anteriores + +(defthm |fn(p) * fn(q) = p * q| + (= (* (fn p) (fn q)) (* p q))) + +(in-theory (disable |p * fn(q) = p * q| + |fn(p) * q = p * q| + |fn(p) * fn(q) = p * q|)) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.acl2 new file mode 100644 index 0000000..5269e94 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fucongruencias-suma" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.lisp new file mode 100644 index 0000000..11ff055 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.lisp @@ -0,0 +1,182 @@ +; ACL2 Univariate Polynomials over a Field books -- Sum Congruences +;; Congruences for Sums of Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ------------------------------------------------------------------ +;;; Congruencia de la igualdad con la suma de polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Aquí se demuestran las congruencias de la igualdad de polinomios +;;; con la suma. Las demostraciones son complejas debido a que +;;; necesitan reglas expansivas. Estas reglas son peligrosas, ya que +;;; pueden producir fácilmente ciclos en el demostrador. Para +;;; restringir su aplicación caben dos opciones: +;;; +;;; 1. Desactivarlas y usarlas explícitamente donde sea necesario. Una +;;; variante es no generar la regla en absoluto (es decir, introducir +;;; el teorema con la clases de reglas vacía). +;;; +;;; 2. Restringir su aplicación sintácticamente para prevenir +;;; expansiones en cadena. Esto se puede lograr graciasa syntaxp. +;;; +;;; Elegimos la segunda opción porque se consigue un mayor grado de +;;; automatización y hace a las demostraciones menos sensibles a los +;;; cambios. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fucongruencias-suma" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;;(include-book "suma") +(include-book "fusuma" + :load-compiled-file nil) + +;;; ---------------------------------------------------- +;;; Congruencia de la igualdad de polinomios con la suma +;;; ---------------------------------------------------- + +;;; Segundo parámetro + +;;; NOTA: +;;; +;;; Esta propiedad es expansiva; restringimos su aplicación sintácticamente + +(defthm + polinomiop-implies-true-listp + (implies (polinomiop p) + (true-listp p)) + :rule-classes :compound-recognizer) + +(defthm + Right-identity-append + (implies (true-listp p) + (equal (append p nil) p))) + +(defthm |p + q = p + fn(q)| + (implies (syntaxp (not (and (consp q) (eq (primero q) 'fn)))) + (= (+ p q) (+ p (fn q))))) + +(defthm + =P-implies-=P-append-1 + (implies (=P p1 p2) + (=P (append p1 q) + (append p2 q))) + :rule-classes :congruence) + +(defthm + =P-implies-=P-append-2 + (implies (=P q1 q2) + (=P (append p q1) + (append p q2))) + :rule-classes :congruence) + +(defthm + =P-implies-=P-fn + (implies (=P p1 p2) + (=P (fn p1) + (fn p2))) + :rule-classes :congruence) + +;;(defcong = = (+ p q) 2) +(defthm + =-implies-=-+-2 + (implies (= q1 q2) + (= (+ p q1) + (+ p q2))) + :rule-classes :congruence) + +;;; Primer parámetro + +;; (defcong = = (+ p q) 1 +;; :hints (("Goal" +;; :in-theory (disable |p + q = q + p| + =) +;; :use (|p + q = q + p| +;; (:instance |p + q = q + p| (p p-equiv)))))) +(defthm + =-implies-=-+-1 + (implies (= p1 p2) + (= (+ p1 q) + (+ p2 q))) + :rule-classes :congruence + :hints (("Goal" + :in-theory (disable |p + q = q + p| + =) + :use ((:instance + |p + q = q + p| + (p p1)) + (:instance + |p + q = q + p| + (p p2)))))) + +;;; NOTA: +;;; +;;; Esta propiedad es expansiva; restringimos su aplicación sintácticamente + +(defthm |p + q = fn(p) + q| + (implies (syntaxp (not (and (consp p) (eq (primero p) 'fn)))) + (= (+ p q) (+ (fn p) q))) + :hints (("Goal" + :in-theory (disable |p + q = p + fn(q)|) + :use ((:instance |p + q = p + fn(q)| (p q) (q p)))))) + +(defthm |fn(p) + fn(q) = p + q| + (= (+ (fn p) (fn q)) (+ p q))) + +(in-theory (disable |p + q = p + fn(q)| + |p + q = fn(p) + q| + |fn(p) + fn(q) = p + q|)) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.acl2 new file mode 100644 index 0000000..751d832 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuforma-normal" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.lisp new file mode 100644 index 0000000..7e1d77f --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.lisp @@ -0,0 +1,696 @@ +; ACL2 Univariate Polynomials over a Field books -- Normal Form +;; Normal form for Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ----------------------------------------------------------------- +;;; Forma normal de polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Desarrollo de la función de normalización que permite reducir la +;;; comprobación de la igualdad semántica de dos polinomios a la de +;;; una igualdad sintáctica de sus formas normales. Se define primero +;;; una suma externa de un monomio con un polinomio ordenado, teniendo +;;; en cuenta una posible cancelación. A partir de aquí se define la +;;; forma normal y su relación de equivalencia inducida. Se demuestran +;;; algunas propiedades importantes como la idempotencia de la +;;; normalización. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuforma-normal" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;;(include-book "polinomio") +(include-book "fupolinomio" + :load-compiled-file nil) + +;;; -------------------- +;;; Polinomios ordenados +;;; -------------------- + +;;; Esta función permite averiguar si un monomio debe preceder al +;;; monomio principal de un polinomio ordenado + +(defmacro termino-mayor-termino-principal (m p) + `(or (nulop ,p) + (FUTER::< (termino (primero ,p)) (termino ,m)))) + +;;; Reconocedor de polinomios estrictamente ordenado mediante un orden +;;; de términos decreciente y que no poseen monomios nulos + +(defun ordenadop (p) + (and (polinomiop p) + (or (nulop p) + (and (not (FUMON::nulop (primero p))) + (termino-mayor-termino-principal (primero p) (resto p)) + (ordenadop (resto p)))))) + +;;; ------------------------------------ +;;; Adición de un monomio y un polinomio +;;; ------------------------------------ + +;;; Suma un monomio a un polinomio + +(defun +M (m p) + (cond ((and (not (monomiop m)) (not (polinomiop p))) + (nulo)) + ((not (polinomiop p)) + (list m)) + ((not (monomiop m)) + p) + (t + (cons m p)))) + +(defthm |polinomiop(m +M p)| + (polinomiop (+M m p)) + :rule-classes :type-prescription) + +;;; Suma un monomio a un polinomio ordenado + +;;; NOTA: +;;; +;;; Hay que garantizar (cosa que probaremos en breve) que si el +;;; polinomio está normalizado, el resultado también. + +;; (defun +-monomio (m p) +;; (cond ((and (not (monomiop m)) (not (polinomiop p))) +;; (nulo)) +;; ((not (monomiop m)) +;; p) +;; ((and (not (polinomiop p)) (MON::nulop m)) +;; (nulo)) +;; ((not (polinomiop p)) +;; (+M m (nulo))) +;; ((MON::nulop m) +;; p) +;; ((nulop p) +;; (+M m (nulo))) +;; ((TER::= (termino m) (termino (primero p))) +;; (let ((c (COE::+ (coeficiente m) (coeficiente (primero p))))) +;; (if (COE::= c (COE::nulo)) +;; (resto p) +;; (+M (MON::+ (primero p) m) (resto p))))) +;; ((TER::< (termino (primero p)) (termino m)) +;; (+M m p)) +;; (t +;; (+M (primero p) (+-monomio m (resto p)))))) + +(defun +-monomio (m p) + (cond ((and (not (monomiop m)) (not (polinomiop p))) + (nulo)) + ((not (monomiop m)) + p) + ((and (not (polinomiop p)) (FUMON::nulop m)) + (nulo)) + ((not (polinomiop p)) + (+M m (nulo))) + ((FUMON::nulop m) + p) + ((nulop p) + (+M m (nulo))) + ((FUTER::= (termino m) (termino (primero p))) + (let ((c (FLD::+ (coeficiente m) (coeficiente (primero p))))) + (if (FLD::= c (FLD::0_f)) + (resto p) + (+M (FUMON::+ (primero p) m) (resto p))))) + ((FUTER::< (termino (primero p)) (termino m)) + (+M m p)) + (t + (+M (primero p) (+-monomio m (resto p)))))) + +;;; Clausura + +(defthm polinomiop-+-monomio + (polinomiop (+-monomio m p)) + :rule-classes (:type-prescription :rewrite)) + +;;; La suma de un monomio a un polinomio ordenado preserva el orden + +(defthm ordenadop-+-monomio-polinomio-ordenado + (implies (ordenadop p) + (ordenadop (+-monomio m p))) + :rule-classes (:type-prescription :rewrite)) + +;;; El orden de las operaciones no altera la suma de monomios a un +;;; polinomio ordenado + +(defmacro polinomio (m) + `(list ,m)) + +(defun ;;=== + =P (x y) + "A polynomial is a true list of momomials. + Determine if x and y are the same list of monomials, + upto monomial equivalence." + (if (consp x) + (and (consp y) + (FUMON::= (primero x) + (primero y)) + (=P (resto x) + (resto y))) + (equal x y))) + +(defthm + =P-is-an-equivalence + (and (booleanp (=P x y)) + (=P x x) + (implies (=P x y) + (=P y x)) + (implies (and (=P x y) + (=P y z)) + (=P x z))) + :rule-classes :equivalence) + +(defthm + =P-implies-equal-polinomiop + (implies (=P p1 p2) + (equal (polinomiop p1) + (polinomiop p2))) + :rule-classes :congruence) + +(defthm + |FUMON::=-implies-=P-+M-1| + (implies (FUMON::= m1 m2) + (=P (+M m1 p) + (+M m2 p))) + :rule-classes :congruence) + +(defthm + =P-implies-=P-+M-2 + (implies (=P p1 p2) + (=P (+M m p1) + (+M m p2))) + :rule-classes :congruence) + +(defthm + |FUMON::=-implies-=P-+-monomio-1| + (implies (FUMON::= m1 m2) + (=P (+-monomio m1 p) + (+-monomio m2 p))) + :rule-classes :congruence + :hints (("Subgoal *1/10" + :in-theory (disable FUMON::|=-implies-equal-FUTER::<-termino-2b|) + :use (:instance FUMON::|=-implies-equal-FUTER::<-termino-2b| + (FUMON::x (car p))(FUMON::y1 m1)(FUMON::y2 m2))) + ("Subgoal *1/9" + :in-theory (disable FUMON::|=-implies-equal-FUTER::<-termino-2b|) + :use (:instance FUMON::|=-implies-equal-FUTER::<-termino-2b| + (FUMON::x (car p))(FUMON::y1 m1)(FUMON::y2 m2))))) + +(defthm + =P-implies-iff-ordenadop + (implies (=P p1 p2) + (iff (ordenadop p1) + (ordenadop p2))) + :rule-classes nil + :hints (("Subgoal *1/3" + :in-theory (disable + FUMON::|=-implies-equal-FUTER::<-termino-1a| + FUMON::|=-implies-equal-FUTER::<-termino-1b| + FUMON::|=-implies-equal-FUTER::<-termino-2a| + FUMON::|=-implies-equal-FUTER::<-termino-2b|) + :use ((:instance + FUMON::|=-implies-equal-FUTER::<-termino-1a| + (FUMON::z (car p2)) + (FUMON::y1 (cadr p1)) + (FUMON::y2 (cadr p2))) + (:instance + FUMON::|=-implies-equal-FUTER::<-termino-2a| + (FUMON::x (cadr p1)) + (FUMON::y1 (car p1)) + (FUMON::y2 (car p2))))) + ("Subgoal *1/2" + :in-theory (disable + FUMON::|=-implies-equal-FUTER::<-termino-1a| + FUMON::|=-implies-equal-FUTER::<-termino-1b| + FUMON::|=-implies-equal-FUTER::<-termino-2a| + FUMON::|=-implies-equal-FUTER::<-termino-2b|) + :use ((:instance + FUMON::|=-implies-equal-FUTER::<-termino-1a| + (FUMON::z (car p2)) + (FUMON::y1 (cadr p1)) + (FUMON::y2 (cadr p2))) + (:instance + FUMON::|=-implies-equal-FUTER::<-termino-2a| + (FUMON::x (cadr p1)) + (FUMON::y1 (car p1)) + (FUMON::y2 (car p2))))))) + +(defthm + =P-implies-equal-ordenadop + (implies (=P p1 p2) + (equal (ordenadop p1) + (ordenadop p2))) + :rule-classes :congruence + :hints (("Goal" + :use =P-implies-iff-ordenadop))) + +(defthm + =P-implies-=P-+-monomio-2a + (implies (and (=P (double-rewrite p1) + (double-rewrite p2)) + (ordenadop (double-rewrite p1))) + (equal (=P (+-monomio m p1) + (+-monomio m p2)) + t)) + :hints (("Subgoal *1/12" + :in-theory (disable FUMON::=-implies-equal-termino-1 + FUMON::=-implies-equal-termino-2) + :use (:instance + FUMON::=-implies-equal-termino-1 + (FUMON::y1 (car p1)) + (FUMON::y2 (car p2)))) + ("Subgoal *1/9" + :in-theory (disable FUMON::=-implies-equal-termino-1 + FUMON::=-implies-equal-termino-2) + :use (:instance + FUMON::=-implies-equal-termino-1 + (FUMON::y1 (car p1)) + (FUMON::y2 (car p2)))) + ("Subgoal *1/8" + :in-theory (disable FUMON::=-implies-equal-termino-1 + FUMON::=-implies-equal-termino-2) + :use (:instance + FUMON::=-implies-equal-termino-1 + (FUMON::y1 (car p1)) + (FUMON::y2 (car p2)))) + ("Subgoal *1/7" + :in-theory (disable FUMON::=-implies-equal-termino-1 + FUMON::=-implies-equal-termino-2) + :use (:instance + FUMON::=-implies-equal-termino-1 + (FUMON::y1 (car p1)) + (FUMON::y2 (car p2)))))) + +(defthm + =P-implies-=P-+-monomio-2b + (implies (and (=P (double-rewrite p1) + (double-rewrite p2)) + (ordenadop (double-rewrite p2))) + (equal (=P (+-monomio m p1) + (+-monomio m p2)) + t))) + +;; (defthm |m1 +Mo (m2 +Mo 0) =e m2 +Mo (m1 +Mo 0)| +;; (implies (nulop p) +;; (equal (+-monomio m1 (+-monomio m2 p)) +;; (+-monomio m2 (+-monomio m1 p))))) + +(defthm |m1 +Mo (m2 +Mo 0) =P m2 +Mo (m1 +Mo 0)| + (implies (nulop p) + (=P (+-monomio m1 (+-monomio m2 p)) + (+-monomio m2 (+-monomio m1 p))))) + +;; (defthm |t(m1) = t(mp(p)) => m1 +Mo (m2 +Mo p) =e m2 +Mo (m1 +Mo p)| +;; (implies (and (monomiop m1) (ordenadop p) +;; (equal (termino m1) (termino (car p)))) +;; (equal (+-monomio m1 (+-monomio m2 p)) +;; (+-monomio m2 (+-monomio m1 p))))) + +(defthm |t(m1) = t(mp(p)) => m1 +Mo (m2 +Mo p) =P m2 +Mo (m1 +Mo p)| + (implies (and (monomiop (double-rewrite m1)) + (ordenadop (double-rewrite p)) + (equal (termino m1) (termino (car p)))) + (=P (+-monomio m1 (+-monomio m2 p)) + (+-monomio m2 (+-monomio m1 p))))) + +;; (defthm |t(mp(p)) < t(m1) => m1 +Mo (m2 +Mo p) =e m2 +Mo (m1 +Mo p)| +;; (implies (and (monomiop m1) (ordenadop p) +;; (TER::< (termino (car p)) (termino m1))) +;; (equal (+-monomio m1 (+-monomio m2 p)) +;; (+-monomio m2 (+-monomio m1 p))))) + +(defthm |t(mp(p)) < t(m1) => m1 +Mo (m2 +Mo p) =P m2 +Mo (m1 +Mo p)| + (implies (and (monomiop (double-rewrite m1)) + (ordenadop (double-rewrite p)) + (FUTER::< (termino (car p)) (termino m1))) + (=P (+-monomio m1 (+-monomio m2 p)) + (+-monomio m2 (+-monomio m1 p))))) + +;; (defthm |m1 +Mo (m2 +Mo p) =e m2 +Mo (m1 +Mo p)| +;; (implies (ordenadop p) +;; (equal (+-monomio m1 (+-monomio m2 p)) +;; (+-monomio m2 (+-monomio m1 p)))) +;; :hints (("Subgoal *1/9" :in-theory (disable +-monomio)) +;; ("Subgoal *1/8" :in-theory (disable +-monomio)) +;; ("Subgoal *1/7" :in-theory (disable +-monomio)) +;; ("Subgoal *1/6" :in-theory (disable +-monomio)))) + +(defthm |m1 +Mo (m2 +Mo p) =P m2 +Mo (m1 +Mo p)| + (implies (ordenadop (double-rewrite p)) + (=P (+-monomio m1 (+-monomio m2 p)) + (+-monomio m2 (+-monomio m1 p)))) + :hints (("Subgoal *1/9" :in-theory (disable +-monomio)) + ("Subgoal *1/8" :in-theory (disable +-monomio)) + ("Subgoal *1/7" :in-theory (disable +-monomio)) + ("Subgoal *1/6" :in-theory (disable +-monomio)))) + +;;; ------------ +;;; Forma normal +;;; ------------ + +;;; Normalización de un polinomio meidante adición de monomios. + +;;; NOTA: +;;; +;;; Este es un punto en el que en un futuro se podría trabajar para +;;; mejorar la eficiencia de los algoritmos. Básicamente podemos +;;; entender la normalización de un polinomio como un proceso de +;;; ordenación (con algunas diferencias importantes) y, con éste +;;; símil, el algoritmo que se presenta a continuación correspondería +;;; con un método directo (inserción directa). Cabría la posibilidad +;;; de adaptar algoritmos de ordenación más eficientes (los de Hoare y +;;; Williams serían buenas opciones) para normalizar polinomios. + +(defun fn (p) + (cond ((or (not (polinomiop p)) (nulop p)) + (nulo)) + (t + (+-monomio (primero p) (fn (resto p)))))) + +;;; Clausura + +(defthm polinomiop-fn + (polinomiop (fn p)) + :rule-classes (:type-prescription :rewrite)) + +;;; Reconocedor de polinomios normalizados +;;; +;;; NOTA: +;;; +;;; Un polinomio normalizado coincide sintácticamente con su forma +;;; normal. + +(defmacro fnp (p) + `(equal (fn ,p) ,p)) + +;;; La forma normal de un polinomio es un polinomio ordenado + +(defthm ordenadop-fn + (ordenadop (fn p)) + :rule-classes (:type-prescription :rewrite)) + +;;; Si un polinomio está ordenado entonces está en forma normal + +(defthm fn-ordenado + (implies (ordenadop (double-rewrite p)) + (equal (fn p) p))) + +;;; Un polinomio está en forma normal si, y sólo si, está ordenado + +;;; NOTA: +;;; +;;; Este teorema establece la corrección de la función de +;;; normalización frente a la especificación dada por el hecho de que +;;; un polinomio en forma normal debe tener sus monomios ordenados +;;; decrecientemente y no puede poseer monomios nulos. Al ser la +;;; ordenación estricta, se evita la posibilidad de que aparezcan +;;; monomios con el mismo término. + +(defthm fnp-iff-ordenadop + (iff (fnp p) (ordenadop p))) + +;;; El reconocedor de polinomios normalizados reconoce las formas +;;; normales + +(defthm fnp-fn + (fnp (fn p))) + +;;; ------------------ +;;; Igualdad semántica +;;; ------------------ + +;;; Igualdad semántica + +;;; NOTA: +;;; +;;; Aquí radica una de las aplicaciones de la forma normal: permitir +;;; comprobar si dos polinomios son iguales módulo formas normales. + +;; (defun = (p1 p2) +;; (equal (fn p1) (fn p2))) + +(defun = (p1 p2) + (=P (fn p1) (fn p2))) + +;;; La igualdad semántica es una relación de equivalencia + +;;; NOTA: +;;; +;;; Esto abre paso al establecimiento de las congruencias entre la +;;; igualdad semántica y las operaciones. + +(defthm + =-is-an-equivalence + (and (booleanp (= x y)) + (= x x) + (implies (= x y) + (= y x)) + (implies (and (= x y) + (= y z)) + (= x z))) + :rule-classes :equivalence) + +;;; El orden de las operaciones no altera la suma de monomios a un +;;; polinomio ordenado + +(defthm |m1 +M (m2 +M p) = m2 +M (m1 +M p)| + (= (+M m1 (+M m2 p)) + (+M m2 (+M m1 p)))) + +(defthm |m1 +Mo (m2 +Mo p) = m2 +Mo (m1 +Mo p)| + (implies (ordenadop (double-rewrite p)) + (= (+-monomio m1 (+-monomio m2 p)) + (+-monomio m2 (+-monomio m1 p))))) + +;; (defthm |(a + b) = 0 => a +Mo (b +Mo p) = p| +;; (implies (and (COE::coeficientep a) +;; (COE::coeficientep b) +;; (TER::terminop te) +;; (ordenadop p) +;; (not (COE::= a (COE::nulo))) +;; (COE::= (COE::+ a b) (COE::nulo))) +;; (equal (+-monomio (monomio a te) (+-monomio (monomio b te) p)) +;; p)) +;; :hints (("Goal" +;; :in-theory (disable COE::|(a + b) + c = a + (b + c)|)) +;; ("Subgoal *1/8" +;; :use (:instance COE::|(a + b) + c = a + (b + c)| +;; (COE::a a) (COE::b b) +;; (COE::c (coeficiente (primero p))))) +;; ("Subgoal *1/7" +;; :use (:instance COE::|(a + b) + c = a + (b + c)| +;; (COE::a a) (COE::b b) +;; (COE::c (coeficiente (primero p))))))) + +(defthm |(a + b) = 0 => a +Mo (b +Mo p) =P p| + (implies (and (FLD::fdp (double-rewrite a)) + (FLD::fdp (double-rewrite b)) + (FUTER::terminop te) + (ordenadop (double-rewrite p)) + (not (FLD::= (double-rewrite a)(FLD::0_f))) + (FLD::= (FLD::+ (double-rewrite a)(double-rewrite b))(FLD::0_f))) + (=P (+-monomio (monomio a te) (+-monomio (monomio b te) p)) + p)) + :hints (("Goal" + :in-theory (disable FLD::|(a + b) + c = a + (b + c)|)) + ("Subgoal *1/8" + :use (:instance FLD::|(a + b) + c = a + (b + c)| + (FLD::a a) (FLD::b b) + (FLD::c (coeficiente (primero p))))) + ("Subgoal *1/7" + :use (:instance FLD::|(a + b) + c = a + (b + c)| + (FLD::a a) (FLD::b b) + (FLD::c (coeficiente (primero p))))))) + +;; (defthm |¬(a + b) = 0 => a +Mo (b +Mo p) = (a + b) +Mo p| +;; (implies (and (COE::coeficientep a) +;; (COE::coeficientep b) +;; (TER::terminop te) +;; (ordenadop p) +;; (not (COE::= b (COE::nulo))) +;; (not (COE::= (COE::+ a b) (COE::nulo)))) +;; (equal (+-monomio (monomio b te) (+-monomio (monomio a te) p)) +;; (+-monomio (monomio (COE::+ a b) te) p)))) + +(defthm |~(a + b) = 0 => a +Mo (b +Mo p) =P (a + b) +Mo p| + (implies (and (FLD::fdp (double-rewrite a)) + (FLD::fdp (double-rewrite b)) + (FUTER::terminop te) + (ordenadop (double-rewrite p)) + (not (FLD::= (double-rewrite b)(FLD::0_f))) + (not (FLD::= (FLD::+ (double-rewrite a)(double-rewrite b)) + (FLD::0_f)))) + (=P (+-monomio (monomio b te) (+-monomio (monomio a te) p)) + (+-monomio (monomio (FLD::+ a b) te) p)))) + +;;; ----------------------------------------------------------------- +;;; Congruencia de la igualdad de polinomios con la suma de monomio y +;;; polinomio +;;; ----------------------------------------------------------------- + +;;; Primer parámetro + +;; (defcong MON::= = (+M m p) 1 +;; :hints (("Goal" :in-theory (enable MON::=)))) + +(defthm + |FUMON::=-implies-=-+M-1| + (implies (FUMON::= m1 m2) + (= (+M m1 p) + (+M m2 p))) + :rule-classes :congruence) + +;;; Segundo parámetro + +;; (defcong = = (+M m p) 2) + +(defthm + =-implies-=-+M-2 + (implies (= p1 p2) + (= (+M m p1) + (+M m p2))) + :rule-classes :congruence) + +;;; ------------------------------------------------------------- +;;; Congruencia de la igualdad de polinomios con la normalizacion +;;; ------------------------------------------------------------- + +;; (defcong = equal (fn p) 1) + +(defthm + =-implies-=P-fn + (implies (= p1 p2) + (=P (fn p1) + (fn p2))) + :rule-classes :congruence) + +;;; ------------------------------------------------------------ +;;; Congruencia de la igualdad de polinomios con la suma externa +;;; ------------------------------------------------------------ + +;;; Primer parámetro + +;; (defcong MON::= equal (+-monomio m p) 1 +;; :hints (("Goal" :in-theory (enable MON::=)))) + +(defthm + |FUMON::=-implies-=-+-monomio-1| + (implies (FUMON::= m1 m2) + (= (+-monomio m1 p) + (+-monomio m2 p))) + :rule-classes :congruence + :hints (("Goal" + :in-theory (enable FUMON::=)))) + +;;; NOTA: +;;; +;;; Esta propiedad es expansiva; restringimos su aplicación sintácticamente + +(local + (defthm +-monomio-fn + (implies (syntaxp (not (and (consp p) (eq (primero p) 'fn)))) + (= (+-monomio m p) (+-monomio m (fn p)))))) + +;;; Segundo parámetro + +;; (defcong = = (+-monomio m p) 2) + +(defthm + =-implies-=-+-monomio-2 + (implies (= p1 p2) + (= (+-monomio m p1) + (+-monomio m p2))) + :rule-classes :congruence) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Additional theory and theorems. +;; Added by J. Cowles + +(defun + C_= (p) + (if (consp p) + (let ((first (primero p))) + (if (and (monomiop first) + (not (FUMON::nulop first))) + (cons (FUMON::C_= first) + (C_= (rest p))) + (C_= (rest p)))) + nil)) + +(defthm + Polinomiop-C_= + (polinomiop (C_= p)) + :rule-classes :type-prescription) + +(defthm + C_=-=P + (implies (ordenadop (double-rewrite p)) + (=P (C_= p) p))) + +(defthm + C_=-= + (implies (polinomiop (double-rewrite p)) + (= (C_= p) p))) + +(defthm + =P-implies-equal-C_= + (implies (=P p1 p2) + (equal (C_= p1) + (C_= p2))) + :rule-classes :congruence) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.acl2 new file mode 100644 index 0000000..aca24c3 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.acl2 @@ -0,0 +1,21 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(certify-book "fumonomio" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.lisp new file mode 100644 index 0000000..a13a825 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.lisp @@ -0,0 +1,573 @@ +; ACL2 Univariate Polynomials over a Field books -- Monomials +;; Monomials for Univariate polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Modified by John R. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ------------------------------------------------------------------ +;;; Monomios con coeficientes y términos abstractos +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Pares coeficiente-término. Se define una igualdad semántica, ya +;;; que dos monomios con coeficiente nulo han de ser interpretados +;;; como el mismo, aunque tengan distinto término. Orden de monomios +;;; heredado de los términos. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(certify-book "fumonomio" + 4 + nil ;;compile-flg + ) +|# +(in-package "FUMON") + +;; (include-book "coeficiente") +;; (include-book "termino") +(include-book "coe-fld" + :load-compiled-file nil) +(include-book "futermino" + :load-compiled-file nil) + +;;; --------- +;;; Funciones +;;; --------- + +;;; Etiqueta que marca el principio de las funciones + +(deflabel principio-funciones) + +;;; Reconocedor + +;; (defun monomiop (a) +;; (and (consp a) +;; (coeficientep (first a)) +;; (terminop (rest a)))) + +(defun monomiop (a) + (and (consp a) + (fdp (first a)) + (terminop (rest a)))) + +;;; Constructor + +(defun monomio (c e) + (cons c e)) + +;;; Accesores + +;; (defun coeficiente (a) +;; (if (not (monomiop a)) +;; (COE::nulo) +;; (first a))) + +(defun coeficiente (a) + (if (not (monomiop a)) + (FLD::0_f) + (first a))) + +(defun termino (a) + (if (or (not (consp a)) (not (terminop (rest a)))) ;(not (monomiop a)) + (FUTER::uno) + (rest a))) + +;;; Monomio nulo + +;; (defun nulo () +;; (monomio (COE::nulo) (TER::uno))) + +(defun nulo () + (monomio (FLD::0_f) (FUTER::uno))) + +;;; Reconocedor de monomios nulos + +;; (defun nulop (a) +;; (COE::= (coeficiente a) (COE::nulo))) + +(defun nulop (a) + (FLD::= (coeficiente a) (FLD::0_f))) + +;;; Neutro de la operación + +;; (defun identidad () +;; (monomio (COE::identidad) (TER::uno))) + +(defun identidad () + (monomio (FLD::1_f) (FUTER::uno))) + +;;; Operación + +;; (defun * (a b) +;; (monomio (COE::* (coeficiente a) (coeficiente b)) +;; (TER::* (termino a) (termino b)))) + +(defun * (a b) + (monomio (FLD::* (coeficiente a) (coeficiente b)) + (FUTER::* (termino a) (termino b)))) + +;;; Igualdad semántica + +;; (defun = (a b) +;; (or (and (not (monomiop a)) (not (monomiop b))) +;; (and (monomiop a) (monomiop b) +;; (nulop a) (nulop b)) +;; (and (monomiop a) (monomiop b) +;; (COE::= (coeficiente a) (coeficiente b)) +;; (TER::= (termino a) (termino b))))) + +(defun = (a b) + (or (and (not (monomiop a)) (not (monomiop b))) + (and (monomiop a) (monomiop b) + (nulop a) (nulop b)) + (and (monomiop a) (monomiop b) + (FLD::= (coeficiente a) (coeficiente b)) + (FUTER::= (termino a) (termino b))))) + +;;; Igualdad de los términos subyacentes + +(defmacro =T (a b) + `(FUTER::= (termino ,a) (termino ,b))) + +;;; Orden de monomios + +(defmacro < (a b) + `(FUTER::< (termino ,a) (termino ,b))) + +;;; Inmersión en los ordinales + +(defmacro monomio->ordinal (a) + `(FUTER::termino->ordinal (termino ,a))) + +;;; ----------------------- +;;; Teoría de las funciones +;;; ----------------------- + +(deftheory funciones + (set-difference-theories (universal-theory :here) + (universal-theory 'principio-funciones))) + +;;; ----------- +;;; Propiedades +;;; ----------- + +;;; Clausura de las operaciones + +;; (defthm monomiop-monomio +;; (implies (and (coeficientep c) +;; (terminop e)) +;; (monomiop (monomio c e))) +;; :rule-classes (:type-prescription :generalize)) + +(defthm monomiop-monomio + (implies (and (fdp c) + (terminop e)) + (monomiop (monomio c e))) + :rule-classes (:type-prescription :generalize)) + +;; (defthm coeficientep-coeficiente +;; (implies (monomiop m) +;; (coeficientep (coeficiente m))) +;; :rule-classes (:type-prescription :generalize)) + +(defthm coeficientep-coeficiente + (implies (monomiop m) + (fdp (coeficiente m))) + :rule-classes (:type-prescription :generalize)) + +(defthm terminop-termino + (implies (monomiop m) + (FUTER::terminop (termino m))) + :rule-classes (:type-prescription :generalize)) + +(defthm monomiop-identidad + (monomiop (identidad)) + :hints (("Goal" :in-theory (disable (identidad)))) + :rule-classes (:type-prescription :generalize)) + +(defthm monomiop-* + (implies (and (monomiop a) (monomiop b)) + (monomiop (* a b))) + :rule-classes (:type-prescription :generalize)) + +;;; Equivalencia + +;;(defequiv =) +(defthm =-is-an-equivalence + (and (booleanp (= x y)) + (= x x) + (implies (= x y) + (= y x)) + (implies (and (= x y) + (= y z)) + (= x z))) + :rule-classes :equivalence) + +;;; Congruencias + +;;(defcong = COE::= (coeficiente m) 1) +(defthm |=-implies-FLD::=-coeficiente| + (implies (= y1 y2) + (FLD::= (coeficiente y1) + (coeficiente y2))) + :rule-classes :congruence) + +(defthm ;;=== + =-implies-equal-termino-1 + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y1))) + (equal (equal (termino y1) + (termino y2)) + t))) + +(defthm ;;=== + =-implies-equal-termino-2 + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y2))) + (equal (equal (termino y1) + (termino y2)) + t))) + +;;(defcong = = (* a b) 1) +(defthm =-implies-=-*-1 + (implies (= y1 y2) + (= (* y1 z) + (* y2 z))) + :rule-classes :congruence) + +;;(defcong = = (* a b) 2) +(defthm =-implies-=-*-2 + (implies (= y1 y2) + (= (* x y1) + (* x y2))) + :rule-classes :congruence) + +;;; Conmutatividad de la operación + +(defthm |a * b = b * a| + (implies (and (monomiop a) (monomiop b)) + (= (* a b) (* b a)))) + +;;; Asociatividad de la operación + +;; (defthm |(a * b) * c = a * (b * c)| +;; (implies (and (monomiop a) (monomiop b) (monomiop c)) +;; (= (* (* a b) c) (* a (* b c)))) +;; :hints (("Goal" +;; :in-theory (disable (nulo) COE::|a + b = b + a|)))) + +(defthm |(a * b) * c = a * (b * c)| + (implies (and (monomiop a) (monomiop b) (monomiop c)) + (= (* (* a b) c) (* a (* b c)))) + :hints (("Goal" + :in-theory (disable (nulo) FLD::|a + b = b + a|)))) + +;;; Neutro de la operación + +(defthm |1 * b = b| + (implies (monomiop b) + (= (* (identidad) b) b)) + :hints (("Goal" :in-theory (disable (identidad))))) + +;;; Cancelativo de la operación + +(defthm |a = 0 => a * b = 0| + (implies (and (monomiop a) (monomiop b) (nulop a)) + (nulop (* a b))) + :hints (("Goal" :in-theory (disable (nulo))))) + +;;; Coeficiente y término del constructor + +;; (defthm coeficiente-monomio +;; (implies (and (coeficientep c) (terminop e)) +;; (COE::= (coeficiente (monomio c e)) c))) + +(defthm coeficiente-monomio + (implies (and (fdp (double-rewrite c)) (terminop e)) + (FLD::= (coeficiente (monomio c e)) c))) + +;; (defthm termino-monomio +;; (implies (and (coeficientep c) (terminop e)) +;; (TER::= (termino (monomio c e)) e))) + +(defthm termino-monomio + (implies (and (fdp (double-rewrite c)) (terminop e)) + (FUTER::= (termino (monomio c e)) e))) + +;;; Eliminación de destructores + +(defthm monomio-coeficiente-termino + (implies (monomiop m) + (equal (monomio (coeficiente m) (termino m)) m)) + :rule-classes (:rewrite :elim)) + +;;; Coeficiente y término de la operación + +;; (defthm coeficiente-* +;; (COE::= (coeficiente (* a b)) +;; (COE::* (coeficiente a) (coeficiente b))) +;; :hints (("Goal" :in-theory (disable (nulo))))) + +(defthm coeficiente-* + (FLD::= (coeficiente (* a b)) + (FLD::* (coeficiente a) (coeficiente b))) + :hints (("Goal" :in-theory (disable (nulo))))) + +(defthm termino-* + (FUTER::= (termino (* a b)) + (FUTER::* (termino a) (termino b)))) + +;;; Buena fundamentación + +(defthm buena-fundamentacion-<-M + (and (implies (monomiop a) + (o-p (monomio->ordinal a))) + (implies (and (monomiop a) (monomiop b) + (< a b)) + (o< (monomio->ordinal a) (monomio->ordinal b))))) + +(defthm ;;=== + |=-implies-equal-FUTER::termino->ordinal-terminino-1| + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y1))) + (equal (equal (FUTER::termino->ordinal (termino y1)) + (FUTER::termino->ordinal (termino y2))) + t))) + +(defthm ;;=== + |=-implies-equal-FUTER::termino->ordinal-terminino-2| + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y2))) + (equal (equal (FUTER::termino->ordinal (termino y1)) + (FUTER::termino->ordinal (termino y2))) + t))) + +(defthm ;;=== + |=-implies-equal-FUTER::<-termino-1a| + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y1))) + (equal (equal (FUTER::< (termino y1)(termino z)) + (FUTER::< (termino y2)(termino z))) + t))) + +(defthm ;;=== + |=-implies-equal-FUTER::<-termino-1b| + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y2))) + (equal (equal (FUTER::< (termino y1)(termino z)) + (FUTER::< (termino y2)(termino z))) + t))) + +(defthm ;;=== + |=-implies-equal-FUTER::<-termino-2a| + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y1))) + (equal (equal (FUTER::< (termino x)(termino y1)) + (FUTER::< (termino x)(termino y2))) + t))) + +(defthm ;;=== + |=-implies-equal-FUTER::<-termino-2b| + (implies (and (= (double-rewrite y1) + (double-rewrite y2)) + (not (nulop y2))) + (equal (equal (FUTER::< (termino x)(termino y1)) + (FUTER::< (termino x)(termino y2))) + t))) + +;;; Definiciones extras + +;;; Suma + +;; (defun + (a b) +;; (monomio (COE::+ (coeficiente a) (coeficiente b)) +;; (termino a))) + +(defun + (a b) + (monomio (FLD::+ (coeficiente a) (coeficiente b)) + (termino a))) + +;;; Negación + +;; (defun - (a) +;; (monomio (COE::- (coeficiente a)) (termino a))) + +(defun - (a) + (monomio (FLD::- (coeficiente a)) (termino a))) + +;;; Inverso de la suma + +(defthm |a + (- a) = 0| + (implies (monomiop a) + (= (+ a (- a)) (nulo))) + :hints (("Goal" :in-theory (disable (nulo))))) + +;;; -------- +;;; Teoremas +;;; -------- + +;;; Teoremas que resultan de aplicar la conmutatividad a los axiomas + +(defthm |b * 1 = b| + (implies (monomiop b) + (= (* b (identidad)) b)) + :hints (("Goal" :in-theory (disable (identidad))))) + +(defthm |a = 0 => b * a = 0| + (implies (nulop a) + (nulop (* b a)))) + +;;; Complemento a la conmutatividad y la asociatividad de la operación + +(defthm |a * (b * c) = b * (a * c)| + (implies (and (monomiop a) (monomiop b) (monomiop c)) + (= (* a (* b c)) (* b (* a c)))) + :hints (("Goal" + :in-theory (disable |(a * b) * c = a * (b * c)|) + :use (|(a * b) * c = a * (b * c)| + (:instance |(a * b) * c = a * (b * c)| (a b) (b a)))))) + +(defthm |- (a + b) = (- a) + (- b)| + (implies (and (monomiop a) (monomiop b)) + (= (- (+ a b)) (+ (- a) (- b))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Additional Theorems +;; added by J. Cowles + +(defthm + |FLD::=-implies-=-monomio-1| + (implies (FLD::= y1 y2) + (= (monomio y1 z) + (monomio y2 z))) + :rule-classes :congruence) + +(defthm + =-implies-iff-monomiop + (implies (= y1 y2) + (iff (monomiop y1) + (monomiop y2))) + :rule-classes :congruence) + +(defun + C_= (x) + (if (monomiop x) + (if (nulop x) + (monomio (FLD::C_= (coeficiente x)) + (FUTER::uno)) + (monomio (FLD::C_= (coeficiente x)) + (termino x))) + t)) + +(defthm + C_=-= + (implies (monomiop (double-rewrite x)) + (= (C_= x) x))) + +(defthm + =-implies-equal-C_= + (implies (= y1 y2) + (equal (C_= y1) + (C_= y2))) + :rule-classes :congruence) + +(defthm + =-implies-=-+-2 + (implies (= m1 m2) + (= (+ m m1) + (+ m m2))) + :rule-classes :congruence) + +(defthm + =-implies-=_- + (implies (= m1 m2) + (= (- m1) + (- m2))) + :rule-classes :congruence) + +(defthm + =-implies-=-+-1a + (implies (and (= (double-rewrite m1) + (double-rewrite m2)) + (not (nulop m1))) + (equal (= (+ m1 m) + (+ m2 m)) + t))) + +(defthm + =-implies-=-+-1b + (implies (and (= (double-rewrite m1) + (double-rewrite m2)) + (not (nulop m2))) + (equal (= (+ m1 m) + (+ m2 m)) + t))) + +(defthm + |nulop a * b iff (nulop a) or (nulop b)| + (equal (nulop (* a b)) + (or (nulop a) + (nulop b)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; ++++++++++++++++++++++++++ +;;; + Barrera de abstracción + +;;; ++++++++++++++++++++++++++ + +;;; NOTA: +;;; +;;; A partir de aquí se procederá por aplicación de las propiedades + +(in-theory (disable funciones)) +(in-theory (enable nulop (nulop) (:type-prescription nulop))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.acl2 new file mode 100644 index 0000000..78cee74 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuopuesto" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.lisp new file mode 100644 index 0000000..790f562 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.lisp @@ -0,0 +1,254 @@ +; ACL2 Univariate Polynomials over a Field books -- Unary Minus +;; Unary Minus of Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ------------------------------------------------------------------ +;;; Opuesto de polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Desarrollo del opuesto de un polinomio, que se define monomio a +;;; monomio. Su corrección se prueba demostrando que la función que lo +;;; calcula produce el inverso aditivo. Para que éstas y otras +;;; propiedades sean incondicionales (carezcan de hipótesis) se +;;; completa cuidadosamente la definición de la función. Se demuestra +;;; que los polinomios con las operaciones de suma y opuesto forman un +;;; grupo conmutativo. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuopuesto" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;;(include-book "congruencias-suma") +(include-book "fucongruencias-suma" + :load-compiled-file nil) + +;;; --------------------- +;;; Opuesto de polinomios +;;; --------------------- + +;;; La siguiente desactivación es necesaria para la verificación de la +;;; protección del opuesto + +(in-theory (disable FUMON::monomio-coeficiente-termino)) + +(defun - (p) + (cond ((or (not (polinomiop p)) (nulop p)) + (nulo)) + (t + (+M (FUMON::- (primero p)) (- (resto p)))))) + +(in-theory (enable FUMON::monomio-coeficiente-termino)) + +;;; Clausura + +(defthm polinomiop-- + (polinomiop (- p)) + :rule-classes (:type-prescription + :rewrite)) + +;;; Distributividad respecto de la suma de monomio y polinomio + +(defthm |- p =e (- mp(p)) +M (- (resto(p)))| + (implies (and (polinomiop (double-rewrite p)) + (not (nulop p))) + (equal (- p) + (+M (FUMON::- (primero p)) (- (resto p)))))) + +;;; Inverso de la suma + +(defthm |m +M (- m +M 0) = 0| + (implies (monomiop (double-rewrite m)) + (= (+M m (+M (FUMON::- m) (nulo))) + (nulo)))) + +(defthm |p + (- p) = 0| + (= (+ p (- p)) (nulo)) + :hints (("Goal" + :in-theory (disable = + +M - FUMON::-) + :induct (fn p)) + ("Subgoal *1/1" :in-theory (enable = + +M)) + ("Subgoal *1/2" + :use ((:instance |p + q = q + p| + (p (+M (FUMON::- (primero p)) (- (resto p)))) + (q (resto p))))))) + +;;; Distributividad respecto de la suma en orden de monomio y +;;; polinomio + +;; (defthm |- (m +Mo p) =e (- m) +Mo (- p)| +;; (implies (and (monomiop (double-rewrite m)) +;; (polinomiop (double-rewrite p))) +;; (equal (- (+-monomio m p)) +;; (+-monomio (FUMON::- m) (- p))))) + +(defthm |- (m +Mo p) =P (- m) +Mo (- p)| + (implies (and (monomiop (double-rewrite m)) + (polinomiop (double-rewrite p))) + (=P (- (+-monomio m p)) + (+-monomio (FUMON::- m) (- p))))) + +;;; ------------------------------------------------------- +;;; Congruencia de la igualdad de polinomios con el opuesto +;;; ------------------------------------------------------- + +(defthm + |FUMON::nulop_-| + (implies (monomiop (double-rewrite m)) + (equal (FUMON::nulop (FUMON::- m)) + (FUMON::nulop m)))) + +(defthm + =P-implies-=P_- + (implies (=P p1 p2) + (=P (- p1) + (- p2))) + :rule-classes :congruence) + +(defthm + Ordenadop_- + (implies (ordenadop p) + (ordenadop (- p)))) + +;; (local +;; (defthm |fn(- p) = - fn(p)| +;; (equal (fn (- p)) (- (fn p))) +;; :hints (("Goal" :in-theory (disable MON::- ))))) + +(local + (defthm |fn(- p) =P - fn(p)| + (=P (fn (- p)) (- (fn p))) + :hints (("Goal" :in-theory (disable FUMON::- ))))) + +;; (defcong = = (- p) 1) + +(defthm + =-implies-=_- + (implies (= p1 p2) + (= (- p1) + (- p2))) + :rule-classes :congruence) + +;;; --------------- +;;; Desactivaciones +;;; --------------- + +(local (in-theory (disable polinomiop = + -))) + +;;; ----------------------------------------------------------------------- +;;; El inverso debe ser invisible para la primera operación y para sí mismo +;;; ----------------------------------------------------------------------- +(ACL2::set-invisible-fns-table ((+ -) (- -))) + + +;;; El opuesto de una suma de polinomios es la suma de los opuestos. + +(defthm |p + r = q + r <=> p = q| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (iff (= (+ p r) (+ q r)) (= p q))) + :hints (("Goal" + :in-theory (disable |p + q = q + p| |p + 0 = p|) + :use ((:instance |p + q = q + p| (p (+ p r)) (q (- r))) + (:instance |p + q = q + p| (p (- r)) (q (+ q r))) + (:instance |p + 0 = p| (p q)) + |p + 0 = p|)))) + +(local + (defthm |p + q = q <=> p = 0| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (iff (= (+ p q) q) (= p (nulo)))) + :hints (("Goal" + :in-theory (disable |p + r = q + r <=> p = q|) + :use (:instance |p + r = q + r <=> p = q| (q (nulo)) (r q)))))) + +(local + (defthm |p + q = 0 <=> q = - p| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (iff (= (+ p q) (nulo)) (= q (- p)))) + :hints (("Goal" + :in-theory (disable |p + r = q + r <=> p = q|) + :use (:instance |p + r = q + r <=> p = q| (p q) (q (- p)) (r p)))))) + +;;; Mezcla de asociatividad y conmutatividad + +(defthm |p + (q + r) = q + (p + r)| + (= (+ p (+ q r)) (+ q (+ p r))) + :hints (("Goal" + :in-theory (disable |(p + q) + r = p + (q + r)|) + :use (|(p + q) + r = p + (q + r)| + (:instance |(p + q) + r = p + (q + r)| (p q) (q p)))))) + +;;; Idempotencia del inverso + +(defthm |- (- p) = p| + (implies (polinomiop (double-rewrite p)) + (= (- (- p)) p)) + :hints (("Goal" + :in-theory (disable |p + q = 0 <=> q = - p|) + :use (:instance |p + q = 0 <=> q = - p| (p (- p)) (q p))))) + +;;; Distributividad de la inversa sobre la primera operación + +(defthm |- (p + q) = (- p) + (- q)| + (= (- (+ p q)) (+ (- p) (- q))) + :hints (("Goal" + :in-theory (disable |p + q = 0 <=> q = - p|) + :use (:instance |p + q = 0 <=> q = - p| (p (+ p q)) (q (+ (- p) (- q))))))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.acl2 new file mode 100644 index 0000000..d70e8aa --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.acl2 @@ -0,0 +1,29 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(defpkg "FUNPOL" + (set-difference-eq *import-symbols* + '(rem))) + +(certify-book "fupolinomio-normalizado" ? t) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.lisp new file mode 100644 index 0000000..61e5666 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.lisp @@ -0,0 +1,601 @@ +; ACL2 Univariate Polynomials over a Field books -- Normalized Polynomials +;; Normalized Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ------------------------------------------------------------------ +;;; Polinomios normalizados +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Polinomios normalizados definidos a partir de los polinomios +;;; desnormalizados y de la operación de normalización. Ascenso de las +;;; propiedades de anillo de la representación desnormalizada a la +;;; normalizada. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(defpkg "FUNPOL" + (set-difference-eq *import-symbols* + '(rem))) + +(certify-book "fupolinomio-normalizado" + 6 + nil ;;compile-flg + ) +|# +(in-package "FUNPOL") + +;;(include-book "../polinomios/congruencias-producto") +(include-book "fucongruencias-producto" + :load-compiled-file nil) + +(in-theory (enable FUPOL::=)) + +;;; --------------------------------------------- +;;; Reconocedor de los polinomios en forma normal +;;; --------------------------------------------- + +(defmacro polinomiop (p) + `(FUPOL::ordenadop ,p)) + +(defmacro primero (p) + `(FUPOL::primero ,p)) + +(defmacro resto (p) + `(FUPOL::resto ,p)) + +;; (defthm booleanp-polinomiop +;; (ACL2::booleanp (polinomiop p)) +;; :rule-classes :type-prescription) + +(defthm booleanp-polinomiop + (booleanp (polinomiop p)) + :rule-classes :type-prescription) + +;;; -------------------------- +;;; Elemento neutro de la suma +;;; -------------------------- + +(defmacro nulop (p) + `(FUPOL::nulop ,p)) + +(defun nulo () (FUPOL::nulo)) + +(defthm polinomiop-nulo + (polinomiop (nulo)) + :rule-classes :type-prescription) + +;;; ---------------------------- +;;; Elemento neutro del producto +;;; ---------------------------- + +(defun identidad () (FUPOL::identidad)) + +(defthm polinomiop-identidad + (polinomiop (identidad)) + :hints (("Goal" :in-theory (disable (identidad)))) + :rule-classes :type-prescription) + +;;; ---- +;;; Suma +;;; ---- + +(defun + (p q) + (FUPOL::fn (FUPOL::+ p q))) + +(defthm polinomiop-+ + (polinomiop (+ p q)) + :rule-classes :type-prescription) + +;;; -------------- +;;; Multiplicación +;;; -------------- + +(defun * (p q) + (FUPOL::fn (FUPOL::* p q))) + +(defthm polinomiop-* + (polinomiop (* p q)) + :rule-classes :type-prescription) + +;;; ----- +;;; Resta +;;; ----- + +(defun - (p) + (FUPOL::fn (FUPOL::- p))) + +(defthm polinomiop-- + (polinomiop (- p)) + :rule-classes :type-prescription) + +;;; ----------- +;;; Propiedades +;;; ----------- + +(in-theory (disable FUPOL::+ FUPOL::* FUPOL::-)) + +(defun + = (p q) + (FUPOL::=P p q)) + +(defthm + =-is-an-equivalence + (and (booleanp (= p q)) + (= p p) + (implies (= p q) + (= q p)) + (implies (and (= p q) + (= q r)) + (= p r))) + :rule-classes :equivalence) + +(defthm + =-implies-=-+-1 + (implies (= p1 p2) + (= (+ p1 q) + (+ p2 q))) + :rule-classes :congruence + :hints (("Goal" + :use (:instance + FUPOL::=-implies-=-+-1 + (FUPOL::p1 p1) + (FUPOL::p2 p2) + (FUPOL::q q))))) + +(defthm + =-implies-=-+-2 + (implies (= q1 q2) + (= (+ p q1) + (+ p q2))) + :rule-classes :congruence + :hints (("Goal" + :use (:instance + FUPOL::=-implies-=-+-2 + (FUPOL::q1 q1) + (FUPOL::q2 q2) + (FUPOL::p p))))) + +(defthm + =-implies-=-*-1 + (implies (= p1 p2) + (= (* p1 q) + (* p2 q))) + :rule-classes :congruence + :hints (("Goal" + :use (:instance + FUPOL::=-implies-=-*-1 + (FUPOL::p1 p1) + (FUPOL::p2 p2) + (FUPOL::q q))))) + +(defthm + =-implies-=-*-2 + (implies (= q1 q2) + (= (* p q1) + (* p q2))) + :rule-classes :congruence + :hints (("Goal" + :use (:instance + FUPOL::=-implies-=-*-2 + (FUPOL::q1 q1) + (FUPOL::q2 q2) + (FUPOL::p p))))) + +(defthm + =-implies-=_- + (implies (= p1 p2) + (= (- p1) + (- p2))) + :rule-classes :congruence) + +;; (defthm |p + q = q + p| +;; (equal (+ p q) (+ q p)) +;; :hints (("Goal" +;; :in-theory (disable POL::|p + q = q + p|) +;; :use (:instance POL::|p + q = q + p| (POL::p p) (POL::q q))))) + +(defthm |p + q = q + p| + (= (+ p q) (+ q p))) + +;; (defthm |(p + q) + r = p + (q + r)| +;; (equal (+ (+ p q) r) (+ p (+ q r))) +;; :hints (("Goal" +;; :in-theory (disable POL::|p + (q + r) = q + (p + r)|) +;; :use ((:instance POL::|p + (q + r) = q + (p + r)| +;; (POL::p p) (POL::q q) (POL::r r)) +;; (:instance POL::|p + q = fn(p) + q| +;; (POL::p (POL::+ p q)) +;; (POL::q r)) +;; (:instance POL::|p + q = p + fn(q)| +;; (POL::p p) +;; (POL::q (POL::+ q r))))))) + +(defthm |(p + q) + r = p + (q + r)| + (= (+ (+ p q) r) (+ p (+ q r))) + :hints (("Goal" + :in-theory (disable FUPOL::|p + (q + r) = q + (p + r)|) + :use ((:instance FUPOL::|p + (q + r) = q + (p + r)| + (FUPOL::p p) (FUPOL::q q) (FUPOL::r r)) + (:instance FUPOL::|p + q = fn(p) + q| + (FUPOL::p (FUPOL::+ p q)) + (FUPOL::q r)) + (:instance FUPOL::|p + q = p + fn(q)| + (FUPOL::p p) + (FUPOL::q (FUPOL::+ q r))))))) + +;; (defthm |0 + p = p| +;; (implies (polinomiop p) +;; (equal (+ (nulo) p) p)) +;; :hints (("Goal" +;; :in-theory (disable POL::|0 + p = p|) +;; :use (:instance POL::|0 + p = p| (POL::p p))))) + +(defthm |0 + p = p| + (implies (polinomiop (double-rewrite p)) + (= (+ (nulo) p) p))) + +;; (defthm |p * q = q * p| +;; (equal (* p q) (* q p)) +;; :hints (("Goal" +;; :in-theory (disable POL::|p * q = q * p|) +;; :use (:instance POL::|p * q = q * p| (POL::p p) (POL::q q))))) + +(defthm |p * q = q * p| + (= (* p q) (* q p))) + +;; (defthm |(p * q) * r = p * (q * r)| +;; (equal (* (* p q) r) (* p (* q r))) +;; :hints (("Goal" +;; :in-theory (disable POL::|(p * q) * r = p * (q * r)| +;; POL::|p * q = q * p|) +;; :use ((:instance POL::|(p * q) * r = p * (q * r)| +;; (POL::p p) (POL::q q) (POL::r r)) +;; (:instance POL::|fn(p) * q = p * q| +;; (POL::p (POL::* p q)) +;; (POL::q r)) +;; (:instance POL::|p * q = q * p| +;; (POL::q r) (POL::p (POL::* p q))) +;; (:instance POL::|p * q = q * p| +;; (POL::q r) (POL::p (POL::fn (POL::* p q)))) +;; (:instance POL::|p * fn(q) = p * q| +;; (POL::p p) +;; (POL::q (POL::* q r))))))) + +(defthm |(p * q) * r = p * (q * r)| + (= (* (* p q) r) (* p (* q r))) + :hints (("Goal" + :in-theory (disable FUPOL::|(p * q) * r = p * (q * r)| + FUPOL::|p * q = q * p|) + :use ((:instance FUPOL::|(p * q) * r = p * (q * r)| + (FUPOL::p p) (FUPOL::q q) (FUPOL::r r)) + (:instance FUPOL::|fn(p) * q = p * q| + (FUPOL::p (FUPOL::* p q)) + (FUPOL::q r)) + (:instance FUPOL::|p * q = q * p| + (FUPOL::q r) (FUPOL::p (FUPOL::* p q))) + (:instance FUPOL::|p * q = q * p| + (FUPOL::q r) (FUPOL::p (FUPOL::fn (FUPOL::* p q)))) + (:instance FUPOL::|p * fn(q) = p * q| + (FUPOL::p p) + (FUPOL::q (FUPOL::* q r))))))) + +;; (defthm |1 * p = p| +;; (implies (polinomiop p) +;; (equal (* (identidad) p) p)) +;; :hints (("Goal" +;; :in-theory (disable POL::|1 * p = p| (identidad)) +;; :use (:instance POL::|1 * p = p| (POL::p p))))) + +(defthm |1 * p = p| + (implies (polinomiop (double-rewrite p)) + (= (* (identidad) p) p))) + +(defthm |p + (- p) = 0| + (equal (+ p (- p)) (nulo)) + :hints (("Goal" + :use ((:instance FUPOL::|p + q = p + fn(q)| + (FUPOL::p p) + (FUPOL::q (FUPOL::- p))))))) + +;; (defthm |p * (q + r) = (p * q) + (p * r)| +;; (equal (* p (+ q r)) (+ (* p q) (* p r))) +;; :hints (("Goal" +;; :in-theory (disable POL::|p * (q + r) = (p * q) + (p * r)| +;; POL::|(p * q) * r = p * (q * r)|) +;; :use ((:instance POL::|p * (q + r) = (p * q) + (p * r)| +;; (POL::p p) (POL::q q) (POL::r r)) +;; (:instance POL::|fn(p) + fn(q) = p + q| +;; (POL::p (POL::* p q)) +;; (POL::q (POL::* p r))) +;; (:instance POL::|p * fn(q) = p * q| +;; (POL::p p) +;; (POL::q (POL::+ q r))))))) + +(defthm |p * (q + r) = (p * q) + (p * r)| + (= (* p (+ q r)) (+ (* p q) (* p r))) + :hints (("Goal" + :in-theory (disable FUPOL::|p * (q + r) = (p * q) + (p * r)| + FUPOL::|(p * q) * r = p * (q * r)|) + :use ((:instance FUPOL::|p * (q + r) = (p * q) + (p * r)| + (FUPOL::p p) (FUPOL::q q) (FUPOL::r r)) + (:instance FUPOL::|fn(p) + fn(q) = p + q| + (FUPOL::p (FUPOL::* p q)) + (FUPOL::q (FUPOL::* p r))) + (:instance FUPOL::|p * fn(q) = p * q| + (FUPOL::p p) + (FUPOL::q (FUPOL::+ q r))))))) + +(defthm |0 * p =e 0| + (equal (* (nulo) p) (nulo))) + +(defthm |p * 0 =e 0| + (equal (* p (nulo)) (nulo))) + +(defthm |- 0 =e 0| + (equal (- (nulo)) (nulo))) + + +;;; Mejor con teorías + +(in-theory (disable + (+) * (*) - (-) nulo (nulo) identidad (identidad))) + +(in-theory (disable = (=))) +;;; ----------------------------------------------------------------------- +;;; El inverso debe ser invisible para la primera operación y para sí mismo +;;; ----------------------------------------------------------------------- + +;; (ACL2::set-invisible-fns-table ((+ -) (- -))) +(set-invisible-fns-table ((+ -) (- -))) + +;;; -------------------------------------- +;;; Propiedades derivadas de las de anillo +;;; -------------------------------------- + +;;; Teoremas que resultan de aplicar la conmutatividad a los axiomas + +;; (defthm |p + 0 = p| +;; (implies (polinomiop p) +;; (equal (+ p (nulo)) p))) + +(defthm |p + 0 = p| + (implies (polinomiop (double-rewrite p)) + (= (+ p (nulo)) p))) + +;; (defthm |p * 1 = p| +;; (implies (polinomiop p) +;; (equal (* p (identidad)) p))) + +(defthm |p * 1 = p| + (implies (polinomiop (double-rewrite p)) + (= (* p (identidad)) p))) + +;; (defthm |(- p) + p = 0| +;; (equal (+ (- p) p) (nulo))) + +(defthm |(- p) + p = 0| + (= (+ (- p) p) (nulo))) + +;; (defthm |(p + q) * r = (p * r) + (q * r)| +;; (equal (* (+ p q) r) (+ (* p r) (* q r)))) + +(defthm |(p + q) * r = (p * r) + (q * r)| + (= (* (+ p q) r) (+ (* p r) (* q r)))) + +;;; Teorema de cancelación + +;; (defthm |p + r = q + r <=> p = q| +;; (implies (and (polinomiop p) (polinomiop q)) +;; (iff (equal (+ p r) (+ q r)) (equal p q))) +;; :hints (("Goal" +;; :in-theory (disable |p + q = q + p| |p + 0 = p|) +;; :use ((:instance |p + q = q + p| (p (+ p r)) (q (- r))) +;; (:instance |p + q = q + p| (p(- r)) (q (+ q r))) +;; (:instance |p + 0 = p| (p q)) +;; |p + 0 = p|)))) + +(defthm |p + r = q + r <=> p = q| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (iff (= (+ p r) (+ q r)) (= p q))) + :hints (("Goal" + :in-theory (disable |p + q = q + p| |p + 0 = p|) + :use ((:instance |p + q = q + p| (p (+ p r)) (q (- r))) + (:instance |p + q = q + p| (p(- r)) (q (+ q r))) + (:instance |p + 0 = p| (p q)) + |p + 0 = p|)))) + +;; (defthm |p + q = 0 <=> q = - p| +;; (implies (and (polinomiop p) (polinomiop q)) +;; (iff (equal (+ p q) (nulo)) (equal q (- p)))) +;; :hints (("Goal" +;; :in-theory (disable |p + r = q + r <=> p = q|) +;; :use (:instance |p + r = q + r <=> p = q| (p q) (q (- p)) (r p))))) + +(defthm |p + q = 0 <=> q = - p| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (iff (= (+ p q) (nulo)) (= q (- p)))) + :hints (("Goal" + :in-theory (disable |p + r = q + r <=> p = q|) + :use (:instance |p + r = q + r <=> p = q| (p q) (q (- p)) (r p))))) + +;; (defthm |p * (- q) = - (p * q)| +;; (equal (* p (- q)) (- (* p q))) +;; :hints (("Goal" +;; :in-theory (disable |p * (q + r) = (p * q) + (p * r)|) +;; :use (:instance |p * (q + r) = (p * q) + (p * r)| +;; (q (- q)) (r q))))) + +(defthm |p * (- q) = - (p * q)| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (= (* p (- q)) (- (* p q)))) + :hints (("Goal" + :in-theory (disable |p * (q + r) = (p * q) + (p * r)| + |p + q = 0 <=> q = - p|) + :use ((:instance |p * (q + r) = (p * q) + (p * r)| + (q (- q)) (r q)) + (:instance |p + q = 0 <=> q = - p| + (q (* p (- q)))(p (* p q))))))) + +;; (defthm |p + (q + r) = q + (p + r)| +;; (equal (+ p (+ q r)) (+ q (+ p r))) +;; :hints (("Goal" +;; :in-theory (disable |(p + q) + r = p + (q + r)|) +;; :use (|(p + q) + r = p + (q + r)| +;; (:instance |(p + q) + r = p + (q + r)| (p q) (q p)))))) + +(defthm |p + (q + r) = q + (p + r)| + (= (+ p (+ q r)) (+ q (+ p r))) + :hints (("Goal" + :in-theory (disable |(p + q) + r = p + (q + r)|) + :use (|(p + q) + r = p + (q + r)| + (:instance |(p + q) + r = p + (q + r)| (p q) (q p)))))) + +;; (defthm |- (p + q) = (- p) + (- q)| +;; (equal (- (+ p q)) (+ (- p) (- q))) +;; :hints (("Goal" +;; :in-theory (disable |p + q = 0 <=> q = - p|) +;; :use ((:instance |p + q = 0 <=> q = - p| +;; (p (+ p q)) (q (+ (- p) (- q)))))))) + +(defthm |- (p + q) = (- p) + (- q)| + (= (- (+ p q)) (+ (- p) (- q))) + :hints (("Goal" + :in-theory (disable |p + q = 0 <=> q = - p|) + :use ((:instance |p + q = 0 <=> q = - p| + (p (+ p q)) (q (+ (- p) (- q)))))))) + +;;; Idempotencia del inverso + +;; (defthm |- (- p) = p| +;; (implies (polinomiop p) +;; (equal (- (- p)) p)) +;; :hints (("Goal" +;; :in-theory (disable |p + q = 0 <=> q = - p|) +;; :use (:instance |p + q = 0 <=> q = - p| (p (- p)) (q p))))) + +(defthm |- (- p) = p| + (implies (polinomiop (double-rewrite p)) + (= (- (- p)) p)) + :hints (("Goal" + :in-theory (disable |p + q = 0 <=> q = - p|) + :use (:instance |p + q = 0 <=> q = - p| (p (- p)) (q p))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Additional theory and theorems by J. Cowles + +(defthm |(- p) * q = - (p * q)| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (= (* (- p) q) (- (* p q))))) + +(defthm |(- p) * (- q) = p * q| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (= (* (- p) (- q)) (* p q)))) + +(defthm |p * (q * r) = q * (p * r)| + (= (* p (* q r)) (* q (* p r))) + :hints (("Goal" + :in-theory (disable |(p * q) * r = p * (q * r)|) + :use (|(p * q) * r = p * (q * r)| + (:instance |(p * q) * r = p * (q * r)| (p q) (q p)))))) + +(defun + C_= (p) + (FUPOL::fn (FUPOL::C_= p))) + +(defthm + Polinomiop-C_= + (polinomiop (C_= p)) + :rule-classes :type-prescription) + +(in-theory (enable = (=))) + +(defthm + C_=-= + (implies (polinomiop (double-rewrite p)) + (= (C_= p) p))) + +(defthm + =-implies-equal-C_= + (implies (= p1 p2) + (equal (C_= p1) + (C_= p2))) + :rule-classes :congruence) + +(defthm + |=-implies-equal-FUPOL::ordenadop| + (implies (= p1 p2) + (equal (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2))) + :rule-classes :congruence) + +(defthm + |p1 * p2 = 0 <=> p1 = 0 or p2 = 0| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2))) + (equal (= (* p1 p2)(nulo)) + (or (= p1 (nulo)) + (= p2 (nulo))))) + :hints (("Goal" + :in-theory (e/d (* (*) nulo) + (FUPOL::|fn(p1 * p2) = 0 <=> p1 = 0 or p2 = 0|)) + :use (:instance + FUPOL::|fn(p1 * p2) = 0 <=> p1 = 0 or p2 = 0| + (FUPOL::p1 p1) + (FUPOL::p2 p2))))) + +(in-theory (disable = (=))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.acl2 new file mode 100644 index 0000000..2f4083f --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fupolinomio" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.lisp new file mode 100644 index 0000000..3731841 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.lisp @@ -0,0 +1,123 @@ +; ACL2 Univariate Polynomials over a Field books -- (Unnormalized) Polynomials +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ------------------------------------------------------------------- +;;; Polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Representación abstracta de los polinomios mediante listas propias +;;; de ACL2 formadas por monomios que contienen coeficientes y +;;; términos abstractos. +;;; ------------------------------------------------------------------- +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fupolinomio" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;;(include-book "monomio") +(include-book "fumonomio" + :load-compiled-file nil) + +;;; --------- +;;; Funciones +;;; --------- + +;;; Accesores + +(defmacro primero (p) + `(first ,p)) + +(defmacro resto (p) + `(rest ,p)) + +;;; Reconocedor + +(defun polinomiop (p) + (if (atom p) + (equal p nil) + (and (monomiop (primero p)) (polinomiop (resto p))))) + +;;; Polinomio nulo en forma normal + +;;; NOTA: +;;; +;;; Posteriormente definiremos la igualdad semántica entre +;;; polinomios. Entonces, esta definición corresponderá al +;;; representante canónico de la clase de equivalencia formada por los +;;; polinomios nulos. + +(defmacro nulo () nil) + +;;; NOTA: +;;; +;;; La siguiente versión se emplea en los casos base de las funciones +;;; recursivas que trabajan con polinomios. + +(defmacro nulop (p) + `(atom ,p)) + +;;; ----------- +;;; Propiedades +;;; ----------- + +;;; Clausura + +(defthm polinomiop-resto + (implies (polinomiop p) + (polinomiop (resto p))) + :rule-classes :type-prescription) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.acl2 new file mode 100644 index 0000000..3a3b5d1 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuproducto" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.lisp new file mode 100644 index 0000000..3639b3d --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.lisp @@ -0,0 +1,583 @@ +; ACL2 Univariate Polynomials over a Field books -- Polynomial Products +;; Products of Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +; Modified by Matt Kaufmann for ACL2 Version 3.1 because +; SBCL complains about LISP::. + +;; Based on +;;; --------------------------------------------------------------- +;;; Producto de polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Desarrollo del producto externo de un monomio por un polinomio y +;;; del producto de polinomios. Las funciones se completan +;;; cuidadosamente, de lo contrario, no es posible establecer las +;;; congruencias, ya que éstas no pueden contener hipótesis. Se +;;; demuestra que los polinomios con el producto forman un monoide +;;; conmutativo y que el producto distribuye respecto de la suma, +;;; completándose con esto la demostración de las propiedades del +;;; anillo de polinomios. +;;; ---------------------------------------------------------------- +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fuproducto" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;; (include-book "opuesto") +(include-book "fuopuesto" + :load-compiled-file nil) + +;;; ------ +;;; Neutro +;;; ------ + +(defmacro identidad () + `(+M (FUMON::identidad) (nulo))) + +(defmacro identidadp (p) + `(= ,p (identidad))) + +(defthm polinomiop-identidad + (polinomiop (identidad)) + :rule-classes :type-prescription) + +;; (defthm +;; |RNG::1 !RNG::= RNG::0| +;; (not (RNG::= (RNG::1_r)(RNG::0_r))) +;; :hints (("Goal" +;; :use RNG::|0 != 1|))) + +(defthm ordenadop-identidad + (ordenadop (identidad)) + :hints (("Goal" :in-theory (enable FUMON::identidad))) + :rule-classes :type-prescription) + +;;; ------------------------------- +;;; Producto de monomio y polinomio +;;; ------------------------------- + +(defun *-monomio (m p) + (cond ((or (nulop p) (not (monomiop m)) (not (polinomiop p))) + (nulo)) + (t + (+M (FUMON::* m (primero p)) (*-monomio m (resto p)))))) + +;;; Clausura + +(defthm polinomiop-*-monomio + (polinomiop (*-monomio m p)) + :rule-classes (:type-prescription + :rewrite)) + +;;; Neutro + +(defthm |1 *M p = p| + (implies (polinomiop (double-rewrite p)) + (= (*-monomio (FUMON::identidad) p) p))) + +;;; Cancelación + +;;; NOTA: +;;; +;;; Primero se demuestra sintácticamente, introduciendo la forma +;;; normal. Luego se extiende a la igualdad semántica. + +(defthm |m = 0 => fn(m *M p) =e 0| + (implies (FUMON::nulop m) + (equal (fn (*-monomio m p)) (nulo)))) + +(defthm |m = 0 => m *M p = 0| + (implies (FUMON::nulop m) + (= (*-monomio m p) (nulo)))) + +;;; Distributividad del producto externo respecto de la suma. + +(defthm |m1 *M (m2 +M p) =e (m1 * m2) +M (m *M p)| + (implies (and (monomiop (double-rewrite m1)) + (monomiop (double-rewrite m2))) + (equal (*-monomio m1 (+M m2 p)) + (+M (FUMON::* m1 m2) (*-monomio m1 p))))) + +(defthm |m *M (p + q) = (m *M p) + (m *M q)| + (= (*-monomio m (+ p q)) + (+ (*-monomio m p) (*-monomio m q))) + :hints (("Goal" + :in-theory (disable = + +M |p + q = q + p|)) + ("Subgoal *1/1" :in-theory (enable = + +M)))) + +;;; NOTA: +;;; +;;; Esta propiedad permite cambiar un producto externo por otro +;;; más sencillo sobre monomios. + +(defthm |m1 *M (m2 *M p) = (m1 * m2) *M p| + (implies (and (monomiop (double-rewrite m1)) + (monomiop (double-rewrite m2))) + (= (*-monomio m1 (*-monomio m2 p)) + (*-monomio (FUMON::* m1 m2) p))) + :hints (("Goal" :in-theory (disable = + +M)) + ("Subgoal *1/1" :in-theory (enable = + +M)))) + +(defthm + |p != 0 => m *M p != 0| + (implies (and (monomiop (double-rewrite m)) + (polinomiop (double-rewrite p)) + (not (nulop p))) + (not (nulop (*-monomio m p))))) + +(defthm + |ordenadop p => ordenadop m *M p| + (implies (and (not (FUMON::nulop m)) + (ordenadop (double-rewrite p))) + (ordenadop (*-monomio m p)))) + +(defthm + | m != 0 and p != 0 => fn(m *M p) != 0| + (implies (and (monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (ordenadop (double-rewrite p)) + (not (nulop p))) + (not (nulop (fn (*-monomio m p))))) + :hints (("Goal" + :in-theory (disable fnp-iff-ordenadop) + :use |p != 0 => m *M p != 0|))) + +;;; ---------------------- +;;; Producto de polinomios +;;; ---------------------- + +(defun * (p q) + (cond ((or (nulop p) (not (polinomiop p))) + (nulo)) + (t + (+ (*-monomio (primero p) q) (* (resto p) q))))) + +;;; Clausura + +(defthm polinomiop-* + (polinomiop (* p q)) + :rule-classes (:type-prescription + :rewrite)) + +;;; El producto de un monomio por el producto de dos polinomios es +;;; igual al producto del segundo polinomio por el resultado de +;;; multiplicar el monomio por el primer polinomio + +(defthm |m *M (p * q) = (m *M p) * q| + (implies (monomiop (double-rewrite m)) + (= (*-monomio m (* p q)) + (* (*-monomio m p) q))) + :hints (("Goal" + :in-theory (disable + =)))) + +;;; Distributividad respecto de la suma + +(defthm |p * q =e mp(p) *M q + resto(p) * q| + (implies (and (polinomiop (double-rewrite p)) + (not (nulop p))) + (equal (* p q) + (+ (*-monomio (primero p) q) (* (resto p) q))))) + +(defthm |(p + q) * r = (p * r) + (q * r)| + (= (* (+ p q) r) (+ (* p r) (* q r))) + :hints (("Goal" + :induct (fn p) + :in-theory (disable = + *)) + ("Subgoal *1/1" + :in-theory (enable = + *)))) + +;;; Neutro + +(defthm |1 * p = p| + (= (* (identidad) p) p)) + +;;; Cancelación + +(defthm |0 * p =e 0| + (equal (* (nulo) p) (nulo))) + +;; (defthm |0 * p = 0| +;; (= (* (nulo) p) (nulo))) + +;;; Asociatividad + +(defthm |(p * q) * r = p * (q * r)| + (= (* (* p q) r) (* p (* q r))) + :hints (("Goal" :in-theory (disable = +)))) + +;;; Conmutatividad + +;;; NOTA: +;;; +;;; La inducción apropiada es múltiple. Unas veces se requiere una +;;; hipótesis de inducción sobre uno de los parámetros, otras veces +;;; sobre el otro y otras sobre ambos. Hemos de suministrar el +;;; esquema. + +(encapsulate () + (local + (defthm tecnico + (implies (and (monomiop (double-rewrite m)) + (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (= (+ p (+M m q)) (+ q (+M m p)))) + :hints (("Goal" :in-theory (disable = +))))) + + (local + (defun esquema-de-induccion (p q) + (declare (xargs :verify-guards nil :measure (ACL2::+ (len p) (len q)))) + (cond ((or (nulop p) (nulop q)) + t) + (t + (and (esquema-de-induccion (resto p) (resto q)) + (esquema-de-induccion (resto p) q) + (esquema-de-induccion p (resto q))))))) + + (defthm |p * q = q * p| + (= (* p q) (* q p)) + :hints (("Goal" + :induct (esquema-de-induccion p q) + :do-not '(eliminate-destructors) + :in-theory (disable = + +M + |m = 0 => m *M p = 0| + |p != 0 => m *M p != 0|))))) + +;;; Distributividad respecto de la suma + +(defthm |p * (q + r) = (p * q) + (p * r)| + (= (* p (+ q r)) (+ (* p q) (* p r))) + :hints (("Goal" + :in-theory (disable = + *) + :use ((:instance |(p + q) * r = (p * r) + (q * r)| + (r p) (p q) (q r)))))) + +(defthm |p * 1 = p| + (= (* p (identidad)) p)) + +(defthm |p * 0 =e 0| + (equal (* p (nulo))(nulo))) + +;; (defthm |p * 0 = 0| +;; (= (* p (nulo)) (nulo))) + +(defthm + |nulop p1 * p2 <=> nulop p1 or nulop p2| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2))) + (equal (nulop (* p1 p2)) + (or (nulop p1) + (nulop p2))))) + +(defthm + |p1 * p2 = 0 <=> p1 = 0 or p2 = 0| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2))) + (equal (equal (* p1 p2)(nulo)) + (or (equal p1 (nulo)) + (equal p2 (nulo)))))) + +(defthm + |primero (p1 * p2) =e (primero p1) FUMON::* (primero p2)| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2)) + (not (nulop p1)) + (not (nulop p2))) + (equal (primero (* p1 p2)) + (FUMON::* (primero p1)(primero p2))))) + +(defun + >-monomio (m p) + "Determine if monomio m is FUMON::> than + every monomio in p." + (if (consp p) + (and (FUTER::< (termino (primero p))(termino m)) + (>-monomio m (resto P))) + t)) + +(defthm + |primero p FUMON::< m => >-monomio m p| + (implies (and (ordenadop (double-rewrite p)) + (FUMON::< (primero p) m)) + (>-monomio m p))) + +(defthm + |m >-monomio p => primero (m +M p) =e m| + (implies (and (monomiop m) + (not (FUMON::nulop m)) + (>-monomio m p)) + (equal (primero (+-monomio m p)) m))) + +(defthm + |m >-monomio (n +-monomio p)| + (implies (and (>-monomio m p) + (FUTER::< (termino n)(termino m))) + (>-monomio m (+-monomio n p)))) + +(defthm + |m >-monomio p => m >-monomio (fn p)| + (implies (>-monomio m p) + (>-monomio m (fn p)))) + +(defthm + |(primero p) >-monomio (resto p) => primero (fn p) =e primero p| + (implies (and (polinomiop (double-rewrite p)) + (not (FUMON::nulop (primero p))) + (>-monomio (primero p)(resto p))) + (equal (primero (fn p))(primero p)))) + +(defthm + |primero (p1 * p2) != 0| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2)) + (not (nulop p1)) + (not (nulop p2))) + (not (FUMON::nulop (primero (* p1 p2))))) + :hints (("Goal" + :in-theory (disable + |primero (p1 * p2) =e (primero p1) FUMON::* (primero p2)|) + :use |primero (p1 * p2) =e (primero p1) FUMON::* (primero p2)|))) + +(defthm + |ordenadop p => (primero p) >-monomio (resto p)| + (implies (and (ordenadop (double-rewrite p)) + (not (nulop p))) + (>-monomio (primero p)(resto p)))) + +(defthm + |primero (m *M p) >-monomio resto (m *M p)| + (implies (and (not (FUMON::nulop m)) + (ordenadop (double-rewrite p))) + (>-monomio (primero (*-monomio m p)) + (resto (*-monomio m p)))) + :hints (("Goal" + :in-theory (disable |ordenadop p => ordenadop m *M p|) + :use |ordenadop p => ordenadop m *M p|))) + +(defthm + |m >-monomio (append p1 p2)| + (implies (and (>-monomio m p1) + (>-monomio m p2)) + (>-monomio m (append p1 p2)))) + +(defthm + |termino (primero (*-monomio n p)) FUTER::< termino (primero (*-monomio m p))| + (implies (and (monomiop (double-rewrite m)) + (monomiop (double-rewrite n)) + (FUMON::< n m) + (polinomiop (double-rewrite p)) + (not (nulop p))) + (FUTER::< (termino (primero (*-monomio n p))) + (termino (primero (*-monomio m p)))))) + +(defthm + |m FUMON::> n and n >-monomio p => m >-monomio p| + (implies (and (FUMON::< n m) + (>-monomio n p)) + (>-monomio m p))) + +(defthm + |primero (m *M p) >- monomio append (resto m *M p)(n *m p)| + (implies (and (monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (not (FUMON::nulop n)) + (FUMON::< n m) + (ordenadop (double-rewrite p))) + (>-monomio (primero (*-monomio m p)) + (append (resto (*-monomio m p)) + (*-monomio n p)))) + :hints + (("Goal" + :in-theory + (disable + |m >-monomio (append p1 p2)| + |termino (primero (*-monomio n p)) FUTER::< termino (primero (*-monomio m p))|) + :use + (|termino (primero (*-monomio n p)) FUTER::< termino (primero (*-monomio m p))| + (:instance + |m >-monomio (append p1 p2)| + (m (primero (*-monomio m p))) + (p1 (resto (*-monomio m p))) + (p2 (*-monomio n p))))))) + +(defthm + |primero append (m *M p)(n *M p) >- monomio resto append ( m *M p)(n *m p)| + (implies (and (monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (not (FUMON::nulop n)) + (FUMON::< n m) + (ordenadop (double-rewrite p))) + (>-monomio (primero (append (*-monomio m p) + (*-monomio n p))) + (resto (append (*-monomio m p) + (*-monomio n p))))) + :hints (("Goal" + :in-theory (disable + |primero (m *M p) >- monomio append (resto m *M p)(n *m p)|) + :use |primero (m *M p) >- monomio append (resto m *M p)(n *m p)|))) + +(defthm + |primero (m *M p2) >-monomio append (resto m *M p2) p1| + (implies (and (not (FUMON::nulop m)) + (>-monomio (primero p1)(resto p1)) + (FUMON::< (primero p1)(primero (*-monomio m p2))) + (ordenadop (double-rewrite p2))) + (>-monomio (primero (*-monomio m p2)) + (append (resto (*-monomio m p2)) + p1)))) + +(defthm + |primero (append (m *M p2) p1) >-monomio resto (append (m *M p2) p1)| + (implies (and (not (FUMON::nulop m)) + (>-monomio (primero p1)(resto p1)) + (FUMON::< (primero p1)(primero (*-monomio m p2))) + (ordenadop (double-rewrite p2))) + (>-monomio (primero (append (*-monomio m p2) + p1)) + (resto (append (*-monomio m p2) + p1)))) + :hints (("Goal" + :in-theory (disable + |primero (m *M p2) >-monomio append (resto m *M p2) p1|) + :use |primero (m *M p2) >-monomio append (resto m *M p2) p1|))) + +(defthm + |primero (* p1 p2) >-monomio resto (* p1 p2)-lemma| + (implies (and (>-monomio (primero (* (resto p1) p2)) + (resto (* (resto p1) p2))) + (not (FUMON::nulop (primero p1))) + (FUMON::< (primero (resto p1))(primero p1)) + (ordenadop (double-rewrite p2))) + (>-monomio (car (append (*-monomio (primero p1) p2) + (* (resto p1) p2))) + (cdr (append (*-monomio (primero p1) p2) + (* (resto p1) p2))))) + :hints (("Goal" + :in-theory + (disable + |primero (append (m *M p2) p1) >-monomio resto (append (m *M p2) p1)| + |primero (p1 * p2) =e (primero p1) FUMON::* (primero p2)|) + :use + ((:instance + |primero (append (m *M p2) p1) >-monomio resto (append (m *M p2) p1)| + (m (car p1)) + (p1 (* (CDR P1) P2))) + (:instance + |primero (p1 * p2) =e (primero p1) FUMON::* (primero p2)| + (p1 (cdr p1))))))) + +(defthm + |primero (* p1 p2) >-monomio resto (* p1 p2)| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2))) + (>-monomio (primero (* p1 p2))(resto (* p1 p2))))) + +(defthm + |primero fn (p1 * p2) =e primero (p1 * p2)| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2)) + (not (nulop p1)) + (not (nulop p2))) + (equal (primero (fn (* p1 p2)))(primero (* p1 p2))))) + +(defthm + |primero fn (p1 * p2) != 0| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2)) + (not (nulop p1)) + (not (nulop p2))) + (not (FUMON::nulop (primero (fn (* p1 p2)))))) + :hints (("Goal" + :in-theory (disable |primero (p1 * p2) != 0|) + :use |primero (p1 * p2) != 0|))) + +(defthm + |p1 != 0 and p2 != 0 => fn(p1 * p2) != 0| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2)) + (not (nulop p1)) + (not (nulop p2))) + (not (nulop (fn (* p1 p2))))) + :hints (("Goal" + :in-theory + (e/d (coeficiente monomiop) + (|primero fn (p1 * p2) != 0| + |primero fn (p1 * p2) =e primero (p1 * p2)| + |(primero p) >-monomio (resto p) => primero (fn p) =e primero p|)) + :use |primero fn (p1 * p2) != 0|))) + +(defthm + |nulop fn(p1 * p2) <=> nulop p1 or nulop p2| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2))) + (equal (nulop (fn (* p1 p2))) + (or (nulop p1) + (nulop p2)))) + :hints (("Subgoal 3" + :in-theory (disable |p1 != 0 and p2 != 0 => fn(p1 * p2) != 0|) + :use |p1 != 0 and p2 != 0 => fn(p1 * p2) != 0|))) + +(defthm + |fn(p1 * p2) = 0 <=> p1 = 0 or p2 = 0| + (implies (and (ordenadop (double-rewrite p1)) + (ordenadop (double-rewrite p2))) + (equal (equal (fn (* p1 p2))(nulo)) + (or (equal p1 (nulo)) + (equal p2 (nulo))))) + :hints (("Subgoal 3" + :in-theory (disable |p1 != 0 and p2 != 0 => fn(p1 * p2) != 0|) + :use |p1 != 0 and p2 != 0 => fn(p1 * p2) != 0|))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.acl2 new file mode 100644 index 0000000..df6a7b5 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.acl2 @@ -0,0 +1,30 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(defpkg "FUNPOL" + (set-difference-eq *import-symbols* + '(rem))) + +(certify-book "fuquot-rem" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.lisp new file mode 100644 index 0000000..472c729 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.lisp @@ -0,0 +1,3810 @@ +; ACL2 Univariate Polynomials over a Field books -- Polynomial Quotients +; and Remainders +;; Quotients, Remainders, Degrees, and Leading Coefficients +;; of Normalized Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; John Cowles +;; Department of Computer Science +;; University of Wyoming +;; Laramie, WY 82071-3682 U.S.A. + +;; Last modified July 2006 (for ACL2 Version 3.0). + +; Modified by Matt Kaufmann for ACL2 Version 3.1 because +; SBCL complains about LISP::. + +#| +To certify this book, first, create a world with the following package: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(defpkg "FUNPOL" + (set-difference-eq *import-symbols* + '(rem))) + +(certify-book "fuquot-rem" + 6 + nil ;;compile-flg + ) +|# +(in-package "FUNPOL") + +(include-book "fupolinomio-normalizado" + :load-compiled-file nil) + +(defun + deg (p) + (FUMON::termino (primero p))) + +(defthm + Natp-deg + (implies (and (polinomiop p) + (not (= p (nulo)))) + (and (integerp (deg p)) + (>= (deg p) 0))) + :rule-classes :type-prescription + :hints (("Goal" + :in-theory (enable nulo FUTER::terminop)))) + +(defthm + =-implies-equal-deg-a + (implies (and (= (double-rewrite p1) + (double-rewrite p2)) + (polinomiop (double-rewrite p1))) + (equal (equal (deg p1) + (deg p2)) + t)) + :hints (("Goal" + :in-theory (enable = FUMON::=)))) + +(defthm + =-implies-equal-deg-b + (implies (and (= (double-rewrite p1) + (double-rewrite p2)) + (polinomiop (double-rewrite p2))) + (equal (equal (deg p1) + (deg p2)) + t)) + :hints (("Goal" + :in-theory (enable = FUMON::=)))) + +(defthm + |primero (p1 * p2) =e (primero p1) FUMON::* (primero p2)| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2)) + (not (nulop p1)) + (not (nulop p2))) + (equal (primero (* p1 p2)) + (FUMON::* (primero p1)(primero p2)))) + :hints (("Goal" + :in-theory (enable *)))) + +(defthm + |FUMON::termino (* m1 m2) =e FUMON::termino m1 ACL2::+ FUMON::termino m2| + (equal (FUMON::termino (FUMON::* m1 m2)) + (ACL2::+ (FUMON::termino m1) + (FUMON::termino m2))) + :hints (("Goal" + :in-theory (enable FUTER::*)))) + +(defthm + |deg (p1 * p2) =e deg p1 ACL2::+ deg p2| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p1) (nulo))) + (not (= (double-rewrite p2) (nulo)))) + (equal (deg (* p1 p2)) + (ACL2::+ (deg p1) + (deg p2)))) + :hints (("Goal" + :in-theory (enable nulo)))) + +(defthm + |deg p1 <= deg (p1 * p2)| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1) (nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2) (nulo)))) + (<= (deg p1)(deg (* p1 p2)))) + :rule-classes :linear + :hints (("Goal" + :in-theory (disable deg)))) + +(defthm + |deg p2 <= deg (p1 * p2)| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1) (nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2) (nulo)))) + (<= (deg p2)(deg (* p1 p2)))) + :rule-classes :linear + :hints (("Goal" + :in-theory (disable deg)))) + +(defun + lc (p) + (FUMON::coeficiente (primero p))) + +(defthm + |FLD::fdp (lc p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (and (FLD::fdp (lc p)) + (not (FLD::= (lc p)(FLD::0_f))))) + :hints (("Goal" + :in-theory (enable nulo)))) + +(defthm + |primero -p FUMON::= FUMON::- primero p| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p) (nulo)))) + (FUMON::= (primero (- p))(FUMON::- (primero p)))) + :hints (("Goal" + :in-theory (enable nulo - FUPOL::+M)))) + +(defthm + |resto -p = - resto p| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p) (nulo)))) + (= (resto (- p))(- (resto p)))) + :hints (("Goal" + :in-theory (enable nulo -)))) + +(defthm + |nil + p = p| + (implies (polinomiop (double-rewrite p)) + (= (+ nil p) p)) + :hints (("Goal" + :in-theory (e/d (nulo)(|0 + p = p|)) + :use |0 + p = p|))) + +(defthm + |FUMON::termino (- m) =e FUMON::termino m| + (implies (FUMON::monomiop (double-rewrite m)) + (equal (FUMON::termino (FUMON::- m)) + (FUMON::termino m)))) + +(defthm + |FUMON::monomiop (primero p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (FUMON::monomiop (primero p))) + :hints (("Goal" + :in-theory (enable nulo)))) + +(defthm + |not FUMON::nulop (primero p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (not (FUMON::nulop (primero p)))) + :hints (("Goal" + :in-theory (enable nulo)))) + +(defthm + |FUMON::termino (primero (- p)) =e FUMON::termino FUMON::- (primero p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (equal (FUMON::termino (primero (- p))) + (FUMON::termino (FUMON::- (primero p))))) + :hints (("Goal" + :in-theory (disable FUMON::- + |FUMON::termino (- m) =e FUMON::termino m|)))) + +(defthm + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (equal (FUMON::termino (FUMON::- (primero p))) + (FUMON::termino (primero p)))) + :hints (("Goal" + :in-theory (disable |FUMON::termino (- m) =e FUMON::termino m|) + :use (:instance + |FUMON::termino (- m) =e FUMON::termino m| + (m (primero p)))))) + +(defthm + |deg (- p) =e deg p| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (equal (deg (- p)) + (deg p))) + :hints (("Goal" + :in-theory + (disable + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)|) + :use + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)|))) + +(defthm + |primero p FUPOL::+-monomio resto p =e p| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (equal (FUPOL::+-monomio (primero p)(resto p)) p))) + +(defthm + |- nil =e nil| + (equal (- nil) nil) + :hints (("Goal" + :in-theory (e/d (nulo) + (|- 0 =e 0|)) + :use |- 0 =e 0|))) + +(defthm + |- p =e FUPOL::- p| + (implies (polinomiop (double-rewrite p)) + (equal (- p)(FUPOL::- p))) + :hints (("Goal" + :in-theory (enable -)))) + +(defthm + |- (m +Mo p) = (- m) +Mo (- p)| + (implies (and (FUMON::monomiop (double-rewrite m)) + (polinomiop (double-rewrite p))) + (= (- (FUPOL::+-monomio m p)) + (FUPOL::+-monomio (FUMON::- m)(- p)))) + :hints (("Goal" + :in-theory (e/d (=) + (FUPOL::|- (m +Mo p) =P (- m) +Mo (- p)|)) + :use (:instance + FUPOL::|- (m +Mo p) =P (- m) +Mo (- p)| + (FUPOL::m m) + (FUPOL::p p))))) + +(in-theory (disable |- p =e FUPOL::- p|)) + +(defthm + |p + q FUPOL::=P mp(p) +Mo (resto(p) + q)-lemma| + (implies (and (polinomiop (double-rewrite p)) + (FUMON::monomiop (double-rewrite m))) + (FUPOL::=p (FUPOL::+-monomio m (FUPOL::fn (FUPOL::+ nil p))) + (FUPOL::+-monomio m p)))) + +(defthm + |p + q = mp(p) +Mo (resto(p) + q)-lemma-a| + (implies (and (polinomiop p) + (not (= p (nulo))) + (polinomiop q)) + (= (+ p q) (FUPOL::+-monomio (primero p)(+ (resto p) q)))) + :rule-classes nil + :hints (("Goal" + :in-theory (enable + =) + :do-not '(generalize)))) + +(defthm + |p + q = mp(p) +Mo (resto(p) + q)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q))) + (= (+ p q) (FUPOL::+-monomio (primero p)(+ (resto p) q)))) + :hints (("Goal" + :use |p + q = mp(p) +Mo (resto(p) + q)-lemma-a|))) + +(defthm + |=-implies-=-FUPOL::+-monomio-2a| + (implies (and (= (double-rewrite p1) + (double-rewrite p2)) + (polinomiop (double-rewrite p1))) + (equal (= (FUPOL::+-monomio m p1) + (FUPOL::+-monomio m p2)) + t)) + :hints (("Goal" + :in-theory (enable =)))) + +(defthm + |=-implies-=-FUPOL::+-monomio-2b| + (implies (and (= (double-rewrite p1) + (double-rewrite p2)) + (polinomiop (double-rewrite p2))) + (equal (= (FUPOL::+-monomio m p1) + (FUPOL::+-monomio m p2)) + t)) + :hints (("Goal" + :in-theory (enable =)))) + +(defthm + |q + p = mp(q) +Mo (resto(q) + p)| + (implies (and (polinomiop q) + (not (= q (nulo))) + (polinomiop p)) + (= (+ q p) (FUPOL::+-monomio (primero q)(+ (resto q) p)))) + :rule-classes nil) + +(defthm + |p + q = mp(q) +Mo (p + (resto(q))| + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo)))) + (= (+ p q) (FUPOL::+-monomio (primero q)(+ p (resto q))))) + :hints (("Goal" + :use |q + p = mp(q) +Mo (resto(q) + p)|))) + +(defthm + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo)))) + (= (+ p q) + (FUPOL::+-monomio (primero p) + (FUPOL::+-monomio (primero q) + (+ (resto p) + (resto q)))))) + :hints (("Goal" + :in-theory (disable |p + q = mp(p) +Mo (resto(p) + q)|) + :use |p + q = mp(p) +Mo (resto(p) + q)|))) + +(defthm + |FUMON::coeficiente (- m) FLD::= FLD::- (FUMON::coeficiente m)| + (implies (FUMON::monomiop (double-rewrite m)) + (FLD::= (FUMON::coeficiente (FUMON::- m)) + (FLD::- (FUMON::coeficiente m))))) + +(defthm + |coeficiente (- (primero p)) FLD::= FLD::- (coeficiente (primero p))| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo)))) + (FLD::= (FUMON::coeficiente (FUMON::- (primero p))) + (FLD::- (FUMON::coeficiente (primero p))))) + :hints (("Goal" + :in-theory + (disable |FUMON::coeficiente (- m) FLD::= FLD::- (FUMON::coeficiente m)|) + :use (:instance + |FUMON::coeficiente (- m) FLD::= FLD::- (FUMON::coeficiente m)| + (m (primero p)))))) + +(defthm + |coeficiente (primero p)) + coeficiente (primero q) = 0| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (FLD::= (FLD::+ (FUMON::coeficiente (primero p)) + (FUMON::coeficiente (primero q))) + (FLD::0_f))) + :hints + (("Goal" + :in-theory + (e/d + (nulo) + (|coeficiente (- (primero p)) FLD::= FLD::- (coeficiente (primero p))|)) + :use |coeficiente (- (primero p)) FLD::= FLD::- (coeficiente (primero p))|))) + +(defthm + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-1| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (= (FUPOL::+-monomio + (FUMON::monomio (FUMON::coeficiente (primero p)) + (FUMON::termino (primero p))) + (FUPOL::+-monomio (FUMON::monomio (FUMON::coeficiente (car q)) + (FUMON::termino (car p))) + (+ (resto p)(resto q)))) + (+ (resto p)(resto q)))) + :hints (("Goal" + :in-theory (e/d (=)(FUPOL::|(a + b) = 0 => a +Mo (b +Mo p) =P p|)) + :use (:instance + FUPOL::|(a + b) = 0 => a +Mo (b +Mo p) =P p| + (FUPOL::p (+ (resto p)(resto q))) + (FUPOL::a (FUMON::coeficiente (primero p))) + (FUPOL::b (FUMON::coeficiente (primero q))) + (FUPOL::te (FUMON::termino (primero p))))))) + +(defthm + Lemma-a + (implies (and (polinomiop q) + (not (= q (nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (equal (FUMON::termino (FUMON::- (primero p))) + (FUMON::termino (primero q)))) + :rule-classes nil) + +(defthm + Lemma-b + (implies (and (polinomiop p) + (not (= p (nulo))) + (polinomiop q) + (not (= q (nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + :rule-classes nil + :hints (("Goal" + :in-theory + (disable + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)|) + :use (|FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)| + Lemma-a)))) + +(defthm + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-2| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (= (FUPOL::+-monomio + (FUMON::monomio (FUMON::coeficiente (primero p)) + (FUMON::termino (primero p))) + (FUPOL::+-monomio (FUMON::monomio (FUMON::coeficiente (primero q)) + (FUMON::termino (primero q))) + (+ (resto p)(resto q)))) + (+ (resto p)(resto q)))) + :hints (("Goal" + :in-theory (disable |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-1| + FUPOL::ordenadop) + :use (|(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-1| + Lemma-b)))) + +(defthm + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (= (FUPOL::+-monomio (primero p) + (FUPOL::+-monomio (primero q) + (+ (resto p) + (resto q)))) + (+ (resto p)(resto q)))) + :hints (("Goal" + :in-theory (disable |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-2| + FUPOL::ordenadop) + :use |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-2|))) + +;;Bad rewrite rule: +(defthm + |p + q = (resto p) + (resto q)| + (implies (and (polinomiop p) + (not (= p (nulo))) + (polinomiop q) + (not (= q (nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q))) + (= (+ p q)(+ (resto p)(resto q)))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable FUPOL::ordenadop)))) + +;;Bad rewrite rule: +(defthm + |p + q = (resto p) + (resto q)-a| + (implies (and (polinomiop p) + (not (= p (nulo))) + (polinomiop q) + (not (= q (nulo))) + (FUMON::= (primero p) + (FUMON::- (primero q)))) + (= (+ p q)(+ (resto p)(resto q)))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |p + q = mp(q) +Mo (p + (resto(q))| + |p + q = mp(p) +Mo (resto(p) + q)| + FUPOL::ordenadop) + :use (:instance + |p + q = (resto p) + (resto q)| + (p q)(q p))))) + +(defthm + |deg(p + q) =_e deg(p)-lemma-1| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUTER::< (FUMON::termino (primero q)) + (FUMON::termino (primero p)))) + (FUPOL::>-monomio (primero (FUPOL::+ p q))(resto (FUPOL::+ p q)))) + :hints (("Goal" + :in-theory (enable FUPOL::+)))) + +(defthm + |deg(p + q) =_e deg(p)-lemma-2| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUTER::< (FUMON::termino (primero q)) + (FUMON::termino (primero p)))) + (equal (primero (FUPOL::fn (FUPOL::+ p q))) + (primero (FUPOL::+ p q)))) + :hints + (("Goal" + :in-theory + (e/d (nulo) + (FUPOL::|(primero p) >-monomio (resto p) => primero (fn p) =e primero p|)) + :use (:instance + FUPOL::|(primero p) >-monomio (resto p) => primero (fn p) =e primero p| + (FUPOL::p (FUPOL::+ p q)))))) + +(defthm + |deg(p + q) =_e deg(p)-lemma-3| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p) (nulo)))) + (equal (primero (FUPOL::+ p q)) + (primero p))) + :hints (("Goal" + :in-theory (enable FUPOL::+ nulo)))) + +(defthm + |deg(p + q) =_e deg(p)-lema-4| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (FUTER::< (FUMON::termino (primero q)) + (FUMON::termino (primero p)))) + (equal (primero (+ p q)) + (primero p))) + :hints (("Goal" + :in-theory (enable +)))) + +(defthm + |deg(p + q) =_e deg(p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (> (deg p) (deg q))) + (equal (deg (+ p q)) + (deg p))) + :hints (("Goal" + :in-theory (enable FUTER::<)))) + +(defthm + |=-refines-FUPOL::=P| + (implies (= p1 p2) + (FUPOL::=P p1 p2)) + :rule-classes :refinement + :hints (("Goal" + :in-theory (enable =)))) + +(defthm + |FUPOL::=P-refines-=| + (implies (FUPOL::=P p1 p2) + (= p1 p2)) + :rule-classes :refinement + :hints (("Goal" + :in-theory (enable =)))) + +(defthm + |deg(p + q) =_e deg(q)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (ACL2::< (deg p)(deg q))) + (equal (deg (+ p q)) + (deg q))) + :hints (("Goal" + :in-theory (disable =-implies-equal-deg-a + =-implies-equal-deg-b + |deg(p + q) =_e deg(p)|) + :use ((:instance + =-implies-equal-deg-a + (p1 (+ p q)) + (p2 (+ q p))) + (:instance + |deg(p + q) =_e deg(p)| + (p q)(q p)))))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-1| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + (FUPOL::>-monomio (primero p) + (append (resto p)(resto q))))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-2| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (not (= (+ (resto p)(resto q))(nulo))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + (FUPOL::>-monomio (primero p) + (FUPOL::+ (resto p)(resto q)))) + :hints (("Goal" + :in-theory (enable FUPOL::+)))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-3| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (not (= (+ (resto p)(resto q))(nulo))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + (FUPOL::>-monomio (primero p) + (FUPOL::fn (FUPOL::+ (resto p)(resto q))))) + :hints (("Goal" + :in-theory (disable FUPOL::ordenadop)))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-4| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (not (= (+ (resto p)(resto q))(nulo))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + (FUPOL::>-monomio (primero p) + (+ (resto p)(resto q)))) + :hints (("Goal" + :in-theory (e/d (+)(FUPOL::ordenadop))))) + +;; (defthm +;; |deg(p + q) ACL2::< deg(p)-lemma-5| +;; (implies (and (polinomiop p) +;; (not (= p (nulo))) +;; (FUPOL::>-monomio m p)) +;; (FUTER::< (FUMON::termino (primero p)) +;; (FUMON::termino m))) +;; :hints (("Goal" +;; :in-theory (enable nulo)))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-5| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (FUPOL::>-monomio m p)) + (FUTER::< (FUMON::termino (primero p)) + (FUMON::termino m))) + :hints (("Goal" + :in-theory (enable nulo)))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-6| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (not (= (+ (resto p)(resto q))(nulo))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + (FUTER::< (FUMON::termino (primero (+ (resto p)(resto q)))) + (FUMON::termino (primero p)))) + :hints (("Goal" + :in-theory (e/d (nulo) + (FUPOL::ordenadop))))) + +(defthm + |deg(p + q) ACL2::< deg(p)-lemma-7| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q)(nulo))) + (not (= (+ (resto p)(resto q))(nulo))) + (equal (FUMON::termino (primero p)) + (FUMON::termino (primero q)))) + (ACL2::< (deg (+ (resto p)(resto q))) + (deg p))) + :hints (("Goal" + :in-theory (e/d (FUTER::<) + (|deg(p + q) ACL2::< deg(p)-lemma-6|)) + :use |deg(p + q) ACL2::< deg(p)-lemma-6|))) + +(defthm + |deg(p + q) ACL2::< deg(p)| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q) (nulo))) + (FUMON::= (FUMON::- (primero p)) + (primero q)) + (not (= (+ (double-rewrite p) + (double-rewrite q)) + (nulo)))) + (ACL2::< (deg (+ p q)) + (deg p))) + :rule-classes (:rewrite + :linear) + :hints (("Goal" + :in-theory + (e/d (FUMON::=) + (=-implies-equal-deg-a + =-implies-equal-deg-b + |deg(p + q) ACL2::< deg(p)-lemma-7| + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)| + FUPOL::ordenadop)) + :use (|p + q = (resto p) + (resto q)| + (:instance + =-implies-equal-deg-a + (p1 (+ p q))(p2 (+ (resto p)(resto q)))) + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)| + |deg(p + q) ACL2::< deg(p)-lemma-7|)))) + +(defthm + |deg(p + q) ACL2::< deg(p)-a| + (implies (and (polinomiop (double-rewrite p)) + (not (= (double-rewrite p)(nulo))) + (polinomiop (double-rewrite q)) + (not (= (double-rewrite q) (nulo))) + (FUMON::= (primero p) + (FUMON::- (primero q))) + (not (= (+ (double-rewrite p) + (double-rewrite q)) + (nulo)))) + (ACL2::< (deg (+ p q)) + (deg p))) + :rule-classes (:rewrite + :linear) + :hints + (("Goal" + :in-theory + (disable |deg(p + q) ACL2::< deg(p)| + FUMON::nulop + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |p + q = mp(q) +Mo (p + (resto(q))| + |p + q = mp(p) +Mo (resto(p) + q)| + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)| + FUMON::=-implies-equal-termino-1 + FUMON::=-implies-equal-termino-2 + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use ((:instance + |deg(p + q) ACL2::< deg(p)| + (p q)(q p)) + (:instance + |FUMON::termino (FUMON::- (primero p) =e FUMON::termino (primero p)| + (p q)) + (:instance + FUMON::=-implies-equal-termino-1 + (FUMON::y1 (primero p)) + (FUMON::y2 (FUMON::- (primero q)))) + (:instance + =-implies-equal-deg-a + (p1 (+ p q)) + (p2 (+ q p))))))) + +(defthm + |not FUMON::nulop m| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (not (FUMON::nulop (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2)))))) + :hints (("Goal" + :in-theory (enable nulo FUTER::terminop)))) + +(defthm + |m FUPOL::*-monomio p2 != 0| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop p2) + (not (= p2 (nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (not (= (FUPOL::*-monomio m p2) + (nulo))))) + :hints (("Goal" + :in-theory (enable FUTER::* FUTER::terminop + FUMON::* FUMON::monomiop FUMON::monomio + FUMON::coeficiente FUMON::termino + FUPOL::+M =)))) + +(defthm + |polinomiop (m FUPOL::*-monomio p2)| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop p2) + (not (= p2 (nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (polinomiop (FUPOL::*-monomio m p2)))) + :hints (("Goal" + :in-theory (disable FUPOL::|ordenadop p => ordenadop m *M p| + |not FUMON::nulop m|) + :use (|not FUMON::nulop m| + (:instance + FUPOL::|ordenadop p => ordenadop m *M p| + (FUPOL::p p2) + (FUPOL::m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))))))) + +(defthm + |primero(m FUPOL::*-monomio p2) FUMON::= primero(p1)| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUMON::= (primero (FUPOL::*-monomio m p2)) + (primero p1)))) + :hints (("Goal" + :in-theory (enable FUTER::* FUTER::terminop + FUMON::* FUMON::monomiop FUMON::monomio + FUMON::= FUMON::coeficiente FUMON::termino + FUPOL::+M nulo)))) + +(defthm + |primero (- (m *-monomio p2)) = - (primero (m *-monomio p2))| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUMON::= (primero (- (FUPOL::*-monomio m p2))) + (FUMON::- (primero (FUPOL::*-monomio m p2)))))) + :hints (("Goal" + :in-theory (disable |primero -p FUMON::= FUMON::- primero p| + |polinomiop (m FUPOL::*-monomio p2)| + |m FUPOL::*-monomio p2 != 0|) + :use ((:instance + |primero -p FUMON::= FUMON::- primero p| + (p (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUPOL::*-monomio m p2)))) + |polinomiop (m FUPOL::*-monomio p2)| + |m FUPOL::*-monomio p2 != 0|)))) + +(defthm + |FUMON::- (FUMON::- m) FUMON::= m| + (implies (FUMON::monomiop (double-rewrite m)) + (FUMON::= (FUMON::- (FUMON::- m)) + m))) + +(defthm + |FUMON::- (primero (- (m *-monomio p2))) = (primero (m *-monomio p2))| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUMON::= (FUMON::- (primero (- (FUPOL::*-monomio m p2)))) + (primero (FUPOL::*-monomio m p2))))) + :hints (("Goal" + :in-theory + (disable |primero (- (m *-monomio p2)) = - (primero (m *-monomio p2))| + FUMON::=-implies-=_- + FUMON::-) + :use (|primero (- (m *-monomio p2)) = - (primero (m *-monomio p2))| + (:instance + FUMON::=-implies-=_- + (FUMON::m1 (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (primero (- (FUPOL::*-monomio m p2))))) + (FUMON::m2 (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUMON::- (primero (FUPOL::*-monomio m p2))))) + ))))) + +(defthm + |FUMON::- (primero (- (m *-monomio p2))) FUMON::= primero p1| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUMON::= (FUMON::- (primero (- (FUPOL::*-monomio m p2)))) + (primero p1)))) + :hints (("Goal" + :in-theory + (disable + |FUMON::- (primero (- (m *-monomio p2))) = (primero (m *-monomio p2))| + |primero(m FUPOL::*-monomio p2) FUMON::= primero(p1)|) + :use + (|FUMON::- (primero (- (m *-monomio p2))) = (primero (m *-monomio p2))| + |primero(m FUPOL::*-monomio p2) FUMON::= primero(p1)|)))) + +(defthm + |FUPOL::- p != 0| + (implies (and (polinomiop p) + (not (= p (nulo)))) + (not (= (FUPOL::- p)(nulo)))) + :hints (("Goal" + :in-theory (enable =)))) + +(defthm + |- p != 0| + (implies (and (polinomiop p) + (not (= p (nulo)))) + (not (= (- p)(nulo)))) + :hints (("Goal" + :in-theory (enable |- p =e FUPOL::- p|)))) + +(defthm + |- (m FUPOL::*-monomio p2) != 0| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop p2) + (not (= p2 (nulo))) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (not (= (- (FUPOL::*-monomio m p2)) + (nulo))))) + :hints (("Goal" + :in-theory (disable |m FUPOL::*-monomio p2 != 0| + |polinomiop (m FUPOL::*-monomio p2)|) + :use (|m FUPOL::*-monomio p2 != 0| + |polinomiop (m FUPOL::*-monomio p2)|)))) + +(defthm + |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1| + (implies (and (polinomiop (double-rewrite p1)) + (not (= (double-rewrite p1)(nulo))) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (ACL2::>= (deg p1) + (deg p2)) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (not (= (+ p1 (- (FUPOL::*-monomio m p2))) + (nulo))))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (ACL2::< (deg (+ p1 (- (FUPOL::*-monomio m p2)))) + (deg p1)))) + :hints (("Goal" + :in-theory (disable deg lc + FUMON::- FUPOL::ordenadop + |deg(p + q) ACL2::< deg(p)| + |deg(p + q) ACL2::< deg(p)-a|) + :use ((:instance + |deg(p + q) ACL2::< deg(p)-a| + (p p1)(q (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (- (FUPOL::*-monomio m p2))))))))) + +(defun + quot (p1 p2) + (declare (xargs :measure (if (and (polinomiop p1) + (not (= p1 (nulo)))) + (ACL2::+ 1 (deg p1)) + 0) + :hints (("Goal" + :in-theory (disable deg lc)) + ("Subgoal 1.1" + :in-theory + (disable + |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1|) + :use + |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1| + )))) + (if (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (polinomiop p1) + (polinomiop p2) + (ACL2::>= (deg p1) + (deg p2))) + (let ((m (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))))) + (FUPOL::+-monomio m + (quot (+ p1 (- (FUPOL::*-monomio m p2))) + p2))) + (nulo))) + +(defthm + |~(polinomiop p1) => quot(p1 p2) =e 0| + (implies (not (polinomiop (double-rewrite p1))) + (equal (quot p1 p2) + (nulo)))) + +(defthm + |~(polinomiop p2) => quot(p1 p2) =e 0| + (implies (not (polinomiop (double-rewrite p2))) + (equal (quot p1 p2) + (nulo)))) + +(defthm + |deg p1 < deq p2 => quot(p1 p2) =e 0| + (implies (ACL2::< (deg p1) + (deg p2)) + (equal (quot p1 p2) + (nulo)))) + +(defthm + |(p = 0) =e (p =e nil)| + (equal (= p (nulo)) + (equal p nil)) + :hints (("Goal" + :in-theory (enable = nulo)))) + +(defthm + |p1 = 0 => quot(p1 p2) =e 0| + (implies (= (double-rewrite p1)(nulo)) + (equal (quot p1 p2) + (nulo)))) + +(defthm + |p2 = 0 => quot(p1 p2) =e 0| + (implies (= (double-rewrite p2)(nulo)) + (equal (quot p1 p2) + (nulo)))) + +(in-theory (disable |(p = 0) =e (p =e nil)|)) + +(defthm + Polinomiop-quot + (polinomiop (quot p1 p2)) + :hints (("Goal" + :in-theory (disable deg lc)))) + +(defun + quot-induct-hint (p1 p2 p) + (declare (xargs :measure (if (and (polinomiop p1) + (not (= p1 (nulo)))) + (ACL2::+ 1 (deg p1)) + 0) + :hints (("Goal" + :in-theory (disable deg lc)) + ("Subgoal 1.1" + :in-theory + (disable + |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1|) + :use + (:instance + |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1| + (p2 p)))))) + (if (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (not (= p (nulo))) + (polinomiop p1) + (polinomiop p ) + (ACL2::>= (deg p1)(deg p))) + (let ((m1 (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p))) + (ACL2::- (deg p1) + (deg p)))) + (m2 (FUMON::monomio (FLD::* (lc p2) + (FLD::/ (lc p))) + (ACL2::- (deg p2) + (deg p))))) + (quot-induct-hint (+ p1 (- (FUPOL::*-monomio m1 p))) + (+ p2 (- (FUPOL::*-monomio m2 p))) + p)) + t)) + +(defthm + =-implies-=-quot-1-lemma-1 + (implies (and (ACL2::< (deg p1) (deg p)) + (= (double-rewrite p1) + (double-rewrite p2))) + (= (quot p2 p)(nulo))) + :hints (("Goal" + :in-theory (disable deg + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use =-implies-equal-deg-b))) + +(defthm + =-implies-=-quot-1-lemma-2 + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (FUPOL::ordenadop p) + (<= (deg p) (deg p1)) + (<= (deg p) (deg p2)) + (equal (deg p1)(deg p2)) + (= p1 p2)) + (FUMON::= (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (enable = FUMON::=)))) + +(defthm + =-implies-=-quot-1-lemma-3 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p) (deg p1)) + (= p1 p2)) + (FUMON::= (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use (=-implies-=-quot-1-lemma-2 + =-implies-equal-deg-a)))) + +(defthm + |FUMON::=-implies-=-FUPOL::*-monomio-1| + (implies (FUMON::= m1 m2) + (= (FUPOL::*-monomio m1 p) + (FUPOL::*-monomio m2 p))) + :rule-classes :congruence) + +(defthm + =-implies-=-quot-1-lemma-4 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p) (deg p1)) + (= p1 p2)) + (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + p))) + (+ p2 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + p))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc) + :use =-implies-=-quot-1-lemma-3))) + +(defthm + =-implies-=-quot-1-lemma-5 + (implies (and (FUMON::= m1 m2) + (= p1 p2) + (polinomiop p1)) + (= (FUPOL::+-monomio m1 p1) + (FUPOL::+-monomio m2 p2))) + :rule-classes nil) + +(defthm + =-implies-=-quot-1-lemma-6 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p) (deg p1)) + (= p1 p2) + (= + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + p))) + p) + (quot + (+ p2 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + p))) + p))) + (= (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + p))) + p)) + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + (quot + (+ p2 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + p))) + p)))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc + |=-implies-=-FUPOL::+-monomio-2a| + |=-implies-=-FUPOL::+-monomio-2b| + FUPOL::|FUMON::=-implies-=P-+-monomio-1| + ) + :use ((:instance + =-implies-=-quot-1-lemma-5 + (m1 (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p))))) + (m2 (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p))))) + (p1 (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + p))) + p)) + (p2 (quot + (+ p2 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + p))) + p))) + =-implies-=-quot-1-lemma-3)))) + +(defthm + =-implies-=-quot-1-lemma-7 + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (polinomiop p1) + (polinomiop p2) + (ACL2::>= (deg p1) + (deg p2))) + (equal (quot p1 p2) + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))) + (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::- (deg p1) + (deg p2))) + p2))) + p2)))) + :rule-classes nil + :hints (("Goal" + :in-theory (e/d (nulo) + (deg lc (:definition quot))) + :use (:definition quot)))) + +(defthm + =-implies-=-quot-1-lemma-8 + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (FUPOL::ordenadop p) + (<= (deg p) (deg p1)) + (<= (deg p) (deg p2)) + (= p1 p2) + (= + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + p))) + p) + (quot + (+ p2 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + p))) + p))) + (= (quot p1 p) + (quot p2 p))) + :rule-classes nil + :hints (("Goal" + :in-theory (e/d (nulo) + (deg lc (:definition quot))) + :use (=-implies-=-quot-1-lemma-6 + (:instance + =-implies-=-quot-1-lemma-7 + (p2 p)) + (:instance + =-implies-=-quot-1-lemma-7 + (p1 p2) + (p2 p)))))) + +(defthm + =-implies-=-quot-1-lemma-9 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p) (deg p1)) + (= p1 p2) + (= + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p))) + (ACL2::+ (deg p1) + (ACL2::- (deg p)))) + p))) + p) + (quot + (+ p2 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p2) (FLD::/ (lc p))) + (ACL2::+ (deg p2) + (ACL2::- (deg p)))) + p))) + p))) + (= (quot p1 p)(quot p2 p))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUPOL::+-monomio + quot FUPOL::ordenadop + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use (=-implies-=-quot-1-lemma-8 + =-implies-equal-deg-a)))) + +(defthm + =-implies-=-quot-1 + (implies (= p1 p2) + (= (quot p1 p) + (quot p2 p))) + :rule-classes :congruence + :hints (("Goal" + :in-theory (disable deg lc) + :induct (quot-induct-hint p1 p2 p)) + ("Subgoal *1/1" + :use (=-implies-=-quot-1-lemma-4 + =-implies-=-quot-1-lemma-9)))) + +(defthm + =-implies-=-quot-2-lemma-1 + (implies (and (ACL2::< (deg p)(deg p1)) + (= (double-rewrite p1) + (double-rewrite p2))) + (= (quot p p2)(nulo))) + :hints (("Goal" + :in-theory (disable deg + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use =-implies-equal-deg-b))) + +(defthm + =-implies-=-quot-2-lemma-2 + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (FUPOL::ordenadop p) + (<= (deg p1)(deg p)) + (<= (deg p2)(deg p)) + (equal (deg p1)(deg p2)) + (= p1 p2)) + (FUMON::= (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (enable = FUMON::=)))) + +(defthm + =-implies-=-quot-2-lemma-3 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p1)(deg p)) + (= p1 p2)) + (FUMON::= (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use (=-implies-=-quot-2-lemma-2 + =-implies-equal-deg-a)))) + +(defthm + =-implies-=-quot-2-lemma-4 + (implies (and (FUMON::= m1 m2) + (= p1 p2)) + (= (quot (+ p (- (FUPOL::*-monomio m1 p1))) + p2) + (quot (+ p (- (FUPOL::*-monomio m2 p2))) + p2))) + :rule-classes nil) + +(defthm + =-implies-=-quot-2-lemma-5 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p1)(deg p)) + (= p1 p2)) + (= (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p2) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))) + p2))) + p2))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc) + :use (=-implies-=-quot-2-lemma-3 + (:instance + =-implies-=-quot-2-lemma-4 + (m1 (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1))))) + (m2 (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))))))))) + +(defthm + =-implies-=-quot-2-lemma-6 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p1)(deg p)) + (= p1 p2) + (= (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p1) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p2))) + (= (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p1) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))) + p2))) + p2))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc) + :use =-implies-=-quot-2-lemma-5))) + +(defthm + =-implies-=-quot-2-lemma-7 + (implies (and (FUMON::= m1 m2) + (= p1 p2) + (polinomiop p1)) + (= (FUPOL::+-monomio m1 p1) + (FUPOL::+-monomio m2 p2))) + :rule-classes nil) + +(defthm + =-implies-=-quot-2-lemma-8 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p1)(deg p)) + (= p1 p2) + (= (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p1) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p2))) + (= (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p1)) + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))) + p2))) + p2)))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc + FUPOL::|FUMON::=-implies-=P-+-monomio-1| + |=-implies-=-FUPOL::+-monomio-2a| + |=-implies-=-FUPOL::+-monomio-2b| + ) + :use (=-implies-=-quot-2-lemma-3 + =-implies-=-quot-2-lemma-6 + (:instance + =-implies-=-quot-2-lemma-7 + (m1 (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1))))) + (m2 (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2))))) + (p1 (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p1)) + (p2 (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p2))) + (ACL2::+ (deg p) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + +(defthm + =-implies-=-quot-2-lemma-9 + (implies (and (not (= p1 (nulo))) + (not (= p (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p) + (<= (deg p1)(deg p)) + (= p1 p2) + (= (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p1) + (quot (+ p + (- + (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p) (FLD::/ (lc p1))) + (ACL2::+ (deg p) + (ACL2::- (deg p1)))) + p1))) + p2))) + (= (quot p p1) + (quot p p2))) + :rule-classes nil + :hints (("Goal" + :in-theory (e/d (nulo) + (deg lc (:definition quot))) + :use (=-implies-=-quot-2-lemma-8 + (:instance + =-implies-=-quot-1-lemma-7 + (p1 p) + (p2 p1)) + (:instance + =-implies-=-quot-1-lemma-7 + (p1 p)))))) + +(defthm + =-implies-=-quot-2 + (implies (= p1 p2) + (= (quot p p1) + (quot p p2))) + :rule-classes :congruence + :hints (("Goal" + :in-theory (disable deg lc)) + ("Subgoal *1/1" + :use =-implies-=-quot-2-lemma-9))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-1| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (equal + (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ + (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + (ACL2::< (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :rule-classes nil + :hints (("Goal" + :in-theory + (disable deg lc + |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1|) + :use |deg (p1 + (- (m FUPOL::*-monomio p2))) ACL2::< deg p1|))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-2| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (> (FUMON::termino m) + (FUMON::termino (primero p)))) + (equal (primero (FUPOL::+-monomio m p)) + m)) + :hints (("Goal" + :in-theory (e/d (FUTER::<) + (FUPOL::|primero p FUMON::< m => >-monomio m p|)) + :use (:instance + FUPOL::|primero p FUMON::< m => >-monomio m p| + (FUPOL::m m) + (FUPOL::p p))))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + (implies (and (not (= (double-rewrite p1)(nulo))) + (not (= (double-rewrite p2)(nulo))) + (FUPOL::ordenadop (double-rewrite p1)) + (FUPOL::ordenadop (double-rewrite p2)) + (<= (deg p2) (deg p1))) + (FUMON::monomiop (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))))) + :hints (("Goal" + :in-theory (enable nulo FUTER::terminop FUMON::monomiop + FUMON::monomio FUMON::termino + FUMON::coeficiente)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + (implies (and (not (= (double-rewrite p1)(nulo))) + (not (= (double-rewrite p2)(nulo))) + (FUPOL::ordenadop (double-rewrite p1)) + (FUPOL::ordenadop (double-rewrite p2)) + (<= (deg p2) (deg p1))) + (not (FUMON::nulop (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))))) + :hints (("Goal" + :in-theory (enable nulo FUTER::terminop FUMON::monomiop + FUMON::monomio FUMON::coeficiente)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + (implies (and (not (= (double-rewrite p1)(nulo))) + (not (= (double-rewrite p2)(nulo))) + (FUPOL::ordenadop (double-rewrite p1)) + (FUPOL::ordenadop (double-rewrite p2)) + (<= (deg p2) (deg p1))) + (equal (FUMON::termino (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :hints (("Goal" + :in-theory (enable nulo FUTER::terminop FUMON::monomiop + FUMON::monomio FUMON::termino + FUMON::coeficiente)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-6| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (equal + (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ + (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + (> (FUMON::termino (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (FUMON::termino + (primero (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + FUMON::monomio-coeficiente-termino + car-cdr-elim + FUPOL::*-monomio + FUPOL::ordenadop + |p + q = mp(p) +Mo (resto(p) + q)| + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |- p != 0| + |p + (- p) = 0| + |p + q = 0 <=> q = - p| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |primero -p FUMON::= FUMON::- primero p| + |resto -p = - resto p| + =-IMPLIES-=-+-2) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-1| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5|)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-7| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (equal + (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ + (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + (equal (primero (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))) + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-2| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4|) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-6| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + (:instance + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-2| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (p (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-8| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (equal + (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ + (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + (equal (deg (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + FUMON::monomio-coeficiente-termino + car-cdr-elim + FUPOL::*-monomio + FUPOL::ordenadop + |p + q = mp(p) +Mo (resto(p) + q)| + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |- p != 0| + |p + (- p) = 0| + |p + q = 0 <=> q = - p| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |primero -p FUMON::= FUMON::- primero p| + |resto -p = - resto p| + =-IMPLIES-=-+-2) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-7|)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-9| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (equal (deg (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :rule-classes nil + :hints (("Goal" + ;;:do-not-induct t + :in-theory (e/d (nulo) + (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + FUMON::monomio-coeficiente-termino + car-cdr-elim + FUPOL::*-monomio + FUPOL::ordenadop + |p + q = mp(p) +Mo (resto(p) + q)| + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |- p != 0| + |p + (- p) = 0| + |p + q = 0 <=> q = - p| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |primero -p FUMON::= FUMON::- primero p| + |resto -p = - resto p|)) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4|)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-10| + (implies (and (not (= p1 nil)) + (not (= p2 nil)) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (equal + (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ + (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + (equal + (deg + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :rule-classes nil + :hints (("Goal" + :in-theory (e/d (nulo) + (deg lc + FUMON::monomio-coeficiente-termino + car-cdr-elim + FUPOL::*-monomio + FUPOL::ordenadop + |p + q = mp(p) +Mo (resto(p) + q)| + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |- p != 0| + |p + (- p) = 0| + |p + q = 0 <=> q = - p| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |primero -p FUMON::= FUMON::- primero p| + |resto -p = - resto p| + =-IMPLIES-=-+-2)) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-8| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-9|)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-11| + (implies (and (not (= p1 nil)) + (not (= p2 nil)) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (ACL2::< + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (equal + (deg + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :rule-classes nil + :hints (("Goal" + :in-theory (e/d (nulo) + (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + FUPOL::|mp(m +M p) = m| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + FUMON::monomio-coeficiente-termino + car-cdr-elim + FUPOL::*-monomio + FUPOL::ordenadop + |p + q = mp(p) +Mo (resto(p) + q)| + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |- p != 0| + |p + (- p) = 0| + |p + q = 0 <=> q = - p| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |primero -p FUMON::= FUMON::- primero p| + |resto -p = - resto p| + =-IMPLIES-=-+-2)) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + (:instance + FUPOL::|mp(m +M p) = m| + (FUPOL::m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (FUPOL::p nil)) + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4|)))) + +(defthm + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)| + (implies (and (not (= (double-rewrite p1)(nulo))) + (not (= (double-rewrite p2)(nulo))) + (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2)) + (ACL2::>= (deg p1) + (deg p2))) + (equal (deg (quot p1 p2)) + (ACL2::- (deg p1) + (deg p2)))) + :hints (("Goal" + :in-theory (e/d (nulo) + (deg lc))) + ("Subgoal *1/4''" + :use |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-10|) + ("Subgoal *1/3''" + :use |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-11|) + ("Subgoal *1/1'" + :use |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-9|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-1| + (implies (and (common-lisp::< (deg p1) (deg p2)) + (FUPOL::ordenadop (double-rewrite p1))) + (ACL2::< (deg (+ p1 (nulo))) + (deg p2))) + :hints (("Goal" + :in-theory (disable deg + =-implies-equal-deg-a + =-implies-equal-deg-b) + :use (:instance + =-implies-equal-deg-b + (p1 (+ p1 (nulo))) + (p2 p1))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-2| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (FUPOL::ordenadop (double-rewrite p)) + (> (FUMON::termino m) + (FUMON::termino (primero p)))) + (equal (resto (FUPOL::+-monomio m p)) + p)) + :hints (("Goal" + :in-theory (enable FUTER::<)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-3| + (implies (and (polinomiop p) + (not (nulop p))) + (= (* p q) + (+ (FUPOL::*-monomio (primero p) q) + (* (resto p) q)))) + :rule-classes nil + :hints (("Goal" + :in-theory (enable * + =) + :use (:instance + FUPOL::|p + q = p + fn(q)| + (FUPOL::p (FUPOL::*-monomio (primero p) q)) + (FUPOL::q (FUPOL::* (resto p) q)))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-4| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite q)) + (> (FUMON::termino m) + (FUMON::termino (primero q)))) + (= (* p (FUPOL::+-monomio m q)) + (+ (FUPOL::*-monomio m p) + (* p q)))) + :hints (("Goal" + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-3| + (p (FUPOL::+-monomio m q)) + (q p))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-5| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite q)) + (> (FUMON::termino m) + (FUMON::termino (primero q)))) + (equal (deg (+ p1 (- (* p2 (FUPOL::+-monomio m q))))) + (deg (+ p1 (+ (- (FUPOL::*-monomio m p2)) + (- (* p2 q))))))) + :hints (("Goal" + :in-theory (disable deg)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-6| + (implies (and (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (not (= p2 (nulo))) + (polinomiop (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (polinomiop p2) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (equal (deg (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-7| + (implies (and (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (not (= p2 (nulo))) + (polinomiop p2) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (equal (deg (quot (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ (ACL2::- (deg p2)) + (deg + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-6|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-8| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (ACL2::< (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)|) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-1| + |deg rem(p1 p2) ACL2::< deg p2-lemma-7|)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-9| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (ACL2::< (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)) + (FUMON::termino + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory + (disable deg lc + FUPOL::ORDENADOP + FUPOL::*-monomio + |p + (- p) = 0| + |p + q = 0 <=> q = - p| + |p + q = mp(p) +Mo (resto(p) + q)| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + |deg(p + q) ACL2::< deg(p)| + |(a + b) = 0 => a +Mo (b +Mo p) = p-lemma-3| + |- (m FUPOL::*-monomio p2) != 0| + |primero (- (m *-monomio p2)) = - (primero (m *-monomio p2))| + |- p != 0| + FUPOL::ORDENADOP-+-MONOMIO-POLINOMIO-ORDENADO + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)| + |m FUPOL::*-monomio p2 != 0| + |p + q = mp(p) +Mo (mp(q) +Mo (resto(p) + (resto q)))| + |p1 = 0 => quot(p1 p2) =e 0| + |polinomiop (m FUPOL::*-monomio p2)| + |primero -p FUMON::= FUMON::- primero p| + |primero(m FUPOL::*-monomio p2) FUMON::= primero(p1)|) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + |deg rem(p1 p2) ACL2::< deg p2-lemma-8| + (:instance + (:theorem + (implies (and (ACL2::< a b) + (equal c b)) + (ACL2::< a c))) + (a (deg + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + q2))) + (b (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (c (FUMON::termino + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))))))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-10| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (ACL2::< (FUMON::termino + (primero + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (FUMON::termino + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable lc FUPOL::ordenadop) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-9|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-11| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (and (FUMON::monomiop (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (not (FUMON::nulop (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))))) + (ACL2::< (FUMON::termino + (primero + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (FUMON::termino + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5|) + :use (|deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + |deg rem(p1 p2) ACL2::< deg p2-lemma-10|)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-12| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (equal (deg (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))))) + (deg (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg rem(p1 p2) ACL2::< deg p2-lemma-5| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5|) + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-11| + (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-5| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (q (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + +(defthm + |nil * p =e nil| + (equal (* nil p) nil) + :hints (("Goal" + :in-theory (e/d (nulo) + (|0 * p =e 0|)) + :use |0 * p =e 0|))) + +(defthm + |p * nil =e nil| + (equal (* p nil) nil) + :hints (("Goal" + :in-theory (e/d (nulo) + (|p * 0 =e 0|)) + :use |p * 0 =e 0|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-13| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite p))) + (= (* p (FUPOL::+-monomio m (nulo))) + (FUPOL::*-monomio m p))) + :hints (("Goal" + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-3| + (p (FUPOL::+-monomio m (nulo))) + (q p))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-14| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite p)) + (equal q (nulo))) + (= (* p (FUPOL::+-monomio m q)) + (+ (FUPOL::*-monomio m p) + (* p q)))) + :hints (("Goal" + :in-theory (disable |deg rem(p1 p2) ACL2::< deg p2-lemma-13|) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-13|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-15| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite p2)) + (equal q (nulo))) + (= (- (* p2 (FUPOL::+-monomio m q))) + (+ (- (FUPOL::*-monomio m p2)) + (- (* p2 q))))) + :hints (("Goal" + :in-theory (disable |deg rem(p1 p2) ACL2::< deg p2-lemma-14|) + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-14| + (p p2))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-16| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite p2)) + (equal q (nulo))) + (= (+ p1 + (- (* p2 (FUPOL::+-monomio m q)))) + (+ p1 + (+ (- (FUPOL::*-monomio m p2)) + (- (* p2 q)))))) + :hints (("Goal" + :in-theory (disable |deg rem(p1 p2) ACL2::< deg p2-lemma-15|) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-15|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-17| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite p2)) + (equal q (nulo))) + (equal (deg (+ p1 + (- (* p2 (FUPOL::+-monomio m q))))) + (deg (+ p1 + (+ (- (FUPOL::*-monomio m p2)) + (- (* p2 q))))))) + :hints (("Goal" + :in-theory (disable deg + |deg rem(p1 p2) ACL2::< deg p2-lemma-16|) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-16|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-18| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (equal (deg (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))))) + (deg (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg rem(p1 p2) ACL2::< deg p2-lemma-17|) + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-17| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (q (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-19| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (ACL2::< (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (equal (deg (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))))) + (deg (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg rem(p1 p2) ACL2::< deg p2-lemma-17|) + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-17| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (q (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-20| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1))) + (equal (deg (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))))) + (deg (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio) + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-12| + |deg rem(p1 p2) ACL2::< deg p2-lemma-18| + |deg rem(p1 p2) ACL2::< deg p2-lemma-19|)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-21| + (equal (deg (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + (deg (+ (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-22| + (implies (and (not (= p1 nil)) + (not (= p2 nil)) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (ACL2::< + (deg + (+ + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (- + (* + p2 + (quot + (+ + p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))) + (deg p2))) + (ACL2::< + (deg + (+ + p1 + (- + (* + p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ + p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + (deg p2))) + :rule-classes nil + :hints (("Goal" + :in-theory (e/d (nulo) + (deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio)) + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-20| + |deg rem(p1 p2) ACL2::< deg p2-lemma-21| + (:instance + (:theorem + (implies (and (equal c d) + (equal d a) + (ACL2::< a b)) + (ACL2::< c b))) + (a (deg + (+ + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (- + (* + p2 + (quot + (+ + p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + (b (deg p2)) + (c (deg + (+ + p1 + (- + (* + p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ + p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + (d (deg (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))))))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-23| + (implies (and (FUMON::monomiop (double-rewrite m)) + (not (FUMON::nulop m)) + (polinomiop (double-rewrite q)) + (> (FUMON::termino m) + (FUMON::termino (primero q)))) + (= (+ p1 + (- (* p2 (FUPOL::+-monomio m q)))) + (+ p1 + (+ (- (FUPOL::*-monomio m p2)) + (- (* p2 q))))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-24| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (not (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (>= (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (= (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))) + (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-3| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-4| + |deg (quot p1 p2) =e deg(p1) ACL2::- deg(p2)-lemma-5| + |deg rem(p1 p2) ACL2::< deg p2-lemma-23|) + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-11| + (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-23| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (q (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-25| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo))) + (= (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))) + (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg rem(p1 p2) ACL2::< deg p2-lemma-16|) + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-16| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (q (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-26| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (ACL2::< (deg (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)))) + (deg p2))) + (= (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))) + (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + |deg rem(p1 p2) ACL2::< deg p2-lemma-16|) + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-16| + (m (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2))))) + (q (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2)))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-27| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1))) + (= (+ p1 (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))) + (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio) + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-24| + |deg rem(p1 p2) ACL2::< deg p2-lemma-25| + |deg rem(p1 p2) ACL2::< deg p2-lemma-26|)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-28| + (implies (and (polinomiop c) + (= p1 a) + (= (+ p1 (- a)) + (+ p1 (+ (- b) + (- c))))) + (= (+ p1 (- b)) + c)) + :rule-classes nil + :hints (("Goal" + :in-theory (disable |p + q = 0 <=> q = - p|) + :use (:instance + |p + q = 0 <=> q = - p| + (q (+ p1 (- b))) + (p (- c)))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-29| + (implies (and (polinomiop p1) + (polinomiop a) + (= (+ p1 (- b)) + c) + (= (+ p1 (- a)) + (+ p1 (+ (- b) + (- c))))) + (= p1 a)) + :rule-classes nil) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-30| + (implies (and (polinomiop p1) + (polinomiop a) + (polinomiop c) + (= (+ p1 (- a)) + (+ p1 (+ (- b) + (- c))))) + (equal (= (+ p1 (- b)) + c) + (= p1 a))) + :rule-classes nil + :hints (("Goal" + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-28| + |deg rem(p1 p2) ACL2::< deg p2-lemma-29|)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-31| + (implies (and (polinomiop p1) + (= (+ p1 + (- (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))) + (+ p1 (+ (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (- (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + (equal (= (+ p1 (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (= p1 (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio) + :use (:instance + |deg rem(p1 p2) ACL2::< deg p2-lemma-30| + (a (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))) + (b (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2)) + (c (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-32| + (implies (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1))) + (equal (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (= p1 + (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2)))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio) + :use (|deg rem(p1 p2) ACL2::< deg p2-lemma-27| + |deg rem(p1 p2) ACL2::< deg p2-lemma-31|)))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-33| + (not (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (* p2 + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio + (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + p2))) + (not + (= p1 + (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-32|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-34| + (not (and (not (= p1 (nulo))) + (not (= p2 (nulo))) + (FUPOL::ordenadop p1) + (FUPOL::ordenadop p2) + (<= (deg p2) (deg p1)) + (= (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + p2))) + (nulo)) + (not + (= p1 + (* p2 + (FUPOL::+-monomio + (FUMON::monomio (FLD::* (lc p1) (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- (deg p2)))) + (quot + (+ p1 + (- (FUPOL::*-monomio + (FUMON::monomio (FLD::* (lc p1) + (FLD::/ (lc p2))) + (ACL2::+ (deg p1) + (ACL2::- + (deg p2)))) + p2))) + p2))))))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc FUPOL::*-monomio FUMON::nulop + FUPOL::+-monomio) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-33|))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-35| + (implies (and (polinomiop p1) + (polinomiop p2) + (not (= p1 (nulo))) + (not (= p2 (nulo))) + (not (= p1 (* p2 (quot p1 p2))))) + (ACL2::< (deg (+ p1 (- (* p2 (quot p1 p2))))) + (deg p2))) + :rule-classes nil + :hints (("Goal" + :in-theory (disable deg lc)) + ("Subgoal *1/4" + :in-theory (e/d (nulo) + (deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio))) + ("Subgoal *1/4''" + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-22|) + ("Subgoal *1/3.2" + :in-theory (disable + deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-33|) + ("Subgoal *1/3.1" + :in-theory (e/d (nulo) + (deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio))) + ("Subgoal *1/2.2" + :in-theory (disable + deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-34|) + ("Subgoal *1/2.1" + :in-theory (e/d + (nulo) + (deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio))))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2-lemma-36| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (not (= (double-rewrite p1) + (* (double-rewrite p2) + (quot (double-rewrite p1) + (double-rewrite p2)))))) + (ACL2::< (deg (+ p1 (- (* p2 (quot p1 p2))))) + (deg p2))) + :rule-classes (:linear :rewrite) + :hints (("Goal" + :in-theory (disable + deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-35|))) + +(defun + rem (p1 p2) + (+ p1 (- (* p2 (quot p1 p2))))) + +(defthm + Polinomiop-rem + (polinomiop (rem p1 p2))) + +(defthm + |(polinomiop p1) & ~(polinomiop p2) => rem(p1 p2) = p1| + (implies (and (polinomiop (double-rewrite p1)) + (not (polinomiop (double-rewrite p2)))) + (= (rem p1 p2) p1))) + +(defthm + |(polinomiop p1) & deg p1 < deq p2 => rem(p1 p2) = p1| + (implies (and (polinomiop (double-rewrite p1)) + (ACL2::< (deg p1) + (deg p2))) + (= (rem p1 p2) p1))) + +(defthm + |p1 = 0 => rem(p1 p2) = 0| + (implies (= (double-rewrite p1)(nulo)) + (= (rem p1 p2) + (nulo)))) + +(defthm + |(polinomiop p1) & p2 = 0 => rem(p1 p2) = 0| + (implies (and (polinomiop (double-rewrite p1)) + (= (double-rewrite p2)(nulo))) + (= (rem p1 p2) p1))) + +(defthm + |deg rem(p1 p2) ACL2::< deg p2| + (implies (and (polinomiop (double-rewrite p1)) + (polinomiop (double-rewrite p2)) + (not (= (double-rewrite p2)(nulo))) + (not (= (rem p1 p2)(nulo)))) + (ACL2::< (deg (rem p1 p2)) + (deg p2))) + :rule-classes (:linear :rewrite :generalize) + :hints (("Goal" + :in-theory (disable + deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio + |deg rem(p1 p2) ACL2::< deg p2-lemma-36|) + :use |deg rem(p1 p2) ACL2::< deg p2-lemma-36|))) + +(defthm + =-implies-=-rem-1 + (implies (= p1 p2) + (= (rem p1 p) + (rem p2 p))) + :rule-classes :congruence) + +(defthm + =-implies-=-rem-2 + (implies (= p1 p2) + (= (rem p p1) + (rem p p2))) + :rule-classes :congruence) + +(defthm + quot-rem-elim + (implies (polinomiop p1) + (= (+ (rem p1 p2) + (* p2 (quot p1 p2))) + p1)) + :rule-classes :elim + :hints (("Goal" + :in-theory (disable + deg lc FUMON::nulop FUPOL::*-monomio FUPOL::+-monomio + |p + q = mp(p) +Mo (resto(p) + q)|)))) + +(in-theory (disable deg lc rem)) + +(defthm + quot-rem-rewrite + (implies (polinomiop (double-rewrite p1)) + (= (+ (rem p1 p2) + (* p2 (quot p1 p2))) + p1))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.acl2 new file mode 100644 index 0000000..0b17b56 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.acl2 @@ -0,0 +1,26 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fusuma" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.lisp new file mode 100644 index 0000000..2c551ef --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.lisp @@ -0,0 +1,165 @@ +; ACL2 Univariate Polynomials over a Field books -- Polynomial Sums +;; Sums of Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +;; Based on +;;; ---------------------------------------------------------------- +;;; Suma de polinomios +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Desarrollo de la suma de polinomios definida simplemente como la +;;; concatenación de las listas de monomios que los integran. Las +;;; propiedades de la concatenación de listas permiten establecer la +;;; base para realizar demostraciones de propiedades sobre los +;;; polinomios más complicadas que incorporan la igualdad +;;; semántica. Se demuestra que los polinomios con la operación de +;;; suma forman un monoide conmutativo. +;;; ---------------------------------------------------------------- +#| +To certify this book, first, create a world with the following packages: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FLD" + *import-symbols*) + +(defpkg "FUTER" + *import-symbols*) + +(defpkg "FUMON" + (union-eq *import-symbols* + '(FLD::fdp FUTER::terminop))) + +(defpkg "FUPOL" + (union-eq *import-symbols* + '(FUTER::naturalp FUTER::terminop FUMON::monomio FUMON::coeficiente + FUMON::termino FUMON::monomiop))) + +(certify-book "fusuma" + 5 + nil ;;compile-flg + ) +|# +(in-package "FUPOL") + +;;(include-book "forma-normal") +(include-book "fuforma-normal" + :load-compiled-file nil) + +;;; ------------------ +;;; Suma de polinomios +;;; ------------------ + +(defun + (p q) + (cond ((and (not (polinomiop p)) (not (polinomiop q))) + (nulo)) + ((not (polinomiop p)) + q) + ((not (polinomiop q)) + p) + (t + (append p q)))) + +;;; Clausura + +(defthm polinomiop-append + (implies (and (polinomiop (double-rewrite p)) + (polinomiop (double-rewrite q))) + (polinomiop (append p q))) + :rule-classes (:type-prescription :rewrite)) + +(defthm polinomiop-+ + (polinomiop (+ p q)) + :rule-classes (:type-prescription :rewrite)) + +;;; ---------------------- +;;; Propiedades de la suma +;;; ---------------------- + +;;; Neutro + +(defthm |(0 p) = p| + (equal (append (nulo) p) p)) + +(defthm |0 + p = p| + (= (+ (nulo) p) p)) + +(defthm |(p 0) = p| + (implies (polinomiop (double-rewrite p)) + (equal (append p (nulo)) p))) + +(defthm |p + 0 = p| + (= (+ p (nulo)) p)) + +;;; Asociatividad + +(defthm |(m +M p) + q =P m +M (p + q)| + (equal (+ (+M m p) q) (+M m (+ p q))) + :hints (("Goal" + :use polinomiop-append))) + +(defthm |p + q =e mp(p) +M (resto(p) + q)-1| + (implies (and (polinomiop p) + (not (nulop p))) + (equal (+ p q) (+M (primero p) (+ (resto p) q)))) + :rule-classes nil) + +(defthm |p + q =e mp(p) +M (resto(p) + q)| + (implies (and (polinomiop (double-rewrite p)) + (not (nulop p))) + (equal (+ p q) (+M (primero p) (+ (resto p) q)))) + :hints (("Goal" + :use |p + q =e mp(p) +M (resto(p) + q)-1|))) + +(local (in-theory (disable = + +M))) + +(defthm |(p + q) + r = p + (q + r)| + (= (+ (+ p q) r) (+ p (+ q r))) + :hints (("Goal" :induct (fn p)) + ("Subgoal *1/1" :in-theory (enable = + +M)))) + +;;; Conmutatividad + +(defthm |q + p = mp(p) +M (q + resto(p))| + (implies (and (polinomiop (double-rewrite p)) + (not (nulop p))) + (= (+ q p) (+M (primero p) (+ q (resto p))))) + :hints (("Goal" :induct (fn q)) + ("Subgoal *1/1" :in-theory (enable = + +M)))) + +(defthm |p + q = q + p| + (= (+ p q) (+ q p)) + :hints (("Goal" :induct (fn p)) + ("Subgoal *1/1" :in-theory (enable = + +M)))) diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.acl2 b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.acl2 new file mode 100644 index 0000000..61dd68f --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.acl2 @@ -0,0 +1,14 @@ +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FUTER" + *import-symbols*) + +(certify-book "futermino" ? t) + diff --git a/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.lisp b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.lisp new file mode 100644 index 0000000..5585ef8 --- /dev/null +++ b/books/workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.lisp @@ -0,0 +1,335 @@ +; ACL2 Univariate Polynomials over a Field books -- Terms +;; Terms for Univariate Polynomials over a Field +; Copyright (C) 2006 John R. Cowles and Ruben A. Gamboa, University of +; Wyoming + +; This book is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. + +; This book is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. + +; You should have received a copy of the GNU General Public License +; along with this book; if not, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Modified by J. Cowles + +;; Last modified July 2006 (for ACL2 Version 3.0). + +; Modified by Matt Kaufmann for ACL2 Version 3.1 because +; SBCL complains about LISP::. + +;; Based on +;;; ------------------------------------------------------------------ +;;; Términos abstractos +;;; +;;; Autores: +;;; +;;; Inmaculada Medina Bulo +;;; Francisco Palomo Lozano +;;; +;;; Descripción: +;;; +;;; Un monoide conmutativo de términos con un orden bien fundamentado +;;; cuya representación se abstrae mediante un encapsulado. Las listas +;;; propias de números naturales de ACL2 con la suma elemento a +;;; elemento y el orden lexicográfico sirven como modelo de la teoría +;;; generada. La buena fundamentación del orden se establece por +;;; inmersión en los ordinales ACL2. +;;; +;;; Notas generales: +;;; +;;; La parte más complicada es la inmersión y la buena fundamentación +;;; del orden. Es curioso que los ordinales obtenidos son bastante +;;; pequeños en relación a, por ejemplo, los propuestos por Kaufmann, +;;; Manolios y Moore como solución al ejercicio 6.8 de su libro +;;; «Computer-Aided Reasoning. An Approach». Véase el trabajo +;;; presentado en Austin. +;;; ------------------------------------------------------------------ +#| +To certify this book, first, create a world with the following package: + +(in-package "ACL2") + +(defconst *import-symbols* + (set-difference-eq + (union-eq *acl2-exports* + *common-lisp-symbols-from-main-lisp-package*) + '(null + * - < = / commutativity-of-* associativity-of-* + commutativity-of-+ associativity-of-+ distributivity))) + +(defpkg "FUTER" + *import-symbols*) + +(certify-book "futermino" + 2 + nil ;;compile-flg + ) +|# +(in-package "FUTER") +;; (encapsulate + +;; ;;; --------- +;; ;;; Signatura +;; ;;; --------- + +;; ((terminop (a) boolean) +;; (* (a b) termino) +;; (uno () termino) +;; (termino->ordinal (a) ordinal) +;; (< (a b) boolean)) + +;; ;;; ---------------- +;; ;;; Testigos locales +;; ;;; ---------------- + +;; ;;; Reconocedor + +;; (local +;; (defun terminop (a) +;; (if (atom a) +;; (equal a nil) +;; (and (natp (first a)) (terminop (rest a)))))) +(defun + terminop (a) + (and (integerp a) + (>= a 0))) + + ;;; Neutro de la operación + +;; (local +;; (defun uno () +;; nil)) + +;; hide is needed below to prevent the theorem +;; prover from ``knowing'' too much about UNO, +;; i.e. from knowing that UNO equals 0. +(defun + uno () + (hide 0)) + ;;; Operación + +;; (local +;; (defun * (a b) +;; (cond ((and (not (terminop a)) (not (terminop b))) +;; (uno)) +;; ((not (terminop a)) +;; b) +;; ((not (terminop b)) +;; a) +;; ((atom a) +;; b) +;; ((atom b) +;; a) +;; (t +;; (cons (ACL2::+ (first a) (first b)) (* (rest a) (rest b))))))) +(defun + * (a b) + (ACL2::+ a b)) + + ;;; Igualdad sintáctica entre términos + +(defmacro = (a b) + `(equal ,a ,b)) + + ;;; Inmersión en los ordinales + +;; (local +;; (defun termino->e0-ordinal (a) +;; (if (atom a) +;; 1 +;; (cons (cons (len a) (first a)) (termino->e0-ordinal (rest a)))))) + + +;; (local +;; (defun termino->ordinal (a) +;; (if (atom a) +;; 1 +;; (cons (cons (len a) (1+ (first a))) (termino->ordinal (rest a)))))) +(defun + termino->ordinal (a) + (ACL2::+ 1 a)) + + ;;; Orden lexicográfico estricto + +;; (local +;; (defun < (a b) +;; ; (declare (xargs :guard (and (terminop a) (terminop b)))) +;; (cond ((or (atom a) (atom b)) +;; (not (atom b))) +;; ((ACL2::< (len a) (len b)) +;; t) +;; ((ACL2::> (len a) (len b)) +;; nil) +;; ((equal (first a) (first b)) +;; (< (rest a) (rest b))) +;; (t +;; (ACL2::< (first a) (first b)))))) +(defun + < (a b) + (ACL2::< a b)) + + ;;; ------- + ;;; Axiomas + ;;; ------- + + ;;; El reconocedor es una función booleana + +(defthm booleanp-terminop + (booleanp (terminop a)) + :rule-classes :type-prescription) + + ;;; Clausura de las operaciones + +(defthm terminop-* + (implies (and (terminop a) (terminop b)) + (terminop (* a b))) + :rule-classes :type-prescription) + +(defthm terminop-uno + (terminop (uno)) + :rule-classes :type-prescription) + + ;;; Conmutatividad de la operación + +(defthm |a * b = b * a| + (implies (and (terminop a) (terminop b)) + (= (* a b) (* b a)))) + + ;;; Asociatividad de la operación + +(defthm |(a * b) * c = a * (b * c)| + (implies (and (terminop a) (terminop b) (terminop c)) + (= (* (* a b) c) (* a (* b c))))) + + ;;; Neutro de la operación + +(defthm |1 * a = a| + (implies (terminop a) + (= (* (uno) a) a))) + + ;;; -------------------- + ;;; Buena fundamentación + ;;; -------------------- + + ;;; Extensión de la corrección de la inmersión + +;; (local +;; (defthm extension-correccion +;; (implies (and (terminop a) +;; (o-p (termino->ordinal (rest a)))) +;; (o-p (termino->ordinal a))) +;; :otf-flg t)) + + ;;; Corrección de la inmersión + +;; (local +;; (defthm o-p-termino->ordinal +;; (implies (terminop a) +;; (o-p (termino->ordinal a))) +;; :hints (("Goal" +;; :in-theory (disable o-p termino->ordinal))))) + + ;;; Buena fundamentación + + ;;; NOTA: + ;;; + ;;; Este teorema es útil como regla de reescritura para extender el + ;;; orden de términos a polinomios. + +(defthm buena-fundamentacion-< + (and (implies (terminop a) + (o-p (termino->ordinal a))) + (implies (and (terminop a) (terminop b) + (< a b)) + (o< (termino->ordinal a) (termino->ordinal b)))) + :rule-classes (:rewrite :well-founded-relation)) + + ;;; La inmersión no produce 0 + + ;;; NOTA: + ;;; + ;;; Estos teoremas facilitan la extensión del orden de términos a + ;;; polinomios. + +(defthm |~(termino->ordinal(a) = 0)| + (implies (terminop a) + (not (equal (termino->ordinal a) 0)))) + +(defthm |(termino->ordinal(a) >O 0)| + (implies (terminop a) + (O< 0 (termino->ordinal a)))) + + ;;; --------------------- + ;;; Propiedades del orden + ;;; --------------------- + + ;;; NOTA: + ;;; + ;;; En realidad estas propiedades no son independientes de los + ;;; axiomas. Se podrían deducir de la inmersión. + + ;;; Irreflexividad + +(defthm |~(a < a)| + (not (< a a))) + ;;; Antisimetría + +(defthm |a < b => ~(b < a)| + (implies (< a b) (not (< b a)))) + + ;;; Transitividad + +(defthm |a < b & b < c => a < c| + (implies (and (< a b) (< b c)) (< a c))) + + ;;; Tricotomía + +(defthm |a < b or b < a or a = b| + (implies (and (terminop a) (terminop b)) + (or (< a b) (< b a) (= a b))) + :rule-classes + ((:rewrite :corollary + (implies (and (terminop a) (terminop b) + (not (= a b)) (not (< a b))) + (< b a))))) + +;; Properties of ordering on univariate terms: + +(defthm + |a < b => a * c < b * c| + (implies (< a b) + (< (* a c)(* b c)))) + +(defthm + |b < c => a * b < a * c| + (implies (< b c) + (< (* a b)(* a c)))) + +(in-theory (disable terminop (terminop) * (*) uno (uno) + termino->ordinal (termino->ordinal) < (<))) + +;;; -------- +;;; Teoremas +;;; -------- + +;;; Teoremas que resultan de aplicar la conmutatividad a los axiomas + +(defthm |a * 1 = a| + (implies (terminop a) + (= (* a (uno)) a))) + +;;; Complemento a la conmutatividad y la asociatividad de la operación + +(defthm |a * (b * c) = b * (a * c)| + (implies (and (terminop a) (terminop b) (terminop c)) + (= (* a (* b c)) (* b (* a c)))) + :hints (("Goal" + :in-theory (disable |(a * b) * c = a * (b * c)|) + :use (|(a * b) * c = a * (b * c)| + (:instance |(a * b) * c = a * (b * c)| (a b) (b a)))))) |