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

时间:2020-02-13 17:29:05

标签: lisp common-lisp

前言

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

问题

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

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

我想以类似于以下方式的方式对此数据进行编码: City encoding method

而我一生都无法弄清楚如何在Lisp中实现这一点。如果有人有见识,将不胜感激。如果有更好的方法来创建我的*data*集,可以更轻松地添加它!

1 个答案:

答案 0 :(得分:3)

现在我明白了。解决方法如下:

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

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

(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-list中删除匹配的current-city来逐步更新city-sequence。 在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))

它正确返回:

(0 2 2 0 0)

通过在最后一个函数中定义更多let变量, setf-指向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))))
相关问题