По заданному дереву построить новое дерево только из тех элементов данного дерева, которые оканчиваются на 7

@Jourex · Регистрация: 05.12.2017

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

Пожалуйста, помогите. Уже весь мозг себе сломала. Т-Т
Есть задание - "Напишите функцию, которая по заданному дереву строит новое дерево только тех элементов данного дерева, которые оканчиваются на 7".
Вот код программы. Тут по сути просто реализовано удаление элемента из дерева. Проблемы две: 1) удаляется только один элемент, а не все его вхождения. 2)Получается, нужно удалить все вхождения функции, которая отвечает за проверку элементов на конец 7. сама функция тоже почему-то удаляет только первое вхождение, а не все.
Функция для поиска элементов, кончающихся на 7:

Lisp

 (defun atm (n &optional (r nil) )        
(cond ((null n) nil)                       
((= (rem (car n) 10) 7) (cons (car n) r))  
(t ( atm (cdr n) r))                       
))

Сама функция удаления элемента:

Lisp

(DEFUN DELETE (ATM &optional TREE)
(SETQ SUBTREE (SEARCH ATM TREE))
      (COND ( (NULL SUBTREE) (PRINT "usla v dereve net") )
            (  T
                 (COND ( (EQUAL SUBTREE (LIST ATM NIL NIL))
                          ; uzel list
                          (REPLACE SUBTREE NIL TREE)
                       )
                       ( (AND (NOT (NULL (LEFT  SUBTREE)))
                              (NOT (NULL (RIGHT SUBTREE))))
                            (SETQ UZEL
                              (RIGHTLIST (LEFT SUBTREE)))
                            (RPLACA SUBTREE UZEL)
                            (COND ( (NULL (RIGHT
                                           (LEFT SUBTREE)))
                                    (REPLACE (LEFT SUBTREE)
                                      (CADR (LEFT SUBTREE))
                                             TREE) )
                                  ( (NULL (LEFT
                                           (LEFT SUBTREE)))
                                    (REPLACE (LEFT SUBTREE)
                                      (CADDR (LEFT SUBTREE))
                                             TREE) )
                                  (  T  (REPLACE (LIST UZEL
                                                  NIL NIL)
                                                 NIL TREE) )
                            )
                       )
                       ( (NULL (RIGHT SUBTREE))
                             (REPLACE SUBTREE (CADR SUBTREE)
                                      TREE)
                       )
                       ( (NULL (LEFT SUBTREE))
                             (REPLACE SUBTREE (CADDR SUBTREE)
                                      TREE)
                       )
                 )
            )
      )
   )

Ну и весь код на всякий случай.

Lisp

 (DEFUN ROOT (&optional TREE)
      (CAR TREE))
   (DEFUN LEFT (&optional TREE)
      (CADR TREE))
(DEFUN RIGHT (&optional TREE)
      (CADDR TREE))
 (DEFUN RIGHTLIST (&optional TREE)
      (COND ( (NULL (RIGHT TREE)) (CAR TREE) )
            (  T  (RIGHTLIST (RIGHT TREE)) )
      ))
 
   (DEFUN LEFTLIST (&optional TREE)
 
       (COND ( (NULL (LEFT TREE)) (CAR TREE) )
             (  T  (LEFTLIST (LEFT TREE)) )
       )
   )
  (DEFUN SEARCH (A &optional TREE)
      (COND ( (NULL TREE)          NIL  )
            ( (EQUAL A (CAR TREE)) TREE )
            ( (< A (CAR TREE)) (SEARCH A (CADR  TREE)) )
            (          T           (SEARCH A (CADDR TREE)) )
      )
   )
 
   (DEFUN REPLACE (OLD &optional NEW LST)
 
      (COND ( (ATOM LST) LST )
            ( (EQUAL OLD LST) NEW )
            (  T  (CONS (REPLACE OLD NEW (CAR LST))
                        (REPLACE OLD NEW (CDR LST))) )
      )
   )
(DEFUN DELETE1 (ATM &optional TREE)
 
      (COND ( (NULL TREE) NIL )
            ( (< ATM (ROOT TREE))
                 (LIST (CAR TREE)
                       (DELETE1 ATM (LEFT TREE))
                       (RIGHT TREE))
            )
            ( (> ATM (ROOT TREE))
                 (LIST (CAR TREE)
                       (LEFT TREE)
                       (DELETE1 ATM (RIGHT TREE)))
            )
            (  T  (COND ( (NULL (RIGHT TREE)) (LEFT  TREE) )
                        ( (NULL (LEFT  TREE)) (RIGHT TREE) )
                        (  T  (LIST (UD (LEFT TREE))
                                    (DELETE1
                                        (UD (LEFT TREE))
                                        (LEFT TREE))
                                    (RIGHT TREE)) )) )
      )
   )
 
 
(defun atm (n &optional (r nil) )        
(cond ((null n) nil)                       
((= (rem (car n) 10) 7) (cons (car n) r))  
(t ( atm (cdr n) r))                       
))                                         
 
 
 
   (DEFUN UD (&optional TREE)
 
      (COND ( (NULL (RIGHT TREE)) (CAR TREE) )
            (  T  (UD (RIGHT TREE)) )
      )
   )
