;;;	Copyright (c) 1989, 1990 by Aubrey Jaffer, All rights reserved.

;;;; Built in functions
(defbltn 'commands
  (lambda ()
    (for-each (lambda (ap) (write (car ap)) (display " ")) infodefs)
    (newline)
    '()))

(defbltn 'describe
  (lambda (x)
    (for-each (lambda (i)
		(cond ((string? i) (display i))
		      ((sexp? i)
		       (write-sexp i *output-grammer*))
		      (else (eval-error "bad info entry")))
		(newline))
	      (or (assq (var->symbol (variable x)) infodefs) '()))
    '()))

(defbltn 'example
  (lambda (x)
    (let ((info (assq (var->symbol (variable x)) infodefs)))
      (do ((info (if info (cddr info) '()) (cdr info)))
	  ((or (null? info) (not (string? (car info))))
	   (cond ((null? info) 'no_example)
		 (else (write-sexp (car info) *input-grammer*)
		       (car info))))))))

(defbltn 'total-differential
  (lambda (obj) (total-differential obj)))

(defbltn 'negate
  (lambda (obj) (app* -@1 obj))
  "Unary negation."
  '(negate a)
  '(* -1 a))

(defbltn '^				;need to do expt also
  (lambda (x exp) (^ (expr x) (normalize exp)))
  "Exponentiation."
  '(^ (+ a 1) 2)
  '(+ 1 a (^ a 2)))

(defbltn '^^				;need to do ncexpt also
  (lambda (a pow) (ncexpt (exprs a) (normalize pow)))
  "Non-commutative Exponentiation.  For vectors, this is repeated dot
product."
  '(^^ #(a b) 2)
  '(+ (^ a 2) (^ b 2))
  "For matrices, this is repeated matrix multiplication.  If n is
negative, the inverse of the matrix is raised to -n."
  '(^^ #(#(a b) #(c d)) 2)
  "For single-valued functions of one variable, This is the
composition of the function with itself n times.  If n is negative,
the inverse of the function is raised to -n."
  '(^^ (lambda #(x) (+ 1 (* 2 x))) -2))

(defbltn '*
  (lambda args (reduce (lambda (x y) (app* @1*@2 x y)) args))
  "Multiplication, times."
  '(* a 7)
  '(* 7 a))

(defbltn '+
  (lambda args (reduce (lambda (x y) (app* @1+@2 x y)) args))
  "Addition, plus."
  '(+ a b))

(defbltn '-
  (lambda args (reduce (lambda (x y) (app* @1-@2 x y)) args))
  "Subtraction, minus."
  '(- a 9))

(defbltn '/
  (lambda args (reduce (lambda (x y) (app* @1/@2 x y)) args))
  "Quotient, division, divide, over."
  '(/ a b))

(defbltn 'bunch
  (lambda args (map licit args))
  "bunch, vector, list."
  '(bunch a b)
  '#(a b))

(defbltn 'rapply
  (lambda args (apply rapply args))
  "subscripted reference"
  '(rapply #(a b) 2)
  'b)

(defbltn 'or
  (lambda args
    (poleqn->licit (reduce poly_* (map licit->poleqn args))))
  "union, multiple value.  Or of two equations returns an equation
with either condition true."
  '(or (= a b) (= a c))
  '(= 0 (- (^ a 2) (* b c)))
  "Or of two values yields a multiple value, such as +/-x"
  '(or x (negate x))
  '(+/- x)
  "Or of an equation and a value will yield the value.")

(defbltn '=
  (lambda (x y) (app* @1=@2 x y))
  "equals, equality.  This expresses a relation between variables and
numbers"
  '(= a (^ b 2))
  '(= 0 (- a (^ b 2)))
  "it does not conote value assignment")

(defbltn 'qed
  (lambda () (math_exit #t))
  "qed, quit, bye, exit.  This leaves the math system")

;;;; User callable functions

(defbltn 'listofvars
  (lambda (exp) (map var->expl (alg_vars exp)))
  "This returns a list of variables occuring in the argument"
  '(listofvars (+ a (/ b c))))

(defbltn 'coeff
  (lambda (p var . optional)
    (let ((ord (if (null? optional) 1 (car optional))))
      (poly_coeff p (variable var) (integer ord))))
  "coeff, coefficient.  Returns the coefficient of (optional 1) power
of var in poly")

(defbltn 'num
  (lambda (exp) (num exp))
  "num, numerator, top.  The numerator of a rational expression.")

(defbltn 'denom
  (lambda (exp) (denom exp))
  "denom, denominator, bottom.  The denominator of a rational
expression.") 

(defbltn 'divide
  (lambda (dividend divisor . vars)
    (set! dividend (licit->polxpr dividend))
    (set! divisor (licit->polxpr divisor))
    (poly_pdiv dividend divisor (if (null? vars)
				    (car divisor)
				  (variable (car vars))))))

(defbltn 'content
  (lambda (poly var)
    (let* ((var (variable var))
	   (poly (promote var (licit->polxpr poly)))
	   (cont (apply poly_gcd* (cdr poly))))
      (list cont (poly_/ poly cont))))
  "Returns a list of content and primitive part of a polynomial with
respect to the variable.  The content is the GCD of the coefficients
of the polynomial in the variable.  The primitive part is poly divided
by the content"
  '(content (+ (* 2 x y) (* 4 (^ x 2) (^ y 2))) y)
  '#((* x y) (+ y (* 2 x (^ y 2)))))

;;; This is user callable GCD.
(defbltn 'gcd
  (lambda (a b)
    (poly_gcd (licit->polxpr a) (licit->polxpr b)))
  "gcd, greatest common divisor.  The greatest common divisor of 2
rational expressions.") 

(defbltn 'mod
  (lambda (licit polxpr)
    (poleqn->licit (poly_prem (licit->poleqn licit) (licit->polxpr polxpr))))
  "the first argument modulo the second argument")

;;; This is user callable RESULTANT.  It always operates on
;;; polynomials and does not know about extensions etc.
(defbltn 'resultant
  (lambda (a b v)
    (let ((res (poly_resultant
		(licit->polxpr a)
		(licit->polxpr b)
		(variable v))))
      (if (number? res) '() res)))
  "resultant.  The result of eliminating a variable between 2
equations (or polynomials).") 

(defbltn 'bezout
  (lambda (p1 p2 var)
    (bezout (licit->polxpr p1)
	    (licit->polxpr p2)
	    (variable var)))
  "bezout.  A matrix whose determinant is the resultant of 2 equations
(or polynomials.)") 

(defbltn 'bruno
  (lambda (p1 p2 var)
    (bruno (licit->polxpr p1)
	   (licit->polxpr p2)
	   (variable var)))
  "bruno.  Bruno's version of a matrix whose determinant is the
resultant of 2 equations (or polynomials).") 

(defbltn 'sylvester
  (lambda (p1 p2 var)
    (sylvester (licit->polxpr p1)
	       (licit->polxpr p2)
	       (variable var)))
  "sylvester.  Sylvester's version of a matrix whose determinant is
the resultant of 2 equations (or polynomials).  This is a larger
matrix than bruno.")

(defbltn 'poly_discriminant
  (lambda (poly var)
  (let ((p (licit->polxpr poly))
	(v (variable var)))
    (poly_resultant (poly_diff p v) p v)))
  "discriminant of a polynomial.  the square of the product of the
differences of all pairs of roots."
  '(poly_discriminant (* (- x a) (- x b) (- x c)) x))

(defbltn 'eliminate
  (lambda (eqns vars)
    (poleqns->licits (eliminate (licits->poleqns eqns) (variables vars))))
  "eliminate.  An equation or set of equations with vars eliminated")

(defbltn 'factor
  (lambda (poly) (poly_factorq (licit->polxpr poly))))


(defbltn 'matrix
  (lambda args (apply matrix args))
  "matrix.  makes a copy of a matrix")

(defbltn 'genmatrix
  (lambda (fun i2 j2 . i1j1)
    (let ((i1 1) (j1 1))
      (cond ((null? i1j1))
	    ((begin (set! i1 (car i1j1))
		    (set! i1j1 (cdr i1j1))
		    (set! j1 i1)
		    (null? i1j1)))
	    ((begin (set! j1 (car i1j1))
		    (set! i1j1 (cdr i1j1))
		    (null? i1j1)))
	    (else (math-error "Too many arguments")))
      (mtrx_genmatrix
       fun 
       (integer i2)
       (integer j2)
       (integer i1)
       (integer j1))))
  "genmatrix.  A matrix whose entries are the function applied to its indices")

(defbltn 'copymatrix
  (lambda (m) (copymatrix m))
  "copymatrix.  a copy of a matrix")

(defbltn 'copylist list-copy
  "copylist.  a copy of a vector")

(defbltn 'ident
  (lambda (n) (diagmatrix n 1))
  "ident, identity matrix.  A square matrix of 0s except the diagonal
entries are 1")

(defbltn 'diagmatrix
  (lambda (n x) (mtrx_diagmatrix (integer n) x))
  "diagmatrix, diagonal matrix.  A square matrix of 0s except the
diagonal entries = argument")

(defbltn 'determinant
  (lambda (m) (determinant m))
  "determinant.  The determinant of a square matrix")

(defbltn 'crossproduct
  (lambda (x y) (crossproduct x y))
  "crossproduct.  Crossproduct of 2 vectors")

(defbltn 'dotproduct
  (lambda (x y) (dotproduct x y))
  "dotproduct.  dotproduct of 2 vectors.  matrix multiplication if one
of the arguments is a matrix")

(defbltn 'row
  (lambda (m i)
    (if (matrix? m)
	(list-ref m (+ -1 (integer i)))
      (math-error "Row of non-matrix?: " M)))
  "Row.  row of a matrix")

(defbltn 'col
  (lambda (m i)
    (cond ((matrix? m)
	   (map (lambda (row)
		  (list (list-ref row (+ -1 (integer i)))))
		m))
	  ((bunch? m) (list-ref m (integer i)))
	  (else (math-error "Column of non-matrix?: " M))))
  "column.  column of a matrix")

(defbltn 'minor
  (lambda (m i j)
    (mtrx_minor m (integer i) (integer j)))
  "minor.  minor of a matrix")

(defbltn 'transpose
  (lambda (m) (transpose m))
  "transpose.  transpose of a matrix")

(defbltn 'load
  (lambda (file)
    (load (if (symbol? file) (symbol->string file) file))))

(defbltn 'finv
  (lambda (f)
    (fcinverse f)))
