with Ada.Text_IO; use Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Ada.Float_Text_IO; use Ada.Float_Text_IO; with Ada.Unchecked_Deallocation; package body Vecteurs_Creux is procedure Free is new Ada.Unchecked_Deallocation (T_Cellule, T_Vecteur_Creux); procedure Initialiser (V : out T_Vecteur_Creux) is begin V := null; end Initialiser; procedure Detruire (V: in out T_Vecteur_Creux) is begin if V /= null then Detruire(V.All.Suivant); Free(V); V := null; end if; end Detruire; function Est_Nul (V : in T_Vecteur_Creux) return Boolean is begin return V = null; end Est_Nul; function Composante_Recursif (V : in T_Vecteur_Creux ; Indice : in Integer) return Float is begin if V = null or else V.All.Indice > Indice then put("testestest"); Afficher(V); new_line; return 0.0; elsif Indice = V.All.Indice then return V.All.Valeur; else return Composante_Recursif(V.All.Suivant, Indice); end if; end Composante_Recursif; function Composante_Iteratif (V : in T_Vecteur_Creux ; Indice : in Integer) return Float is Cursor : T_Vecteur_Creux; l : Integer := 0; begin if V = null then return 0.0; else Cursor := V; While (Cursor /= null) Loop l := Cursor.All.Indice; if l > Indice then return 0.0; elsif l = Indice then return Cursor.All.Valeur; end if; Cursor := Cursor.All.Suivant; End Loop; return 0.0; end if; end Composante_Iteratif; procedure Modifier (V : in out T_Vecteur_Creux ; -- TODO: réimplémenter avec un Cursor_last pour compresser la procédure Indice : in Integer ; Valeur : in Float ) is Cursor : T_Vecteur_Creux; aDetruire : T_Vecteur_Creux; begin if V = null then V := new T_Cellule'(Indice, Valeur, null); elsif V.All.Indice > Indice and Valeur /= 0.0 then V := new T_Cellule'(Indice, Valeur, V); elsif V.All.Indice = Indice then if Valeur = 0.0 then aDetruire := V; V := V.All.Suivant; Free(aDetruire); else V.All.Valeur := Valeur; end if; else Cursor := V; While (Cursor /= null) Loop if Cursor.All.Suivant = null then exit when Valeur = 0.0; Cursor.All.Suivant := new T_Cellule'(Indice, Valeur, null); exit; elsif Cursor.All.Suivant.All.Indice = Indice then if Valeur = 0.0 then aDetruire := Cursor.All.Suivant; Cursor.All.Suivant := Cursor.All.Suivant.All.Suivant; Free(aDetruire); exit; else Cursor.All.Suivant.All.Valeur := Valeur; exit; end if; elsif Cursor.All.Suivant.All.Indice > Indice then exit when Valeur = 0.0; Cursor.All.Suivant := new T_Cellule'(Indice, Valeur, Cursor.All.Suivant); exit; end if; Cursor := Cursor.All.Suivant; End Loop; end if; end Modifier; function Sont_Egaux_Recursif (V1, V2 : in T_Vecteur_Creux) return Boolean is begin if V1 = null xor V2 = null then return false; elsif V1 = null and V2 = null then return true; elsif (V1.All.Valeur = V2.All.Valeur and V1.All.Indice = V2.All.Indice) then return true; else return Sont_Egaux_Recursif (V1.All.Suivant, V2.All.Suivant); end if; end Sont_Egaux_Recursif; function Sont_Egaux_Iteratif (V1, V2 : in T_Vecteur_Creux) return Boolean is Cursor1, Cursor2 : T_Vecteur_Creux; begin if V1 = null xor V2 = null then return false; elsif V1 = null and V2 = null then return true; else Cursor1 := V1; Cursor2 := V2; While true Loop if not (Cursor1.All.Valeur = Cursor2.All.Valeur and Cursor1.All.Indice = Cursor2.All.Indice) then return false; else Cursor1 := Cursor1.All.Suivant; Cursor2 := Cursor2.All.Suivant; exit when Cursor1 = null and Cursor2 = null; end if; End Loop; return true; end if; end Sont_Egaux_Iteratif; procedure Additionner (V1 : in out T_Vecteur_Creux; V2 : in T_Vecteur_Creux) is V : T_Vecteur_Creux; Cursor1, Cursor2 : T_Vecteur_Creux; begin Initialiser(V); if V1 /= null and V2 = null then null; elsif V1 = null and V2 /= null then V1 := V2; elsif V1 = null and V2 = null then null; else Cursor1 := V1; Cursor2 := V2; while (Cursor1 /= null and Cursor2 /= null) loop if Cursor1 /= null then Modifier(V, Cursor1.All.Indice, Cursor1.All.Valeur); Cursor1 := Cursor1.All.Suivant; end if; if Cursor2 /= null then Modifier(V, Cursor2.All.Indice, Cursor2.All.Valeur); Cursor2 := Cursor2.All.Suivant; end if; end loop; end if; V1 := V; end Additionner; function Norme2 (V : in T_Vecteur_Creux) return Float is Cursor : T_Vecteur_Creux; n : Float := 0.0; begin Cursor := V; while (Cursor /= null) loop n := n + Cursor.All.Valeur*Cursor.All.Valeur; Cursor := Cursor.All.Suivant; end loop; return n; end Norme2; Function Produit_Scalaire (V1, V2: in T_Vecteur_Creux) return Float is Cursor : T_Vecteur_Creux; n : float := 0.0; begin Cursor := V1; while (Cursor /= null) loop n := n + Cursor.All.Valeur*Composante_Recursif(V2, Cursor.All.Indice); Cursor := Cursor.All.Suivant; end loop; return n; end Produit_Scalaire; procedure Afficher (V : T_Vecteur_Creux) is begin if V = Null then Put ("--E"); else -- Afficher la composante V.all Put ("-->[ "); Put (V.all.Indice, 0); Put (" | "); Put (V.all.Valeur, Fore => 0, Aft => 1, Exp => 0); Put (" ]"); -- Afficher les autres composantes Afficher (V.all.Suivant); end if; end Afficher; function Nombre_Composantes_Non_Nulles (V: in T_Vecteur_Creux) return Integer is begin if V = Null then return 0; else return 1 + Nombre_Composantes_Non_Nulles (V.All.Suivant); end if; end Nombre_Composantes_Non_Nulles; end Vecteurs_Creux;