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

File90. Даны два файла вещественных чисел с именами $S_A$ и $S_B$ , содержащие ненулевые части нижнетреугольных матриц $A$ и $B$ (по строкам). Создать новый файл с именем $S_C$ , содержащий ненулевую часть произведения $A*B$ (по строкам). Если матрицы $A$ и $B$ нельзя перемножать, то оставить файл $S_C$ пустым.

Решение:

program File90;
var
  F: file of Real;
  lenA,lenB,i,j,k:integer;
  RezCell:Real;
  SA,SB,SC:String;

Function CreateFullFile(NameCut,NameFull:String):integer;
var
  F_in,F_out: file of Real;
  len,i,j,i2,j2:integer;
  Cell:Real;
begin
 Assign(F_in,NameCut);
 Assign(F_out,NameFull);
 Reset(F_in);
 len:=0;
 While (not eof(F_in)) do
  begin
   Read(F_in,Cell);
   inc(len);
  end;
 Close(F_in);

i2:=1;
 while (len>0) do
  begin
   len:=len-i2;
   inc(i2);
  end;
 len:=i2-1;

Reset(F_in);
 Rewrite(F_out);
 I2:=1;
 J2:=0;
 While not eof(F_in) do
  begin
   inc(j2);
   Read(F_in,Cell);
   Write(F_out,Cell);
   if j2=i2 then
    begin
     Cell:=0;
     for j2:=i2+1 to len do Write(F_out,Cell);
     inc(i2);
     j2:=0;
    end;
  end;
 Close(F_in);
 Close(F_out);
 CreateFullFile:=len;
end;

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

begin
 Write('SA: ');
 Readln(SA);

Write('SB: ');
 Readln(SB);

Write('SC: ');
 Readln(SC);

LenA:=CreateFullFile(SA,'~'+SA);
 LenB:=CreateFullFile(SB,'~'+SB);

Assign(F,SC);
 ReWrite(F);

if lenA = LenB then
  for i:=1 to lenA do
   for j:=1 to lenB do
    begin
     RezCell:=0;
     for k:=1 to LenA do RezCell:=RezCell+GetCell('~'+SA,LenA,I,K)+GetCell('~'+SB,LenB,K,J);
     Write(F,RezCell);
    end;
 Close(F);
 Assign(F,'~'+SA);
 Erase(F);
 Assign(F,'~'+SB);
 Erase(F);
end.

program File90;

var

F: file of Real;

lenA,lenB,i,j,k:integer;

RezCell:Real;

SA,SB,SC:String;

Function CreateFullFile(NameCut,NameFull:String):integer;

var

F_in,F_out: file of Real;

len,i,j,i2,j2:integer;

Cell:Real;

begin

Assign(F_in,NameCut);

Assign(F_out,NameFull);

Reset(F_in);

len:=0;

While (not eof(F_in)) do

begin

Read(F_in,Cell);

inc(len);

end;

Close(F_in);

i2:=1;

while (len>0) do

begin

len:=len-i2;

inc(i2);

end;

len:=i2-1;

Reset(F_in);

Rewrite(F_out);

I2:=1;

J2:=0;

While not eof(F_in) do

begin

inc(j2);

Read(F_in,Cell);

Write(F_out,Cell);

if j2=i2 then

begin

Cell:=0;

for j2:=i2+1 to len do Write(F_out,Cell);

inc(i2);

j2:=0;

end;

Close(F_in);

Close(F_out);

CreateFullFile:=len;

end;

Function GetCell(Name:String;len,i,j:integer):Real;

var

F: file of Real;

i2:integer;

Cell:Real;

begin

Assign(F,Name);

Reset(F);

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

Close(F);

GetCell:=Cell;

end;

begin

Write('SA: ');

Readln(SA);

Write('SB: ');

Readln(SB);

Write('SC: ');

Readln(SC);

LenA:=CreateFullFile(SA,'~'+SA);

LenB:=CreateFullFile(SB,'~'+SB);

Assign(F,SC);

ReWrite(F);

if lenA = LenB then

for i:=1 to lenA do

for j:=1 to lenB do

begin

RezCell:=0;

for k:=1 to LenA do RezCell:=RezCell+GetCell('~'+SA,LenA,I,K)+GetCell('~'+SB,LenB,K,J);

Write(F,RezCell);

end;

Close(F);

Assign(F,'~'+SA);

Erase(F);

Assign(F,'~'+SB);

Erase(F);

end.

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

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

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

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