一 求有向图中强连通分量

一求有向图中强连通分量

(1)功能

求有向图中强连通分量

(2)调用方式

先输入顶点个数（2～9），点“确定”后将出现顶点图示，再将每条有向边按起始点、终点输入。每输入一条边起、终点后，按“输入”确认，就可在图形中显示该边。

当所有边输入完毕后，点“终了”键结束。将在现有图形上画出

(3)算法说明

算法步骤如下：

1、在二维数组pm中形成图的邻接矩阵。

2、利用warshell算法计算图的路径矩阵，并存放在pm中：

For k = 1 To p '计算pm

For j = 1 To p

For i = 1 To p

If pm(i, k) = 1 And pm(k, j) = 1 Then

pm(i, j) = 1

End If

Next i

Next j

Next k

3、计算cm矩阵：

For i = 1 To p '计算cm

For j = 1 To p

If pm(i, j) = 1 And pm(j, i) = 1 Then

cm(i, j) = 1

End If

Next j

Next i

4、依次检查cm各行，

(4)程序清单

Dim ans As String

Dim PI As Double

Dim pm(10, 10), cm(10, 10), om(10, 10), i, j, k, p, a, c, d, n, b(10), s(10, 10), x(10), y(10) As Integer

Function arrow(i, j)

Line (x(i), y(i))-(x(j), y(j)), QBColor(0)

t = Atn((y(i) - y(j)) / (x(i) - x(j)))

If x(j) > x(i) Then

t = t + PI

End If

Me.DrawWidth = 2

Line (x(j), y(j))-(x(j) + 40 * Cos(t + PI / 16), y(j) + 40 * Sin(t + PI / 16)), QBColor(0)

Line (x(j), y(j))-(x(j) + 40 * Cos(t - PI / 16), y(j) + 40 * Sin(t - PI / 16)), QBColor(0)

Me.DrawWidth = 1

End Function

Private Sub Command1_Click()

Cls

a = 0

If Not IsNumeric(Text1.Text) Then '输入顶点个数

a = MsgBox("请输入2-9的整数", 0)

Text1.Text = ""

Else

p = Int(Text1.Text)

If p < 2 Or p > 9 Then

a = MsgBox("顶点个数有误，请从新输入", 0)

Text1.Text = ""

End If

End If

If a = 0 Then '依据顶点个数画图Dim ra As Integer

ScaleTop = -1100

ScaleLeft = -700

ScaleHeight = 2000

ScaleWidth = 2000

For i = 1 To p

FillColor = QBColor(0)

FillStyle = 0

x(i) = Cos(2 * PI * (i - 1) / p) * 500

y(i) = Sin(2 * PI * (i - 1) / p) * 500

Circle (x(i), y(i)), 7, QBColor(0)

CurrentX = x(i) * 1.2

CurrentY = y(i) * 1.2

Print i

Next i

End If

End Sub

Private Sub Command2_Click()

c = 0

If Not IsNumeric(Text2.Text) Or Not IsNumeric(Text3.Text) Then '输入边的信息

c = MsgBox("顶点必须为数字，请从新输入", 0)

Text2.Text = ""

Text3.Text = ""

Exit Sub

Else

i = Int(Text2.Text)

j = Int(Text3.Text)

End If

If i < 1 Or i > p Or j < 1 Or j > p Then '判断顶点合法

c = MsgBox("顶点有误，请从新输入", 0)

Text2.Text = ""

Text3.Text = ""

End If

If c = 0 Then '画边om(i, j) = 1

a = arrow(i, j)

Text2.Text = ""

Text3.Text = ""

End If

End Sub

Private Sub Command3_Click()

n = 0

For i = 1 To p

om(i, i) = 1

For j = 1 To p

pm(i, j) = om(i, j)

Next j

Next i

For k = 1 To p '计算pm

For j = 1 To p

For i = 1 To p

If pm(i, k) = 1 And pm(k, j) = 1 Then

pm(i, j) = 1

End If

Next i

Next j

Next k

For i = 1 To p '计算cm

For j = 1 To p

If pm(i, j) = 1 And pm(j, i) = 1 Then

cm(i, j) = 1

End If

Next j

Next i