;;; This software is being provided to you, the LICENSEE, by the
;;; Massachusetts Institute of Technology (M.I.T.), and the NEC Research
;;; Institute (NECI) under the following license.  By obtaining, using
;;; and/or copying this software, you agree that you have read,
;;; understood, and will comply with these terms and conditions:
;;; 
;;; Permission to use, copy, modify and distribute, including the right to
;;; grant others rights to distribute at any tier, this software and its
;;; documentation for research purposes only and without fee or royalty is
;;; hereby granted, provided that you agree to comply with the following
;;; copyright notice and statements, including the disclaimer, and that
;;; the same appear on ALL copies of the software and documentation,
;;; including modifications that you make for internal use or for
;;; distribution:
;;; 
;;; Copyright 1995 by the Massachusetts Institute of Technology.  All
;;; rights reserved.  Copyright 1995 by NEC Research Institute Inc. All
;;; rights reserved
;;; 
;;; THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. and NECI MAKE NO
;;; REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED.  By way of example,
;;; but not limitation, M.I.T. and NECI MAKE NO REPRESENTATIONS OR
;;; WARRANTIES OF MERCHANTABILITY OR FITNESS FOR ANY PARTICULAR PURPOSE OR
;;; THAT THE USE OF THE LICENSED SOFTWARE OR DOCUMENTATION WILL NOT
;;; INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER
;;; RIGHTS.
;;; 
;;; The name of the Massachusetts Institute of Technology or M.I.T., or
;;; NEC Research Institute, or NECI may NOT be used in advertising or
;;; publicity pertaining to distribution of the software.  Title to
;;; copyright in this software and any associated documentation shall at
;;; all times remain with M.I.T. and NECI, and USER agrees to preserve
;;; same.
;;; 

;;; -*- Mode: LISP; Base: 10; Package: G; Syntax: Common-Lisp -*-
(in-package G)

(export '(SQ SQUARE ~= ~=x-y ~zerop ~< ~<= ~> ~>= ~signum filter flatten randomize-list random-between
	  random-choose remnth nthrdc nlast average xor remdups help)) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Auxiliary macros and functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun SQ (x)
  "Returns the square of X"
  (* x x))

(defun SQUARE (x)
  "Returns the square of X"
  (* x x))

(defun ~= (number &rest more-numbers)
  "Returns T if for all pairs (X Y) of the arguments, |X-Y| <= (X * *EPSILON*) or *EPSILON*."
  (loop for remaining-numbers on (cons number more-numbers)
	as first = (first remaining-numbers)
	unless (loop for second in (cdr remaining-numbers)
		     unless (~=x-y first second)
		       return nil
		     finally (return t))
	  return nil
	finally (return t)))

(defun ~=x-y (x y)
  "Returns T if |X-Y| <= (X * *EPSILON*) or *EPSILON*."
  (<= (abs (- x y)) (max (* x *epsilon*) *epsilon*)))

(defun ~zerop (number)
  "Returns T if NUMBER is within *EPSILON*."
  (<= (abs number) *epsilon*))

(defun ~SIGNUM (number)
 "Returns 0 if number is ~zerop, otherwise like signum"
 (cond ((< *epsilon* number) 1)
       ((< number *-epsilon*) -1)
       (t 0)))

;;; Note that with the EPSILON slop, <= and < are equivalent.  So are > and >=.

(defun ~< (number &rest more-numbers)
  "Returns T if < holds within *EPSILON*."
  (loop as first in (cons number more-numbers)
	for second in more-numbers
	unless (or (< first second)
		   (~= first second))
	  return nil
	finally (return t)))

(defun ~<= (number &rest more-numbers)
  "Returns T if <= holds within *EPSILON*."
  (apply #'~< number more-numbers))

(defun ~> (number &rest more-numbers)
  "Returns T if > holds within *EPSILON*."
  (loop as first in (cons number more-numbers)
	for second in more-numbers
	unless (or (> first second)
		   (~= first second))
	  return nil
	finally (return t)))

(defun ~>= (number &rest more-numbers)
  "Returns T if >= holds within *EPSILON*."
  (apply #'~> number more-numbers))

(defun FILTER (proc lst)
  (loop for mem in lst
	appending
	(if (apply proc (list mem)) (list mem))))

(defun FLATTEN (lst-of-lsts)
  (loop for lst in lst-of-lsts
	appending
	lst))

(defun RANDOMIZE-LIST (lst)
  (if (null (cdr lst)) lst
      (let ((n (random (length lst))))
	(cons (nth n lst) (randomize-list (remnth n lst))))))

;;; pick a number between 1st and last.  It may equal 1st, but must be less than last.
(defun RANDOM-BETWEEN (1st last)
  (+ 1st (random (- last 1st))))

(defun RANDOM-CHOOSE (lst)
  (nth (random (length lst)) lst))

(defun REMNTH (n lst)
  (loop for i from 0 to (1- (length lst))
	for mem in lst
	appending
	(if (/= i n) (list mem) nil)))

(defun NTHRDC (n lst)
  (reverse (nthcdr n (reverse lst))))

(defun NLAST (n lst) (nth n (reverse lst)))

(defun AVERAGE (nums)
  (/ (apply #'+ nums) (length nums)))

(defun XOR (a1 a2)
  (or (and a1 (not a2)) (and (not a1) a2)))

(defun REMDUPS (lst &optional (test-fun #'equal) (order-fun nil))
  "If order-fun is provided, then the lst may be mutated."
  (if order-fun
      (if (null lst) nil
	  (let ((lst (sort lst order-fun)))
	    (cons (car lst)
		  (loop for last-item in lst
			for item in (cdr lst)
			appending
			  (when (not (apply test-fun (list last-item item)))
			    (list item))))))
      (loop for mem in lst
	    for rest-lst on lst
	    appending
	      (if (not (member mem (cdr rest-lst) :test test-fun))
		  (list mem)))))

(defun help ()
  (format t "~%The geometry system is documented in the file: geometry-gen:geometry-gen;document.tex"))
