IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Помогите плз решить задачу на множество, Два множества на плоскости и треугольник...
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Сергей

Репутация: -  0  +


Доброго времени суток всем...
Честно скажу - с програмированием не сложилось еще с начала обучения... Но сессию сдавать надо. Поэтому очень прошу помочь !help.gif

Вот такое условие:

Цитата
Даны два множества точек на плоскости. Из первого множества выбрать три различные точки так, чтобы треугольник с вершинами в этих точках содержал(строго внутри себя) равное количество точек первого и второго множеств.


Путем поиска в интернете было найдено следуещее решение:

uses Crt;

type point = record
x, y : integer;
end;

const MaxArraySize = 10; {Max. array points}

var
ar1, ar2 : array [1..MaxArraySize] of point;
ar1size, ar2size : integer; {inputed array sizes}
i, j, k, g, n1, n2 : integer;
F : Text;

{---------------------------------------------------}
procedure ExitProg;
begin
Writeln('Input error');
ReadKey;
Halt;
end;

{---------------------------------------------------}
{Fill array by hand, return number of entered points}
{---------------------------------------------------}
function FromKeyb(var mas:array of point; max:integer):integer;
var i,n : integer;
begin
Writeln('Enter points number (3<x<', max, ')');
Readln(n);
if (n < 3) then
begin
Writeln('Minimum 3 points need!.');
ExitProg;
end;
if (n > max) then
begin
Writeln('Too many points!.');
ExitProg;
end;

for i := 0 to n-1 do
begin
Write('point #', i+1, ' ');
Readln(mas[i].x, mas[i].y);
end;
FromKeyb := n; {return entered points number}
end;

{-----------------------------------------------------}
{Fill array from file, return number of entered points}
{-----------------------------------------------------}
function FromFile(var mas:array of point; fname:string; max:integer):integer;
var i : integer;
F : text;
begin
Assign(F, fname);
Reset(F);
{read points}
i := 0;
while ((not Eof(F)) and (i < max)) do
begin
Readln(F, mas[i].x, mas[i].y);
i := i+1;
end;
Close(F);

if (i < 3) then
begin
Writeln('File: ', fname, ' Minimum 3 points need!.');
ExitProg;
end;
Writeln('File: ', fname, ' Readed ', i, ' points.');
FromFile := i; {return entered points number}
end;

{---------------------------------}
{Is the point strongly in triangle}
{---------------------------------}
function InTriangle(a,b,c,p:point):boolean;
function pr(t1,t2:point):boolean;
begin
pr:=((p.x-t1.x)*(t2.y-t1.y))>((t2.x-t1.x)*(p.y-t1.y));
end;
begin
if (pr(a,b)=pr(b,c)) and (pr(a,b)=pr(c,a))
then
begin
if ((a.x=p.x) or (b.x=p.x) or (c.x=p.x)) and
((a.y=p.y) or (b.y=p.y) or (c.y=p.y))
then InTriangle := False
else InTriangle := True
end
else InTriangle := False;
end;

begin
ClrScr;
Writeln('Input no more ', MaxArraySize, ' points from:');
Writeln('(1) keyboard');
Writeln('(2) files in1.txt and in2.txt');

case ReadKey of
'1': begin
ClrScr;
Writeln('Input (x y) coordinats pair for 1st array.');
ar1size := FromKeyb(ar1, MaxArraySize);
Writeln('Input (x y) coordinats pair for 2nd array.');
ar2size := FromKeyb(ar2, MaxArraySize);
end;
'2': begin
ClrScr;
ar1size := FromFile(ar1, 'c:\in1.txt', MaxArraySize);
ar2size := FromFile(ar2, 'c:\in2.txt', MaxArraySize);
end;
else
ExitProg;
end;

Assign(F, 'c:\out.txt');
Rewrite(F);
for i:=1 to ar1size do
for j:=i+1 to ar1size do
for k:=j+1 to ar1size do
begin
n1:=0; n2:=0;
for g:=1 to ar1size do {points in triangle from array1}
begin
{Write( '(',ar1[i].x,',',ar1[i].y,')',
' (',ar1[j].x,',',ar1[j].y,')',
' (',ar1[k].x,',',ar1[k].y,')',
' ',ar1[g].x,',',ar1[g].y);
if (InTriangle(ar1[i],ar1[j],ar1[k],ar1[g]) = True)
then Writeln(' true') else Writeln;}

if (InTriangle(ar1[i],ar1[j],ar1[k],ar1[g]) = True)
then n1:=n1+1;
end;
for g:=1 to ar2size do {points in triangle from array2}
begin
{Write( '(',ar1[i].x,',',ar1[i].y,')',
' (',ar1[j].x,',',ar1[j].y,')',
' (',ar1[k].x,',',ar1[k].y,')',
' ',ar2[g].x,',',ar2[g].y);
if (InTriangle(ar1[i],ar1[j],ar1[k],ar2[g]) = True)
then Writeln(' true') else Writeln;}

if (InTriangle(ar1[i],ar1[j],ar1[k],ar2[g]) = True)
then n2:=n2+1;
end;
if ((n1=n2) and (n1<>0)) then
begin
Writeln('Triangle: (',ar1[i].x,',',ar1[i].y,')',
' (',ar1[j].x,',',ar1[j].y,')',
' (',ar1[k].x,',',ar1[k].y,')');
Writeln(F,'Triangle: (',ar1[i].x,',',ar1[i].y,')',
' (',ar1[j].x,',',ar1[j].y,')',
' (',ar1[k].x,',',ar1[k].y,')');
Writeln(n1,' points strongly in triangle from both arrays.');
Writeln(F,n1,' points strongly in triangle from both arrays.'); Close(F);
ReadKey;
Halt;
end;
end;
Writeln('Solution not found');
Writeln(F,'Solution not found');
Close(F);
ReadKey;
end.


Но, как мне кажется, это решение не соответствует условию... Вообщем разьясните, плз, если ошибаюсь или представьте свое решение. Буду очень признателен!

Сообщение отредактировано: kpaqp4er -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
kpaqp4er   Помогите плз решить задачу на множество   14.05.2009 2:22
Lapp   Во-первых, прочти Правила и убери картинку (да еще…   14.05.2009 3:01
kpaqp4er   Во-первых, прочти Правила и убери картинку (да ещ…   14.05.2009 3:24
Lapp   выложил найденное решение, чтобы оно возможно помо…   14.05.2009 3:45
kpaqp4er   Как заданы точки - в файле? Вообще, условие не …   14.05.2009 4:05
Lapp   я думаю подойдут все варианты, кроме треугольника …   14.05.2009 4:17
kpaqp4er   Если эти два множества разнесены в пространстве, …   14.05.2009 4:24
Lapp   В этом случае согласен :good:Ок :yes2: А в оста…   14.05.2009 4:35
kpaqp4er   Ок :yes2: А в остальных случаях тебя устраивает…   14.05.2009 4:54
Lapp   Извиняюсь, пришлось немного отвлечься.. Со всем со…   14.05.2009 5:59
Lapp   крафчег, чего молчишь? Без твоих твоих ответов, …   15.05.2009 0:05
kpaqp4er   крафчег, чего молчишь? Без твоих твоих ответов,…   15.05.2009 0:33
Lapp   Не совсем понятно как, что и как задавать в функци…   15.05.2009 0:45
kpaqp4er   Это другой вопрос, рн впереди. Тебе понятна логи…   15.05.2009 0:57
Lapp   Синтаксис Паскаля прост и естественен)). Ты попроб…   15.05.2009 1:19


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 7.09.2025 11:49
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name