Как реализовать Unchecked_Access

Добавить после type Matrix

type Matrix_P is access Matrix;

(используйте свое собственное соглашение для именования типов доступа).

Затем глобально замените access Matrix на Matrix_P.

Затем в Adjust_Bounds вам, похоже, нужно заменить

      Rowmax := Integer'Min (Item'Last (1), Row);

by

      Rowmax := Integer'Max (Item'Last (1), Row);

и аналогично для Colmax.

Вы можете рассмотреть возможность создания расширяемой матрицы с использованием шаблона, показанного в следующей спецификации пакета:

with Ada.Containers.Vectors;
generic
   type Index_Type is range <>;
   with package inner_vector is new Ada.Containers.Vectors(<>);
package Vector_Of_Vectors is
   package V_Matrix is new Ada.Containers.Vectors(Index_Type   => Index_Type,
                                                  Element_Type => Inner_Vector.Vector,
                                                  "="          => Inner_Vector."=");
   use Inner_Vector;
end Vector_Of_Vectors;

Этот шаблон будет концептуально имитировать массив массивов

type foo is array (Positive range 1..10) of Integer;
type bar is array (Natural range 0..9) of foo;

Теперь вы сможете изменять длину каждого векторного элемента типа V_Matrix, а также добавлять дополнительные векторные элементы в V_Matrix.

Ниже приведен небольшой пример создания пакета Vector_Of_Vectors:

with Ada.Containers.Vectors;
with Vector_Of_Vectors;
with Ada.Text_IO; use Ada.Text_IO;
use Ada.Containers;

procedure Main is
   package Int_Vector is new Ada.Containers.Vectors(Index_Type => Natural,
                                                    Element_Type => Integer);
   use Int_Vector;
   
   package Int_Matrix is new Vector_Of_Vectors(Index_Type   => Natural,
                                               inner_vector => Int_Vector);
   use Int_Matrix;
   
   Temp_Vect : Int_Vector.Vector;
   Temp_Mat  : V_Matrix.Vector;
