Arrays

Constrained Array

Goal: declare a constrained array and implement operations on it.

Steps:

  1. Implement the Constrained_Arrays package.

    1. Declare the range type My_Index.

    2. Declare the array type My_Array.

    3. Declare and implement the Init function.

    4. Declare and implement the Double procedure.

    5. Declare and implement the First_Elem function.

    6. Declare and implement the Last_Elem function.

    7. Declare and implement the Length function.

    8. Declare the object A of My_Array type.

Requirements:

  1. Range type My_Index has a range from 1 to 10.

  2. My_Array is a constrainted array of Integer type.

    1. It must make use of the My_Index type.

    2. It is therefore limited to 10 elements.

  3. Function Init returns an array where each element is initialized with the corresponding index.

  4. Procedure Double doubles the value of each element of an array.

  5. Function First_Elem returns the first element of the array.

  6. Function Last_Elem returns the last element of the array.

  7. Function Length returns the length of the array.

  8. Object A of My_Array type is initialized with:

    1. the values 1 and 2 for the first two elements, and

    2. 42 for all other elements.

package Constrained_Arrays is -- Complete the type and subprogram declarations: -- -- type My_Index is [...] -- -- type My_Array is [...] -- -- function Init ... -- -- procedure Double ... -- -- function First_Elem ... -- -- function Last_Elem ... -- -- function Length ... -- -- A : ... end Constrained_Arrays;
package body Constrained_Arrays is -- Create the implementation of the subprograms! -- end Constrained_Arrays;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Constrained_Arrays; use Constrained_Arrays; procedure Main is type Test_Case_Index is (Range_Chk, Array_Range_Chk, A_Obj_Chk, Init_Chk, Double_Chk, First_Elem_Chk, Last_Elem_Chk, Length_Chk); procedure Check (TC : Test_Case_Index) is AA : My_Array; procedure Display (A : My_Array) is begin for I in A'Range loop Put_Line (Integer'Image (A (I))); end loop; end Display; procedure Local_Init (A : in out My_Array) is begin A := (100, 90, 80, 10, 20, 30, 40, 60, 50, 70); end Local_Init; begin case TC is when Range_Chk => for I in My_Index loop Put_Line (My_Index'Image (I)); end loop; when Array_Range_Chk => for I in My_Array'Range loop Put_Line (My_Index'Image (I)); end loop; when A_Obj_Chk => Display (A); when Init_Chk => AA := Init; Display (AA); when Double_Chk => Local_Init (AA); Double (AA); Display (AA); when First_Elem_Chk => Local_Init (AA); Put_Line (Integer'Image (First_Elem (AA))); when Last_Elem_Chk => Local_Init (AA); Put_Line (Integer'Image (Last_Elem (AA))); when Length_Chk => Put_Line (Integer'Image (Length (AA))); end case; end Check; begin if Argument_Count < 1 then Put_Line ("ERROR: missing arguments! Exiting..."); return; elsif Argument_Count > 1 then Put_Line ("Ignoring additional arguments..."); end if; Check (Test_Case_Index'Value (Argument (1))); end Main;

Colors: Lookup-Table

Goal: rewrite a package to represent HTML colors in RGB format using a lookup table.

Steps:

  1. Implement the Color_Types package.

    1. Declare the array type HTML_Color_RGB.

    2. Declare the To_RGB_Lookup_Table object and initialize it.

    3. Adapt the implementation of To_RGB function.

Requirements:

  1. Array type HTML_Color_RGB is used for the table.

  2. The To_RGB_Lookup_Table object of HTML_Color_RGB type contains the lookup table.

    • This table must be implemented as an array of constant values.

  3. The implementation of the To_RGB function must use the To_RGB_Lookup_Table object.

Remarks:

  1. This exercise is based on the HTML colors exercise from a previous lab (Records).

  2. In the previous implementation, you could use a case statement to implement the To_RGB function. Here, you must rewrite the function using a look-up table.

    1. The implementation of the To_RGB function below includes the case statement as commented-out code. You can use this as your starting point: you just need to copy it and convert the case statement to an array declaration.

    1. Don't use a case statement to implement the To_RGB function. Instead, write code that accesses To_RGB_Lookup_Table to get the correct value.

  3. The following table contains the HTML colors and the corresponding value in hexadecimal form for each color element:

    Color

    Red

    Green

    Blue

    Salmon

    #FA

    #80

    #72

    Firebrick

    #B2

    #22

    #22

    Red

    #FF

    #00

    #00

    Darkred

    #8B

    #00

    #00

    Lime

    #00

    #FF

    #00

    Forestgreen

    #22

    #8B

    #22

    Green

    #00

    #80

    #00

    Darkgreen

    #00

    #64

    #00

    Blue

    #00

    #00

    #FF

    Mediumblue

    #00

    #00

    #CD

    Darkblue

    #00

    #00

    #8B
package Color_Types is type HTML_Color is (Salmon, Firebrick, Red, Darkred, Lime, Forestgreen, Green, Darkgreen, Blue, Mediumblue, Darkblue); subtype Int_Color is Integer range 0 .. 255; type RGB is record Red : Int_Color; Green : Int_Color; Blue : Int_Color; end record; function To_RGB (C : HTML_Color) return RGB; function Image (C : RGB) return String; -- Declare array type for lookup table here: -- -- type HTML_Color_RGB is ... -- Declare lookup table here: -- -- To_RGB_Lookup_Table : ... end Color_Types;
with Ada.Integer_Text_IO; package body Color_Types is function To_RGB (C : HTML_Color) return RGB is begin -- Implement To_RGB using To_RGB_Lookup_Table return (0, 0, 0); -- Use the code below from the previous version of the To_RGB -- function to declare the To_RGB_Lookup_Table: -- -- case C is -- when Salmon => return (16#FA#, 16#80#, 16#72#); -- when Firebrick => return (16#B2#, 16#22#, 16#22#); -- when Red => return (16#FF#, 16#00#, 16#00#); -- when Darkred => return (16#8B#, 16#00#, 16#00#); -- when Lime => return (16#00#, 16#FF#, 16#00#); -- when Forestgreen => return (16#22#, 16#8B#, 16#22#); -- when Green => return (16#00#, 16#80#, 16#00#); -- when Darkgreen => return (16#00#, 16#64#, 16#00#); -- when Blue => return (16#00#, 16#00#, 16#FF#); -- when Mediumblue => return (16#00#, 16#00#, 16#CD#); -- when Darkblue => return (16#00#, 16#00#, 16#8B#); -- end case; end To_RGB; function Image (C : RGB) return String is subtype Str_Range is Integer range 1 .. 10; SR : String (Str_Range); SG : String (Str_Range); SB : String (Str_Range); begin Ada.Integer_Text_IO.Put (To => SR, Item => C.Red, Base => 16); Ada.Integer_Text_IO.Put (To => SG, Item => C.Green, Base => 16); Ada.Integer_Text_IO.Put (To => SB, Item => C.Blue, Base => 16); return ("(Red => " & SR & ", Green => " & SG & ", Blue => " & SB &")"); end Image; end Color_Types;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Color_Types; use Color_Types; procedure Main is type Test_Case_Index is (Color_Table_Chk, HTML_Color_To_Integer_Chk); procedure Check (TC : Test_Case_Index) is begin case TC is when Color_Table_Chk => Put_Line ("Size of HTML_Color_RGB: " & Integer'Image (HTML_Color_RGB'Length)); Put_Line ("Firebrick: " & Image (To_RGB_Lookup_Table (Firebrick))); when HTML_Color_To_Integer_Chk => for I in HTML_Color'Range loop Put_Line (HTML_Color'Image (I) & " => " & Image (To_RGB (I)) & "."); end loop; end case; end Check; begin if Argument_Count < 1 then Put_Line ("ERROR: missing arguments! Exiting..."); return; elsif Argument_Count > 1 then Put_Line ("Ignoring additional arguments..."); end if; Check (Test_Case_Index'Value (Argument (1))); end Main;

Unconstrained Array

Goal: declare an unconstrained array and implement operations on it.

Steps:

  1. Implement the Unconstrained_Arrays package.

    1. Declare the My_Array type.

    2. Declare and implement the Init procedure.

    3. Declare and implement the Init function.

    4. Declare and implement the Double procedure.

    5. Declare and implement the Diff_Prev_Elem function.

Requirements:

  1. My_Array is an unconstrained array (with a Positive range) of Integer elements.

  2. Procedure Init initializes each element with the index starting with the last one.

    • For example, for an array of 3 elements where the index of the first element is 1 (My_Array (1 .. 3)), the values of these elements after a call to Init must be (3, 2, 1).

  3. Function Init returns an array based on the length L and start index I provided to the Init function.

    1. I indicates the index of the first element of the array.

    2. L indicates the length of the array.

    3. Both I and L must be positive.

    4. This is its declaration: function Init (I, L : Positive) return My_Array;.

    5. You must initialize the elements of the array in the same manner as for the Init procedure described above.

  4. Procedure Double doubles each element of an array.

  5. Function Diff_Prev_Elem returns — for each element of an input array A — an array with the difference between an element of array A and the previous element.

    1. For the first element, the difference must be zero.

    2. For example:

      • INPUT: (2, 5, 15)

      • RETURN of Diff_Prev_Elem: (0, 3, 10), where

        • 0 is the constant difference for the first element;

        • 5 - 2 = 3 is the difference between the second and the first elements of the input array;

        • 15 - 5 = 10 is the difference between the third and the second elements of the input array.

Remarks:

  1. For an array A, you can retrieve the index of the last element with the attribute 'Last.

    1. For example: Y : Positive := A'Last;

    2. This can be useful during the implementation of procedure Init.

  2. For the implementation of the Init function, you can call the Init procedure to initialize the elements. By doing this, you avoid code duplication.

  3. Some hints about attributes:

    1. You can use the range attribute (A'Range) to retrieve the range of an array A.

    2. You can also use the range attribute in the declaration of another array (e.g.: B : My_Array (A'Range)).

    3. Alternatively, you can use the A'First and A'Last attributes in an array declaration.

package Unconstrained_Arrays is -- Complete the type and subprogram declarations: -- -- type My_Array is ...; -- -- procedure Init ...; function Init (I, L : Positive) return My_Array; -- procedure Double ...; -- -- function Diff_Prev_Elem ...; end Unconstrained_Arrays;
package body Unconstrained_Arrays is -- Implement the subprograms: -- -- procedure Init is... -- function Init (L : Positive) return My_Array is... -- procedure Double ... is... -- function Diff_Prev_Elem ... is... end Unconstrained_Arrays;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Unconstrained_Arrays; use Unconstrained_Arrays; procedure Main is type Test_Case_Index is (Init_Chk, Init_Proc_Chk, Double_Chk, Diff_Prev_Chk, Diff_Prev_Single_Chk); procedure Check (TC : Test_Case_Index) is AA : My_Array (1 .. 5); AB : My_Array (5 .. 9); procedure Display (A : My_Array) is begin for I in A'Range loop Put_Line (Integer'Image (A (I))); end loop; end Display; procedure Local_Init (A : in out My_Array) is begin A := (1, 2, 5, 10, -10); end Local_Init; begin case TC is when Init_Chk => AA := Init (AA'First, AA'Length); AB := Init (AB'First, AB'Length); Display (AA); Display (AB); when Init_Proc_Chk => Init (AA); Init (AB); Display (AA); Display (AB); when Double_Chk => Local_Init (AB); Double (AB); Display (AB); when Diff_Prev_Chk => Local_Init (AB); AB := Diff_Prev_Elem (AB); Display (AB); when Diff_Prev_Single_Chk => declare A1 : My_Array (1 .. 1) := (1 => 42); begin A1 := Diff_Prev_Elem (A1); Display (A1); end; end case; end Check; begin if Argument_Count < 1 then Put_Line ("ERROR: missing arguments! Exiting..."); return; elsif Argument_Count > 1 then Put_Line ("Ignoring additional arguments..."); end if; Check (Test_Case_Index'Value (Argument (1))); end Main;

Product info

Goal: create a system to keep track of quantities and prices of products.

Steps:

  1. Implement the Product_Info_Pkg package.

    1. Declare the array type Product_Infos.

    2. Declare the array type Currency_Array.

    3. Implement the Total procedure.

    4. Implement the Total function returning an array of Currency_Array type.

    5. Implement the Total function returning a single value of Currency type.

Requirements:

  1. Quantity of an individual product is represented by the Quantity subtype.

  2. Price of an individual product is represented by the Currency subtype.

  3. Record type Product_Info deals with information for various products.

  4. Array type Product_Infos is used to represent a list of products.

  5. Array type Currency_Array is used to represent a list of total values of individual products (see more details below).

  6. Procedure Total receives an input array of quantities and an input array of amounts for each product.

    1. It outputs an array with the total value of each product using the Currency_Array type.

    2. The total value of an individual product is calculated by multiplying the quantity for this product by its price.

  7. Function Total returns an array of Currency_Array type.

    1. This function has the same purpose as the procedure Total.

    2. The difference is that the function returns an array instead of providing this array as an output parameter.

  8. The second function Total returns a single value of Currency type.

    1. This function receives an array of products.

    2. It returns a single value corresponding to the total value for all products in the system.

Remarks:

  1. You can use Currency (Q) to convert from an element Q of Quantity type to the Currency type.

    1. As you might remember, Ada requires an explicit conversion in calculations where variables of both integer and floating-point types are used.

    2. In our case, the Quantity subtype is based on the Integer type and the Currency subtype is based on the Float type, so a conversion is necessary in calculations using those types.

package Product_Info_Pkg is subtype Quantity is Natural; subtype Currency is Float; type Product_Info is record Units : Quantity; Price : Currency; end record; -- Complete the type declarations: -- -- type Product_Infos is ... -- -- type Currency_Array is ... procedure Total (P : Product_Infos; Tot : out Currency_Array); function Total (P : Product_Infos) return Currency_Array; function Total (P : Product_Infos) return Currency; end Product_Info_Pkg;
package body Product_Info_Pkg is -- Complete the subprogram implementations: -- -- procedure Total (P : Product_Infos; -- Tot : out Currency_Array) is ... -- function Total (P : Product_Infos) return Currency_Array is ... -- function Total (P : Product_Infos) return Currency is ... end Product_Info_Pkg;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Product_Info_Pkg; use Product_Info_Pkg; procedure Main is package Currency_IO is new Ada.Text_IO.Float_IO (Currency); type Test_Case_Index is (Total_Func_Chk, Total_Proc_Chk, Total_Value_Chk); procedure Check (TC : Test_Case_Index) is subtype Test_Range is Positive range 1 .. 5; P : Product_Infos (Test_Range); Tots : Currency_Array (Test_Range); Tot : Currency; procedure Display (Tots : Currency_Array) is begin for I in Tots'Range loop Currency_IO.Put (Tots (I)); New_Line; end loop; end Display; procedure Local_Init (P : in out Product_Infos) is begin P := ((1, 0.5), (2, 10.0), (5, 40.0), (10, 10.0), (10, 20.0)); end Local_Init; begin Currency_IO.Default_Fore := 1; Currency_IO.Default_Aft := 2; Currency_IO.Default_Exp := 0; case TC is when Total_Func_Chk => Local_Init (P); Tots := Total (P); Display (Tots); when Total_Proc_Chk => Local_Init (P); Total (P, Tots); Display (Tots); when Total_Value_Chk => Local_Init (P); Tot := Total (P); Currency_IO.Put (Tot); New_Line; end case; end Check; begin if Argument_Count < 1 then Put_Line ("ERROR: missing arguments! Exiting..."); return; elsif Argument_Count > 1 then Put_Line ("Ignoring additional arguments..."); end if; Check (Test_Case_Index'Value (Argument (1))); end Main;

String_10

Goal: work with constrained string types.

Steps:

  1. Implement the Strings_10 package.

    1. Declare the String_10 type.

    2. Implement the To_String_10 function.

Requirements:

  1. The constrained string type String_10 is an array of ten characters.

  2. Function To_String_10 returns constrained strings of String_10 type based on an input parameter of String type.

    • For strings that are more than 10 characters, omit everything after the 11th character.

    • For strings that are fewer than 10 characters, pad the string with ' ' characters until it is 10 characters.

Remarks:

  1. Declaring String_10 as a subtype of String is the easiest way.

    • You may declare it as a new type as well. However, this requires some adaptations in the Main test procedure.

  2. You can use Integer'Min to calculate the minimum of two integer values.

package Strings_10 is -- Complete the type and subprogram declarations: -- -- subtype String_10 is ...; -- Using "type String_10 is..." is possible, too. However, it -- requires a custom Put_Line procedure that is called in Main: -- procedure Put_Line (S : String_10); -- function To_String_10 ...; end Strings_10;
package body Strings_10 is -- Complete the subprogram declaration and implementation: -- -- function To_String_10 ... is end Strings_10;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Strings_10; use Strings_10; procedure Main is type Test_Case_Index is (String_10_Long_Chk, String_10_Short_Chk); procedure Check (TC : Test_Case_Index) is SL : constant String := "And this is a long string just for testing..."; SS : constant String := "Hey!"; S_10 : String_10; begin case TC is when String_10_Long_Chk => S_10 := To_String_10 (SL); Put_Line (String (S_10)); when String_10_Short_Chk => S_10 := (others => ' '); S_10 := To_String_10 (SS); Put_Line (String (S_10)); end case; end Check; begin if Argument_Count < 1 then Ada.Text_IO.Put_Line ("ERROR: missing arguments! Exiting..."); return; elsif Argument_Count > 1 then Ada.Text_IO.Put_Line ("Ignoring additional arguments..."); end if; Check (Test_Case_Index'Value (Argument (1))); end Main;

List of Names

Goal: create a system for a list of names and ages.

Steps:

  1. Implement the Names_Ages package.

    1. Declare the People_Array array type.

    2. Complete the declaration of the People record type with the People_A element of People_Array type.

    3. Implement the Add procedure.

    4. Implement the Reset procedure.

    5. Implement the Get function.

    6. Implement the Update procedure.

    7. Implement the Display procedure.

Requirements:

  1. Each person is represented by the Person type, which is a record containing the name and the age of that person.

  2. People_Array is an unconstrained array of Person type with a positive range.

  3. The Max_People constant is set to 10.

  4. Record type People contains:

    1. The People_A element of People_Array type.

    2. This array must be constrained by the Max_People constant.

  5. Procedure Add adds a person to the list.

    1. By default, the age of this person is set to zero in this procedure.

  6. Procedure Reset resets the list.

  7. Function Get retrieves the age of a person from the list.

  8. Procedure Update updates the age of a person in the list.

  9. Procedure Display shows the complete list using the following format:

    1. The first line must be LIST OF NAMES:. It is followed by the name and age of each person in the next lines.

    2. For each person on the list, the procedure must display the information in the following format:

      NAME: XXXX
AGE: YY

Remarks:

  1. In the implementation of procedure Add, you may use an index to indicate the last valid position in the array — see Last_Valid in the code below.

  2. In the implementation of procedure Display, you should use the Trim function from the Ada.Strings.Fixed package to format the person's name — for example: Trim (P.Name, Right).

  3. You may need the Integer'Min (A, B) and the Integer'Max (A, B) functions to get the minimum and maximum values in a comparison between two integer values A and B.

  4. Fixed-length strings can be initialized with whitespaces using the others syntax. For example: S : String_10 := (others => ' ');

  5. You may implement additional subprograms to deal with other types declared in the Names_Ages package below, such as the Name_Type and the Person type.

    1. For example, a function To_Name_Type to convert from String to Name_Type might be useful.

    2. Take a moment to reflect on which additional subprograms could be useful as well.

package Names_Ages is Max_People : constant Positive := 10; subtype Name_Type is String (1 .. 50); type Age_Type is new Natural; type Person is record Name : Name_Type; Age : Age_Type; end record; -- Add type declaration for People_Array record: -- -- type People_Array is ...; -- Replace type declaration for People record. You may use the -- following template: -- -- type People is record -- People_A : People_Array ...; -- Last_Valid : Natural; -- end record; -- type People is null record; procedure Reset (P : in out People); procedure Add (P : in out People; Name : String); function Get (P : People; Name : String) return Age_Type; procedure Update (P : in out People; Name : String; Age : Age_Type); procedure Display (P : People); end Names_Ages;
with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings; use Ada.Strings; with Ada.Strings.Fixed; use Ada.Strings.Fixed; package body Names_Ages is procedure Reset (P : in out People) is begin null; end Reset; procedure Add (P : in out People; Name : String) is begin null; end Add; function Get (P : People; Name : String) return Age_Type is begin return 0; end Get; procedure Update (P : in out People; Name : String; Age : Age_Type) is begin null; end Update; procedure Display (P : People) is begin null; end Display; end Names_Ages;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Names_Ages; use Names_Ages; procedure Main is type Test_Case_Index is (Names_Ages_Chk, Get_Age_Chk); procedure Check (TC : Test_Case_Index) is P : People; begin case TC is when Names_Ages_Chk => Reset (P); Add (P, "John"); Add (P, "Patricia"); Add (P, "Josh"); Display (P); Update (P, "John", 18); Update (P, "Patricia", 35); Update (P, "Josh", 53); Display (P); when Get_Age_Chk => Reset (P); Add (P, "Peter"); Update (P, "Peter", 45); Put_Line ("Peter is " & Age_Type'Image (Get (P, "Peter")) & " years old."); end case; end Check; begin if Argument_Count < 1 then Ada.Text_IO.Put_Line ("ERROR: missing arguments! Exiting..."); return; elsif Argument_Count > 1 then Ada.Text_IO.Put_Line ("Ignoring additional arguments..."); end if; Check (Test_Case_Index'Value (Argument (1))); end Main;