Source code for solving the problem of Hualan Road in VB

xiaoxiao2021-03-06  67

Global variable definition

Type HrdState 'Huarong Road's Chess Bureau

State (1 to 12) as long 'on the current position of the 12 chess pieces on the board Superid as long' position number of the last board, 0 represents the level of the last Level As long "This does not play the game, 0 representative is the start state End typepublic g_next as chrdnextpublic g_save as chrdsavepublic g_state as hrdstate

Application startup

Sub main ()

FRMHRDMAIN.SHOW 'Display Main Window End Sub ChrdNext Package Calculation Next Algorithm Class DIM BS (1 TO 12) As LONG' Square, Receive Enter Value DIM ES (1 TO 12) AS LONG 'chess pieces of calculation, generate output values, the number of generals of the intermediate variable DIM HNUM AS long', the input value, the input value, the output value, the output value DIM Saveend (1 to 240) As long 'finally generated storage result array, output value public function getId (ID as long) as longgetid = saveend (ID) End FunctionPublic Sub getnext (BeginState () As long, Beginhnum As Long DIM I as Longdim MoveType As Long' Mobile direction DIM IEND AS long 'record mobile results for i = 1 to 12 BS (i) = beginstate (i)' initial state Next hnum = beginhnum 'The number of generals in the horizontal place IENDNUM = 0' Initialization results are 0IF MoveCaocao () = 0 THEN ADDENDFOR i = 2 TO HNUM 1 'Mobile Grounding General for MoveType = 1 To 4 if Move Htiger (MoveType, i) = 0 THEN ADDEND NEXT MOVETYPENEXT IFOR i = HNUM 2 TO 6' Mobile Eyed General For movetype = 1 to 4 if Movevtiger (MoveTiTiger (I) = 0 THEN ADDEND NEXT MOVETYPENEXT IFOR I = 7 TO 10 'Moving Cather for MoveType = 1 To 4 if Movefighter (MoveType, i) = 0 THEN Addend Next MOVETYPENEXT IEND SUBPRIVATE SUB ADDEND () 'Adds data from the End array to Savend, and finally add 1DIM i as long for i = 1 to 12 Savend (IndNum * 12 i) = ES (i) next I Iendnum = IENDNUM 1END SUBPRIVATE SUB SORTEND (Beginid As Long, Endid As Long) Sortes the output results, ensuring the small person before, after the latter DIM I as longdim j AS Longdim swap as longi = begingerddo while i < = Endid - 1 j = i 1 do while j <= endid if es (i)> ES (j) THEN SWAP = ES (i): ES (i) = es (j): es (j) = swap end IF j = j 1 loop i = i

1LOOOPEND SUBPRIVATE FUNCTION MOVEFIGHTER (Move_TYPE As Long, ID As Long) AS Long 'Initialization Next Data DIM I As Longfor I = 1 To 12 ES (I) = BS (I) Next Imovefighter = -1' Initial Return Value Select Case Move_type case 1 'UP IF ES (11) = ES (ID) - 4 THEN ES (ID) = ES (ID) - 4: ES (11) = ES (11) 4 Movefighter = 0: goto sort end ififf ES (12) = ES (ID) - 4 THEN ES (ID) = ES (ID) - 4: ES (12) = ES (12) 4 MoveFighter = 0: GOTO SORT End IF Case 2 'Down IF ES ( 11) = ES (ID) 4 THEN ES (ID) = ES (ID) 4: ES (11) = ES (11) - 4 MoveFighter = 0: GOTO SORT END IF ES (12) = ES (ID) ) 4 THEN ES (ID) = ES (ID) 4: ES (12) = ES (12) - 4 Movefighter = 0: GOT ES (11) = ES (ID) - 1 and ES (11) MOD 4 <> 0 THEN ES (ID) = ES (ID) - 1: ES (11) = ES (11) 1 Movefighter = 0: goto sort end if estil (12) = ES (ID) - 1 and ES (12) MOD 4 <> 0 THEN ES (ID) = ES (ID) - 1: ES (12) = ES (12) 1 Movefighter = 0: GOTO SORT END IF CASE 4 'Right IF ES (11) = ES (ID) 1 And ES (11) MOD 4 <> 1 THEN ES (ID) = ES (ID) 1: ES (11) = ES (11) - 1 Movefighter = 0: GOTO SORT END IF ES (12) = ES (ID) 1 and ES (12) MOD 4 <> 1 THEN ES (ID) = ES (ID) 1: ES (12) = ES (12) - 1 MoveFighter = 0: goto sort end ifend selectsort: if Movefighter =