begin

   Temp_Vect := Int_Vector.Empty_Vector;
   for I in 1..5 loop
      Temp_Vect.append(I);
   end loop;
   
   Temp_Mat.Append(Temp_Vect);
    
   temp_Vect := Int_Vector.Empty_Vector;
    
   for I in 15..25 loop
      Temp_Vect.append(I);
   end loop;
   Temp_Mat.Append(Temp_Vect);
     
   for V of Temp_Mat loop
      for I of V loop
         Put(I'Image);
      end loop;
      New_Line;
   end loop;
end Main;

Вот возможное решение для динамически самонастраивающегося двумерного массива. Применение:

package Rect is new Rectangular (Element => Float, Default => 0.0);
use Rect;
Map : Rect.Matrix;
...
Map(-25, 97) := 42.0;

Перераспределение базового массива было бы неприемлемо затратным, если бы оно происходило при каждом увеличении размера, поэтому пакет выделяет немного больше, чем необходимо для уменьшения перераспределения.

Образец Main непрерывно расширяет массив до тех пор, пока куча не будет исчерпана, отмечая время для каждого перераспределения. Я был приятно удивлен скоростью скомпилированного кода, перераспределение массива 1_000 X 1_000 (1_000_000 элементов) занимает всего ~5 мс:

Вот результат, полученный на AMD 3960X:

Resized to  0..10, 0..10 =  1 entries in  0.000002100 s
Resized to  0..24, 0..24 =  121 entries in  0.000001500 s
Resized to  0..54, 0..54 =  625 entries in  0.000011800 s
Resized to  0..118, 0..118 =  3025 entries in  0.000033200 s
Resized to  0..254, 0..254 =  14161 entries in  0.000116400 s
Resized to  0..541, 0..541 =  65025 entries in  0.000204300 s
Resized to  0..1143, 0..1143 =  293764 entries in  0.000889200 s
Resized to  0..2400, 0..2400 =  1308736 entries in  0.004220100 s
Resized to  0..5015, 0..5015 =  5764801 entries in  0.017126300 s
Resized to  0..10439, 0..10439 =  25160256 entries in  0.072370300 s
 10000 X  10000 is  381Mb
Resized to  0..21661, 0..21661 =  108993600 entries in  0.328238800 s
 20000 X  20000 is  1525Mb
Resized to  0..44827, 0..44827 =  469242244 entries in  1.432776000 s
 30000 X  30000 is  3433Mb
 40000 X  40000 is  6103Mb
Resized to  0..92556, 0..92556 =  2009549584 entries in  56.372428000 s
 50000 X  50000 is  9536Mb
 60000 X  60000 is  13732Mb
 70000 X  70000 is  18692Mb
 80000 X  80000 is  24414Mb
 90000 X  90000 is  30899Mb

raised STORAGE_ERROR : System.Memory.Alloc: heap exhausted

Как и ожидалось, STORAGE_ERROR, у меня 32 ГБ памяти.

Это одна из моих первых попыток в Аде, критика будет очень кстати.

главная.объявления

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Assertions; use Ada.Assertions;
with Rectangular;

procedure Main is
    
    subtype Element is Float;
    
    Default_Value : Element := 42.0;
    
    package Rect is new Rectangular (Element => Element, Default => Default_Value);
    use Rect;
    Map : Rect.Matrix;
    
begin
    declare -- warmup, ensure values get set and defaults are applied
    begin
        Map (0, 0) := 2.3;
        Map (10, 10) := Map (0, 0) + 1.0;
        Assert (Map (0, 0) = 2.3);
        Assert (Map (10, 10) = 3.3);
        Assert (Map (5, 5) = Default_Value);
    end;
    
    declare -- Exercise hard to get reallocation timings
        Bytes           : Long_Long_Integer;
        MBytes          : Long_Long_Integer;
        ILong           : Long_Long_Integer;
        Current, Should : Element;
    begin
        for I in 0 .. 100_000 loop

            Map (I, I) := Element (I * 3);
            
            if I mod 10_000 = 0 then -- occasionally
                
                -- Check every value. On diagonal=3*, Off diagonal=Default_Value
                for Row in 0 .. I loop
                    for Col in 0 .. I loop
                        Current := Map (Row, Col );
                        if Row = Col then
                            Should := Element (Row * 3);
                        else
                            Should := Default_Value;
                        end if;
                        Assert (Current = Should);
                    end loop;
                end loop;
                
                -- Show progress
                ILong := Long_Long_Integer (I);
                Bytes := Ilong * Ilong * Long_Long_Integer (Element'Size) / 8;
                MBytes := Bytes / 2 ** 20;
                Put_Line (I'Image & " X " & I'Image & " is " & MBytes'Image & "Mb");
            end if;
        end loop;
    end;
end Main;

Прямоугольные.объявления

generic
    type Element is private;
    Default : Element;

package Rectangular is
-- Provides an X..Y matrix of Element, which can be used just like a 2D Array.
-- The bounds of the array adjust themselves to accomodate requested indexes.
-- Rule-of-thumb: ~5 millseconds to re-allocate an array of 1'000'000 (1'000 x 1'000) entries. YMMV.
-- Usage:
--    package Rect is new Rectangular (Element => Float, Default => 0.0);
--    use Rect;
--    Map : Rect.Matrix;
--    ...
--    Map(-25, 97) := 42.0;
-- The bounds are now -25..0, 0..97, 2'548 elements, all 0.0 except -25,97 = 42.0
    
    type Matrix is tagged limited private
      with 
         Constant_Indexing => Get_Element,
         Variable_Indexing => Get_Reference;

    type Element_Access is access all Element;

    function Get_Element (M : in out Matrix; E : in Element_Access) return Element;

    function Get_Element (M : in out Matrix; Row, Col : in Integer) return Element;

    type Reference (R : access Element) is limited null record
      with Implicit_Dereference => R;

    function Get_Reference (M : in out Matrix; E : in Element_Access) return Reference;

    function Get_Reference (M : in out Matrix; Row, Col : in Integer) return Reference;

private
    type Backing is array (Integer range <>, Integer range <>) of Element;
    type Backing_Access is access Backing;
    type Matrix is tagged limited record
        Items : Backing_Access;
    end record;
end Rectangular;

Прямоугольный.adb:

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar; use Ada.Calendar;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Unchecked_Deallocation;
with Ada.Numerics.Generic_Elementary_Functions;

package body Rectangular is

    Demo : constant Boolean := True; -- Set to False once you've watched the demo
    
    function Create (Row_First, Row_Last, Col_First, Col_Last : Integer) return Backing_Access is
    -- Create a Backing array of Element'Access with (possibly negative) bounds
    begin
        return Answer :  Backing_Access :=
          new Backing (Row_First .. Row_Last, Col_First .. Col_Last)
        do
            for I in Row_First .. Row_Last loop
                for J in Col_First .. Col_Last loop
                    Answer (I, J) := Default;
                end loop;
            end loop;
        end return;
    end Create;
    
    function Multiplier (Bounds : Integer) return Float is
    -- From the bounds of an array, calculate a suitable, gentle increase
    -- Bounds | Log/(1+bounds,2) | 1/That | Increase
    --       1         1.0          1.000         1 
    --      10         3.5          0.289         3 
    --     100         6.7          0.150        15 
    --   1,000        10.0          0.100       100 
    --   5,000        12.3          0.081       407 
    --  10,000        13.3          0.075       753 
    --  25,000        14.6          0.068     1,711 
    -- 100,000        16.6          0.060     6,021 
    --
    -- So, for a matrix bound (row or column) that is 25'000, 
    -- the matrix will be resized to 25'000+1'711=26'711
    
        package Floats is new Ada.Numerics.Generic_Elementary_Functions (Float);
        Factor, Result : Float;
    begin
        Factor := Floats.Log (Float (1 + Bounds), 2.0);
        Result := 1.0 + 1.0 / Factor;
        -- Put_Line (Bounds'Image & ' ' & Factor'Image & ' ' & Result'Image);
        return Result;
    end Multiplier;
    
    procedure Free is new Ada.Unchecked_Deallocation (Backing, Backing_Access);
    -- Release a Backing.
    -- We know that this is safe, as they are private and only *we* can allocate them
    
    procedure Adjust_Bounds (M : in out Matrix; Row, Col : in Integer) is
    -- Check to see if Row-Col is within the current bounds.
    -- If not, enlarge the Backing to accomodate said Row-Col
    begin
        if M.Items = null then -- auto-initialise
            M.Items := Create (Row, Row, Col, Col);
        end if;
            
        if Row >= M.Items'First (1) and Row <= M.Items'Last (1) and
          Col >= M.Items'First (2) and Col <= M.Items'Last (2) then
            return; -- In bounds, all is well
        end if;
        
        declare
            Enlarged                       : Backing_Access;
            Row_First, Row_Last            : Integer;
            Col_First, Col_Last            : Integer;
            Row_Range, Col_Range           : Integer;
            Row_Multiplier, Col_Multiplier : Float;
            Start_Time, End_Time           : Time;
        
        begin
            if Demo then
                Start_Time := Clock;
            end if;
            Row_First := M.Items'First (1);
            Row_Last := M.Items'Last (1);
            Row_Range := Row_Last - Row_First + 1;
            Row_Multiplier := Multiplier (Row_Range);
        
            Col_First := M.Items'First (2);
            Col_Last := M.Items'Last (2);
            Col_Range := Col_Last - Col_First + 1;
            Col_Multiplier := Multiplier (Col_Range); 

            -- Integer'Min because the requested index may be further out than our conservative expansion multiplier
            if Row < Row_First then
                Row_First := Integer'Min (Row, Row_First - Integer (Float (Row_Range) * Row_Multiplier));
            elsif Row > Row_Last then
                Row_Last := Integer'Max (Row, Row_Last + Integer (Float (Row_Range) * Row_Multiplier));
            end if;
        
        
            if Col < Col_First then
                Col_First := Integer'Min (Col, Col_First - Integer (Float (Col_Range) * Col_Multiplier));
            elsif Col > Col_Last then
                Col_Last := Integer'Max (Col, Col_Last + Integer (Float (Col_Range) * Col_Multiplier));
            end if;

            Enlarged := Create (Row_First, Row_Last, Col_First, Col_Last);

            -- Copy old to new
            for R in M.Items'Range (1) loop
                for C in M.Items'Range (2) loop
                    Enlarged (R, C) := M.Items (R, C);
                end loop;
            end loop;
        
            Free (M.Items);
            M.Items := Enlarged;
            
            -- just for demonstration
            if Demo then
                declare
                    Seconds : Duration;
                    Size    : Long_Long_Integer := Long_Long_Integer (Row_Range) * Long_Long_Integer (Col_Range);
                begin
                    End_Time := Clock;
                    Seconds := End_Time - Start_Time;
                    Row_Range := Row_Last - Row_First + 1;
                    Col_Range := Col_Last - Col_First + 1;
                    Put_Line ("Resized to " & Row_First'Image & ".." & Trim (Row_Last'Image, Left) & ',' & 
                      Col_First'Image & ".." & Trim (Col_Last'Image, Left) & 
                      " = " & Size'Image & " entries in " & Duration'Image (Seconds) & " s");
                end;
            end if;
        end;
        
    end Adjust_Bounds;
    
    function Get_Reference (M : in out Matrix; E : in Element_Access) return Reference is
      (Reference'(R => E));

    function Get_Element (M : in out Matrix; E : in Element_Access) return Element is
      (M (E));

    function Get_Element (M : in out Matrix; Row, Col : in Integer) return Element is
        Result : Element;
    begin
        Adjust_Bounds (M, Row, Col);
        Result := M.Items (Row, Col);
        return Result;
    end Get_Element;

    function Get_Reference (M : in out Matrix; Row, Col : in Integer) return Reference is
    begin
        Adjust_Bounds (M, Row, Col);
        -- Unrestricted_Access is wicked, but we know what we're doing and it's the only way
        return Answer : Reference :=
          Reference'(R => M.Items ( Row, Col)'Unrestricted_Access);
    end Get_Reference;
    
end Rectangular;