2. Текст программы

Program kurs_Tozik;

Type matr=array[1..20,1..20]of real;

vect=array[1..20] of real;

var a:matr;

sStl,sStr:vect;

sD,min:real;

i,j,n,imin,jmin:byte;

f1,f2:text;

Reg:array[1..20] of string;

{---------------------------------------------------------------}

{Процедура вывода линии}

Procedure VivLine(kol:integer);

var i:integer;

begin

for i:=1 to kol*10 do write('_');

writeln;

end;

{---------------------------------------------------------------}

{Процедура присвоения регионам названия}

Procedure Region;

begin

Reg[1]:= 'Гомель ';

Reg[2]:= 'Минск ';

Reg[3]:= 'Гродно ';

Reg[4]:= 'Брест ';

Reg[5]:= 'Могилев ';

Reg[6]:= 'Витебск ';

Reg[7]:= 'Бобруйск';

end;

{---------------------------------------------------------------}

{Процедура заполнения матрицы из файла}

Procedure Vvod(n:byte;var a:matr);

Var i,j:byte;

Begin

reset(f1);

for i:=1 to n do

begin

for j:=1 to n do read(f1,a[i,j]);

readln(f1);

end;

close(f1);

end;

{---------------------------------------------------------------}

{Процедура вывода матрицы}

Procedure vivod(n:byte;a:matr);

Var i,j:byte;

Begin

VivLine(n+1);

write(' ':9);

for i:=1 to n do write('|',reg[i]:9);

writeln;

VivLine(n+1);

for i:=1 to n do

begin

write(reg[i]:8) ;

for j:=1 to n do write(' |',a[i,j]:8:1);

writeln;

VivLine(n+1);

end;

end;

{---------------------------------------------------------------}

{Нахождение суммы диагональных элементов}

Procedure SumDiag (n:byte;a:matr);

Var i,j:byte;

sD:real;

Begin

sD:=0;

for i:=1 to n do

for j:=1 to n do

if (i=j)then sD:=sD+a[i,j];

writeln;

writeln;

writeln('Объем перевозок в МЕСТНОМ сообщении = ',sD);

writeln;

end;

{---------------------------------------------------------------}

{Нахoждение суммы по столбцам}

Procedure sumStolb(n:byte;a:matr);

Var i,j:byte;

sum:vect;

Begin

for j:=1 to n do

begin

sum[j]:=0;

for i:=1 to n do

sum[j]:=sum[j]+a[i,j];

end;

writeln;

writeln('Суммарный объем В В О З А в регионы (суммы по столбцам)');

VivLine(n);

for i:=1 to n do

begin

if i<>1 then write('|');

write(reg[i]:9);

end;

writeln;

VivLine(n);

for i:=1 to n do

begin

if i<>1 then write('|');

write(sum[i]:8:1,' ');

end;

writeln;

VivLine(n);

end;

{---------------------------------------------------------------}

{Нахoждение суммы по строкам}

Procedure sumStrok(n:byte;a:matr);

Var i,j:byte;

sum:vect;

Begin

for i:=1 to n do

begin

sum[i]:=0;

for j:=1 to n do

sum[i]:=sum[i]+a[i,j];

end;

writeln;

writeln('Суммарный объем В Ы В О З А из регионов (суммы по строкам) ');

VivLine(2);

for i:=1 to n do

begin

writeln(reg[i]:8,'|',sum[i]:9:1);

VivLine(2);

end;

end;

{---------------------------------------------------------------}

{Начало раздела оператора главной программы}

Begin

assign(f1,'kr_input.txt');

Region;

n:=7;

vvod (n,a);

writeln(' И с х о д н а я таблица п е р е в о з о к г р у з о в между регионами');

vivod(n,a);

sumStolb(n,a);

sumStrok(n,a);

SumDiag (n,a);

{Нахождение минимальной перевозки под главной диагональю}

imin:=2; jmin:=1;

min:=a[imin,1];

for i:=3 to n do

for j:=1 to i-1 do

if a[i,j] < min then

begin

min:=a[i,j];

imin:=i; jmin:=j;

end;

writeln('Минимальная перевозка= ',min,' из региона ',Reg[imin],'в регион ', Reg[jmin]);

{Увеличение перевозок по найденному региону на 17%}

for i:=1 to n do

a[i,jmin]:=a[i,jmin]+a[i,jmin]*0.17;

writeln('Преобразованная таблица п е р е в о з о к г р у з о в между регионами ');

vivod(n,a);

end.