Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / MinimizeNameFast / 24 сообщений из 24, страница 1 из 1
08.05.2019, 23:16
    #39811584
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
Вкратце, в 12 секунд выигрыш при сортировке файлов у меня в программе


Писалось для 64 битной платформы, быстрее в 2.3 - 2.5 раза, самые лучшие результаты fast - 1,025. Для стандартной 2,318
Ну а для 32 битного приложения fast - 1,005 для той 1,969


Если нужно будет быстренько продрать 1000000 миллионов путей, то fast выдаст 9,983 когда стандартная 18,995 на 64 к слову 9,926 - 21,871

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math, Vcl.FileCtrl, StrUtils;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

function MinimizeNameFast(const Filename: string; const Canvas: TCanvas; const MaxLen: Integer;
  const Step: string = '...'): string;
var
  Return: string;
  S: TSize;
  I, LenStr, Offset, ResultLen: Integer;
  StrCurr: PChar;
begin
  Result := '';
  if Canvas.TextWidth(Filename) <= MaxLen then
    Exit(Filename);

  I := Pos(':', Filename);

  case Filename[I + 1] of
    '\', '/': Inc(I);
  end;

  Offset := Length(Step);

  ResultLen := I + Offset;

  SetLength(Return, ResultLen);

  ResultLen := 1;
  if I > 0 then
  begin
    Move(Filename[1], Return[ResultLen], I * SizeOf(Char));
    Inc(ResultLen, I);
  end;

  Move(Step[1], Return[ResultLen], Offset * SizeOf(Char));
  Inc(ResultLen, Offset);

  LenStr := Length(Filename);
  I := LenStr;

  StrCurr := PChar(Pointer(Filename));
  Inc(StrCurr, LenStr);

  repeat
    case StrCurr^ of
      '\', '/':
        begin
          Offset := LenStr - I;
          SetLength(Return, ResultLen + Offset - 1);
          Move(StrCurr^, Return[ResultLen], Offset * SizeOf(Char));

          if Canvas.TextWidth(Return) > MaxLen then
            if Result = '' then
              Exit(Return)
            else
              Exit;
          Result := Return;
        end;
    end;
    Dec(I);
    Dec(StrCurr);
  until Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);

  Result := Filename;
end;

const
  Str: array [0 .. 6] of string = ('ger.exe', 'c:\DIR11111\DIR2\DIR3\DIR4\DIR5\DIR6\DIR7\5675.exe',
    'g:\erhrthrthrth\rthy5r6y95\erpogkeokgr\erger.exe',
    't:\095t904i59045derghrth\erthr45hy45y\4.exe',
    '\rthrtyrtjrj\rthrthrthrthrth\45y45y45y45y45y.exe',
    'ioptrhr\rthjtyjtyjtyj\4otykotyj\ftrjtyjtyjty.exe',
    'rthgtyjtyjtdyjtyjtyjtkry67ki6ryjktyyukyfukytukyukyfrkyukyukyukyukrth.exe');

procedure TForm2.FormCreate(Sender: TObject);
  procedure TestMinimizeNameFast(T: TCanvas; C: Integer);
  var
    Fr, T1, T2: Int64;
    Dt: Extended;
    I: Integer;
    S: string;
  begin
    QueryPerformanceFrequency(Fr);
    QueryPerformanceCounter(T1);
    for I := 0 to C do
      for S in Str do
        MinimizeNameFast(S, T, RandomRange(80, 160));
    QueryPerformanceCounter(T2);
    Dt := (T2 - T1) / Fr;
    Memo1.Lines.Add('Fast Время выполнения в секундах: ' + FloatToStr(Dt));
  end;

  procedure TestMinimizeName(T: TCanvas; C: Integer);
  var
    Fr, T1, T2: Int64;
    Dt: Extended;
    I: Integer;
    S: string;
  begin
    QueryPerformanceFrequency(Fr);
    QueryPerformanceCounter(T1);
    for I := 0 to C do
      for S in Str do
        MinimizeName(S, T, RandomRange(80, 160));
    QueryPerformanceCounter(T2);
    Dt := (T2 - T1) / Fr;
    Memo1.Lines.Add('turtle Время выполнения в секундах: ' + FloatToStr(Dt));
  end;

