S. Fisher schrieb:
> This is faster than the one at the shootout
> (shootout.alioth.debian.org/gp4/benchmark.php?test=fannkuch&lang=fpascal&id=3)
> on my computer. See if it's faster on yours.
Indeed, just submit it.
>
> { The Computer Language Shootout
> http://shootout.alioth.debian.org/
>
> contributed by Florian Klaempfl
> modified by Micha Nelissen
> modified by Vincent Snijders
> modified by Steve Fisher
>
> Compile with
> fpc -O3 fannkuch.pp
> }
>
> {$INLINE ON}
> {$OVERFLOWCHECKS OFF}
> {$RANGECHECKS OFF}
>
> type
> TIntegerArray = Array[0..99] of longint;
>
> var
> permu, permu_copy, count: TIntegerArray;
> r, n, answer : longint;
>
> procedure swap(var a, b: longint); inline;
> var tmp: longint;
> begin tmp := a; a := b; b := tmp end;
>
> procedure roll_down( var a : array of longint ); inline;
> var tmp : longint;
> begin
> tmp := a[ 0 ];
> move( a[1], a[0], high(a)*sizeof(longint) );
> a[ high(a) ] := tmp;
> end;
>
>
> procedure reverse( var a: array of longint ); inline;
> var
> pi, pj : pLongint;
> begin
> pi := @a[0];
> pj := @a[high(a)];
> while pi<pj do
> begin
> swap(pi^, pj^);
> inc(pi);
> dec(pj);
> end;
> end;
>
> function NextPermutation: boolean;
> var
> r0: longint;
> begin
> r0 := r; // use local variable
> NextPermutation := true;
> repeat
> if r0 = n then
> begin
> NextPermutation := false;
> break;
> end;
> roll_down( permu[ 0 .. r0 ] );
> dec(count[r0]);
> if count[r0] > 0 then
> break;
> inc(r0);
> until false;
> r := r0;
> end;
>
> function fannkuch: longint;
> var
> print30, m, i, last, tmp, flips: longint;
> begin
> print30 := 0;
> fannkuch := 0;
> m := n - 1;
>
> // Initial permutation.
> for i := 0 to m do permu[i] := i;
>
> r := n;
> repeat
> if print30 < 30 then
> begin
> for i := 0 to m do write(permu[i] + 1);
> writeln; inc(print30);
> end;
> while r <> 1 do
> begin
> count[r-1] := r;
> dec(r);
> end;
> if (permu[0]<>0) and (permu[m]<>m) then
> begin
> move(permu[0], permu_copy[0], sizeof(longint)*n);
> flips := 0;
>
> last := permu_copy[0];
> repeat
> // Reverse part of the array.
> reverse( permu_copy[ 1 .. last-1 ] );
> tmp := permu_copy[ last ];
> permu_copy[ last ] := last;
> last := tmp;
> inc(flips);
> until last = 0;
>
> if flips > fannkuch then
> fannkuch := flips;
> end;
> until not NextPermutation;
> end;
>
> begin
> n := 7;
> if paramCount() = 1 then
> Val(ParamStr(1), n);
> answer := fannkuch;
> writeln('Pfannkuchen(', n, ') = ', answer);
> end.
>
>
> __________________________________________________
> Do You Yahoo!?
> Tired of spam? Yahoo! Mail has the best spam protection around
> http://mail.yahoo.com
> _______________________________________________
> fpc-pascal maillist - fpc-pascal@lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
>
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