(DEFUN DELETE (ATM &optional TREE)
(SETQ SUBTREE (SEARCH ATM TREE))
      (COND ( (NULL SUBTREE) (PRINT "usla v dereve net") )
            (  T
                 (COND ( (EQUAL SUBTREE (LIST ATM NIL NIL))
                          ; uzel list
                          (REPLACE SUBTREE NIL TREE)
                       )
                       ( (AND (NOT (NULL (LEFT  SUBTREE)))
                              (NOT (NULL (RIGHT SUBTREE))))
                            (SETQ UZEL
                              (RIGHTLIST (LEFT SUBTREE)))
                            (RPLACA SUBTREE UZEL)
                            (COND ( (NULL (RIGHT
                                           (LEFT SUBTREE)))
                                    (REPLACE (LEFT SUBTREE)
                                      (CADR (LEFT SUBTREE))
                                             TREE) )
                                  ( (NULL (LEFT
                                           (LEFT SUBTREE)))
                                    (REPLACE (LEFT SUBTREE)
                                      (CADDR (LEFT SUBTREE))
                                             TREE) )
                                  (  T  (REPLACE (LIST UZEL
                                                  NIL NIL)
                                                 NIL TREE) )
                            )
                       )
                       ( (NULL (RIGHT SUBTREE))
                             (REPLACE SUBTREE (CADR SUBTREE)
                                      TREE)
                       )
                       ( (NULL (LEFT SUBTREE))
                             (REPLACE SUBTREE (CADDR SUBTREE)
                                      TREE)
                       )
                 )
            )
      )
   )
 
(DELETE (ATM '(13 (17 nil nil) (17 nil nil))))))
'(13 (17 nil nil) (17 nil nil)))))

Добавлено через 1 минуту
Ах да, использовать можно только те функции, которые у меня есть. Т.е. никаких if, where, loop и пр. отсюда еще больше сложности -.-

@Catstail · 18.01.2018, 05:53

Удаление из дерева - очень сложная операция. Проще построить новое дерево из исходного (тем более, что и в условии так и написано!):

Lisp

;; Вставка в дерево поиска
 
(defun ins-in-tree (v tree)
  (cond ((null tree) (list nil v nil))
        ((<= v (cadr tree)) (list (ins-in-tree v (car tree)) (cadr tree) (caddr tree)))
        (t (list (car tree) (cadr tree) (ins-in-tree v (caddr tree))))))
 
;; Решение
 
(defun task (tree &optional (r nil))
  (cond ((null tree) r)
        (t (let* ((rl (task (car tree) r))
                  (rr (task (caddr tree) rl)))
           (cond ((= (mod (cadr tree) 10) 7) (ins-in-tree (cadr tree) rr))
                 (t rr))))))
 
;; Создаем тестовое дерево:
 
(setq *t* '((nil 6 (nil 17 nil)) 27 ((nil 7 nil) 31 (nil 47 nil)))) 
 
==> ((NIL 6 (NIL 17 NIL)) 27 ((NIL 7 NIL) 31 (NIL 47 NIL)))
 
;; Запускаем:
 
(task *t*)
 
==> ((NIL 7 NIL) 17 ((NIL 27 NIL) 47 NIL))

@Jourex · 18.01.2018, 14:35 **[ТС]**

И правда! Спасибо огромное!

Добавлено через 8 минут
Только немного не понимаю, как вы задаете дерево?

Добавлено через 2 минуты
Например, есть дерево - (5 (3 (1 nil nil) (4 nil nil)) (7 (6 nil nil)
5
3 7
1 4 6
Выглядит вроде так. Когда ввожу его, вознкиает проблема - bad argument type - 5.
Как нужно видоизменить ввод?

@Catstail · 18.01.2018, 16:25

У меня другой порядок задания дерева: (левое поддерево - вершина - правое поддерево)

@Jourex · 18.01.2018, 19:09 **[ТС]**

А нельзя ли рисунком? Вообще не понимаю, что именно там вершина... :С

@Catstail · 18.01.2018, 20:21

Что тут непонятно? У вас (1 nil nil), а у меня (nil 1 nil). И вся разница.

@Jourex 0 / 0 / 0 Регистрация: 05.12.2017 Сообщений: 3
	18.01.2018, 14:35 [ТС]	3
	И правда! Спасибо огромное! Добавлено через 8 минут Только немного не понимаю, как вы задаете дерево? Добавлено через 2 минуты Например, есть дерево - (5 (3 (1 nil nil) (4 nil nil)) (7 (6 nil nil) 5 3 7 1 4 6 Выглядит вроде так. Когда ввожу его, вознкиает проблема - bad argument type - 5. Как нужно видоизменить ввод? 0

@Catstail Модератор 36603 / 20332 / 4220 Регистрация: 12.02.2012 Сообщений: 33,649 Записей в блоге: 13
	18.01.2018, 16:25	4
	У меня другой порядок задания дерева: (левое поддерево - вершина - правое поддерево) 0

@Jourex 0 / 0 / 0 Регистрация: 05.12.2017 Сообщений: 3
	18.01.2018, 19:09 [ТС]	5
	А нельзя ли рисунком? Вообще не понимаю, что именно там вершина... :С 0

@Catstail Модератор 36603 / 20332 / 4220 Регистрация: 12.02.2012 Сообщений: 33,649 Записей в блоге: 13
	18.01.2018, 20:21	6
	Что тут непонятно? У вас (1 nil nil), а у меня (nil 1 nil). И вся разница. 0