#lang racket ;;; Set Functions (define (is-element? x set) (if (null? set) #f (if (equal? x (car set)) #t (is-element? x (cdr set))))) (define (set-insert x set) (if (is-element? x set) set (cons x set))) (define (set-union set1 set2) (if (null? set1) set2 (set-insert (car set1) (set-union (cdr set1) set2)))) (define (set-intersection set1 set2) (if (null? set1) set1 (if (is-element? (car set1) set2) (cons (car set1) (set-intersection (cdr set1) set2)) (set-intersection (cdr set1) set2)))) (define (subset? sub super) (if (null? sub) #t (if (is-element? (car sub) super) (subset? (cdr sub) super) #f))) (define (set-equal? s1 s2) (if (subset? s1 s2) (subset? s2 s1) #f)) (define (make-pairs m x) (if (null? m) m (cons (list (car m) x) (make-pairs (cdr m) x)))) (define (kart m1 m2) (if (null? m2) m2 (append (make-pairs m1 (car m2)) (kart m1 (cdr m2))))) ;; Eingabe: ;; sets: Eine Liste von Listen (interpretiert als ;; Menge von Mengen) ;; element: Ein einzelnes Element ;; Ausgabe: ;; Liste von Listen, wobei jede der Originalliste ;; um das einzelne Element erweitert wird (define (add-to-sets sets element) (if (null? sets) sets (cons (cons element (car sets)) (add-to-sets (cdr sets) element)))) ;;; Potenzmenge klassisch, aber ineffizient (doppelte ;;; Berechnung von (powerset (cdr set))) (define (powerset set) (if (null? set) (list set) (append (powerset (cdr set)) (add-to-sets (powerset (cdr set)) (car set))))) ;;; Relationen werden als Liste von zwei-elementigen Listen repraesentiert. (define (left tuple) (car tuple)) (define (right tuple) (car (cdr tuple))) ;; Finde alle elemente, die in der gegebenen Relation zu element stehen. (define (find-related element relation) (if (null? relation) '() (if (equal? element (left (car relation))) (cons (right (car relation)) (find-related element (cdr relation))) (find-related element (cdr relation))))) ;;; Create a new relation that relates one element to all elements in set (define (one-relation element set) (if (null? set) '() (cons (list element (car set)) (one-relation element (cdr set))))) (define (relation-product relation2 relation1) (if (null? relation2) '() (set-union (one-relation (left (car relation2)) (find-related (right (car relation2)) relation1)) (relation-product (cdr relation2) relation1)))) (define (is-transitive? relation) (subset? (relation-product relation relation) relation)) (define (filter-transitive relset) (if (null? relset) relset (if (is-transitive? (car relset)) (cons (car relset) (filter-transitive (cdr relset))) (filter-transitive (cdr relset))))) ;;; Hausaufgabe Mengenlehre (define all-rels (kart '(a b c) '(a b c))) (display "Anzahl der transitiven Relationen ueber {1, 2, 3}: ") (display (length (filter-transitive (powerset all-rels)))) (newline) ;;; Unit tests (define univ '(1 2 3 4)) (define rel-empty '()) (define rel-id '((1 1) (2 2) (3 3) (4 4))) (define rel-all (kart univ univ)) (define rel-next '((1 2) (2 3) (3 4))) (define rel-lt '((1 2) (2 3) (3 4) (1 3) (1 4) (2 4))) rel-all (is-transitive? rel-id) (is-transitive? rel-next) (is-transitive? rel-lt) (relation-product rel-next rel-empty) (relation-product rel-next rel-id) (relation-product rel-next rel-next)