将强制扩展到其他合理的对象类型转换

Question

人工智能中的一个基本原则是，不同的问题表示可以帮助解决问题，也可以阻止解决。因此，在通用Lisp中编程时，能够很容易地切换数据表示形式可能会带来优势，特别是在快速原型开发过程中。一个常见的例子是将列表转换为向量对象表示(反之亦然)。在这种情况下，内置函数coerce提供适当的转换，以及其他一些可能有用的转换。然而，在通用Lisp中有许多合理的转换可能性，但内置函数没有涵盖这些可能性。对于那些与内置函数相对应的函数(比如intern，它可以从字符串转换为符号，具有副作用)，内建函数通常是多样化的，并且为了提高效率而高度专业化。这个库试图将许多对象类型转换合并为一个名为convert的函数，并将类型转换扩展到基线以外的许多其他对象。

取包含数字2、字符#\2、字符串"2“和符号x 2的一组对象。这里内置的转换函数包括character, string, symbol-name, find-symbol, intern, digit-char, parse-integer, format, read-from-string, princ-to-string, prin1-to-string, and coerce，更不用说简单的复制函数了。但是character -> number、symbol -> character和其他几个潜在的转换都不是直接可用的。要进行这样的转换，只需编写(convert #\2 'number) -> 2或(convert '|2| 'character) -> #\2可能比较方便。convert的通用模板在获取任意对象和结果规范时以coerce为模板。以下列出了可接受的结果规范。一个不同之处是，convert总是返回一个新对象，即使结果与参数对象的类型相同(当然，参数对象不可变时除外--即字符、数字或符号)。

在任何特定情况下，类型转换是否合理总是值得商榷的，但大多数合理的转换，以及一些相当深奥的转换，都是为了方便而提供的。在快速原型应用程序中，该库可能是最好的应用程序，在快速原型应用程序中，简单的类型转换可以方便实验和数据操作。效率不是主要的设计目标，因为目前主要的重点是准确性、一致性、实用性和覆盖面。还包括各种测试用例，这些测试用例可以通过对字符、数字、特定符号和长度为1的字符串之间的基本转换执行(convert-test-1)来运行，或者通过对一些更高级的转换执行(convert-test-2)来运行。测试结果输出到终端。

以下是库提供的可能转换的列表。这里列出的任何结果说明符(在右边)都可以作为convert的第二个参数。一般来说，不可能或奇怪的转换尝试应该会产生一个错误：

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

关于代码评审，有太多的方法需要单独检查，但是知道是否缺少有用的转换或返回非常规的结果会很有帮助。谢谢。

;;;; 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)))
         ))

Answer 1

是的，我得到了描述，在描述的情况下，它可能很有用，尽管我也会说，所有这些特殊的/单一的情况转换，比如PROPER-LIST、NESTED-LISTS和NESTED-VECTORS，都有点复杂。

• LIST-TO-STRING可能只是(format NIL "~{~A~}" (or list '(NIL))) --当然有一些方法可以在FORMAT中完成这一切，但这也会降低可读性。
• 您也可以使用一个库来代替测试工作台。
• CONVERT从一个向量到另一个向量，可能只是在使用(copy-seq object)吗？
• 在字符串到符号转换中，字符串上的ELT可能应该是(char object 0)。
• 我确信ARRAY-TO-NESTED-LISTS和-VECTORS可以简化，使用更少的内存。然而，无论如何，这些可能不会有意地在大数组上使用。
• CONVERT to PROPER-LIST可以稍微简单一点：(let* (复制(复制列表对象))(最后一次复制) (cdr (cdr最后一次))(除非(listp cdr) (setf (cdr最近) (list Cdr))拷贝)
• 对NUMBER的转换应该重用一些代码，例如：(defun (object) (let (从字符串读取(princ- to对象) (if (number- obj) obj (错误“A不能转换为数字”)。))对于字符串，它可能会花费更多的钱。

意外行为：

• (convert 42 'character)会引发一个错误，而(convert 1 'character)不会。这从其他类似方法的描述中是正确的，但我也希望有一个更好的错误。
• CONVERT to符号使用的是没有目标包的INTERN，总体上可能不太好，我建议使用关键字参数(如果其他方法需要一些选项的话)。
• 从字符串到向量的转换可能是需要的，但也是出乎意料的:字符串毕竟是一个向量。
• 从字符串到符号的CONVERT将在很大程度上取决于读取器，":foo"将被读取为关键字:FOO (大写)，而"foo"将被读取为常规符号|foo| (小写)，这是一个奇怪的区别。

另外，为了完整起见，也缺少了一些转换，比如其他的数字塔、DOUBLE-FLOAT、COMPLEX等等？

总的来说，我看上去不错，但这也是一个很难搞清楚的话题。