Удалить все повторения и оставить первый - Lisp

Узнай цену своей работы

Формулировка задачи:

Всем доброе время суток! Задача такова: Есть список с вложенными списками внутри, в этом списке нужно удалить все повторения по модулю и оставить только первое число. (не знаю, понятно ли сформулировал) Вот пару примеров: (1 2 -1 2) => (1 2) (-1 2 (1) 3) => (-1 2 3) (1 2 (3 4 -2 -4) -1 0) => (1 2 (3 4) 0) (-3 ((2 0 2) 2) (-4 4) (2 0 3 4) -3 2) => (-3 ((2 0)) (-4)) В принципе большая часть работы сделана, за исключением одного нюанса, никак не могу осилить под списки. Проблема в том что при входе в подсписок удаляю все повторения в хвосте на данном уровне, но не на уровне выше. (как-то так, думаю посмотрев код будет понятней) Например: Должно быть: (((2) 0 2) 1 2 2) => (((2) 0) 1) Получается: (((2) 0 2) 1 2 2) => (((2) 0) 1 2)

Немного кода:

(defun cons-if-x-not-null (x l)
  (if (NULL x) l (cons x l))
)
 
;delete x from list and all sublists
(defun delete-x-all (l x)
  (cond ((OR (NULL l) (NULL x)) nil)
        ((atom l) l)
        ((not(atom x)) l)
        ((not(atom (car l))) (cons-if-x-not-null (delete-x-all (car l) x) (delete-x-all (cdr l) x)))
        ((= (abs(car l)) (abs x)) (delete-x-all (cdr l) x))
        (T (cons-if-x-not-null (car l) (delete-x-all (cdr l) x))))
)
 
;delete duplicates from list and all sublists, leave only the first
(defun delete-dup-leave-first-all (l) 
  (cond ((atom l) l)
        ((atom (car l)) 
         (cons-if-x-not-null 
          (car l) 
          (delete-dup-leave-first-all (delete-x-all (cdr l) (car l)))))
        (T 
         (cons-if-x-not-null 
          (delete-dup-leave-first-all (car l))
          (delete-dup-leave-first-all (delete-x-all (cdr l) (caar l))) ;проблема где-то здесь
         )
        )
  )
)

Решение задачи: «Удалить все повторения и оставить первый»

textual
Листинг программы
;; Построение списка уникальных модулей
 
(defun list-abs (LST &OPTIONAL R) 
  (COND ((NULL LST) R) 
           ((LISTP (CAR LST)) (LIST-ABS (CDR LST) (LIST-ABS (CAR LST) R))) 
           ((MEMBER (ABS (CAR LST)) R) (LIST-ABS (CDR LST) R)) 
           (T (LIST-ABS (CDR LST) (CONS (ABS (CAR LST)) R)))))
 
;; Основное действие задачи:
 
(defun action (lst c)
  (cond ((null lst) nil)
        ((listp (car lst))
         (let* ((a0 (list-abs (car lst)))
                (ac (remove-if-not (lambda (x) (member x c)) a0))
                (ad (remove-if (lambda (x) (member x ac)) c)))  
               (cons (action (car lst) ac) (action (cdr lst) ad))))
        ((member (abs (car lst)) c) (cons (car lst) (action (cdr lst) (remove (abs (car lst)) c))))
        (t (action (cdr lst) c))))
 
;; Собственно, решение:
 
(defun task (lst)
   (action lst (list-abs lst)))
 
;; Проверка
 
(task '(-1 2 (1) 3))
 
==> (-1 2 NIL 3)
 
(task '(-3 ((2 0 2) 2) (-4 4) (2 0 3 4) -3 2))
 
==> (-3 ((2 0)) (-4) NIL)
 
(task '(1 2 (3 4 -2 -4) -1 0))
 
==> (1 2 (3 4) 0)

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4 из 5
Похожие ответы