Перейти к содержанию

Книга программиста/Структуры данных в PascalABC.Net

Материал из Викиучебника — открытых книг для открытого мира

К оглавлению

Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовалась среда PascalABC.Net 3.0.

Структура кода класса

[править]
  1. Приватные переменные
  2. Свойства
  3. Методы
  4. Clone(), CloneAs(), Readln()
  5. Классовые методы
  6. Операторы
  7. ToString(), Print(), Println()

Классы без свойств

[править]
type
  TPoint = class
  public 
    X, Y: integer;
    
    constructor(cx, cy: integer);
    begin
      X := cx;Y := cy;
    end;
    
    function Clone() := new TPoint(X, Y);
    
    procedure Println() := Write(Format('({0}, {1})', X, Y));
  end;

begin
  var P := new TPoint(1, 2);
  P.Println();
end.

Структуры данных на базе статического массива

[править]

Простейший стек

[править]
const
  MaxSize = 100;

type
  TStack = class
  private
    _A: array [0..MaxSize - 1] of integer;
    _Count: integer;
  
  public 
    property Count: integer read _Count; // Фактическое количество элементов
    
    constructor();
    begin
    end;
    
    procedure Push(v: integer); // Добавляет элемент в конец.
    begin
      if _Count = MaxSize then
        raise new Exception('Переполнение стека.');
      
      Inc(_Count);
      _A[Pred(_Count)] := v;
    end;
    
    function Pop(): integer; // Удаляет последний элемент и возвращает его значение.
    begin
      if _Count = 0 then
        raise new Exception('Стек пуст.');
      
      Result := _A[Pred(_Count)];
      Dec(_Count);
    end;
  end;

begin
  var Q := new TStack();
  for var i := 1 to 10 do
    Q.Push(i);
  for var i := 1 to 10 do
    Writeln(Q.Pop());
end.

Простейшая очередь

[править]
const
  MaxSize = 100;

type
  TQueue = class
  private 
    _A: array [0..MaxSize - 1] of integer;
    _Head, _Tail: integer;
    _Count: integer;
  
  public 
    property Count: integer read _Count;
    
    constructor();
    begin
    end;
    
    procedure Enqueue(v: integer); // Вставляет элемент в конец.
    begin
      if _Count = MaxSize then
        raise new Exception('Переполнение очереди.');
      
      _A[_Tail] := v;
      _Tail := Succ(_Tail) mod MaxSize;
      Inc(_Count);
    end;
    
    function Dequeue(): integer; // Удаляет первый элемент и возвращает его значение.
    begin
      if _Count = 0 then
        raise new Exception('Очередь пуста.');
      
      Result := _A[_Head];
      _Head := Succ(_Head) mod MaxSize;
      Dec(_Count);
    end;
  end;

begin
  var Q := new TQueue();
  for var i := 1 to 100 do
    Q.Enqueue(i);
  for var i := 1 to 100 do
    Writeln(Q.Dequeue());
end.

Структуры данных на базе динамического массива

[править]

Стек

[править]
type
  TStack = class
  private 
    _A: array of integer;
    _Count, _Capacity: integer;
  
  public 
    property Count: integer read _Count; // Фактическое количество элементов
    property Capacity: integer read _Capacity; // Ёмкость
    
    constructor();
    begin
      _Capacity := 2;
      SetLength(_A, _Capacity);
    end;
    
    procedure Clear() := _Count := 0; // Выполняет очистку стека.
    
    procedure Push(v: integer); // Выполняет вставку числа в стек.
    begin
      Inc(_Count);
      if _Count > _Capacity then
      begin
        _Capacity *= 2;
        SetLength(_A, _Capacity);
      end;
      _A[Pred(_Count)] := v;
    end;
    
    function Pop(): integer; // Выполняет удаление последнего элемента стека.
    begin
      if _Count > 0 then
      begin
        Result := _A[Pred(_Count)];
        Dec(_Count);
      end
      else
        raise new System.InvalidOperationException('Стек пуст.');
    end;
    
    procedure Print(); // Выполняет вывод на экран стека.
    begin
      for var i := 0 to Pred(_Count) do
        if i < Pred(_Count) then
          WriteFormat('{0} ', _A[i].ToString())
        else
          Write(_A[i].ToString());
    end;
    
    procedure Println(); // Выполняет вывод на экран стека и переходит на новую строку.
    begin
      Print();
      Writeln();
    end;
  end;

begin
  var S := new TStack();
  for var i := 0 to 2 do
    S.Push(i);
  
  Writeln('Изначальный стек:');
  S.Print();
  S.Clear();
  Writeln('Пустой стек:');
  S.Print();
end.

Функции быстрого создания стека

[править]
function GenStack(params values: array of integer): TStack; // Выполняет генерацию стека на основе параметров.
begin
  Result := new TStack();
  foreach var v in values do
    Result.Push(v);
end;

Список

[править]
type
  TDynamicArray = class(System.ICloneable, System.IEquatable<TDynamicArray>)
  private 
    _A: array of integer;
    _Count, _Capacity: integer;
    
    procedure TryRaiseIndexOutOfRangeException(i: integer);
    begin
      if (i >= _Count) or (i < 0) then
        raise new System.IndexOutOfRangeException();
    end;
    
    procedure TryRaiseZeroCountException();
    begin
      if _Count = 0 then
        raise new Exception('Список пуст.');
    end;
    
    function GetItem(i: integer): integer;
    begin
      TryRaiseIndexOutOfRangeException(i);
      Result := _A[i];
    end;
    
    procedure SetItem(i: integer; v: integer);
    begin
      TryRaiseIndexOutOfRangeException(i);
      _A[i] := v;
    end;
    
    procedure TryResize();
    begin
      Inc(_Count);
      if _Count > _Capacity then
      begin
        _Capacity *= 2;
        SetLength(_A, _Capacity);
      end;
    end;
  
  public 
    property Items[i: integer]: integer read GetItem write SetItem;default;
    property Count: integer read _Count;
    property Capacity: integer read _Capacity;
    
    constructor();
    begin
      _Capacity := 2;
      SetLength(_A, _Capacity);
    end;
    
    procedure AddLast(v: integer); // Выполняет добавление элемента в конец списка.
    begin
      TryResize();
      _A[Pred(_Count)] := v;
    end;
    
    procedure RemoveLast(); // Выполняет удаление последнего элемента списка.
    begin
      TryRaiseZeroCountException();
      Dec(_Count);
    end;
    
    procedure AddFirst(v: integer); // Выполняет добавление элемента в начало списка.
    begin
      TryResize();
      for var i := Pred(_Count) downto 1 do
        _A[i] := _A[Pred(i)];
      _A[0] := v;
    end;
    
    procedure RemoveFirst(); // Выполняет удаление первого элемента списка.
    begin
      TryRaiseZeroCountException();
      for var i := 0 to _Count - 2 do
        _A[i] := _A[Succ(i)];
    end;
    
    function Seach(v1: integer): integer; // Выполняет поиск элемента по списку и возвращает его индекс (либо выбрасывает исключение при его отсутствии).
    begin
      Result := 0;
      while (Result < _Count) and (_A[Result] <> v1) do Inc(Result);
      TryRaiseIndexOutOfRangeException(Result);
    end;
    
    procedure Insert(v1, v2: integer); // Выполняет вставку элемента v2 после элемента со значением v1 в список.
    begin
      TryResize();
      var j := Seach(v1);
      for var i := Pred(_Count) downto Succ(j) do
        _A[i] := _A[Pred(i)];
      _A[j] := v2;
    end;
    
    procedure Remove(v1: integer); // Выполняет удаление элемента со значением v1 из списка.
    begin
      TryRaiseZeroCountException();
      var j := Seach(v1);
      for var i := j to _Count - 2 do
        _A[i] := _A[Succ(i)];
      Dec(_Count);
    end;
    
    procedure Remove(a: TDynamicArray); // Выполняет удаление всех элементов a из списка.
    begin
      for var i := 0 to Pred(a.Count) do
        Remove(a[i]);
    end;
    
    procedure AppendLast(a: TDynamicArray); // Выполняет добавление второго списка в конец.
    begin
      for var i := 0 to Pred(a.Count) do
        AddLast(a[i]);
    end;
    
    procedure AppendFirst(a: TDynamicArray); // Выполняет добавление второго списка в начало.
    begin
      for var i := 0 to Pred(a.Count) do
        AddFirst(a[i]);
    end;
    
    procedure Shuffle(); // Выполняет случайное перемешивание списка.
    begin
      for var i := 0 to _Count - 2 do
        Swap(_A[i], _A[Random(Succ(i), Pred(_Count))]);
    end;
    
    function &Repeat(c: integer): TDynamicArray; // Выполняет дублирование списка c раз.
    begin
      Result := new TDynamicArray();
      for var i := 1 to c do
        Result.AppendLast(self);
    end;
    
    function Clone(): object; // Выполняет полное копирование списка.
    begin
      var outcome := new TDynamicArray();
      for var i := 0 to Pred(_Count) do
        outcome.AddLast(_A[i]);
      Result := outcome;
    end;
    
    function CloneAs() := TDynamicArray(Clone());
    
    function Equals(b: TDynamicArray): boolean; // Выполняет сравнение списков.
    begin
      if _Count = b.Count then
      begin
        Result := true;
        var i := 0;
        while Result and (i < _Count) do
        begin
          Result := _A[i] = b[i];
          Inc(i);
        end;
      end;
    end;
    
    class function Readln(c: integer): TDynamicArray; // Выполняет чтение списка с клавиатуры и возвращает новый список.
    begin
      Result := new TDynamicArray();
      for var i := 1 to c do
        Result.AddLast(ReadlnInteger(Format('Value {0}:', i)));
    end;
    
    class procedure operator+=(a: TDynamicArray; v1: integer) := a.AddLast(v1);
    
    class function operator*(a: TDynamicArray; c: integer): TDynamicArray; // Выполняет дублирование списка c раз.
    begin
      Result := new TDynamicArray();
      for var i := 1 to c do
        Result.AppendLast(a);
    end;
    
    class function operator+(a: TDynamicArray; v1: integer): TDynamicArray;
    begin
      Result := a.CloneAs();
      Result.AddLast(v1);
    end;
    
    class function operator+(v1: integer; a: TDynamicArray): TDynamicArray;
    begin
      Result := a.CloneAs();
      Result.AddFirst(v1);
    end;
    
    class function operator+(a, b: TDynamicArray): TDynamicArray;
    begin
      Result := a.CloneAs();
      Result.AppendLast(b);
    end;
    
    class function operator-(a: TDynamicArray; v1: integer): TDynamicArray;
    begin
      Result := a.CloneAs();
      Result.Remove(v1);
    end;
    
    class function operator-(a, b: TDynamicArray): TDynamicArray;
    begin
      Result := a.CloneAs();
      for var i := 0 to Pred(b.Count) do
        Result.Remove(b[i]);
    end;
    
    class function operator=(a, b: TDynamicArray) := a.Equals(b);
    
    class function operator<>(a, b: TDynamicArray) := not (a = b);
    
    class function operator explicit(numbers: array of integer): TDynamicArray;
    begin
      Result := new TDynamicArray();
      foreach var number in numbers do
        Result.AddLast(number);
    end;
    
    class function operator explicit(s: string): TDynamicArray;
    begin
      var numbers := s.ToIntegers();
      Result := new TDynamicArray();
      foreach var number in numbers do
        Result.AddLast(number);
    end;
    
    procedure Print();
    begin
      for var i := 0 to Pred(_Count) do
        if i < Pred(_Count) then
          WriteFormat('{0} ', _A[i].ToString())
        else
          Write(_A[i].ToString());
    end;
    
    procedure Println();
    begin
      Print();
      Writeln();
    end;
  end;

