Форум программистов, компьютерный форум, киберфорум
bedvit
Войти
Регистрация
Восстановить пароль
Рейтинг: 5.00. Голосов: 1.

Библиотека COM (OLE Automation). Часть 1 - ArraySort (String)

Запись от bedvit размещена 13.11.2018 в 21:46
Обновил(-а) bedvit 20.07.2020 в 16:12 (Новая версия)

Теперь часть библиотеки BedvitCOM.
См. Часть 2.
Решил запустить пробный шар, и если будет время и интерес к данной тематике, возможно сделаю что-то годное в своих COM и XLL библиотеках.
Цель - скорость и удобство работы, создание для скриптовых языков, языков с поддержкой COM - того, чего там нет или есть, но хочется лучше.
В данном момент ориентир на VBA.
Добавил новый класс - "VBA" к двум уже существующим (см. ссылку выше).
Добавил новый метод - "ArraySortS" - сортировка данных (String) в одномерном/двухмерном массиве. С выводом индексов, сортировка возможна практически в любой размерности, если сортировать по первым двум измерениям) + удаление дубликатов.
На порядок быстрее QuickSort на массивах VBA. до 35 раз!
COM упакована в XLL (распаковывается и регистрируется автоматом).
Открываем XLL, пишем код в VBA - пользуемся.

26/11/2018 - Обновления функционала:
1.Сортировка одномерных и двухмерных массивов
2.Удаление дубликатов в одномерных массивах
3.Вывод по одномерному и двухмерному массивам индексов по строкам или столбцам.
4.Сортировка по столбцам, строкам, целому массиву с выводом строки/столбцы, столбцы/строки.
5.Сортировка по 3 ключам (столбцам, строкам)
6.Размерность массива может быть любой, в т.ч. и с минусовых значений -5+0+5... и т.д. (вывод индексов в такой же размерности)
7.Обработка NULL - строк (перемещение на последние позиции)
8.Использованы параллельные алгоритмы сортировки.
(библиотеки PPL, костыли не прикручивал)


Интерфейс класса:
C++
1
2
3
4
5
interface IVBA : IDispatch
{
    [id(1), helpstring("Array sort")] HRESULT ArraySortS([in, out] VARIANT* array_in_out, [in,defaultvalue(0)] VARIANT_BOOL sort_order, [in, defaultvalue(0)] LONG key_1, [in, defaultvalue(0)] LONG key_2, [in, defaultvalue(0)] LONG key_3, [in, defaultvalue(0)]  LONG sort_orientation,  [in, defaultvalue(0)]  VARIANT_BOOL delete_duplicates,[in, defaultvalue(0)]  VARIANT_BOOL out_array_index, [in, out, defaultvalue(0)] VARIANT* index_array_out);
 
};
Параметры метода:
1.array_in_out - указатель на массив (ввод/вывод)
2.sort_order - порядок сортировки : 0-по возрастанию, 1-по убыванию
3.key_1 - ключи сортировки (порядковый номер столбца/строки, начиная с 1) по умолчанию - первый столбец/строка
4.key_2
5.key_3
6.sort_orientation - ориентация сортировки (0 - по строкам, 1 - по столбцам, 2- целый массив вывод строка-столбец, 3- целый массив вывод столбец-строка)
7.delete_duplicates - удаляем дубликаты (в одномерных массивах)
8.out_array_index - выводим индексы, "булево" 1/0 (тогда основной массив array_in_out - не меняется, выводятся данные в index_array_out )
9.index_array_out - одномерный массив с индексами (с учетом всех ключей), если задан out_array_index=1

Все параметры метода, кроме входящего массива - опциональные (с значениями по умолчанию - 0 (ключи-1))
Метод "ArraySortS" работает через Variant, т.к. на некоторых скриптовых языках SAFEARRAY ходит через границы COM, только в обертке VARIANT (без изобретения костылей).

Пример тестирования и использования в VBA (элементарно через CreateObject("BedvitCOM.VBA")):
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Sub Test_arr_sort()
'Dim bVBA As BedvitCOM.VBA: Set a = New BedvitCOM.VBA 'ранее связывание
Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание
Dim testSize As Long: testSize = 2000000
Dim arr_index, arrTmp, i As Long, J As Long, t
 