var
  S, R1, R2, Res: string;
  T: TCanvas;
  I, R: Integer;
begin
  Memo1.Lines.Clear;
  Memo1.ScrollBars := SsBoth;
  T := Label1.Canvas;
  TestMinimizeNameFast(T, 1000000);
  TestMinimizeName(T, 1000000);

  for R := 0 to 5 do
  begin
    Memo1.Lines.Add('-------------------');
    for S in Str do
    begin
      I := RandomRange(80, 160);
      R1 := MinimizeNameFast(S, T, I);
      R2 := MinimizeName(S, T, I);

      Res := '[' + T.TextWidth(R1).ToString;
      Res := Res + ' - ' + T.TextWidth(R2).ToString;
      Res := Res + '] max (' + I.ToString + ') "' + R1 + '" > - < "' + R2 + '"';

      Memo1.Lines.Add(Res);
    end;
  end;
end;

end.




Выигрыш обусловлен тем, что стандартная функция постоянно то добавляет \...\ то удаляет.
...
Рейтинг: 0 / 0
09.05.2019, 18:04
    #39811719
white_nigger
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
Озвучьте изначальную задачу. Причем тут сортировка и эта потенциально глючная поделка?
...
Рейтинг: 0 / 0
13.05.2019, 18:08
    #39812626
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
white_nigger,

так вывести файлики которые сейчас проходят обработку.

И она совершенно не глючная. Она работает как для путей с \ так и / ломанных. И работает точно так же. Конечно же если не давать ей кушать в край неверные пути. Но это и не будет.
...
Рейтинг: 0 / 0
13.05.2019, 18:11
    #39812627
Квейд
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
...
Рейтинг: 0 / 0
13.05.2019, 19:03
    #39812647
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
shonli95И она совершенно не глючная.shonli95
Код: pascal
1.
until Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);

Это как минимум

Вот второй багshonli95
Код: pascal
1.
StrCurr := PChar(Pointer(Filename));



Дальше не смотрел
...
Рейтинг: 0 / 0
14.05.2019, 08:26
    #39812761
X11
X11
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
shonli95быстренько продрать 1000000 миллионов путей
миллион миллионов?
...
Рейтинг: 0 / 0
14.05.2019, 09:24
    #39812795
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
_Vasilisk_,

Хде баг? Ко - ко - ко.
Код: pascal
1.
2.
Unit2.pas.64: StrCurr := PChar(Pointer(Filename));
005D35E2 8BDF             mov ebx,edi






Я вижу что он присвоил адрес Filename в ebx

Потом он делает
Код: pascal
1.
2.
Unit2.pas.84: Dec(StrCurr);
005D365D 83EB02           sub ebx,$02



И естественно сверяет
Код: pascal
1.
2.
3.
Unit2.pas.85: until Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);
005D3660 3BFB             cmp edi,ebx
005D3662 7287             jb $005d35eb



И если мы проверим конец функции
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Unit2.pas.88: end;
005D366E 33C0             xor eax,eax
005D3670 5A               pop edx
005D3671 59               pop ecx
005D3672 59               pop ecx
005D3673 648910           mov fs:[eax],edx
005D3676 688B365D00       push $005d368b
005D367B 8D45FC           lea eax,[ebp-$04] // Тут он чистит const Filename: string; 
005D367E E81566E3FF       call @UStrClr
005D3683 C3               ret 
005D3684 E92B5CE3FF       jmp @HandleFinally
005D3689 EBF0             jmp $005d367b
005D368B 5F               pop edi
005D368C 5E               pop esi
005D368D 5B               pop ebx
005D368E 8BE5             mov esp,ebp
005D3690 5D               pop ebp
005D3691 C20800           ret $0008



