It's a basic principle in AI that different problem representations can either facilitate or impede a solution. Being able to readily switch data representations while programming in Common Lisp may therefore offer advantages, particularly during rapid prototyping. One common example is converting from a list to a vector object representation (or vise versa). In this case the built-in function coerce provides the appropriate conversions, along with several other potentially useful conversions. However, there are many reasonable conversion possibilities in Common Lisp that are not covered by built-in functions. And for those that do correspond to a built-in function (like intern which can convert from a string to a symbol, with side effects), the built-in functions are typically diverse and highly specialized for efficiency. This library attempts to consolidate many object type conversions into one function named convert, and to extend type conversions to a number of other objects beyond the baseline.
Take the set of objects comprising the number 2, the character #\2, the string "2", and the symbol |2|. The built-in conversion functions here include character, string, symbol-name, find-symbol, intern, digit-char, parse-integer, format, read-from-string, princ-to-string, prin1-to-string, and coerce, not to mention the simple copying functions. But the character -> number, symbol -> character, and several other potential conversions are not directly available. To make such conversions, it might be convenient to simply write (convert #\2 'number) -> 2, or (convert '|2| 'character) -> #\2. The general template for convert is patterned after coerce in taking an arbitrary object and a result specification. The acceptable result specifications are listed below. One difference is that convert always returns a new object, even when the result is the same type as the argument object (except, of course, when the argument object is immutable--i.e., a character, number, or symbol).
Whether a type conversion is justified in any particular case is always debatable, but most reasonable conversions, and some rather esoteric ones, are available for convenience. The library is probably best employed in rapid prototyping applications, where easy type conversions may facilitate experimentation and data manipulation. Efficiency is not a primary design goal, since the main emphasis presently is on accuracy, consistency, utility, and coverage. A variety of test cases is also included, which can be run by executing (convert-test-1) for basic conversions among characters, digits, certain symbols, and strings of length 1; or by executing (convert-test-2) for some more advanced conversions. Test results are output to the terminal.
The following is a list of possible conversions provided by the library. Any of the result specifiers listed here (on the right-hand-side) are acceptable as the second argument to convert. In general, impossible or bizarre attempts at conversion should generate an error:
character -> character, number, symbol, string
number -> character, number, symbol, string
symbol -> character, number, symbol, string
string -> character, number, symbol, string, list, vector (list or vector of characters)
dotted list -> list, proper-list (list for simple copy)
proper list -> list, vector, string
vector -> list, vector, string (vector adjustability retained)
nested lists or vectors -> nested-lists, nested-vectors (homogeneous conversion)
array -> nested-lists, nested-vectors
Regarding code review, there are too many methods to check individually, but it would be helpful to know if a useful conversion is missing or returns an unorthodox result. Thank you.
;;;; Filename: convert.lisp
;(in-package :ut)
(defgeneric convert (object type)
(:documentation "Extension of coerce for various other objects and types.
But always returns a new object of the specified type,
except for (immutable) characters, numbers, and symbols."))
(defun list-to-string (list)
"Converts a list to a string."
(if list
(reduce (lambda (x y)
(concatenate 'string x y))
list :key #'princ-to-string)
"NIL"))
(defun array-to-nested-lists (array &rest indexes)
"Extract the section of the multidimentional array defined by the
indexes. Must be (<= (length indexes) (array-rank array)) ==> T.
When (= (length indexes) (array-rank array)), this is equivanent
to AREF. Authored by sds."
(let ((ni (length indexes)))
(if (= ni (array-rank array))
(apply #'aref array indexes)
(loop for i from 0 below (array-dimension array ni)
collect (apply #'array-to-nested-lists array
(append indexes (list i)))))))
(defun array-to-nested-vectors (array &rest indexes)
"Extract the section of the multidimentional array defined by the
indexes. Must be (<= (length indexes) (array-rank array)) ==> T.
When (= (length indexes) (array-rank array)), this is equivanent
to AREF. Adapted from code by sds."
(let ((ni (length indexes)))
(if (= ni (array-rank array))
(apply #'aref array indexes)
(coerce (loop for i from 0 below (array-dimension array ni)
collect (apply #'array-to-nested-vectors array
(append indexes (list i))))
'vector))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod convert ((object symbol) (type (eql 'character)))
"Converts a symbol to a character."
(character (symbol-name object)))
(defmethod convert ((object character) (type (eql 'character)))
"Simply returns the immutable character."
object)
(defmethod convert ((object number) (type (eql 'character)))
"Converts a digit to a character."
(character (princ-to-string object)))
(defmethod convert ((object string) (type (eql 'character)))
"Converts a string of length 1 to a character."
(character object))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod convert ((object string) (type (eql 'list)))
"Converts a string to a list of characters."
(coerce object 'list))
(defmethod convert ((object cons) (type (eql 'proper-list)))
"Converts a possibly dotted list to a proper list, returning a new list."
(let ((copy (copy-list object)))
(loop for cell on copy
when (and (cdr cell) (atom (cdr cell)))
do (setf (cdr cell) (cons (cdr cell) nil))
finally (return copy))))
(defmethod convert ((object array) (type (eql 'nested-lists)))
"Converts the elements of an array to an array formatted list."
(array-to-nested-lists object))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod convert ((object symbol) (type (eql 'number)))
"Converts a symbol to a number."
(let ((obj (read-from-string (princ-to-string object))))
(if (numberp obj)
obj
(error "~A cannot be converted to a number." object))))
(defmethod convert ((object character) (type (eql 'number)))
"Converts a character to a number."
(let ((obj (read-from-string (princ-to-string object))))
(if (numberp obj)
obj
(error "~A cannot be converted to a number." object))))
(defmethod convert ((object number) (type (eql 'number)))
"Simply returns the immutable number."
object)
(defmethod convert ((object string) (type (eql 'number)))
"Converts a string to a number."
(let ((obj (read-from-string object)))
(if (numberp obj)
obj
(error "~A cannot be converted to a number." object))))
(defmethod convert ((object ratio) (type (eql 'float)))
"Converts a ratio to a float."
(float object))
(defmethod convert ((object float) (type (eql 'ratio)))
"Converts a real number to a rational number."
(rationalize object))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod convert ((object symbol) (type (eql 'string)))
"Converts a symbol to a string."
(cond ((keywordp object) (prin1-to-string object))
(t (copy-seq (symbol-name object)))))
(defmethod convert ((object character) (type (eql 'string)))
"Converts a character to a string."
(princ-to-string object))
(defmethod convert ((object number) (type (eql 'string)))
"Converts a number to a string."
(princ-to-string object))
(defmethod convert ((object string) (type (eql 'string)))
"Converts a string into a copy of itself."
(princ-to-string object))
(defmethod convert ((object cons) (type (eql 'string)))
"Converts a list of objects to a string."
(list-to-string object))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod convert ((object symbol) (type (eql 'symbol)))
"Simply returns the immutable symbol."
object)
(defmethod convert ((object character) (type (eql 'symbol)))
"Converts a character to a symbol."
(intern (princ-to-string object)))
(defmethod convert ((object number) (type (eql 'symbol)))
"Converts a number to a symbol."
(intern (princ-to-string object)))
(defmethod convert ((object string) (type (eql 'symbol)))
"Converts a string to a symbol."
(cond ((and (>= (length object) 1) (eql (elt object 0) #\:))
(read-from-string object))
(t (intern object))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod convert ((object cons) (type (eql 'vector)))
"Converts a list to a vector."
(coerce object 'vector))
(defmethod convert ((object string) (type (eql 'vector)))
"Converts a list to a vector."
(coerce (coerce object 'list) 'vector))
(defmethod convert ((object vector) (type (eql 'vector)))
"Converts a vector to a copy of itself."
(let ((new-vector
(make-array (array-dimensions object)
:element-type (array-element-type object)
:adjustable (adjustable-array-p object)
:fill-pointer (and (array-has-fill-pointer-p object)
(fill-pointer object)))))
(dotimes (i (array-total-size object))
(setf (row-major-aref new-vector i)
(row-major-aref object i)))
new-vector))
(defmethod convert ((object array) (type (eql 'nested-vectors)))
"Converts the elements of an array to a vector in array format."
(array-to-nested-vectors object))
(defmethod convert ((object sequence) (type (eql 'nested-lists)))
"Converts the elements of a sequence, including subvectors, sublists,
and substrings to homogeneous nested lists"
(map 'list (lambda (elt)
(cond ((or (consp elt) (stringp elt) (vectorp elt))
(convert elt 'nested-lists))
(t elt)))
object))
(defmethod convert ((object vector) (type (eql 'nested-lists)))
"Converts the elements of a vector, including subvectors, sublists,
and substrings to homogeneous nested lists"
(map 'list (lambda (elt)
(cond ((or (consp elt) (stringp elt) (vectorp elt))
(convert elt 'nested-lists))
(t elt)))
object))
(defmethod convert ((object sequence) (type (eql 'nested-vectors)))
"Converts the elements of a sequence, including sublists, subvectors,
and substrings to nested vectors."
(map 'vector (lambda (elt)
(cond ((or (consp elt) (stringp elt) (vectorp elt))
(convert elt 'nested-vectors))
(t elt)))
object))
(defmethod convert ((object vector) (type (eql 'nested-vectors)))
"Converts the elements of a vector, including sublists, subvectors,
and substrings to nested vectors."
(map 'vector (lambda (elt)
(cond ((or (consp elt) (stringp elt) (vectorp elt))
(convert elt 'nested-vectors))
(t elt)))
object))
;;;;;;;;;;;;;;;;;;; Test Bench ;;;;;;;;;;;;;;;;
;;;; From Practical Common Lisp by Peter Seibel
(defvar *test-name* nil)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (make-symbol ,(string n))))
,@body)))
(defmacro deftest (name parameters &body body)
"Define a test function. Within a test function we can call other
test functions or use `check' to run individual test cases."
`(defun ,name ,parameters
(let ((*test-name* (append *test-name* (list ',name))))
,@body)))
(defmacro check (&body forms)
"Run each expression in `forms' as a test case."
`(combine-results
,@(loop for f in forms collect `(report-result ,f ',f))))
(defmacro combine-results (&body forms)
"Combine the results (as booleans) of evaluating `forms' in order."
(with-gensyms (result)
`(let ((,result t))
,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
,result)))
(defun report-result (result form)
"Report the results of a single test case. Called by `check'."
(format t "~:[FAIL~;pass~]: ~S~%" result form)
result)
;;;;;;;;;;;;;;;;;;;;;;; Convert Tests ;;;;;;;;;;;;;;;;;;;;;;
(defparameter *convert-types* '(character symbol number string)) ;list vector array structure))
(defparameter *convert-table* #2A(
;character symbol number string
(- NIL - "NIL" )
(#\T T - "T" )
(- || - "" )
(- |""| - "\"\"" )
(- \|\| - "||" )
(#\Space | | - " " )
(#\A A - "A" )
(#\a |a| - "a" )
(#\+ + - "+" )
(- |"a"| - "\"a\"" )
(- |#\\a| - "#\\a" )
(- :A - ":A" )
(- AB - "AB" )
(- |Ab| - "Ab" )
(#\2 |2| 2 "2" )
(- |22| 22 "22" )
(- |3/4| 3/4 "3/4" )
(- |-2| -2 "-2" )
(- |0.75| 0.75 "0.75" )
(- |20.0d0| 20.0d0 "20.0d0" )
(- |#C(1 2)| #C(1 2) "#C(1 2)" )
))
(defun convert-test-1 ()
"Tests the basic convert methods using the conversion table *convert-table*
with headings *convert-types*."
(declare (special *convert-table* *convert-types*))
(loop for row from 0 below (array-dimension *convert-table* 0)
do (loop for col1 from 0 below (array-dimension *convert-table* 1)
do (loop for col2 from 0 below (array-dimension *convert-table* 1)
for type in *convert-types*
do (let ((elt1 (aref *convert-table* row col1))
(elt2 (aref *convert-table* row col2))) ;(print (list elt1 elt2))
(unless (or (eq elt1 '-) (eq elt2 '-))
(let ((result (convert elt1 type)))
(if (equalp (convert elt1 type) elt2)
(format t "pass: (convert ~S ~S) -> ~S~%" elt1 type elt2)
(format t "fail: (convert ~S ~S) -> ~S required: ~S~%"
elt1 type result elt2)))))))))
(defmacro convert-test-2 ()
"Tests more complex conversions."
(check (equal (convert '(1 2 . 3) 'proper-list)
'(1 2 3))
(= (convert 0.75 'ratio)
3/4)
(= (convert 3/4 'float)
0.75)
(equal (convert '(a |b| "c" #\d 2) 'string)
"Abcd2")
(equalp (convert '(a |b| "c" #\d 2) 'vector)
#(A |b| "c" #\d 2))
(equal (convert "Ab(c)" 'list)
'(#\A #\b #\( #\c #\)))
(equalp (convert "Ab(c)" 'vector)
#(#\A #\b #\( #\c #\)))
(let* ((vec (make-array 3 :initial-element 1 :fill-pointer 1))
(result (convert vec 'vector))) ;copies vector
(and (equalp result #(1)) (= (fill-pointer result) 1)))
(equal (convert #(a b #(c)) 'nested-lists)
'(a b (c)))
(equal (convert #3A(((1 2 3 4) (5 6 7 8) (9 10 11 12))
((13 15 15 16) (17 18 19 20) (21 22 23 24)))
'nested-lists)
'(((1 2 3 4) (5 6 7 8) (9 10 11 12))
((13 15 15 16) (17 18 19 20) (21 22 23 24))))
(equalp (convert #3A(((1 2 3 4) (5 6 7 8) (9 10 11 12))
((13 15 15 16) (17 18 19 20) (21 22 23 24)))
'nested-vectors)
#(#(#(1 2 3 4) #(5 6 7 8) #(9 10 11 12))
#(#(13 15 15 16) #(17 18 19 20) #(21 22 23 24))))
(equalp (convert '(a b (c)) 'nested-vectors)
#(a b #(c)))
))
