Сомневаюсь, что это кого-нибудь заинтересует, но все-таки спрошу.
Решил я тут на днях сделать простенький клиент для KataGo (мощный движок для игры в го с возможностью анализа)
и столкнулся с задачей определения мертвых групп. Когда-то, очень давно, я успешно эту задачу решал на BlitzBasic (тогда еще не было PB).
Но с тех пор и код был утерян, и тот скромный навык который был, и сообразительность. И теперь не могу допетрить - как я это делал.
Потому тупо спросил у Алисы...
На удивление она выдала почти рабочий код, который я здесь привожу с некоторыми исправлениями и дополнениями.
Это работает, но сам алгоритм какой-то, скажем так, слишком трудоемкий.
Да, можно сделать так, чтобы анализ запускался только при контактном ходе с камнем другого цвета (а не после каждого хода),
но этого мало. Нужен другой алгоритм - я ведь делал это как-то иначе (и без рекурсии, и без списков, и без необходимости проверять
после каждого хода ВСЕ группы на доске).
Может кто натолкнет на мысль?
Global Dim board(18, 18), Dim visited(18, 18), col=1 ; col=1 - черные камни, col=2 - белые
Structure StoneGroup ; для координат камней в группе
x.i
y.i
EndStructure
Procedure FindGroup(x, y, color, List group.StoneGroup()) ; Поиск группы
If x < 0 Or x >18 Or y < 0 Or y > 18 ; Проверка границ доски
ProcedureReturn
EndIf
If visited(x, y) Or board(x, y) <> color ; Если клетка уже посещена или цвет не совпадает — выход
ProcedureReturn
EndIf
visited(x, y) = 1 ; Помечаем как посещённую
AddElement(group()) ; Добавляем камень в группу
group()\x = x
group()\y = y
; Рекурсивно обходим соседей (4 направления)
FindGroup(x - 1, y, color, group()) ; влево
FindGroup(x + 1, y, color, group()) ; вправо
FindGroup(x, y - 1, color, group()) ; вверх
FindGroup(x, y + 1, color, group()) ; вниз
EndProcedure
Procedure Liberty(List group.StoneGroup()) ; Есть ли дамэ (свободный пункт) у группы?
ForEach group()
x = group()\x
y = group()\y
; Проверяем 4 соседних пункта
If x > 0 And board(x - 1, y) = 0 : ProcedureReturn 1 : EndIf
If x < 18 And board(x + 1, y) = 0 : ProcedureReturn 1 : EndIf
If y > 0 And board(x, y - 1) = 0 : ProcedureReturn 1 : EndIf
If y < 18 And board(x, y + 1) = 0 : ProcedureReturn 1 : EndIf
Next
ProcedureReturn 0 ; Нет ни одного дамэ
EndProcedure
Procedure RemoveDead(targetColor) ; Удаление мёртвых групп заданного цвета
For x = 0 To 18 ; Сбрасываем флаги посещения
For y = 0 To 18
visited(x, y) = 0
Next
Next
For x = 0 To 18 ; Проходим по всем клеткам доски
For y = 0 To 18
If board(x, y) = targetColor And Not visited(x, y) ; Камень нужного цвета и не посещён
NewList group.StoneGroup()
FindGroup(x, y, targetColor, group())
If Not Liberty(group()) ; Группа мёртвая — удаляем
Debug "Удалена группа (" + Str(x) + "," + Str(y) + ") (цвет: " + Str(targetColor) + ")"
ForEach group()
board(group()\x, group()\y) = 0 ; Очищаем клетку
Next
EndIf
ClearList(group())
EndIf
Next
Next
EndProcedure
Procedure PrintBoard() ; Вывод доски (для отладки)
StartDrawing(CanvasOutput(1))
DrawImage(ImageID(0), 0, 0)
For y = 0 To 18
For x = 0 To 18
If board(x, y)
DrawAlphaImage(ImageID(board(x, y)), x*39, y*39)
EndIf
Next
Next
StopDrawing()
EndProcedure
Procedure clik() ; Левый клик на доске
x=GetGadgetAttribute(1, #PB_Canvas_MouseX)/39
y=GetGadgetAttribute(1, #PB_Canvas_MouseY)/39
If x<19 And y<19 And board(x,y)=0
board(x,y)=col
RemoveDead(3-col)
PrintBoard()
col=3-col
EndIf
EndProcedure
Procedure risunok() ; Для визуализации работы алгоритма
StartDrawing(ImageOutput(0))
For i=21 To 741 Step 39
LineXY(21, i, 723, i, 0) : LineXY(i, 21, i, 723, 0)
Next
DrawingMode(#PB_2DDrawing_Outlined) : Box(20, 20, 705, 705, 0)
StopDrawing()
For i=1 To 2
StartDrawing(ImageOutput(i))
DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_AlphaBlend)
Circle(21, 21, 18, RGBA(5, 5, 5, 255))
FillArea(21, 21, RGB(5, 5, 5), RGBA(60*i*i, 60*i*i, 60*i*i, 255))
StopDrawing()
Next
SetGadgetAttribute(1,#PB_Canvas_Image,ImageID(0))
EndProcedure
; ---------- ОСНОВНАЯ ПРОГРАММА ----------
OpenWindow(0, 0, 0, 756, 756, "Algorithm", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowColor(0, $6699CC)
CanvasGadget(1, 6, 6, 745, 745)
CreateImage(0, 745, 745, 24, $77CEFF)
CreateImage(1, 43, 43 ,32, #PB_Image_Transparent)
CreateImage(2, 43, 43 ,32, #PB_Image_Transparent)
risunok() ; Простенький рисунок доски и камней
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
If EventGadget()=1 And EventType()=#PB_EventType_LeftClick
clik()
EndIf
EndSelect
ForEver