Форум программистов, компьютерный форум, киберфорум
Наши страницы
Lisp
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
Lambdik
1043 / 937 / 107
Регистрация: 04.11.2012
Сообщений: 971
Записей в блоге: 3
1

Императивный алгоритм

12.04.2013, 22:49. Просмотров 918. Ответов 12
Метки нет (Все метки)

Увеличить на единицу каждое число многоуровневого списка.
Пример, когда список линейный.
Lisp
1
2
3
4
5
6
7
8
9
10
(defun plus1 (lst)
  (prog (acc)
  a (cond ((null lst) (return acc)))
    (setq acc (append acc (list (+ 1 (car lst)))))
    (setq lst (cdr lst))
   (go a)))
 
(plus1 '(0 1 2 3 4))
 
==> (1 2 3 4 5)
А если так:

Lisp
1
> (plus1 '(0 (1 (2)) ((3) 4)))
Можно ли решить в императивном стиле, либо с применением циклов?
Или только рекурсия?
1
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
12.04.2013, 22:49
Ответы с готовыми решениями:

Переписать код с Лиспа на императивный язык: Вычисление двойного интеграла
Есть код (если я правильно узнал язык) на Лиспе, описывающий вычисление двойного интеграла методом...

Декларативный и Императивный язык - в чём разница?
В чём разница между декларативными и императивными языками программирования? Википедия ответа не...

Нужен алгоритм поиска пути в этом лабиринте (будь то волновой алгоритм или алгоритм правой/левой руки )
#include "stdafx.h" #include <iostream> #include <conio.h> using namespace std; void lab...

Волновой алгоритм поиска (Алгоритм A* / Алгоритм А стар)
Хочу разработать алгоритм для решения головоломки с подвижными дисками (перестановочная...

Линейный алгоритм, Алгоритм с ветвлениями, Циклический алгоритм Линейный алгоритм
Линейный алгоритм, Алгоритм с ветвлениями, Циклический алгоритм Линейный алгоритм 1. Объясни, что...

12
_sg
4098 / 3848 / 289
Регистрация: 12.05.2012
Сообщений: 2,707
13.04.2013, 00:06 2
Lisp
1
2
3
4
5
6
7
(defun grow-deep (w)
  (cond ((null w) nil)
        ((atom (car w)) (cons (1+ (car w)) (grow-deep (cdr w))))
        ((cons (grow-deep (car w)) (grow-deep (cdr w))))))
 
> (grow-deep '((1 (2 3)) ((4 (5) 6)) ((7 8) 9)))
((2 (3 4)) ((5 (6) 7)) ((8 9) 10))
Lisp
1
2
3
4
5
6
7
(defun grow-deep (w &aux (a (car w)) (d (cdr w)))
  (cond ((null w) nil)
        ((atom a) (cons (1+ a) (grow-deep d)))
        ((cons (grow-deep a) (grow-deep d)))))
 
> (grow-deep '((1 (2 3)) ((4 (5) 6)) ((7 8) 9)))
((2 (3 4)) ((5 (6) 7)) ((8 9) 10))
Lisp
1
2
3
4
5
6
7
8
(defun grow-deep (x &aux r)
  (reverse (dolist (i x r)
             (cond ((numberp i) (setq r (cons (+ i 1) r)))
                   ((listp i) (setq r (cons (grow-deep i) r)))
                   ((setq r (cons (list i) r)))))))
 
> (grow-deep '((1 2 (3 4) (((5 6))) -1)))
((2 3 (4 5) (((6 7))) 0))
Lisp
1
2
3
4
5
(defun grow-deep (w &aux (a (car w)) (d (cdr w)))
  (when w  (cons (if (atom a) (1+ a) (grow-deep a)) (grow-deep d))))
 
> (grow-deep '((1 2 (3 4) (((5 6))) -1)))
((2 3 (4 5) (((6 7))) 0))
Добавлено через 1 минуту
Lisp
1
2
3
4
5
6
(defun grow-deep (w &aux (a (car w)))
  (when w (cons (if (atom a) (1+ a) (grow-deep a))
                (grow-deep (cdr w)))))
 
> (grow-deep '((1 2 (3 4) (((5 6))) -1)))
((2 3 (4 5) (((6 7))) 0))
2
Algiz
161 / 161 / 22
Регистрация: 23.02.2011
Сообщений: 347
13.04.2013, 00:13 3
Лучший ответ Сообщение было отмечено как решение

Решение

Ну вот, например, с хвостовой рекурсией и стеком. Этот вариант компилятор сом развернет в цикл
Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun task(cur &optional stack)
    (if cur
        (if (listp (car cur))
            (task (cdr cur) (cons (car cur) stack))
            (progn
                (incf (car cur))
                (task (cdr cur) stack)))
        (if stack
            (task (car stack) (cdr stack)))))
 
(defun solve(a) (task a) a)
2
korvin_
2441 / 1918 / 346
Регистрация: 28.04.2012
Сообщений: 6,573
13.04.2013, 08:14 4
Лучший ответ Сообщение было отмечено как решение

Решение

Цитата Сообщение от Algiz Посмотреть сообщение
Ну вот, например, с хвостовой рекурсией и стеком. Этот вариант компилятор сом развернет в цикл
Или не развернет.
2
13.04.2013, 08:14
_sg
4098 / 3848 / 289
Регистрация: 12.05.2012
Сообщений: 2,707
13.04.2013, 08:21 5
Lisp
1
2
3
4
5
(defun grow-deep (w)
  (loop for a in w collect (if (atom a) (1+ a) (grow-deep a))))
 
> (grow-deep '(1 (2) ((3) 4) 5))
(2 (3) ((4) 5) 6)
2
korvin_
2441 / 1918 / 346
Регистрация: 28.04.2012
Сообщений: 6,573
13.04.2013, 08:22 6
Лучший ответ Сообщение было отмечено как решение

Решение

А если так:

Lisp
1
> (plus1 '(0 (1 (2)) ((3) 4)))
Можно ли решить в императивном стиле, либо с применением циклов?
Или только рекурсия?
Можно конечно полностью избавиться от рекурсии, но довольно сложно, код получится трудным для чтения и понимания. Лучше совместить циклы и рекурсию:
Lisp
1
2
3
4
5
6
7
8
9
(defun plus1 (tree)
  (do ((xs tree (cdr xs))
       result)
      ((null xs) (nreverse result))
    (let* ((x (car xs))
           (y (cond ((numberp x) (+ x 1))
                    ((listp   x) (plus1 x))
                    ( t          x))))
      (push y result))))
Lisp
1
2
> (plus1 '(0 (1 (2)) ((3) 4)))
(1 (2 (3)) ((4) 5))
2
_sg
4098 / 3848 / 289
Регистрация: 12.05.2012
Сообщений: 2,707
13.04.2013, 08:25 7
Lisp
1
2
3
4
5
6
(defun grow-deep (w)
  (loop for a in w collect
        (if (atom a) (if (numberp a) (1+ a) a) (grow-deep a))))
 
> (grow-deep '(1 (2 nil) ((3) nil 4) 5))
(2 (3 NIL) ((4) NIL 5) 6)
2
Lambdik
1043 / 937 / 107
Регистрация: 04.11.2012
Сообщений: 971
Записей в блоге: 3
13.04.2013, 09:00  [ТС] 8
Цитата Сообщение от korvin_ Посмотреть сообщение
Можно конечно полностью избавиться от рекурсии, но довольно сложно, код получится трудным для чтения и понимания.
Понял!

Спасибо всем за отзывчивость!

Добавлено через 11 минут
Да, кстати, по горячим следам...
Переписал, ту же функцию, как рекомендуют, по-современному.
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun plus1+ (seq)
  (prog (acc)
  a (cond ((endp seq) (return (nreverse acc))))
    (push (1+ (first seq)) acc)
    (pop seq)
   (go a)))
 
CL-USER 2 > (time (plus1+ '(0 1 2 3 4)))
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 9756 bytes
0 Page faults
Calls to %EVAL    172
(1 2 3 4 5)
Против моего первого варианта plus1 с append'ом.
Lisp
1
2
3
4
5
6
7
8
9
CL-USER 2 > (time (plus1 '(0 1 2 3 4)))
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 1700 bytes
0 Page faults
Calls to %EVAL    116
(1 2 3 4 5)
А думал, будет наоборот. Значения Allocation и Calls to %EVAL, желательно должны быть поменьше, так ведь?
0
korvin_
2441 / 1918 / 346
Регистрация: 28.04.2012
Сообщений: 6,573
14.04.2013, 10:27 9
Цитата Сообщение от Lambdik Посмотреть сообщение
Переписал, ту же функцию, как рекомендуют, по-современному.
С каких пор goto стал современным?
0
Lambdik
1043 / 937 / 107
Регистрация: 04.11.2012
Сообщений: 971
Записей в блоге: 3
14.04.2013, 12:30  [ТС] 10
korvin_
Использование функции push в сочетании с nreverse по идее, должно улучшать производительность кода.
Но результаты тестирования на LispWorks этого не подтверждают.
Возьмем Ваш пример.
Lisp
1
2
3
4
5
6
7
8
9
CL-USER 2 > (time (plus1 '(0 1 2 3 4)))
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 7476 bytes
0 Page faults
Calls to %EVAL    168
(1 2 3 4 5)
..и немного изменим:
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defun plus1 (tree)
  (do ((xs tree (cdr xs))
       result)
      ((null xs) (reverse result))
    (let* ((x (car xs))
           (y (cond ((numberp x) (+ x 1))
                    ((listp   x) (plus1 x))
                    ( t          x))))
      (setq result (cons y result)))))
 
CL-USER 2 > (time (plus1 '(0 1 2 3 4)))
Timing the evaluation of (PLUS1 (QUOTE (0 1 2 3 4)))
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 3128 bytes
0 Page faults
Calls to %EVAL    143
(1 2 3 4 5)
Видно, что использование памяти уменьшилось.
Для Вас это простой теоретический вопрос, для меня сложный.
0
Catstail
Модератор
24496 / 12422 / 2264
Регистрация: 12.02.2012
Сообщений: 20,172
14.04.2013, 14:51 11
Еще один (правда, не императивный) вариант:

Lisp
1
2
3
4
5
6
7
8
(defun inc-lst (lst)
   (mapcar #'(lambda (x) (if (numberp x) (1+ x) (inc-lst x))) lst))
 
==> inc-lst
 
(inc-lst '(1 2 (1 2) (((3 4))) 5 6))
 
==> (2 3 (2 3) (((4 5))) 6 7)
Добавлено через 37 минут
А вот абсолютно императивный алгоритм (но структуроразрушающий). Действительно, не слишком красиво:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
(defun inc-lst (lst)
 (let ((init lst) (curr lst) (s nil))
  ;; Первый цикл увеличивает числа нулевого уровня, 
  ;; а списки - в стек
  (loop
    (if (atom (car curr)) 
        (rplaca curr (1+ (car curr)))
        (push (car curr) s))
    (setq curr (cdr curr))
    (when (null curr) (return t)))
  ;; а теперь - обработка стека...
  (loop
    (when (null s) (return init))
    (setq curr (pop s))
    (loop
       (if (atom (car curr)) 
           (rplaca curr (1+ (car curr)))
           (push (car curr) s))
       (setq curr (cdr curr))
       (when (null curr) (return t))))       
))
 
==> inc-lst
 
(inc-lst '(1 2 (3) (((4 5))) 6))
 
==> (2 3 (4) (((5 6))) 7)
Добавлено через 6 минут
Цитата Сообщение от korvin_ Посмотреть сообщение
С каких пор goto стал современным?
в том коде goto действительно не нужен. Вместо возврата на метку лучше использовать бесконечный цикл.

Добавлено через 3 минуты
А мой последний код можно сократить вдвое! Вот так:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(defun inc-lst (lst)
 (let ((init lst) (curr lst) (s nil))
  (push lst s)
  (loop
    (when (null s) (return init))
    (setq curr (pop s))
    (loop
       (if (atom (car curr)) 
           (rplaca curr (1+ (car curr)))
           (push (car curr) s))
       (setq curr (cdr curr))
       (when (null curr) (return t))))       
))
 
==> inc-lst
 
(inc-lst '(1 2 (3) (((4 5))) 6))
 
==> (2 3 (4) (((5 6))) 7)
1
korvin_
2441 / 1918 / 346
Регистрация: 28.04.2012
Сообщений: 6,573
14.04.2013, 15:21 12
Цитата Сообщение от Lambdik Посмотреть сообщение
Видно, что использование памяти уменьшилось.
Для Вас это простой теоретический вопрос, для меня сложный.
1) а ты попробуй скомпилировать обе функции (либо с помощью соответствующих кнопок интерфейса, либо в REPL с помощью compile: (compile 'plus1)).
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
(defun plus1/nreverse/push (tree)
  (do ((xs tree (cdr xs))
       result)
      ((null xs) (nreverse result))
    (let* ((x (car xs))
           (y (cond ((numberp x) (+ x 1))
                    ((listp   x) (plus1/nreverse/push x))
                    ( t          x))))
      (push y result))))
 
(defun plus1/reverse/cons (tree)
  (do ((xs tree (cdr xs))
       result)
      ((null xs) (reverse result))
    (let* ((x (car xs))
           (y (cond ((numberp x) (+ x 1))
                    ((listp   x) (plus1/reverse/cons x))
                    ( t          x))))
      (setq result (cons y result)))))
 
(defun test ()
  (let ((xs (loop :for i :below 100 :collect i)))
    (time (plus1/nreverse/push xs))
    (time (plus1/reverse/cons  xs))
    nil))
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
CL-USER> (test)
Timing the evaluation of (PLUS1/NREVERSE/PUSH XS)
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 1200 bytes
0 Page faults
Timing the evaluation of (PLUS1/REVERSE/CONS XS)
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 2400 bytes
0 Page faults
NIL
2) push делает в общем-то ровно то же, что и setq+cons:
Lisp
1
2
3
4
5
CL-USER> (pprint (macroexpand-1 '(push x xs)))
 
(LET ((#:|new-value-824| X))
  (LET* ((#:|Store-Var-823| (CONS #:|new-value-824| XS)))
    (SETQ XS #:|Store-Var-823|)))
1
Lambdik
1043 / 937 / 107
Регистрация: 04.11.2012
Сообщений: 971
Записей в блоге: 3
14.04.2013, 15:27  [ТС] 13
Цитата Сообщение от korvin_ Посмотреть сообщение
попробуй скомпилировать обе функции
Теперь уяснил.

Catstail Спасибо за живой пример!
0
14.04.2013, 15:27
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.04.2013, 15:27

Построить алгоритм Маркова, который ищет НОД (Алгоритм Евклида)
Здравствуйте, ребята, выручайте. Весь инет перерыл, всю голову сломал, но не могу сделать. Суть в...

Алгоритм устранения непродуктивных нетерминалов, алгоритм построения недостижимых символов
Задание: найдите лишние нетерминалы в следующей грамматике с начальным нетерминалом S и в...

Построить алгоритм ДО и алгоритм ПОКА для вычислений значения функции на отрезке [a,b] с шагом h.
Построить алгоритм ДО и алгоритм ПОКА для вычислений значения функции на отрезке с шагом h....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
13
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru