The Slowest Pascal ReverseString competition

What is it

The Slowest Pascal ReverseString Competition is exactly what it says.
It is a challenge to code a function in Pascal that reverses a given string and will take up as much time as possible.
David B Morgan was the one that started this competition in news:alt.comp.lang.borland-delphi

The objective is not only to write slow code, but also to write a nice beautifull function. And, the shorter the code, the better!

The rules

The function prototype should be
function ReverseString(S: String): String
The function is not allowed to call any other self defined (i.e. non standard) functions or procedures
No math exercises are allowed to calculate loop control variables or the like (otherwise one could calculate any integer by adding more and more math)
Use of floating point variables is not allowed
No object may be created in the function, or should be needed to drop on the form at designtime
No calls to new(), getmem() etc are allowed
Repeated use of functions that are inverses of each other (like: strToInt(intToStr(i)))is not allowed, because there would be no limit to it's extend
Of course nothing like sleep() is allowed ...
Only the System and SysUtils units may be used

Speed testing

Testing the speed of the function is done on my machine running Deplhi 3 Professional on a Celeron 700 Mz, 128 Mb sytem with Windows Me as the OS. The string 'Hello World' is used for the timing procedure.

The timing procedure is as follows:


const Cycles = 100000;

var i, T0, T1, Diff: LongInt;
    DummyStr: String;

...
  T0 := GetTickCount;
  for i := 1 to Cycles do DummyStr := ReverseString('Hello World');
  T1 := GetTickCount;
  Diff := T1 - T0;
...

Results

Author	Nr. of ticks	Ticks per cycle
Reference function	69	0.0007
B Tierens	96	0.0010
Nicholas Sherlock	130	0.0013
J French ^*	630	0.0063
Alan Lloyd	1250	0.0125
Riaan ^*	2310	0.0231
Bruce Roberts	2500	0.0250
Bart Broersma	9275	0.0928

^* Technically these entries do not meet the rules set above. However they were posted on the newsgroup before I made up the rules, so they are included in the results.

Code from each author

Reference function

function ReverseString_Ref(const S: String): String;
var i,j: LongInt;
begin
  j := Length(S);
  Setlength(Result,j);
  i := 1;
  while i <= j do //Actually this is faster than a for loop
  begin
    result[i] := S[j-i+1];
    inc(i);
  end;
end;

B Tierens

function ReverseString_BT(const S: String): String;
//B Tierens
var
  revStr: String;
  i: integer;
begin
  setLength(revStr,length(s));
  for i := 1 to length(s) do
  begin
    revStr[length(s)-i+1] := s[i];
  end;
  Result := revStr;
end;

Nicholas Sherlock

function ReverseString_NS(s: string): string;
//Nicholas Sherlock
type pchar = ^char;
var i: integer;
   a, b: pchar;
begin
   i := length(s);
   setlength(result, i);
   a := pchar(@s[1]);
   b := pchar(@result[i]);
   repeat
     b^ := a^;
     dec(b);
     inc(a);
     dec(i);
     if i = 0 then break;
   until false;
end;

J French

Function SortIt( Item1, Item2 :Pointer ):Integer;
  Type TRec = Record
       Case Integer Of
       0: (N :Integer);
       1: (D :DWORD);
  End;
  pRec = ^TRec;
Begin
  Result := -1;
  // Signed comparison
  If pRec( Item1 ).N <= pRec( Item2 ).N Then
     Begin
       Result := 0;
       // And an unsigned variation
       If pRec( Item1 ).D < pRec( Item2 ).D Then
          Result := 1;
     End;
End;

Function ReverseString_JF(S: String ):String;
//J French
  Type TRec = Record
    Pos :Integer;
    C   :Char;
  End;
  pTRec = ^TRec;
Var
  L9 :Integer;
  AList :TList;
  Recs :Array[0..255] of TRec;
  //Originally: Array of TRec; Modified to compile in D3
Begin
  // We don't really want memory fragmentation
  Result := StringOfChar( 'x', Length(S) );
  //Originally:  SetLength( Recs, Length(S) ); Modified to compile in D3
  AList := TList.Create;
  AList.Capacity := Length(S);
  For L9 := Low( Recs ) To length(s)-1 Do
      Begin
        Recs[L9].Pos := L9;
        Recs[L9].C := S[L9 + 1];
        AList.Add( @Recs[L9] );
      End;
  AList.Sort( SortIt );
  For L9 := 0 To AList.Count - 1 Do
      Result[ L9 + 1 ] := pTRec( AList.Items[L9] ).C;
  AList.Free;
End;

Alan Lloyd

function ReverseString_AL(S: string): string;
//Alan Lloyd
var
  i : integer;
begin
  i := Length(S);
  Result := '';
  if i > 0 then
    repeat
      Result := Result + Copy(S, i, 1);
      i := i - 1;
      if I = 0 then
        Break;
    until (Length(S) = 0);
end;

Riaan

function ReverseString_Riaan(S: string): string;
//Riaan
var work : string;
    i : integer;
    tempL : char;
    tempR : char;
begin
  i := trunc(maxdouble / maxdouble); // '1'
  work := copy(s, trunc(maxdouble / maxdouble), length(s));
  While i <= (length(work) div (trunc(maxdouble / maxdouble) +
  trunc(maxdouble / maxdouble))) do
  begin
    tempL := copy(work, i, trunc(maxdouble / maxdouble))[trunc(maxdouble /
    maxdouble)];
    delete(work, i, trunc(maxdouble / maxdouble));
    tempR := copy(work, length(work) - i + trunc(maxdouble / maxdouble),
    trunc(maxdouble / maxdouble))[trunc(maxdouble / maxdouble)];
    delete(work, length(work) - i + trunc(maxdouble / maxdouble),
    trunc(maxdouble / maxdouble));
    Insert(tempR, work, i);
    Insert(tempL, work, length(work) - i + trunc(maxdouble / maxdouble) +
    trunc(maxdouble / maxdouble));
    i := i + trunc(maxdouble / maxdouble);
  end;
  result := work;
end;

Bruce Roberts

function ReverseString_BR (s : string) : string;
//Bruce Roberts
{I really like the short coding and the recursiveness of this one,
so I'll give extra points !!}
begin
  if s <> '' then Result := Copy (s, Length (s), 1) +
                  ReverseString_BR (Copy (s, 1, Length (s) -  1))
  else Result := s;
end;

Bart Broersma