powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Быстрая замена символа
259 сообщений из 259, показаны все 11 страниц
Быстрая замена символа
    #39676186
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Может, кто подскажет, как ещё быстрее можно...

Начал с такого
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
function FastCommatopoint(s: string): string;
var
  i: Integer;
begin
  Result := s;
  for i := 1 to Length(s) do
    if Result[i] = ',' then
      Result[i] := '.';
end;



Сейчас дошёл до такого
Код: 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.
function UseRepneScasb(s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result

    Mov EDI, [EAX]
    Mov   ECX,[EDI-4]
    Sub ECX, 1

    Mov   AL,COMMA_
    Mov   BL,DOT_

    Cld
@Next:
    repne scasb
    jecxz @Exit
    Mov   [EDI-1],BL
    Jmp   @Next

@Exit:
    Pop  EBX
    Pop  ESI

  end;
end;



Разница
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676191
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
2 секунды - это такие длинные строки или в цикле?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676196
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
wadman2 секунды - это такие длинные строки или в цикле?

Строки - 250 Char
ии 10 млн раз ...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676197
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubwadman2 секунды - это такие длинные строки или в цикле?

Строки - 250 Char
ии 10 млн раз ...
Лучшеб код сравнения, чем словесное описание. Тут все, конечно, джентльмены, но... :)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676203
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А так?
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
procedure FastCommatopoint(var s: string);
var
  i: Integer;
begin
  for i := 1 to Length(s) do
    if s[i] = ',' then
      s[i] := '.';
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676204
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
wadman,
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676211
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

DevEx специально используете?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676212
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
procedure ReplaceChar(const Source, Target: Char; var Str: string);
var
  P: PChar;
  I:Integer;
begin
  Result := Str;
  P := Pointer(Result);
  for i := 0 to Length(Str) - 1 do
  begin
    if P^ = Source then
      P^ := Target;
    Inc(P);
  end;
end;


Сильно отличается от asm варианта?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676213
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
_Vasilisk_А так?
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
procedure FastCommatopoint(var s: string);
var
  i: Integer;
begin
  for i := 1 to Length(s) do
    if s[i] = ',' then
      s[i] := '.';
end;



Так хорошо, но копирование снаружи тогда возникает...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676215
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Василий 2
Код: pascal
1.
2.
3.
4.
5.
6.
procedure ReplaceChar(const Source, Target: Char; var Str: string);
var
  P: PChar;
  I:Integer;
begin
  Result := Str;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676221
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Василий 2
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
procedure ReplaceChar(const Source, Target: Char; var Str: string);
var
  P: PChar;
  I:Integer;
begin
  Result := Str;
  P := Pointer(Result);
  for i := 0 to Length(Str) - 1 do
  begin
    if P^ = Source then
      P^ := Target;
    Inc(P);
  end;
end;


Сильно отличается от asm варианта?

Кстати да, тоже хорошо!
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676223
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

авторrepne scasb

у тебя там ansi строки?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676230
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
makhaon,
Ага, delphi5
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676234
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
_Vasilisk_zinpub,

DevEx специально используете?

А что с ним не так?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676236
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
zinpub_Vasilisk_zinpub,

DevEx специально используете?

А что с ним не так?

Понял, пардон, кидал на форму, что под рукой было.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676374
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Василий 2
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
procedure ReplaceChar(const Source, Target: Char; var Str: string);
var
  P: PChar;
  I:Integer;
begin
  Result := Str;
  P := Pointer(Result);
  for i := 0 to Length(Str) - 1 do
  begin
    if P^ = Source then
      P^ := Target;
    Inc(P);
  end;
end;


Сильно отличается от asm варианта?

Фи
Код: pascal
1.
2.
3.
4.
5.
6.
 while P^ <> nil do 
  begin
    if P^ = Source then
        P^ := Target;
     Inc(P);
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676380
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо
Код: pascal
1.
 while P^ <> nil do 


А если никогда не будет?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676384
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
wadmanА если никогда не будет?Видимо имелось ввиду:
Код: pascal
1.
while P^ <> #0 do 

правда это не сработает в случае строк, которые могут содержать бинарный ноль
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676389
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
На данный момент, самый быстрый вариант такой

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  I: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;



Использование while - ускорения не даёт, и чуть замедляет...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676396
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubИспользование while - ускорения не даёт, и чуть замедляет
ну понятно. нативный loop и должен быть быстрее велосипедного, иначе зачем он нужен.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676409
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да. Там #0 (Прироста нету... Странно ведь!)


Сделал тест на токио. С включённой оптимизацией

Результаты
Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:211
ReplaceCharByPChar   -> 00:00:208
TestMy               -> 00:00:207
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:212
ReplaceCharByPChar   -> 00:00:207
TestMy               -> 00:00:208
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:220
ReplaceCharByPChar   -> 00:00:213
TestMy               -> 00:00:218
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:211
ReplaceCharByPChar   -> 00:00:210
TestMy               -> 00:00:208
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:212
ReplaceCharByPChar   -> 00:00:212
TestMy               -> 00:00:212




Код
Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TCommatFunc = function(s: string): string;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 1000000;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ForkReplaceC_lodsw(s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;

function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: string;
    const iRunTime: TDateTime): string;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: string;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to 50000 - 1 do
    Func(s);

  Result := Now - aStartTime;
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: string;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    if Random(10) > iFactor then
      s := s + ','
    else
      s := s + Chr(40 + Trunc(Random(150)));
  end;

  mmo2.Text := s;

end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(10, 5000);
end;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676411
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вносил правки. И изменил на

Код: pascal
1.
2.
 for i := 0 to 50000 - 1 do
    Func(s);



а так же
Код: pascal
1.
  FillRandomText(10, 5000);
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676414
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоВносил правки. И изменил на

Код: pascal
1.
2.
 for i := 0 to 50000 - 1 do
    Func(s);



а так же
Код: pascal
1.
  FillRandomText(10, 5000);



Factor =10, в FillRandom... Не проставит запятые
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676415
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_Василий 2
Код: pascal
1.
2.
3.
4.
5.
6.
procedure ReplaceChar(const Source, Target: Char; var Str: string);
var
  P: PChar;
  I:Integer;
begin
  Result := Str;


Переделывал из кода, где возвращается копия с замененными символами, остался артефакт
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676423
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Василий 2_Vasilisk_пропущено...

Переделывал из кода, где возвращается копия с замененными символами, остался артефакт

Я её допеределывал, чуууть медленнее асма
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676424
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоФи
Код: pascal
1.
2.
3.
4.
5.
6.
 while P^ <> #0 do 
  begin
    if P^ = Source then
        P^ := Target;
     Inc(P);
  end;


В теории - да, быстрее на один вызов Length. Однако опирается на постулат, что все строки заканчиваются нулевым символом, что, емнип, не документировано. Также не прожуёт строки с нулевым символом внутри (а это, к примеру, способ задания массива строк в WinApi).
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676429
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubЯ её допеределывал, чуууть медленнее асма
Вот и славно :)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676432
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Василий 2ГирлионайльдоФи
Код: pascal
1.
2.
3.
4.
5.
6.
 while P^ <> #0 do 
  begin
    if P^ = Source then
        P^ := Target;
     Inc(P);
  end;


В теории - да, быстрее на один вызов Length. Однако опирается на постулат, что все строки заканчиваются нулевым символом, что, емнип, не документировано. Также не прожуёт строки с нулевым символом внутри (а это, к примеру, способ задания массива строк в WinApi).

Лишнее чтение на каждой итерации
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676433
Фотография Dmitry Arefiev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: pascal
1.
2.
3.
4.
5.
6.
7.
PEnd := P + Length(AStr);
while P < PEnd do 
begin
  if P^ = Source then
    P^ := Target;
  Inc(P);
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676434
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Посмотрите на тесты (Код с низу) Переносы не имеют значения никакого.
Код: sql
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.
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:415
ReplaceCharByPChar   -> 00:00:420
TestMy               -> 00:00:411
Самый быстрый: 3     -> 00:00:411
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:413
ReplaceCharByPChar   -> 00:00:417
TestMy               -> 00:00:412
Самый быстрый: 3     -> 00:00:412
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:416
ReplaceCharByPChar   -> 00:00:414
TestMy               -> 00:00:412
Самый быстрый: 3     -> 00:00:412
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:420
ReplaceCharByPChar   -> 00:00:412
TestMy               -> 00:00:413
Самый быстрый: 2     -> 00:00:412
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:429
ReplaceCharByPChar   -> 00:00:411
TestMy               -> 00:00:411
Самый быстрый: 3     -> 00:00:411



Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TCommatFunc = function(s: string): string;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 1000000;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ForkReplaceC_lodsw(s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;

function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

var
  MinTest: TDateTime;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: string;
    const iRunTime: TDateTime): string;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  MinTest := TDateTime(1000000000);
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + (IdxMin + 1).ToString,
    MinTest));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: string;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to 50000 - 1 do
    Func(s);

  Result := Now - aStartTime;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: string;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    if Random(10) > iFactor then
      s := s + ','
    else
      s := s + Chr(40 + Trunc(Random(150)));
  end;

  mmo2.Text := s;

end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(20, 10000);
end;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676436
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
zinpub,

если строки ансишные, то табличку перекодировки сделай, должно весьма быстро получиться.


Код: 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.
type
  TaRecode = array[Char] of Char;

var
  fRecode: TaRecode;

procedure Init();
var
  c: Char;
begin
  for c := Low(Char) to High(Char) do
    fRecode[c] := c;
  fRecode[','] := '.';
end;

procedure Recode(var str: string; const aRecode : TaRecode);
var
  i: Integer;
begin
  for i := 1 to Length(str) do
    str[i] := aRecode[str[i]];
end;
...
// Использование:
var
  fStr: string;
begin
  Init();
...
  fStr := '123,54';
  Recode(fStr, fRecode);
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676444
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччД__,

Вообще ужассно

Код: sql
1.
2.
3.
4.
5.
6.
7.
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:435
ReplaceCharByPChar   -> 00:00:415
TestMy               -> 00:00:411
PEnd                 -> 00:00:411
Recode               -> 00:02:297
Самый быстрый: 3     -> 00:00:411



Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

  TCommatFunc = function(s: ApString): ApString;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 1000000;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ForkReplaceC_lodsw(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;

function ReplaceCharByPChar(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function PEnd(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

type
  TaRecode = array [ApChar] of ApChar;

var
  fRecode: TaRecode;

procedure Init();
var
  c: ApChar;
begin
  for c := Low(ApChar) to High(ApChar) do
    fRecode[c] := c;
  fRecode[','] := '.';
end;

function Recode(str: ApString): ApString;
var
  i: Integer;
begin
  Result := str;
  for i := 1 to Length(Result) do
    Result[i] := fRecode[Result[i]];
end;

var
  MinTest: TDateTime;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: ApString; const iRunTime: TDateTime)
    : ApString;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  MinTest := TDateTime(1000000000);
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('PEnd', RunFunc(@PEnd)));
  mmo1.Lines.Add(FormatOutput('Recode', RunFunc(@Recode)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + (IdxMin + 1).ToString,
    MinTest));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: ApString;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to 50000 - 1 do
    Func(s);

  Result := Now - aStartTime;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: ApString;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    if Random(10) > iFactor then
      s := s + ','
    else
      s := s + Chr(40 + Trunc(Random(150)));
  end;

  mmo2.Text := s;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Init();
end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(20, 10000);
end;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676448
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
И чего вам эти попугаи покоя не дают ? Или это возвращение великого оптимизатора ?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676451
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоВообще ужассно
Да,, операция записи недешева.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676453
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiИ чего вам эти попугаи покоя не дают ? Или это возвращение великого оптимизатора ?

Самый оптимальный вариант. Быстрее только включить выравнивание на 16. И с помощью SSE инструкций искать маску символа. Прирост в два раза.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
function PEnd(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676487
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоschiИ чего вам эти попугаи покоя не дают ? Или это возвращение великого оптимизатора ?

Самый оптимальный вариант. Быстрее только включить выравнивание на 16. И с помощью SSE инструкций искать маску символа. Прирост в два раза.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
function PEnd(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;



Самый оптимальный вариант - это StringReplace. Дешево, сердито и всем понятно
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676507
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоВообще ужассно

А все символы в исходной строке требуют замену - что быстрее?

А если в множестве заменяемых символов больше одного элемента?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676509
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schi
Самый оптимальный вариант - это StringReplace. Дешево, сердито и всем понятно

Он сначала выделяет 32 элемента в массив, и ищет через pos позиции, записывая их в массив. выделяя его, если нужно.
А потом только, он гуляет по этому массиву, и заменяет в строке нужные позиции


Короткий аналог, без массива

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
function ReplPos(const s: string): string;
label ToDo;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  FoundPos: Integer;
begin
  FoundPos := 1;
  Result := s;
ToDo:
  FoundPos := Pos(COMMA_, Result, FoundPos);
  if FoundPos = 0 then
    Exit;

  Result[FoundPos] := DOT_;
  Inc(FoundPos, 1);
  goto ToDo;
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676513
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоСамый оптимальный вариант
А ничего, что в этом варианте есть сайд эффект - замена символов в исходной строке?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676518
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччД__, если массово заменять. То StringReplace проигрывает, а твоя функция по прежнему выдаёт тоже самое

Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:410
ReplaceCharByPChar   -> 00:00:406
TestMy               -> 00:00:406
PEnd                 -> 00:00:407
StringReplace        -> 00:07:924
Recode               -> 00:02:484
Самый быстрый: 2     -> 00:00:406
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:410
ReplaceCharByPChar   -> 00:00:405
TestMy               -> 00:00:406
PEnd                 -> 00:00:404
StringReplace        -> 00:07:809
Recode               -> 00:02:480
Самый быстрый: 4     -> 00:00:404
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:411
ReplaceCharByPChar   -> 00:00:407
TestMy               -> 00:00:405
PEnd                 -> 00:00:407
StringReplace        -> 00:07:817
Recode               -> 00:02:484
Самый быстрый: 3     -> 00:00:405



код
Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

  TCommatFunc = function(s: ApString): ApString;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    Memo1: TMemo;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 1000000;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ForkReplaceC_lodsw(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;

function ReplaceCharByPChar(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function PEnd(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

type
  TaRecode = array [ApChar] of ApChar;

var
  fRecode: TaRecode;

procedure Init();
var
  c: ApChar;
begin
  for c := Low(ApChar) to High(ApChar) do
    fRecode[c] := c;
  fRecode[','] := '.';
end;

function Recode(str: ApString): ApString;
var
  i: Integer;
begin
  Result := str;
  for i := 1 to Length(Result) do
    Result[i] := fRecode[Result[i]];
end;

function StrReplace(s: ApString): ApString;
begin
  Result := StringReplace(s, ',', '.', [rfReplaceAll]);

end;

var
  MinTest: TDateTime;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: ApString; const iRunTime: TDateTime)
    : ApString;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  MinTest := TDateTime(1000000000);
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('PEnd', RunFunc(@PEnd)));

  mmo1.Lines.Add(FormatOutput('StringReplace', RunFunc(@StrReplace)));

  mmo1.Lines.Add(FormatOutput('Recode', RunFunc(@Recode)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + (IdxMin + 1).ToString,
    MinTest));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: ApString;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to 50000 - 1 do
    Func(s);

  Result := Now - aStartTime;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: ApString;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    s := s + ','
  end;

  mmo2.Text := s;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Init();
end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(20, 10000);
end;

end.



Код: pascal
1.
2.
3.
4.
  for i := 0 to iCharCount do
  begin
    s := s + ','
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676519
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

мы двигаем 1 указатель, который в конце нигде не используется. Думаю что не вызовет порчу памяти
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676523
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдомы двигаем 1 указатель, который в конце нигде не используется. Думаю что не вызовет порчу памяти
Я о том, что у тебя содержимое const s: string; меняется.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676525
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

не доглядел)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676528
haydegen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676530
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдоне доглядел)
Ещё, если хочешь ускориться обрабатывай по несколько символов за итерацию.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676531
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоschiСамый оптимальный вариант - это StringReplace. Дешево, сердито и всем понятно

Он сначала выделяет 32 элемента в массив, и ищет через pos позиции, записывая их в массив. выделяя его, если нужно.
А потом только, он гуляет по этому массиву, и заменяет в строке нужные позиции


Короткий аналог, без массива

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
function ReplPos(const s: string): string;
label ToDo;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  FoundPos: Integer;
begin
  FoundPos := 1;
  Result := s;
ToDo:
  FoundPos := Pos(COMMA_, Result, FoundPos);
  if FoundPos = 0 then
    Exit;

  Result[FoundPos] := DOT_;
  Inc(FoundPos, 1);
  goto ToDo;
end;



"Я понимаю, лет 30-40 назад, при тогдашней стоимости и производительности железа имело смысл минимизировать все и везде, вплоть до оптимизации кода инициализации. Но сейчас смысла в этих попытках столько же, сколько в тщательном измерении длины шага мерина, которого ведут на живодерню (с) Виктор Конецкий

Мне без разницы, занимает утилита 12 килобайт или 10 мебагайт, если она делает то, что мне нужно. "
20472449
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676542
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
schiИ чего вам эти попугаи покоя не дают ? Или это возвращение великого оптимизатора ?

Неет, мне хватает варианта by Vassily2, но ради интереса...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676543
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоПосмотрите на тесты (Код с низу) Переносы не имеют значения никакого.
Код: sql
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.
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:415
ReplaceCharByPChar   -> 00:00:420
TestMy               -> 00:00:411
Самый быстрый: 3     -> 00:00:411
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:413
ReplaceCharByPChar   -> 00:00:417
TestMy               -> 00:00:412
Самый быстрый: 3     -> 00:00:412
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:416
ReplaceCharByPChar   -> 00:00:414
TestMy               -> 00:00:412
Самый быстрый: 3     -> 00:00:412
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:420
ReplaceCharByPChar   -> 00:00:412
TestMy               -> 00:00:413
Самый быстрый: 2     -> 00:00:412
------------------------------------------------------
ForkReplaceC_lodsw   -> 00:00:429
ReplaceCharByPChar   -> 00:00:411
TestMy               -> 00:00:411
Самый быстрый: 3     -> 00:00:411



Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TCommatFunc = function(s: string): string;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 1000000;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ForkReplaceC_lodsw(s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;

function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

var
  MinTest: TDateTime;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: string;
    const iRunTime: TDateTime): string;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  MinTest := TDateTime(1000000000);
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + (IdxMin + 1).ToString,
    MinTest));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: string;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to 50000 - 1 do
    Func(s);

  Result := Now - aStartTime;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: string;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    if Random(10) > iFactor then
      s := s + ','
    else
      s := s + Chr(40 + Trunc(Random(150)));
  end;

  mmo2.Text := s;

