задача на паскале.матрица (другая), про абсциссу и ординаты в матрицы ,строка и столбец Опции

[Roman1]

помогите пожалуйста:
Считать из текстового файла Beg.txt матрицу Р(2,10). Элементы столбцов соответственно абсцисса и ордината одной из десяти точек плоскости. Если нет ни одной пары точек, расстояние между которыми меньше заданной величины R, заменить на нуль в матрице Р все отрицательные абсциссы точек, увеличив ординаты этих точек на R. Результат записать в файл Rez.txt.
Если получится, то сегодня

[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: 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.

Сообщение отредактировано: volvo - 4.11.2006 0:14

[volvo]

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;

[Bokul]

volvo, не увидел , сейчас исправлю.

[Bokul]

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;

[volvo]

А здесь и не надо Begin - ординату в любом случае надо увеличивать.

Правда? Тогда, как ты объяснишь вот это:

Если нет ни одной пары точек, расстояние между которыми меньше заданной величины R, заменить на нуль в матрице Р все отрицательные абсциссы точек, увеличив ординаты этих точек на R.

Заметь, не "увеличив ординаты ВСЕХ точек на R.", а именно ЭТИХ точек...

[Bokul]

а именно ЭТИХ точек...

Опять моя невнимательность проявляется...

[Roman1]

Спасибо большое!) код Bokul рабочий? ещё не компилил...

[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.