Delphi.cz

Český portál Delphi

Soutěž - výsledky

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.

BlueBoard.cz

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

BlueBoard.cz

Datum: 2010-07-29 21:23:00 Tagy: optimalizace

soutez