То убедимся что там нет очистки ebx и это простой адрес, если бы это было Integer и так далее
...
Рейтинг: 0 / 0
14.05.2019, 09:26
    #39812796
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
X11shonli95быстренько продрать 1000000 миллионов путей
миллион миллионов?

Ага, 5000000 миллионов. Но это погрешность в быстром фильтре
...
Рейтинг: 0 / 0
14.05.2019, 09:29
    #39812797
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
_Vasilisk_,

Даже если сделать так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
          if Canvas.TextWidth(Return) > MaxLen then
          begin
            StrCurr := nil;
            if Result = '' then
              Exit(Return)
            else
              Exit;
          end;



То компилятор вырежет StrCurr := nil.
...
Рейтинг: 0 / 0
14.05.2019, 09:55
    #39812811
asutp2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
shonli95_Vasilisk_,

Хде баг? Ко - ко - ко.


как минимум для начала:

1. Cardinal represents a subset of the natural numbers. The range for the Cardinal type is from 0 through 4294967295.
The size of Cardinal is 32 bits across all 64-bit and 32-bit platforms.

2. The size of a pointer depends on the operating system and/or the processor. On 32-bit platforms, a pointer is stored on 4 bytes as a 32-bit address. On 64-bit platforms, a pointer is stored on 8 bytes as a 64-bit address

после этого смотрим код:
Код: pascal
1.
until Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);



Так что иди кукарекай дальше
...
Рейтинг: 0 / 0
14.05.2019, 11:51
    #39812890
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
asutp2,

Там не нужен NativeUInt потому как
Код: pascal
1.
Dec(StrCurr);



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

Так как округление всегда будет ровно главной строке в любом случае. И это не даст санкционировать баг.

Ещё проще говоря

Код: pascal
1.
2.
3.
4.
5.
Unit2.pas.88: until Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);
00000000006B2872 488B4528         mov rax,[rbp+$28]
00000000006B2876 413BC6           cmp eax,r14d
00000000006B2879 48894528         mov [rbp+$28],rax
00000000006B287D 0F8261FFFFFF     jb MinimizeNameFast + $144




Код: pascal
1.
2.
3.
4.
5.
Unit2.pas.88: until NativeUInt (Pointer(Filename)) >= NativeUInt (StrCurr);
00000000006B2872 488B4528         mov rax,[rbp+$28]
00000000006B2876 493BC6           cmp rax,r14
00000000006B2879 48894528         mov [rbp+$28],rax
00000000006B287D 0F8261FFFFFF     jb MinimizeNameFast + $144




Из этого следует, что он сгенерирует одинаковый код

И бага никакого не существует
...
Рейтинг: 0 / 0
14.05.2019, 11:53
    #39812892
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
Я то думал что эти азы все знают. Но я ошибался.
...
Рейтинг: 0 / 0
14.05.2019, 12:08
    #39812908
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
shonli95asutp2,
Ещё проще говоря

Код: pascal
1.
00000000006B2876 413BC6           cmp eax,r14d

Код: pascal
1.
00000000006B2876 493BC6           cmp rax,r14


Из этого следует, что он сгенерирует одинаковый код

Тебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?
...
Рейтинг: 0 / 0
14.05.2019, 12:11
    #39812911
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
shonli95_Vasilisk_,

Хде баг? Ко - ко - ко.
Код: pascal
1.
2.
Unit2.pas.64: StrCurr := PChar(Pointer(Filename));
005D35E2 8BDF             mov ebx,edi


Я вижу что он присвоил адрес Filename в ebx

Что будет, если FileName = '' ?
...
Рейтинг: 0 / 0
14.05.2019, 12:12
    #39812912
Квейд
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
_Vasilisk_Вот второй багshonli95
Код: pascal
1.
StrCurr := PChar(Pointer(Filename));




