Etherogeneous N ary tree : search, save And Restore (list impl)

Etherogeneous N ary tree : search, save And Restore (list impl) - Algo - Programmation

Marsh Posté le 25-09-2024 à 09:49:22    

Bonjour,
 
J'ai corrigé au mieux des algorithme de sauvegarde et restauration d'un arbre n aires.
 
Corrigez moi si je me trompe...
 
 
Je vous donne des bout de code avec Ada.
 
 
La sauvegarde est une procedure récursive enregistrant chaque noeud et feuille avec leur nombre d'enfant respectif ; Place le caractère bell pour indiquer la profondeur du noeud ; Sauvegarde dans un fichier.
La restauration est une procedure récursive de lecture de l'arbre et la reconstruction de l'arbre.
 
Arbre N aires d'un objet à l'échelle de classe. - Using bell character.
Specification

Code :
  1. type Tag_Name is 
  2.          (Null_Tag,
  3.           Universe, Animal, Content,  Planning, Plan, Activity,  Event, Note, 
  4.           Perso_Ac, Def_Class, Acc_Line, Deal, Entep_Ac, Contact, Car, House,
  5.           Saved_Ac);
  6.       
  7.  
  8.  
  9.       subtype Abstracted_Index is Positive range 1..Ptr_Max;
  10.  
  11.       type Abstracted_Class(Tag : Tag_Name);
  12.       type Abstracted_Access is access all Abstracted_Class'Class;
  13.       function Equal(Left, Right : in Abstracted_Access) return Boolean;
  14.  
  15.  
  16.  
  17.       package Abstracted_Vectors is new Vectors(Abstracted_Index, Abstracted_Access, Equal);
  18.       use Abstracted_Vectors;
  19.       subtype Objects_vector is Abstracted_Vectors.Vector;
  20.  
  21.       type Abstracted_Class(Tag : Tag_Name) is abstract tagged
  22.          record
  23.             Index       : Abstracted_Index := 1;
  24.         Name        : Name_Type := (others => Wide_Character'Val(32));
  25.         Vector      : Objects_Vector;
  26.         Create_Date : Time := Clock;
  27.          end record;
  28.  
  29.       procedure Write (O : in Abstracted_Class;File : in W_Io.File_Type) is abstract;
  30.       procedure Read (O : in out Abstracted_Class;File : in W_Io.File_Type) is abstract;
  31.       procedure Random (O : in out Abstracted_Class) is abstract;
  32.  
  33.  
  34.       
  35.       type Terminal_record is tagged
  36.          record
  37.             Obj    : Abstracted_Access;
  38.             V_Switch : Objects_Vector;
  39.             Obj_Cur  : Abstracted_Access;
  40.       end record;


Implementation
Voici les procedure de sauvegarde et de restauration de l'arbre dans lequelles j'utilise quelque procedure externe :
- Global_Read : permet de lire un noeud dans un fichier ; Non fournit
- Global_Print : permet d'afficher l'état d'un noeud ; Le nombre d'enfant trié par Tag_Name ; non fournit
- parent : permet d'aller au noeud parent ;
- Switch : permet d'aller au noeud enfant à l'index indiqué.
Sauvegarde

Code :
  1. procedure Save_Object (Object : Abstracted_Access;              
  2.          File : W_Io.File_Type;
  3.          Index  : Natural := 0) is
  4.          O : Abstracted_Access := Object;                  
  5.          New_Index : Natural := Index;
  6.       begin      
  7.       
  8.          O.all.Write(File);
  9.       
  10.          W_Io.Put_Line(File, To_Wide_String(Integer'Image(Integer(Abstracted_Vectors.Length(O.Vector)))));
  11.       
  12.          W_Io.Put_Line(File, Wide_Character'Val(7) & "" );
  13.       
  14.          if not Is_Empty(O.Vector) then
  15.       
  16.       
  17.             for I in 1..Last_Index(O.Vector) loop
  18.                declare
  19.                   E : constant Abstracted_Access :=
  20.                   Abstracted_Vectors.Element(O.Vector, I);
  21.                begin
  22.       
  23.                   Save_Object(E, File, New_Index+1);           
  24.       
  25.       
  26.                end;
  27.             end loop;          
  28.       
  29.       
  30.             for I in 0..Index loop
  31.                W_Io.Put_Line(File, Wide_Character'Val(7) & "" );
  32.             end loop;
  33.       
  34.       
  35.           end if;
  36.       
  37.       
  38.       
  39.       end Save_Object;
  40.       
  41.     
  42.  
  43.       
  44.       procedure Save (Object : in Abstracted_Access;
  45.          Filename : in String) is
  46.          File : W_Io.File_Type;
  47.       
  48.       begin
  49.       
  50.          W_Io.Create(File, W_Io.Out_File, Filename);
  51.       
  52.          Save_Object(Object, File);
  53.       
  54.          W_Io.Close(File);
  55.       
  56.       end Save;
  57.     
  58.  
  59. Restauration
  60.  
  61.    
  62.    procedure Restore_Vector(T : in out Terminal_Record;
  63.                    File : W_Io.File_Type) is
  64.       
  65.       
  66.       Line_Index : positive := 1;     
  67.       Is_End : Boolean := False;
  68.       Wchar : Wide_Character;
  69.  
  70.       Prompt : Name_Type;
  71.       Success : Boolean := True;
  72.       O : Abstracted_Access;     
  73.       End_Of_File : Boolean := False;
  74.       
  75.       P  : Natural := 0;
  76.       Child_Numb : Natural := 0;
  77.    begin
  78.       
  79.       
  80.       declare
  81.      Children : Wide_String := W_Io.Get_Line(File);
  82.       begin
  83.      Child_Numb := Natural'Value(To_String(Children));
  84.      
  85.      if Child_Numb /= 0 then
  86.         for I in 1..Child_Numb loop
  87.            if not W_Io.End_Of_File(File) then
  88.               -- ici on cherche le caractère bell
  89.           while not W_Io.End_Of_File(File) loop
  90.           begin
  91.             W_Io.Look_ahead(File, Wchar, Is_end);
  92.             if Is_Graphic(To_Character(Wchar)) then
  93.                exit;           
  94.             end if;
  95.             
  96.             W_Io.Get_Immediate(File, Wchar);
  97.             if Wchar = Wide_Character'Val(7) then
  98.                P := P + 1;                      
  99.             end if;
  100.              end;
  101.           end loop;
  102.      
  103.           Global_Read(File, End_Of_File, O);
  104.           
  105.           
  106.  
  107.           Global_Print(O, Win, Line_index);
  108.           
  109.           
  110.           
  111.           if P > 0 and P <= Natural(Length(T.V_Switch)) then
  112.              
  113.  
  114.              for I in 1..P-1 loop
  115.             Parent(T, Prompt);
  116.              end loop;                     
  117.              
  118.              
  119.              Success := False;
  120.           elsif P > 0 then
  121.              
  122.  
  123.              for I in 1..P loop
  124.             Parent(T, Prompt);
  125.              end loop;
  126.              
  127.              
  128.           end if;
  129.           Line_Index := 1;
  130.           if not Success then                     
  131.              if O.Index /= 1 then
  132.             
  133.  
  134.             T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
  135.  
  136.              elsif not Is_Empty (T.Obj_Cur.Vector) and O.Index = 1 then           
  137.             Switch(T, Last_Index(T.Obj_Cur.Vector), Prompt, Success);
  138.             
  139.  
  140.  
  141.             T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
  142.             
  143.              end if;
  144.              
  145.           elsif not Is_Empty (T.Obj_Cur.Vector) and O.Index = 1 then           
  146.              Switch(T, Last_Index(T.Obj_Cur.Vector), Prompt, Success);
  147.              if Success then
  148.  
  149.             T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;                   
  150.              else
  151.             raise Program_Error;
  152.              end if;                           
  153.           else
  154.  
  155.              T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
  156.           end if;
  157.           
  158.  
  159.           if not W_Io.End_Of_File(File) then
  160.              Restore_Vector(T, File);
  161.           end if;        
  162.     
  163.            end if;     
  164.         end loop;
  165.         
  166.      end if;
  167.      
  168.      -- le code ci-dessous est peut-être inutile.
  169.      if not W_Io.End_Of_File(File) then
  170.         Restore_Vector(T, File);
  171.      end if;        
  172.     
  173.       exception
  174.      when others =>
  175.            Put("Error when restore object" );
  176.            
  177.      end;
  178.       
  179.             
  180.    end Restore_Vector;
  181.  
  182.     
  183.  
  184.    
  185.    procedure Restore_Object (T : in out Terminal_Record;
  186.                     File : W_Io.File_Type) is
  187.       End_Of_File : Boolean := False;
  188.       Vector : Objects_Vector;
  189.       
  190.    begin
  191.  
  192.       if not W_Io.End_Of_File(File) then
  193.      
  194.         Global_Read(File, End_Of_File, T.Obj);
  195.      
  196.       end if;
  197.       
  198.       T.Obj_Cur := T.Obj;
  199.       
  200.       if not W_Io.End_Of_File(File) then
  201.      
  202.      
  203.      Restore_Vector(T, File);
  204.      
  205.       end if;            
  206.       
  207.    end Restore_Object;
  208.    
  209.    procedure Restore(T : in out Terminal_Record;
  210.                 Filename : in String) is
  211.       
  212.       File : W_Io.File_Type;
  213.    begin
  214.       
  215.       W_Io.Open(File, W_Io.in_File, Filename);
  216.       if not W_Io.End_Of_File(File) then
  217.         Restore_Object(T, File);
  218.       end if;
  219.       
  220.       W_Io.Close(File);
  221.    end Restore;

   
 
Navigation
 
   

Code :
  1. procedure Parent(T : in out Terminal_Record;
  2.                Prompt : out Name_Type) is
  3.       
  4.       V : Objects_Vector := T.V_Switch;
  5.    begin
  6.       if not Is_Empty(V) then
  7.         if Last_Index(V) >= 1 then
  8.            T.Obj_Cur := Last_Element(V);
  9.            if T.Obj_Cur /= null then
  10.               Prompt := T.Obj_Cur.Name;
  11.               if Last_Index(V) > 1 then
  12.              Delete(V, Last_Index(V));
  13.               end if;
  14.            end if;
  15.         end if;
  16.       end if;
  17.       T.V_Switch := V;
  18.    end Parent;
  19.    
  20.  
  21.  
  22.    procedure Switch(T : in out Terminal_Record;
  23.                Num : in Abstracted_Index;
  24.                Prompt : out Name_Type;
  25.                Success : out boolean) is
  26.       Vector : Objects_Vector;     
  27.    begin
  28.       Success := False;
  29.       Prompt := (others => Wide_Character'Val(32));
  30.       if T.Obj_Cur /= null then
  31.         Vector := T.Obj_Cur.Vector;
  32.         if not Is_Empty(Vector) then
  33.            if Num <= Last_Index(Vector) then
  34.               T.V_Switch := T.V_Switch & T.Obj_Cur;
  35.               T.Obj_Cur := Abstracted_Vectors.Element(Vector, Num);
  36.               if T.Obj_Cur /= null then
  37.              Prompt := T.Obj_Cur.Name;             
  38.              Success := True;
  39.               else
  40.              raise Program_Error;             
  41.               end if;
  42.            end if;
  43.         end if;
  44.       end if;     
  45.    end Switch;


 
 
 
Merci pour vos retour.


Message édité par lady287 le 19-11-2024 à 09:54:59
Reply

Marsh Posté le 25-09-2024 à 09:49:22   

Reply

Marsh Posté le 18-11-2024 à 05:37:39    

Bonjour,
 
J'ai fais plus simple ou plus efficace en tout cas.
 
 
Restauration :

Code :
  1. procedure Restore_Vector(T : in out Terminal_Type;
  2.                    File : W_Io.File_Type) is
  3.       
  4.       Success : Boolean := False;
  5.       N, O : Abstract_Access;     
  6.       Child_Childs, Child_Numb : Natural := 0;
  7.       End_Of_File : Boolean := False;
  8.    begin
  9.       
  10.       if T.Root = null then
  11.      Global_Read(File, End_Of_File, T.Root);
  12.      
  13.      T.Cur := T.Root;
  14.      
  15.      declare
  16.         Children : constant Wide_String := W_Io.Get_Line(File);
  17.      begin
  18.      
  19.         Child_Numb := Natural'Value(Handling.To_String(Children));
  20.         if Child_Numb = 0 then
  21.            if not W_Io.End_Of_File(File) then
  22.           Restore_Vector(T, File);
  23.            end if;
  24.         else
  25.            for Child in 1..Child_Numb loop
  26.           Global_Read(File, End_Of_File, N);
  27.           T.Cur.Childs := T.Cur.Childs & N;
  28.           declare
  29.              Children : constant Wide_String := W_Io.Get_Line(File);
  30.           begin
  31.              
  32.              Child_Childs := Natural'Value(Handling.To_String(Children));
  33.              if Child_Childs /= 0 then
  34.             Switch(T, Last_Index(T.Cur.Childs), Success);
  35.             if not W_Io.End_Of_File(File) then
  36.                Restore_Vector(T, File);
  37.             end if;
  38.             Parent(T);
  39.              end if;
  40.           
  41.           exception
  42.              when others =>
  43.             
  44.             null;
  45.           end;
  46.            end loop;
  47.         end if;
  48.      
  49.  
  50.      end;
  51.       else
  52.      
  53.      Global_Read(File, End_Of_File, O);
  54.      T.Cur.Childs := T.Cur.Childs & O;
  55.      declare
  56.         Children : constant Wide_String := W_Io.Get_Line(File);
  57.      begin
  58.         
  59.         Child_Numb := Natural'Value(Handling.To_String(Children));
  60.         if Child_Numb /= 0 then
  61.            for Child in 1..Child_Numb loop
  62.           Global_Read(File, End_Of_File, N);
  63.           T.Cur.Childs := T.Cur.Childs & N;
  64.           declare
  65.              Children : constant Wide_String := W_Io.Get_Line(File);
  66.           begin
  67.              
  68.              Child_Childs := Natural'Value(Handling.To_String(Children));
  69.              if Child_Childs /= 0 then
  70.             Switch(T, Last_Index(T.Cur.Childs), Success);
  71.             for Child in 1..Child_childs loop
  72.                if not W_Io.End_Of_File(File) then
  73.                   Restore_Vector(T, File);
  74.                end if;
  75.             end loop;
  76.             Parent(T);
  77.              end if;
  78.              
  79.           exception
  80.              when others =>
  81.             
  82.             null;
  83.           end;
  84.            end loop;
  85.         end if;
  86.      end;
  87.      
  88.       end if;
  89.    end Restore_Vector;
  90.  
  91. procedure Restore(T : in out Terminal_Type;
  92.                 Filename : in String) is
  93.       
  94.       End_Of_File : Boolean := False;
  95.       File : W_Io.File_Type;
  96.    begin
  97.       
  98.       W_Io.Open(File, W_Io.in_File, Filename);
  99.       if not W_Io.End_Of_File(File) then
  100.         Restore_Vector(T, File);
  101.       end if;
  102.       
  103.       W_Io.Close(File);
  104.    end Restore;


 
Sauvegarde :
 

Code :
  1. procedure Save_Object (Object : Abstract_Access;              
  2.                  File : W_Io.File_Type;
  3.                  Index  : Natural := 0) is
  4.       O : constant Abstract_Access := Object;
  5.       New_Index : Natural := Index;
  6.    begin      
  7.       
  8.       O.all.Write(File);
  9.       
  10.       W_Io.Put_Line(File, Handling.To_Wide_String(Integer'Image(Integer(Abstract_Vectors.Length(O.Childs)))));
  11.  
  12.       if not Is_Empty(O.Childs) then
  13.         for I in 1..Last_Index(O.Childs) loop
  14.            declare
  15.               E : constant Abstract_Access :=
  16.             Abstract_Vectors.Element(O.Childs, I);
  17.            begin
  18.            
  19.               Save_Object(E, File, New_Index+1);           
  20.            end;
  21.         end loop;          
  22.      
  23.       end if;
  24.   end Save_Object;
  25. procedure Save (Object : in Abstract_Access;
  26.               Filename : in String) is
  27.       File : W_Io.File_Type;
  28.       
  29.    begin
  30.       
  31.       W_Io.Create(File, W_Io.Out_File, Filename);
  32.       
  33.       Save_Object(Object, File);
  34.       
  35.       W_Io.Close(File);
  36.       
  37.    end Save;


Reply

Marsh Posté le 19-11-2024 à 10:01:24    

Bonjour,
 
Je viens de corriger la procédure search de mon programme.
 
Cette version cherche l'item suivant de nom Nom dans les itens suivant.et déplace le terminal  au premier item de nom Nom.
(voir l'attribut Cur)
 
Path_Index est une variable devant $etre initialisée à zéro.
 

Code :
  1. procedure Search(T : in out Terminal_Type;
  2.                name : in Wide_String;
  3.                Path_Index : in out Natural;
  4.                Success : out boolean) is
  5.       
  6.       
  7.       
  8.       Vector : Abstract_Vectors.Vector := T.Cur.Childs;
  9.       
  10.    begin
  11.       Success := False;
  12.       
  13.       if not Is_Empty(Vector) then
  14.      for I in 1..Last_Index(Vector) loop
  15.         declare
  16.            E : constant Abstract_Access := Abstract_Vectors.Element(Vector, I);
  17.            Term : Terminal_Type := T;
  18.         begin
  19.            if E /= null then                        
  20.           if E.Info.Name.all = Name then
  21.              Switch(Term, I,  success);
  22.              if Success then
  23.             T := Term;
  24.             exit;
  25.              end if;
  26.             
  27.           else
  28.              Switch(Term, I,  success);
  29.              Path_Index := Path_Index + 1;
  30.              if Success then
  31.             Search(Term, Name, Path_Index, Success);
  32.             if Success then
  33.             T := Term;
  34.             exit;
  35.              end if;
  36.              end if;    
  37.           end if;
  38.            else
  39.           raise Program_Error;
  40.            end if;
  41.         end;
  42.      end loop;
  43.      
  44.       end if;
  45.       
  46.    end Search;

Reply

Marsh Posté le 22-11-2024 à 19:32:30    

Bon, je m'étais leuré.
 
Voic des corrections :
 
Le type a changé, j'ai ajouté le nombre de fils à un objet :
 

Code :
  1. type Abstract_Info(Tag : Class_Enum) is
  2.       record
  3.      Index   : Abstract_Index := 1;
  4.      Name    : Wide_String_Access;
  5.      Created : Time := Time_Of(1970, 1, 1, 0.0);
  6.      Childs_Num : Natural := 0;
  7.       end record;
  8.    
  9.    type Abstract_Class(Tag : Class_Enum) is abstract tagged
  10.       record
  11.      
  12.      Info : Abstract_Info(Tag);
  13.      
  14.      Childs  : Abstract_Vectors.Vector;
  15.      
  16.      
  17.       end record;


 
Save

Code :
  1. rocedure Save_Object (Object : Abstract_Access;              
  2.                  File : W_Io.File_Type;
  3.                  Index  : Natural := 0) is
  4.       O : constant Abstract_Access := Object;
  5.       New_Index : Natural := Index;
  6.    begin      
  7.  
  8.       O.all.Write(File);
  9.  
  10.       
  11.       
  12.       if not Is_Empty(O.Childs) then
  13.  
  14.      
  15.         for I in 1..Last_Index(O.Childs) loop
  16.  
  17.            declare
  18.               E : constant Abstract_Access :=
  19.             Abstract_Vectors.Element(O.Childs, I);
  20.            begin
  21.  
  22.               Save_Object(E, File, New_Index+1);           
  23.            
  24.            end;
  25.         end loop;          
  26.  
  27.       end if;
  28.       
  29.    end Save_Object;
  30.    
  31.    
  32.    
  33.    
  34.    
  35.    procedure Save (Object : in Abstract_Access;
  36.               Filename : in String) is
  37.       File : W_Io.File_Type;
  38.       
  39.    begin
  40.  
  41.       W_Io.Create(File, W_Io.Out_File, Filename);
  42.  
  43.       Save_Object(Object, File);
  44.  
  45.       W_Io.Close(File);
  46.  
  47.    end Save;


 
Restore

Code :
  1. procedure Restore_Vector(T : in out Terminal_Type;
  2.                    File : W_Io.File_Type) is
  3.       
  4.       Success : Boolean := False;
  5.       N, O : Abstract_Access;     
  6.       Child_Childs, Child_Numb : Natural := 0;
  7.       End_Of_File : Boolean := False;
  8.    begin
  9.       
  10.       if T.Root = null then
  11.      
  12.      Global_Read(File, End_Of_File, T.Root);
  13.      
  14.      T.Cur := T.Root;
  15.      
  16.      if T.Cur.Info.Childs_Num /= 0 then
  17.         
  18.         for Child in 1..T.Cur.Info.Childs_Num loop
  19.            if not W_Io.End_Of_File(File) then
  20.           
  21.           Restore_Vector(T, File);
  22.           
  23.            end if;
  24.            Parent(T);
  25.            
  26.         end loop;
  27.      end if;
  28.       else
  29.  
  30.      
  31.      for Child in 1..T.Cur.Info.Childs_Num loop
  32.  
  33.         Global_Read(File, End_Of_File, N);        
  34.         T.Cur.Childs := T.Cur.Childs & N;
  35.         
  36.  
  37.         if not W_Io.End_Of_File(File) then
  38.            if N.Info.Childs_num /= 0 then
  39.           
  40.           Switch(T, Last_Index(T.Cur.Childs), Success);
  41.           
  42.           Restore_Vector(T, File);
  43.           
  44.           Parent(T);
  45.           
  46.            end if;
  47.  
  48.            
  49.         end if;
  50.         
  51.      end loop;
  52.      
  53.       end if;
  54.    end Restore_Vector;
  55.  
  56.  
  57.  
  58. procedure Restore(T : in out Terminal_Type;
  59.                 Filename : in String) is
  60.       
  61.       End_Of_File : Boolean := False;
  62.       File : W_Io.File_Type;
  63.    begin
  64.       
  65.       W_Io.Open(File, W_Io.in_File, Filename);
  66.       if not W_Io.End_Of_File(File) then
  67.         Restore_Vector(T, File);
  68.       end if;
  69.       
  70.       W_Io.Close(File);
  71.    end Restore;


Message édité par lady287 le 22-11-2024 à 19:35:06
Reply

Marsh Posté le 22-11-2024 à 19:56:32    

j'adore les arbres N aires !
 

|+-----------------------------------------------------------------------------------------------------------------[X]+|
|| +  1 UNIVERSE Universe 2024-11-22 18:49:47                                                                         ||
|| |                                                                                                                  ||
||  +  1 PROGRAM Skywalker 2024-11-22 18:50:11                                                                        ||
||    |                                                                                                               ||
||     +  1 MAIN skywalker 2024-11-22 18:50:24                                                                        ||
||     +  2 LIBRARY Sky 2024-11-22 18:50:58                                                                           ||
||       |                                                                                                            ||
||        +  1 COMPONENT sky 2024-11-22 18:51:18                                                                      ||
||        +  2 COMPONENT sky-walk 2024-11-22 18:51:33                                                                 ||
||        +  3 COMPONENT sky-classes 2024-11-22 18:51:49                                                              ||
||          |                                                                                                         ||
||           +  1 CLASS Abstract_Class 2024-11-22 18:53:50                                                            ||
||           +  2 MACHINE generic n ary tree 2024-11-22 18:54:21                                                      ||
||                                                                                                                    ||
||                                                                                                                    ||
|


Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed