Skip Navigation Links
Проект "Real Time Systems DD"
Пакеты реализаций математических множеств натуральных чисел.

В этой статье представлены два пакета реализаций множеств натуральных чисел на языке Ada 2012.


Первый пакет имеет название "set_of_natural_pkg". Реализация множества натуральных чисел этого пакета построена по алгоритму "двухуровневых битовых карт". Диапазон представляемых чисел – 0 .. 4096*4096 – 1 (что вполне достаточно для представления всех символов Unicode).


Ниже приведён исходный текст спецификации пакета:
-- set_of_natural_pkg.ads
with Interfaces;                 use Interfaces;
with Ada.Finalization;
with Ada.Unchecked_Deallocation;
with Ada.Iterator_Interfaces;

package set_of_natural_pkg is

   -- --------------------------------------------------------------------------
   -- Определиние типов элементов множества
   subtype element_value_ext is Integer range -1 .. 4096*4096 - 1;
   subtype element_value is element_value_ext range 0 .. element_value_ext'Last;
   no_element_value : constant element_value_ext := -1;
   -- --------------------------------------------------------------------------

   -- --------------------------------------------------------------------------
   -- публичное определение типа множества "BS_Set"
   type BS_Set is tagged private
     with
       Constant_Indexing => BS_Element,
       Default_Iterator  => BS_Iterate,
       Iterator_Element  => element_value;
   type BS_Access is access all BS_Set;
   -- --------------------------------------------------------------------------

   -- --------------------------------------------------------------------------
   -- Определения для "Ada.Iterator_Interfaces" (перечисление элементов множества)
   type BS_Cursor is private;
   no_element : constant BS_Cursor;
   function BS_Has_Element (Position : BS_Cursor) return Boolean;
   package BS_Iterator_Interface is new Ada.Iterator_Interfaces( BS_Cursor, BS_Has_Element );
   function BS_Element(Set : aliased BS_Set; Position : BS_Cursor) return element_value_ext;
   function To_Cursor (Set : aliased BS_Set; Value : element_value_ext) return BS_Cursor;
   function BS_Iterate(Set : BS_Set) return BS_Iterator_Interface.Reversible_Iterator'Class;
   function BS_Iterate(Set : BS_Set; Start : BS_Cursor) return BS_Iterator_Interface.Reversible_Iterator'Class;
   function BS_Find(Set : BS_Set; cs_element : element_value) return BS_Cursor;
   -- --------------------------------------------------------------------------

   procedure Deallocate(ptr : in out BS_Access);
   -- --------------------------------------------------------------------------
   -- Добавление нового элемента в множество.
   --    Если параметр element = no_element_value то значение добавляемого элемента устанавливается на единицу
   --    большим максимального элемента присутствующего в множестве (если множество было пустым то значение
   --    элемента устанавливается равным нулю). В любом случае, выходной параметр element_pos получает значение
   --    добавляемого элемента.
   procedure Append (
                     set_object : in out BS_Set;
                     element : in element_value_ext;
                     element_pos : out element_value_ext
                    );
   -- --------------------------------------------------------------------------
   -- Удаление элемента из множества
   procedure Remove (
                     set_object : in out BS_Set;
                     element : in element_value
                    );
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “or” – объединение множеств.
   function "or" (Left, Right : BS_Set) return BS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “and” – пересечение множеств.
   function "and" (Left, Right : BS_Set) return BS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “xor” – антипересечение множеств.
   function "xor" (Left, Right : BS_Set) return BS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “-” – вычитание множеств.
   function "-" (Left, Right : BS_Set) return BS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “not” – инверсия множества.
   function "not" (set_object : BS_Set) return BS_Set;
   -- --------------------------------------------------------------------------
   procedure minmax_recalculation( set_object : in out BS_Set);
   -- --------------------------------------------------------------------------
   -- Очистка множества.
   procedure Clear( set_object : in out BS_Set);
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “=” – предикат равенства множеств.
   function "=" (Left, Right : BS_Set) return Boolean;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “>” – предикат полного включения.
   --    Множество «Right» полностью содержится в множестве «Left».
   function ">" (Left, Right : BS_Set) return Boolean;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “>=” – предикат неполного включения.
   --    Множество «Right» содержится в множестве или равно множеству «Left».
   function ">=" (Left, Right : BS_Set) return Boolean;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Предикат пустоты множества.
   function IsEmpty(set_object : BS_Set) return Boolean with Inline => True;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Предикат полного заполнения множества.
   function IsFullFilled(set_object : BS_Set) return Boolean;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Предикат присутствия элемента в множестве.
   function Find(set_object : BS_Set; element : element_value) return Boolean;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Получение первого элемента множества.
   function GetFirst(set_object : BS_Set) return element_value_ext;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Получение последнего элемента множества.
   function GetLast(set_object : BS_Set) return element_value_ext;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Получение следующего элемента множества.
   function GetNext(set_object : BS_Set; element : element_value_ext) return element_value_ext;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Получение предыдущего элемента множества.
   function GetPrev(set_object : BS_Set; element : element_value_ext) return element_value_ext;
   -- --------------------------------------------------------------------------

