Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как быстро узнать что в строке одни нули? [D7, XP]


Страницы:   1 2

RusSun ©   (2016-09-03 09:01:00) 

Сабж.

RusSun   (2016-09-04 13:43:00) [1]

to All Спасибо большущее.
Строки от коротких ~16 до более длинных 64 и более символов.
тема закрыта.

Sha   (2016-09-04 12:57:00) [2]

> Игорь Шевченко ©   (04.09.16 12:48) [18]
> Я проверял далеко на не последней, это проверялось на D2006.

ну значит там RTL уже поправлена
 

> Кстати, на юникодных '0' это не байт.

именно поэтому я так аккуратно и назвал свою функцию

Sha   (2016-09-04 12:52:00) [3]

> manaka ©   (04.09.16 12:44) [17]

Берем за образец что-нибудь вроде  

function CharPos(ch: char; const s: string): integer;
var
 i: integer;
begin;
 for i:=1 to Length(s) do if s[i]=ch then begin;
   Result:=i; exit;
   end;
 Result:=0;
 end;


и делаем что-нибудь вроде  

function NonBlankPos(const s: string): integer;
var
 i: integer;
begin;
 for i:=1 to Length(s) do if s[i]>#32 then begin;   //или <>
   Result:=i; exit;
   end;
 Result:=0;
 end;

Игорь Шевченко   (2016-09-04 12:48:00) [4]

Sha ©   (04.09.16 12:29) [16]


> В последних версиях Delphi, вероятно, так и будет


Я проверял далеко на не последней, это проверялось на D2006. Кстати, на юникодных '0' это не байт.

manaka   (2016-09-04 12:44:00) [5]

Удалено модератором
Примечание: Флудить завязывай

Sha   (2016-09-04 12:29:00) [6]

> Игорь Шевченко ©   (04.09.16 12:09) [15]

В последних версиях Delphi, вероятно, так и будет
за счет инлайна и улучшенной функции сравнения.

А у меня (как и у автора) D7.
Там моя быстрее в 2 раза даже на длинных строках.
И мне не хочется думать, что это из-за не очень нового компа )

Игорь Шевченко   (2016-09-04 12:09:00) [7]

Sha ©   (04.09.16 11:36) [13]

Кстати, на длинных строках у меня быстрее получается. Но не думаю, что автору нужно длинные строки сравнивать

Text: "0000000000000000000000000000000000000000000000000000000", length: 55
Sha:                0,167 seconds to compare 10000000 times.
Sniknik:            0,698 seconds to compare 10000000 times.
Igor Schevchenko:   0,143 seconds to compare 10000000 times.

Игорь Шевченко   (2016-09-04 12:05:00) [8]

Дабы не утруждать мозг раздумиями:

Text: "000000000000", length: 12
Sha:                0,090 seconds to compare 10000000 times.
Sniknik:            0,635 seconds to compare 10000000 times.
Igor Schevchenko:   0,110 seconds to compare 10000000 times.
Text: "0", length: 1
Sha:                0,095 seconds to compare 10000000 times.
Sniknik:            0,561 seconds to compare 10000000 times.
Igor Schevchenko:   0,096 seconds to compare 10000000 times.
Text: "Edit1", length: 5
Sha:                0,090 seconds to compare 10000000 times.
Sniknik:            0,563 seconds to compare 10000000 times.
Igor Schevchenko:   0,090 seconds to compare 10000000 times.

Sha   (2016-09-04 11:36:00) [9]

Вариант с развернутым циклом:

function IsBufferOfByte(pBuf: pointer; Len: integer; Value: byte): boolean;
const
 Test: array[0..3] of cardinal= (0, $FF, $FFFF, $FFFFFF);
var
 Mask: cardinal;
 pEnd: pointer;
label
 ExitFalse;
begin;
 if Len=0 then goto ExitFalse;
 Mask:=Value * $01010101;
 pEnd:=@pIntegerArray(pBuf)[Len shr 3 * 2];
 while pBuf<>pEnd do begin;
   if Int64Rec(pBuf^).Lo<>Mask then goto ExitFalse;
   if Int64Rec(pBuf^).Hi<>Mask then goto ExitFalse;
   inc(pInt64(pBuf));
   end;
 if Len and 4<>0 then begin;
   if Cardinal(pBuf^)<>Mask then goto ExitFalse;
   inc(pCardinal(pBuf));
   end;
 Len:=Len and 3;
 if (Len=0) or ((pCardinal(pBuf)^ xor Mask) and Test[Len]=0) then begin;
   Result:=true;
   exit;
   end;
