BitCell

by **xlad** » 28 Mar 2010, 00:02

De ceva vreme tot incerc sa implementez o metoda de memorare a unor date ordonate dupa un anumit criteriu si incerc sa le salvez intr-un arbore binar de cautare, dar care sa fie cat mai rapid (la insertie,stergere si cautare).

Am cautat diverse astfel de metode si cea mai buna mi s-a parut AVL Tree ( http://people.ksp.sk/~kuko/bak/big/ ) si am si gasit un exemplu foarte bun, insa are o problema. :((

http://www.filefront.com/15949169/0315c.txt/

La acel cod sursa merge foate bine inserarea elementelor in arbore, dar can vreau sa sterg un element nu este sters cum trebuie (fie sterge si descendentii lui, fie da access violation error)

As fi recunoscator daca cineva m-ar ajuta sa corectez functia de stergere, astfel incat sa stearga doar elementul dorit, nu si celelalte elemente care se afla sub el si fara sa aiba buguri (access violation).

De exemplu in arborele de mai jos, daca ii dau sa stearga elementul 7 imi da eroare memory access violation, sau daca sterg 2 imi sterge si 1 si 3.

Line number On/Off | Expand/Contract | Select all

 
 
       4
     /   \
    2     6
   / \   /  \
  1  3   5   7
              \
               9
 
 

by **DarkByte** » 28 Mar 2010, 00:48

Posteaza si sursa ta, te rog.

by **xlad** » 28 Mar 2010, 11:16

AVL.pas

Line number On/Off | Expand/Contract | Select all

 
Unit AVL ;
 
  Interface
 
  Const
    Max_Tree_Nodes = 500 ;  { Constant is significant only if an ordered }
                            { array of the AVL tree nodes is desired.    }
 
  Type
    AVLTreeStr = String[12] ;
 
    BalanceSet = (Left_Tilt , Neutral , Right_Tilt) ;
 
    AVLDataRec = Record
                   Key    : AVLTreeStr ;
{                   RecOfs : LongInt    ;
                   RecNum : Word       ; }
                 End ;
 
 
    AVLPtr = ^AVL_Tree_Rec ;
    AVL_Tree_Rec = Record
                     TreeData : AVLDataRec ;
                     Balance  : BalanceSet ;
                     Left  ,
                     Right    : AVLPtr     ;
                   End ;
 
    TreeRecArray = Array[1..Max_Tree_Nodes] of AVLDataRec ;
{.PA}
    Procedure Insert_AVLTree(Var Root : AVLPtr     ;
                                 X    : AVLDataRec  ) ;
 
    Function Search_AVLTree(Var Root       : AVLPtr     ;
                                X          : AVLDataRec  ) : Boolean ;
 
    Function Search(    Root : AVLPtr     ;
                    Var X    : AVLDataRec  ) : Boolean ;
 
    Procedure AVLSort_To_Array(Var Root  : AVLPtr       ;
                               Var SortX : TreeRecArray ;
                               Var Count : Word          ) ;
 
    Function Find_AVLNode(Var Root : AVLPtr     ;
                              X    : AVLDataRec  ) : AVLPtr ;
 
    Procedure Delete_AVLTree(Var Root  : AVLPtr     ;
                                 X     : AVLDataRec ;
                             Var DelOK : Boolean     ) ;
 
 
  Implementation
{.PA}
{***********************************************************************
*                                                                      *
*      Rotate_Right                                                    *
*                                                                      *
*      Re-arranges tree nodes by rotating them to the right.           *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Rotate_Right(Var Root : AVLPtr) ;
      Var
        Ptr2 ,
        Ptr3   : AVLPtr ;
 
      Begin  { Rotate_Right }
        Ptr2 := Root^.Right ;
        If Ptr2^.Balance = Right_Tilt then
          Begin
            Root^.Right   := Ptr2^.Left ;
            Ptr2^.Left    := Root       ;
            Root^.Balance := Neutral    ;
            Root          := Ptr2       ;
          End
        Else
          Begin
            Ptr3        := Ptr2^.Left  ;
            Ptr2^.Left  := Ptr3^.Right ;
            Ptr3^.Right := Ptr2        ;
            Root^.Right := Ptr3^.Left  ;
            Ptr3^.Left  := Root        ;
 
            If Ptr3^.Balance = Left_Tilt then
              Ptr2^.Balance := Right_Tilt
            Else
              Ptr2^.Balance := Neutral ;
 
            If Ptr3^.Balance = Right_Tilt then
              Root^.Balance := Left_Tilt
            Else
              Root^.Balance := Neutral ;
 
            Root := Ptr3 ;
          End ;
 
        Root^.Balance := Neutral ;
 
      End ;  { Rotate_Right }
{.PA}
{***********************************************************************
*                                                                      *
*      Rotate_Left                                                     *
*                                                                      *
*      Re-arranges tree nodes by rotating them to the left.            *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Rotate_Left(Var Root : AVLPtr) ;
      Var
        Ptr2 ,
        Ptr3   : AVLPtr ;
 
      Begin  { Rotate_Left }
        Ptr2 := Root^.Left ;
        If Ptr2^.Balance = Left_Tilt then
          Begin
            Root^.Left    := Ptr2^.Right;
            Ptr2^.Right   := Root       ;
            Root^.Balance := Neutral    ;
            Root          := Ptr2       ;
          End
        Else
          Begin
            Ptr3        := Ptr2^.Right ;
            Ptr2^.Right := Ptr3^.Left  ;
            Ptr3^.Left  := Ptr2        ;
            Root^.Left  := Ptr3^.Right ;
            Ptr3^.Right := Root        ;
 
            If Ptr3^.Balance = Right_Tilt then
              Ptr2^.Balance := Left_Tilt
            Else
              Ptr2^.Balance := Neutral ;
 
            If Ptr3^.Balance = Left_Tilt then
              Root^.Balance := Right_Tilt
            Else
              Root^.Balance := Neutral ;
 
            Root := Ptr3 ;
          End ;
 
        Root^.Balance := Neutral ;
 
      End ;  { Rotate_Left }
{.PA}
{***********************************************************************
*                                                                      *
*      Insert_AVL                                                      *
*                                                                      *
*      Workhouse routine to perform node insertion in an AVL tree.     *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Insert_AVL(Var Root       : AVLPtr     ;
                             X          : AVLDataRec ;
                         Var InsertedOK : Boolean     ) ;
      Begin  { Insert_AVL }
        If Root = Nil then
          Begin
            New(Root) ;
            With Root^ do
              Begin
                TreeData := X       ;
                Left     := Nil     ;
                Right    := Nil     ;
                Balance  := Neutral ;
              End ;
 
            InsertedOK := True ;
          End
        Else
          If X.Key = Root^.TreeData.Key then
            Begin
              InsertedOK := False ;
              Exit ;
            End
          Else
            If X.Key <= Root^.TreeData.Key then
              Begin
                Insert_AVL(Root^.Left , X , InsertedOK) ;
                If InsertedOK then
                  Case Root^.Balance of
                    Left_Tilt  : Begin
                                   Rotate_Left(Root) ;
                                   InsertedOK := False ;
                                 End ;
 
                    Neutral    : Root^.Balance := Left_Tilt ;
 
                    Right_Tilt : Begin
                                   Root^.Balance := Neutral ;
                                   InsertedOK    := False   ;
                                 End ;
                  End ; { Case Root^.Balance of }
              End
            Else
              Begin
                Insert_AVL(Root^.Right , X , InsertedOK) ;
                If InsertedOK then
                  Case Root^.Balance of
                    Left_Tilt  : Begin
                                   Root^.Balance := Neutral ;
                                   InsertedOk    := False   ;
                                 End ;
 
                    Neutral    : Root^.Balance := Right_Tilt ;
 
                    Right_Tilt : Begin
                                   Rotate_Right(Root) ;
                                   InsertedOK := False ;
                                 End ;
                  End ;  { Case Root^.Balance of }
              End ;
 
      End ;  { Insert_AVL }
{.PA}
{***********************************************************************
*                                                                      *
*      Insert_AVLTree                                                  *
*                                                                      *
*      Insert a datum into the AVL tree.                               *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Insert_AVLTree(Var Root : AVLPtr     ;
                                 X    : AVLDataRec  ) ;
      Var
        InsertedOK : Boolean ;
 
      Begin  { Insert_AVLTree }
        InsertedOK := False ;
        Insert_AVL(Root , X , InsertedOK) ;
      End ;  { Insert_AVLTree }
 
 
{***********************************************************************
*                                                                      *
*      Search                                                          *
*                                                                      *
*      Search for datum in the AVL tree.  This interface routine is    *
*      needed because of the recursion involved in Search_AVLTree.     *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Function Search(    Root : AVLPtr     ;
                    Var X    : AVLDataRec  ) : Boolean ;
      Begin
        If Search_AVLTree(Root , X) then
          Begin
            Move(Root^ , X , SizeOf(AVLDataRec)) ;
            Search := True ;
          End
        Else
          Search := False ;
      End ;
 
 
{***********************************************************************
*                                                                      *
*      Search_AVLTree                                                  *
*                                                                      *
*      Search for datum in the AVL tree.                               *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Function Search_AVLTree(Var Root       : AVLPtr     ;
                                X          : AVLDataRec  ) : Boolean ;
      Begin  { Search_AVLTree }
        Search_AVLTree := False ;
 
        While Root <> Nil do
          Begin
            If X.Key > Root^.TreeData.Key then
              Root := Root^.Right
            Else
              Begin
                If X.Key < Root^.TreeData.Key then
                  Root := Root^.Left
                Else
                  {                         }
                  { A match has been found. }
                  {                         }
                  Begin
                    Search_AVLTree := True ;
                    Exit ;
                  End ;
              End ;
          End ;
      End ;  { Search_AVLTree }
 
 
{***********************************************************************
*                                                                      *
*      Traverse_Tree                                                   *
*                                                                      *
*        Local recursive routine used to traverse the AVL tree.        *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    PROCEDURE Traverse_Tree(Var Root  : AVLPtr       ;
                            Var SortX : TreeRecArray ;
                            Var Count : Word          ) ;
      Begin  { Traverse_Tree }
        If Root <> Nil then
          Begin
            Traverse_Tree(Root^.Left , SortX , Count) ;
            Inc(Count) ;
            If Count <= Max_Tree_Nodes then
              SortX[Count].Key := Root^.TreeData.Key ;
            Traverse_Tree(Root^.Right , SortX , Count) ;
          End ;
      End ;  { Traverse_Tree }
 
 
{***********************************************************************
*                                                                      *
*      AVLSort_To_Array                                                *
*                                                                      *
*      Return the tree data in a sorted vector (array).                *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure AVLSort_To_Array(Var Root  : AVLPtr       ;
                               Var SortX : TreeRecArray ;
                               Var Count : Word          ) ;
      Begin  { AVLSort_To_Array }
        Count := 0 ;  { Initialize number of array members. }
 
        { In-order traverse of the tree. }
        Traverse_Tree(Root , SortX , Count) ;
      End ;  { AVLSort_To_Array }
{.PA}
{***********************************************************************
*                                                                      *
*      Find_AVLNode                                                    *
*                                                                      *
*      Return the pointer to a node in the AVL tree for a requested    *
*      datum.                                                          *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Function Find_AVLNode(Var Root : AVLPtr     ;
                              X    : AVLDataRec  ) : AVLPtr ;
      Var
        No_Match : Boolean ;
 
      Begin  { Find_AVLNode }
        No_Match := True ;
 
        While (Root <> Nil) and No_Match do
          If X.Key > Root^.TreeData.Key then
            Root := Root^.Right
          Else
            If X.Key < Root^.TreeData.Key then
              Root := Root^.Left
            Else
              No_Match := False ;
 
        Find_AVLNode := Root ;
      End ;  { Find_AVLNode }
{.PA}
{***********************************************************************
*                                                                      *
*      Balance_Right                                                   *
*                                                                      *
*      Restores the balanced/near balanced state of an AVL tree by     *
*      rebalancing a right subtree.                                    *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Balance_Right(Var Root  : AVLPtr  ;
                            Var DelOK : Boolean  ) ;
      Var
        Ptr2 ,
        Ptr3   : AVLPtr ;
 
        Balnc2 ,
        Balnc3   : BalanceSet ;
 
      Begin  { Balance_Right }
        Case Root^.Balance of
          Left_Tilt  : Root^.Balance := Neutral ;
 
          Neutral    : Begin
                         Root^.Balance := Right_Tilt ;
                         DelOk := False ;
                       End ;
 
          Right_Tilt : Begin
                         Ptr2 := Root^.Right ;
                         Balnc2 := Ptr2^.Balance ;
                         If not (Balnc2 = Left_Tilt) then
                           Begin
                             Root^.Right := Ptr2^.Left ;
                             Ptr2^.Left := Root ;
                             If Balnc2 = Neutral then
                               Begin
                                 Root^.Balance := Right_Tilt ;
                                 Ptr2^.Balance := Left_Tilt  ;
                                 DelOk := False ;
                               End
                             Else
                               Begin
                                 Root^.Balance := Neutral ;
                                 Ptr2^.Balance := Neutral ;
                               End ;
 
                             Root := Ptr2 ;
                           End
                         Else
                           Begin
                             Ptr3        := Ptr2^.Left    ;
                             Balnc3      := Ptr3^.Balance ;
                             Ptr2^.Left  := Ptr3^.Right   ;
                             Ptr3^.Right := Ptr2          ;
                             Root^.Right := Ptr3^.Left    ;
                             Ptr3^.Left  := Root          ;
 
                             If Balnc3 = Left_Tilt then
                               Ptr2^.Balance := Right_Tilt
                             Else
                               Ptr2^.Balance := Neutral ;
 
                             If Balnc3 = Right_Tilt then
                               Root^.Balance := Left_Tilt
                             Else
                               Root^.Balance := Neutral ;
                             Root := Ptr3 ;
                             Ptr3^.Balance := Neutral ;
                           End ;
                       End ;
        End ;  { CAse Root^.Balance of }
      End ;  { Balance_Right }
{.PA}
{***********************************************************************
*                                                                      *
*      Balance_Left                                                    *
*                                                                      *
*      Restores the balanced/near balanced state of an AVL tree by     *
*      rebalancing a left subtree.                                     *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Balance_Left(Var Root  : AVLPtr  ;
                           Var DelOK : Boolean  ) ;
      Var
        Ptr2 ,
        Ptr3   : AVLPtr ;
 
        Balnc2 ,
        Balnc3   : BalanceSet ;
 
      Begin  { Balance_Left }
        Case Root^.Balance of
          Left_Tilt  : Root^.Balance := Neutral ;
 
          Neutral    : Begin
                         Root^.Balance := Left_Tilt ;
                         DelOk := False ;
                       End ;
 
          Right_Tilt : Begin  { Right_Tilt }
                         Ptr2 := Root^.Left ;
                         Balnc2 := Ptr2^.Balance ;
                         If not (Balnc2 = Right_Tilt) then
                           Begin
                             Root^.Left  := Ptr2^.Right ;
                             Ptr2^.Right := Root        ;
                             If Balnc2 = Neutral then
                               Begin
                                 Root^.Balance := Left_Tilt  ;
                                 Ptr2^.Balance := Right_Tilt ;
                                 DelOk := False ;
                               End
                             Else
                               Begin
                                 Root^.Balance := Neutral ;
                                 Ptr2^.Balance := Neutral ;
                               End ;
 
                             Root := Ptr2 ;
                           End
                         Else
                           Begin
                             Ptr3        := Ptr2^.Right   ;
                             Balnc3      := Ptr3^.Balance ;
                             Ptr2^.Right := Ptr3^.Left    ;
                             Ptr3^.Left  := Ptr2          ;
                             Root^.Left  := Ptr3^.Right   ;
                             Ptr3^.Right := Root          ;
 
                             If Balnc3 = Right_Tilt then
                               Ptr2^.Balance := Left_Tilt
                             Else
                               Ptr2^.Balance := Neutral ;
 
                             If Balnc3 = Left_Tilt then
                               Root^.Balance := Right_Tilt
                             Else
                               Root^.Balance := Neutral ;
 
                             Root := Ptr3 ;
                             Ptr3^.Balance := Neutral ;
                           End ;
                       End ;  { Right_Tilt }
        End ;  { Case Root^.Balance of }
      End ;  { Balance_Left }
{.PA}
{***********************************************************************
*                                                                      *
*      Delete_Both_Children                                            *
*                                                                      *
*        Delete a node with two empty subtrees.                        *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
  Procedure Delete_Both_Children(Var Root ,
                                     Ptr    : AVLPtr  ;
                                 Var DelOK  : Boolean  ) ;
    Begin  { Delete_Both_Children }
      If Ptr^.Right = Nil then
        Begin
          Root^.TreeData := Ptr^.TreeData ;
          Ptr   := Ptr^.Left ;
          DelOk := True ;
        End
      Else
        Begin
          Delete_Both_Children(Root , Ptr^.Right , DelOK) ;
          If DelOk then
            Balance_Left(Ptr , DelOK) ;
        End ;
    End ;  { Delete_Both_Children }
{.PA}
{***********************************************************************
*                                                                      *
*      Delete_AVL                                                      *
*                                                                      *
*        Recursive routine used for node deletion.                     *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Delete_AVL(Var Root  : AVLPtr     ;
                             X     : AVLDataRec ;
                         Var DelOK : Boolean     ) ;
      Var
        Ptr : AVLPtr ;
 
      Begin  { Delete_AVL }
        If Root = Nil then
          DelOK := False
        Else
          If X.Key < Root^.TreeData.Key then
            Begin
              Delete_AVL(Root^.Left , X , DelOK) ;
              If DelOK then
                Balance_Right(Root , DelOK) ;
            End
          Else
            If X.Key > Root^.TreeData.Key then
              Begin
                Delete_AVL(Root^.Right , X , DelOK) ;
                If DelOK then
                  Balance_Left(Root , DelOK) ;
              End
            Else
              Begin
                Ptr := Root ;
                If Root^.Right = Nil then
                  Begin
                    Root := Root^.Left ;
                    DelOK := True ;
                  End
                Else
                  Begin
                    Delete_Both_Children(Root , Root^.Left , DelOK) ;
                    If DelOK then
                      Balance_Right(Root , DelOK) ;
                  End ;
              End ;
 
              Dispose(Ptr) ;
      End ;  { Delete_AVL }
{.PA}
{***********************************************************************
*                                                                      *
*      Delete_AVLTree                                                  *
*                                                                      *
*      Deletes the key of X if it is present in the AVL tree.          *
*                                                                      *
*      Modifications                                                   *
*      =============                                                   *
*                                                                      *
***********************************************************************}
 
    Procedure Delete_AVLTree(Var Root  : AVLPtr     ;
                                 X     : AVLDataRec ;
                             Var DelOK : Boolean     ) ;
      Begin  { Delete_AVLTree }
        DelOK := False ;
 
        Delete_AVL(Root , X , DelOK) ;
      End ;  { Delete_AVLTree }
 
 
  Begin  { AVL_Tree }
  End.   { AVL_Tree }
 

Si intr-o fereastra oarecare (unit1/form1)

Line number On/Off | Expand/Contract | Select all

 
procedure TForm1.FormCreate(Sender: TObject);
Var TempAVL:AVLPtr;
    X:AVLDataRec;
    b:Boolean;
begin
 TempAvl := Nil;
 X.Key := '5';//Chiar daca am pus sa memoreze string-uri, se poate schimba usor implementarea sa salveze numere si alte tipuri
 Insert_AVLTree(TempAvl,X);
 X.Key := '6';
 Insert_AVLTree(TempAvl,X);
 X.Key := '7';
 Insert_AVLTree(TempAvl,X);
 X.Key := '3';
 Insert_AVLTree(TempAvl,X);
 X.Key := '4';
 Insert_AVLTree(TempAvl,X);
 X.Key := '2';
 Insert_AVLTree(TempAvl,X);
 X.Key := '9';
 Insert_AVLTree(TempAvl,X);
 X.Key := '1';
 Insert_AVLTree(TempAvl,X);
 X.Key := '7';
 Delete_AVLTree(TempAvl,X,b);//Aici nu merge
 X.Key := '2';
 Delete_AVLTree(TempAvl,X,b);
 X.Key := '5';
 Delete_AVLTree(TempAvl,X,b);
 X.Key := '3';
 Delete_AVLTree(TempAvl,X,b);
end;
 

BitCell

Problema la arbori binari

Problema la arbori binari

Re: Problema la arbori binari

Re: Problema la arbori binari

Who is online