Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
Вкратце, в 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

+
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.



Выигрыш обусловлен тем, что стандартная функция постоянно то добавляет \...\ то удаляет.
8 май 19, 23:16    [21881555]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 2069
Озвучьте изначальную задачу. Причем тут сортировка и эта потенциально глючная поделка?
9 май 19, 18:04    [21881829]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
white_nigger,

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

И она совершенно не глючная. Она работает как для путей с \ так и / ломанных. И работает точно так же. Конечно же если не давать ей кушать в край неверные пути. Но это и не будет.
13 май 19, 18:08    [21883649]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5208
Cравни с PathCompactPath

https://docs.microsoft.com/en-us/windows/desktop/api/shlwapi/nf-shlwapi-pathcompactpathaw
13 май 19, 18:11    [21883652]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10857
shonli95
И она совершенно не глючная.
shonli95
until Cardinal(Pointer(Filename)) >= Cardinal(StrCurr);
Это как минимум

Вот второй баг
shonli95
StrCurr := PChar(Pointer(Filename));


Дальше не смотрел
13 май 19, 19:03    [21883690]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
X11
Member

Откуда: Kharkiv, Ukraine
Сообщений: 12971
shonli95
быстренько продрать 1000000 миллионов путей

миллион миллионов?
14 май 19, 08:26    [21883996]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
_Vasilisk_,

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





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

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


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


И если мы проверим конец функции
+
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 и так далее
14 май 19, 09:24    [21884052]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
X11
shonli95
быстренько продрать 1000000 миллионов путей

миллион миллионов?


Ага, 5000000 миллионов. Но это погрешность в быстром фильтре
14 май 19, 09:26    [21884054]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
_Vasilisk_,

Даже если сделать так
          if Canvas.TextWidth(Return) > MaxLen then
          begin
            StrCurr := nil;
            if Result = '' then
              Exit(Return)
            else
              Exit;
          end;


То компилятор вырежет StrCurr := nil.
14 май 19, 09:29    [21884055]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 464
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

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


Так что иди кукарекай дальше
14 май 19, 09:55    [21884078]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
asutp2,

Там не нужен NativeUInt потому как
Dec(StrCurr);


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

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

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

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



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



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

И бага никакого не существует
14 май 19, 11:51    [21884218]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
Я то думал что эти азы все знают. Но я ошибался.
14 май 19, 11:53    [21884222]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
alekcvp
Member

Откуда:
Сообщений: 1342
shonli95
asutp2,
Ещё проще говоря

00000000006B2876 413BC6           cmp eax,r14d
00000000006B2876 493BC6           cmp rax,r14

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

Тебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?
14 май 19, 12:08    [21884248]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
alekcvp
Member

Откуда:
Сообщений: 1342
shonli95
_Vasilisk_,

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

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

Что будет, если FileName = '' ?
14 май 19, 12:11    [21884252]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5208
_Vasilisk_
Вот второй баг
shonli95
StrCurr := PChar(Pointer(Filename));



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

Во избежание "лишнего" вызова _UStrToPWChar
14 май 19, 12:12    [21884253]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5208
alekcvp
shonli95
_Vasilisk_,

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

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

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


Будет StrCurr = nil
14 май 19, 12:13    [21884255]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
alekcvp
Member

Откуда:
Сообщений: 1342
Квейд
Это не баг, так можно делать.
Во избежание "лишнего" вызова _UStrToPWChar

Так можно делать, если ты на 100% уверен что строка не пустая (или проверяешь это дальше).

Квейд
alekcvp
пропущено...
Что будет, если FileName = '' ?

Будет StrCurr = nil

Правильно, а что, после этого, у нас будет вот здесь?
case StrCurr^ of
      '\', '/':
14 май 19, 12:21    [21884272]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5208
alekcvp
Квейд
Это не баг, так можно делать.
Во избежание "лишнего" вызова _UStrToPWChar

Так можно делать, если ты на 100% уверен что строка не пустая (или проверяешь это дальше).

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

Будет StrCurr = nil

Правильно, а что, после этого, у нас будет вот здесь?
case StrCurr^ of
      '\', '/':
это к автору :)
14 май 19, 12:27    [21884276]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 464
alekcvp
shonli95
asutp2,
Ещё проще говоря

00000000006B2876 413BC6           cmp eax,r14d
00000000006B2876 493BC6           cmp rax,r14

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

Тебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?
Его такие мелочи в принципе не смущают)))))
14 май 19, 12:27    [21884278]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
alekcvp
Тебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?


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



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



  if Canvas.TextWidth(Filename) <= MaxLen then
    Exit(Filename);




А там где StrCurr^ текущий символ
14 май 19, 12:31    [21884284]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
shonli95
Member

Откуда:
Сообщений: 61
Вы сейчас из мухи слона пытаетесь высосать
14 май 19, 12:31    [21884287]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
alekcvp
Member

Откуда:
Сообщений: 1342
shonli95
alekcvp
Тебя не смущает, что в первом случае 32-битное сравнение, а во втором - 64-битное ?

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

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

Имеем:
StrCurr := PChar(Pointer(Filename));
  Inc(StrCurr, LenStr);
StrCurr = $0000456800000010

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

+ Ответ
Cardinal($FFFFFFF0) >= Cardinal($00000010) = True! Внезапно!
14 май 19, 12:46    [21884302]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 2069
Да ладно вам. Во вселенной аффтора этот код ошибок не имеет! Картинка с другого сайта.
PS: Хотя может и догонит со временем...
14 май 19, 23:47    [21884847]     Ответить | Цитировать Сообщить модератору
 Re: MinimizeNameFast  [new]
Василий 2
Member

Откуда:
Сообщений: 542
А всего-то надо привести к PByte
15 май 19, 10:23    [21885022]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить