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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 30.12.2015, 23:45   #11
dimon_snake
Форумчанин
 
Регистрация: 05.11.2015
Сообщений: 167
По умолчанию

Все, сдал наконец.
Правда, методом трассировки луча.
dimon_snake вне форума Ответить с цитированием
Старый 31.12.2015, 01:00   #12
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Код:
type TPoint = record
						x, y : double;
				  end;

function Dot(a, b, c : TPoint) : double;
begin
	a.x := a.x-b.x;
	a.y := a.y-b.y;

	c.x := c.x-b.x;
	c.y := c.y-b.y;

	Exit(a.x*b.x+a.y*b.y)
end;

function Cross(a, b, c : TPoint) : double;
begin
	a.x := a.x-b.x;
	a.y := a.y-b.y;

	c.x := c.x-b.x;
	c.y := c.y-b.y;

	Exit(a.x*b.y-a.y*b.x);
end;

var
	a : array [1..4] of TPoint;
	p : TPoint;
	i : Integer;
	s : double;

begin
	Assign(input,'towns.in'); 
	Assign(output,'towns.out'); 
	Reset(input); Rewrite(output);
	while not eof(input) do begin

		for i := 1 to 4 do
			Read(a[i].x, a[i].y);

		Read(p.x, p.y);
		
		s := 0;
		for i := 1 to 2 do
			s := s + Cross(a[1], a[i+1], a[i+2]);

		for i := 1 to 3 do 
			s := s - Abs(Cross(p, a[i], a[i+1]))/2;

		s := s - Abs(Cross(p, a[1], a[4]));

		if Abs(s) < 1e-8 then
			WriteLn('YES')
		else
			WriteLn('NO')
	end;
	Close(input);
	Close(output)
