Naše malá soutěž je u konce, takže je na čase provést nějaké zhodnocení. Jsem rád, že se zúčastnilo celkem dost lidí a co je ještě lepší, že co člověk to algoritmus, přičemž některé opravdu překvapující. Rád bych všem poděkoval, bylo to velmi zajímavé.
Úplně na začátek malá anketa - snad bude blueboard fungovat.
Když jsem zadání vymýšlel, uvažoval jsem o třech optimalizacích:
- získání řetězce ze string listu
- součet dat z řetězce
- součet cifer z výsledku
Omlouvám se, že v zadání nebylo, že se nesmí měnit vstupní data - čehož bylo využito ve třech případech, kdy si autoři pak použili stringlist jako cache. Takové řešení mne překvapilo, ale musel jsem je odmítnout. Ale má chyba - špatné zadání.
Ohledně metodiky měření: trošku jsem potunil šablonu (částečně díky jednomu z autorů) aby se mi to lépe hodnotilo, jelikož všechny řešení jsou v jednom souboru, kdy na začátku se nastavila priorita na RealTime a před testováním řešitele se zavolala FlushInstructionCache, což trošku stabilizovalo výsledky měření, i když podle mne rychlost výsledného kódu závisí i na okolních funkcích, což moc nechápu. Každopádně pořadí to nezmění (na předních místech určitě ne) - ale kdyby někdo věděl co s tím, tak napište do komentářů. Data byla lehce editována, takže funkce místo původní hodnoty 1 měla vrátit 3.
procedure mRunTest(const sResolver:string; lst:TStringList; p:TTestProc);
var
i:Integer;
tick, tickend: Cardinal;
iResult: Integer;
{KernelTime,} UserTime : Int64;
CreationTime1,CreationTime2,ExitTime1,ExitTime2,KernelTime1,KernelTime2,UserTime1,UserTime2:_FILETIME;
H:Cardinal;
begin
writeln('Resitel:', sResolver);
H:=GetCurrentProcess;
FlushInstructionCache(h, nil, 0);
tick:= GetTickCount;
GetProcessTimes(H,CreationTime1,ExitTime1,KernelTime1,UserTime1); // kernelovska funkce - mereni casu procesu
iResult := 0;
for i := 1 to 10000000 do
Inc(iResult, p(lst));
GetProcessTimes(H,CreationTime2,ExitTime2,KernelTime2,UserTime2); // kernelovska funkce - mereni casu procesu
tickend := GetTickCount;
UserTime:=int64(UserTime2)-int64(UserTime1);
writeln(Format('Result = [%d], Time = [%d], UserTime = [%5.3f]', [iResult, tickend - tick, UserTime/10000000]));
// writeln(lst.Text); // kontrola
end;
Takže výsledný běh programu - řešitel "Best of řešení" je kombinací prakticky best of ze všech řešení:
Resitel:Best of řešení
Result = [30000000], Time = [968], UserTime = [0,969]
Resitel:Marek Jurica
Result = [30000000], Time = [1641], UserTime = [1,641]
Resitel:Dalibor Toman
Result = [30000000], Time = [1813], UserTime = [1,813]
Resitel:Tomáš Jantač
Result = [30000000], Time = [2609], UserTime = [2,594]
Resitel:Vladimír Bárta
Result = [30000000], Time = [3781], UserTime = [3,781]
Resitel:Jiri Koula
Result = [30000000], Time = [4672], UserTime = [4,656]
Resitel:Ota Milink
Result = [30000000], Time = [4750], UserTime = [4,734]
Resitel:Aleš Gregor
Result = [30000000], Time = [5266], UserTime = [5,234]
Resitel:David Lebeda
Result = [30000000], Time = [4937], UserTime = [4,953]
Resitel:Petr Kundrata
Result = [30000000], Time = [5094], UserTime = [5,063]
Resitel:Cerda
Result = [30000000], Time = [5437], UserTime = [5,438]
Resitel:Milan Medlik
Result = [30000000], Time = [5141], UserTime = [5,141]
Resitel:Milan Dvorak
Result = [30000000], Time = [5516], UserTime = [5,516]
Resitel:Josef Piskac
Result = [30000000], Time = [5718], UserTime = [5,719]
Resitel:CerdaAsm
Result = [30000000], Time = [6594], UserTime = [6,594]
Resitel:Radek Voltr
Result = [30000000], Time = [5953], UserTime = [5,953]
Resitel:Pavel Gratzer
Result = [30000000], Time = [5860], UserTime = [5,844]
Resitel:Pepak
Result = [30000000], Time = [6015], UserTime = [5,969]
Resitel:Reloader
Result = [30000000], Time = [5719], UserTime = [5,703]
Resitel:Miroslav Logaj
Result = [30000000], Time = [7594], UserTime = [7,563]
Resitel:Jaroslav Dakš
Result = [30000000], Time = [7484], UserTime = [7,484]
Resitel:Jakub Flaška
Result = [30000000], Time = [8266], UserTime = [8,250]
Resitel:Čestmír Najzar
Result = [30000000], Time = [11219], UserTime = [11,219]
Hotovo!
Vítězem je Marek Juřica, cena poroty (tj. pěkné - elegantní - cool řešení) byl větší oříšek, rozhodovalo se mezi Vladimír Bárta, Jiří Koula, David Lebeda, ale na poslední chvilku to je Tomáš Jantač. Opravdu gratuluji. Tomáš Jantač měl 4 varianty (různě špinavé). Vítěz i vítěz ceny poroty dostávají hrneček a PDF serveru delphi.cz.
Další výrazně neobvyklé řešení: Pepák a brutální věc od Dalibora Tomana (principiálně stejná jako jedna z variant Tomáše Jantače - tu jsem vypustil).
Best of řešení
Je kombinací řešení, které napsal Marek Juřica (částečně shodné s řešením Dalibora Tomana a Tomáše Jantače), háčku na přístup k private polím (Marek Juřica, Vladimír Bárta) a nakonec Tomáše Jantače (podobně i Jiří Koula).
V první části se přes tabulku posčítají hodnoty z stringu, který se díky háčku získal přímo. Iterace se provádí přes PChar inkrementací ukazatele na řetězec. Tady upozorním, že zvyšování proměnné typu PChar v unicode Delphi (2009+) posune ukazatel o 2 byte (Char = 2byte), v starších Delphi o 1 byte (Char = 1byte). Tím pádem se řeší hodně věcí při migraci ze starších verzí.
No a nakonec fígl ohledně závislosti ciferného součtu a zbytku po dělení 9.
type
THackList = class(TStrings)
private
FList: PStringItemList;
end;
/// absolutni reseni
function CountDigit_Absolute(const lst: TStrings):Integer;
const arr2 :array[0..255] of byte = (
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8,9,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
var
i, j: Integer;
pC: PChar;
pStr: ^String;
begin
Result := -1;
pStr := @THackList(lst).FList[0].FString;
pC := PChar(Pointer(pStr^));
for i := 0 to Length(pStr^) - 1 do
begin
Inc(Result, arr2[Ord(pC^)]);
Inc(pC);
end;
result:=(Result mod 9)+1; // abraka dabra :oD
end;
Některé řešení
Řešení David Lebeda, osobně se mi líbí.
function CountDigit_DLebeda(const lst: TStrings):Integer;
var
pc: PChar;
begin
result := 0;
pc := PChar(@lst[0][1]);
while pc^ <> #0 do
begin
if AnsiChar(pc^) in ['1'..'9'] then
begin
result := result + byte(pc^) - ord('0');
// if result > 9 then
// dec(result, 9);
case result of
10..18: dec(result, 9);
end;
end;
inc(pc);
end;
end;
Řešení Tomáše Jantače (varianta A1 - B1 - cena poroty). Jen bych upozornil, že A2 B1 by mohlo být
i nejrychlejší - viz CPU, kdy pro P: TStringItem; se generuje kód pro práci se záznamem.
Pozn. Delphi.cz: Variantu B2 jsem vypustil - nebyla nejrychlejší a zabírala moc místa.
{
varianta A1 - poctive / hezky kod
varianta A2 - trosku hack RTL knihovny (vyzaduje jeji nezmenenou podobu!)
variante B1 - poctive / elegantni
A1 B1 - nejcistci kod
A2 B1 - (hack do RTL)
pole 256 konstant "bArray" povazuji narozdil od pole pro variantu B2 za korektni,
proto bych osobne uprednostnoval variantu A2 B1
}
{.$DEFINE A1}
{$DEFINE A2}
{$DEFINE B1}
function CountDigit_TJantac(const lst: TStrings):Integer;
const
bArray : array[$00..$FF] of integer =
( 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,1, 2,3,4,5,6,7,8,9,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0
);
var
I: Integer;
{$IFDEF A1}
S: String;
{$ENDIF}
{$IFDEF A2}
P: TStringItem;
{$ENDIF}
begin
Result:=-1;
{$IFDEF A1}
S:=lst.Strings[0];
for I:=1 to Length(S)
do Inc(result,bArray[Byte(S[I])]);
{$ENDIF}
{$IFDEF A2} // humus, závislé na verzi
P:=PStringItemList(Pointer((Integer(lst)+$1C))^)^[0]; // v Delphi 5 $0C
for I:=1 to Length(P.FString)
do Inc(result,bArray[Byte(P.FString[I])]);
{$ENDIF}
{$IFDEF B1}
result:=(Result mod 9)+1; // abraka dabra :oD
{$ENDIF}
end;
Řešení Jiří Koula.
function CountDigit_JKoula(const lst: TStrings):Integer;
var s:string;
l:integer;
b:integer;
n:integer;
begin
n:=0;
s:=lst[0];
for l:=length(s) downto 1 do
begin
b:=Ord(s[l]);
if b in [49..57] then n:=n+(b xor 48);
end;
if n=0 then
Result:=0
else
begin
n:=n mod 9;
if n=0 then Result:=9 else Result:=n;
end;
end;
Řešení Vladimír Bárta:
function CountDigit_VBarta(const lst: TStrings):Integer;
var
s: PWord;
begin
Result := 0;
//bez kontroly! if lst.Count = 0 then Exit;
// alternativa bez hacku: pWord(@lst[0][1]);
s := pWord(TStringListHack(lst).FList[0].FString);
while s^ <> 0 do begin
if s^ - 48 in [0..9] then begin
Inc(Result, s^ - 48);
if (Result) >= 10 then
Dec(Result, 9); // - 10 + 1
end;
inc(s);
end;
end;
Všechny řešení lze stáhnout zde (v jednom souboru). Vaše názory mne (a nejen mne) zajímají, klidně pište do komentářů.
Pro informaci: Výsledná aplikace kompilováná v Delphi 2010 pro porovnání.
RSS