构造相邻矩阵的代码(vb.net)

zansan

玩彩票的人大概用过旋转矩阵,现在这些矩阵是固定的.<br />下面的代码可以将一个矩阵的所有相邻矩阵找出.现在好象还没有哪个软件作到这一步.<br />我的英语不好,如果有什么问题请与我联系: XUZIJIEWZ@YAHOO.COM.CN<br /> <br /> <br /> <br />ublic Class closewheel <br />&#39;If you have a wheel name &quot;firwheel&quot;. the &quot;firwheel&quot; is of &quot;M pick N&quot; and &quot;L if K&quot;. <br />&#39;Then you can use this class to get all close wheel of &quot;firwheel&quot;. <br />&#39;those close wheels differ from &quot;firwheel&quot; at only one line. <br />&#39;in fact there are some close wheels to &quot;firwheel&quot;. <br />&#39; <br />&#39;How to use the class? <br />&#39;1,dim a new object myclosewheel: dim myclosewheel as new closewheel <br />&#39;2,initialize the object myclosewheel: myclosewheel.inims(m,n,k,l) <br />&#39;3,get you close wheels eith myclosewheel: myclosewheel.getwheel(firwheel,endwheel) <br />&#39;must run at the order. or it will do wrong. <br />&#39; <br />&#39;the firwheel is 2 dimension array. it include some lines. <br />&#39;exp: <br />&#39; the wheel include 3 lines. (1 2 3 4) (2 3 4 5) ( 1 3 4 6) <br />&#39; the firwheel is : 1 2 3 4 <br />&#39; 2 3 4 5 <br />&#39; 1 3 4 6 <br />&#39; <br />&#39;the endwheel is 3 dimension array. the modul is : endwheel(the i wheel, the j line, the k number) <br />&#39; <br />&#39;the class can be ameliorated to do other thing. <br />&#39; <br />&#39;i must provide for exam, so i had not debug it. the principle is not difficult to know. you can debug it. <br />&#39; <br />&#39; good luck&#33; <br />&#39;MAIL: xuzijiewz@yahoo.com.cn <br />rivate Shared ms(,,,,) As Integer <br />rivate Shared MYM As Byte <br />rivate Shared MYN As Byte <br />rivate Shared MYK As Byte <br />Private Shared MYL As Byte <br />Public Sub inims(ByVal M As Byte, ByVal N As Byte, ByVal K As Byte, ByVal L As Byte) <br />If M &lt; N Or N &lt; K Or K &lt; L Or L &lt; 1 Then <br />MsgBox(&quot;there is somee wrong with input wheel .&quot;, MsgBoxStyle.OKOnly, &quot;CLOSE LOTTO WHEEL&quot;) <br />Exit Sub <br />End If <br />Dim I1 As Integer, I2 As Integer, IWS As Long = 1 <br />MYM = M : MYK = K : MYN = N : MYL = L <br />If L &lt; M / 2 And N &gt; M / 2 Then <br />I2 = Int(M / 2) <br />ElseIf L &gt; M / 2 Then <br />I2 = L <br />ElseIf N &lt; M / 2 Then <br />I2 = N <br />End If <br />For I1 = 1 To I2 <br />IWS = IWS * (M - I1 + 1) / I1 <br />Next <br />ReDim ms(M, 1, 1, IWS, N - 1) <br />For I1 = L To K <br />Call creams(N, I1, 1, 1) <br />Call creams(M - N, N - I1, 1, 0) <br />Call creams(K, I1, 0, 1) <br />Call creams(M - K, K - I1, 0, 0) <br />Next <br />End Sub <br /><br />Public Sub GETWHEEL(ByVal INWHEEL(,) As Byte, ByRef OUTWHEEL(,,) As Byte) <br />Dim FIRWHEEL(UBound(INWHEEL, 1), MYN - 1) As Byte, I As Byte, MIDLINES(,) As Byte, ENDLINES(,) As Byte, i1 As Byte, I2 As Byte, I3 As Byte, IWHEEL As Integer = -1 <br />For I = 0 To UBound(INWHEEL, 1) <br />For i1 = 0 To MYN - 1 <br />FIRWHEEL(I, i1) = INWHEEL(I, i1) - 1 <br />Next <br />Next <br />For I = 0 To UBound(INWHEEL, 1) <br />10: i1 = 0 <br />For I2 = 0 To MYN - 1 <br />If FIRWHEEL(I, I2) = FIRWHEEL(I, I2 + 1) Then <br />MsgBox(&quot;there is somee wrong with input wheel.&quot;, MsgBoxStyle.OKOnly, &quot;CLOSE LOTTO WHEEL&quot;) <br />Exit Sub <br />ElseIf FIRWHEEL(I, I2) &gt; FIRWHEEL(I, I2 + 1) Then <br />I3 = FIRWHEEL(I, I2) <br />FIRWHEEL(I, I2) = FIRWHEEL(I, I2 + 1) <br />FIRWHEEL(I, I2 + 1) = I3 <br />i1 = i1 + 1 <br />End If <br />Next <br />If i1 &gt; 0 Then GoTo 10 <br />Next <br />For I = 0 To UBound(INWHEEL, 1) <br />Call FIT(FIRWHEEL, I, 1, MIDLINES) <br />Call FIT(MIDLINES, 1, 0, ENDLINES) <br />For i1 = 0 To UBound(ENDLINES, 1) <br />For I2 = 0 To MYN - 1 <br />If FIRWHEEL(I, I2) &lt;&gt; ENDLINES(i1, I2) Then GoTo 100 <br />Next <br />GoTo 200 <br />100: ReDim Preserve OUTWHEEL(IWHEEL + 1, UBound(FIRWHEEL, 1), MYN - 1) <br />For I2 = 0 To UBound(FIRWHEEL, 1) <br />For I3 = 0 To MYN - 1 <br />OUTWHEEL(IWHEEL, I2, I3) = FIRWHEEL(I2, I3) + 1 <br />Next <br />Next <br />For I3 = 0 To MYN - 1 <br />OUTWHEEL(IWHEEL, I, I3) = ENDLINES(i1, I3) + 1 <br />Next <br />IWHEEL = IWHEEL + 1 <br />200: Next <br />Next <br />End Sub <br /><br />Private Sub FIT(ByVal INWHEEL1(,) As Byte, ByVal IN1 As Byte, ByVal IN2 As Byte, ByRef OUTLINES(,) As Byte) <br />Dim LINES(UBound(INWHEEL1, 2)) As Byte, OTHERNUM(MYM - 1) As Byte, OTHERNUM1(MYM - 1) As Integer <br />Dim I As Byte, i1 As Long, I2 As Long, I3 As Long, I4 As Byte, i5 As Byte, IFJ As Long, IBC As Byte, IBCI As Long, i6 As Byte, i7 As Byte <br />Dim LINEFJ(MYN) As Byte, LINEBC(MYN) As Byte, LINE(MYN) As Byte, ILINES As Integer = -1 <br />For I = 0 To MYM - 1 <br />OTHERNUM1(I) = I <br />Next <br />For I = 0 To UBound(INWHEEL1, 2) <br />LINES(I) = INWHEEL1(IN1, I) <br />OTHERNUM1(LINES(I)) = -1 <br />Next <br />i1 = 0 <br />For I = 0 To MYM - 1 <br />If OTHERNUM1(I) &gt; -1 Then <br />OTHERNUM(i1) = OTHERNUM1(I) <br />i1 = i1 + 1 <br />End If <br />Next <br />For I = MYL To MYK <br />For i1 = 0 To ms(I, IN2, 1, 0, 0) <br />For I2 = 0 To I - 1 <br />LINEFJ(I2) = LINES(ms(I, IN2, 1, i1, I2)) <br />Next I2 <br />If (IN2 = 1 And MYK = I) Or (IN2 = 0 And MYN = I) Then <br />IBCI = 0 <br />Else <br />If IN2 = 1 Then <br />IBCI = ms(MYK - I, 0, 0, 0, 0) <br />Else <br />IBCI = ms(MYN - I, 1, 0, 0, 0) <br />End If <br />End If <br />For I2 = 0 To IBCI <br />If IBCI = 0 Then <br />For I3 = 0 To I - 1 <br />LINE(I3) = LINEFJ(I3) <br />Next <br />GoTo 50 <br />Else <br />If IN2 = 1 Then <br />For I3 = 0 To MYK - I - 1 <br />LINEBC(I3) = OTHERNUM(ms(MYK - I, 0, 0, I2, I3)) <br />Next I3 <br />Else <br />For I3 = 0 To MYN - I - 1 <br />LINEBC(I3) = OTHERNUM(ms(MYN - I, 1, 0, I2, I3)) <br />Next I3 <br />End If <br />End If <br />I3 = 0 : I4 = 0 : i6 = 0 <br />If IN2 = 1 Then <br />i7 = MYK - I <br />Else <br />i7 = MYN - I <br />End If <br />Do While I3 &lt; I And I4 &lt; i7 <br />If LINEFJ(I3) &lt; LINEBC(I4) Then <br />LINE(i6) = LINEFJ(I3) <br />I3 = I3 + 1 <br />Else <br />LINE(i6) = LINEBC(I4) <br />I4 = I4 + 1 <br />End If <br />i6 = i6 + 1 <br />Loop <br />If I3 = I Then <br />For i5 = I4 To i7 - 1 <br />LINE(i6 + i5 - I4) = LINEBC(i5) <br />Next <br />Else <br />For i5 = I3 To I - 1 <br />LINE(i6 + i5 - I3) = LINEFJ(i5) <br />Next <br />End If <br />50: <br />If IN2 = 1 Then <br />i7 = MYN <br />Else <br />i7 = MYK <br />End If <br />For I3 = 0 To UBound(INWHEEL1, 1) <br />I4 = 0 : i5 = 0 : i6 = 0 <br />Do While i5 &lt; i7 And I4 &lt; i7 <br />If LINE(I4) &lt; INWHEEL1(I3, i5) Then <br />I4 = I4 + 1 <br />ElseIf LINE(I4) &gt; INWHEEL1(I3, i5) Then <br />i5 = i5 + 1 <br />ElseIf LINE(I4) = INWHEEL1(I3, i5) Then <br />I4 = I4 + 1 : i5 = i5 + 1 : i6 = i6 + 1 <br />End If <br />Loop <br />If IN2 = 1 Then <br />If i6 &gt; MYL - 1 Then GoTo 100 <br />Else <br />If i6 &lt; MYL Then GoTo 100 <br />End If <br />Next <br />ILINES = ILINES + 1 <br />ReDim Preserve OUTLINES(ILINES, i7 - 1) <br />For I3 = 0 To i7 - 1 <br />OUTLINES(ILINES, I3) = LINE(I3) <br />Next <br />100: Next <br />Next i1 <br />Next I <br />End Sub <br /><br />Private Sub creams(ByVal m As Byte, ByVal n As Byte, ByVal in1 As Byte, ByVal in2 As Byte) <br />Dim num(n + 1) As Byte, i As Byte, iP As Byte = n, IWS As Long = 1 <br />If n = 0 Then Exit Sub <br />For i = 1 To n <br />num(i) = i <br />Next <br />Do While iP &gt; 0 <br />For i = 1 To n <br />ms(n, in1, in2, IWS, i - 1) = num(i) - 1 <br />Next <br />100: num(iP) = num(iP) + 1 <br />If num(iP) &gt; m - n + iP Then <br />iP = iP - 1 <br />If iP = 0 Then <br />ms(n, in1, in2, 0, 0) = IWS <br />Exit Sub <br />End If <br />GoTo 100 <br />End If <br />For i = iP To n - 1 <br />num(i + 1) = num(i) + 1 <br />Next <br />IWS = IWS + 1 <br />iP = n <br />Loop <br />End Sub <br />End Class