''''''''''''1х массив'''''''''''''''''''''''
Dim Arr1: ReDim Arr1(-5 To testSize) As String
Dim Arr2: ReDim Arr2(-5 To testSize, -2 To 3) As String
 
'arr(5) - NULL - проверка для сортировки пустых
Arr1(6) = 0
Arr1(7) = "Test_arr_sort"
For i = 8 To testSize
  Arr1(i) = Format$(Int(Rnd * testSize), "0000000") '30% дубликатов
Next
 
arrTmp = Arr1 '!
t = Timer
bVBA.ArraySortS arrTmp
Debug.Print "Простая сорт. 1х массива, по возрастанию (по умолч.): " & Timer - t & " сек."
 
arrTmp = Arr1 '!!
t = Timer
bVBA.ArraySortS arrTmp, 1, , , , , 1, 0, 0
Debug.Print "Простая сорт.по убыванию 1x массива с удалением" & ((UBound(arrTmp) - LBound(arrTmp)) / (testSize - LBound(arrTmp)) - 1) * 100 & "%: " & Timer - t & " сек."
 
'arrTmp = arr - начальный массив не меняется, поэтому темповый - не нужен '!
t = Timer
bVBA.ArraySortS Arr1, 1, , , , , , 1, arr_index
Debug.Print "Вывод индексов для 1х массива, сортировка по убыванию:" & Timer - t & " сек."
 
''''''''''''2х массив'''''''''''''''''''''''
'arr(5) - NULL - проверка для сортировки пустых
Arr2(6, 2) = 0
Arr2(7, 2) = "Test_arr_sort"
For i = 8 To testSize
    For J = -2 To 3
        Arr2(i, J) = Format$(Int(Rnd * testSize), "0000000") '30% дубликатов
    Next
Next
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, , , , 2, 0, 0, 0
Debug.Print "Сортировка всего 2х массива - вывод строка-столбец: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 5, , , 3, 0, 0, 0
Debug.Print "Сортировка всего 2х массива - вывод столбец-строка " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp
Debug.Print "Простая сортировка 2х массива: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer '!
bVBA.ArraySortS arrTmp, 0, 3, , , , , 1, arr_index
Debug.Print "Вывод индексов для 2х массива, по указанному столбцу: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 5, , , 1, 0, 0, 0
Debug.Print "Сортировка 2х массива по 5му столбцу: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer '!
bVBA.ArraySortS arrTmp, 0, 8, , , 1, , 1, arr_index
Debug.Print "Вывод индексов для 2х массива, по 8й строке: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 8, , , 1, 0, 0, 0
Debug.Print "Сортировка 2х массива по 8й строке: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 1, 2, 3, 0, , 1, arr_index
Debug.Print "Вывод индексов для 2х массива, по 1,2,3му столбцу: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 1, 2, 3, 0, 0, 0, 0
Debug.Print "Сортировка 2х массива по 1,2,3му столбцу: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 8, 9, 10, 1, 0, 1, arr_index
Debug.Print "Вывод индексов для 8,9,10й строке: " & Timer - t & " сек."
 
arrTmp = Arr2 '!
t = Timer
bVBA.ArraySortS arrTmp, 0, 8, 9, 10, 1, 0, 0, 0
Debug.Print "Сортировка 2х массива по 8,9,10й строке: " & Timer - t & " сек."
 
Set bVBA = Nothing
End Sub


Результаты на 2-х млн. строк и 4-м столбцам:

Алгоритмы в VBA (быстрейшее решения, для сравнения):
QuickSort на VBA (простая сортировка одномерного массива) -6.8 сек.
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
Const testSize = 2000000
Dim a(testSize), x$, y$
 
Sub test()
Dim i&
For i = 0 To testSize
  a(i) = Format$(Int(Rnd * testSize), "0000000")
Next
 
Dim t#
t = Timer
QuickSort 0, testSize
Debug.Print Timer - t
 
End Sub
 
Sub QuickSort(ByVal L As Long, ByVal U As Long)
Dim i As Long, j As Long
i = L: j = U: x = a((L + U) \ 2)
Do
  While a(i) < x: i = i + 1: Wend: While x < a(j): j = j - 1: Wend 'по возрастанию
'  While A(I) > X: I = I + 1: Wend: While X > A(J): J = J - 1: Wend 'по убыванию
  If i <= j Then
    y = a(i): a(i) = a(j): a(j) = y:    i = i + 1: j = j - 1
  End If
Loop Until i > j
If L < j Then QuickSort L, j
If i < U Then QuickSort i, U
End Sub


Метод ArraySortS из класса BedvitCOM.VBA (тестовый стенд: ЦП-QuadCore Intel Core i7-3770, ОЗУ-16ГБ (DDR3-1600 DDR3 SDRAM), WIN7x64, MS Office2016x64):
Простая сорт. 1х массива, по возрастанию (по умолч.): 0,21875 сек.
Простая сорт.по убыванию 1x массива с удалением-34,5385136537159%: 0,3515625 сек.
Вывод индексов для 1х массива, сортировка по убыванию:0,2460938 сек.
Сортировка всего 2х массива - вывод строка-столбец: 1,75 сек.
Сортировка всего 2х массива - вывод столбец-строка 1,78125 сек.
Простая сортировка 2х массива: 0,390625 сек.
Вывод индексов для 2х массива, по указанному столбцу: 0,28125 сек.
Сортировка 2х массива по 5му столбцу: 0,05078125 сек.
Вывод индексов для 2х массива, по 8й строке: 0 сек.
Сортировка 2х массива по 8й строке: 0,05078125 сек.
Вывод индексов для 2х массива, по 1,2,3му столбцу: 1,484375 сек.
Сортировка 2х массива по 1,2,3му столбцу: 1,519531 сек.
Вывод индексов для 8,9,10й строке: 0 сек.
Сортировка 2х массива по 8,9,10й строке: 0,05078125E сек.

18/02/2018 - добавил СОМ-библиотеки
Для возможности использовать данную сортировку в СОМ-поддерживающих программах.
Регистрация COM реализовано как под админом, так и под пользователем (актуально в офисной части клиентов)
Регистрация стандартная:
Админ: Regsvr32 "FullName.DLL" !ПОМНИМ! В Win10 регистрация под правами админа: "правая кнопка" - "Пуск" -"Командная строка (администратор)"
Пользователь: Regsvr32 /i /n "FullName.DLL"
Удалить из реестра: Regsvr32 /u "FullName.DLL"

