Книга программиста/Структуры данных в PascalABC.Net
Внешний вид
(перенаправлено с «Структуры данных в PascalABC.Net»)
Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовалась среда PascalABC.Net 3.0.
Структура кода класса
[править]- Приватные переменные
- Свойства
- Методы
- Clone(), CloneAs(), Readln()
- Классовые методы
- Операторы
- 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.