Этот ... Лисп , Ученая блоха

Люди добрые, помогите пожалуйста с лиспом!!!
"Ученая блоха"
Дан квадрат размером n*n, в клетки которого вписаны числа от 1 до 9. По клеткам квадрата прыгает ученая блоха, причем, прыжки она делает строго подчиняясь следующим правилам.
-- Блоха никогда не прыгает за пределы квадрата
-- с клетки, в которую вписано число k блоха прыгает ровно на k клеток по вертикали или горизонтали
На входе блохе даны размер квадрата, матрица дальностей прыжков, начальная позиция, позиция завтрака.

Написать программу, в которой блоха по заданному квадрату допрыгает до завтрака.

Пока для себя ставлю задачу найти все возможные пути.
В роде бы она сначала првильные давала ответы, а потом чего-то начала зависать, причем непонятно как, так что знаменитая фраза "или я или машина", переполнение стека не считается за косяк!!!
Вот как я решал:
Примечание вы не смотрите, что страшная рекурсия, это нам так надо!!!
Кто возьмется проверять, начинайте с (TS)

Цитата

(trace solve)
(defun solve (n m break cursolve solves queue branches)
(cond ((null queue) (cond ((equal break (car cursolve)) (append solves (list (reverse cursolve))))
(t solves)
)
)
((eq '0 (car branches))
(cond ((equal break (car cursolve))
(solve n m break (cdr cursolve)
(append solves (list (reverse cursolve)))
queue (cdr branches)
)
)
(t (solve n m break (cdr cursolve)
solves queue (cdr branches)
)
)
)
)

(t ((lambda (new_stream)
(solve n m break (cons (car queue) cursolve) solves (append new_stream (cdr queue))
(cons (length new_stream)
(dec_head branches)
)
)
) (cond ((equal (car queue) break) nil)
(t (neighbours n cursolve (car queue) (new_index (car queue) m)))
)
)
)
)
)

(defun dec_head (lst)
(cond ((null lst) nil)
(t (cons (1- (car lst)) (cdr lst)))
)
)

(defun neighbours (n cursolve curpos index)
(good_neighbours n (list (addx curpos index) (addy curpos index)
(subx curpos index) (suby curpos index))
'() cursolve)
)

(defun good_neighbours (n candidates result cursolve)

(cond ((null candidates) result)
((member_d (car candidates) cursolve)
(good_neighbours n (cdr candidates) result cursolve)
)
(t ((lambda (x y)
(cond ((or (> x n) (< x 1) (> y n) (< y 1))
(good_neighbours n (cdr candidates) result cursolve))
(t (good_neighbours n (cdr candidates) (cons (car candidates) result) cursolve))
)
)(caar candidates) (cdar candidates)
)
)
)
)
(defun member_d (curpos cursolve)
(cond ((null cursolve) nil)
((equal curpos (car cursolve)) T)
(t (member_d curpos (cdr cursolve)))
)
)
;---------------------------------------
;Add and sub functions

(defun addx (pos index)
(cons (+ (car pos) index) (cdr pos))
)
(defun subx (pos index)
(cons (- (car pos) index) (cdr pos))
)
(defun addy (pos index)
(cons (car pos) (+ (cdr pos) index))
)
(defun suby (pos index)
(cons (car pos) (- (cdr pos) index))
)
;----------------------------------------

;Function returns new distance of the jump
(defun new_index (curpos m)
(nth (1- (cdr curpos)) (nth (1- (car curpos)) m))
)

;MAIN FUNCTION WITH WHICH MUST BE STARTED PROGRAM
(defun main(m curpos break)
(lambda (solves)
(cond ((null solves) nil)
(t (list solves
(least_jumps (cdr solves) (car solves) (length (car solves)))
(least_dist (cdr solves) (car solves) (ld (cadr solves) (caar solve) '0))
)
)
)
)
(solve (length m) m curpos break curpos '())
)
;Function returns Least distance by which bloha can reach its breakfast
(defun least_dist (solves cur_solut ld_s)
(cond ((null solves) cur_solut)
(t ((lambda (cur_ld_s)
(cond ((< cur_ld_s ld_s) (least_dist (cdr solves) (car solves) cur_ld_s))
(t (least_dist (cdr solves) cur_solut ld_s))
)
)(ld (cdar solves) (caar solves) '0))
)
)
)
; Function which calculates distance for current solution
(defun ld (solve last_step amount)
(cond ((null solve) amount)
((eq (caar solve) (car last_step))
(ld (cdr solve) (car solve) (+(abs(- (cdar solve)
(cdr last_step)
)
)
amount)
) )
(t (ld (cdr solve) (car solve) (+ (abs(- (caar solve)
(car last_step)
)
)
amount)
) )
)
)

;Function which searches solution with the least amount of jumps
(defun least_jumps (solves cur_solve l_jumps)
(cond ((null solves) cur_solve)
(t ((lambda (njumps)
(cond ((< njumps l_jumps) (least_jumps (cdr solves) (car solves) njumps))
(t (least_jumps (cdr solves) cur_solve l_jumps))
)
) (1- (length (car solves)))
)
)
)
)

(defun ts ()
(first_run '2 '((1 1)
(1 1)
) '(1 . 1) '(2 . 2))
)

(defun first_run (n m curpos break)
(solve n m break '() '() (list curpos) '(1))
)

И еще вопрос у меня XLISP 1996 года, у кого нибудь есть покруче вещь?
Также выслушаю все рекомендации в адрес всей программы

Под Windows хорошо работает LispWorks (www.lispworks.com). Под Linux -
см. www.cliki.net/Common%20Lisp%20Implementations.

Несколько мелких замечаний к программе:

1. Не хватает комментария - что делает функция SOLVE. Например:

"N - размер доски, M - матрица расстояний, BREAK - координаты
завтрака. Координаты ячеек, который уже посетила блоха, лежат в
обратном порядке в списке CURSOLVE; первая ячейка в нем - текущее
положение блохи. Аргумент QUEUE - список ..., BRANCHES - .... Функция
ищет все ациклические продолжения текущего пути [такие, что первый
прыжок совершается в одну из ячеек из QUEUE???] и добавляет найденные
пути от исходной точки к списку SOLVES."

2. Мне кажется, что матрицу было бы естественнее хранить в двумерном
массиве.

3. Достаньте текстовый редактор, автоматически выравнивающий текст.
Например, GOOD_NEIGHBOURS лучше оформить так:

(defun good_neighbours (n candidates result cursolve)
  (cond ((null candidates) result)
        ((member_d (car candidates) cursolve)
         (good_neighbours n (cdr candidates) result cursolve))
        (t ((lambda (x y)
              (cond ((or (> x n) (< x 1) (> y n) (< y 1))
                     (good_neighbours n (cdr candidates) result cursolve))
                    (t
                     (good_neighbours n (cdr candidates) (cons (car candidates) result) cursolve))))
            (caar candidates) (cdar candidates)))))

(надеюсь, что сайт все не испортит)

4. Последняя LAMBDA выглядит просто ужасно - имена X и Y находятся
слишком далеко от их определений. Лучше использовать LET:

(defun good_neighbours (n candidates result cursolve)
  (cond ((null candidates) result)
        ((member_d (car candidates) cursolve)
         (good_neighbours n (cdr candidates) result cursolve))
        (t (let ((x (caar candidates))
                 (y (cdar candidates)))
             (cond ((or (> x n) (< x 1) (> y n) (< y 1))
                    (good_neighbours n (cdr candidates) result cursolve))
                   (t
                    (good_neighbours n (cdr candidates) (cons (car candidates) result) cursolve)))))))

5. Не надо засорять аргументы функции ее внутренними переменными;
используейте локальные функции или необязательные параметры:

(defun good_neighbours (n candidates cursolve &optional (result '()))
  (cond ((null candidates) result)
        ((member_d (car candidates) cursolve)
         (good_neighbours n (cdr candidates) cursolve result))
        (t (let ((x (caar candidates))
                 (y (cdar candidates)))
             (cond ((or (> x n) (< x 1) (> y n) (< y 1))
                    (good_neighbours n (cdr candidates) cursolve result))
                   (t
                    (good_neighbours n (cdr candidates) cursolve (cons (car candidates) result))))))))

При вызове снаружи: (good_neighbours n (list ...) cursolve)

6. Рекурсию, где это возможно, стоит заменять стандартными функционалами:

(defun good_neighbours (n candidates cursolve)
  (remove-if (lambda (pos)
               (or (member_d pos cursolve)
                   (let ((x (car pos))
                         (y (cdr pos)))
                     (or (> x n) (< x 1) (> y n) (< y 1)))))
             candidates))
 
(defun member_d (curpos cursolve)
  (member curpos cursolve :test #'equal))

Цитата

www.cliki.net/Common%20Lisp%20implementations

Oops, http://www.cliki.net/Common%20Lisp%20implementation

Alexey Dejneka
Рад, что ты откликнулся!!! , но все же программа циклица из-за полохого интерпритатора или из-за глупого решения?

Текст на самом деле был выровнен, как ты мне сказал, но, почему то передалось в такой форме, которой ты видишь.
А функциями я пользуюсь по мере того, как нам их давали.
К примеру нам не давали, let, а все новшества, препод считает как несамостоятельно сделанную работу.
А

Цитата

(member curpos cursolve :test #'equal))

я вообще не знаю

Ну все равно спасибо!!!

Но вопрос, работает моя прога или нет остается открытым

На каких входных данных она зацикливается? И все-таки хотелось бы увидеть описание функции SOLVE.

Цитата

Текст на самом деле был выровнен, как ты мне сказал, но, почему то передалось в такой форме, которой ты видишь.

Закрывающие скобки сами выскочили на отдельные строки ?:-)
В следующий раз попробуй окружить код тегами code и /code в квадратных скобках.

Я как видно выбрал поиск в глубину, хотя вчера один товарищ сказал, что для циклического графа лучше использовать поиск в ширину. Это правда?

Насчет описания

Цитата

N - размер доски, M - матрица расстояний, BREAK - координаты
завтрака. Координаты ячеек, который уже посетила блоха, лежат в
обратном порядке в списке CURSOLVE; первая ячейка в нем - текущее
положение блохи. Solves - это все решения, найденные на текущий момент
Аргумент QUEUE - список координат, по которым блохе предстоит попрыгать.
BRANCHES - (ветви (сложно объяснить)) список, элементы которого говорят о том, сколько вершин еще непройдено. Функция
ищет все ациклические продолжения текущего пути [такие, что
прыжки совершается в одну из ячеек из QUEUE, а если продолжения из текущей позиции нет, то отходим на одну назад] и добавляет найденные
пути от исходной точки к списку SOLVES

(defun solve (n m break cursolve solves queue branches)
    (cond ((null queue) (cond ((equal break (car cursolve)) (append solves (list (reverse cursolve))))
                              (t solves)
          )             )
          ((eq '0 (car branches))
                (cond ((equal break (car cursolve))
                            (solve n m break (cdr cursolve)
                                  (append solves (list (reverse cursolve)))
                                   queue (cdr branches)
                            )
                      )
                      (t (solve n m break (cdr cursolve)
                                solves queue (cdr branches)
                         )
                      )
                 )
          )
          ((equal break (car cursolve))
                            (solve n m break (cdr cursolve)
                                  (append solves (list (reverse cursolve)))
                                   queue (dec_head branches)
                            )
          )
          
          (t ((lambda (new_stream)
                  (cond ((null new_stream)
                               (solve n m break (cons (car queue) cursolve) solves (cdr queue)
                                      (cons '0 (dec_head branches))
                               )
                        )
                        (t (solve n m break (cons (car queue) cursolve) solves (append new_stream (cdr queue))
                                     (cons (length new_stream)
                                           (dec_head branches)
                                      
                           )         )
                        )
                  )
              ) (cond ((equal (car queue) break) nil)
                      (t (neighbours n cursolve (car queue) (new_index (car queue) m)))
                )
             )
          )
    )
)
 
(defun dec_head (lst)
    (cond ((null lst) nil)
          (t (cons (1- (car lst)) (cdr lst)))
    )
)
 
(defun neighbours (n cursolve curpos index)
    (good_neighbours n (list (addx curpos index) (addy curpos index)
                             (subx curpos index) (suby curpos index))
                     '() cursolve)
)
 
(defun good_neighbours (n candidates result cursolve)
 
    (cond ((null candidates) result)
          ((member_d (car candidates) cursolve)
              (good_neighbours n (cdr candidates) result cursolve)
          )
          (t ((lambda (x y)
                   (cond ((or (> x n) (< x 1) (> y n) (< y 1))
                          (good_neighbours n (cdr candidates) result cursolve))
                         (t (good_neighbours n (cdr candidates) (cons (car candidates) result) cursolve))
                   )
              )(caar candidates) (cdar candidates)
             )
          )
    )
)
(defun member_d (curpos cursolve)
    (cond ((null cursolve) nil)
          ((equal curpos (car cursolve)) T)
          (t (member_d curpos (cdr cursolve)))
    )
)
;---------------------------------------
;Add and sub functions
 
(defun addx (pos index)
    (cons (+ (car pos) index) (cdr pos))
)
(defun subx (pos index)
    (cons (- (car pos) index) (cdr pos))
)
(defun addy (pos index)
    (cons (car pos) (+ (cdr pos) index))
)
(defun suby (pos index)
    (cons (car pos) (- (cdr pos) index))
)
;----------------------------------------
 
;Function returns new distance of the jump
(defun new_index (curpos m)
    (nth (1- (cdr curpos)) (nth (1- (car curpos)) m))
)
 
;MAIN FUNCTION WITH WHICH MUST BE STARTED PROGRAM
(defun main(n m curpos break)
    ((lambda (solves)
         (cond ((null solves) '(I cannot eat my breakfast))
               (t (list (append '(All the ways:) solves)
                        (least_jumps (cdr solves) (car solves) (1- (length (car solves))))
                        (least_dist (cdr solves) (car solves) (ld (cdar solves) (caar solves) '0))
                  )
               )
         )
     )(solve n m break '() '() (list curpos) '(1))
    )
)
;Function returns Least distance by which bloha can reach its breakfast
(defun least_dist (solves cur_solut ld_s)
    (cond ((null solves) (append (append '(The way with the least distance:) (list cur_solut)) (append '(With distance) (list ld_s))))
          (t ((lambda (cur_ld_s)
                  (cond ((< cur_ld_s ld_s) (least_dist (cdr solves) (car solves) cur_ld_s))
                        (t (least_dist (cdr solves) cur_solut ld_s))
                  )
             )(ld (cdar solves) (caar solves) '0))
           )
    )
)
; Function which calculates distance for current solution
(defun ld (solve last_step amount)
    (cond ((null solve) amount)
          ((eq (caar solve) (car last_step))
               (ld (cdr solve) (car solve) (+(abs(- (cdar solve)
                                                    (cdr last_step)
                                                 )  
                                             )
                                             amount)
          )    )
          (t (ld (cdr solve) (car solve) (+ (abs(- (caar solve)
                                                   (car last_step)
                                                )
                                            )
                                            amount)
          )  )
    )
)
 
;Function which searches solution with the least amount of jumps
(defun least_jumps (solves cur_solve l_jumps)
    (cond ((null solves) (append (append '(The way with the least jumps:) (list cur_solve)) (append '(With jumps) (list l_jumps))))
          (t ((lambda (njumps)
                 (cond ((< njumps l_jumps) (least_jumps (cdr solves) (car solves) njumps))
                       (t (least_jumps (cdr solves) cur_solve l_jumps))
                 )
              ) (1- (length (car solves)))
             )
          )  
    )
)
 
(defun ts ()
    (first_run '2 '((1 1) (1 1)) '(1 . 1) '(2 . 2))
)
 
(defun first_run (n m curpos break)
        (main n m curpos break)
)

Зацикливается на самой безобидной функции memeber_d. Да и то смотря при каких входных данных (входные данные корректны, но разные), вроде бы доже из функции выходит, но потом выдает всякую ересь, или зацикливается без трассировки, просто стоит на месте.
Как то подозрительно? Еще, если в матрице менять индексы, и завтраки с начальными позициями менять, то всякие #<Foo: #3635644564564564564> вылазят вместо переданных, допустим, ((2 . 2))

Запусти TS

Еще раз благодарю за уделение мне времени.

Цитата

Я как видно выбрал поиск в глубину, хотя вчера один товарищ сказал, что для циклического графа лучше использовать поиск в ширину. Это правда?

Я думаю, что, пока ищутся ациклические пути, это не имеет значения.

Цитата

Аргумент QUEUE - список координат, по которым блохе предстоит попрыгать.

Не верю! Кстати, с продолжениями текущего пути я тоже не угадал.

Насчет зацикливания.
Сейчас попробовал запустить по старым XLisp под DOS, действительно, на матрице 3x3 падает. Под SBCL 0.9.7 и CLISP 2.33 все работает чисто. Скорее всего, XLisp-у просто не хватает ресурсов; возможно, он не умеет оптимизировать концевую рекурсию. Попробуй запустить под LispWorks.

Я вижу ты хороший человек
1. Слухай, ты что фан Лиспа? Или собираешься разрабатывать аналитические ситемы и ИИ?

2.

Цитата

Не верю!

Как это не верю, если я писал, то как не верить автору?

3.

Цитата

Насчет зацикливания.
Сейчас попробовал запустить по старым XLisp под DOS, действительно, на матрице 3x3 падает. Под SBCL 0.9.7 и CLISP 2.33 все работает чисто.

Это ты насчет solve или даже main проверил?

P. S. Если будут интересные задачки пиши, разберемся вместе!!! Я кажется начал врубаться в Лисп!!! И мне стало очень интересно.

P. P. S. Это ты мне помог с задачей all-permutations?

Добавлено 16.12.05, 08:03
1. Кстати я сам написал (defun dec_head ...), но кажется, что уж больно тупая, нельзя ли как нибудь проще?
2. Пришлось писать самому функцию (defun member_d ...), т. к. не работает (member) для вложенных списков, почему? Моё подозрение, что в member заложена проверка с помощью eq, и видимо не прокатывает, а если как в моем случае equal, то все пучком.

Еще раз спасибо!!!

Кстати Alexey Dejneka, не подскажешь как сделать оценку сложности программы?
Мои подозрения, что в роде 2*n(n!*n!), ну, так по Окулову в одной из задачек.

Цитата

ты что фан Лиспа?

Есть немного :-)

Цитата

Как это не верю, если я писал, то как не верить автору?

Легко: в начале ты задаешь QUEUE почти пустым, а прыгать еще долго...

Цитата

даже main проверил?

Если в первой версии main функцию SOLVE запускать так:

(solve (length m) m break () () (list curpos) '(1))

то, вроде, работает.

Цитата

Моё подозрение, что в member заложена проверка с помощью eq

В диалекте Common Lisp все (почти) проверки по умолчанию производятся с помощью EQL (проверка на идентичность объектов). Если нужны проверки на "похожесть" - это нужно явно указывать. Например, в ключевом аргументе :TEST :-).

Цитата

Если будут интересные задачки пиши, разберемся вместе!!!

На www.cliki.net полно ссылок на свободные проекты, от операционных
систем до систем автоматизированного доказательства теорем; во многих
есть интересные задачи.

1.

Цитата

Легко: в начале ты задаешь QUEUE почти пустым, а прыгать еще долго...

Так я же потом буду расширять её!!! Записываю в очередь "хороших соседей".

2. Это ты мне помог с задачей all-permutations?

3.

Цитата

1. Кстати я сам написал (defun dec_head ...), но кажется, что уж больно тупая, нельзя ли как нибудь проще?
Еще раз спасибо!!!

Цитата

Кстати Alexey Dejneka, не подскажешь как сделать оценку сложности программы?
Мои подозрения, что в роде 2*n(n!*n!), ну, так по Окулову в одной из задачек.

Добавлено 16.12.05, 14:56
Рекомендую зарегайся!!!

Цитата

Аргумент QUEUE - список координат, по которым блохе предстоит попрыгать.

Все-таки, нет. Я попробовал другой вариант, без счетчиков:

(defun solve (n m break cursolve solves queue)
  (cond ((null queue)
         (cond ((equal break (car cursolve)) (append solves (list (reverse cursolve))))
               (t solves)))
        ((null (car queue))
         (solve n m break (cdr cursolve)
                (cond ((equal break (car cursolve))
                       (append solves (list (reverse cursolve))))
                      (t solves))
                (cdr queue)))
        (t (let ((new_stream  (cond ((equal (caar queue) break) nil)
                                    (t (neighbours n cursolve (caar queue) (new_index (caar queue) m))))))
             (solve n m break (cons (caar queue) cursolve) solves
                    (cons new_stream (cons (cdar queue) (cdr queue))))))))
(defun first_run (n m curpos break)
  (solve n m break '() '() (list (list curpos))))

Здесь каждой вершине из CURSOLVE соответствует один элемент QUEUE - список вершин; блоха начинает прыгать по вершинам из CURSOLVE, но в любой момент может свернуть (в частности, когда CURSOLVE кончится), при этом сойти она может лишь в одну из указанных вершин из списка QUEUE. Например, CURSOLVE=(A B), QUEUE=((A1 A2) (B1 B2) ©); допустимы пути B-A-A1-что-угодно (сошла после BA, последняя точка заданного пути - A), B-A-A2-..., B-B1-..., B-B2-..., C-.... В твоем варианте список QUEUE разглаживается и добавляется список BRANCHES, указывающий количество элементов в каждой группе.

Цитата

Это ты мне помог с задачей all-permutations?

Принимал участие.

Цитата

Кстати я сам написал (defun dec_head ...), но кажется, что уж больно тупая, нельзя ли как нибудь проще?

Через элементарные функции - вроде нет. Можно использовать обратную кавычку или модификацию списка. Ну, и проверка на непустоту - лишняя.

(defun dec-head (list)
  `(,(1- (car list)) ,@(cdr list)))
 
(defun dec-head (lst)
  (decf (car lst))
  lst)

Цитата

как сделать оценку сложности программы?

Не знаю. Ничего, кроме очевидной верхней оценки - 3^(n^2) (идем на все четыре стороны, кроме той, откуда пришли) и очевидной нижней $С_(2n)^n$ (количество монотонных путей в квадрате из левого верхнего угла в правый нижний) в голову не приходит.

Сообщение отредактировано: Alexey Dejneka - 16.12.05, 16:25

Цитата

Все-таки, нет. Я попробовал другой вариант, без счетчиков:

Я тебе скажу, тоже пришло в голову в queue делать список списков, но потом честно сказать заломало
А в голове зрел такой же метод решения.

Цитата

Принимал участие.

Еще раз большое спасибо

Цитата

Не знаю. Ничего, кроме очевидной верхней оценки - 3^(n^2) (идем на все четыре стороны, кроме той, откуда пришли) и очевидной нижней $С_(2n)^n$ (количество монотонных путей в квадрате из левого верхнего угла в правый нижний) в голову не приходит.

Интересная логика, еще раз спасибо. (Надеюсь спасибаться не достал)

Отличный ты парень все таки, была б моя воля 10 очков тебе дал.

Еще мона получить твои анкетные данные (для интереса интереса):
1. Город, где живешь
2. Окончил или учишься какой/в каком университете
3. Какие еще языки знаешь
4. Учавствуешь в олимпиадах по программированию (если да то в каких)
5. Со скольки лет с компом не растаешься
6. Сколько времени посвящаешь этому ящику?
7.

if (6. >= 6)
    printf("Какое у тебя зрение?")

if (4. == true)
    goto topcoder.com;

Спасибо!!! Ты настоящий друг!!!