begin
  var L := new TDynamicArray();
  
  for var i := 0 to 9 do
    L += i;
  
  L.Println();
  L.Repeat(2).Println();
  L.Shuffle();
  L.Println();
  TDynamicArray('0 12 3 4 512').Println();
end.

Функции быстрого создания списков

[править]
function DArr(params values: array of integer): TDynamicArray;
begin
  Result := new TDynamicArray();
  foreach var v in values do
    Result.AddLast(v);
end;

function DArr(params arrays: array of TDynamicArray): TDynamicArray; // Выполняет склеивание списков и возвращает новый список.
begin
  Result := new TDynamicArray();
  foreach var a in arrays do
    Result.AppendLast(a);
end;

Методы расширения

[править]

Простейшие методы

[править]
function First(self: TDynamicArray): integer; extensionmethod; // Возвращает первый элемент списка.
begin
  Result := self[0];
end;

function Last(self: TDynamicArray): integer; extensionmethod; // Возвращает последний элемент списка.
begin
  Result := self[Pred(self.Count)];
end;

function GetAt(self: TDynamicArray; i: integer): integer; extensionmethod; // Получает значение элемента с индексом i mod self.Count.
begin
  Result := self[i mod self.Count];
end;

procedure SetAt(self: TDynamicArray; i, v: integer); extensionmethod; // Устанавливает значение элемента с индексом i mod self.Count.
begin
  self[i mod self.Count] := v;
end;

function Min(self: TDynamicArray): integer; extensionmethod; // Возвращает минимальный элемент списка.
begin
  Result := integer.MaxValue;
  for var i := 0 to Pred(self.Count) do
    if Result > self[i] then
      Result := self[i];
end;

function Max(self: TDynamicArray): integer; extensionmethod; // Возвращает максимальный элемент списка.
begin
  Result := integer.MinValue;
  for var i := 0 to Pred(self.Count) do
    if Result < self[i] then
      Result := self[i];
end;

function Average(self: TDynamicArray): real; extensionmethod; // Возвращает среднее значение элементов списка.
begin
  for var i := 0 to Pred(self.Count) do
    Result += self[i];
  Result /= self.Count;
end;

function Cartesian(self, a: TDynamicArray): sequence of (integer, integer); extensionmethod; // Возвращает декартово произведение двух списков в виде кортежей вида (integer, integer).
begin
  for var i := 0 to Pred(self.Count) do
    for var j := 0 to Pred(a.Count) do
      yield (self[i], a[j]);
end;

function Reversed(self: TDynamicArray): TDynamicArray; extensionmethod;// Возвращает перевёрнутый список.
begin
  Result := self.CloneAs();
  for var i := 0 to Pred(Result.Count) div 2 do
  begin
    var i1 := Pred(Result.Count) - i;
    var c := Result[i];
    Result[i] := Result[i1];
    Result[i1] := c;
  end;
end;

function Contains(self: TDynamicArray; v1: integer): boolean; extensionmethod;
begin
  try
    self.Seach(v1);
    Result := true;
  except 
    on System.IndexOutOfRangeException do end;
end;

function operator in(v1: integer; a: TDynamicArray): boolean; extensionmethod;
begin
  Result := a.Contains(v1);
end;

function CountEqual(self, b: TDynamicArray): boolean; extensionmethod;
begin
  Result := self.Count = b.Count;
end;

function operator>(a, b: TDynamicArray): boolean; extensionmethod; // Возвращает true, если все элементы a больше элементов b.
begin
  if not a.CountEqual(b) then exit;
  var i := 0;
  while (i < a.Count) and (a[i] > b[i]) do Inc(i);
  if i = a.Count then Result := true;
end;

function operator<(a, b: TDynamicArray): boolean; extensionmethod; // Возвращает true, если все элементы a меньше элементов b.
begin
  if not a.CountEqual(b) then exit;
  var i := 0;
  while (i < a.Count) and (a[i] < b[i]) do Inc(i);
  if i = a.Count then Result := true;
end;

function operator>=(a, b: TDynamicArray): boolean; extensionmethod; // Возвращает true, если все элементы a больше или равны элементам b.
begin
  if not a.CountEqual(b) then exit;
  var i := 0;
  while (i < a.Count) and (a[i] >= b[i]) do Inc(i);
  if i = a.Count then Result := true;
end;

function operator<=(a, b: TDynamicArray): boolean; extensionmethod; // Возвращает true, если все элементы a меньше или равны элементам b.
begin
  if not a.CountEqual(b) then exit;
  var i := 0;
  while (i < a.Count) and (a[i] <= b[i]) do Inc(i);
  if i = a.Count then Result := true;
end;

function JoinIntoString(self: TDynamicArray; delim: string): string; extensionmethod; // Объединяет в строку все элементы массива, заполняя промежутки между элементами разделителем delim.
begin
  var i := 0;
  while i < self.Count do
  begin
    if i < Pred(self.Count) then
      Result += self[i] + delim
    else
      Result += self[i];
    Inc(i);
  end;
end;

function JoinIntoString(self: TDynamicArray; delims: array of string): string; extensionmethod; // Объединяет в строку все элементы массива, заполняя промежутки между элементами разделителями из массива delims.
begin
  var (i, j) := (0, 0);
  while i < self.Count do
  begin
    if i < Pred(self.Count) then
      Result += self[i] + delims[j mod delims.Length]
    else
      Result += self[i];
    Inc(i);
    Inc(j);
  end;
end;

Селектор и поиск минимума и максимума по ключу

[править]
type
  TSelector = function(x: integer): integer;
  TSelector2 = function(x, y: integer): integer;

function MinBy(self: TDynamicArray; f: TSelector): integer; extensionmethod; // Возвращает элемент списка с минимальным ключём, получаемым функцией f.
begin
  Result := integer.MaxValue;
  for var i := 0 to Pred(self.Count) do
  begin
    var outcome := f(self[i]);
    if Result > outcome then
      Result := outcome;
  end;
end;

function MaxBy(self: TDynamicArray; f: TSelector): integer; extensionmethod; // Возвращает элемент списка с максимальным ключём, получаемым функцией f.
begin
  Result := integer.MinValue;
  for var i := 0 to Pred(self.Count) do
  begin
    var outcome := f(self[i]);
    if Result < outcome then
      Result := outcome;
  end;
end;

function Select(self: TDynamicArray; f: TSelector): TDynamicArray; extensionmethod; // Возвращает список, который получается из изначального применением к каждому из его элементов функции f.
begin
  Result := new TDynamicArray();
  for var i := 0 to Pred(self.Count) do
    Result.AddLast(f(self[i]));
end;

function SelectMany(self, a: TDynamicArray; f: TSelector2): TDynamicArray; // Возвращает список из элементов, которые были получены применением функции.
begin
  Result := new TDynamicArray();
  foreach var x in self.Cartesian(a) do
    Result.AddLast(f(x.Item1, x.Item2));
end;

Срезы

[править]
type
  InvalidSliceParameterValueException = class(Exception)
  end;

