Program Dost; Uses crt; var SM,dt,td,sk,dk: array [1..13,1..13] of 0..1; i,j,n,m,t:integer; {SM-мат-ца смежности} Begin {Dt - мат-ца достижимости} clrscr; {TD - транспониронная DT} {SK - мат-ца сильных компонент} For i:=1 to 13 do {Dk - мат-ца диагонально-кубический вид} For j:=1 to 13 do sm[i,j]:=0; {обнуляем мат-цу} {Сама матрица смежности} sm[1,2]:=1 ; sm[7,4]:=1; sm[1,5]:=1 ; sm[8,7]:=1; sm[1,6]:=1 ; sm[9,7]:=1; sm[2,1]:=1 ; sm[10,7]:=1; sm[3,2]:=1 ; sm[11,10]:=1; sm[3,4]:=1 ; sm[11,12]:=1; sm[3,5]:=1 ; sm[12,8]:=1; sm[4,9]:=1 ; sm[12,11]:=1; sm[5,1]:=1 ; sm[12,13]:=1; sm[5,7]:=1 ; sm[13,11]:=1; sm[6,5]:=1 ; sm[6,8]:=1 ; sm[6,10]:=1; {-----------------------------Достижимость по Уоршеллу----------------------------------------------} For i:=1 to 13 do For j:=1 to 13 do Dt[i,j]:=Sm[i,j]; n:=0; For j:=1 to 13 do Begin Inc(n); For i:=1 to 13 do If i<>j then If dt[i,j]=1 then begin For m:=1 to 13 do Dt[i,m]:=Dt[i,m]+Dt[n,m]; If dt[i,j]>1 then begin dt[i,j]:=1; End; end; For i:=1 to 13 do dt[i,i]:=1; {--------__Вывод мат-цы-------} For i:=1 to 13 do Begin writeln; For j:=1 to 13 do write (dt[i,j]:2); end; writeln; {---------------Мат-ца сильных компонент------} For i:=1 to 13 do begin For j:=1 to 13 do Begin sk[i,j]:=0; td[i,j]:=dt[j,i]; If (dt[i,j]=td[i,j]) and (dt[i,j]=1) then sk[i,j]:=1; end; end; {----------Вывод мат-цы ск} For i:=1 to 13 do Begin inc(t); GotoXy(40,t); For j:=1 to 13 do write (sk[i,j]:2); end; {--------- Приводим мат-цу ск к виду блочно диаг-му-----} For i:=1 to 13 do begin For j:=1 to n do If sk[i,j]=1 then Begin inc(m); Dk[i,m]:=1; end; readln; end.