source: CGBLisp/trunk/src/cgb-lisp.lisp@ 40

#|
        $Id: cgb-lisp.lisp,v 1.1 2009/01/19 07:44:57 marek Exp $        
  *--------------------------------------------------------------------------*
  |  Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu)    |
  |    Department of Mathematics, University of Arizona, Tucson, AZ 85721    |
  |                                                                          |
  | Everyone is permitted to copy, distribute and modify the code in this    |
  | directory, as long as this copyright note is preserved verbatim.         |
  *--------------------------------------------------------------------------*
|#

;;----------------------------------------------------------------
;; An example facility
;;----------------------------------------------------------------
;; It should be run from the CGB-LISP package and the symbols which appear in the variable
;; otherwise it will not work because the variable names which appear in strings will not
;; be in the same package as the variables appearing in the variable lists; well, this
;; would not happen if variable lists were strings as well, but it is the price to pay for
;; the convenience of being able to type variable lists quickly.
;;----------------------------------------------------------------

(defpackage "CGB-LISP"
  (:use "INFIX" "INFIX-PRINTER" "MAKELIST" "ORDER" "MONOM" "COEFFICIENT-RING" "TERM" "POLY"
    "MODULAR" "MODULAR-POLY" "DIVISION" "PARSE" "PRINTER"
    "POLY-WITH-SUGAR" "GROBNER" "COLORED-POLY" "POLY-GCD" "RAT"
    "RATPOLY" "STRING-GROBNER" "DYNAMICS" "PROVER" "COMMON-LISP"))

(in-package "CGB-LISP")

(defvar *examples*
  '((string-grobner . ((string-grobner "[x^2+y,x-y]" '(x y))
                       (string-grobner "[y-x^2,z-x^3]" '(x y z) :order #'grevlex>)))
    (string-grobner-system . ((string-grobner-system "[u*x+y,x+y]" '(x y) '(u))
                              (string-grobner-system "[u*x+y,x+y]" '(x y) '(u) :cover '(("[u-1]" "[]")))))
    (string-read-poly . ((string-read-poly "[x^3+3*x^2+3*x+1]" '(x))))
    (string-elimination-ideal . ((string-elimination-ideal "[x^2+y^2-2,x*y-1]" '(x y) 1)))
    (string-ideal-saturation-1 . ((string-ideal-saturation-1 "[x^2*y,y^3]" "x" '(x y))))
    (string-ideal-polysaturation-1 . ((string-ideal-polysaturation-1 "[x^2*y,y^3]" "[x,y]" '(x y))))
    (string-cond . ((string-cond '("[u^2-v]" "[v-1]") '(u v) #'grevlex>)))
    (string-cover . ((string-cover '(("[u^2-v]" "[u]") ("[u+v]" "[]")) '(u v) #'grevlex>)))
    (string-determine . ((string-determine
                          "[u*x+y,v*x^2+y^2]"
                          '(x y)
                          '(u v)
                          :cond '("[u,v]" "[v-1]")
                          :main-order #'lex>)))
    (parse-string-to-sorted-alist . ((parse-string-to-sorted-alist "x^2+y^3" '(x y) #'grevlex>)
                                     (parse-string-to-sorted-alist "[x^2+y^3,x-y]" '(x y) #'grevlex>)))
    (translate-statements . ((translate-statements (collinear a b c) (perpendicular a b a c))))
    (translate-theorem . ((translate-theorem
                           ((perpendicular A B C D)
                            (perpendicular C D E F))
                           ((parallel A B E F)
                            (identical-points C D)))
                          (translate-theorem
                           ((perpendicular A B A C)
                            (midpoint B C M)
                            (midpoint A M O)
                            (collinear B H C)
                            (perpendicular A H B C))
                           ((equidistant M O H O)
                            (identical-points B C)
                            ))))
    (prove-theorem . ((prove-theorem
                       ((perpendicular A B C D)
                        (perpendicular C D E F))
                       ((parallel A B E F)
                        (identical-points C D)))
                      (prove-theorem
                       ((perpendicular A B A C)
                        (midpoint B C M)
                        (midpoint A M O)
                        (collinear B H C)
                        (perpendicular A H B C))
                       ((equidistant M O H O)
                        (identical-points B C)))
                      (prove-theorem
                       ((perpendicular A B A C)
                        (identical-points B C))
                       ((identical-points A B)
                        (identical-points A C)))
                      (prove-theorem
                       ((perpendicular A B A C)
                        (identical-points B C))
                       ((identical-points A B)
                        (real-identical-points A C)))))
    )
  "A list of available examples.")


(defun example (symbol &optional (stream t))
    "Run short examples associated with a symbol, which typically is a function name."
    (dolist (e (cdr (assoc symbol *examples*)))
      (run-example e stream))
    (values))

(defun run-example (e stream)
  "Evaluate a single form E and send output to stream STREAM."
  (format stream "~%;;----------------------------------------------------------------")
  (format stream "~%;;")
  (format stream "~%;;~1T~S" e)
  (format stream "~%;;")
  (format stream "~%;;----------------------------------------------------------------~&")
  (let ((counter 0))
    (dolist (val (multiple-value-list (eval e)))
      (format stream "[ RETURN VALUE ~d]-->> ~S~&" (incf counter) val)))
  (values))

(defun all-examples (&optional (stream t))
  "Run all available examples and send output to STREAM."
  (dolist (a *examples*)
    (dolist (e (cdr a))
      (run-example e stream)))
  (values))