function Slice(self: TDynamicArray; a: integer := 0; b: integer := 1; step: integer := 1): TDynamicArray; extensionmethod; // Возвращает срез списка.
begin
  if (step = 0) or (a < b) and (step < 0) or (a >= b) and (step > 0) then
    raise new InvalidSliceParameterValueException('Недопустимая нижняя(верхняя) граница/шаг. При a > b step должен быть больше 0, иначе step должен быть меньше 0.');
  
  Result := new TDynamicArray();
  if a < b then
  begin
    var i := a;
    while (i <= b) do
    begin
      Result.AddLast(self[i]);
      Inc(i, step);
    end;
  end
  else
  begin
    var i := a;
    while (i >= b) do
    begin
      Result.AddLast(self[i]);
      Inc(i, step);
    end;
  end
end;

Связные списки

[править]

Односвязный список

[править]

Реализация через record

[править]
type
  PNode = ^TNode;
  TNode = record
    Value: integer;
    Next: PNode;
  end;
  
  TLinkedList = PNode;

function NewNode(value: integer; next: PNode): PNode;
begin
  New(Result);
  Result^.Value := value;
  Result^.Next := next;
end;

function IsEmpty(var l: TLinkedList) := l = nil;

function GetCount(l: TLinkedList): integer;
begin
  while l <> nil do
  begin
    Inc(Result);
    l := l^.Next;
  end;
end;

procedure Clear(var l: TLinkedList);
begin
  while l <> nil do
  begin
    var l1 := l^.Next;
    Dispose(l);
    l := l1;
  end;
end;

procedure AddFirst(var l: TLinkedList; n: PNode);
begin
  n^.Next := l;
  l := n;
end;

procedure RemoveFirst(var l: TLinkedList);
begin
  if l <> nil then
    l := l^.Next;
end;

procedure Print(l: TLinkedList);
begin
  while l <> nil do
  begin
    if l^.Next <> nil then
      WriteFormat('{0} ', l^.Value)
    else
      Write(l^.Value);
    l := l^.Next;
  end;
end;

procedure Println(l: TLinkedList);
begin
  Print(l);
  Writeln();
end;

begin
  var L := NewNode(0, nil);
  
  for var i := 1 to 9 do
    AddFirst(L, NewNode(i, nil));
  
  Println(L);
  Writeln(GetCount(L));
end.

Реализация через классы

[править]

Примитивная реализация

[править]
type
  TNode = auto class
    Value: integer;
    Next: TNode;
  end;
  
  TLinkedList = TNode;

function IsEmpty(l: TLinkedList) := l = nil;

function GetCount(l: TLinkedList): integer;
begin
  while l <> nil do
  begin
    Inc(Result);
    l := l.Next;
  end;
end;

procedure Clear(var l: TLinkedList) := l := nil;

procedure AddFirst(var l: TLinkedList; n: TNode);
begin
  n.Next := l;
  l := n;
end;

procedure RemoveFirst(var l: TLinkedList);
begin
  if l <> nil then
    l := l.Next;
end;

procedure Print(l: TLinkedList);
begin
  while l <> nil do
  begin
    if l.Next <> nil then
      WriteFormat('{0} ', l.Value)
    else
      Write(l.Value);
    l := l.Next;
  end;
end;

procedure Println(l: TLinkedList);
begin
  Print(l);
  Writeln();
end;

begin
  var L := new TLinkedList(0, nil);
  
  for var i := 1 to 9 do
    AddFirst(L, new TNode(i, nil));
  
  Println(L);
  Writeln(GetCount(L));
end.

Многослойная абстракция

[править]
type
  TNode = class
  private 
    _Value: integer;
    _Next: TNode;
  
  public 
    property Value: integer read _Value write _Value;
    property Next: TNode read _Next write _Next;
    
    constructor(v: integer);
    begin
      Value := v;
    end;
  end;

type
  TLinkedList = class
  private 
    _Head: TNode;
    _Count: integer;
  
  public 
    property Head: TNode read _Head;
    property Count: integer read _Count;
    
    constructor();
    begin
    end;
    
    function IsEmpty() := _Count = 0;
    
    procedure Clear();
    begin
      _Head := nil;
      _Count := 0;
    end;
    
    procedure AddFirst(n: TNode);
    begin
      n.Next := _Head;
      _Head := n;
      Inc(_Count);
    end;
    
    procedure RemoveFirst();
    begin
      if _Head <> nil then
      begin
        _Head := _Head.Next;
        Dec(_Count);
      end;
    end;
    
    class procedure operator+=(l: TLinkedList; v: integer) := l.AddFirst(new TNode(v));
    
    procedure Print();
    begin
      var n := _Head;
      while n <> nil do
      begin
        if n.Next <> nil then
          WriteFormat('{0} ', n.Value)
        else
          Write(n.Value);
        n := n.Next;
      end;
    end;
    
    procedure Println();
    begin
      Print();
      Writeln();
    end;
  end;

begin
  var L := new TLinkedList();
  
  for var i := 0 to 9 do
    L += i;
  
  WritelnFormat('Количество элементов в списке равно {0}.', L.Count);
  L.Println();
end.

Функции трансформации в другие структуры данных:

function ToArray(): array of integer;
begin
  SetLength(Result, _Count);
  var n := _Head;
  var i := 0;
  while n <> nil do
  begin
    Result[i] := n.Value;
    n := n.Next;
    Inc(i);
  end;
end;
Функции быстрого создания списков
[править]
function Lst(params values: array of integer): TLinkedList;
begin
  Result := new TLinkedList();
  for var i := Pred(values.Length) downto 0 do
    Result.AddFirst(new TNode(values[i]));
end;

Двусвязный список с многослойной абстракцией

[править]
type
  TNode = class
  private 
    _Value: integer;
    _Next, _Previous: TNode;
  
  public 
    property Value: integer read _Value write _Value;
    property Next: TNode read _Next write _Next;
    property Previous: TNode read _Previous write _Previous;
    
    constructor(v: integer);
    begin
      Value := v;
    end;
  end;

type
  TLinkedList = class
  private 
    _Head, _Tail: TNode;
    _Count: integer;
    
    procedure TryRaiseZeroCountException();
    begin
      if _Count = 0 then
        raise new Exception('Список пуст.');
    end;
  
  public 
    property Head: TNode read _Head;
    property Tail: TNode read _Tail;
    property Count: integer read _Count;
    
    constructor();
    begin
    end;
    
    function IsEmpty() := _Count = 0;
    
    procedure Clear();
    begin
      _Head := nil;
      _Tail := nil;
      _Count := 0;
    end;
    
    procedure AddFirst(n: TNode);
    begin
      n.Next := _Head;
      n.Previous := nil;
      if _Head <> nil then
        _Head.Previous := n
      else
        _Tail := n;
      _Head := n;
      Inc(_Count);
    end;
    
    procedure RemoveFirst();
    begin
      TryRaiseZeroCountException();
      _Head := _Head.Next;
      if _Count = 1 then
        _Tail := nil;
      Dec(_Count);
    end;
    
    procedure AddLast(n: TNode);
    begin
      if _Count = 0 then
        AddFirst(n)
      else
      begin
        n.Next := nil;
        n.Previous := _Tail;
        _Tail.Next := n;
        _Tail := n;
        Inc(_Count);
      end;
    end;
    
    procedure RemoveLast();
    begin
      if _Count = 1 then
        RemoveFirst()
      else
      begin
        TryRaiseZeroCountException();
        _Tail := _Tail.Previous;
        _Tail.Next := nil;
        Dec(_Count);
      end;
    end;
    
    class function Readln(c: integer): TLinkedList;
    begin
      Result := new TLinkedList();
      for var i := 1 to c do
        Result.AddLast(new TNode(ReadlnInteger(Format('Value {0}:', i))));
    end;
    
    class procedure operator+=(var l: TLinkedList; v: integer) := l.AddLast(new TNode(v));
    
    procedure Print();
    begin
      var n := _Head;
      while n <> nil do
      begin
        if n.Next <> nil then
          WriteFormat('{0} ', n.Value)
        else
          Write(n.Value);
        n := n.Next;
      end;
    end;
    
    procedure Println();
    begin
      Print();
      Writeln();
    end;
  end;

begin
  var L := TLinkedList.Readln(ReadlnInteger('Count:'));
  L.Println();
end.

Функции быстрого создания списков

[править]
function Lst(params values: array of integer): TLinkedList;
begin
  Result := new TLinkedList();
  foreach var v in values do
    Result.AddLast(new TNode(v));
end;

Математические структуры данных

[править]

Точка

[править]

Первый подход

[править]
uses System;
const
  Eps = 1E-5; // Погрешность

type
  TPoint = class(ICloneable, IEquatable<TPoint>)
  private 
    _X, _Y: real;
  
  public 
    property X: real read _X write _X; // X координата точки
    property Y: real read _Y write _Y; // Y координата точки
    
    constructor(x_, y_: real);
    begin
      X := x_;Y := y_;
    end;
    
    function DistanceTo(p: TPoint) := Sqrt(Sqr(p.X - _X) + Sqr(p.Y - _Y)); // Возвращает дистанцию от данной точки до точки p.
    
    function GetRadiusVectorLength() := Sqrt(Sqr(_X) + Sqr(_Y)); // Получает длину радиус вектора, задаваемого координатами данной точки.
    
    function Clone(): object := new TPoint(_X, _Y);
    
    function CloneAs() := TPoint(Clone());
    
    function Equals(p: TPoint) := (Abs(_X - p.X) < Eps) and (Abs(_Y - p.Y) < Eps);
    
    class function Readln() := new TPoint(ReadlnReal('X:'), ReadlnReal('Y:')); // Выполняет чтение точки с клавиатуры и возвращает новую точку.
    
    class function operator=(a, b: TPoint) := a.Equals(b);
    
    class function operator<>(a, b: TPoint) := not (a = b);
    
    function ToString() := Format('Point({0}, {1})', _X, _Y); // Возвращает строковое представление объекта.
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  TPoint.Readln().Println();
end.

