Список: Написать программу для выделения списков в заданном интервале в произвольно введенном исходном списке.

@Nsity · Регистрация: 13.05.2012

Студворк — интернет-сервис помощи студентам

Написать программу для выделения списков в заданном интервале в произвольно введенном исходном списке.
Сформировать их них список и вывести его. Исходный список имеет уровень 0, вложенный список имеет уровень 1 и т.д.
Пример.
(a(b(с 1)d e)f((2(g))3))
с 2-3 уровни ((с 1)(2(g))(g))

Пыталась сначала выделить списки на определенном уровне, но и это не работает правильно. Помогите, пожалуйста!!!

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
28
29
(defun p1 (L N)
(setq Rez ())
(dolist (L1 L)
(if (and (listp L1) (= N 0))
(setq Rez (append Rez (cons L1 ())))
)
(if (and (listp L1) (> N 0))
(progn
(setq TU 0)
(setq Rez (p2 L1 N Rez TU))
)
)
)
(princ Rez)
)
(defun p2 (L1X NX RezX TUX)
(setq TUX (1+ TUX))
(dolist (L1X1 L1X)
(progn
(if (and (listp L1X1) (= TUX NX))
(setq RezX (append RezX (cons L1X1 ())))
)
(if (listp L1X1)
 (p2 L1X1 NX RezX TUX)
)
)
)
(return-from p2 RezX)
)

@helter · 18.03.2013, 12:34

Catstail, своё-то легко написать, а чужой код поправить слабо?

Давайте будем нести Лисп в массы, а не склонять народ к халтурной копипасте. Тем более, Nsity явно делом занимается, а не ждёт халявы.

@Catstail · 18.03.2013, 12:43

Сообщение от helter

Catstail, своё-то легко написать, а чужой код поправить слабо?

- ладно, посмотрю...

@helter · 18.03.2013, 13:54

Да я сам смотрю, почти заработало. Сейчас напишу.

Добавлено через 1 час 9 минут

Сообщение от Nsity

helter,
Попыталась что-то сделать по вашим рекомендациям, но теперь выводит просто список списков всех уровней. Не понимаю, как за границы интервала не выходить.

Кликните здесь для просмотра всего текста

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
28
29
(defun p1 (L N1 N2)
  (setq Rez ())
  (dolist (L1 L)
    (if (and (listp L1) (= N1 0))
      (progn 
      (setq Rez (append Rez (cons L1 ())))
      (setq Rez (p2 L1 N1 N2 Rez))
      )
    )
    (if  (and (listp L1) (> N1 0))
      (progn
      (setq N1 (1- N1) N2 (1- N2))
      (setq Rez (p2 L1 N1 N2 Rez))
      )
    )
  ) 
  (princ Rez)
)
(defun p2 (L1X N1X N2X RezX)
  (dolist (L1X1 L1X)
    (if   (listp L1X1)
      (progn 
      (setq RezX (append RezX (cons L1X1 ())))
      (p2 L1X1 N1X N2X RezX)
    )
  )
  )
  (return-from p2 RezX)
)

Nsity, ваш стиль по-прежнему печалит меня. Висячие скобки, заглавные буквы - это же ужасно. В Лиспе не принято использовать ВерблюжийПортфель. Зато можно использовать дефис: l1-x1 и т. д. setq-ы.

Nsity, насколько я понял, вашей идеей было использовать функцию p2, которая сама по себе ничего не считала бы, а существовала исключительно ради сайд-эффекта: собирала бы значения в переменную. Относитесь настороженно к сайд-эффектам.

Не работала она в первую очередь потому, что при каждом рекурсивном вызове создавалась новая переменная rezx. Вот как можно этого избежать с помощью глобальной переменной:

