Поиск совпадений цифр в списке чисел. Есть ли мысли?

← →
Sha © (2005-10-26 16:22) [40]

Если из цикла вынести лишнее, простой перебор ускоряется в 2 раза

procedure TForm1.Button3Click(Sender: TObject); //попарное сравнение (чуть быстрее) var A: array of Int64; l1, l2: Int64; i, j, k, ii, jj, Cnt, Mx: Integer; t: DWord; md: array[1..14] of integer; begin SetLength(A, N); RandSeed := 2; for i := 0 to N - 1 do begin A[i] := 10000000000000 + Int64(1000000) * Random(90000000) + Random(1000000); // Memo1.Lines.Add(Format("%d %d", [i, A[i]])); end; t := GetTickCount; Mx := 0; ii := 0; jj := 0; for i := 0 to N - 2 do begin l1 := A[i]; for k := 1 to 14 do begin md[k]:=l1 mod 10; l1 := l1 div 10; end; for j := i + 1 to N - 1 do begin l2 := A[j]; Cnt := 0; for k := 1 to 14 do begin Inc(Cnt,ord(l2 mod 10=md[k])); l2 := l2 div 10; end; if Cnt > Mx then begin Mx := Cnt; ii := i; jj := j; end; end; end; Memo1.Lines.Add(Format("%d мс:", [GetTickCount - t])); Memo1.Lines.Add(Format("%d совпадений:", [Mx])); Memo1.Lines.Add(Format("%d %d", [ii, A[ii]])); Memo1.Lines.Add(Format("%d %d", [jj, A[jj]])); end;

← →
MBo © (2005-10-26 16:55) [41]

>Sha © (26.10.05 15:55) [39]

На P3-600 разница еще больше - в 200 раз
Самые глубоковложенный цикл выполняется в переборном методе примерно 7*N^2 раз, а во втором случае 0.7 * N^2 раз.

В матричном методе в цикле просто инкремент байта идет.
А в переборе в цикле выполняются 4 деления Int64 - это, конечно, маразм, и нужно оптимизировать, переходя к сравнению строковых значений.
Тогда разница всего в 1.6-2 раза будет, так что увы, овчинка с использованием доп. памяти в моей реализации выделки не стоит ;(

procedure TForm1.Button1Click(Sender: TObject); var A: array of Int64; B: array of string; i, j, k, ii, jj, Cnt, Mx: Integer; t: DWord; begin SetLength(A, N); SetLength(B, N); RandSeed := 2; for i := 0 to N - 1 do begin A[i] := 10000000000000 + Int64(1000000) * Random(90000000) + Random(1000000); B[i] := IntToStr(A[i]); // Memo1.Lines.Add(Format("%d %d", [i, A[i]])); end; t := GetTickCount; Mx := 0; ii := 0; jj := 0; for i := 0 to N - 2 do for j := i + 1 to N - 1 do begin Cnt:=0; for k:=1 to 14 do begin if B[i,k]=B[j,k] then Inc(Cnt); end; if Cnt > Mx then begin Mx := Cnt; ii := i; jj := j; end; end; Memo1.Lines.Add(Format("%d мс:", [GetTickCount - t])); Memo1.Lines.Add(Format("%d совпадений:", [Mx])); Memo1.Lines.Add(Format("%d %d", [ii, A[ii]])); Memo1.Lines.Add(Format("%d %d", [jj, A[jj]])); end;

← →
Sha © (2005-10-26 16:59) [42]

Еще немного улучшил полный перебор:
- вычисляю модули один раз
- оптимизировал работу с индексами

Результат превосходит ожидания
657 мс: 10 совпадений: 3814 35129365269927 4733 28047279209345 procedure TForm1.Button4Click(Sender: TObject); //попарное сравнение (еще быстрее) var A: array of Int64; l1, l2: Int64; i, j, k, ii, jj, Cnt, Mx, jmax: Integer; t: DWord; md: array of integer; begin if N<2 then exit; SetLength(A, N); RandSeed := 2; for i := 0 to N - 1 do begin A[i] := 10000000000000 + Int64(1000000) * Random(90000000) + Random(1000000); // Memo1.Lines.Add(Format("%d %d", [i, A[i]])); end; SetLength(md,14 * N); t := GetTickCount; Mx := 0; ii := 0; jj := 0; j:=14*N; for i:=0 to N-1 do begin l1 := A[i]; for k := 1 to 14 do begin dec(j); md[j]:=l1 mod 10; l1 := l1 div 10; end; end; i:=(N-1)*14-1; jmax:=N*14-1; repeat j:=jmax; repeat k:=-13; Cnt := 0; repeat Inc(Cnt,ord(md[i+k]=md[j+k])); inc(k); until k>0; if Cnt > Mx then begin Mx := Cnt; ii := i; jj := j; end; dec(j,14); until j=i; dec(i,14); until i<0; Memo1.Lines.Add(Format("%d мс:", [GetTickCount - t])); Memo1.Lines.Add(Format("%d совпадений:", [Mx])); Memo1.Lines.Add(Format("%d %d", [ii div 14, A[ii div 14]])); Memo1.Lines.Add(Format("%d %d", [jj div 14, A[jj div 14]])); end;

← →
Sha © (2005-10-26 17:10) [43]

Можно еще ускорить ~10..15% если в цикле перебора пар
вместо типа целочисленных индексов i, j использовать
указатели pIntegerArray.

← →
MBo © (2005-10-26 17:25) [44]

>Sha © (26.10.05 16:59) [42]
Мощно ускорилось. Но со сравнением строк быстрее будет.

Матричный алгоритм переделал, отказавшись от списков в пользу массивов - еще в полтора раза разогнал.

P600, 5000 элементов:

Перебор, сравнение строк - 2914
Матричный, TList 1813
Матричный, массивы 1342
Sha [42] 5909

← →
Sha © (2005-10-26 17:39) [45]

> MBo © (26.10.05 17:25) [44]
> Мощно ускорилось. Но со сравнением строк быстрее будет.

На моем P4 сравнение строк медленнее:

797 мс: 10 совпадений: 253 52449711333529 2212 52449701333918

Но его тоже можно значительно ускорить,
если все данные хранить в одной строке

← →
Sha © (2005-10-26 18:03) [46]

594 мс: ! procedure TForm1.Button6Click(Sender: TObject); var A: array of Int64; B, s: string; i, j, k, Cnt, Mx: Integer; t: DWord; p, q, r, ii, jj: pchar; begin SetLength(A, N); SetLength(s, N*14); p:=pointer(s); RandSeed := 2; for i := 0 to N - 1 do begin A[i] := 10000000000000 + Int64(1000000) * Random(90000000) + Random(1000000); B:= IntToStr(A[i]); move(b[1], p^, 14); inc(p,14); // Memo1.Lines.Add(Format("%d %d", [i, A[i]])); end; t := GetTickCount; Mx := 0; //ii := 0; //jj := 0; p:=pointer(s); r:=p+14*(N-2); repeat q:=p; repeat inc(q,14); Cnt:=0; k:=13; repeat inc(Cnt,ord(p[k]=q[k])); dec(k); until k<0; if Cnt > Mx then begin Mx := Cnt; ii := p; jj := q; end; until q>r; inc(p,14); until p>r; Memo1.Lines.Add(Format("%d мс:", [GetTickCount - t])); Memo1.Lines.Add(Format("%d совпадений:", [Mx])); //Memo1.Lines.Add(Format("%d %d", [ii, A[ii]])); //Memo1.Lines.Add(Format("%d %d", [jj, A[jj]])); end;

← →
SergP. (2005-10-26 18:24) [47]

> Sha © (26.10.05 18:03) [46]

А чему у Вас равно N ?

← →
Sha © (2005-10-26 18:30) [48]

> SergP. (26.10.05 18:24) [47]
> А чему у Вас равно N ?
5000

← →
Sha © (2005-10-26 18:39) [49]

> Sha © (26.10.05 18:03) [46]
Было бы еще заметно быстрее, если б компилятор оптимально распределил
регистры.
Он r держит на регистре, а p - на стеке, а надо наоборот.
В общем, на BASMе можно еще процентов 15 отжать.

← →
Sha © (2005-10-26 18:54) [50]

Если развернуть внутренний цикл, получим 500 мс:

p:=pointer(s); r:=p+14*(N-2); repeat q:=p; repeat inc(q,14); Cnt:=0; inc(Cnt,ord(p[00]=q[00])); inc(Cnt,ord(p[01]=q[01])); inc(Cnt,ord(p[02]=q[02])); inc(Cnt,ord(p[03]=q[03])); inc(Cnt,ord(p[04]=q[04])); inc(Cnt,ord(p[05]=q[05])); inc(Cnt,ord(p[06]=q[06])); inc(Cnt,ord(p[07]=q[07])); inc(Cnt,ord(p[08]=q[08])); inc(Cnt,ord(p[09]=q[09])); inc(Cnt,ord(p[10]=q[10])); inc(Cnt,ord(p[11]=q[11])); inc(Cnt,ord(p[12]=q[12])); inc(Cnt,ord(p[13]=q[13])); if Cnt > Mx then begin Mx := Cnt; //ii := p; //jj := q; end; until q>r; inc(p,14); until p>r;

← →
Sha © (2005-10-27 01:38) [51]

Еще в 4 раза быстрее
//С использованием Lookup-таблицы //(в 4 раза быстрее ускоенного строкового) procedure TForm1.Button2Click(Sender: TObject); type pWord = ^tWord; tWord = array[0..MaxInt div 4] of word; const DigitsInNumber = 14; DigitsRounded = (DigitsInNumber+3) and -4; //16 Bytes = DigitsRounded div sizeof(word); //8 Words = Bytes div sizeof(word); //4 WordsTotal = N * Words; var Data: array of word; LookupTable: array[word] of byte; Distance, MaxDistance: byte; t: integer; p, q, r: pWord; begin; //Генерируем десятичные цифры //Храним в упакованном двоично-десятичном формате //Одно 16-значное число занимает 8 байт (4 слова) SetLength(Data, WordsTotal); p:=pointer(Data); pointer(r):=@p[WordsTotal-Words]; RandSeed:=183; q:=r; repeat; t:=Random(10); t:=t shl 4 + Random(10); t:=t shl 4 + Random(10); t:=t shl 4 + Random(10); q[0]:=t; dec(cardinal(q),sizeof(word)); until cardinal(p)>cardinal(q); //Заполняем lookup-таблицу for t:=0 to $FFFF do LookupTable[t]:=ord(t and $000F=0) + ord(t and $00F0=0) + ord(t and $0F00=0) + ord(t and $F000=0); //Ищем минимальное расстояние между числами чисел t:=GetTickCount; MaxDistance:=0; repeat; q:=r; repeat; Distance:=LookupTable[p[0] xor q[0]] + LookupTable[p[1] xor q[1]] + LookupTable[p[2] xor q[2]] + LookupTable[p[3] xor q[3]]; dec(cardinal(q),Bytes); if MaxDistance<Distance then MaxDistance:=Distance; until cardinal(p)>=cardinal(q); inc(cardinal(p),Bytes); until cardinal(p)>=cardinal(r); t:=integer(GetTickCount)-t; //Выводим результат Memo1.Lines.Add(Format("%d мс, %d совпадений", [t, MaxDistance])); end;

← →
Sha © (2005-10-27 01:41) [52]

Только заменить идентификаторы надо :)
Distance -> Matched
MaxDistance -> MaxMatched