Второй подход

[править]
uses System;
const
  Eps = 1E-5; // Погрешность

type
  TPoint = class
  private 
    _X, _Y: real;
  
  public 
    property X: real read _X write _X;
    property Y: real read _Y write _Y;
    
    constructor(x_, y_: real);
    begin
      X := x_;Y := y_;
    end;
    
    class function DistanceBetween(p1, p2: TPoint) := Sqrt(Sqr(p2.X - p1.X) + Sqr(p2.Y - p1.Y));
    
    class function GetRadiusVectorLength(p: TPoint) := Sqrt(Sqr(p.X) + Sqr(p.Y));
    
    class function Clone(p: TPoint): object := new TPoint(p.X, p.Y);
    
    class function CloneAs(p: TPoint) := TPoint(Clone(p));
    
    class function Equals(p1, p2: TPoint) := (Abs(p2.X - p1.X) < Eps) and (Abs(p2.Y - p1.Y) < Eps);
    
    class function Readln() := new TPoint(ReadlnReal('X:'), ReadlnReal('Y:'));
    
    class function operator=(a, b: TPoint) := TPoint.Equals(a, b);
    
    class function operator<>(a, b: TPoint) := not (a = b);
    
    function ToString() := Format('Point({0}, {1})', _X, _Y);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var (A, B) := (TPoint.Readln(), TPoint.Readln());
  TPoint.DistanceBetween(A, B).Println();
  TPoint.Equals(A, B).Println();
end.

Диапазон

[править]

Первый подход

[править]
uses System;
const
  Eps = 1E-5; // Погрешность

type
  TRange = class(ICloneable, IEquatable<TRange>)
  private 
    _A, _B: real;
    _IncludeA, _IncludeB: boolean;
    
    procedure TrySwap(var less, most: real);
    begin
      if most - less < -Eps then
        Swap(less, most);
    end;
    
    procedure SetA(v: real);
    begin
      TrySwap(v, _B);
      _A := v;
    end;
    
    procedure SetB(v: real);
    begin
      TrySwap(_A, v);
      _B := v;
    end;
    
    function AreEqual(a_, b_: real) := Abs(a_ - b_) <= Eps;
  
  public 
    property A: real read _A write SetA; // Нижняя граница
    property B: real read _B write SetB; // Верхняя граница
    property IncludeA: boolean read _IncludeA write _IncludeA; // Включать ли нижнюю границу
    property IncludeB: boolean read _IncludeB write _IncludeB; // Включать ли верхнюю границу
    
    constructor(a_, b_: real);
    begin
      TrySwap(a_, b_);
      _A := a_;_B := b_;
    end;
    
    // Возвращает true, если точка внутри диапазона (учитывается Eps).
    function IsIn(c: real) := ((c - _A > Eps) or _IncludeA and AreEqual(_A, c)) and
                              ((_B - c > Eps) or _IncludeB and AreEqual(_B, c));
    
    function IsIn(r: TRange) := IsIn(r.A) and IsIn(r.B);
    
    function Clone(): object := new TRange(_A, _B);
    
    function CloneAs() := TRange(Clone());
    
    function Equals(r: TRange) := (Abs(_A - r.A) < Eps) and (Abs(_B - r.B) < Eps);
    
    class function Readln() := new TRange(ReadlnReal('A:'), ReadlnReal('B:'));
    
    class function operator in(c: real; r: TRange) := r.IsIn(c);
    
    class function operator in(r1, r2: TRange) := r2.IsIn(r1);
    
    function ToString() := Format('{0}{1}, {2}{3}', _IncludeA ? '[' : '(', _A, _B, _IncludeB ? ']' : ')');
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var R := new TRange(-2, 2);
  R.Println();
  R.B := -8;
  R.IncludeA := true;
  R.Println();
  WritelnFormat('-4 внутри R: {0}.', -5 in R); // Эквивалентно: R.IsIn(-5).
  WritelnFormat('-2 внутри R: {0}.', -4 in R);
  WritelnFormat('Второй диапазон внутри R: {0}.', new TRange(-8, -2.1) in R);
end.

Второй подход

[править]
type
  TRange = class
  private 
    _A, _B: real;
    _IncludeA, _IncludeB: boolean;
    
    procedure TrySwap(var less, most: real);
    begin
      if most - less < -Eps then
        Swap(less, most);
    end;
    
    procedure SetA(v: real);
    begin
      TrySwap(v, _B);
      _A := v;
    end;
    
    procedure SetB(v: real);
    begin
      TrySwap(_A, v);
      _B := v;
    end;
    
    class function AreEqual(a_, b_: real) := Abs(a_ - b_) <= Eps;
  
  public 
    property A: real read _A write SetA; // Нижняя граница
    property B: real read _B write SetB; // Верхняя граница
    property IncludeA: boolean read _IncludeA write _IncludeA; // Включать ли нижнюю границу
    property IncludeB: boolean read _IncludeB write _IncludeB; // Включать ли верхнюю границу
    
    constructor(a_, b_: real);
    begin
      TrySwap(a_, b_);
      _A := a_;_B := b_;
    end;
    
    // Возвращает true, если точка внутри диапазона (учитывается Eps).
    class function IsIn(r: TRange; c: real) := ((c - r.A > Eps) or r.IncludeA and TRange.AreEqual(r.A, c)) and
                                               ((r.B - c > Eps) or r.IncludeB and TRange.AreEqual(r.B, c));
    
    class function IsIn(big, small: TRange) := TRange.IsIn(big, small.A) and TRange.IsIn(big, small.B);
    
    class function Clone(r: TRange): object := new TRange(r.A, r.B);
    
    class function CloneAs(r: TRange) := TRange(Clone(r));
    
    class function Equals(r1, r2: TRange) := (Abs(r2.A - r1.A) < Eps) and (Abs(r2.B - r1.B) < Eps);
    
    class function Readln() := new TRange(ReadlnReal('A:'), ReadlnReal('B:'));
    
    class function operator in(c: real; r: TRange) := TRange.IsIn(r, c);
    
    class function operator in(small, big: TRange) := TRange.IsIn(big, small);
    
    function ToString() := Format('{0}{1}, {2}{3}', _IncludeA ? '[' : '(', _A, _B, _IncludeB ? ']' : ')');
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var R := new TRange(-2, 2);
  R.Println();
  R.B := -8;
  R.IncludeA := true;
  R.Println();
  WritelnFormat('-4 внутри R: {0}.', -2.1 in R);
  WritelnFormat('-2 внутри R: {0}.', -4 in R);
  WritelnFormat('Второй диапазон внутри R: {0}.', new TRange(-8, -2.1) in R);
end.

Вектора

[править]

Двумерный вектор

[править]
uses System;
const
  Eps = 1E-5; // Погрешность

type
  TVector2D = class(ICloneable, IEquatable<TVector2D>)
  private 
    _X, _Y: real;
    
    function GetLength() := Sqrt(Sqr(_X) + Sqr(_Y));
    
    function GetAngle() := Math.Atan2(_Y, _X) + 2 * Pi * Ord(_Y < 0);
  
  public 
    property X: real read _X write _X;
    property Y: real read _Y write _Y;
    property Length: real read GetLength; // Длина вектора
    property Angle: real read GetAngle; // Угол поворота вектора
    
    constructor(x_, y_: real);
    begin
      X := x_;Y := y_;
    end;
    
    procedure Normalize();
    begin
      var l := GetLength();
      _X /= l;_Y /= l;
    end;
    
    function DotProduct(v: TVector2D) := _X * v.X + _Y * v.Y; // Возвращает скалярное произведение векторов.
    
    function CrossProductAbs(v: TVector2D) := Abs(_X * v.Y - _Y * v.X); // Возвращает модуль векторного произведения (координаты z векторов self и v считаются равными 0).
    
    function IsCollinear(v: TVector2D) := CrossProductAbs(v) = 0; // Возвращает true, если векторы являются коллинеарными.
    
    procedure Add(v: TVector2D);
    begin
      _X += v.X;
      _Y += v.Y;
    end;
    
    procedure Subtract(v: TVector2D);
    begin
      _X -= v.X;
      _Y -= v.Y;
    end;
    
    procedure Multiply(k: real);
    begin
      _X *= k;
      _Y *= k;
    end;
    
    procedure Divide(k: real);
    begin
      _X /= k;
      _Y /= k;
    end;
    
    class function VectorX() := new TVector2D(1, 0);
    
    class function VectorY() := new TVector2D(0, 1);
    
    class function VectorSum(params vectors: array of TVector2D): TVector2D;// Возвращает вектор, получаемый суммированием всех векторов, указанных в параметрах.
    begin
      Result := new TVector2D(0, 0);
      foreach var vector in vectors do
        Result := Result + vector;
    end;
    
    function Clone(): object := new TVector2D(_X, _Y);
    
    function CloneAs() := TVector2D(Clone());
    
    function Equals(v: TVector2D) := (Abs(_X - v.X) < Eps) and (Abs(_Y - v.Y) < Eps);
    
    class function Readln() := new TVector2D(ReadlnInteger('X:'), ReadlnInteger('Y:'));
    
    class procedure operator+=(v, v1: TVector2D) := v.Add(v1);
    
    class procedure operator-=(v, v1: TVector2D) := v.Subtract(v1);
    
    class procedure operator*=(v: TVector2D; k: real) := v.Multiply(k);
    
    class procedure operator/=(v: TVector2D; k: real) := v.Divide(k);
    
    class function operator+(v, v1: TVector2D): TVector2D;
    begin
      Result := v.CloneAs();
      Result += v1;
    end;
    
    class function operator-(v, v1: TVector2D): TVector2D;
    begin
      Result := v.CloneAs();
      Result -= v1;
    end;
    
    class function operator*(v: TVector2D; k: real): TVector2D;
    begin
      Result := v.CloneAs();
      Result *= k;
    end;
    
    class function operator/(v: TVector2D; k: real): TVector2D;
    begin
      Result := v.CloneAs();
      Result /= k;
    end;
    
    class function operator-(v: TVector2D): TVector2D; // Возвращает новый вектор с координатами (-X, -Y).
    begin
      Result := v.CloneAs();
      Result *= -1;
    end;
    
    class function operator=(a, b: TVector2D) := a.Equals(b);
    
    class function operator<>(a, b: TVector2D) := not (a = b);
    
    function ToString() := Format('Vector({0}, {1})', _X, _Y);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var V1 := new TVector2D(4, 6);
  var V2 := new TVector2D(1, 3);
  Writeln((V1 + V2).ToString());
