Реализация интересного метода кодирования в Лиспе - PullRequest
Новая
       3

Реализация интересного метода кодирования в Лиспе

1 голос
/ 13 февраля 2020

Предисловие

Я работаю над реализацией алгоритма Geneti c для задачи коммивояжера. Я предполагаю, что вы можете отправиться в любой город из любого города. В то время как это для задания, я распространил это на личный проект, поскольку крайний срок истек, и я решил использовать Lisp, который определенно не требовался. Точка кодирования моих данных, указанная ниже, заключается в том, чтобы позже легко выполнить кроссинговер в алгоритме.

Задача

Предположим, у вас есть список городов, приведенный примерно так: 

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

Я хочу закодировать эти данные следующим образом: City encoding method

, и я до сих пор не могу понять, как это реализовать в Лисп. Если у кого-то есть понимание, это будет высоко ценится. Если есть лучший способ создать мой набор *data*, который бы облегчил его включение,

1 Ответ

3 голосов
/ 14 февраля 2020

Теперь я понял это. Вот решение: 

(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))))
...