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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.06.2010, 15:07   #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 в 15:14.
Student_ya вне форума Ответить с цитированием
Старый 01.06.2010, 19:23   #2
D@rkD@iver
Форумчанин
 
Регистрация: 28.07.2009
Сообщений: 189
По умолчанию

пиши договоримся
ISQ: 412842920
skype: hrusloff
пишу программы для студентов и школьников на Pascal, Delphi, C++, WINAPI, assembler
обучаю программированию на паскале(дистанционно);mail: hruslow@gmail.com
D@rkD@iver вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Оплачу решение задач по паскалю!!Срочно! WebKiller Паскаль, Turbo Pascal, PascalABC.NET 1 17.06.2009 01:36
Прошу помочь. Оплачу. dreo Фриланс 8 22.12.2007 00:35