• Познакомьтесь с пентестом веб-приложений на практике в нашем новом бесплатном курсе

    «Анализ защищенности веб-приложений»

    🔥 Записаться бесплатно!

  • CTF с учебными материалами Codeby Games

    Обучение кибербезопасности в игровой форме. Более 200 заданий по Active Directory, OSINT, PWN, Веб, Стеганографии, Реверс-инжинирингу, Форензике и Криптографии. Школа CTF с бесплатными курсами по всем категориям.

Утилита Для Работы С List

Darkhan

Green Team
14.12.2012
99
2
BIT
0
Добрый время суток, уважаемые форумчане!

Недавно я столкнулся с проблемой сортировки списков(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
 
A

alexas

Darkhan спасибо.
Мне пригодится т.к. часто работаю с короткими листами, а оборачивать с класс все недосуг :)
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
давайте, для начала, разберёмся с понятиями...
то что индусы назвали List, на самоме деле - либо Map либо HashMap в понятиях java
т.е.: доступ по ключу, и предположительно хэшированный
т.о. не подразумевается уникальность значений и сортировка
вопрос о сортировке затрагивает смысл этого действа - сортировать что:
-ключи
-значения
в java есть уже готовые классы и методы как для хранения (различного) так и для сортировки
со строками прекрасно справляются java классы (в т.ч. через бридж)
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
вопрос о сортировке затрагивает смысл этого действа - сортировать что:
-ключи
-значения
Предположим в листе объекты самописных классов, и есть необходимость отсортировать по какому(-им)-нибудь свойству(-ам).
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
вот к-н св-во и приводится к стрингу (например)
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
теряется смысл сортировки искомых свойств, если при этом не менять позиции объектов
пример можно?

Добавлено:
В итоге решил написать утилиту с возможностями:
1) Обращения к элементу списка по позиции (по индексу)
2) Получение предыдущего/следующего индекса элемента
3) Получение первого/последнего индекса элемент
4) Определение количества элементов списка
я правильно понял - здесь вообще нет сортировки?
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
я правильно понял - здесь вообще нет сортировки?
совершенно верно, после отрицательных результатов тестирования удалил методы перестановки элементов, а также сам метод сортировки(buble)
Предположим, необходимо сделать статистический отчет, по исполнителям документов, отсортированный по количеству просроченных документов, имеющий также столбцы по:
- исполненным в срок
- находящиеся на исполнении
- отписанных подчиныенным.

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

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
и что из перечисленного я не могу конвертнуть в строку (для сортировки)?

Добавлено: сортировка по key& {|} &NoteID
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
lmike, согласен, еще одна причина не использовать данную утилиту для сортировки. Поэтому и выложил в целях найти ему другое применение
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
ArrayList, Sort, Hash
ну тогда вот <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"LS"</div></div><div class="sp-body"><div class="sp-content">
Код:
Option Public
Option Declare
Use "SortList.LS2J"
........................
'************************************
Class SorterObj As ErrorHandler
Private keyList List As String 'ключём явл. UNID, значением - ключ сортировки (для доступа по UNID)
Private docsHash List As NotesDocument 'для доступа к документу по индексу, из отсорт. массива
Private sortArr As Variant 'сюда попадают отсортированные ключи
Private Sorter As SortObj
Private keys As Variant
Private isChanged As Boolean
Private isDoctype As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'docArr - массив NotesDocument, для сортировки
'xKeys - список имен полей, по кот. будет сортироваться, поля не д.б. многозначными (использует 1-е значение)
Sub New(docArr List As NotesDocument, xKeys As Variant)
On Error Goto ErrH
Set Sorter=New SortObj
keys=xKeys
If Not Isarray(keys) Then Dim tmp:tmp=Split({},{}):tmp(0)=keys:keys=tmp
Forall x In docArr
Call Add(x)
End Forall
isDoctype=True
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Add(doc As NotesDocument) As NotesDocument
On Error Goto ErrH
Dim s As String
s=doc.UniversalID
Set docsHash(s)=doc
Dim key As String
key=JoinKeys(doc)
keyList(s)=key
Sorter.Add(key &EL_SEP &s)
Set Me.Add=doc
isChanged=True
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function JoinKeys(xDoc As NotesDocument) As String
On Error Goto ErrH
Dim sKey
sKey=Split("","")
'		DbgMsg({fields:} &Join(keys,{;}))
Forall k In keys
Dim s As String
'явное приведение к типу
s=Cstr(k)
If xDoc.HasItem(s) Then
Dim v
v=xDoc.GetItemValue(s)
Dim itm As NotesItem
Set itm=xDoc.GetFirstItem(s)
'преобразуем к виду, кот. "правильно" сортируется как строка
Select Case itm.Type
Case NUMBERS:
s=Format(v(0), {000000.00})
Case DATETIMES:
s=Format(v(0), {YYYYMMDD})
Case TEXT:
s=v(0)
Case Else
'генерим ошибку
Error ERRINCOMARTIBLE, CS_ERRINCOMARTIBLE & CS_INCOMPFIELD
End Select
sKey=Arrayappend(sKey, Ucase(s))
End If
End Forall
sKey=Join(sKey, SORT_SEP)
JoinKeys=sKey
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get NthDocument(i As Long) As NotesDocument
On Error Goto ErrH
GetAll
Dim s As String
s=sortArr(i)
DbgMsg Cstr(i) &{;Sorted key:} &s
'вылетит по ошибке если индекс больше Count
Set NthDocument=docsHash(Strrightback(s, EL_SEP))
Quit:
Exit Property
ErrH:
Error Err, RaiseError
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get Count As Long
Count=Sorter.Count
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetAll As Variant
If isChanged Then
sortArr=Sorter.Sort()
isChanged=False
End If
GetAll=sortArr
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetIndex(doc As NotesDocument) As Long
On Error Goto ErrH
GetAll 'сортировка если нужно
GetIndex=Sorter.GetIndex(keyList(doc.UniversalID) &EL_SEP &doc.UniversalID)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Remove(doc As NotesDocument) As Boolean
On Error Goto ErrH
If Sorter.Remove(keyList(doc.UniversalID) &EL_SEP &doc.UniversalID) Then
Erase docsHash(doc.UniversalID)
Erase keyList(doc.UniversalID)
isChanged=True
Me.Remove=True
End If
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
End Class
'************************************
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"java bridge - SortList.LS2J"</div></div><div class="sp-body"><div class="sp-content">
Код:
Option Public
Option Declare
Use "ErrorHandling"
Uselsx "*lsxlc"
Use "SortList"
'/*лицензия LGPL
'автор: Чолоков М. Н.
'*/
Const ERRBASE_SORT=1130
Private Const ERRLS2JINIT=ERRBASE_SORT+1, CS_ERRLS2JINIT={ошибка инициализации класса Java}
'********************************
'класс реализован для вывода отсортированных значений списком (в массив LS)
Class SortObj As ErrorHandlerWJ
Private SortListObj As JavaObject
Private SortListClass As JavaClass
Private fCount As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub New()
Dim fail As Boolean
On Error Goto errorhandler
Set SortListClass = jSession.GetClass("SortList")
Set SortListObj = SortListClass.CreateObject
ExitFunction:
If fail Then 
On Error Goto 0
Error ERRLS2JINIT, CS_ERRLS2JINIT
End If
Exit Sub
errorhandler:
Call Me.RaiseError()
fail=True
Resume ExitFunction
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Delete()
If Not SortListObj Is Nothing Then
Delete SortListObj
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Add(s As String)
SortListObj.add(s)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Remove(s As String) As Boolean
Me.Remove=SortListObj.remove(s)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetIndex(s As String)
GetIndex=SortListObj.getindex(s)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Sort() As Variant
Sort=SortListObj.sort()
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get Count As Long
Count=SortListObj.count()
End Property
End Class
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"java - SortList"</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='java'>import java.util.*;
public class SortList {
private ArrayList arrList=new ArrayList();
public void add(String s){
arrList.add(s);
}
public boolean remove(String s){
return arrList.remove(s);
}
public String[] sort(){
Collections.sort(arrList);
String[] sorted=new String[arrList.size()];
arrList.toArray(sorted);
return sorted;
}
public int count(){
return arrList.size();
}
public int getIndex(String s){
return arrList.indexOf(s);
}
}[/CODE]ссылка на хэндлеры https://codeby.net/threads/44627.html?vi...st&p=216667
 

VladSh

