• Максимальный M-угольник
  MAXSQUAR
  
  Условие  Комментарии  Решение  Тестовые файлы  Оглавление

Описание
Заданы N различных точек плоскости и натуральное число М - количество углов многоугольника

Задание
Требуется найти максимальный по площади невырожденный М-угольник без самопересечений и самокасаний, вершинами которого являются некоторые из этих N точек


Входные данные
В первой строке входного файла через пробел записаны два целых числа М и N (3≤M≤N≤10). Во второй строке перечислены N точек, каждая из которых задана парой своих координат. Координаты являются вещественными числами и разделяются пробелом.

Выходные данные
В первую строку выходного файла нужно вывести площадь искомого М-угольника, а во вторую - номера точек, являющихся вершинами этого М-угольника (в порядке обхода по или против часовой стрелки). Номера точек разделяются пробелом. Если правильных вариантов решений несколько, то достаточно вывести любой из них. Если же ни один М-угольник с указанными свойствами построить невозможно, то выходной файл должен содержать единственное число "0"


Например:

MAXSQUAR.IN
3 4
0 0 0 1 1 0 1 1

MAXSQUAR.OUT
0.5
1 2 3






Решение

{$A-,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
 
program maxsquar;

const
  inFile = 'maxsquar.in';
  outFile = 'maxsquar.out';
  eps = 1e-6;
  maxN = 10;
 
type
  float = extended;
  TInfo = ( iUndef, iTrue, iFalse );
 
var
  n: integer;
  m: integer;
  x,y: array[1..maxN] of float;
  answer: float;
  used: array[1..maxN] of boolean;
  p,bestP: array[1..maxN] of integer;
  cache: array[1..maxN,1..maxN,1..maxN,1..maxN] of TInfo;
 
function det(a, b, c, d : float) : float;
begin
  det := a * d - b * c;
end;
 
function CheckIntersection(a, b, c, d : integer) : boolean;
var
  dd,du,dv: float;
  u,v: float;
begin
  if cache[a,b,c,d] <> iUndef then begin
    CheckIntersection := cache[a,b,c,d] = iTrue;
    exit;
  end;
 
  cache[a,b,c,d] := iFalse;
  CheckIntersection := false;
 
  dd := det( x[b] - x[a], x[c] - x[d], y[b] - y[a], y[c] - y[d] );
  if abs( dd ) < eps then exit;
 
  du := det( x[c] - x[a], x[c] - x[d], y[c] - y[a], y[c] - y[d] );
  dv := det( x[b] - x[a], x[c] - x[a], y[b] - y[a], y[c] - y[a] );
 
  u := du / dd;
  v := dv / dd;
 
  if (u < eps) or (u > 1 - eps) or
     (v < eps) or (v > 1 - eps) then exit;
  cache[a,b,c,d] := iTrue;
  CheckIntersection := true;
end;
 
procedure Rec(k : integer; s : float);
label next;
var
  i,j: integer;
begin
  if k > m then begin
    for i := 1 to m - 1 do
      if CheckIntersection(p[i], p[i+1], p[m], p[1]) then exit;
    s := abs(s + (x[p[1]] - x[p[m]]) * (y[p[1]] + y[p[m]]));
    if s > answer then begin
      answer := s;
      bestP := p;
    end;
    exit;
  end;
 
  for i := 1 to n do
    if not used[i] then begin
      for j := 1 to k - 2 do
        if CheckIntersection(p[j], p[j+1], p[k-1], i) then goto next;
      used[i] := true;
      p[k] := i;
      if k = 1 then
        Rec(k + 1, s)
      else
        Rec(k + 1, s + (x[i] - x[p[k-1]]) * (y[i] + y[p[k-1]]));
      used[i] := false;
      next;
    end;
end;
 
procedure Solve;
begin
  answer := 0;
  fillchar(used, sizeof(used), false);
  Rec(1, 0);
  answer := answer/2;
end;
 
procedure ReadData;
var
  i: integer;
begin
  read(m, n);
  for i := 1 to n do read(x[i], y[i]);
end;
 
procedure WriteData;
var
  i: integer;
begin
  writeln(answer:0:10);
  if abs(answer) > eps then begin
    for i := 1 to m do write(bestP[i], ' ');
    writeln;
  end;
end;
 
procedure Initialize;
begin
  assign(input, inFile);
  reset(input);
  assign(output, outFile);
  rewrite(output);
end;
 
procedure Finalize;
begin
  close(input);
  close(output);
  halt( 0 );
end;
 
begin
  Initialize;
  ReadData;
  Solve;
  WriteData;
  Finalize;
end.

© Особенности национальных задач по информатике