在 Lisp 中实现有趣的编码方法

Implementing Interesting Encoding Method in Lisp

前言

我正在为旅行商问题实施遗传算法。我正在做一些基线假设,例如您可以从任何城市前往任何城市。虽然这是一项任务,但由于截止日期已过,我已将其扩展到个人项目,并且我选择使用 Lisp,这绝对不是必需的。以下面列出的这种方式对我的数据进行编码的目的是为了稍后在算法中轻松执行交叉。

问题

假设你有一个城市列表,给出类似于以下内容

(defvar *data* (list
               '(A 20 10)
               '(B 5  16)
               '(C 12 18)
               '(D x  y)
               '(E x  y)
               ...

我想以类似于此的方式对这些数据进行编码:

我一辈子都想不出如何在 Lisp 中实现它。如果有人有一些见解,将不胜感激。如果有更好的方法来创建我的 *data* 集,可以更轻松地加入它!

现在我明白了。这是解决方案:

(defparameter *data* (list
                     '(A 20 10)
                     '(B 5 16)
                     '(C 12 18)
                     '(D x y)
                     '(E x y)))

您需要一个函数来查找城市在城市列表 (*data*) 中的索引位置,并删除其在城市列表中的条目和更新后的 returns城市列表。

(defun choose-city (city-list city-name)
  "Return city-name with its index position
  and city-list with the chosen city removed, keeping the order."
  (let* ((cities (mapcar #'car city-list))
         (pos (position city-name cities)))
    (list city-name 
          pos 
          (append (subseq city-list 0 pos)
                  (subseq city-list (+ pos 1) (length city-list))))))

;; improved version by @Kaz - thanks! (lispier)
(defun choose-city (city-list city-name)
  (list city-name 
        (positiion city-name city-list :key #'car :test #'eql)
        (remove city-name city-list :key #'car :test #'eql)))

然后,你需要一个应用前一个函数的函数 一遍又一遍地收集索引位置,并通过删除 city-sequence 中匹配的 current-city 逐步更新 city-list。 在 lisp 中出现的典型模式是 将待变异变量定义为 let 表达式中的局部变量,并从 let 表达式的主体中使用 setf (setf-ing) 更新变量值.

(defun choose-cities-subsequently (city-list city-sequence)
  "Return sequence of subsequent-index-positions of the cities
  given in city-sequence. After choosing a sequence, the city is
  removed from the city-list and its index position of the previous
  pool taken for record."
  (let ((index-positions '()) ; initiate collector variable
        (current-city-list city-list)) ; current state of city-list
    (loop for current-city in city-sequence
          do (progn
               ;; call `choose-city` and capture its results
               (destructuring-bind 
                 (name index new-city-list) ; capturing vars
                 ;; and in the following the function call:
                 (choose-city current-city-list current-city) 
                 ;; update collector variable and 
                 ;; current-city-list using the captured values
                 (setf index-positions (cons index index-positions))
                 (setf current-city-list new-city-list)))
          ;; if city-sequence processed in this way, 
          ;; return the collected index-positions.
          ;; remark: cons-ing during collecting and 
          ;; at the end nreverse-ing the result
          ;; when/while returning 
          ;; is a very typical lisp idiom 
          finally (return (nreverse index-positions)))))

;; improved version by @Kaz - thanks!
(defun choose-cities-subsequently (city-list city-sequence)
  (let ((index-positions '()) ; initiate collector variable
        (current-city-list city-list)) ; current state of city-list
    (loop for current-city in city-sequence
          collect (destructuring-bind 
              (name index new-city-list) 
              (choose-city current-city-list current-city) 
                    (setf current-city-list new-city-list)
                    index)
        into index-positions
      finally (return index-positions)))))

现在,如果你 运行

(choose-cities-subsequently *data* '(A D E B C))

它 returns 正确:

(0 2 2 0 0)

通过在最后一个函数中定义更多 let 变量和 setf-fing 到 destructuring-bind 表达式主体中的那些,并返回最终列表中的最终值, 您可以收集更多信息并使它们可见。

试图简化一点递归定义

(defparameter *data* (list
                     '(A 20 10)
                     '(B 5 16)
                     '(C 12 18)
                     '(D x y)
                     '(E x y)))

(defun choose-city (city-list city-name)
  (list (position city-name city-list :key #'car :test #'eql)
        (remove city-name city-list :key #'car :test #'eql)))
;; when city names are strings use `:test #'string=

(defun choose-cities-subsequently (city-list city-sequence)
  (let ((current-cities city-list))
    (loop for current-city in city-sequence
          for (idx updated-cities) = (choose-city current-cities current-city)
          collect (progn (setf current-cities updated-cities)
                         idx)
            into index-positions
          finally (return index-positions))))

(choose-cities-subsequently *cities* '(A D E B C))
;; (0 2 2 0 0)

;; a tail-call recursive version:
(defun choose-cities-subsequently (cities city-sequence 
                                   &key (acc-cities '()) 
                                        (acc-positions '())
                                        (pos-counter 0)
                                        (test #'eql))
    (cond ((or (null city-sequence) (null cities)) (nreverse acc-positions))
          ((funcall test (car city-sequence) (car cities))
           (choose-cities-subsequently (append (nreverse acc-cities) (cdr cities))
                                       (cdr city-sequence)
                                       :acc-cities '()
                                       :acc-positions (cons pos-counter acc-positions)
                                       :pos-counter 0
                                       :test test))
          (t (choose-cities-subsequently (cdr cities)
                                         city-sequence
                                         :acc-cities (cons (car cities) acc-cities)
                                         :acc-positions acc-positions
                                         :pos-counter (1+ pos-counter)
                                         :test test))))