generic
   type Base_Type is mod <>;
   Multiplyer, Adder: Base_Type;
   Output_Divisor: Base_Type := 1;
package LCG is

   procedure Initialize(Seed: Base_Type);
   function Random return Base_Type;
   -- changes the state and outputs the result

end LCG;

package body LCG is

   State: Base_Type := Base_Type'First;

   procedure Initialize(Seed: Base_Type) is
   begin
      State := Seed;
   end Initialize;

   function Random return Base_Type is
   begin
      State := State * Multiplyer + Adder;
      return State / Output_Divisor;
   end Random;

end LCG;

with Ada.Text_IO, LCG;

procedure Run_LCGs is

   type M31 is mod 2**31;

   package BSD_Rand is new LCG(Base_Type => M31, Multiplyer => 1103515245,
                               Adder => 12345);

   package MS_Rand  is new LCG(Base_Type => M31, Multiplyer => 214013,
                               Adder => 2531011, Output_Divisor => 2**16);

begin
   for I in 1 .. 10 loop
      Ada.Text_IO.Put_Line(M31'Image(BSD_Rand.Random));
   end loop;
   for I in 1 .. 10 loop
       Ada.Text_IO.Put_Line(M31'Image(MS_Rand.Random));
   end loop;
end Run_LCGs;

 12345
 1406932606
 654583775
 1449466924
 229283573
 1109335178
 1051550459
 1293799192
 794471793
 551188310
 38
 7719
 21238
 2437
 8855
 11797
 8365
 32285
 10450
 30612

The code implements two historic random number generators: the rand() function from BSD libc and the rand() function from the Microsoft C Runtime (MSCVRT.DLL). The generators are based on the Linear Congruential Generator (LCG) formula and are designed to replicate the same sequence of integers as the original generators when given the same seed. The code also includes a generic package for LCG and specific implementations for the BSD and Microsoft formulas.


with Ada.Unchecked_Deallocation;
-- Define the link type
procedure Singly_Linked is

   type Link;
   type Link_Access is access Link;
   type Link is record
      Data : Integer;
      Next : Link_Access := null;
   end record;
   -- Instantiate the generic deallocator for the link type
   procedure Free is new Ada.Unchecked_Deallocation(Link, Link_Access);

   -- Define the procedure
   procedure Insert_Append(Anchor : Link_Access; Newbie : Link_Access) is
   begin
      if Anchor /= null and Newbie /= null then
         Newbie.Next := Anchor.Next;
         Anchor.Next := Newbie;
      end if;
   end Insert_Append;

   -- Create the link elements
   A : Link_Access := new Link'(1, null);
   B : Link_Access := new Link'(2, null);
   C : Link_Access := new Link'(3, null);
-- Execute the program
begin
   Insert_Append(A, B);
   Insert_Append(A, C);
   Free(A);
   Free(B);
   Free(C);
end Singly_Linked;

define a method for inserting an element into a singly-linked list after a specified element. The method is used to insert an element 'C' into a list containing elements 'A' and 'B', specifically after element 'A'. The code also makes the predefined generic procedure 'Ada.Unchecked_Deallocation' visible in its context.


with ada.text_io;use ada.text_io;

procedure ethiopian is
  function double  (n : Natural) return Natural is (2*n);
  function halve   (n : Natural) return Natural is (n/2);
  function is_even (n : Natural) return Boolean is (n mod 2 = 0);

  function mul (l, r : Natural) return Natural is
  (if l = 0 then 0 elsif l = 1 then r elsif is_even (l) then mul (halve (l),double (r))
   else r + double (mul (halve (l), r)));

begin
  put_line (mul (17,34)'img);
end ethiopian;

The code defines three functions for halving an integer, doubling an integer, and checking if an integer is even. These functions are used to implement Ethiopian multiplication, a method of multiplying integers using addition, doubling, and halving. The multiplication process involves creating a table, discarding rows with even numbers in the left column, and summing the remaining values in the right column.


Iterative[edit]
function Factorial (N : Positive) return Positive is
   Result : Positive := N;
   Counter : Natural := N - 1;
begin
   for I in reverse 1..Counter loop
      Result := Result * I;
   end loop;
   return Result;
end Factorial;

Recursive[edit]
function Factorial(N : Positive) return Positive is
   Result : Positive := 1;
begin
   if N > 1 then
      Result := N * Factorial(N - 1);
   end if;
   return Result;
end Factorial;

Numerical Approximation[edit]
with Ada.Numerics.Generic_Complex_Types;
with Ada.Numerics.Generic_Complex_Elementary_Functions;
with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO.Complex_Io;
with Ada.Text_Io; use Ada.Text_Io;

procedure Factorial_Numeric_Approximation is
   type Real is digits 15;
   package Complex_Pck is new Ada.Numerics.Generic_Complex_Types(Real);
   use Complex_Pck;
   package Complex_Io is new Ada.Text_Io.Complex_Io(Complex_Pck);
   use Complex_IO;
   package Cmplx_Elem_Funcs is new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pck);
   use Cmplx_Elem_Funcs;

   function Gamma(X : Complex) return Complex is
      package Elem_Funcs is new Ada.Numerics.Generic_Elementary_Functions(Real);
      use Elem_Funcs;
      use Ada.Numerics;
      -- Coefficients used by the GNU Scientific Library
      G : Natural := 7;
      P : constant array (Natural range 0..G + 1) of Real := (
         0.99999999999980993, 676.5203681218851, -1259.1392167224028,
         771.32342877765313, -176.61502916214059, 12.507343278686905,
         -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7);
      Z : Complex := X;
      Cx : Complex;
      Ct : Complex;
   begin
      if Re(Z) < 0.5 then
         return Pi / (Sin(Pi * Z) * Gamma(1.0 - Z));
      else
         Z := Z - 1.0;
         Set_Re(Cx, P(0));
         Set_Im(Cx, 0.0);
         for I in 1..P'Last loop
            Cx := Cx + (P(I) / (Z + Real(I)));
         end loop;
         Ct := Z + Real(G) + 0.5;
         return Sqrt(2.0 * Pi) * Ct**(Z + 0.5) * Exp(-Ct) * Cx;
      end if;
   end Gamma;

   function Factorial(N : Complex) return Complex is
   begin
      return Gamma(N + 1.0);
   end Factorial;
   Arg : Complex;
begin
   Put("factorial(-0.5)**2.0 = ");
   Set_Re(Arg, -0.5);
   Set_Im(Arg, 0.0);
   Put(Item => Factorial(Arg) **2.0, Fore => 1, Aft => 8, Exp => 0);
   New_Line;
   for I in 0..9 loop
      Set_Re(Arg, Real(I));
      Set_Im(Arg, 0.0);
      Put("factorial(" & Integer'Image(I) & ") = ");
      Put(Item => Factorial(Arg), Fore => 6, Aft => 8, Exp => 0);
      New_Line;
   end loop;
end Factorial_Numeric_Approximation;

The code defines a function that calculates the factorial of a given number. The factorial is the product of all positive integers from the given number down to 1. The function can be implemented either iteratively or recursively. It optionally includes error handling for negative input numbers. It is related to the task of generating primorial numbers.


with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;

procedure Bulls_And_Cows is
   package Random_Natural is new Ada.Numerics.Discrete_Random (Natural);
   Number : String (1..4);
begin
   declare -- Generation of number
      use Random_Natural;
      Digit    : String   := "123456789";
      Size     : Positive := 9;
      Dice     : Generator;
      Position : Natural;
   begin
      Reset (Dice);
      for I in Number'Range loop
         Position := Random (Dice) mod Size + 1;
         Number (I) := Digit (Position);
         Digit (Position..Size - 1) := Digit (Position + 1..Size);
         Size := Size - 1;
      end loop;
   end;
   loop -- Guessing loop
      Put ("Enter four digits:");
      declare
         Guess : String  := Get_Line;
         Bulls : Natural := 0;
         Cows  : Natural := 0;
      begin
         if Guess'Length /= 4 then
            raise Data_Error;
         end if;
         for I in Guess'Range loop
            for J in Number'Range loop
               if Guess (I) not in '1'..'9' or else (I < J and then Guess (I) = Guess (J)) then
                  raise Data_Error;
               end if;
               if Number (I) = Guess (J) then
                  if I = J then
                     Bulls := Bulls + 1;
                  else
                     Cows := Cows + 1;
                  end if;
               end if;
            end loop;
         end loop;
         exit when Bulls = 4;
         Put_Line (Integer'Image (Bulls) & " bulls," & Integer'Image (Cows) & " cows");
      exception
         when Data_Error => Put_Line ("You should enter four different digits 1..9");
      end;
   end loop;
end Bulls_And_Cows;

generate a unique four-digit number, accept and validate user guesses, calculate and print scores based on matching digits and their positions, and end the program when the user guess matches the generated number.


with Ada.Numerics;                       use Ada.Numerics;
with Ada.Numerics.Float_Random;          use Ada.Numerics.Float_Random;
with Ada.Numerics.Elementary_Functions;  use Ada.Numerics.Elementary_Functions;

procedure Normal_Random is
   function Normal_Distribution
            (  Seed  : Generator;
               Mu    : Float := 1.0;
               Sigma : Float := 0.5
            )  return Float is
   begin
      return
         Mu + (Sigma * Sqrt (-2.0 * Log (Random (Seed), 10.0)) * Cos (2.0 * Pi * Random (Seed)));
   end Normal_Distribution;

   Seed         : Generator;
   Distribution : array (1..1_000) of Float;
begin
   Reset (Seed);
   for I in Distribution'Range loop
      Distribution (I) := Normal_Distribution (Seed);
   end loop;
end Normal_Random;

generate a collection of 1000 normally distributed pseudo-random numbers with a mean of 1.0 and a standard deviation of 0.5.


with Ada.Text_IO; use Ada.Text_IO;
procedure dot_product is
	type vect is array(Positive range <>) of Integer;
	v1 : vect := (1,3,-5);
	v2 : vect := (4,-2,-1);

	function dotprod(a: vect; b: vect) return Integer is
		sum : Integer := 0;
		begin
		if not (a'Length=b'Length) then raise Constraint_Error; end if;
		for p in a'Range loop
			sum := sum + a(p)*b(p);
		end loop;
		return sum;
	end dotprod;

begin
put_line(Integer'Image(dotprod(v1,v2)));
end dot_product;

Implement a function to calculate the dot product of two vectors of arbitrary length. The function multiplies corresponding elements from each vector and sums the products. The vectors must be of the same length. Example vectors used are [1, 3, -5] and [4, -2, -1].


with Ada.Text_Io; use Ada.Text_Io;

procedure Read_Stream is
   Line : String(1..10);
   Length : Natural;
begin
   while not End_Of_File loop
      Get_Line(Line, Length); -- read up to 10 characters at a time
      Put(Line(1..Length));
      -- The current line of input data may be longer than the string receiving the data.
      -- If so, the current input file column number will be greater than 0
      -- and the extra data will be unread until the next iteration.
      -- If not, we have read past an end of line marker and col will be 1
      if Col(Current_Input) = 1 then
         New_Line;
      end if;
   end loop;
end Read_Stream;

"Code reads a text stream from standard input either word-by-word or line-by-line until no more data is available, then writes the output to standard output."


Works with: GNAT

with Ada.Text_IO.Text_Streams;
with DOM.Core.Documents;
with DOM.Core.Nodes;

procedure Serialization is
   My_Implementation : DOM.Core.DOM_Implementation;
   My_Document       : DOM.Core.Document;
   My_Root_Node      : DOM.Core.Element;
   My_Element_Node   : DOM.Core.Element;
   My_Text_Node      : DOM.Core.Text;
begin
   My_Document := DOM.Core.Create_Document (My_Implementation);
   My_Root_Node := DOM.Core.Documents.Create_Element (My_Document, "root");
   My_Root_Node := DOM.Core.Nodes.Append_Child (My_Document, My_Root_Node);
   My_Element_Node := DOM.Core.Documents.Create_Element (My_Document, "element");
   My_Element_Node := DOM.Core.Nodes.Append_Child (My_Root_Node, My_Element_Node);
   My_Text_Node := DOM.Core.Documents.Create_Text_Node (My_Document, "Some text here");
   My_Text_Node := DOM.Core.Nodes.Append_Child (My_Element_Node, My_Text_Node);
   DOM.Core.Nodes.Write
     (Stream => Ada.Text_IO.Text_Streams.Stream
        (Ada.Text_IO.Standard_Output),
      N => My_Document,
      Pretty_Print => True);
end Serialization;

<?xml version="1.0" encoding="utf-8"?>
<root>
 <element>Some text here</element>
</root>

create a simple DOM and serialize it to XML format using XML/Ada from AdaCore. The code can be optimized by adding "use" clauses and writing the creation functions in the declaration part.


The following example displays a date-time stamp. The time zone value is the number of minutes offset from the prime meridian.with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Formatting; use Ada.Calendar.Formatting;
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
with Ada.Text_Io; use Ada.Text_Io;

procedure System_Time is
   Now : Time := Clock;
begin
   Put_line(Image(Date => Now, Time_Zone => -7*60));
end System_Time;

the system time in a specified unit. This can be used for debugging, network information, random number seeds, or program performance. The time is retrieved either by a system command or a built-in language function. It is related to the task of date formatting and retrieving system time.


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_SEDOL is

   subtype SEDOL_String is String (1..6);
   type SEDOL_Sum is range 0..9;

   function Check (SEDOL : SEDOL_String) return SEDOL_Sum is
      Weight : constant array (SEDOL_String'Range) of Integer := (1,3,1,7,3,9);
      Sum    : Integer := 0;
      Item   : Integer;
   begin
      for Index in SEDOL'Range loop
         Item := Character'Pos (SEDOL (Index));
         case Item is
            when Character'Pos ('0')..Character'Pos ('9') =>
               Item := Item - Character'Pos ('0');
            when Character'Pos ('B')..Character'Pos ('D') |
                 Character'Pos ('F')..Character'Pos ('H') |
                 Character'Pos ('J')..Character'Pos ('N') |
                 Character'Pos ('P')..Character'Pos ('T') |
                 Character'Pos ('V')..Character'Pos ('Z') =>
               Item := Item - Character'Pos ('A') + 10;
            when others =>
               raise Constraint_Error;
         end case;
         Sum := Sum + Item * Weight (Index);
      end loop;
      return SEDOL_Sum ((-Sum) mod 10);
   end Check;

   Test : constant array (1..10) of SEDOL_String :=
             (  "710889", "B0YBKJ", "406566", "B0YBLH", "228276",
                "B0YBKL", "557910", "B0YBKR", "585284", "B0YBKT"
             );
begin
   for Index in Test'Range loop
      Put_Line (Test (Index) & Character'Val (Character'Pos ('0') + Check (Test (Index))));
   end loop;
end Test_SEDOL;

7108899
B0YBKJ7
4065663
B0YBLH2
2282765
B0YBKL9
5579107
B0YBKR5
5852842
B0YBKT7

The code calculates and appends the checksum digit for each 6-digit SEDOL number in the given list. It also verifies the validity of each input SEDOL string and raises a Constraint_Error for any invalid input. The checksum is computed using the formula (-sum) mod 10.


Library: GtkAda

with Glib;                use Glib;
with Cairo;               use Cairo;
with Cairo.Png;           use Cairo.Png;
with Cairo.Pattern;       use Cairo.Pattern;
with Cairo.Image_Surface; use Cairo.Image_Surface;
with Ada.Numerics;

procedure Sphere is
   subtype Dub is Glib.Gdouble;

   Surface    : Cairo_Surface;
   Cr         : Cairo_Context;
   Pat        : Cairo_Pattern;
   Status_Out : Cairo_Status;
   M_Pi       : constant Dub := Dub (Ada.Numerics.Pi);

begin
   Surface := Create (Cairo_Format_ARGB32, 512, 512);
   Cr      := Create (Surface);
   Pat     :=
      Cairo.Pattern.Create_Radial (230.4, 204.8, 51.1, 204.8, 204.8, 256.0);
   Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 0.0, 1.0, 1.0, 1.0, 1.0);
   Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 1.0, 0.0, 0.0, 0.0, 1.0);
   Cairo.Set_Source (Cr, Pat);
   Cairo.Arc (Cr, 256.0, 256.0, 153.6, 0.0, 2.0 * M_Pi);
   Cairo.Fill (Cr);
   Cairo.Pattern.Destroy (Pat);
   Status_Out := Write_To_Png (Surface, "SphereAda.png");
   pragma Assert (Status_Out = Cairo_Status_Success);
end Sphere;

Library: Display

with Display; use Display;
with Display.Basic; use Display.Basic;

procedure Main is
   Ball : Shape_Id := New_Circle
     (X      => 0.0,
      Y      => 0.0,
      Radius => 20.0,
      Color  => Blue);
begin
   null;
end Main;

The code generates a graphical or ASCII representation of a sphere, using either static or rotational projection. It translates from the C code found at the specified URL, utilizing the Cairo component of GtkAda to create and save the sphere as a PNG. The code operates on a loose binding to SDL, requiring a new project to be initiated from an empty game template in the GPS installation.


with Ada.Text_IO;

procedure Nth is

   function Suffix(N: Natural) return String is
   begin
      if    N mod 10 = 1 and then N mod 100 /= 11 then return "st";
      elsif N mod 10 = 2 and then N mod 100 /= 12 then return "nd";
      elsif N mod 10 = 3 and then N mod 100 /= 13 then return "rd";
      else return "th";
      end if;
   end Suffix;

   procedure Print_Images(From, To: Natural) is
   begin
      for I in From .. To loop
	 Ada.Text_IO.Put(Natural'Image(I) & Suffix(I));
      end loop;
      Ada.Text_IO.New_Line;
   end Print_Images;

begin
   Print_Images(   0,   25);
   Print_Images( 250,  265);
   Print_Images(1000, 1025);
end Nth;

The code defines a function that takes an integer input greater than or equal to zero and returns a string representation of the number with an ordinal suffix. The function is tested with ranges 0 to 25, 250 to 265, and 1000 to 1025. The use of apostrophes in the output is optional.


with Ada.Text_IO;

procedure Strip_Characters_From_String is

   function Strip(The_String: String; The_Characters: String)
                  return String is
      Keep:   array (Character) of Boolean := (others => True);
      Result: String(The_String'Range);
      Last:   Natural := Result'First-1;
   begin
      for I in The_Characters'Range loop
         Keep(The_Characters(I)) := False;
      end loop;
      for J in The_String'Range loop
         if Keep(The_String(J)) then
            Last := Last+1;
            Result(Last) := The_String(J);
         end if;
      end loop;
      return Result(Result'First .. Last);
   end Strip;

   S: String := "She was a soul stripper. She took my heart!";

begin -- main
   Ada.Text_IO.Put_Line(Strip(S, "aei"));
end Strip_Characters_From_String;

"Function to remove specific characters from a given string"


with Ada.Text_IO;              use Ada.Text_IO;
with Ada.Integer_Text_IO;      use Ada.Integer_Text_IO;
with Ada.Containers.Generic_Array_Sort;
with Ada.Strings.Unbounded;    use Ada.Strings.Unbounded;
with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;

procedure Main is
   type map_element is record
      Num  : Positive;
      Word : Unbounded_String;
   end record;

   type map_list is array (Positive range <>) of map_element;

   function "<" (Left, Right : map_element) return Boolean is
   begin
      return Left.Num < Right.Num;
   end "<";

   procedure list_sort is new Ada.Containers.Generic_Array_Sort
     (Index_Type => Positive, Element_Type => map_element,
      Array_Type => map_list);

   procedure general_fizz_buzz (max : Positive; words : in out map_list) is
      found : Boolean;
   begin
      list_sort (words);

      for i in 1 .. max loop
         found := False;
         for element of words loop
            if i mod element.Num = 0 then
               found := True;
               Put (element.Word);
            end if;
         end loop;
         if not found then
            Put (Item => i, Width => 1);
         end if;
         New_Line;
      end loop;
   end general_fizz_buzz;

   fizzy : map_list :=
     ((3, To_Unbounded_String ("FIZZ")), (7, To_Unbounded_String ("BAXX")),
      (5, To_Unbounded_String ("BUZZ")));

begin
   general_fizz_buzz (20, fizzy);
end Main;

implement a generalized version of FizzBuzz that takes a maximum number and a list of factor-word pairs as inputs from the user. The code prints numbers from 1 to the maximum number, replacing multiples of each factor with the corresponding word. For numbers that are multiples of multiple factors, the associated words are printed in ascending order of their factors.


with Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

procedure Prepend_String is
   S: Unbounded_String := To_Unbounded_String("World!");
begin
   S := "Hello " & S;-- this is the operation to prepend "Hello " to S.
   Ada.Text_IO.Put_Line(To_String(S));
end Prepend_String;

create a string variable with a specific text value, prepend another string literal to this variable, and display the content of the updated variable. If possible, the task is performed idiomatically without referring to the variable twice. In Ada language, due to the immutability of string length, an Unbounded_String type variable is used, requiring conversions for initialization and printing.


-- FILE: dragon_curve.gpr --
with "gtkada";

project Dragon_Curve is
   Adaflags    := External_As_List ("ADAFLAGS", " ");
   Ldflags     := External_As_List ("LDFLAGS", " ");

   for Languages use ("Ada");
   for Main use ("dragon_curve.adb");
   for Source_Dirs use ("./");
   for Object_Dir use "obj/";
   for Exec_Dir use ".";

   package Compiler is
      for Switches ("Ada") use ("-g", "-O0", "-gnaty-s", "-gnatwJ")
         & Adaflags;
   end Compiler;

   package Linker is
      for Leading_Switches ("Ada") use Ldflags;
   end Linker;

end Dragon_Curve;

-- FILE: dragon_curve.adb --
with Ada.Text_IO; use Ada.Text_IO;
with Events; use Events;
with GLib.Main; use GLib.Main;
with GTK;
with GTK.Drawing_Area; use GTK.Drawing_Area;
with GTK.Main;
with GTK.Window; use GTK.Window;

procedure Dragon_Curve is
   Window : GTK_Window;
begin
   GTK.Main.Init;
   GTK_New (Window);
   GTK_New (Drawing_Area);
   Window.Add (Drawing_Area);
   Drawing_Area.On_Draw (Events.Draw'Access, Drawing_Area);
   Show_All (Window);
   Resize (Window, 800, 800);
   GTK.Main.Main;
end Dragon_Curve;

-- FILE: events.ads --
with Ada.Numerics.Generic_Elementary_Functions;
with Cairo;
with GLib; use Glib;
with GTK.Drawing_Area; use GTK.Drawing_Area;
with GTK.Widget; use GTK.Widget;
with GLib.Object; use GLib.Object;

package Events is
   Drawing_Area : GTK_Drawing_Area;

   package GDouble_Elementary_Functions is new Ada.Numerics.Generic_Elementary_Functions (Float);
   use GDouble_Elementary_Functions;

   function Draw (Self : access GObject_Record'Class;
                  CC   : Cairo.Cairo_Context)
                  return Boolean;
end Events;

-- FILE: events.adb --
with Cairo;
with GTK;

package body Events is
   function Draw (Self : access GObject_Record'Class;
                  CC   : Cairo.Cairo_Context)
                  return Boolean
   is
      type Rotate_Type is (Counterclockwise, Clockwise);

      type Point is record
         X, Y : GDouble;
      end record;

      procedure Heighway_Branch (CC     : Cairo.Cairo_Context;
                                 A, B   : Point;
                                 Rotate : Rotate_Type;
                                 N      : Natural)
      is
         R, RU, C : Point;
      begin
         if N = 0 then
            Cairo.Move_To (CC, A.X, A.Y);
            Cairo.Line_To (CC, B.X, B.Y);
            Cairo.Stroke (CC);
         else
            -- Rotate 45 degrees --
            case Rotate is
               when Clockwise =>
                  R.X := GDouble ((1.0 / Sqrt (2.0)) * Float (B.X - A.X)
                                   - (1.0 / Sqrt (2.0)) * Float (B.Y - A.Y));
                  R.Y := GDouble ((1.0 / Sqrt (2.0)) * Float (B.X - A.X)
                                   + (1.0 / Sqrt (2.0)) * Float (B.Y - A.Y));
               when Counterclockwise =>
                  R.X := GDouble ((1.0 / Sqrt (2.0)) * Float (B.X - A.X)
                                   + (1.0 / Sqrt (2.0)) * Float (B.Y - A.Y));
                  R.Y := GDouble (-(1.0 / Sqrt (2.0)) * Float (B.X - A.X)
                                   + (1.0 / Sqrt (2.0)) * Float (B.Y - A.Y));
            end case;

            -- Make unit vector from rotation --
            RU.X := GDouble (Float (R.X) / Sqrt ( Float (R.X ** 2 + R.Y ** 2)));
            RU.Y := GDouble (Float (R.Y) / Sqrt ( Float (R.X ** 2 + R.Y ** 2)));

            -- Scale --
            R.X := RU.X * GDouble (Sqrt (Float (B.X - A.X) ** 2 + Float (B.Y - A.Y) ** 2) / Sqrt (2.0));
            R.Y := RU.Y * GDouble (Sqrt (Float (B.X - A.X) ** 2 + Float (B.Y - A.Y) ** 2) / Sqrt (2.0));

            C := (R.X + A.X, R.Y + A.Y);

            Heighway_Branch (CC, A, C, Clockwise, N - 1);
            Heighway_Branch (CC, C, B, Counterclockwise, N - 1);
         end if;
      end Heighway_Branch;

      Depth : constant := 14;
      Center, Right, Bottom, Left: Point;
      Width  : GDouble := GDouble (Drawing_Area.Get_Allocated_Width);
      Height : GDouble := GDouble (Drawing_Area.Get_Allocated_Height);

   begin
      Center := (Width / 2.0, Height / 2.0);
      Right  := (Width,       Height / 2.0);
      Left   := (0.0,         Height / 2.0);
      Bottom := (Width / 2.0, Height);

      Cairo.Set_Source_RGB (CC, 0.0, 1.0, 0.0);
      Heighway_Branch (CC, Center, Right, Clockwise, Depth);
      Cairo.Set_Source_RGB (CC, 0.0, 1.0, 1.0);
      Heighway_Branch (CC, Center, Left, Clockwise, Depth);
      Cairo.Set_Source_RGB (CC, 0.0, 1.0, 0.5);
      Heighway_Branch (CC, Center, Bottom, Clockwise, Depth);

      return True;
   end Draw;
end Events;

The code generates a dragon curve fractal, either displaying it directly or writing it to an image file. It uses various algorithms to create the fractal, including recursive, successive approximation, iterative, and Lindenmayer system methods. The code also includes functionality for determining the direction of the curve at each point, calculating absolute X,Y coordinates for each point, and testing whether a given point or segment is on the curve. It can also limit the curve to a certain number of points or a specific subsection. The code is written using GTKAda and Cairo.


with Ada.Numerics.Discrete_Random;
with Ada.Text_IO;
procedure Guess_Number is
   subtype Number is Integer range 1 .. 10;
   package Number_IO is new Ada.Text_IO.Integer_IO (Number);
   package Number_RNG is new Ada.Numerics.Discrete_Random (Number);
   Generator  : Number_RNG.Generator;
   My_Number  : Number;
   Your_Guess : Number;
begin
   Number_RNG.Reset (Generator);
   My_Number := Number_RNG.Random (Generator);
   Ada.Text_IO.Put_Line ("Guess my number!");
   loop
      Ada.Text_IO.Put ("Your guess: ");
      Number_IO.Get (Your_Guess);
      exit when Your_Guess = My_Number;
      Ada.Text_IO.Put_Line ("Wrong, try again!");
   end loop;
   Ada.Text_IO.Put_Line ("Well guessed!");
end Guess_Number;

-------------------------------------------------------------------------------------------------------
-- Another version ------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------------------

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Numerics.Discrete_Random;

-- procedure main - begins program execution
procedure main is
guess : Integer := 0;
counter : Integer := 0;
theNumber : Integer := 0;

-- function generate number - creates and returns a random number between the
-- ranges of 1 to 100
function generateNumber return Integer is
   type randNum is new Integer range 1 .. 100;
   package Rand_Int is new Ada.Numerics.Discrete_Random(randNum);
   use Rand_Int;
   gen : Generator;
   numb : randNum;

begin
   Reset(gen);

   numb := Random(gen);

   return Integer(numb);
end generateNumber;

-- procedure intro - prints text welcoming the player to the game
procedure intro is
begin
   Put_Line("Welcome to Guess the Number");
   Put_Line("===========================");
   New_Line;

   Put_Line("Try to guess the number. It is in the range of 1 to 100.");
   Put_Line("Can you guess it in the least amount of tries possible?");
   New_Line;
end intro;

begin
   New_Line;

   intro;
   theNumber := generateNumber;

   -- main game loop
   while guess /= theNumber loop
      Put("Enter a guess: ");
      guess := integer'value(Get_Line);

      counter := counter + 1;

      if guess > theNumber then
         Put_Line("Too high!");
      elsif guess < theNumber then
         Put_Line("Too low!");
      end if;
   end loop;

   New_Line;

   Put_Line("CONGRATULATIONS! You guessed it!");
   Put_Line("It took you a total of " & integer'image(counter) & " attempts.");

   New_Line;
end main;

"Implement a number guessing game where the computer selects a number between 1 and 10. The player is repeatedly prompted to guess the number until the correct number is guessed, upon which a 'Well guessed!' message is displayed and the program terminates. A conditional loop is used to facilitate repeated guessing."


   type Lower_Case is new Character range 'a' .. 'z';

   type Arr_Type is array (Integer range <>) of Lower_Case;
   A : Arr_Type (1 .. 26) := "abcdefghijklmnopqrstuvwxyz";

   B : Arr_Type (1 .. 26);
begin
   B(B'First) := 'a';
   for I in B'First .. B'Last-1 loop
      B(I+1) := Lower_Case'Succ(B(I));
   end loop; -- now all the B(I) are different

generates an array or list of all lower case ASCII characters from a to z using a reliable and strongly typed coding style. It ensures no manual enumeration of characters, thus reducing the risk of bugs. It also checks for errors such as inclusion of upper-case letters or symbols, and incorrect number of letters. The code also prevents duplication of letters in the array.


with ada.text_io; use ada.text_io;
procedure binary is
  bit : array (0..1) of character := ('0','1');

  function bin_image (n : Natural) return string is
  (if n < 2 then (1 => bit (n)) else bin_image (n / 2) & bit (n mod 2));

  test_values : array (1..3) of Natural := (5,50,9000);
begin
  for test of test_values loop
	put_line ("Output for" & test'img & " is " & bin_image (test));
  end loop;
end binary;

generate a sequence of binary digits for a given non-negative integer. The output displays only the binary digits of each number, followed by a newline, without any whitespace, radix, sign markers, or leading zeros. The conversion can be achieved using built-in radix functions or a user-defined function.


Library: SDLAda
with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;

procedure Draw_A_Pixel is

   Width   : constant := 320;
   Height  : constant := 200;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;

   procedure Wait is
      use type SDL.Events.Event_Types;
      Event : SDL.Events.Events.Events;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
         delay 0.100;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Draw a pixel",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));
   Renderer.Set_Draw_Colour ((255, 0, 0, 255));
   Renderer.Draw (Point => (100, 100));
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Draw_A_Pixel;

"Creates a 320x240 window and draws a single red pixel at position (100, 100)."


Works with: Ada version 2005

with Config; use Config;
with Ada.Text_IO; use Ada.Text_IO;

procedure Rosetta_Read_Cfg is
  cfg: Configuration:= Init("rosetta_read.cfg", Case_Sensitive => False, Variable_Terminator => ' ');
  fullname       : String  := cfg.Value_Of("*", "fullname");
  favouritefruit : String  := cfg.Value_Of("*", "favouritefruit");
  needspeeling   : Boolean := cfg.Is_Set("*", "needspeeling");
  seedsremoved   : Boolean := cfg.Is_Set("*", "seedsremoved");
  otherfamily    : String  := cfg.Value_Of("*", "otherfamily");
begin
  Put_Line("fullname = "       & fullname);
  Put_Line("favouritefruit = " & favouritefruit);
  Put_Line("needspeeling = "   & Boolean'Image(needspeeling));
  Put_Line("seedsremoved = "   & Boolean'Image(seedsremoved));
  Put_Line("otherfamily = "    & otherfamily);
end;

The code reads a standard configuration file, ignores lines starting with a hash or semicolon, and blank lines. It sets variables based on the configuration entries, treating data as case sensitive. It also handles options with multiple parameters, storing them in an array. The code uses the Config package from SourceForge.


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Long_Float_Text_IO; use Ada.Long_Float_Text_IO;
with Ada.Numerics.Generic_Elementary_Functions;

procedure Haversine_Formula is

   package Math is new Ada.Numerics.Generic_Elementary_Functions (Long_Float); use Math;

   -- Compute great circle distance, given latitude and longitude of two points, in radians
   function Great_Circle_Distance (lat1, long1, lat2, long2 : Long_Float) return Long_Float is
      Earth_Radius : constant := 6371.0; -- in kilometers
      a : Long_Float := Sin (0.5 * (lat2 - lat1));
      b : Long_Float := Sin (0.5 * (long2 - long1));
   begin
      return 2.0 * Earth_Radius * ArcSin (Sqrt (a * a + Cos (lat1) * Cos (lat2) * b * b));
   end Great_Circle_Distance;

   -- convert degrees, minutes and seconds to radians
   function DMS_To_Radians (Deg, Min, Sec : Long_Float := 0.0) return Long_Float is
      Pi_Over_180 : constant := 0.017453_292519_943295_769236_907684_886127;
   begin
      return (Deg + Min/60.0 + Sec/3600.0) * Pi_Over_180;
   end DMS_To_Radians;

begin
   Put_Line("Distance in kilometers between BNA and LAX");
   Put (Great_Circle_Distance (
         DMS_To_Radians (36.0, 7.2), DMS_To_Radians (86.0, 40.2),       -- Nashville International Airport (BNA)
         DMS_To_Radians (33.0, 56.4), DMS_To_Radians (118.0, 24.0)),    -- Los Angeles International Airport (LAX)
      Aft=>3, Exp=>0);
end Haversine_Formula;

Implement a function to calculate the great-circle distance between two points on a sphere using the Haversine formula. The function takes the coordinates of Nashville International Airport (BNA) and Los Angeles International Airport (LAX) as input and returns the distance between them. The calculation uses the recommended earth radius of 6372.8 km or 6371 km, depending on the level of precision required.


Library: AWS
with Ada.Text_IO; use Ada.Text_IO;

with AWS.Client;
with AWS.Response;

procedure HTTP_Request is
begin
   Put_Line (AWS.Response.Message_Body (AWS.Client.Get (URL => "http://www.rosettacode.org")));
end HTTP_Request;

Print the content of a specified URL to the console using HTTP request.


Translation of: C
Works with: GNAT
with Ada.Text_IO;
use  Ada.Text_IO;

procedure Luhn is

  function Luhn_Test (Number: String) return Boolean is
    Sum  : Natural := 0;
    Odd  : Boolean := True;
    Digit: Natural range 0 .. 9;
  begin
    for p in reverse Number'Range loop
      Digit := Integer'Value (Number (p..p));
      if Odd then
        Sum := Sum + Digit;
      else
        Sum := Sum + (Digit*2 mod 10) + (Digit / 5);
      end if;
      Odd := not Odd;
    end loop;
    return (Sum mod 10) = 0;
  end Luhn_Test;

begin

  Put_Line (Boolean'Image (Luhn_Test ("49927398716")));
  Put_Line (Boolean'Image (Luhn_Test ("49927398717")));
  Put_Line (Boolean'Image (Luhn_Test ("1234567812345678")));
  Put_Line (Boolean'Image (Luhn_Test ("1234567812345670")));

end Luhn;

The code validates credit card numbers using the Luhn test. It reverses the input number, calculates the sum of odd and even positioned digits (with even digits being doubled and if the result is greater than nine, the digits of the result are summed). If the total sum ends in zero, the number is deemed valid. The code tests this functionality on four given numbers.


with Ada.Command_Line, Ada.Text_IO;

procedure Josephus is

   function Arg(Idx, Default: Positive) return Positive is -- read Argument(Idx)
      (if Ada.Command_Line.Argument_Count >= Index
         then Positive'Value(Ada.Command_Line.Argument(Index)) else Default);

   Prisoners:  constant Positive := Arg(Idx => 1, Default => 41);
   Steps:      constant Positive := Arg(Idx => 2, Default =>  3);
   Survivors:  constant Positive := Arg(Idx => 3, Default =>  1);
   Print:               Boolean := (Arg(Idx => 4, Default =>  1) = 1);

   subtype Index_Type is Natural range 0 .. Prisoners-1;
   Next: array(Index_Type) of Index_Type;
   X: Index_Type := (Steps-2) mod Prisoners;

begin
   Ada.Text_IO.Put_Line
     ("N =" & Positive'Image(Prisoners) & ",  K =" & Positive'Image(Steps) &
        (if Survivors > 1 then ",  #survivors =" & Positive'Image(Survivors)
        else ""));
   for Idx in Next'Range loop -- initialize Next
      Next(Idx) := (Idx+1) mod Prisoners;
   end loop;
   if Print then
      Ada.Text_IO.Put("Executed: ");
   end if;
   for Execution in reverse 1 .. Prisoners loop
      if Execution = Survivors then
         Ada.Text_IO.New_Line;
         Ada.Text_IO.Put("Surviving: ");
         Print := True;
      end if;
      if Print then
         Ada.Text_IO.Put(Positive'Image(Next(X)));
      end if;
      Next(X) := Next(Next(X)); -- "delete" a prisoner
      for Prisoner in 1 .. Steps-1 loop
         X := Next(X);
      end loop;
   end loop;
end Josephus;

The code takes four parameters: the total number of prisoners (N), the step size (K), the number of survivors (M), and an indicator to print executions or survivors. It simulates the Josephus problem where prisoners are sequentially eliminated every K steps in a circle until only M survivors remain. The code calculates and prints the killing sequence or the surviving prisoners based on the indicator. The prisoners are numbered from 0 to N-1. The default parameters are 41, 3, 1, 1.


with Ada.Strings.Fixed;  use Ada.Strings.Fixed;
with Ada.Text_IO;        use Ada.Text_IO;

procedure String_Multiplication is
begin
   Put_Line (5 * "ha");
end String_Multiplication;

hahahahaha

The code takes a string and a number as input and repeats the string for the given number of times. It also provides a method to repeat a single character to create a new string. An example of its usage in Ada programming language is also given.


with Ada.Text_IO; with Gnat.Regpat; use Ada.Text_IO;

procedure Regex is

   package Pat renames Gnat.Regpat;

   procedure Search_For_Pattern(Compiled_Expression: Pat.Pattern_Matcher;
                                Search_In: String;
                                First, Last: out Positive;
                                Found: out Boolean) is
      Result: Pat.Match_Array (0 .. 1);
   begin
      Pat.Match(Compiled_Expression, Search_In, Result);
      Found := not Pat."="(Result(1), Pat.No_Match);
      if Found then
         First := Result(1).First;
         Last := Result(1).Last;
      end if;
   end Search_For_Pattern;

   Word_Pattern: constant String := "([a-zA-Z]+)";

   Str:           String:= "I love PATTERN matching!";
   Current_First: Positive := Str'First;
   First, Last:   Positive;
   Found:         Boolean;

begin
   -- first, find all the words in Str
   loop
      Search_For_Pattern(Pat.Compile(Word_Pattern),
                         Str(Current_First .. Str'Last),
                         First, Last, Found);
   exit when not Found;
      Put_Line("<" & Str(First .. Last) & ">");
      Current_First := Last+1;
   end loop;

   -- second, replace "PATTERN" in Str by "pattern"
   Search_For_Pattern(Pat.Compile("(PATTERN)"), Str, First, Last, Found);
   Str := Str(Str'First .. First-1) & "pattern" & Str(Last+1 .. Str'Last);
   Put_Line(Str);
end Regex;

utilize a gnat/gcc library to match a string against a regular expression and substitute part of a string using a regular expression, as there is no Regular Expression library in the Ada Standard.


with Ada.Text_Io;
with Ada.Integer_Text_IO;

procedure Integer_Arithmetic is
   use Ada.Text_IO;
   use Ada.Integer_Text_Io;

   A, B : Integer;
begin
   Get(A);
   Get(B);
   Put_Line("a+b = " & Integer'Image(A + B));
   Put_Line("a-b = " & Integer'Image(A - B));
   Put_Line("a*b = " & Integer'Image(A * B));
   Put_Line("a/b = " & Integer'Image(A / B));
   Put_Line("a mod b = " & Integer'Image(A mod B)); -- Sign matches B
   Put_Line("remainder of a/b = " & Integer'Image(A rem B)); -- Sign matches A
   Put_Line("a**b = " & Integer'Image(A ** B));

end Integer_Arithmetic;

take two integers as input from the user and display their sum, difference, product, integer quotient, remainder, and exponentiation. The code also indicates the rounding direction for the quotient and the sign of the remainder. It does not include error handling. A bonus feature is the inclusion of the `divmod` operator example.


with Ada.Strings.Fixed, Ada.Integer_Text_IO;

procedure Substrings is
begin
   Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source  => "the three truths",
                                                     Pattern => "th"));
   Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source  => "ababababab",
                                                     Pattern => "abab"));
end Substrings;

The code defines a function to count the number of non-overlapping occurrences of a given substring within a larger string. The function takes two arguments: the main string and the substring to search for. It returns an integer representing the count of non-overlapping occurrences. The function prioritizes the highest number of non-overlapping matches, typically matching from left-to-right or right-to-left.


with Ada.Text_Io; use Ada.Text_Io;

procedure Towers is
   type Pegs is (Left, Center, Right);
   procedure Hanoi (Ndisks : Natural; Start_Peg : Pegs := Left; End_Peg : Pegs := Right; Via_Peg : Pegs := Center) is
   begin
      if Ndisks > 0 then
         Hanoi(Ndisks - 1, Start_Peg, Via_Peg, End_Peg);
         Put_Line("Move disk" & Natural'Image(Ndisks) & " from " & Pegs'Image(Start_Peg) & " to " & Pegs'Image(End_Peg));
         Hanoi(Ndisks - 1, Via_Peg, End_Peg, Start_Peg);
      end if;
   end Hanoi;
begin
   Hanoi(4);
end Towers;

"Implement a recursive solution to solve the Towers of Hanoi problem."


with Ada.Text_IO;  use Ada.Text_IO;
procedure Test_Binomial is
   function Binomial (N, K : Natural) return Natural is
      Result : Natural := 1;
      M      : Natural;
   begin
      if N < K then
         raise Constraint_Error;
      end if;
      if K > N/2 then -- Use symmetry
         M := N - K;
      else
         M := K;
      end if;
      for I in 1..M loop
         Result := Result * (N - M + I) / I;
      end loop;
      return Result;
   end Binomial;
begin
   for N in 0..17 loop
      for K in 0..N loop
         Put (Integer'Image (Binomial (N, K)));
      end loop;
      New_Line;
   end loop;
end Test_Binomial;

The code calculates any binomial coefficient using the provided formula. It is specifically designed to output the binomial coefficient of 5 choose 3, which is 10. It also includes tasks for generating combinations and permutations, both with and without replacement.


generic
   type Element_Type is digits <>;
   type Index_Type is (<>);
   type Array_Type is array(Index_Type range <>) of Element_Type;
package Shell_Sort is
   procedure Sort(Item : in out Array_Type);
end Shell_Sort;

package body Shell_Sort is

   ----------
   -- Sort --
   ----------

   procedure Sort (Item : in out Array_Type) is
      Increment : Natural := Index_Type'Pos(Item'Last) / 2;
      J : Index_Type;
      Temp : Element_Type;
   begin
      while Increment > 0 loop
         for I in Index_Type'Val(Increment) .. Item'Last loop
            J := I;
            Temp := Item(I);
            while J > Index_Type'val(Increment) and then Item (Index_Type'Val(Index_Type'Pos(J) - Increment)) > Temp loop
               Item(J) := Item (Index_Type'Val(Index_Type'Pos(J) - Increment));
               J := Index_Type'Val(Index_Type'Pos(J) - Increment);
            end loop;
            Item(J) := Temp;
         end loop;
         if Increment = 2 then
            Increment := 1;
         else
            Increment := Increment * 5 / 11;
         end if;
      end loop;
   end Sort;

end Shell_Sort;

implement the Shell sort algorithm to sort an array of elements. The algorithm, named after Donald Shell, uses a diminishing increment sort method. It performs a series of interleaved insertion sorts based on an increment sequence, reducing the increment size after each pass until it reaches 1. The final sort is a basic insertion sort, but the data is almost sorted at this point, making it the "best case" scenario for insertion sort. The algorithm can use any sequence ending in 1, with a geometric increment sequence with a ratio of about 2.2 showing good performance in empirical studies. The implementation is generic and can handle arrays indexed by integer or enumeration types starting at any value.


type Grayscale_Image is array (Positive range <>, Positive range <>) of Luminance;

function Grayscale (Picture : Image) return Grayscale_Image is
   type Extended_Luminance is range 0..10_000_000;
   Result : Grayscale_Image (Picture'Range (1), Picture'Range (2));
   Color  : Pixel;
begin
   for I in Picture'Range (1) loop
      for J in Picture'Range (2) loop
         Color := Picture (I, J);
         Result (I, J) :=
            Luminance
            (  (  2_126 * Extended_Luminance (Color.R)
               +  7_152 * Extended_Luminance (Color.G)
               +    722 * Extended_Luminance (Color.B)
               )
            /  10_000
            );
      end loop;
   end loop;
   return Result;
end Grayscale;

function Color (Picture : Grayscale_Image) return Image is
   Result : Image (Picture'Range (1), Picture'Range (2));
begin
   for I in Picture'Range (1) loop
      for J in Picture'Range (2) loop
         Result (I, J) := (others => Picture (I, J));
      end loop;
   end loop;
   return Result;
end Color;

extend the data storage type to support grayscale images, define operations to convert a color image to a grayscale image and vice versa, calculate luminance of a color using a specific formula, and handle potential rounding errors in floating-point arithmetic.


Works with: GNAT
Library: GtkAda

with Gtk.Main;
with Gtk.Handlers;
with Gtk.Label;
with Gtk.Button;
with Gtk.Window;
with Glib.Main;

procedure Animation is
   Scroll_Forwards : Boolean := True;

   package Button_Callbacks is new Gtk.Handlers.Callback
     (Gtk.Button.Gtk_Button_Record);

   package Label_Timeout is new Glib.Main.Generic_Sources
     (Gtk.Label.Gtk_Label);

   package Window_Callbacks is new Gtk.Handlers.Return_Callback
     (Gtk.Window.Gtk_Window_Record, Boolean);

   --  Callback for click event
   procedure On_Button_Click
     (Object : access Gtk.Button.Gtk_Button_Record'Class);

   --  Callback for delete event
   function On_Main_Window_Delete
     (Object : access Gtk.Window.Gtk_Window_Record'Class)
      return   Boolean;

   function Scroll_Text (Data : Gtk.Label.Gtk_Label) return Boolean;

   procedure On_Button_Click
     (Object : access Gtk.Button.Gtk_Button_Record'Class)
   is
      pragma Unreferenced (Object);
   begin
      Scroll_Forwards := not Scroll_Forwards;
   end On_Button_Click;

   function On_Main_Window_Delete
     (Object : access Gtk.Window.Gtk_Window_Record'Class)
      return   Boolean
   is
      pragma Unreferenced (Object);
   begin
      Gtk.Main.Main_Quit;
      return True;
   end On_Main_Window_Delete;

   function Scroll_Text (Data : Gtk.Label.Gtk_Label) return Boolean is
      Text : constant String := Gtk.Label.Get_Text (Data);
   begin
      if Scroll_Forwards then
         Gtk.Label.Set_Text
           (Label => Data,
            Str   => Text (Text'First + 1 .. Text'Last) & Text (Text'First));
      else
         Gtk.Label.Set_Text
           (Label => Data,
            Str   => Text (Text'Last) & Text (Text'First .. Text'Last - 1));
      end if;
      return True;
   end Scroll_Text;

   Main_Window     : Gtk.Window.Gtk_Window;
   Text_Button     : Gtk.Button.Gtk_Button;
   Scrolling_Text  : Gtk.Label.Gtk_Label;
   Timeout_ID      : Glib.Main.G_Source_Id;
   pragma Unreferenced (Timeout_ID);

begin
   Gtk.Main.Init;
   Gtk.Window.Gtk_New (Window => Main_Window);
   Gtk.Label.Gtk_New (Label => Scrolling_Text, Str => "Hello World! ");
   Gtk.Button.Gtk_New (Button => Text_Button);
   Gtk.Button.Add (Container => Text_Button, Widget => Scrolling_Text);
   Button_Callbacks.Connect
     (Widget => Text_Button,
      Name   => "clicked",
      Marsh  => Button_Callbacks.To_Marshaller (On_Button_Click'Access));
   Timeout_ID :=
     Label_Timeout.Timeout_Add
       (Interval => 125,
        Func     => Scroll_Text'Access,
        Data     => Scrolling_Text);
   Gtk.Window.Add (Container => Main_Window, Widget => Text_Button);
   Window_Callbacks.Connect
     (Widget => Main_Window,
      Name   => "delete_event",
      Marsh  => Window_Callbacks.To_Marshaller (On_Main_Window_Delete'Access));
   Gtk.Window.Show_All (Widget => Main_Window);
   Gtk.Main.Main;
end Animation;

The code creates a GUI with an animated "Hello World!" text that appears to be rotating to the right. The rotation direction reverses whenever the user clicks on the text within the window.


loop
   Value := Value + 1;
   Put (Value);
   exit when Value mod 6 = 0;
end loop;

for Value in 0..Integer'Last loop
   Put (Value);
   exit when Value mod 6 = 0;
end loop;

Initialize a value at 0, then enter a loop where the value is incremented by 1 and printed each iteration. The loop continues as long as the value modulo 6 is not 0. The loop is guaranteed to execute at least once.


Works with: GCC version 4.1.2
Byte Length[edit]
Str    : String := "Hello World";
Length : constant Natural := Str'Size / 8;

Character Length[edit]
Latin_1_Str    : String           := "Hello World";
UCS_16_Str     : Wide_String      := "Hello World";
Unicode_Str    : Wide_Wide_String := "Hello World";
Latin_1_Length : constant Natural := Latin_1_Str'Length;
UCS_16_Length  : constant Natural := UCS_16_Str'Length;
Unicode_Length : constant Natural := Unicode_Str'Length;

determine the character and byte length of a string, taking into account different encodings such as UTF-8 and UTF-16. The character length is calculated based on individual Unicode code points, not user-visible graphemes. The code also handles Non-BMP code points correctly. It provides the option to mark examples with character length, byte length or grapheme length. For languages capable of providing string length in graphemes, it marks those examples accordingly. It also considers the 'Size attribute for byte length calculation and 'Length attribute for character length calculation in Ada language. The code supports strings of Latin-1, UCS-16 and full Unicode characters.


with Ada.Streams.Stream_IO;
with Ada.Text_IO;
procedure Random is
   Number : Integer;
   Random_File : Ada.Streams.Stream_IO.File_Type;
begin
   Ada.Streams.Stream_IO.Open (File => Random_File,
                               Mode => Ada.Streams.Stream_IO.In_File,
                               Name => "/dev/random");
   Integer'Read (Ada.Streams.Stream_IO.Stream (Random_File), Number);
   Ada.Streams.Stream_IO.Close (Random_File);
   Ada.Text_IO.Put_Line ("Number:" & Integer'Image (Number));
end Random;

demonstrate how to generate a random 32-bit number using a system's built-in mechanism, not relying solely on a software algorithm like /dev/urandom devices in Unix.


with Ada.Text_IO;

procedure Remove_Characters is
   S: String := "upraisers";
   use Ada.Text_IO;
begin
   Put_Line("Full String:   """ & S & """");
   Put_Line("Without_First: """ & S(S'First+1 .. S'Last) & """");
   Put_Line("Without_Last:  """ & S(S'First   .. S'Last-1) & """");
   Put_Line("Without_Both:  """ & S(S'First+1 .. S'Last-1) & """");
end Remove_Characters;

Full String:   "upraisers"
Without_First: "praisers"
Without_Last:  "upraiser"
Without_Both:  "praiser"

with Ada.Text_IO;
with Ada.Strings.UTF_Encoding.Wide_Strings;

procedure Remove_Characters
is
   use Ada.Text_IO;
   use Ada.Strings.UTF_Encoding;
   use Ada.Strings.UTF_Encoding.Wide_Strings;

   S : String := "upraisers";
   U : Wide_String := Decode (UTF_8_String'(S));

   function To_String (X : Wide_String)return String
   is
   begin
      return String (UTF_8_String'(Encode (X)));
   end To_String;

begin
   Put_Line
     (To_String
        ("Full String:   """ & U & """"));
   Put_Line
     (To_String
        ("Without_First: """ & U (U'First + 1 .. U'Last) & """"));
   Put_Line
     (To_String
        ("Without_Last:  """ & U (U'First   .. U'Last - 1) & """"));
   Put_Line
     (To_String
        ("Without_Both:  """ & U (U'First + 1 .. U'Last - 1) & """"));

end Remove_Characters;

Full String:   "upraisers"
Without_First: "praisers"
Without_Last:  "upraiser"
Without_Both:  "praiser"

demonstrate how to remove the first, last, or both characters from a string, ensuring compatibility with any valid Unicode code point in UTF-8 or UTF-16 encoding. The program references logical characters, not 8-bit or 16-bit code units.


with Ada.Text_IO;

procedure Single_Instance is

   package IO renames Ada.Text_IO;
   Lock_File: IO.File_Type;
   Lock_File_Name: String := "single_instance.magic_lock";

begin
   begin
      IO.Open(File => Lock_File, Mode=> IO.In_File, Name => Lock_File_Name);
      IO.Close(Lock_File);
      IO.Put_Line("I can't -- another instance of me is running ...");
   exception
      when IO.Name_Error =>
         IO.Put_Line("I can run!");
         IO.Create(File => Lock_File, Name => Lock_File_Name);
         for I in 1 .. 10 loop
            IO.Put(Integer'Image(I));
            delay 1.0; -- wait one second
         end loop;
         IO.Delete(Lock_File);
         IO.New_Line;
         IO.Put_Line("I am done!");
   end;
exception
   when others => IO.Delete(Lock_File);
end Single_Instance;

The code checks if there is only one instance of an application running. It attempts to open a file for reading, if the file doesn't exist, it raises a 'Name_Error', creates the file, and performs its task. If the file exists or any other exception is raised, the program stops. It also handles a race condition where multiple instances might run if they try to open the file before it's created.


Library: GTK
Library: GtkAda
with Gtk.Main;
with Glib;
with Gtk.Window;  use Gtk.Window;
with Gtk.Enums;   use Gtk.Enums;
with Ada.Text_IO; use Ada.Text_IO;

procedure Max_Size is

   Win          : Gtk_Window;
   Win_W, Win_H : Glib.Gint;
   package Int_Io is new Integer_IO (Glib.Gint);
   Hid : Gtk.Main.Quit_Handler_Id;

begin
   Gtk.Main.Init;
   Gtk_New (Win);
   Initialize (Win, Window_Toplevel);
   Maximize (Win);
   Show (Win);
   Get_Size (Win, Win_W, Win_H);
   Put ("Maximum dimensions of window : W ");
   Int_Io.Put (Win_W, Width => 4);
   Put (" x H ");
   Int_Io.Put (Win_H, Width => 4);
   New_Line;
   Hid := Gtk.Main.Quit_Add_Destroy (0, Win);
end Max_Size;

Maximum dimensions of window : W 1280 x H  734

determine the maximum height and width of a window that can fit within the physical display area of the screen, considering window decorations, menubars, multiple monitors, and tiling window managers. The output is based on a 1280 x 800 screen with Windows XP.


Translation of: C++
with Ada.Text_IO;

procedure Sudoku is
   type sudoku_ar_t is array ( integer range 0..80 ) of integer range 0..9;
   FINISH_EXCEPTION : exception;

   procedure prettyprint(sudoku_ar: sudoku_ar_t);
   function checkValidity( val : integer; x : integer; y : integer;  sudoku_ar: in  sudoku_ar_t) return Boolean;
   procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t);
   procedure solve(sudoku_ar: in out sudoku_ar_t);

   function checkValidity( val : integer; x : integer; y : integer;  sudoku_ar: in  sudoku_ar_t) return Boolean
   is
   begin
      for i in 0..8 loop

         if ( sudoku_ar( y * 9 + i ) = val or sudoku_ar( i * 9 + x ) = val ) then
            return False;
         end if;
      end loop;

      declare
         startX : constant integer := ( x / 3 ) * 3;
         startY : constant integer := ( y / 3 ) * 3;
      begin
         for i in startY..startY+2 loop
            for j in startX..startX+2 loop
               if ( sudoku_ar( i * 9 +j ) = val ) then
                  return False;
               end if;
            end loop;
         end loop;
         return True;
      end;
   end checkValidity;

   procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t)
   is
   begin
      if ( pos = 81 ) then
         raise FINISH_EXCEPTION;
      end if;
      if (  sudoku_ar(pos) > 0 ) then
         placeNumber(pos+1, sudoku_ar);
         return;
      end if;
      for n in 1..9 loop
         if( checkValidity( n,  pos mod 9, pos / 9 , sudoku_ar ) ) then
            sudoku_ar(pos) := n;
            placeNumber(pos + 1, sudoku_ar );
            sudoku_ar(pos) := 0;
         end if;
      end loop;
   end placeNumber;

   procedure solve(sudoku_ar: in out sudoku_ar_t)
   is
   begin
      placeNumber( 0, sudoku_ar );
      Ada.Text_IO.Put_Line("Unresolvable !");
   exception
      when FINISH_EXCEPTION =>
         Ada.Text_IO.Put_Line("Finished !");
         prettyprint(sudoku_ar);
   end solve;

   procedure prettyprint(sudoku_ar: sudoku_ar_t)
   is
      line_sep   : constant String  := "------+------+------";
   begin
      for i in sudoku_ar'Range loop
         Ada.Text_IO.Put(sudoku_ar(i)'Image);
         if (i+1) mod 3 = 0 and not((i+1) mod 9 = 0) then
            Ada.Text_IO.Put("|");
         end if;
         if (i+1) mod 9 = 0 then
            Ada.Text_IO.Put_Line("");
         end if;
         if (i+1) mod 27 = 0 then
            Ada.Text_IO.Put_Line(line_sep);
         end if;
      end loop;
   end prettyprint;

   sudoku_ar : sudoku_ar_t :=
     (
      8,5,0,0,0,2,4,0,0,
      7,2,0,0,0,0,0,0,9,
      0,0,4,0,0,0,0,0,0,
      0,0,0,1,0,7,0,0,2,
      3,0,5,0,0,0,9,0,0,
      0,4,0,0,0,0,0,0,0,
      0,0,0,0,8,0,0,7,0,
      0,1,7,0,0,0,0,0,0,
      0,0,0,0,3,6,0,4,0
     );

begin
   solve( sudoku_ar );
end Sudoku;

"Implement a Sudoku solver that takes a partially filled 9x9 grid as input and outputs the completed Sudoku grid in a human-readable format."


generic
   type Element_Type is private;
   type Array_Type is array (Positive range <>) of Element_Type;

procedure Generic_Shuffle (List : in out Array_Type);

with Ada.Numerics.Discrete_Random;

procedure Generic_Shuffle (List : in out Array_Type) is
   package Discrete_Random is new Ada.Numerics.Discrete_Random(Result_Subtype => Integer);
   use Discrete_Random;
   K : Integer;
   G : Generator;
   T : Element_Type;
begin
   Reset (G);
   for I in reverse List'Range loop
      K := (Random(G) mod I) + 1;
      T := List(I);
      List(I) := List(K);
      List(K) := T;
   end loop;
end Generic_Shuffle;

with Ada.Text_IO;
with Generic_Shuffle;

procedure Test_Shuffle is

   type Integer_Array is array (Positive range <>) of Integer;

   Integer_List : Integer_Array
     := (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18);
   procedure Integer_Shuffle is new Generic_Shuffle(Element_Type => Integer,
                                                    Array_Type => Integer_Array);
begin

   for I in Integer_List'Range loop
      Ada.Text_IO.Put(Integer'Image(Integer_List(I)));
   end loop;
   Integer_Shuffle(List => Integer_List);
   Ada.Text_IO.New_Line;
   for I in Integer_List'Range loop
      Ada.Text_IO.Put(Integer'Image(Integer_List(I)));
   end loop;
end Test_Shuffle;

implement the Knuth shuffle (also known as the Fisher-Yates shuffle) algorithm. The algorithm randomly shuffles the elements of an integer array or an array of any type. The shuffle is done in-place, but can be modified to return a new array if necessary. The algorithm can also be adjusted to iterate from left to right.


with Ada.Text_IO, GNAT.Calendar.Time_IO, Ada.Command_Line,
  Ada.Calendar.Formatting, Ada.Calendar.Arithmetic;

procedure Last_Weekday_In_Month is

   procedure Put_Line(T: Ada.Calendar.Time) is
      use GNAT.Calendar.Time_IO;
   begin
      Ada.Text_IO.Put_Line(Image(Date => T, Picture => ISO_Date));
   end Put_Line;

   use Ada.Calendar, Ada.Calendar.Arithmetic;
   subtype Day_Name is Formatting.Day_Name; use type Formatting.Day_Name;

   T, Selected : Time;
   Weekday: Day_Name  := Day_Name'Value(Ada.Command_Line.Argument (1));
   Year : Year_Number := Integer'Value (Ada.Command_Line.Argument (2));

begin
   for Month in 1 .. 12 loop
      T := Time_Of (Year => Year, Month => Month, Day => 01);
      while Ada.Calendar.Month(T) = Month loop
	 if Formatting.Day_Of_Week (T) = Weekday then
	    Selected := T;
	 end if;
	 T := T + Day_Count(1);
      end loop;
      Put_Line(Selected);
   end loop;
end Last_Weekday_In_Month;

The code takes a year as input and returns the dates of the last Fridays of each month for that given year.


with Ada.Text_IO;

procedure Goodbye_World is
begin
   Ada.Text_IO.Put("Goodbye, World!");
end Goodbye_World;

with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;

procedure Goodbye_World is
    stdout: Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output;
begin
    String'Write(Ada.Text_IO.Text_Streams.Stream(stdout), "Goodbye World");
end Goodbye_World;

display the string "Goodbye, World!" without a trailing newline using Ada.Text_IO.Text_Streams to control the termination. The codes also handle the automatic insertion of a newline in some languages and ensure the output includes a final, implementation-defined terminator if the output is a file such as stdout on UNIX systems.


Library: GTK version GtkAda
Library: GtkAda
with Gtk.Button;  use Gtk.Button;
with Gtk.GEntry;  use Gtk.GEntry;
with Gtk.Label;   use Gtk.Label;
with Gtk.Window;  use Gtk.Window;
with Gtk.Widget;  use Gtk.Widget;
with Gtk.Table;   use Gtk.Table;

with Gtk.Handlers;
with Gtk.Main;

procedure Graphic_Input is
   Window  : Gtk_Window;
   Grid    : Gtk_Tnetable;
   Label   : Gtk_Label;
   Message : Gtk_Label;
   Edit    : Gtk_GEntry;
   Button  : Gtk_Button;

   package Handlers is new Gtk.Handlers.Callback (Gtk_Widget_Record);
   package Return_Handlers is
      new Gtk.Handlers.Return_Callback (Gtk_Widget_Record, Boolean);

   function Delete_Event (Widget : access Gtk_Widget_Record'Class)
      return Boolean is
   begin
      return False;
   end Delete_Event;

   procedure Destroy (Widget : access Gtk_Widget_Record'Class) is
   begin
      Gtk.Main.Main_Quit;
   end Destroy;

   procedure Clicked (Widget : access Gtk_Widget_Record'Class) is
   begin
      if Get_Text (Label) = "Enter integer:" then
         Set_Text (Message, "Entered:" & Integer'Image (Integer'Value (Get_Text (Edit))));
         Set_Sensitive (Button, False);
      else
         Set_Text (Message, "Entered:" & Get_Text (Edit));
         Set_Text (Label, "Enter integer:");
      end if;
   exception
      when Constraint_Error =>
         Set_Text (Message, "Error integer input");
   end Clicked;

begin
   Gtk.Main.Init;
   Gtk.Window.Gtk_New (Window);
   Gtk_New (Grid, 2, 3, False);
   Add (Window, Grid);
   Gtk_New (Label, "Enter string:");
   Attach (Grid, Label, 0, 1, 0, 1);
   Gtk_New (Edit);
   Attach (Grid, Edit, 1, 2, 0, 1);
   Gtk_New (Button, "OK");
   Attach (Grid, Button, 2, 3, 0, 1);
   Gtk_New (Message);
   Attach (Grid, Message, 0, 3, 1, 2);
   Return_Handlers.Connect
   (  Window,
      "delete_event",
      Return_Handlers.To_Marshaller (Delete_Event'Access)
   );
   Handlers.Connect
   (  Window,
      "destroy",
      Handlers.To_Marshaller (Destroy'Access)
   );
   Handlers.Connect
   (  Button,
      "clicked",
      Handlers.To_Marshaller (Clicked'Access)
   );
   Show_All (Grid);
   Show (Window);

   Gtk.Main.Main;
end Graphic_Input;

"Implement functionality to accept a string and the integer 75000 as inputs from a graphical user interface."


with Ada.Text_IO;

procedure Caesar is

   type modulo26 is modulo 26;

   function modulo26 (Character: Character;

implement both encoding and decoding functions of a Caesar cipher. The cipher rotates the alphabet letters based on a key ranging from 1 to 25, replacing each letter with the corresponding next letter in the alphabet. The codes also handle cases of wrapping from Z to A. The codes illustrate that Caesar cipher provides minimal security as it is vulnerable to frequency analysis and brute force attacks. The codes also demonstrate that Caesar cipher is identical to Vigenère cipher with a key length of 1 and to Rot-13 with a key of 13.


with Ada.Text_IO; use Ada.Text_IO;

procedure Lcm_Test is
   function Gcd (A, B : Integer) return Integer is
      M : Integer := A;
      N : Integer := B;
      T : Integer;
   begin
      while N /= 0 loop
         T := M;
         M := N;
         N := T mod N;
      end loop;
      return M;
   end Gcd;

   function Lcm (A, B : Integer) return Integer is
   begin
      if A = 0 or B = 0 then
         return 0;
      end if;
      return abs (A) * (abs (B) / Gcd (A, B));
   end Lcm;
begin
   Put_Line ("LCM of 12, 18 is" & Integer'Image (Lcm (12, 18)));
   Put_Line ("LCM of -6, 14 is" & Integer'Image (Lcm (-6, 14)));
   Put_Line ("LCM of 35, 0 is" & Integer'Image (Lcm (35, 0)));
end Lcm_Test;

LCM of 12, 18 is 36
LCM of -6, 14 is 42
LCM of 35, 0 is 0

calculate the least common multiple (LCM) of two integers m and n. The LCM is the smallest positive integer that is a factor of both m and n. If either m or n is zero, the LCM is zero. The LCM can be found by iterating all multiples of m until a multiple of n is found, or by using the formula lcm(m, n) = |m × n| / gcd(m, n), where gcd is the greatest common divisor. The LCM can also be found by merging the prime decompositions of m and n.


with Ada.Text_IO;

procedure Cusip_Test is
   use Ada.Text_IO;

   subtype Cusip is String (1 .. 9);

   function Check_Cusip (Code : Cusip) return Boolean is
      Sum : Integer := 0;
      V   : Integer;

   begin
      for I in Code'First .. Code'Last - 1 loop
         case Code (I) is
            when '0' .. '9' =>
               V := Character'Pos (Code (I)) - Character'Pos ('0');
            when 'A' .. 'Z' =>
               V := Character'Pos (Code (I)) - Character'Pos ('A') + 10;
            when '*' => V := 36;
            when '@' => V := 37;
            when '#' => V := 38;
            when others => return False;
         end case;

         if I mod 2 = 0 then
            V := V * 2;
         end if;

         Sum := Sum + V / 10 + (V mod 10);
      end loop;

      return (10 - (Sum mod 10)) mod 10 =
        Character'Pos (Code (Code'Last)) - Character'Pos ('0');
   end Check_Cusip;

   type Cusip_Array is array (Natural range <>) of Cusip;

   Test_Array : Cusip_Array :=
     ("037833100",
      "17275R102",
      "38259P508",
      "594918104",
      "68389X106",
      "68389X105");
begin
   for I in Test_Array'Range loop
      Put (Test_Array (I) & ": ");
      if Check_Cusip (Test_Array (I)) then
         Put_Line ("valid");
      else
         Put_Line ("not valid");
      end if;
   end loop;
end Cusip_Test;

The code validates the last digit (check digit) of a given CUSIP code, which is a nine-character alphanumeric code used to identify North American financial securities. The validation is performed according to a specific algorithm that considers the numeric value of digits, the ordinal position of letters in the alphabet, and specific values for special characters. The code also handles the doubling of values for even-positioned characters. The final check digit is calculated as (10 - (sum of calculated values mod 10)) mod 10.


with Ada.Text_IO;  use Ada.Text_IO;
with System;       use System;

procedure Host_Introspection is
begin
   Put_Line ("Word size" & Integer'Image (Word_Size));
   Put_Line ("Endianness " & Bit_Order'Image (Default_Bit_Order));
end Host_Introspection;

Sample output on a Pentium machine:
Word size 32
Endianness LOW_ORDER_FIRST

"Outputs the word size and endianness of the host machine."


Library: AWS
with Ada.Integer_Text_IO;   use Ada.Integer_Text_IO;
with Ada.Strings.Fixed;     use Ada.Strings.Fixed;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO;           use Ada.Text_IO;

with Ada.Containers.Ordered_Sets;
with Ada.Strings.Less_Case_Insensitive;

with AWS.Client;
with AWS.Response;

procedure Test is

   use Ada.Strings;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   type A_Language_Count is
      record
         Count    : Integer := 0;
         Language : Unbounded_String;
      end record;

   function "=" (L, R : A_Language_Count) return Boolean is
   begin
      return L.Language = R.Language;
   end "=";

   function "<" (L, R : A_Language_Count) return Boolean is
   begin
      -- Sort by 'Count' and then by Language name
      return L.Count < R.Count
        or else (L.Count = R.Count
                 and then Less_Case_Insensitive (Left  => To_String (L.Language),
                                                 Right => To_String (R.Language)));
   end "<";

   package Sets is new Ada.Containers.Ordered_Sets (A_Language_Count);
   use Sets;

   Counts : Set;

   procedure Find_Counts (S : String) is
      Title_Str : constant String  := "title=""Category:";
      End_A_Str : constant String  := "</a> (";

      Title_At   : constant Natural := Index (S, Title_Str);
   begin
      if Title_At /= 0 then
         declare
            Bracket_At : constant Natural := Index (S (Title_At   + Title_Str'Length .. S'Last), ">");
            End_A_At   : constant Natural := Index (S (Bracket_At + 1                .. S'Last), End_A_Str);
            Space_At   : constant Natural := Index (S (End_A_At   + End_A_Str'Length .. S'Last), " ");
            Count      : constant Natural := Natural'Value (S (End_A_At + End_A_Str'Length .. Space_At - 1));
            Language   : constant String  :=                S (Title_At + Title_Str'Length .. Bracket_At - 2);
         begin
            if Bracket_At /= 0 and then End_A_At /= 0 and then Space_At /= 0 then
               begin
                  Counts.Insert (New_Item => (Count, +Language));
               exception
                  when Constraint_Error =>
                     Put_Line (Standard_Error, "Warning: repeated language: " & Language);
                     -- Ignore repeated results.
                     null;
               end;
            end if;
            -- Recursively parse the string for languages and counts
            Find_Counts (S (Space_At + 1 .. S'Last));
         end;
      end if;

   end Find_Counts;

   Place : Natural := 1;

   procedure Display (C : Cursor) is
   begin
      Put (Place, Width => 1);             Put (". ");
      Put (Element (C).Count, Width => 1); Put (" - ");
      Put_Line (To_String (Element (C).Language));
      Place := Place + 1;
   end Display;

   Http_Source : constant AWS.Response.Data :=
     AWS.Client.Get ("http://rosettacode.org/mw/index.php?title=Special:Categories&limit=5000");
begin
   Find_Counts (AWS.Response.Message_Body (Http_Source));
   Counts.Reverse_Iterate (Display'Access);
end Test;

sort the most popular computer programming languages based on the number of members in Rosetta Code categories. It fetches data either through web scraping or using the API method. The code also has the functionality to filter incorrect results. The final output is a ranked list of all programming languages.


arrays[edit]
with Ada.Integer_Text_IO;
use  Ada.Integer_Text_IO;

procedure For_Each is

   A : array (1..5) of Integer := (-1, 0, 1, 2, 3);

begin

   for Num in A'Range loop
      Put( A (Num) );
   end loop;

end For_Each;

   for Item of A loop
      Put( Item );
   end loop;

doubly linked lists[edit]
Works with: Ada 2005
with Ada.Integer_Text_IO, Ada.Containers.Doubly_Linked_Lists;
use  Ada.Integer_Text_IO, Ada.Containers;

procedure Doubly_Linked_List is

   package DL_List_Pkg is new Doubly_Linked_Lists (Integer);
   use     DL_List_Pkg;

   procedure Print_Node (Position : Cursor) is
   begin
      Put (Element (Position));
   end Print_Node;

   DL_List : List;

begin

   DL_List.Append (1);
   DL_List.Append (2);
   DL_List.Append (3);

   -- Iterates through every node of the list.
   DL_List.Iterate (Print_Node'Access);

end Doubly_Linked_List;

vectors[edit]
Works with: Ada 2005
with Ada.Integer_Text_IO, Ada.Containers.Vectors;
use  Ada.Integer_Text_IO, Ada.Containers;

procedure Vector_Example is

   package Vector_Pkg is new Vectors (Natural, Integer);
   use     Vector_Pkg;

   procedure Print_Element (Position : Cursor) is
   begin
      Put (Element (Position));
   end Print_Element;

   V : Vector;

begin

   V.Append (1);
   V.Append (2);
   V.Append (3);

   -- Iterates through every element of the vector.
   V.Iterate (Print_Element'Access);

end Vector_Example;

Iterates through each element in a collection in order using a "for each" loop or an alternative loop and prints them. This is implemented in Ada 2012.


with Ada.Text_IO, Ada.Containers.Indefinite_Vectors, Ada.Strings.Fixed, Ada.Strings.Maps;
use Ada.Text_IO, Ada.Containers, Ada.Strings, Ada.Strings.Fixed, Ada.Strings.Maps;

procedure Tokenize is
   package String_Vectors is new Indefinite_Vectors (Positive, String);
   use String_Vectors;
   Input  : String   := "Hello,How,Are,You,Today";
   Start  : Positive := Input'First;
   Finish : Natural  := 0;
   Output : Vector   := Empty_Vector;
begin
   while Start <= Input'Last loop
      Find_Token (Input, To_Set (','), Start, Outside, Start, Finish);
      exit when Start > Finish;
      Output.Append (Input (Start .. Finish));
      Start := Finish + 1;
   end loop;
   for S of Output loop
      Put (S & ".");
   end loop;
end Tokenize;

"Tokenizes a string by commas into an array, and displays the words to the user separated by a period, including a trailing period."


with Ada.Text_Io; use Ada.Text_Io;

procedure Gcd_Test is
   function Gcd (A, B : Integer) return Integer is
      M : Integer := A;
      N : Integer := B;
      T : Integer;
   begin
      while N /= 0 loop
         T := M;
         M := N;
         N := T mod N;
      end loop;
      return M;
   end Gcd;

begin
   Put_Line("GCD of 100, 5 is" & Integer'Image(Gcd(100, 5)));
   Put_Line("GCD of 5, 100 is" & Integer'Image(Gcd(5, 100)));
   Put_Line("GCD of 7, 23 is" & Integer'Image(Gcd(7, 23)));
end Gcd_Test;

GCD of 100, 5 is 5
GCD of 5, 100 is 5
GCD of 7, 23 is 1

find the greatest common divisor (GCD), also known as greatest common factor (gcf) or greatest common measure, of two integers.


Works with: GNAT

with Ada.Text_IO;
with Ada.IO_Exceptions;
with GNAT.Sockets;
procedure Echo_Server is
   Receiver   : GNAT.Sockets.Socket_Type;
   Connection : GNAT.Sockets.Socket_Type;
   Client     : GNAT.Sockets.Sock_Addr_Type;
   Channel    : GNAT.Sockets.Stream_Access;
begin
   GNAT.Sockets.Create_Socket (Socket => Receiver);
   GNAT.Sockets.Set_Socket_Option
     (Socket => Receiver,
      Level  => GNAT.Sockets.Socket_Level,
      Option => (Name    => GNAT.Sockets.Reuse_Address, Enabled => True));
   GNAT.Sockets.Bind_Socket
     (Socket  => Receiver,
      Address => (Family => GNAT.Sockets.Family_Inet,
                  Addr   => GNAT.Sockets.Inet_Addr ("127.0.0.1"),
                  Port   => 12321));
   GNAT.Sockets.Listen_Socket (Socket => Receiver);
   loop
      GNAT.Sockets.Accept_Socket
        (Server  => Receiver,
         Socket  => Connection,
         Address => Client);
      Ada.Text_IO.Put_Line
        ("Client connected from " & GNAT.Sockets.Image (Client));
      Channel := GNAT.Sockets.Stream (Connection);
      begin
         loop
            Character'Output (Channel, Character'Input (Channel));
         end loop;
      exception
         when Ada.IO_Exceptions.End_Error =>
            null;
      end;
      GNAT.Sockets.Close_Socket (Connection);
   end loop;
end Echo_Server;

with Ada.Text_IO;
with Ada.IO_Exceptions;
with GNAT.Sockets;
procedure echo_server_multi is
-- Multiple socket connections example based on Rosetta Code echo server.

   Tasks_To_Create : constant := 3; -- simultaneous socket connections.

-------------------------------------------------------------------------------
-- Use stack to pop the next free task index. When a task finishes its
-- asynchronous (no rendezvous) phase, it pushes the index back on the stack.
   type Integer_List is array (1..Tasks_To_Create) of integer;
   subtype Counter is integer range 0 .. Tasks_To_Create;
   subtype Index is integer range 1 .. Tasks_To_Create;
   protected type Info is
      procedure Push_Stack (Return_Task_Index : in Index);
      procedure Initialize_Stack;
      entry Pop_Stack (Get_Task_Index : out Index);
   private
      Task_Stack   : Integer_List; -- Stack of free-to-use tasks.
      Stack_Pointer: Counter := 0;
   end Info;

   protected body Info is
      procedure Push_Stack (Return_Task_Index : in Index) is
      begin -- Performed by tasks that were popped, so won't overflow.
         Stack_Pointer := Stack_Pointer + 1;
         Task_Stack(Stack_Pointer) := Return_Task_Index;
      end;

      entry Pop_Stack (Get_Task_Index : out Index) when Stack_Pointer /= 0 is
      begin -- guarded against underflow.
         Get_Task_Index := Task_Stack(Stack_Pointer);
         Stack_Pointer := Stack_Pointer -  1;
      end;

      procedure Initialize_Stack is
      begin
         for I in Task_Stack'range loop
            Push_Stack (I);
         end loop;
      end;
   end Info;

   Task_Info : Info;

-------------------------------------------------------------------------------
   task type SocketTask is
      -- Rendezvous the setup, which sets the parameters for entry Echo.
      entry Setup (Connection : GNAT.Sockets.Socket_Type;
                   Client     : GNAT.Sockets.Sock_Addr_Type;
                   Channel    : GNAT.Sockets.Stream_Access;
                   Task_Index : Index);
      -- Echo accepts the asynchronous phase, i.e. no rendezvous. When the
      -- communication is over, push the task number back on the stack.
      entry Echo;
   end SocketTask;

   task body SocketTask is
      my_Connection : GNAT.Sockets.Socket_Type;
      my_Client     : GNAT.Sockets.Sock_Addr_Type;
      my_Channel    : GNAT.Sockets.Stream_Access;
      my_Index      : Index;
   begin
      loop -- Infinitely reusable
         accept Setup (Connection : GNAT.Sockets.Socket_Type;
                       Client  : GNAT.Sockets.Sock_Addr_Type;
                       Channel : GNAT.Sockets.Stream_Access;
                       Task_Index   : Index) do
            -- Store parameters and mark task busy.
            my_Connection := Connection;
            my_Client     := Client;
            my_Channel    := Channel;
            my_Index      := Task_Index;
         end;

         accept Echo; -- Do the echo communications.
         begin
            Ada.Text_IO.Put_Line ("Task " & integer'image(my_Index));
            loop
               Character'Output (my_Channel, Character'Input(my_Channel));
            end loop;
         exception
            when Ada.IO_Exceptions.End_Error =>
              Ada.Text_IO.Put_Line ("Echo " & integer'image(my_Index) & " end");
            when others =>
              Ada.Text_IO.Put_Line ("Echo " & integer'image(my_Index) & " err");
         end;
         GNAT.Sockets.Close_Socket (my_Connection);
         Task_Info.Push_Stack (my_Index); -- Return to stack of unused tasks.
      end loop;
   end SocketTask;

-------------------------------------------------------------------------------
-- Setup the socket receiver, initialize the task stack, and then loop,
-- blocking on Accept_Socket, using Pop_Stack for the next free task from the
-- stack, waiting if necessary.
   task type SocketServer (my_Port : GNAT.Sockets.Port_Type) is
      entry Listen;
   end SocketServer;

   task body SocketServer is
   Receiver   : GNAT.Sockets.Socket_Type;
   Connection : GNAT.Sockets.Socket_Type;
   Client     : GNAT.Sockets.Sock_Addr_Type;
   Channel    : GNAT.Sockets.Stream_Access;
   Worker     : array (1..Tasks_To_Create) of SocketTask;
   Use_Task   : Index;

   begin
      accept Listen;
      GNAT.Sockets.Create_Socket (Socket => Receiver);
      GNAT.Sockets.Set_Socket_Option
        (Socket => Receiver,
         Level  => GNAT.Sockets.Socket_Level,
         Option => (Name    => GNAT.Sockets.Reuse_Address, Enabled => True));
      GNAT.Sockets.Bind_Socket
        (Socket  => Receiver,
         Address => (Family => GNAT.Sockets.Family_Inet,
                     Addr   => GNAT.Sockets.Inet_Addr ("127.0.0.1"),
                     Port   => my_Port));
      GNAT.Sockets.Listen_Socket (Socket => Receiver);
      Task_Info.Initialize_Stack;
Find: loop -- Block for connection and take next free task.
         GNAT.Sockets.Accept_Socket
           (Server  => Receiver,
            Socket  => Connection,
            Address => Client);
         Ada.Text_IO.Put_Line ("Connect " & GNAT.Sockets.Image(Client));
         Channel := GNAT.Sockets.Stream (Connection);
         Task_Info.Pop_Stack(Use_Task); -- Protected guard waits if full house.
         -- Setup the socket in this task in rendezvous.
         Worker(Use_Task).Setup(Connection,Client, Channel,Use_Task);
         -- Run the asynchronous task for the socket communications.
         Worker(Use_Task).Echo; -- Start echo loop.
      end loop Find;
   end SocketServer;

   Echo_Server : SocketServer(my_Port => 12321);

-------------------------------------------------------------------------------
begin
   Echo_Server.Listen;
end echo_server_multi;

The code creates an echo server that listens on TCP port 12321, accepts and handles simultaneous connections from multiple clients, specifically from localhost. It echoes back complete lines received from clients. The server supports both single-threaded and multi-threaded operations, with the latter allowing a maximum of about 2000 threads per process on OS X 10.10.5 with gcc 4.9.1. Connection information is logged to standard output. The server remains responsive to other clients even if one client sends a partial line or stops reading responses.


package Numeric_Tests is
   function Is_Numeric (Item : in String) return Boolean;
end Numeric_Tests;

package body Numeric_Tests is
   function Is_Numeric (Item : in String) return Boolean is
      Dummy : Float;
   begin
      Dummy := Float'Value (Item);
      return True;
   exception
      when others =>
         return False;
   end Is_Numeric;
end Numeric_Tests;

with Ada.Text_Io; use Ada.Text_Io;
with Numeric_Tests; use Numeric_Tests;

procedure Is_Numeric_Test is
   S1 : String := "152";
   S2 : String := "-3.1415926";
   S3 : String := "Foo123";
begin
   Put_Line(S1 & " results in " & Boolean'Image(Is_Numeric(S1)));
   Put_Line(S2 & " results in " & Boolean'Image(Is_Numeric(S2)));
   Put_Line(S3 & " results in " & Boolean'Image(Is_Numeric(S3)));
end Is_Numeric_Test;

The following codes define a boolean function named Is_Numeric. This function takes a string as input and checks if it is a numeric string, including floating point and negative numbers. The implementation of this function is found in a separate package body file. An additional file demonstrates how to call the Is_Numeric function.


Library: AWS

with AWS.Client;
with AWS.Response;
with Ada.Text_IO; use Ada.Text_IO;
procedure GetHttps is
begin
   Put_Line (AWS.Response.Message_Body (AWS.Client.Get (
      URL => "https://sourceforge.net/")));
end GetHttps;

Send a GET request to the URL "https://www.w3.org/", validate the host certificate, and print the response to the console without authentication. The functionality is similar to the HTTP task with openssl support in AWS.


with Ada.Containers.Doubly_Linked_Lists;
with Ada.Text_IO;

procedure Main is
   package FIO is new Ada.Text_IO.Float_IO (Float);

   type Point is record
      X, Y : Float;
   end record;

   function "-" (Left, Right : Point) return Point is
   begin
      return (Left.X - Right.X, Left.Y - Right.Y);
   end "-";

   type Edge is array (1 .. 2) of Point;

   package Point_Lists is new Ada.Containers.Doubly_Linked_Lists
     (Element_Type => Point);
   use type Point_Lists.List;
   subtype Polygon is Point_Lists.List;

   function Inside (P : Point; E : Edge) return Boolean is
   begin
      return (E (2).X - E (1).X) * (P.Y - E (1).Y) >
             (E (2).Y - E (1).Y) * (P.X - E (1).X);
   end Inside;

   function Intersecton (P1, P2 : Point; E : Edge) return Point is
      DE : Point := E (1) - E (2);
      DP : Point := P1 - P2;
      N1 : Float := E (1).X * E (2).Y - E (1).Y * E (2).X;
      N2 : Float := P1.X * P2.Y - P1.Y * P2.X;
      N3 : Float := 1.0 / (DE.X * DP.Y - DE.Y * DP.X);
   begin
      return ((N1 * DP.X - N2 * DE.X) * N3, (N1 * DP.Y - N2 * DE.Y) * N3);
   end Intersecton;

   function Clip (P, C : Polygon) return Polygon is
      use Point_Lists;
      A, B, S, E : Cursor;
      Inputlist  : List;
      Outputlist : List := P;
      AB         : Edge;
   begin
      A := C.First;
      B := C.Last;
      while A /= No_Element loop
         AB        := (Element (B), Element (A));
         Inputlist := Outputlist;
         Outputlist.Clear;
         S := Inputlist.Last;
         E := Inputlist.First;
         while E /= No_Element loop
            if Inside (Element (E), AB) then
               if not Inside (Element (S), AB) then
                  Outputlist.Append
                    (Intersecton (Element (S), Element (E), AB));
               end if;
               Outputlist.Append (Element (E));
            elsif Inside (Element (S), AB) then
               Outputlist.Append
                 (Intersecton (Element (S), Element (E), AB));
            end if;
            S := E;
            E := Next (E);
         end loop;
         B := A;
         A := Next (A);
      end loop;
      return Outputlist;
   end Clip;

   procedure Print (P : Polygon) is
      use Point_Lists;
      C : Cursor := P.First;
   begin
      Ada.Text_IO.Put_Line ("{");
      while C /= No_Element loop
         Ada.Text_IO.Put (" (");
         FIO.Put (Element (C).X, Exp => 0);
         Ada.Text_IO.Put (',');
         FIO.Put (Element (C).Y, Exp => 0);
         Ada.Text_IO.Put (')');
         C := Next (C);
         if C /= No_Element then
            Ada.Text_IO.Put (',');
         end if;
         Ada.Text_IO.New_Line;
      end loop;
      Ada.Text_IO.Put_Line ("}");
   end Print;

   Source  : Polygon;
   Clipper : Polygon;
   Result  : Polygon;
begin
   Source.Append ((50.0, 150.0));
   Source.Append ((200.0, 50.0));
   Source.Append ((350.0, 150.0));
   Source.Append ((350.0, 300.0));
   Source.Append ((250.0, 300.0));
   Source.Append ((200.0, 250.0));
   Source.Append ((150.0, 350.0));
   Source.Append ((100.0, 250.0));
   Source.Append ((100.0, 200.0));
   Clipper.Append ((100.0, 100.0));
   Clipper.Append ((300.0, 100.0));
   Clipper.Append ((300.0, 300.0));
   Clipper.Append ((100.0, 300.0));
   Result := Clip (Source, Clipper);
   Print (Result);
end Main;

implement the Sutherland-Hodgman polygon clipping algorithm. The code takes a closed polygon and a rectangle as inputs, clips the polygon by the rectangle, and outputs the sequence of points that define the resulting clipped polygon. For extra credit, the code also displays all three polygons on a graphical surface, using different colors for each polygon and filling the resulting polygon. The orientation of the display can be either north-west or south-west.


with Ada.Numerics.Elementary_Functions;
use Ada.Numerics.Elementary_Functions;
with Ada.Float_Text_Io; use Ada.Float_Text_Io;
with Ada.Text_IO; use Ada.Text_IO;

procedure Trig is
   Degrees_Cycle : constant Float := 360.0;
   Radians_Cycle : constant Float := 2.0 * Ada.Numerics.Pi;
   Angle_Degrees : constant Float := 45.0;
   Angle_Radians : constant Float := Ada.Numerics.Pi / 4.0;
   procedure Put (V1, V2 : Float) is
   begin
      Put (V1, Aft => 5, Exp => 0);
      Put (" ");
      Put (V2, Aft => 5, Exp => 0);
      New_Line;
   end Put;
begin
   Put (Sin (Angle_Degrees, Degrees_Cycle),
        Sin (Angle_Radians, Radians_Cycle));
   Put (Cos (Angle_Degrees, Degrees_Cycle),
        Cos (Angle_Radians, Radians_Cycle));
   Put (Tan (Angle_Degrees, Degrees_Cycle),
        Tan (Angle_Radians, Radians_Cycle));
   Put (Cot (Angle_Degrees, Degrees_Cycle),
        Cot (Angle_Radians, Radians_Cycle));
   Put (ArcSin (Sin (Angle_Degrees, Degrees_Cycle), Degrees_Cycle),
        ArcSin (Sin (Angle_Radians, Radians_Cycle), Radians_Cycle));
   Put (Arccos (Cos (Angle_Degrees, Degrees_Cycle), Degrees_Cycle),
        Arccos (Cos (Angle_Radians, Radians_Cycle), Radians_Cycle));
   Put (Arctan (Y => Tan (Angle_Degrees, Degrees_Cycle)),
        Arctan (Y => Tan (Angle_Radians, Radians_Cycle)));
   Put (Arccot (X => Cot (Angle_Degrees, Degrees_Cycle)),
        Arccot (X => Cot (Angle_Degrees, Degrees_Cycle)));
end Trig;

demonstrate the use of trigonometric functions such as sine, cosine, tangent, and their inverses in a specific programming language. The functions are applied to the same angle in both radians and degrees. For non-inverse functions, the arguments evaluate to the same angle. For inverse functions, the same number is used and its answer is converted to radians and degrees. If the language lacks certain trigonometric functions, the code provides custom functions based on known approximations or identities. The Ada language's library trig functions, which default to radians, are also demonstrated with examples specifying cycles for degrees and radians. The inverse trig functions' output is in units of the specified cycle.


with Ada.Interrupts; use Ada.Interrupts;
with Ada.Interrupts.Names; use Ada.Interrupts.Names;

package Sigint_Handler is
      protected Handler is
      entry Wait;
      procedure Handle;
      pragma Interrupt_Handler(Handle);
      pragma Attach_Handler(Handle, Sigint);
      private
      Call_Count : Natural := 0;
   end Handler;

end Sigint_Handler;

package body Sigint_Handler is

   -------------
   -- Handler --
   -------------

   protected body Handler is

      ----------
      -- Wait --
      ----------

      entry Wait when Call_Count > 0 is
      begin
         Call_Count := Call_Count - 1;
      end Wait;

      ------------
      -- Handle --
      ------------

      procedure Handle is
      begin
         Call_Count := Call_Count + 1;
      end Handle;

   end Handler;

end Sigint_Handler;

with Ada.Calendar; use Ada.Calendar;
with Ada.Text_Io; use Ada.Text_Io;
with Sigint_Handler; use Sigint_Handler;

procedure Signals is
   task Counter is
      entry Stop;
   end Counter;
   task body Counter is
      Current_Count : Natural := 0;
   begin
      loop
         select
            accept Stop;
            exit;
         or delay 0.5;
         end select;
         Current_Count := Current_Count + 1;
         Put_Line(Natural'Image(Current_Count));
      end loop;
   end Counter;
   task Sig_Handler;

   task body Sig_Handler is
      Start_Time : Time := Clock;
      Sig_Time : Time;
   begin
      Handler.Wait;
      Sig_Time := Clock;
      Counter.Stop;
      Put_Line("Program execution took" & Duration'Image(Sig_Time - Start_Time) & " seconds");
   end Sig_Handler;

begin
   null;

end Signals;

The code outputs an integer every half second. It also includes a signal handler for the SIGINT signal, often generated by user's ctrl-C command. On receiving this signal, the program stops outputting integers, displays the total runtime in seconds, and then terminates. The signal handler is defined at the library level and is executed when the SIGINT signal is received.


S : String := "12345";
S := Ada.Strings.Fixed.Trim(Source => Integer'Image(Integer'Value(S) + 1), Side => Ada.Strings.Both);

"Increments a numerical string using the Ada.Strings.Fixed package's function for trimming blanks."


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Common_Path is
   function "rem" (A, B : String) return String is
      Slash : Integer := A'First; -- At the last slash seen in A
      At_A  : Integer := A'first;
      At_B  : Integer := B'first;
   begin
      loop
         if At_A > A'Last then
            if At_B > B'Last or else B (At_B) = '/' then
               return A;
            else
               return A (A'First..Slash - 1);
            end if;
         elsif At_B > B'Last then
            if A (At_A) = '/' then -- A cannot be shorter than B here
               return B;
            else
               return A (A'First..Slash - 1);
            end if;
         elsif A (At_A) /= B (At_B) then
            return A (A'First..Slash - 1);
         elsif A (At_A) = '/' then
            Slash := At_A;
         end if;
         At_A := At_A + 1;
         At_B := At_B + 1;
      end loop;
   end "rem";
begin
   Put_Line
   (  "/home/user1/tmp/coverage/test" rem
      "/home/user1/tmp/covert/operator" rem
      "/home/user1/tmp/coven/members"
   );
end Test_Common_Path;

/home/user1/tmp

"Code generates a common directory path from a set of directory paths using a specified directory separator character. It identifies the common part of the directory tree in all directories, not just the longest common string. The code also includes a test case using '/' as the separator and three specific directory paths."


with Ada.Text_IO, Ada.Float_Text_IO;

procedure FindMedian is

    f: array(1..10) of float := ( 4.4, 2.3, -1.7, 7.5, 6.6, 0.0, 1.9, 8.2, 9.3, 4.5 );
    min_idx: integer;
    min_val, median_val, swap: float;

begin
    for i in f'range loop
        min_idx := i;
        min_val := f(i);
        for j in i+1 .. f'last loop
            if f(j) < min_val then
                min_idx := j;
                min_val := f(j);
            end if;
        end loop;
        swap := f(i); f(i) := f(min_idx); f(min_idx) := swap;
    end loop;

    if f'length mod 2 /= 0 then
        median_val := f( f'length/2+1 );
    else
        median_val := ( f(f'length/2) + f(f'length/2+1) ) / 2.0;
    end if;

    Ada.Text_IO.Put( "Median value: " );
    Ada.Float_Text_IO.Put( median_val );
    Ada.Text_IO.New_line;
end FindMedian;

The code calculates the median value of a vector of floating-point numbers. It handles even number of elements by returning the average of the two middle values. The median is found using the selection algorithm for optimal time complexity. The code also includes tasks for calculating various statistical measures like mean, mode, and standard deviation. It also calculates moving (sliding window and cumulative) averages and different types of means such as arithmetic, geometric, harmonic, quadratic, and circular.


with Ada.Text_IO; use Ada.Text_IO;

procedure Fizzbuzz is
begin
   for I in 1..100 loop
      if I mod 15 = 0 then
         Put_Line("FizzBuzz");
      elsif I mod 5 = 0 then
         Put_Line("Buzz");
      elsif I mod 3 = 0 then
         Put_Line("Fizz");
      else
         Put_Line(Integer'Image(I));
      end if;
   end loop;
end Fizzbuzz;

print numbers from 1 to 100, replacing multiples of three with 'Fizz', multiples of five with 'Buzz', and multiples of both three and five with 'FizzBuzz'.