end.

Если площадь параллелограмма равна нулю, то векторы коллинеарны.

Трехмерный вектор

[править]
uses System;
const
  Eps = 1E-5; // Погрешность

type
  TVector3D = class(ICloneable, IEquatable<TVector3D>)
  private 
    _X, _Y, _Z: real;
    
    function GetLength() := Sqrt(Sqr(_X) + Sqr(_Y) + Sqr(_Z));
    
    function AreEqual(v1, v2: real) := Abs(v1 - v2) < Eps;
    
  public 
    property X: real read _X write _X;
    property Y: real read _Y write _Y;
    property Z: real read _Z write _Z;
    property Length: real read GetLength;
    
    constructor(x_, y_, z_: real);
    begin
      X := x_;Y := y_;Z := z_;
    end;
    
    procedure Normalize();
    begin
      var l := GetLength();
      _X /= l;_Y /= l;_Z /= l;
    end;
    
    function DotProduct(v: TVector3D) := _X * v.X + _Y * v.Y + _Z * v.Z;
    
    function CrossProduct(v: TVector3D) := new TVector3D(_Y * v.Z - v.Y * _Z, -(_X * v.Z - v.X * _Z), _X * v.Y - v.X * _Y);
    
    function IsCollinear(v: TVector3D) := CrossProduct(v).Length = 0;
    
    // Вычисляет смешанное произведение векторов в координатах.
    function MixedMult(v1, v2: TVector3D) := _X * v1.Y * v2.Z + _Y * v1.Z * v2.X + v1.X * v2.Y * _Z -
                                             v2.X * v1.Y * _Z - v1.X * _Y * v2.Z - v2.Y * v1.Z * _X;
    
    procedure Add(v: TVector3D);
    begin
      _X += v.X;
      _Y += v.Y;
      _Z += v.Z;
    end;
    
    procedure Subtract(v: TVector3D);
    begin
      _X -= v.X;
      _Y -= v.Y;
      _Z -= v.Z;
    end;
    
    procedure Multiply(k: real);
    begin
      _X *= k;
      _Y *= k;
      _Z *= k;
    end;
    
    procedure Divide(k: real);
    begin
      _X /= k;
      _Y /= k;
      _Z /= k;
    end;
    
    class function VectorX() := new TVector3D(1, 0, 0);
    
    class function VectorY() := new TVector3D(0, 1, 0);
    
    class function VectorZ() := new TVector3D(0, 0, 1);
    
    class function VectorSum(params vectors: array of TVector3D): TVector3D;
    begin
      Result := new TVector3D(0, 0, 0);
      foreach var vector in vectors do
        Result := Result + vector;
    end;
    
    function Clone(): object := new TVector3D(_X, _Y, _Z);
    
    function CloneAs() := TVector3D(Clone());
    
    function Equals(v: TVector3D) := AreEqual(_X, v.X) and AreEqual(_Y, v.Y) and AreEqual(_Z, v.Z);
    
    class function Readln() := new TVector3D(ReadlnInteger('X:'), ReadlnInteger('Y:'), ReadlnInteger('Z:'));
    
    class procedure operator+=(v, v1: TVector3D) := v.Add(v1);
    
    class procedure operator-=(v, v1: TVector3D) := v.Subtract(v1);
    
    class procedure operator*=(v: TVector3D; k: real) := v.Multiply(k);
    
    class procedure operator/=(v: TVector3D; k: real) := v.Divide(k);
    
    class function operator+(v, v1: TVector3D): TVector3D;
    begin
      Result := v.CloneAs();
      Result += v1;
    end;
    
    class function operator-(v, v1: TVector3D): TVector3D;
    begin
      Result := v.CloneAs();
      Result -= v1;
    end;
    
    class function operator*(v: TVector3D; k: real): TVector3D;
    begin
      Result := v.CloneAs();
      Result *= k;
    end;
    
    class function operator/(v: TVector3D; k: real): TVector3D;
    begin
      Result := v.CloneAs();
      Result /= k;
    end;
    
    class function operator-(v: TVector3D): TVector3D; // Возвращает новый вектор с координатами (-X, -Y).
    begin
      Result := v.CloneAs();
      Result *= -1;
    end;
    
    function ToString() := Format('Vector({0}, {1}, {2})', _X, _Y, _Z);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var (V1, V2, V3) := (new TVector3D(2, -1, 4), new TVector3D(7, 2, 3), new TVector3D(3, -2, 1));
  Writeln(V1.MixedMult(V2, V3).ToString());
end.

Что такое смешанное произведение?

Класс окружности

[править]
type
  NegativeOrZeroRadiusException = class(Exception)
  end;

type
  TCircle = class(ICloneable, IEquatable<TCircle>)
  private 
    _Center: TPoint;
    _R: real;
    
    procedure SetR(v: real);
    begin
      if v <= 0 then
        raise new NegativeOrZeroRadiusException('Отрицательный или равный нулю радиус не может быть у окружности.');
      _R := v;
    end;
    
    function GetD() := _R * 2;
    
    function GetLength() := 2 * Pi * _R;
    
  public 
    property Center: TPoint read _Center write _Center; // Центр окружности
    property R: real read _R write _R; // Радиус
    property D: real read GetD; // Диаметр
    property Length: real read GetLength; // Длина окружности
    
    constructor(c: TPoint; radius: real);
    begin
      Center := c;
      R := radius;
    end;
    
    function IntersectsWith(c: TCircle) := _Center.DistanceTo(c.Center) < _R + c.R; // Возвращает true, если окружности пересекаются.
    
    function ConcernWith(c: TCircle) := _Center.DistanceTo(c.Center) = _R + c.R; // Возвращает true, если окружности касаются друг друга.
    
    function Clone(): object := new TCircle(_Center.CloneAs(), _R);
    
    function CloneAs() := TCircle(Clone());
    
    function Equals(c: TCircle) := _Center.Equals(c.Center) and (Abs(_R - c.R) < Eps);
    
    class function Readln() := new TCircle(TPoint.Readln(), ReadlnReal('R:'));
    
    function ToString() := Format('Circle({0}, {1})', _Center.ToString(), _R);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  (new TCircle(new TPoint(0, 0), 5)).IntersectsWith(new TCircle(new TPoint(0, 5), 5)).Println();
end.

Класс дроби

[править]
uses System;

