Delphi-Help

  • Increase font size
  • Default font size
  • Decrease font size
Главная

Задача. Геометрия.

Оцените материал
(0 голосов)

Задача. Геометрия.

На геометрической плоскости дано множество точек. Координаты точек хранятся в текстовом файле. В первой строке файла содержится количество точек. Во второй, и последующих записаны координаты точки по оси 0х,0у. Программа должна решить поставленную задачу и нарисовать на экране заданное множество точек и решение. Среди точек плоскости получить три точки, для которых треугольник с вершинами в данных точках содержит такое же количество внутренних точек множества, что и окружность, проходящая через данные точки.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, StdCtrls, TeEngine, Series, TeeProcs, Chart;
 
type // точка на плоскости
  Point = record
    X : Extended;
    Y : Extended;
  end;
 
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    Chart1: TChart;
    Series1: TPointSeries;
    Button3: TButton;
    Series2: TPointSeries;
    Label1: TLabel;
    Series3: TLineSeries;
    Button4: TButton;
    procedure N2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    function ParseString(str: string;var cnt:integer):TStringlist;
    procedure Button3Click(Sender: TObject);
    function FindCentreCircle(a,b,c : Point; var r : extended):Point;
    function SquareThreeAngle(a,b,c : Point): extended;
    function InTA(a,b,c,O : Point): boolean;
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  pnts : array of Point;
 
implementation
 
uses Math;
 
{$R *.dfm}
 
procedure TForm1.N2Click(Sender: TObject);
// открываем файл посредством компонента SaveDialog
begin
  memo1.Lines.Clear;
  if OpenDialog1.Execute then 
 //открываем диалог для выбора файла и загружаем содержимое в memo1
    Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
// считываем в массив координаты из файла загруженного в memo
var i,cnt,tmp : integer;          
//  считать координаты из memo1 в массив точек pnts
    workarray : TStringList;
begin
  if Memo1.Lines.Count = 0 then // если файл пуст, то завершаем
    Exit;
  cnt := StrToInt(Memo1.Lines[0]);
  Series1.Clear;
  Series2.Clear;
  Series3.Clear;
 
  SetLength(pnts,cnt);
 // указываем длину массива значением из первой строчки файла
 
  for i := 1 to cnt do
    begin
      workarray := ParseString(memo1.Lines[i],tmp);
// используем функцию разделения строки на слова, то есть получаем 2 координаты
      pnts[i-1].X := StrToInt(workarray[0]);
      pnts[i-1].Y := StrToInt(workarray[1]);
      Series1.AddXY(pnts[i-1].X,pnts[i-1].Y)// выводим точки на график
    end;
 
end;
 
function TForm1.ParseString(str: string;var cnt:integer):TStringlist;
// функцию разделения строки на слова
var strs : TStringlist;
    tmp  : string;
    i,j  : integer;
begin
  strs := TStringlist.Create;
  i := 1;
  j := 1;
  repeat
    if (str[i] = ';')or(i = Length(str)+1) then 
// если в строке попадается символ ; или конец строки,
// то они являются делителем строки на слова
      begin
        tmp := Copy(str,j,i-j);
        strs.Add(tmp);
        j := i+1
      end;
    inc(i);
 
  until i > Length(str)+1;
 
  cnt := strs.Count;
  result := strs;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
// дополнительная функция для создания файла с координатами
var i,r1,r2 : integer;   
// метод для создания файла со случайными координатами,
// необходим, чтобы быстро получить необходимый файл)
begin
  memo1.Lines.Clear;
  memo1.Lines.Add('21');
  randomize;
 
  for i:=0 to 20 do
    begin
      r1 := Random(20)-10;
      r2 := Random(20)-10;
      memo1.Lines.Add(IntToStr(r1)+';'+IntToStr(r2));
    end;
  if SaveDialog1.Execute then
    memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
 
procedure TForm1.Button3Click(Sender: TObject);
// определяем окружность и треугольник
var i,j,k,n,cnt1,cnt2,cnttmp,cnttemp : integer;
    fi,Sq,rtmp,r  : extended;
    p : array [0..3] of Point;
    p0 : Point;
begin
  cnt1 := 0;
  cnt2 := 0;
  r := 2;
  Series2.Clear;
  Series3.Clear;
  for i := 0 to Length(pnts)-3 do 
// пробегаемся по всем неповторяющимся тройкам точек
    for j:= i+1 to Length(pnts)-2 do
      for k:= j+1 to Length(pnts)-1 do
        begin
//          if (i=0)and(j=29)and(k=100) then
//            rtmp := 0;
          Sq := SquareThreeAngle(pnts[i],pnts[j],pnts[k]);
// определяем, не лежат ли 3 точки на одной прямой, то есть
// находим площадь треугольника, и если она > 0, 
// значит не лежат 3 точки на 1 прямой
          if Sq > 0.001 then
              begin                                                   
                p0 := FindCentreCircle(pnts[i],pnts[j],pnts[k],rtmp); 
