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


Оставить комментарий

Я не робот.