end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(20, 10000);
end;

end.



Не переносы, а запятые, которые и надо заменять
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676545
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
чччД__ГирлионайльдоВообще ужассно

А все символы в исходной строке требуют замену - что быстрее?

А если в множестве заменяемых символов больше одного элемента?

Строка от 120 до 370 символов. Запятых от 12 до 67
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676546
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
haydegenГирлионайльдо, добавь https://bitbucket.org/alex7691/delphi/src/master/FastStringReplace/

Оттуда и брал начальный вариант 😔
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676547
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev AlexeyГирлионайльдоне доглядел)
Ещё, если хочешь ускориться обрабатывай по несколько символов за итерацию.

Пробовал, тормозит сильнее... См. ЧегоТоrtosW
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676548
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubПробовал, тормозит сильнее... См. ЧегоТоrtosW
Странно, у меня получилось лучше PEnd процентов на ~25. Проверял по 4 символа за итерацию.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676549
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Извините Всё, что молчал - дожди, утонул вместе с телефоном :-)... Только высушил, пробовать буду завтра.... По данным : около 2-3 МБ на вход на каждые 10-15 символов ЗПТ
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676550
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev AlexeyzinpubПробовал, тормозит сильнее... См. ЧегоТоrtosW
Странно, у меня получилось лучше PEnd процентов на ~25. Проверял по 4 символа за итерацию.
А как по 4? У меня только AH, AL...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676551
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubА как по 4? У меня только AH, AL...
Примерно так:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
if CPos[0] = ',' then
 CPos[0] := '.';
if CPos[1] = ',' then
 CPos[1] := '.';
if CPos[2] = ',' then
 CPos[2] := '.';
if CPos[3] = ',' then
 CPos[3] := '.';

inc(CPos, 4);


;)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676552
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev AlexeyzinpubА как по 4? У меня только AH, AL...
Примерно так:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
if CPos[0] = ',' then
 CPos[0] := '.';
if CPos[1] = ',' then
 CPos[1] := '.';
if CPos[2] = ',' then
 CPos[2] := '.';
if CPos[3] = ',' then
 CPos[3] := '.';

inc(CPos, 4);


;)

D5 не в курсе.

На асме сам написал на AH, AL. - не даёт прироста
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676553
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Оптимизатор не в курсе, всмысле
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676554
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
zinpub,

а зачем тебе эта спешка?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676555
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
чччД__zinpub,

а зачем тебе эта спешка?

Микросервисы - ля..

100-150файлов в минуту...

И у всех ЗПТ вместо ТЧК.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676556
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubОптимизатор не в курсе, всмысле
Тут от оптимизатора и не требуется ничего. Это, как раз, ручное разворачивание цикла.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676557
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
zinpubчччД__zinpub,

а зачем тебе эта спешка?

Микросервисы - ля..

100-150файлов в минуту...

И у всех ЗПТ вместо ТЧК.
Ты ответь: спешка тебе эта для чего?

Что - уже все страшно тормозит, и ты нашел бутылочное горлышко, и оно именно в этой запятой?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676558
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
чччД__zinpubпропущено...


Микросервисы - ля..

100-150файлов в минуту...

И у всех ЗПТ вместо ТЧК.
Ты ответь: спешка тебе эта для чего?

Что - уже все страшно тормозит, и ты нашел бутылочное горлышко, и оно именно в этой запятой?

Горлышко, я нашёл, когда там Pos был... дальше - стало интересно...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676559
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubГорлышко, я нашёл, когда там Pos был... дальше - стало интересно..А нет возможности заставить файлы формироваться сразу с точками? Была бы самая крутая оптимизация :)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676575
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
white_niggerzinpubГорлышко, я нашёл, когда там Pos был... дальше - стало интересно..А нет возможности заставить файлы формироваться сразу с точками? Была бы самая крутая оптимизация :)

Ээх, горячего компота прям на рану... 😭
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676606
afgm
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попробовал скопировать функцию в коде ForkReplaceC_lodsw под другим названием и добавил в тесты. Время выполнения у них разное. Если это воспроизводится у кого-либо, то вопрос к бенчмаркалке.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676608
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afgmПопробовал скопировать функцию в коде ForkReplaceC_lodsw под другим названием и добавил в тесты. Время выполнения у них разное. Если это воспроизводится у кого-либо, то вопрос к бенчмаркалке.

На каком кол-ве прогонов? На сколько разное?

Если +-(несколько миллисекунд) - то это норм, иначе магия :-)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676613
afgm
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubНа каком кол-ве прогонов? На сколько разное?
Прогонов 50000
Код: plaintext
1.
2.
3.
4.
ForkReplaceC_lodsw   -> 00:00:273
ForkReplaceC_lodsw   -> 00:00:270
ForkReplaceC_lodsw_FIX -> 00:00:435
ForkReplaceC_lodsw_FIX -> 00:00:438

От порядка выполнения не зависит, а зависит от положения в исходном файле.
Если функции поменять в коде местами, то новая функция становится быстрее, а старая, соответственно, медленнее.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676617
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afgmzinpubНа каком кол-ве прогонов? На сколько разное?
Прогонов 50000
Код: plaintext
1.
2.
3.
4.
ForkReplaceC_lodsw   -> 00:00:273
ForkReplaceC_lodsw   -> 00:00:270
ForkReplaceC_lodsw_FIX -> 00:00:435
ForkReplaceC_lodsw_FIX -> 00:00:438

От порядка выполнения не зависит, а зависит от положения в исходном файле.
Если функции поменять в коде местами, то новая функция становится быстрее, а старая, соответственно, медленнее.

Погрешность, Now ...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676619
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
поставь 10 000 000 раз...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676620
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afgmzinpubНа каком кол-ве прогонов? На сколько разное?
Прогонов 50000
Код: plaintext
1.
2.
3.
4.
ForkReplaceC_lodsw   -> 00:00:273
ForkReplaceC_lodsw   -> 00:00:270
ForkReplaceC_lodsw_FIX -> 00:00:435
ForkReplaceC_lodsw_FIX -> 00:00:438

От порядка выполнения не зависит, а зависит от положения в исходном файле.
Если функции поменять в коде местами, то новая функция становится быстрее, а старая, соответственно, медленнее.

Эээ и что за камень? поставил у себя 50 000...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676631
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyzinpubПробовал, тормозит сильнее... См. ЧегоТоrtosW
Странно, у меня получилось лучше PEnd процентов на ~25. Проверял по 4 символа за итерацию.


Ещё можно по масске искать и сравнивать. Только я не мастак искать масски.


Вот пример, ищем в 4 байтах конец строки, если нет, то плюсуем + 4. Если встретили конец, то считает оставшейся по символам

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
type
  ApString = PAnsiChar;

function StrlenMy(s: ApString): NativeUInt;
begin
  Result := 0;
  while ((PNativeUInt(s)^ - $01010101) and $80808080) = 0 do  // Ищем в 4 байтах конец строки #0
  begin
    inc(Result, Sizeof(ApString));
    inc(s, Sizeof(ApString));
  end;

  while s^ <> #0 do
  begin
    inc(Result, 1);
    inc(s, 1);
  end;
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676651
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоKazantsev Alexeyпропущено...

Странно, у меня получилось лучше PEnd процентов на ~25. Проверял по 4 символа за итерацию.


Ещё можно по масске искать и сравнивать. Только я не мастак искать масски.


Вот пример, ищем в 4 байтах конец строки, если нет, то плюсуем + 4. Если встретили конец, то считает оставшейся по символам

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
type
  ApString = PAnsiChar;

function StrlenMy(s: ApString): NativeUInt;
begin
  Result := 0;
  while ((PNativeUInt(s)^ - $01010101) and $80808080) = 0 do  // Ищем в 4 байтах конец строки #0
  begin
    inc(Result, Sizeof(ApString));
    inc(s, Sizeof(ApString));
  end;

  while s^ <> #0 do
  begin
    inc(Result, 1);
    inc(s, 1);
  end;
end;



Даже так пробовал...
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
    Cld
@Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
@Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
@Skip:
    Dec   ECX
    Jnz   @Next



хуже ...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676664
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

Я не вижу так же

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
StrlenMy:
StrlenMy:
xor edx,edx
jmp $0041aff2
add edx,$04
add eax,$04
mov ecx,[eax]
sub ecx,$01010101
test ecx,$80808080
jz $0041afec
jmp $0041b006
inc edx
inc eax
cmp byte ptr [eax],$00
jnz $0041b004
mov eax,edx
ret 
mov eax,eax



С коментами
Код: 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.
Project4.dpr.16: Result := 0;
0041AFE8 33D2             xor edx,edx
0041AFEA EB06             jmp $0041aff2
Project4.dpr.19: inc(Result, Sizeof(ApString));
0041AFEC 83C204           add edx,$04
Project4.dpr.20: inc(s, Sizeof(ApString));
0041AFEF 83C004           add eax,$04
Project4.dpr.17: while ((PNativeUInt(s)^ - $01010101) and $80808080) = 0 do  // Ищем в 4 байтах конец строки #0
0041AFF2 8B08             mov ecx,[eax]
0041AFF4 81E901010101     sub ecx,$01010101
0041AFFA F7C180808080     test ecx,$80808080
0041B000 74EA             jz $0041afec
0041B002 EB02             jmp $0041b006
Project4.dpr.25: inc(Result, 1);
0041B004 42               inc edx
Project4.dpr.26: inc(s, 1);
0041B005 40               inc eax
Project4.dpr.23: while s^ <> #0 do
0041B006 803800           cmp byte ptr [eax],$00
0041B009 75F9             jnz $0041b004
Project4.dpr.28: end;
0041B00B 8BC2             mov eax,edx
0041B00D C3               ret 
0041B00E 8BC0             mov eax,eax

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676675
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

Вот с проверкой четвёрками:
Код: 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.
function _Replace(const s : AnsiString) : AnsiString;
var

 l    : Integer;
 i    : Integer;
 cpos : PAnsiChar;

begin

 Result := Copy(s, 1);

 l    := Length(Result);
 cpos := Pointer(Result);

 for i := 1 to l div 4 do
  begin

   if cpos[0] = ',' then
    cpos[0] := '.';

   if cpos[1] = ',' then
    cpos[1] := '.';

   if cpos[2] = ',' then
    cpos[2] := '.';

   if cpos[3] = ',' then
    cpos[3] := '.';

   inc(cpos, 4);

  end;

 for i := 1 to l mod 4 do
  begin

   if cpos[0] = ',' then
    cpos[0] := '.';

   inc(cpos);

  end;

end;


Работает на 30% быстрее PEnd. Правда не знаю, умеет ли Delphi 5 div и mod оптимизировать.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676679
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоKazantsev Alexeyпропущено...

Странно, у меня получилось лучше PEnd процентов на ~25. Проверял по 4 символа за итерацию.


Ещё можно по масске искать и сравнивать. Только я не мастак искать масски.


Вот пример, ищем в 4 байтах конец строки, если нет, то плюсуем + 4. Если встретили конец, то считает оставшейся по символам

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
type
  ApString = PAnsiChar;

function StrlenMy(s: ApString): NativeUInt;
begin
  Result := 0;
  while ((PNativeUInt(s)^ - $01010101) and $80808080) = 0 do  // Ищем в 4 байтах конец строки #0
  begin
    inc(Result, Sizeof(ApString));
    inc(s, Sizeof(ApString));
  end;

  while s^ <> #0 do
  begin
    inc(Result, 1);
    inc(s, 1);
  end;
end;



Пардон, не разобрал на телефоне.
А, при чём здесь длина строки вообще? она и так в -4 байта лежит...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676680
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub
Пардон, не разобрал на телефоне.
А, при чём здесь длина строки вообще? она и так в -4 байта лежит...


Серьёзно? Я тут говорю, что в 4 байтах можно по маске сразу понять, есть ли символ. А он не понимает. Эх ты.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676684
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev Alexeyzinpub,

Вот с проверкой четвёрками:
Код: 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.
function _Replace(const s : AnsiString) : AnsiString;
var

 l    : Integer;
 i    : Integer;
 cpos : PAnsiChar;

begin

 Result := Copy(s, 1);

 l    := Length(Result);
 cpos := Pointer(Result);

 for i := 1 to l div 4 do
  begin

   if cpos[0] = ',' then
    cpos[0] := '.';

   if cpos[1] = ',' then
    cpos[1] := '.';

   if cpos[2] = ',' then
    cpos[2] := '.';

   if cpos[3] = ',' then
    cpos[3] := '.';

   inc(cpos, 4);

  end;

 for i := 1 to l mod 4 do
  begin

   if cpos[0] = ',' then
    cpos[0] := '.';

   inc(cpos);

  end;

end;


Работает на 30% быстрее PEnd. Правда не знаю, умеет ли Delphi 5 div и mod оптимизировать.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676685
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоzinpubПардон, не разобрал на телефоне.
А, при чём здесь длина строки вообще? она и так в -4 байта лежит...


Серьёзно? Я тут говорю, что в 4 байтах можно по маске сразу понять, есть ли символ. А он не понимает. Эх ты.

Так это всё равно на 4 маски сравнивать...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676688
afgm
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubЭээ и что за камень? поставил у себя 50 000...
i5 6500
Ты сам постил аналогичные результаты для 50 000 21586838
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676689
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
zinpubГирлионайльдопропущено...



Серьёзно? Я тут говорю, что в 4 байтах можно по маске сразу понять, есть ли символ. А он не понимает. Эх ты.

Так это всё равно на 4 маски сравнивать...

Хотя нет, кажется понял... Ща буду думать...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676694
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afgmzinpubЭээ и что за камень? поставил у себя 50 000...
i5 6500
Ты сам постил аналогичные результаты для 50 000 21586838

Это не я ...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676696
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

Там в коде нескольких функций (ReplaceCharByPChar в частности) допущена ошибка о которой я уже писал - меняются символы в исходной строке (копирования данных не происходит - выше скорость):
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676708
afgm
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubЭто не я ...
Я ошибся, но там порядок похожий.
1. В коде CNT_RUN с циклом не связана.
2. Погрешности now нет. Переделал на StopWatch. Всё аналогично.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676720
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

Вот тут можно подробнее узнать о этом
http://graphics.stanford.edu/~seander/bithacks.html#ZeroInWord
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676727
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev Alexeyzinpub,

Там в коде нескольких функций (ReplaceCharByPChar в частности) допущена ошибка о которой я уже писал - меняются символы в исходной строке (копирования данных не происходит - выше скорость):
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);



Да, косякнул...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676731
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afgmzinpubЭто не я ...
Я ошибся, но там порядок похожий.
1. В коде CNT_RUN с циклом не связана.
2. Погрешности now нет. Переделал на StopWatch. Всё аналогично.

CNT_RUN с Edit'ом связана...

Код покажи...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676738
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я делал PosByte на этих бинарных трюках, выходило шустрее даже асмового Pos для анси строк. Но вот незадача - для юникод строк это уже не работает.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676739
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubДа, косякнул...
Другие функции проверь.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676746
afgm
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubКод покажи...
source
Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Diagnostics;

type

  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

  TCommatFunc = function(s: ApString): ApString;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    btnTest: TButton;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
  private
    { Private declarations }
     function RunFunc(Func: TCommatFunc): Int64;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
  public
    { Public declarations }
  end;

const
  CNT_RUN = 50000;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function ForkReplaceC_lodsw(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;


function ForkReplaceC_lodsw_FIX(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   BH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit
    push ECX

    shr ECX,1

    Cld
  @Next:
    Lodsw
    Cmp   AH,BH
    Jne   @Skip1
    Mov   [ESI-1],BL
  @Skip1:
    Cmp   AL,BH
    Jne   @Skip
    Mov   [ESI-2],BL
  @Skip:
    Dec   ECX
    Jnz   @Next

    // ------------------------
    pop ECX
    and ECX,2
    jz @Exit
  @Next20:
    Lodsb
    Cmp   AH,BH
    Jne   @Skip20
    Mov   [ESI-1],BL
  @Skip20:
    Dec   ECX
    Jnz   @Next20
  @Exit:
    Pop  EBX
    Pop  ESI

  end;
end;

function PEnd(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;


function PEnd_ASM(const s: ApString): ApString;
asm
// Unit1.pas.175: begin
                          push ebp
                          mov ebp,esp
                          push ebx
                          push esi
                          mov esi,edx
                          mov ebx,eax
//Unit1.pas.176: Result := s;
                          mov eax,esi
                          mov edx,ebx
                          call System.@LStrAsg
//Unit1.pas.177: P := Pointer(Result);
                          mov eax,[esi]
//Unit1.pas.178: PEnd := P + Length(s);
                          mov edx,ebx
                          test edx,edx
                          jz @005d2c0b
                          sub edx,$04
                          mov edx,[edx]
@005d2c0b:
                          add edx,eax

                          mov esi, $2e //--


//Unit1.pas.179: while P < PEnd do
                          cmp edx,eax
                          jbe @005d2c1e
//Unit1.pas.181: if P^ = COMMA_ then
@005d2c11:
{
                          cmp byte ptr [eax],$2c
                          jnz @005d2c19
//Unit1.pas.182: P^ := DOT_;
                          mov byte ptr [eax],$2e
}
//--
//                         cmp byte ptr [eax],$2c
//                           cmove  eax,ebx
//                         cmove
                          xor ebx,ebx
                          mov bl, byte ptr [eax]
                          xor ecx, $2e
                          //xor ebx, $000000FF
                          cmp bl, $2c
                          cmovne ecx, ebx        // if char<>',' then ecx <- char
////                          mov bl, $2e
////                          cmove ecx, ebx
                          cmove cx, si         //  if char=',' then ecx <- '.'


////                          mov ecx, ebx
                          mov byte ptr [eax], cl
//--
//Unit1.pas.183: Inc(P);
@005d2c19:
                         inc eax
//Unit1.pas.179: while P < PEnd do
                          cmp edx,eax
                          jnbe @005d2c11
//Unit1.pas.185: end;
@005d2c1e:
                          pop esi
                          pop ebx
                          pop ebp
                          ret
end;


function ReplaceCharByPChar(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(const s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;


type
  TaRecode = array [ApChar] of ApChar;

var
  fRecode: TaRecode;

procedure Init();
var
  c: ApChar;
begin
  for c := Low(ApChar) to High(ApChar) do
    fRecode[c] := c;
  fRecode[','] := '.';
end;

function Recode(str: ApString): ApString;
var
  i: Integer;
begin
  Result := str;
  for i := 1 to Length(Result) do
    Result[i] := fRecode[Result[i]];
end;

var
  MinTest: int64;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);
 function FormatOutput(const aFuncName: ApString; const iRunTime: Int64)
    : ApString;
  begin
    Result := Format('%-20s -> %d', [aFuncName, iRunTime]);
  end;

begin
  MinTest := 100000000000000000;
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');



  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw',
    RunFunc(@ForkReplaceC_lodsw)));

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw_FIX',
    RunFunc(@ForkReplaceC_lodsw_FIX)));

  mmo1.Lines.Add(FormatOutput('ForkReplaceC_lodsw_FIX',
    RunFunc(@ForkReplaceC_lodsw_FIX)));


  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('PEnd', RunFunc(@PEnd)));
  mmo1.Lines.Add(FormatOutput('PEnd_ASM', RunFunc(@PEnd_ASM)));
  mmo1.Lines.Add(FormatOutput('Recode', RunFunc(@Recode)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + IntToStr(IdxMin + 1),
    MinTest));

end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: ApString;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    if Random(10) > iFactor then
      s := s + ','
    else
      s := s + Chr(40 + Trunc(Random(150)));
  end;

  mmo2.Text := s;

end;

function TForm1.RunFunc(Func: TCommatFunc): Int64;
var
  aStartTime: TDateTime;
  i: Integer;
  s: ApString;
  sw: TStopwatch;
begin
  s := mmo2.Text;

//  aStartTime := Now;
  sw := TStopwatch.StartNew;
  for i := 0 to CNT_RUN - 1 do
    Func(s);

//  Result := Now - aStartTime;
  sw.Stop;
  Result := sw.ElapsedMilliseconds;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Init();
end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
 FillRandomText(20, 10000);
end;

procedure TForm1.btnTestClick(Sender: TObject);
begin
  ShowMessage(PEnd('123,asd'));
  ShowMessage(PEnd_ASM('123,asd'));
end;

end.




Можешь выслать свою тестовую программу целиком на afgm[гав]mail.ru ?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676807
afgm
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afgmМожешь выслать свою тестовую программу...
Ответ по поводу скорости уже нашёл
Код: pascal
1.
2.
  FillRandomText(StrToInt(edtFactor.Text), 250);
  FillRandomText(20, 10000);
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676830
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
1. Многопоточность никак не поможет?
Мне с файлами, бывает, сильно помогает.
2. MMX никак не поможет?
Ну и с объемными данными тоже.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676833
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я нашёл способ, как проверить, есть ли какой нибудь символ в 4 байтном слове

Код: pascal
1.
p := 'T,xt';




Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Символ: T Есть!
Символ: x Есть!
Символ: , Есть!

Символ: e Нету!

Символ: t Есть!

Символ: 3 Нету!
Символ: K Нету!
Символ: j Нету!
Символ: o Нету!
Символ: # Нету!
Символ: Ф Нету!
Символ: Я Нету!
Символ: С Нету!
Символ: . Нету!
Символ: X Нету!





Код: 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.
program Project4;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils;

function checkChar(Sum: NativeUInt; Ch: byte): Boolean;
begin
  Sum := Sum xor (72340172838076673 * Ch);
  Result := ((Sum - $01010101) and not Sum and $80808080) <> 0;
end;


var
  p: PansiChar;


procedure assert(c: char);
var
  s: string;
begin
  if checkChar(PNativeUInt(p)^, ord(c)) then
    s := ' Есть!'
  else
    s := ' Нету!';

  Writeln('Символ: ', c, s);
end;

begin
  p := 'T,xt';
  assert('T');
  assert('x');
  assert(',');
  assert('e');
  assert('t');
  assert('3');
  assert('K');
  assert('j');
  assert('o');
  assert('#');
  assert('Ф');
  assert('Я');
  assert('С');
  assert('.');
  assert('X');

  Readln;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676860
Polesov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Привет.

zinpubМожет, кто подскажет, как ещё быстрее можно...

Начал с такого
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
function FastCommatopoint(s: string): string;
var
  i: Integer;
begin
  Result := s;
  for i := 1 to Length(s) do
    if Result[i] = ',' then
      Result[i] := '.';
end;



Можно читать по 4 байта. У меня получилось примерно в два раза вышеприведенного варианта:

Код: 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.
function UseLodsD( s : AnsiString ) : AnsiString;
begin
  Result := s;

  asm
       Push     ESI
       Push     EDI
       Push     EBX

       Mov      EAX,    Result

       Mov      ESI,    [EAX]
       Mov      ECX,    [ESI - 4]
       Mov      EBX,    ECX
       And      EBX,    011b
       Shr      ECX,    2

  @@10:
       LodsD
       Mov      EDX,    4

  @@20:
       Cmp      AL,     ','
       Jne      @@30
       Mov      EDI,    ESI
       Sub      EDI,    EDX
       Mov      Byte Ptr [EDI], '.'

  @@30:
       Shr      EAX,    8
       Dec      EDX
       Test     EDX,    EDX
       Jnz      @@20

       Loop     @@10

       Test     EBX,    EBX
       Jz       @@90

       Mov      ECX,    EBX

  @@40:
       LodsB
       Cmp      AL,     ','
       Jne      @@50
       Mov      Byte Ptr [ESI - 1], '.'

  @@50:
       Loop    @@40

  @@90:
       Pop      EBX
       Pop      EDI
       Pop      ESI
  end;
end;



С уважением, Poleosv.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676872
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я сделать самую быструю функцию! Кто сможет меня вздёрнуть?) (Только не надо SSE, он точно быстрее будет)

Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
------------------------------------------------------
ReplaceCharByPChar   -> 00:02:879
TestMy               -> 00:02:368
PEnd                 -> 00:02:797
Rep4Bytes            -> 00:01:084
Самый быстрый: 4     -> 00:01:084
------------------------------------------------------
ReplaceCharByPChar   -> 00:02:945
TestMy               -> 00:02:470
PEnd                 -> 00:02:975
Rep4Bytes            -> 00:01:097
Самый быстрый: 4     -> 00:01:097



Код тестовый
Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

  TCommatFunc = function(s: ApString): ApString;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    Memo1: TMemo;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 100000; // РАБОТАЕТ

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ReplaceCharByPChar(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function PEnd(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function Rep4Bytes(str: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P, C: ApPChar;
  len: Cardinal;
  Sum: NativeUInt;
  Offset: byte;
  i: Integer;
begin
  Result := str;
  P := Pointer(Result);
  len := Length(str);

  while len >= sizeof(ApPChar) do
  begin
    Sum := PNativeUInt(P)^ xor (72340172838076673 * ord(COMMA_));
    if ((Sum - $01010101) and not Sum and $80808080) <> 0 then
    begin
      for Offset := 0 to 3 do
      begin
        C := ApPChar(P + Offset);
        if C^ = COMMA_ then
          C^ := DOT_;
      end;
    end;
    dec(len, sizeof(ApPChar));
    Inc(P, sizeof(ApPChar));
  end;

  while len <> 0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    dec(len);
    Inc(P);
  end;
end;

var
  MinTest: TDateTime;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: ApString; const iRunTime: TDateTime)
    : ApString;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  MinTest := TDateTime(1000000000);
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('PEnd', RunFunc(@PEnd)));
  mmo1.Lines.Add(FormatOutput('Rep4Bytes', RunFunc(@Rep4Bytes)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + (IdxMin + 1).ToString,
    MinTest));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: ApString;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to CNT_RUN - 1 do
    Func(s);

  Result := Now - aStartTime;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: ApString;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    s := s + ','
  end;

  mmo2.Text := s;

end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(20, 10000);
end;

end.




Функция

Код: 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.
function Rep4Bytes(str: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P, C: ApPChar;
  len: Cardinal;
  Sum: NativeUInt;
  Offset: byte;
  i: Integer;
begin
  Result := str;
  P := Pointer(Result);
  len := Length(str);

  while len >= sizeof(ApPChar) do
  begin
    Sum := PNativeUInt(P)^ xor (72340172838076673 * ord(COMMA_));
    if ((Sum - $01010101) and not Sum and $80808080) <> 0 then
    begin
      for Offset := 0 to 3 do
      begin
        C := ApPChar(P + Offset);
        if C^ = COMMA_ then
          C^ := DOT_;
      end;
    end;
    dec(len, sizeof(ApPChar));
    Inc(P, sizeof(ApPChar));
  end;

  while len <> 0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    dec(len);
    Inc(P);
  end;
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676875
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Polesov,

Твоя asm функция капелька в море в производительности
Rep4Bytes -> 00:01:083
UseLodsD -> 00:02:088
Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
------------------------------------------------------
ReplaceCharByPChar   -> 00:02:873
TestMy               -> 00:02:401
PEnd                 -> 00:02:810
Rep4Bytes            -> 00:01:083
UseLodsD             -> 00:02:088
Самый быстрый: 4     -> 00:01:083
------------------------------------------------------
ReplaceCharByPChar   -> 00:02:876
TestMy               -> 00:02:370
PEnd                 -> 00:02:814
Rep4Bytes            -> 00:01:080
UseLodsD             -> 00:02:070
Самый быстрый: 4     -> 00:01:080

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676878
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Для тех кто может подумать что моя функция не работает Раз она быстрая очень


(Включить оптимизацию в настройке проекта. И вставить этот код в консольное приложение)

Код: 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.
program Project4;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils;

type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

function Rep4Bytes(str: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P, C: ApPChar;
  len: Cardinal;
  Sum: NativeUInt;
  Offset: byte;
  i: Integer;
begin
  Result := str;
  P := Pointer(Result);
  len := Length(str);

  while len >= sizeof(ApPChar) do
  begin
    Sum := PNativeUInt(P)^ xor (72340172838076673 * ord(COMMA_));
    if ((Sum - $01010101) and not Sum and $80808080) <> 0 then
    begin
      for Offset := 0 to 3 do
      begin
        C := ApPChar(P + Offset);
        if C^ = COMMA_ then
          C^ := DOT_;
      end;
    end;
    dec(len, sizeof(ApPChar));
    Inc(P, sizeof(ApPChar));
  end;

  while len <> 0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    dec(len);
    Inc(P);
  end;
end;

var
  P: string;

begin
  P := ',,,,,,,,,,,,,,,,,SIVJRG J jrigjre шокпшкп ,,,,,,,,,,с';
  Writeln(Rep4Bytes(P));

  Readln;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676879
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubKazantsev Alexeyzinpub,

Там в коде нескольких функций (ReplaceCharByPChar в частности) допущена ошибка о которой я уже писал - меняются символы в исходной строке (копирования данных не происходит - выше скорость):
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
function ReplaceCharByPChar(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: PChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);



Да, косякнул...


вставь между этими операторами
Код: pascal
1.
UniqueString(Result);



и чтобы сразу видеть инвалидные функции в тело RunFunc можно добавить предварительную проверку
Код: pascal
1.
2.
3.
4.
5.
  t:=Func(s);
  if (pos(',',s)=0) or (pos(',',t)<>0) or (t=s) then begin;
   Result:=1;
   exit;
   end



и наконец, в объявление функций лучше добавить const
Код: pascal
1.
  TCommatFunc = function(const s: ApString): ApString;



также можно рассмотреть процедуры
Код: pascal
1.
  TCommaProc = procedure(var s: ApString);
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676898
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

чей-то софт напоминает) но тоже инвалид.

Кстати, по-хорошему, можно было бы обобщить на любую пару символов и с масками игру с масками осилить до конца.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676899
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоЯ сделать самую быструю функцию! Кто сможет меня вздёрнуть?)
Это как раз тот момент, когда оптимизация превращает код в колдунство. И опять же, это только для однобайтовых строк.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676906
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
За то она самая быстрая, из всех предложенных вариантов :D И я этим горжусь,,даже на asm никто не осилил быстрее
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676915
Polesov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоPolesov,

Твоя asm функция капелька в море в производительности
Rep4Bytes -> 00:01:083
UseLodsD -> 00:02:088


У меня получились другие цифры (значения в миллисекундах):
Код: powershell
1.
2.
3.
FastCommatopoint: 1047
UseLodsD: 719
Rep4Bytes: 828


Процессор i7-4790, 3.6 GHz, Win 8.1 x64

Вот тестовый код:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
  Memo1.Lines.Clear;
  t := GetTickCount;
  for i := 1 to 10000000 do
    s := FastCommatopoint( z );
  Memo1.Lines.Add( 'FastCommatopoint: ' + IntToStr( GetTickCount - t ) );

  t := GetTickCount;
  for i := 1 to 10000000 do
    s := UseLodsD( z );
  Memo1.Lines.Add( 'UseLodsD: ' + IntToStr( GetTickCount - t ) );

  t := GetTickCount;
  for i := 1 to 10000000 do
    s := Rep4Bytes( z );
  Memo1.Lines.Add( 'Rep4Bytes: ' + IntToStr( GetTickCount - t ) );



функцию UseLodsD можно ускорить процентов на 6-8, если после чтения последовательно сравнивать AL и AH и сдвигать EAX на 16.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676916
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоЗа то она самая быстрая, из всех предложенных вариантов :D И я этим горжусь,,даже на asm никто не осилил быстрее
Она у тебя просто работает некорректно.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676917
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоЗа то она самая быстрая, из всех предложенных вариантов :D И я этим горжусь,,даже на asm никто не осилил быстрее

а то, что она немного портит исходные данные, неважно )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676947
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Блин. Я ожидал что компилятор скопирует строку, а он не сделал это. Он делает это только вот так

Код: pascal
1.
2.
  Result := str;
  Result[1] := Result[1];



Иначе Result остаётся указателем на str... Капец подводный камюшек. Весь мизинчик разбил в кровь
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676949
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Тогда мой вариант подходит для того, если заменяемый символ встречается не так часто.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676960
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоТогда мой вариант подходит для того, если заменяемый символ встречается не так часто.
Твой корректный вариант работает чуть быстрее моего, если данные сформированы по условиям TC (По данным : около 2-3 МБ на вход на каждые 10-15 символов ЗПТ). Разница в производительности крайне незначительна и, на мой взгляд, не оправдывает усложнения кода. Но если в каждой четвёрке символов будет запятая твой вариант начинает сильно отставать.

p.s. А ты, случаем, не Няшик?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676963
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоБлин. Я ожидал что компилятор скопирует строку, а он не сделал это. Он делает это только вот так

Код: pascal
1.
2.
  Result := str;
  Result[1] := Result[1];



Иначе Result остаётся указателем на str... Капец подводный камюшек.

так тоже не так сделает, обломается на пустой строке
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676974
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попкорна уже не хватает.
Предлагаю ТС заняться оптимизацией секций initialization и finalization - вот где поле-то непаханное.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676975
Фотография Квейд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоБлин. Я ожидал что компилятор скопирует строку

Все правильно делает компилятор. Если строка не меняется, зачем нужна ее копия, если можно просто увеличить счетчик ссылок?


ГирлионайльдоОн делает это только вот так

Код: pascal
1.
2.
  Result := str;
  Result[1] := Result[1];



Иначе Result остаётся указателем на str... Капец подводный камюшек.

Покури справку по UniqueString
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676978
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вы уж определитесь, что именно делаете - новую строку с заменами или замены в старой строке. ТС-у был нужен второй вариант, как мне кажется. Первый же элементарно получается из второго добавлением UniqueString и возвратом результата. Да и как-то странно говорить о быстроте и выжимать такты, когда всё начинается с жирного выделения и копирования памяти.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676994
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
makhaon1. Многопоточность никак не поможет?
Мне с файлами, бывает, сильно помогает.
2. MMX никак не поможет?
Ну и с объемными данными тоже.

1. Нельзя, он(сервис) и так в 20 потоках пашет,
2. Думаю...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39676995
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
PolesovПривет.

zinpubМожет, кто подскажет, как ещё быстрее можно...

Начал с такого
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
function FastCommatopoint(s: string): string;
var
  i: Integer;
begin
  Result := s;
  for i := 1 to Length(s) do
    if Result[i] = ',' then
      Result[i] := '.';
end;



Можно читать по 4 байта. У меня получилось примерно в два раза вышеприведенного варианта:

Код: 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.
function UseLodsD( s : AnsiString ) : AnsiString;
begin
  Result := s;

  asm
       Push     ESI
       Push     EDI
       Push     EBX

       Mov      EAX,    Result

       Mov      ESI,    [EAX]
       Mov      ECX,    [ESI - 4]
       Mov      EBX,    ECX
       And      EBX,    011b
       Shr      ECX,    2

  @@10:
       LodsD
       Mov      EDX,    4

  @@20:
       Cmp      AL,     ','
       Jne      @@30
       Mov      EDI,    ESI
       Sub      EDI,    EDX
       Mov      Byte Ptr [EDI], '.'

  @@30:
       Shr      EAX,    8
       Dec      EDX
       Test     EDX,    EDX
       Jnz      @@20

       Loop     @@10

       Test     EBX,    EBX
       Jz       @@90

       Mov      ECX,    EBX

  @@40:
       LodsB
       Cmp      AL,     ','
       Jne      @@50
       Mov      Byte Ptr [ESI - 1], '.'

  @@50:
       Loop    @@40

  @@90:
       Pop      EBX
       Pop      EDI
       Pop      ESI
  end;
end;



С уважением, Poleosv.

Пробовал, почему-то по одному lodsb быстрее, хотя у меня несколько по другому... попробую
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677000
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ГирлионайльдоЯ сделать самую быструю функцию! Кто сможет меня вздёрнуть?) (Только не надо SSE, он точно быстрее будет)

Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
------------------------------------------------------
ReplaceCharByPChar   -> 00:02:879
TestMy               -> 00:02:368
PEnd                 -> 00:02:797
Rep4Bytes            -> 00:01:084
Самый быстрый: 4     -> 00:01:084
------------------------------------------------------
ReplaceCharByPChar   -> 00:02:945
TestMy               -> 00:02:470
PEnd                 -> 00:02:975
Rep4Bytes            -> 00:01:097
Самый быстрый: 4     -> 00:01:097



Код тестовый
Код: 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.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

  TCommatFunc = function(s: ApString): ApString;

  TForm1 = class(TForm)
    btnCommaToPoint: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btnFill: TButton;
    Memo1: TMemo;
    procedure btnCommaToPointClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
  private
    function RunFunc(Func: TCommatFunc): TDateTime;

    procedure FillRandomText(const iFactor, iCharCount: Integer);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CNT_RUN = 100000; // РАБОТАЕТ

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ReplaceCharByPChar(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  i: Integer;
begin
  Result := s;
  P := Pointer(Result);
  for i := 0 to Length(s) - 1 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function TestMy(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
begin
  Result := s;
  P := Pointer(Result);
  while P^ <> #0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function PEnd(s: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P: ApPChar;
  PEnd: Pointer;
begin
  Result := s;
  P := Pointer(Result);
  PEnd := P + Length(s);
  while P < PEnd do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    Inc(P);
  end;
end;

function Rep4Bytes(str: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P, C: ApPChar;
  len: Cardinal;
  Sum: NativeUInt;
  Offset: byte;
  i: Integer;
begin
  Result := str;
  P := Pointer(Result);
  len := Length(str);

  while len >= sizeof(ApPChar) do
  begin
    Sum := PNativeUInt(P)^ xor (72340172838076673 * ord(COMMA_));
    if ((Sum - $01010101) and not Sum and $80808080) <> 0 then
    begin
      for Offset := 0 to 3 do
      begin
        C := ApPChar(P + Offset);
        if C^ = COMMA_ then
          C^ := DOT_;
      end;
    end;
    dec(len, sizeof(ApPChar));
    Inc(P, sizeof(ApPChar));
  end;

  while len <> 0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    dec(len);
    Inc(P);
  end;
end;

var
  MinTest: TDateTime;
  IdxMin, IdxCurr: Integer;

procedure TForm1.btnCommaToPointClick(Sender: TObject);

  function FormatOutput(const aFuncName: ApString; const iRunTime: TDateTime)
    : ApString;
  begin
    Result := Format('%-20s -> %s', [aFuncName, FormatDateTime('NN:SS:ZZZ',
      iRunTime)]);
  end;

begin
  MinTest := TDateTime(1000000000);
  IdxMin := 0;
  IdxCurr := 0;

  mmo1.Lines.Add('------------------------------------------------------');

  mmo1.Lines.Add(FormatOutput('ReplaceCharByPChar',
    RunFunc(@ReplaceCharByPChar)));

  mmo1.Lines.Add(FormatOutput('TestMy', RunFunc(@TestMy)));

  mmo1.Lines.Add(FormatOutput('PEnd', RunFunc(@PEnd)));
  mmo1.Lines.Add(FormatOutput('Rep4Bytes', RunFunc(@Rep4Bytes)));

  mmo1.Lines.Add(FormatOutput('Самый быстрый: ' + (IdxMin + 1).ToString,
    MinTest));

end;

function TForm1.RunFunc(Func: TCommatFunc): TDateTime;
var
  aStartTime: TDateTime;
  i: Integer;
  s: ApString;
begin
  s := mmo2.Text;

  aStartTime := Now;

  for i := 0 to CNT_RUN - 1 do
    Func(s);

  Result := Now - aStartTime;

  if MinTest - Result > 0 then
  begin
    MinTest := Result;
    IdxMin := IdxCurr;
  end;
  Inc(IdxCurr);
end;

procedure TForm1.FillRandomText(const iFactor, iCharCount: Integer);
var
  i: Integer;
  s: ApString;
begin
  s := '';

  for i := 0 to iCharCount do
  begin
    s := s + ','
  end;

  mmo2.Text := s;

end;

procedure TForm1.btnFillClick(Sender: TObject);
begin
  FillRandomText(20, 10000);
end;

end.




Функция

Код: 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.
function Rep4Bytes(str: ApString): ApString;
const
  COMMA_ = ',';
  DOT_ = '.';
var
  P, C: ApPChar;
  len: Cardinal;
  Sum: NativeUInt;
  Offset: byte;
  i: Integer;
begin
  Result := str;
  P := Pointer(Result);
  len := Length(str);

  while len >= sizeof(ApPChar) do
  begin
    Sum := PNativeUInt(P)^ xor (72340172838076673 * ord(COMMA_));
    if ((Sum - $01010101) and not Sum and $80808080) <> 0 then
    begin
      for Offset := 0 to 3 do
      begin
        C := ApPChar(P + Offset);
        if C^ = COMMA_ then
          C^ := DOT_;
      end;
    end;
    dec(len, sizeof(ApPChar));
    Inc(P, sizeof(ApPChar));
  end;

  while len <> 0 do
  begin
    if P^ = COMMA_ then
      P^ := DOT_;
    dec(len);
    Inc(P);
  end;
end;



Ноздря в ноздрю с ForkReplaceC

------------------------------------------------------
FastCommaToPoint -> 00:00:906
UseReplaceC -> 00:00:547
ForkReplaceC -> 00:00:187
UseRepneScasb -> 00:00:203
PCharRepl -> 00:00:844
ForkReplaceC_lodsw -> 00:00:250
ReplaceCharByPChar -> 00:00:594
ReplaceCharByPChar_While -> 00:00:640
ForForForFor -> 00:00:578
ReplaceCharByPChar_WhileByLen -> 00:00:657
ReplaceKazantsev4 -> 00:00:406
Rep4Bytes -> 00:00:187
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677001
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Aleksandr Sharahovzinpubпропущено...


Да, косякнул...


вставь между этими операторами
Код: pascal
1.
UniqueString(Result);



и чтобы сразу видеть инвалидные функции в тело RunFunc можно добавить предварительную проверку
Код: pascal
1.
2.
3.
4.
5.
  t:=Func(s);
  if (pos(',',s)=0) or (pos(',',t)<>0) or (t=s) then begin;
   Result:=1;
   exit;
   end



и наконец, в объявление функций лучше добавить const
Код: pascal
1.
  TCommatFunc = function(const s: ApString): ApString;



также можно рассмотреть процедуры
Код: pascal
1.
  TCommaProc = procedure(var s: ApString);



Объявление да исправил....

через var нельзя... там Copy местами передаёт параметр...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677005
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ВСЕМ СПАСИБО !!

Остановился на таком варианте...

Код: 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.
function ForkReplaceC(const s: string): string;
const
  COMMA_ = ',';
  DOT_ = '.';
begin
  Result := s;
  UniqueString(Result);

  asm
    Push  ESI
    Push  EBX

    Mov   EAX,Result
    Or    EAX,EAX
    Jz    @Exit
    Mov   ESI,[EAX]
    Or    ESI,ESI
    Jz    @Exit

    Mov   AH,COMMA_
    Mov   BL,DOT_
    Cmp   AH,BL
    Jz    @Exit

    Mov   ECX,[ESI-4]
    Jecxz @Exit

    Cld
@Next:
    Lodsb
    Cmp   AL,AH
    Jne   @Skip
    Mov   [ESI-1],BL
@Skip:
    Dec   ECX
    Jnz   @Next
@Exit:
    Pop  EBX
    Pop  ESI
  end;
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677006
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

авторНельзя, он(сервис) и так в 20 потоках пашет,

даже у нас на одной тествой машине 10ти летней давности с двумя ядрами сотня потоков работает без особых проблем. в том числе как раз файлы гигабайтами перемалывает.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677008
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
makhaonzinpub,

авторНельзя, он(сервис) и так в 20 потоках пашет,

даже у нас на одной тествой машине 10ти летней давности с двумя ядрами сотня потоков работает без особых проблем. в том числе как раз файлы гигабайтами перемалывает.

А, что даст сотня потоков, если все ядра разобраны ?

Или, я чего то не понимаю...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677015
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubmakhaonzinpub,

пропущено...


даже у нас на одной тествой машине 10ти летней давности с двумя ядрами сотня потоков работает без особых проблем. в том числе как раз файлы гигабайтами перемалывает.

А, что даст сотня потоков, если все ядра разобраны ?

Или, я чего то не понимаю...

Сотня потоков даст непрерывную нагрузку на процессор (перемалывает файлы - ждет завершения ввода-вывода)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677017
Polesov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubПробовал, почему-то по одному lodsb быстрее, хотя у меня несколько по другому... попробую

Вот немного улучшенный вариант с чтением по 4 байта (последовательное сравнение AL, AH и сдвигом вправо на 16):
Код: 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.
function UseLodsD2( s : AnsiString ) : AnsiString;
begin
  Result := s;

  asm
       Push     ESI
       Push     EDI
       Push     EBX

       Mov      EAX,    Result

       Mov      ESI,    [EAX]
       Mov      ECX,    [ESI - 4]
       Mov      EBX,    ECX
       And      EBX,    011b
       Shr      ECX,    2

  @@10:
       LodsD
       Mov      EDX,    2

  @@20:
       Cmp      AL,     ','
       Jne      @@25
       Mov      EDI,    ESI
       Sub      EDI,    EDX
       Mov      Byte Ptr [EDI], '.'

  @@25:
       Cmp      AH,     ','
       Jne      @@30
       Mov      EDI,    ESI
       Sub      EDI,    EDX
       Mov      Byte Ptr [EDI], '.'

  @@30:
       Shr      EAX,    16
       Dec      EDX
       Test     EDX,    EDX
       Jnz      @@20

       Loop     @@10

       Test     EBX,    EBX
       Jz       @@90

       Mov      ECX,    EBX

  @@40:
       LodsB
       Cmp      AL,     ','
       Jne      @@50
       Mov      Byte Ptr [ESI - 1], '.'

  @@50:
       Loop    @@40

  @@90:
       Pop      EBX
       Pop      EDI
       Pop      ESI
  end;
end;




Вот вариант с LodsB (простой в реализации):
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
function UseLodsB( s : AnsiString ) : AnsiString;
begin
  Result := s;

  asm
       Push     ESI

       Mov      EAX,    Result
       Mov      ESI,    [EAX]
       Mov      ECX,    [ESI - 4]

  @@10:
       LodsB
       Cmp      AL,     ','
       Jne      @@20
       Mov      Byte Ptr [ESI - 1], '.'

  @@20:
       Loop    @@20

       Pop      ESI
  end;
end;




Вот результаты:
Код: powershell
1.
2.
3.
FastCommatopoint: 1047
UseLodsD2: 625
UseLodsB: 735



В принципе, результаты ожидаемы.

P.S. Хотелось бы посмотреть на вариант функции, победившей в этом "тендере" :-)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677021
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubВСЕМ СПАСИБО !!
Остановился на таком варианте...


У меня на i7-7700 вот такое быстрее + универсальнее, понятнее, паскальнее )

Код: 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.
var
  CharReplaceTable: array[byte] of byte;

procedure InitCharReplaceTable(const FromChars, ToChars: string; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

procedure ShaCharReplaceProc(var s: AnsiString; pCharReplaceTable: pByteArray);
var
  len: integer;
  p: pInteger;
begin
  len:=Length(s);
  p:=pointer(s);
  while len>0 do begin;
    p^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    dec(len,4);
    end;
  end;

function ShaCharReplaceFunc(const s: AnsiString; pCharReplaceTable: pByteArray): string;
var
  len: integer;
  p, q: pInteger;
begin
  len:=Length(s);
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>0 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677024
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

не подумайте чего-нибудь плохого, UniqueStr пропал в результате проверок в первой процедуре )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677025
Polesov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

Вот результаты полученные с помощью QueryPerformanceCounter:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
const
  z : AnsiString = '1234567890,qwertyuiop,asdfghjkl,zxcvbnm,()-,';
var
  b : int64;
  e : int64;
begin
  QueryPerformanceCounter( b );
  for i := 1 to 10000000 do
    s := ForkReplaceC( z );
  QueryPerformanceCounter( e );
  Memo1.Lines.Add( 'ForkReplaceC: ' + IntToStr( ( e - b ) div 3600 ) );  // 3600 - частота CPU



Видно, что при трех измерениях результаты практически одинаковы:
Код: powershell
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
FastCommatopoint: 1053
UseRepneScasb: 1197
UseLodsD: 685
UseLodsD2: 630
UseLodsB: 731
Rep4Bytes: 846
ForkReplaceC: 655

FastCommatopoint: 1053
UseRepneScasb: 1198
UseLodsD: 685
UseLodsD2: 630
UseLodsB: 730
Rep4Bytes: 844
ForkReplaceC: 654

FastCommatopoint: 1054
UseRepneScasb: 1197
UseLodsD: 683
UseLodsD2: 631
UseLodsB: 729
Rep4Bytes: 845
ForkReplaceC: 656



По моим измерениям видно, что самый быстрый вариант UseLodsD2 :-)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677027
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

если загрузка 100% ядер то увеличивать нет смысла, безусловно. однако обычно ядра недогружены либо из-за дисковых операций либо из-за сети
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677028
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

А строки почему только кратные 4?
SetLength для необнулённого Result в реальном коде, скорее всего, будет давать просадку.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677033
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
И опять-таки Wide string в пролете, а ведь им уже почти десять лет.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677035
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyAleksandr Sharahov,

А строки почему только кратные 4?

Не обязательно кратные. Последний кусок может быть не кратным. Но все равно обработается как 4-байтовый интегер. Если подходить формально, то так делать некорректно по 2 причинам:
1. Выход за границу строки. Но т.к. память выделяется кратно 4, то к AV это не приведет.
2. Терминатор обрабатывается как символ данных и теоретически может быть заменен, если нулевой элемент в таблице замен не равен 0. Но тут уж программист в ответе.

Kazantsev AlexeySetLength для необнулённого Result в реальном коде, скорее всего, будет давать просадку.
А какие тут еще варианты? Setstring или присваивание? Надо бы проверить, конечно.

P.S. Код писал, чтобы сравнить с работой с масками по 4 байта. Получилось примерно одинаково.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677036
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr SharahovА какие тут еще варианты? Setstring или присваивание?
Result := ''; SetLength(Result, ...); Без обнуления на потенциальных реаллоках будет ещё копирование данных происходить.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677043
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyAleksandr SharahovА какие тут еще варианты? Setstring или присваивание?
Result := ''; SetLength(Result, ...); Без обнуления на потенциальных реаллоках будет ещё копирование данных происходить.

Скорее всего, для длинного результата, большего по сравнению с предыдущим так и будет.
Но, с другой стороны, на малых длинах и при меньшей или равной длине нового результата это, вероятно, будет медленнее.
Требуется проверка с тем MM, который предполагается использовать.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677045
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

Можно еще такое проверить
Код: pascal
1.
2.
  if Length(Result)>len then Result:='';
  SetLength(Result, len);
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677047
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

ошибся, неравенство в другую сторону надо
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677049
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Я согласен, что всё это тестировать нужно по месту применения, но даже на малых строках вариант с обнулением выигрывает:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
function getstr(const astr : string): string;
begin
//result := '';
 setlength(result, length(astr));
end;

 for index := 1 to 100000000 do begin
  if odd(index) then
   s := getstr('0123456789')
  else
   s := getstr('01234');
   s1 := s;
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677069
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyЯ согласен, что всё это тестировать нужно по месту применения, но даже на малых строках вариант с обнулением выигрывает:


Сейчас проверил на D7 c FastMM и без него.
Получилось, что SetLength без доп.ухищрений быстрее всего. Наверно сделал что-то не так )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677070
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Я на XE2 проверял с дефолтным FastMM. Противоположный результат.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677077
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
schizinpubпропущено...


А, что даст сотня потоков, если все ядра разобраны ?

Или, я чего то не понимаю...

Сотня потоков даст непрерывную нагрузку на процессор (перемалывает файлы - ждет завершения ввода-вывода)

Она и есть под постоянной загрузкой, если очередь растёт - запускаются дополнительные машины.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677078
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
zinpub,

Да, вот привычка блин, про фастмм забыл
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677079
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyAleksandr Sharahov,

Я на XE2 проверял с дефолтным FastMM. Противоположный результат.

Теперь спать не буду)
Вот ведь вопрос: они там что-то улучшили или что-то сломали?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677083
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Aleksandr SharahovKazantsev AlexeyAleksandr Sharahov,

Я на XE2 проверял с дефолтным FastMM. Противоположный результат.

Теперь спать не буду)
Вот ведь вопрос: они там что-то улучшили или что-то сломали?

А на ХЕ2 строки не уникодные? Я как-то с д7 на ХЕ10 сразу перепрыгнул.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677085
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpubА на ХЕ2 строки не уникодные? Я как-то с д7 на ХЕ10 сразу перепрыгнул.
Юникодные. Они с 2009 юникодные.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677130
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

Да действительно, в некоторых случаях заметно ускорение на уровне ~10%, поправил.
+ Добавил перегруженную функцию, она чуть быстрее, но работает только с одной парой:
Код: 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.
unit ShaCharReplaceUnit;

interface

uses
  SysUtils;

//Do not include #0 into FromChars!
procedure InitCharReplaceTable(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): string; overload;
function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): string; overload;

implementation

//Do not include #0 into FromChars!
procedure InitCharReplaceTable(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do if FromChars[i]<>#0 then pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): string;
var
  len: integer;
  p, q: pInteger;
begin
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>0 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  end;

function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): string;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
label
  loop, last;
begin;
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  chf:=chf xor integer($FFFFFFFF);
  while len>0 do begin;
    ch1:=pinteger(p)^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    pinteger(q)^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  end;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677132
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
Aleksandr SharahovKazantsev Alexey,

Да действительно, в некоторых случаях заметно ускорение на уровне ~10%, поправил.
+ Добавил перегруженную функцию, она чуть быстрее, но работает только с одной парой:
Код: 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.
unit ShaCharReplaceUnit;

interface

uses
  SysUtils;

//Do not include #0 into FromChars!
procedure InitCharReplaceTable(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): string; overload;
function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): string; overload;

implementation

//Do not include #0 into FromChars!
procedure InitCharReplaceTable(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do if FromChars[i]<>#0 then pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): string;
var
  len: integer;
  p, q: pInteger;
begin
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>0 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  end;

function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): string;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
label
  loop, last;
begin;
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  chf:=chf xor integer($FFFFFFFF);
  while len>0 do begin;
    ch1:=pinteger(p)^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    pinteger(q)^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  end;

end.



парни, прекращайте гнать индусский код
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677134
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecator,

а он нам нравится
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677137
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
Aleksandr Sharahovdefecator,

а он нам нравится
великий оптимизатор дарует вам снисхождение !
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677178
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zinpub,

Кстати, на моем компе вот такое получилось быстрее, не говоря уж о 21590243
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
function ReplaceCommaToDot(const s: string): string;
var
  i: integer;
  p: pChar;
begin
  Result:=s;
  UniqueString(Result);
  p:=pointer(Result);
  i:=(Length(Result)-1) and -4;
  while i>=0 do begin;
    if p[i]  =',' then p[i]  :='.';
    if p[i+1]=',' then p[i+1]:='.';
    if p[i+2]=',' then p[i+2]:='.';
    if p[i+3]=',' then p[i+3]:='.';
    dec(i,4);
    end;
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677197
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

а остаток ? Крокодильчикам?)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677201
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоAleksandr Sharahov,

а остаток ? Крокодильчикам?)

А подумать? Крокодильчики съели мозг?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677202
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Обновил модуль, теперь можно менять любой символ строки (даже #0) на любой:
Код: 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.
unit ShaCharReplaceUnit;

interface

uses
  SysUtils;

procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): string; overload;
function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): string; overload;

implementation

procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do if FromChars[i]<>#0 then pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): string;
var
  len: integer;
  p, q: pInteger;
begin
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>3 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    pByteArray(q)[len]:=pCharReplaceTable[pByteArray(p)[len]];
    end;
  end;

function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): string;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
  ch: AnsiChar;
label
  loop, last;
begin;
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  chf:=chf xor integer($FFFFFFFF);
  while len>3 do begin;
    ch1:=p^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    q^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    ch:=pChar(p)[len];
    if ch=chFrom then ch:=chTo;
    pChar(q)[len]:=ch;
    end;
  end;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677206
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

забыл поправить процедуру инициализации с учетом последнего изменения
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677219
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Не то (Прошлый код) и не тот, один и тот же результат
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677222
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Если заменить string на AnsiString то норм. Подправь это расхождение. Ато принимаешь AnsiString а возвращаешь string
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677223
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоЕсли заменить string на AnsiString то норм. Подправь это расхождение. Ато принимаешь AnsiString а возвращаешь string

Спасибо, поправил. Исправленная версия:
Код: 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.
unit ShaCharReplaceUnit;

interface

uses
  SysUtils;

procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): AnsiString; overload;
function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): AnsiString; overload;

implementation

procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): AnsiString;
var
  len: integer;
  p, q: pInteger;
begin
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>3 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    pByteArray(q)[len]:=pCharReplaceTable[pByteArray(p)[len]];
    end;
  end;

function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): AnsiString;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
  ch: AnsiChar;
label
  loop, last;
begin;
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  chf:=chf xor integer($FFFFFFFF);
  while len>3 do begin;
    ch1:=p^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    q^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    ch:=pAnsiChar(p)[len];
    if ch=chFrom then ch:=chTo;
    pAnsiChar(q)[len]:=ch;
    end;
  end;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677250
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
Aleksandr SharahovГирлионайльдоЕсли заменить string на AnsiString то норм. Подправь это расхождение. Ато принимаешь AnsiString а возвращаешь string

Спасибо, поправил. Исправленная версия:
Код: 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.
unit ShaCharReplaceUnit;

interface

uses
  SysUtils;

procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): AnsiString; overload;
function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): AnsiString; overload;

implementation

procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): AnsiString;
var
  len: integer;
  p, q: pInteger;
begin
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>3 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    pByteArray(q)[len]:=pCharReplaceTable[pByteArray(p)[len]];
    end;
  end;

function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): AnsiString;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
  ch: AnsiChar;
label
  loop, last;
begin;
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  chf:=chf xor integer($FFFFFFFF);
  while len>3 do begin;
    ch1:=p^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    q^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    ch:=pAnsiChar(p)[len];
    if ch=chFrom then ch:=chTo;
    pAnsiChar(q)[len]:=ch;
    end;
  end;

end.



боги индусского кода ))))
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677253
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecator,

на самом деле это очень полезная функция,
через нее можно делать всевозможные перекодировки, upper/lower и т.п.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677269
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahovdefecator,

на самом деле это очень полезная функция,
через нее можно делать всевозможные перекодировки, upper/lower и т.п.

LCMapString(Ex) еще более полезная функция, а главное - она уже написана и оттестирована.
А на все остальное с лихвой хватает StringReplace.

Саша, при всем к тебе уважении, рассчитывать на включение такого кода в более или менее серьезный проект - это слишком радужно
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677271
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schi,

так это, стреляли...
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677280
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь,

сейчас ради интереса сравнил скорость с AnsiUpperCase, она отличается на порядок,
но это, конечно, фигня, недостойная включения в более-менее серьезный проект )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677323
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr SharahovИгорь,

сейчас ради интереса сравнил скорость с AnsiUpperCase, она отличается на порядок,
но это, конечно, фигня, недостойная включения в более-менее серьезный проект )

А кому она нужна, эта скорость AnsiUpperCase в более или менее серьезном проекте ? Правильно - никому. Потому что в серьезных проектах все уже давно перешли на юникод
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677326
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiAleksandr SharahovИгорь,

сейчас ради интереса сравнил скорость с AnsiUpperCase, она отличается на порядок,
но это, конечно, фигня, недостойная включения в более-менее серьезный проект )

А кому она нужна, эта скорость AnsiUpperCase в более или менее серьезном проекте ? Правильно - никому. Потому что в серьезных проектах все уже давно перешли на юникод

Тебе, конечно, видней.
Ты ведь знаешь все более или менее серьезные проекты и все, что им нужно )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677333
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiА кому она нужна, эта скорость AnsiUpperCase в более или менее серьезном проекте ? Правильно - никому. Потому что в серьезных проектах все уже давно перешли на юникод
Внезапно в юникодных дельфях AnsiUpperCase работает с ... юникодом.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677543
vavan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiПотому что в серьезных проектах все уже давно перешли на юникодсразу вспоминается jep 254. надо бы попросить еще поддержку 7-битных строк
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677554
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiА на все остальное с лихвой хватает StringReplace.
В более новых версия ее подрихтовали, но вплоть до ХЕ2 на нее было не взглянуть без слез. Убийца производительности. А уж для замены или удаления символов ее юзать - разве что на очень нетребовательных проектах.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677572
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Василий 2schiА на все остальное с лихвой хватает StringReplace.
В более новых версия ее подрихтовали, но вплоть до ХЕ2 на нее было не взглянуть без слез. Убийца производительности. А уж для замены или удаления символов ее юзать - разве что на очень нетребовательных проектах.

Я, за более чем 35 лет программирования, ни разу не видел, чтобы в информационных системах узким местом в производительности была замена символов. Возможно, мне не повезло
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39677772
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Еще вариант с чтением четверками (замена по месту, строки родные). Начинает обходить простейший for с длины строки 5, прирост становится больше с увеличением длины, но не превышает 50%.

Код: 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.
procedure ReplaceChar(var s: string; FromChar, ToChar: Char);
var
  len, tail: Cardinal;
  pStart, pEndDiv4: pChar;

  procedure Repl(p: PChar; FromChar, ToChar: Char); inline;
  begin
    if p^ = FromChar then p^ := ToChar;
  end;

begin
  pStart := Pointer(s);
  len := Length(s);
  tail := len mod 4;
  pEndDiv4 := pStart + len - tail;
  while pStart < pEndDiv4 do
  begin
    Repl(pStart,   FromChar, ToChar);
    Repl(pStart+1, FromChar, ToChar);
    Repl(pStart+2, FromChar, ToChar);
    Repl(pStart+3, FromChar, ToChar);
    Inc(pStart, 4);
  end;

  if tail > 2 then
    Repl(pStart + 2, FromChar, ToChar);
  if tail > 1 then
    Repl(pStart + 1, FromChar, ToChar);
  if tail > 0 then
    Repl(pStart + 0, FromChar, ToChar);
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679249
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
"Ну куда он, куда он гонится?
Неужель он не знает, что живых коней
Победила стальная конница?"
https://godbolt.org/g/zgmGz8
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679257
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Sapersky,

было бы интересно увидеть завершенную процедуру на Delphi (BASM) и замерить скорость.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679259
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Aleksandr Sharahov,
Вручную конвертировать под дельфийский ассемблер - дурное занятие, недавно была ветка про линковку сишного кода.
Для 64 бит:
{$LINK 'clang_sse.o'}
procedure ReplaceChr(s : PAnsiChar; Cnt : Integer; FromChar, ToChar : AnsiChar); cdecl; external;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679262
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Sapersky,

ну ладно, будет время проверю при случае.

Ща проверил свои поделки на СЕ.

Ассемблерный выхлоп из-под СЕ оказался медленнее, чем из-под D7, основной цикл на 16 байт длиннее.
Ускорение по сравнению с RTL уменьшилось с 7-9 раз всего до 3 раз.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679307
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Если надо 32 бита, то могу предложить только в виде dll-ки, 32-битные obj так запросто не линкуются и конверсия в omf почему-то не помогает.
procedure ReplaceChr(s : PAnsiChar; Cnt : Integer; FromChar, ToChar : AnsiChar); cdecl; external 'gcc_sse32.dll';
Aleksandr SharahovАссемблерный выхлоп из-под СЕ оказался медленнее, чем из-под D7Там же FPC в качестве компилятора Паскаля, все претензии ему.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679309
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Sapersky,

Код: pascal
1.
ReplaceChr(var s: PAnsiChar; 



А во вторых
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679310
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
SaperskyЕсли надо 32 бита, то могу предложить только в виде dll-ки, 32-битные obj так запросто не линкуются и конверсия в omf почему-то не помогает.
procedure ReplaceChr(s : PAnsiChar; Cnt : Integer; FromChar, ToChar : AnsiChar); cdecl; external 'gcc_sse32.dll';
Aleksandr SharahovАссемблерный выхлоп из-под СЕ оказался медленнее, чем из-под D7Там же FPC в качестве компилятора Паскаля, все претензии ему.

http://www.sql.ru/forum/actualfile.aspx?id=21602858] Приложенный файл (Str_Replace_dll32.zip - 132Kb)
это чудовищно.
замена символа превратилась в монстра
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679311
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679312
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
*4.1
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679315
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Гирлионайльдо,

да, SSE4 нужен. И нет, s там просто указатель, без var.

авторзамена символа превратилась в монстра
Это просто для тестирования, так-то можно и компактнее. 2 системных dll-ки - багофича последних версий gcc.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679316
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Sapersky,

результат в ms под D7 (в цикле 20000 раз массив 1024 строк длиной 9..99):

Код: pascal
1.
2.
3.
4.
1000  ShaCharReplace1            - замена 1 на 1
1000  ShaCharReplace2            - таблица 
2875  ReplaceCommaToDot       - цикл развернут x4 
1968  gccReplaceCommaToDot  - sse
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679318
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

забыл привести исходник:
Код: pascal
1.
2.
3.
4.
5.
6.
function gccReplaceCommaToDot(const s: AnsiString): AnsiString; //
begin
  Result:=s;
  UniqueString(Result);
  ReplaceChr(pointer(Result), Length(Result), ',', '.');
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679322
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Aleksandr Sharahov,

По-моему на коротких строках начинает упираться в дельфийскую обвязку, все эти UniqueString и т.д.
Т.е. если делать в цикле так:
ReplaceChr(@s[1], c, ',', '.');
то быстро, а если так:
s1 := s;
ReplaceChr(@s1[1], c, ',', '.');
то медленнее в 10 раз (UniqueString создаёт новую строку, а в первом случае нет).
Возможно это более жизненный сценарий, но получается, что тестируем в основном оптимальность перераспределения памяти.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679325
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SaperskyAleksandr Sharahov,

По-моему на коротких строках начинает упираться в дельфийскую обвязку, все эти UniqueString и т.д.
Т.е. если делать в цикле так:
ReplaceChr(@s[1], c, ',', '.');
то быстро, а если так:
s1 := s;
ReplaceChr(@s1[1], c, ',', '.');
то медленнее в 10 раз (UniqueString создаёт новую строку, а в первом случае нет).
Возможно это более жизненный сценарий, но получается, что тестируем в основном оптимальность перераспределения памяти.

На строках длиной 89..99 разница менее заметна, но есть

1485 ShaCharReplace1
1453 ShaCharReplace2
3718 ReplaceCommaToDot
1844 gccReplaceCommaToDot
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679326
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
обвязка необходима, чтобы не портить исходную строку
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679329
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecatorэто чудовищно.
замена символа превратилась в монстраЯ вот думаю, почему еще никто как обычно не предложил использовать для этого БД?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679342
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Aleksandr Sharahovобвязка необходима, чтобы не портить исходную строку
Но тогда пусть обвязка будет одинаковой. Добавил в DLL функцию:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
procedure ReplaceChr2(Src, Dst : PAnsiChar; Cnt : Integer; FromChar, ToChar : AnsiChar); cdecl; external 'gcc_sse32.dll';
// Использование
function gccReplaceCommaToDot(const s: AnsiString): AnsiString;
Var len : Integer;
begin
  len := Length(s);
  Result := '';
  SetLength(Result, len);
  ReplaceChr2(pointer(s), pointer(Result), len, ',', '.');
end;


Впрочем, махинации с памятью всё равно скрывают преимущество сишного варианта до длины строк в 100+ символов.

Можно убрать перевыделение в ShaCharReplace и сравнивать с ReplaceChr2, тогда разница заметнее.

Код: 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.
procedure ShaCharReplacePtr(Src, Dst: PAnsiChar; len : Integer; chFrom, chTo: AnsiChar);
var
  ch1, ch2, chf, cht: integer;
  p, q: pInteger;
  ch: AnsiChar;
begin;
  p:=pointer(Src);
  q:=pointer(Dst);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  chf:=chf xor integer($FFFFFFFF);
  while len>3 do begin;
    ch1:=p^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    q^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
  end;
  while len>0 do begin;
    dec(len);
    ch:=pAnsiChar(p)[len];
    if ch=chFrom then ch:=chTo;
    pAnsiChar(q)[len]:=ch;
  end;
end;


...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679345
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SSE2

function
Код: 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.
type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

function RepSSE22(const Str: ApPChar; FromChar, SetChar: AnsiChar; len: Integer)
  : ApPChar; assembler;
asm
  mov     edi, len
  push    ebp
  push    ebx
  push    edi
  push    esi
  sub     esp, 12
  mov     esi, eax
  mov     dword ptr [esp + 8], ecx
  mov     ebp, edx
  call    SysGetMem
  test    edi, edi
  jle     @@toto1_8
  xor     ecx, ecx
  cmp     edi, 31
  jbe     @@toto1_5
  mov     edx, ebp
  mov     ecx, edi
  movzx   edx, dl
  and     ecx, -32
  movd    xmm0, edx
  movzx   edx, byte ptr [esp + 8]
  punpcklbw       xmm0, xmm0
  pshuflw xmm0, xmm0, 224
  pshufd  xmm0, xmm0, 0
  movd    xmm1, edx
  xor     edx, edx
  punpcklbw       xmm1, xmm1
  pshuflw xmm1, xmm1, 224
  pshufd  xmm1, xmm1, 0
@@toto1_3:
  movdqu  xmm2, [esi + edx]
  movdqu  xmm3, [esi + edx + 16]
  movdqa  xmm6, xmm1
  movdqa  xmm4, xmm2
  movdqa  xmm5, xmm3
  pcmpeqb xmm4, xmm0
  pcmpeqb xmm5, xmm0
  pand    xmm6, xmm4
  pandn   xmm4, xmm2
  por     xmm4, xmm6
  movdqa  xmm6, xmm1
  pand    xmm6, xmm5
  pandn   xmm5, xmm3
  movdqu  [eax + edx], xmm4
  por     xmm5, xmm6
  movdqu  [eax + edx + 16], xmm5
  add     edx, 32
  cmp     ecx, edx
  jne     @@toto1_3
@@toto1_4:
  cmp     edi, ecx
  je      @@toto1_8
@@toto1_5:
  mov     dl, byte ptr [esi + ecx]
  mov     ebx, ebp
  cmp     dl, bl
  mov     ebx, dword ptr [esp + 8] // 4-byte Reload
  mov     dh, bl
  je      @@toto1_7
  mov     dh, dl
@@toto1_7:
  mov     byte ptr [eax + ecx], dh
  inc     ecx
  jmp     @@toto1_4
@@toto1_8:
  add     esp, 12
  pop     esi
  pop     edi
  pop     ebx
  pop     ebp
end;



Test
Код: pascal
1.
2.
3.
4.
  Str := ' TestString - rehrthrth - - - - - - - - - -Yes - ';
  NewStr := RepSSE22(Str, '-', '!', Length(Str));

  Writeln(NewStr);  //  TestString ! rehrthrth ! ! ! ! ! ! ! ! ! !Yes !




Код: 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.
program Project1;

uses
  System.SysUtils;

type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;

function RepSSE22(const Str: ApPChar; FromChar, SetChar: AnsiChar; len: Integer)
  : ApPChar; assembler;
asm
  mov     edi, len
  push    ebp
  push    ebx
  push    edi
  push    esi
  sub     esp, 12
  mov     esi, eax
  mov     dword ptr [esp + 8], ecx
  mov     ebp, edx
  call    SysGetMem
  test    edi, edi
  jle     @@toto1_8
  xor     ecx, ecx
  cmp     edi, 31
  jbe     @@toto1_5
  mov     edx, ebp
  mov     ecx, edi
  movzx   edx, dl
  and     ecx, -32
  movd    xmm0, edx
  movzx   edx, byte ptr [esp + 8]
  punpcklbw       xmm0, xmm0
  pshuflw xmm0, xmm0, 224
  pshufd  xmm0, xmm0, 0
  movd    xmm1, edx
  xor     edx, edx
  punpcklbw       xmm1, xmm1
  pshuflw xmm1, xmm1, 224
  pshufd  xmm1, xmm1, 0
@@toto1_3:
  movdqu  xmm2, [esi + edx]
  movdqu  xmm3, [esi + edx + 16]
  movdqa  xmm6, xmm1
  movdqa  xmm4, xmm2
  movdqa  xmm5, xmm3
  pcmpeqb xmm4, xmm0
  pcmpeqb xmm5, xmm0
  pand    xmm6, xmm4
  pandn   xmm4, xmm2
  por     xmm4, xmm6
  movdqa  xmm6, xmm1
  pand    xmm6, xmm5
  pandn   xmm5, xmm3
  movdqu  [eax + edx], xmm4
  por     xmm5, xmm6
  movdqu  [eax + edx + 16], xmm5
  add     edx, 32
  cmp     ecx, edx
  jne     @@toto1_3
@@toto1_4:
  cmp     edi, ecx
  je      @@toto1_8
@@toto1_5:
  mov     dl, byte ptr [esi + ecx]
  mov     ebx, ebp
  cmp     dl, bl
  mov     ebx, dword ptr [esp + 8] // 4-byte Reload
  mov     dh, bl
  je      @@toto1_7
  mov     dh, dl
@@toto1_7:
  mov     byte ptr [eax + ecx], dh
  inc     ecx
  jmp     @@toto1_4
@@toto1_8:
  add     esp, 12
  pop     esi
  pop     edi
  pop     ebx
  pop     ebp
end;

var
  NewStr, Str: ApPChar;

begin
  Str := ' TestString - rehrthrth - - - - - - - - - -Yes - ';
  NewStr := RepSSE22(Str, '-', '!', Length(Str));
  Writeln(NewStr);

  Readln;

end.

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679346
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Sapersky,

Убрал всю работу с памятью, в процедуре оставил правку на месте.
Преимущество sse на коротких строках в 2 раза, на длинных - в 3 раза:

Код: pascal
1.
2.
3.
4.
1516  ShaCharReplace1
1421  ShaCharReplace2
1141  ShaCharReplaceЗProc - на месте
344  ReplaceChr                  - на месте



Теперь дело за табличным вариантом на sse )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679347
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

