This repository has been archived on 2024-12-25. You can view files and clone it, but cannot push or open issues or pull requests.
OldPascalProjects/BlockFileOfT/Сравнение скорости.pas
2024-03-10 20:32:51 +03:00

289 lines
9.7 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

uses BlockFileOfT;
// Эта процедура позволяет копировать память между содержимым массива и другим массивом/стеком
// При этом не волнуясь о блокировках массивов в памяти
// Если элемент массива передан как var-параметр, то сборщик мусора не трогает этот массив
procedure CopyMem<T1,T2>(var o1: T1; var o2: T2; count: integer) :=
System.Buffer.MemoryCopy(
@o1, @o2,
count, count
);
type
StructLayout = System.Runtime.InteropServices.StructLayoutAttribute;
LayoutKind = System.Runtime.InteropServices.LayoutKind;
FieldOffset = System.Runtime.InteropServices.FieldOffsetAttribute;
// Size контролирует размер записи. Его можно не указывать, тогда его выберет автоматически
// В нашем случае нужен один байт для поля length
// А затем место под 255 символов (масимум, который может хранить эта строка)
// При этом каждый символ занимает два байта в памяти
[StructLayout(LayoutKind.&Explicit, Size= 1 + 255*2 )]
ValueString255 = record
public [FieldOffset(0)] length: byte;
public [FieldOffset(1)] body: char;
public const MaxLength = 255;
// operator explicit, принимающий array of char и возвращающий ValueString255 выглядит в коде как:
// var s := ValueString255(a);
// Где тип у "a" — array of char
public static function operator explicit(a: array of char): ValueString255;
begin
Result.length := Min(MaxLength, a.Length); // если a.Length>MaxLength, то length надо обрезать до MaxLength
if Result.length=0 then exit; // иначе упадёт a[0]
CopyMem(a[0], Result.body, Result.length*2); // char занимает два байта, поэтому копируем length*2
end;
public static function operator explicit(s: string): ValueString255;
begin
Result.length := Min(MaxLength, s.Length);
if Result.length=0 then exit;
CopyMem(s[1], Result.body, Result.length*2);
end;
public static function operator explicit(s: ValueString255): array of char;
begin
Result := new char[s.length];
if s.length=0 then exit;
CopyMem(s.body, Result[0], s.length*2);
end;
// объявлять тип CharArr может быть неудобно
public function ToCharArray: array of char;
type CharArr = array of char;
begin
Result := CharArr(self);
end;
public static function operator explicit(s: ValueString255): string :=
new string(@s.body, 0, s.length);
public function ToString: string; override :=
string(self);
end;
///Это будет сохранять в file of T
AR = record
s: string[255];
//dt: DateTime; // Не даёт ¯\_(ツ)_/¯
dt: int64; // Ну и ладно, в System.DateTime всё хранится в одном поле типа int64
i: integer;
ch: char;
b: byte;
end;
///Это будет сохранять в BlockFileOf<T>
BR = record
s: ValueString255;
dt: DateTime; // А BlockFileOf<T> принимает любые размерные типы без ограничений
i: integer;
ch: char;
b: byte;
end;
///Это тип для ввода/вывода
///В нём хранятся входные данные, общие и для file of T, и для BlockFileOf<T>
///Тут же описаны и преобразования всех особых типов
///Заметьте, преобразование string[255] к string и назад ничего не копирует и не преобразовывает, если изначальная строка уже была <= 255 символов
///Поэтому преобразования между ValueString255 и string работают медленнее
///И даже при этом BlockFileOf<T> всё равно быстрее
IOR = record
s: string;
dt: System.DateTime;
i: integer;
ch: char;
b: byte;
static function operator explicit(a: IOR): AR;
begin
Result.s := a.s;
Result.dt := a.dt.Ticks; // Ticks возвращает никак не преобразованное значение единственного внутреннего поля DateTime
Result.i := a.i;
Result.ch := a.ch;
Result.b := a.b;
end;
static function operator explicit(a: IOR): BR;
begin
Result.s := ValueString255(a.s); // вызываем наш operator explicit
Result.dt := a.dt;
Result.i := a.i;
Result.ch := a.ch;
Result.b := a.b;
end;
static function operator explicit(a: AR): IOR;
begin
Result.s := a.s;
Result.dt := new DateTime(a.dt); // Единственный конструктор DateTime принимающий 1 параметр - принимает кол-во тиков. И напрямую присваивает это значение внутреннему полю
Result.i := a.i;
Result.ch := a.ch;
Result.b := a.b;
end;
static function operator explicit(a: BR): IOR;
begin
Result.s := string(a.s);
Result.dt := a.dt;
Result.i := a.i;
Result.ch := a.ch;
Result.b := a.b;
end;
static function GetRandom: IOR;
begin
Result.s := new string(ArrGen(Random(256), i -> ChrAnsi(Random(byte.MaxValue))));
Result.dt := System.DateTime.Now.AddTicks(System.Convert.ToInt64(((Random * 2 - 1) * 1024 * 1024 * 1024 * 1024)));
Result.i := (Random(word.MaxValue) shl 16) + Random(word.MaxValue);
Result.ch := ChrAnsi(Random(byte.MaxValue));
Result.b := Random(256);
end;
public function ToString: string; override :=
$'IOR( s.Length={s.Length}, dt={dt}, i={i}, ch="{ch}", b={b} )';
end;
procedure TestIntegrity1(c: integer);
begin
var f: file of AR;
var test_arr := ArrGen(c, i -> IOR.GetRandom);
Rewrite(f, 'temp.bin');
foreach var a in test_arr.Select(a -> AR(a)) do
f.Write(a);
f.Close;
Reset(f);
var n_test_arr := f.ReadElements.Select(a -> IOR(a)).ToArray;
f.Close;
if not test_arr.SequenceEqual(n_test_arr) then
begin
writeln('тест 1 (file of T) не пройден');
if test_arr.Length <> n_test_arr.Length then
writeln($'len: {test_arr.Length} <> {n_test_arr.Length}') else
for var i := 0 to test_arr.Length - 1 do
if test_arr[i] <> n_test_arr[i] then
begin
writeln($'el:{#10}{test_arr[i]}{#10}{n_test_arr[i]}{#10}');
end;
readln;
exit;
end;
end;
procedure TestIntegrity2(c: integer);
begin
var f := new BlockFileOf<BR>('temp.bin');
var test_arr := ArrGen(c, i -> IOR.GetRandom);
f.Rewrite;
f.Write(test_arr.ConvertAll(a -> BR(a)));
f.Close;
f.Reset;
var n_test_arr := f.Read(f.Size).ConvertAll(a -> IOR(a));
f.Close;
if not test_arr.SequenceEqual(n_test_arr) then
begin
writeln('тест 2 (BlockFileOf<T>) не пройден');
if test_arr.Length <> n_test_arr.Length then
writeln($'len: {test_arr.Length} <> {n_test_arr.Length}') else
for var i := 0 to test_arr.Length - 1 do
if test_arr[i] <> n_test_arr[i] then
begin
writeln($'el:{#10}{test_arr[i]}{#10}{n_test_arr[i]}{#10}');
end;
readln;
exit;
end;
end;
procedure TestIntegrity;
begin
TestIntegrity1(10000);
writeln('тест 1 ok');
TestIntegrity2(10000);
writeln('тест 2 ok');
writeln('тесты ok');
end;
procedure TestSpeed;
begin
var sw := new System.Diagnostics.Stopwatch; // Точнее, чем этим, замерить невозможно
var lc := 10;
var ec := 10000;//Чем больше элементов, тем больше преимущество BlockFileOf<T>, потому что он сохраняет их всех сразу.
//Но он быстрее даже если сохранять по одному элементу
var t1, t2: int64;
var f1: file of AR;
Assign(f1, 'temp.bin');
var f2 := new BlockFileOf<BR>('temp.bin');
while true do
begin
var test_arr := ArrGen(ec, i -> IOR.GetRandom);
sw.Restart;
loop lc do
begin
Rewrite(f1);
var AR_arr := test_arr.ConvertAll(a -> AR(a));
foreach var a in AR_arr do f1.Write(a);
f1.Close;
Reset(f1);
ArrGen(ec, i -> IOR(f1.Read));
f1.Close;
end;
sw.Stop;
t1 += sw.ElapsedTicks;
sw.Restart;
loop lc do
begin
f2.Rewrite;
f2.Write(test_arr.ConvertAll(a -> BR(a)));
f2.Close;
f2.Reset;
f2.Read(ec).ConvertAll(a -> IOR(a));
f2.Close;
end;
sw.Stop;
t2 += sw.ElapsedTicks;
System.GC.Collect;
System.Console.Clear;
writeln($'file of T: {t1}');
writeln($'BlockFile: {t2}');
end;
end;
begin
// Уберите флажок "Debug версия" в "Сервис>>Настройки>>Опции компиляции" и запускайте по Shift+F9, иначе отладка может неравномерно влиять на результаты
// Тест на отсутствие ошибок. Можно убрать
TestIntegrity;
// Тест скорости
// Он бесконечный, чем дольше тестируется - тем более усреднённые, а значит и более точные результаты
TestSpeed;
end.