начинающий
Lotus Team
11.12.2009
1 783
157
BIT
53
Если нужна динамика, делаем список, содержащий списки. Тэг - критерий, например "По дате ...". Если не нужна, этот уровень вложенности пропускаем.
В подсписках тэги - значения вышеуказанного критерия для сортировки (в нашем случае - даты, преобразованные в строку), в значениях - всё, что нам угодно.
К каждому подсписку дополнительно массив критериев (массив строк с датами), вычитанный при формировании каждого подсписка.
Сортировка применяется к массивам значений критериев, вычитка из списка производится по отсортированному массиву, т.е. в нужном порядке.

Здесь уже были большие обсуждения сортировки "доков" с рабочим кодом, и похожий пример был реализован в 2-х вариантах.
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
VladSh, изюминка в том, что если отбросить вариант использования готовых решений на java через бридж, мы имеем следующее:
существующий лист с предопределенными тэгами "превращается" в "резиновый" массив, значения которого - тэги изначального листа. Это позволяет итерировать по листу подобно массиву. Т.е. нет необходимости создания дополнительного связующего листа (массива) с критериями сортировки, просто обращаемся напрямую к элементу листа
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
Darkhan в этой схеме, пересортировка по др. критерию будет накладной (таскать объекты по памяти)
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
lmike, Ваши сомнения резонны (хотя есть сомнения по поводу именно "таскания" объектов, имхо, действия происходят вокруг ссылок на объекты, да и перестановке подлежат не сами объекты, а лишь позиции). Стоит отметить, что эффективность не увеличится вразы в случае реализации отдельного механизма для манипуляций с критериями сортировки, так как постоянные обращения к элементам по тэгу заметно уступают по скорости простой итерации forall.
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
про forall не понял...
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
Imike, например:
Код:
%REM
Agent d
Created Apr 24, 2013 by Administrator Administrator
Description: Comments for Agent
%END REM
Option Public
Option Declare

Dim listO List As Variant
Dim n As Long
Sub Initialize
n = 2000
Call sortBubbleByForall(listO)
Call sortBubbleByAnotherMethod(listO, n)
End Sub
Sub Terminate

End Sub

%REM
Sub sortBubbleByForall
Description: Comments for Sub
%END REM
Private Sub sortBubbleByForall(listO List As Variant)
Dim temp As Variant
Call initList()

Print "sortBubbleByForall start " & Now
ForAll l1 In listO
ForAll l2 In listO
If l1>l2 Then 
temp = l1
l1 = l2
l2 = temp
End If
End ForAll
End ForAll
Print "sortBubbleByForall finish " & Now

End Sub
%REM
Sub sortBubbleByForall
Description: Comments for Sub
%END REM
Private Sub sortBubbleByAnotherMethod(listO List As Variant, n As Long)
Dim temp As Variant
Dim i As Long
Dim j As Long

Call initList()

Print "sortBubbleByAnotherMethod start " & Now
For i=0 To n-1
For j=i+1 To n
If listO(i)>listO(j) Then 
temp = listO(i)
listO(i) = listO(j)
listO(j) = temp
End If
Next
Next
Print "sortBubbleByAnotherMethod finish " & Now
End Sub
%REM
Sub initList
Description: Comments for Sub
%END REM
Private Sub initList()
Dim i As Long
For i=0 To n
listO(i) = n - i
Next
End Sub

и это с учетом того, что способ через ForAll дает фору по кол-ву итераций своему "оппоненту"))
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
сравнивать такие реализации некорректно...
-хэш от целого, чаще всего, лишён смысла
-рассматривать перебор упорядоченного множества..., притом что сортировка предполагает неупорядоченное
-др. нюанецы: типа распределение хэша, метод сортировки... (в случае не bubble - перебор просто "невозможен")
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
-хэш от целого, чаще всего, лишён смысла
"целый" тэг был взят для упрощения приведения моего примера, т.е. без создания связующих компонентов
-рассматривать перебор упорядоченного множества..., притом что сортировка предполагает неупорядоченное
в качестве значения можно взять стринговый хэш от текущего значения
-др. нюанецы: типа распределение хэша, метод сортировки... (в случае не bubble - перебор просто "невозможен")
поэтому и создавался данная утилита, в силу того что стандартному перебору через ForAll "по зубам" лишь bubble, однако, имхо, он превзойдет по скорости QSort(если реализовать в данной утилите)
 
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!