AV на
movdqu [eax + edx], xmm4
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679348
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Sapersky,

Результат твоей новой sse-функции с учетом выделения памяти
на коротких строках примерно совпадает с моим,
а на длинных в 2 раза лучше:

Код: pascal
1.
2.
3.
4.
1500  ShaCharReplace1
1422  ShaCharReplace2
3734  ReplaceCommaToDot
797  gccReplaceCommaToDot
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679350
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а на очень длинных в 6 раз!
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679358
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Это потому что надо ручками освобождать память.

Вот автоматическое. Проверь эту. Снизу есть TestSSE

Код: 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.
type
  ApChar = AnsiChar;
  ApString = AnsiString;
  ApPChar = PAnsiChar;


procedure RepSSE2(len: Integer; NewStr: ApPChar; const Str: ApPChar;
  FromChar, SetChar: AnsiChar); assembler;
asm
  push    ebx
  push    edi
  push    esi
  test    eax, eax
  jle     @@toto0_10
  xor     esi, esi
  cmp     eax, 31
  jbe     @@toto0_7
  lea     edi, [ecx + eax]
  cmp     edi, edx
  jbe     @@toto0_4
  lea     edi, [edx + eax]
  cmp     edi, ecx
  ja      @@toto0_7
@@toto0_4:
  movzx   edi,  FromChar
  mov     esi, eax
  and     esi, -32
  movd    xmm0, edi
  movzx   edi,  SetChar
  punpcklbw       xmm0, xmm0     
  pshuflw xmm0, xmm0, 224       
  pshufd  xmm0, xmm0, 0         
  movd    xmm1, edi
  xor     edi, edi
  punpcklbw       xmm1, xmm1     
  pshuflw xmm1, xmm1, 224        
  pshufd  xmm1, xmm1, 0         
@@toto0_5:                            
  movdqu  xmm2, [ecx + edi]
  movdqu  xmm3, [ecx + edi + 16]
  movdqa  xmm6, xmm1
  movdqa  xmm4, xmm2
  movdqa  xmm5, xmm3
  pcmpeqb xmm4, xmm0
  pcmpeqb xmm5, xmm0
  pand    xmm6, xmm4
  pandn   xmm4, xmm2
  por     xmm4, xmm6
  movdqa  xmm6, xmm1
  pand    xmm6, xmm5
  pandn   xmm5, xmm3
  movdqu  [edx + edi], xmm4
  por     xmm5, xmm6
  movdqu  [edx + edi + 16], xmm5
  add     edi, 32
  cmp     esi, edi
  jne     @@toto0_5
  cmp     esi, eax
  je      @@toto0_10
@@toto0_7:                            
  mov     bh, byte ptr [ecx + esi]
  mov     bl, SetChar
  cmp     bh,  FromChar
  je      @@toto0_9
  mov     bl, bh
@@toto0_9:                               
  mov     byte ptr [edx + esi], bl
  inc     esi
  cmp     eax, esi
  jne     @@toto0_7
@@toto0_10:
  pop     esi
  pop     edi
  pop     ebx
end;

function TestSSE(const Str: ApPChar): ApString;
var
  tmp: ApPChar;
  len: Integer;
begin
  len := length(Str);
  SetLength(Result, len);
  RepSSE2(len, ApPChar(Result), Str, ',', '!');
end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679408
Valery_B
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Посмотрел на код
Код: pascal
1.
2.
procedure ReplaceChr2(Src, Dst : PAnsiChar; Cnt : Integer; FromChar, ToChar : AnsiChar); cdecl; external 'gcc_sse32.dll';
procedure RepSSE2(len: Integer; NewStr: ApPChar; const Str: ApPChar;  FromChar, SetChar: AnsiChar); assembler;



Первая мысль:
YouTube Video
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679410
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я, впрочем, сразу говорил, что в SIMD уходить нужно )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679435
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Valery_B,

И что ? То что аргументы похожи ? А как иначе сделать выделение строки - освобождаемой автоматически ? Если у Delphi нет такой возможности через обычные выделялки.

Это работает так. Ты выделяешь строку. Но она никуда не девается. Ей надо сделать Resize .. Больше или меньше в любом случае.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679437
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

скорее он говорит о том, что всё уже сделано до нас )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679443
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679451
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я всегда верил в мощь ума наших программистов. Жалко только, что он на всякую ерунду растрачивается
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679476
zinpub
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Про SSE сам читаю как раз... да это здорово выходит!

Осталось придумать, как в D5 запилить :-)
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679483
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

второе место, немного отстает на всех длинах:
Код: pascal
1.
2.
3.
4.
9875  ShaCharReplace1
9172  ShaCharReplace2
1609  TestSSE2
1563  gccReplaceCommaToDot




не понял, это нафига? строки не могут перекрываться:
Код: pascal
1.
2.
3.
4.
5.
6.
  lea     edi, [ecx + eax]
  cmp     edi, edx
  jbe     @@toto0_4
  lea     edi, [edx + eax]
  cmp     edi, ecx
  ja      @@toto0_7
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679551
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

А можешь приложить свой тестер ? Хочу оптимизировать его на твоём

-- Это его так Clang сделал. И действительно. Это не нужный код
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679584
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоAleksandr Sharahov,

А можешь приложить свой тестер ? Хочу оптимизировать его на твоём

-- Это его так Clang сделал. И действительно. Это не нужный код


Специального тестера у меня нет. Но там примитивно все: генерируется массив случайных строк и потом в цикле крутим вызовы, время по GetTickCount.

Просто у меня там много лишнего наворочено (валидации разные + другие функции), выбрасывать долго + боюсь запутаться в этом хламе.

Оптимизировать там ничего не надо, надо просто преломить паскальную версию к SSE,
предварительно pxor xmm1, xmm0 и далее в цикле:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
  
  movdqu  xmm2, [ecx + edi]
  movdqu  xmm3, [ecx + edi + 16]
  movdqa  xmm4, xmm2
  movdqa  xmm5, xmm3
  pcmpeqb xmm2, xmm0
  pcmpeqb xmm3, xmm0
  pand    xmm2, xmm1
  pand    xmm3, xmm1
  pxor    xmm2, xmm4
  pxor    xmm3, xmm5



Вечером проверю, думаю, быстрее будет.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679622
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Это 32 символа если что.

Насчёт GetTickCount я вообще не уверен, у неё погрешность есть от "of 10 milliseconds to 16 milliseconds." до 30 как показывает практика
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679627
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоAleksandr Sharahov,

Это 32 символа если что.

Насчёт GetTickCount я вообще не уверен, у неё погрешность есть от "of 10 milliseconds to 16 milliseconds." до 30 как показывает практика

я знаю, если что )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679740
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
проверил на строках длиной 899..999

Код: pascal
1.
2.
3.
4.
5.
10532  ShaCharReplace1
9734  ShaCharReplace2
1797  TestSSE2
1625  gccReplaceCommaToDot
1515  ShaCharReplaceSSE



исходник
Код: 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.
procedure InternalReplaceSSE(p, q: pointer; chf, cht: integer);
asm
  movd    xmm0, ecx
  movd    xmm1, cht
  mov     ecx, [eax-4]
  and     ecx, -32
  pshufd  xmm0, xmm0, 0
  pshufd  xmm1, xmm1, 0
@@loop:
  movdqu  xmm2, [eax]
  movdqu  xmm3, [eax + 16]
  movdqa  xmm4, xmm2
  movdqa  xmm5, xmm3
  pcmpeqb xmm2, xmm0
  pcmpeqb xmm3, xmm0
  pand    xmm2, xmm1
  pand    xmm3, xmm1
  pxor    xmm2, xmm4
  pxor    xmm3, xmm5
  movdqu  [edx], xmm2
  movdqu  [edx + 16], xmm3
  add     eax, 32
  add     edx, 32
  sub     ecx, 32
  jg      @@loop
  end;

function ShaCharReplaceSSE(const s: AnsiString; chFrom, chTo: AnsiChar): AnsiString;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
  ch: AnsiChar;
label
  loop, last;
begin;
  len:=Length(s);
  Result:='';
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  if len>31 then begin;
    InternalReplaceSSE(p, q, chf, cht);
    inc(pChar(p), len and -32);
    inc(pChar(q), len and -32);
    len:=len and 31;
    end;
  chf:=chf xor integer($FFFFFFFF);
  while len>3 do begin;
    ch1:=p^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    q^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    ch:=pAnsiChar(p)[len];
    if ch=chFrom then ch:=chTo;
    pAnsiChar(q)[len]:=ch;
    end;
  end;

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679862
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Молодец Очень быстро!
Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
UseLodsD             -> 00:04:425
TestSSE2             -> 00:02:319
ShaCharReplaceSSE2   -> 00:00:887
Самый быстрый: 3     -> 00:00:887
------------------------------------------------------
UseLodsD             -> 00:04:454
TestSSE2             -> 00:02:214
ShaCharReplaceSSE2   -> 00:00:806
Самый быстрый: 3     -> 00:00:806
------------------------------------------------------
UseLodsD             -> 00:04:123
TestSSE2             -> 00:02:122
ShaCharReplaceSSE2   -> 00:00:802
Самый быстрый: 3     -> 00:00:802
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679865
Toxic Phantom
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
idHTTP отправляет POST запрос на локальный сервер в base64 кодировке, обратно ответ прямо в StringList пишется. При всех кажущихся недостатках, таким образом удается подключить php в котором обработка строк делается изящно и на раз-два. Так нельзя делать а то вдруг проект за день заработает вместо двух недель
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679867
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Toxic PhantomidHTTP отправляет POST запрос на локальный сервер в base64 кодировке, обратно ответ прямо в StringList пишется. При всех кажущихся недостатках, таким образом удается подключить php в котором обработка строк делается изящно и на раз-два. Так нельзя делать а то вдруг проект за день заработает вместо двух недельОригинально. Я то думал рано или поздно предложат использовать БД. А тут таки php сервер!
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679871
Toxic Phantom
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat,

Ну а что делать? сервер рядом, линк гигабитный, памяти везде с избытком
Так же использую БД в качестве динамического массива. То есть dbGrid он завязан на таблицу, на клик обработчик.. При клике запись удаляется, все на лету рефрешится. В конце кнопочка подтверждение и то что осталось пишется в другую таблицу. Все работает на самом деле. Главное чтобы работало... Если на выставку то конечно так нельзя делать.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679876
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat, Toxic Phantom,

лучше жуйте
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679878
Toxic Phantom
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat, Оценка меня человеком не имеющего своих мыслей, и соответственно достижений в жизни, зато пользующимся мыслями другого человека с родовой травмой меня совершенно не интересует.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679879
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Aleksandr Sharahovrgreat, Toxic Phantom,

лучше жуйте
+1

Рано сдаваться.
Страниц на тридцать тема потянет, не меньше.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679881
Фотография JayDi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччД__Aleksandr Sharahovrgreat, Toxic Phantom,

лучше жуйте
+1

Рано сдаваться.
Страниц на тридцать тема потянет, не меньше.
Зря смеетесь. То, что передача текстовых данных в сервис на пхп и возврат результата -- работает быстрее родного кода на делфи -- местные фанатики делфи должны голову пеплом посыпать.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679882
Toxic Phantom
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Страдайте - я ж не против. У нищих своя правда всегда, с которой сложно спорить. Бояре берут ЭВМ с 32гб озу и на ССД, обрабатывают разные части проекта технологиями которые под это подходят , крепостные стараются угодить внутреннему преподавателю информатики. По этому бояре работают на дорогих машинах а крепостные улучшают... )) Вам с этим жить, даже если это боль и слезы.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679884
Toxic Phantom
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
JaDi, да, быстро, прекрасно работает, уже более 10 лет юзаю.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679887
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
JaDiЗря смеетесь. То, что передача текстовых данных в сервис на пхп и возврат результата -- работает быстрее родного кода на делфи -- местные фанатики делфи должны голову пеплом посыпать.

проще выкопать из пепла того Delphi-программиста и выгнать нафиг
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679889
Фотография softwarer
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
JaDiТо, что передача текстовых данных в сервис на пхп и возврат результата -- работает быстрее родного кода на делфи -- местные фанатики делфи должны голову пеплом посыпать.
Я думаю, автор обидится, если его пеплом посыпать чью-нибудь голову.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679896
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Delphi && PHP
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679897
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
чччД__Тему можно закрывать с пометкой "Solved".

"Пэхапэ рулит" - (с).
тут на форуме некоторое время маячил персонаж,
который обещал написать супер быстрый интерпретатор PHP

Но куда-то слился
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679900
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
defecatorчччД__Тему можно закрывать с пометкой "Solved".

"Пэхапэ рулит" - (с).
тут на форуме некоторое время маячил персонаж,
который обещал написать супер быстрый интерпретатор PHP

Но куда-то слился
Дык, написал и теперь где-то на Багамах поселился, бабло с клиентов стрижет.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679901
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecator,

Заработал миллионы, купил большой двух этажный дом с бассейном и дорогой авто. И больше ничего не надо
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679903
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоDelphi && PHP
Так и знал, что это Няшик
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679907
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

Я не он. Это моя наработка, около 4 месяцев ей. Это легко проверить, проверив какие я темы создавал, например тут
http://www.sql.ru/forum/1291164/bezopastnaya-proverka-na-obekt-ili-klass
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679908
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
JaDiЗря смеетесь. То, что передача текстовых данных в сервис на пхп и возврат результата -- работает быстрее родного кода на делфи -- местные фанатики делфи должны голову пеплом посыпать.Бенч в студию!
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679909
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
rgreatJaDiЗря смеетесь. То, что передача текстовых данных в сервис на пхп и возврат результата -- работает быстрее родного кода на делфи -- местные фанатики делфи должны голову пеплом посыпать.Бенч в студию!
какой бенч ? это же Жадик
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679916
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Передача файла на сервер может происходить в двух случаях из PHP

1) Curl - Post
Код: php
1.
2.
3.
4.
5.
6.
7.
8.
9.
Function LoadFilePost($url, $ParamPost) {
$url = curl_init($url);
curl_setopt($url, 47, 1);
curl_setopt($url, 10015, $ParamPost);
$Result = curl_exec($url);
curl_close($url);
unset($url, $ParamPos);
return $Result;
} 



Допустим на сервере
Код: php
1.
2.
3.
 <?php
move_uploaded_file($_FILES['File']['tmp_name'], $_FILES['File']['name']);
?> 



Загрузка
Код: php
1.
2.
3.
4.
$File = 'file.ext';
LoadFilePost('http://.....com/uploaded_file.php', array(
'name' => basename($File),
'File' => "@".$File));  





2) И посредством сокетов
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679919
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
3) Через любимый HttpRequest
http://php.net/manual/pl/httprequest.setpostfields.php
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679920
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
квантовые вычисления предлагали?
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679924
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
makhaonквантовые вычисления предлагали?
Да, конечно: 21606031 .
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679929
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоЯ не он
Плохо шифруешься, Никита Фролов
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679935
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

Ошибся немного. https://vk.com/jj_jj95
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679942
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоОшибся немного. https://vk.com/jj_jj95
Это ещё один твой виртуал?

