1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
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<pj do
begin
swap(pi^, pj^);
inc(pi);
dec(pj);
end;
end;
function countflips: longint; inline;
var
last: LongInt;
tmp: LongInt;
begin
countflips := 0;
last := permu_copy[0];
repeat
// Reverse part of the array.
reverse(last);
tmp := permu_copy[last];
permu_copy[last] := last;
last := tmp;
inc(countflips);
until last = 0;
end;
function NextPermutation: boolean;
var
tmp: LongInt;
i : longint;
begin
NextPermutation := true;
repeat
if r = n then
begin
NextPermutation := false;
break;
end;
tmp := permu[0];
for i := 1 to r do
permu[i-1] := permu[i];
permu[r] := tmp;
dec(count[r]);
if count[r] > 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.
|
