Arrays
Constrained Array
Goal: declare a constrained array and implement operations on it.
Steps:
Implement the
Constrained_Arrayspackage.
Declare the range type
My_Index.Declare the array type
My_Array.Declare and implement the
Initfunction.Declare and implement the
Doubleprocedure.Declare and implement the
First_Elemfunction.Declare and implement the
Last_Elemfunction.Declare and implement the
Lengthfunction.Declare the object
AofMy_Arraytype.
Requirements:
Range type
My_Indexhas a range from 1 to 10.
My_Arrayis a constrained array ofIntegertype.
It must make use of the
My_Indextype.It is therefore limited to 10 elements.
Function
Initreturns an array where each element is initialized with the corresponding index.Procedure
Doubledoubles the value of each element of an array.Function
First_Elemreturns the first element of the array.Function
Last_Elemreturns the last element of the array.Function
Lengthreturns the length of the array.Object
AofMy_Arraytype 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_Typespackage.
Declare the array type
HTML_Color_RGB.Declare the
To_RGB_Lookup_Tableobject and initialize it.Adapt the implementation of the
To_RGBfunction.
Requirements:
Array type
HTML_Color_RGBis used for the table.The
To_RGB_Lookup_Tableobject ofHTML_Color_RGBtype contains the lookup table.
This table must be implemented as an array of constant values.
The implementation of the
To_RGBfunction must use theTo_RGB_Lookup_Tableobject.
Remarks:
This exercise is based on the HTML colors exercise from a previous lab (Records).
In the previous implementation, you could use a
casestatement to implement theTo_RGBfunction. Here, you must rewrite the function using a look-up table.
The implementation of the
To_RGBfunction 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_RGBfunction. Instead, write code that accessesTo_RGB_Lookup_Tableto 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
#72Firebrick
#B2
#22
#22Red
#FF
#00
#00Darkred
#8B
#00
#00Lime
#00
#FF
#00Forestgreen
#22
#8B
#22Green
#00
#80
#00Darkgreen
#00
#64
#00Blue
#00
#00
#FFMediumblue
#00
#00
#CDDarkblue
#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_Arrayspackage.
Declare the
My_Arraytype.Declare and implement the
Initprocedure.Declare and implement the
Initfunction.Declare and implement the
Doubleprocedure.Declare and implement the
Diff_Prev_Elemfunction.
Requirements:
My_Arrayis an unconstrained array (with aPositiverange) ofIntegerelements.Procedure
Initinitializes 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 toInitmust be(3, 2, 1).Function
Initreturns an array based on the lengthLand start indexIprovided to theInitfunction.
Iindicates the index of the first element of the array.
Lindicates the length of the array.Both
IandLmust 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
Initprocedure described above.Procedure
Doubledoubles each element of an array.Function
Diff_Prev_Elemreturns — for each element of an input arrayA— an array with the difference between an element of arrayAand 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
0is the constant difference for the first element;
5 - 2 = 3is the difference between the second and the first elements of the input array;
15 - 5 = 10is 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
Initfunction, you can call theInitprocedure 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'FirstandA'Lastattributes 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_Pkgpackage.
Declare the array type
Product_Infos.Declare the array type
Currency_Array.Implement the
Totalprocedure.Implement the
Totalfunction returning an array ofCurrency_Arraytype.Implement the
Totalfunction returning a single value ofCurrencytype.
Requirements:
Quantity of an individual product is represented by the
Quantitysubtype.Price of an individual product is represented by the
Currencysubtype.Record type
Product_Infodeals with information for various products.Array type
Product_Infosis used to represent a list of products.Array type
Currency_Arrayis used to represent a list of total values of individual products (see more details below).Procedure
Totalreceives an input array of products.
It outputs an array with the total value of each product using the
Currency_Arraytype.The total value of an individual product is calculated by multiplying the quantity for this product by its price.
Function
Totalreturns an array ofCurrency_Arraytype.
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
Totalreturns a single value ofCurrencytype.
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 elementQofQuantitytype to theCurrencytype.
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
Quantitysubtype is based on theIntegertype and theCurrencysubtype is based on theFloattype, 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_10package.
Declare the
String_10type.Implement the
To_String_10function.
Requirements:
The constrained string type
String_10is an array of ten characters.Function
To_String_10returns constrained strings ofString_10type based on an input parameter ofStringtype.
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_10as a subtype ofStringis the easiest way.
You may declare it as a new type as well. However, this requires some adaptations in the
Maintest procedure.You can use
Integer'Minto 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_Agespackage.
Declare the
People_Arrayarray type.Complete the declaration of the
Peoplerecord type with thePeople_Aelement ofPeople_Arraytype.Implement the
Addprocedure.Implement the
Resetprocedure.Implement the
Getfunction.Implement the
Updateprocedure.Implement the
Displayprocedure.
Requirements:
Each person is represented by the
Persontype, which is a record containing the name and the age of that person.
People_Arrayis an unconstrained array ofPersontype with a positive range.The
Max_Peopleconstant is set to 10.Record type
Peoplecontains:
The
People_Aelement ofPeople_Arraytype.This array must be constrained by the
Max_Peopleconstant.Procedure
Addadds a person to the list.
By default, the age of this person is set to zero in this procedure.
Procedure
Resetresets the list.Function
Getretrieves the age of a person from the list.Procedure
Updateupdates the age of a person in the list.Procedure
Displayshows 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_Validin the code below.In the implementation of procedure
Display, you should use theTrimfunction from theAda.Strings.Fixedpackage 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 valuesAandB.Fixed-length strings can be initialized with whitespaces using the
otherssyntax. For example:S : String_10 := (others => ' ');You may implement additional subprograms to deal with other types declared in the
Names_Agespackage below, such as theName_Typeand thePersontype.
For example, a function
To_Name_Typeto convert fromStringtoName_Typemight 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;