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

Тема в разделе "Lotus - Программирование", создана пользователем Darkhan, 16 апр 2013.

  1. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    Добрый время суток, уважаемые форумчане!

    Недавно я столкнулся с проблемой сортировки списков(list) объектов. Главный вопрос в динамической итерации по списку, лотус нам предлагает один лишь forall, с помощью которого для меня был возможен пузырьковый метод сортировки (и то не оптимизированный).

    В интернете нашел решение, идея которого базируется на "превращении" листа в обычный массив, однако у массива есть ограничение по размеру.

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

    Однако результаты тестирования показали, что стандартная итерация гораздо быстрее самописного инструмента. Возможно данная утилита пригодится для других целей
    Код (LotusScript):
    %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
    Способы итерации:
    Код (LotusScript):
    %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
     
  2. alexas

    alexas Well-Known Member

    Регистрация:
    10 июн 2009
    Сообщения:
    215
    Симпатии:
    0
    Darkhan спасибо.
    Мне пригодится т.к. часто работаю с короткими листами, а оборачивать с класс все недосуг :)
     
  3. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    давайте, для начала, разберёмся с понятиями...
    то что индусы назвали List, на самоме деле - либо Map либо HashMap в понятиях java
    т.е.: доступ по ключу, и предположительно хэшированный
    т.о. не подразумевается уникальность значений и сортировка
    вопрос о сортировке затрагивает смысл этого действа - сортировать что:
    -ключи
    -значения
    в java есть уже готовые классы и методы как для хранения (различного) так и для сортировки
    со строками прекрасно справляются java классы (в т.ч. через бридж)
     
  4. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    Предположим в листе объекты самописных классов, и есть необходимость отсортировать по какому(-им)-нибудь свойству(-ам).
     
  5. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    вот к-н св-во и приводится к стрингу (например)
     
  6. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    теряется смысл сортировки искомых свойств, если при этом не менять позиции объектов
     
  7. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    пример можно?

    Добавлено:
    я правильно понял - здесь вообще нет сортировки?
     
  8. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    совершенно верно, после отрицательных результатов тестирования удалил методы перестановки элементов, а также сам метод сортировки(buble)
    Предположим, необходимо сделать статистический отчет, по исполнителям документов, отсортированный по количеству просроченных документов, имеющий также столбцы по:
    - исполненным в срок
    - находящиеся на исполнении
    - отписанных подчиныенным.

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

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    и что из перечисленного я не могу конвертнуть в строку (для сортировки)?

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

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    lmike, согласен, еще одна причина не использовать данную утилиту для сортировки. Поэтому и выложил в целях найти ему другое применение
     
  11. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    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">
    Код (LotusScript):
    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">
    Код (LotusScript):
    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]ссылка на хэндлеры http://codeby.net/forum/threads/44627.html?vi...st&p=216667
     
  12. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    Imike, по Вашим следам , видать, я шел...)))
     
  13. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    Если нужна динамика, делаем список, содержащий списки. Тэг - критерий, например "По дате ...". Если не нужна, этот уровень вложенности пропускаем.
    В подсписках тэги - значения вышеуказанного критерия для сортировки (в нашем случае - даты, преобразованные в строку), в значениях - всё, что нам угодно.
    К каждому подсписку дополнительно массив критериев (массив строк с датами), вычитанный при формировании каждого подсписка.
    Сортировка применяется к массивам значений критериев, вычитка из списка производится по отсортированному массиву, т.е. в нужном порядке.

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

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    VladSh, изюминка в том, что если отбросить вариант использования готовых решений на java через бридж, мы имеем следующее:
    существующий лист с предопределенными тэгами "превращается" в "резиновый" массив, значения которого - тэги изначального листа. Это позволяет итерировать по листу подобно массиву. Т.е. нет необходимости создания дополнительного связующего листа (массива) с критериями сортировки, просто обращаемся напрямую к элементу листа
     
  15. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    Darkhan в этой схеме, пересортировка по др. критерию будет накладной (таскать объекты по памяти)
     
  16. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    lmike, Ваши сомнения резонны (хотя есть сомнения по поводу именно "таскания" объектов, имхо, действия происходят вокруг ссылок на объекты, да и перестановке подлежат не сами объекты, а лишь позиции). Стоит отметить, что эффективность не увеличится вразы в случае реализации отдельного механизма для манипуляций с критериями сортировки, так как постоянные обращения к элементам по тэгу заметно уступают по скорости простой итерации forall.
     
  17. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    про forall не понял...
     
  18. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    Imike, например:
    Код (LotusScript):
    %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 дает фору по кол-ву итераций своему "оппоненту"))
     
  19. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.083
    Симпатии:
    300
    сравнивать такие реализации некорректно...
    -хэш от целого, чаще всего, лишён смысла
    -рассматривать перебор упорядоченного множества..., притом что сортировка предполагает неупорядоченное
    -др. нюанецы: типа распределение хэша, метод сортировки... (в случае не bubble - перебор просто "невозможен")
     
  20. Darkhan

    Darkhan Lotus team
    Lotus team

    Регистрация:
    14 дек 2012
    Сообщения:
    97
    Симпатии:
    4
    "целый" тэг был взят для упрощения приведения моего примера, т.е. без создания связующих компонентов
    в качестве значения можно взять стринговый хэш от текущего значения
    поэтому и создавался данная утилита, в силу того что стандартному перебору через ForAll "по зубам" лишь bubble, однако, имхо, он превзойдет по скорости QSort(если реализовать в данной утилите)
     
Загрузка...

Поделиться этой страницей