12
Декабрь
2009
Задача – попасть конем в данную клетку
Задача – попасть конем в данную клетку
Option Explicit Public Type Point X As Long Y As Long End Type Public Jamps(7) As Point Public TryPnts(64) As Point Public ResPnts(64) As Point Public UbResult As Long Public Target As Point ' Любопытства ради, будем считать общее число вызовов Public NumCall As Long Sub InitJamps() Jamps(0).X = -1&: Jamps(0).Y = 2& Jamps(1).X = 1&: Jamps(1).Y = 2& Jamps(2).X = 2&: Jamps(2).Y = 1& Jamps(3).X = 2&: Jamps(3).Y = -1& Jamps(4).X = 1&: Jamps(4).Y = -2& Jamps(5).X = -1&: Jamps(5).Y = -2& Jamps(6).X = -2&: Jamps(6).Y = -1& Jamps(7).X = -2&: Jamps(7).Y = 1& End Sub Public Function TestPnt(ByVal ub As Long) As Long Dim retv As Long, i As Long retv = 0& If (TryPnts(ub).X = Target.X) And (TryPnts(ub).Y = Target.Y) Then GoTo Finita retv = -1& If TryPnts(ub).X < 1 Then GoTo Finita If TryPnts(ub).X > 8 Then GoTo Finita If TryPnts(ub).Y < 1 Then GoTo Finita If TryPnts(ub).Y > 8 Then GoTo Finita retv = 1& For i = 0& To ub - 2& ' С предыдущей смысла проверять нет If (TryPnts(ub).X = TryPnts(i).X) And (TryPnts(ub).Y = TryPnts(i).Y) Then retv = -1&: Exit For End If Next Finita: TestPnt = retv End Function Public Function ХодКонем(ByVal ub As Long) As Long Dim i As Long, j As Long, retv As Long ' ***** Игры для отладки ***** Static Level If Level = 0& Then NumCall = 0&: UbResult = 64&: InitJamps Level = Level + 1 NumCall = NumCall + 1& ' ***** С отладкой пока все ***** retv = TestPnt(ub) Select Case retv Case -1& ' Не туда retv = 64& Case 0& ' Попали! И все устроено так, что этот путь наверняка короче retv = ub UbResult = retv For j = 0 To UbResult ResPnts(j) = TryPnts(j) Next j Case 1& ' Прыгаем дальше If ub >= UbResult - 1& Then ' Тут ловить нечего retv = 64& Else For i = 0& To 7& TryPnts(ub + 1&).X = TryPnts(ub).X + Jamps(i).X TryPnts(ub + 1&).Y = TryPnts(ub).Y + Jamps(i).Y retv = ХодКонем(ub + 1&) If UbResult > retv Then UbResult = retv For j = 0 To UbResult ResPnts(j) = TryPnts(j) Next j End If Next i End If End Select ХодКонем = retv Level = Level - 1 DoEvents End Function ' Проверяем в Excel. ' Начальную и конечную позицию лошадки задаем прямо в коде теста Sub Испытание() Dim i As Long TryPnts(0&).X = 2: TryPnts(0&).Y = 2 Target.X = 6: Target.Y = 8 ХодКонем 0 MsgBox "Длина пинимального пути = " & CStr(UbResult) & vbCrLf _ & "Число вызовов функции ХодКонем = " & CStr(NumCall) ' Чуть-чуть макеяжа With Range("B2:I9") .ClearContents .Interior.ColorIndex = 15 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .BorderAround xlContinuous, xlThick, 9 With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 2 End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 2 End With .ColumnWidth = 3 .RowHeight = 18 .Font.Size = 18 For i = 0 To UbResult With .Cells(9 - ResPnts(i).Y, ResPnts(i).X) .Interior.ColorIndex = 28 .Value = IIf((i > 0) And (i < UbResult), "x", ChrW(9822)) End With Next End With End Sub