Lisp
1
2
3
4
5
6
7
8
(defparameter *rezx* '())
 
(defun p2 (l1x n1x n2x)
  ((when (and (<= n1x 0) (>= n2x 0))
    (push l1x *rezx*))
  (dolist (l1x1 l1x)
    (when (and (listp l1x1) (plusp n2x))
      (p2 l1x1 (- n1x 1) (- n2x 1))))))

В таком виде функция уже почти пригодна к использованию.

Lisp
1
2
3
4
CL-USER> (p2 '(a (b (c 1) d e) f ((2 (g)) 3)) 2 3)
NIL
CL-USER> *rezx*
((G) (2 (G)) (C 1))

Обратите внимание: функция ничего не считает, а только складывает ответ в глобальную переменную. Вы сами придумали, не я.

Зато ответ правильный.

Прежде всего, несколько замечаний по коду. Во-первых, как видите, всё сделал маленькими буквами. Во-вторых, у вас была путаница с уровнями вложенности (надо было на единицу уменьшать). В третьих, это

Lisp
1
(setq RezX (append RezX (cons L1X1 ())))

жуть.

(cons L1X1 ()) - это (list l1x1). И вообще, зачем в хвост? Добавляйте лучше в голову, это всегда дешевле и короче: (push l1x1 rezx).
В-четвёртых, я дописал вам и проверку того, надо ли включать текущий список. И получилась рабочая функция.

Замечание насчёт if. Тот факт, что эта форма не предусматривает implicit progn (то есть progn приходится самому писать), намекает, что if в первую очередь предназначен для вычисления значения, а не для условного выполнения. Когда вы пишете функционально, у вас никаких блоков последовательных функций не может быть: куда девались бы ответы первых функций? Если вам нужно именно условное выполнение, лучше по возможности пользоваться специально созданными when/unless с implicit progn-ом.

Конечно, интерфейс через глобальную переменную - это глупость. Можно объявить функцию p2 внутри let-а, что сделает для этой функции доступной неглобальную переменную, невидимую из остальной программы. Вот так:

Lisp
1
2
3
4
5
6
7
8
9
10
11
(let ((rezx '()))
  (defun p2 (l1x n1x n2x)
  (when (and (<= n1x 0) (>= n2x 0))
    (push l1x rezx))
  (dolist (l1x1 l1x)
    (when (and (listp l1x1) (plusp n2x))
      (p2 l1x1 (- n1x 1) (- n2x 1))))
  rezx))
 
CL-USER> (p2 '(a (b (c 1) d e) f ((2 (g)) 3)) 2 3)
((G) (2 (G)) (C 1))

Кстати, обратите внимание. Что возвращает функция? Последнее вычисленное значение. Поэтому чтобы вернуть rezx, я просто в конце пишу rezx.

Такая конструкция, когда функция использует переменную, объявленную на более высоком уровне, называется замыканием. Обратите внимание: переменные, объявляемые let-ом, живут вечно, но видны только внутри своего let-а (lexical scope). Это обеспечивает нам инкапсуляцию.

Однако в действительности замыкание не было бы нужно, если бы вы мыслили более функционально. Использование повтороного присванивания одной и той же переменной - императивный подход. В функциональном подходе тоже вводят переменные, но они скорее обозначения, чем переменные: им не присваивают значения повторно. Эти переменные служат для того, чтобы передать их функциям, которые вычислят значения, которые они передадут другим функциям и пр. Функциональное программирование - это непрерывный поток данных, обрабатываемых функциями.

Хотя моё собственное решение, которое я хочу показать, не функциональное, там тоже есть присваивание. Потому что Лисп не Хаскел, можно как угодно писать.

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(defun lists-inside (lst l n)
  (if (>= n l)
      (if (minusp n)
          '()
          (let ((res (if (<= l 0)
                         (list lst)
                         '())))
            (dolist (x lst)
              (when (listp x)
                (setf res (nconc (lists-inside x (- l 1) (- n 1)) res))))
            res))
      '()))

Что здесь. Во первую очередь проверка, чтобы верхняя граница была не меньше нижней, иначе вернуть пустой список. Дальше смотрим: если верхняя граница отрицательная - тоже пустой. Потом содержательная часть, которая соответствует неотрицательной верхней границе. Я создаю переменную res, куда буду складывать ответ. В качестве начального значения мне нужно либо поместить туда данный мне список lst (если подсписки нулевого уровня нужны), либо просто пустой список, если подсписки нулевого уровня не нужны. Для этого я использую if по прямому назначению, как тернарный оператор. Потом понятно: прохожусь по списку и если нахожу подсписок, добавляю к результату его "хорошие" подсписки (рекурсия). После цикла возвращаю результат: выражение res является последним в let-e, поэтому она есть значение let-а, которое (при выполнении условий) становится значениями объемлющих if-ов. Поскольку тело функции состоит из единственного if-а, она возвращает значение этого if-а.

Да, nconc - это то же, что и append, только опасный вариант. Если сомневаетесь, используйте append. (Здесь я могу использовать nconc, потому что вижу создание списка res с самого начала и вижу, что ничего не порушится.)

Вот! Теперь задавайте вопросы.

@Catstail · 18.03.2013, 17:56

Вот объяснение моего решения (нерекурсивное и без явных присвоений):

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
(defun lst-lv (lst n1 n2)
  ;; s-стек, res-результат
  ;; в стеке будут храниться агрегаты вида (уровень подсписок)
  (let ((s nil) (res nil))  
    ;; Заносим в стек весь исходный список с уровнем 0
    (push (list 0 lst) s)
    ;; Проходим по исходному списку и заносим встречающиеся
    ;; подсписки с уровнем 1
    (dolist (i lst t)
     (when (listp i) (push (list 1 i) s)))
    ;; главный цикл
    (loop
       ;; если стек пуст - возврат res 
       (when (null s) (return res))
       ;; извлекаем элемент из стека -> l
       ;; его номер уровня -> lv
       ;; его подсписок -> ll 
       (let* ((l (pop s)) (lv (car l)) (ll (cadr l)))
          ;; Если номер уровня лежит в нужном диапазоне
          ;; и подсписок не содержится в res - добавим ll в res
          (when (and (<= lv n2) (>= lv n1) (not (member ll res)))
             (push ll res)) 
          ;; если уровень подсписка меньше верхней границы 
          (when (< lv n2)
            ;; проходим этот список
            (dolist (i ll t)
               ;; каждый подсписок заносим в стек с номером
               ;; уровня, большим на 1  
               (when (and (listp i) (not (member (list (1+ lv) i) s))) 
                     (push (list (1+ lv) i) s))))))))
 
==>lst-lv
 
;; проверка:
 
(lst-lv '(a (b (c 1) d e) f ((2 (g (h))) 3)) 1 2)
 
==> ((c 1) (b (c 1) d e) (2 (g (h))) ((2 (g (h))) 3))
 
(lst-lv '(a (b (c 1) d e) f ((2 (g (h))) 3)) 1 1)
 
==> ((b (c 1) d e) ((2 (g (h))) 3))
 
(lst-lv '(a (b (c 1) d e) f ((2 (g (h))) 3)) 4 4)
 
==> ((h))
 
(lst-lv '(a (b (c 1) d e) f ((2 (g (h))) 3)) 3 4)
 
==> ((h) (g (h)))

Добавлено через 1 час 26 минут
Этот код можно упростить:

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
(defun lst-lv (lst n1 n2)
  ;; s-стек, res-результат
  ;; в стеке будут храниться агрегаты вида (уровень подсписок)
  (let ((s nil) (res nil))  
    ;; Заносим в стек весь исходный список с уровнем 0
    (push (list 0 lst) s)
    ;; главный цикл
    (loop
       ;; если стек пуст - возврат res 
       (when (null s) (return res))
       ;; извлекаем элемент из стека -> l
       ;; его номер уровня -> lv
       ;; его подсписок -> ll 
       (let* ((l (pop s)) (lv (car l)) (ll (cadr l)))
          ;; Если номер уровня лежит в нужном диапазоне
          ;; и подсписок не содержится в res - добавим ll в res
          (when (and (<= lv n2) (>= lv n1) (not (member ll res)))
             (push ll res)) 
          ;; если уровень подсписка меньше верхней границы 
          (when (< lv n2)
            ;; проходим этот список
            (dolist (i ll t)
               ;; каждый подсписок заносим в стек с номером
               ;; уровня, большим на 1  
               (when (and (listp i) (not (member (list (1+ lv) i) s))) 
                     (push (list (1+ lv) i) s))))))))

@_sg · 18.03.2013, 18:27

вариант записи решения helter:

Lisp
1
2
3
4
5
6
7
8
9
10
(defun level-range (w n m)
  (when (>= m n)
    (when (>= m 0)
      (let ((ac (if (<= n 0)
                    (list w)
                    nil)))
        (dolist (a w)
          (when (listp a)
            (setf ac (nconc (level-range a (1- n) (1- m)) ac))))
        ac))))

Добавлено через 1 минуту
сам придумать ничего не могу:

Lisp
1
2
3
4
5
6
7
(defun level-range (w n m &aux (ac (if (<= n 0) (list w) nil)) )
  (when (>= m n)
    (when (>= m 0)
      (dolist (a w)
        (when (listp a)
          (setf ac (nconc (level-range a (1- n) (1- m)) ac))))
      ac)))

@Nsity · 18.03.2013, 20:41 **[ТС]**

Спасибо за ваши решения, но я еще многих функций типа let, when и т.д. особо не знаю...
Вот на основе ваших решений сделала такую программу. Работает вроде правильно, но в ответ выводит 2 раза одно и тоже. Как от этого избавиться?

Lisp
1
2
3
4
5
6
7
8
9
10
(defun p1 (l1 n1 n2)
(setq rezx ())
(p2 l1 n1 n2)
(princ rezx))
(defun p2 (l1x n1x n2x)
  (if (and (<= n1x 0) (>= n2x 0))
   (setq rezx (append rezx (cons l1x ()))))
  (dolist (l1x1 l1x)
    (if (and (listp l1x1))
      (p2 l1x1 (- n1x 1) (- n2x 1))))

@helter · 18.03.2013, 21:09

Nsity, скобки -

Так вы зачем-то печатаете: princ. Вместо (princ rezx) напишите просто rezx, чтобы функция возвращала значение, и всё. Лучше считать отдельно, выводить на печать отдельно.

let - совершенно фундаментальная вещь, гораздо важнее, чем операторы присваивания. Странно, что вы знаете последние и не знаете первого. Макрос let создаёт локальные переменные, а точнее, биндинги (binding читается байндинг, но это трудно произнести русскими звуками). Используется так:

Lisp
1
2
3
4
5
6
(let ((имя1 выраж1)
      ...
      (имяn выражn))
  форма1
  ...
  формаk)

Макрос вычисляет значения выражений и привязывает их к именам, после этого имена видны во всех формах, составляющих тело let-а. Как и всё остальное, let возвращает значение; в качестве его значения выступает значение последней формы или nil, если в теле нет форм. Если писать в функциональном стиле, "переменные", созданные let-ом, на самом деле являются просто обозначениями, и их значение не меняется.

when и unless - макросы для выполнения одного или нескольких действий при (не)выполнении некоторого условия. См. http://www.lispworks.com/docum... _when_.htm И вообще обратите внимание на этот сайт.

@Catstail · 20.03.2013, 15:35

Вот еще решение:

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
(defun f0 (lst)
 (if (atom lst) Nil (remove-if #'atom lst)))
 
(defun f1 (lst)
 (apply 'append (remove nil (mapcar #'f0 lst))))
 
(defun task (lst n1 n2 &optional (k 0) res)
  (cond ((> k n2) res)
        ((< k (- n1 1)) (task (f1 lst) n1 n2 (+ k 1) res))
        (t (let* ((l1 (f0 lst))
                  (l2 (f1 l1)))
                 (task l2 n1 n2 (+ k 1) (append res l1))))))    
 
(task '(a (b (c 1) d e) f ((2 (g (h))) 3)) 3 4)
 
==> ((g (h)) (h))
 
(task '(a (b (c 1) d e) f ((2 (g (h))) 3)) 2 3)
 
==> ((c 1) (2 (g (h))) (g (h)) (h))
 
(task '(a (b (c 1) d e) f ((2 (g (h))) 3)) 0 1)
 
==> ((b (c 1) d e) ((2 (g (h))) 3) (c 1) (2 (g (h))))

Новые блоги и статьи Все статьи Все блоги /
SUNO Ai - Река Без Дна zorxor 31.07.2026 Автор стихотворения - астрофизик Марина Катыс Ссылка на сгенерированную музыкальную композицию: https:/ / suno. com/ song/ 6f6e5464-b290-4650-be6c-44c85f8d8013 Я говорю, что Время- как вода течет. . .	Из невошедшего на форум (диалог с ИИ-гугла) zorxor 29.07.2026 А вот, что интересно, сказал мне ИИ-гугла: Этот текст — эмоциональный пост пользователя под ником zorxor на интернет-форуме (вероятно, посвященном мистике, непознанному или альтернативной науке). . . .	Был праздник вчера, а я и не знал. kumehtar 28.07.2026 27. 07. 2026г. Intel Core 2 Duo исполнилось 20 лет Новости компьютерного мира и их обсуждение (4) Салют, шампанское, овации! :drink:	Нейтральные знания, чистый код - бла-бла-бла-бла, на самом деле кликбейт и самореклама, плагиат, и вот почему Hrethgir 27.07.2026 То-есть отклонение такой публикации говорит само за себя, и пусть только возьмут на вооружение после отклонения публикации - это будет чистейшим актом плагиата. Отклонял Хабр. Дословно, отклонённая. . .
тв 16 бой ии anaschu 27.07.2026 Великий Перелом ИИ: Как уравнения ОДУ Radau дожали цензурные фильтры Алисы Фиксируем в мемофонде Теории Всего беспрецедентный факт в истории ИИ-зондирования. В затяжном многораундовом. . .	мв 15. непроверенное, возможно, глюк anaschu 27.07.2026 НАУЧНО-АНАЛИТИЧЕСКИЙ ОТЧЕТ. РАЗДЕЛ 1. 1: «НАУКА» (РАСШИРЕННАЯ СТЕХИОМЕТРИЧЕСКАЯ И ГЕНЕТИЧЕСКАЯ ВЕРСИЯ)Тема: Теоретическое обоснование инвариантности 19-мерного тензорного ядра непрерывных ОДУ и. . .	Очистка реквизитов и табличных частей документа при копировании (вариант 2) Maks 26.07.2026 Алгоритм из решения ниже разработан на примере нетипового документа "ЗаявкаНаРаботу", разработанного в КА2. Задача: Заменить алгоритм запрета копирования документов для сотрудников с ролью "Стажер",. . .	Доктрина интенционального знания - Доктрина для портала "Срез". Hrethgir 25.07.2026 Может найдётся кто захочет оценить доктрину. . . Написания правил участия для меня роскошь, требующая лимита времени, поэтому все сообщения не прошедшие модерацию будут видны только участникам портала,. . .

@helter 4528 / 3522 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	18.03.2013, 12:34
	Catstail, своё-то легко написать, а чужой код поправить слабо? Давайте будем нести Лисп в массы, а не склонять народ к халтурной копипасте. Тем более, Nsity явно делом занимается, а не ждёт халявы. 0

Список: Написать программу для выделения списков в заданном интервале в произвольно введенном исходном списке.

Решение