Помогите плз решить задачу на множество, Два множества на плоскости и треугольник... Опции

[kpaqp4er]

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

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

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

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

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 - 13.05.2009 22:49

[Lapp]

Во-первых, прочти Правила и убери картинку (да еще и анимированную) из подписи.

Во-вторых, я мог бы сделать две вещи: либо помочь тебе исправить/доделать твое собственное решение, либо, если хочешь, сделать набросок своего. Чье-то постороннее решение, чтобы ты свалил свою курсовую, у меня нет ни малейшего желания даже смотреть. Либо разбирайся с ним сам, либо давай помогу сделать с нуля.
Вот так.