12.4 Ein allgemeines Mengenkonstrukt als Beispiel

In diesem Abschnitt wollen wir ein Paket realisieren, das den abstrakten Datentyp ,,Menge`` dermaßen darstellt, daß basierend auf einer ,,allgemeinen Logik`` unterschiedliche Ausprägungen von Mengen möglich sind. Im speziellen werden wir Standard-Mengen und Fuzzy-Mengen als Beispiele angeben.

Da der Typ Boolean nicht getaggt ist, können wir ihn nicht einfach durch Typerweiterung für unsere Zwecke anpassen. Es ist daher zunächst notwendig, ein allgemeines Logik-Paket zu erstellen, von dem dann spezielle Logiken wie etwa die Standard-Logik (zweiwertige Logik) oder die Fuzzy-Logik abgeleitet werden können. Wir werden uns dabei auf die Operationen ,,und``, ,,oder`` und ,,not`` beschränken. Unser Paket hat daher folgendes Aussehen:

package General_Boolean is

type gen_bool is abstract tagged private;

function "and"(left,right: gen_bool) return gen_bool is abstract;
function "or" (left,right: gen_bool) return gen_bool is abstract;
function "not"(val: gen_bool) return gen_bool is abstract;

private

type gen_bool is abstract tagged null record;

end General_Boolean;

Damit als Basis schaffen wir eine Spezifikation für unser allgemeines Mengen-Paket.

with General_Boolean;

generic
type item is private;
type set_bool is new General_Boolean.gen_bool with private;
package General_Set is

type set is tagged private;

function Is_Member(I: item; s: set) return set_bool'CLASS;
function Union(left,right: set) return set;
function Intersection(left,right: set) return set;

type Member_Function_Pointer is access
function(I: item) return set_bool'CLASS;

function Create(Member_Function: Member_Function_Pointer) return set;

private

type node;
type node_pointer is access all node'CLASS;

type set is tagged
record
root: node_pointer;
end record;

type node is abstract tagged null record;

function Process(I:item; np: access node) return set_bool'CLASS is abstract;

end General_Set;

zur Bildung des Durchschnitts zweier Mengen. Da es sehr schwierig ist, für die Schaffung von Mengen eine allgemein passende Operation anzugeben, überlassen wir die Realisierung dieser Operation dem Benutzer des Paketes, indem wir eine Funktion Create spezifizieren, die eine Menge zurückgibt und deren Parameter ein Pointer auf eine Funktion ist. Mit Hilfe dieser Funktion kann der Benutzer beliebige (Grund-)Mengen generieren, die er dann mit den anderen Operationen kombinieren kann.

Im Private-Teil des Paketes sehen wir bereits den ersten Teil der Implementierung des datentyps set. Alle Grund-Mengen werden als Blätter eines Baumes repräsentiert, die Operationen Union und Intersection werden als

interne, binäre Knoten eines Baumes dargestellt. Der gesamte Baum ist die interne Darstellung einer Menge. Der Typ node ist der abstrakte Vatertyp der Knoten des Baumes. Für ihn ist auch eine abstrakte Operation Process definiert, die uns für die Traversierung des Baumes gute Dienste leisten wird.

package body General_Set is

type binary_operator is (and_op, or_op);

type binary_node is new node with
record
left, right: node_pointer;
op: binary_operator;
end record;

function Process(I:item; np: access binary_node) return set_bool'CLASS;

function Process(I:item; np: access binary_node) return set_bool'CLASS
is
left_result: set_bool'CLASS := Process(I,np.left);
right_result: set_bool'CLASS := Process(I,np.right);
begin
case np.op is
when and_op = $>$
return (left_result and right_result);
when or_op = $>$
return (left_result or right_result);
end case;
end Process;

type leave is new node with
record
m: Member_Function_Pointer;
end record;

function Process(I:item; np: access leave) return set_bool'CLASS;

function Process(I:item; np: access leave) return set_bool'CLASS
is
begin
return np.m(I);
end Process;

function Is_Member(I: item; s: set) return set_bool'CLASS
is
begin
return Process(I,s.root);
end Is_Member;

function Union(left,right: set) return set
is
h: set;
bn: binary_node;
begin
bn.op := or_op;
bn.left := left.root;
bn.right := right.root;
h.root := new binary_node'(bn);
return h;
end Union;

function Intersection(left,right: set) return set

is
h: set;
bn: binary_node;
begin
bn.op := and_op;
bn.left := left.root;
bn.right := right.root;
h.root := new binary_node'(bn);
return h;
end Intersection;

function Create(Member_Function: Member_Function_Pointer) return set
is
h: set;
l: leave;
begin
l.m := Member_Function;
h.root := new leave'(l);
return h;
end Create;

end General_Set;