program fannkuch; { 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 reverse( k: longint); inline; var pi, pj : pLongint; begin pi := @permu_copy[1]; pj := @permu_copy[k-1]; while pi 0 then break; inc(r); until false; end; function fannkuch: longint; var print30, m, i, 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 := countflips; 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.