type
  TFraction = class(ICloneable, IEquatable<TFraction>, IComparable<TFraction>)
  private 
    _Numerator, _Denominator: integer;
    _TryAlwaysReduce: boolean;
    _TryCutOutput: boolean;
  
  public 
    procedure Reduce();
    begin
      var a := _Numerator;
      var b := _Denominator;
      while (a <> 0) and (b <> 0) do
        if a > b then a := a mod b else b := b mod a;
      
      var gcd := a + b;
      _Numerator := _Numerator div gcd;
      _Denominator := _Denominator div gcd;
    end;
  
  private 
    procedure TryReduce();
    begin
      if _TryAlwaysReduce then Reduce();
    end;
    
    procedure SetDenominator(v: integer);
    begin
      if v = 0 then
        raise new Exception('Знаменатель не может быть нулем.');
      _Denominator := v;
    end;
    
    procedure SetTryAlwaysReduce(v: boolean);
    begin
      _TryAlwaysReduce := v;
      TryReduce();
    end;
  
  public 
    property Numerator: integer read _Numerator write _Numerator; // Числитель
    property Denominator: integer read _Denominator write SetDenominator; // Знаменатель
    property TryAlwaysReduce: boolean read _TryAlwaysReduce write SetTryAlwaysReduce; // Сокращать ли всегда дробь (если возможно)
    property TryCutOutput: boolean read _TryCutOutput write _TryCutOutput; // Выводить ли только числитель (если знаменатель равен единице)
    
    constructor(n: integer; dn: integer := 1);
    begin
      Numerator := n;
      Denominator := dn;
    end;
    
    function ToReal() := _Numerator / _Denominator; // Возвращает вещественное число, соответствующее данной дроби.
    
    class function FromReal(a: real): TFraction; // Возвращает дробь, соответствующую данному вещественному числу.
    begin
      var n := Frac(a);
      var d := 1;
      while Frac(n) <> 0 do
      begin
        n *= 10;
        d *= 10;
      end;
      Result := new TFraction(Trunc(n), Trunc(d));
    end;
    
    procedure Add(f: TFraction);
    begin
      if _Denominator = f.Denominator then
        _Numerator += f.Numerator
      else
      begin
        _Numerator := _Numerator * f.Denominator + f.Numerator * _Denominator;
        _Denominator *= f.Denominator;
      end;
      TryReduce();
    end;
    
    procedure Subtract(f: TFraction);
    begin
      if _Denominator = f.Denominator then
        _Numerator -= f.Numerator
      else
      begin
        _Numerator := _Numerator * f.Denominator - f.Numerator * _Denominator;
        _Denominator *= f.Denominator;
      end;
      TryReduce();
    end;
    
    procedure Multiply(f: TFraction);
    begin
      _Numerator *= f.Numerator;
      _Denominator *= f.Denominator;
      TryReduce();
    end;
    
    procedure Divide(f: TFraction);
    begin
      _Numerator *= f.Denominator;
      _Denominator *= f.Numerator;
      TryReduce();
    end;
    
    function Clone(): object := new TFraction(_Numerator, _Denominator);
    
    function CloneAs() := TFraction(Clone());
    
    function Equals(f: TFraction) := (_Numerator = f.Numerator) and (_Denominator = f.Denominator);
    
    function CompareTo(f: TFraction): integer;
    begin
      var outcome := CloneAs();
      outcome.Subtract(f);
      var r := outcome.ToReal();
      if r > 0 then
        Result := 1
      else if r < 0 then
        Result := -1;
    end;
    
    class function Readln() := new TFraction(ReadlnInteger('Numerator:'), ReadlnInteger('Denominator:'));
    
    class procedure operator+=(f1, f2: TFraction) := f1.Add(f2);
    
    class procedure operator-=(f1, f2: TFraction) := f1.Subtract(f2);
    
    class procedure operator*=(f1, f2: TFraction) := f1.Multiply(f2);
    
    class procedure operator/=(f1, f2: TFraction) := f1.Divide(f2);
    
    class procedure operator+=(f1: TFraction; n: integer) := f1 += new TFraction(n, 1);
    
    class procedure operator-=(f1: TFraction; n: integer) := f1 -= new TFraction(n, 1);
    
    class procedure operator*=(f1: TFraction; n: integer) := f1 *= new TFraction(n, 1);
    
    class procedure operator/=(f1: TFraction; n: integer) := f1 -= new TFraction(n, 1);
    
    class function operator+(f1, f2: TFraction): TFraction;
    begin
      Result := f1.CloneAs();
      Result += f2;
    end;
    
    class function operator-(f1, f2: TFraction): TFraction;
    begin
      Result := f1.CloneAs();
      Result -= f2;
    end;
    
    class function operator*(f1, f2: TFraction): TFraction;
    begin
      Result := f1.CloneAs();
      Result *= f2;
    end;
    
    class function operator/(f1, f2: TFraction): TFraction;
    begin
      Result := f1.CloneAs();
      Result /= f2;
    end;
    
    class function operator-(f1: TFraction) := new TFraction(-f1.Numerator, f1.Denominator); // Возвращает дробь с противоположным знаком (минус вносится в числитель).
    
    class function operator=(f1, f2: TFraction) := f1.Equals(f2);
    
    class function operator<>(f1, f2: TFraction) := not (f1 = f2);
    
    class function operator>(f1, f2: TFraction) := f1.CompareTo(f2) = 1;
    
    class function operator>=(f1, f2: TFraction) := (f1 - f2).ToReal() >= 0;
    
    class function operator<(f1, f2: TFraction) := f1.CompareTo(f2) = -1;
    
    class function operator<=(f1, f2: TFraction) := (f1 - f2).ToReal() <= 0;
    
    function ToString(): string; override;
    begin
      if not _TryCutOutput then
        Result := Format('{0}/{1}', _Numerator, _Denominator)
      else if _Denominator = 1 then
        Result := _Numerator.ToString();
    end;
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var F1 := new TFraction(3, 10);
  var F2 := new TFraction(1, 5);
  F1.CompareTo(F2).Println();
  (F1 + F2).Println();
  F1.TryAlwaysReduce := true;
  F1.Println();
end.

Методы расширения

[править]
function Succ(self: TFraction): TFraction; extensionmethod; // Возвращает следующую дробь (если дробь равна, например, 2/5, то функция вернет 3/5).
begin
  Result := new TFraction(Succ(self.Numerator), self.Denominator);
end;

function Pred(self: TFraction): TFraction; extensionmethod; // Возвращает предыдущую дробь (если дробь равна, например, 4/5, то функция вернет 3/5).
begin
  Result := new TFraction(Pred(self.Numerator), self.Denominator);
end;

procedure Inc(self: TFraction); extensionmethod; // Увеличивает числитель дроби на 1.
begin
  self.Numerator += 1;
end;

procedure Dec(self: TFraction); extensionmethod; // Уменьшает числитель дроби на 1.
begin
  self.Numerator -= 1;
end;

function IsPositive(self: TFraction): boolean; extensionmethod; // Возвращает true, если дробь больше 0.
begin
  Result := self.Numerator * self.Denominator > 0;
end;

function IsNegative(self: TFraction): boolean; extensionmethod; // Возвращает true, если дробь меньше или равна 0.
begin
  Result := not self.IsPositive();
end;

Комплексное число

[править]
uses System;
const
  Eps = 1E-5; // Погрешность

type
  TComplex = class(ICloneable, IEquatable<TComplex>)
  private 
    _X, _Y: real;
  
  public 
    property X: real read _X write _X;
    property Y: real read _Y write _Y;
    
    constructor(x_, y_: real);
    begin
      X := x_;Y := y_;
    end;
    
    procedure Add(z: TComplex);
    begin
      _X += z.X;
      _Y += z.Y;
    end;
    
    procedure Subtract(z: TComplex);
    begin
      _X += z.X;
      _Y += z.Y;
    end;
    
    procedure Multiply(z: TComplex);
    begin
      var cx := _X;
      _X := _X * z.X - _Y * z.Y;
      _Y := cx * z.Y + z.X * _Y;
    end;
    
    procedure Divide(z: TComplex);
    begin
      var v := Sqr(z.X) + Sqr(z.Y);
      var cx := _X;
      _X := (_X * z.X - _Y * z.Y) / v;
      _Y := (z.X * _Y - cx * z.Y) / v;
    end;
    
    function Conjugate() := new TComplex(_X, -_Y);
    
    function Clone(): object := new TComplex(_X, _Y);
    
    function CloneAs() := TComplex(Clone());
    
    function Equals(p: TComplex) := (Abs(_X - p.X) < Eps) and (Abs(_Y - p.Y) < Eps);
    
    class function Readln() := new TComplex(ReadlnInteger('X:'), ReadlnInteger('Y:'));
    
    class procedure operator+=(z1, z2: TComplex) := z1.Add(z2);
    
    class procedure operator-=(z1, z2: TComplex) := z1.Subtract(z2);
    
    class procedure operator*=(z1, z2: TComplex) := z1.Multiply(z2);
    
    class procedure operator/=(z1, z2: TComplex) := z1.Divide(z2);
    
    class function operator+(z1, z2: TComplex): TComplex;
    begin
      Result := z1.CloneAs();
      Result += z2;
    end;
    
    class function operator-(z1, z2: TComplex): TComplex;
    begin
      Result := z1.CloneAs();
      Result -= z2;
    end;
    
    class function operator*(z1, z2: TComplex): TComplex;
    begin
      Result := z1.CloneAs();
      Result *= z2;
    end;
    
    class function operator/(z1, z2: TComplex): TComplex;
    begin
      Result := z1.CloneAs();
      Result /= z2;
    end;
    
    class function operator=(z1, z2: TComplex) := z1.Equals(z2);
    
    class function operator<>(z1, z2: TComplex) := not (z1 = z2);
    
    function ToString() := Format('Complex = {0} + i({1})', _X, _Y);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var Z1 := new TComplex(1, 3);
  var Z2 := new TComplex(5, -2);
  Z1.Println();
  Z2.Println();
  (Z1 * Z2).Println();
end.

Класс матрицы

[править]
type
  InvalidSizeException = class(Exception)
  end;