0 THEN SORTEND 7, 10 'Sorting Sortend 11, 12' Pair Sort End IFEND FunctionPrivate Function MoveCao () As long'step1 Initialization Next DIM I As Longfor I = 1 To 12 ES (I) = BS I) Next ImovecaoCao = -1 'Initialization return value, -1 represents unsuccessful' Up according to rules, limit Cao Cao from moving 'IF ES (11) = ES (1) - 8 and ES (12) = ES (11) 1 THEN 'ES (1) = ES (1) - 4: ES (11) = ES (11) 8: ES (12) = ES (12) 8' MoveCaocao = 0'END IF'DOWNIF ES 11) = ES (1) 8 and ES (12) = ES (11) 1 THEN ES (1) = ES (1) 4: ES (11) = ES (11) - 8: ES (12) = ES (12) - 8 MoveCaocao = 0: goto sortend iF'LEFTIF ES (11) = ES (1) - 1 and ES (12) = ES (11) 4 and (ES (11) MOD 4) <> 0 THEN ES (1) = ES (1) - 1: ES (11) = ES (11) 2: ES (12) = ES (12) 2 MoveCaocao = 0: goto sortend iF'Rightif ES (11) = ES (1) 2 and ES (12) = ES (11) 4 and (ES (11) MOD 4) <> 1 THEN ES (1) = ES (1) 1: ES (11) = ES (11) - 2: ES (12) = ES (12) - 2 MoveCaocao = 0: goto sort

End if 'Moving Cao Cao, do not need to be re-sorted Sort:' Do NotEnd FunctionPrivate Function Movehtiger (MoveType As Long, ID As Long) AS Long 'Initialization Next Data DIM I As Longfor i = 1 To 12 ES (i) = BS (i) Next imovehtiger = -1 'Setting initial value Select Case MoveType Case 1' UP IF ES (11) = ES (ID) - 4 and ES (12) = ES (11) 1 THEN ES (ID) = ES (ID) - 4: ES (11) = ES (11) 4: ES (12) = ES (12) 4 MoveHtiger = 0: Goto Sort end if case 2 'Down IF ES (11) = ES (ID) 4 and ES (12) = ES (11) 1 THEN ES (ID) = ES (ID) 4: ES (11) = ES (11) - 4: ES (12) = ES (12 ) - 4 movehtiger = 0: goto sort end if case 3 'Left if es (11) = ES (ID) - 1 and ES (11) MOD 4 <> 0 THEN ES (ID) = ES (ID) - 1: ES (11) = ES (11) 2 Move Htiger = 0: GOTO SORT END IF ES (12) = ES (ID) - 1 and ES (12) MOD 4 <> 0 THEN ES (ID) = ES (ID) ) - 1: es (12) = ES (12) 2 Movehtiger = 0: goto sort end if case 4 'Right IF ES (11) = ES (ID) 2 and ES (11) MOD 4 <> 1 THEN ES (ID) = ES (ID) 1: ES (11) = ES (11) - 2 Move Htiger = 0: GOTO SORT END IF ES (12) = ES (ID) ) 2 and ES (12) MOD 4 <> 1 THEN ES (ID) = ES (ID) 1: ES (12) = ES (12) - 2 MoveHtiger = 0: goto sort end ifend selectsort: if movehtiger = 0 THEN SORTEND 2, HNUM 1 'Ground Place Sort Sortend 11, 12' Space Sorting End IFEND FunctionPrivate Function MoveVTIGER (MoveType As Long, ID As Long) AS Long '

