form1.frm

来自「多种方法解决全排列的问题 在vb环境下编写」· FRM 代码 · 共 165 行

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "全排列输出程序"
   ClientHeight    =   8310
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   11685
   LinkTopic       =   "Form1"
   ScaleHeight     =   8310
   ScaleWidth      =   11685
   StartUpPosition =   3  '窗口缺省
   Begin VB.Menu CXZZF 
      Caption         =   "串行增值"
   End
   Begin VB.Menu CXWPF 
      Caption         =   "串行换位"
   End
   Begin VB.Menu te1 
      Caption         =   "新加方法1"
   End
   Begin VB.Menu te2 
      Caption         =   "新加方法2"
   End
   Begin VB.Menu BXKZF 
      Caption         =   "并行扩展"
   End
   Begin VB.Menu BXDLF 
      Caption         =   "并行单列"
   End
   Begin VB.Menu DGJHF 
      Caption         =   "递归交换"
   End
   Begin VB.Menu DGFZH 
      Caption         =   "递归赋值"
   End
   Begin VB.Menu TC 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const DM = 1000: Dim N, pl, s$(DM)
Private Sub CXZZF_Click()
   pl = 0: Dim d(DM): Call Csh
   For i = 1 To N: d(i) = i: Next i: m = f(N)
   For i = 1 To m: For j = 1 To N: s$(d(j)) = Right$(Str$(j), 1): Next j: Call prn(i, s$())
g1:  d(N) = d(N) + N - 1
     For j = N To 2 Step -1
       If d(j) > N Then d(j) = d(j) Mod N: d(j - 1) = d(j - 1) + 1
     Next j
     For j = 1 To N - 1
       For k = j + 1 To N: If d(j) = d(k) Then GoTo g1
       Next k
     Next j
   Next i
End Sub
Private Sub CXWPF_Click()
    pl = 1: Call Csh: p = 0
g2: p = p + 1: Call prn(p, s$())
    For i = N - 1 To 1 Step -1
      If s$(i) < s$(i + 1) Then
        For j = N To i + 1 Step -1: If s$(i) <= s$(j) Then Exit For
        Next j: Swap s$(i), s$(j)
        For j = N To 1 Step -1: If i + 1 >= j Then Exit For
        Swap s$(i + 1), s$(j): i = i + 1: Next j: GoTo g2
      End If
    Next i
End Sub
Sub te1_Click()
  pl = 2: Call Csh: p = 0
  Do: x = 0: p = p + 1: Call prn(p, s$())
    For i = 1 To N - 1: If s$(i) < s$(i + 1) Then x = i
    Next i
    If x <> 0 Then
      For i = x To N: If s$(x) < s$(i) Then j = i
      Next i: Swap s$(x), s$(j)
      For i = x + 1 To N
        If i <> N + x + 1 - i Then Swap s$(i), s$(N + x + 1 - i)
        If (i + 1) * 2 > N + x + 1 Then Exit For
      Next i
    End If
  Loop While x <> 0
End Sub
Rem reeor !
Sub te2_click()
  pl = 3: Call Csh: Call dg3(0, p)
End Sub
Sub dg3(m, p)
  If m < N - 1 Then
    Call dg3(m + 1, p)
    For i = m + 1 To N - 1
      Swap s$(m), s$(i): Call dg3(i, p): Swap s$(m), s$(i)
    Next i
  Else
    p = p + 1: Call prn(p, s$())
  End If
End Sub
Private Sub BXKZF_Click()
  pl = 4: Dim d$(DM, DM): Call Csh: d$(1, 1) = s$(1)
  For i = 1 To N - 1: v = f(i)
    For j = 1 To v: d$(j, i + 1) = s$(i + 1): Next j
    For j = 1 To i: For k = 1 To i + 1
      For m = 1 To v: d$(j * v + m, k) = d$(m, k): Next m
    Next k: Next j
    For j = 1 To i: For k = 1 To v
      m = j * v + k: d$(m, i + 1) = d$(m, j): d$(m, j) = s$(i + 1)
    Next k: Next j
  Next i
  For i = 1 To f(N): For j = 1 To N: s$(j) = d$(i, j): Next j: Call prn(i, s$()): Next i
End Sub
Private Sub BXDLF_Click()
  pl = 5: Dim d$(DM, DM): Call Csh: w = f(N): q = w
  For i = 1 To N: k = 0: p = i: q = q / (N - i + 1)
    Do: For j = 1 To q: d$(j + k, i) = s$(p): Next j
      k = k + q: If k + q > w Then Exit Do
g4:   p = p + 1: If p > N Then p = 1
      For j = 0 To i - 1: If s$(p) = d$(k + 1, j) Then GoTo g4
      Next j
    Loop
  Next i
  For i = 1 To f(N): For j = 1 To N: s$(j) = d$(i, j): Next j: Call prn(i, s$()): Next i
End Sub
Private Sub DGJHF_Click()
  pl = 6: Call Csh: Call dg1(1, p)
End Sub
Private Sub dg1(m, p)
  Dim d$(DM)
  If m = N Then
    p = p + 1: Call prn(p, s$())
  Else
    For i = m To N: d$(i) = s$(i): Next i
    For i = m To N
      For j = m To N: s$(j) = d$(j): Next j
      Swap s$(m), s$(i): Call dg1(m + 1, p)
    Next i
  End If
End Sub
Private Sub DGFZH_Click()
  pl = 7: Dim d$(DM): Call Csh: For i = 1 To N: d$(1) = s$(i): Call dg2(d$(), 1, p): Next i
End Sub
Private Sub dg2(d$(), m, p)
  If m = N Then
    p = p + 1: Call prn(p, d$())
  Else
    For i = 1 To N
      For j = 1 To m: If d$(j) = s$(i) Then GoTo g6
      Next j: d$(j) = s$(i): Call dg2(d$(), j, p)
g6: Next i
  End If
End Sub
Private Sub Csh()
   N = 5: For i = 1 To N: s$(i) = Chr$(48 + i): Next i: PSet (1, 1): Print Space$(15 * pl + 1); "NO:" + Str$(pl + 1)
End Sub
Private Sub prn(p, s$())
  Print Space$(15 * pl + 1); p;: For i = 1 To N: Print s$(i);: Next i: Print
End Sub
Private Sub Swap(i, j): t = i: i = j: j = t: End Sub
Private Function f(N): v = 1: For i = 1 To N: v = v * i: Next i: f = v: End Function
Private Sub TC_Click(): End: End Sub