七、求Eular回路.docVIP

求Eular回路 功能 在n个顶点的图G中，一条Eular回路是一顶点序列v1，v2，····vn 其中，每个顶点vi由一条边连到vi+1（i=1，2，·····，n-1），而vn被连到v1。 调用方式 先输入顶点个数（3～9），点“确定”后将出现顶点图示，再将每条有向边按起始点、终点输入。每输入一条边起、终点后，按“输入”确认，就可在图形中显示该边。当所有边输入完毕后，按“完成”键，将计算所有的Eular回路。然后点击下方的“下一个”或“上一个”按钮将在图上用有色线段依次表示出每一个Eular回路。 算法说明 一步一步的构造Eular回路,并且在每一步都进行测试，看看局部构造的向量是否有可能扩充为一个Eular回路，若不能就立即删除它并转到下一步。 Sub step2() nc = stack(m) m = m - 1 If nc 0 Then step3 Else k = k - 1 If k 0 Then step2 Else index = False End If End If End Sub Sub step3() A(k) = stack(m) stack(m) = nc - 1 If k n Then k = k + 1 step4 End If End Sub Sub step4() c = candidate() b = 0 For i = 1 To n If ed(i) = True Then m = m + 1 stack(m) = i b = b + 1 End If Next i m = m + 1 stack(m) = b step2 End Sub Function candidate() If k = 1 Then z1(1) = ep(2, 1) Else If k 2 Then If ep(2, A(k - 1)) = z1(k - 2) Then z1(k - 1) = ep(1, A(k - 1)) Else z1(k - 1) = ep(2, A(k - 1)) End If End If For j = 1 To n ed(j) = False Next j For j = 1 To n If z1(k - 1) = ep(1, j) Or z1(k - 1) = ep(2, j) Then ed(j) = True End If Next j For j = 1 To k - 1 ed(A(j)) = False Next j End If End Function 程序清单 Dim ans As String Dim PI As Double Dim stack(37), ep(3, 37), st(999, 37), A(37), z1(10), x(10), y(10), d(37) As Integer Dim h, nc, i, j, c, b, e, k, m, n, p, q As Integer Dim linei As Integer Dim ed(37), index As Boolean Sub step1() index = True z1(1) = ep(2, 1) stack(1) = 1 stack(2) = 1 m = 2 step2 End Sub Sub step2() nc = stack(m) m = m - 1 If nc 0 Then step3 Else k = k - 1 If k 0 Then step2