end.
На сайте почему-то не работает..
Ошибка выполнения..
Poma][a вне форума Ответить с цитированием
Старый 31.12.2015, 01:32   #13
dimon_snake
Форумчанин
 
Регистрация: 05.11.2015
Сообщений: 167
По умолчанию

Цитата:
Сообщение от Poma][a Посмотреть сообщение
Код:
type TPoint = record
						x, y : double;
				  end;

function Dot(a, b, c : TPoint) : double;
begin
	a.x := a.x-b.x;
	a.y := a.y-b.y;

	c.x := c.x-b.x;
	c.y := c.y-b.y;

	Exit(a.x*b.x+a.y*b.y)
end;

function Cross(a, b, c : TPoint) : double;
begin
	a.x := a.x-b.x;
	a.y := a.y-b.y;

	c.x := c.x-b.x;
	c.y := c.y-b.y;

	Exit(a.x*b.y-a.y*b.x);
end;

var
	a : array [1..4] of TPoint;
	p : TPoint;
	i : Integer;
	s : double;

begin
	Assign(input,'towns.in'); 
	Assign(output,'towns.out'); 
	Reset(input); Rewrite(output);
	while not eof(input) do begin

		for i := 1 to 4 do
			Read(a[i].x, a[i].y);

		Read(p.x, p.y);
		
		s := 0;
		for i := 1 to 2 do
			s := s + Cross(a[1], a[i+1], a[i+2]);

		for i := 1 to 3 do 
			s := s - Abs(Cross(p, a[i], a[i+1]))/2;

		s := s - Abs(Cross(p, a[1], a[4]));

		if Abs(s) < 1e-8 then
			WriteLn('YES')
		else
			WriteLn('NO')
	end;
	Close(input);
	Close(output)
end.
На сайте почему-то не работает..
Ошибка выполнения..
Все можно сделать и проще.
Код:
var
x1,x2,x3,x4,x,y1,y2,y3,y4,y:longint;
fi,fo:text;
l:byte;
begin
Assign(fi,'towns.in');
Assign(fo,'towns.out');
Reset(fi);
Rewrite(fo);
while not eof(fi) do begin
Read(fi,x1,y1,x2,y2,x3,y3,x4,y4,x,y);
Readln(fi);
l:=0;
if ((((y1<=y)and(y<y2))or((y2<=y) and (y<y1)))and(x>(x2-x1)*(y-y1)/(y2-y1)+x1))
then Inc(l);
if ((((y2<=y)and(y<y3))or((y3<=y) and (y<y2)))and(x>(x3-x2)*(y-y2)/(y3-y2)+x2))
then inc(l);
if ((((y3<=y)and(y<y4))or((y4<=y) and (y<y3)))and(x>(x4-x3)*(y-y3)/(y4-y3)+x3))
then inc(l);
if ((((y4<=y)and(y<y1))or((y1<=y) and (y<y4)))and(x>(x1-x4)*(y-y4)/(y1-y4)+x4))
then inc(l);
if l mod 2 <>0
then Write(fo,'YES')
else Write(fo,'NO');
Writeln(fo);
end;
close(fo);
end.
Через метод трассировки луча и уравнение прямой. Считаем, сколько сторон пересечет луч, проведенный вправо от точки. Если непарное количество, то точка внутри. Парное - снаружи.
dimon_snake вне форума Ответить с цитированием
Старый 31.12.2015, 01:36   #14
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Ну а еще можно построить выпуклую оболучку, и глянуть что одной точки там не будет или она будет принадлежать уравнению одной из прямых..
Это не проще..
Мне волнуют почему у меня ошибка, хотя вроде бы все должно работать..
Poma][a вне форума Ответить с цитированием
Старый 31.12.2015, 04:42   #15
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Код:
uses SysUtils;
type TPoint = record
						x, y : double;
				  end;

function Dot(b, a, c : TPoint) : double;
begin
	a.x := a.x-b.x;
	a.y := a.y-b.y;

	c.x := c.x-b.x;
	c.y := c.y-b.y;

	Exit(a.x*c.x+a.y*c.y)
end;

function Cross(b, a, c : TPoint) : double;
begin
	a.x := a.x-b.x;
	a.y := a.y-b.y;

	c.x := c.x-b.x;
	c.y := c.y-b.y;

	Exit(a.x*c.y-a.y*c.x);
end;

var
	a : array [1..4] of TPoint;
	p : TPoint;
	i : Integer;
	s1,s2 : double;
    f,g:Text;
begin
	Assign(f,ExtractFilePath(ParamStr(0))+'towns.in'); 
	Assign(g,ExtractFilePath(ParamStr(0))+'towns.out'); 
	Reset(f); Rewrite(g);
	while not eoln(f) do begin

		for i := 1 to 4 do
			Read(f,a[i].x, a[i].y);

		ReadLn(f,p.x, p.y);
		
		s1 := 0;
		for i := 3 to 4 do
			s1 := s1 + Cross(a[1], a[i-1], a[i]);
		
		s2 := 0;
		for i := 1 to 3 do
			s2 := s2 + Abs(Cross(p, a[i], a[i+1]));

		s2 := s2 + Abs(Cross(p, a[1], a[4]));
		
		if Abs(Abs(s1)-Abs(s2)) < 1e-8 then
			WriteLn(g,'YES')
		else
			WriteLn(g,'NO')
	end;
	Close(g);
end.
На 80 зашло..
Poma][a вне форума Ответить с цитированием
Старый 31.12.2015, 15:23   #16
dimon_snake
Форумчанин
 
Регистрация: 05.11.2015
Сообщений: 167
По умолчанию

И уже 16 попыток)
Значит, там просто что-то не учтено.
Вы пытаетесь свою программу до 100 баллов довести?
dimon_snake вне форума Ответить с цитированием
Старый 31.12.2015, 16:12   #17
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 18,922
По умолчанию

Цитата:
Poma][a
1e-8 думаешь достаточно? Если сильно вытянутый 4-угольник и точка очень близка к границе может не прокатить
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 31.12.2015, 17:13   #18
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

16 попыток не из-за этого.. Эт я Паскаль вспоминал и файлы мучал..
Аватар, может быть, но чет не верится.. Потом проверю..
Poma][a вне форума Ответить с цитированием
Старый 01.01.2016, 11:02   #19
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Выкрутил точность на максимум - все равно.. Интересно почему..
Poma][a вне форума Ответить с цитированием
Старый 01.01.2016, 12:34   #20
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 18,922
По умолчанию

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


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Анимация в Pascal ABC - закат солнца. (Очень нужна помощь, доделать программу) Господин Никто Паскаль, Turbo Pascal, PascalABC.NET 5 28.05.2015 13:11
Интересное задание при устройстве на работу по БД (нужна помощь) maybebest Помощь студентам 2 09.01.2015 00:52
Проектное задание. Нужна помощь. Vektor1 Помощь студентам 19 07.11.2013 19:08
Помогите доделать задание. fred9ra Общие вопросы C/C++ 1 11.01.2009 22:16