Глубина первого вхождения элемента Y, удовлетворяющего некоторому предикату P, в список W

@OFKtop · Регистрация: 20.03.2017

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

Доброго времени! Уже видел подобную тему, где расписывали как решить задачку, но: там условие отличалось тем, что нужно было найти глубину последнего вхождения элемента Y. Собственно, вопрос заключается в следующем: что нужно изменить в коде, чтобы находилась глубина первого вхождения в список? И, если возможно, прокомментируйте, пожалуйста, строки, а то я вообще ни бум-бум в этом языке, а сдавать все равно придётся (
Решение задачи с поиском последнего вхождения было вот таким :

Lisp
1
2
3
4
5
6
7
8
9
10
(defun maxDepth1 (f s g) ; предикат f, список s, текущая глубина g
        (cond ((null s) 0) ; если список пустой – глубина 0
              ((listp (first s)) 
                (max    
                      (maxDepth1 f (rest s) g)       
                      (maxDepth1 f (first s) (+ 1 g))))
            ((funcall f (first s)) 
                (max g                                
                     (maxDepth1 f (rest s) g))) 
            (t (maxDepth1 f (rest s) g))))

@Catstail · 21.11.2019, 21:07

Приведи внятную формулировку задачи

@OFKtop · 22.11.2019, 06:49 **[ТС]**

Необходимо найти глубину ПЕРВОГО вхождения элемента Y, удовлетворяющего некоторому предикату P, в список W.

@Catstail · 22.11.2019, 10:30

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

Необходимо найти глубину ПЕРВОГО вхождения элемента Y,

- смотрите:

Lisp
1
 ((((a y))) y)

Какое из вхождений первое?

@OFKtop · 22.11.2019, 17:42 **[ТС]**

То, где Y в списке вложенном вместе с A

@Catstail · 22.11.2019, 18:08

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun mark (list &optional (lv 0))
  (cond ((null list) nil)
        ((atom (car list)) (cons (list (car list) lv) (mark (cdr list) lv)))
        (t (cons (mark (car list) (+ lv 1)) (mark (cdr list) lv)))))  
  
(defun is-pair (list)
  (and (atom (car list))(= 2 (length list))))
 
(defun flat-pair (list)
  (cond ((null list) nil)
        ((is-pair (car list)) (cons (car list) (flat-pair (cdr list))))
        (t (append (flat-pair (car list)) (flat-pair (cdr list))))))
 
(defun task (list x)
  (cadar (remove-if-not (lambda (pair) (eq x (car pair))) (flat-pair (mark list)))))
 
(task '(a ((b c) d) (((a b z)))) 'b)
==> 2
 
(task '((((a y))) y) 'y)
==> 3

@OFKtop · 22.11.2019, 20:14 **[ТС]**

Спасибо вам большое за решение. И ещё, последняя просьба: если можно, поясните, пожалуйста, вкратце, что делает каждая функция? Ну, грубо говоря, краткое описание того, как программа работает?

@Catstail · 23.11.2019, 08:44

А вы можете и сами проверить... Функция mark размечает список - заменяет каждый атом x списковой парой (x d), где d - глубина вложенности:

Lisp
1
2
3
4
5
6
7
8
9
10
(defun mark (list &optional (lv 0))
  (cond ((null list) nil)
        ((atom (car list)) (cons (list (car list) lv) (mark (cdr list) lv)))
        (t (cons (mark (car list) (+ lv 1)) (mark (cdr list) lv)))))  
 
==> MARK
 
(mark '(a ((b c) d) (((a b z)))))
 
==> ((A 0) (((B 2) (C 2)) (D 1)) ((((A 3) (B 3) (Z 3)))))

Функция is-pair проверяет, является ли список парой:

Lisp
1
2
3
4
5
6
7
8
9
10
(defun is-pair (list)
  (and (atom (car list))(= 2 (length list))))
 
==> IS-PAIR
 
(is-pair '(a 4))
==> T
 
(is-pair '((a 4) (b 5)))
==> NIL

Функция flat-pair делает список пар одноуровневым:

Lisp
1
2
3
4
5
6
7
8
9
(defun flat-pair (list)
  (cond ((null list) nil)
        ((is-pair (car list)) (cons (car list) (flat-pair (cdr list))))
        (t (append (flat-pair (car list)) (flat-pair (cdr list))))))
 
==> FLAT-PAIR
 
(flat-pair '((a 1) ((b 3) (c 4))))
==> ((A 1) (B 3) (C 4))

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

@_sg · 23.11.2019, 12:06

как вариант:

Lisp
1
2
3
4
5
6
7
8
9
(defun deep (z w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (deep z a (1+ n)))
                ((eq a z) n)
                ((deep z (cdr w) n)))))
 
> (deep 'b '(a ((b c) d) (((a b z)))))
2
> (deep 'y '((((a y))) y))
3

Добавлено через 2 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun deep
    (z w &optional (n 0) &aux (a (car w)))
  (cond ((null w) nil)
        ((listp a) (deep z a (1+ n)))
        ((eq a z) n)
        (t (deep z (cdr w) n))))
 
> (deep 'b '(a ((b c) d) (((a b z)))))
2
> (deep 'y '((((a y))) y))
3

Добавлено через 6 минут

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

удовлетворяющего некоторому предикату P

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun deep
    (p w &optional (n 0) &aux (a (car w)))
  (cond ((null w) nil)
        ((listp a) (deep p a (1+ n)))
        ((funcall p a) n)
        ((deep p (cdr w) n))))
 
> (deep #'evenp '(1 ((2 1) 3) (((1 2 3)))))
2
> (deep #'evenp '((((1 2))) 2))
3

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

Lisp
1
2
3
4
5
6
7
8
9
(defun deep (p w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (deep p a (1+ n)))
                ((funcall p a) n)
                ((deep p (cdr w) n)))))
 
> (deep #'evenp '(1 ((2 1) 3) (((1 2 3)))))
2
> (deep #'evenp '((((1 2))) 2))
3

@Catstail · 23.11.2019, 12:34

_sg, есть проблема:

Lisp
1
2
3
4
5
6
7
8
(defun deep (z w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (deep z a (1+ n)))
                ((eq a z) n)
                ((deep z (cdr w) n)))))
                
(print (deep 'b '(a ((a c) d) (((a b z))))))
 
Nil

@_sg · 23.11.2019, 15:59

Lisp
1
2
3
4
5
6
7
8
(defun deep (z w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (let ((k (deep z a (1+ n))))  
                             (if k k (deep z (cdr w) n))))
                ((eq a z) n)
                ((deep z (cdr w) n)))))
 
> (deep  2 '(1 ((2 1) 3) (((1 2 3 4)))))
2

Lisp
1
2
3
4
5
6
7
8
(defun deep (p w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (let ((k (deep p a (1+ n))))  
                             (if k k (deep p (cdr w) n))))
                ((funcall p a) n)
                ((deep p (cdr w) n)))))
 
> (deep #'minusp '(1 ((2 1) 3) (((1 2 (-3) 4)))))
4

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

Lisp
1
2
3
4
5
6
7
8
(defun deep (z w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (cond ((deep z a (1+ n))) 
                                 ((deep z (cdr w) n))))
                ((eql a z) n)
                ((deep z (cdr w) n)))))
 
> (deep  2 '(1 ((2 1) 3) (((1 2 3 4)))))
2

Lisp
1
2
3
4
5
6
7
8
(defun deep (p w &optional (n 0) &aux (a (car w)))
  (when w (cond ((listp a) (cond ((deep p a (1+ n))) 
                                 ((deep p (cdr w) n))))
                ((funcall p a) n)
                ((deep p (cdr w) n)))))
 
> (deep #'minusp '(1 ((2 1) 3) (((1 2 (-3) 4)))))
4

@OFKtop · 24.11.2019, 07:13 **[ТС]**

Разобрался в обоих предложенных решениях. Спасибо большое, все работает!)

Новые блоги и статьи Все статьи Все блоги /
WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .	Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114
Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и напряжениями. Надо найти токи в ветвях. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и решает её. Последовательность действий:. . .	Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .

@Catstail Супер-модератор 38167 / 21102 / 4307 Регистрация: 12.02.2012 Сообщений: 34,690 Записей в блоге: 14
	21.11.2019, 21:07
	Приведи внятную формулировку задачи 0

@OFKtop 0 / 0 / 0 Регистрация: 20.03.2017 Сообщений: 11
	22.11.2019, 06:49 [ТС]
	Необходимо найти глубину ПЕРВОГО вхождения элемента Y, удовлетворяющего некоторому предикату P, в список W. 0

@OFKtop 0 / 0 / 0 Регистрация: 20.03.2017 Сообщений: 11
	22.11.2019, 17:42 [ТС]
	То, где Y в списке вложенном вместе с A 0

@OFKtop 0 / 0 / 0 Регистрация: 20.03.2017 Сообщений: 11
	22.11.2019, 20:14 [ТС]
	Спасибо вам большое за решение. И ещё, последняя просьба: если можно, поясните, пожалуйста, вкратце, что делает каждая функция? Ну, грубо говоря, краткое описание того, как программа работает? 0

@OFKtop 0 / 0 / 0 Регистрация: 20.03.2017 Сообщений: 11
	24.11.2019, 07:13 [ТС]
	Разобрался в обоих предложенных решениях. Спасибо большое, все работает!) 0