Глубина первого вхождения элемента 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 **[ТС]**

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

Новые блоги и статьи Все статьи Все блоги /
AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .	Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .
Программный контроль заполнения реквизитов табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .	wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .

@Catstail Супер-модератор 38195 / 21128 / 4309 Регистрация: 12.02.2012 Сообщений: 34,736 Записей в блоге: 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