type
  TMatrix = class(System.ICloneable, System.IEquatable<TMatrix>)
  private 
    _A: array [,] of real;
    _RowsCount, _ColsCount: integer;
    
    procedure TryRaiseInvalidSizeException(v: integer);
    begin
      if v <= 0 then
        raise new InvalidSizeException('Недопустимое значение.');
    end;
    
    function GetItem(i, j: int64) := _A[i, j];
    
    procedure SetItem(i, j: int64; v: real) := _A[i, j] := v;
    
    procedure Resize() := SetLength(_A, _RowsCount, _ColsCount);
    
    procedure SetRowsCount(v: integer);
    begin
      TryRaiseInvalidSizeException(v);
      _RowsCount := v;
      Resize();
    end;
    
    procedure SetColCount(v: integer);
    begin
      TryRaiseInvalidSizeException(v);
      _ColsCount := v;
      Resize();
    end;
  
  public 
    property Items[i, j: int64]: real read GetItem write SetItem;default;
    property RowsCount: integer read _RowsCount write SetRowsCount;
    property ColsCount: integer read _ColsCount write SetColCount;
    
    constructor(rCount: integer := 3; cCount: integer := 3);
    begin
      RowsCount := rCount;
      ColsCount := cCount;
      Resize();
    end;
    
    function Add(k: integer): TMatrix;
    begin
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to Pred(_ColsCount) do
          _A[i, j] += k;
      Result := self;
    end;
    
    function Subtract(k: integer) := Add(-k);
    
    function Multiply(k: integer): TMatrix;
    begin
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to Pred(_ColsCount) do
          _A[i, j] *= k;
      Result := self;
    end;
    
    function Divide(k: integer): TMatrix;
    begin
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to Pred(_ColsCount) do
          _A[i, j] /= k;
      Result := self;
    end;
    
    function ToZero(): TMatrix; // Заполняет матрицу нулями и возвращает ссылку на нее.
    begin
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to Pred(_ColsCount) do
          _A[i, j] := 0;
      Result := self;
    end;
    
    function ToUnitMatrix(): TMatrix; // Возвращает единичную матрицу.
    begin
      ToZero();
      for var i := 0 to Pred(_RowsCount) do
        _A[i, i] := 1;
      Result := self;
    end;
    
    function Transpose(): TMatrix; // Транспонирует матрицу.
    begin
      Result := new TMatrix(_ColsCount, _RowsCount);
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to Pred(_ColsCount) do
          Result[j, i] := _A[i, j];
    end;
    
    function Resize(k: integer): TMatrix; // Изменяет размер матрицы, сохраняя отношение RowsCount / ColsCount.
    begin
      TryRaiseInvalidSizeException(k);
      _RowsCount *= k;
      _ColsCount *= k;
      Result := self;
    end;
    
    function Shuffle(): TMatrix;
    begin
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to _ColsCount - 2 do
          Swap(_A[i, j], _A[i, Random(Succ(j), Pred(_ColsCount))]);
      Result := self;
    end;
    
    function AlgebraicComplement(i, j: integer): (integer, TMatrix); // Вычисляет алгебраическое дополнение и возвращает его в виде кортежа вида (integer, TMatrix).
    begin
      var outcome := new TMatrix(Pred(_RowsCount), Pred(_ColsCount));
      for var i1 := 0 to Pred(_RowsCount) do
        for var j1 := 0 to Pred(_ColsCount) do
          if (i1 <> i) and (j1 <> j) then
          begin
            var i2 := i1 - 1 * Ord(i1 > i);
            var j2 := j1 - 1 * Ord(j1 > j);
            outcome[i2, j2] := _A[i1, j1];
          end;
      Result := (1 - 2 * Ord((i + j) mod 2 <> 0), outcome);
    end;
    
    function Clone(): object;
    begin
      var outcome := new TMatrix(_RowsCount, _ColsCount);
      for var i := 0 to Pred(_RowsCount) do
        for var j := 0 to Pred(_ColsCount) do
          outcome[i, j] := _A[i, j];
      Result := outcome;
    end;
    
    function CloneAs() := TMatrix(Clone());
    
    function Equals(m: TMatrix): boolean;
    begin
      if (_RowsCount <> m.RowsCount) or (_ColsCount <> m.ColsCount) then
        raise new System.InvalidOperationException('Матрицы имеют различные размеры.');
      
      Result := true;
      for var i := 0 to Pred(_RowsCount) do
      begin
        for var j := 0 to Pred(_ColsCount) do
          if _A[i, j] <> m[i, j] then
          begin
            Result := false;
            break;
          end;
        if not Result then break;
      end;
    end;
    
    class function Readln(rCount, cCount: integer): TMatrix;
    begin
      Result := new TMatrix(rCount, cCount);
      for var i := 0 to Pred(rCount) do
        for var j := 0 to Pred(cCount) do
          Result[i, j] := ReadlnInteger(Format('Value ({0}, {1}):', Succ(i), Succ(j)));;
    end;
    
    class procedure operator+=(m: TMatrix; k: integer) := m.Add(k);
    
    class procedure operator-=(m: TMatrix; k: integer) := m.Subtract(k);
    
    class procedure operator*=(m: TMatrix; k: integer) := m.Multiply(k);
    
    class procedure operator/=(m: TMatrix; k: integer) := m.Divide(k);
    
    class function operator+(m: TMatrix; k: integer): TMatrix;
    begin
      Result := m.CloneAs();
      Result += k;
    end;
    
    class function operator-(m: TMatrix; k: integer) := m + (-k);
    
    class function operator*(m: TMatrix; k: integer): TMatrix;
    begin
      Result := m.CloneAs();
      Result *= k;
    end;
    
    class function operator/(m: TMatrix; k: integer): TMatrix;
    begin
      Result := m.CloneAs();
      Result /= k;
    end;
    
    class function operator*(m1, m2: TMatrix): TMatrix; // Возвращает результат умножения матриц.
    begin
      Result := new TMatrix(m1.RowsCount, m2.ColsCount);
      for var i := 0 to Pred(Result.RowsCount) do
        for var j := 0 to Pred(Result.ColsCount) do
          for var k := 0 to Pred(Result.RowsCount) do
            Result[i, j] += m1[i, k] + m2[k, j];
    end;
    
    class function operator-(m: TMatrix) := m * (-1);
    
    class function operator=(m1, m2: TMatrix) := m1.Equals(m2);
    
    class function operator<>(m1, m2: TMatrix) := not (m1 = m2);
    
    function ToString() := Format('Matrix {0}x{1}', _RowsCount, _ColsCount);
    
    function Print(): TMatrix;
    begin
      Write(ToString());
      Result := self;
    end;
    
    function Println(): TMatrix;
    begin
      Result := Print();
      Write();
    end;
    
    function WritelnMatrix(width: integer := 4): TMatrix; // Выводит содержимое матрицы.
    begin
      for var i := 0 to Pred(_RowsCount) do
      begin
        for var j := 0 to Pred(_ColsCount) do
          Write(_A[i, j]:width);
        Writeln();
      end;
      Result := self;
    end;
  end;

begin
  TMatrix.Readln(ReadlnInteger('Rows count 1:'), ReadlnInteger('Cols count 1:')).WritelnMatrix();
end.

Методы расширения

[править]
function First(self: TMatrix): real; extensionmethod;
begin
  Result := self[0, 0];
end;

function Last(self: TMatrix): real; extensionmethod;
begin
  Result := self[Pred(self.RowsCount), Pred(self.ColsCount)];
end;

function Min(self: TMatrix): real; extensionmethod;
begin
  Result := integer.MaxValue;
  for var i := 0 to Pred(self.RowsCount) do
    for var j := 0 to Pred(self.ColsCount) do
      if self[i, j] < Result then
        Result := self[i, j];
end;

function Max(self: TMatrix): real; extensionmethod;
begin
  Result := integer.MinValue;
  for var i := 0 to Pred(self.RowsCount) do
    for var j := 0 to Pred(self.ColsCount) do
      if self[i, j] > Result then
        Result := self[i, j];
end;

function Average(self: TMatrix): real; extensionmethod; // Возвращает среднее значение элементов матрицы.
begin
  for var i := 0 to Pred(self.RowsCount) do
    for var j := 0 to Pred(self.ColsCount) do
      Result += self[i, j];
  Result /= self.RowsCount * self.ColsCount;
end;

function Cartesian(self, m: TMatrix): sequence of (real, real); extensionmethod; // Возвращает декартово произведение двух матриц в виде кортежей вида (integer, integer).
begin
  for var i := 0 to Pred(self.RowsCount) do
    for var j := 0 to Pred(self.ColsCount) do
      for var i1 := 0 to Pred(m.RowsCount) do
        for var j1 := 0 to Pred(m.ColsCount) do
          yield (self[i, j], m[i1, j1]);
end;

function SwapRows(self: TMatrix; i1, i2: integer): TMatrix; extensionmethod;
begin
  for var j := 0 to Pred(self.ColsCount) do
  begin
    var c := self[i1, j];
    self[i1, j] := self[i2, j];
    self[i2, j] := c;
  end;
  Result := self;
end;

function SwapCols(self: TMatrix; j1, j2: integer): TMatrix; extensionmethod;
begin
  for var i := 0 to Pred(self.RowsCount) do
  begin
    var c := self[i, j1];
    self[i, j1] := self[i, j2];
    self[i, j2] := c;
  end;
  Result := self;
end;

function SwapRowsSucc(self: TMatrix; i: integer): TMatrix; extensionmethod;
begin
  Result := self.SwapRows(i, Succ(i));
end;

function SwapRowsPred(self: TMatrix; i: integer): TMatrix; extensionmethod;
begin
  Result := self.SwapRows(i, Pred(i));
end;

function SwapColsSucc(self: TMatrix; j: integer): TMatrix; extensionmethod;
begin
  Result := self.SwapCols(j, Succ(j));
end;

function SwapColsPred(self: TMatrix; j: integer): TMatrix; extensionmethod;
begin
  Result := self.SwapCols(j, Pred(j));
end;

function InsertRow(self: TMatrix; row: array of real; i: integer): TMatrix; extensionmethod;
begin
  if row.Length <> self.ColsCount then
    raise new Exception('Длина массива не равна количеству столбцов.');
  
  self.RowsCount += 1;
  
  for var i1 := self.RowsCount - 2 downto i do
    self.SwapRowsSucc(i1);
  
  for var j := 0 to Pred(self.ColsCount) do
    self[i, j] := row[j];
  Result := self;
end;

