Привет ребят! Я ищу самый быстрый алгоритм.
Некоторые способы придумал. Но, пока-что самым быстрым у меня остаётся перебор всех элементов списка.
Суть вот в чём. Есть список, с координатами и размерами прямоугольников. Список может быть очень большой.
Задача состоит в том, что нужно максимально быстро найти любой элемент списка, который соответствует указанной координате. Первый созданный элемент, самый нижний, последний, самый верхний. Поэтому, если последний и первый находятся в указанных координатах, то должен быть найден последний.
Нужно учитывать, что элементы списка, могут изменить свои координаты и размеры. Поэтому, каждый новый поиск, это должен учитывать.
Вот код с визуальной демонстрацией и примером поиска по всему списку от последнего к первому:
Код:
Structure DefRect
x.w
y.w
w.u
h.u
name.s
EndStructure
Declare IsDebuggerEnabled()
Global gCicle ; Здесь количество проходов, в тесте времени
If IsDebuggerEnabled()
gCicle = 1000 ; с отладчиком
Else
gCicle = 10000 ; без отладчика
EndIf
Global NewList gObject.DefRect()
Global gDefaultFont = LoadFont(#PB_Any, "SegoeUI", 8)
Global gSize
; Отвечает, включён ли отладчик
Procedure IsDebuggerEnabled() ; https://www.purebasic.fr/english/viewtopic.php?t=19001
!if defined _PB_DEBUGGER_Control
!mov eax, 1
!else
!mov eax, 0
!end if
ProcedureReturn
EndProcedure
; Здесь просто вывод сообщения. Если отладчик включён, то вывод в Debug, иначе в MessageRequester
Procedure _P( Text$ )
If IsDebuggerEnabled()
Debug Text$
Else
MessageRequester("Debug",Text$)
EndIf
EndProcedure
; Вариант 1. Поиск объекта под точкой. Простой перебор сверху вниз
Procedure Search_1( x.w, y.w )
Protected *Object.DefRect
If gSize
PushListPosition( gObject() )
LastElement( gObject() )
Repeat
With gObject()
If x>=\x And x<\x+\w And y>=\y And y<\y+\h
*Object = @gObject()
Break
EndIf
EndWith
Until Not PreviousElement( gObject() )
PopListPosition( gObject() )
EndIf
ProcedureReturn *Object
EndProcedure
Procedure AddRect( x.w, y.w, w.u, h.u )
; добавляем элемент и вбиваем данные
AddElement( gObject() )
With gObject()
\x = x : \y = y : \w = w : \h = h: \name = Str(ListIndex(gObject()))
EndWith
gSize = ListSize(gObject()) ; запоминаем размер
EndProcedure
; для прорисовки всплывающего сообщения
Global gToggle = 0, gOldX, gOldY
Procedure _PushCanvas( x, y, w, h )
If Not gToggle And GrabDrawingImage( 0, x, y, w, h )
gToggle = 1
gOldX = x
gOldY = y
EndIf
EndProcedure
; для прорисовки всплывающего сообщения
Procedure _PopCanvas()
If gToggle
DrawImage( ImageID(0), gOldX, gOldY )
gToggle = 0
EndIf
EndProcedure
; создаёт и рисует объекты
Procedure _CreateAndDrawObjects()
If StartDrawing(CanvasOutput(0))
Protected x = 5, y = 5, w = 26, h = 32
Protected OutputW = OutputWidth(), OutputH = OutputHeight()
If IsFont(gDefaultFont) : DrawingFont(FontID(gDefaultFont)) : EndIf
Protected xw = 16
For i=0 To 999 ; сколько объектов
If x > OutputW - w
y+18
x = 5 + xw
xw + Random(30,5)
If xw > 60 : xw = Random(30,5) : EndIf
EndIf
AddRect( x, y, w, h )
DrawingMode( #PB_2DDrawing_AlphaBlend )
Box( x, y, w, h, $E0000000 | Random($EE0000, $0000EE) )
DrawingMode( #PB_2DDrawing_Transparent )
DrawText( x+2, y, Str(i), $111111 )
DrawingMode( #PB_2DDrawing_Outlined )
Box( x, y, w, h, $111111)
x+w + 1
Next
StopDrawing()
EndIf
EndProcedure
Procedure _Event()
Protected.q TimeS, TimeE
Protected x = GetGadgetAttribute( 0, #PB_Canvas_MouseX )
Protected y = GetGadgetAttribute( 0, #PB_Canvas_MouseY )
Protected.DefRect *SearchObj1
;- Вариант 1. Тест Search_1
TimeS = ElapsedMilliseconds()
For n=1 To gCicle
*SearchObj1 = Search_1( x, y )
Next
TimeE = ElapsedMilliseconds() - TimeS
Protected TextObj1$ = "1) Объект не найден"
If *SearchObj1 : With *SearchObj1
TextObj1$ = "1) Объект " + \name + " [" +\x+","+\y+","+\w+","+\h+"]. Найден за: " + Str(TimeE) + "мс. Проходов: " + Str(n-1)
EndWith : EndIf
; ---
If StartDrawing( CanvasOutput(0) )
; скрываем сообщение при выходе указателя мыши с холста
If EventType() = #PB_EventType_MouseLeave
_PopCanvas()
StopDrawing()
ProcedureReturn
EndIf
; вывод сообщения при перемещении указателя мыши по холсту
Protected Coord$ = "x=" + RSet(Str(x),3,"0") + ", y=" + RSet(Str(y),3,"0")
_PopCanvas()
If IsFont(gDefaultFont) : DrawingFont(FontID(gDefaultFont)) : EndIf
Protected tw1 = TextWidth(TextObj1$), tw2 = TextWidth(TextObj2$), tw
If tw2 > tw1 : tw = tw2 : Else : tw = tw1 : EndIf
Protected w = 283, h = 50, th = TextHeight("A")
If w < tw : w = tw : EndIf
x+2
y-h-8
w+10
Protected OutputW = OutputWidth(), OutputH = OutputHeight()
If x+w > OutputW : x = OutputW - w : EndIf
If y < 0
y+h + 5
x+12
If x+w > OutputW : y+17 : EndIf
EndIf
_PushCanvas( x, y, w, h )
ClipOutput( x, y, w, h )
DrawingMode( #PB_2DDrawing_AlphaBlend )
Box( x, y, w, h, $F0D5EFFF )
DrawingMode( #PB_2DDrawing_Outlined )
Box( x, y, w, h, $111111)
DrawingMode( #PB_2DDrawing_Transparent )
DrawText( x+5, y, Coord$, 0 ) : y+th
DrawText( x+5, y, TextObj1$, $8B0000 ) : y+th
DrawText( x+5, y, TextObj2$, $8B0000 )
StopDrawing()
EndIf
EndProcedure
;- окно с холстом
Global gWinW = 940, gWinH = 600
If OpenWindow( 0, 0, 0, gWinW, gWinH, "Тест Скорости определения объекта по координатам", #PB_Window_SystemMenu | #PB_Window_ScreenCentered )
CanvasGadget( 0, 0, 0, gWinW, gWinH )
_CreateAndDrawObjects()
BindGadgetEvent( 0, @_Event(), #PB_EventType_MouseMove )
BindGadgetEvent( 0, @_Event(), #PB_EventType_MouseLeave )
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIfВ решении, не обязательно должен быть только список, он существует только пока. Приветствуется любой алгоритм и его реализация, которая будет максимально быстрой.
Отредактировано Webarion (13.11.2022 00:10:20)
варианты я рассматриваю 
