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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 16.05.2009, 19:07   #21
__STDC__
Участник клуба
 
Аватар для __STDC__
 
Регистрация: 16.03.2009
Сообщений: 1,013
По умолчанию

Забавный вариант программы:
Код:
const
	n = 4;

type
	coords = record
		x,y:real;
	end;
	apexes = array[1..4] of coords;
	
procedure get_points(var a:apexes);
var
	i:byte;
begin
	for i:=1 to n do begin
		writeln('Введите координаты точки ',i);
		readln(a[i].x,a[i].y);
	end;		
end;

function check(a:apexes):boolean;
var
	flag1:boolean;
begin
	check := false;
	flag1 := ((a[1].x = a[2].x) and (a[3].x = a[4].x)) or
			((a[1].x = a[4].x) and (a[2].x = a[3].x)) or
			((a[1].x = a[3].x) and (a[2].x = a[4].x));
			
	check := ((a[1].y = a[2].y) and (a[3].y = a[4].y)) or
			 ((a[1].y = a[4].y) and (a[2].y = a[3].y)) or
			 ((a[1].y = a[3].y) and (a[2].y = a[4].y)) and flag1;	
end;

var
	a:apexes;
begin
	get_points(a);
	if (check(a)) then
		writeln('YES')
	else
		writeln('NO');
end.
Потестил только на наборах (1;1), (1;2), (3;1), (3;2) и (1;1), (1;2), (3;1), (3;3), так что не скажу, работает ли полностью правильно) но для этих наборов вроде верно)
Uguu~
__STDC__ вне форума Ответить с цитированием
Старый 16.05.2009, 19:14   #22
__STDC__
Участник клуба
 
Аватар для __STDC__
 
Регистрация: 16.03.2009
Сообщений: 1,013
По умолчанию

или так покрасивее
Код:
function check(a:apexes):boolean;
var
	flag1,flag2:boolean;
begin
	check := false;
	flag1 := ((a[1].x = a[2].x) and (a[3].x = a[4].x)) or
			 ((a[1].x = a[4].x) and (a[2].x = a[3].x)) or
			 ((a[1].x = a[3].x) and (a[2].x = a[4].x));
			
	flag2 := ((a[1].y = a[2].y) and (a[3].y = a[4].y)) or
			 ((a[1].y = a[4].y) and (a[2].y = a[3].y)) or
			 ((a[1].y = a[3].y) and (a[2].y = a[4].y));	
			 
	if (flag2 and flag1) then check := true;
end;
Uguu~
__STDC__ вне форума Ответить с цитированием
Старый 16.05.2009, 19:43   #23
Арсенчик
Новичок
Джуниор
 
Регистрация: 16.05.2009
Сообщений: 15
Сообщение

Спасибо,конечно,большое,но возможно ли написать программу на более доступном уровне?..потому что такую программу у меня никто не примет..
Арсенчик вне форума Ответить с цитированием
Старый 16.05.2009, 19:44   #24
__STDC__
Участник клуба
 
Аватар для __STDC__
 
Регистрация: 16.03.2009
Сообщений: 1,013
По умолчанию

а что тут недоступного?) надо еще добавить проверку на нахождение всех точек на одной прямой кстати =)
Uguu~
__STDC__ вне форума Ответить с цитированием
Старый 16.05.2009, 20:06   #25
Арсенчик
Новичок
Джуниор
 
Регистрация: 16.05.2009
Сообщений: 15
По умолчанию

Добьёшь прогу?(я про точки на одной прямой)
Арсенчик вне форума Ответить с цитированием
Старый 16.05.2009, 20:24   #26
__STDC__
Участник клуба
 
Аватар для __STDC__
 
Регистрация: 16.03.2009
Сообщений: 1,013
По умолчанию

уверен, что хочешь этого?) ну смотри...
Код:
const
	n = 4;

type
	coords = record
		x,y:real;
	end;
	apexes = array[1..4] of coords;
	
procedure get_points(var a:apexes);
var
	i:byte;
begin
	for i:=1 to n do begin
		writeln('Введите координаты точки ',i);
		readln(a[i].x,a[i].y);
	end;		
end;

function check(a:apexes):boolean;
var
	flag1,flag2:boolean;
begin
	check := 	(((a[1].y = a[2].y) and (a[3].y = a[4].y)) or
				((a[1].y = a[4].y) and (a[2].y = a[3].y)) or
				((a[1].y = a[3].y) and (a[2].y = a[4].y))
				and
				(((a[1].x = a[2].x)) and (a[3].x = a[4].x)) or
				((a[1].x = a[4].x) and (a[2].x = a[3].x)) or
				((a[1].x = a[3].x) and (a[2].x = a[4].x)))
				and
				(((a[1].x <> a[2].x) and (a[1].x <> a[3].x)) or
				((a[1].x <> a[2].x) and (a[1].x <> a[4].x)) or
				((a[1].x <> a[2].x) and (a[1].x <> a[4].x)) or
				((a[2].x <> a[3].x) and (a[2].x <> a[4].x)))
				and
				(((a[1].y <> a[2].y) and (a[1].y <> a[3].y)) or
				((a[1].y <> a[2].y) and (a[1].y <> a[4].y)) or
				((a[1].y <> a[2].y) and (a[1].y <> a[4].y)) or
				((a[2].y <> a[3].y) and (a[2].y <> a[4].y)));
end;

var
	a:apexes;
begin
	get_points(a);
	if (check(a)) then
		writeln('YES')
	else
		writeln('NO');
end.
только я не проверял)) потесть сам)
Uguu~
__STDC__ вне форума Ответить с цитированием
Старый 17.05.2009, 12:29   #27
Арсенчик
Новичок
Джуниор
 
Регистрация: 16.05.2009
Сообщений: 15
По умолчанию

Протестировал - работает неверно!Господа программисты,подумайте ещё пожалуйста!
Арсенчик вне форума Ответить с цитированием
Старый 17.05.2009, 15:01   #28
__STDC__
Участник клуба
 
Аватар для __STDC__
 
Регистрация: 16.03.2009
Сообщений: 1,013
По умолчанию

На чем тестировал? На каких наборах?
Uguu~
__STDC__ вне форума Ответить с цитированием
Старый 17.05.2009, 15:32   #29
Арсенчик
Новичок
Джуниор
 
Регистрация: 16.05.2009
Сообщений: 15
Сообщение

Если основания трапеции параллельны осям - всё тип-топ..если под углом - говорит,что не трапеция..
Арсенчик вне форума Ответить с цитированием
Старый 17.05.2009, 15:35   #30
__STDC__
Участник клуба
 
Аватар для __STDC__
 
Регистрация: 16.03.2009
Сообщений: 1,013
По умолчанию

ну да, это логично) тогда надо делать как был первоначальный вариант... считать векторы и смотреть на их векторное произведение
Uguu~
__STDC__ вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Паскаль Принадлежность точки заданной области Unikummm Помощь студентам 18 28.11.2010 16:04
Отбражение чисел - точки, это точки, а не запятые, обозначающие дробную часть Дикий Помощь студентам 7 12.05.2008 17:57
Поиск выхода из лабиринта! Входными параметрами являются лабиринт, заданный массивом A[n][n] Astor Помощь студентам 4 12.05.2008 16:45
являются ли числа в файле упорядоченными Pohmel Помощь студентам 6 21.04.2008 16:12