0

出于快速原型设计的目的，我想开始构建 Common Lisp 中提供的一些基本函数的通用版本库，而不是仅仅为手头的任务收集（或导入）特殊用途的函数。例如，该map函数适度泛化以对任何类型的序列进行操作，但不处理可调整向量。编写下面的特殊用途扩展似乎足以满足当前使用，但仍然有限：

(defun map-adjustable-vector (function adjustable-vector)
  "Provides mapping across items in an adjustable vector."
  (let ((new-adj-vec 
          (make-array (array-total-size adjustable-vector)
                        :element-type (array-element-type adjustable-vector)
                        :adjustable t
                        :fill-pointer (fill-pointer adjustable-vector))))
    (dotimes (i (array-total-size adjustable-vector))
      (setf (aref new-adj-vec i) (funcall function (aref adjustable-vector i))))
    new-adj-vec))

我想看到的是如何编写这样的函数，该函数还需要一个输出类型规范（包括一个新的“可调整向量类型”）并允许多种列表和向量作为输入——换句话说，模式化之后map。

更广泛地说，了解是否有与编写此类通用函数相关的基本原则或想法会很有用。例如，专门针对输出类型规范的通用方法是否是上述功能的可行方法？或者，也许，可以在泛化中利用自身，如前一篇文章映射到嵌套序列树中的mapcoredump 所示？我不知道泛化是否有任何限制（除了一定的低效率），但我想看看它能走多远。

4

1 回答 1

0

在这种情况下，map可以考虑使用make-sequence来创建结果序列。

但是，您的问题太宽泛了，任何答案基本上都是一种意见。你可以做任何你想做的事情，但本质上，最直接的方法是扩展序列类型参数以包含具有填充指针和/或可调整的向量：

;;; For use by the following deftype only
(defun my-vector-typep (obj &key (adjustable '*) (fill-pointer '*))
  (and (or (eql adjustable '*)
           ;; (xor adjustable (adjustable-array-p obj))
           (if adjustable
               (adjustable-array-p obj)
               (not (adjustable-array-p obj))))
       (or (eql fill-pointer '*)
           (if (null fill-pointer)
               (not (array-has-fill-pointer-p obj))
               (and (array-has-fill-pointer-p obj)
                    (or (eql fill-pointer t)
                        (eql fill-pointer (fill-pointer obj))))))))

;;; A type whose purpose is to describe vectors
;;; with fill pointers and/or that are adjustable.
;;; 
;;; element-type and size are the same as in the type vector
;;; adjustable is a generalized boolean, or *
;;; fill-pointer is a valid fill pointer, or t or nil, or *
(deftype my-vector (&key element-type size adjustable fill-pointer)
  (if (and (eql adjustable '*) (eql fill-pointer '*))
      `(vector element-type size)
      ;; TODO: memoize combinations of adjustable = true/false/* and fill-pointer = t/nil/*
      (let ((function-name (gensym (symbol-name 'my-vector-p))))
        (setf (symbol-function function-name)
              #'(lambda (obj)
                  (my-vector-p obj :adjustable adjustable :fill-pointer fill-pointer)))
        `(and (vector ,element-type ,size)
              (satisfies ,function-name)))))

(defun my-make-sequence (resulting-sequence-type size &key initial-element)
  (when (eql resulting-sequence-type 'my-vector)
    (setf resulting-sequence-type '(my-vector)))
  (if (and (consp resulting-sequence-type)
           (eql (first resulting-sequence-type) 'my-vector))
      (destructuring-bind (&key (element-type '*) (type-size '* :size) (adjustable '*) (fill-pointer '*))
          (rest resulting-sequence-type)
        (assert (or (eql type-size '*) (<= size type-size)))
        (make-array (if (eql type-size '*) size type-size)
                    :element-type (if (eql element-type '*) t element-type)
                    :initial-element initial-element
                    :adjustable (if (eql adjustable '*) nil adjustable)
                    :fill-pointer (if (eql fill-pointer '*) nil fill-pointer)))
      (make-sequence resulting-sequence-type size
                     :initial-element initial-element)))

;; > (my-make-sequence '(my-vector :adjustable t) 10)

(defun my-map (resulting-sequence-type function &rest sequences)
  (apply #'map-into
         (my-make-sequence resulting-sequence-type
                           (if (null sequences)
                               0
                               (reduce #'min (rest sequences)
                                       :key #'length
                                       :initial-value (length (first sequence))))
         function
         sequences)))

;; > (my-map '(my-vector :adjustable t) #'+ '(1 2 3) '(3 2 1))

还有许多其他选择，例如简单地显式提供目标序列map-into（已排序，可能使用树；如果它的元素很少，可能使用 conses）并且可以返回任何类型的序列。

真的，这是一个开放式问题，主要取决于您的需求和/或想象力。

于 2017-03-10T00:54:21.833 回答