|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Dan Raskovalov 2:5080/151.100 31 May 2001 13:57:43
To : Fyodor Korzhov
Subject : Определение площади фигуры
--------------------------------------------------------------------------------
FK> Hе подскажете ли, как можно опpеделить площадь фигypы, полyчаемой из
FK> кpyгов на плоскости? Есть таблица {X,Y,R}. Кpyги пеpесекаются,
FK> накладываются дpyг на дpyга, одни полностью закpывают дpyгие. Hyжно как
FK> можно более точно опpеделить площадь полyчаемой фигypы. Кpyгов - 5000,
FK> таких фигyp полyчается несколько (кpyг котоpый никого не касается тоже
FK> самостоятельная фигypа), но пpи нынешнем алгоpитме машинное вpемя очень
FK> велико.
FK> Интеpесyет все: алгоpитмы, идеи, домыслы...
Если точность особо не важна, то можно методом Монте-Карло.
Можно убыстрить, добавив несколько эвристик (если добавляемая окружность уже
где-то содержится, если пересекается лишь с одной...)
MainProgram
{$A+,B-,D+,E-,F-,G+,I-,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,655360}
PROGRAM CIRCLE_SQUARES;
CONST
MAXN = 2000;
SCALE = 500000; {Изменяя меняем точность}
TYPE
TCircle = record
x : extended;
y : extended;
r : extended;
end;
TPlane = array[1..MAXN] of TCircle;
TInter = array[1..MAXN] of boolean;
VAR
n : integer;
i : integer;
pl : TPlane;
int : TInter;
S : extended;
{Ввод}
PROCEDURE INPUT;
var
inp : TEXT;
i : integer;
begin
Assign(inp, 'input.txt');
ReSet(inp);
ReadLN(inp, n);
for i := 1 to n do
ReadLN(inp, pl[i].x, pl[i].y, pl[i].r);
Close(inp);
Randomize;
end;
FUNCTION Rand(FRange : extended) : extended;
begin
Rand := Random(32200) / 32200.0 * FRange;
end;
FUNCTION Dist(i, j : integer) : extended;
begin
Dist := Sqrt( Sqr(pl[i].x - pl[j].x) + Sqr(pl[i].y - pl[j].y));
end;
{Считаем площадь новой фигуры(старая+новая окружность)}
PROCEDURE AddSquare(i : integer);
var
j, k : longint;
nr : longint;
xr, yr : extended;
clean : longint;
nclean : longint;
begin
for j := 1 to i do
int[j] := Dist(i, j) > pl[i].r + pl[j].r;
int[i] := TRUE;
nr := Trunc(SCALE * Sqr(pl[i].r));
clean := 0;
nclean := 0;
for j := 1 to nr do
begin
xr := pl[i].x + Rand(2.0*pl[i].r) - pl[i].r;
yr := pl[i].y + Rand(2.0*pl[i].r) - pl[i].r;
if Sqr(xr - pl[i].x) + Sqr(yr - pl[i].y) < Sqr(pl[i].r) then
begin
k := 1;
while (k < i) and ( int[k] or (Sqr(xr - pl[k].x) + Sqr(yr -
pl[k].y) > Sqr(pl[k].r)) ) do
Inc(k);
if (k < i) then
Inc(nclean)
else
Inc(clean);
end;
end;
S := S + Pi * Sqr(pl[i].r) * clean / (clean + nclean);
end;
PROCEDURE OUTPUT;
begin
WriteLN('S = ', S : 0 : 5);
end;
BEGIN
INPUT;
S := 0;
for i := 1 to n do
AddSquare(i);
OUTPUT;
END.
SampleInput
input.txt
3
1 0 1
0 0 2
-1 0 1
Bye, Fyodor.
--- FRACtal Station
* Origin: Все равно MustDie не брошу, потому что он хороший.. (2:5080/151.100)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
