Löschen von negierten Werten aus einer Liste in Schema

Question

Auflösung nimmt eine Liste und entfernt negierte Elemente aus dieser Liste. Die negierte Form wird durch eine Liste mit not im Kopf dargestellt. Zum Beispiel, wenn ich '(a (not b) c (not f) (not a) b e) habe, sollte meine Ausgabe '(c (not f) e) sein. Ich habe Funktionen geschrieben remove-x, die ein Element aus der Liste entfernt und match?, die einen Wert und gibt den übereinstimmenden Wert in der Liste zurück. Wenn mein Wert 'a ist, würde '(not a) von der Liste zurückgegeben werden.

Also mein Problem ist in der Auflösungsfunktion. Ich möchte herausfinden, ob es irgendwelche negierten Elemente gibt und wenn es welche gibt, möchte ich beide das Element und seine Negation löschen. Ich brauche auch einen Weg, um herauszufinden, wie falsch zurück, wenn keine Änderungen an meiner Liste wurden aktualisiert:

(define (resolution? alist) 
    (cond ((null? alist) '()) 
      ((not (equal? #f (match? (car alist) (cdr alist)))) 
       (and (remove-x (match? (car alist) (cdr alist)) alist) 
        (remove-x (car alist) alist))) 
      (else (cons (car alist) (resolution? cdr alist))))) 

Diese beiden Funktionen unter Arbeit:

(define (match? value alist) 
    (cond ((null? alist) #f) 
      ((and (list? (car alist)) 
       (equal? value (car (cdr (car alist))))) 
      (car alist)) 
      ((equal? value (car alist)) (car alist)) 
      (else (match? value (cdr alist))))) 

    (define (remove-x x alist) 
    (cond ((null? alist) '()) 
      ((equal? x (car alist)) (cdr alist)) 
      (else (cons (car alist) (remove-x x (cdr alist)))))) 

Answer 1

Ich denke, Ihre Lösung ein bisschen mehr braucht Ich würde vorschlagen, mehr Helfer zu schreiben. Im Kern besteht das zu lösende Problem darin, den Satzunterschied zwischen zwei Listen zu finden. Hier ist mein Schuss:

; obtain the non-negated variables in the list 
(define (vars alist) 
    (filter (lambda (e) (not (pair? e))) alist)) 

; obtain the negated variables in the list 
(define (negated-vars alist) 
    (map cadr (filter pair? alist))) 

; find the set difference between two lists 
(define (difference lst1 lst2) 
    (cond ((null? lst1) '()) 
     ((member (car lst1) lst2) 
     (difference (cdr lst1) lst2)) 
     (else 
     (cons (car lst1) (difference (cdr lst1) lst2))))) 

; build the resolution, traverse alist and for each member 
; check if it's in the corresponding white list of variables 
(define (build-resolution alist clean-vars clean-negs) 
    (cond ((null? alist) alist) 
     ((if (pair? (car alist)) 
      (member (cadar alist) clean-negs) 
      (member (car alist) clean-vars)) 
     (cons (car alist) (build-resolution (cdr alist) clean-vars clean-negs))) 
     (else 
     (build-resolution (cdr alist) clean-vars clean-negs)))) 

; pre-calculate lists, call the procedure that does the heavy lifting 
(define (resolution? alist) 
    (let* ((vs (vars alist)) 
     (nv (negated-vars alist)) 
     (clean-vars (difference vs nv)) 
     (clean-negs (difference nv vs)) 
     (resp (build-resolution alist clean-vars clean-negs))) 
    (if (equal? alist resp) #f resp))) 

Es funktioniert wie beworben:

(resolution? '(a (not b) c (not f) (not a) b e)) 
=> '(c (not f) e) 

(resolution? '(a (not b) c (not d) (not e) f g)) 
=> #f 

Answer 2

Eine alternative Lösung, die durch die Verwendung von fold vereinfacht werden könnte.

(define resolution? 
    (lambda (lst) 
    (let loop ((todo lst) 
       (result '())) 
     (if (null? todo) 
      (alist->list result) 
      (let ((item (car todo))) 
      (loop (cdr todo) 
        (modify-alist result item))))))) 


(define modify-alist 
    (lambda (alist item) 
    (let ((key (if (symbol? item) item (cadr item))) 
      (value (if (symbol? item) 'affirmed 'negated))) 
     (let loop ((todo alist) 
       (result '())) 
     (if (null? todo) 
      (cons (cons key value) result) 
      (let ((item (car todo))) 
       (if (eq? key (car item)) 
        (let* ((old-value (cdr item)) 
         (new-value (cond ((eq? value old-value) value) 
              ((eq? 'cancelled old-value) old-value) 
              (else 'cancelled)))) 
        (cons (cons key new-value) 
          (append result (cdr todo)))) 
        (loop (cdr todo) 
         (cons item result))))))))) 

(define alist->list 
    (lambda (lst) 
    (let loop ((todo lst) 
       (result '())) 
     (if (null? todo) 
      result 
      (let* ((item (car todo)) 
       (value (cdr item))) 
      (loop (cdr todo) 
        (case (cdr item) 
        ((affirmed) (cons (car item) result)) 
        ((negated) (cons (list 'not (car item)) result)) 
        (else result))))))))