private
   type bit_set is array (0 .. 63) of Unsigned_64;
   type bit_set_access is access all bit_set;
   type bit_set_array is array (0 .. 4095) of bit_set_access;
   type bit_mask_array is array (0 .. 63) of Unsigned_64;
   type BS_Set is new Ada.Finalization.Controlled with record
      min_element, max_element : element_value_ext := -1;
      not_empty_bitset, full_bitsets : bit_set := (others => 0);
      bit_sets : bit_set_array := (others => null);
   end record;
   overriding procedure Initialize (set_object : in out BS_Set);
   overriding procedure Adjust     (set_object : in out BS_Set);
   overriding procedure Finalize   (set_object : in out BS_Set);
   procedure Free is
     new Ada.Unchecked_Deallocation (bit_set, bit_set_access);
   procedure Free is
     new Ada.Unchecked_Deallocation (BS_Set, BS_Access);
   type BS_Cursor is
      record
         BS_Set_Ref : BS_Access;
         Value  : element_value_ext := no_element_value;
      end record;
   no_element : constant BS_Cursor := BS_Cursor'(null, no_element_value);
end set_of_natural_pkg;
Демонстрация применения интерфейса перечисления элементов множества приведена в следующем примере:
-- bs_test.adb
with set_of_natural_pkg; use set_of_natural_pkg;

procedure bs_test is
   bs : BS_Set;
   element_pos : element_value_ext;
   start_pos : BS_Cursor;
   curr_elem : element_value_ext;
begin
   for I in element_value range 13 .. 113 loop
      Append(bs, I, element_pos);
   end loop;
   start_pos := To_Cursor(bs, 97);
   pragma Assert(start_pos /= no_element);
   for I in reverse BS_Iterate(bs, start_pos) loop
      curr_elem := bs(I);
      pragma Assert(curr_elem /= no_element_value);
   end loop;
end bs_test;

Применённый для данного пакета алгоритм эффективно работает на 64-х разрядных системных архитектурах. На 32-х разрядных системных архитектурах алгоритм будет работать медленно, так как 64-х разрядная арифметика будет эмулироваться, или вообще не будет работать если 64-х разрядная арифметика запрещена. Я, в своё время, разработал подобный пакет, реализованный по алгоритму трёхуровневых битовых карт на языке ADA95, который успешно работал на 32-х разрядных системных архитектурах. Но исходные тексты этого пакета были утеряны. Эффективность подобных алгоритмов зависит от длины машинного слова. Чем больше длина машинного слова, тем выше эффективность работы алгоритма. Отсюда вопрос, а работают ли инструкции расширения AVX с битовыми картами? Если да, то это бы дало большие возможности создания высокоэффективных реализаций алгоритмов работы с математическими множествами. Если кому-то что-то об этом известно, то пусть оставит комментарий на этой странице.



Второй пакет называется «Comma_Separated_Set» и представляет собой простенькую реализацию множества натуральных чисел, где множество представлено текстовой строкой, содержащей список натуральных чисел, разделённых запятыми. Реализация поддерживает очень ограниченное количество операций над множеством, но может быть очень полезной при обработке XML-файлов, где множества хранятся как атрибуты XML-элементов.

