4
\$\begingroup\$

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)))
         ))
\$\endgroup\$
  • \$\begingroup\$ Do you plan on making a proper library ? (at least on version control and with an asdf system) \$\endgroup\$ – Ehvince Jul 31 '18 at 11:26
  • \$\begingroup\$ @Ehvince Thanks for your interest. It was just a learning exercise, and I don't know much about proper CL libraries (except that I find them hard to use). But it's open source so anyone can do as they wish with it. \$\endgroup\$ – davypough Aug 2 '18 at 5:24
1
\$\begingroup\$

Right, I get the description, it's probably useful in the described circumstances, though I'd also say that having all these special/single case conversions like PROPER-LIST, NESTED-LISTS and NESTED-VECTORS is a bit much.

  • LIST-TO-STRING could just be (format NIL "~{~A~}" (or list '(NIL))) - there are ways to do it all just in the FORMAT of course, but that'd also be less readable.
  • Instead of the test bench you could also use a library.
  • CONVERT from vector to vector could just be using (copy-seq object)?
  • In the string to symbol conversion ELT on a string should probably be (char object 0).
  • I'm pretty sure ARRAY-TO-NESTED-LISTS and -VECTORS could be simplified and use less memory. Then again, these might not be used intentionally on big arrays anyway.
  • CONVERT to PROPER-LIST can be a bit simpler:

    (let* ((copy (copy-list object))
           (last (last copy))
           (cdr (cdr last)))
      (unless (listp cdr)
        (setf (cdr last) (list cdr)))
      copy))
    
  • The conversions to NUMBER should reuse some code, e.g.:

    (defun to-number (object)
      (let ((obj (read-from-string (princ-to-string object))))
        (if (numberp obj)
            obj
            (error "~A cannot be converted to a number." object))))
    

    For strings it would possibly a bit more costly.

Unexpected behaviour:

  • (convert 42 'character) raises an error while (convert 1 'character) doesn't. That's correct from the description of the other similar methods, but I'd also like a nicer error.
  • CONVERT to symbols uses INTERN without a target package, that's probably not so nice overall, I'd suggest a keyword argument (also in case other methods would need some options).
  • The conversion from string to vector is probably wanted, but also unexpected: A string is a vector after all.
  • CONVERT from string to symbol will depend a lot on the reader, ":foo" will be read as keyword :FOO (upper case), while "foo" will be read as regular symbol |foo| (lower case), which is a weird distinction.

Also some conversions are missing that should probably be there for completeness sake, like the rest of the numerical tower, DOUBLE-FLOAT, COMPLEX etc.?

Overall looks good to me, but it's also a difficult topic to get right IMO.

\$\endgroup\$
  • 1
    \$\begingroup\$ I'm always struck by how many ways there are to skin a common lisp cat. 'convert' was an interesting learning exercise, and I appreciate going deeper with your comments. Thanks for an insightful analysis. \$\endgroup\$ – davypough Aug 6 '17 at 15:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.