VB source code for your reference this program together and work very troublesome, goto have to spend VERSION 5.00Begin VB.Form Form1 Caption = "Form1" ClientHeight = 6960 ClientLeft = 165 ClientTop = 735 ClientWidth = 9900 LinkTopic = "Form1" ScaleHeight = 6960 ScaleWidth = 9900 StartUpPosition = 3 'Windows Default Begin VB.TextBox Text1 Height = 6840 Left = 30 MultiLine = -1' True ScrollBars = 3 'Both TabIndex = 0 Top = 60 Width = 9840 End Begin VB.Menu start Caption = "start "EndEndAttribute VB_Name =" Form1 "Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False 'problem description:' has the same twelve outer ball, which has a bad ball, its weight and the other ten 'has a slight (But can be measured) difference. Now there is a very sensitive balance without weight, asking how to say three times, guarantee to find out the bad ball, and know that it is more light than the standard 'ball. Option Explicit 'Partial Method DIM BallData (3, 2, 5) As long' Data Left
Private ball (12) as long 'small ball weight, value of 0, 1 or -1, indicating normal ball than other ball weight than other spherical light privacy detection values first feed front 1. Left 10 after taking the ball, the right 100 second times, the left 1000 right 10000
Private Partcount As long 'Piece PRIVATE PARTARRAY (12, 12) AS Long' Various Groups Mark Data Private Partnum (12) As long 'Various PRIVATE PartGeted (12) as long' each group has been taken Multiple private partgeted2 (12) as long 'Various groups of PRIVATE BALLNUM As Long, GetNum As long
'Require 3 to avoid data conflicts Private ArrayData (3) As Longprivate ArrayData (3, 10,000, 2, 5) As longprivate get1 as long, get2 as long
Private ResulTarray (3, 3, 3, 2, 5) as long '3 Take Value Results' In order to reduce the number of variables, use multi-dimensional arrays, various dimensions, weightresult (2), WeightResult (2), L / R, BallData 'effective data is (1 1)' (2 1) (2 2 1) (2 31) '(311 312 313) (321 322 323) (331 332 333)
Private sub flow_resize () text1.move 0, 0, me.scalewidth, me.scaleheightend sub
Private subst_click () 'ok mainproc (0) End Sub
Public Function MainProc (BYVAL ISTEP As Long) Starting MainProc (0) DIM I As Long, J AS Long, K As Long Dim Num As Long, Sum as Long, Ok As Boolean MainProc = FALSE NUM = GetNum (ISTEP) 'Based on 0 IF Num> 3 ^ (3 - Istep) THEN EXIT function istep = istep 1 getArray ISTEP for i = 1 to arraydatacount (istep)' Based on 1, take 1 2 3 Total 3 groups of small ball 'legal test Call setArray (ISTEP, I) 'Setting the ball data BallData (istep,) WeightResult (istep) = -1' Settings WeightResult (istep) Num = GetNum (istep) IF Num> 3 ^ (3 - istep) THEN GOTO NEXTI WeightResult (istep) = 0 Num = getnum (istep) if Num> 3 ^ (3 - istep) Then goto nexti weightresult (istep) = 1 Num = getnum (istep) IF NUM> 3 ^ (3 - istep) Then Goto nexti if ISTEP <3 TEN 'does not fill the weight of WeightResult (ISTEP) = -1' Settings If Not MainProc (istep) Then Goto nexti WeightResult (istep) = 0 if Not M AinProc (istep) THEN GOTO NEXTI WeightResult (istep) = 1 if not mainproc (istep) Then Goto nexti endiff (istep, i) 'According to ISTEP, BALLDATA (ISTEP,,), WeightResult (istep) sets the ball results (13) MainProc = true if istep = 1 Then PrintResult End If Exit Function 'This does not quit, and setResult is changed to save all tested methods, you can get all combinations Nexti: Next IEND Function
'CompletedPublic function getnum (Byval istep as long) AS long' based on BallData (3, 2, 5) Long, K As Long, OK As Boolean for i = 0 to 12: Ball (i) = 0: Next Num = 24 'Up to 24 conform for I = 1 to 12 Ball (i - 1) = 0 Ball (i) = 1 '第 重 重 = 0 for J = 1 To 5 SUM = SUM BALL (BallData (K, 1, J)) - Ball (BallData (k, 2, j)) Next if Sum <> weightresult (k) THEN NUM = Num - 1 exit for end if Next Next I Ball (12) = 0 for i = 1 to 12 Ball (i - 1) = 0 Ball (i) = -1 '第 重 重 重 = 1 to istep Sum = 0 for J = 1 To 5 SUM = Sum Ball (BallData (K, 1, J)) - Ball (BallData (K, 2, J)) Next if Sum <> weightresult (k) THEN NUM = Num - 1 EXI T for end if next Next i getnum = Numend Function GetArray (BYVAL ISTEP As Long) Based on the former ISTEP times, list all non-repeated ball combination DIM I as long, J AS Long Dim Ok As Boolean setball Istep - 1 getPart arraydatacount (istep) = 0 for i = 1 to 5 ballnum = i getArrayBynum istep, 1, i Next Ind Function
'CompletedPublic Function GetArrayBynum (BYVAL ISTEP AS Long, Byval Part As Long, BYVAL NUM AS long) AS Boolean Dim i As long, J AS Long Dim Ok As Boolean Partgeted (Part) = 0 if Num = 0 Then' End GetNum = 0 For i = 1 to part - 1 for j = 1 to partgeted (i) getsednum = getEDnum 1 arraydata (istep, 0, 1, getEDnum) = Partarray (i, j) 'temporarily stored in ArrayData (ISTEP, 0, 1 , NEXT J NEXT I getArrayBynum2 istep, 1, ballnum exit function end if if part> partcount or num <0 THEN EXIT function end if for i = 0 to 5 if i <= partnum (part) THEN PARTGETED (Part) = i GetArrayBynum Istep, Part 1, Num - I else EXIT for end if Next Iend Function
'CompletedPublic Function GetArrayByNum2 (ByVal iStep As Long, ByVal Part As Long, ByVal Num As Long) As Boolean Dim i As Long, j As Long Dim OK As Boolean PartGeted2 (Part) = 0 If Num = 0 Then' end ArrayDataCount (iStep ) = Arraydatacount (istep) 1 getsednum = 0 for i = 0 to 5 arraydata (istep, arraydatacount (istep), 1, i) = 0 arraydata (istep, arraydatacount (istep), 2, i) = 0 Next I for i = 1 to part - 1 for j = 1 to partgeted2 (i) getsednum = getEDnum 1 arraydata (istep, arraydatacount (istep), 1, getsednum) = arraydata (istep, 0, 1, getEDnum) arraydata (istep, arraydatacount (ISTEP), 2, GEDNUM = PARTARRAY (i, j partgeted (i)) Next J next I exit function end if if part> partcount or num <0 THEN EXIT FUNCTION END IF for I = 0 to 5 if i < = Partnum (part) - Partgeted (Part) THEN PARTGETE D2 (part) = I getArrayBynum2 istep, part 1, num - i else exit for end if Next Ind Function
'CompletedPublic function getPart () Depending on BallValue Getting Group Data DIM I As Long, J AS Long Dim Ok As Boolean Partcount = 0 for i = 1 To 12 OK = False For J = 1 To Partcount IF BallValue (PartArray (J, 1 )) = BallValue (i) Then ok = true partnum (j) = partnum (j) 1 partarray (j, partnum (j)) = i exit for end if next if not ok kil dam = partcount 1 partnum (partcount ) = 1 PartArray (Partcount, 1) = I end if nextend'completedPublic function setball (istep as long) Set BallValue (12) DIM I as Long, J AS Long Dim Value As Long for i = 1 To 12 BallValue I) = 1 Next I for i = 1 to istep value = 100 ^ I / 10 if weightresult (i) = 0 THEN for J = 1 to 5 BallValue (BallData (i, 1, j)) = BallValue (BallData (i , 1, J)) Value BallValue (BallData (i, 2, j) = BallValue (BallData (I, 2, J)) Value Next Else for J = 1 to 5 BallValue (BallData (I, 1, J)) = BallValue (BallData (i, 1, j)) Value BallValue BallData (I, 2, J)) = BallValue (BallData (I, 2, J)) Value * 10 Next End If Nextend Function 'Unexpected PUBLIC SUB SetArray (BYVAL ISTEP AS Long "setting Ball Data BallData (ISTEP, 2) DIM I As Long, J AS Long for i = 1 To 5 BallData (ISTEP, 1, I) = ArrayData (ISTEP, NUM, 1, I) BallData (ISTEP, 2, I) = ArrayData (ISTEP, NUM, 2, I) Next IEND SUB
Public SUB SETRESULT (BYVAL ISTEP AS Long, BYVAL NUM AS Long) Settings Dix number results DIM I as long, J is long if istep = 1 Then for i = 1 to 5 ResultArray (1, 1, 1, 1, i) = ArrayData (ISTEP, NUM, 1, I) Resultay (1, 1, 1, 2, i) = arraydata (istep, num, 2, i) Next elseif istep = 2 Then for i = 1 to 5 ResultArray (2, Weightresult (1) 2, 1, 1, i) = ArrayData (istep, Num, 1, i) ResultArray (2, WeightResult (1) 2, 1, 2, i) = ArrayData (ISTEP, NUM, 2, I) Next elseif istep = 3 Then for i = 1 to 5 ResultArray (3, Weightresult (1) 2, WeightResult (2) 2, 1, i) = arraydata (istep, num, 1, i) ResultArray (3 , Weightresult (1) 2, Weightresult (2) 2, 2, I) = ArrayData (istep, Num, 2, i) Next End ifend sub
'Output Results Public Function PrintResult () DIM LS AS STRING, RS AS STRING, S As Variant Dim I As Long, J AS Long, K as long const sp as long = 30 s = array ("<", "=", ">") '1 ls = "": rs = "" for i = 1 to 5 balldata (1, 1, i) = ResulTarray (1, 1, 1, 1, i) BallData (1, 2, i) = ResulTarray (1, 1, 1, 2, i) if ResultArray (1, 1, 1, 1, i) <> 0 THEN LS = LS & ResultArray (1, 1, 1, 1, i) RS = RS & ResultArray (1, 1, 1, 2, i) end if next i text1.text = text1.text & ls & "v" & = = 1 to 3 WeightResult (1) = i - 2 ls = " ": Rs =" "for j = 1 to 5 BallData (2, 1, j) = ResulTarray (2, i, 1, 1, j) balldata (2, 2, j) = ResultArray (2, i, 1, 2, J) IF ResulTarray (2, i, 1, 1, j) <> 0 THEN LS = LS & Resultay (2, i, 1, 1, j) = rs & resultArray (2, i, 1, 2 , j) end if next j text1.text = text1.text & space (SP) & S (Weig HTRESULT (1) 1) & ls & "V" & RS & VBCRLF for J = 1 To 3 WeightResult (2) = J - 2 Ls = ": rs =" "fork = 1 to 5 BallData (3, 1, K) = ResulTarray (3, i, j, 1, k) BallData (3, 2, k) = Resultay (3, i, j, 2, k) if ResultArray (3, i, j, 1, k <> 0 THEN LS = LS & ResultArray (3, I, J, 1, K) RS = RS &
ResulTarray (3, I, J, 2, K) end if next text1.text = text1.text & space (SP * 2) & S (WeightResult (2) 1) & ls & "V" & RS & VBCRLF for K = 1 to 3 weightresult (3) = k - 2 text1.text = text1.text & space (sp * 3) & S (WeightResult (3) 1) & getResultstring & Vbcrf next k Next Next Iend Function