Это не баг, так можно делать.

Во избежание "лишнего" вызова _UStrToPWChar
...
Рейтинг: 0 / 0
14.05.2019, 12:13
    #39812914
Квейд
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
alekcvpshonli95_Vasilisk_,

Хде баг? Ко - ко - ко.
Код: pascal
1.
2.
Unit2.pas.64: StrCurr := PChar(Pointer(Filename));
005D35E2 8BDF             mov ebx,edi


Я вижу что он присвоил адрес Filename в ebx

Что будет, если FileName = '' ?

Будет StrCurr = nil
...
Рейтинг: 0 / 0
14.05.2019, 12:21
    #39812922
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
КвейдЭто не баг, так можно делать.
Во избежание "лишнего" вызова _UStrToPWChar
Так можно делать, если ты на 100% уверен что строка не пустая (или проверяешь это дальше).

Квейдalekcvpпропущено...
Что будет, если FileName = '' ?
Будет StrCurr = nil
Правильно, а что, после этого, у нас будет вот здесь?
Код: pascal
1.
2.
case StrCurr^ of
      '\', '/':
...
Рейтинг: 0 / 0
14.05.2019, 12:27
    #39812924
Квейд
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
alekcvpКвейдЭто не баг, так можно делать.
Во избежание "лишнего" вызова _UStrToPWChar
Так можно делать, если ты на 100% уверен что строка не пустая (или проверяешь это дальше).

Квейдпропущено...

Будет StrCurr = nil
Правильно, а что, после этого, у нас будет вот здесь?
Код: pascal
1.
2.
case StrCurr^ of
      '\', '/':

это к автору :)
...
Рейтинг: 0 / 0
14.05.2019, 12:27
    #39812926
asutp2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
alekcvpshonli95asutp2,
Ещё проще говоря

Код: pascal
1.
00000000006B2876 413BC6           cmp eax,r14d

Код: pascal
1.
00000000006B2876 493BC6           cmp rax,r14


Из этого следует, что он сгенерирует одинаковый код

Тебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?Его такие мелочи в принципе не смущают)))))
...
Рейтинг: 0 / 0
14.05.2019, 12:31
    #39812932
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
alekcvpТебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?

20 % 15 = 5 так и тут. Я уже описал этот феномен, когда одна строка указывает на другую. В сдучае 15 это SizeOf(X)



alekcvpЧто будет, если FileName = '' ?


Код: pascal
1.
2.
  if Canvas.TextWidth(Filename) <= MaxLen then
    Exit(Filename);





А там где StrCurr^ текущий символ
...
Рейтинг: 0 / 0
14.05.2019, 12:31
    #39812934
shonli95
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
Вы сейчас из мухи слона пытаетесь высосать
...
Рейтинг: 0 / 0
14.05.2019, 12:46
    #39812943
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
shonli95alekcvpТебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?
20 % 15 = 5 так и тут. Я уже описал этот феномен, когда одна строка указывает на другую. В сдучае 15 это SizeOf(X)

Хорошо, покажу на пальцах:
Pointer(FileName) = $00004567FFFFFFF0
Length(FileName) = 32

Имеем:
Код: pascal
1.
2.
StrCurr := PChar(Pointer(Filename));
  Inc(StrCurr, LenStr);

StrCurr = $0000456800000010

Внимание вопрос: чему равно условие?
Код: pascal
1.
Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);


ОтветCardinal($FFFFFFF0) >= Cardinal($00000010) = True! Внезапно!
...
Рейтинг: 0 / 0
14.05.2019, 23:47
    #39813264
white_nigger
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
Да ладно вам. Во вселенной аффтора этот код ошибок не имеет!

PS: Хотя может и догонит со временем...
...
Рейтинг: 0 / 0
15.05.2019, 10:23
    #39813379
Василий 2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
MinimizeNameFast
А всего-то надо привести к PByte
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / MinimizeNameFast / 24 сообщений из 24, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]