Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Работа для программиста > Фриланс
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.06.2010, 17:08   #1
Student_ya
 
Регистрация: 31.05.2010
Сообщений: 5
Радость "Графика" (заплачу чуток)

Дана задача:
Многоугольник (не обязательно выпуклый) задан на плоскости перечислением координат вершин в порядке обхода его границ. Определить площадь многоугольника.МНЕ НУЖНО ЧТОБЫ ПРОГРАММА ТАКЖЕ ВЫВОДИЛА ГРАФИК ЭТОЙ ФИГУРЫ ПО КООРДИНАТАМ (координаты задаются в текст файле points.dat)т.е вам нужно редактировать эту прогу!

Денежное вознаграждение гарантирую
Вот программа:
Uses Crt;
const max=100;
var
n, i, j: integer;
sd: array[1..100] of
record
x,y: real;
angle: real;
end;
S: real;

procedure Angles;
var
al1,al2,
dx, dy, dxp, dyp,
s_in, s_out, a: real;
i,j: integer;

function ArcCos(a: real): real;
var res: real;
begin
if abs(a)<1.0E-30 then res:=pi/2
else res:=ArcTan(sqrt(1-a*a)/a);
if dx<0 then
if dy>=0 then res:=pi+res
else res:=-pi-res
else
if dy<0 then res:=-res;
ArcCos:=res
end;

begin
dxp:=sd[1].x-sd[n].x;
dyp:=sd[1].y-sd[n].y;
a:=sqrt(dxp*dxp+dyp*dyp);
dxp:=dxp/a;
dyp:=dyp/a;
i:=1;
while i<=(n-1) do
begin
dx:=sd[i+1].x-sd[i].x;
dy:=sd[i+1].y-sd[i].y;
a:=sqrt(dx*dx+dy*dy);
dx:=dx/a;
dy:=dy/a;
if (dx=dxp) and (dy=dyp) then
begin
dec(n);
for j:=i to n do sd[j]:=sd[j+1];
end;
dxp:=dx; dyp:=dy;
inc(i)
end;

dx:=sd[1].x-sd[n].x;
dy:=sd[1].y-sd[n].y;
al1:=ArcCos(dx/sqrt(dx*dx+dy*dy));
for i:=1 to n-1 do
begin
dx:=sd[i+1].x-sd[i].x;
dy:=sd[i+1].y-sd[i].y;
al2:=ArcCos(dx/sqrt(dx*dx+dy*dy));
sd[i].angle:=pi-al1+al2;
if sd[i].angle>2*pi then sd[i].angle:=sd[i].angle-2*pi
else
if sd[i].angle<0 then sd[i].angle:=2*pi+sd[i].angle;
al1:=al2
end;
dx:=sd[1].x-sd[n].x;
dy:=sd[1].y-sd[n].y;
al2:=ArcCos(dx/sqrt(dx*dx+dy*dy));
sd[n].angle:=pi-al1+al2;
if sd[n].angle>2*pi then sd[n].angle:=sd[n].angle-2*pi
else
if sd[n].angle<0 then sd[n].angle:=2*pi+sd[n].angle;
s_in:=0;
s_out:=0;
for i:=1 to n do
begin
if sd[i].angle<0 then sd[i].angle:=2*pi+sd[i].angle;
S_in:=S_in+sd[i].angle;
S_out:=S_out+(2*pi-sd[i].angle);
end;
if S_out<S_in then
for i:=1 to n do sd[i].angle:=2*pi-sd[i].angle;

end;

procedure input;
var f: text;
i: integer;

begin
Assign(f,'points.dat');
reset(f);
readln(f, n);
for i:=1 to n do readln(f, sd[i].x, sd[i].y);
end;

function St(x1,y1, x2,y2, x3,y3: real): real;
var a, b, c, p: real;
begin
a:=sqrt(sqr(x1-x2)+sqr(y1-y2));
b:=sqrt(sqr(x1-x3)+sqr(y1-y3));
c:=sqrt(sqr(x3-x2)+sqr(y3-y2));
p:=(a+b+c)/2;
St:=sqrt(p*(p-a)*(p-b)*(p-c));
end;

function cross(c: integer): boolean;
var a, b, i: integer;
AA, BB, CC,
AA1, BB1, CC1: real;

function Mline(x,y: real): real;
begin
Mline:=AA*x+BB*y+CC
end;

function Sline(x,y: real): real;
begin
Sline:=AA1*x+BB1*y+CC1
end;