function InsertCol(self: TMatrix; col: array of real; j: integer): TMatrix; extensionmethod;
begin
  if col.Length <> self.RowsCount then
    raise new Exception('Длина массива не равна количеству строк.');
  
  self.ColsCount += 1;
  
  for var j1 := self.ColsCount - 2 downto j do
    self.SwapColsSucc(j1);
  
  for var i := 0 to Pred(self.RowsCount) do
    self[i, j] := col[i];
  Result := self;
end;

Преобразования на плоскости

[править]

Класс линейного оператора

[править]
type
  TTransformFunc = function(x: real): real; // Тип функции преобразования.
  TLinearOperatorMatrix2D = class
  private 
    _A, _B, _C, _D: real;
  
  public 
    property A: real read _A write _A;
    property B: real read _B write _B;
    property C: real read _C write _C;
    property D: real read _D write _D;
    
    constructor(vi, vj: TVector2D; xF, yF: TTransformFunc);
    begin
      _A := xF(vi.X);_C := yF(vi.Y);
      _B := xF(vj.X);_D := yF(vj.Y);
    end;
    
    constructor(va, vb, vc, vd: real);
    begin
      _A := va;_B := vb;
      _C := vc;_D := vd;
    end;
    
    class function ScaleOperator(k: integer) := new TLinearOperatorMatrix2D(k, 0, 0, k); // Возвращает оператор масштабирования.
    
    class function BiasOperator() := new TLinearOperatorMatrix2D(1, 1, 0, 1); // Возвращает оператор сдвига плоскости.
    
    function ApplyToVector(v: TVector2D) := new TVector2D(v.X * _A + v.Y * _B, v.X * _C + v.Y * _D); // Применяет преобразование к вектору.
    
    function ToString() := Format('{0}, {1}; {2}, {3}', _A, _B, _C, _D);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var Op := TLinearOperatorMatrix2D.ScaleOperator(3);
  Op.Println();
  Op.ApplyToVector(new TVector2D(2, 2)).Println();
end.

Что такое линейный оператор?

Структуры данных для графики

[править]

Класс цвета

[править]
type
  TColor = class(System.ICloneable, System.IEquatable<TColor>)
  private 
    _R, _G, _B: byte;
  
    function RandomFromPair(v1, v2: byte): byte;
    begin
      Result := v1;
      if Random(100) mod 2 = 0 then
        Result := v2;
    end;
    
  public 
    property R: byte read _R write _R;
    property G: byte read _G write _G;
    property B: byte read _B write _B;
    
    constructor(r_, g_, b_: byte);
    begin
      R := r_;
      G := g_;
      B := b_;
    end;
    
    procedure Add(c1: TColor);
    begin
      (_R, _G, _B) := (_R + c1.R, _G + c1.G, _B + c1.B);
    end;
    
    procedure Subtract(c1: TColor);
    begin
      (_R, _G, _B) := (_R - c1.R, _G - c1.G, _B - c1.B);
    end;
    
    procedure Multiply(c1: TColor);
    begin
      (_R, _G, _B) := (_R * c1.R, _G * c1.G, _B * c1.B);
    end;
    
    procedure Divide(c1: TColor);
    begin
      (_R, _G, _B) := (_R div c1.R, _G div c1.G, _B div c1.B);
    end;
    
    procedure &Mod(c1: TColor);
    begin
      (_R, _G, _B) := (_R mod c1.R, _G mod c1.G, _B mod c1.B);
    end;
    
    procedure Darken(c1: TColor);
    begin
      (_R, _G, _B) := (Min(_R, c1.R), Min(_G, c1.G), Min(_B, c1.B));
    end;
    
    procedure Brighten(c1: TColor);
    begin
      (_R, _G, _B) := (Max(_R, c1.R), Max(_G, c1.G), Max(_B, c1.B));
    end;
    
    procedure RandomFrom(c1: TColor);
    begin
      (_R, _G, _B) := (RandomFromPair(_R, c1.R), RandomFromPair(_G, c1.G), RandomFromPair(_B, c1.B));
    end;
    
    procedure Invert();
    begin
      (_R, _G, _B) := (255 - _R, 255 - _G, 255 - _B);
    end;
    
    function Clone(): object := new TColor(_R, _G, _B);
    
    function CloneAs() := TColor(Clone());
    
    function Equals(c: TColor) := (_R = c.R) and (_G = c.G) and (_B = c.B);
    
    class function Readln() := new TColor(ReadlnInteger('R:'), ReadlnInteger('G:'), ReadlnInteger('B:'));
    
    class procedure operator+=(c1, c2: TColor) := c1.Add(c2);
    
    class procedure operator-=(c1, c2: TColor) := c1.Subtract(c2);
    
    class procedure operator*=(c1, c2: TColor) := c1.Multiply(c2);
    
    class function operator+(c1, c2: TColor): TColor;
    begin
      Result := c1.CloneAs();
      Result.Add(c2);
    end;
    
    class function operator-(c1, c2: TColor): TColor;
    begin
      Result := c1.CloneAs();
      Result.Subtract(c2);
    end;
    
    class function operator*(c1, c2: TColor): TColor;
    begin
      Result := c1.CloneAs();
      Result.Multiply(c2);
    end;
    
    class function operator div(c1, c2: TColor): TColor;
    begin
      Result := c1.CloneAs();
      Result.Divide(c2);
    end;
    
    class function operator mod(c1, c2: TColor): TColor;
    begin
      Result := c1.CloneAs();
      Result.Mod(c2);
    end;
    
    class function operator-(c1: TColor): TColor;
    begin
      Result := c1.CloneAs();
      Result.Invert();
    end;
    
    class function operator=(c1, c2: TColor) := c1.Equals(c2);
    
    class function operator<>(c1, c2: TColor) := not (c1 = c2);
    
    function ToString() := Format('Color({0}, {1}, {2})', _R, _G, _B);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  (-(new TColor(155, 10, 10) + new TColor(55, 50, 10))).Println();
end.

Класс черепашки

[править]
uses GraphABC;
type
  TTurtle = class(System.ICloneable)
  private 
    _SavedX, _SavedY: real;
    _CoordinatesAreSaved: boolean;
    
    _SavedAngle: real;
    _AngleIsSaved: boolean;
    
    _X, _Y: real;
    _Step: real;
    _MustDraw: boolean;
    _Angle: real;
    
    procedure TurtleLine(x1, y1, x2, y2: real);
    begin
      if _MustDraw then
        Line(Round(x1), Round(y1), Round(x2), Round(y2));
    end;
  
  public 
    property X: real read _X; // X координата черепашки
    property Y: real read _Y; // Y координата черепашки
    property Step: real read _Step write _Step; // Длина одного шага
    property MustDraw: boolean read _MustDraw write _MustDraw; // Рисовать ли отрезки
    property Angle: real read _Angle; // Угол поворота
    property CoordinatesAreSaved: boolean read _CoordinatesAreSaved;
    property AngleIsSaved: boolean read _AngleIsSaved;
    
    constructor(a: real := 90; s: real := 50);
    begin
      _Angle := a;
      _X := Window.Width / 2;
      _Y := Window.Height / 2;
      Step := s;
      MustDraw := true;
    end;
    
    procedure DecAngle(rotation: real) := _Angle -= rotation;
    
    procedure IncAngle(rotation: real) := _Angle += rotation;
    
    procedure MoveForward(); // Выполняет смещение вперед.
    begin
      var ang := DegToRad(_Angle);
      var (x1, y1) := (_X + _Step * Cos(ang), _Y + _Step * Sin(ang));
      TurtleLine(_X, _Y, x1, y1);
      (_X, _Y) := (x1, y1);
    end;
    
    procedure MoveBackward(); // Выполняет смещение назад.
    begin
      var ang := DegToRad(_Angle);
      var (x1, y1) := (_X - _Step * Cos(ang), _Y - _Step * Sin(ang));
      TurtleLine(_X, _Y, x1, y1);
      (_X, _Y) := (x1, y1);
    end;
    
    procedure MoveTo(cx, cy: real);
    begin
      (_X, _Y) := (cx, cy);
    end;
    
    procedure SaveCoordinates(); // Сохраняет координаты
    begin
      _CoordinatesAreSaved := true;
      (_SavedX, _SavedY) := (_X, _Y);
    end;
    
    function LoadCoordinates(): boolean; // Загружает сохраненные координаты
    begin
      if not _CoordinatesAreSaved then exit;
      (_X, _Y) := (_SavedX, _SavedY);
      Result := _CoordinatesAreSaved;
    end;
    
    procedure ClearSavedCoordinates() := _CoordinatesAreSaved := false; // Отменяет сохранение координат
    
    procedure SaveAngle(); // Сохраняет угол поворота
    begin
      _AngleIsSaved := true;
      _SavedAngle := _Angle;
    end;
    
    function LoadAngle(): boolean; // Загружает сохраненный угол
    begin
      if _AngleIsSaved then
        _Angle := _SavedAngle;
      Result := _AngleIsSaved;
    end;
    
    procedure ClearSavedAngle() := _AngleIsSaved := false; // Отменяет сохранение угла
    
    function Clone(): object;
    begin
      var outcome := new TTurtle(_Angle, _Step);
      outcome.MoveTo(_X, _Y);
      outcome.MustDraw := _MustDraw;
      Result := outcome;
    end;
    
    function CloneAs() := TTurtle(Clone());
    
    function ToString() := Format('Motion vector: ({0}, {1})', _X, _Y);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;

begin
  var T := new TTurtle(45);
  T.MoveForward();
  T.DecAngle(45);
  T.MoveForward();
end.

Ссылки

[править]

Динамические структуры данных