Meeting a Challenge of Knuth John Cowles CLI and University of Wyoming September 1993 (work actually completed in the summer of 1991) This work was supported in part at Computational Logic, Inc., by the Defense Advanced Research Projects Agency, ARPA Order 7406. The views and conclusions contained in this document are those of the author(s) and should not be interpreted as representing the official policies, either expressed or implied, of Computational Logic, Inc., the Defense Advanced Research Projects Agency or the U.S. Government. This note presents two solutions to a challenge problem posed by Donald E. Knuth. It is the concatenation of files in the CLI directory /slocal/src/pc-nqthm-1992/examples/cowles/, to be released with Pc-Nqthm-1992. The organization is follows. 1. The file /slocal/src/pc-nqthm-1992/examples/cowles/knuth-91.events, which presents a solution using the Nqthm-1992 interpreter functions (e.g., EVAL$). 2. The file /slocal/src/pc-nqthm-1992/examples/cowles/knuth-91a.events, which presents a solution using the ``functional variables'' mechanism (CONSTRAIN and FUNCTIONALLY-INSTANTIATE events) of Nqthm-1992. 3. Supporting files of events, which need to be executed in the following order before running either of the two files above (which are each to be run independently on top of "integers"). a. bags.events b. naturals.events c. integers.events The paper referred to below has been published since the time that the events below were created. Here is the reference. D.E. Knuth, Textbook examples of recursion, In: Artificial Intelligence and Mathematical Theory of Computation: Papers in Honor of John McCarthy, edited by V. Lifschitz, Academic Press, San Diego, CA, 1991, pages 207-229. ========================= knuth-91.events ========================= ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; In an unpublished paper, Textbook Examples of Recursion, Donald E. ; Knuth of Stanford University gives the following generalization of ; McCarthy's 91 function: ; Let a be a real, let b and d be positive reals, and let c be a ; positive integer. ; Define K( x ) for integer inputs x by ; K( x ) <== if x > a then x - b ; else K( ... K( x+d ) ... ). ; Here the else-clause in this definition has c applications of the ; function K. ; When a = 100, b = 10, c = 2, and d = 11, the definition specializes ; to McCarthy's original 91 function: ; K( x ) <== if x > 100 then x - 10 ; else K( K( x+11 ) ). ; Knuth calls the first definition of K given above, the generalized ; 91 recursion scheme with parameters ( a,b,c,d ). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The purpose of this file of Boyer-Moore-Kaufmann events is to ; provide mechanical verification of the following theorem given by ; Knuth in his paper. ; Theorem. The generalized 91 recursion with parameters ( a,b,c,d ) ; defines a total function on the integers if and only if ; (c-1)b < d. In such a case the values of K( x ) also ; satisfy the much simpler recurrence ; K( x ) = if x > a then x - b ; else K( x+d-(c-1)b ). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The first problem to solve is: How can Knuth's problem be stated so ; the theorem prover can work on it? ; Define two mutually recursive ( partial ) functions: ; K( a,b,c,d,x ) <== if x > a then x - b ; else IterateK( a,b,c,d,c,x+d ). ; IterateK( a,b,c,d,e,x ) <== if e <= 1 ; then K( a,b,c,d,x ) ; else K( a,b,c,d, ; IterateK( a,b,c,d,e-1,x)) ; Knuth's parameters a, b, c, and d are included in the formal ; parameters of both K and IterateK because the theorem prover does ; not allow functions with definitions which contain "global" ; variables. ; Intuitively, IterateK iterates K e times, that is, K is applied e ; times. ; When the specified number, e, of times K is be iterated is is not ; positive, K is iterated one time. That is, when e<1 the result in ; IterateK is the same as if e were 1. ; Thus K( a,b,c,d,x ) = IterateK( a,b,c,d,1,x ). ; Since the theorem prover does not deal with reals, the parameters ; a,b,c, and d are assumed to be integers. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; To avoid the complications of dealing with mutually recursive ; partial functions, a suggestion of M. Kaufmann is followed: ; In the definition of IterateK, replace occurrences of K with the ; body of K. ; Define a recursive partial function by ; IterK( a,b,c,d,e,x ) <== if 1 < e ; then IterK( a,b,c,d,1, ; IterK( a,b,c,d,e-1,x )) ; else if a < x ; then x - b ; else IterK( a,b,c,d,c,x+d). ; Then the partial function K can be defined by ; K( a,b,c,d,x ) <== IterK( a,b,c,d,1,x ). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; K( a,b,c,d,x ) is said to exist just in case the tuple of integers ; ( a,b,c,d,x ) is in the domain of those input values where the ; partial function K halts and produces output values. ; Knuth's theorem follows from parts 1, 4, 6, 8, and 9 of the ; following Main Theorem. ; 1. If x > a, then K( a,b,c,d,x ) exists. ; 2. If x <= a, d <= 0, and c <= 1, then K( a,b,c,d,x ) does not ; exist. ; 3. If x <= a, d <= 0, and c > 1, then K( a,b,c,d,x ) does not ; exist. ; 4. If x <= a, d > 0, and c <= 1, then K( a,b,c,d,x ) exists. ; 5. If x <= a, d > 0, c > 1, and b <= 0, then K( a,b,c,d,x ) ; exists. ; 6. If x <= a, d > 0, c > 1, and b > 0, then K( a,b,c,d,x ) ; exists if and only if K( a,b,c,d,x+d-(c-1)b ) exists and ; K( a,b,c,d,x ) = K( a,b,c,d,x+d-(c-1)b ). ; 7. If d > 0, c > 1, b > 0, and (c-1)b < d, then ; K( a,b,c,d,x ) exists if and only if K( a,b,1,d-(c-1)b,x ) ; exists and K( a,b,c,d,x ) = K( a,b,1,d-(c-1)b,x ). ; 8. If d > 0, c > 1, b > 0, and (c-1)b < d, then ; K( a,b,c,d,x ) exists. ; 9. If x <= a, d > 0, c > 1, b > 0, and (c-1)b >= d, then ; K( a,b,c,d,x ) does not exist ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Use the library of integer facts. (NOTE-LIB "integers") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define the partial function IterK using EVAL$, ; and define the partial function K using IterK. (DEFN ITERK ( A B C D E X ) (EVAL$ T '(IF (ILESSP '1 E) (ITERK A B C D '1 (ITERK A B C D (IDIFFERENCE E '1) X)) (IF (ILESSP A X) (IDIFFERENCE X B) (ITERK A B C D C (IPLUS X D)))) (LIST (CONS 'A A)(CONS 'B B)(CONS 'C C) (CONS 'D D)(CONS 'E E)(CONS 'X X)))) (DEFN K ( A B C D X ) (ITERK A B C D 1 X)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Recursively distribute V&C-APPLY$ throughout the body of the ; defintion of ITERK. Break the definition into several cases. (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS (REWRITE) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'IF (LIST (V&C-APPLY$ 'ILESSP (LIST '(1 . 0) (CONS E 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (V&C-APPLY$ 'IF (LIST (V&C-APPLY$ 'ILESSP (LIST (CONS A 0) (CONS X 0))) (V&C-APPLY$ 'IDIFFERENCE (LIST (CONS X 0) (CONS B 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0)))))))))) ; hint ( (EXPAND (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) )) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE (REWRITE) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'IF (LIST (V&C-APPLY$ 'ILESSP (LIST '(1 . 0) (CONS E 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (V&C-APPLY$ 'IF (LIST (V&C-APPLY$ 'ILESSP (LIST (CONS A 0) (CONS X 0))) (V&C-APPLY$ 'IDIFFERENCE (LIST (CONS X 0) (CONS B 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0))))))))))) ; hint ( (EXPAND (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) )) (PROVE-LEMMA COST-IS-A-NUMBERP (REWRITE GENERALIZE) (NUMBERP (CDR (V&C-APPLY$ FN ARGS))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA COST>0-IF-FN-EXISTS (REWRITE) (IMPLIES (V&C-APPLY$ FN ARGS) (LESSP 0 (CDR (V&C-APPLY$ FN ARGS)))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA ITERK-COST>BODY-COST (REWRITE) (IMPLIES (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (LESSP (CDR (V&C-APPLY$ 'IF (LIST (V&C-APPLY$ 'ILESSP (LIST '(1 . 0) (CONS E 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (V&C-APPLY$ 'IF (LIST (V&C-APPLY$ 'ILESSP (LIST (CONS A 0) (CONS X 0))) (V&C-APPLY$ 'IDIFFERENCE (LIST (CONS X 0) (CONS B 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0)))))))))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))))) ; hint ( (EXPAND (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) )) (PROVE-LEMMA V&C-APPLY$-IF ( REWRITE ) (EQUAL (V&C-APPLY$ 'IF ARGS) (IF (CAR ARGS) (IF (CAAR ARGS) (FIX-COST (CADR ARGS) (ADD1 (CDAR ARGS))) (FIX-COST (CADDR ARGS) (ADD1 (CDAR ARGS)))) F)) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1 (REWRITE) (IMPLIES (ILESSP 1 E) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0)))))))) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E>1 (REWRITE) (IMPLIES (ILESSP 1 E) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))))))) (PROVE-LEMMA ITERK-COST>BODY-COST-WHEN-E>1 (REWRITE) (IMPLIES (AND (ILESSP 1 E) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0)))))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))))) ; hint ( (USE (ITERK-COST>BODY-COST (A A))) )) (PROVE-LEMMA EQ-ARGS-GIVE-EQ-EXISTENCE (REWRITE) (IMPLIES (AND (NOT (EQUAL FN 'QUOTE)) (NOT (EQUAL FN 'IF)) (EQUAL (STRIP-CARS ARGS1) (STRIP-CARS ARGS2)) (EQUAL (MEMBER F ARGS1) (MEMBER F ARGS2))) (IFF (V&C-APPLY$ FN ARGS1) (V&C-APPLY$ FN ARGS2))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA EQ-ARGS-GIVE-EQ-VALUES (REWRITE) (IMPLIES (AND (NOT (EQUAL FN 'QUOTE)) (NOT (EQUAL FN 'IF)) (EQUAL (STRIP-CARS ARGS1) (STRIP-CARS ARGS2)) (EQUAL (MEMBER F ARGS1) (MEMBER F ARGS2))) (EQUAL (CAR (V&C-APPLY$ FN ARGS1)) (CAR (V&C-APPLY$ FN ARGS2)))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA EQ-ARGS-COST-DEPENDS-ON-COST-OF-ARGS (REWRITE) (IMPLIES (AND (NOT (EQUAL FN 'IF)) (LESSP (SUM-CDRS ARGS1) (SUM-CDRS ARGS2)) (EQUAL (STRIP-CARS ARGS1) (STRIP-CARS ARGS2)) (V&C-APPLY$ FN ARGS1) (V&C-APPLY$ FN ARGS2)) (LESSP (CDR (V&C-APPLY$ FN ARGS1)) (CDR (V&C-APPLY$ FN ARGS2)))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA ITERK-V&C-APPLY$-IDIFFERENCE-EXISTS (REWRITE) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0)))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))) )) (PROVE-LEMMA ITERK-V&C-APPLY$-IDIFFERENCE-VALUE (REWRITE) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))) )) (PROVE-LEMMA ITERK-V&C-APPLY$-IDIFFERENCE-COST (REWRITE) (IMPLIES (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0)))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0)))))) ; hint ( (USE (EQ-ARGS-COST-DEPENDS-ON-COST-OF-ARGS (FN 'ITERK) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))) )) (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2 (REWRITE) (IMPLIES (ILESSP 1 E) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))))) (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS) )) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 (REWRITE) (IMPLIES (ILESSP 1 E) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0)))))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))))) (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS) )) (PROVE-LEMMA ARGS-EXIST-WHEN-FN-EXISTS (REWRITE) (IMPLIES (AND (NOT (EQUAL FN 'IF)) (V&C-APPLY$ FN ARGS)) (NOT (MEMBER F ARGS))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA ITERK-COST>BODY-COST-WHEN-E>1-VERSION-2 (REWRITE) (IMPLIES (AND (ILESSP 1 E) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0)))))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))))) ; hint ( (USE (ARGS-EXIST-WHEN-FN-EXISTS (FN 'ITERK) (ARGS (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0)))))) (ITERK-COST>BODY-COST-WHEN-E>1 (A A)) (ITERK-V&C-APPLY$-IDIFFERENCE-COST (A A)) (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0)))))) (EQ-ARGS-COST-DEPENDS-ON-COST-OF-ARGS (FN 'ITERK) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (V&C-APPLY$ 'IDIFFERENCE (CONS (CONS E 0) '((1 . 0)))) (CONS X 0))))) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS X 0))))))) (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS ITERK-VALUE=BODY-VALUE ARGS-EXIST-WHEN-FN-EXISTS) )) (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3-CASE-1 NIL (IMPLIES (AND VC-X (ILESSP 1 E)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X)))))) ; hint ( (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS ITERK-VALUE=BODY-VALUE) (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X)) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS (CAR VC-X) 0)))) (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS (CAR VC-X) 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))))) (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))) (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X)))) )) (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3-CASE-2 NIL (IMPLIES (AND (EQUAL VC-X F) (ILESSP 1 E)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X)))))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 (REWRITE) (IMPLIES (ILESSP 1 E) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X)))))) ; hint ( (USE (ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3-CASE-1 (A A)) (ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3-CASE-2 (A A))) )) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3-CASE-1 NIL (IMPLIES (AND VC-X (ILESSP 1 E)) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))))))) ; hint ( (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS ITERK-VALUE=BODY-VALUE) (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X)) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS (CAR VC-X) 0)))) (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS (CAR VC-X) 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))))) (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))) (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X)))) )) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3-CASE-2 NIL (IMPLIES (AND (EQUAL VC-X F) (ILESSP 1 E)) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))))))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 (REWRITE) (IMPLIES (ILESSP 1 E) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) VC-X))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IDIFFERENCE E 1) 0) VC-X))))))) ; hint ( (USE (ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3-CASE-1 (A A)) (ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3-CASE-2 (A A))) )) (PROVE-LEMMA ITERK-EXISTS-WHEN-E<=1&A=X (REWRITE) (IMPLIES (AND (NOT (ILESSP 1 E)) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0)))))))) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E<=1&A>=X (REWRITE) (IMPLIES (AND (NOT (ILESSP 1 E)) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0))))))))) (PROVE-LEMMA ITERK-COST>BODY-COST-WHEN-E<=1&A>=X (REWRITE) (IMPLIES (AND (NOT (ILESSP 1 E)) (NOT (ILESSP A X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0)))))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))))) ; hint ( (USE (ITERK-COST>BODY-COST (A A))) )) (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS) (DISABLE ITERK-VALUE=BODY-VALUE) (DISABLE ITERK-COST>BODY-COST) (PROVE-LEMMA ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E<=1&A>=X-VERSION-2 (REWRITE) (IMPLIES (AND (NOT (ILESSP 1 E)) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0))))) )) (PROVE-LEMMA ITERK-VALUE=BODY-VALUE-WHEN-E<=1&A>=X-VERSION-2 (REWRITE) (IMPLIES (AND (NOT (ILESSP 1 E)) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0)))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0))))) )) (PROVE-LEMMA ITERK-COST>BODY-COST-WHEN-E<=1&A>=X-VERSION-2 (REWRITE) (IMPLIES (AND (NOT (ILESSP 1 E)) (NOT (ILESSP A X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0)))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))))) ; hint ( (USE (ITERK-COST>BODY-COST-WHEN-E<=1&A>=X (A A)) (EQ-ARGS-COST-DEPENDS-ON-COST-OF-ARGS (FN 'ITERK) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0))))) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0)))) (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (V&C-APPLY$ 'IPLUS (LIST (CONS X 0) (CONS D 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X D) 0))))) )) (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1) (DISABLE ITERK-VALUE=BODY-VALUE-WHEN-E>1) (DISABLE ITERK-COST>BODY-COST-WHEN-E>1) (DISABLE ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E<=1&A>=X) (DISABLE ITERK-VALUE=BODY-VALUE-WHEN-E<=1&A>=X) (DISABLE ITERK-COST>BODY-COST-WHEN-E<=1&A>=X) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events are versions of Part 1 of the ; Main Theorem given above in the introduction. ; 1. If x > a, then K( a,b,c,d,x ) exists. ; Proof. By the definitions of IterK and K. (PROVE-LEMMA K-EXISTS-WHEN-X>A (REWRITE) (IMPLIES (ILESSP A X) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) ; hint ( (expand (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) )) (PROVE-LEMMA K-HALTS-WHEN-X>A (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP (CAR VC-A)(CAR VC-X))) (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X ))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 1. The cost of computing IterK is unbounded ; when x <= a, d <= 0, and c <= 1: ; Assume x <= a, d <= 0, c <= 1, i > 0, ; and ; IterK( a,b,c,d,1,x ) exists. ; Then IterK( a,b,c,d,c,x+id ) exists ; and ; cost[ IterK( a,b,c,d,c,x+id ) ] + i-1 ; < ; cost[ IterK( a,b,c,d,1,x ) ]. ; Proof. By induction on i. (PROVE-LEMMA COUNT-SUB1-X0&X<>1 (REWRITE) (IMPLIES (AND (ILESSP 0 X) (NOT (EQUAL X 1))) (LESSP (COUNT (IPLUS -1 X)) (COUNT X))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (DEFN INDUCT-HINT-POSITIVE-INT ( X ) (IF (NOT (ILESSP 0 X)) T (IF (EQUAL X 1) T (INDUCT-HINT-POSITIVE-INT (IPLUS -1 X))))) (PROVE-LEMMA SUB1-X>0-WHEN-X>0&X<>1 (REWRITE) (IMPLIES (AND (ILESSP 0 X) (NOT (EQUAL X 1))) (ILESSP 0 (IPLUS -1 X))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA X+_I-1_D<=A-WHEN-X<=A&D<=0&I>0 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 0 I)) (NOT (ILESSP A (IPLUS X (ITIMES (IPLUS -1 I) D))))) ; hint ( (DISABLE-THEORY INTEGERS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK_X+_I-1_D_IMPLIES_ITERK_X+ID-WHEN-X<=A&D<=0&C<=1&I>0 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (NOT (ILESSP 1 C)) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES (IPLUS -1 I) D)) 0)))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES D I)) 0)))) ; hint ( (USE (ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E<=1&A>=X-VERSION-2 (E C)(X (IPLUS X (ITIMES (IPLUS -1 I) D)))) (X+_I-1_D<=A-WHEN-X<=A&D<=0&I>0 (A A))) )) (PROVE-LEMMA ITERK-E=1&X-IMPLIES-ITERK-E=C&X+ID-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (NOT (ILESSP 1 C)) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS 1 0) (CONS X 0)))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES I D)) 0)))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT I)) )) (PROVE-LEMMA W-1+Y0 (A A)) (ITERK-E=1&X-IMPLIES-ITERK-E=C&X+ID-WHEN-X<=A&D<=0&C<=1 (I (IPLUS -1 I))) (ITERK-COST>BODY-COST-WHEN-E<=1&A>=X-VERSION-2 (E C) (X (IPLUS X (ITIMES (IPLUS -1 I) D))))) )) (PROVE-LEMMA COST-BASE-STEP-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS 1 0) (CONS X 0)))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS D X) 0)))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS 1 0) (CONS X 0)))))) ; hint ( (USE (ITERK-COST>BODY-COST-WHEN-E<=1&A>=X-VERSION-2 (E 1))) )) (PROVE-LEMMA ITERK-E=1&X-COST>I-1+COST-ITERK-E=C&X+ID-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (NOT (ILESSP 1 C)) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (LESSP (PLUS (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES I D)) 0)))) (IPLUS -1 I)) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT I)) )) (PROVE-LEMMA Y<=Z-WHEN-X+Y-1=0&Y>0 NIL (IMPLIES (AND (NUMBERP X) (ILESSP 0 Y) (LESSP (PLUS X (IPLUS -1 Y)) Z)) (EQUAL (NOT (LESSP Z Y)) T)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK-COST-IS-UNBOUNDED-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (NOT (ILESSP 1 C)) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (NOT (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) I))) ; hint ( (USE (Y<=Z-WHEN-X+Y-1=0&Y>0 (X (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES I D)) 0))))) (Y I) (Z (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))))) )) (PROVE-LEMMA ILESSP-0-ADD1-X (REWRITE) (ILESSP 0 (ADD1 X)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK-DOES-NOT-EXIST-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (NOT (ILESSP 1 C))) (NOT (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) ; hint ( (USE (ITERK-COST-IS-UNBOUNDED-WHEN-X<=A&D<=0&C<=1 (I (ADD1 (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events are versions of Part 2 of the ; Main Theorem given above in the introduction. ; 2. If x <= a, d <= 0, and c <= 1, then ; K( a,b,c,d,x ) does not exist. ; Proof. By Lemma 1 and the definition of K. (PROVE-LEMMA K-DOES-NOT-EXIST-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (NOT (ILESSP 1 C))) (NOT (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0))))) ; hint ( (EXPAND (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) )) (PROVE-LEMMA K-DOES-NOT-HALT-WHEN-X<=A&D<=0&C<=1 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (NOT (ILESSP (CAR VC-A)(CAR VC-X))) (NOT (ILESSP 0 (CAR VC-D))) (NOT (ILESSP 1 (CAR VC-C)))) (NOT (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X)))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 2. When the number of iterates is positive, ; the cost of computing IterK is an order ; homomorhism of the number of iterates: ; Assume that 0 < e1 < e2 ; and ; IterK( a,b,c,d,e2,x ) exists. ; Then IterK( a,b,c,d,e1,x ) also exists ; and ; cost[ IterK( a,b,c,d,e1,x ) ] ; < ; cost[ IterK( a,b,c,d,e2,x ) ]. ; Proof. Hold e1 constant and induct on e2. (PROVE-LEMMA COUNT-SUB1-Y1-WHEN-Y>X&X>0 (REWRITE) (IMPLIES (AND (ILESSP 0 X) (ILESSP X Y)) (ILESSP 1 Y)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&0Y-1 (REWRITE) (IMPLIES (AND (ILESSP 0 X) (ILESSP X Y) (NOT (EQUAL X (IPLUS -1 Y)))) (ILESSP X (IPLUS -1 Y))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-WHEN-Y>X&X>0) )) (PROVE-LEMMA COST>COST-OF-ARGS (REWRITE) (IMPLIES (AND (NOT (EQUAL FN 'IF)) (NOT (MEMBER F ARGS)) (V&C-APPLY$ FN ARGS)) (LESSP (SUM-CDRS ARGS) (CDR (V&C-APPLY$ FN ARGS)))) ; hint ( (ENABLE V&C-APPLY$) )) (PROVE-LEMMA SUM-CDRS>=MEMBER (REWRITE) (IMPLIES (MEMBER X L) (NOT (LESSP (SUM-CDRS L)(CDR X))))) (PROVE-LEMMA COST>MEMBER (REWRITE) (IMPLIES (AND (V&C-APPLY$ FN ARGS) (NOT (EQUAL FN 'IF)) (MEMBER X ARGS) ) (LESSP (CDR X) (CDR (V&C-APPLY$ FN ARGS))))) (PROVE-LEMMA COST-ITERK-AT-E1MEMBER (FN 'ITERK) (ARGS (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E2) 0) (CONS X 0))))) (X (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E2) 0) (CONS X 0))))) (ITERK-COST>BODY-COST-WHEN-E>1-VERSION-2 (E E2))) )) (DISABLE Y>1-WHEN-Y>X&X>0) (PROVE-LEMMA COST-ITERK-AT-E1 1: ; Assume x <= a, d <= 0, c > 1, i > 0, ; and ; IterK( a,b,c,d,1,x ) exists. ; Then IterK( a,b,c,d,1,x+id ) exists ; and ; cost[ IterK( a,b,c,d,1,x+id ) ] + i ; < ; cost[ IterK( a,b,c,d,1,x ) ]. ; Proof. By induction on i. (PROVE-LEMMA ITERK_X+_I-1_D_IMPLIES_ITERK_X+ID-WHEN-X<=A&D<=0&C>1&I>0&E=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 I) D)) 0)))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES D I)) 0)))) ; hint ( (USE (ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E<=1&A>=X-VERSION-2 (E 1)(X (IPLUS X (ITIMES (IPLUS -1 I) D)))) (X+_I-1_D<=A-WHEN-X<=A&D<=0&I>0 (A A))) )) (PROVE-LEMMA ITERK-X-IMPLIES-ITERK-X+ID-WHEN-X<=A&D<=0&C>1&E=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES I D)) 0)))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT I)) )) (PROVE-LEMMA ITERK-X+D-COST=X&11 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C) (ILESSP 0 I) (NOT (EQUAL I 1)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))) (LESSP (PLUS (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 I) D)) 0)))) (IPLUS -1 I)) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) (LESSP (PLUS (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES D I)) 0)))) I) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) ; hint ( (USE (X+_I-1_D<=A-WHEN-X<=A&D<=0&I>0 (A A)) (ITERK-X-IMPLIES-ITERK-X+ID-WHEN-X<=A&D<=0&C>1&E=1 (I (IPLUS -1 I))) (ITERK-X+D-COST=X&1I+COST-ITERK-X+ID-WHEN-X<=A&D<=0&C>1&E=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (LESSP (PLUS (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES I D)) 0)))) I) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT I)) )) (PROVE-LEMMA ITERK-COST-IS-UNBOUNDED-WHEN-X<=A&D<=0&C>1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C) (ILESSP 0 I) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (LESSP I (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) ; hint ( (USE (ITERK-X-COST>I+COST-ITERK-X+ID-WHEN-X<=A&D<=0&C>1&E=1 (A A))) )) (PROVE-LEMMA ITERK-DOES-NOT-EXIST-WHEN-X<=A&D<=0&C>1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C)) (NOT (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) ; hint ( (USE (ITERK-COST-IS-UNBOUNDED-WHEN-X<=A&D<=0&C>1 (I (ADD1 (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events are versions of Part 3 of the ; Main Theorem given above in the introduction. ; 3. If x <= a, d <= 0, and c > 1, then ; K( a,b,c,d,x ) does not exist. ; Proof. By Lemma 3 and the definition of K. (PROVE-LEMMA K-DOES-NOT-EXIST-WHEN-X<=A&D<=0&C>1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (NOT (ILESSP 0 D)) (ILESSP 1 C)) (NOT (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0))))) ; hint ( (expand (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) )) (PROVE-LEMMA K-DOES-NOT-HALT-WHEN-X<=A&D<=0&C>1 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (NOT (ILESSP (CAR VC-A)(CAR VC-X))) (NOT (ILESSP 0 (CAR VC-D))) (ILESSP 1 (CAR VC-C))) (NOT (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X)))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 4. IterK exists when d > 0, ; c <= 1, and e = c: ; Assume d > 0, and c <= 1. ; Then IterK( a,b,c,d,c,x ) exists. ; Proof. Hold the parameter a fixed and ; induct on the value given by ; if x > a then 0 ; else 1 + a - x. (DEFN K-MEASURE ( A X ) (IF (ILESSP A X) 0 (IPLUS 1 (IPLUS A (INEG X))))) (PROVE-LEMMA K-MEASURE_X+D=X (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X))) (LESSP (K-MEASURE A (IPLUS D X)) (K-MEASURE A X))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (DISABLE K-MEASURE) (DEFN INDUCT-HINT-K-MEASURE ( A B C D X ) (IF (NOT (ILESSP 0 D)) T (IF (ILESSP A X) T (INDUCT-HINT-K-MEASURE A B C D (IPLUS D X)))) ; hint ( (LESSP (K-MEASURE A X)) )) (PROVE-LEMMA ITERK-EXISTS-WHEN-D>0&C<=1&E=C (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP 1 C))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS X 0)))) ; hint ( (INDUCT (INDUCT-HINT-K-MEASURE A B C D X)) )) (PROVE-LEMMA ITERK-EXISTS-WHEN-X<=A&D>0&C<=1&E=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (ILESSP 0 D) (NOT (ILESSP 1 C))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events are versions of Part 4 of the ; Main Theorem given above in the introduction. ; 4. If x <= a, d > 0, and c <= 1, then ; K( a,b,c,d,x ) exists. ; Proof. By Lemma 4 and the definition of K. (PROVE-LEMMA K-EXISTS-WHEN-X<=A&D>0&C<=1 (REWRITE) (IMPLIES (AND (NOT (ILESSP A X)) (ILESSP 0 D) (NOT (ILESSP 1 C))) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) ; hint ( (expand (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) )) (PROVE-LEMMA K-HALTS-WHEN-X<=A&D>0&C<=1 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (NOT (ILESSP (CAR VC-A)(CAR VC-X))) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP 1 (CAR VC-C)))) (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X ))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 5. IterK exists and has value > a ; when x > a, b <= 0, and e > 0: ; Assume x > a, b <= 0, and e > 0. ; Then IterK( a,b,c,d,e,x ) exists ; and ; IterK( a,b,c,d,e,x ) > a. ; Proof. By induction on e. (PROVE-LEMMA ITERK-EXISTS-WHEN-E<=1&A1-WHEN-X>0&X<>1 (REWRITE) (IMPLIES (AND (ILESSP 0 X) (NOT (EQUAL X 1))) (ILESSP 1 X)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK-EXISTS&ITERK>A-WHEN-X>A&B<=0&E>0 (REWRITE) (IMPLIES (AND (ILESSP A X) (NOT (ILESSP 0 B)) (ILESSP 0 E)) (AND (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (ILESSP A (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))))))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT E)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 6. The number of iterates in the composition ; of IterK with itself add up: ; Let e1 > 0 and e2 > 0. Then ; IterK( a,b,c,d,e1,IterK( a,b,c,d,e2,x ) ) exists ; iff ; IterK( a,b,c,d,e1+e2,x ) exists ; and ; IterK( a,b,c,d,e1,IterK( a,b,c,d,e2,x ) ) ; = ; IterK( a,b,c,d,e1+e2,x ) ; Proof. By induction on e1. (PROVE-LEMMA IPLUS_1_-1_X=X_WHEN_X>0 (REWRITE) (IMPLIES (ILESSP 0 X) (EQUAL (IPLUS 1 (IPLUS -1 X)) X)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA X+Y>1-WHEN-X>0&X<>1&0= x+nd. ; Then ; IterK( a,b,c,d,1,x ) exists ; iff ; IterK( a,b,c,d,1+n(c-1),x+nd ) exists ; and ; IterK( a,b,c,d,1,x ) ; = ; IterK( a,b,c,d,1+n(c-1),x+nd ). ; Proof. By induction on n. (PROVE-LEMMA N_C-1_+1=C-WHEN-N=1&C>1 (REWRITE) (IMPLIES (AND (EQUAL N 1) (ILESSP 1 C)) (EQUAL (IPLUS 1 (ITIMES N (IPLUS -1 C))) C)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ND=D-WHEN-N=1&D>0 (REWRITE) (IMPLIES (AND (EQUAL N 1) (ILESSP 0 D)) (EQUAL (ITIMES N D) D)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA A>=X-WHEN-A+D>=X+D (REWRITE) (IMPLIES (NOT (ILESSP (IPLUS A D) (IPLUS X D))) (NOT (ILESSP A X)))) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-EXISTS-BASE-STEP (REWRITE) (IMPLIES (AND (EQUAL N 1) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))) ; hint ( (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-VALUE-BASE-STEP (REWRITE) (IMPLIES (AND (EQUAL N 1) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) ; hint ( (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA N-1_C-1>0-WHEN-11 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 N) (NOT (EQUAL N 1))) (ILESSP 0 (ITIMES (IPLUS -1 N) (IPLUS -1 C)))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-EXISTS-STEP-1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 N) (NOT (EQUAL N 1))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES (IPLUS -1 N) (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0))))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (ITIMES (IPLUS -1 N) (IPLUS -1 C))) (E2 1) (X (IPLUS X (ITIMES (IPLUS -1 N) D)))) (N-1_C-1>0-WHEN-11 (A A))) )) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-VALUE-STEP-1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 N) (NOT (EQUAL N 1))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES (IPLUS -1 N) (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0)))))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (ITIMES (IPLUS -1 N) (IPLUS -1 C))) (E2 1) (X (IPLUS X (ITIMES (IPLUS -1 N) D)))) (N-1_C-1>0-WHEN-11 (A A))) (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES) )) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-EXISTS-STEP-2 (REWRITE) (IMPLIES (AND (ILESSP 0 N) (ILESSP 0 D) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0))))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES N D)) 0))))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES N D)) 0))))))))) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-VALUE-STEP-2 (REWRITE) (IMPLIES (AND (ILESSP 0 N) (ILESSP 0 D) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0)))))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES N D)) 0)))))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (ITIMES (IPLUS -1 N) D)) 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES N D)) 0))))))))) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-EXISTS-STEP-3 (REWRITE) (IMPLIES (AND (ILESSP 0 N) (NOT (EQUAL N 1)) (ILESSP 1 C)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES N D)) 0))))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (ITIMES (IPLUS -1 N) (IPLUS -1 C))) (E2 C) (X (IPLUS X (ITIMES N D)))) (N-1_C-1>0-WHEN-11 (A A))) (DISABLE ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 NBR-OF-ITERATES-SUM-EXISTS&VALUES) )) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-VALUE-STEP-3 (REWRITE) (IMPLIES (AND (ILESSP 0 N) (NOT (EQUAL N 1)) (ILESSP 1 C)) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (ITIMES (IPLUS -1 N) (IPLUS -1 C)) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS C 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (ITIMES (IPLUS -1 N) (IPLUS -1 C))) (E2 C) (X (IPLUS X (ITIMES N D)))) (N-1_C-1>0-WHEN-11 (A A))) (DISABLE ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 NBR-OF-ITERATES-SUM-EXISTS&VALUES) )) (PROVE-LEMMA A+D>=X+_N-1_D-WHEN-A+D>=X+ND&0=X+ND (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT N)) (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA ITERK_E=1+_N_C-1&X+ND-VALUE-WHEN-1=X+ND (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) ; hint ( (INDUCT (INDUCT-HINT-POSITIVE-INT N)) (DISABLE-THEORY INTEGERS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define the function N( a,d,x ) recursively, ; so that whenever d > 0, N( a,d,x ) is the smallest ; nonnegative integer i such that x + id > a. (DEFN N ( A D X ) (IF (NOT (ILESSP 0 D)) 0 (IF (ILESSP A X) 0 (IPLUS 1 (N A D (IPLUS X D))))) ; hint ( (LESSP (K-MEASURE A X)) )) (PROVE-LEMMA N>=0 (REWRITE) (NOT (ILESSP (N A D X) 0))) (PROVE-LEMMA N>0-WHEN-D>O&X<=A (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X))) (ILESSP 0 (N A D X)))) (PROVE-LEMMA A=X+ND-WHEN-D>0&A>=X (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X))) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES (N A D X) D)))))) (PROVE-LEMMA ITERK-E=1&X-IFF-ITERK_E=1+_N_C-1&X+ND-WHEN-1=X (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES (N A D X) (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES (N A D X) D)) 0))))) ; hint ( (DISABLE-THEORY INTEGERS) (USE (ITERK_E=1+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND (N (N A D X)))) )) (PROVE-LEMMA ITERK-EXISTS-WHEN-E=1+N_C-1&X=X+ND&B<=0 (REWRITE) (IMPLIES (AND (NOT (ILESSP 0 B)) (ILESSP 1 C) (ILESSP 0 D)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES (N A D X) (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES (N A D X) D)) 0)))) ; hint ( (USE (ITERK-EXISTS&ITERK>A-WHEN-X>A&B<=0&E>0 (E (IPLUS 1 (ITIMES (N A D X) (IPLUS -1 C)))) (X (IPLUS X (ITIMES (N A D X) D)))) (A0&C<1&B<=0 (REWRITE) (IMPLIES (AND (NOT (ILESSP 0 B)) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) ; hint ( (DISABLE-THEORY INTEGERS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events are versions of Part 5 of the ; Main Theorem given above in the introduction. ; 5. If x <= a, d > 0, c > 1, and b <= 0, then ; K( a,b,c,d,x ) exists. ; Proof. By Lemma 7, the definition of the ; function N, Part 1 of the Main Theorem, ; and the definition of K. (PROVE-LEMMA K-EXISTS-WHEN-X<=A&D>0&C<1&B<=0 (REWRITE) (IMPLIES (AND (NOT (ILESSP 0 B)) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) ; hint ( (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK_E=1+_N_C-1&X+ND-VALUE-BASE-STEP ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2) (EXPAND (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) )) (PROVE-LEMMA K-HALTS-WHEN-X<=A&D>0&C<1&B<=0 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (NOT (ILESSP 0 (CAR VC-B))) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP (CAR VC-A) (CAR VC-X)))) (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 8. Generalize Lemma 7 to the case when e > 1. ; Assume 1 < c, 0 < d, 1 < e, 0 < n, and a+d >= x+nd. ; Then ; IterK( a,b,c,d,e,x ) exists ; iff ; IterK( a,b,c,d,e+n(c-1),x+nd ) exists ; and ; IterK( a,b,c,d,e,x ) ; = ; IterK( a,b,c,d,e+n(c-1),x+nd ). ; Proof. By Lemma 6 (with e2 = 1) and Lemma 7. (PROVE-LEMMA X+-X+Y=FIX-INT-Y (REWRITE) (IMPLIES (ILESSP 0 X) (EQUAL (IPLUS X (IPLUS (MINUS X) Y)) (FIX-INT Y))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA FIX-INT-X=X-WHEN-X>1 (REWRITE) (IMPLIES (ILESSP 1 X) (EQUAL (FIX-INT X) X)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X (REWRITE) (IMPLIES (ILESSP 1 E) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (IPLUS -1 E)) (E2 1))) (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK-E-X=ITERK-E-1-ITERK-1-X (REWRITE) (IMPLIES (ILESSP 1 E) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (IPLUS -1 E)) (E2 1))) (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK_E+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND-STEP-1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))))) ; hint ( (DISABLE-THEORY INTEGERS) (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))))) )) (PROVE-LEMMA ITERK_E+_N_C-1&X+ND-VALUE-WHEN-1=X+ND-STEP-1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))))) ; hint ( (DISABLE-THEORY INTEGERS) (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))))) )) (PROVE-LEMMA ITERK_E+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND-STEP-2 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 1 E) (ILESSP 0 N)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS E (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (IPLUS -1 E)) (E2 (IPLUS 1 (ITIMES N (IPLUS -1 C)))) (X (IPLUS X (ITIMES N D))))) (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK_E+_N_C-1&X+ND-VALUE-WHEN-1=X+ND-STEP-2 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 1 E) (ILESSP 0 N)) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS E (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) ; hint ( (USE (NBR-OF-ITERATES-SUM-EXISTS&VALUES (E1 (IPLUS -1 E)) (E2 (IPLUS 1 (ITIMES N (IPLUS -1 C)))) (X (IPLUS X (ITIMES N D))))) (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK_E+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS E (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0))))) ; hint ( (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA ITERK_E+_N_C-1&X+ND-VALUE-WHEN-1=X+ND (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS E (ITIMES N (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES N D)) 0)))))) ; hint ( (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA ITERK-E&X-IFF-ITERK_E+_N_C-1&X+ND-WHEN-1=X&E>1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS E (ITIMES (N A D X) (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES (N A D X) D)) 0))))) ; hint ( (DISABLE-THEORY INTEGERS) (USE (ITERK_E+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND (N (N A D X)))) )) (PROVE-LEMMA ITERK-E&X=ITERK_E+_N_C-1&X+ND-WHEN-1=X&E>1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS E (ITIMES (N A D X) (IPLUS -1 C))) 0) (CONS (IPLUS X (ITIMES (N A D X) D)) 0)))))) ; hint ( (DISABLE-THEORY INTEGERS) (USE (ITERK_E+_N_C-1&X+ND-VALUE-WHEN-1=X+ND (N (N A D X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 9. The number of iterates of K can be reduced ; by one if the value of x is reduced by b ; when a < x. ; Assume 1 < e, and a < x. ; Then ; IterK( a,b,c,d,e,x ) exists ; iff ; IterK( a,b,c,d,e-1,x-b ) exists ; and ; IterK( a,b,c,d,e,x ) ; = ; IterK( a,b,c,d,e-1,x-b ). ; Proof. By Lemma 6 (with e2 = 1), and the definition ; of IterK for values of x larger than a. (PROVE-LEMMA ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-1A-STEP-1 (REWRITE) (IMPLIES (AND (ILESSP A X) (ILESSP 1 E)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))))) )) (PROVE-LEMMA ITERK_E_X=ITERK_E-1_X-B-WHEN-1A-STEP-1 (REWRITE) (IMPLIES (AND (ILESSP A X) (ILESSP 1 E)) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0)))))) ; hint ( (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))))) )) (PROVE-LEMMA ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-1A (REWRITE) (IMPLIES (AND (ILESSP A X) (ILESSP 1 E)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0)))))) (PROVE-LEMMA ITERK_E_X=ITERK_E-1_X-B-WHEN-1A (REWRITE) (IMPLIES (AND (ILESSP A X) (ILESSP 1 E)) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 10. A key fact noted by Knuth in his proof. ; Assume 1 < c, 0 < d, 1 < e, and x <= a. ; Then ; IterK( a,b,c,d,e,x ) exists ; iff ; IterK( a,b,c,d,e-1+N( a,d,x )(c-1),x+N( a,d,x )d-b ) ; exists ; and ; IterK( a,b,c,d,e,x ) ; = ; IterK( a,b,c,d,e-1+N( a,d,x )(c-1),x+N( a,d,x )d-b ). ; Proof. By Lemma 8, the definition of the function N, ; and Lemma 9. (PROVE-LEMMA E+N_C-1_>1-WHEN-1=X&E>1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0))))) ; hint ( (USE (ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-1A (E (IPLUS E (ITIMES (N A D X)(IPLUS -1 C)))) (X (IPLUS X (ITIMES (N A D X) D))))) (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA ITERK-E&X=ITERK_-1+E+_N_C-1&X+ND-B-WHEN-1=X&E>1 (REWRITE) (IMPLIES (AND (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0)))))) ; hint ( (DISABLE-THEORY INTEGERS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 11. Another key fact noted by Knuth. ; Assume 0 < b, 1 < c, 0 < d, 1 < e, and x <= a. ; Then ; IterK( a,b,c,d,e-1,x-b ) exists ; iff ; IterK( a,b,c,d,e-1+N( a,d,x )(c-1),x-b+N( a,d,x )d ) ; exists ; and ; IterK( a,b,c,d,e-1,x-b ) ; = ; IterK( a,b,c,d,e-1+N( a,d,x )(c-1),x-b+N( a,d,x )d ). ; Proof. By Lemma 7 (if e = 2), Lemma 8 (if e > 2), and ; the definition of the function N. (PROVE-LEMMA A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 0 D) (ILESSP 0 N) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES N D))))) (NOT (ILESSP (IPLUS A D) (IPLUS (IDIFFERENCE X B) (ITIMES N D))))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) (ENABLE IDIFFERENCE) )) (PROVE-LEMMA ITERK-E-1&X-B-IFF-ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E>2 NIL (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 2 E) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0))))) ; hint ( (USE (ITERK_E+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND (E (IPLUS -1 E)) (N (N A D X)) (X (IDIFFERENCE X B))) (A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 (N (N A D X))) (A+D>=X+ND-WHEN-D>0&A>=X (A A))) (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK-E-1&X-B=ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&E>2 NIL (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 2 E) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0)))))) ; hint ( (USE (ITERK_E+_N_C-1&X+ND-VALUE-WHEN-1=X+ND (E (IPLUS -1 E)) (N (N A D X)) (X (IDIFFERENCE X B))) (A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 (N (N A D X))) (A+D>=X+ND-WHEN-D>0&A>=X (A A))) (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA X+2-1=X+1 (REWRITE) (EQUAL (IPLUS -1 (IPLUS 2 X)) (IPLUS 1 X))) (PROVE-LEMMA ITERK-E-1&X-B-IFF-ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E=2 NIL (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (EQUAL E 2) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0))))) ; hint ( (USE (ITERK_E=1+_N_C-1&X+ND-EXISTS-WHEN-1=X+ND (N (N A D X)) (X (IDIFFERENCE X B))) (A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 (N (N A D X))) (A+D>=X+ND-WHEN-D>0&A>=X (A A))) (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK-E-1&X-B=ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E=2 NIL (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (EQUAL E 2) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0)))))) ; hint ( (USE (ITERK_E=1+_N_C-1&X+ND-VALUE-WHEN-1=X+ND (N (N A D X)) (X (IDIFFERENCE X B))) (A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 (N (N A D X))) (A+D>=X+ND-WHEN-D>0&A>=X (A A))) (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK-E-1&X-B-IFF-ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E>1 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0))))) ; hint ( (USE (ITERK-E-1&X-B-IFF-ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E=2 (A A)) (ITERK-E-1&X-B-IFF-ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E>2 (A A))) (ENABLE ILESSP) (DISABLE-THEORY INTEGERS) (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK-E-1&X-B=ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E>1 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 (IPLUS E (ITIMES (N A D X) (IPLUS -1 C)))) 0) (CONS (IDIFFERENCE (IPLUS X (ITIMES (N A D X) D)) B) 0)))))) ; hint ( (USE (ITERK-E-1&X-B=ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&B>0&E=2 (A A)) (ITERK-E-1&X-B=ITERK_E-1+_N_C-1&X-B+ND-WHEN-1=X&E>2 (A A))) (ENABLE ILESSP) (DISABLE-THEORY INTEGERS) (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 12. The number of iterates of K can be reduced ; by one if the value of x is reduced by b ; when a >= x and restrictions are placed ; on the parameters a,b,c, and d. ; Assume 0 < b, 1 < c, 0 < d, 1 < e, and a >= x. ; Then ; IterK( a,b,c,d,e,x ) exists ; iff ; IterK( a,b,c,d,e-1,x-b ) exists ; and ; IterK( a,b,c,d,e,x ) ; = ; IterK( a,b,c,d,e-1,x-b ). ; Proof. By Lemma 10 and Lemma 11. (PROVE-LEMMA ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-0=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0))))) ; hint ( (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA ITERK_E_X=ITERK_E-1_X-B-WHEN-0=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 1 E) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS E 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS -1 E) 0) (CONS (IDIFFERENCE X B) 0)))))) ; hint ( (DISABLE A+D>=X+ND-WHEN-D>0&A>=X A+D>=X-B+ND-WHEN-B>0&A+D>=X+ND&D>0 NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X=ITERK-E-1-ITERK-1-X ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (DISABLE-THEORY INTEGERS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 13. Combine Lemma 9 and Lemma 12 about reducing ; the number of iterates of K by one. ; Assume 0 < b, 1 < c, 0 < d, and 1 < e. ; Then ; IterK( a,b,c,d,e,x ) exists ; iff ; IterK( a,b,c,d,e-1,x-b ) exists ; and ; IterK( a,b,c,d,e,x ) ; = ; IterK( a,b,c,d,e-1,x-b ). ; Proof. By Lemma 9 (if x > a) and Lemma 12 (if x <= a). (PROVE-LEMMA ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (DISABLE-THEORY INTEGERS) (USE (ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-0=X (A A))) )) (PROVE-LEMMA ITERK_E_X=ITERK_E-1_X-B-WHEN-01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (DISABLE-THEORY INTEGERS) (USE (ITERK_E_X=ITERK_E-1_X-B-WHEN-0=X (A A))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 14. Generalize Lemma 13 by reducing the number ; of iterates of K by more than one. ; Assume 0 < b, 1 < c, 0 < d, 1 < e, and 0 < j < e. ; Then ; IterK( a,b,c,d,e,x ) exists ; iff ; IterK( a,b,c,d,e-j,x-jb ) exists ; and ; IterK( a,b,c,d,e,x ) ; = ; IterK( a,b,c,d,e-j,x-jb ). ; Proof. By induction on j. (PROVE-LEMMA ITERK_E_X-IFF-ITERK_E-J_X-JB-WHEN-0= x. ; Then ; IterK( a,b,c,d,1,x ) exists ; iff ; IterK( a,b,c,d,1,x+d-(c-1)b ) exists ; and ; IterK( a,b,c,d,1,x ) ; = ; IterK( a,b,c,d,1,x+d-(c-1)b ). ; Proof. By Lemma 14 with e = c, j = c-1, and ; x replaced by x + d. (PROVE-LEMMA ITERK_X-IFF-ITERK_X+D_C-1_B-WHEN-0=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))) 0))))) ; hint ( (USE (ITERK_E_X-IFF-ITERK_E-J_X-JB-WHEN-0=X ITERK_E_X-IFF-ITERK_E-J_X-JB-WHEN-01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK_X=ITERK_X+D_C-1_B-WHEN-0=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))) 0)))))) ; hint ( (USE (ITERK_E_X=ITERK_E-J_X-JB-WHEN-01-VERSION-3 ITERK-VALUE=BODY-VALUE-WHEN-E>1-VERSION-2 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events give a version of Part 6 of ; the Main Theorem given above in the introduction. ; 6. If x <= a, d > 0, c > 1, and b > 0, then ; K( a,b,c,d,x ) exists if and only if ; K( a,b,c,d,x+d-(c-1)b ) exists and ; K( a,b,c,d,x ) = K( a,b,c,d,x+d-(c-1)b ). ; Proof. By Lemma 15 and the definition of K. (PROVE-LEMMA K_X-IFF-K_X+D_C-1_B-WHEN-0=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (IFF (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0))) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))) 0))))) ; hint ( (DISABLE-THEORY INTEGERS) (EXPAND (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0))) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))) 0)))) )) (PROVE-LEMMA K_X=K_X+D_C-1_B-WHEN-0=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X))) (EQUAL (CAR (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))) 0)))))) ; hint ( (DISABLE-THEORY INTEGERS) (EXPAND (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0))) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))) 0)))) )) (PROVE-LEMMA K_X-IFF-K_X+D_C-1_B-WHEN-0=X-VERSION-2 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP (CAR VC-A) (CAR VC-X)))) (IFF (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X)) (V&C-APPLY$ 'K (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) 0))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) (PROVE-LEMMA K_X=K_X+D_C-1_B-WHEN-0=X-VERSION-2 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP (CAR VC-A) (CAR VC-X)))) (EQUAL (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))) (CAR (V&C-APPLY$ 'K (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) 0)))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events give a more general version ; of Part 6 of the Main Theorem. (PROVE-LEMMA K_X-IFF-K_X+D_C-1_B-WHEN-0=X-VERSION-3 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP (CAR VC-A) (CAR VC-X)))) (IFF (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X)) (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) COST))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) COST))))) )) (PROVE-LEMMA K_X=K_X+D_C-1_B-WHEN-0=X-VERSION-3 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP (CAR VC-A) (CAR VC-X)))) (EQUAL (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))) (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) COST)))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) COST))))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 16. The parameter c can be replaced by 1 if ; the parameter d is modified in a suitable ; way, when certain restrictions are placed ; on the parameters. ; Assume 0 < b, 1 < c, 0 < d, and (c-1)b < d. ; Then ; IterK( a,b,c,d,1,x ) exists ; iff ; IterK( a,b,1,d-(c-1)b,1,x ) exists ; and ; IterK( a,b,c,d,1,x ) ; = ; IterK( a,b,1,d-(c-1)b,1,x ). ; Proof. By induction on the value given by ; if x > a then 0 ; else 1 + a - x. ; Also use Lemma 15. (PROVE-LEMMA K-MEASURE_X+D-_C-1_B=X (REWRITE) (IMPLIES (AND (ILESSP (ITIMES B C) (IPLUS B D)) (NOT (ILESSP A X))) (LESSP (K-MEASURE A (IPLUS B (IPLUS D (IPLUS X (INEG (ITIMES B C)))))) (K-MEASURE A X))) ; hint ( (USE (K-MEASURE_X+D=X (D (IDIFFERENCE D (ITIMES B (IPLUS -1 C)))))) )) (DEFN INDUCT-HINT-1-K-MEASURE ( A B C D X ) (IF (NOT (ILESSP (ITIMES B (IPLUS -1 C)) D)) T (IF (ILESSP A X) T (INDUCT-HINT-1-K-MEASURE A B C D (IPLUS X (IDIFFERENCE D (ITIMES B (IPLUS -1 C))))))) ; hint ( (LESSP (K-MEASURE A X)) )) (PROVE-LEMMA ITERK_C&D-IFF-ITERK_1&D-C-1_B-WHEN-0 0, c > 1, b > 0, and (c-1)b < d, then ; K( a,b,c,d,x ) exists if and only if ; K( a,b,1,d-(c-1)b,x ) exists and ; K( a,b,c,d,x ) = K( a,b,1,d-(c-1)b,x ). ; Proof. By Lemma 16. (PROVE-LEMMA K_C&D-IFF-K_1&D-C-1_B-WHEN-0 0, c > 1, b > 0, and (c-1)b < d, then ; K( a,b,c,d,x ) exists. ; Proof. By Lemma 17. (PROVE-LEMMA K-EXISTS-WHEN-0= x, and IterK( a,b,c,d,1,x ) exists. ; Then IterK( a,b,c,d,1,x+d ) exists ; and ; cost[ IterK( a,b,c,d,1,x+d ) ] ; < ; cost[ IterK( a,b,c,d,1,x ) ] ; Proof. By the definition of IterK and Lemma 2. (PROVE-LEMMA ITERK-X+D-EXISTS-WHEN-ITERK-EXISTS&1=X (REWRITE) (IMPLIES (AND (ILESSP 1 C) (NOT (ILESSP A X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS D X) 0)))) ; hint ( (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X) )) (PROVE-LEMMA ITERK-X+D-COST=X (REWRITE) (IMPLIES (AND (ILESSP 1 C) (NOT (ILESSP A X)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (LESSP (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS D X) 0)))) (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) ; hint ( (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 19. The cost of computing K is lowered ; when K is iterated c times and ; "enough" d's are added to x. ; Assume 1 < c, a >= x, 0 < d, and ; IterK( a,b,c,d,1,x ) exists. ; Then IterK( a,b,c,d,c,x+N( a,d,x )d ) exists ; and ; cost[ IterK( a,b,c,d,c,x+N( a,d,x )d ) ] ; < ; cost[ IterK( a,b,c,d,1,x ) ] ; Proof. Hold a fixed and induct on the ; value given by ; if x > a then 0 ; else 1 + a - x. (PROVE-LEMMA N=1-WHEN-X+D>A&A>=X&D>0 ( REWRITE ) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X)) (ILESSP A (IPLUS D X))) (EQUAL (N A D X) 1))) (DEFN INDUCT-HINT-2-K-MEASURE ( A D X ) (IF (NOT (ILESSP 0 D)) T (IF (ILESSP A X) T (IF (ILESSP A (IPLUS D X)) T (INDUCT-HINT-2-K-MEASURE A D (IPLUS D X))))) ; hint ( (LESSP (K-MEASURE A X)) )) (PROVE-LEMMA ITERK-X+ND-EXISTS-WHEN-ITERK-EXISTS&1=X&0=X ITERK-E&X-IFF-ITERK_E+_N_C-1&X+ND-WHEN-1=X&E>1 ITERK-E&X-IFF-ITERK_-1+E+_N_C-1&X+ND-B-WHEN-1=X&E>1 ITERK_E=1+_N_C-1&X+ND-EXISTS-BASE-STEP ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) (PROVE-LEMMA ITERK-X+ND-COST=X&0=X ITERK-E&X-IFF-ITERK_E+_N_C-1&X+ND-WHEN-1=X&E>1 ITERK-E&X-IFF-ITERK_-1+E+_N_C-1&X+ND-B-WHEN-1=X&E>1 ITERK_E=1+_N_C-1&X+ND-EXISTS-BASE-STEP ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 20. The number of iterates of K can be ; reduced to 1 if "enough" b's are ; sutracted from x. ; Assume 0 < b, 1 < c, 0 < d, 1 < e, 0 < i < e, ; and IterK( a,b,c,d,e,x ) exists. ; Then IterK( a,b,c,d,1,x-ib ) exists. ; Proof. By Lemma 14 and Lemma 2. (PROVE-LEMMA E-I=1-WHEN-1+I>=E&IBODY-COST-WHEN-E>1-VERSION-2 (E 2)) (EQ-ARGS-COST-DEPENDS-ON-COST-OF-ARGS (FN 'ITERK) (ARGS1 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (INEG B)) 0))) (ARGS2 (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))))) )) (PROVE-LEMMA FIX-INT-X=X-WHEN-0BODY-COST-WHEN-E>1-VERSION-2 (E (IPLUS 1 I)))) )) (PROVE-LEMMA ITERK_I_X-IFF-ITERK_1_X-IB-WHEN-00&I<>1 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 I) (NOT (EQUAL I 1))) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS I 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (INEG (ITIMES B (IPLUS -1 I)))) 0))))) ; hint ( (USE (ITERK_E_X-IFF-ITERK_E-J_X-JB-WHEN-00&I<>1 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 I) (NOT (EQUAL I 1))) (EQUAL (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS I 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (INEG (ITIMES B (IPLUS -1 I)))) 0)))))) ; hint ( (USE (ITERK_E_X=ITERK_E-J_X-JB-WHEN-00 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 I)) (IFF (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS (IPLUS 1 I) 0) (CONS X 0))) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS (IPLUS X (INEG (ITIMES B I))) 0))))) ; hint ( (DISABLE NBR-OF-ITERATES-SUM-EXISTS&VALUES ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X) )) (PROVE-LEMMA ITERK_1_X-IB_COST0 (A A)) (ITERK_1_X-IB_COST1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (USE (ITERK-AT-E1-EXISTS-WHEN-ITERK-AT-E2-EXISTS&00) (USE (ITERK-E=I-EXISTS-WHEN-ITERK-E=I+1-EXISTS (A A)) (ITERK_1_X-IB_COST0) (HANDS-OFF V&C-APPLY$) )) (PROVE-LEMMA ITERK_1_X-IB_COST0) (HANDS-OFF V&C-APPLY$) )) (PROVE-LEMMA E=I+1-OR-E>I+1-WHEN-E>I>0 NIL (IMPLIES (AND (ILESSP 0 I) (ILESSP I E)) (OR (EQUAL E (IPLUS 1 I)) (ILESSP (IPLUS 1 I) E))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERK_1_X-IB_COSTI+1-WHEN-E>I>0 (E E)) (ITERK_1_X-IB_COST0) (DISABLE-THEORY INTEGERS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define the function J( a,b,x ) recursively, ; so that whenever b > 0, J( a,b,x ) is the smallest ; nonnegative integer i such that x <= a + ib. (DEFN HOW-FAR-ABOVE-A ( A X ) (IF (NOT (ILESSP A X)) 0 (IPLUS X (INEG A)))) (PROVE-LEMMA NUMBERP_X-A_WHEN_X>A (REWRITE) (IMPLIES (ILESSP A X) (NUMBERP (IPLUS X (INEG A)))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA X-A-BX-WHEN-A=0 (REWRITE) (NOT (ILESSP (J A B X) 0))) (PROVE-LEMMA J>0-WHEN-X>A&B>0 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP A X)) (ILESSP 0 (J A B X)))) (PROVE-LEMMA X<=A+JB-WHEN-01&A+_C-1_B>=X (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP A X) (NOT (ILESSP (IPLUS A (ITIMES B (IPLUS -1 C))) X))) (ILESSP (J A B X) C)) ; hint ( (USE (X= x, ; and IterK( a,b,c,d,c,x ) exists. ; Then IterK( a,b,c,d,1,x-J( a,b,x )b ) exists ; and ; cost[ IterK( a,b,c,d,1,x-J( a,b,x )b ) ] ; < ; cost[ IterK( a,b,c,d,c,x ) ] ; Proof. By Lemma 22 and the definition of J. (PROVE-LEMMA ITERK_1_X-JB-EXISTS-WHEN-ITERK_E=C_X-EXISTS&0A ITERK_E_X-IFF-ITERK_E-1_X-B-WHEN-1A-STEP-1 ITERK-E-X-IFF-ITERK-E-1-ITERK-1-X ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-3 ITERK-EXISTS-IFF-BODY-EXISTS-WHEN-E>1-VERSION-2) (HANDS-OFF V&C-APPLY$) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define the function L( a,b,d,x ) to be the following ; combination of x, b, d, and the functions J and N: ; x + N( a,d,x ) d - J( a,b,x+N( a,d,x )d ) b. (DEFN L ( A B D X ) (IPLUS (IPLUS X (ITIMES D (N A D X))) (INEG (ITIMES B (J A B (IPLUS X (ITIMES D (N A D X)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Lemma 24. Computing K with L( a,b,d,x ) is cheaper ; than computing K with x. ; Assume 0 < b, 1 < c, 0 < d, a >= x, (c-1)b >= d, ; and IterK( a,b,c,d,1,x ) exists. ; Then IterK( a,b,c,d,1,L( a,b,d,x ) ) exists ; and ; cost[ IterK( a,b,c,d,1,L( a,b,d,x ) ) ] ; < ; cost[ IterK( a,b,c,d,1,x ) ] ; Proof. By Lemma 19 and Lemma 23. (PROVE-LEMMA X>=Z-WHEN-X>=Y&Y>=Z NIL (IMPLIES (AND (NOT (ILESSP X Y)) (NOT (ILESSP Y Z))) (NOT (ILESSP X Z))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA A+_C-1_B>=X+ND-WHEN-0=X&_C-1_B>=D (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X)) (NOT (ILESSP (ITIMES B (IPLUS -1 C)) D))) (NOT (ILESSP (IPLUS A (ITIMES B (IPLUS -1 C))) (IPLUS X (ITIMES D (N A D X)))))) ; hint ( (USE (X>=Z-WHEN-X>=Y&Y>=Z (X (IPLUS A (ITIMES B (IPLUS -1 C)))) (Y (IPLUS A D)) (Z (IPLUS X (ITIMES D (N A D X)))))) )) (PROVE-LEMMA ITERK-L-EXISTS-WHEN-ITERK-X-EXISTS&0=X&0=X+ND-WHEN-0=X&_C-1_B>=D (A A)) (A=X&0=X&0=X+ND-WHEN-0=X&_C-1_B>=D (A A)) (A= d ; Assume 0 < b, 1 < c, 0 < d, a >= x, (c-1)b >= d, ; i > 0, and IterK( a,b,c,d,1,x ) exists. ; Then IterK( a,b,c,d,1,IterL( i,a,b,d,x ) ) exists ; and ; cost[ IterK( a,b,c,d,1,IterL( i,a,b,d,x ) ) ] + i-1 ; < ; cost[ IterK( a,b,c,d,1,x ) ] ; Proof. By induction on i using Lemma 24. (PROVE-LEMMA ITERK-ITERL-EXISTS-WHEN-ITERK-X-EXISTS&0=D&X<=A&ETC (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (ILESSP 0 I) (NOT (ILESSP A X)) (NOT (ILESSP (ITIMES B (IPLUS -1 C)) D)) (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))) (LESSP I (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))) ; hint ( (USE (I=D&X<=A&ETC (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X)) (NOT (ILESSP (ITIMES B (IPLUS -1 C)) D))) (NOT (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0))))) ; hint ( (USE (ITERK-COST-IS-UNBOUNDED-WHEN-_C-1_B>=D&X<=A&ETC (I (ADD1 (CDR (V&C-APPLY$ 'ITERK (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) '(1 . 0) (CONS X 0)))))))) (DISABLE-THEORY INTEGERS) (HANDS-OFF V&C-APPLY$) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The next two events are versions of Part 9 of the ; Main Theorem given above in the introduction. ; 9. If x <= a, d > 0, c > 1, b > 0, and ; (c-1)b >= d, then K( a,b,c,d,x ) does ; not exist. ; Proof. By Lemma 25 and the definition of K. (PROVE-LEMMA K-DOES-NOT-EXIST-WHEN-_C-1_B>=D&X<=A&ETC (REWRITE) (IMPLIES (AND (ILESSP 0 B) (ILESSP 1 C) (ILESSP 0 D) (NOT (ILESSP A X)) (NOT (ILESSP (ITIMES B (IPLUS -1 C)) D))) (NOT (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0))))) ; hint ( (EXPAND (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) (CONS C 0) (CONS D 0) (CONS X 0)))) (DISABLE-THEORY INTEGERS) (DISABLE K_X-IFF-K_X+D_C-1_B-WHEN-0=X-VERSION-3 K_X-IFF-K_X+D_C-1_B-WHEN-0=X-VERSION-2 K_X-IFF-K_X+D_C-1_B-WHEN-0=X) )) (PROVE-LEMMA K-DOES-NOT-HALT-WHEN-_C-1_B>=D&X<=A&ETC (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D)) (NOT (ILESSP (CAR VC-A) (CAR VC-X))) (NOT (ILESSP (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))) (CAR VC-D)))) (NOT (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X)))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-EXISTENCE (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) (CONS (CAR VC-C) 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X)))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Here a quantifier is used to define the concept that K ; is a total function of x with parameters a,b,c, and d. ; This is the only place in this file of events that ; an explicit quantifier is used. (DEFN-SK K-IS-TOTAL ( VC-A VC-B VC-C VC-D ) (FORALL VC-X (IMPLIES VC-X (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))))) (PROVE-LEMMA K-IS-TOTAL-SUFF (REWRITE) (IMPLIES (IMPLIES (VC-X VC-A VC-B VC-C VC-D) (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D (VC-X VC-A VC-B VC-C VC-D)))) (K-IS-TOTAL VC-A VC-B VC-C VC-D))) (PROVE-LEMMA K-IS-TOTAL-NECC (REWRITE) (IMPLIES (NOT (IMPLIES VC-X (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X)))) (NOT (K-IS-TOTAL VC-A VC-B VC-C VC-D))) ; hint ( (USE (K-IS-TOTAL (VC-A VC-A))) )) (DISABLE K) (DISABLE K-IS-TOTAL) (PROVE-LEMMA KNUTH-THEOREM-IF-PART-CASE-1 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D))) (IMPLIES (ILESSP (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))) (CAR VC-D)) (K-IS-TOTAL VC-A VC-B VC-C VC-D))) ; hint ( (USE (K-HALTS-WHEN-00&C<=1 (VC-X (VC-X VC-A VC-B VC-C VC-D))) (K-HALTS-WHEN-X>A (VC-X (VC-X VC-A VC-B VC-C VC-D)))) )) (PROVE-LEMMA KNUTH-THEOREM-IF-PART (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D (ILESSP 0 (CAR VC-B)) (ILESSP 0 (CAR VC-D))) (IMPLIES (ILESSP (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))) (CAR VC-D)) (K-IS-TOTAL VC-A VC-B VC-C VC-D))) ; hint ( (USE (KNUTH-THEOREM-IF-PART-CASE-1 (VC-A VC-A))) )) (PROVE-LEMMA KNUTH-THEOREM-ONLY-IF-PART-CASE-1 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D (ILESSP 0 (CAR VC-B)) (ILESSP 1 (CAR VC-C)) (ILESSP 0 (CAR VC-D))) (IMPLIES (K-IS-TOTAL VC-A VC-B VC-C VC-D) (ILESSP (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))) (CAR VC-D)))) ; hint ( (USE (K-IS-TOTAL-NECC (VC-X VC-A)) (K-DOES-NOT-HALT-WHEN-_C-1_B>=D&X<=A&ETC (VC-X VC-A))) )) (PROVE-LEMMA KNUTH-THEOREM-ONLY-IF-PART-CASE-2 (REWRITE) (IMPLIES (AND (ILESSP 0 B) (NOT (ILESSP 1 C)) (ILESSP 0 D)) (ILESSP (ITIMES B (IPLUS -1 C)) D)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA KNUTH-THEOREM-ONLY-IF-PART (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D (ILESSP 0 (CAR VC-B)) (ILESSP 0 (CAR VC-D))) (IMPLIES (K-IS-TOTAL VC-A VC-B VC-C VC-D) (ILESSP (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))) (CAR VC-D)))) ; hint ( (USE (KNUTH-THEOREM-ONLY-IF-PART-CASE-1 (VC-A VC-A))) (DISABLE-THEORY INTEGERS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Here is a version of Knuth's theorem: ; Theorem. The generalized 91 recursion with parameters ( a,b,c,d ) ; defines a total function on the integers if and only if ; (c-1)b < d. (PROVE-LEMMA KNUTH-THEOREM (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D (ILESSP 0 (CAR VC-B)) (ILESSP 0 (CAR VC-D))) (IFF (K-IS-TOTAL VC-A VC-B VC-C VC-D) (ILESSP (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))) (CAR VC-D)))) ; hint ( (USE (KNUTH-THEOREM-ONLY-IF-PART (VC-A VC-A))) (DISABLE-THEORY INTEGERS) )) (PROVE-LEMMA K-VALUE-WHEN-A=X&C=1 (REWRITE) (IMPLIES (NOT (ILESSP A X)) (EQUAL (CAR (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) '(1 . 0) (CONS D 0) (CONS X 0)))) (CAR (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) '(1 . 0) (CONS D 0) (CONS (IPLUS X D) 0)))))) ; hint ( (USE (ITERK-VALUE=BODY-VALUE-WHEN-E<=1&A>=X-VERSION-2 (C 1) (E 1))) (EXPAND (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) '(1 . 0) (CONS D 0) (CONS X 0))) (V&C-APPLY$ 'K (LIST (CONS A 0) (CONS B 0) '(1 . 0) (CONS D 0) (CONS (IPLUS D X) 0)))) )) (PROVE-LEMMA K-VALUE=BODY-VALUE-WHEN-A>=X&C=1-VERSION-2 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (EQUAL (CAR VC-C) 1) (NOT (ILESSP (CAR VC-A) (CAR VC-X)))) (EQUAL (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))) (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (CAR VC-D)) COST)))))) ; hint ( (USE (EQ-ARGS-GIVE-EQ-VALUES (FN 'K) (ARGS1 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) '(1 . 0) (CONS (CAR VC-D) 0) (CONS (CAR VC-X) 0))) (ARGS2 (LIST VC-A VC-B VC-C VC-D VC-X))) (EQ-ARGS-GIVE-EQ-VALUES (FN 'K) (ARGS1 (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (CAR VC-D)) COST))) (ARGS2 (LIST (CONS (CAR VC-A) 0) (CONS (CAR VC-B) 0) '(1 . 0) (CONS (CAR VC-D) 0) (CONS (IPLUS (CAR VC-X) (CAR VC-D)) 0))))) )) (PROVE-LEMMA KNUTH-THEOREM-PART-2-CASE-2 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (EQUAL (CAR VC-C) 1)) (EQUAL (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))) (IF (ILESSP (CAR VC-A)(CAR VC-X)) (IDIFFERENCE (CAR VC-X) (CAR VC-B)) (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) COST)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Here is a version of that part of Knuth's theorem ; which gives the circumstances when K satisfies a ; simpler recurrence. ; Theorem. In such a case the values of K( x ) also ; satisfy the much simpler recurrence ; K( x ) = if x > a then x - b ; else K( x+d-(c-1)b ). (PROVE-LEMMA KNUTH-THEOREM-PART-2 (REWRITE) (IMPLIES (AND VC-A VC-B VC-C VC-D VC-X (ILESSP 0 (CAR VC-B)) (ILESSP 0 (CAR VC-C)) (ILESSP 0 (CAR VC-D))) (EQUAL (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D VC-X))) (IF (ILESSP (CAR VC-A)(CAR VC-X)) (IDIFFERENCE (CAR VC-X) (CAR VC-B)) (CAR (V&C-APPLY$ 'K (LIST VC-A VC-B VC-C VC-D (CONS (IPLUS (CAR VC-X) (IDIFFERENCE (CAR VC-D) (ITIMES (CAR VC-B) (IPLUS -1 (CAR VC-C))))) COST))))))) ; hint ( (USE (KNUTH-THEOREM-PART-2-CASE-1 (VC-A VC-A)) (KNUTH-THEOREM-PART-2-CASE-2 (VC-A VC-A))) )) ========================= knuth-91a.events ========================= ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; In an unpublished paper, Textbook Examples of Recursion, Donald E. ; Knuth of Stanford University gives the following generalization of ; McCarthy's 91 function: ; Let a be a real, let b and d be positive reals, and let c be a ; positive integer. ; Define K( x ) for integer inputs x by ; K( x ) <== if x > a then x - b ; else K( ... K( x+d ) ... ). ; Here the else-clause in this definition has c applications of the ; function K. ; When a = 100, b = 10, c = 2, and d = 11, the definition specializes ; to McCarthy's original 91 function: ; K( x ) <== if x > 100 then x - 10 ; else K( K( x+11 ) ). ; Knuth calls the first definition of K given above, the generalized ; 91 recursion scheme with parameters ( a,b,c,d ). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The purpose of this file of Boyer-Moore-Kaufmann events is to ; provide mechanical verification of the following theorem given by ; Knuth in his paper. ; Theorem. The generalized 91 recursion with parameters ( a,b,c,d ) ; defines a total function on the integers if and only if ; (c-1)b < d. In such a case the values of K( x ) also ; satisfy the much simpler recurrence ; K( x ) = if x > a then x - b ; else K( x+d-(c-1)b ). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Use the library of integer facts. (NOTE-LIB "integers") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Introduce a new function FN of one argument with ; no constraints. (CONSTRAIN FN-INTRO (REWRITE) T ((FN (LAMBDA (X) X)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Recursively define what it means to ; iterate applications of FN. (DEFN ITER-FN ( I X ) (IF (ZEROP I) X (FN (ITER-FN (SUB1 I) X)))) (PROVE-LEMMA ITER-FN=FN (REWRITE) (EQUAL (ITER-FN 1 X)(FN X)) ; hint ( (EXPAND (ITER-FN 1 X)) )) (PROVE-LEMMA ITER-FN-SUM (REWRITE) (EQUAL (ITER-FN I (ITER-FN J X)) (ITER-FN (PLUS I J) X))) (PROVE-LEMMA ITER-FN-SUM-INTEGER (REWRITE) (IMPLIES (AND (ILESSP 0 I) (ILESSP 0 J)) (EQUAL (ITER-FN I (ITER-FN J X)) (ITER-FN (IPLUS I J) X))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Introduce new constants (ie., functions with no arguments) ; P, Q, R, and S with the indicated constaints (CONSTRAIN P-Q-R-S-INTRO (REWRITE) (AND (INTEGERP (P)) (INTEGERP (Q)) (INTEGERP (R)) (INTEGERP (S)) (NOT (ILESSP (Q) 0)) (NOT (ILESSP (P)(S)))) ((P (LAMBDA () 1)) (Q (LAMBDA () 0)) (R (LAMBDA () 0)) (S (LAMBDA () 0)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define a "general Knuth" function, GK, of one argument ; which will be used later to help witness the existence ; of functions which satisfy the defining recursion of ; the generalized 91 function. (DEFN K-MEASURE ( A X ) (IF (ILESSP A X) 0 (IPLUS 1 (IPLUS A (INEG X))))) (PROVE-LEMMA K-MEASURE-RETURNS-NUMBERP (REWRITE) (NUMBERP (K-MEASURE A X)) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA K-MEASURE-X+Y0-WHEN-N>0&N<>1 (REWRITE) (IMPLIES (AND (ILESSP 0 N) (NOT (EQUAL N 1))) (ILESSP 0 (IPLUS -1 N))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA X<=Z-WHEN-X=X+_N-1_R-WHEN-P+R>=X+NR NIL (IMPLIES (AND (ILESSP 0 (R)) (NOT (ILESSP (IPLUS (P) (R)) (IPLUS X (ITIMES N (R)))))) (NOT (ILESSP (IPLUS (P) (R)) (IPLUS X (ITIMES (IPLUS -1 N) (R)))))) ; hint ( (USE (X<=Z-WHEN-X=Y-Z-WHEN-X+Z>=Y NIL (IMPLIES (NOT (ILESSP (IPLUS X Z) Y)) (NOT (ILESSP X (IPLUS Y (INEG Z)))))) (PROVE-LEMMA ITERGK-X=ITERGK-X+NR-INDUCTION-STEP (REWRITE) (IMPLIES (AND (ILESSP 0 N) (NOT (EQUAL N 1)) (IMPLIES (AND (LESSP 0 I) (ILESSP 0 (R)) (ILESSP 0 (IPLUS -1 N)) (NOT (ILESSP (IPLUS (P) (R)) (IPLUS X (ITIMES (IPLUS -1 N) (R)))))) (EQUAL (ITER-GK I X) (ITER-GK I (IPLUS X (ITIMES (IPLUS -1 N) (R)))))) (LESSP 0 I) (ILESSP 0 (R)) (NOT (ILESSP (IPLUS (P) (R)) (IPLUS X (ITIMES N (R)))))) (EQUAL (EQUAL (ITER-GK I X) (ITER-GK I (IPLUS X (ITIMES (R) N)))) T)) ; hint ( (USE (P+R>=X+_N-1_R-WHEN-P+R>=X+NR (A A)) (ITERGK-X=ITERGK-X+R (X (IPLUS (INEG (R)) (IPLUS X (ITIMES (R) N))))) (X>=Y-Z-WHEN-X+Z>=Y (X (P))(Z (R)) (Y (IPLUS X (ITIMES (R) N))))) )) (PROVE-LEMMA ITERGK-X=ITERGK-X+NR (REWRITE) (IMPLIES (AND (LESSP 0 I) (ILESSP 0 (R)) (ILESSP 0 N) (NOT (ILESSP (IPLUS (P)(R)) (IPLUS X (ITIMES N (R)))))) (EQUAL (ITER-GK I X) (ITER-GK I (IPLUS X (ITIMES N (R)))))) ; hint ( (INDUCT (INDUCT-HINT-POS-INT N)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define the function N( a,d,x ) recursively, ; so that whenever d > 0, N( a,d,x ) is the smallest ; nonnegative integer i such that x + id > a. (DEFN N ( A D X ) (IF (NOT (ILESSP 0 D)) 0 (IF (ILESSP A X) 0 (IPLUS 1 (N A D (IPLUS X D))))) ; hint ( (LESSP (K-MEASURE A X)) )) (PROVE-LEMMA N>=0 (REWRITE) (NOT (ILESSP (N A D X) 0))) (PROVE-LEMMA N>0-WHEN-D>O&X<=A (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X))) (ILESSP 0 (N A D X)))) (PROVE-LEMMA A=X+ND-WHEN-D>0&A>=X (REWRITE) (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP A X))) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES (N A D X) D)))))) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q+NR-STEP-1 (REWRITE) (IMPLIES (AND (LESSP 0 I) (ILESSP 0 (R)) (NOT (ILESSP (P) X))) (EQUAL (ITER-GK I X) (ITER-GK I (IPLUS X (ITIMES (R) (N (P)(R) X)))))) ; hint ( (USE (ITERGK-X=ITERGK-X+NR (N (N (P)(R) X))) (A+D>=X+ND-WHEN-D>0&A>=X (A (P)) (D (R)))) )) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q+NR-STEP-2 (REWRITE) (IMPLIES (LESSP 0 I) (EQUAL (ITER-GK I (IPLUS X (ITIMES (R) (N (P)(R) X)))) (ITER-GK (SUB1 I) (GK (IPLUS X (ITIMES (R) (N (P)(R) X)))))))) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q+NR-STEP-3 (REWRITE) (IMPLIES (AND (LESSP 0 I) (ILESSP 0 (R)) (NOT (ILESSP (P) X))) (EQUAL (ITER-GK (SUB1 I) (GK (IPLUS X (ITIMES (R) (N (P)(R) X))))) (ITER-GK (SUB1 I) (IPLUS X (IPLUS (INEG (Q)) (ITIMES (R) (N (P)(R) X))))))) ; hint ( (USE (A=Z-WHEN-X>=Y&Y>=Z NIL (IMPLIES (AND (NOT (ILESSP X Y)) (NOT (ILESSP Y Z))) (NOT (ILESSP X Z))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA X+Y>=X+-Z+Y-WHEN-Z>=0 NIL (IMPLIES (NOT (ILESSP Z 0)) (NOT (ILESSP (IPLUS X Y) (IPLUS (IPLUS X (INEG Z)) Y))))) (PROVE-LEMMA ITERGK_I-1_X-Q=ITERGK_I-1_X-Q+NR (REWRITE) (IMPLIES (AND (LESSP 1 I) (ILESSP 0 (R)) (NOT (ILESSP (P) X))) (EQUAL (ITER-GK (SUB1 I) (IPLUS X (INEG (Q)))) (ITER-GK (SUB1 I) (IPLUS X (IPLUS (INEG (Q)) (ITIMES (R) (N (P)(R) X))))))) ; hint ( (USE (ITERGK-X=ITERGK-X+NR (I (SUB1 I)) (N (N (P) (R) X)) (X (IPLUS X (INEG (Q))))) (A+D>=X+ND-WHEN-D>0&A>=X (A (P)) (D (R))) (X>=Z-WHEN-X>=Y&Y>=Z (X (IPLUS (P) (R))) (Y (IPLUS X (ITIMES (N (P) (R) X) (R)))) (Z (IPLUS (IPLUS X (INEG (Q))) (ITIMES (N (P) (R) X) (R))))) (X+Y>=X+-Z+Y-WHEN-Z>=0 (Y (ITIMES (N (P) (R) X) (R))) (Z (Q)))) )) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q-WHEN-P>=X&R>0 (REWRITE) (IMPLIES (AND (LESSP 1 I) (ILESSP 0 (R)) (NOT (ILESSP (P) X))) (EQUAL (ITER-GK I X) (ITER-GK (SUB1 I) (IPLUS X (INEG (Q)))))) ; hint ( (USE (ITERGK_I-1_X-Q=ITERGK_I-1_X-Q+NR (A A))) )) (PROVE-LEMMA ITERGK=S-WHEN-P>=X&0>=R&0=X+-Y-WHEN-Y>=0 NIL (IMPLIES (NOT (ILESSP Y 0)) (NOT (ILESSP X (IPLUS X (INEG Y)))))) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q-WHEN-P>=X&0>=R (REWRITE) (IMPLIES (AND (LESSP 1 I) (NOT (ILESSP 0 (R))) (NOT (ILESSP (P) X))) (EQUAL (ITER-GK I X) (ITER-GK (SUB1 I) (IPLUS X (INEG (Q)))))) ; hint ( (USE (ITERGK=S-WHEN-P>=X&0>=R&0=Z-WHEN-X>=Y&Y>=Z (X (P)) (Y X) (Z (IPLUS X (INEG (Q))))) (X>=X+-Y-WHEN-Y>=0 (Y (Q)))) )) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q-WHEN-P=X&R>0 (A A)) (ITERGK_I_X=ITERGK_I-1_X-Q-WHEN-P>=X&0>=R (A A))) )) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-1_X-Q-INTEGER (REWRITE) (IMPLIES (ILESSP 1 I) (EQUAL (ITER-GK I X) (ITER-GK (IPLUS -1 I) (IPLUS X (INEG (Q)))))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ONE-ONE+Y=Y (REWRITE) (IMPLIES (INTEGERP Y) (EQUAL (IPLUS 1 (IPLUS -1 Y)) Y))) (PROVE-LEMMA ITERGK_I_X=ITERGK_I-J_X-JQ (REWRITE) (IMPLIES (AND (ILESSP 0 J) (ILESSP J I)) (EQUAL (ITER-GK I X) (ITER-GK (IPLUS I (INEG J)) (IPLUS X (INEG (ITIMES J (Q))))))) ; hint ( (INDUCT (INDUCT-HINT-POS-INT J)) )) (PROVE-LEMMA ITERGK_I_X=GK_X-_I-1_Q-WHEN-I>1 (REWRITE) (IMPLIES (ILESSP 1 I) (EQUAL (ITER-GK I X) (GK (IPLUS X (INEG (ITIMES (IPLUS -1 I)(Q))))))) ; hint ( (USE (ITERGK_I_X=ITERGK_I-J_X-JQ (J (IPLUS -1 I)))) )) (PROVE-LEMMA X=1-OR-X>1-WHEN-X>0 NIL (IMPLIES (ILESSP 0 X) (OR (EQUAL X 1) (ILESSP 1 X))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERGK_I_X=GK_X-_I-1_Q (REWRITE) (IMPLIES (ILESSP 0 I) (EQUAL (ITER-GK I X) (GK (IPLUS X (INEG (ITIMES (IPLUS -1 I)(Q))))))) ; hint ( (USE (X=1-OR-X>1-WHEN-X>0 (X I))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Introduce new constants (ie., functions with no arguments) ; A, B, C, and E with the indicated constaints. (CONSTRAIN A-B-C-D-INTRO (REWRITE) (AND (INTEGERP (A)) (INTEGERP (B)) (INTEGERP (C)) (INTEGERP (D)) (ILESSP 0 (B)) (ILESSP 0 (C)) (ILESSP 0 (D))) ((A (LAMBDA () 1)) (B (LAMBDA () 1)) (C (LAMBDA () 1)) (D (LAMBDA () 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Define two functions K and K1 which will be shown to satisfy ; the generalized 91 recursion scheme with parameters ; ( (A),(B),(C),(D) ). #| The following is the original version, which failed to be the correct lemma for the acceptance of the definition of K in Nqthm-1992. Following that is a new version. (PROVE-LEMMA K-MEASURE-DECREASES-DEFN-K&K1 (REWRITE) (IMPLIES (AND (NOT (ILESSP (A) X)) (ILESSP 0 (IPLUS (D) (IPLUS (INEG (ITIMES (B) (C))) (INEG (ITIMES (B) -1)))))) (LESSP (K-MEASURE (A) (IPLUS (D) (IPLUS (INEG (ITIMES (B) (C))) (IPLUS (INEG (ITIMES (B) -1)) X)))) (K-MEASURE (A) X))) ; hint ( (USE (K-MEASURE-X+Y=X (REWRITE) (NOT (ILESSP X X))) (FUNCTIONALLY-INSTANTIATE ITERK_I_X=K_X-_I-1_B (REWRITE) (IMPLIES (ILESSP 0 I) (EQUAL (ITER-K I X) (K (IPLUS X (INEG (ITIMES (IPLUS -1 I)(B))))))) ITERGK_I_X=GK_X-_I-1_Q ((GK K)(ITER-GK ITER-K)(P A)(Q B)(S A) (R (LAMBDA () (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))))) (PROVE-LEMMA X>=X-Y-WHEN-Y>0 (REWRITE) (IMPLIES (ILESSP 0 Y) (NOT (ILESSP X (IPLUS X (INEG Y)))))) (FUNCTIONALLY-INSTANTIATE ITERK1_I_X=K1_X-_I-1_B (REWRITE) (IMPLIES (ILESSP 0 I) (EQUAL (ITER-K1 I X) (K1 (IPLUS X (INEG (ITIMES (IPLUS -1 I)(B))))))) ITERGK_I_X=GK_X-_I-1_Q ((GK K1)(ITER-GK ITER-K1)(P A)(Q B) (S (LAMBDA () (IPLUS (A) (INEG (B))))) (R (LAMBDA () (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The two functions K and K1 satisfy the generalized 91 ; recursion scheme with parameters ( (A),(B),(C),(D) ): (PROVE-LEMMA X>=Y+Z-WHEN-X>=Y&0>=Z NIL (IMPLIES (AND (NOT (ILESSP X Y)) (NOT (ILESSP 0 Z))) (NOT (ILESSP X (IPLUS Y Z)))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA GK_X+R=S-WHEN-P>=X&0>=R NIL (IMPLIES (AND (NOT (ILESSP (P) X)) (NOT (ILESSP 0 (R)))) (EQUAL (GK (IPLUS X (R))) (S))) ; hint ( (USE (X>=Y+Z-WHEN-X>=Y&0>=Z (X (P)) (Y X) (Z (R)))) )) (FUNCTIONALLY-INSTANTIATE K_X+D-_C-1_B=A-WHEN-A>=X&0>=D-_C-1_B NIL (IMPLIES (AND (NOT (ILESSP (A) X)) (NOT (ILESSP 0 (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C)))))))) (EQUAL (K (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))) (A))) GK_X+R=S-WHEN-P>=X&0>=R ((GK K)(P A)(Q B)(S A) (R (LAMBDA () (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))))) (FUNCTIONALLY-INSTANTIATE K1_X+D-_C-1_B=A-B-WHEN-A>=X&0>=D-_C-1_B NIL (IMPLIES (AND (NOT (ILESSP (A) X)) (NOT (ILESSP 0 (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C)))))))) (EQUAL (K1 (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))) (IPLUS (A) (INEG (B))))) GK_X+R=S-WHEN-P>=X&0>=R ((GK K1)(P A)(Q B) (S (LAMBDA () (IPLUS (A) (INEG (B))))) (R (LAMBDA () (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C)))))))) ) (PROVE-LEMMA ITIMES2--1 (REWRITE) (EQUAL (ITIMES X -1) (INEG X))) (PROVE-LEMMA K-SATISFIES-GEN-91-RECURSION (REWRITE) (EQUAL (K X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (ITER-K (C) (IPLUS X (D))))) ; hint ( (USE (K_X+D-_C-1_B=A-WHEN-A>=X&0>=D-_C-1_B (A A))) )) (PROVE-LEMMA K1-SATISFIES-GEN-91-RECURSION (REWRITE) (EQUAL (K1 X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (ITER-K1 (C) (IPLUS X (D))))) ; hint ( (USE (K1_X+D-_C-1_B=A-B-WHEN-A>=X&0>=D-_C-1_B (A A))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; So now that it has been verified that the two functions ; K and K1 satisfy the generalized 91 recursion scheme ; with parameters ( (A),(B),(C),(D) ); we now verify that ; the two functions are not the same when ; (D) <= (B)[(C)-1]. (PROVE-LEMMA X-Y<=0-WHEN-X<=Y NIL (IMPLIES (NOT (ILESSP Y X)) (NOT (ILESSP 0 (IPLUS X (INEG Y)))))) (PROVE-LEMMA X-Y=X&0>=R (A A))) )) (DISABLE K-SATISFIES-GEN-91-RECURSION) (DISABLE K1-SATISFIES-GEN-91-RECURSION) (FUNCTIONALLY-INSTANTIATE K-SATISFIES-SIMPLE-RECURSION NIL (EQUAL (K X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (K (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))))) GK-VERSION-OF-SIMPLE-RECURSION ((GK K)(P A)(Q B)(S A) (R (LAMBDA () (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))))) (CONSTRAIN G-SATISFIES-SIMPLE-RECURSION (REWRITE) (EQUAL (G X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (G (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS -1 (C))))))))) ((G K)) ; hint ( (USE (K-SATISFIES-SIMPLE-RECURSION (A A))) )) (PROVE-LEMMA G=X-B-WHEN-A0-WHEN-Y0-WHEN-Y0-WHEN-Y=X (REWRITE) (IMPLIES (NOT (ILESSP (A) X)) (EQUAL (H X) (ITER-H (C) (IPLUS (D) X)))) ; hint ( (HANDS-OFF ITER-H) )) (PROVE-LEMMA ITERH=X-WHEN-I-IS-ZEROP (REWRITE) (IMPLIES (ZEROP I) (EQUAL (ITER-H I X) X))) (DISABLE H-SATISFIES-GEN-91-RECURSION) (PROVE-LEMMA ITERH=H-ITER-H-WHEN-NOT-ZEROP-I (REWRITE) (IMPLIES (NOT (ZEROP I)) (EQUAL (ITER-H I X) (H (ITER-H (SUB1 I) X)))) ; hint ( (USE (H-SATISFIES-GEN-91-RECURSION (A A))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; To prevent looping at least one of the following ; should be disabled: (DISABLE H=ITERH-WHEN-A>=X) (DISABLE ITERH=H-ITER-H-WHEN-NOT-ZEROP-I) (FUNCTIONALLY-INSTANTIATE ITER-H=H (REWRITE) (EQUAL (ITER-H 1 X)(H X)) ITER-FN=FN ((FN H) (ITER-FN ITER-H)) ; hint ( (USE (H-SATISFIES-GEN-91-RECURSION (A A))) )) (FUNCTIONALLY-INSTANTIATE ITER-H-SUM (REWRITE) (EQUAL (ITER-H I (ITER-H J X)) (ITER-H (PLUS I J) X)) ITER-FN-SUM ((FN H) (ITER-FN ITER-H)) ; hint ( (USE (H-SATISFIES-GEN-91-RECURSION (A A))) )) (FUNCTIONALLY-INSTANTIATE ITER-H-SUM-INTEGER (REWRITE) (IMPLIES (AND (ILESSP 0 I) (ILESSP 0 J)) (EQUAL (ITER-H I (ITER-H J X)) (ITER-H (IPLUS I J) X))) ITER-FN-SUM-INTEGER ((FN H) (ITER-FN ITER-H)) ; hint ( (USE (H-SATISFIES-GEN-91-RECURSION (A A))) )) (PROVE-LEMMA H-SATISFIES-SIMPLE-REC-WHEN-C=1 (REWRITE) (IMPLIES (EQUAL (C) 1) (EQUAL (H X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (H (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS (C) -1))))))))) ; hint ( (USE (H-SATISFIES-GEN-91-RECURSION (A A))) )) (PROVE-LEMMA I-IS-INTEGER-WHEN-1A (REWRITE) (IMPLIES (AND (ILESSP 1 I) (ILESSP (A) X)) (EQUAL (ITER-H I X) (ITER-H (IPLUS -1 I) (IPLUS X (INEG (B)))))) ; hint ( (USE (ITER-H-SUM-INTEGER (I (IPLUS -1 I)) (J 1))) )) (PROVE-LEMMA A>=X-WHEN-A+D>=D+X (REWRITE) (IMPLIES (NOT (ILESSP (IPLUS A D) (IPLUS D X))) (NOT (ILESSP A X)))) (PROVE-LEMMA ITERH_1+X_Y=ITERH_X_H_Y (REWRITE) (IMPLIES (ILESSP 0 X) (EQUAL (ITER-H (IPLUS 1 X) Y) (ITER-H X (H Y)))) ; hint ( (USE (ITER-H-SUM-INTEGER (I X) (J 1) (X Y))) )) (PROVE-LEMMA ITERH_X_H_Y=ITERH_X+C-1_X+D-WHEN-X>0&A>=Y (REWRITE) (IMPLIES (AND (ILESSP 0 X) (NOT (ILESSP (A) Y))) (EQUAL (ITER-H X (H Y)) (ITER-H (IPLUS (C) X) (IPLUS (D) Y)))) ; hint ( (ENABLE H=ITERH-WHEN-A>=X) )) (PROVE-LEMMA ITERH_1_X=ITERH_1+N_C-1_X+ND-INDUCTION-STEP-PART-1 (REWRITE) (IMPLIES (AND (ILESSP 0 (ITIMES (IPLUS -1 N) (IPLUS (C) -1))) (NOT (ILESSP (A) (IPLUS X (ITIMES (IPLUS -1 N) (D)))))) (EQUAL (ITER-H (IPLUS 1 (ITIMES (IPLUS -1 N) (IPLUS (C) -1))) (IPLUS X (ITIMES (IPLUS -1 N) (D)))) (ITER-H (IPLUS 1 (ITIMES N (IPLUS (C) -1))) (IPLUS X (ITIMES N (D)))))) ; hint ( (USE (ITERH_1+X_Y=ITERH_X_H_Y (X (ITIMES (IPLUS -1 N) (IPLUS (C) -1))) (Y (IPLUS X (ITIMES (IPLUS -1 N) (D)))))) )) (PROVE-LEMMA N-1*C-1>0 NIL (IMPLIES (AND (ILESSP 0 N) (NOT (EQUAL N 1)) (ILESSP 1 (C))) (ILESSP 0 (ITIMES (IPLUS -1 N) (IPLUS (C) -1)))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA A>=X+_N-1_D-WHEN-A+D>=X+DN NIL (IMPLIES (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES D N)))) (NOT (ILESSP A (IPLUS X (ITIMES (IPLUS -1 N) D)))))) (PROVE-LEMMA ITERH_1_X=ITERH_1+N_C-1_X+ND-INDUCTION-STEP-PART-2 (REWRITE) (IMPLIES (AND (ILESSP 0 N) (NOT (EQUAL N 1)) (ILESSP 1 (C)) (NOT (ILESSP (IPLUS (A) (D)) (IPLUS X (ITIMES N (D))))) (EQUAL (ITER-H 1 X) (ITER-H (IPLUS 1 (ITIMES (IPLUS -1 N) (IPLUS (C) -1))) (IPLUS X (ITIMES (IPLUS -1 N) (D)))))) (EQUAL (ITER-H 1 X) (ITER-H (IPLUS 1 (ITIMES N (IPLUS (C) -1))) (IPLUS X (ITIMES N (D)))))) ; hint ( (USE (ITERH_1_X=ITERH_1+N_C-1_X+ND-INDUCTION-STEP-PART-1 (A A)) (N-1*C-1>0 (A A)) (A>=X+_N-1_D-WHEN-A+D>=X+DN (A (A)) (D (D)))) )) (PROVE-LEMMA A+D>=X+_N-1_D-WHEN-A+D>=X+DN NIL (IMPLIES (AND (ILESSP 0 D) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES D N))))) (NOT (ILESSP (IPLUS A D) (IPLUS X (ITIMES (IPLUS -1 N) D))))) ; hint ( (USE (X<=Z-WHEN-X=X+_N-1_D-WHEN-A+D>=X+DN (A (A)) (D (D))) (ITERH_1_X=ITERH_1+N_C-1_X+ND-INDUCTION-STEP-PART-2 (A A))) )) (PROVE-LEMMA ITERH_1_X=ITERH_1+N_C-1_X+ND-BASE-STEP (REWRITE) (IMPLIES (AND (ILESSP 1 (C)) (NOT (ILESSP (IPLUS (A) (D)) (IPLUS (D) X)))) (EQUAL (ITER-H 1 X) (ITER-H (C) (IPLUS (D) X)))) ; hint ( (ENABLE H=ITERH-WHEN-A>=X) )) (PROVE-LEMMA ITERH_1_X=ITERH_1+N_C-1_X+ND (REWRITE) (IMPLIES (AND (ILESSP 1 (C)) (ILESSP 0 N) (NOT (ILESSP (IPLUS (A)(D)) (IPLUS X (ITIMES N (D)))))) (EQUAL (ITER-H 1 X) (ITER-H (IPLUS 1 (ITIMES N (IPLUS (C) -1))) (IPLUS X (ITIMES N (D)))))) ; hint ( (INDUCT (INDUCT-HINT-POS-INT N)) (DISABLE ITER-H=H) )) (PROVE-LEMMA ITERH_I_X=ITERH_I+N_C-1_X+ND-STEP-1 (REWRITE) (IMPLIES (ILESSP 1 I) (EQUAL (ITER-H I X) (ITER-H (IPLUS -1 I) (ITER-H 1 X)))) ; hint ( (DISABLE ITER-H=H ITER-H-SUM) )) (PROVE-LEMMA ITERH_I_X=ITERH_I+N_C-1_X+ND-STEP-2 (REWRITE) (IMPLIES (AND (ILESSP 1 (C)) (ILESSP 0 N) (NOT (ILESSP (IPLUS (A)(D)) (IPLUS X (ITIMES N (D)))))) (EQUAL (ITER-H (IPLUS -1 I) (ITER-H 1 X)) (ITER-H (IPLUS -1 I) (ITER-H (IPLUS 1 (ITIMES N (IPLUS (C) -1))) (IPLUS X (ITIMES N (D))))))) ; hint ( (DISABLE ITER-H=H ITER-H-SUM ;; added for Nqthm-1992 CORRECTNESS-OF-CANCEL-ITIMES-ILESSP-FACTORS) )) (PROVE-LEMMA CN-N>=0-WHEN-1=0-WHEN-1=X+ND-WHEN-D>0&A>=X (A (A)) (D (D)))) )) (PROVE-LEMMA I+N_C-1_-1>0 NIL (IMPLIES (AND (ILESSP 1 I) (ILESSP 1 C) (ILESSP 0 N)) (ILESSP 0 (IPLUS -1 (IPLUS I (ITIMES N (IPLUS C -1)))))) ; hint ( (DISABLE-THEORY INTEGERS NATURALS) (ENABLE-THEORY INTEGER-DEFNS) )) (PROVE-LEMMA ITERH_I_X=ITERH_I-1+N_C-1_X+ND-B-STEP-2 (REWRITE) (IMPLIES (AND (ILESSP 1 I) (ILESSP 1 (C)) (NOT (ILESSP (A) X))) (EQUAL (ITER-H (IPLUS I (ITIMES (N (A) (D) X) (IPLUS (C) -1))) (IPLUS X (ITIMES (N (A) (D) X) (D)))) (ITER-H (IPLUS -1 (IPLUS I (ITIMES (N (A) (D) X) (IPLUS (C) -1)))) (H (IPLUS X (ITIMES (N (A) (D) X) (D))))))) ; hint ( (USE (I+N_C-1_-1>0 (C (C)) (N (N (A) (D) X))) (ITER-H-SUM-INTEGER (I (IPLUS -1 (IPLUS I (ITIMES (N (A) (D) X) (IPLUS (C) -1))))) (J 1) (X (IPLUS X (ITIMES (N (A) (D) X) (D)))))) )) (PROVE-LEMMA ITERH_I_X=ITERH_I-1+N_C-1_X+ND-B-STEP-3 (REWRITE) (IMPLIES (AND (ILESSP 1 I) (ILESSP 1 (C)) (NOT (ILESSP (A) X))) (EQUAL (ITER-H (IPLUS -1 (IPLUS I (ITIMES (N (A) (D) X) (IPLUS (C) -1)))) (H (IPLUS X (ITIMES (N (A) (D) X) (D))))) (ITER-H (IPLUS -1 (IPLUS I (ITIMES (N (A) (D) X) (IPLUS (C) -1)))) (IPLUS (INEG (B)) (IPLUS X (ITIMES (N (A) (D) X) (D))))))) ; hint ( (USE (A=Y-Z-WHEN-X>=Y&0=Y-Z-WHEN-X>=Y&0=X+ND-WHEN-D>0&A>=X (A (A)) (D (D)))) ;; added for Nqthm-1992 (disable CORRECTNESS-OF-CANCEL-INEG-TERMS-FROM-EQUALITY CORRECTNESS-OF-CANCEL-IPLUS) )) (PROVE-LEMMA I-1>1-WHEN-I<>2&12 (REWRITE) (IMPLIES (AND (NOT (EQUAL I 2)) (ILESSP 1 I) (ILESSP 1 (C)) (NOT (ILESSP (A) X))) (EQUAL (ITER-H (IPLUS -1 I) (IPLUS X (INEG (B)))) (ITER-H (IPLUS -1 (IPLUS I (ITIMES (N (A) (D) X) (IPLUS (C) -1)))) (IPLUS (INEG (B)) (IPLUS X (ITIMES (N (A) (D) X) (D))))))) ; hint ( (USE (ITERH_I_X=ITERH_I+N_C-1_X+ND (I (IPLUS -1 I)) (X (IPLUS X (INEG (B)))) (N (N (A) (D) X))) (A+D>=X+ND-WHEN-D>0&A>=X (A (A)) (D (D))) (X>=Y-Z-WHEN-X>=Y&01-WHEN-I<>2&12 (A A)) (ITERH_I-1_X-B=ITERH_I-1+N_C-1_X+ND-B-WHEN-I=2 (A A))) )) (PROVE-LEMMA ITERH_I_X=ITERH_I-1_I-B-WHEN-A>=X (REWRITE) (IMPLIES (AND (ILESSP 1 I) (ILESSP 1 (C)) (NOT (ILESSP (A) X))) (EQUAL (ITER-H I X) (ITER-H (IPLUS -1 I)(IPLUS X (INEG (B)))))) ; hint ( (USE (ITERH_I-1_X-B=ITERH_I-1+N_C-1_X+ND-B (A A))) )) (PROVE-LEMMA ITERH_I_X=ITERH_I-1_I-B (REWRITE) (IMPLIES (AND (ILESSP 1 I) (ILESSP 1 (C))) (EQUAL (ITER-H I X) (ITER-H (IPLUS -1 I)(IPLUS X (INEG (B)))))) ; hint ( (USE (ITERH_I_X=ITERH_I-1_I-B-WHEN-A>=X (A A))) )) (PROVE-LEMMA X*1=X-WHEN-00-WHEN-C>1 (REWRITE) (IMPLIES (ILESSP 1 C) (ILESSP 0 (IPLUS C -1)))) (PROVE-LEMMA C-1=X) )) (PROVE-LEMMA H-SATISFIES-SIMPLE-REC-WHEN-C>1 (REWRITE) (IMPLIES (ILESSP 1 (C)) (EQUAL (H X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (H (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS (C) -1)))))))))) (PROVE-LEMMA H-SATISFIES-SIMPLE-REC (REWRITE) (EQUAL (H X) (IF (ILESSP (A) X) (IPLUS X (INEG (B))) (H (IPLUS X (IPLUS (D) (INEG (ITIMES (B) (IPLUS (C) -1)))))))) ; hint ( (DISABLE H=X-B-WHEN-A1 H-SATISFIES-SIMPLE-REC-WHEN-C=1) (USE (H-SATISFIES-SIMPLE-REC-WHEN-C=1 (A A)) (H-SATISFIES-SIMPLE-REC-WHEN-C>1 (A A)) (X=1-OR-X>1-WHEN-X>0 (X (C)))) )) (FUNCTIONALLY-INSTANTIATE H=K-WHEN-B_C-1_1 H-SATISFIES-SIMPLE-REC-WHEN-C=1 H-SATISFIES-SIMPLE-REC) (USE (H-SATISFIES-SIMPLE-REC (A A))) )) ;;;;;;;;;;MAKE-LIB IS HERE;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;I am here;;;;;;;;;;;; ; (MAKE-LIB "knuth-91a") ; (MAKE-LIB-CONDITIONAL "knuth-91a" T T) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ========================= bags.events ========================= (boot-strap nqthm) (DEFN DELETE (X L) (IF (LISTP L) (IF (EQUAL X (CAR L)) (CDR L) (CONS (CAR L) (DELETE X (CDR L)))) L)) (DEFN BAGDIFF (X Y) (IF (LISTP Y) (IF (MEMBER (CAR Y) X) (BAGDIFF (DELETE (CAR Y) X) (CDR Y)) (BAGDIFF X (CDR Y))) X)) (DEFN BAGINT (X Y) (IF (LISTP X) (IF (MEMBER (CAR X) Y) (CONS (CAR X) (BAGINT (CDR X) (DELETE (CAR X) Y))) (BAGINT (CDR X) Y)) NIL)) (DEFN OCCURRENCES (X L) (IF (LISTP L) (IF (EQUAL X (CAR L)) (ADD1 (OCCURRENCES X (CDR L))) (OCCURRENCES X (CDR L))) 0)) (DEFN SUBBAGP (X Y) (IF (LISTP X) (IF (MEMBER (CAR X) Y) (SUBBAGP (CDR X) (DELETE (CAR X) Y)) F) T)) (LEMMA LISTP-DELETE (REWRITE) (EQUAL (LISTP (DELETE X L)) (IF (LISTP L) (OR (NOT (EQUAL X (CAR L))) (LISTP (CDR L))) F)) ((ENABLE DELETE) (INDUCT (DELETE X L)))) (disable listp-delete) (LEMMA DELETE-NON-MEMBER (REWRITE) (IMPLIES (NOT (MEMBER X Y)) (EQUAL (DELETE X Y) Y)) ((ENABLE DELETE))) (LEMMA DELETE-DELETE (REWRITE) (EQUAL (DELETE Y (DELETE X Z)) (DELETE X (DELETE Y Z))) ((ENABLE DELETE DELETE-NON-MEMBER))) (lemma equal-occurrences-zero (rewrite) (equal (equal (occurrences x l) 0) (not (member x l))) ((enable occurrences))) (LEMMA MEMBER-NON-LIST (REWRITE) (IMPLIES (NOT (LISTP L)) (NOT (MEMBER X L)))) (lemma member-delete (rewrite) (equal (member x (delete y l)) (if (member x l) (if (equal x y) (lessp 1 (occurrences x l)) t) f)) ((enable delete occurrences))) (LEMMA MEMBER-DELETE-IMPLIES-MEMBERSHIP (REWRITE) (IMPLIES (MEMBER X (DELETE Y L)) (MEMBER X L)) ((ENABLE DELETE))) (LEMMA OCCURRENCES-DELETE (REWRITE) (EQUAL (OCCURRENCES X (DELETE Y L)) (IF (EQUAL X Y) (IF (MEMBER X L) (SUB1 (OCCURRENCES X L)) 0) (OCCURRENCES X L))) ((ENABLE OCCURRENCES DELETE EQUAL-OCCURRENCES-ZERO))) (LEMMA MEMBER-BAGDIFF (REWRITE) (EQUAL (MEMBER X (BAGDIFF A B)) (LESSP (OCCURRENCES X B) (OCCURRENCES X A))) ((ENABLE BAGDIFF OCCURRENCES EQUAL-OCCURRENCES-ZERO OCCURRENCES-DELETE))) (lemma bagdiff-delete (rewrite) (equal (bagdiff (delete e x) y) (delete e (bagdiff x y))) ((enable BAGDIFF DELETE DELETE-DELETE DELETE-NON-MEMBER MEMBER-BAGDIFF MEMBER-DELETE OCCURRENCES-DELETE))) (LEMMA SUBBAGP-DELETE (REWRITE) (IMPLIES (SUBBAGP X (DELETE U Y)) (SUBBAGP X Y)) ((ENABLE DELETE SUBBAGP DELETE-DELETE MEMBER-DELETE-IMPLIES-MEMBERSHIP))) (LEMMA SUBBAGP-CDR1 (REWRITE) (IMPLIES (SUBBAGP X Y) (SUBBAGP (CDR X) Y)) ((ENABLE SUBBAGP SUBBAGP-DELETE))) (LEMMA SUBBAGP-CDR2 (REWRITE) (IMPLIES (SUBBAGP X (CDR Y)) (SUBBAGP X Y)) ((ENABLE DELETE SUBBAGP DELETE-NON-MEMBER SUBBAGP-CDR1))) (LEMMA SUBBAGP-BAGINT1 (REWRITE) (SUBBAGP (BAGINT X Y) X) ((ENABLE DELETE SUBBAGP BAGINT SUBBAGP-CDR2))) (LEMMA SUBBAGP-BAGINT2 (REWRITE) (SUBBAGP (BAGINT X Y) Y) ((ENABLE SUBBAGP BAGINT SUBBAGP-CDR2))) (prove-lemma occurrences-bagint (rewrite) (equal (occurrences x (bagint a b)) (if (lessp (occurrences x a) (occurrences x b)) (occurrences x a) (occurrences x b))) ((enable occurrences bagint equal-occurrences-zero occurrences-delete))) (prove-lemma occurrences-bagdiff (rewrite) (equal (occurrences x (bagdiff a b)) (difference (occurrences x a) (occurrences x b))) ((enable occurrences bagdiff equal-occurrences-zero occurrences-delete))) (prove-lemma member-bagint (rewrite) (equal (member x (bagint a b)) (and (member x a) (member x b))) ((enable bagint member-delete))) (deftheory bags (occurrences-bagint bagdiff-delete occurrences-bagdiff member-bagint member-bagdiff subbagp-bagint2 subbagp-bagint1 subbagp-cdr2 subbagp-cdr1 subbagp-delete)) (make-lib "bags") ========================= naturals.events ========================= (note-lib "bags") ;; Tue Sep 26 10:20:45 1989, from ~wilding/numerical/newnat.events ;; NATURALS Theory ;; Created by Bill Bevier 1988 (see CLI internal note 057) ;; Modifications by Bill Bevier and Matt Wilding (9/89) including ;; adding some new metalemmas for times, reorganizing the theories, ;; removing some extraneous lemmas, and removing dependence upon ;; other theories (by adding the pertinent lemmas). ;; This script requires the bags theory ;; This script sets up a theory for the NATURALS with the following subtheories ;; ADDITION ;; MULTIPLICATION ;; REMAINDER ;; QUOTIENT ;; EXPONENTIATION ;; LOGS ;; GCDS ;; The theories of EXPONENTIATION, LOGS, and GCDS still need a lot of work ; -------------------------------------------------------------------------------- ; ARITHMETIC ; -------------------------------------------------------------------------------- ; -------------------- PLUS & DIFFERENCE -------------------- ; ---------- EQUAL ---------- (lemma equal-plus-0 (rewrite) (equal (equal (plus a b) 0) (and (zerop a) (zerop b)))) (lemma plus-cancellation (rewrite) (equal (equal (plus a b) (plus a c)) (equal (fix b) (fix c)))) (disable plus-cancellation) (lemma equal-difference-0 (rewrite) (and (equal (equal (difference x y) 0) (not (lessp y x))) (equal (equal 0 (difference x y)) (not (lessp y x)))) ((induct (difference x y)))) (lemma difference-cancellation (rewrite) (equal (equal (difference x y) (difference z y)) (if (lessp x y) (not (lessp y z)) (if (lessp z y) (not (lessp y x)) (equal (fix x) (fix z))))) ((enable equal-difference-0))) (disable difference-cancellation) ; ---------- PLUS ---------- (lemma commutativity-of-plus (rewrite) (equal (plus x y) (plus y x))) (lemma commutativity2-of-plus (rewrite) (equal (plus x (plus y z)) (plus y (plus x z)))) (lemma plus-zero-arg2 (rewrite) (implies (zerop y) (equal (plus x y) (fix x))) ((induct (plus x y)))) (lemma plus-add1-arg1 (rewrite) (equal (plus (add1 a) b) (add1 (plus a b)))) (lemma plus-add1-arg2 (rewrite) (equal (plus x (add1 y)) (if (numberp y) (add1 (plus x y)) (add1 x)))) (lemma associativity-of-plus (rewrite) (equal (plus (plus x y) z) (plus x (plus y z)))) (lemma plus-difference-arg1 (rewrite) (equal (plus (difference a b) c) (if (lessp b a) (difference (plus a c) b) (plus 0 c))) ((induct (difference a b)))) (lemma plus-difference-arg2 (rewrite) (equal (plus a (difference b c)) (if (lessp c b) (difference (plus a b) c) (plus a 0))) ((induct (plus a b)))) ; ---------- DIFFERENCE-PLUS cancellation rules ---------- ; ; Here are the basic canonicalization rules for differences of sums. These ; are subsumed by the meta lemmas and are therefore globally disabled. ; They are here merely to prove the meta lemmas. (lemma difference-plus-cancellation-proof () (equal (difference (plus x y) x) (fix y))) (lemma difference-plus-cancellation (rewrite) (and (equal (difference (plus x y) x) (fix y)) (equal (difference (plus y x) x) (fix y))) ((use (difference-plus-cancellation-proof (x x) (y y))) (enable commutativity-of-plus))) (disable difference-plus-cancellation) (lemma difference-plus-plus-cancellation-proof () (equal (difference (plus x y) (plus x z)) (difference y z))) (lemma difference-plus-plus-cancellation (rewrite) (and (equal (difference (plus x y) (plus x z)) (difference y z)) (equal (difference (plus y x) (plus x z)) (difference y z)) (equal (difference (plus x y) (plus z x)) (difference y z)) (equal (difference (plus y x) (plus z x)) (difference y z))) ((use (difference-plus-plus-cancellation-proof (x x) (y y) (z z))) (enable commutativity-of-plus))) (disable difference-plus-plus-cancellation) (lemma difference-plus-plus-cancellation-hack (rewrite) (equal (difference (plus w x a) (plus y z a)) (difference (plus w x) (plus y z))) ((enable commutativity-of-plus commutativity2-of-plus difference-plus-plus-cancellation) (do-not-induct t))) (disable difference-plus-plus-cancellation-hack) ; Here are a few more facts about difference needed to prove the meta lemmas. ; These are disabled here. We re-prove them after the proof of the meta ; lemmas so that they will fire before the meta lemmas in subsequent proofs. (lemma diff-sub1-arg2 (rewrite) (equal (difference a (sub1 b)) (if (zerop b) (fix a) (if (lessp a b) 0 (add1 (difference a b))))) ((induct (difference a b)))) (disable diff-sub1-arg2) (lemma diff-diff-arg1 (rewrite) (equal (difference (difference x y) z) (difference x (plus y z)))) (lemma diff-diff-arg2 (rewrite) (equal (difference a (difference b c)) (if (lessp b c) (fix a) (difference (plus a c) b))) ((enable diff-sub1-arg2 plus-zero-arg2) (induct (difference a b)))) ; diff-diff-diff should be removed, but since the hack lemmas for ; correctness-of-cancel-difference-plus are designed for it, we'll ; keep it around. (lemma diff-diff-diff (rewrite) (implies (and (leq b a) (leq d c)) (equal (difference (difference a b) (difference c d)) (difference (plus a d) (plus b c)))) ((enable diff-diff-arg1 diff-diff-arg2 plus-difference-arg2 plus-zero-arg2) (do-not-induct t))) (disable diff-diff-diff) (lemma difference-lessp-arg1 (rewrite) (implies (lessp a b) (equal (difference a b) 0))) (disable difference-lessp-arg1) ; -------------------------------------------------------------------------------- ; Meta Lemmas to Cancel PLUS and DIFFERENCE expressions ; -------------------------------------------------------------------------------- ; ---------- PLUS-TREE and PLUS-FRINGE ---------- (defn plus-fringe (x) (if (and (listp x) (equal (car x) 'plus)) (append (plus-fringe (cadr x)) (plus-fringe (caddr x))) (cons x nil))) (defn plus-tree (l) (if (nlistp l) ''0 (if (nlistp (cdr l)) (list 'fix (car l)) (if (nlistp (cddr l)) (list 'plus (car l) (cadr l)) (list 'plus (car l) (plus-tree (cdr l))))))) (lemma numberp-eval$-plus (rewrite) (implies (and (listp x) (equal (car x) 'plus)) (numberp (eval$ t x a)))) (disable numberp-eval$-plus) (lemma numberp-eval$-plus-tree (rewrite) (numberp (eval$ t (plus-tree l) a)) ((enable plus-tree))) (disable numberp-eval$-plus-tree) (lemma member-implies-plus-tree-greatereqp (rewrite) (implies (member x y) (not (lessp (eval$ t (plus-tree y) a) (eval$ t x a)))) ((enable plus-tree plus-zero-arg2))) (disable member-implies-plus-tree-greatereqp) (lemma plus-tree-delete (rewrite) (equal (eval$ t (plus-tree (delete x y)) a) (if (member x y) (difference (eval$ t (plus-tree y) a) (eval$ t x a)) (eval$ t (plus-tree y) a))) ((enable delete plus-tree delete-non-member difference-plus-cancellation equal-difference-0 equal-plus-0 listp-delete member-implies-plus-tree-greatereqp numberp-eval$-plus-tree plus-zero-arg2))) (disable plus-tree-delete) (lemma subbagp-implies-plus-tree-greatereqp (rewrite) (implies (subbagp x y) (not (lessp (eval$ t (plus-tree y) a) (eval$ t (plus-tree x) a)))) ((enable plus-tree subbagp member-implies-plus-tree-greatereqp plus-tree-delete plus-zero-arg2 subbagp-cdr2))) (disable subbagp-implies-plus-tree-greatereqp) (lemma plus-tree-bagdiff (rewrite) (implies (subbagp x y) (equal (eval$ t (plus-tree (bagdiff y x)) a) (difference (eval$ t (plus-tree y) a) (eval$ t (plus-tree x) a)))) ((enable bagdiff plus-tree subbagp commutativity-of-plus diff-diff-arg1 difference-lessp-arg1 member-implies-plus-tree-greatereqp numberp-eval$-plus-tree plus-tree-delete plus-zero-arg2 subbagp-cdr2 subbagp-implies-plus-tree-greatereqp))) (disable plus-tree-bagdiff) (lemma numberp-eval$-bridge (rewrite) (implies (equal (eval$ t z a) (eval$ t (plus-tree x) a)) (numberp (eval$ t z a))) ((enable plus-tree numberp-eval$-plus-tree))) (disable numberp-eval$-bridge) (lemma bridge-to-subbagp-implies-plus-tree-greatereqp (rewrite) (implies (and (subbagp y (plus-fringe z)) (equal (eval$ t z a) (eval$ t (plus-tree (plus-fringe z)) a))) (equal (lessp (eval$ t z a) (eval$ t (plus-tree y) a)) f)) ((enable subbagp plus-fringe plus-tree subbagp-implies-plus-tree-greatereqp))) (disable bridge-to-subbagp-implies-plus-tree-greatereqp) (lemma eval$-plus-tree-append (rewrite) (equal (eval$ t (plus-tree (append x y)) a) (plus (eval$ t (plus-tree x) a) (eval$ t (plus-tree y) a))) ((enable plus-zero-arg2 commutativity2-of-plus commutativity-of-plus equal-plus-0 plus-cancellation plus-tree numberp-eval$-plus-tree numberp-eval$-bridge))) (disable eval$-plus-tree-append) (lemma plus-tree-plus-fringe (rewrite) (equal (eval$ t (plus-tree (plus-fringe x)) a) (fix (eval$ t x a))) ((enable plus-zero-arg2 commutativity-of-plus plus-fringe plus-tree numberp-eval$-plus numberp-eval$-bridge eval$-plus-tree-append) (induct (plus-fringe x)))) (disable plus-tree-plus-fringe) (lemma member-implies-numberp (rewrite) (implies (and (member c (plus-fringe x)) (numberp (eval$ t c a))) (numberp (eval$ t x a))) ((enable plus-fringe numberp-eval$-plus) (induct (plus-fringe x)))) (disable member-implies-numberp) (lemma cadr-eval$-list (rewrite) (and (equal (car (eval$ 'list x a)) (eval$ t (car x) a)) (equal (cdr (eval$ 'list x a)) (if (listp x) (eval$ 'list (cdr x) a) 0)))) (disable cadr-eval$-list) (lemma eval$-quote (rewrite) (equal (eval$ t (cons 'quote args) a) (car args))) (disable eval$-quote) (lemma listp-eval$ (rewrite) (equal (listp (eval$ 'list x a)) (listp x))) (disable listp-eval$) ; ---------- CANCEL PLUS ---------- ; CANCEL-EQUAL-PLUS cancels identical terms in a term which is the equality ; of two sums. For example, ; ; (EQUAL (PLUS A B C) (PLUS B D E)) => (EQUAL (PLUS A C) (PLUS D E)) ; (defn cancel-equal-plus (x) (if (and (listp x) (equal (car x) 'equal)) (if (and (listp (cadr x)) (equal (caadr x) 'plus) (listp (caddr x)) (equal (caaddr x) 'plus)) (list 'equal (plus-tree (bagdiff (plus-fringe (cadr x)) (bagint (plus-fringe (cadr x)) (plus-fringe (caddr x))))) (plus-tree (bagdiff (plus-fringe (caddr x)) (bagint (plus-fringe (cadr x)) (plus-fringe (caddr x)))))) (if (and (listp (cadr x)) (equal (caadr x) 'plus) (member (caddr x) (plus-fringe (cadr x)))) (list 'if (list 'numberp (caddr x)) (list 'equal (plus-tree (delete (caddr x) (plus-fringe (cadr x)))) ''0) (list 'quote f)) (if (and (listp (caddr x)) (equal (caaddr x) 'plus) (member (cadr x) (plus-fringe (caddr x)))) (list 'if (list 'numberp (cadr x)) (list 'equal ''0 (plus-tree (delete (cadr x) (plus-fringe (caddr x))))) (list 'quote f)) x))) x)) (lemma correctness-of-cancel-equal-plus ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-equal-plus x) a)) ((enable bridge-to-subbagp-implies-plus-tree-greatereqp cancel-equal-plus difference-cancellation equal-difference-0 eval$-quote member-implies-numberp member-implies-plus-tree-greatereqp numberp-eval$-plus plus-tree-bagdiff plus-tree-delete plus-tree-plus-fringe subbagp-bagint1 subbagp-bagint2) (disable eval$))) ; ---------- CANCEL-DIFFERENCE-PLUS ---------- ; CANCEL-DIFFERENCE-PLUS cancels identical terms in a term which is the ; difference of two sums. For example, ; ; (DIFFERENCE (PLUS A B C) (PLUS B D E)) => (DIFFERENCE (PLUS A C) (PLUS D E)) ; ; Using rewrite rules, we canonicalize terms involving PLUS and DIFFERENCE ; to be the DIFFERENCE of two sums. Then CANCEL-DIFFERENCE-PLUS cancels out ; like terms. (defn cancel-difference-plus (x) (if (and (listp x) (equal (car x) 'difference)) (if (and (listp (cadr x)) (equal (caadr x) 'plus) (listp (caddr x)) (equal (caaddr x) 'plus)) (list 'difference (plus-tree (bagdiff (plus-fringe (cadr x)) (bagint (plus-fringe (cadr x)) (plus-fringe (caddr x))))) (plus-tree (bagdiff (plus-fringe (caddr x)) (bagint (plus-fringe (cadr x)) (plus-fringe (caddr x)))))) (if (and (listp (cadr x)) (equal (caadr x) 'plus) (member (caddr x) (plus-fringe (cadr x)))) (plus-tree (delete (caddr x) (plus-fringe (cadr x)))) (if (and (listp (caddr x)) (equal (caaddr x) 'plus) (member (cadr x) (plus-fringe (caddr x)))) ''0 x))) x)) (lemma correctness-of-cancel-difference-plus ((meta difference)) (equal (eval$ t x a) (eval$ t (cancel-difference-plus x) a)) ((enable cancel-difference-plus associativity-of-plus bridge-to-subbagp-implies-plus-tree-greatereqp commutativity-of-plus diff-diff-diff difference-lessp-arg1 difference-plus-plus-cancellation-hack equal-difference-0 eval$-quote member-implies-plus-tree-greatereqp numberp-eval$-plus plus-tree-bagdiff plus-tree-delete plus-tree-plus-fringe subbagp-bagint1 subbagp-bagint2) (disable eval$))) ; ---------- DIFFERENCE ---------- ; Here are the rules for difference terms which we want to try before ; the meta lemmas. They help canonicalize terms to differences of sums. (lemma difference-elim (elim) (implies (and (numberp y) (not (lessp y x))) (equal (plus x (difference y x)) y))) (lemma difference-leq-arg1 (rewrite) (implies (leq a b) (equal (difference a b) 0))) (lemma difference-add1-arg2 (rewrite) (equal (difference a (add1 b)) (if (lessp b a) (sub1 (difference a b)) 0)) ((enable difference-leq-arg1) (induct (difference a b)))) (lemma difference-sub1-arg2 (rewrite) (equal (difference a (sub1 b)) (if (zerop b) (fix a) (if (lessp a b) 0 (add1 (difference a b))))) ((enable diff-sub1-arg2))) (lemma difference-difference-arg1 (rewrite) (equal (difference (difference x y) z) (difference x (plus y z))) ((enable diff-diff-arg1))) (lemma difference-difference-arg2 (rewrite) (equal (difference a (difference b c)) (if (lessp b c) (fix a) (difference (plus a c) b))) ((enable diff-diff-arg2))) (lemma difference-x-x (rewrite) (equal (difference x x) 0)) ; ---------- LESSP ---------- (lemma lessp-difference-cancellation (rewrite) (equal (lessp (difference a c) (difference b c)) (if (leq c a) (lessp a b) (lessp c b))) ((enable equal-difference-0))) (disable lessp-difference-cancellation) ; CANCEL-LESSP-PLUS cancels LESSP terms whose arguments are sums. ; Examples: ; (LESSP (PLUS A B C) (PLUS A C D)) -> (LESSP (FIX B) (FIX D)) ; (LESSP A (PLUS A B)) -> (NOT (ZEROP (FIX B))) ; (LESSP (PLUS A B) A) -> F (defn cancel-lessp-plus (x) (if (and (listp x) (equal (car x) 'lessp)) (if (and (listp (cadr x)) (equal (caadr x) 'plus) (listp (caddr x)) (equal (caaddr x) 'plus)) (list 'lessp (plus-tree (bagdiff (plus-fringe (cadr x)) (bagint (plus-fringe (cadr x)) (plus-fringe (caddr x))))) (plus-tree (bagdiff (plus-fringe (caddr x)) (bagint (plus-fringe (cadr x)) (plus-fringe (caddr x)))))) (if (and (listp (cadr x)) (equal (caadr x) 'plus) (member (caddr x) (plus-fringe (cadr x)))) (list 'quote f) (if (and (listp (caddr x)) (equal (caaddr x) 'plus) (member (cadr x) (plus-fringe (caddr x)))) (list 'not (list 'zerop (plus-tree (delete (cadr x) (plus-fringe (caddr x)))))) x))) x)) (lemma correctness-of-cancel-lessp-plus ((meta lessp)) (equal (eval$ t x a) (eval$ t (cancel-lessp-plus x) a)) ((enable cancel-lessp-plus bridge-to-subbagp-implies-plus-tree-greatereqp equal-difference-0 eval$-quote lessp-difference-cancellation member-implies-plus-tree-greatereqp numberp-eval$-plus plus-tree-bagdiff plus-tree-delete plus-tree-plus-fringe subbagp-bagint1 subbagp-bagint2) (disable eval$))) ; Define the available theory of addition. To get the list of events to ; put in the theory, evaluate the following form in NQTHM at this point ; in the script. This form lists all lemmas which are globally enabled, ; and which have non-null lemma type. ; ; (remove-if-not (function (lambda (x) ; (and (member x (lemmas)) ; (not (assoc x disabled-lemmas)) ; (not (null (nth 2 (get x 'event))))))) ; chronology) (deftheory addition (EQUAL-PLUS-0 EQUAL-DIFFERENCE-0 COMMUTATIVITY-OF-PLUS COMMUTATIVITY2-OF-PLUS PLUS-ZERO-ARG2 PLUS-ADD1-ARG2 PLUS-ADD1-ARG1 ASSOCIATIVITY-OF-PLUS PLUS-DIFFERENCE-ARG1 PLUS-DIFFERENCE-ARG2 diff-diff-arg1 diff-diff-arg2 CORRECTNESS-OF-CANCEL-EQUAL-PLUS CORRECTNESS-OF-CANCEL-DIFFERENCE-PLUS DIFFERENCE-ELIM DIFFERENCE-LEQ-ARG1 DIFFERENCE-ADD1-ARG2 DIFFERENCE-SUB1-ARG2 DIFFERENCE-DIFFERENCE-ARG1 DIFFERENCE-DIFFERENCE-ARG2 DIFFERENCE-X-X CORRECTNESS-OF-CANCEL-LESSP-PLUS)) ; ---------- TIMES ---------- (lemma equal-times-0 (rewrite) (equal (equal (times x y) 0) (or (zerop x) (zerop y))) ((enable equal-plus-0) (induct (times x y)))) (lemma equal-times-1 (rewrite) (equal (equal (times a b) 1) (and (equal a 1) (equal b 1))) ((enable equal-plus-0) (induct (times a b)))) ;(lemma equal-sub1-times-0 (rewrite) ; (equal (equal (sub1 (times a b)) 0) ; (or (zerop a) ; (zerop b) ; (and (equal a 1) (equal b 1))))) (lemma equal-sub1-0 (rewrite) (equal (equal (sub1 x) 0) (or (zerop x) (equal x 1)))) (lemma times-zero (rewrite) (implies (zerop y) (equal (times x y) 0)) ((enable plus-zero-arg2 commutativity-of-plus))) (lemma times-add1 (rewrite) (equal (times x (add1 y)) (if (numberp y) (plus x (times x y)) (fix x))) ((enable plus-zero-arg2 commutativity-of-plus))) (lemma commutativity-of-times (rewrite) (equal (times y x) (times x y)) ((enable times-zero times-add1))) (lemma times-distributes-over-plus-proof () (equal (times x (plus y z)) (plus (times x y) (times x z))) ((enable commutativity2-of-plus associativity-of-plus))) (lemma times-distributes-over-plus (rewrite) (and (equal (times x (plus y z)) (plus (times x y) (times x z))) (equal (times (plus x y) z) (plus (times x z) (times y z)))) ((use (times-distributes-over-plus-proof (x x) (y y) (z z)) (times-distributes-over-plus-proof (x z) (y x) (z y))) (enable commutativity-of-times))) (lemma commutativity2-of-times (rewrite) (equal (times x y z) (times y x z)) ((enable commutativity-of-times times-distributes-over-plus))) (lemma associativity-of-times (rewrite) (equal (times (times x y) z) (times x y z)) ((enable commutativity-of-times commutativity2-of-times))) (lemma times-distributes-over-difference-proof () (equal (times (difference a b) c) (difference (times a c) (times b c))) ((enable commutativity-of-times) (enable-theory addition))) (lemma times-distributes-over-difference (rewrite) (and (equal (times (difference a b) c) (difference (times a c) (times b c))) (equal (times a (difference b c)) (difference (times a b) (times a c)))) ((use (times-distributes-over-difference-proof (a a) (b b) (c c)) (times-distributes-over-difference-proof (a b) (b c) (c a))) (enable commutativity-of-times))) (lemma times-quotient-proof () (implies (and (not (zerop x)) (equal (remainder y x) 0)) (equal (times (quotient y x) x) (fix y))) ((enable times-zero times-add1) (induct (remainder y x)))) (lemma times-quotient (rewrite) (implies (and (not (zerop y)) (equal (remainder x y) 0)) (and (equal (times (quotient x y) y) (fix x)) (equal (times y (quotient x y)) (fix x)))) ((use (times-quotient-proof (x y) (y x))) (enable commutativity-of-times))) (lemma times-1-arg1 (rewrite) (equal (times 1 x) (fix x)) ((enable times-zero))) (lemma lessp-times1-proof () (implies (and (lessp a b) (not (zerop c))) (equal (lessp a (times b c)) t))) (lemma lessp-times1 (rewrite) (implies (and (lessp a b) (not (zerop c))) (and (equal (lessp a (times b c)) t) (equal (lessp a (times c b)) t))) ((enable commutativity-of-times) (use (lessp-times1-proof (a a) (b b) (c c))) (do-not-induct t))) (lemma lessp-times2-proof () (implies (and (leq a b) (not (zerop c))) (equal (lessp (times b c) a) f))) (lemma lessp-times2 (rewrite) (implies (and (leq a b) (not (zerop c))) (and (equal (lessp (times b c) a) f) (equal (lessp (times c b) a) f))) ((enable commutativity-of-times) (use (lessp-times2-proof (a a) (b b) (c c))) (do-not-induct t))) (lemma lessp-times3-proof1 () (implies (and (not (zerop a)) (lessp 1 b)) (lessp a (times a b))) ((enable-theory addition) (enable times-zero))) (lemma lessp-times3-proof2 () (implies (lessp a (times a b)) (and (not (zerop a)) (lessp 1 b))) ((enable-theory addition))) (lemma lessp-times3 (rewrite) (and (equal (lessp a (times a b)) (and (not (zerop a)) (lessp 1 b))) (equal (lessp a (times b a)) (and (not (zerop a)) (lessp 1 b)))) ((enable commutativity-of-times) (use (lessp-times3-proof1 (a a) (b b)) (lessp-times3-proof2 (a a) (b b))) (do-not-induct t))) (lemma lessp-times-cancellation-proof () (equal (lessp (times x z) (times y z)) (and (not (zerop z)) (lessp x y))) ((enable commutativity-of-times correctness-of-cancel-lessp-plus times-zero))) (lemma lessp-times-cancellation1 (rewrite) (and (equal (lessp (times x z) (times y z)) (and (not (zerop z)) (lessp x y))) (equal (lessp (times z x) (times y z)) (and (not (zerop z)) (lessp x y))) (equal (lessp (times x z) (times z y)) (and (not (zerop z)) (lessp x y))) (equal (lessp (times z x) (times z y)) (and (not (zerop z)) (lessp x y)))) ((use (lessp-times-cancellation-proof (x x) (y y) (z z))) (enable commutativity-of-times) (do-not-induct t))) (disable lessp-times-cancellation1) (lemma lessp-plus-times-proof () (implies (lessp x a) (equal (lessp (plus x (times a b)) (times a c)) (lessp b c))) ((enable-theory addition) (enable commutativity-of-times lessp-times-cancellation1 lessp-times1 lessp-times2 lessp-times3 times-add1 times-zero) (induct (lessp b c)))) (lemma lessp-plus-times1 (rewrite) (and (equal (lessp (plus a (times b c)) b) (and (lessp a b) (zerop c))) (equal (lessp (plus a (times c b)) b) (and (lessp a b) (zerop c))) (equal (lessp (plus (times c b) a) b) (and (lessp a b) (zerop c))) (equal (lessp (plus (times b c) a) b) (and (lessp a b) (zerop c)))) ((use (lessp-plus-times-proof (a b) (b c) (c 1) (x a))) (enable commutativity-of-plus commutativity-of-times times-1-arg1) (do-not-induct t))) (lemma lessp-plus-times2 (rewrite) (implies (and (not (zerop a)) (lessp x a)) (and (equal (lessp (plus x (times a b)) (times a c)) (lessp b c)) (equal (lessp (plus x (times b a)) (times a c)) (lessp b c)) (equal (lessp (plus x (times a b)) (times c a)) (lessp b c)) (equal (lessp (plus x (times b a)) (times c a)) (lessp b c)) (equal (lessp (plus (times a b) x) (times a c)) (lessp b c)) (equal (lessp (plus (times b a) x) (times a c)) (lessp b c)) (equal (lessp (plus (times a b) x) (times c a)) (lessp b c)) (equal (lessp (plus (times b a) x) (times c a)) (lessp b c)))) ((enable commutativity-of-plus commutativity-of-times) (use (lessp-plus-times-proof (a a) (b b) (c c) (x x))) (do-not-induct t))) (lemma lessp-1-times (rewrite) (equal (lessp 1 (times a b)) (not (or (zerop a) (zerop b) (and (equal a 1) (equal b 1)))))) ;;; meta lemmas to cancel lessp-times and equal-times expressions ;; examples ;; (lessp (times b (times d a)) (times b (times e (times a f)))) -> ;; (and (and (not (zerop a)) ;; (not (zerop b))) ;; (lessp (fix d) (times e f))) ;; ;; (equal (times b (times c d)) (times b d)) -> ;; (or (or (zerop b) (zerop d)) ;; (equal (fix c) 1)) (defn times-tree (x) (if (nlistp x) ''1 (if (nlistp (cdr x)) (list 'fix (car x)) (if (nlistp (cddr x)) (list 'times (car x) (cadr x)) (list 'times (car x) (times-tree (cdr x))))))) (defn times-fringe (x) (if (and (listp x) (equal (car x) 'times)) (append (times-fringe (cadr x)) (times-fringe (caddr x))) (cons x nil))) (defn or-zerop-tree (x) (if (nlistp x) '(false) (if (nlistp (cdr x)) (list 'zerop (car x)) (if (nlistp (cddr x)) (list 'or (list 'zerop (car x)) (list 'zerop (cadr x))) (list 'or (list 'zerop (car x)) (or-zerop-tree (cdr x))))))) (defn and-not-zerop-tree (x) (if (nlistp x) '(true) (if (nlistp (cdr x)) (list 'not (list 'zerop (car x))) (list 'and (list 'not (list 'zerop (car x))) (and-not-zerop-tree (cdr x)))))) (lemma numberp-eval$-times (rewrite) (implies (equal (car x) 'times) (numberp (eval$ t x a)))) (disable numberp-eval$-times) (lemma eval$-times (rewrite) (implies (equal (car x) 'times) (equal (eval$ t x a) (times (eval$ t (cadr x) a) (eval$ t (caddr x) a))))) (disable eval$-times) (lemma eval$-or (rewrite) (implies (equal (car x) 'or) (equal (eval$ t x a) (or (eval$ t (cadr x) a) (eval$ t (caddr x) a))))) (disable eval$-or) (lemma eval$-equal (rewrite) (implies (equal (car x) 'equal) (equal (eval$ t x a) (equal (eval$ t (cadr x) a) (eval$ t (caddr x) a))))) (disable eval$-equal) (lemma eval$-lessp (rewrite) (implies (equal (car x) 'lessp) (equal (eval$ t x a) (lessp (eval$ t (cadr x) a) (eval$ t (caddr x) a))))) (disable eval$-lessp) (lemma eval$-quotient (rewrite) (implies (equal (car x) 'quotient) (equal (eval$ t x a) (quotient (eval$ t (cadr x) a) (eval$ t (caddr x) a))))) (disable eval$-quotient) (lemma eval$-if (rewrite) (implies (equal (car x) 'if) (equal (eval$ t x a) (if (eval$ t (cadr x) a) (eval$ t (caddr x) a) (eval$ t (cadddr x) a))))) (disable eval$-if) (lemma numberp-eval$-times-tree (rewrite) (numberp (eval$ t (times-tree x) a)) ((enable times-tree))) (disable numberp-eval$-times-tree) (lemma lessp-times-arg1 () (implies (not (zerop a)) (equal (not (lessp (times a x) (times a y))) (not (lessp x y)))) ((induct (plus a x)) (enable times correctness-of-cancel-lessp-plus))) (lemma infer-equality-from-not-lessp () (implies (and (numberp a) (numberp b)) (equal (and (not (lessp a b)) (not (lessp b a))) (equal a b)))) (lemma equal-times-arg1 (rewrite) (implies (not (zerop a)) (equal (equal (times a x) (times a y)) (equal (fix x) (fix y)))) ((use (lessp-times-arg1 (a a) (x x) (y y)) (lessp-times-arg1 (a a) (x y) (y x)) (infer-equality-from-not-lessp (a (times a x)) (b (times a y)))) (do-not-induct t))) (disable equal-times-arg1) (lemma equal-times-bridge (rewrite) (equal (equal (times a b) (times c (times a d))) (or (zerop a) (equal (fix b) (times c d)))) ((enable commutativity-of-times commutativity2-of-times equal-times-0 equal-times-arg1 times-zero))) (disable equal-times-bridge) (lemma eval$-times-member (rewrite) (implies (member e x) (equal (eval$ t (times-tree x) a) (times (eval$ t e a) (eval$ t (times-tree (delete e x)) a)))) ((enable delete times-tree COMMUTATIVITY-OF-TIMES DELETE-NON-MEMBER EQUAL-TIMES-0 EQUAL-TIMES-BRIDGE LISTP-DELETE MEMBER-NON-LIST TIMES-1-ARG1 TIMES-ZERO))) (disable eval$-times-member) (lemma zerop-makes-times-tree-zero (rewrite) (implies (and (not (eval$ t (and-not-zerop-tree x) a)) (subbagp x y)) (equal (eval$ t (times-tree y) a) 0)) ((enable AND-NOT-ZEROP-TREE COMMUTATIVITY-OF-TIMES EVAL$-TIMES-MEMBER SUBBAGP TIMES-TREE TIMES-ZERO))) (disable zerop-makes-times-tree-zero) (lemma or-zerop-tree-is-not-zerop-tree (rewrite) (equal (eval$ t (or-zerop-tree x) a) (not (eval$ t (and-not-zerop-tree x) a))) ((enable AND-NOT-ZEROP-TREE OR-ZEROP-TREE))) (disable or-zerop-tree-is-not-zerop-tree) (lemma zerop-makes-times-tree-zero2 (rewrite) (implies (and (eval$ t (or-zerop-tree x) a) (subbagp x y)) (equal (eval$ t (times-tree y) a) 0)) ((use (zerop-makes-times-tree-zero) (or-zerop-tree-is-not-zerop-tree)) (enable OR-ZEROP-TREE SUBBAGP TIMES-TREE))) (disable zerop-makes-times-tree-zero2) (lemma times-tree-append (rewrite) (equal (eval$ t (times-tree (append x y)) a) (times (eval$ t (times-tree x) a) (eval$ t (times-tree y) a))) ((enable append ASSOCIATIVITY-OF-TIMES COMMUTATIVITY-OF-TIMES COMMUTATIVITY2-OF-TIMES EQUAL-TIMES-0 EQUAL-TIMES-ARG1 EQUAL-TIMES-BRIDGE NUMBERP-EVAL$-TIMES-TREE TIMES-1-ARG1 TIMES-TREE TIMES-ZERO))) (disable times-tree-append) (lemma times-tree-of-times-fringe (rewrite) (equal (eval$ t (times-tree (times-fringe x)) a) (fix (eval$ t x a))) ((enable COMMUTATIVITY-OF-TIMES EVAL$-TIMES TIMES-FRINGE TIMES-TREE TIMES-TREE-APPEND TIMES-ZERO) (induct (times-fringe x)))) (disable times-tree-of-times-fringe) (defn cancel-lessp-times (x) (if (and (equal (car x) 'lessp) (equal (caadr x) 'times) (equal (caaddr x) 'times)) (let ((inboth (bagint (times-fringe (cadr x)) (times-fringe (caddr x))))) (if (listp inboth) (list 'and (and-not-zerop-tree inboth) (list 'lessp (times-tree (bagdiff (times-fringe (cadr x)) inboth)) (times-tree (bagdiff (times-fringe (caddr x)) inboth)))) x)) x)) (lemma eval$-lessp-times-tree-bagdiff (rewrite) (implies (and (subbagp x y) (subbagp x z) (eval$ t (and-not-zerop-tree x) a)) (equal (lessp (eval$ t (times-tree (bagdiff y x)) a) (eval$ t (times-tree (bagdiff z x)) a)) (lessp (eval$ t (times-tree y) a) (eval$ t (times-tree z) a)))) ((enable AND-NOT-ZEROP-TREE BAGDIFF EVAL$-TIMES-MEMBER LESSP-TIMES-CANCELLATION1 SUBBAGP SUBBAGP-CDR1 SUBBAGP-CDR2 TIMES-TREE ZEROP-MAKES-TIMES-TREE-ZERO))) (disable eval$-lessp-times-tree-bagdiff) (lemma zerop-makes-lessp-false-bridge (rewrite) (implies (and (equal (car x) 'times) (equal (car y) 'times) (not (eval$ t (and-not-zerop-tree (bagint (times-fringe x) (times-fringe y))) a))) (equal (lessp (times (eval$ t (cadr x) a) (eval$ t (caddr x) a)) (times (eval$ t (cadr y) a) (eval$ t (caddr y) a))) f)) ((enable AND-NOT-ZEROP-TREE BAGINT COMMUTATIVITY-OF-TIMES DELETE EQUAL-TIMES-0 EVAL$-TIMES ;MEMBER-CONS ;MEMBER-NON-LIST SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-FRINGE TIMES-TREE TIMES-TREE-APPEND TIMES-TREE-OF-TIMES-FRINGE TIMES-ZERO) (use (zerop-makes-times-tree-zero (x (bagint (times-fringe x) (times-fringe y))) (y (times-fringe x))) (zerop-makes-times-tree-zero (x (bagint (times-fringe x) (times-fringe y))) (y (times-fringe y)))))) (disable zerop-makes-lessp-false-bridge) (lemma correctness-of-cancel-lessp-times ((meta lessp)) (equal (eval$ t x a) (eval$ t (cancel-lessp-times x) a)) ((enable CANCEL-LESSP-TIMES EVAL$-LESSP-TIMES-TREE-BAGDIFF EVAL$-LESSP EVAL$-TIMES SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-TREE-OF-TIMES-FRINGE ZEROP-MAKES-LESSP-FALSE-BRIDGE))) (defn cancel-equal-times (x) (if (and (equal (car x) 'equal) (equal (caadr x) 'times) (equal (caaddr x) 'times)) (let ((inboth (bagint (times-fringe (cadr x)) (times-fringe (caddr x))))) (if (listp inboth) (list 'or (or-zerop-tree inboth) (list 'equal (times-tree (bagdiff (times-fringe (cadr x)) inboth)) (times-tree (bagdiff (times-fringe (caddr x)) inboth)))) x)) x)) (lemma zerop-makes-equal-true-bridge (rewrite) (implies (and (equal (car x) 'times) (equal (car y) 'times) (eval$ t (or-zerop-tree (bagint (times-fringe x) (times-fringe y))) a)) (equal (equal (times (eval$ t (cadr x) a) (eval$ t (caddr x) a)) (times (eval$ t (cadr y) a) (eval$ t (caddr y) a))) t)) ((enable BAGINT COMMUTATIVITY-OF-TIMES DELETE EQUAL-TIMES-0 EVAL$-TIMES OR-ZEROP-TREE SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-FRINGE TIMES-TREE TIMES-TREE-APPEND TIMES-TREE-OF-TIMES-FRINGE TIMES-ZERO) (use (zerop-makes-times-tree-zero2 (x (bagint (times-fringe x) (times-fringe y))) (y (times-fringe x))) (zerop-makes-times-tree-zero2 (x (bagint (times-fringe x) (times-fringe y))) (y (times-fringe y)))))) (disable zerop-makes-equal-true-bridge) (lemma eval$-equal-times-tree-bagdiff (rewrite) (implies (and (subbagp x y) (subbagp x z) (not (eval$ t (or-zerop-tree x) a))) (equal (equal (eval$ t (times-tree (bagdiff y x)) a) (eval$ t (times-tree (bagdiff z x)) a)) (equal (eval$ t (times-tree y) a) (eval$ t (times-tree z) a)))) ((enable AND-NOT-ZEROP-TREE BAGDIFF EQUAL-TIMES-ARG1 EVAL$-TIMES-MEMBER NUMBERP-EVAL$-TIMES-TREE OR-ZEROP-TREE OR-ZEROP-TREE-IS-NOT-ZEROP-TREE SUBBAGP SUBBAGP-CDR1 SUBBAGP-CDR2 TIMES-TREE ZEROP-MAKES-TIMES-TREE-ZERO))) (disable eval$-equal-times-tree-bagdiff) (lemma cancel-equal-times-preserves-inequality (rewrite) (implies (and (subbagp z x) (subbagp z y) (not (equal (eval$ t (times-tree x) a) (eval$ t (times-tree y) a)))) (not (equal (eval$ t (times-tree (bagdiff x z)) a) (eval$ t (times-tree (bagdiff y z)) a)))) ((enable BAGDIFF EVAL$-TIMES-MEMBER SUBBAGP SUBBAGP-CDR2 TIMES-TREE))) (disable cancel-equal-times-preserves-inequality) (lemma cancel-equal-times-preserves-inequality-bridge (rewrite) (implies (and (equal (car x) 'times) (equal (car y) 'times) (not (equal (times (eval$ t (cadr x) a) (eval$ t (caddr x) a)) (times (eval$ t (cadr y) a) (eval$ t (caddr y) a))))) (not (equal (eval$ t (times-tree (bagdiff (times-fringe x) (bagint (times-fringe x) (times-fringe y)))) a) (eval$ t (times-tree (bagdiff (times-fringe y) (bagint (times-fringe x) (times-fringe y)))) a)))) ((enable BAGDIFF BAGINT COMMUTATIVITY-OF-TIMES SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-FRINGE TIMES-TREE TIMES-TREE-APPEND TIMES-TREE-OF-TIMES-FRINGE TIMES-ZERO) (use (cancel-equal-times-preserves-inequality (z (bagint (times-fringe x) (times-fringe y))) (x (times-fringe x)) (y (times-fringe y)))))) (disable cancel-equal-times-preserves-inequality-bridge) (lemma correctness-of-cancel-equal-times ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-equal-times x) a)) ((enable CANCEL-EQUAL-TIMES CANCEL-EQUAL-TIMES-PRESERVES-INEQUALITY-BRIDGE EVAL$-EQUAL EVAL$-EQUAL-TIMES-TREE-BAGDIFF EVAL$-TIMES SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-TREE-OF-TIMES-FRINGE ZEROP-MAKES-EQUAL-TRUE-BRIDGE))) ; Define the available theory of multiplication. To get the list of ; events to put in the theory, evaluate the following form in NQTHM at ; this point in the script. This form lists all lemmas which are ; globally enabled, and which have non-null lemma type. ; ; (remove-if-not (function (lambda (x) ; (and (member x (lemmas)) ; (not (assoc x disabled-lemmas)) ; (not (null (nth 2 (get x 'event)))) ; (not (member x (nth 2 (get 'addition 'event))))))) ; chronology) (deftheory multiplication (EQUAL-TIMES-0 EQUAL-TIMES-1 equal-sub1-0 TIMES-ZERO TIMES-ADD1 COMMUTATIVITY-OF-TIMES TIMES-DISTRIBUTES-OVER-PLUS COMMUTATIVITY2-OF-TIMES ASSOCIATIVITY-OF-TIMES TIMES-DISTRIBUTES-OVER-DIFFERENCE TIMES-QUOTIENT TIMES-1-ARG1 LESSP-TIMES1 LESSP-TIMES2 lessp-times3 LESSP-PLUS-TIMES1 LESSP-PLUS-TIMES2 LESSP-1-TIMES correctness-of-cancel-lessp-times correctness-of-cancel-equal-times)) ; ---------- REMAINDER ---------- (lemma lessp-remainder (rewrite generalize) (equal (lessp (remainder x y) y) (not (zerop y)))) (lemma remainder-noop (rewrite) (implies (lessp a b) (equal (remainder a b) (fix a)))) (lemma remainder-of-non-number (rewrite) (implies (not (numberp a)) (equal (remainder a n) (remainder 0 n)))) (lemma remainder-zero (rewrite) (implies (zerop x) (equal (remainder y x) (fix y)))) (lemma plus-remainder-times-quotient (rewrite) (equal (plus (remainder x y) (times y (quotient x y))) (fix x)) ((enable commutativity2-of-plus commutativity-of-plus times-zero times-add1 commutativity-of-times))) (DISABLE PLUS-REMAINDER-TIMES-QUOTIENT) (lemma remainder-quotient-elim (elim) (implies (and (not (zerop y)) (numberp x)) (equal (plus (remainder x y) (times y (quotient x y))) x)) ((enable plus-remainder-times-quotient))) ; (lemma remainder-sub1 (rewrite) ; (implies (and (not (zerop a)) ; (not (zerop b))) ; (equal (remainder (sub1 a) b) ; (if (equal (remainder a b) 0) ; (sub1 b) ; (sub1 (remainder a b))))) ; ((enable lessp-remainder ; remainder-noop ; remainder-quotient-elim) ; (enable-theory addition) ; (induct (remainder a b)))) (lemma remainder-add1 (rewrite) (implies (equal (remainder a b) 0) (equal (remainder (add1 a) b) (remainder 1 b))) ((enable remainder-noop) (enable-theory addition) (induct (remainder a b)))) (lemma remainder-plus-proof () (implies (equal (remainder b c) 0) (equal (remainder (plus a b) c) (remainder a c))) ((enable remainder-noop) (enable-theory addition) (induct (remainder b c)))) (lemma remainder-plus (rewrite) (implies (equal (remainder a c) 0) (and (equal (remainder (plus a b) c) (remainder b c)) (equal (remainder (plus b a) c) (remainder b c)) (equal (remainder (plus x y a) c) (remainder (plus x y) c)))) ((use (remainder-plus-proof (a b) (b a) (c c)) (remainder-plus-proof (a a) (b b) (c c)) (remainder-plus-proof (b a) (a (plus x y)) (c c))) (enable commutativity-of-plus commutativity2-of-plus associativity-of-plus))) (lemma equal-remainder-plus-0-proof () (implies (equal (remainder a c) 0) (equal (equal (remainder (plus a b) c) 0) (equal (remainder b c) 0))) ((enable remainder-plus))) (lemma equal-remainder-plus-0 (rewrite) (implies (equal (remainder a c) 0) (and (equal (equal (remainder (plus a b) c) 0) (equal (remainder b c) 0)) (equal (equal (remainder (plus b a) c) 0) (equal (remainder b c) 0)) (equal (equal (remainder (plus x y a) c) 0) (equal (remainder (plus x y) c) 0)))) ((use (equal-remainder-plus-0-proof (a a) (b b) (c c)) (equal-remainder-plus-0-proof (a b) (b a) (c c)) (equal-remainder-plus-0-proof (a a) (b (plus x y)) (c c))) (enable associativity-of-plus commutativity-of-plus commutativity2-of-plus) (do-not-induct t))) (lemma equal-remainder-plus-remainder-proof () (implies (lessp a c) (equal (equal (remainder (plus a b) c) (remainder b c)) (zerop a))) ((enable remainder-noop) (enable-theory addition) (induct (remainder b c)))) (lemma equal-remainder-plus-remainder (rewrite) (implies (lessp a c) (and (equal (equal (remainder (plus a b) c) (remainder b c)) (zerop a)) (equal (equal (remainder (plus b a) c) (remainder b c)) (zerop a)))) ((use (equal-remainder-plus-remainder-proof (a a) (b b) (c c))) (enable commutativity-of-plus) (do-not-induct t))) (DISABLE EQUAL-REMAINDER-PLUS-REMAINDER) (lemma remainder-times1-proof () (implies (equal (remainder b c) 0) (equal (remainder (times a b) c) 0)) ((enable-theory multiplication addition) (enable remainder-plus remainder-noop remainder-zero))) (lemma remainder-times1 (rewrite) (implies (equal (remainder b c) 0) (and (equal (remainder (times a b) c) 0) (equal (remainder (times b a) c) 0))) ((use (remainder-times1-proof (a a) (b b) (c c)) (remainder-times1-proof (a b) (b a) (c c))) (enable commutativity-of-times))) (lemma remainder-times1-instance-proof () (equal (remainder (times x y) y) 0) ((enable commutativity-of-times difference-plus-cancellation remainder-zero) (induct (times x y)))) (lemma remainder-times1-instance (rewrite) (and (equal (remainder (times x y) y) 0) (equal (remainder (times x y) x) 0)) ((use (remainder-times1-instance-proof (x x) (y y)) (remainder-times1-instance-proof (x y) (y x))) (enable commutativity-of-times))) (lemma remainder-times-times-proof () (equal (remainder (times x y) (times x z)) (times x (remainder y z))) ((enable-theory addition multiplication) (enable remainder-zero) (induct (remainder y z)))) (lemma remainder-times-times (rewrite) (and (equal (remainder (times x y) (times x z)) (times x (remainder y z))) (equal (remainder (times x z) (times y z)) (times (remainder x y) z))) ((use (remainder-times-times-proof (x x) (y y) (z z)) (remainder-times-times-proof (x z) (y x) (z y))) (enable commutativity-of-times))) (DISABLE REMAINDER-TIMES-TIMES) (lemma remainder-times2-proof () (implies (equal (remainder a z) 0) (equal (remainder a (times z y)) (times z (remainder (quotient a z) y)))) ((enable-theory addition multiplication) (enable lessp-remainder remainder-noop remainder-plus remainder-quotient-elim remainder-times-times remainder-times1-instance remainder-zero) (do-not-induct t))) (lemma remainder-times2 (rewrite) (implies (equal (remainder a z) 0) (and (equal (remainder a (times y z)) (times z (remainder (quotient a z) y))) (equal (remainder a (times z y)) (times z (remainder (quotient a z) y))))) ((use (remainder-times2-proof (a a) (y y) (z z))) (enable commutativity-of-times))) (lemma remainder-times2-instance (rewrite) (and (equal (remainder (times x y) (times x z)) (times x (remainder y z))) (equal (remainder (times x z) (times y z)) (times (remainder x y) z))) ((enable remainder-times-times))) (lemma remainder-difference1 (rewrite) (implies (equal (remainder a c) (remainder b c)) (equal (remainder (difference a b) c) (difference (remainder a c) (remainder b c)))) ((enable lessp-remainder equal-remainder-plus-remainder remainder-plus remainder-quotient-elim remainder-times1-instance) (enable-theory addition) (do-not-induct t))) (defn double-remainder-induction (a b c) (if (zerop c) 0 (if (lessp a c) 0 (if (lessp b c) 0 (double-remainder-induction (difference a c) (difference b c) c))))) (lemma remainder-difference2 (rewrite) (implies (and (equal (remainder a c) 0) (not (equal (remainder b c) 0))) (equal (remainder (difference a b) c) (if (lessp b a) (difference c (remainder b c)) 0))) ((enable equal-remainder-plus-0 lessp-remainder remainder-noop remainder-of-non-number remainder-quotient-elim remainder-times1-instance remainder-zero) (disable times-distributes-over-plus) (enable-theory addition multiplication) (induct (double-remainder-induction a b c)))) (lemma remainder-difference3 (rewrite) (implies (and (equal (remainder b c) 0) (not (equal (remainder a c) 0))) (equal (remainder (difference a b) c) (if (lessp b a) (remainder a c) 0))) ((enable remainder-noop remainder-of-non-number remainder-zero) (enable-theory addition) (induct (double-remainder-induction a b c)))) (DISABLE REMAINDER-DIFFERENCE3) (lemma equal-remainder-difference-0 (rewrite) (equal (equal (remainder (difference a b) c) 0) (if (leq b a) (equal (remainder a c) (remainder b c)) t)) ((enable lessp-remainder remainder-difference1 remainder-of-non-number remainder-plus remainder-quotient-elim remainder-times1-instance remainder-zero) (enable-theory addition) (do-not-induct t))) (DISABLE EQUAL-REMAINDER-DIFFERENCE-0) (lemma lessp-plus-fact (rewrite) (implies (and (equal (remainder b x) 0) (equal (remainder c x) 0) (lessp b c) (lessp a x)) (equal (lessp (plus a b) c) t)) ((enable-theory addition) (induct (double-remainder-induction b c x)))) (DISABLE LESSP-PLUS-FACT) (lemma remainder-plus-fact () (implies (and (equal (remainder b x) 0) (equal (remainder c x) 0) (lessp a x)) (equal (remainder (plus a b) c) (plus a (remainder b c)))) ((enable lessp-plus-fact remainder-noop remainder-difference1) (enable-theory addition multiplication) (induct (remainder b c)))) (lemma remainder-plus-times-times-proof () (implies (lessp a b) (equal (remainder (plus a (times b c)) (times b d)) (plus a (remainder (times b c) (times b d))))) ((use (remainder-plus-fact (a a) (x b) (b (times b c)) (c (times b d)))) (enable remainder-times1-instance remainder-times2-instance) (do-not-induct t))) (lemma remainder-plus-times-times (rewrite) (implies (lessp a b) (and (equal (remainder (plus a (times b c)) (times b d)) (plus a (remainder (times b c) (times b d)))) (equal (remainder (plus a (times c b)) (times d b)) (plus a (remainder (times c b) (times d b)))))) ((use (remainder-plus-times-times-proof (a a) (b b) (c c) (d d))) (enable commutativity-of-times) (do-not-induct t))) ; REMAINDER-PLUS-TIMES-TIMES-INSTANCE is the completion of the rules ; TIMES-DISTRIBUTES-OVER-PLUS, REMAINDER-TIMES-TIMES and REMAINDER-PLUS-TIMES-TIMES (lemma remainder-plus-times-times-instance (rewrite) (implies (lessp a b) (and (equal (remainder (plus a (times b c) (times b d)) (times b e)) (plus a (times b (remainder (plus c d) e)))) (equal (remainder (plus a (times c b) (times d b)) (times e b)) (plus a (times b (remainder (plus c d) e)))))) ((enable commutativity-of-times remainder-times-times remainder-plus-times-times) (use (times-distributes-over-plus (x b) (y c) (z d))) (do-not-induct t))) (lemma remainder-remainder (rewrite) (implies (equal (remainder b a) 0) (equal (remainder (remainder n b) a) (remainder n a))) ((induct (remainder n b)) (enable remainder-plus remainder-quotient-elim remainder-zero) (enable-theory addition multiplication))) (lemma remainder-1-arg1 (rewrite) (equal (remainder 1 x) (if (equal x 1) 0 1)) ((enable difference-leq-arg1))) (lemma remainder-1-arg2 (rewrite) (equal (remainder y 1) 0)) (lemma remainder-x-x (rewrite) (equal (remainder x x) 0) ((enable equal-difference-0))) (lemma transitivity-of-divides () (implies (and (equal (remainder a b) 0) (equal (remainder b c) 0)) (equal (remainder a c) 0)) ((enable remainder remainder-noop remainder-plus) (enable-theory addition))) ; Define the available theory of remainder. To get the list of ; events to put in the theory, evaluate the following form in NQTHM at ; this point in the script. This form lists all lemmas which are ; globally enabled, and which have non-null lemma type. ; ; ; (let ((lemmas (lemmas))) ; (remove-if-not (function (lambda (x) ; (and (member x lemmas) ; (not (assoc x disabled-lemmas)) ; (not (null (nth 2 (get x 'event)))) ; (not (member x (nth 2 (get 'addition 'event)))) ; (not (member x (nth 2 (get 'multiplication 'event))))))) ; chronology)) (deftheory remainders (LESSP-REMAINDER REMAINDER-NOOP REMAINDER-OF-NON-NUMBER REMAINDER-ZERO REMAINDER-QUOTIENT-ELIM REMAINDER-ADD1 REMAINDER-PLUS EQUAL-REMAINDER-PLUS-0 REMAINDER-TIMES1 REMAINDER-TIMES1-INSTANCE REMAINDER-TIMES2 REMAINDER-TIMES2-INSTANCE REMAINDER-DIFFERENCE1 REMAINDER-DIFFERENCE2 REMAINDER-PLUS-TIMES-TIMES REMAINDER-PLUS-TIMES-TIMES-INSTANCE REMAINDER-REMAINDER REMAINDER-1-ARG1 REMAINDER-1-ARG2 REMAINDER-X-X)) ; ---------- QUOTIENT, DIVIDES ---------- (lemma quotient-noop (rewrite) (implies (equal b 1) (equal (quotient a b) (fix a)))) (lemma quotient-of-non-number (rewrite) (implies (not (numberp a)) (equal (quotient a n) (quotient 0 n)))) (lemma quotient-zero (rewrite) (implies (zerop x) (equal (quotient y x) 0))) (lemma quotient-add1 (rewrite) (implies (equal (remainder a b) 0) (equal (quotient (add1 a) b) (if (equal b 1) (add1 (quotient a b)) (quotient a b)))) ((enable quotient-noop) (enable-theory addition) (induct (remainder a b)))) (lemma equal-quotient-0 (rewrite) (equal (equal (quotient a b) 0) (or (zerop b) (lessp a b))) ((induct (quotient a b)))) (lemma quotient-sub1 (rewrite) (implies (and (not (zerop a)) (not (zerop b))) (equal (quotient (sub1 a) b) (if (equal (remainder a b) 0) (sub1 (quotient a b)) (quotient a b)))) ((enable quotient-noop equal-quotient-0) (enable-theory addition) (induct (remainder a b)))) (lemma quotient-plus-proof () (implies (equal (remainder b c) 0) (equal (quotient (plus a b) c) (plus (quotient a c) (quotient b c)))) ((enable remainder-noop) (enable-theory addition) (induct (remainder b c)))) (lemma quotient-plus (rewrite) (implies (equal (remainder a c) 0) (and (equal (quotient (plus a b) c) (plus (quotient a c) (quotient b c))) (equal (quotient (plus b a) c) (plus (quotient a c) (quotient b c))) (equal (quotient (plus x y a) c) (plus (quotient (plus x y) c) (quotient a c))))) ((use (quotient-plus-proof (a b) (b a) (c c)) (quotient-plus-proof (a a) (b b) (c c)) (quotient-plus-proof (a (plus x y)) (b a) (c c))) (enable commutativity-of-plus commutativity2-of-plus associativity-of-plus) (do-not-induct t))) ; I need QUOTIENT-TIMES-INSTANCE to prove the more general QUOTIENT-TIMES, ; but I want QUOTIENT-TIMES-INSTANCE to be tried first (i.e. come after ; QUOTIENT-TIMES in the event list.) So first, prove QUOTIENT-TIMES-INSTANCE-TEMP, ; then prove QUOTIENT-TIMES, and finally give QUOTIENT-TIMES-INSTANCE. (lemma quotient-times-instance-temp-proof () (equal (quotient (times y x) y) (if (zerop y) 0 (fix x))) ((enable times-zero commutativity-of-times difference-plus-cancellation))) (lemma quotient-times-instance-temp (rewrite) (and (equal (quotient (times y x) y) (if (zerop y) 0 (fix x))) (equal (quotient (times x y) y) (if (zerop y) 0 (fix x)))) ((use (quotient-times-instance-temp-proof (x x) (y y)) (quotient-times-instance-temp-proof (x y) (y x))) (enable commutativity-of-times))) (DISABLE QUOTIENT-TIMES-INSTANCE-TEMP) (lemma quotient-times-proof () (implies (equal (remainder a c) 0) (equal (quotient (times a b) c) (times b (quotient a c)))) ((enable-theory addition multiplication remainders) (enable quotient-plus quotient-noop equal-quotient-0 quotient-times-instance-temp) (induct (remainder a c)))) (lemma quotient-times (rewrite) (implies (equal (remainder a c) 0) (and (equal (quotient (times a b) c) (times b (quotient a c))) (equal (quotient (times b a) c) (times b (quotient a c))))) ((enable commutativity-of-times) (use (quotient-times-proof (a a) (b b) (c c))) (do-not-induct t))) (lemma quotient-times-instance (rewrite) (and (equal (quotient (times y x) y) (if (zerop y) 0 (fix x))) (equal (quotient (times x y) y) (if (zerop y) 0 (fix x)))) ((enable quotient-times-instance-temp))) (lemma quotient-times-times-proof () (equal (quotient (times x y) (times x z)) (if (zerop x) 0 (quotient y z))) ((enable-theory addition) (enable lessp-times-cancellation1 equal-times-0 times-zero commutativity-of-times times-distributes-over-difference) (induct (quotient y z)))) (lemma quotient-times-times (rewrite) (and (equal (quotient (times x y) (times x z)) (if (zerop x) 0 (quotient y z))) (equal (quotient (times x z) (times y z)) (if (zerop z) 0 (quotient x y)))) ((use (quotient-times-times-proof (x x) (y y) (z z)) (quotient-times-times-proof (x z) (y x) (z y))) (enable commutativity-of-times))) (disable quotient-times-times) (lemma quotient-difference1 (rewrite) (implies (equal (remainder a c) (remainder b c)) (equal (quotient (difference a b) c) (difference (quotient a c) (quotient b c)))) ((enable-theory addition multiplication remainders) (enable quotient-plus quotient-times-instance equal-remainder-plus-remainder) (do-not-induct t))) (lemma quotient-lessp-arg1 (rewrite) (implies (lessp a b) (equal (quotient a b) 0))) (lemma quotient-difference2 (rewrite) (implies (and (equal (remainder a c) 0) (not (equal (remainder b c) 0))) (equal (quotient (difference a b) c) (if (lessp b a) (difference (quotient a c) (add1 (quotient b c))) 0))) ((enable equal-quotient-0 equal-remainder-plus-0 quotient-times-instance quotient-zero) (disable times-distributes-over-plus equal-remainder-difference-0 remainder-difference3) (enable-theory addition multiplication remainders) (induct (double-remainder-induction a b c)))) (lemma quotient-difference3 (rewrite) (implies (and (equal (remainder b c) 0) (not (equal (remainder a c) 0))) (equal (quotient (difference a b) c) (if (lessp b a) (difference (quotient a c) (quotient b c)) 0))) ((enable equal-quotient-0 equal-remainder-plus-0 quotient-lessp-arg1 quotient-times-instance quotient-zero) (disable times-distributes-over-plus equal-remainder-difference-0 remainder-difference3) (enable-theory addition multiplication remainders) (induct (double-remainder-induction a b c)))) (lemma remainder-equals-its-first-argument (rewrite) (equal (equal a (remainder a b)) (and (numberp a) (or (zerop b) (lessp a b)))) ((induct (remainder a b)) (enable lessp-remainder remainder-noop remainder-zero))) (DISABLE REMAINDER-EQUALS-ITS-FIRST-ARGUMENT) (lemma quotient-remainder-times (rewrite) (equal (quotient (remainder x (times a b)) a) (remainder (quotient x a) b)) ((enable-theory addition multiplication remainders) (enable ;lessp-plus-times2 remainder-equals-its-first-argument quotient-noop quotient-plus quotient-times-instance quotient-zero) (do-not-induct t))) (lemma quotient-remainder (rewrite) (implies (equal (remainder c a) 0) (equal (quotient (remainder b c) a) (remainder (quotient b a) (quotient c a)))) ((enable-theory addition multiplication remainders) (enable quotient-noop quotient-plus quotient-remainder-times quotient-times-instance quotient-zero) (do-not-induct t))) (lemma quotient-remainder-instance (rewrite) (equal (quotient (remainder x (times a b)) a) (remainder (quotient x a) b)) ((enable quotient-remainder quotient-times-instance remainder-times1-instance) (do-not-induct t))) (lemma quotient-plus-fact () (implies (and (equal (remainder b x) 0) (equal (remainder c x) 0) (lessp a x)) (equal (quotient (plus a b) c) (quotient b c))) ((enable quotient-lessp-arg1 lessp-plus-fact) (enable-theory addition multiplication remainders) (induct (quotient b c)))) (lemma quotient-plus-times-times-proof () (implies (lessp a b) (equal (quotient (plus a (times b c)) (times b d)) (quotient (times b c) (times b d)))) ((use (quotient-plus-fact (a a) (x b) (b (times b c)) (c (times b d)))) (enable remainder-times1-instance) (do-not-induct t))) (lemma quotient-plus-times-times (rewrite) (implies (lessp a b) (and (equal (quotient (plus a (times b c)) (times b d)) (quotient (times b c) (times b d))) (equal (quotient (plus a (times b c)) (times b d)) (quotient (times b c) (times b d))))) ((use (quotient-plus-times-times-proof (a a) (b b) (c c) (d d))) (enable commutativity-of-times) (do-not-induct t))) ; QUOTIENT-PLUS-TIMES-TIMES-INSTANCE is the completion of the rules ; QUOTIENT-TIMES-TIMES, QUOTIENT-PLUS-TIMES-TIMES and TIMES-DISTRIBUTES-OVER-PLUS (lemma quotient-plus-times-times-instance (rewrite) (implies (lessp a b) (and (equal (quotient (plus a (times b c) (times b d)) (times b e)) (if (zerop b) 0 (quotient (plus c d) e))) (equal (quotient (plus a (times c b) (times d b)) (times e b)) (if (zerop b) 0 (quotient (plus d c) e))))) ((enable commutativity-of-times commutativity-of-plus quotient-times-times quotient-plus-times-times) (use (times-distributes-over-plus (x b) (y c) (z d))) (do-not-induct t))) (lemma quotient-quotient (rewrite) (equal (quotient (quotient b a) c) (quotient b (times a c))) ((enable-theory addition multiplication remainders) (disable times-distributes-over-plus) (enable quotient-lessp-arg1 quotient-plus quotient-plus-times-times quotient-times-instance quotient-times-times quotient-noop quotient-zero) (do-not-induct t))) (lemma leq-quotient () (implies (lessp a b) (leq (quotient a c) (quotient b c))) ((induct (double-remainder-induction a b c)) (enable quotient-lessp-arg1 quotient-zero))) (lemma quotient-1-arg2 (rewrite) (equal (quotient n 1) (fix n))) (lemma quotient-1-arg1-casesplit () (or (zerop n) (equal n 1) (lessp 1 n))) (lemma quotient-1-arg1 (rewrite) (equal (quotient 1 n) (if (equal n 1) 1 0)) ((enable quotient-lessp-arg1) (use (quotient-1-arg1-casesplit)))) (lemma quotient-x-x (rewrite) (implies (not (zerop x)) (equal (quotient x x) 1)) ((enable difference-x-x))) (lemma lessp-quotient (rewrite) (equal (lessp (quotient i j) i) (and (not (zerop i)) (not (equal j 1))))) ;; Metalemma to cancel quotient-times expressions ;; ex. ;; (quotient (times a b) (times c (times d a))) -> ;; (if (not (zerop a)) ;; (quotient (fix b) (times c d)) ;; (zero)) ;; (defn cancel-quotient-times (x) (if (and (equal (car x) 'quotient) (equal (caadr x) 'times) (equal (caaddr x) 'times)) (let ((inboth (bagint (times-fringe (cadr x)) (times-fringe (caddr x))))) (if (listp inboth) (list 'if (and-not-zerop-tree inboth) (list 'quotient (times-tree (bagdiff (times-fringe (cadr x)) inboth)) (times-tree (bagdiff (times-fringe (caddr x)) inboth))) '(zero)) x)) x)) (lemma zerop-makes-quotient-zero-bridge (rewrite) (implies (and (equal (car x) 'times) (equal (car y) 'times) (not (eval$ t (and-not-zerop-tree (bagint (times-fringe x) (times-fringe y))) a))) (equal (quotient (times (eval$ t (cadr x) a) (eval$ t (caddr x) a)) (times (eval$ t (cadr y) a) (eval$ t (caddr y) a))) 0)) ((use (zerop-makes-times-tree-zero (x (bagint (times-fringe x) (times-fringe y))) (y (times-fringe x))) (zerop-makes-times-tree-zero (x (bagint (times-fringe x) (times-fringe y))) (y (times-fringe y)))) (enable AND-NOT-ZEROP-TREE BAGINT DELETE EQUAL-QUOTIENT-0 EQUAL-TIMES-0 EVAL$-TIMES ;MEMBER-CONS ;MEMBER-NON-LIST SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-FRINGE TIMES-TREE TIMES-TREE-APPEND TIMES-TREE-OF-TIMES-FRINGE ZEROP-MAKES-LESSP-FALSE-BRIDGE))) (disable zerop-makes-quotient-zero-bridge) (lemma eval$-quotient-times-tree-bagdiff (rewrite) (implies (and (subbagp x y) (subbagp x z) (eval$ t (and-not-zerop-tree x) a)) (equal (quotient (eval$ t (times-tree (bagdiff y x)) a) (eval$ t (times-tree (bagdiff z x)) a)) (quotient (eval$ t (times-tree y) a) (eval$ t (times-tree z) a)))) ((enable AND-NOT-ZEROP-TREE BAGDIFF EQUAL-QUOTIENT-0 EVAL$-TIMES-MEMBER NUMBERP-EVAL$-TIMES-TREE QUOTIENT-TIMES-TIMES SUBBAGP SUBBAGP-CDR1 SUBBAGP-CDR2 TIMES-TREE ZEROP-MAKES-TIMES-TREE-ZERO))) (disable eval$-quotient-times-tree-bagdiff) (lemma correctness-of-cancel-quotient-times ((meta quotient)) (equal (eval$ t x a) (eval$ t (cancel-quotient-times x) a)) ((enable CANCEL-QUOTIENT-TIMES EVAL$-QUOTIENT-TIMES-TREE-BAGDIFF EVAL$-QUOTIENT EVAL$-TIMES SUBBAGP-BAGINT1 SUBBAGP-BAGINT2 TIMES-TREE-OF-TIMES-FRINGE ZEROP-MAKES-QUOTIENT-ZERO-BRIDGE))) ; Define the available theory of quotient. To get the list of events to ; put in the theory, evaluate the following form in NQTHM at this point ; in the script. This form lists all lemmas which are globally enabled, ; and which have non-null lemma type. ; ; ; (let ((lemmas (lemmas))) ; (remove-if-not (function (lambda (x) ; (and (member x lemmas) ; (not (assoc x disabled-lemmas)) ; (not (null (nth 2 (get x 'event)))) ; (not (member x (nth 2 (get 'addition 'event)))) ; (not (member x (nth 2 (get 'multiplication 'event)))) ; (not (member x (nth 2 (get 'remainders 'event))))))) ; chronology)) (deftheory quotients (QUOTIENT-NOOP QUOTIENT-OF-NON-NUMBER QUOTIENT-ZERO QUOTIENT-ADD1 EQUAL-QUOTIENT-0 QUOTIENT-SUB1 QUOTIENT-PLUS QUOTIENT-TIMES QUOTIENT-TIMES-INSTANCE QUOTIENT-DIFFERENCE1 QUOTIENT-LESSP-ARG1 QUOTIENT-DIFFERENCE2 QUOTIENT-DIFFERENCE3 QUOTIENT-REMAINDER-TIMES QUOTIENT-REMAINDER QUOTIENT-REMAINDER-INSTANCE QUOTIENT-PLUS-TIMES-TIMES QUOTIENT-PLUS-TIMES-TIMES-INSTANCE QUOTIENT-QUOTIENT QUOTIENT-1-ARG2 QUOTIENT-1-ARG1 QUOTIENT-X-X LESSP-QUOTIENT correctness-of-cancel-quotient-times)) ;;; exp, log, and gcd (defn exp (i j) (if (zerop j) 1 (times i (exp i (sub1 j))))) (defn log (base n) (if (lessp base 2) 0 (if (zerop n) 0 (add1 (log base (quotient n base)))))) (defn gcd (x y) (if (zerop x) (fix y) (if (zerop y) x (if (lessp x y) (gcd x (difference y x)) (gcd (difference x y) y)))) ((ord-lessp (cons (add1 x) (fix y))))) (lemma remainder-exp (rewrite) (implies (not (zerop k)) (equal (remainder (exp n k) n) 0)) ((enable exp remainder-times1-instance))) (defn double-number-induction (i j) (if (zerop i) 0 (if (zerop j) 0 (double-number-induction (sub1 i) (sub1 j))))) (lemma remainder-exp-exp (rewrite) (implies (leq i j) (equal (remainder (exp a j) (exp a i)) 0)) ((enable exp remainder-1-arg2 remainder-times2-instance) (enable-theory addition multiplication) (induct (double-number-induction i j)))) (lemma quotient-exp (rewrite) (implies (not (zerop k)) (equal (quotient (exp n k) n) (if (zerop n) 0 (exp n (sub1 k))))) ((enable exp quotient-times-instance))) (lemma exp-zero (rewrite) (implies (zerop k) (equal (exp n k) 1)) ((enable exp))) (lemma exp-add1 (rewrite) (equal (exp n (add1 k)) (times n (exp n k))) ((enable exp))) (lemma exp-plus (rewrite) (equal (exp i (plus j k)) (times (exp i j) (exp i k))) ((enable exp associativity-of-times commutativity-of-times))) (lemma exp-0-arg1 (rewrite) (equal (exp 0 k) (if (zerop k) 1 0)) ((enable exp))) (lemma exp-1-arg1 (rewrite) (equal (exp 1 k) 1) ((enable exp))) (lemma exp-0-arg2 (rewrite) (equal (exp n 0) 1) ((enable exp))) (lemma exp-times (rewrite) (equal (exp (times i j) k) (times (exp i k) (exp j k))) ((enable exp associativity-of-times commutativity2-of-times exp-zero))) (lemma exp-exp (rewrite) (equal (exp (exp i j) k) (exp i (times j k))) ((enable exp exp-zero exp-1-arg1 exp-plus exp-times))) (lemma equal-exp-0 (rewrite) (equal (equal (exp n k) 0) (and (zerop n) (not (zerop k)))) ((enable exp equal-times-0) (induct (exp n k)))) (lemma equal-exp-1 (rewrite) (equal (equal (exp n k) 1) (if (zerop k) t (equal n 1))) ((enable exp times-zero times-add1))) (lemma exp-difference (rewrite) (implies (and (leq c b) (not (zerop a))) (equal (exp a (difference b c)) (quotient (exp a b) (exp a c)))) ((enable exp) (enable-theory addition multiplication remainders quotients))) (deftheory exponentiation (equal-exp-0 equal-exp-1 exp-exp exp-add1 exp-times exp-1-arg1 exp-zero exp-0-arg2 exp-0-arg1 exp-difference exp-plus quotient-exp remainder-exp-exp remainder-exp)) (lemma equal-log-0 (rewrite) (equal (equal (log base n) 0) (or (lessp base 2) (zerop n))) ((enable log) (induct (log base n)))) (lemma log-0 (rewrite) (implies (zerop n) (equal (log base n) 0)) ((enable log))) (lemma log-1 (rewrite) (implies (lessp 1 base) (equal (log base 1) 1)) ((enable log) (induct (log base n)))) (defn double-log-induction (base a b) (if (lessp base 2) 0 (if (zerop a) 0 (if (zerop b) 0 (double-log-induction base (quotient a base) (quotient b base)))))) (lemma leq-log-log nil (implies (leq n m) (leq (log c n) (log c m))) ((enable log) (induct (double-log-induction c n m)) (use (leq-quotient (a n) (b m) (c c))))) (lemma log-quotient (rewrite) (implies (lessp 1 c) (equal (log c (quotient n c)) (sub1 (log c n)))) ((enable log))) (lemma log-quotient-times-proof () (implies (lessp 1 c) (equal (log c (quotient n (times c m))) (sub1 (log c (quotient n m))))) ((enable log) (enable-theory addition multiplication remainders quotients))) (lemma log-quotient-times (rewrite) (implies (lessp 1 c) (and (equal (log c (quotient n (times c m))) (sub1 (log c (quotient n m)))) (equal (log c (quotient n (times m c))) (sub1 (log c (quotient n m)))))) ((use (log-quotient-times-proof (c c) (n n) (m m))) (enable commutativity-of-times))) (lemma log-quotient-exp (rewrite) (implies (lessp 1 c) (equal (log c (quotient n (exp c m))) (difference (log c n) m))) ((enable exp log log-quotient-times) (enable-theory addition multiplication remainders quotients))) (lemma log-times-proof () (implies (and (lessp 1 c) (not (zerop n))) (equal (log c (times c n)) (add1 (log c n)))) ((enable log) (enable-theory addition multiplication remainders quotients))) (lemma log-times (rewrite) (implies (and (lessp 1 c) (not (zerop n))) (and (equal (log c (times c n)) (add1 (log c n))) (equal (log c (times n c)) (add1 (log c n))))) ((use (log-times-proof (c c) (n n))) (enable commutativity-of-times))) (lemma log-times-exp-proof () (implies (and (lessp 1 c) (not (zerop n))) (equal (log c (times n (exp c m))) (plus (log c n) m))) ((enable log exp) (enable-theory addition multiplication remainders quotients))) (lemma log-times-exp (rewrite) (implies (and (lessp 1 c) (not (zerop n))) (and (equal (log c (times n (exp c m))) (plus (log c n) m)) (equal (log c (times (exp c m) n)) (plus (log c n) m)))) ((use (log-times-exp-proof (c c) (n n) (m m))) (enable commutativity-of-times))) (lemma log-exp (rewrite) (implies (lessp 1 c) (equal (log c (exp c n)) (add1 n))) ((enable log exp log-1) (enable-theory addition multiplication remainders quotients))) (deftheory logs (LOG-EXP LOG-TIMES-EXP LOG-TIMES LOG-QUOTIENT-EXP LOG-QUOTIENT-TIMES LOG-QUOTIENT LOG-1 LOG-0 EQUAL-LOG-0 EXP-EXP)) (lemma commutativity-of-gcd (rewrite) (equal (gcd b a) (gcd a b)) ((enable gcd) (enable-theory addition))) (defn single-number-induction (n) (if (zerop n) 0 (single-number-induction (sub1 n)))) (lemma gcd-0 (rewrite) (and (equal (gcd 0 x) (fix x)) (equal (gcd x 0) (fix x))) ((enable gcd))) (lemma gcd-1 (rewrite) (and (equal (gcd 1 x) 1) (equal (gcd x 1) 1)) ((enable gcd) (enable-theory addition) (induct (single-number-induction x)))) (lemma equal-gcd-0 (rewrite) (equal (equal (gcd a b) 0) (and (zerop a) (zerop b))) ((enable gcd) (enable-theory addition) (induct (gcd a b)))) (lemma lessp-gcd (rewrite) (implies (not (zerop b)) (and (equal (lessp b (gcd a b)) f) (equal (lessp b (gcd b a)) f))) ((enable gcd commutativity-of-gcd) (enable-theory addition))) (lemma gcd-plus-instance-temp-proof () (equal (gcd a (plus a b)) (gcd a b)) ((enable gcd commutativity-of-gcd) (enable-theory addition) (induct (gcd a b)))) (lemma gcd-plus-instance-temp (rewrite) (and (equal (gcd a (plus a b)) (gcd a b)) (equal (gcd a (plus b a)) (gcd a b))) ((enable commutativity-of-plus) (use (gcd-plus-instance-temp-proof (a a) (b b))) (do-not-induct t))) (lemma gcd-plus-proof () (implies (equal (remainder b a) 0) (equal (gcd a (plus b c)) (gcd a c))) ((enable gcd commutativity-of-gcd gcd-1 gcd-plus-instance-temp) (enable-theory addition) (induct (remainder b a)))) (lemma gcd-plus (rewrite) (implies (equal (remainder b a) 0) (and (equal (gcd a (plus b c)) (gcd a c)) (equal (gcd a (plus c b)) (gcd a c)) (equal (gcd (plus b c) a) (gcd a c)) (equal (gcd (plus c b) a) (gcd a c)))) ((enable commutativity-of-plus commutativity-of-gcd) (use (gcd-plus-proof (a a) (b b) (c c))) (do-not-induct t))) (lemma gcd-plus-instance (rewrite) (and (equal (gcd a (plus a b)) (gcd a b)) (equal (gcd a (plus b a)) (gcd a b))) ((enable gcd-plus-instance-temp) (do-not-induct t))) (lemma remainder-gcd (rewrite) (and (equal (remainder a (gcd a b)) 0) (equal (remainder b (gcd a b)) 0)) ((enable gcd) (enable-theory addition remainders))) (lemma distributivity-of-times-over-gcd-proof () (equal (gcd (times x z) (times y z)) (times z (gcd x y))) ((enable gcd commutativity-of-gcd gcd-0 gcd-plus) (enable-theory addition multiplication remainders))) (lemma distributivity-of-times-over-gcd (rewrite) (and (equal (gcd (times x z) (times y z)) (times z (gcd x y))) (equal (gcd (times z x) (times y z)) (times z (gcd x y))) (equal (gcd (times x z) (times z y)) (times z (gcd x y))) (equal (gcd (times z x) (times z y)) (times z (gcd x y)))) ((use (distributivity-of-times-over-gcd-proof (x x) (y y) (z z))) (enable commutativity-of-times) (do-not-induct t))) (lemma gcd-is-the-greatest nil (implies (and (not (zerop x)) (not (zerop y)) (equal (remainder x z) 0) (equal (remainder y z) 0)) (leq z (gcd x y))) ((enable gcd commutativity-of-gcd distributivity-of-times-over-gcd equal-gcd-0) (enable-theory addition multiplication remainders) (do-not-induct t))) (lemma common-divisor-divides-gcd (rewrite) (implies (and (equal (remainder x z) 0) (equal (remainder y z) 0)) (equal (remainder (gcd x y) z) 0)) ((enable gcd commutativity-of-gcd distributivity-of-times-over-gcd equal-gcd-0) (enable-theory addition multiplication remainders) (do-not-induct t))) ; We prove ASSOCIATIVITY-OF-GCD and COMMUTATIVITY2-OF-GCD roughly the same way. ; Use GCD-IS-THE-GREATEST twice to show that each side of the equality is ; less than or equal to the other side. (lemma associativity-of-gcd-zero-case () (implies (or (zerop a) (zerop b) (zerop c)) (equal (gcd (gcd a b) c) (gcd a (gcd b c)))) ((enable gcd gcd-0) (do-not-induct t))) (lemma associativity-of-gcd (rewrite) (equal (gcd (gcd a b) c) (gcd a (gcd b c))) ((enable equal-gcd-0 remainder-gcd) (use (gcd-is-the-greatest (x a) (y (gcd b c)) (z (gcd (gcd a b) c))) (gcd-is-the-greatest (x (gcd a b)) (y c) (z (gcd a (gcd b c)))) (associativity-of-gcd-zero-case (a a) (b b) (c c)) (transitivity-of-divides (a a) (b (gcd a b)) (c (gcd (gcd a b) c))) (transitivity-of-divides (a b) (b (gcd a b)) (c (gcd (gcd a b) c))) (transitivity-of-divides (a b) (b (gcd b c)) (c (gcd a (gcd b c)))) (transitivity-of-divides (a c) (b (gcd b c)) (c (gcd a (gcd b c)))) (common-divisor-divides-gcd (x b) (y c) (z (gcd (gcd a b) c))) (common-divisor-divides-gcd (x a) (y b) (z (gcd a (gcd b c)))) ) (do-not-induct t))) (lemma commutativity2-of-gcd-zero-case () (implies (or (zerop a) (zerop b) (zerop c)) (equal (gcd b (gcd a c)) (gcd a (gcd b c)))) ((enable gcd gcd-0 commutativity-of-gcd) (do-not-induct t))) (lemma commutativity2-of-gcd (rewrite) (equal (gcd b (gcd a c)) (gcd a (gcd b c))) ((enable equal-gcd-0 remainder-gcd) (use (gcd-is-the-greatest (x a) (y (gcd b c)) (z (gcd b (gcd a c)))) (gcd-is-the-greatest (x b) (y (gcd a c)) (z (gcd a (gcd b c)))) (commutativity2-of-gcd-zero-case (a a) (b b) (c c)) (transitivity-of-divides (a a) (b (gcd a c)) (c (gcd b (gcd a c)))) (transitivity-of-divides (a c) (b (gcd a c)) (c (gcd b (gcd a c)))) (transitivity-of-divides (a b) (b (gcd b c)) (c (gcd a (gcd b c)))) (transitivity-of-divides (a c) (b (gcd b c)) (c (gcd a (gcd b c)))) (common-divisor-divides-gcd (x b) (y c) (z (gcd b (gcd a c)))) (common-divisor-divides-gcd (x a) (y c) (z (gcd a (gcd b c)))) ) (do-not-induct t))) (lemma gcd-x-x (rewrite) (equal (gcd x x) (fix x)) ((enable gcd) (enable-theory addition) (induct (single-number-induction x)))) (lemma gcd-idempotence (rewrite) (and (equal (gcd x (gcd x y)) (gcd x y)) (equal (gcd y (gcd x y)) (gcd x y))) ((enable gcd gcd-x-x gcd-plus remainder-gcd gcd-1 commutativity-of-gcd) (enable-theory addition) (induct (gcd x y)))) (deftheory gcds (commutativity2-of-gcd associativity-of-gcd common-divisor-divides-gcd distributivity-of-times-over-gcd lessp-gcd equal-gcd-0 gcd-0 gcd-idempotence gcd-x-x remainder-gcd gcd-plus gcd-plus-instance gcd-1 commutativity-of-gcd)) (deftheory naturals (addition multiplication remainders quotients exponentiation logs gcds)) (make-lib "naturals" t) ========================= integers.events ========================= (note-lib "naturals" t) ;; By Matt Kaufmann, modified from earlier integer library of Bill ;; Bevier and Matt Wilding. A few functions (even ILESSP) have ;; been changed, but I expect the functionality of this library to ;; include all the functionality of the old one in most or even all ;; cases. ;; Modified from /local/src/nqthm-libs/integers.events to get ILEQ ;; expressed in terms of ILESSP and IDIFFERENCE in terms of INEG and ;; IPLUS. There are other changes too. The highlights are the new ;; metalemmas. ;; I'm going to leave the eval$ rules on that are proved here, and ;; leave eval$ off. ;; My intention is that this library be used in a mode in which ILEQ ;; and IDIFFERENCE are left enabled. Otherwise, the aforementioned ;; meta lemmas may not be very useful, and also a number of additional ;; replacement rules may be needed. ;; There are three theories created by this library. INTEGER-DEFNS is ;; a list of definitions of all integer functions (not including the ;; cancellation metafunctions and their auxiliaries, though), except ;; that ILEQ and IDIFFERENCE have been omitted. This is a useful ;; theory for an ENABLE-THEORY hint when one simply wants to blast all ;; integer functions open, and it's also useful if one wants to close ;; them down with a DISABLE-THEORY hint (perhaps to go with an ;; (ENABLE-THEORY T) hint). Second, ALL-INTEGER-DEFNS is the same as ;; INTEGER-DEFNS except that ILEQ and IDIFFERENCE are included in this ;; one. Finally, INTEGERS is a list of all events to be "exported as ;; enabled" from this file when working in a mode where everything not ;; enabled by an ENABLE-THEORY hint is to be disabled. Notice that ;; some rewrite rules have been included that might appear to be ;; unnecessary in light of the metalemmas; that's because metalemmas ;; only work on tame terms. However, there's no guarantee that the ;; rewrite rules alone will prove very useful (on non-tame terms). ;; Also notice that INTEGER-DEFNS is disjoint from INTEGERS, since we ;; expect the basic definitions (other than ILEQ and IDIFFERENCE) to ;; remain disabled. ;; It's easy to see what I have and haven't placed in INTEGERS, since ;; I'll simply comment out the event names that I want to exclude (see ;; end of this file). ;; One might wish to consider changing (fix-int (minus ...)) in some ;; of the definitions below to (ineg ...). ;; The following meta rules are in this library. ;; (A little documentation added by Matt Wilding July 90) ;; ;; CORRECTNESS-OF-CANCEL-INEG ;; cancel the first argument of an iplus term with a member of the second ;; argument. ;; ;; ex: (iplus (ineg y) (iplus (ineg x) (iplus y z))) ;; --> ;; (iplus (ineg x) (fix-int z)) ;; ;; CORRECTNESS-OF-CANCEL-IPLUS ;; cancel the sides of an equality of iplus sums ;; ;; ex: (equal (iplus x (iplus y z)) (iplus a (iplus z x))) ;; --> ;; (equal (fix-int y) (fix-int a)) ;; ;; CORRECTNESS-OF-CANCEL-IPLUS-ILESSP ;; cancel the sides of an ilessp inequality of sums ;; ;; ex: (ilessp (iplus x (iplus y z)) (iplus a (iplus z x))) ;; --> ;; (ilessp y a) ;; ;; CORRECTNESS-OF-CANCEL-ITIMES ;; cancel the sides of an equality of itimes products ;; ;; ex: (equal (itimes x (itimes y z)) (itimes a (itimes z x))) ;; --> ;; (if (equal (itimes x z) '0) ;; t ;; (equal (fix-int y) (fix-int a))) ;; ;; CORRECTNESS-OF-CANCEL-ITIMES-ILESSP ;; cancel the sides of an inequality of itimes products ;; ;; ex: (ilessp (itimes x (itimes y z)) (itimes a (itimes z x))) ;; --> ;; (if (ilessp (itimes x z) '0) ;; (ilessp a y) ;; (if (ilessp 0 (itimes x z)) ;; (ilessp y a) ;; f)) ;; ;; CORRECTNESS-OF-CANCEL-ITIMES-FACTORS ;; cancel factors in equality terms ;; ex: (equal (iplus (itimes x y) x) (itimes z x)) ;; --> ;; (if (equal (fix-int x) '0) ;; t ;; (equal (fix-int (plus y 1)) (fix-int z))) ;; ;; CORRECTNESS-OF-CANCEL-ITIMES-ILESSP-FACTORS ;; cancel factors in ilessp terms ;; ex: (equal (iplus (itimes x y) x) (itimes z x)) ;; --> ;; (if (ilessp x '0) ;; (ilessp z (iplus y 1)) ;; (if (ilessp '0 x) ;; (ilessp (iplus y '1) z) ;; f)) ;; ;; CORRECTNESS-OF-CANCEL-FACTORS-0 ;; factor one side of equality when other side is constant 0 ;; ;; ex: (equal (iplus x (itimes x y)) '0) ;; --> ;; (or (equal (fix-int (iplus '1 y)) '0) ;; (equal (fix-int x) '0)) ;; ;; CORRECTNESS-OF-CANCEL-FACTORS-ILESSP-0 ;; factor one side of inequality when other side is constant 0 ;; ;; ex: (ilessp (iplus x (itimes x y)) '0) ;; --> ;; (or (and (ilessp (iplus '1 y) '0) ;; (ilessp '0 x)) ;; (and (ilessp '0 (iplus '1 y)) ;; (ilessp x '0))) ;; ;; CORRECTNESS-OF-CANCEL-INEG-TERMS-FROM-EQUALITY ;; rewrite equality to remove ineg terms ;; ;; ex: (equal (iplus (ineg x) (ineg y)) (iplus (ineg z) w)) ;; --> ;; (equal (fix-int z) (iplus x (iplus y w))) ;; ;; CORRECTNESS-OF-CANCEL-INEG-TERMS-FROM-INEQUALITY ;; rewrite inequalities to remove ineg terms ;; ;; ex: (ilessp (iplus (ineg x) (ineg y)) (iplus (ineg z) w)) ;; --> ;; (ilessp (fix-int z) (iplus x (iplus y w))) ;(note-lib "/local/src/nqthm-libs/naturals") ;(compile-uncompiled-defns "xxx") ; -------------------------------------------------------------------------------- ; Integers ; -------------------------------------------------------------------------------- #| The function below has no AND or OR, for efficiency (defn integerp (x) (or (numberp x) (and (negativep x) (not (zerop (negative-guts x)))))) |# (DEFN INTEGERP (X) (COND ((NUMBERP X) T) ((NEGATIVEP X) (NOT (ZEROP (NEGATIVE-GUTS X)))) (T F))) (defn fix-int (x) (if (integerp x) x 0)) ;; Even though I'll include a definition for izerop here, I'll ;; often avoid using it. (defn izerop (i) (equal (fix-int i) 0)) #| old version: (defn izerop (i) (if (integerp i) (equal i 0) t)) |# (defn ilessp (i j) (if (negativep i) (if (negativep j) (lessp (negative-guts j) (negative-guts i)) (if (equal i (minus 0)) (lessp 0 j) t)) (if (negativep j) f (lessp i j)))) (defn ileq (i j) ;; I expect this to be enabled, in analogy to leq. (not (ilessp j i))) (defn iplus (x y) (if (negativep x) (if (negativep y) (if (and (zerop (negative-guts x)) (zerop (negative-guts y))) 0 (minus (plus (negative-guts x) (negative-guts y)))) (if (lessp y (negative-guts x)) (minus (difference (negative-guts x) y)) (difference y (negative-guts x)))) (if (negativep y) (if (lessp x (negative-guts y)) (minus (difference (negative-guts y) x)) (difference x (negative-guts y))) (plus x y)))) (defn ineg (x) (if (negativep x) (negative-guts x) (if (zerop x) 0 (minus x)))) (defn idifference (x y) ;; I find it troublesome to reason separately about idifference, ;; especially for metalemmas, so I intend to keep it enabled. (iplus x (ineg y))) (defn iabs (i) (if (negativep i) (negative-guts i) (fix i))) (defn itimes (i j) (if (negativep i) (if (negativep j) (times (negative-guts i) (negative-guts j)) (fix-int (minus (times (negative-guts i) j)))) (if (negativep j) (fix-int (minus (times i (negative-guts j)))) (times i j)))) (defn iquotient (i j) (if (equal (fix-int j) 0) 0 (if (negativep i) (if (negativep j) (if (equal (remainder (negative-guts i) (negative-guts j)) 0) (quotient (negative-guts i) (negative-guts j)) (add1 (quotient (negative-guts i) (negative-guts j)))) (if (equal (remainder (negative-guts i) j) 0) (fix-int (minus (quotient (negative-guts i) j))) (fix-int (minus (add1 (quotient (negative-guts i) j)))))) (if (negativep j) (fix-int (minus (quotient i (negative-guts j)))) (quotient i j))))) (defn iremainder (i j) (idifference i (itimes j (iquotient i j)))) (defn idiv (i j) (if (equal (fix-int j) 0) 0 (if (negativep i) (if (negativep j) (quotient (negative-guts i) (negative-guts j)) (if (equal (remainder (negative-guts i) j) 0) (fix-int (minus (quotient (negative-guts i) j))) (fix-int (minus (add1 (quotient (negative-guts i) j)))))) (if (negativep j) (if (equal (remainder i (negative-guts j)) 0) (fix-int (minus (quotient i (negative-guts j)))) (fix-int (minus (add1 (quotient i (negative-guts j)))))) (quotient i j))))) (defn imod (i j) (idifference (fix-int i) (itimes j (idiv i j)))) (defn iquo (i j) (if (equal (fix-int j) 0) 0 (if (negativep i) (if (negativep j) (quotient (negative-guts i) (negative-guts j)) (fix-int (minus (quotient (negative-guts i) j)))) (if (negativep j) (fix-int (minus (quotient i (negative-guts j)))) (quotient i j))))) (defn irem (i j) (idifference (fix-int i) (itimes j (iquo i j)))) ; ---------- DEFTHEORY events for definitions ---------- (deftheory integer-defns ;; omits ILEQ and IDIFFERENCE and IZEROP (integerp fix-int ilessp iplus ineg iabs itimes iquotient iremainder idiv imod iquo irem)) (deftheory all-integer-defns (integerp fix-int izerop ilessp ileq iplus ineg idifference iabs itimes iquotient iremainder idiv imod iquo irem)) (disable integerp) (disable fix-int) (disable ilessp) (disable iplus) (disable ineg) (disable iabs) (disable itimes) ;; I've disabled the rest later in the file, just because the lemmas ;; about division were (re-)proved with the remaining functions enabled. ; ---------- INTEGERP ---------- (lemma integerp-fix-int (rewrite) (integerp (fix-int x)) ((enable integerp fix-int))) (lemma integerp-iplus (rewrite) (integerp (iplus x y)) ((enable integerp iplus))) (lemma integerp-idifference (rewrite) (integerp (idifference x y)) ((enable integerp-iplus idifference))) (lemma integerp-ineg (rewrite) (integerp (ineg x)) ((enable integerp ineg))) (lemma integerp-iabs (rewrite) (integerp (iabs x)) ((enable integerp iabs))) (lemma integerp-itimes (rewrite) (integerp (itimes x y)) ((enable integerp itimes fix-int))) ; ---------- FIX-INT ---------- ;; The first of these, FIX-INT-REMOVER, is potentially dangerous from ;; a backchaining point of view, but I believe it's necessary. At least ;; the lemmas below it should go a long way toward preventing its application. (lemma fix-int-remover (rewrite) (implies (integerp x) (equal (fix-int x) x)) ((enable fix-int integerp))) (lemma fix-int-fix-int (rewrite) (equal (fix-int (fix-int x)) (fix-int x)) ((enable fix-int integerp))) (lemma fix-int-iplus (rewrite) (equal (fix-int (iplus a b)) (iplus a b)) ((enable fix-int integerp iplus))) (lemma fix-int-idifference (rewrite) (equal (fix-int (idifference a b)) (idifference a b)) ((enable fix-int-iplus idifference))) (lemma fix-int-ineg (rewrite) (equal (fix-int (ineg x)) (ineg x)) ((enable fix-int integerp ineg))) (lemma fix-int-iabs (rewrite) (equal (fix-int (iabs x)) (iabs x)) ((enable integerp fix-int iabs))) (lemma fix-int-itimes (rewrite) (equal (fix-int (itimes x y)) (itimes x y)) ((enable integerp itimes fix-int))) ; ---------- INEG ---------- (lemma ineg-iplus (rewrite) (equal (ineg (iplus a b)) (iplus (ineg a) (ineg b))) ((enable iplus ineg plus-zero-arg2))) (lemma ineg-ineg (rewrite) (equal (ineg (ineg x)) (fix-int x)) ((enable ineg fix-int integerp))) (lemma ineg-fix-int (rewrite) (equal (ineg (fix-int x)) (ineg x)) ((enable ineg fix-int integerp))) (lemma ineg-of-non-integerp (rewrite) (implies (not (integerp x)) (equal (ineg x) 0)) ((enable ineg integerp))) ;; I don't want the backchaining to slow down the prover. (disable ineg-of-non-integerp) (lemma ineg-0 (rewrite) (equal (ineg 0) 0) ((enable ineg))) ; ---------- IPLUS ---------- ;; The first two of these really aren't necessary, in light ;; of the cancellation metalemma. (lemma iplus-left-id (rewrite) (implies (not (integerp x)) (equal (iplus x y) (fix-int y))) ((enable integerp iplus fix-int))) ;; I don't want the backchaining to slow down the prover. (disable iplus-left-id) (lemma iplus-right-id (rewrite) (implies (not (integerp y)) (equal (iplus x y) (fix-int x))) ((enable integerp iplus fix-int plus-zero-arg2))) ;; I don't want the backchaining to slow down the prover. (disable iplus-right-id) (lemma iplus-0-left (rewrite) (equal (iplus 0 x) (fix-int x)) ((enable iplus fix-int integerp))) (lemma iplus-0-right (rewrite) ;; just in case we turn off commutativity (equal (iplus x 0) (fix-int x)) ((enable iplus fix-int integerp))) (lemma commutativity2-of-iplus (rewrite) (equal (iplus x (iplus y z)) (iplus y (iplus x z))) ((enable iplus commutativity2-of-plus))) (lemma commutativity-of-iplus (rewrite) (equal (iplus x y) (iplus y x)) ((enable iplus commutativity2-of-iplus))) (lemma associativity-of-iplus (rewrite) (equal (iplus (iplus x y) z) (iplus x (iplus y z))) ((enable iplus) (enable-theory addition))) (lemma iplus-cancellation-1 (rewrite) (equal (equal (iplus a b) (iplus a c)) (equal (fix-int b) (fix-int c))) ((enable iplus fix-int integerp) (enable-theory addition))) (lemma iplus-cancellation-2 (rewrite) (equal (equal (iplus b a) (iplus c a)) (equal (fix-int b) (fix-int c))) ((use (iplus-cancellation-1)) (enable commutativity-of-iplus))) (lemma iplus-ineg1 (rewrite) (equal (iplus (ineg a) a) 0) ((enable iplus ineg integerp fix-int))) (lemma iplus-ineg2 (rewrite) (equal (iplus a (ineg a)) 0) ((enable iplus ineg integerp fix-int))) (lemma iplus-fix-int1 (rewrite) (equal (iplus (fix-int a) b) (iplus a b)) ((enable iplus fix-int integerp plus-zero-arg2) (do-not-induct t))) (lemma iplus-fix-int2 (rewrite) (equal (iplus a (fix-int b)) (iplus a b)) ((enable iplus fix-int integerp plus-zero-arg2) (do-not-induct t))) ; ---------- IDIFFERENCE ---------- ;; mostly omitted, but I'll keep a few (lemma idifference-fix-int1 (rewrite) (equal (idifference (fix-int a) b) (idifference a b)) ((enable idifference iplus-fix-int1) (do-not-induct t))) (lemma idifference-fix-int2 (rewrite) (equal (idifference a (fix-int b)) (idifference a b)) ((enable idifference iplus-fix-int2 ineg-fix-int) (do-not-induct t))) ; -------------------------------------------------------------------------------- ; Cancel INEG ; -------------------------------------------------------------------------------- ;; We assume that the given term (IPLUS x y) has the property that y has already ;; been reduced and x is not an iplus-term. So, the only question is whether ;; or not the formal negative of x appears in the fringe of y. #| The function below has no AND or OR, for efficiency (defn cancel-ineg-aux (x y) ;; returns nil or else a new term provably equal to (IPLUS x y) (if (and (listp x) (equal (car x) 'ineg)) (cond ((equal y (cadr x)) ''0) ((and (listp y) (equal (car y) 'iplus)) (let ((y1 (cadr y)) (y2 (caddr y))) (if (equal y1 (cadr x)) (list 'fix-int y2) (let ((z (cancel-ineg-aux x y2))) (if z (list 'iplus y1 z) f))))) (t f)) (cond ((nlistp y) f) ((equal (car y) 'ineg) (if (equal x (cadr y)) ''0 f)) ((equal (car y) 'iplus) (let ((y1 (cadr y)) (y2 (caddr y))) (if (and (listp y1) (equal (car y1) 'ineg) (equal x (cadr y1))) (list 'fix-int y2) (let ((z (cancel-ineg-aux x y2))) (if z (list 'iplus y1 z) f))))) (t f)))) |# (DEFN CANCEL-INEG-AUX (X Y) (COND ((LISTP X) (COND ((EQUAL (CAR X) 'INEG) (COND ((EQUAL Y (CADR X)) ''0) ((LISTP Y) (IF (EQUAL (CAR Y) 'IPLUS) (COND ((EQUAL (CADR Y) (CADR X)) (LIST 'FIX-INT (CADDR Y))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F)) F)) (T F))) ((NLISTP Y) F) ((EQUAL (CAR Y) 'INEG) (IF (EQUAL X (CADR Y)) ''0 F)) ((EQUAL (CAR Y) 'IPLUS) (COND ((LISTP (CADR Y)) (COND ((EQUAL (CAADR Y) 'INEG) (COND ((EQUAL X (CADADR Y)) (LIST 'FIX-INT (CADDR Y))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F))) (T F))) ((NLISTP Y) F) ((EQUAL (CAR Y) 'INEG) (IF (EQUAL X (CADR Y)) ''0 F)) ((EQUAL (CAR Y) 'IPLUS) (COND ((LISTP (CADR Y)) (COND ((EQUAL (CAADR Y) 'INEG) (COND ((EQUAL X (CADADR Y)) (LIST 'FIX-INT (CADDR Y))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F))) ((CANCEL-INEG-AUX X (CADDR Y)) (LIST 'IPLUS (CADR Y) (CANCEL-INEG-AUX X (CADDR Y)))) (T F))) (T F))) #| The function below has no AND or OR, for efficiency (defn cancel-ineg (x) (if (and (listp x) (equal (car x) 'iplus)) (let ((temp (cancel-ineg-aux (cadr x) (caddr x)))) (if temp temp x)) x)) |# (DEFN CANCEL-INEG (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'IPLUS) (IF (CANCEL-INEG-AUX (CADR X) (CADDR X)) (CANCEL-INEG-AUX (CADR X) (CADDR X)) X) X) X)) ;; It seems a big win to turn off eval$. I'll leave the recursive step out in ;; hopes that rewrite-eval$ handles it OK. (prove-lemma eval$-list-cons (rewrite) (equal (eval$ 'list (cons x y) a) (cons (eval$ t x a) (eval$ 'list y a)))) (prove-lemma eval$-list-nlistp (rewrite) (implies (nlistp x) (equal (eval$ 'list x a) nil))) (prove-lemma eval$-litatom (rewrite) (implies (litatom x) (equal (eval$ t x a) (cdr (assoc x a))))) #| (prove-lemma eval$-quotep (rewrite) (equal (eval$ t (list 'quote x) a) x)) |# ;; In place of the above I'll do the following, from ;; the naturals library. (enable eval$-quote) (prove-lemma eval$-other (rewrite) (implies (and (not (litatom x)) (nlistp x)) (equal (eval$ t x a) x))) (disable eval$) ;; What I'd like to do is say what (eval$ t (cancel-ineg-aux x y) a), ;; but a rewrite rule will loop because of the recursion. So I ;; introduce a silly auxiliary function so that the opening-up ;; heuristics can help me. The function body has (listp y) tests ;; so that it can be accepted. (defn eval$-cancel-ineg-aux-fn (x y a) (if (and (listp x) (equal (car x) 'ineg)) (cond ((equal y (cadr x)) 0) (t (let ((y1 (cadr y)) (y2 (caddr y))) (if (equal y1 (cadr x)) (fix-int (eval$ t y2 a)) (if (listp y);; silly acceptability thing (iplus (eval$ t y1 a) (eval$-cancel-ineg-aux-fn x y2 a)) 0))))) (cond ((equal (car y) 'ineg) 0) (t (let ((y1 (cadr y)) (y2 (caddr y))) (if (and (listp y1) (equal (car y1) 'ineg) (equal x (cadr y1))) (fix-int (eval$ t y2 a)) (if (listp y);; silly acceptability thing (iplus (eval$ t y1 a) (eval$-cancel-ineg-aux-fn x y2 a)) 0))))))) (prove-lemma eval$-cancel-ineg-aux-is-its-fn (rewrite) (implies (not (equal (cancel-ineg-aux x y) f)) (equal (eval$ t (cancel-ineg-aux x y) a) (eval$-cancel-ineg-aux-fn x y a)))) (prove-lemma iplus-ineg3 (rewrite) (equal (iplus (ineg x) (iplus x y)) (fix-int y)) ((enable-theory integer-defns))) (prove-lemma iplus-ineg4 (rewrite) (equal (iplus x (iplus (ineg x) y)) (fix-int y)) ((use (iplus-ineg3 (x (ineg x)) (y y))))) (prove-lemma iplus-ineg-promote (rewrite) (equal (iplus y (ineg x)) (iplus (ineg x) y))) (prove-lemma iplus-x-y-ineg-x (rewrite) (equal (iplus x (iplus y (ineg x))) (fix-int y))) (disable iplus-ineg-promote) (prove-lemma correctness-of-cancel-ineg-aux (rewrite) (implies (not (equal (cancel-ineg-aux x y) f)) (equal (eval$-cancel-ineg-aux-fn x y a) (iplus (eval$ t x a) (eval$ t y a)))) ((induct (cancel-ineg-aux x y)))) (prove-lemma correctness-of-cancel-ineg ((meta iplus)) (equal (eval$ t x a) (eval$ t (cancel-ineg x) a)) ((disable cancel-ineg-aux))) (disable correctness-of-cancel-ineg-aux) ; -------------------------------------------------------------------------------- ; Cancel IPLUS ; -------------------------------------------------------------------------------- ;; All I do here is cancel like terms from both sides. The problem of handling ;; INEG cancellation IS handled completely separately above. That hasn't always ;; been the case -- in my first try I attempted to integrate the operations. ;; But now I see that for things like (equal z (iplus x (iplus y (ineg x)))) ;; the integrated approach will fail. Also, thanks to Matt Wilding, for pointing ;; out that the "four squares" example that Bill Pase sent me ran faster with ;; the newer approach (on his previously-implemented version for the rationals). #| The function below has no AND or OR, for efficiency (defn iplus-fringe (x) (if (and (listp x) (equal (car x) (quote iplus))) (append (iplus-fringe (cadr x)) (iplus-fringe (caddr x))) (cons x nil))) |# (DEFN IPLUS-FRINGE (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'IPLUS) (APPEND (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST X)) (LIST X))) (prove-lemma lessp-count-listp-cdr (rewrite) (implies (listp (cdr x)) (lessp (count (cdr x)) (count x)))) (defn iplus-tree-rec (l) (if (nlistp (cdr l)) (car l) (list (quote iplus) (car l) (iplus-tree-rec (cdr l))))) (defn iplus-tree (l) (if (listp l) (if (listp (cdr l)) (iplus-tree-rec l) (list (quote fix-int) (car l))) (quote (quote 0)))) (defn iplus-list (x) (if (listp x) (iplus (car x) (iplus-list (cdr x))) 0)) (prove-lemma integerp-iplus-list (rewrite) (integerp (iplus-list x))) (prove-lemma eval$-iplus-tree-rec (rewrite) (equal (eval$ t (iplus-tree-rec x) a) (if (listp x) (if (listp (cdr x)) (iplus-list (eval$ 'list x a)) (eval$ t (car x) a)) 0))) (prove-lemma eval$-iplus-tree (rewrite) (equal (eval$ t (iplus-tree x) a) (iplus-list (eval$ 'list x a)))) (prove-lemma eval$-list-append (rewrite) (equal (eval$ 'list (append x y) a) (append (eval$ 'list x a) (eval$ 'list y a)))) #| The function below has no AND or OR, for efficiency (defn cancel-iplus (x) (if (and (listp x) (equal (car x) (quote equal))) (if (and (listp (cadr x)) (equal (caadr x) (quote iplus)) (listp (caddr x)) (equal (caaddr x) (quote iplus))) (let ((xs (iplus-fringe (cadr x))) (ys (iplus-fringe (caddr x)))) (let ((bagint (bagint xs ys))) (if (listp bagint) (list (quote equal) (iplus-tree (bagdiff xs bagint)) (iplus-tree (bagdiff ys bagint))) x))) (if (and (listp (cadr x)) (equal (caadr x) (quote iplus)) ;; We don't want to introduce the IF below unless something ;; is "gained", or else we may get into an infinite rewriting loop. (member (caddr x) (iplus-fringe (cadr x)))) (list (quote if) (list (quote integerp) (caddr x)) (list (quote equal) (iplus-tree (delete (caddr x) (iplus-fringe (cadr x)))) ''0) (list (quote quote) f)) (if (and (listp (caddr x)) (equal (caaddr x) (quote iplus)) (member (cadr x) (iplus-fringe (caddr x)))) (list (quote if) (list (quote integerp) (cadr x)) (list (quote equal) ''0 (iplus-tree (delete (cadr x) (iplus-fringe (caddr x))))) (list (quote quote) f)) x))) x)) |# (DEFN CANCEL-IPLUS (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'EQUAL) (COND ((LISTP (CADR X)) (COND ((EQUAL (CAADR X) 'IPLUS) (COND ((LISTP (CADDR X)) (COND ((EQUAL (CAADDR X) 'IPLUS) (IF (LISTP (BAGINT (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))) (LIST 'EQUAL (IPLUS-TREE (BAGDIFF (IPLUS-FRINGE (CADR X)) (BAGINT (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (BAGDIFF (IPLUS-FRINGE (CADDR X)) (BAGINT (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) ((MEMBER (CADDR X) (IPLUS-FRINGE (CADR X))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (CONS 'EQUAL (CONS (IPLUS-TREE (DELETE (CADDR X) (IPLUS-FRINGE (CADR X)))) '('0))) (LIST 'QUOTE F))) (T X))) ((MEMBER (CADDR X) (IPLUS-FRINGE (CADR X))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (CONS 'EQUAL (CONS (IPLUS-TREE (DELETE (CADDR X) (IPLUS-FRINGE (CADR X)))) '('0))) (LIST 'QUOTE F))) (T X))) ((LISTP (CADDR X)) (IF (EQUAL (CAADDR X) 'IPLUS) (IF (MEMBER (CADR X) (IPLUS-FRINGE (CADDR X))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (LIST 'EQUAL ''0 (IPLUS-TREE (DELETE (CADR X) (IPLUS-FRINGE (CADDR X))))) (LIST 'QUOTE F)) X) X)) (T X))) ((LISTP (CADDR X)) (IF (EQUAL (CAADDR X) 'IPLUS) (IF (MEMBER (CADR X) (IPLUS-FRINGE (CADDR X))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (LIST 'EQUAL ''0 (IPLUS-TREE (DELETE (CADR X) (IPLUS-FRINGE (CADDR X))))) (LIST 'QUOTE F)) X) X)) (T X)) X) X)) (lemma eval$-cancel-iplus (rewrite) (equal (eval$ t (cancel-iplus x) a) (if (and (listp x) (equal (car x) (quote equal))) (if (and (listp (cadr x)) (equal (caadr x) (quote iplus)) (listp (caddr x)) (equal (caaddr x) (quote iplus))) (let ((xs (iplus-fringe (cadr x))) (ys (iplus-fringe (caddr x)))) (let ((bagint (bagint xs ys))) (if (listp bagint) (equal (iplus-list (eval$ 'list (bagdiff xs (bagint xs ys)) a)) (iplus-list (eval$ 'list (bagdiff ys (bagint xs ys)) a))) (eval$ t x a)))) (if (and (listp (cadr x)) (equal (caadr x) (quote iplus)) (member (caddr x) (iplus-fringe (cadr x)))) (if (integerp (eval$ t (caddr x) a)) (equal (iplus-list (eval$ 'list (delete (caddr x) (iplus-fringe (cadr x))) a)) 0) f) (if (and (listp (caddr x)) (equal (caaddr x) (quote iplus)) (member (cadr x) (iplus-fringe (caddr x)))) (if (integerp (eval$ t (cadr x) a)) (equal 0 (iplus-list (eval$ 'list (delete (cadr x) (iplus-fringe (caddr x))) a))) f) (eval$ t x a)))) (eval$ t x a))) ((enable eval$-iplus-tree cancel-iplus eval$-list-cons eval$-litatom eval$-quote) (disable eval$))) (disable cancel-iplus) (prove-lemma eval$-iplus-list-delete (rewrite) (implies (member z y) (equal (iplus-list (eval$ 'list (delete z y) a)) (idifference (iplus-list (eval$ 'list y a)) (eval$ t z a))))) (prove-lemma eval$-iplus-list-bagdiff (rewrite) (implies (subbagp x y) (equal (iplus-list (eval$ 'list (bagdiff y x) a)) (idifference (iplus-list (eval$ 'list y a)) (iplus-list (eval$ 'list x a)))))) (prove-lemma iplus-list-append (rewrite) (equal (iplus-list (append x y)) (iplus (iplus-list x) (iplus-list y)))) (disable iplus-tree) ;; because we want to use EVAL$-IPLUS-TREE for now (lemma not-integerp-implies-not-equal-iplus (rewrite) (implies (not (integerp a)) (equal (equal a (iplus b c)) f)) ((use (integerp-iplus (x b) (y c))) (enable integerp) (do-not-induct t))) (prove-lemma iplus-list-eval$-fringe (rewrite) ;; similar to IPLUS-TREE-IPLUS-FRINGE (equal (iplus-list (eval$ 'list (iplus-fringe x) a)) (fix-int (eval$ t x a))) ((induct (iplus-fringe x)))) ;; The following two lemmas aren't needed but they sure do ;; shorten the total proof time!!! (prove-lemma iplus-ineg5-lemma-1 (rewrite) (implies (integerp x) (equal (equal x (iplus y (iplus (ineg z) w))) (equal x (iplus (ineg z) (iplus y w)))))) (prove-lemma iplus-ineg5-lemma-2 (rewrite) (implies (and (integerp x) (integerp v)) (equal (equal x (iplus (ineg z) v)) (equal (iplus x z) v)))) (lemma iplus-ineg5 (rewrite) (implies (integerp x) (equal (equal x (iplus y (iplus (ineg z) w))) (equal (iplus x z) (iplus y w)))) ((enable iplus-ineg5-lemma-1 iplus-ineg5-lemma-2 integerp-iplus))) (disable iplus-ineg5-lemma-1) (disable iplus-ineg5-lemma-2) (lemma iplus-ineg6 (rewrite) (implies (integerp x) (equal (equal x (iplus y (iplus w (ineg z)))) (equal (iplus x z) (iplus y w)))) ((use (iplus-ineg5) (commutativity-of-iplus (x w) (y (ineg z)))))) (prove-lemma eval$-iplus (rewrite) (implies (and (listp x) (equal (car x) 'iplus)) (equal (eval$ t x a) (iplus (eval$ t (cadr x) a) (eval$ t (caddr x) a))))) (prove-lemma iplus-ineg7 (rewrite) (equal (equal 0 (iplus x (ineg y))) (equal (fix-int y) (fix-int x))) ((enable-theory integer-defns))) (prove-lemma correctness-of-cancel-iplus ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-iplus x) a))) (disable iplus-ineg5) (disable iplus-ineg6) ; -------------------------------------------------------------------------------- ; Cancel IPLUS from ILESSP ; -------------------------------------------------------------------------------- ;; This is similar to the cancellation of IPLUS terms from equalities, ;; handled above, and uses many of the same lemmas. A small but definite ;; difference however is that for ILESSP we don't have to fix integers. ;; By luck we have that iplus-tree-rec is appropriate here, since ;; the lemma eval$-iplus-tree-rec shows that it (accidentally) behaves ;; properly on the empty list. (prove-lemma ilessp-fix-int-1 (rewrite) (equal (ilessp (fix-int x) y) (ilessp x y)) ((enable-theory integer-defns))) (prove-lemma ilessp-fix-int-2 (rewrite) (equal (ilessp x (fix-int y)) (ilessp x y)) ((enable-theory integer-defns))) ;; Perhaps the easiest approach is to do everything with respect to the ;; same IPLUS-TREE function that we used before, and then once the ;; supposed meta-lemma is proved, go back and show that we get the ;; same answer if we use a version that doesn't fix-int singleton fringes. (defn make-cancel-iplus-inequality-1 (x y) ;; x and y are term lists (list (quote ilessp) (iplus-tree (bagdiff x (bagint x y))) (iplus-tree (bagdiff y (bagint x y))))) #| The function below has no AND or OR, for efficiency (defn cancel-iplus-ilessp-1 (x) (if (and (listp x) (equal (car x) (quote ilessp))) (make-cancel-iplus-inequality-1 (iplus-fringe (cadr x)) (iplus-fringe (caddr x))) x)) |# (DEFN CANCEL-IPLUS-ILESSP-1 (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'ILESSP) (MAKE-CANCEL-IPLUS-INEQUALITY-1 (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) X) X)) ;; Notice that IPLUS-TREE-NO-FIX-INT is currently enabled, which is ;; good since we want to use EVAL$-IPLUS-TREE-NO-FIX-INT for now. (prove-lemma lessp-difference-plus-arg1 (rewrite) (equal (lessp w (difference (plus w y) x)) (lessp x y))) (prove-lemma lessp-difference-plus-arg1-commuted (rewrite) (equal (lessp w (difference (plus y w) x)) (lessp x y))) (prove-lemma iplus-cancellation-1-for-ilessp (rewrite) (equal (ilessp (iplus a b) (iplus a c)) (ilessp b c)) ((enable-theory integer-defns))) (prove-lemma iplus-cancellation-2-for-ilessp (rewrite) (equal (ilessp (iplus b a) (iplus c a)) (ilessp b c))) (prove-lemma correctness-of-cancel-iplus-ilessp-lemma nil (equal (eval$ t x a) (eval$ t (cancel-iplus-ilessp-1 x) a))) (defn iplus-tree-no-fix-int (l) (if (listp l) (iplus-tree-rec l) (quote (quote 0)))) (prove-lemma eval$-ilessp-iplus-tree-no-fix-int (rewrite) (equal (ilessp (eval$ t (iplus-tree-no-fix-int x) a) (eval$ t (iplus-tree-no-fix-int y) a)) (ilessp (eval$ t (iplus-tree x) a) (eval$ t (iplus-tree y) a)))) (disable iplus-tree-no-fix-int) (lemma make-cancel-iplus-inequality-simplifier (rewrite) (equal (eval$ t (make-cancel-iplus-inequality-1 x y) a) (eval$ t (list (quote ilessp) (iplus-tree-no-fix-int (bagdiff x (bagint x y))) (iplus-tree-no-fix-int (bagdiff y (bagint x y)))) a)) ((enable make-cancel-iplus-inequality-1 eval$-ilessp-iplus-tree-no-fix-int) (disable eval$))) #| The function below has no AND or OR, for efficiency (defn cancel-iplus-ilessp (x) (if (and (listp x) (equal (car x) (quote ilessp))) (let ((x1 (iplus-fringe (cadr x))) (y1 (iplus-fringe (caddr x)))) (let ((bagint (bagint x1 y1))) (if (listp bagint) ;; I check (listp bagint) only for efficiency (list (quote ilessp) (iplus-tree-no-fix-int (bagdiff x1 bagint)) (iplus-tree-no-fix-int (bagdiff y1 bagint))) x))) x)) |# ;; **** Should perhaps check that some argument of the ILESSP has function ;; symbol IPLUS, or else we may wind up dealing with (ILESSP 0 0). That should ;; be harmless enough, though, even if *1*IPLUS is disabled; we'll just get the ;; same term back, the hard way. (DEFN CANCEL-IPLUS-ILESSP (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'ILESSP) (IF (LISTP (BAGINT (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))) (LIST 'ILESSP (IPLUS-TREE-NO-FIX-INT (BAGDIFF (IPLUS-FRINGE (CADR X)) (BAGINT (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE-NO-FIX-INT (BAGDIFF (IPLUS-FRINGE (CADDR X)) (BAGINT (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X) X) X)) (disable make-cancel-iplus-inequality-1) (prove-lemma correctness-of-cancel-iplus-ilessp ((meta ilessp)) (equal (eval$ t x a) (eval$ t (cancel-iplus-ilessp x) a)) ((use (correctness-of-cancel-iplus-ilessp-lemma)))) ; ---------- Multiplication ---------- (lemma itimes-zero1 (rewrite) (implies (equal (fix-int x) 0) (equal (itimes x y) 0)) ((enable itimes times fix-int integerp) (do-not-induct t))) (prove-lemma itimes-0-left (rewrite) (equal (itimes 0 y) 0)) ;; I don't want the backchaining to slow down the prover. (disable itimes-zero1) (lemma itimes-zero2 (rewrite) (implies (equal (fix-int y) 0) (equal (itimes x y) 0)) ((enable itimes fix-int integerp times-zero) (do-not-induct t))) (prove-lemma itimes-0-right (rewrite) (equal (itimes x 0) 0)) ;; I don't want the backchaining to slow down the prover. (disable itimes-zero2) (lemma itimes-fix-int1 (rewrite) (equal (itimes (fix-int a) b) (itimes a b)) ((enable itimes fix-int integerp) (do-not-induct t))) (lemma itimes-fix-int2 (rewrite) (equal (itimes a (fix-int b)) (itimes a b)) ((enable itimes fix-int integerp times-zero) (do-not-induct t))) (lemma commutativity-of-itimes (rewrite) (equal (itimes x y) (itimes y x)) ((enable itimes fix-int integerp) (enable-theory multiplication) (do-not-induct t))) (lemma itimes-distributes-over-iplus-proof () (equal (itimes x (iplus y z)) (iplus (itimes x y) (itimes x z))) ((enable itimes iplus integerp fix-int commutativity2-of-iplus associativity-of-iplus) (enable-theory multiplication addition) (do-not-induct t))) (lemma itimes-distributes-over-iplus (rewrite) (and (equal (itimes x (iplus y z)) (iplus (itimes x y) (itimes x z))) (equal (itimes (iplus x y) z) (iplus (itimes x z) (itimes y z)))) ((use (itimes-distributes-over-iplus-proof (x x) (y y) (z z)) (itimes-distributes-over-iplus-proof (x z) (y x) (z y))) (enable commutativity-of-itimes))) (lemma commutativity2-of-itimes (rewrite) (equal (itimes x (itimes y z)) (itimes y (itimes x z))) ((enable itimes integerp fix-int) (enable-theory multiplication) (do-not-induct t))) (lemma associativity-of-itimes (rewrite) (equal (itimes (itimes x y) z) (itimes x (itimes y z))) ((enable itimes integerp fix-int) (enable-theory multiplication) (do-not-induct t))) (lemma equal-itimes-0 (rewrite) (equal (equal (itimes x y) 0) (or (equal (fix-int x) 0) (equal (fix-int y) 0))) ((enable itimes integerp fix-int) (enable-theory multiplication) (do-not-induct t))) (lemma equal-itimes-1 (rewrite) (equal (equal (itimes a b) 1) (or (and (equal a 1) (equal b 1)) (and (equal a -1) (equal b -1)))) ((enable itimes integerp fix-int) (enable-theory multiplication) (do-not-induct t))) (lemma equal-itimes-minus-1 (rewrite) (equal (equal (itimes a b) -1) (or (and (equal a -1) (equal b 1)) (and (equal a 1) (equal b -1)))) ((enable itimes integerp fix-int) (enable-theory multiplication) (do-not-induct t))) (lemma itimes-1-arg1 (rewrite) (equal (itimes 1 x) (fix-int x)) ((enable integerp fix-int itimes) (enable-theory multiplication) (do-not-induct t))) ; ---------- Division ---------- (lemma quotient-remainder-uniqueness () (implies (and (equal a (plus r (times b q))) (lessp r b)) (and (equal (fix r) (remainder a b)) (equal (fix q) (quotient a b)))) ((enable-theory naturals) (enable remainder quotient))) ; We want to define IQUOTIENT and IREMAINDER. The standard approach to ; integer division derives from from the following theorem. ; ; Division Theorem: ; For all integers i,j, j not 0, there exist unique integers q and r ; which satisfy i = jq + r, 0 <= r < |j|. ; ; The functions IQUOTIENT and IREMAINDER are intended to compute q and r. ; Therefore, to be satisfied that we have the right definitions, we must ; prove the above theorem. (prove-lemma division-theorem-part1 () (implies (integerp i) (equal (iplus (iremainder i j) (itimes j (iquotient i j))) i))) (prove-lemma division-theorem-part2 () (implies (and (integerp j) (not (equal j 0))) (not (ilessp (iremainder i j) 0))) ((enable-theory integer-defns))) (prove-lemma division-theorem-part3 () (implies (and (integerp j) (not (equal j 0))) (ilessp (iremainder i j) (iabs j))) ((enable-theory integer-defns))) (lemma division-theorem () (implies (and (integerp i) (integerp j) (not (equal j 0))) (and (equal (iplus (iremainder i j) (itimes j (iquotient i j))) i) (not (ilessp (iremainder i j) 0)) (ilessp (iremainder i j) (iabs j)))) ((use (division-theorem-part1 (i i) (j j)) (division-theorem-part2 (i i) (j j)) (division-theorem-part3 (i i) (j j))))) (lemma quotient-difference-lessp-arg2 (rewrite) (implies (and (equal (remainder a c) 0) (lessp b c)) (equal (quotient (difference a b) c) (if (zerop b) (quotient a c) (if (lessp b a) (difference (quotient a c) (add1 (quotient b c))) 0)))) ((enable-theory naturals) (do-not-induct t))) (lemma iquotient-iremainder-uniqueness () (implies (and (integerp i) (integerp j) (integerp r) (integerp q) (not (equal j 0)) (equal i (iplus r (itimes j q))) (not (ilessp r 0)) (ilessp r (iabs j))) (and (equal r (iremainder i j)) (equal q (iquotient i j)))) ((enable iremainder iabs idifference iplus ineg fix-int itimes iquotient ilessp integerp quotient-difference-lessp-arg2) (enable-theory naturals) (do-not-induct t))) ; It turns out that in computer arithmetic, notions of division other than that ; given by the division theorem are used. Two in particular, called ; "truncate towards negative infinity" and "truncate towards zero" are common. ; We present their definitions here. ; Division Theorem (truncate towards negative infinity variant): ; ; For all integers i,j, j not 0, there exist unique integers q and r ; which satisfy ; i = jq + r, 0 <= r < j (j > 0) ; j < r <= 0 (j < 0) ; ; In this version the integer quotient of two integers is the integer floor ; of the real quotient of the integers. The remainder has the sign of the ; divisor. The functions IDIV and IMOD are intended to compute q and r. ; Therefore, to be satisfied that we have the right definitions, we must ; prove the above theorem. (prove-lemma division-theorem-for-truncate-to-neginf-part1 () (implies (integerp i) (equal (iplus (imod i j) (itimes j (idiv i j))) i)) ((enable-theory integer-defns))) (lemma division-theorem-for-truncate-to-neginf-part2 () (implies (ilessp 0 j) (and (not (ilessp (imod i j) 0)) (ilessp (imod i j) j))) ((enable imod ilessp idifference iplus ineg itimes idiv integerp fix-int) (enable-theory naturals) (do-not-induct t))) (lemma division-theorem-for-truncate-to-neginf-part3 () (implies (and (integerp j) (ilessp j 0)) (and (not (ilessp 0 (imod i j))) (ilessp j (imod i j)))) ((enable imod ilessp idifference iplus ineg itimes idiv integerp fix-int) (enable-theory naturals) (do-not-induct t))) (lemma division-theorem-for-truncate-to-neginf () (implies (and (integerp i) (integerp j) (not (equal j 0))) (and (equal (iplus (imod i j) (itimes j (idiv i j))) i) (if (ilessp 0 j) (and (not (ilessp (imod i j) 0)) (ilessp (imod i j) j)) (and (not (ilessp 0 (imod i j))) (ilessp j (imod i j)))))) ((use (division-theorem-for-truncate-to-neginf-part1 (i i) (j j)) (division-theorem-for-truncate-to-neginf-part2 (i i) (j j)) (division-theorem-for-truncate-to-neginf-part3 (i i) (j j))) (enable integerp ilessp) (do-not-induct t))) (lemma idiv-imod-uniqueness () (implies (and (integerp i) (integerp j) (integerp r) (integerp q) (not (equal j 0)) (equal i (iplus r (itimes j q))) (if (ilessp 0 j) (and (not (ilessp r 0)) (ilessp r j)) (and (not (ilessp 0 r)) (ilessp j r)))) (and (equal r (imod i j)) (equal q (idiv i j)))) ((enable imod iabs idifference iplus ineg fix-int itimes idiv ilessp integerp ;lessp-plus-times-crock ;lessp-times-crock1 ;lessp-times-crock2 ;lessp-times-crock3 ;lessp-times-crock4 quotient-difference-lessp-arg2) (enable-theory naturals) (do-not-induct t))) ; Division Theorem (truncate towards zero variant): ; ; For all integers i,j, j not 0, there exist unique integers q and r ; which satisfy ; i = jq + r, 0 <= r < |j| (i => 0) ; -|j| < r <= 0 (i < 0) ; ; In this version (iquo, irem), the integer quotient of two integers is the integer floor ; of the real quotient of the integers, if the real quotient is positive. If the ; real quotient is negative, the integer quotient is the integer ceiling of the ; real quotient. The remainder has the sign of the dividend. The functions IQUO ; and IREM are intended to compute q and r. Therefore, to be satisfied that we ; have the right definitions, we must prove the above theorem. (prove-lemma division-theorem-for-truncate-to-zero-part1 () (implies (integerp i) (equal (iplus (irem i j) (itimes j (iquo i j))) i)) ((enable-theory integer-defns))) (prove-lemma division-theorem-for-truncate-to-zero-part2 () (implies (and (integerp i) (integerp j) (not (equal j 0)) (not (ilessp i 0))) (and (not (ilessp (irem i j) 0)) (ilessp (irem i j) (iabs j)))) ((enable-theory integer-defns))) (prove-lemma division-theorem-for-truncate-to-zero-part3 () (implies (and (integerp i) (integerp j) (not (equal j 0)) (ilessp i 0)) (and (not (ilessp 0 (irem i j))) (ilessp (ineg (iabs j)) (irem i j)))) ((enable-theory integer-defns))) (lemma division-theorem-for-truncate-to-zero () (implies (and (integerp i) (integerp j) (not (equal j 0))) (and (equal (iplus (irem i j) (itimes j (iquo i j))) i) (if (not (ilessp i 0)) (and (not (ilessp (irem i j) 0)) (ilessp (irem i j) (iabs j))) (and (not (ilessp 0 (irem i j))) (ilessp (ineg (iabs j)) (irem i j)))))) ((use (division-theorem-for-truncate-to-zero-part1 (i i) (j j)) (division-theorem-for-truncate-to-zero-part2 (i i) (j j)) (division-theorem-for-truncate-to-zero-part3 (i i) (j j))) (enable integerp ilessp) (do-not-induct t))) (prove-lemma iquo-irem-uniqueness () (implies (and (integerp i) (integerp j) (integerp r) (integerp q) (not (equal j 0)) (equal i (iplus r (itimes j q))) (if (not (ilessp i 0)) (and (not (ilessp r 0)) (ilessp r (iabs j))) (and (not (ilessp 0 r)) (ilessp (ineg (iabs j)) r)))) (and (equal r (irem i j)) (equal q (iquo i j)))) ((enable-theory integer-defns))) ; ---------- Multiplication Facts (prove-lemma itimes-ineg-1 (rewrite) (equal (itimes (ineg x) y) (ineg (itimes x y))) ((enable-theory integer-defns))) (prove-lemma itimes-ineg-2 (rewrite) (equal (itimes x (ineg y)) (ineg (itimes x y))) ((enable-theory integer-defns))) (prove-lemma itimes-cancellation-1 (rewrite) (equal (equal (itimes a b) (itimes a c)) (or (equal (fix-int a) 0) (equal (fix-int b) (fix-int c)))) ((enable-theory integer-defns))) (lemma itimes-cancellation-2 (rewrite) (equal (equal (itimes b a) (itimes c a)) (or (equal (fix-int a) 0) (equal (fix-int b) (fix-int c)))) ((use (itimes-cancellation-1)) (enable commutativity-of-itimes))) (lemma itimes-cancellation-3 (rewrite) (equal (equal (itimes a b) (itimes c a)) (or (equal (fix-int a) 0) (equal (fix-int b) (fix-int c)))) ((use (itimes-cancellation-1)) (enable commutativity-of-itimes))) ; ---------- Division Facts (lemma integerp-iquotient (rewrite) (integerp (iquotient i j)) ((enable integerp iquotient fix-int) (do-not-induct t))) (lemma integerp-iremainder (rewrite) (integerp (iremainder i j)) ((enable iremainder integerp-idifference) (do-not-induct t))) (lemma integerp-idiv (rewrite) (integerp (idiv i j)) ((enable integerp idiv fix-int) (do-not-induct t))) (lemma integerp-imod (rewrite) (integerp (imod i j)) ((enable imod integerp-idifference) (do-not-induct t))) (lemma integerp-iquo (rewrite) (integerp (iquo i j)) ((enable integerp iquo fix-int) (do-not-induct t))) (lemma integerp-irem (rewrite) (integerp (irem i j)) ((enable irem integerp-idifference) (do-not-induct t))) (lemma iquotient-fix-int1 (rewrite) (equal (iquotient (fix-int i) j) (iquotient i j)) ((enable integerp iquotient fix-int) (do-not-induct t))) (lemma iquotient-fix-int2 (rewrite) (equal (iquotient i (fix-int j)) (iquotient i j)) ((enable integerp iquotient fix-int) (do-not-induct t))) (lemma iremainder-fix-int1 (rewrite) (equal (iremainder (fix-int i) j) (iremainder i j)) ((enable iremainder idifference-fix-int1 iquotient-fix-int1) (do-not-induct t))) (lemma iremainder-fix-int2 (rewrite) (equal (iremainder i (fix-int j)) (iremainder i j)) ((enable iremainder itimes-fix-int1 iquotient-fix-int2) (do-not-induct t))) (lemma idiv-fix-int1 (rewrite) (equal (idiv (fix-int i) j) (idiv i j)) ((enable integerp idiv fix-int) (do-not-induct t))) (lemma idiv-fix-int2 (rewrite) (equal (idiv i (fix-int j)) (idiv i j)) ((enable integerp idiv fix-int) (do-not-induct t))) (lemma imod-fix-int1 (rewrite) (equal (imod (fix-int i) j) (imod i j)) ((enable imod fix-int-fix-int idiv-fix-int1) (do-not-induct t))) (lemma imod-fix-int2 (rewrite) (equal (imod i (fix-int j)) (imod i j)) ((enable imod itimes-fix-int1 idiv-fix-int2) (do-not-induct t))) (lemma iquo-fix-int1 (rewrite) (equal (iquo (fix-int i) j) (iquo i j)) ((enable integerp iquo fix-int) (do-not-induct t))) (lemma iquo-fix-int2 (rewrite) (equal (iquo i (fix-int j)) (iquo i j)) ((enable integerp iquo fix-int) (do-not-induct t))) (lemma irem-fix-int1 (rewrite) (equal (irem (fix-int i) j) (irem i j)) ((enable irem fix-int-fix-int iquo-fix-int1) (do-not-induct t))) (lemma irem-fix-int2 (rewrite) (equal (irem i (fix-int j)) (irem i j)) ((enable irem itimes-fix-int1 iquo-fix-int2) (do-not-induct t))) (lemma fix-int-iquotient (rewrite) (equal (fix-int (iquotient i j)) (iquotient i j)) ((enable integerp iquotient fix-int) (do-not-induct t))) (lemma fix-int-iremainder (rewrite) (equal (fix-int (iremainder i j)) (iremainder i j)) ((enable iremainder fix-int-idifference) (do-not-induct t))) (lemma fix-int-idiv (rewrite) (equal (fix-int (idiv i j)) (idiv i j)) ((enable integerp idiv fix-int) (do-not-induct t))) (lemma fix-int-imod (rewrite) (equal (fix-int (imod i j)) (imod i j)) ((enable imod fix-int-idifference) (do-not-induct t))) (lemma fix-int-iquo (rewrite) (equal (fix-int (iquo i j)) (iquo i j)) ((enable integerp iquo fix-int) (do-not-induct t))) (lemma fix-int-irem (rewrite) (equal (fix-int (irem i j)) (irem i j)) ((enable irem fix-int-idifference) (do-not-induct t))) (disable iquotient) (disable iremainder) (disable idiv) (disable imod) (disable iquo) (disable irem) ; ---------- Meta lemma for itimes cancellation ;; I tried to adapt this somewhat from corresponding meta lemmas in ;; naturals library, but it seemed to get hairy. So instead I'll try ;; to parallel the development I gave for IPLUS. I'll be lazier here ;; about efficiency, so I'll use a completely analogous definition of ;; itimes-tree. Notice that I've avoided the IZEROP-TREE approach ;; from the naturals version, in that I simply create the appropriate ;; common fringe into a product and say that this product is non-zero ;; when dividing both sides by it. It can then be up to the user whether ;; or not to enable the (meta or rewrite) rule that says that izerop of a product reduces ;; to the disjunction of izerop of the factors. #| The function below has no AND or OR, for efficiency (defn itimes-fringe (x) (if (and (listp x) (equal (car x) (quote itimes))) (append (itimes-fringe (cadr x)) (itimes-fringe (caddr x))) (cons x nil))) |# (DEFN ITIMES-FRINGE (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'ITIMES) (APPEND (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X))) (LIST X)) (LIST X))) (defn itimes-tree-rec (l) (if (nlistp (cdr l)) (car l) (list (quote itimes) (car l) (itimes-tree-rec (cdr l))))) (defn itimes-tree (l) (if (listp l) (if (listp (cdr l)) (itimes-tree-rec l) (list (quote fix-int) (car l))) (quote (quote 1)))) (defn itimes-list (x) (if (listp x) (itimes (car x) (itimes-list (cdr x))) 1)) (prove-lemma integerp-itimes-list (rewrite) (integerp (itimes-list x))) (prove-lemma eval$-itimes-tree-rec (rewrite) (implies (listp x) (equal (eval$ t (itimes-tree-rec x) a) (if (listp (cdr x)) (itimes-list (eval$ 'list x a)) (eval$ t (car x) a))))) ;; The following allows us to pretty much ignore itimes-tree forever. (Notice ;; that it is disabled immediately below.) (prove-lemma eval$-itimes-tree (rewrite) (equal (eval$ t (itimes-tree x) a) (itimes-list (eval$ 'list x a)))) (disable itimes-tree) ;; because we want to use EVAL$-ITIMES-TREE for now (defn make-cancel-itimes-equality (x y in-both) ;; x and y are term lists and for efficiency we pass in-both as their bagint, ;; which is a listp. (list 'if (list 'equal (itimes-tree in-both) ''0) (list 'quote t) (list (quote equal) (itimes-tree (bagdiff x in-both)) (itimes-tree (bagdiff y in-both))))) #| The function below has no AND or OR, for efficiency (defn cancel-itimes (x) (if (and (listp x) (equal (car x) (quote equal))) (if (and (listp (cadr x)) (equal (caadr x) (quote itimes)) (listp (caddr x)) (equal (caaddr x) (quote itimes))) (if (listp (bagint (itimes-fringe (cadr x)) (itimes-fringe (caddr x)))) (make-cancel-itimes-equality (itimes-fringe (cadr x)) (itimes-fringe (caddr x)) (bagint (itimes-fringe (cadr x)) (itimes-fringe (caddr x)))) x) (if (and (listp (cadr x)) (equal (caadr x) (quote itimes))) ;; We don't want to introduce the IF below unless something ;; is "gained", or else we may get into an infinite rewriting loop. (if (member (caddr x) (itimes-fringe (cadr x))) (list (quote if) (list (quote integerp) (caddr x)) (make-cancel-itimes-equality (itimes-fringe (cadr x)) (list (caddr x)) (list (caddr x))) (list (quote quote) f)) x) (if (and (listp (caddr x)) (equal (caaddr x) (quote itimes))) (if (member (cadr x) (itimes-fringe (caddr x))) (list (quote if) (list (quote integerp) (cadr x)) (make-cancel-itimes-equality (list (cadr x)) (itimes-fringe (caddr x)) (list (cadr x))) (list (quote quote) f)) x) x))) x)) |# (DEFN CANCEL-ITIMES (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'EQUAL) (COND ((LISTP (CADR X)) (COND ((EQUAL (CAADR X) 'ITIMES) (COND ((LISTP (CADDR X)) (COND ((EQUAL (CAADDR X) 'ITIMES) (IF (LISTP (BAGINT (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X)))) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X)) (BAGINT (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X)))) X)) ((MEMBER (CADDR X) (ITIMES-FRINGE (CADR X))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FRINGE (CADR X)) (LIST (CADDR X)) (LIST (CADDR X))) (LIST 'QUOTE F))) (T X))) ((MEMBER (CADDR X) (ITIMES-FRINGE (CADR X))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FRINGE (CADR X)) (LIST (CADDR X)) (LIST (CADDR X))) (LIST 'QUOTE F))) (T X))) ((LISTP (CADDR X)) (IF (EQUAL (CAADDR X) 'ITIMES) (IF (MEMBER (CADR X) (ITIMES-FRINGE (CADDR X))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (LIST (CADR X)) (ITIMES-FRINGE (CADDR X)) (LIST (CADR X))) (LIST 'QUOTE F)) X) X)) (T X))) ((LISTP (CADDR X)) (IF (EQUAL (CAADDR X) 'ITIMES) (IF (MEMBER (CADR X) (ITIMES-FRINGE (CADDR X))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (LIST (CADR X)) (ITIMES-FRINGE (CADDR X)) (LIST (CADR X))) (LIST 'QUOTE F)) X) X)) (T X)) X) X)) (prove-lemma itimes-list-append (rewrite) (equal (itimes-list (append x y)) (itimes (itimes-list x) (itimes-list y)))) (prove-lemma itimes-list-eval$-fringe (rewrite) ;; similar to ITIMES-TREE-ITIMES-FRINGE (equal (itimes-list (eval$ 'list (itimes-fringe x) a)) (fix-int (eval$ t x a))) ((induct (itimes-fringe x)))) (prove-lemma integerp-eval$-itimes (rewrite) (implies (equal (car x) 'itimes) (integerp (eval$ t x a)))) (lemma not-integerp-implies-not-equal-itimes (rewrite) (implies (not (integerp a)) (equal (equal a (itimes b c)) f)) ((use (integerp-itimes (x b) (y c))) (enable integerp) (do-not-induct t))) (prove-lemma itimes-list-eval$-delete (rewrite) (implies (member z y) (equal (itimes-list (eval$ 'list y a)) (itimes (eval$ t z a) (itimes-list (eval$ 'list (delete z y) a)))))) (prove-lemma itimes-list-bagdiff (rewrite) (implies (subbagp x y) (equal (itimes-list (eval$ 'list y a)) (itimes (itimes-list (eval$ 'list (bagdiff y x) a)) (itimes-list (eval$ 'list x a))))) ((induct (bagdiff y x)))) (prove-lemma equal-itimes-list-eval$-list-delete (rewrite) (implies (and (member c y) (not (equal (fix-int (eval$ t c a)) 0))) (equal (equal x (itimes-list (eval$ 'list (delete c y) a))) (and (integerp x) (equal (itimes x (eval$ t c a)) (itimes-list (eval$ 'list y a))))))) (disable itimes-list-eval$-delete) ;; I had trouble with the clausifier (thanks, J, for pointing that out ;; as the source of my trouble) in the proof of the meta lemma -- it's ;; getting rid of a case split. So, I'll proceed by reducing ;; cancel-itimes in each case; see lemma eval$-make-cancel-itimes-equality ;; (and its -1 and -2 versions). (prove-lemma member-append (rewrite) (equal (member a (append x y)) (or (member a x) (member a y)))) (prove-lemma member-izerop-itimes-fringe (rewrite) (implies (and (member z (itimes-fringe x)) (equal (fix-int (eval$ t z a)) 0)) (equal (fix-int (eval$ t x a)) 0)) ((induct (itimes-fringe x)))) (prove-lemma correctness-of-cancel-itimes-hack-1 (rewrite) (implies (and (member w (itimes-fringe (cons 'itimes x1))) (equal (fix-int (eval$ t w a)) 0) (not (equal (fix-int (eval$ t (car x1) a)) 0))) (equal (fix-int (eval$ t (cadr x1) a)) 0))) (enable eval$-equal) (prove-lemma eval$-make-cancel-itimes-equality (rewrite) (equal (eval$ t (make-cancel-itimes-equality x y in-both) a) (if (eval$ t (list 'equal (itimes-tree in-both) ''0) a) t (equal (itimes-list (eval$ 'list (bagdiff x in-both) a)) (itimes-list (eval$ 'list (bagdiff y in-both) a)))))) (disable make-cancel-itimes-equality) ;; Here's a special case that I hope helps with the clausifier problem. ;; The lemma above seems necessary for its proof. (prove-lemma eval$-make-cancel-itimes-equality-1 (rewrite) (equal (eval$ t (make-cancel-itimes-equality (list x) y (list x)) a) (if (equal (fix-int (eval$ t x a)) 0) t (equal 1 (itimes-list (eval$ 'list (delete x y) a)))))) (prove-lemma equal-fix-int (rewrite) (equal (equal (fix-int x) x) (integerp x)) ((enable-theory integer-defns))) ;; Here's another special case that I hope helps with the clausifier problem. (prove-lemma eval$-make-cancel-itimes-equality-2 (rewrite) (equal (eval$ t (make-cancel-itimes-equality x (list y) (list y)) a) (if (equal (fix-int (eval$ t y a)) 0) t (equal 1 (itimes-list (eval$ 'list (delete y x) a)))))) (prove-lemma eval$-equal-itimes-tree-itimes-fringe-0 (rewrite) (implies (and (eval$ t (list 'equal (itimes-tree (itimes-fringe x)) ''0) a) (equal (car x) 'itimes)) (equal (eval$ t x a) 0))) (prove-lemma izerop-eval-of-member-implies-itimes-list-0 (rewrite) (implies (and (member z y) (equal (fix-int (eval$ t z a)) 0)) (equal (itimes-list (eval$ 'list y a)) 0))) #| The function below has no AND or OR, for efficiency (defn subsetp (x y) (if (nlistp x) t (and (member (car x) y) (subsetp (cdr x) y)))) |# (DEFN SUBSETP (X Y) (COND ((NLISTP X) T) ((MEMBER (CAR X) Y) (SUBSETP (CDR X) Y)) (T F))) (prove-lemma subsetp-implies-itimes-list-eval$-equals-0 (rewrite) (implies (and (subsetp x y) (equal (itimes-list (eval$ 'list x a)) 0)) (equal (itimes-list (eval$ 'list y a)) 0))) (prove-lemma subbagp-subsetp (rewrite) (implies (subbagp x y) (subsetp x y))) (prove-lemma equal-0-itimes-list-eval$-bagint-1 (rewrite) (implies (equal (itimes-list (eval$ 'list (bagint x y) a)) 0) (equal (itimes-list (eval$ 'list x a)) 0)) ((use (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y x))) (disable subsetp-implies-itimes-list-eval$-equals-0))) (prove-lemma equal-0-itimes-list-eval$-bagint-2 (rewrite) (implies (equal (itimes-list (eval$ 'list (bagint x y) a)) 0) (equal (itimes-list (eval$ 'list y a)) 0)) ((use (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y y))) (disable subsetp-implies-itimes-list-eval$-equals-0))) (prove-lemma correctness-of-cancel-itimes-hack-2 (rewrite) (implies (and (listp u) (equal (car u) 'itimes) (listp v) (equal (car v) 'itimes) (not (equal (eval$ t u a) (eval$ t v a)))) (not (equal (itimes-list (eval$ 'list (bagdiff (itimes-fringe u) (bagint (itimes-fringe u) (itimes-fringe v))) a)) (itimes-list (eval$ 'list (bagdiff (itimes-fringe v) (bagint (itimes-fringe u) (itimes-fringe v))) a))))) ((use (itimes-list-bagdiff (y (itimes-fringe u)) (x (bagint (itimes-fringe u) (itimes-fringe v))) (a a)) (itimes-list-bagdiff (y (itimes-fringe v)) (x (bagint (itimes-fringe u) (itimes-fringe v))) (a a))))) (prove-lemma correctness-of-cancel-itimes-hack-3-lemma (rewrite) (implies (and (equal u (itimes a b)) (not (equal (fix-int a) 0))) (equal (equal u (itimes a c)) (equal (fix-int b) (fix-int c))))) (prove-lemma correctness-of-cancel-itimes-hack-3 (rewrite) (implies (and (listp u) (equal (car u) 'itimes) (listp v) (equal (car v) 'itimes) (equal (eval$ t u a) (eval$ t v a)) (not (eval$ t (list 'equal (itimes-tree (bagint (itimes-fringe u) (itimes-fringe v))) ''0) a))) (equal (equal (itimes-list (eval$ 'list (bagdiff (itimes-fringe u) (bagint (itimes-fringe u) (itimes-fringe v))) a)) (itimes-list (eval$ 'list (bagdiff (itimes-fringe v) (bagint (itimes-fringe u) (itimes-fringe v))) a))) t)) ((use (itimes-list-bagdiff (y (itimes-fringe u)) (x (bagint (itimes-fringe u) (itimes-fringe v))) (a a)) (itimes-list-bagdiff (y (itimes-fringe v)) (x (bagint (itimes-fringe u) (itimes-fringe v))) (a a))))) (disable correctness-of-cancel-itimes-hack-3-lemma) (prove-lemma correctness-of-cancel-itimes ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-itimes x) a)) ((do-not-induct t))) ; ---------- Meta lemma for itimes cancellation on ilessp terms ;; I'll try to keep this similar to the approach for equalities above, ;; modified as in the iplus case (i.e. no fix-int is necessary). ;; EVAL$-EQUAL is currently enabled, but that's OK. (defn itimes-tree-no-fix-int (l) (if (listp l) (itimes-tree-rec l) (quote (quote 1)))) ;; The following allows us to pretty much ignore ;; itimes-tree-no-fix-int forever. (Notice that it is disabled ;; immediately below.) (prove-lemma eval$-itimes-tree-no-fix-int-1 (rewrite) (equal (ilessp (eval$ t (itimes-tree-no-fix-int x) a) y) (ilessp (eval$ t (itimes-tree x) a) y))) (prove-lemma eval$-itimes-tree-no-fix-int-2 (rewrite) (equal (ilessp y (eval$ t (itimes-tree-no-fix-int x) a)) (ilessp y (eval$ t (itimes-tree x) a)))) (disable itimes-tree-no-fix-int) ;; We want to use EVAL$-ITIMES-TREE, and ITIMES-TREE is still disabled ;; so we're in good shape. (defn make-cancel-itimes-inequality (x y in-both) ;; x and y are term lists and for efficiency we pass in-both as their bagint, ;; which is a listp. (list 'if (list 'ilessp (itimes-tree-no-fix-int in-both) ''0) (list (quote ilessp) (itimes-tree-no-fix-int (bagdiff y in-both)) (itimes-tree-no-fix-int (bagdiff x in-both))) (list 'if (list 'ilessp ''0 (itimes-tree-no-fix-int in-both)) (list (quote ilessp) (itimes-tree-no-fix-int (bagdiff x in-both)) (itimes-tree-no-fix-int (bagdiff y in-both))) '(false)))) #| The function below has no AND or OR, for efficiency (defn cancel-itimes-ilessp (x) (if (and (listp x) (equal (car x) (quote ilessp)) (listp (bagint (itimes-fringe (cadr x)) (itimes-fringe (caddr x))))) (make-cancel-itimes-inequality (itimes-fringe (cadr x)) (itimes-fringe (caddr x)) (bagint (itimes-fringe (cadr x)) (itimes-fringe (caddr x)))) x)) |# (DEFN CANCEL-ITIMES-ILESSP (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'ILESSP) (IF (LISTP (BAGINT (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X)))) (MAKE-CANCEL-ITIMES-INEQUALITY (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X)) (BAGINT (ITIMES-FRINGE (CADR X)) (ITIMES-FRINGE (CADDR X)))) X) X) X)) (prove-lemma eval$-make-cancel-itimes-inequality (rewrite) (equal (eval$ t (make-cancel-itimes-inequality x y in-both) a) (if (eval$ t (list 'ilessp (itimes-tree-no-fix-int in-both) ''0) a) (ilessp (eval$ t (itimes-tree-no-fix-int (bagdiff y in-both)) a) (eval$ t (itimes-tree-no-fix-int (bagdiff x in-both)) a)) (if (eval$ t (list 'ilessp ''0 (itimes-tree-no-fix-int in-both)) a) (ilessp (eval$ t (itimes-tree-no-fix-int (bagdiff x in-both)) a) (eval$ t (itimes-tree-no-fix-int (bagdiff y in-both)) a)) f)))) (disable make-cancel-itimes-inequality) (prove-lemma listp-bagint-with-singleton-implies-member (rewrite) (implies (listp (bagint y (list z))) (member z y))) (prove-lemma itimes-list-eval$-list-0 (rewrite) (implies (member 0 x) (equal (itimes-list (eval$ 'list x a)) 0))) (prove-lemma ilessp-itimes-right-positive nil (implies (ilessp 0 x) (equal (ilessp y z) (ilessp (itimes y x) (itimes z x)))) ((enable-theory integer-defns))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-1 (rewrite) (implies (and (subbagp bag x) (subbagp bag y) (ilessp 0 (itimes-list (eval$ 'list bag a)))) (equal (ilessp (itimes-list (eval$ 'list (bagdiff x bag) a)) (itimes-list (eval$ 'list (bagdiff y bag) a))) (ilessp (itimes-list (eval$ 'list x a)) (itimes-list (eval$ 'list y a))))) ((use (ilessp-itimes-right-positive (x (itimes-list (eval$ 'list bag a))) (y (itimes-list (eval$ 'list (bagdiff x bag) a))) (z (itimes-list (eval$ 'list (bagdiff y bag) a)))) (itimes-list-bagdiff (y x) (x bag) (a a)) (itimes-list-bagdiff (y y) (x bag) (a a))))) (prove-lemma listp-bagint-with-singleton-member (rewrite) (equal (listp (bagint y (list z))) (member z y))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-2-lemma (rewrite) (implies (member 0 (itimes-fringe w)) (equal (eval$ t w a) 0)) ((expand (itimes-fringe w)))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-2 (rewrite) (implies (member 0 (itimes-fringe w)) (not (ilessp (eval$ t w a) 0)))) (disable correctness-of-cancel-itimes-ilessp-hack-2-lemma) ;;; Now hack-3 and hack-4 below are all that's left to prove before the ;;; main result. (prove-lemma ilessp-trichotomy (rewrite) (implies (not (ilessp x y)) (equal (ilessp y x) (not (equal (fix-int x) (fix-int y))))) ((enable-theory integer-defns))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-3-lemma-1 nil (implies (and (equal 0 (itimes-list (eval$ 'list bag a))) (subsetp bag z)) (equal (itimes-list (eval$ 'list z a)) 0))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-3-lemma-2 nil (implies (and (equal 0 (itimes-list (eval$ 'list bag a))) (subsetp bag (itimes-fringe x))) (equal (fix-int (eval$ t x a)) 0)) ((use (correctness-of-cancel-itimes-ilessp-hack-3-lemma-1 (z (itimes-fringe x)))))) (prove-lemma same-fix-int-implies-not-ilessp (rewrite) (implies (equal (fix-int x) (fix-int y)) (not (ilessp x y))) ((enable-theory integer-defns))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-3 (rewrite) (implies (and (not (ilessp (itimes-list (eval$ 'list bag a)) 0)) (not (ilessp 0 (itimes-list (eval$ 'list bag a)))) (subbagp bag (itimes-fringe w)) (subbagp bag (itimes-fringe v))) (not (ilessp (eval$ t w a) (eval$ t v a)))) ((use (correctness-of-cancel-itimes-ilessp-hack-3-lemma-2 (x w) (bag bag)) (correctness-of-cancel-itimes-ilessp-hack-3-lemma-2 (x v) (bag bag))))) (prove-lemma ilessp-itimes-right-negative nil (implies (ilessp x 0) (equal (ilessp y z) (ilessp (itimes z x) (itimes y x)))) ((enable-theory integer-defns))) (prove-lemma correctness-of-cancel-itimes-ilessp-hack-4 (rewrite) (implies (and (subbagp bag x) (subbagp bag y) (ilessp (itimes-list (eval$ 'list bag a)) 0)) (equal (ilessp (itimes-list (eval$ 'list (bagdiff x bag) a)) (itimes-list (eval$ 'list (bagdiff y bag) a))) (ilessp (itimes-list (eval$ 'list y a)) (itimes-list (eval$ 'list x a))))) ((use (ilessp-itimes-right-negative (x (itimes-list (eval$ 'list bag a))) (y (itimes-list (eval$ 'list (bagdiff x bag) a))) (z (itimes-list (eval$ 'list (bagdiff y bag) a)))) (itimes-list-bagdiff (y x) (x bag) (a a)) (itimes-list-bagdiff (y y) (x bag) (a a))))) (disable ilessp-trichotomy) (disable same-fix-int-implies-not-ilessp) (prove-lemma correctness-of-cancel-itimes-ilessp ((meta ilessp)) (equal (eval$ t x a) (eval$ t (cancel-itimes-ilessp x) a)) ((do-not-induct t))) ;; I think that the following lemma is safe because it won't be ;; called at all during relieve-hyps. (prove-lemma ilessp-strict (rewrite) (implies (ilessp x y) (not (ilessp y x))) ((enable-theory integer-defns))) ; ---------- Setting up the State ---------- ;; I'll close by disabling (or enabling) those rules and definitions ;; whose status as left over from above isn't quite what I'd like. ;; I'm going to leave the eval$ rules on and eval$ off. (disable eval$-cancel-iplus) (disable eval$-iplus) (disable lessp-count-listp-cdr) (disable eval$-iplus-tree-rec) (disable eval$-iplus-tree) ;;(disable eval$-list-append) ;; Nice rule -- I'll keep it enabled (disable iplus-list-eval$-fringe) (disable eval$-iplus-list-bagdiff) (disable lessp-difference-plus-arg1) (disable lessp-difference-plus-arg1-commuted) (disable correctness-of-cancel-iplus-ilessp-lemma) (disable eval$-ilessp-iplus-tree-no-fix-int) (disable make-cancel-iplus-inequality-simplifier) (disable quotient-difference-lessp-arg2) (disable eval$-itimes-tree-rec) (disable eval$-itimes-tree) (disable itimes-list-eval$-fringe) (disable integerp-eval$-itimes) (disable itimes-list-bagdiff) (disable equal-itimes-list-eval$-list-delete) (disable member-izerop-itimes-fringe) (disable correctness-of-cancel-itimes-hack-1) (disable eval$-make-cancel-itimes-equality) (disable eval$-make-cancel-itimes-equality-1) (disable eval$-make-cancel-itimes-equality-2) (disable eval$-equal-itimes-tree-itimes-fringe-0) (disable izerop-eval-of-member-implies-itimes-list-0) (disable subsetp-implies-itimes-list-eval$-equals-0) (disable equal-0-itimes-list-eval$-bagint-1) (disable equal-0-itimes-list-eval$-bagint-2) (disable correctness-of-cancel-itimes-hack-2) (disable correctness-of-cancel-itimes-hack-3-lemma) (disable correctness-of-cancel-itimes-hack-3) (disable eval$-itimes-tree-no-fix-int-1) (disable eval$-itimes-tree-no-fix-int-2) (disable eval$-make-cancel-itimes-inequality) (disable listp-bagint-with-singleton-implies-member) (disable itimes-list-eval$-list-0) (disable correctness-of-cancel-itimes-ilessp-hack-1) (disable listp-bagint-with-singleton-member) (disable correctness-of-cancel-itimes-ilessp-hack-2) (disable correctness-of-cancel-itimes-ilessp-hack-3-lemma-1) (disable correctness-of-cancel-itimes-ilessp-hack-3-lemma-2) (disable correctness-of-cancel-itimes-ilessp-hack-3) (disable correctness-of-cancel-itimes-ilessp-hack-4) ;; The last one is a tough call, but I think it's OK. ;; (disable ilessp-strict) ;;;;;; ***** EXTRA META STUFF ***** ;;;;;; ;; The next goal is to improve itimes cancellation so that it looks ;; for common factors, and hence works on equations like ;; x*y + x = x*z ;; and, for that matter, ;; a*x + -b*x = 0. ;; Rather than changing the existing cancel-itimes function, I'll ;; leave that one but disable its metalemma at the end. Then if the ;; new version, which I'll call cancel-itimes-factors, is found to be ;; too slow, one can always disable its metalemma and re-enable the ;; metalemma for cancel-itimes. ;; Notice, by the way, that the existing cancel-itimes function is ;; useless for something like the following, since there's no special ;; treatment for INEG. I'll remedy that in this version. #| (IMPLIES (AND (NOT (IZEROP X)) (EQUAL (ITIMES A X) (INEG (ITIMES B X)))) (EQUAL (FIX-INT A) (INEG B))) |# (defn itimes-tree-ineg (l) ;; Like itimes-tree-rec in that it doesn't apply fix-int even for a one-element ;; list, but with special treatment if l is a list starting with (quote -1). ;; Notice the coding with IF, for computational efficiency. (if (listp l) (if (equal (car l) (list 'quote -1)) (if (listp (cdr l)) (list 'ineg (itimes-tree-rec (cdr l))) (car l)) (itimes-tree-rec l)) (quote (quote 1)))) (defn itimes-factors (x) ;; a "generalization" of itimes-fringe (if (listp x) (cond ((equal (car x) (quote itimes)) (append (itimes-factors (cadr x)) (itimes-factors (caddr x)))) ((equal (car x) (quote iplus)) (let ((bag1 (itimes-factors (cadr x))) (bag2 (itimes-factors (caddr x)))) (let ((inboth (bagint bag1 bag2))) (if (listp inboth) (cons (list 'iplus (itimes-tree-ineg (bagdiff bag1 inboth)) (itimes-tree-ineg (bagdiff bag2 inboth))) inboth) (list x))))) ((equal (car x) (quote ineg)) (cons (list 'quote -1) (itimes-factors (cadr x)))) (t (list x))) (list x))) (prove-lemma itimes--1 (rewrite) (equal (itimes -1 x) (ineg x)) ((enable-theory integer-defns))) ;; I'll need the following lemma because it's simplest not to deal with ;; e.g. (equal x x), where x is a variable, in the meta thing. I'll do ;; the one after it too, simply because I'm thinking of it now. (prove-lemma equal-ineg-ineg (rewrite) (equal (equal (ineg x) (ineg y)) (equal (fix-int x) (fix-int y))) ((enable-theory integer-defns))) (prove-lemma ilessp-ineg-ineg (rewrite) (equal (ilessp (ineg x) (ineg y)) (ilessp y x)) ((enable-theory integer-defns))) (prove-lemma fix-int-eval$-itimes-tree-rec (rewrite) (implies (listp x) (equal (fix-int (eval$ t (itimes-tree-rec x) a)) (itimes-list (eval$ 'list x a)))) ((enable eval$-itimes-tree-rec))) (prove-lemma eval$-itimes-tree-ineg (rewrite) (equal (fix-int (eval$ t (itimes-tree-ineg x) a)) (itimes-list (eval$ 'list x a))) ((enable eval$-itimes-tree-rec))) ;; Now I want the above lemma to apply, but it doesn't, so the ;; following three lemmas are used instead. (prove-lemma ineg-eval$-itimes-tree-ineg (rewrite) (equal (ineg (eval$ t (itimes-tree-ineg x) a)) (ineg (itimes-list (eval$ 'list x a)))) ((use (eval$-itimes-tree-ineg)))) (prove-lemma iplus-eval$-itimes-tree-ineg (rewrite) (and (equal (iplus (eval$ t (itimes-tree-ineg x) a) y) (iplus (itimes-list (eval$ 'list x a)) y)) (equal (iplus y (eval$ t (itimes-tree-ineg x) a)) (iplus y (itimes-list (eval$ 'list x a))))) ((use (eval$-itimes-tree-ineg)))) (prove-lemma itimes-eval$-itimes-tree-ineg (rewrite) (and (equal (itimes (eval$ t (itimes-tree-ineg x) a) y) (itimes (itimes-list (eval$ 'list x a)) y)) (equal (itimes y (eval$ t (itimes-tree-ineg x) a)) (itimes y (itimes-list (eval$ 'list x a))))) ((use (eval$-itimes-tree-ineg)))) (disable itimes-tree-ineg) #| ****** The following definitions are for efficient execution of metafunctions. They should probably be applied to all the metafunctions with fns arguments AND and OR. (defmacro nqthm-macroexpand (defn &rest fns) `(nqthm-macroexpand-fn ',defn ',fns)) (defun nqthm-macroexpand-fn (defn fns) (iterate for fn in fns when (not (get fn 'sdefn)) do (er soft (fn) |Sorry| |,| |but| |there| |is| |no| SDEFN |for| (!ppr fn (quote |.|)))) (let (name args body) (match! defn (defn name args body)) (let ((arity-alist (cons (cons name (length args)) arity-alist))) (list 'defn name args (untranslate (normalize-ifs (nqthm-macroexpand-term (translate body) fns) nil nil nil)))))) (defun nqthm-macroexpand-term (term fns) (cond ((or (variablep term) (fquotep term)) term) ((member-eq (ffn-symb term) fns) (let ((sdefn (get (ffn-symb term) 'sdefn))) (sub-pair-var (cadr sdefn) (iterate for arg in (fargs term) collect (nqthm-macroexpand-term arg fns)) (caddr sdefn)))) (t (fcons-term (ffn-symb term) (iterate for arg in (fargs term) collect (nqthm-macroexpand-term arg fns)))))) |# ;; I "macroexpand" away the following below, so it's not really needed except ;; for the proof. That is, I use it in the definition of cancel-itimes-factors, ;; but then get rid of it for cancel-itimes-factors-expanded, and although I ;; reason about the former, I USE the latter, for efficiency. (defn iplus-or-itimes-term (x) (if (listp x) (case (car x) (iplus t) (itimes t) (ineg (if (listp (cadr x)) (equal (car (cadr x)) 'itimes) f)) (otherwise f)) f)) (defn cancel-itimes-factors (x) (if (and (listp x) (equal (car x) (quote equal))) (let ((bagint (bagint (itimes-factors (cadr x)) (itimes-factors (caddr x))))) (let ((new-equality (make-cancel-itimes-equality (itimes-factors (cadr x)) (itimes-factors (caddr x)) bagint))) (if (iplus-or-itimes-term (cadr x)) (if (listp bagint) (if (iplus-or-itimes-term (caddr x)) new-equality (list 'if (list 'integerp (caddr x)) new-equality (list 'quote f))) x) (if (iplus-or-itimes-term (caddr x)) (if (listp bagint) (list 'if (list 'integerp (cadr x)) new-equality (list 'quote f)) x) x)))) x)) ;; The following was generated with the nqthm-macroexpand macro defined above. (DEFN CANCEL-ITIMES-FACTORS-expanded (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'EQUAL) (COND ((LISTP (CADR X)) (CASE (CAR (CAR (CDR X))) (IPLUS (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X))))) (ITIMES (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X))))) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)))) (OTHERWISE (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F))) X)) (ITIMES (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X))))) (ITIMES (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X))))) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)))) (OTHERWISE (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F))) X)) (INEG (COND ((LISTP (CADADR X)) (COND ((EQUAL (CAADADR X) 'ITIMES) (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X))))) (ITIMES (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X))))) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)))) (OTHERWISE (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F))) X)) ((LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (ITIMES (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X) X) X)) (OTHERWISE X))) (T X))) ((LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (ITIMES (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X) X) X)) (OTHERWISE X))) (T X))) (OTHERWISE (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (ITIMES (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X) X) X)) (OTHERWISE X)) X)))) ((LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (IPLUS (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (ITIMES (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X)) (INEG (IF (LISTP (CADADDR X)) (IF (EQUAL (CAADADDR X) 'ITIMES) (IF (LISTP (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'IF (LIST 'INTEGERP (CADR X)) (MAKE-CANCEL-ITIMES-EQUALITY (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)) (BAGINT (ITIMES-FACTORS (CADR X)) (ITIMES-FACTORS (CADDR X)))) (LIST 'QUOTE F)) X) X) X)) (OTHERWISE X))) (T X)) X) X)) (prove-lemma cancel-itimes-factors-expanded-cancel-itimes-factors (rewrite) (equal (cancel-itimes-factors-expanded x) (cancel-itimes-factors x)) ((disable-theory t) (enable-theory ground-zero) (enable iplus-or-itimes-term cancel-itimes-factors cancel-itimes-factors-expanded))) (disable cancel-itimes-factors-expanded) (disable iplus-or-itimes-term) (prove-lemma equal-itimes-list-eval$-list-delete-new-1 (rewrite) (implies (not (equal (fix-int (eval$ t elt a)) 0)) (equal (equal x (itimes-list (eval$ 'list (delete elt bag) a))) (if (member elt bag) (and (integerp x) (equal (itimes x (eval$ t elt a) ) (itimes-list (eval$ 'list bag a)))) (equal x (itimes-list (eval$ 'list bag a)))))) ((enable equal-itimes-list-eval$-list-delete))) (prove-lemma equal-itimes-list-eval$-list-delete-new-2 (rewrite) (implies (not (equal (fix-int (eval$ t elt a)) 0)) (equal (equal (itimes-list (eval$ 'list (delete elt bag) a)) x) (if (member elt bag) (and (integerp x) (equal (itimes x (eval$ t elt a) ) (itimes-list (eval$ 'list bag a)))) (equal x (itimes-list (eval$ 'list bag a))))))) (prove-lemma itimes-itimes-list-eval$-list-delete (rewrite) (implies (member x bag) (equal (itimes (eval$ t x a) (itimes-list (eval$ 'list (delete x bag) a))) (itimes-list (eval$ 'list bag a))))) (prove-lemma equal-itimes-list-eval$-list-bagdiff (rewrite) (implies (and (subbagp in-both bag1) (subbagp in-both bag2) (not (equal (itimes-list (eval$ 'list in-both a)) 0))) (equal (equal (itimes-list (eval$ 'list (bagdiff bag1 in-both) a)) (itimes-list (eval$ 'list (bagdiff bag2 in-both) a))) (equal (itimes-list (eval$ 'list bag1 a)) (itimes-list (eval$ 'list bag2 a)))))) (prove-lemma membership-of-0-implies-itimes-list-is-0 (rewrite) (implies (member 0 x) (equal (itimes-list x) 0))) (prove-lemma member-0-eval$-list (rewrite) (implies (member 0 x) (member 0 (eval$ 'list x a)))) (prove-lemma itimes-list-eval$-factors-lemma (rewrite) (equal (itimes (itimes-list (eval$ 'list (bagint bag1 bag2) a)) (itimes-list (eval$ 'list (bagdiff bag2 (bagint bag1 bag2)) a))) (itimes-list (eval$ 'list bag2 a))) ((use (itimes-list-bagdiff (x (bagint bag1 bag2)) (y bag2))))) (prove-lemma itimes-list-eval$-factors-lemma-prime (rewrite) (equal (itimes (itimes-list (eval$ 'list (bagint bag1 bag2) a)) (itimes-list (eval$ 'list (bagdiff bag1 (bagint bag1 bag2)) a))) (itimes-list (eval$ 'list bag1 a))) ((use (itimes-list-bagdiff (x (bagint bag1 bag2)) (y bag1))))) (prove-lemma itimes-list-eval$-factors (rewrite) ;; similar to ITIMES-LIST-EVAL$-FRINGE, except one has to reason about bagdiff etc. (equal (itimes-list (eval$ 'list (itimes-factors x) a)) (fix-int (eval$ t x a))) ((induct (itimes-factors x)) (enable ;;eval$-list-append ;; already enabled now integerp-eval$-itimes itimes-list-bagdiff listp-bagint-with-singleton-member))) (prove-lemma iplus-or-itimes-term-integerp-eval$ (rewrite) (implies (iplus-or-itimes-term x) (integerp (eval$ t x a))) ((enable iplus-or-itimes-term))) (prove-lemma eval$-list-bagint-0 nil (implies (equal (itimes-list (eval$ 'list (bagint x y) a)) 0) (and (equal (itimes-list (eval$ 'list x a)) 0) (equal (itimes-list (eval$ 'list y a)) 0))) ((use (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y x)) (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y y))))) (prove-lemma eval$-list-bagint-0-implies-equal (rewrite) (implies (and (equal (itimes-list (eval$ 'list (bagint (itimes-factors v) (itimes-factors w)) a)) 0) (integerp (eval$ t v a)) (integerp (eval$ t w a))) (equal (equal (eval$ t v a) (eval$ t w a)) t)) ((use (eval$-list-bagint-0 (x (itimes-factors v)) (y (itimes-factors w)))))) (prove-lemma correctness-of-cancel-itimes-factors ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-itimes-factors-expanded x) a)) ((do-not-induct t) (enable eval$-itimes-tree eval$-make-cancel-itimes-equality))) ;; OK -- now, the lessp case, finally. Ugh! (defn cancel-itimes-ilessp-factors (x) (if (listp x) (if (equal (car x) 'ilessp) (if (listp (bagint (itimes-factors (cadr x)) (itimes-factors (caddr x)))) (make-cancel-itimes-inequality (itimes-factors (cadr x)) (itimes-factors (caddr x)) (bagint (itimes-factors (cadr x)) (itimes-factors (caddr x)))) x) x) x)) (prove-lemma bagint-singleton (rewrite) (equal (bagint x (list y)) (if (member y x) (list y) nil))) (prove-lemma izerop-ilessp-0-relationship (rewrite) (equal (equal (fix-int x) 0) (and (not (ilessp x 0)) (not (ilessp 0 x)))) ((enable-theory integer-defns))) (prove-lemma ilessp-itimes-list-eval$-list-delete-helper-1 (rewrite) (implies (ilessp 0 w) (equal (ilessp (itimes x w) (itimes w u)) (ilessp x u)))) (prove-lemma ilessp-itimes-list-eval$-list-delete-helper-2 (rewrite) (implies (ilessp w 0) (equal (ilessp (itimes w u) (itimes x w)) (ilessp x u)))) (prove-lemma ilessp-itimes-list-eval$-list-delete (rewrite) (implies (and (member z y) (not (equal (fix-int (eval$ t z a)) 0))) (equal (ilessp x (itimes-list (eval$ 'list (delete z y) a))) (if (ilessp 0 (eval$ t z a)) (ilessp (itimes x (eval$ t z a)) (itimes-list (eval$ 'list y a))) (if (ilessp (eval$ t z a) 0) (ilessp (itimes-list (eval$ 'list y a)) (itimes x (eval$ t z a))) f)))) ((enable itimes-list-eval$-delete) (disable itimes-itimes-list-eval$-list-delete))) (prove-lemma ilessp-itimes-list-eval$-list-delete-prime-helper-1 (rewrite) (implies (ilessp 0 w) (equal (ilessp (itimes w u) (itimes x w)) (ilessp u x)))) (prove-lemma ilessp-itimes-list-eval$-list-delete-prime-helper-2 (rewrite) (implies (ilessp w 0) (equal (ilessp (itimes x w) (itimes w u)) (ilessp u x)))) (prove-lemma ilessp-itimes-list-eval$-list-delete-prime (rewrite) (implies (and (member z y) (not (equal (fix-int (eval$ t z a)) 0))) (equal (ilessp (itimes-list (eval$ 'list (delete z y) a)) x) (if (ilessp 0 (eval$ t z a)) (ilessp (itimes-list (eval$ 'list y a)) (itimes x (eval$ t z a))) (if (ilessp (eval$ t z a) 0) (ilessp (itimes x (eval$ t z a)) (itimes-list (eval$ 'list y a))) f)))) ((enable itimes-list-eval$-delete) (disable itimes-itimes-list-eval$-list-delete ilessp-itimes-list-eval$-list-delete))) ;; **** Do I have anything like the following two lemmas for the equality case? ;; Should I? ;;;***** I should also consider if I've dealt with things like 0 = a*x + b*x, and ;;; simlilarly for ilessp. (prove-lemma ilessp-0-itimes (rewrite) (equal (ilessp 0 (itimes x y)) (or (and (ilessp 0 x) (ilessp 0 y)) (and (ilessp x 0) (ilessp y 0)))) ((enable-theory integer-defns))) (prove-lemma ilessp-itimes-0 (rewrite) (equal (ilessp (itimes x y) 0) (or (and (ilessp 0 x) (ilessp y 0)) (and (ilessp x 0) (ilessp 0 y)))) ((enable-theory integer-defns))) (prove-lemma ilessp-itimes-list-eval$-list-bagdiff (rewrite) (implies (and (subbagp in-both bag1) (subbagp in-both bag2) (not (equal (itimes-list (eval$ 'list in-both a)) 0))) (equal (ilessp (itimes-list (eval$ 'list (bagdiff bag1 in-both) a)) (itimes-list (eval$ 'list (bagdiff bag2 in-both) a))) (if (ilessp 0 (itimes-list (eval$ 'list in-both a))) (ilessp (itimes-list (eval$ 'list bag1 a)) (itimes-list (eval$ 'list bag2 a))) (ilessp (itimes-list (eval$ 'list bag2 a)) (itimes-list (eval$ 'list bag1 a)))))) ((enable ilessp-trichotomy) (disable izerop-ilessp-0-relationship))) (prove-lemma zero-ilessp-implies-not-equal nil ;; This is not a rewrite rule because I don't want to slow down ;; the rewriter. Maybe that's not such a great decision. (implies (ilessp 0 x) (not (equal 0 x)))) (prove-lemma ilessp-itimes-list-eval$-list-bagdiff-corollary-1 (rewrite) (implies (and (subbagp in-both bag1) (subbagp in-both bag2) (ilessp 0 (itimes-list (eval$ 'list in-both a)))) (equal (ilessp (itimes-list (eval$ 'list (bagdiff bag1 in-both) a)) (itimes-list (eval$ 'list (bagdiff bag2 in-both) a))) (ilessp (itimes-list (eval$ 'list bag1 a)) (itimes-list (eval$ 'list bag2 a))))) ((use (zero-ilessp-implies-not-equal (x (itimes-list (eval$ 'list in-both a))))))) (prove-lemma ilessp-zero-implies-not-equal nil ;; This is not a rewrite rule because I don't want to slow down ;; the rewriter. Maybe that's not such a great decision. (implies (ilessp x 0) (not (equal 0 x)))) (prove-lemma ilessp-itimes-list-eval$-list-bagdiff-corollary-2 (rewrite) (implies (and (subbagp in-both bag1) (subbagp in-both bag2) (ilessp (itimes-list (eval$ 'list in-both a)) 0)) (equal (ilessp (itimes-list (eval$ 'list (bagdiff bag1 in-both) a)) (itimes-list (eval$ 'list (bagdiff bag2 in-both) a))) (ilessp (itimes-list (eval$ 'list bag2 a)) (itimes-list (eval$ 'list bag1 a))))) ((use (ilessp-zero-implies-not-equal (x (itimes-list (eval$ 'list in-both a))))))) (prove-lemma member-0-itimes-factors-yields-0 (rewrite) ;; I'll hang this on MEMBER for efficiency (implies (not (equal (eval$ t w a) 0)) (not (member 0 (itimes-factors w))))) (prove-lemma member-0-itimes-factors-yields-0-ilessp-consequence-1 (rewrite) ;; I'll hang this on MEMBER for efficiency (implies (ilessp (eval$ t w a) 0) (not (member 0 (itimes-factors w)))) ((use (member-0-itimes-factors-yields-0)))) (prove-lemma member-0-itimes-factors-yields-0-ilessp-consequence-2 (rewrite) ;; I'll hang this on MEMBER for efficiency (implies (ilessp 0 (eval$ t w a)) (not (member 0 (itimes-factors w)))) ((use (member-0-itimes-factors-yields-0)))) #| (prove-lemma eval$-list-bagint-0 nil (implies (equal (itimes-list (eval$ 'list (bagint x y) a)) 0) (and (equal (itimes-list (eval$ 'list x a)) 0) (equal (itimes-list (eval$ 'list y a)) 0))) ((use (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y x)) (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y y))))) |# #| (prove-lemma eval$-list-bagint-0-implies-equal (rewrite) (implies (and (equal (itimes-list (eval$ 'list (bagint (itimes-factors v) (itimes-factors w)) a)) 0) (integerp (eval$ t v a)) (integerp (eval$ t w a))) (equal (equal (eval$ t v a) (eval$ t w a)) t)) ((use (eval$-list-bagint-0 (x (itimes-factors v)) (y (itimes-factors w)))))) |# ;; At this point I'm going to switch the states of ilessp-trichotomy and ;; izerop-ilessp-0-relationship, for good (or till I change my mind again!). (enable ilessp-trichotomy) (disable izerop-ilessp-0-relationship) (prove-lemma eval$-list-bagint-0-for-ilessp nil (implies (and (not (ilessp (itimes-list (eval$ 'list (bagint x y) a)) 0)) (not (ilessp 0 (itimes-list (eval$ 'list (bagint x y) a))))) (and (equal (fix-int (itimes-list (eval$ 'list x a))) 0) (equal (fix-int (itimes-list (eval$ 'list y a))) 0))) ((use (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y x)) (subsetp-implies-itimes-list-eval$-equals-0 (x (bagint x y)) (y y))))) (prove-lemma eval$-list-bagint-0-implies-equal-for-ilessp-lemma nil (implies (and (not (ilessp (itimes-list (eval$ 'list (bagint (itimes-factors v) (itimes-factors w)) a)) 0)) (not (ilessp 0 (itimes-list (eval$ 'list (bagint (itimes-factors v) (itimes-factors w)) a))))) (equal (fix-int (eval$ t v a)) (fix-int (eval$ t w a)))) ((use (eval$-list-bagint-0-for-ilessp (x (itimes-factors v)) (y (itimes-factors w)))))) (prove-lemma equal-fix-int-to-ilessp nil ;; Not a rewrite rule, for efficiency (implies (equal (fix-int x) (fix-int y)) (not (ilessp x y))) ((enable-theory integer-defns))) (prove-lemma eval$-list-bagint-0-implies-equal-for-ilessp (rewrite) (implies (and (not (ilessp (itimes-list (eval$ 'list (bagint (itimes-factors v) (itimes-factors w)) a)) 0)) (not (ilessp 0 (itimes-list (eval$ 'list (bagint (itimes-factors v) (itimes-factors w)) a))))) (and (not (ilessp (eval$ t v a) (eval$ t w a))) (not (ilessp (eval$ t w a) (eval$ t v a))))) ((use (eval$-list-bagint-0-implies-equal-for-ilessp-lemma) (equal-fix-int-to-ilessp (x (eval$ t v a)) (y (eval$ t w a))) (equal-fix-int-to-ilessp (x (eval$ t w a)) (y (eval$ t v a)))))) ;; The rewrite rule ILESSP-TRICHOTOMY seemed to mess up the proof of the following, ;; so I'm just going to leave it disabled. (disable ilessp-trichotomy) (prove-lemma correctness-of-cancel-itimes-ilessp-factors ((meta ilessp)) (equal (eval$ t x a) (eval$ t (cancel-itimes-ilessp-factors x) a)) ((do-not-induct t) (enable eval$-itimes-tree-no-fix-int-1 eval$-itimes-tree-no-fix-int-2 eval$-itimes-tree eval$-make-cancel-itimes-inequality))) ;; OK -- now, the zero cases. (enable LESSP-COUNT-LISTP-CDR) (defn disjoin-equalities-with-0 (factors) (if (listp (cdr factors)) (list 'or (list 'equal (list 'fix-int (car factors)) ''0) (disjoin-equalities-with-0 (cdr factors))) (list 'equal (list 'fix-int (car factors)) ''0))) (disable LESSP-COUNT-LISTP-CDR) (defn cancel-factors-0 (x) (if (listp x) (if (equal (car x) 'equal) (if (equal (cadr x) ''0) (let ((factors (itimes-factors (caddr x)))) (if (listp (cdr factors)) (disjoin-equalities-with-0 factors) x)) (if (equal (caddr x) ''0) (let ((factors (itimes-factors (cadr x)))) (if (listp (cdr factors)) (disjoin-equalities-with-0 factors) x)) x)) x) x)) (defn some-eval$s-to-0 (x a) ;; says that some member of x eval$s to an izerop (if (listp x) (or (equal (fix-int (eval$ t (car x) a)) 0) (some-eval$s-to-0 (cdr x) a)) f)) (prove-lemma eval$-disjoin-equalities-with-0 (rewrite) (implies (listp lst) (equal (eval$ t (disjoin-equalities-with-0 lst) a) (some-eval$s-to-0 lst a)))) (prove-lemma some-eval$s-to-0-append (rewrite) (equal (some-eval$s-to-0 (append x y) a) (or (some-eval$s-to-0 x a) (some-eval$s-to-0 y a)))) (prove-lemma some-eval$s-to-0-eliminator (rewrite) (equal (some-eval$s-to-0 x a) (equal (itimes-list (eval$ 'list x a)) 0))) (prove-lemma listp-cdr-factors-implies-integerp (rewrite) (implies (listp (cdr (itimes-factors v))) (integerp (eval$ t v a))) ((expand (itimes-factors v)))) (prove-lemma correctness-of-cancel-factors-0 ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-factors-0 x) a))) ;; and now for inequalities... (enable LESSP-COUNT-LISTP-CDR) (defn conjoin-inequalities-with-0 (factors parity) ;; Returns an inequality saying that 0 is less than the product of the ;; factors if parity is not F and the other way around otherwise. (if (listp (cdr factors)) (if parity (list 'or (list 'and (list 'ilessp ''0 (car factors)) (conjoin-inequalities-with-0 (cdr factors) t)) (list 'and (list 'ilessp (car factors) ''0) (conjoin-inequalities-with-0 (cdr factors) f))) (list 'or (list 'and (list 'ilessp (car factors) ''0) (conjoin-inequalities-with-0 (cdr factors) t)) (list 'and (list 'ilessp ''0 (car factors)) (conjoin-inequalities-with-0 (cdr factors) f)))) (if parity (list 'ilessp ''0 (car factors)) (list 'ilessp (car factors) ''0)))) (disable lessp-count-listp-cdr) (defn cancel-factors-ilessp-0 (x) (if (listp x) (if (equal (car x) 'ilessp) (if (equal (cadr x) ''0) (let ((factors (itimes-factors (caddr x)))) (if (listp (cdr factors)) (conjoin-inequalities-with-0 factors t) x)) (if (equal (caddr x) ''0) (let ((factors (itimes-factors (cadr x)))) (if (listp (cdr factors)) (conjoin-inequalities-with-0 factors f) x)) x)) x) x)) (prove-lemma conjoin-inequalities-with-0-eliminator (rewrite) (implies (listp x) (equal (eval$ t (conjoin-inequalities-with-0 x parity) a) (if parity (ilessp 0 (itimes-list (eval$ 'list x a))) (ilessp (itimes-list (eval$ 'list x a)) 0))))) (prove-lemma correctness-of-cancel-factors-ilessp-0 ((meta ilessp)) (equal (eval$ t x a) (eval$ t (cancel-factors-ilessp-0 x) a))) (disable equal-itimes-list-eval$-list-delete-new-1) (disable equal-itimes-list-eval$-list-delete-new-2) (disable itimes-itimes-list-eval$-list-delete) (disable equal-itimes-list-eval$-list-bagdiff) (disable itimes-list-eval$-factors-lemma) (disable itimes-list-eval$-factors-lemma-prime) (disable itimes-list-eval$-factors) (disable iplus-or-itimes-term-integerp-eval$) (disable eval$-list-bagint-0) (disable eval$-list-bagint-0-implies-equal) (disable izerop-ilessp-0-relationship) (disable ilessp-itimes-list-eval$-list-delete-helper-1) (disable ilessp-itimes-list-eval$-list-delete-helper-2) (disable ilessp-itimes-list-eval$-list-delete) (disable ilessp-itimes-list-eval$-list-delete-prime-helper-1) (disable ilessp-itimes-list-eval$-list-delete-prime-helper-2) (disable ilessp-itimes-list-eval$-list-delete-prime) (disable ilessp-0-itimes) (disable ilessp-itimes-0) (disable listp-cdr-factors-implies-integerp) ;; We presumably have better meta-lemmas now, but if we want we ;; can disable those (i.e., correctness-of-cancel-itimes-factors, ;; correctness-of-cancel-itimes-ilessp-factors, ;; correctness-of-cancel-factors-0, and ;; correctness-of-cancel-factors-ilessp-0) and enable the two ;; mentioned below: (disable correctness-of-cancel-itimes) (disable correctness-of-cancel-itimes-ilessp) ;; I'll disable some rules now, finally, that I'd previously thought ;; would be OK but now fear because of potential nasty backchaining. (disable not-integerp-implies-not-equal-iplus) (disable not-integerp-implies-not-equal-itimes) (disable subbagp-subsetp) (disable eval$-list-bagint-0-implies-equal-for-ilessp) ; ---------- Cancel ineg terms from equalities and inequalities ---------- (defn split-out-ineg-terms (x) ;; Here x is a list and we return a pair consisting of ;; a list of the terms in x not starting with INEG and a list ;; of those terms that do (with their INEG headers stripped off). (if (listp x) (let ((pair (split-out-ineg-terms (cdr x))) (a (car x))) (if (listp a) (if (equal (car a) 'ineg) (cons (car pair) (cons (cadr a) (cdr pair))) (if (and (equal (car a) 'quote) (negativep (cadr a)) (not (equal (negative-guts (cadr a)) 0))) (cons (car pair) (cons (list 'quote (negative-guts (cadr a))) (cdr pair))) (cons (cons a (car pair)) (cdr pair)))) (cons (cons a (car pair)) (cdr pair)))) (cons nil nil))) (defn remove-inegs (x y) ;; x and y are term lists that are known to represent integers. ;; The idea is to rearrange (equal x y) or (ilessp x y). Notice ;; that the negative terms are put in the front, so that APPEND ;; will run fast and do no CONSing in the frequent case that ;; there are no negative terms. ;; Returns F, though, if there's no change at all. I was getting ;; into an infinite loop when I built a new term, since there was ;; an extra FIX-INT put there. (let ((xpair (split-out-ineg-terms x)) (ypair (split-out-ineg-terms y))) (if (or (listp (cdr xpair)) (listp (cdr ypair))) (cons (append (cdr ypair) (car xpair)) (append (cdr xpair) (car ypair))) f))) (defn iplus-or-ineg-term (x) (and (listp x) (or (equal (car x) (quote ineg)) (equal (car x) (quote iplus))))) (defn make-cancel-ineg-terms-equality (x) (let ((new-fringes (remove-inegs (iplus-fringe (cadr x)) (iplus-fringe (caddr x))))) (if new-fringes (if (iplus-or-ineg-term (cadr x)) (if (iplus-or-ineg-term (caddr x)) (list (quote equal) (iplus-tree (car new-fringes)) (iplus-tree (cdr new-fringes))) (list 'if (list 'integerp (caddr x)) (list (quote equal) (iplus-tree (car new-fringes)) (iplus-tree (cdr new-fringes))) (list 'quote f))) ;; otherwise, the first argument is not an iplus or ineg term (if (iplus-or-ineg-term (caddr x)) (list 'if (list 'integerp (cadr x)) (list (quote equal) (iplus-tree (car new-fringes)) (iplus-tree (cdr new-fringes))) (list 'quote f)) x)) x))) (defn cancel-ineg-terms-from-equality (x) (if (and (listp x) (equal (car x) (quote equal))) (make-cancel-ineg-terms-equality x) x)) ;; The following was created from nqthm-macroexpand with arguments ;; and or make-cancel-ineg-terms-equality iplus-or-ineg-term (DEFN CANCEL-INEG-TERMS-FROM-EQUALITY-expanded (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'EQUAL) (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (COND ((LISTP (CADR X)) (CASE (CAR (CAR (CDR X))) (INEG (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (INEG (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))))) (IPLUS (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))))) (OTHERWISE (LIST 'IF (LIST 'INTEGERP (CADDR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F)))) (IPLUS (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (INEG (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))))) (IPLUS (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))))) (OTHERWISE (LIST 'IF (LIST 'INTEGERP (CADDR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F)))) (LIST 'IF (LIST 'INTEGERP (CADDR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F)))) (OTHERWISE (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (INEG (LIST 'IF (LIST 'INTEGERP (CADR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F))) (IPLUS (LIST 'IF (LIST 'INTEGERP (CADR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F))) (OTHERWISE X)) X)))) ((LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (INEG (LIST 'IF (LIST 'INTEGERP (CADR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F))) (IPLUS (LIST 'IF (LIST 'INTEGERP (CADR X)) (LIST 'EQUAL (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) (LIST 'QUOTE F))) (OTHERWISE X))) (T X)) X) X) X)) (prove-lemma CANCEL-INEG-TERMS-FROM-EQUALITY-CANCEL-INEG-TERMS-FROM-EQUALITY-expanded (rewrite) (equal (CANCEL-INEG-TERMS-FROM-EQUALITY-expanded x) (CANCEL-INEG-TERMS-FROM-EQUALITY x)) ((disable-theory t) (enable-theory ground-zero) (enable make-cancel-ineg-terms-equality iplus-or-ineg-term CANCEL-INEG-TERMS-FROM-EQUALITY-expanded CANCEL-INEG-TERMS-FROM-EQUALITY))) (disable CANCEL-INEG-TERMS-FROM-EQUALITY-expanded) (prove-lemma integerp-eval$-iplus-or-ineg-term (rewrite) (implies (iplus-or-ineg-term x) (integerp (eval$ t x a)))) (disable iplus-or-ineg-term) (prove-lemma eval$-iplus-list-car-remove-inegs (rewrite) (implies (remove-inegs x y) (equal (iplus-list (eval$ 'list (car (remove-inegs x y)) a)) (iplus (iplus-list (eval$ 'list (car (split-out-ineg-terms x)) a)) (iplus-list (eval$ 'list (cdr (split-out-ineg-terms y)) a)))))) (prove-lemma eval$-iplus-list-cdr-remove-inegs (rewrite) (implies (remove-inegs x y) (equal (iplus-list (eval$ 'list (cdr (remove-inegs x y)) a)) (iplus (iplus-list (eval$ 'list (car (split-out-ineg-terms y)) a)) (iplus-list (eval$ 'list (cdr (split-out-ineg-terms x)) a)))))) (prove-lemma minus-ineg (rewrite) (implies (and (numberp x) (not (equal x 0))) (equal (minus x) (ineg x))) ((enable-theory integer-defns))) (prove-lemma iplus-list-eval$-car-split-out-ineg-terms (rewrite) (equal (iplus-list (eval$ 'list (car (split-out-ineg-terms x)) a)) (iplus (iplus-list (eval$ 'list x a)) (iplus-list (eval$ 'list (cdr (split-out-ineg-terms x)) a)))) ((induct (split-out-ineg-terms x)) (enable eval$-quote))) (disable remove-inegs) (prove-lemma correctness-of-cancel-ineg-terms-from-equality ((meta equal)) (equal (eval$ t x a) (eval$ t (cancel-ineg-terms-from-equality-expanded x) a)) ((enable eval$-iplus-tree iplus-list-eval$-fringe eval$-quote) (disable iplus-fringe))) (defn make-cancel-ineg-terms-inequality (x) (let ((new-fringes (remove-inegs (iplus-fringe (cadr x)) (iplus-fringe (caddr x))))) (if new-fringes (list (quote ilessp) (iplus-tree (car new-fringes)) (iplus-tree (cdr new-fringes))) x))) (defn cancel-ineg-terms-from-inequality (x) (if (and (listp x) (equal (car x) (quote ilessp))) ;; the tests below are for efficiency only (if (iplus-or-ineg-term (cadr x)) (make-cancel-ineg-terms-inequality x) (if (iplus-or-ineg-term (caddr x)) (make-cancel-ineg-terms-inequality x) x)) x)) ;; The following was created from nqthm-macroexpand with arguments ;; and or make-cancel-ineg-terms-inequality iplus-or-ineg-term (DEFN CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded (X) (IF (LISTP X) (IF (EQUAL (CAR X) 'ILESSP) (COND ((LISTP (CADR X)) (CASE (CAR (CAR (CDR X))) (INEG (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST 'ILESSP (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) (IPLUS (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST 'ILESSP (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) (OTHERWISE (IF (LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (INEG (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST 'ILESSP (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) (IPLUS (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST 'ILESSP (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) (OTHERWISE X)) X)))) ((LISTP (CADDR X)) (CASE (CAR (CAR (CDR (CDR X)))) (INEG (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST 'ILESSP (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) (IPLUS (IF (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))) (LIST 'ILESSP (IPLUS-TREE (CAR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X))))) (IPLUS-TREE (CDR (REMOVE-INEGS (IPLUS-FRINGE (CADR X)) (IPLUS-FRINGE (CADDR X)))))) X)) (OTHERWISE X))) (T X)) X) X)) (prove-lemma CANCEL-INEG-TERMS-FROM-INEQUALITY-CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded (rewrite) (equal (CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded x) (CANCEL-INEG-TERMS-FROM-INEQUALITY x)) ((disable-theory t) (enable-theory ground-zero) (enable make-cancel-ineg-terms-inequality iplus-or-ineg-term CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded CANCEL-INEG-TERMS-FROM-INEQUALITY))) (disable CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded) (prove-lemma correctness-of-cancel-ineg-terms-from-inequality ((meta ilessp)) (equal (eval$ t x a) (eval$ t (cancel-ineg-terms-from-inequality-expanded x) a)) ((enable eval$-iplus-tree iplus-list-eval$-fringe eval$-quote) (disable iplus-fringe))) (disable minus-ineg) (disable integerp-eval$-iplus-or-ineg-term) ; ---------- Eliminating constants ---------- ;; We want to combine in terms like (iplus 3 (iplus x 7)). Also, when ;; two iplus terms are equated or in-equated, there should only be a ;; natural number summand on at most one side. Finally, if one adds 1 ;; to the right side of a strict inequality, a stronger inequality (in ;; a certain sense) is obtained by removing the 1 and making a non-strict ;; inequality in the other direction. (prove-lemma plus-iplus (rewrite) (implies (and (numberp i) (numberp j)) (equal (plus i j) (iplus i j))) ((enable iplus))) (prove-lemma iplus-constants (rewrite) ;; by now the term presumably has no MINUS terms in it (equal (iplus (add1 i) (iplus (add1 j) x)) (iplus (plus (add1 i) (add1 j)) x)) ((enable fix-int integerp) (disable plus-add1-arg1))) (prove-lemma numberp-is-integerp (rewrite) (implies (numberp w) (integerp w)) ((enable integerp))) (prove-lemma difference-idifference (rewrite) (implies (and (numberp x) (numberp y) (leq x y)) (equal (difference y x) (idifference y x)))) (prove-lemma cancel-constants-equal-lemma nil (implies (and (numberp m) (numberp n)) (equal (equal (iplus m x) (iplus n y)) (if (lessp m n) (equal (fix-int x) (iplus (difference n m) y)) (equal (iplus (difference m n) x) (fix-int y)))))) (prove-lemma cancel-constants-equal (rewrite) (equal (equal (iplus (add1 i) x) (iplus (add1 j) y)) (if (lessp i j) (equal (fix-int x) (iplus (difference j i) y)) (equal (iplus (difference i j) x) (fix-int y)))) ((use (cancel-constants-equal-lemma (m (add1 i)) (n (add1 j)))) (expand (difference (add1 i) (add1 j)) (difference (add1 j) (add1 i)) (lessp (add1 i) (add1 j))) (disable-theory t) (enable-theory ground-zero))) (prove-lemma ilessp-add1 (rewrite) (implies (numberp y) (equal (ilessp x (add1 y)) (not (ilessp y x)))) ((enable-theory integer-defns))) (prove-lemma ilessp-add1-iplus (rewrite) (implies (numberp y) (equal (ilessp x (iplus (add1 y) z)) (not (ilessp (iplus y z) x)))) ((enable-theory integer-defns) (disable plus-iplus difference-idifference))) (prove-lemma cancel-constants-ilessp-lemma-1 nil (implies (and (numberp m) (numberp n)) (equal (ilessp (iplus m x) (iplus n y)) (if (lessp m n) (ilessp x (iplus (difference n m) y)) (ilessp (iplus (difference m n) x) y))))) (prove-lemma cancel-constants-ilessp-lemma-2 nil (implies (and (numberp m) (numberp n)) (equal (ilessp (iplus m x) (iplus n y)) (if (lessp m n) (not (ilessp (iplus (sub1 (difference n m)) y) x)) (ilessp (iplus (difference m n) x) y)))) ((use (cancel-constants-ilessp-lemma-1) (ilessp-add1-iplus (y (sub1 (difference n m))) (z y) (x x))) (disable ilessp-add1-iplus))) (prove-lemma cancel-constants-ilessp (rewrite) (equal (ilessp (iplus (add1 i) x) (iplus (add1 j) y)) (if (lessp i j) (not (ilessp (iplus (sub1 (difference j i)) y) x)) (ilessp (iplus (difference i j) x) y))) ((use (cancel-constants-ilessp-lemma-2 (m (add1 i)) (n (add1 j)))) (expand (difference (add1 i) (add1 j)) (difference (add1 j) (add1 i)) (lessp (add1 i) (add1 j))) (disable-theory t) (enable-theory ground-zero))) (disable plus-iplus) (disable numberp-is-integerp) (disable difference-idifference) ; ---------- Final DEFTHEORY event ---------- ;; I'll go ahead and include iplus-list and itimes-list and lemmas ;; about them that were developed. ;; I've left out ILESSP-TRICHOTOMY because I'm scared it will slow ;; things down too much. But it certainly represents useful ;; information. (deftheory integers (ileq idifference integerp-fix-int integerp-iplus integerp-idifference integerp-ineg integerp-iabs integerp-itimes fix-int-remover fix-int-fix-int fix-int-iplus fix-int-idifference fix-int-ineg fix-int-iabs fix-int-itimes ineg-iplus ineg-ineg ineg-fix-int ineg-of-non-integerp ineg-0 iplus-left-id iplus-right-id iplus-0-left iplus-0-right commutativity2-of-iplus commutativity-of-iplus associativity-of-iplus iplus-cancellation-1 iplus-cancellation-2 iplus-ineg1 iplus-ineg2 iplus-fix-int1 iplus-fix-int2 idifference-fix-int1 idifference-fix-int2 ;; iplus-fringe lessp-count-listp-cdr iplus-tree-rec iplus-tree iplus-list ;; eval$-iplus-tree-rec eval$-iplus-tree eval$-list-append ;; cancel-iplus iplus-list-append iplus-ineg3 iplus-ineg4 ;; iplus-list-eval$-fringe ;; not-integerp-implies-not-equal-iplus <<>> correctness-of-cancel-iplus ilessp-fix-int-1 ilessp-fix-int-2 ;; make-cancel-iplus-inequality-1 cancel-iplus-ilessp-1 ;; <<< I omit the following two facts because they're naturals facts, ;; and hence I feel that it's up to naturals to "export" ;; them >>> ;; lessp-difference-plus-arg1 lessp-difference-plus-arg1-commuted iplus-cancellation-1-for-ilessp iplus-cancellation-2-for-ilessp ;; correctness-of-cancel-iplus-ilessp-lemma iplus-tree-no-fix-int ;; eval$-ilessp-iplus-tree-no-fix-int ;; make-cancel-iplus-inequality-simplifier cancel-iplus-ilessp correctness-of-cancel-iplus-ilessp ;; itimes-zero1 itimes-0-left ;; itimes-zero2 itimes-0-right itimes-fix-int1 itimes-fix-int2 commutativity-of-itimes itimes-distributes-over-iplus-proof itimes-distributes-over-iplus commutativity2-of-itimes associativity-of-itimes equal-itimes-0 equal-itimes-1 equal-itimes-minus-1 itimes-1-arg1 quotient-remainder-uniqueness ;; division-theorem-part1 division-theorem-part2 division-theorem-part3 division-theorem ;; <<< Same comment as in angle braces above >>> quotient-difference-lessp-arg2 ;; iquotient-iremainder-uniqueness ;; division-theorem-for-truncate-to-neginf-part1 ;; division-theorem-for-truncate-to-neginf-part2 ;; division-theorem-for-truncate-to-neginf-part3 ;; division-theorem-for-truncate-to-neginf ;; idiv-imod-uniqueness ;; division-theorem-for-truncate-to-zero-part1 ;; division-theorem-for-truncate-to-zero-part2 ;; division-theorem-for-truncate-to-zero-part3 ;; division-theorem-for-truncate-to-zero iquo-irem-uniqueness itimes-ineg-1 itimes-ineg-2 itimes-cancellation-1 itimes-cancellation-2 itimes-cancellation-3 integerp-iquotient integerp-iremainder integerp-idiv integerp-imod integerp-iquo integerp-irem iquotient-fix-int1 iquotient-fix-int2 iremainder-fix-int1 iremainder-fix-int2 idiv-fix-int1 idiv-fix-int2 imod-fix-int1 imod-fix-int2 iquo-fix-int1 iquo-fix-int2 irem-fix-int1 irem-fix-int2 fix-int-iquotient fix-int-iremainder fix-int-idiv fix-int-imod fix-int-iquo fix-int-irem ;; itimes-fringe ;; itimes-tree-rec itimes-tree itimes-list ;; eval$-itimes-tree-rec ;; eval$-itimes-tree make-cancel-itimes-equality ;; cancel-itimes itimes-list-append ;; itimes-list-eval$-fringe ;; integerp-eval$-itimes ;; not-integerp-implies-not-equal-itimes <<>> ;; itimes-list-eval$-delete itimes-list-bagdiff ;; equal-itimes-list-eval$-list-delete member-append;; <<< I'll go ahead and export this since it's ;; so fundamental if one has member around. >>> ;; member-izerop-itimes-fringe correctness-of-cancel-itimes-hack-1 ;; eval$-make-cancel-itimes-equality ;; eval$-make-cancel-itimes-equality-1 equal-fix-int ;; eval$-make-cancel-itimes-equality-2 ;; eval$-equal-itimes-tree-itimes-fringe-0 ;; izerop-eval-of-member-implies-itimes-list-0 subsetp;; <<< May as well have this enabled if it's going to ;; be imported here. >>> ;; subsetp-implies-itimes-list-eval$-equals-0 ;; subbagp-subsetp <<>> ;; equal-0-itimes-list-eval$-bagint-1 ;; equal-0-itimes-list-eval$-bagint-2 ;; correctness-of-cancel-itimes-hack-2 ;; correctness-of-cancel-itimes-hack-3-lemma ;; correctness-of-cancel-itimes-hack-3 correctness-of-cancel-itimes ;; itimes-tree-no-fix-int eval$-itimes-tree-no-fix-int-1 ;; eval$-itimes-tree-no-fix-int-2 make-cancel-itimes-inequality ;; cancel-itimes-ilessp eval$-make-cancel-itimes-inequality ;; listp-bagint-with-singleton-implies-member itimes-list-eval$-list-0 ;; ilessp-itimes-right-positive ;; correctness-of-cancel-itimes-ilessp-hack-1 ;; listp-bagint-with-singleton-member <<< Too obscure to be worthwhile >>> ;; correctness-of-cancel-itimes-ilessp-hack-2-lemma ;; correctness-of-cancel-itimes-ilessp-hack-2 ;; ilessp-trichotomy <<>> ;; correctness-of-cancel-itimes-ilessp-hack-3-lemma-1 ;; correctness-of-cancel-itimes-ilessp-hack-3-lemma-2 ;; same-fix-int-implies-not-ilessp ;; correctness-of-cancel-itimes-ilessp-hack-3 ;; ilessp-itimes-right-negative ;; correctness-of-cancel-itimes-ilessp-hack-4 correctness-of-cancel-itimes-ilessp ilessp-strict ;; cancel-ineg-aux ;; cancel-ineg eval$-list-cons eval$-list-nlistp eval$-litatom eval$-quote eval$-other ;; eval$-cancel-ineg-aux-fn eval$-cancel-ineg-aux-is-its-fn iplus-ineg-promote iplus-x-y-ineg-x ;; correctness-of-cancel-ineg-aux correctness-of-cancel-ineg integerp-iplus-list ;; eval$-cancel-iplus eval$-iplus-list-delete eval$-iplus-list-bagdiff ;; iplus-ineg5-lemma-1 iplus-ineg5-lemma-2 iplus-ineg5 iplus-ineg6 ;; eval$-iplus plus-ineg7 ;; <<>> ITIMES-TREE-INEG ITIMES-FACTORS ITIMES--1 EQUAL-INEG-INEG ILESSP-INEG-INEG FIX-INT-EVAL$-ITIMES-TREE-REC ;may as well leave it enabled EVAL$-ITIMES-TREE-INEG ;may as well leave it enabled INEG-EVAL$-ITIMES-TREE-INEG ;may as well leave it enabled IPLUS-EVAL$-ITIMES-TREE-INEG ;may as well leave it enabled ITIMES-EVAL$-ITIMES-TREE-INEG ;may as well leave it enabled IPLUS-OR-ITIMES-TERM CANCEL-ITIMES-FACTORS CANCEL-ITIMES-FACTORS-EXPANDED CANCEL-ITIMES-FACTORS-EXPANDED-CANCEL-ITIMES-FACTORS ;; EQUAL-ITIMES-LIST-EVAL$-LIST-DELETE-NEW-1 ;; EQUAL-ITIMES-LIST-EVAL$-LIST-DELETE-NEW-2 ;; ITIMES-ITIMES-LIST-EVAL$-LIST-DELETE ;; EQUAL-ITIMES-LIST-EVAL$-LIST-BAGDIFF MEMBERSHIP-OF-0-IMPLIES-ITIMES-LIST-IS-0 MEMBER-0-EVAL$-LIST ;; ITIMES-LIST-EVAL$-FACTORS-LEMMA ;; ITIMES-LIST-EVAL$-FACTORS-LEMMA-PRIME ITIMES-LIST-EVAL$-FACTORS ;; IPLUS-OR-ITIMES-TERM-INTEGERP-EVAL$ ;; EVAL$-LIST-BAGINT-0 ;; EVAL$-LIST-BAGINT-0-IMPLIES-EQUAL CORRECTNESS-OF-CANCEL-ITIMES-FACTORS CANCEL-ITIMES-ILESSP-FACTORS BAGINT-SINGLETON ;; <<>> ;; IZEROP-ILESSP-0-RELATIONSHIP ;; ILESSP-ITIMES-LIST-EVAL$-LIST-DELETE-HELPER-1 ;; ILESSP-ITIMES-LIST-EVAL$-LIST-DELETE-HELPER-2 ;; ILESSP-ITIMES-LIST-EVAL$-LIST-DELETE ;; ILESSP-ITIMES-LIST-EVAL$-LIST-DELETE-PRIME-HELPER-1 ;; ILESSP-ITIMES-LIST-EVAL$-LIST-DELETE-PRIME-HELPER-2 ;; ILESSP-ITIMES-LIST-EVAL$-LIST-DELETE-PRIME ;; ILESSP-0-ITIMES ;; ILESSP-ITIMES-0 ILESSP-ITIMES-LIST-EVAL$-LIST-BAGDIFF ;; ZERO-ILESSP-IMPLIES-NOT-EQUAL <<>> ILESSP-ITIMES-LIST-EVAL$-LIST-BAGDIFF-COROLLARY-1 ;; ILESSP-ZERO-IMPLIES-NOT-EQUAL <<>> MEMBER-0-ITIMES-FACTORS-YIELDS-0 MEMBER-0-ITIMES-FACTORS-YIELDS-0-ILESSP-CONSEQUENCE-1 MEMBER-0-ITIMES-FACTORS-YIELDS-0-ILESSP-CONSEQUENCE-2 ;; EVAL$-LIST-BAGINT-0-FOR-ILESSP <<>> ;; EVAL$-LIST-BAGINT-0-IMPLIES-EQUAL-FOR-ILESSP-LEMMA <<>> ;; EQUAL-FIX-INT-TO-ILESSP <<>> ;; EVAL$-LIST-BAGINT-0-IMPLIES-EQUAL-FOR-ILESSP ILESSP-ITIMES-LIST-EVAL$-LIST-BAGDIFF-COROLLARY-2 CORRECTNESS-OF-CANCEL-ITIMES-ILESSP-FACTORS DISJOIN-EQUALITIES-WITH-0 CANCEL-FACTORS-0 SOME-EVAL$S-TO-0 EVAL$-DISJOIN-EQUALITIES-WITH-0 SOME-EVAL$S-TO-0-APPEND SOME-EVAL$S-TO-0-ELIMINATOR ;; LISTP-CDR-FACTORS-IMPLIES-INTEGERP CORRECTNESS-OF-CANCEL-FACTORS-0 CONJOIN-INEQUALITIES-WITH-0 CANCEL-FACTORS-ILESSP-0 ;;;;;; and now from the final two metalemmas split-out-ineg-terms ;; function ;; remove-inegs ;; function, disabled ;; make-cancel-ineg-terms-equality ;; function ;; iplus-or-ineg-term ;; function, disabled ;; cancel-ineg-terms-from-equality ;; function, disabled ;; CANCEL-INEG-TERMS-FROM-EQUALITY-expanded ;; function ;; CANCEL-INEG-TERMS-FROM-EQUALITY-CANCEL-INEG-TERMS-FROM-EQUALITY-expanded ;;harmless ;; integerp-eval$-iplus-or-ineg-term ;; should be disabled, since iplus-or-ineg-term is ;; eval$-iplus-list-car-remove-inegs ;; harmless ;; eval$-iplus-list-cdr-remove-inegs ;; harmless ;; minus-ineg ;; definitely should be disabled ;; iplus-list-eval$-car-split-out-ineg-terms ;; harmless correctness-of-cancel-ineg-terms-from-equality ;; make-cancel-ineg-terms-inequality ;; function ;; cancel-ineg-terms-from-inequality ;; function ;; CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded ;; function, disabled ;; CANCEL-INEG-TERMS-FROM-INEQUALITY-CANCEL-INEG-TERMS-FROM-INEQUALITY-expanded ;; harmless correctness-of-cancel-ineg-terms-from-inequality ;; plus-iplus iplus-constants ;; numberp-is-integerp ;; difference-idifference ;; cancel-constants-equal-lemma ;; nil lemma cancel-constants-equal ilessp-add1 ilessp-add1-iplus ;; cancel-constants-ilessp-lemma-1 ;; nil lemma ;; cancel-constants-ilessp-lemma-2 ;; nil lemma cancel-constants-ilessp )) (make-lib "integers" t)