begin
if c=1 then
begin
a:=n;
b:=2;
end
else if c=n then
begin
a:=n-1;
b:=1;
end
else
begin
a:=c-1;
b:=c+1;
end;
cross:=true;
AA:=sd[b].y-sd[a].y;
BB:=-(sd[b].x-sd[a].x);
CC:=sd[a].y*(sd[b].x-sd[a].x)-sd[a].x*(sd[b].y-sd[a].y);
if n=4 then
begin
for i:=1 to n do
if (Mline(sd[i].x, sd[i].y)*Mline(sd[c].x, sd[c].y)>0) and (i<>c) then exit;
cross:=false;
exit
end;
for i:=1 to n-1 do
begin
AA1:=sd[i+1].y-sd[i].y;
BB1:=-(sd[i+1].x-sd[i].x);
CC1:=sd[i].y*(sd[i+1].x-sd[i].x)-sd[i].x*(sd[i+1].y-sd[i].y);
if Mline(sd[i].x, sd[i].y)*Mline(sd[i+1].x,sd[i+1].y)<0 then
if Sline(sd[a].x, sd[a].y)*Sline(sd[b].x,sd[b].y)<0 then exit;
end;
AA1:=sd[1].y-sd[n].y;
BB1:=-(sd[1].x-sd[n].x);
CC1:=sd[n].y*(sd[1].x-sd[n].x)-sd[n].x*(sd[1].y-sd[n].y);
if Mline(sd[n].x, sd[n].y)*Mline(sd[1].x,sd[1].y)<0 then
if Sline(sd[a].x, sd[a].y)*Sline(sd[b].x,sd[b].y)<0 then exit;
cross:=false;
end;

begin
ClrScr;
input;
Angles;
S:=0;
while n>3 do
begin
i:=1;
while (sd[i].angle>pi) or (cross(i)) do
inc(i);
if i=1 then
S:=S+St(sd[1].x,sd[1].y, sd[2].x,sd[2].y, sd[n].x,sd[n].y)
else
if i=n then
S:=S+St(sd[n].x,sd[n].y, sd[1].x,sd[1].y, sd[n-1].x,sd[n-1].y)
else S:=S+St(sd[i].x,sd[i].y, sd[i-1].x,sd[i-1].y, sd[i+1].x,sd[i+1].y);
dec(n);
for j:=i to n do sd[j]:=sd[j+1];
Angles
end;
S:=S+St(sd[1].x,sd[1].y, sd[2].x,sd[2].y, sd[3].x,sd[3].y);
Writeln('Площадь фигуры: ', S:3:3);
Readkey
end.
Student_ya вне форума Ответить с цитированием
Старый 01.06.2010, 17:34   #2
mss
Заблокирован
 
Регистрация: 27.05.2010
Сообщений: 1,099
По умолчанию

Это безобразие проще выкинуть в топку и переписать с нуля.

icq 169527143
mss вне форума Ответить с цитированием
Старый 01.06.2010, 17:56   #3
Student_ya
 
Регистрация: 31.05.2010
Сообщений: 5
По умолчанию

Программа все правильно высчитывает
Student_ya вне форума Ответить с цитированием
Старый 01.06.2010, 18:01   #4
mss
Заблокирован
 
Регистрация: 27.05.2010
Сообщений: 1,099
По умолчанию

Ну так а чтобы она еще и "вырисовывала", придется разбираться во всем этом "правильно высчитывающем" безобразии. Что ощутимо более трудоемко (и, соотв-но, дороже для тебя), нежели переписать весь код заново.
Ну решать все равно тебе - наше дело предложить)
mss вне форума Ответить с цитированием
Старый 01.06.2010, 18:03   #5
Student_ya
 
Регистрация: 31.05.2010
Сообщений: 5
По умолчанию

Могу скинуть привиденный в порядок текст на почту
Student_ya вне форума Ответить с цитированием
Старый 01.06.2010, 18:11   #6
mss
Заблокирован
 
Регистрация: 27.05.2010
Сообщений: 1,099
По умолчанию

Чтобы привести его в порядок недостаточно одного форматирования кода.
Наведению порядка подлежит как минимум сам алгоритм , не нуждающийся в дан.задаче ни в триг.функциях, ни в вычислении корней с квадратами.
Кр.того я подозреваю, что твой алгоритм не учитывает потенциальную возможность пересечения ребер заданного в файле полигона, что исключает его "правильное высчитывание".
mss вне форума Ответить с цитированием
Старый 01.06.2010, 18:12   #7
Black Fregat
Программист
Участник клуба
 
Аватар для Black Fregat
 
Регистрация: 23.06.2009
Сообщений: 1,772
По умолчанию

Что, никто не берется? Ну скиньте все материалы на black.fregat@gmail.com
Black Fregat вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как обойти "преобразование типа из "string" в "float" невозможно" lexluter1988 Помощь студентам 1 07.08.2010 12:23
при вводе на листе "магазин"- код товара появлялось "описание" товара из "склада" с "продажной ценой" aleksei78 Microsoft Office Excel 13 25.08.2009 12:04
"Текстовые файлы" и "Графика и подпрограммы" Nata!!!@ Помощь студентам 5 05.12.2007 18:17