помогите пожалуйста:
Считать из текстового файла Beg.txt матрицу Р(2,10). Элементы столбцов соответственно абсцисса и ордината одной из десяти точек плоскости. Если нет ни одной пары точек, расстояние между которыми меньше заданной величины R, заменить на нуль в матрице Р все отрицательные абсциссы точек, увеличив ординаты этих точек на R. Результат записать в файл Rez.txt.
Если получится, то сегодня
Полная версия: задача на паскале.матрица (другая)
uses crt;
const r=-10;
type
main=array[1..10,1..2]of integer;
procedure read_array(s:string; var mas:main);
var f: file of main;
begin
assign(f,s);
reset(f);
read(f,mas);
close(f);
end;
procedure write_array(s:string; mas:main);
var f:file of main;
begin
assign(f,s);
rewrite(f);
write(f,mas);
close(f);
end;
procedure print_array(mas:main);
var i,j:byte;
begin
for i:=1 to 10 do
begin
for j:=1 to 2 do
write(mas[i,j],' ');
writeln;
end;
end;
var mas:main; i,j:integer; b:boolean;
begin
clrscr;
read_array('d:\input.ini',mas);
print_array(mas);
b:=false;
for i:=1 to 9 do
for j:=i to 10 do
if sqrt(sqr(mas[i,1]-mas[j,1])+sqr(mas[i,2]-mas[j,2]))<r then
b:=true;
writeln;
writeln;
if b=false then
begin
for i:=1 to 10 do
begin
if mas[i,1]<0 then
mas[i,1]:=0;
inc(mas[i,2],r);
writeln(mas[i,1],' ',mas[i,2]);
end;
end;
write_array('d:\output.ini',mas);
readln;
end.
Bokul,
Кроме того:
var f: file of main;далеко не то же самое, что
var f: text;
Кроме того:
if b=false then begin
for i:=1 to 10 do begin
if mas[i,1]<0 then begin { <--- Begin забыл }
mas[i,1]:=0;
inc(mas[i,2],r);
end; { <--- и End тоже }
writeln(mas[i,1],' ',mas[i,2]);
end;
end;
volvo, не увидел 
, сейчас исправлю.
, сейчас исправлю.
Цитата
if mas[i,1]<0 then begin { <--- Begin забыл }
mas[i,1]:=0;
inc(mas[i,2],r);
end; { <--- и End тоже }
{ <--- Begin забыл }
А здесь и не надо Begin - ординату в любом случае надо увеличивать.
Вот процедури считования и записи для текстових файлов:
procedure read_array(s:string; var mas:main);
var f:text; buf1,buf2:string; code,i,j:byte;
begin
assign(f,s);
reset(f);
buf2:='';
for i:=1 to 10 do
begin
readln(f,buf1);
for j:=1 to length(buf1) do
begin
if buf1[j]=' ' then
begin
val(buf2,mas[i,1],code);
buf2:='';
end
else
buf2:=buf2+buf1[j];
if j=length(buf1) then
begin
val(buf2,mas[i,2],code);
buf2:='';
end;
end;
buf1:='';
end;
close(f);
end;
procedure write_array(s:string; mas:main);
var f:text; str1,str2:string; i:byte;
begin
assign(f,s);
rewrite(f);
append(f);
for i:=1 to 10 do
begin
str(mas[i,1],str1);
str(mas[i,2],str2);
writeln(f,str1+' ',str2);
end;
close(f);
end;
Цитата(Bokul @ 22.06.2006 20:15)
А здесь и не надо Begin - ординату в любом случае надо увеличивать.
Правда? Тогда, как ты объяснишь вот это:Цитата(Задание)
Если нет ни одной пары точек, расстояние между которыми меньше заданной величины R, заменить на нуль в матрице Р все отрицательные абсциссы точек, увеличив ординаты этих точек на R.
Заметь, не "увеличив ординаты ВСЕХ точек на R.", а именно ЭТИХ точек...
Цитата
а именно ЭТИХ точек...
Опять моя невнимательность проявляется...
Спасибо большое!) код Bokul рабочий? ещё не компилил...
Цитата
код Bokul рабочий? ещё не компилил...
Вот рабочий
uses crt;
const r=-10;
type
main=array[1..10,1..2]of integer;
procedure read_array(s:string; var mas:main);
var f:text; buf1,buf2:string; code,i,j:byte;
begin
assign(f,s);
reset(f);
buf2:='';
for i:=1 to 10 do
begin
readln(f,buf1);
for j:=1 to length(buf1) do
begin
if buf1[j]=' ' then
begin
val(buf2,mas[i,1],code);
buf2:='';
end
else
buf2:=buf2+buf1[j];
if j=length(buf1) then
begin
val(buf2,mas[i,2],code);
buf2:='';
end;
end;
buf1:='';
end;
close(f);
end;
procedure write_array(s:string; mas:main);
var f:text; str1,str2:string; i:byte;
begin
assign(f,s);
rewrite(f);
append(f);
for i:=1 to 10 do
begin
str(mas[i,1],str1);
str(mas[i,2],str2);
writeln(f,str1+' ',str2);
end;
close(f);
end;
procedure print_array(mas:main);
var i,j:byte;
begin
for i:=1 to 10 do
begin
for j:=1 to 2 do
write(mas[i,j],' ');
writeln;
end;
end;
var mas:main; i,j:integer; b:boolean;
begin
clrscr;
read_array('d:\input.ini',mas);
print_array(mas);
b:=false;
for i:=1 to 9 do
for j:=i to 10 do
if sqrt(sqr(mas[i,1]-mas[j,1])+sqr(mas[i,2]-mas[j,2]))<r then
b:=true;
writeln;
writeln;
if b=false then
begin
for i:=1 to 10 do
begin
if mas[i,1]<0 then
begin
mas[i,1]:=0;
inc(mas[i,2],r);
end;
writeln(mas[i,1],' ',mas[i,2]);
end;
end;
write_array('d:\output.ini',mas);
readln;
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.