Решаем задачи Абрамян на Паскале. File78

File78. Дан файл вещественных чисел, содержащий элементы прямоугольной матрицы (по строкам), причем первый элемент файла содержит количество столбцов матрицы. Создать новый файл той же структуры, содержащий матрицу, транспонированную к исходной.

Решение:

program File78;
var
  F_out: file of Real;

  I,J,ColunmCount,RowCount:integer;
  Cell:Real;
  Name_in,Name_out:String;

Procedure SizeMatrix(Name:String; var X,Y:integer);
var
 F: file of Real;
 Cell:Real;
begin
  Assign(F,Name);
  Reset(F);
  Read(F,Cell);
  X:=trunc(Cell);
  Y:=0;
  While not eof(F) do
   begin
    inc(Y);
    Read(F,Cell);
   end;
  Close(F);
  Y:=Y div X;
end;

Function GetCell(Name:String; I,J:integer):Real;
var
 F: file of Real;
 Cell:Real;
 ColunmCount,i2:integer;
begin
  Assign(F,Name);
  Reset(F);
  Read(F,Cell);
  ColunmCount:=trunc(Cell);
  for i2:=1 to ColunmCount*(i-1)+j do Read(F,Cell);
  Close(F);
  GetCell:=Cell;
end;

begin
  Write('File in: ');
  Readln(Name_in);

  Write('File out: ');
  Readln(Name_out);


  SizeMatrix(Name_in,ColunmCount,RowCount);

  Assign(F_out,Name_out);
  Rewrite(F_out);
  Cell:=RowCount;
  Write(F_out,Cell);


  for i:=1 to ColunmCount do
   For j:=1 to RowCount do
    begin
     Cell:=GetCell(Name_in,J,I);
     Write(F_out,Cell);
    end;
  Close(F_out);
end.

program File78;

var

F_out: file of Real;

I,J,ColunmCount,RowCount:integer;

Cell:Real;

Name_in,Name_out:String;

Procedure SizeMatrix(Name:String; var X,Y:integer);

var

F: file of Real;

Cell:Real;

begin

Assign(F,Name);

Reset(F);

Read(F,Cell);

X:=trunc(Cell);

Y:=0;

While not eof(F) do

begin

inc(Y);

Read(F,Cell);

end;

Close(F);

Y:=Y div X;

end;

Function GetCell(Name:String; I,J:integer):Real;

var

F: file of Real;

Cell:Real;

ColunmCount,i2:integer;

begin

Assign(F,Name);

Reset(F);

Read(F,Cell);

ColunmCount:=trunc(Cell);

for i2:=1 to ColunmCount*(i-1)+j do Read(F,Cell);

Close(F);

GetCell:=Cell;

end;

begin

Write('File in: ');

Readln(Name_in);

Write('File out: ');

Readln(Name_out);

SizeMatrix(Name_in,ColunmCount,RowCount);

Assign(F_out,Name_out);

Rewrite(F_out);

Cell:=RowCount;

Write(F_out,Cell);

for i:=1 to ColunmCount do

For j:=1 to RowCount do

begin

Cell:=GetCell(Name_in,J,I);

Write(F_out,Cell);

end;

Close(F_out);

end.

Другие задачи из раздела File можно посмотреть здесь.

Комментарии 1

нет смысла в таком громоздком решении, тут можно всё упростить

 var
 s_in,s_out:string;
 f1,f2:file of real;
 i,j,col,str:integer;
 r:real;
 begin
 readln(s_in);
 assign(f1,s_in);
 readln(s_out);
 assign(f2,s_out);
 reset(f1);
 read(f1,r);
 col:=trunc(r);            {<- вместо процедуры MatrixSize }
 str:=filesize(f1) div col;{<- эти 2 строчки               }
 rewrite(f2);
 write(f2,str);
 for i:=1 to col do 
   For j:=1 to str do
    begin
    seek (f1,col*(j-1)+i); {<-вместо процедуры GetCell эта 1 строчка}
    read(f1,r);
    write(f2,r);
    end;
    reset(f2); // с этой строки идёт проверка результатов 
    for i:=1 to filesize(f2) do // она в задании не требуется
    begin
    read(f2,r);
    write(r:1:2,' ');
    end;
end.

s_in,s_out:string;

f1,f2:file of real;

i,j,col,str:integer;

r:real;

readln(s_in);

assign(f1,s_in);

readln(s_out);

assign(f2,s_out);

reset(f1);

read(f1,r);

col:=trunc(r); {<- вместо процедуры MatrixSize }

str:=filesize(f1) div col;{<- эти 2 строчки }

rewrite(f2);

write(f2,str);

for i:=1 to col do

For j:=1 to str do

seek (f1,col*(j-1)+i); {<-вместо процедуры GetCell эта 1 строчка}

write(f2,r);

reset(f2); // с этой строки идёт проверка результатов

for i:=1 to filesize(f2) do // она в задании не требуется

read(f2,r);

write(r:1:2,' ');

Ответить

Решаем задачи Абрамян на Паскале. File78

Комментарии:

Комментарии 1

Добавить комментарий Отменить ответ