1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Помогите пожалуйста!! Завтра сдавать, я в графах ни бум-бум...очень прошу! 23. На плоскости заданы 2n точек своими координатами. Найдите уравнение какой-либо прямой, делящей данное множество точек на два подмножества по n точек.
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.