uses crt;
{Элемент линейного списка}
type prebro=^rebro;
rebro = record
{Начальная и конечная вершины ребра}
p1,p2:integer;
{Интенсивность}
alfa:real;
{Ссылка на следующий элемент списка}
next:prebro;
end;
{Добавить ребро с вершинами p1 и p2 и интенсивностью alfa}
procedure add(var g:prebro;p1,p2:integer;alfa:real);
var q:prebro;
begin
{Если список пуст}
if g=nil
then begin
{Создаем первый элемент}
new(g);
g^.p1:=p1;
g^.p2:=p2;
g^.alfa:=alfa;
g^.next:=nil;
end
{иначе}
else begin
{сдвигаемся на конец}
q:=g;
while q^.next<>nil do
q:=q^.next;
{и дабавляем новый элемент туда}
new(q^.next);
q^.next^.p1:=p1;
q^.next^.p2:=p2;
q^.next^.alfa:=alfa;
q^.next^.next:=nil;
end;
end;
{Расчёт i,j-го коффициента матрицы левой части
системы уравнений Колмогорова, т.е. коэффициент при
j-том p в i-том уравнении}
function Aij(g:prebro;i,j:integer):real;
var sum:real;
begin
sum:=0;
{при диагональном элементе -- сумма всех исходщих интенсивностей
со знаком минус}
if i=j
then begin
{перебирается весь список}
while (g<>nil) do
begin
{если встретилось ребро, выходящее из i}
if g^.p1=i
then sum:=sum-g^.alfa;
g:=g^.next;
end;
end
{при остальных элементах -- входящая интенсивность для
данной пары вершин i и j.
Примечание: я не стал исключать возможности нескольких
рёбер на одной и той же паре вершин. Это требует лишь
добавления break под условие}
else begin
while (g<>nil) do
begin
if (g^.p1=j) and (g^.p2=i)
then sum:=sum+g^.alfa;
g:=g^.next;
end;
end;
Aij:=result;
end;
var graf:prebro;
n,m,i,j:integer;
a:real;
begin
write('Vvedite kolichestvo vershin grafa: ');
readln(n);
i:=1;
while i<=n do
begin
writeln('Vershina ',i);
write('Vvedite nomer smezhnoy vershiny (0 - zakonchit): ');
readln(m);
if (m<1) or (m>n)
then begin
if m=0
then inc(i)
else writeln('Neverny nomer vershiny');
continue;
end;
write('Vvedite intensivnost alfa_',i,'_',m,': ');
readln(a);
add(graf,i,m,a);
end;
{Ниже программно вводится заданный граф.
Можно это раскомментарить, а можно стереть}
{n:=5;
add(graf,1,2,1);
add(graf,1,3,1);
add(graf,3,2,1);
add(graf,3,4,1);
add(graf,4,5,1);
add(graf,5,3,1);}
{Вывод на экран}
clrscr;
for i:=1 to n do
begin
write('dp',i,'(t)/dt = ');
for j:=1 to n do
begin
a:=Aij(graf,i,j);
{Если коэффициент ненулевой -- слагаемое выводится на экран.
Если положительное -- добавляется знак плюс }
if a>0
then write ('+');
if a<>0
then write(a:0:2,'*p',j,'(t) ');
end;
writeln;
end;
readkey;
end.
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.