Многоугольники

На плоскости задано такое множество из N многоугольников, что выполняются следующие условия:

никакие два многоугольника не имеют общих точек;

для каждого i–го многоугольника существует P_i многоугольников, внутри которых он находится, и N-1-P_i многоугольников, которые находятся внутри его, 0P_iN-1.

Задание

Напишите программу POLYGON, которая для каждого многоугольника выдает количество многоугольников, внутри которых он находится.

Входные данные

Первая строка входного файла POLYGON.DAT содержит целое число N — количество многоугольников, 3N10000. Следующие N строк файла описывают N многоугольников. (i+1)–ая строка файла описывает i–ый многоугольник. Первое целое число C_i — количество вершин многоугольника, 3C_i20. Последующие C_i пар чисел — координаты вершин многоугольника в порядке его обхода. Координаты вершин — целые числа, принадлежащие диапазону от -2 000 000 000 до 2 000 000 000.

Выходные данные

Единственная строка выходного файла POLYGON.SOL должна содержать N чисел: i–ое число строки должно быть P_i — количество многоугольников, внутри которых находится i–ый многоугольник.

Пример входных и выходных данных

POLYGON.DAT	POLYGON.SOL
3 3 -2 1 8 9 12 1 3 7 5 6 3 7 4 4 4 3 7 7 9 3 1 2	0 2 1

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

{$M 16384,0,655360}

program Polygon;

type

tAr=array[1..10000] of integer;

var

fr, fw: text;

n, heap_size: integer;

ci: longint;

minx: array[1..10000] of longint;

number: array [1..10000] of integer;

answer: ^tAr;

procedure Swap(i, j: integer);

var tmp: longint;

begin

tmp := minx[i];

minx[i] := minx[j];

minx[j] := tmp;

tmp := number[i];

number[i] := number[j];

number[j] := tmp;

end;

procedure Heapify(i: integer);

var l, r, largest: integer;

begin

while (true) do

begin

l := i shl 1; {i := i * 2}

r := l + 1;

if (l <= heap_size) and (minx[l] > minx[i]) then

largest := l

else

largest := i;

if (r <= heap_size) and (minx[r] > minx[largest]) then

largest := r;

if (largest <> i) then

swap(i, largest)

else

break;

i := largest;

end;

end;

procedure HeapSort;

var i: integer;

begin

{build heap}

heap_size := n;

for i := (n shr 1) downto 1 do {for i := (n div 2) downto 1 do}

Heapify(i);

{sort items}

for i:=n downto 2 do

begin

swap(1, i);

dec(heap_size); {heap_size := heap_size - 1}

Heapify(1);

end;

end;

procedure Main;

var i: integer;

begin

for i:=1 to 10000 do

number[i] := i;

HeapSort;

end;

var

i: integer;

j: longint;

x, y, xmin: longint;

begin

assign(fr, 'polygon.dat');

reset(fr);

assign(fw, 'polygon.sol');

rewrite(fw);

GetMEm(answer, sizeof(integer) * 10000);

readln(fr, n);

for i:=1 to n do

begin

read(fr, ci);

read(fr, xmin, y);

for j:=2 to ci do

begin

read(fr, x, y);

if (x < xmin) then

xmin := x;

end;

minx[i] := xmin;

readln(fr);

end;

Main;

for i:=1 to n do

answer^[number[i]] := i - 1;

write(fw, answer^[1]);

for i:=2 to n do

write(fw, ' ', answer^[i]);

writeln(fw);

FreeMEm(answer, sizeof(integer) * 10000);

close(fw);

close(fr);

end.

Пути

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

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

Игра завершается когда фишка не может сделать ход.

Задание

Напишите программу WAYS, которая по числам N, M (1≤N≤50, 2≤M≤10), и таблице переходов между клетками определяет какое наибольшее количество раз можно провести фишку от первого до последнего столбца игрового поля.

Входные данные

В первой строке входного файла WAYS.DAT находятся числа N и M. Далее следует M-1 блок по N строк в каждом — описание возможных переходов для каждой клетки поля. Каждая i–ая строка j–го блока описывает возможные переходы из клетки в i–ой строке и j–ом столбце игрового поля. Первое число в строке задает количество возможных переходов из клетки, после чего следуют номера строк следующего столбца по возрастанию и без повторений.

Выходные данные

В единственной строке выходного файла WAYS.SOL должно находиться целое число, которое соответствует искомому количеству путей. (Ответ может быть 0, если ни из одной клетки первого столбца нельзя достичь ни одной клетки последнего). Для приведенного примера входных данных фишку можно провести 3 раза, например, по таким маршрутам: (133), (244) и (422).

Пример входных и выходных данных

WAYS.DAT	WAYS.SOL
4 3 2 1 3 3 1 2 4 0 2 2 3 1 2 1 2 1 3 2 2 4	3

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

{$M 16384,0,655360}

const

FileIn = 'ways.dat';

FileOut = 'ways.sol';

MAX_N = 50;

MAX_M = 10;

type

TAdjacent = array[1..MAX_N] of boolean;

TField = array[1..MAX_N, 1..MAX_M] of TAdjacent;

TVertex = record

Direction : boolean;

Incoming, Outcoming : TAdjacent;

end;

TNetwork = array[1..MAX_N, 1..MAX_M] of TVertex;

TQueueElement = record

IsStarting : boolean;

Row, Column : byte;

From : integer;

end;

TQueue = array[1..MAX_N*MAX_M*2] of TQueueElement;

{ TStorageElement = record

WasHere : boolean;

Column, Row : byte;

end; }

TStorage = array[1..MAX_N, 1..MAX_M, false..true] of boolean {TStorageElement};

var

N,M : integer;

Field : TField;

Queue : TQueue;

NumQueue, CurrQueue : integer;

Storage : TStorage;

Network : ^TNetwork;

Answer : integer;

procedure InitializeNetwork;

var

i, j, u : integer;

begin

New(Network);

FillChar(Network^, SizeOf(Network^), 0);

for i:=1 to N do

for j:=1 to M do

begin

Network^[i, j].Direction := true;

for u:=1 to N do

Network^[i, j].Outcoming[u] := Field[i,j][u];

end;

end;

procedure Init;

var

Fi : Text;

i, j, u : integer;

K : integer;

Row : byte;

begin

FillChar(Field, SizeOf(Field), false);

Assign(Fi, FileIn);

Reset(Fi);

ReadLn(Fi, N, M);

for i:=1 to M-1 do

for j:=1 to N do

begin

Read(Fi, K);

for u:=1 to K do

begin

Read(Fi, Row);

Field[j,i][Row] := true;

end;

end;

Close(Fi);

Answer:=0;

InitializeNetwork;

end;

function FindPath : boolean;

var

i : integer;

Row, Column : byte;

procedure AddElement(IsStarting : boolean; Row, Column : byte; From : integer);

begin

if Storage[Row, Column, IsStarting] = false then

begin

Inc(NumQueue);

Queue[NumQueue].IsStarting := IsStarting;

Queue[NumQueue].Column := Column;

Queue[NumQueue].Row := Row;

Queue[NumQueue].From := From;

Storage[Row, Column, IsStarting] := true;

end;

end;

begin

{Initialization of Queue}

FindPath := true;

FillChar(Queue, SizeOf(Queue), 0);

FillChar(Storage, SizeOf(Storage), false);

NumQueue := 0;

CurrQueue := 1;

for i:=1 to N do

if Network^[i,1].Direction then AddElement(true, i, 1, 0);

{Calculation of path}

while CurrQueue<=NumQueue do

begin

Row := Queue[CurrQueue].Row;

Column := Queue[CurrQueue].Column;

if (Queue[CurrQueue].IsStarting) and (Network^[Row, Column].Direction) then

begin

AddElement(false, Row, Column, CurrQueue);

If Column=M then exit;

end;

if (not Queue[CurrQueue].IsStarting) and (not Network^[Row, Column].Direction) then

AddElement(true, Row, Column, CurrQueue);

if Queue[CurrQueue].IsStarting then

for i:=1 to N do

if Network^[Row, Column].Incoming[i] then

AddElement(false, i, Column-1, CurrQueue);

if not Queue[CurrQueue].IsStarting then

for i:=1 to N do

if Network^[Row, Column].Outcoming[i] then

AddElement(true, i, Column+1, CurrQueue);

Inc(CurrQueue);

end;

FindPath := false;

end;

procedure RecalculateNetwork;

var

CurrRow, CurrColumn, PrevRow, PrevColumn : byte;

CurrIsStarting, PrevIsStarting : boolean;

PrevQueue : integer;

begin

{The latest element in Queue is the element to check}

CurrQueue:=NumQueue;

while (Queue[CurrQueue].From<>0) do

begin

CurrIsStarting:=Queue[CurrQueue].IsStarting;

CurrRow:=Queue[CurrQueue].Row;

CurrColumn:=Queue[CurrQueue].Column;

PrevQueue:=Queue[CurrQueue].From;

PrevIsStarting:=Queue[PrevQueue].IsStarting;

PrevRow:=Queue[PrevQueue].Row;

PrevColumn:=Queue[PrevQueue].Column;

if (PrevRow=CurrRow) and (PrevColumn=CurrColumn) then

Network^[CurrRow, CurrColumn].Direction:= not Network^[CurrRow, CurrColumn].Direction;

if PrevColumn<CurrColumn then

begin

Network^[CurrRow, CurrColumn].Incoming[PrevRow]:=true;

Network^[PrevRow, PrevColumn].Outcoming[CurrRow]:=false;

end;

if PrevColumn>CurrColumn then

begin

Network^[CurrRow, CurrColumn].Outcoming[PrevRow]:=true;

Network^[PrevRow, PrevColumn].Incoming[CurrRow]:=false;

end;

CurrQueue := PrevQueue;

end;

end;

procedure PrintNetwork;

var

i, j, u : integer;

begin

for i:=1 to n do

begin

Write(i,'. ');

for j:=1 to m do

begin

Write('(');

for u:=1 to n do

if Network^[i,j].Incoming[u] then Write('+') else Write('-');

Write(')');

if Network^[i,j].Direction then Write('+') else Write('-');

Write('(');

for u:=1 to n do

if Network^[i,j].Outcoming[u] then Write('+') else Write('-');

Write(') ');

end;

WriteLn;

end;

WriteLn;

end;

procedure Run;

var

flag : boolean;

begin

flag:= true;

{PrintNetwork;} {TEST}

while flag do

begin

flag:=false;

if FindPath then

begin

RecalculateNetwork;

{PrintNetwork;} {TEST}

Inc(Answer);

flag:=true;

end;

end;

end;

procedure Done;

var

Fo : Text;

begin

Assign(Fo, FileOut);

Rewrite(Fo);

WriteLn(Fo, Answer);

Close(Fo);

end;

begin

Init;

Run;

Done;

end.