Предыдущая тема :: Следующая тема |
Автор |
Сообщение |
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Пн Апр 16, 2007 5:22 am Заголовок сообщения: Запрос к obj или оптимизация вложенных циклов в MB... |
|
|
Пишу прогу, по поиску интерфиренции... Смысол найти два объекта (точки) на растоянии 50м друг от друга... Много точек повторяется, хотел сделать что то вроде GROUP BY obj.x - не получается, пришлось делать динамический массив и забивать все туда, выкидывая повторяющиеся координаты, соответственно потом два вложенных цикла по всем точкам... Работает, но работает ТРОЕ СУТОК :( Помогите советом как быть? Может кто знает как оптимизировать вложенные циклы в MB? Или как сделать сортировку и групировку для obj.x ... |
|
Вернуться к началу |
|
|
Нестеров Валерий
Зарегистрирован: 21.03.2006 Сообщения: 492
|
Добавлено: Пн Апр 16, 2007 9:17 am Заголовок сообщения: |
|
|
Вариантов множество!
1. Я понял, что вначале нужно избавиться от повторяющихся точек, это можно сделать с помощью дополнительных утилит (поискать в инете), можно также сделать в таблице дополнительные поля "X" и "Y" и вытащить в них координаты точек. Затем запросами отобрать дублированные, например вот так:
1.1 SELECT X, COUNT(*) FROM point INTO my_groupX GROUP BY X
1.2 SELECT Y, COUNT(*) FROM point INTO my_groupY GROUP BY Y
1.3 SELECT * FROM point WHERE X IN (SELECT X FROM my_groupX WHERE count > 1) INTO my_doubleX
1.4 SELECT * FROM my_doubleX WHERE Y IN (SELECT Y FROM my_groupY WHERE count > 1) INTO my_doubleXY
1.5 Теперь можно на основе выборки "my_doubleXY" удалить дублированные
Для ускорения выполнения этих операторов можно проиндекисровать колонки X и Y.
2. Для определения попадания точек в радиус 50 метров можно использовать пространственный запрос, для этого можно сделать вспомогательный слой сформировав в нем окружности радиусом 50 метров с центром в имеющейся точке. А затем выполнять пространственный запрос для каждой окружности:
SELECT * FROM circle, point WHERE circle.obj Intersects point.obj
Скорее всего используя возможности запросов MapInfo у вас получится обработка гораздо быстрее. _________________ Жизнь прекрасна!i |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Пн Апр 16, 2007 9:40 am Заголовок сообщения: |
|
|
Спасибо большое, я попробую... |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 4:53 am Заголовок сообщения: |
|
|
Валерий, я последовал Вашему совету и воспользовался Вашим запросом, программа работает, но виснит после обработки 5-7 таблиц... Ниже преведен текст процедуры, если вас не затруднит оцените корректность выполнения операций... |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 4:58 am Заголовок сообщения: |
|
|
Sub CalculateBedCells
Dim DistArray() As TCords
Dim DistArray2() As TCords
Dim realXY As TCords
Dim tempXY As TCords
Dim tables() As TTab
Dim obj_type As Integer
Dim RowCount, i, j, count, p, t As Integer
Dim dist, x1, x2, y1, y2 As Float
Dim svolota, labuda, ci1, ci2 As String
Redim tables(1)
i = 0
Open File "C:\temp\Tables.txt" For INPUT As #1
Do While not EOF(1)
i = i + 1
Redim tables(i)
Input #1, tables(i).TabName
Loop
Close File #1
' Загружаем список частот
i = 0
Open File "C:\temp\Names.txt" For INPUT As #1
Do While not EOF(1)
i = i + 1
Input #1, tables(i).freq
Loop
Close File #1
cls ' очищаем окошко
' ГЛОБАЛЬНЫЙ ЦИКЛ ПО СРАВНЕНИЮ ТАБЛИЦ И ПОИСКУ ИНТЕРФЕРЕНЦИИ
Close All Interactive
DISTAN = ReadControlValue(1) |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 4:59 am Заголовок сообщения: |
|
|
For j = 60 to Ubound(tables)-1
print "Table in use : "+tables(j).TabName
count = 0
Redim DistArray(1)
Open Table tables(j).TabName Interactive As Temp
Map From Temp
Fetch first from Temp
RowCount = TableInfo(Temp, TAB_INFO_NROWS)
If RowCount <> 0 Then
Print "Row Count : "+Str$(RowCount)
' Открываем текстовой файлик для записи координат
Open File "C:\temp\FREQ_"+tables(j).freq+".txt" For OUTPUT As #2
PRINT #2, "NAME1 CI1 X1 Y1 NAME2 CI2 X2 Y2 DISTANCE [metr]"
obj_type = ObjectInfo(Temp.obj, OBJ_INFO_TYPE)
' Добавляем первую строчку в файл
'=========================================================================
If obj_type = OBJ_POINT Then
tempXY.x = ObjectGeography(Temp.obj, OBJ_GEO_POINTX)
tempXY.y = ObjectGeography(Temp.obj, OBJ_GEO_POINTY)
tempXY.ci = Temp.CI
count = count + 1
Redim DistArray(count)
DistArray(count).x = tempXY.x
DistArray(count).y = tempXY.y
DistArray(count).ci = tempXY.ci
DistArray(count).name = tempXY.name
End If
'=========================================================================
Fetch Next from Temp |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 5:03 am Заголовок сообщения: |
|
|
For i = 2 to RowCount - 1
'Возвращаемся на 1 запись назад
Fetch Prev from Temp
OnError GoTo _error_
If obj_type = OBJ_POINT Then
tempXY.x = ObjectGeography(Temp.obj, OBJ_GEO_POINTX)
tempXY.y = ObjectGeography(Temp.obj, OBJ_GEO_POINTY)
tempXY.ci = Temp.CI
End If
'Переходим на текущую
Fetch Next from Temp
If obj_type = OBJ_POINT Then
realXY.x = ObjectGeography(Temp.obj, OBJ_GEO_POINTX)
realXY.y = ObjectGeography(Temp.obj, OBJ_GEO_POINTY)
realXY.ci = Temp.CI
realXY.name = Temp.CELL_NAME
End If |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 5:03 am Заголовок сообщения: |
|
|
If tempXY.x <> realXY.x AND tempXY.y <> realXY.y Then
' Заполняем массив для расчета расстояния
count = count + 1
Redim DistArray(count)
DistArray(count).x = realXY.x
DistArray(count).y = realXY.y
DistArray(count).ci = realXY.ci
DistArray(count).name = realXY.name
End If
' На следующую
_go_:
Fetch Next from Temp
Next
print "After cleaning : " + Ubound(DistArray)
print "Name : " + DistArray(1).name
' Расчитываем дистанцию и накапливаем совпадения
count = 0 |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 5:04 am Заголовок сообщения: |
|
|
'=============================================================================
' REFACTORING
' Необходимо создать новую таблицу в текущем слое и сделать ее редактируемой...
' Основной запрос для определения множества точек...
' SELECT CI FROM Temp, WORK WHERE Temp.obj INTERSECTS WORK.obj GROUP BY CI INTO SET_OF_POINTS
'=============================================================================
Dim AppPath As String
AppPath = ApplicationDirectory$()
Create Table "WORK" (ID Integer) file AppPath + "WORK.TAB" TYPE NATIVE Charset "WindowsCyrillic"
Create Map For WORK CoordSys Earth Projection 1, 104
Create Index On WORK (ID)
Add Map Layer WORK
Set Map Layer 1 Editable On
Set Map Distance Units "m"
Insert Into WORK (obj) Values ( CreateCircle(DistArray(1).x, DistArray(1).y, DISTAN) )
Dim Interfirience As Integer
for p = 1 to Ubound(DistArray)
Update WORK Set obj = CreateCircle(DistArray(p).x, DistArray(p).y, DISTAN)
SELECT CI FROM Temp, WORK WHERE Temp.obj INTERSECTS WORK.obj GROUP BY CI INTO SET_OF_POINTS
Interfirience = TableInfo(SET_OF_POINTS, TAB_INFO_NROWS)
If Interfirience > 2 then
count = count + 1
End If
Close Table SET_OF_POINTS
next |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 5:05 am Заголовок сообщения: |
|
|
PRINT #2, Str$(count)
Close File #2
print "Bed cells count : "+Str$(count)
' замут с розрядностью найденых совпадений
if Len(Str$(count)) = 6 then
labuda = Str$(count)
end if
if Len(Str$(count)) = 5 then
labuda = "0"+Str$(count)
end if
if Len(Str$(count)) = 4 then
labuda = "00"+Str$(count)
end if
if Len(Str$(count)) = 3 then
labuda = "000"+Str$(count)
end if
if Len(Str$(count)) = 2 then
labuda = "0000"+Str$(count)
end if
if Len(Str$(count)) = 1 then
labuda = "00000"+Str$(count)
end if |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Чт Апр 19, 2007 5:06 am Заголовок сообщения: |
|
|
Rename File "C:\temp\FREQ_"+tables(j).freq+".txt" As "C:\temp\_"+labuda +"_FREQ_"+tables(j).freq+"_DIST_"+Str$(DISTAN)+"m"+".txt"
End If
Close Table Temp
Close Table WORK
Next
Note "ALL DONE !!!"
Exit Sub
_error_:
'Print "Error : " + Str$(Err()) + " " + Error$()
Resume _go_
End Sub |
|
Вернуться к началу |
|
|
Нестеров Валерий
Зарегистрирован: 21.03.2006 Сообщения: 492
|
Добавлено: Чт Апр 19, 2007 3:02 pm Заголовок сообщения: |
|
|
Оценивать алгоритм у меня не получится, просто не найду время, но если у вас работает, а затем виснет, значит, что-то где то или переполняется (например массивы в оперативной памяти) или доходит до затыка. Это вам нужно определить экспериментально или по каким-нибудь логам. Кстати, если вы работаете со строками таблицы используя команды "Fetch" и т.д., то желательно перед запуском вашей программки все таблицы упаковать (Таблица\Изменить\Упаковать), потому, что бывают затыки на удаленных строках. Также бывют просто битые таблицы или объекты (например, объект в карте есть, а в списке нет или наоборот). _________________ Жизнь прекрасна!i |
|
Вернуться к началу |
|
|
Egor
Зарегистрирован: 25.10.2006 Сообщения: 26
|
Добавлено: Пт Апр 20, 2007 5:08 am Заголовок сообщения: |
|
|
Разобрался... Причина зависания - пустые таблицы... Программа работает отлично!!! Ваш совет очень помог... время работы сократилось с трех суток до 4 часов... |
|
Вернуться к началу |
|
|
|