Задача

Кратеры на Луне
MOONCRAT

Условие Комментарии Решение Тестовые файлы Оглавление

Описание
Пролетающие время от времени в опасной близости от нашего спутника Луны астероиды захватываются ее гравитационным полем и, будучи ничем не задерживаемы, врезаются с огромной скоростью в лунную поверхность, оставляя в память о себе порядочных размеров кратеры приблизительно круглой формы.

Задание
Увлекающийся астрономией профессор 3.Ездочетов занялся изучением современной карты участка лунной поверхности. Он решил найти на ней максимально длинную цепочку вложенных друг в друга кратеров. Зная о Ваших недюжинных способностях в области построения алгоритмов, за помощью в решении этой непростой задачи он обратился к Вам

Входные данные
Первая строка входного файла содержит целое число N - количество кратеров, отмеченных на карте (1≤N≤500). Следующие N строк содержат описания кратеров с номерами от 1 до N. Описание каждого кратера занимает отдельную строку и состоит из трех целых чисел, принадлежащих диапазону [-32768,32767] и разделенных пробелами. Первые два числа представляют собой декартовы координаты его центра, а третье - радиус. Все кратеры различны

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

Например:

MOONCRAT.IN
4
0 0 30
-15 15 20
15 10 5
10 10 10

MOONCRAT.OUT
3
3 4 1

Идеи
Обход в глубину, динамическое программирование

Комментарии
Построим граф, вершины которого соответствуют кратерам, а дуга из вершины i в вершину j идет в том и только том случае, когда i-ый кратер целиком лежит внутри j-го. По условию задачи нам нужно найти длиннейший путь в полученном ориентированном ациклическом графе. Для этого применяем метод динамического программирования, используя схему топологической сортировки [Липский 88, п.3.4; Кнут 76, п.2.2.3]

Упражнение
При определении того, лежит ли i-ый кратер внутри j-го, не обязательно применять вычисления с плавающей точкой. Покажите, как организовать эту проверку, используя лишь целочисленную арифметику диапазона Longint, так, чтобы исключить возможность арифметического переполнения

Решение

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+}
{$M 65384,0,655360}

Program mooncrat;
Const InputFile='mooncrat.in';
      OutputFile='mooncrat.out';
Const MaxN=500;
Var Ax, Ay, Ar: Array[1..MaxN] Of LongInt;
     Ls, sc, whb, hwd: Array[1..MaxN] Of Integer;
     N: Integer;
     mx, mxi: Integer;

Procedure Init;
Var i: Integer;
   Begin
    Assign(Input, InputFile);
     Reset(Input);
      Read(N);
       For i:=1 To N Do Read(Ax[i], Ay[i], Ar[i]);
     Close(Input);
   End;

Procedure Swap(Var a, b: Integer);
Var c: Integer;
   Begin
    c:=a; a:=b; b:=c;
   End;

Procedure Sort;
Var i, j: Integer;
   Begin
    For i:=1 To N-1 Do
    For j:=i+1 To N Do
    If sc[i]>sc[j] Then Begin
     Swap(sc[i], sc[j]);
     Swap(whb[i], whb[j]);
    End;
   End;

Function Incl(Const x, y: LongInt;Const j: Integer): Boolean;
Var x1, y1, r: Real;
   Begin
    x1:=x-Ax[j];
    y1:=y-Ay[j];
    r:=Ar[j];
    Incl:=(Sqr(x1) + Sqr(y1))<=(Sqr(r));
   End;

Function Incld(Const i, j: Integer): Boolean;
Begin
   Incld:=Incl(Ax[i]+Ar[i], Ay[i], j) And Incl(Ax[i]-Ar[i], Ay[i], j) And
   Incl(Ax[i], Ay[i]+Ar[i], j) And Incl(Ax[i], Ay[i]-Ar[i], j);
End;

Procedure Obx;
Var i, j: Integer;
   Begin
    FillChar(hwd, SizeOf(hwd), 0);
    FillChar(Ls, SizeOf(Ls), 0);
     mx:=1; mxi:=1;
    For i:=1 To N Do hwd[i]:=1;
    For i:=1 To N Do Begin
     For j:=i+1 To N Do
     If Incld(whb[i], whb[j]) And ((hwd[j]Then Begin
      Ls[j]:=i;
      hwd[j]:=hwd[i]+1;
     End;
     If hwd[i]>mx Then Begin mxi:=i; mx:=hwd[i]; End;
    End;
   End;

Procedure Solve;
Var i, j: Integer;
   Begin
    FillChar(sc, SizeOf(sc), 0);
    For i:=1 To N Do
    For j:=1 To N Do
     If Incld(j, i) Then Inc(sc[i]);
    For i:=1 To N Do whb[i]:=i;
    Sort;
    Obx;
   End;

Procedure SayRec(Const mi: Integer);
Begin
   If mi=0 Then Exit;
   SayRec(Ls[mi]);
   Write(whb[mi], ' ');
End;

Procedure Done;
Begin
   Assign(Output, OutputFile);
    Rewrite(Output);
     WriteLn(mx);
     SayRec(mxi);
    Close(Output);
End;

BEGIN
Init;
Solve;
Done;
END.