Задача. Геометрия.
На геометрической плоскости дано множество точек. Координаты точек хранятся в текстовом файле. В первой строке файла содержится количество точек. Во второй, и последующих записаны координаты точки по оси 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. |