Revise 12/TP-HN-2008/R2

1 files changed, 69 insertions, 0 deletions

diff --git a/12/TP-HN-2008/R2/tbc.pas b/12/TP-HN-2008/R2/tbc.pas
new file mode 100755
index 0000000..1a26a91
--- /dev/null
+++ b/12/TP-HN-2008/R2/tbc.pas
@@ -0,0 +1,69 @@
+var

+  f : text;

+  i, l, m, n : integer;

+  a : array[1..1000] of longint;

+

+procedure qsort(l, h : integer);

+  var

+    i, j : integer;

+    x, tmp : longint;

+  begin

+    i := l;

+    j := h;

+    x := a[(i + j) div 2];

+    repeat

+      while a[i] < x do inc(i);

+      while x < a[j] do dec(j);

+      if i <= j then

+        begin

+          tmp := a[i];

+          a[i] := a[j];

+          a[j] := tmp;

+          inc(i);

+          dec(j)

+        end

+    until i > j;

+    if l < j then qsort(l, j);

+    if i < h then qsort(i, h)

+  end;

+

+function biin(n0 : integer) : boolean;

+  var l, h, m : integer;

+  begin

+    l := 1;

+    h := n;

+    repeat

+      m := (l + h) div 2;

+      if a[m] = n0 then exit(true);

+      if a[m] < n0 then l := m + 1

+      else h := m - 1

+    until l > h;

+    biin := false

+  end;

+

+function libtbc(n0 : integer) : boolean;

+  var i, j : integer;

+  begin

+    for i := 1 to n0 - 1 do

+      for j := n0 + 1 to n do

+        if biin(a[n0] * 3 - a[i] - a[j]) then

+          exit(true);

+    libtbc := false

+  end;

+

+begin

+  assign(f, 'TBC.INP');

+  reset(f);

+  readln(f, n);

+  for i := 1 to n do readln(f, a[i]);

+  close(f);

+  qsort(1, n);

+  m := 0;

+  for l := 2 to n - 1 do

+    if libtbc(l) then

+      inc(m);

+  assign(f, 'TBC.OUT');

+  rewrite(f);

+  writeln(f, m);

+  close(f)

+end.