Форум программистов, компьютерный форум, киберфорум
Наши страницы
bedvit
Войти
Регистрация
Восстановить пароль
Оценить эту запись

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

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

В продолжении темы Длинная арифметика (Bignum arithmetic) c COM-интерфейсом и C API Functions для Excel на библиотеках MPIR. С/С++
Решил запустить пробный шар, и если будет время и интерес к данной тематике, возможно сделаю что-то годное в своих COM и XLL библиотеках.
Цель - скорость и удобство работы, создание для скриптовых языков, языков с поддержкой COM - того, чего там нет или есть, но хочется лучше.
В данном момент ориентир на VBA.
Добавил новый класс - "VBA" к двум уже существующим (см. ссылку выше).
Добавил новый метод - "ArraySort" - сортировка данных в одномерном/двухмерном массиве. С выводом индексов, сортировка возможна практически в любой размерности, если сортировать по первым двум измерениям) + удаление дубликатов.
На порядок быстрее QuickSort на массивах VBA. до 35 раз!
COM упакована в XLL (распаковывается и регистрируется автоматом).
Открываем XLL, пишем код в VBA - пользуемся.

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


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

Все параметры метода, кроме входящего массива - опциональные (с значениями по умолчанию - 0 (ключи-1))
Метод "ArraySort" работает через 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
Sub Test_arr_sort()
'Dim a 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 arr: ReDim arr(5 To testSize) As String
'arr(5) - NULL - проверка для сортировки пустых
arr(6) = 0
arr(7) = "Test_arr_sort"
For i = 8 To testSize
  arr(i) = Format$(Int(Rnd * testSize), "0000000") '30% дубликатов
Next
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp
Debug.Print "Простая сорт. 1х массива, по возрастанию (по умолч.): " & Timer - t & " сек."
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp, 1, , , , , 1, 0, 0
Debug.Print "Простая сорт.по убыванию 1x массива с удалением" & (UBound(arrTmp) / testSize - 1) * 100 & "%: " & Timer - t & " сек."
 
'arrTmp = arr - начальный массив не меняется, поэтому темповый - не нужен
t = Timer
bVBA.ArraySort arr, 1, , , , , , 1, arr_index
Debug.Print "Вывод индексов для 1х массива, сортировка по убыванию:" & Timer - t & " сек."
 
''''''''''''2х массив'''''''''''''''''''''''
ReDim arr(5 To testSize, 2 To 5) As String
'arr(5) - NULL - проверка для сортировки пустых
arr(6, 2) = 0
arr(7, 2) = "Test_arr_sort"
For i = 8 To testSize
    For j = 2 To 5
        arr(i, j) = Format$(Int(Rnd * testSize), "0000000") '30% дубликатов
    Next
Next
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp
Debug.Print "Простая сортировка 2х массива: " & Timer - t & " сек."
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp, 0, 5, , , , 0, 0, 0
Debug.Print "Сортировка 2х массива по 5й строке: " & Timer - t & " сек."
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp, 0, , , , 2, 0, 0, 0
Debug.Print "Сортировка всего 2х массива - вывод строки/столбцы: " & Timer - t & " сек."
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp, 0, 5, , , 3, 0, 0, 0
Debug.Print "Сортировка всего 2х массива - вывод столбцы/строки " & Timer - t & " сек."
 
t = Timer
bVBA.ArraySort arr, 0, 3, , , , , 1, arr_index
Debug.Print "Вывод индексов для 2х массива, по указанному столбцу: " & Timer - t & " сек."
 
t = Timer
bVBA.ArraySort arr, 0, 5, , , , 0, 1, arr_index
Debug.Print "Вывод индексов для 2х массива, по указанноq строке: " & Timer - t & " сек."
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp, 0, 5, 6, 7, 1, 0, 0, 0
Debug.Print "Сортировка 2х массива по 5,6,7й строке: " & Timer - t & " сек."
 
arrTmp = arr
t = Timer
bVBA.ArraySort arrTmp, 0, 3, 4, 5, , 0, 0, 0
Debug.Print "Сортировка 2х массива по 3,4,5му столбцу: " & 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


Метод ArraySort из класса BedvitCOM.VBA:
Простая сорт. 1х массива, по возрастанию (по умолч.): 0,21875 сек.
Простая сорт.по убыванию 1x массива с удалением-34,55365%: 0,3046875 сек.
Вывод индексов для 1х массива, сортировка по убыванию:0,25 сек.
Простая сортировка 2х массива: 0,359375 сек.
Сортировка 2х массива по 5й строке: 0,3515625 сек.
Сортировка всего 2х массива - вывод строки/столбцы: 1,117188 сек.
Сортировка всего 2х массива - вывод столбцы/строки 1,195313 сек.
Вывод индексов для 2х массива, по указанному столбцу: 0,296875 сек.
Вывод индексов для 2х массива, по указанноq строке: 0,2890625 сек.
Сортировка 2х массива по 5,6,7й строке: 0,03125 сек.
Сортировка 2х массива по 3,4,5му столбцу: 0,9609375 сек.
Миниатюры
Нажмите на изображение для увеличения
Название: BedvitCOM_VBA.PNG
Просмотров: 24
Размер:	21.0 Кб
ID:	5116  
Вложения
Тип файла: zip BedvitXLLx32.zip (742.2 Кб, 11 просмотров)
Тип файла: zip BedvitXLLx64.zip (666.9 Кб, 14 просмотров)
Размещено в Без категории
Просмотров 192 Комментарии 1
Всего комментариев 1
Комментарии
  1. Старый комментарий
    Аватар для bedvit
    26/11/2018 - Обновления функционала
    Запись от bedvit размещена 27.11.2018 в 09:08 bedvit вне форума
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru