Задача на графы, Очень срочно! Опции

[klik1602]

Помогите пожалуйста!! Завтра сдавать, я в графах ни бум-бум...очень прошу!
23. На плоскости заданы 2n точек своими координатами. Найдите уравнение какой-либо прямой, делящей данное множество точек на два подмножества по n точек.

[klik1602]

вот код:

program L15_23;
const
 maxn=100;
type
 koardinat=array[1..maxn] of real;
var
 x,y:koardinat;
 k,n:integer;
 x0,y0,x1,x2,y1,miny,maxy:real;

procedure VvodKoardinat (n:integer; var x,y:koardinat);
{procedura vvoda koardinat tochek}
var
 i:byte;
 fin:text;
begin
 assign(fin,'L15_IN.txt');
 reset(fin);
 for i:=1 to n do
 begin
  read(fin,x[i]);
 end;
 readln(fin);
 for i:=1 to n do
 begin
  read(fin,y[i]);
 end;
 close(fin);
end;

procedure VivodKoardinat (n:integer; x,y:koardinat);
{procedura vivoda koardinat tochek}
var
 i:byte;
 fout:text;
begin
 assign(fout,'L15_23_OUT.txt');
 rewrite(fout);
 for i:=1 to n do
 begin
  write(fout,x[i]2,' ');
 end;
 writeln(fout);
 for i:=1 to n do
 begin
  write(fout,y[i]2,' ');
 end;
 close(fout);
end;

procedure sortirovka(var x,y:koardinat; n:integer);
{procedura sortirovki koardinat tochek v poryadke neubivaniya x-vih
koardinat, esli x odinakovi, to v poryadke neubivaniya y-vih koardinat,
ispol'zuem lineinuyu sortirovku po nevozrastaniyu}
var
 i,j:byte;
 buf,buf1,buf2:real;
begin
 for i:=1 to n-1 do
 for j:=i+1 to n do
 begin
  if x[i]<x[j] then
  begin
   buf:=x[i];
   x[i]:=x[j];
   x[j]:=buf;
   buf1:=y[i];
   y[i]:=y[j];
   y[j]:=buf1;
  end;
  if (x[i]=x[j]) and (y[i]<y[j]) then
  begin
   buf2:=y[i];
   y[i]:=y[j];
   y[j]:=buf2;
  end;
 end;
end;

procedure srednyaya_tochka(var x0,y0:real; var k:integer; x,y:koardinat;n:integer);
{pricedura nahogdeniya koardinati srednei tochki}
begin
 k:=n div 2+1;
 x0:=x[k];
 y0:=y[k];
end;

procedure tochki(var x1,x2,y1:real; x,y:koardinat; n,k:integer; x0,y0:real);
{procedira nahogdeniya dopolnitelnih tochek}
var
 i,j,l:integer;
begin
 i:=k;
 if x[i-1]<>x0 then {nahodim x1}
  x1:=x0-1
 else
 begin
  while x[i]=x0 do
  i:=i-1;
  if i=0 then
   x1:=x0-1
  else
   x1:=x[i];
 end;
 j:=k;            {nahodim x2}
 if x[j+1]<>x0 then
  x2:=x0+1
 else
 begin
  while x[i]=x0 do
  i:=i+1;
  if i=n+1 then
   x2:=x0+1
  else
   x2:=x[i];
 end;
{nahodim y1}
 l:=k;
 if x[l-1]<>x0 then
  y1:=y0-1
 else
  y1:=y[l-1];
end;


procedure MinMaxY (var maxy,miny:real; y:koardinat; n:integer);
{procedura nahogdeniya min i max y koardinati}
var
 i:integer;
begin
 maxy:=y[1];
 miny:=y[1];
 for i:=1 to n do
 begin
  if y[i]>maxy then
   maxy:=y[i]
  else
  if y[i]<miny then
   miny:=y[i];
 end;
end;

procedure uravnenie_pryamoi(x1,x2,y1,x0,y0,miny,maxy:real);
{nahogdenie uravneniya pryamoi i vivod ego v fail}
var
 z,a,b,m1,m2,l1,l2:real;
 fout:text;
begin
 a:=x0-x1;
 b:=x2-x0;
 if a<=b then
  z:=a
 else
  z:=b;
 m1:=x0;
 l1:=(y0+y1)/2;
 m2:=x0+z/2;
 l2:=y0-maxy+miny;
 assign (fout,'L15_23_OUT.txt');
 append (fout);
 writeln(fout,' ');
 writeln(fout,'Uravnenie pryamoi zadannoe dvumya tochkami');
 writeln (fout,'x-',m1:2:0,'/',m2:2:0,'-',m1:2:0,'= y-',l1:2:0,'/',l2:2:0,'-',l1:2:0);
 close(fout);
end;

begin
 writeln ('vvedite n - chetnoe kolichestvo tochek');
 repeat
  readln(n);
 until n mod 2=0;
 x1:=0;x2:=0;y1:=0;miny:=0;maxy:=0;k:=0;
 VvodKoardinat (n,x,y);
 Sortirovka(x,y,n);
 VivodKoardinat (n,x,y);
 srednyaya_tochka(x0,y0,k,x,y,n);
 tochki(x1,x2,y1,x,y,n,k,x0,y0);
 MinMaxY (maxy,miny,y,n);
 uravnenie_pryamoi(x1,x2,y1,x0,y0,miny,maxy);
end.