From c96bcd83401346fa3a7894250a12d03d74bb81e1 Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Wed, 7 Nov 2007 20:15:50 +0000
Subject: [PATCH] + new fannkuch.pp from S. Fisher

git-svn-id: trunk@9150 -
---
 .gitattributes                       |   1 +
 tests/bench/shootout/src/fannkuch.pp | 122 +++++++++++++++++++++++++++
 2 files changed, 123 insertions(+)
 create mode 100644 tests/bench/shootout/src/fannkuch.pp

diff --git a/.gitattributes b/.gitattributes
index a6eb8ba85d..e9b0f1100d 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -5636,6 +5636,7 @@ tests/bench/shootout/obsolete/wc.pp svneol=native#text/plain
 tests/bench/shootout/src/bench.c -text
 tests/bench/shootout/src/binarytrees.pp svneol=native#text/plain
 tests/bench/shootout/src/chameneos.pp svneol=native#text/plain
+tests/bench/shootout/src/fannkuch.pp svneol=native#text/plain
 tests/bench/shootout/src/fasta.pp svneol=native#text/plain
 tests/bench/shootout/src/hello.pp svneol=native#text/plain
 tests/bench/shootout/src/knucleotide.pp svneol=native#text/plain
diff --git a/tests/bench/shootout/src/fannkuch.pp b/tests/bench/shootout/src/fannkuch.pp
new file mode 100644
index 0000000000..76fdfc4bcf
--- /dev/null
+++ b/tests/bench/shootout/src/fannkuch.pp
@@ -0,0 +1,122 @@
+{ 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.