DataMuseum.dk

top - metrics - download

    Length: 3843 (0xf03)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Text_Io;
package body Search_Tree is

    function Normaliser (S : String; Length : Natural) return Index is
    begin
        if S'Length >= Length then
            return S (S'First .. S'First + Length - 1);
        else
            return S & (1 .. Length - S'Length => ' ');
        end if;
    end Normaliser;


    function Is_Empty (The_Object : Object) return Boolean is
    begin
        return (The_Object = null);
    end Is_Empty;


    procedure Build (The_Tree : in out Object;
                     One_Index : in String;
                     One_Element : in Element) is
    begin
        The_Tree := new Node'(The_Index => Normaliser (One_Index, 80),
                              The_Element => One_Element,
                              Left => null,
                              Right => null);
    end Build;


    function Under_Left_Tree (A : Object) return Object is
    begin
        return A.Left;
    end Under_Left_Tree;


    function Under_Right_Tree (A : Object) return Object is
    begin
        return A.Right;
    end Under_Right_Tree;


    function Search (The_Index : in String; A : Object) return Object is
        One_Tree : Object;
    begin
        if A = null then
            return null;
        else
            One_Tree := A;
            while not "=" (Normaliser (The_Index, 80), One_Tree.The_Index) loop
                if Normaliser (The_Index, 80) > One_Tree.The_Index then
                    One_Tree := Under_Right_Tree (One_Tree);
                else
                    One_Tree := Under_Left_Tree (One_Tree);
                end if;
                exit when Is_Empty (One_Tree);
            end loop;
            return One_Tree;
        end if;
    end Search;


    procedure Insert_Element (The_Tree : in out Object;
                              The_Element : in Element;
                              The_Index : in String) is
    begin
        if Is_Empty (The_Tree) then
            Build (The_Tree, The_Index, The_Element);
        else
            if "=" (Normaliser (The_Index, 80), The_Tree.The_Index) then
                Text_Io.Put_Line ("Cet element existe deja");
            else
                if Normaliser (The_Index, 80) > The_Tree.The_Index then
                    Insert_Element (The_Tree.Right, The_Element, The_Index);
                else
                    Insert_Element (The_Tree.Left, The_Element, The_Index);
                end if;
            end if;

        end if;
    end Insert_Element;


    procedure Create (The_Tree : in out Object) is
    begin
        The_Tree := null;
    end Create;


    function Exist_Element
                (The_Tree : in Object; The_Index : in String) return Boolean is
    begin
        return Search (Normaliser (The_Index, 80), The_Tree) /= null;
    end Exist_Element;


    procedure Consulter_Element (The_Tree : in Object;
                                 The_Index : in String;
                                 The_Element : out Element;
                                 Found : out Boolean) is
        One_Tree : Object;
    begin
        One_Tree := Search (The_Index, The_Tree);
        if One_Tree = null then
            Found := False;
        else
            Found := True;
            The_Element := One_Tree.The_Element;
        end if;
    end Consulter_Element;


    procedure Modifier_Element (The_Tree : in out Object;
                                The_Index : in String;
                                The_Element : in Element;
                                Found : out Boolean) is
        One_Tree : Object;
    begin
        One_Tree := Search (The_Index, The_Tree);
        if One_Tree = null then
            Found := False;
        else
            Found := True;
            One_Tree.The_Element := The_Element;
        end if;
    end Modifier_Element;

end Search_Tree;