
          ;---------------------------------------------------;
          ;   INF III Aufgabe 3 - Mengenoperationen in LISP   ;
          ;                                                   ;
          ;   Beispiel zum LISP-Interpreter von TOY Prolog    ;
          ;---------------------------------------------------;


(setq emptyset 'nil)                ; Konstante : leere Menge

(de emptyp (set) (null set))        ; Pr„dikat : ist 'set' die leere Menge ?

(de setwith (elem) (list elem))     ; x --> { x }

(de setp (structure)                ; prft, ob 'structure' eine Menge ist
   (cond ((emptyp structure) t)
         ((atom structure) nil)
         (t (and (or (atom (car structure)) (setp (car structure)))
                 (setp (cdr structure))
                 (not (setmemberp (car structure) (cdr structure)))
            )
         )
   )
)

(de setmemberp (elem set)           ; prft, ob elem Element von set ist
   (cond ((emptyp set) nil)
         ((atom elem) (member elem set))
         (t (tryset elem set))
   )
)

(de tryset (setelem set)
   (cond ((emptyp set) nil)
         ((atom (car set)) (tryset setelem (cdr set)))
         (t (cond ((setequalp setelem (car set)) t)
                  (t (tryset setelem (cdr set)))
            )
         )
   )
)

; Mengengleichheit :

(de setequalp (set1 set2) (and (sub1 set1 set2) (sub1 set2 set1)))

; Vereinigung :

(de setunion (set1 set2)   ; bildet die Vereinigung von set1 & set2
   (cond ((emptyp set1) set2)
         ((setmemberp (car set1) set2) (setunion (cdr set1) set2))
         (t (cons (car set1) (setunion (cdr set1) set2)))
   )
)

; Untermengenrelation : (sub set1 set2) ist T, falls set1 Untermenge von set2

(de sub (set1 set2)
   (cond ((and (setp set1) (setp set2)) (sub1 set1 set2))
         (t (print '(Argument von sub ist keine Menge)) nil)
   )
)

(de sub1 (set1 set2)
   (cond ((emptyp set1) t)
         ((setmemberp (car set1) set2) (sub1 (cdr set1) set2))
         (t nil)
   )
)

; Potenzmenge von set

(de power (set)
   (cond ((setp set) (power1 set))
         (t (print '(Argument von power ist keine Menge)) nil)
   )
)

(de power1 (set)
   (cond ((emptyp set) (setwith emptyset))
         (t (seq (pow) (setq pow (power1 (cdr set)))
                       (setunion pow (distribute pow (car set)))
            ))
   )
)

; Funktionenmenge von set1 nach set2

(de func (set1 set2)
   (cond ((and (setp set1) (setp set2)) (func1 set1 set2))
         (t (print '(Argument von func ist keine Menge)) nil)
   )
)

(de func1 (set1 set2)
   (cond ((emptyp set1) (setwith emptyset))
         (t (seq (funcx pairset) (setq funcx (func1 (cdr set1) set2))
                                 (setq pairset (pairs (car set1) set2))
                                 (distribset funcx pairset)
            ))
   )
)

; berechne { (a, y) | y aus Y } , a und Y gegeben
;
; (x, y) wird dargestellt als (x | y)

(de pairs (elem set)
   (cond ((emptyp set) emptyset)
         (t (setunion (setwith (list elem '| (car set)))
                      (pairs elem (cdr set))
            ))
   )
)

; berechne { A vereinigt { b } | A aus X, b aus Y }

(de distribset (set1 set2)
   (cond ((emptyp set2) emptyset)
         (t (setunion (distribute set1 (car set2))
                      (distribset set1 (cdr set2))
            ))
   )
)

; berechne { A vereinigt { b } | A aus X }

(de distribute (set elem)
   (cond ((emptyp set) emptyset)
         (t (setunion (setwith (setunion (car set) (setwith elem)))
                      (distribute (cdr set) elem)
            ))
   )
)

; (c) Jens J. Kilian 1987

(end)