// Используем функция для определения центра окружности и радиуса
 
//                Label1.Caption := IntToStr(i)+' '+IntToStr(j)+' '+IntToStr(k);
                cnttmp := 0;
                for n:=0 to Length(pnts)-1 do 
// проверяем какие точки лежат на окружности
                  if (n<>i)and(n<>j)and(n<>k) then
                    if (sqrt(sqr(pnts[n].X-p0.X)+sqr(pnts[n].Y-p0.Y))< rtmp)then 
// То есть подставляем координаты точки в уравнение окружности
                      inc(cnttmp);
 
                cnttemp := 0;
                for n:=0 to Length(pnts)-1 do 
// проверяем какие точки лежат в треугольнике
                  if (n<>i)and(n<>j)and(n<>k) then
                    if (InTA(pnts[i],pnts[j],pnts[k],pnts[n]))then 
// Используем специальную функцию для проверки
                      inc(cnttemp);
 
                if (cnttmp = cnttemp)and(cnttmp > cnt1)and(cnttemp > cnt2) then 
// проверяем, совпало ли количество точек в треугольнике и круге,
// и максимальное ли это число
                  begin
                    p[0] := p0; //запоминаем максимальное число
                    p[1] := pnts[i];
                    p[2] := pnts[j];
                    p[3] := pnts[k];
                    cnt1 := cnttmp;
                    cnt2 := cnttemp;
                    Label1.Caption := IntToStr(cnttmp)+' '+IntToStr(cnttemp);
                    r := rtmp;
                  end;
              end;
        end;
 
  fi := 0;
  Series2.AddXY(p[0].X,p[0].Y); // Выводим окружность на график
  Series3.AddXY(p[1].X,p[1].Y);
  Series3.AddXY(p[2].X,p[2].Y);
  Series3.AddXY(p[3].X,p[3].Y);
  while fi < 360 do 
// цикля для вывода окружности используя параметрическое уравнение окружности
    begin
      Series2.AddXY(r*cos(fi)+p[0].X,r*sin(fi)+p[0].Y);
      fi := fi + 0.1;
    end;
end;
 
 
 
function TForm1.FindCentreCircle(a, b, c: Point; var r: Extended): Point; 
// функция нахождения центра окружности построенной на 3х точках
var p0 : Point;
    x1,x2,x3,y1,y2,y3,x0,y0,a1,a2,b1,b2,c1,c2: extended;
begin
  x1 := a.X;
  x2 := b.X;
  x3 := c.X;
  y1 := a.Y;
  y2 := b.Y;
  y3 := c.Y;
 
  a1 := -2*x1 + 2*x2;
  a2 := -2*x2 + 2*x3;
  b1 := -2*y1 + 2*y2;
  b2 := -2*y2 + 2*y3;
 
  c1 := (sqr(x2)-sqr(x1)) + (sqr(y2)-sqr(y1));
  c2 := (sqr(x3)-sqr(x2)) + (sqr(y3)-sqr(y2));
 
  x0 := (b1*c2-b2*c1)/(a2*b1-a1*b2);
  y0 := 0;
  if b1 <> 0 then
    y0 := (c1-a1*x0)/b1;
  if b2 <> 0 then
    y0 := (c2-a2*x0)/b2;
 
  p0.X := x0;
  p0.Y := y0;  
  r := sqrt(sqr(a.X-p0.X)+sqr(a.Y-p0.Y));
  result := p0;
end;
 
function TForm1.SquareThreeAngle(a, b, c: Point): extended;
// функция для определения площади треугольника по заданным 
// координатам вершин треугольника
begin
  result := abs((b.X-a.X)*(c.Y-a.Y)-(c.X-a.X)*(b.Y-a.Y))/2;
end;
 
function TForm1.InTA(a, b, c, O: Point): boolean;
// функция, определяющая расположение точки относительно 
// треугольника (в качестве параметров задаются 3 вершина и искомая точка
var sq,sq1,sq2,sq3 : extended;
begin               
// метод основан на сравнении суммы  площадей 3х 
// полученных треугольников с площадью общего треугольника
    result :=false;
    sq := SquareThreeAngle(a,b,c);
    sq1 := SquareThreeAngle(O,b,c);
    sq2 := SquareThreeAngle(a,O,c);
    sq3 := SquareThreeAngle(a,b,O);
    if abs(sq-(sq1+sq2+sq3)) < 0.000000001 then
      result := true;
 
end;
 
procedure TForm1.Button4Click(Sender: TObject);
var i,j,k,n : integer;
begin
  n := 0;
  for i := 3 to Length(pnts)-1 do
    if InTA(pnts[0],pnts[1],pnts[2],pnts[i]) then
      inc(n);
 
  Label1.Caption := IntToStr(n);
end;
 
end.

Прочитано 2696 раз
Авторизуйтесь, чтобы получить возможность оставлять комментарии

www.laborkomplekt.ru

Авторизация



Счетчики