Удаление элементов внутри подсписков

Question

У меня есть список вида:

((1 (3 2 4)) (2 (3 1)) (3 (2 1)) (4 (1))) 

Этот список представляет собой график формы («узел» («ребер»)). Как я могу подойти к написанию процедуры, которая принимает значение, представляющее узел, например «1», и удаляет этот узел из графика. Например: (delete-node ng) с вводом 5 и '((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 (5)) (5 ​​(4))) следует выход:

((1 (3 2)) (2 (3 1)) (3 (2 1)) (4())) 

Как можно видеть из приведенного выше примера, узел и любые ребра добавлены к этому узлу оба должны быть удалены. Мой код до сих пор выглядит следующим образом:

(define graph '((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 (5)) (5 (4)))) 

;...Other procedures not shown... 

(define (delete-node n g) 
    (define (delete ls item) 
     (cond ((null? ls) nil) 
      ((pair? (car ls)) 
      (cons (delete (car ls) item) (delete (cdr ls) item))) 
      ((equal? (car ls) item) (delete (cdr ls) item)) 
      (else (cons (car ls) (delete (cdr ls) item))))) 
     (delete (filter (lambda (x) (not (eq? (car x) n))) g) n)) 

(delete-node 5 graph) 

Приведенный выше код работает, но есть ли более эффективный способ сделать это?

Answer 1

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

(define (delete-node n g) 
    (map (lambda(x) (list (car x) (filter (lambda(x) (not (= x n))) (cadr x)))) 
     (filter (lambda(x) (not (= (car x) n))) g))) 

(delete-node 5 '((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 (5)) (5 (4)))) 
     ; produces ((1 (3 2)) (2 (3 1)) (3 (2 1)) (4())) 

Несколько более эффективным решением с рекурсивной функции вместо этого следующее:

(define (delete-node n g) 
    (cond ((null? g) '()) 
     ((= (caar g) n) (delete-node n (cdr g))) 
     (else (cons (list (caar g) (filter (lambda(x) (not (= x n))) (cadar g))) 
        (delete-node n (cdr g)))))) 

Если граф является большим и вы знаете, что его структура верна, зная, что только одна исходящая дуга от узла может быть равна n, более эффективная версия может быть следующей:

(define (delete-node n g) 
    (define (delete-edge edges) 
    (cond ((null? edges) '()) 
      ((= (car edges) n) (cdr edges)) ; stop recursion when the edge is found 
      (else (delete-edge (cdr edges))))) 
    (cond ((null? g) '()) 
     ((= (caar g) n) (delete-node n (cdr g))) 
     (else (if (member n (cadar g) =) 
        (cons (list (caar g) (delete-edge (cadar g))) 
         (delete-node n (cdr g))) 
        (cons (car g) (delete-node n (cdr g))))))) 

Обратите внимание, что тест (member n (cadar g) =) сделан, чтобы избежать копирования списка ребер, когда n нет.

Answer 2

Не уверен, правильно ли я понял ваш вопрос - это соответствует вашим потребностям?

(define (delete-node node graph) 
    (define node-1 (car node)) 
    (define node-2 (cdr node)) 
    (let iter ((graph graph) (result '())) 
    (if (null? graph) 
     (reverse result) 
     (let* ((head (car graph)) (head-1 (car head)) (head-2 (cadr head))) 
      (iter (cdr graph) 
       (cons (cond 
         ((eqv? head-1 node-1) (list head-1 (remove node-2 head-2))) 
         ((eqv? head-1 node-2) (list head-1 (remove node-1 head-2))) 
         (else   head)) 
         result)))))) 

Тестирование:

> (delete-node '(2 . 3) '((1 (3 2 4)) (2 (3 1)) (3 (2 1)) (4 (1)))) 
'((1 (3 2 4)) (2 (1)) (3 (1)) (4 (1))) 
> (delete-node '(1 . 2) '((1 (3 2 4)) (2 (3 1)) (3 (2 1)) (4 (1)))) 
'((1 (3 4)) (2 (3)) (3 (2 1)) (4 (1)))