ExitFalse:
 Result:=false;
 end;

Sha   (2016-09-04 09:19:00) [10]

> sniknik ©   (04.09.16 01:52) [11]
> и кстати думаю довольно быстро будет.

Думаю, в разы разница будет.
А если в [9] цикл развернуть, то и на порядок.

sniknik   (2016-09-04 01:52:00) [11]

а ну да, в оригиналном вопросе просто проверка на все нули, с неопределенной/заданной длиной, еще проще -
function TestStringsForZeros(const Source: string): Boolean;
begin
 Result:= Source = StringOfChar('0', Length(Source));
end;
и кстати думаю довольно быстро будет.

sniknik   (2016-09-04 01:48:00) [12]

быстро, красиво, ... надо проще делать.
function TestStringsForZeros(const Source: string; Count: integer): Boolean;
begin
 Result:= Source = StringOfChar('0', Count);
end;

Sha   (2016-09-03 22:55:00) [13]

Так тоже должно быть довольно быстро, хотя и не очень красиво, наверное:

function IsBufferOfByte(pBuf: pointer; Len: integer; Value: byte): boolean;
var
 Mask: cardinal;
label
 ExitFalse;
begin;
 if Len=0 then goto ExitFalse;  
 Mask:=Value * $01010101;
 while Len>=4 do begin;
   if pCardinal(pBuf)^<>Mask then goto ExitFalse;
   inc(pCardinal(pBuf));
   dec(Len,4);
   end;
 if (Len=0) or ((pCardinal(pBuf)^ xor Mask) shl ((4-Len) shl 3)=0) then begin;
   Result:=true;
   exit;
   end;
ExitFalse:
 Result:=false;
 end;


Использовать так:

var
 s: string;
begin;
 s:='aaaaa';
 Result:=IsBufferOfByte(pointer(s),Length(s),byte('a')))));
 end;

Игорь Шевченко   (2016-09-03 18:50:00) [14]

RusSun ©   (03.09.16 11:26) [5]

Примерно так:

const
 Zeros: PChar = '00000000000000000000000000000000000000000000000000'; //Сколько надо по длине

function TestStringsForZeros (const Source: string): Boolean; inline;
begin
 Result := CompareMem(PChar(Source), Zeros, Length(Source));
end;

Leonid Troyanovsky   (2016-09-03 14:53:00) [15]


> RusSun ©   (03.09.16 11:26) [5]


function IsStringMonoChar(const s: String; c: Char): Boolean;
var
 i, k, L: Longint;
 p: PChar;
 t: array [0..3] of Char;
begin
 L := Length(s);
 Result := L > 0;
 if not Result then
   Exit;

 p := PChar(s);
 FillChar(t, 4, c);
 k := L div 4;

 for i := 0 to k-1 do
    begin
      Result := PLongint(p)^ = PLongint(@t)^;
      if not Result then
        Exit;
      inc(p, 4);
    end;

  k := L mod 4;
  for i := L-k+1 to L do
    begin
      Result := s[i] = c;
      if not Result then
        Exit;
     end;
end;

no tested.

--
Regards, LVT.

RusSun   (2016-09-03 12:00:00) [16]


> быстрой функцией сравнения.

можно по точнее

RusSun   (2016-09-03 11:26:00) [17]

to Игорь Шевченко

>  finally end; //of finally
>  Ты зачем так пишешь ? Не надо.

потому Не часто пользуюсь, try http://www.delphibasics.ru/Try.php,
что не означает, что так как я написал верно и так всем надо делать. =)

to Leonid Troyanovsky,Игорь Шевченко.

1ое можно код.
2ое строка имеет переменную длину.

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

Игорь Шевченко   (2016-09-03 10:52:00) [18]


>  finally end; //of finally


Ты зачем так пишешь ? Не надо.

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

Leonid Troyanovsky   (2016-09-03 09:53:00) [19]


> RusSun ©   (03.09.16 09:17) [2]

> к символу. И в конце result:=true/false

Не в конце, а до первого несовпадения.
Ну, и сравнивать можно сразу по 4 (or 8) байт.

--
Regards, LVT.

RusSun   (2016-09-03 09:17:00) [20]

"Пришло" пока только два "варианта".
1 сравнивать от символа к символу. И в конце result:=true/false
второй вариант что-то вроде
2 try
  result:=false;
  if StrToInt(s) = 0 then
  result:=true
  finally end; //of finally
Есть ли ещё?

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо