forum.boolean.name - Показать сообщение отдельно

SubZer0 · 29.09.2006, 20:32

Для тех кто не в теме смотрите эту тему...

есть куча способов реализации сего алгоритма... можно реализовать на списках как в статье см. ссылу, а можно двумерными массивами...

каждый из этих методов можно реально оптимизировать... обэтом и будет сей топ.

я взял реализацию на двумерных массивах, поскольку нужно было высчитывать дорогу до многих мест одновременно располагающихся динамично... на списках как я думаю было бы намного дольше.

дак вот, разобравшись в стратегии действия алгоритма пишем программу:

ИМХО что надо в основном роптимизировать, дак это расстановку чисел, т.е. первый проход... обратный проход по расставленным стоимостям передвижения в большой оптимизации не нуждается поскольку прост как 2 байта... обратный проход мной рассмотрен не будет...

допустим нам надо будет идти из точки А с координатами (15,15)

Graphics 640,480,32,2

Dim Map(20,20)

ax=15
ay=15

For i=1 To 20
 For j=1 To 20
  Map(i,j)=0
 Next
Next 


Map(5,5)=-1
Map(5,6)=-1
Map(5,7)=-1
Map(5,8)=-1
Map(5,9)=-1
Map(5,10)=-1
Map(5,11)=-1


Map(ax,ay)=1


For i=2 To 19
 For j=2 To 19
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=1 To 20
 For j=1 To 20
  Text i*15,j*15,Str(Map(i,j))
 Next
Next 

WaitKey()

думаю программу объяснять не надо... просто прочесываем весь массив и выставляем следующую стоимость в следующей пустой клетке...

в результате одного прохода мы увидим, что стоимостями уже заполнен правый угол карты... происходит это потому, что цикл проходит слева направо и сверху вниз... таким образом ставим стоимость клетки в текущую и переходим к следующей, а в проверке соседних клеток мы проверяем предидущую и т.д.

сразу появляется мысля, что чтоб заполнить всю карту нужно повторять этот проход пока она вся не заполнится... но это маленько ошибочное суждение...

можно ведь взять и просто повернуть циклы в обратном направлении..

Graphics 640,480,32,2

Dim Map(20,20)

ax=15
ay=15

For i=1 To 20
 For j=1 To 20
  Map(i,j)=0
 Next
Next 


Map(5,5)=-1
Map(5,6)=-1
Map(5,7)=-1
Map(5,8)=-1
Map(5,9)=-1
Map(5,10)=-1
Map(5,11)=-1


Map(ax,ay)=1


For i=2 To 19
 For j=2 To 19
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=19 To 2 Step -1
 For j=19 To 2 Step -1
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=1 To 20
 For j=1 To 20
  Text i*15,j*15,Str(Map(i,j))
 Next
Next 

WaitKey()

End

теперь после двух проходов у нас получается полностью заполненная стоимостями передвижения карта...

я чуть не подпрыгнул на диване когда придумал такой метод... но вскоре мой пыл утих поскольку у метода есть существенный недостаток а именно:

продлим стенку вниз

Graphics 640,480,32,2

Dim Map(20,20)

ax=15
ay=15

For i=1 To 20
 For j=1 To 20
  Map(i,j)=0
 Next
Next 


Map(5,5)=-1
Map(5,6)=-1
Map(5,7)=-1
Map(5,8)=-1
Map(5,9)=-1
Map(5,10)=-1
Map(5,11)=-1
Map(5,12)=-1
Map(5,13)=-1
Map(5,14)=-1
Map(5,15)=-1
Map(5,16)=-1
Map(5,17)=-1


Map(ax,ay)=1


For i=2 To 19
 For j=2 To 19
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=19 To 2 Step -1
 For j=19 To 2 Step -1
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=1 To 20
 For j=1 To 20
  Text i*15,j*15,Str(Map(i,j))
 Next
Next 

WaitKey()

End

теперь внимательно всмотритесь в числа слеа от стенки... если бы нам пришлось расчитывать путь не от самого верха стенки, а там где начинаются числа 27, то программа обратного прохода пошла бы вниз, а кротчайший путь был бы вверх...

еще один недостаток:

если мы загнем наше препятствие снизу, то получим вообще белое пятно которое не рассчитано

Graphics 640,480,32,2

Dim Map(20,20)

ax=15
ay=15

For i=1 To 20
 For j=1 To 20
  Map(i,j)=0
 Next
Next 


Map(6,5)=-1
Map(6,6)=-1
Map(6,7)=-1
Map(6,8)=-1
Map(6,9)=-1
Map(6,10)=-1
Map(6,11)=-1
Map(6,12)=-1
Map(6,13)=-1
Map(6,14)=-1
Map(6,15)=-1
Map(6,16)=-1
Map(6,17)=-1
Map(5,17)=-1
Map(4,17)=-1
Map(3,17)=-1



Map(ax,ay)=1


For i=2 To 19
 For j=2 To 19
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=19 To 2 Step -1
 For j=19 To 2 Step -1
  f=10000
  If Map(i,j)>=0 Then
   If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

   If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
   If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
   If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
   If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

   If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

  EndIf
 Next
Next 


For i=1 To 20
 For j=1 To 20
  Text i*15,j*15,Str(Map(i,j))
 Next
Next 

WaitKey()

End

здесь мы видим недостаток... таким образом из угла небыло бы выхода вобще...

посидев и хорошо подумав я всетаки дошел как усовершенствовать свой метод...

все оказалось проще чем я ожидал:

Graphics 640,480,32,2

Dim Map(20,20)

ax=15
ay=15

For i=1 To 20
 For j=1 To 20
  Map(i,j)=0
 Next
Next 


Map(6,5)=-1
Map(6,6)=-1
Map(6,7)=-1
Map(6,8)=-1
Map(6,9)=-1
Map(6,10)=-1
Map(6,11)=-1
Map(6,12)=-1
Map(6,13)=-1
Map(6,14)=-1
Map(6,15)=-1
Map(6,16)=-1
Map(6,17)=-1
Map(5,17)=-1
Map(4,17)=-1
Map(3,17)=-1



Map(ax,ay)=1


For ij=1 To 2

 For i=2 To 19
  For j=2 To 19
   f=10000
   If Map(i,j)>=0 Then
    If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) 

    If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
    If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
    If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
    If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

    If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

   EndIf
  Next
 Next 


 For i=19 To 2 Step -1
  For j=19 To 2 Step -1
   f=10000
   If Map(i,j)>=0 Then
    If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j)

    If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j)
    If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j)
    If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1)
    If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1)

    If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1

   EndIf
  Next
 Next 

Next
For i=1 To 20
 For j=1 To 20
  Text i*15,j*15,Str(Map(i,j))
 Next
Next 

WaitKey()

End

просто напросто повторяем эти два прохода (цикл ij) и теперь у нас полноценная карта со стоимостями в любую ее точку

в результате, чем сложнее будет путь, тем больше раз надо будет повторять проходы...

у меня в гаме не будет сложнее пути чем за два угла... таким образом я решил сделать два прохода по два вложенных цикла!

самое главное преимущество сего метода состоит в том, что теперь по полученному массиву можно определить до какой цели будет самый краткий путь, просто брать значение ячейки массива и сравнивать...

буду рад объективной критике, и конструктивным предложениям (а-ля делитесь опытом)