Последние версии библиотек.
Миниатюры
Нажмите на изображение для увеличения
Название: BedvitCOM_VBA1.PNG
Просмотров: 113
Размер:	90.1 Кб
ID:	5523  
Размещено в Без категории
Показов 1436 Комментарии 12
Всего комментариев 12
Комментарии
  1. Старый комментарий
    Аватар для bedvit
    26/11/2018 - Обновления функционала
    Запись от bedvit размещена 27.11.2018 в 09:08 bedvit вне форума
  2. Старый комментарий
    подскажите, как сделать, чтобы в Ворде тоже работало? пока ошибку выдает на строке
    Visual Basic
    1
    
    Set bVBA = CreateObject("BedvitCOM.VBA")
    спс
    Запись от Ципихович Эндрю размещена 04.01.2019 в 09:50 Ципихович Эндрю вне форума
  3. Старый комментарий
    Аватар для bedvit
    Ципихович Эндрю, извините что с опозданием, дела не ждут, редко бываю. По вашему вопросу - для того, что бы использовать эту библиотеку в VBA (Word ), ее нужно зарегистрировать. И все заработает ) просто в Excel за вас это делает .xll Если тема ещё интересна, вышлю вам СОМ.DLL для использования в Word и любых других СОМ-поддерживающих программах.
    Запись от bedvit размещена 16.02.2019 в 00:22 bedvit вне форума
  4. Старый комментарий
    Если тема ещё интересна - ДА!
    вышлю вам СОМ.DLL для использования в Word - спасибо, жду
    Запись от Ципихович Эндрю размещена 16.02.2019 в 11:47 Ципихович Эндрю вне форума
  5. Старый комментарий
    Аватар для bedvit
    Выслал вам на указанную почту.
    Запись от bedvit размещена 17.02.2019 в 09:37 bedvit вне форума
  6. Старый комментарий
    А у меня ваш код ошибку выдаёт "Invalid procedure call or argument"
    Запись от FireHeadChaos размещена 26.10.2019 в 20:29 FireHeadChaos вне форума
  7. Старый комментарий
    Аватар для bedvit
    Вы открыли xll или зарегистрировали СОМ? Возможно вы передаёте неверный аргумент. Как вы используете данную библиотеку?
    Запись от bedvit размещена 27.10.2019 в 12:53 bedvit вне форума
  8. Старый комментарий
    вышлю вам СОМ.DLL для использования в Word
    Выслал вам на указанную почту

    решил вернуться к теме, приложите пжл здесь, спс
    Запись от Ципихович Эндрю размещена 27.10.2019 в 13:08 Ципихович Эндрю вне форума
  9. Старый комментарий
    Я пытаюсь использовать ваш тест: Пример тестирования и использования в VBA (элементарно через CreateObject("BedvitCOM.VBA")) . И что интересно объект создаётся. Открывал XLL
    Запись от FireHeadChaos размещена 27.10.2019 в 13:09 FireHeadChaos вне форума
  10. Старый комментарий
    Аватар для bedvit
    Ципихович Эндрю, посмотрите по ссылке Последние версии библиотек. Там всегда самая последняя.
    FireHeadChaos, можете показать код? Массив должен быть завернут в variant
    Visual Basic
    1
    
    Dim Arr1: ReDim Arr1(-5 To testSize) As String
    Есть вариант сортировки любых данных (Variant), он более универсальный:
    Библиотека COM (OLE Automation). Часть 2 - ArraySort (Variant)

    FireHeadChaos, да есть такой момент, сейчас посмотрю.
    Проблема решена. Залил новую версию.
    Запись от bedvit размещена 28.10.2019 в 00:03 bedvit вне форума
    Обновил(-а) bedvit 28.10.2019 в 13:12
  11. Старый комментарий
    Простая сорт. STRING 1х массива, по возрастанию (по умолч.): 0,9140625 сек.
    Простая сорт. VARIANT 1х массива, по возрастанию (по умолч.): 1,132813 сек.
    Простая сорт. VARIANT 2х массива, по возрастанию (по умолч.): 1,640625 сек.
    Простая сорт. VARIANT 2х массива, по убыванию по первому ключу и по возрастанию по второму: 3,476563 сек.
    Простая сорт. VARIANT 2х массива, по возрастанию по трём ключам: 4,257813 сек.
    Простая сорт. VARIANT 2х массива, по убыванию, по первому столбцу и третьему: 0 сек.
    Вот мой результат по сортировкам, заполнил предварительно колонки листа случайными значениями и ещё заметил нагрузку процессора на все 100
    Запись от FireHeadChaos размещена 28.10.2019 в 15:17 FireHeadChaos вне форума
  12. Старый комментарий
    Аватар для bedvit
    Цитата:
    Сообщение от FireHeadChaos Просмотреть комментарий
    Вот мой результат по сортировкам, заполнил предварительно колонки листа случайными значениями и ещё заметил нагрузку процессора на все 100
    Спасибо за тест, у вас время больше, видимо машина слабее, чем тестовый стенд: ЦП-QuadCore Intel Core i7-3770, ОЗУ-16ГБ (DDR3-1600 DDR3 SDRAM), WIN7x64, MS Office2016x64
    Нагрузка на ЦП 100% - потому как использованы параллельные алгоритмы сортировки (библиотеки PPL).
    По выявленным ошибкам - прошу писать в блог или на почту.
    В блог думаю лучше, будет информация для других пользователей.
    Запись от bedvit размещена 28.10.2019 в 16:46 bedvit вне форума
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.