Ниже приведён исходный текст спецификации пакета:
-- comma_separated_set.ads
with Ada.Iterator_Interfaces;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Comma_Separated_Set is

   -- --------------------------------------------------------------------------
   -- Определиние типов элементов множества
   subtype element_value_ext is Integer range -1 .. Integer'Last;
   subtype element_value is element_value_ext range 0 .. element_value_ext'Last;
   no_element_value : constant element_value_ext := -1;
   -- --------------------------------------------------------------------------

   -- --------------------------------------------------------------------------
   -- публичное определение типа множества "CS_Set"
   type CS_Set is tagged private
     with
       Constant_Indexing => CS_Element,
       Default_Iterator  => CS_Iterate,
       Iterator_Element  => element_value;
   type CS_Access is access all CS_Set;
   -- --------------------------------------------------------------------------

   -- --------------------------------------------------------------------------
   -- Определения для "Ada.Iterator_Interfaces" (перечисление элементов множества)
   type CS_Cursor is private;
   no_element : constant CS_Cursor;
   function CS_Has_Element (Position : CS_Cursor) return Boolean;
   package CS_Iterator_Interface is new Ada.Iterator_Interfaces( CS_Cursor, CS_Has_Element );
   function CS_Element(Set : aliased CS_Set; Position : CS_Cursor) return element_value_ext;
   function CS_Iterate(Set : CS_Set) return CS_Iterator_Interface.Forward_Iterator'Class;
   function CS_Find(Set : CS_Set; cs_element : element_value) return CS_Cursor;
   -- --------------------------------------------------------------------------

   -- --------------------------------------------------------------------------
   -- Преобразование текстовой строки во внутреннее представление типа "CS_Set".
   function To_CS_Set(set_str : String) return CS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Преобразование значения типа "CS_Set" в текстовую строку.
   function CS_To_String(Set : CS_Set) return String;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Добавление элемента во множество.
   procedure CS_Append(Set : in out CS_Set; cs_element : element_value);
   -- --------------------------------------------------------------------------
   procedure CS_Delete(Set : in out CS_Set; cs_element : element_value);
   -- --------------------------------------------------------------------------
   -- Получение значения мощности множества.
   function CS_Power(Set : CS_Set) return Natural;
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “=” – предикат равенства множеств.
   function "=" (Left, Right : CS_Set) return Boolean;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “+” – объединение множеств.
   function "+" (Left, Right : CS_Set) return CS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Переопределённая операция “-” – вычитание множеств.
   function "-" (Left, Right : CS_Set) return CS_Set;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Предикат присутствия элемента в множестве.
   function In_Set(Set : CS_Set; cs_element : element_value) return Boolean;
   -- --------------------------------------------------------------------------

   -- --------------------------------------------------------------------------
   -- Преобразование натурального числа в текстовую строку без лидирующих и суффиксных пробелов.
   function get_natural_img (num : Natural) return String;
   -- --------------------------------------------------------------------------
   -- --------------------------------------------------------------------------
   -- Преобразование текстовой строки в натуральное число.
   function string_to_natural(str : String) return Natural;
   -- --------------------------------------------------------------------------

private

   type CS_Set is tagged
      record
         CS_Set_Str : Unbounded_String;
      end record;

   type CS_Cursor is
      record
         CS_Set_Ref : CS_Access;
         Value  : element_value_ext := no_element_value;
         Value_Position, Comma_position : Natural := 0;
      end record;
   no_element : constant CS_Cursor := CS_Cursor'(null, no_element_value, 0, 0);

end Comma_Separated_Set;

Таблица загрузок проекта:
Ссылка Описание
set_of_natural_lib.zip Упакованная папка проекта «set_of_natural_lib»
set_of_natural_lib Папка проекта «set_of_natural_lib»
comma_separated_set.zip Упакованная папка проекта «comma_separated_set»
comma_separated_set Папка проекта «comma_separated_set»

Таблица комментариев и пожеланий:
Добавте новый комментарий или пожелание:
Имя создателя комментария:   
Адрес электронной почты создателя комментария:   
Текст комментария:   
   
«RTSDD Web-Site» v 1.0.0000.0001 β Системы Реального Времени DD © 2019
Главный архитектор систем Сергей Дюков
Готово Статус исполнения