;|
Date: Sat, 18 Dec 1999 14:25:07 +0000
From: Jeremy Dunn
To: rurban@sbox.tu-graz.ac.at
Subject: Some more useful code
Reini,
This email is a somewhat of a potpourri of different code I have used
that I have found useful and applied to my own copy of STDLIB. I will
attempt to relate the usefullness of each pieces of code to each other
but I will have to stray from the path now and again.
First, this piece of code mimicks the SWITCH function in C. I find that
one has to be careful about using (list ) rather than '() for the list
inputs. I was hoping that someone more knowledgeable than I might have
suggestions for making this routine more robust.
|;
;;;======================================================================
;;; This function mimics the SWITCH function in the C programming language.
;;; An expression such as
;;; (cond
;;; ((= x a) A) can be written as (switch x '(a b c) '(A B C))
;;; ((= x b) B)
;;; ((= x c) C) If the second list is one item longer than the first list
;;; ) then it is returned as a default if none of the previous
;;; items satisfy x. Thus
;;; (cond
;;; ((= x a) A) is written as (switch x '(a b) '(A B C))
;;; ((= x b) B)
;;; (T C)
;;; )
(defun SWITCH (opt L1 L2 / optval Lval len1 len2 L1end L1pos)
(setq optval (eval opt)
Lval (mapcar 'eval L1)
len1 (length L1)
len2 (length L2)
L1end (member optval Lval)
L1pos (if L1end (- len1 (length L1end)) nil)
L1pos (if L1pos (eval (nth L1pos L2)) nil)
)
(if (= len1 len2)
(if L1pos L1pos)
(if L1pos L1pos (eval (last L2)))
)
)
;;; I also use two functions that I call OR= and AND=. OR= is basically a
;;; special form of MEMBER that only makes a boolean test and does not
;;; return the rest of the list.
;;; Returns T if ele appears in lst. Different from member in that
;;; it does not exert the extra effort of returning the rest of the
;;; list. This is more suitable if one is only in need of the boolean
;;; response and not the return of the rest of the list. Should be faster
;;; but I have not tested it to prove my assertion.
;;; (or= a '(b c d)) is the same as (or (= a b)(= a c)(= a d))
(defun OR= (lst ele / len bool cnt)
(setq len (length lst) cnt 0 bool nil)
(while (and (not bool)(< cnt len))
(if (= ele (nth cnt lst))(setq bool T))
(setq cnt (1+ cnt))
)
bool
)
;;; Counterpart to OR=
;;; Example: (and= a '(b c d)) is the same as (and (= a b)(= a c)(= a d))
(defun and= (x lst)
(apply 'and (mapcar '= (std-make-list (length lst) x) lst)))
;;;Let us give an example of using AND=. The next function makes the
;;;testing of a list for the types of its elements much simpler.
;;; Is every element in the list of the same type?
;;; Example: (settype '(2 5 4) 'INT) => T
(defun SETTYPE (lst typ)
(and (consp lst)
(not (std-not-proper-list-p lst))
(<= (length lst) *MAX-ARGS-LIMIT*)
(and= typ (mapcar 'type lst))))
;;;Now instead of having the function STD-STRING-LIST-P we have that these two
;;;expressions are equivalent:
;;;
;;;(std-string-list-p lst) <==> (settype lst 'STR)
;;;
;;;We do not now need several separate functions to test the type of a
;;;list. STD-NUMBER-LIST-P can be redefined as
;;; Is the list a list of numbers
(defun STD-NUMBER-LIST-P (lst)
(and (consp lst)
(not (std-not-proper-list-p lst))
(<= (length lst) *MAX-ARGS-LIMIT*)
(and= T (mapcar 'numberp lst))))
;;;Note the use of AND= again.
;;;
;;;I have more to say about testing types. First we develop the TYPECHAR
;;;function which takes the expression returned from (type x) as a single
;;;character string code according to the following function:
;;; This support function returns a letter code for all of the data
;;; types, this is very important for the TYPEWCMATCH function which comes next.
(defun TYPECHAR (x / typ)
(setq typ (type x))
(cond
((= typ 'REAL) "R")
((= typ 'FILE) "F")
((= typ 'STR) "S")
((= typ 'INT) "I")
((= typ 'SYM) "Y")
((= typ 'LIST) "L")
((= typ 'SUBR) "s")
((= typ 'EXSUBR) "X")
((= typ 'PICKSET) "P")
((= typ 'ENAME) "E")
((= typ 'PAGETB) "p")
(T "N") ;response for NIL
)
)
;;;Now what good is this? We use it in the following function:
;;; This function takes a list of elements converts their data type to
;;; a type character (as per above) concatenates them all into a string
;;; and compares them to a wcmatch pattern to determine if the types
;;; conform to a desired pattern.
;;; (typewcmatch '(1 "a" 3 4) "IIII") => nil
;;; (typewcmatch '(1 "a" 3 4) "*I") => T
;;; (typewcmatch '(1 "a" 3 4) "I[IS]II") => T
(defun TYPEWCMATCH (lst pattern)
(if (listp lst)
(wcmatch (apply 'strcat (mapcar 'typechar lst)) pattern)
nil))
;|
This function is very handy if we need to take a list of arguments and
see if their data types conform to a desired pattern without having to
use multiple AND's OR's and other functions. For a possible application
we reconsider the STD-POINTP function. It is now defined as
(defun STD-POINTP (pt)
(and (listp pt)
(<= 2 (length pt) 3)
(apply (function and) (mapcar (function numberp) pt))))
But using TYPEWCMATCH we could also define this as
(defun STD-POINTP (pt)
(typewcmatch pt "[IR][IR],[IR][IR][IR]"))
Similarly, we could redefine STD-2DPOINTP and STD-3DPOINTP as
(defun STD-2DPOINTP (pt)
(typewcmatch pt "[IR][IR]"))
(defun STD-3DPOINTP (pt)
(typewcmatch pt "[IR][IR][IR]"))
Pretty nifty huh? Now we divert a bit. I saw that the routine
STD-INTERSECTION in the module STDLIST did not create an intersection
properly in certain cases. This function is now fixed. The trick is to
delete the item from the second list when it matches so that one is
continually comparing against a smaller list.
;;; STD-INTERSECTION returns all elements that are in lst1 and lst2.
;;; (setintersection '(0 1 2 3 4 5) '(2 0 6 7)) => (0 2)
(defun STD-INTERSECTION (lst1 lst2 / L)
(setq L '())
(foreach X lst1
(if (or= X lst2) ;Here is an example of or= replacing MEMBER,
(setq L (cons X L) ;we only need the boolean.
lst2 (std-delpos (std-position X lst2) lst2)))) ;fix is here!
(reverse L))
Hope someone finds something usefull here. Always looking for new ideas.
-Jeremy Dunn
|;