29.09.2006, 20:32	#1
SubZer0 Администратор Регистрация: 03.09.2005 Сообщений: 2,408 Написано 301 полезных сообщений (для 996 пользователей)	*A и способы его оптимизации** Для тех кто не в теме смотрите эту тему... есть куча способов реализации сего алгоритма... можно реализовать на списках как в статье см. ссылу, а можно двумерными массивами... каждый из этих методов можно реально оптимизировать... обэтом и будет сей топ. я взял реализацию на двумерных массивах, поскольку нужно было высчитывать дорогу до многих мест одновременно располагающихся динамично... на списках как я думаю было бы намного дольше. дак вот, разобравшись в стратегии действия алгоритма пишем программу: ИМХО что надо в основном роптимизировать, дак это расстановку чисел, т.е. первый проход... обратный проход по расставленным стоимостям передвижения в большой оптимизации не нуждается поскольку прост как 2 байта... обратный проход мной рассмотрен не будет... допустим нам надо будет идти из точки А с координатами (15,15) Graphics 640,480,32,2 Dim Map(20,20) ax=15 ay=15 For i=1 To 20 For j=1 To 20 Map(i,j)=0 Next Next Map(5,5)=-1 Map(5,6)=-1 Map(5,7)=-1 Map(5,8)=-1 Map(5,9)=-1 Map(5,10)=-1 Map(5,11)=-1 Map(ax,ay)=1 For i=2 To 19 For j=2 To 19 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=1 To 20 For j=1 To 20 Text i15,j15,Str(Map(i,j)) Next Next WaitKey() думаю программу объяснять не надо... просто прочесываем весь массив и выставляем следующую стоимость в следующей пустой клетке... в результате одного прохода мы увидим, что стоимостями уже заполнен правый угол карты... происходит это потому, что цикл проходит слева направо и сверху вниз... таким образом ставим стоимость клетки в текущую и переходим к следующей, а в проверке соседних клеток мы проверяем предидущую и т.д. сразу появляется мысля, что чтоб заполнить всю карту нужно повторять этот проход пока она вся не заполнится... но это маленько ошибочное суждение... можно ведь взять и просто повернуть циклы в обратном направлении.. Graphics 640,480,32,2 Dim Map(20,20) ax=15 ay=15 For i=1 To 20 For j=1 To 20 Map(i,j)=0 Next Next Map(5,5)=-1 Map(5,6)=-1 Map(5,7)=-1 Map(5,8)=-1 Map(5,9)=-1 Map(5,10)=-1 Map(5,11)=-1 Map(ax,ay)=1 For i=2 To 19 For j=2 To 19 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=19 To 2 Step -1 For j=19 To 2 Step -1 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=1 To 20 For j=1 To 20 Text i15,j15,Str(Map(i,j)) Next Next WaitKey() End теперь после двух проходов у нас получается полностью заполненная стоимостями передвижения карта... я чуть не подпрыгнул на диване когда придумал такой метод... но вскоре мой пыл утих поскольку у метода есть существенный недостаток а именно: продлим стенку вниз Graphics 640,480,32,2 Dim Map(20,20) ax=15 ay=15 For i=1 To 20 For j=1 To 20 Map(i,j)=0 Next Next Map(5,5)=-1 Map(5,6)=-1 Map(5,7)=-1 Map(5,8)=-1 Map(5,9)=-1 Map(5,10)=-1 Map(5,11)=-1 Map(5,12)=-1 Map(5,13)=-1 Map(5,14)=-1 Map(5,15)=-1 Map(5,16)=-1 Map(5,17)=-1 Map(ax,ay)=1 For i=2 To 19 For j=2 To 19 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=19 To 2 Step -1 For j=19 To 2 Step -1 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=1 To 20 For j=1 To 20 Text i15,j15,Str(Map(i,j)) Next Next WaitKey() End теперь внимательно всмотритесь в числа слеа от стенки... если бы нам пришлось расчитывать путь не от самого верха стенки, а там где начинаются числа 27, то программа обратного прохода пошла бы вниз, а кротчайший путь был бы вверх... еще один недостаток: если мы загнем наше препятствие снизу, то получим вообще белое пятно которое не рассчитано Graphics 640,480,32,2 Dim Map(20,20) ax=15 ay=15 For i=1 To 20 For j=1 To 20 Map(i,j)=0 Next Next Map(6,5)=-1 Map(6,6)=-1 Map(6,7)=-1 Map(6,8)=-1 Map(6,9)=-1 Map(6,10)=-1 Map(6,11)=-1 Map(6,12)=-1 Map(6,13)=-1 Map(6,14)=-1 Map(6,15)=-1 Map(6,16)=-1 Map(6,17)=-1 Map(5,17)=-1 Map(4,17)=-1 Map(3,17)=-1 Map(ax,ay)=1 For i=2 To 19 For j=2 To 19 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=19 To 2 Step -1 For j=19 To 2 Step -1 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=1 To 20 For j=1 To 20 Text i15,j15,Str(Map(i,j)) Next Next WaitKey() End здесь мы видим недостаток... таким образом из угла небыло бы выхода вобще... посидев и хорошо подумав я всетаки дошел как усовершенствовать свой метод... все оказалось проще чем я ожидал: Graphics 640,480,32,2 Dim Map(20,20) ax=15 ay=15 For i=1 To 20 For j=1 To 20 Map(i,j)=0 Next Next Map(6,5)=-1 Map(6,6)=-1 Map(6,7)=-1 Map(6,8)=-1 Map(6,9)=-1 Map(6,10)=-1 Map(6,11)=-1 Map(6,12)=-1 Map(6,13)=-1 Map(6,14)=-1 Map(6,15)=-1 Map(6,16)=-1 Map(6,17)=-1 Map(5,17)=-1 Map(4,17)=-1 Map(3,17)=-1 Map(ax,ay)=1 For ij=1 To 2 For i=2 To 19 For j=2 To 19 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next For i=19 To 2 Step -1 For j=19 To 2 Step -1 f=10000 If Map(i,j)>=0 Then If f>Map(i,j) And Map(i,j)>0 Then f=Map(i,j) If f>Map(i+1,j) And Map(i+1,j)>0 Then f=Map(i+1,j) If f>Map(i-1,j) And Map(i-1,j)>0 Then f=Map(i-1,j) If f>Map(i,j+1) And Map(i,j+1)>0 Then f=Map(i,j+1) If f>Map(i,j-1) And Map(i,j-1)>0 Then f=Map(i,j-1) If f<>10000 And f<>Map(i,j) Then Map(i,j)=f+1 EndIf Next Next Next For i=1 To 20 For j=1 To 20 Text i15,j15,Str(Map(i,j)) Next Next WaitKey() End просто напросто повторяем эти два прохода (цикл ij) и теперь у нас полноценная карта со стоимостями в любую ее точку в результате, чем сложнее будет путь, тем больше раз надо будет повторять проходы... у меня в гаме не будет сложнее пути чем за два угла... таким образом я решил сделать два прохода по два вложенных цикла! самое главное преимущество сего метода состоит в том, что теперь по полученному массиву можно определить до какой цели будет самый краткий путь, просто брать значение ячейки массива и сравнивать... буду рад объективной критике, и конструктивным предложениям (а-ля делитесь опытом) __________________ Как минимум я помог многим (с)
(Offline)