Initialization Next Data DIM I as Longfor i = 1 to 12 ES (i) = BS (i) Next ImoveVTIGER = -1select Case MoveType Case 1 'Up IF ES (11) = ES (ID) - 4 THEN ES (ID) ) = ES (ID) - 4: ES (11) = ES (11) 8: MoveVTIGER = 0: GOTO SORT END IF ES (12) = ES (ID) - 4 THEN ES (ID) = ES (id) ) - 4: ES (12) = ES (12) 8: movevtiger = 0: goto sort end if case 2 'Down IF ES (11) = ES (ID) 8 THEN ES (ID) = ES (ID) 4: ES (11) = ES (11) - 8: Movevtiger = 0: goto sort end if esti es (12) = ES (ID) 8 THEN ES (ID) = ES (ID) 4: ES 12) = ES (12) - 8: MoveVTIGER = 0: goto sort end if case 3 'Left if es (11) = ES (ID) - 1 and ES (12) = ES (11) 4 and ES (11 ) MOD 4 <> 0 THEN ES (ID) = ES (ID) - 1: ES (11) = ES (11) 1: ES (12) = ES (12) 1 MoveVTIGER = 0: goto sort endiff Case 4 'Right IF ES (11) = ES (ID) 1 and ES (12) = ES (11) 4 and ES (11) MOD 4 <> 1 THEN ES (ID) = ES (ID) 1 : ES (11) = ES (11) - 1: ES (12) = ES (12) - 1 Movevtiger = 0: goto sort end = 0 THEN SORTEND HNUM 2, 6 'Vertical sequence sortend 11, 12' space sort Endness Functionchrdsave Saves the Node Record Class I have passed

Option expedition

Dim SaveState (1 To 300000) As HRDState 'go up to 30,000 steps Public iCurrentNum As Long' pointer Private Function current position IsExist (NewState () As Long, ilevel As Long) As BooleanIsExist = FalseDim i As LongFor i = iCurrentNum To 1 Step -1 if Savestate (I) .level 0 THEN G_STATE = SaveState (ID) End IFEND Function Main Interface Code

Private Sub Showid (ID As Long, Deep As Long)

Label1.caption = "Number of Nodes:" & CSTR (ID) & "Test Depth:" & CSTR (Deep) End Subprivate Function IsValid (State () As Long, Byval Hnum As Long DIM BS (1 to 20) AS Integerdim I as integerim k as integer'initfor i = 1 to 20 bs (i) = 1Next'Checkfor i = 1 to 12k = state (i) SELECT CASE I Case 1 'Cao Cao BS (K) = 0 BS (k 1) = 0 BS (k 4) = 0 BS (k 5) = 0 case 2, 3, 4, 5, 6 IF i <= hnum 1 Ten 'horizontal general BS (k) = 0 BS (K 1) = 0 else 'vertical general BS (k) = 0 BS (k 4) = 0 END IF CASE 7, 8, 9, 10, 11, 12' Small and space BS (K) = 0nd SelectNext iisvalid = TrueFor i = 1 To 20 If bs (i)> 0 Then isvalid = False Exit Function End IfNext iEnd FunctionPrivate Sub cmdStart_Click () Dim BEGINSTATE (1 To 12) As LongDim i As LongDim j As LongDim k As LongDim iHnum As LongDim Time1 as datedim time2 as datedim ifile as integerifile = freefile () Time1 = now () for i = 1 to 12 beginState (i) = int (MID (TextBegin.Text, I * 2 - 1, 2)) Next Iihnum = clng (txtnum.text) if not isvalid (beginstate, ihnum) Then msgbox "Initial status is not legal, please check!" EXIT SUBEND IFSET G_NEXT = New ChrdNextSet G_save = new chrdsaveg_save.addState BeginState, 0, 0 'records to the final record to = 1do while i <= g_save.icurrentnum' stack has not completed 'read the current record g_save.getState I showid i, g_state.Level' judgment Can I end the cycle if g_state.state (1) = 14 THEN G_SAVE.ICURRENTNUM = I exit do end if 'calculates all sub-step g_state.state, ihnum j =

转载请注明原文地址:https://www.9cbs.com/read-90134.html

New Post(0)