Arrays
Constrained Array
Goal: declare a constrained array and implement operations on it.
Steps:
Implement the
Constrained_Arrays
package.
Declare the range type
My_Index
.Declare the array type
My_Array
.Declare and implement the
Init
function.Declare and implement the
Double
procedure.Declare and implement the
First_Elem
function.Declare and implement the
Last_Elem
function.Declare and implement the
Length
function.Declare the object
A
ofMy_Array
type.
Requirements:
Range type
My_Index
has a range from 1 to 10.
My_Array
is a constrained array ofInteger
type.
It must make use of the
My_Index
type.It is therefore limited to 10 elements.
Function
Init
returns an array where each element is initialized with the corresponding index.Procedure
Double
doubles the value of each element of an array.Function
First_Elem
returns the first element of the array.Function
Last_Elem
returns the last element of the array.Function
Length
returns the length of the array.Object
A
ofMy_Array
type is initialized with:
the values 1 and 2 for the first two elements, and
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:
Implement the
Color_Types
package.
Declare the array type
HTML_Color_RGB
.Declare the
To_RGB_Lookup_Table
object and initialize it.Adapt the implementation of the
To_RGB
function.
Requirements:
Array type
HTML_Color_RGB
is used for the table.The
To_RGB_Lookup_Table
object ofHTML_Color_RGB
type contains the lookup table.
This table must be implemented as an array of constant values.
The implementation of the
To_RGB
function must use theTo_RGB_Lookup_Table
object.
Remarks:
This exercise is based on the HTML colors exercise from a previous lab (Records).
In the previous implementation, you could use a
case
statement to implement theTo_RGB
function. Here, you must rewrite the function using a look-up table.
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.
Don't use a case statement to implement the
To_RGB
function. Instead, write code that accessesTo_RGB_Lookup_Table
to get the correct value.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:
Implement the
Unconstrained_Arrays
package.
Declare the
My_Array
type.Declare and implement the
Init
procedure.Declare and implement the
Init
function.Declare and implement the
Double
procedure.Declare and implement the
Diff_Prev_Elem
function.
Requirements:
My_Array
is an unconstrained array (with aPositive
range) ofInteger
elements.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 toInit
must be(3, 2, 1)
.Function
Init
returns an array based on the lengthL
and start indexI
provided to theInit
function.
I
indicates the index of the first element of the array.
L
indicates the length of the array.Both
I
andL
must be positive.This is its declaration:
function Init (I, L : Positive) return My_Array;
.You must initialize the elements of the array in the same manner as for the
Init
procedure described above.Procedure
Double
doubles each element of an array.Function
Diff_Prev_Elem
returns — for each element of an input arrayA
— an array with the difference between an element of arrayA
and the previous element.
For the first element, the difference must be zero.
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:
For an array
A
, you can retrieve the index of the last element with the attribute'Last
.For example:
Y : Positive := A'Last;
This can be useful during the implementation of procedure
Init
.
For the implementation of the
Init
function, you can call theInit
procedure to initialize the elements. By doing this, you avoid code duplication.Some hints about attributes:
You can use the range attribute (
A'Range
) to retrieve the range of an arrayA
.You can also use the range attribute in the declaration of another array (e.g.:
B : My_Array (A'Range)
).Alternatively, you can use the
A'First
andA'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:
Implement the
Product_Info_Pkg
package.
Declare the array type
Product_Infos
.Declare the array type
Currency_Array
.Implement the
Total
procedure.Implement the
Total
function returning an array ofCurrency_Array
type.Implement the
Total
function returning a single value ofCurrency
type.
Requirements:
Quantity of an individual product is represented by the
Quantity
subtype.Price of an individual product is represented by the
Currency
subtype.Record type
Product_Info
deals with information for various products.Array type
Product_Infos
is used to represent a list of products.Array type
Currency_Array
is used to represent a list of total values of individual products (see more details below).Procedure
Total
receives an input array of products.
It outputs an array with the total value of each product using the
Currency_Array
type.The total value of an individual product is calculated by multiplying the quantity for this product by its price.
Function
Total
returns an array ofCurrency_Array
type.
This function has the same purpose as the procedure
Total
.The difference is that the function returns an array instead of providing this array as an output parameter.
The second function
Total
returns a single value ofCurrency
type.
This function receives an array of products.
It returns a single value corresponding to the total value for all products in the system.
Remarks:
You can use
Currency (Q)
to convert from an elementQ
ofQuantity
type to theCurrency
type.
As you might remember, Ada requires an explicit conversion in calculations where variables of both integer and floating-point types are used.
In our case, the
Quantity
subtype is based on theInteger
type and theCurrency
subtype is based on theFloat
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:
Implement the
Strings_10
package.
Declare the
String_10
type.Implement the
To_String_10
function.
Requirements:
The constrained string type
String_10
is an array of ten characters.Function
To_String_10
returns constrained strings ofString_10
type based on an input parameter ofString
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:
Declaring
String_10
as a subtype ofString
is the easiest way.
You may declare it as a new type as well. However, this requires some adaptations in the
Main
test procedure.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:
Implement the
Names_Ages
package.
Declare the
People_Array
array type.Complete the declaration of the
People
record type with thePeople_A
element ofPeople_Array
type.Implement the
Add
procedure.Implement the
Reset
procedure.Implement the
Get
function.Implement the
Update
procedure.Implement the
Display
procedure.
Requirements:
Each person is represented by the
Person
type, which is a record containing the name and the age of that person.
People_Array
is an unconstrained array ofPerson
type with a positive range.The
Max_People
constant is set to 10.Record type
People
contains:
The
People_A
element ofPeople_Array
type.This array must be constrained by the
Max_People
constant.Procedure
Add
adds a person to the list.
By default, the age of this person is set to zero in this procedure.
Procedure
Reset
resets the list.Function
Get
retrieves the age of a person from the list.Procedure
Update
updates the age of a person in the list.Procedure
Display
shows the complete list using the following format:
The first line must be
LIST OF NAMES:
. It is followed by the name and age of each person in the next lines.For each person on the list, the procedure must display the information in the following format:
NAME: XXXX AGE: YY
Remarks:
In the implementation of procedure
Add
, you may use an index to indicate the last valid position in the array — seeLast_Valid
in the code below.In the implementation of procedure
Display
, you should use theTrim
function from theAda.Strings.Fixed
package to format the person's name — for example:Trim (P.Name, Right)
.You may need the
Integer'Min (A, B)
and theInteger'Max (A, B)
functions to get the minimum and maximum values in a comparison between two integer valuesA
andB
.Fixed-length strings can be initialized with whitespaces using the
others
syntax. For example:S : String_10 := (others => ' ');
You may implement additional subprograms to deal with other types declared in the
Names_Ages
package below, such as theName_Type
and thePerson
type.
For example, a function
To_Name_Type
to convert fromString
toName_Type
might be useful.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;