Вот эта твоя наработка удивительным образом, как две капли воды, похожа вот на это .
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39679966
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
Kazantsev AlexeyГирлионайльдоОшибся немного. https://vk.com/jj_jj95
Это ещё один твой виртуал?

Вот эта твоя наработка удивительным образом, как две капли воды, похожа вот на это .
няшик спалился
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680032
vavan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоМолодец Очень быстро!сперва пободались а потом традиционно пришел лесникшарахов и всех разогнал
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680064
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да ладно. Шарахов позаимствовал главную ускорялку у компилятора Си и соединил её со своим криптокодом (который видимо и даёт ускорение на длинах меньше 32).

В результате:
На Дельфи 65 строк кода и на 10% быстрее.
На Си 5 строк (простых как мычание), или даже 3, если скобки не считать. При этом больше гибкость - перекомпилируется под любой набор инструкций, Unicode и т.д.

Мне второй вариант больше нравится. Хотя дело вкуса.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680076
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
А изначальный посыл был в том, что сишный компилятор где-то уже может заменить Шарахова :)

Как его использовать - другое дело, но копипастить ассемблер по-моему сомнительное занятие. Я пробовал и намучился, пришлось прилично править т.к. в X86 нет полностью эквивалентного соглашания о вызовах, работу со стеком переделывал и т.д. Лучше линковка или DLL.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680078
vavan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SaperskyНа Си 5 строк (простых как мычание), или даже 3, если скобки не считать. При этом больше гибкость - перекомпилируется под любой набор инструкций, Unicode и т.д.

Мне второй вариант больше нравится. Хотя дело вкусада я так-то сишник и сам неоднократно тут говорил что борландячий компайлер из прошлого тысячелетия, не все просто в курсе. когда на vs пишу тоже в голову не приходит асм юзать и особо заморачиваться
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680082
vavan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SaperskyЛучше линковка или DLLага, чуть ли не в том еще веке порой математику и прочую критичную числогрызню цепляли к борландовому фронту в виде длл собранной скажем интелячьим компайлером
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680112
Sapersky
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Сейчас и бесплатные GCC/Clang вроде ничего.

Но заметный эффект получается, только если алгоритм в принципе векторизуется. Или его можно переписать так, чтобы векторизовался.
За исключением может быть плавающей точки на x86 компиляторе Дельфи, которая такая медленная, что и переписывание "в лоб" на Си может помочь.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680126
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SaperskyДа ладно. Шарахов позаимствовал главную ускорялку у компилятора Си и соединил её со своим криптокодом (который видимо и даёт ускорение на длинах меньше 32).

В результате:
На Дельфи 65 строк кода и на 10% быстрее.
На Си 5 строк (простых как мычание), или даже 3, если скобки не считать. При этом больше гибкость - перекомпилируется под любой набор инструкций, Unicode и т.д.

Мне второй вариант больше нравится. Хотя дело вкуса.

Си заставил посмотреть в сторону SSE.
Потому как не может бездушная железяка все такое )

Но если без эмоций вникнуть в код, то увидишь,
что мой SSE-код скорее "позаимствован"
из моего же криптокода на паскале.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680145
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
vavanSaperskyЛучше линковка или DLLага, чуть ли не в том еще веке порой математику и прочую критичную числогрызню цепляли к борландовому фронту в виде длл собранной скажем интелячьим компайлером
... фотртана
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680149
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SaperskyНо заметный эффект получается, только если алгоритм в принципе векторизуется. Или его можно переписать так, чтобы векторизовался.
Я сейчас сижу на core2duo и вообще таких машин ещё - дофига и больше. Так что чистый AVX ещё лет десять минимум (ИМХО) придётся дублировать SSE2+.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680233
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Иногда SSE2 не так уж плох,
тест AnsiUpperCase на строках длины 888..999, SSE42 в пролете:
Код: pascal
1.
2.
3.
4.
5.
16438  AnsiUpperCase - RTL
2609  ShaCharReplace - замена по таблице (параметр)
2625  ShaAnsiUpperCase - замена по таблице (без параметра)
641  ShaAnsiUpperCaseSSE - SSE2, таблица 1251 жестко запаяна
812  ShaAnsiUpperCaseSSE42 - новая инструкция для диапазонов 1251 
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680543
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
топик на время, нетленка навечно:

Как быстро заменить символы в строке http://www.guildalfa.ru/alsha/node/36
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680545
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
Aleksandr Sharahovтопик на время, нетленка навечно:

Как быстро заменить символы в строке http://www.guildalfa.ru/alsha/node/36
хорошо, но представляет лишь академический интерес
лично я в свои проекты не потащу индусский лапшекод, какой бы он ни был быстрый
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680551
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecator,

ладно, считай что отмазался, разрешаю не тащить )
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680578
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov Как быстро заменить символы в строке http://www.guildalfa.ru/alsha/node/36
Мы тут это уже проходили. Если у вас в приложении узкое место - это поиск (и замена) чего-либо в строках, то необходимо включать выравнивание на 16 байт в FastMM и вместо movedq u xmmX, [mem] использовать movedq a , тогда и производительность вырастает в разы, а в случае поиска можно вообще pcmpeqd сразу к памяти применять, без предварительной загрузки в регистр.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680604
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvp,

А такое выравнивание будет работать для строк ? Так как такое не работает
Код: pascal
1.
System.SetMinimumBlockAlignment(mba16Byte);



Я в своё время, делал свои строки, где выделялась ровно 16 через SysGetMem. Структура была такая
Код: pascal
1.
2.
3.
4.
5.
6.
7.
  TMyStr = record 
    WideByte : Boolean; // 2 байта ? Или 1
	StrByte : TArray<Byte>; // Массив байт
	LengthStr : NativeUInt; // Текущая длина
	MaxLengthStr : NativeUInt; // Максимальная длина, с учётом 16 или 8 
	Ref : Cardinal;
   end;



Работа с такой структурой была реализована через record helper for
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680634
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpЕсли у вас в приложении узкое место - это поиск (и замена) чего-либо в строках, то необходимо

Выбросить это приложение и начать жить.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680637
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдоalekcvp,

А такое выравнивание будет работать для строк ? Так как такое не работает
Код: pascal
1.
System.SetMinimumBlockAlignment(mba16Byte);



Прекрасно работает, просто надо учитывать что строка на самом деле - это StrRec (12 байт) + данные, т.е. в начале каждой строки есть 2 невыровненых символа (4 байта), которые надо обработать отдельно, а потом уже можно нормально обрабатывать.

Причём в 64-х битном режиме размер StrRec, внезапно, увеличивается до 16 байт и там все строки автоматически получаются выравненными:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
  StrRec = packed record
  {$IF defined(CPUX64)}
    _Padding: LongInt; // Make 16 byte align for payload..
  {$IFEND}
    codePage: Word;
    elemSize: Word;
    refCnt: Longint;
    length: Longint;
  end;
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680641
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvp,

Даже при mba16Byte SSE откажется работать, из за того что NativeInt(@str[1]) and 15 = 12.


Нет там никаких 4 не выровненных байта на 32 битной платформе.
Код: pascal
1.
GetMem(P, SizeOf(StrRec) + (CharLength + 1) * SizeOf(WideChar));



Что значит, что в структуре StrRec последним перед строкой идёт length. А это значит, что мы можем сделать
Код: pascal
1.
PInteger(PByte(str) - SizeOf(Integer))^



И получить длину. А сделав так.
Код: pascal
1.
2.
3.
4.
5.
6.
    Writeln(PWord(PByte(str)
      - SizeOf(Integer)  {length}
      - SizeOf(Integer)  {refCnt}
      - SizeOf(Word)     {elemSize}
      - SizeOf(Word)     {codePage}
    )^);



Можно уже получить codePage 1200

И того, строка длиной в 4 : (12 + (4 + 1) * 2 = 22) and 15 = 6 И того 10 не выровненных байт. SSE откажется работать в таком случае 100%

... А на 64 битной платформе всё понятно, у них там стаб для SSE 64 битного.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680692
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоИ того, строка длиной в 4 : (12 + (4 + 1) * 2 = 22) and 15 = 6 И того 10 не выровненных байт. SSE откажется работать в таком случае 100%
Я не знаю что и как ты считаешь, но если PStrRec выравнивается на 16 байт, а её размер - 12 байт, то (PStrRec + 4) тоже будет выравнена на 16 байт, это очевидно.

Вот кусок рабочего кода (сравнение строк, а не поиск)
Код: 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.
  ...
  { сначала сравниваем отдельно два первых символа }
  mov     ebx, [eax]
  xor     ebx, [eax + edx]
  jnz     @@exit
  lea     eax, [eax + 4]
  sub     ecx, 2
  jbe     @@exit
  xor     ebx, ebx
  lea     ebx, [ebx - 8]
  test    ecx, ebx
  jz      @@l2c
  { потом в цикле сравниваем по 8 символов (16 байт) }
@@l8c:
  movdqa  xmm0, dqword ptr [eax]
  pcmpeqd xmm0, dqword ptr [eax + edx]
  pmovmskb ebp, xmm0
  sub     ebp, $FFFF
  jnz     @@exit
  lea     eax, [eax + $10]
  lea     ecx, [ecx - $08]
  test    ecx, ebx
  jnz     @@l8c
  ...

...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680693
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
P.S: Так же очевидно, что строки длиной меньше 6 символов обрабатывать через 8-байтные регистры бесcмысленно.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680713
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpAleksandr Sharahov Как быстро заменить символы в строке http://www.guildalfa.ru/alsha/node/36
Мы тут это уже проходили. Если у вас в приложении узкое место - это поиск (и замена) чего-либо в строках, то необходимо включать выравнивание на 16 байт в FastMM и вместо movedq u xmmX, [mem] использовать movedq a , тогда и производительность вырастает в разы, а в случае поиска можно вообще pcmpeqd сразу к памяти применять, без предварительной загрузки в регистр.

Результаты эксперимента на i7-7770 для процедуры SSEReplace из статьи на сайте:

1. одинаковая скорость movdqu и movdqa на выровненных данных
2. падение скорости на 10% у movdqu на невыровненных данных
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680717
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да. Строку можно и ручками выровнять. Но тогда какой смысл ? Лучше сразу работать с выравненными данными. Давая полноценную 16 летную строку с #0 заполнением, умножая на 2 её, когда нет места в ней.

Тогда мы просто будем использовать чистый SSE без всяких выравниваний в SSE
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680721
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

я не собираюсь что-то ручками выравнивать, мысль в другом

1. обе команды равноценны или почти равноценны на выровненных данных
2а. важна скорость не самой команды, а процедуры, в которой она работает
2б. на современном процессоре скорость процедуры отличается на 10% в лучшем случае
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680728
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я самое логичное вижу, это пересобрать модуль System и сделать в нём

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
  PStrRec = ^StrRec;
  StrRec = packed record
    _Padding: Integer; // Make 16 byte align for payload..
    codePage: Word;
    elemSize: Word;
    refCnt: Integer;
    length: Integer;
  end;



Убрав {$IF defined(CPU64BITS)}
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680737
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Глупая идея была. Пересобрал. По прежнему NativeInt(@s[1]) and 15 выдаёт 12

Все asm функции потеряли получение длины, по offset -4
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680746
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я глянул, нигде не используется _Padding

Сделал так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
  StrRec = packed record
    codePage: Word;
    elemSize: Word;
    refCnt: Integer;
    length: Integer;
    _Padding: Integer; // Make 16 byte align for payload..
  end;



В getmem.inc так же

Аналогично
Код: pascal
1.
2.
3.
4.
5.
  TDynArrayRec = packed record
    RefCnt: Integer;
    Length: NativeInt;
    _Padding: Integer; // Make 16 byte align for payload..
  end;




Длина заработала. А выравнивание нету. Такого же как и для 64 bit
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680756
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

думаю, первая попытка была верной, надо внимательней пройтись по CPU64BITS
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680759
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А почему embarcadero такие му**ки? И не могут сделать, сборку всех исходников из исходников.
И исключить все не возможные dcu для сборки?


Все их исходники пересобираются через source\rtl\BuildWinRTL.dproj
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680761
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Не знаю, выравнивания нету никакого. Не знаю почему, всё время 12. Уже всё перетыкал. Другие участки возможные
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
const
  // Using an initialized _AnsiStr to be sure of alignement
  // and so that it is read only.
  // Note: This const assumes a little endian machine.
  EmptyStringA: _AnsiStr =
{$IFDEF CPU64BITS}
  #$00#$00#$00#$00 +  // Padding, data is 16 byte aligned
{$ENDIF}
  #$FF#$FF +          // codePage := FFFF;
  #$01#$00 +          // elemSize := 1;
  #$FF#$FF#$FF#$FF +  // refCnt := -1;
  #$00#$00#$00#$00 +  // length := 0;
  #$00#$00;           // Data   := nil;

  EmptyStringW: _AnsiStr =
{$IFDEF CPU64BITS}
  #$00#$00#$00#$00 +  // Padding, data is 16 byte aligned
{$ENDIF}
  #$FF#$FF +          // codePage := FFFF;
  #$02#$00 +          // elemSize := 2;
  #$FF#$FF#$FF#$FF +  // refCnt := -1;
  #$00#$00#$00#$00 +  // length := 0;
  #$00#$00;           // Data   := nil;



Я трогать не стал. Мб может и в них дела. А может и не в них
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680774
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Короче то, что не работала - это моя жопо рукость. Ибо он собирал по пути
Documents\Embarcadero\Studio\19.0\lib\Win32

Заменив файлики. Я увидел результат
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680776
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоAleksandr Sharahov,

Не знаю, выравнивания нету никакого. Не знаю почему, всё время 12. Уже всё перетыкал. Другие участки возможные
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
const
  // Using an initialized _AnsiStr to be sure of alignement
  // and so that it is read only.
  // Note: This const assumes a little endian machine.
  EmptyStringA: _AnsiStr =
{$IFDEF CPU64BITS}
  #$00#$00#$00#$00 +  // Padding, data is 16 byte aligned
{$ENDIF}
  #$FF#$FF +          // codePage := FFFF;
  #$01#$00 +          // elemSize := 1;
  #$FF#$FF#$FF#$FF +  // refCnt := -1;
  #$00#$00#$00#$00 +  // length := 0;
  #$00#$00;           // Data   := nil;

  EmptyStringW: _AnsiStr =
{$IFDEF CPU64BITS}
  #$00#$00#$00#$00 +  // Padding, data is 16 byte aligned
{$ENDIF}
  #$FF#$FF +          // codePage := FFFF;
  #$02#$00 +          // elemSize := 2;
  #$FF#$FF#$FF#$FF +  // refCnt := -1;
  #$00#$00#$00#$00 +  // length := 0;
  #$00#$00;           // Data   := nil;



Я трогать не стал. Мб может и в них дела. А может и не в них

как я понимаю, этот код относится к строковым константам,
тогда имеет смысл тут тоже раскомментировать,
+ проверить выравнивание констант
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39680777
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov1. одинаковая скорость movdqu и movdqa на выровненных данных
2. падение скорости на 10% у movdqu на невыровненных данных
Если данные выровнены, то можно сравнивать образец сразу с памятью, без загрузки в регистр. Но в случае именно замены символа там код сильно усложнится и это усложнение может съесть весь выигрыш. А вот при сравнении строк - это ускоряет немного.
...
Рейтинг: 0 / 0
Быстрая замена символа
    #39681280
чччД__
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Up!
...
Рейтинг: 0 / 0
259 сообщений из 259, показаны все 11 страниц
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Быстрая замена символа
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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