KingKong
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
во задача
даны два множества точек на плоскости. Из первого множества выбрать три различные точки так, чтобы треугольник с вершинами в этих тчках содержал(строго внутри себя) равное количество точек первого и второго множеств.
вот решение
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. |
так не пойдёт