Sha © (27.10.05 01:38) [51]

Красивая идея!
Эх, если бы можно было сделать таблицу не до $FFFF, а до 99 999 999 999 999, тогда получалось бы готовое число совпадений по одному xor.

> Sandman29 © (27.10.05 09:22) [54]

Для CPU xor-ов dword-ов все равно будет не меньше 2-х,
поэтому таблица длиннее $FFFFFFFF (что тоже нереально)
не требуется.

Жаль время заполнения такой таблицы будет очень нехилое.

Sha © (27.10.05 09:47) [55]

Для CPU xor-ов dword-ов все равно будет не меньше 2-х,
поэтому таблица длиннее $FFFFFFFF (что тоже нереально)
не требуется.

Согласен, стормозил. Даешь 128-битные процессоры! :)

>Жаль время заполнения такой таблицы будет очень нехилое.

Можно в ПЗУ записать. Теоретически

Компилятор генерит более эффективный код (в 1.6 раза)
если ему немного помочь :)

Итого 78 мс:

//С использованием Lookup-таблицы //(в ~5-6 раз быстрее ускоенного строкового) //Оптимизировано с целью использования компилятором movzx procedure TForm1.Button10Click(Sender: TObject); type pWord = ^tWord; tWord = array[0..MaxInt div 4] of word; const DigitsInNumber = 14; DigitsRounded = (DigitsInNumber+3) and -4; //16 DigitsInByte = 2; Bytes = DigitsRounded div DigitsInByte; //8 Words = Bytes div sizeof(word); //4 WordsTotal = N * Words; var Data: array of word; LookupTable: array[word] of byte; Matched, MaxMatched: integer; t, w: integer; p, q, r: pWord; begin; //Генерируем десятичные цифры //Храним в упакованном двоично-десятичном формате //Одно 16-значное число занимает 8 байт (4 слова) SetLength(Data, WordsTotal); p:=pointer(Data); pointer(r):=@p[WordsTotal-Words]; RandSeed:=183; q:=r; repeat; t:=Random(10); t:=t shl 4 + Random(10); t:=t shl 4 + Random(10); t:=t shl 4 + Random(10); q[0]:=t; dec(cardinal(q),sizeof(word)); until cardinal(p)>cardinal(q); //Заполняем lookup-таблицу for t:=0 to $FFFF do LookupTable[t]:=ord(t and $000F=0) + ord(t and $00F0=0) + ord(t and $0F00=0) + ord(t and $F000=0); //Ищем минимальное расстояние между числами t:=GetTickCount; MaxMatched:=0; repeat; q:=r; repeat; w:=p[0]; w:=w xor q[0]; Matched:=LookupTable[w]; w:=p[1]; w:=w xor q[1]; Matched:=Matched+LookupTable[w]; w:=p[2]; w:=w xor q[2]; Matched:=Matched+LookupTable[w]; w:=p[3]; w:=w xor q[3]; Matched:=Matched+LookupTable[w]; dec(cardinal(q),Bytes); if MaxMatched<Matched then MaxMatched:=Matched; until cardinal(p)>=cardinal(q); inc(cardinal(p),Bytes); until cardinal(p)>=cardinal(r); t:=integer(GetTickCount)-t; //Выводим результат Memo1.Lines.Add(Format("%d мс, %d совпадений", [t, MaxMatched])); end;

Поиск совпадений цифр в списке чисел. Есть ли мысли? Найти похожие ветки