Добрый время суток, уважаемые форумчане!
Недавно я столкнулся с проблемой сортировки списков(list) объектов. Главный вопрос в динамической итерации по списку, лотус нам предлагает один лишь forall, с помощью которого для меня был возможен пузырьковый метод сортировки (и то не оптимизированный).
В интернете нашел решение, идея которого базируется на "превращении" листа в обычный массив, однако у массива есть ограничение по размеру.
В итоге решил написать утилиту с возможностями:
1) Обращения к элементу списка по позиции (по индексу)
2) Получение предыдущего/следующего индекса элемента
3) Получение первого/последнего индекса элемент
4) Определение количества элементов списка
и.т.д.
Однако результаты тестирования показали, что стандартная итерация гораздо быстрее самописного инструмента. Возможно данная утилита пригодится для других целей
Способы итерации:
Недавно я столкнулся с проблемой сортировки списков(list) объектов. Главный вопрос в динамической итерации по списку, лотус нам предлагает один лишь forall, с помощью которого для меня был возможен пузырьковый метод сортировки (и то не оптимизированный).
В интернете нашел решение, идея которого базируется на "превращении" листа в обычный массив, однако у массива есть ограничение по размеру.
В итоге решил написать утилиту с возможностями:
1) Обращения к элементу списка по позиции (по индексу)
2) Получение предыдущего/следующего индекса элемента
3) Получение первого/последнего индекса элемент
4) Определение количества элементов списка
и.т.д.
Однако результаты тестирования показали, что стандартная итерация гораздо быстрее самописного инструмента. Возможно данная утилита пригодится для других целей
Код:
%REM
Library ListLibrary
Created Apr 11, 2013 by Administrator Administrator
Description: Comments for Library
%END REM
Option Public
Option Declare
'Нулевой индекс
Public Const NULL_TAG = {#NULL_TAG#}
'Сообщения об ошибках
Private Const ERR_01 = {List is empty}
Private Const ERR_02 = {Tag does not exist: }
Private Const ERR_03 = {Position does not exist: }
%REM
Class ListController
Description: Класс-утилита для работы с листами
%END REM
Public Class ListController
Private className As String
Private listVar List As Variant
Private tagOfPosition List As Variant
Private positionOfTag List As Long
Private listCount As Long
Private isObjectList As Boolean
%REM
Sub New
Description: Constructor
%END REM
Sub New()
me.className = TypeName(me)
me.listCount = -1
End Sub
Sub Delete
Call truncate()
End Sub
%REM
Sub truncate
Description: Очистка
%END REM
Public Sub truncate()
me.listCount = -1
Erase me.listVar
Erase me.tagOfPosition
Erase me.positionOfTag
End Sub
%REM
Function isListEmpty
Description: Проверка на пустоту листа
%END REM
Public Function isListEmpty() As Boolean
isListEmpty = (me.listCount=-1)
End Function
%REM
Function getListSize
Description: Получение размерности листа
%END REM
Public Function getListSize() As Long
getListSize = me.listCount
End Function
%REM
Function containsTag
Description: Проверка на существование индекса
%END REM
Public Function containsTag(tag As Variant) As Boolean
containsTag = IsElement(me.positionOfTag(tag))
End Function
%REM
Function containsPosition
Description: Проверка на существование позиции
%END REM
Public Function containsPosition(position As Long) As Boolean
containsPosition = IsElement(me.tagOfPosition(position))
End Function
%REM
Function putElement
Description: Добавление (замена) элемента в лист
Возвращает переданный <value>
%END REM
Public Function putElement(tag As Variant, value As Variant) As Variant
On Error GoTo eh
If containsTag(tag) Then
Call me.listVar(tag).setValue(value)
Else
me.listCount = me.listCount + 1
me.tagOfPosition(me.listCount) = tag
me.positionOfTag(tag) = me.listCount
End If
me.isObjectList = IsObject(value)
If me.isObjectList Then
Set me.listVar(tag) = value
Set putElement = value
Else
me.listVar(tag) = value
putElement = value
End If
GoTo ex
eh:
Error Err, Error & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getElementByTag
Description: Получение элемента листа по индексу
%END REM
Public Function getElementByTag(tag As Variant) As Variant
On Error GoTo eh
If me.isObjectList Then
Set getElementByTag = me.listVar(tag)
Else
getElementByTag = me.listVar(tag)
End If
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getElementByPosition
Description: Получение элемента по позиции
%END REM
Public Function getElementByPosition(position As Long) As Variant
On Error GoTo eh
If me.isObjectList Then
Set getElementByPosition = me.listVar(me.tagOfPosition(position))
Else
getElementByPosition = me.listVar(me.tagOfPosition(position))
End If
GoTo ex
eh:
Error Err, ERR_03 & position & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getPositionByTag
Description: Получение позиции элемента по индексу
%END REM
Public Function getPositionByTag(tag As Variant) As Long
On Error GoTo eh
getPositionByTag = me.positionOfTag(tag)
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getTagByPosition
Description: Получение индекса элемента по позиции
%END REM
Public Function getTagByPosition(position As Long) As Variant
On Error GoTo eh
getTagByPosition = me.tagOfPosition(position)
GoTo ex
eh:
Error Err, ERR_03 & position & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Sub removeElementByTag
Description: Удаление элемента по индексу
%END REM
Public Sub removeElementByTag(tag As Variant)
On Error GoTo eh
Dim position As Long
Dim removePosition As Long
Dim tagTemp As Variant
removePosition = me.positionOfTag(tag)
Erase me.positionOfTag(tag)
Erase me.listVar(tag)
For position=removePosition To me.listCount-1
tagTemp = me.tagOfPosition(position+1)
positionOfTag(tagTemp) = position
me.tagOfPosition(position) = tagTemp
Next
Erase me.tagOfPosition(me.listCount)
me.listCount = me.listCount - 1
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Sub
%REM
Sub removeElementByPosition
Description: Удаление элемента по позиции
%END REM
Public Sub removeElementByPosition(position As Long)
On Error GoTo eh
Call removeElementByTag(me.tagOfPosition(position))
GoTo ex
eh:
Error Err, ERR_03 & position & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Sub
%REM
Function getFirstTag
Description: Получение первого индекса
%END REM
Public Function getFirstTag() As Variant
On Error GoTo eh
If isListEmpty() Then
getFirstTag = NULL_TAG
Else
getFirstTag = me.tagOfPosition(0)
End If
GoTo ex
eh:
Error Err, Error & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getLastTag
Description: Получение последнего индекса
%END REM
Public Function getLastTag() As Variant
On Error GoTo eh
If isListEmpty() Then
getLastTag = NULL_TAG
Else
getLastTag = me.tagOfPosition(me.listCount)
End If
GoTo ex
eh:
Error Err, Error & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function isNullTag
Description: Проверка на нулевой индекс
%END REM
Public Function isNullTag(tag As Variant) As Boolean
On Error GoTo eh
isNullTag = (CStr(tag)=NULL_TAG)
GoTo ex
eh:
Error Err, Error & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function isFirstTag
Description: Проверка на первый индекс
%END REM
Public Function isFirstTag(tag As Variant) As Boolean
On Error GoTo eh
isFirstTag = (me.positionOfTag(tag)=0)
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function isLastTag
Description: Проверка на последний индекс
%END REM
Public Function isLastTag(tag As Variant) As Boolean
On Error GoTo eh
isLastTag = (me.positionOfTag(tag)=me.listCount)
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getPrevTag
Description: Получение предыдующего относительно <tag> индексa,
если <tag> - первый, то возвращает нулевой индекс
%END REM
Public Function getPrevTag(tag As Variant) As Variant
On Error GoTo eh
Dim position As Long
position = me.positionOfTag(tag)
If position=0 Then
getPrevTag = NULL_TAG
Else
getPrevTag = me.tagOfPosition(position-1)
End If
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Function getNextTag
Description: Получение следующего относительно <tag> индексa,
если <tag> - последний, то возвращает нулевой индекс
%END REM
Public Function getNextTag(tag As Variant) As Variant
On Error GoTo eh
Dim position As Long
position = me.positionOfTag(tag)
If position=me.listCount Then
getNextTag = NULL_TAG
Else
getNextTag = me.tagOfPosition(position+1)
End If
GoTo ex
eh:
Error Err, ERR_02 & tag & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Function
%REM
Sub appendList
Description: Добавление готового листа
%END REM
Public Sub appendVariantList(listVariantParam List As Variant)
On Error GoTo eh
ForAll lvp In listVariantParam
Call putElement(ListTag(lvp), lvp)
End ForAll
GoTo ex
eh:
Error Err, Error & " №" & Err & Chr(10) & "Class: " & Me.className & Chr(10) & "Method: " & _
LSI_Info(2) & Chr(10) & "Called by: " & LSI_Info(12) & " on line " & Erl & Chr(10)
ex:
End Sub
End Class
Способы итерации:
Код:
%REM
Agent tem
Created Apr 11, 2013 by Administrator Administrator
Description: Comments for Agent
%END REM
Option Public
Option Declare
Use "ListLibrary"
Sub Initialize
Dim listController As New ListController
Call listController.putElement("8", "Gerard")
Call listController.putElement("23", "Carragher")
Call listController.putElement("7", "Suarez")
Call listController.putElement("1", "Reina")
Call listController.putElement("5", "Agger")
Call listController.putElement("21", "Lucas")
Call listController.putElement("24", "Allen")
Call listController.putElement("3", "Enrique")
Call listController.putElement("2", "Johnson")
Call iterarteMethod1(listController)
End Sub
Sub Terminate
End Sub
%REM
Sub iterarteMethod1
Description: Comments for Sub
%END REM
Private Sub iterarteMethod1(listController As ListController)
Dim index As Variant
index = listController.getFirstTag()
While(Not listController.isNullTag(index))
Print listController.getElementByTag(index)
index = listController.getNextTag(index)
Wend
End Sub
%REM
Sub iterarteMethod2
Description: Comments for Sub
%END REM
Private Sub iterarteMethod2(listController As ListController)
Dim i As Long
For i=0 To listController.getListSize()
Print listController.getElementByPosition(i)
Next
End Sub
%REM
Sub iterarteMethod3
Description: Comments for Sub
%END REM
Private Sub iterarteMethod3(listController As ListController)
Dim index As Variant
index = listController.getLastTag()
While(Not listController.isNullTag(index))
Print listController.getElementByTag(index)
index = listController.getPrevTag(index)
Wend
End Sub