Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
задача со звездочкой - vba работа с памятью
 
#1
12.11.2010 14:11:34
задача: вернуть числовой код, уникальный для любого  3х-буквенного сочетания(точнее от 1 до 3х букв)  
 
мое первоначальное решение:  
 
Function getncomb(sr$) As Long  
getncomb = CLng(Asc(Mid(LCase(sr), 1, 1)) - 223) * 10000  
If Len(sr) > 1 Then  
   getncomb = getncomb + (Asc(Mid(LCase(sr), 2, 1)) - 223) * 100  
   If Len(sr) > 2 Then getncomb = getncomb + Asc(Mid(LCase(sr), 3, 1)) - 223  
End If  
End Function  
 
 
вот текущее решение - работает в 4 раза быстрее:  
Private Declare Sub GetMem8 Lib "msvbvm60.dll" (ByVal SrcPointer As Long, ByVal DstPointer As Long)  
Function getncomb(sr$) As Long  
Dim  r(0 To 99) As Integer  
Call GetMem8(StrPtr(sr), VarPtr(r(0)))  
getncomb = r(0) - 1071  
If Len(sr) > 1 Then  
   getncomb = getncomb + (r(1) - 1071) * 33  
   If Len(sr) > 2 Then getncomb = getncomb + (r(2) - 1071) * 1089  
End If  
End Function  
 
 
собственно вопрос - будет ли быстрее, если не переписывать память(в данном случае нужно всего лишь 6 байт, но приходится брать 8), а подменить указатели, чтобы массив r ссылался на данные строки sr  ?
Живи и дай жить..
 
 
 
#2
13.11.2010 08:22:48
Доброе утро, Слэн!  
Вот так у меня в раза 2.5 ускорилось:  
 
Dim r(0 To 5) As Integer  
 
Function TxtCode1(s$) As Long  
 GetMem8 StrPtr(s), VarPtr(r(0))  
 TxtCode1 = r(0)  
 If Len(s) > 1 Then  
   TxtCode1 = TxtCode1 + r(1) * 255&  
   If Len(s) > 2 Then TxtCode1 = TxtCode1 + r(2) * 65025  
 End If  
End Function  
 
Операция с памятью здесь на 1-й взгляд выглядит рискованно, но на 2-й вроде всё корректно. При тестировании глюков не обнаружил.
 
 
 
#3
13.11.2010 09:54:30
Привет ZVI!  
 
спасибо за отклик. На вас и надеялся(ну мож и кому еще интересно)  
 
еще раз убедился, что обстоятельность эффективна :)  
 
я в общем-то получал результаты по скорости того же порядка, но использовал код не оформленный функцией. Соответственно dim оставался за кадром.  
корректность операции с памятью, конечно, под вопросом, но с другой стороны мы же не обращаемся к байтам, выходящим за пределы строки?  
 
расстановка везде, где можно нужных типов данных тоже дает прирост, хотя и небольшой.. :)  
 
а вот на избавление от операции вычитания я пойтить не могу :) - в дальнейшем этот код будет индексом массива и так "разбазаривать" память все же не пойдет.  
 
Но я это не озвучил в топике, как и то , что буквы будут только русские и уже в нижнем регистре - приношу извинения.  
 
как все таки насчет подмены?  создаем массив r()(статический, как уже понятно),  
переписываем его указатель на данные, чтобы указывал на строку..  
 
все же это всего 4 байта, а не 8..  ?  правда потом возникает вопрос освобождения памяти.. :)  что скажете? не связываться?  
 
у вас же
Живи и дай жить..
 
 
 
#4
13.11.2010 09:59:07
да к тому же если строка тоже статическая( а это так и есть :)), то эта операция вообще выпадает из цикла..
Живи и дай жить..
 
 
 
#5
13.11.2010 12:19:14
Может, так?  
 
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ByVal SrcPointer As Long, ByVal DstPointer As Long)  
Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByVal SrcPointer As Long, ByVal DstPointer As Long)  
 
Function String2Index(s As String) As Long  
GetMem4 StrPtr(s), VarPtr(String2Index)  
If Len(s) > 2 Then GetMem1 StrPtr(s) + 4, VarPtr(String2Index) + 1  
End Function  
 
Каждый символ строки занимает 2 байта. Второй байт для всех русских букв равен 4.  
Сначала кладем в переменную 4 байта (2 символа). Если строка длиннее, кладем первый байт 3-го символа во 2-й байт переменной (где было 4).
 
 
 
#6
13.11.2010 13:48:55
щас сравним, спасибо
Живи и дай жить..
 
 
 
#7
13.11.2010 14:16:28
быстро, да..  
 
но разброс значений..  
 
покумекаем. спасибо за идею
Живи и дай жить..
 
 
 
#8
13.11.2010 14:30:53
А че разброс? Ты сам захотел результат как Long.  
На самом деле, вариантов всего 34*34*34 = 39304 (34 = 33 буквы + отсутствие буквы), можно и в Integer запихать. Но это будет, очевидно, медленнее. Так что либо скорость, либо компактность данных.  
Для уменьшения разброса можно три первых байта подряд положить.
 
 
 
#9
13.11.2010 18:10:23
Написал упаковку в Int. Вот исходный вариант  
 
Function String2Int1(s As String) As Integer  
Dim b() As Byte, L As Long  
b = s  
L = b(0) - 48  'а->0, ё->33  
If UBound(b) > 2 Then L = L + (b(2) - 47) * 34  'нет симв->0, а->1, ё->34  
If UBound(b) > 4 Then L = L + (b(4) - 47) * 1156&    '34*34  
String2Int1 = L - 10000  
End Function  
 
А вот максимально оптимизированный, работает на 6% быстрее  
 
Function String2Int(s As String) As Integer  
Dim b() As Byte  
b = s  
If UBound(b) > 4& Then  
   String2Int = b(0&) + b(2&) * 34& + b(4&) * 1156& - 65978   '34*34  
ElseIf UBound(b) > 2& Then  
   String2Int = b(0&) + b(2&) * 34& - 11646&  
Else  
   String2Int = b(0&) - 10048&  'а->0, ё->33  
End If  
End Function  
 
Интересно, что если сделать  
...  
Dim ub&  
ub=ubound(b)  
if ub...  
 
то становится медленнее!
 
 
 
#10
15.11.2010 10:31:39
нет. это в три раза медленнее, чем это:  
 
 
Dim rcomb(0 To 3) As Integer, sr$, ncomb&  
Function getncomb3() As Long  
Call GetMem8(StrPtr(sr), VarPtr(rcomb(0)))  
ncomb = rcomb(0) - 1071  
If Len(sr) > 1 Then  
ncomb = ncomb + (rcomb(1) - 1071&) * 33&  
If Len(sr) > 2 Then ncomb = ncomb + (rcomb(2) - 1071&) * 1089&  
End If  
End Function  
 
 
если убрать dim из функции( как указал ZVI), то становится не в три, а в два раза медленнее.  
 
сама идея выбросить промежуточный массив мне понравилась - сам не допер.  
надо только найти компромисс.    
 
буква ё не участвует :), так что все таки 33( с 224 по 255   и отсутствие)  
 
разброс в принципе не так уж важен, лишь бы можно было работать.  
 
задумка такова:  
 
берется словарь, каждое слово разбивается на сочетания букв, например:  
 
абажур - а, аб, аба,баж,ажу,жур, ур, р  
 
каждому сочетанию ставится в соответствие индекс( уникальный и повторяемый)  
 
далее инициируется индексный массив  такой, что arr(индекс) будет указывать на массив строк, содержащий соответствующие слова(включающие сочетание, сопоставленное индексу)..  
 
соответственно разброс - это напрямую размерность индексного массива..
Живи и дай жить..
 
 
 
#11
15.11.2010 16:33:22
вот так получается совсем чуть медленнее чем у Казанского в первом варианте, с меньшим разбросом:  
Private Type SAFEARRAYBOUND  
 cElements As Long    'Количество элементов в размерности  
 lLBound As Long      'Нижняя граница размерности  
End Type  
Private Type SAFEARRAY  
 cDims As Integer     'Число размерностей  
 fFeatures As Integer 'Флаг, юзается функциями SafeArray  
 cbElements As Long   'Размер одного элемента в байтах  
 cLocks As Long       'Сколько раз массив был locked, но пока не unlocked.  
 pvData As Long              'Указатель на данные.  
 rgsabound As SAFEARRAYBOUND 'Повторяется для каждой размерности.  
End Type  
Dim rcomb(0 To 9) As Long, sr$, ncomb&, sa1 As SAFEARRAY, rcomb_b(0 To 5) As Byte  
 
Sub ttt()  
Dim i&, s$, ls&, j&, p_rcomb&, p_safe&  
sr = "атф"  
GetMem4 VarPtrArray(rcomb_b()), VarPtr(p_safe)  
GetMem4 p_safe + 12, VarPtr(p_rcomb)  
PutMem4 p_safe + 12, StrPtr(sr)  
 
t = Timer  
For i = 1 To 999999  
 
Call getncomb6  
 
Next  
Debug.Print Timer - t  
End  
PutMem4 p_safe, p_rcomb  
End Sub  
 
Function getncomb6() As Long  
If Len(sr) > 2& Then CopyMemory ncomb, rcomb_b(2), 3  
GetMem1 VarPtr(rcomb_b(0)), VarPtr(ncomb) + 1&  
End Function
Живи и дай жить..
 
 
 
#12
16.11.2010 10:44:57
остановился на этом варианте:  
 
Function getncomb8() As Long  
getncomb8 = rcomb_b(0) - 47  
If Len(sr) > 1& Then getncomb8 = getncomb8 + rcomb_b(2) * 33&  
If Len(sr) > 2& Then getncomb8 = getncomb8 + rcomb_b(4) * 1089&  
End Function  
sr - глобальная  строковая переменная  
rcomb_b - глобальный байтовый массив    
sr и rcomb_b ссылаются на один участок памяти - так что это разное прочтение одних и тех же данных.  
 
 
а вот кто мне объяснит, почему вот так работает медленнее?  
Function getncomb8() As Long  
getncomb8 = rcomb_b(0) '- 47  
If Len(sr) > 1& Then getncomb8 = getncomb8 + rcomb_b(2) * 33&  
If Len(sr) > 2& Then getncomb8 = getncomb8 + rcomb_b(4) * 1089&  
End Function  
 
и вот так работает медленнее:  
Function getncomb8() As Long  
getncomb8 = rcomb_b(0) - 47&  
If Len(sr) > 1& Then getncomb8 = getncomb8 + rcomb_b(2) * 33&  
If Len(sr) > 2& Then getncomb8 = getncomb8 + rcomb_b(4) * 1089&  
End Function
Живи и дай жить..
 
 
 
#13
17.11.2010 11:46:00
up
Живи и дай жить..
 
 
 
#14
18.11.2010 08:53:39
Извиняюсь, был весь в работе :-)  
 
Для случайно заглянувших в тему на всякий случай отпишу, что методы прямой работы с памятью рискованны – можно нарваться на Exceptions и подвесить Excel, а предлагаемые рекомендации уместны для рассматриваемой в теме ну очень быстрой обработки. Для  обычного кодирования это явно избыточно.  
 
1.  Затраты времени.  
 
getncomb8 = rcomb_b(0)  у меня работает не медленнее, чем getncomb8 = rcomb_b(0) - 47 что и ожидалось теоретически.  
 
Поэтому прокомментирую лишь getncomb8 = rcomb_b(0) - 47  
 
1.1 На время работы функции временная переменная со значение 47 каждый раз создается заново, имеет тип Integer и занимает 2 Байта. Если записать 47&, то это уже будет 4 байта и тип Long.  
 
Для 2-байтной переменной типа Integer общее время создания/уничтожения немного быстрее, чем для 4 байтной Long-типа.  
 
1.2 Переменная rcomb_b(0) - однобайтная и имеет тип Byte.  
При вычитании Byte - Long  переменная Byte преобразуется в еще одну 4-х байтную временную переменную типа Long, так как переменные должны быть однотипные, на это тоже нужно время.    
 
А при вычитании Byte - Integer переменная Byte преобразуется в 2-байтную Integer, что быстрее, чем Byte – Long. Но с другой стороны процессоры компьютеров  давно оптимизированы для математических операций с Long, а не с Integer. Современные компьютеры вообще оптимизированы для операций с типом Double.  
 
2. Рекомендации    
 
Для исключения доп. затрат времени на создание временных переменных/констант имеет смысл объявить все необходимые константы вне функции – в модуле.    
 
В математических операциях желательно применять однотипные данные.  
 
Для разнотипных данных все зависит от того, что отнимает больше времени – выравнивание типов с созданием временных переменных, или разница во времени вычисления  для разных типов величин в зависимости от оптимизации процессора. Здесь придется поэкспериментировать.  
 
3. Тестирование  
Слэн, в Вашем тесте времени строки с GetMem4 и PutMem4 почему-то вне цикла, наверное, сравнивать с другими вариантами тоже имеет смысл по аналогии.  
 
4. Другие варианты  
Можно было бы ещё поэкспериментровать с написанием С-ной DLL или TLB, возможно это даст небольшой выигрыш.  
 
Ниже привожу вариант с одним вызовам API, для чистоты эксперимента оставил этот вызов в функции. А то, что прихватываются возможно лишние байты за коротким текстом - не имеет значения. Генерируемые числа для текста с символами от "а" до "яяя" не имеют дыр, т.е диапазон чисел непрерывный.  
 
Private Declare Sub GetMem8 Lib "msvbvm60.dll" (ByVal SrcPointer&, ByVal DstPointer&)  
 
Const L1 = 1&, L2 = 2&, L32 = 32&, i47% = 47, B47 As Byte = 47, L47 = 47&, L1024 = 1024&  
Dim r(0 To 7) As Byte  
 
Function TxtCode2(Txt$) As Long  
 GetMem8 StrPtr(Txt), VarPtr(r(0))  
 TxtCode2 = r(0) - i47  
 If Len(Txt) > L1 Then  
   TxtCode2 = TxtCode2 + (r(2) - B47) * L32  
   If Len(Txt) > L2 Then TxtCode2 = TxtCode2 + (r(4) - B47) * L1024  
 End If  
End Function  
 
Private Sub Test_TxtCode2()  
 Debug.Print TxtCode2("вот")  
End Sub  
 
Private Sub SpeedTest_TxtCode2()  
 Const N& = 5000000  
 Dim t!, i&, Txt$  
 Txt = "где"  
 t = Timer  
 For i = 1 To N  
   Call TxtCode2(Txt)  
 Next  
 t = Timer - t  
 Debug.Print Round(t, 3) & " s", Format(N / t, "# ### ###") & " oper/s", Format(Len(Txt) * N / t, "# ### ###") & " char/s"  
End Sub
 
 
 
#15
18.11.2010 09:04:45
Для универсальности не стал это приводить в коде, но VarPtr(r(0)) тоже имеет смысл вынести из функции в Long-переменную модуля и вычислять её один раз в начале.
 
 
 
#16
18.11.2010 09:23:30
По аналогии с приведеным вариантом можно в SafeArray.pvData переписать Long-адрес StrPtr(Txt).  
Это должно быть ещё бысрее, так как в GetMem4/PutMem4 почти в полтора раза меньше инструкций, чем в GetMem8/PutMem8
 
 
 
#17
18.11.2010 09:56:36
getmem/putmem вне функции  - это и была попытка переписать pvdata один раз при инициализации проекта.  
 
но что-то тут у меня не срослось - данные в массиве с переписанным указателем прыгают.. при переключении страниц памяти что ли.. не хватает знаний..  
 
а переписывать указатель при каждом вызове функции - шило на мыло при таком объеме массива.  
 
спасибо ZVI! буду разбираться понемногу.
Живи и дай жить..
 
 
 
#18
18.11.2010 09:58:58
тут попробовал сравнить:  
ваше  
Function TxtCode2() As Long  
GetMem8 StrPtr(scomb), VarPtr(rcomb_b(0))  
TxtCode2 = rcomb_b(0) - i47  
If Len(scomb) > L1 Then  
TxtCode2 = TxtCode2 + (rcomb_b(2) - B47) * L32  
If Len(scomb) > L2 Then TxtCode2 = TxtCode2 + (rcomb_b(4) - B47) * L1024  
End If  
End Function  
и мое  
Function getncomb8() As Long  
getncomb8 = rcomb_b(0) - 47&  
If Len(scomb) > 1& Then getncomb8 = getncomb8 + rcomb_b(2) * 33&  
If Len(scomb) > 2& Then getncomb8 = getncomb8 + rcomb_b(4) * 1089&  
End Function  
 
 
так мое почти в два раза быстрее..  ?
Живи и дай жить..
 
 
 
#19
18.11.2010 10:07:42
прошу прощения..не с этим надо сравнивать  :)  
 
это как раз с переписанным pvdata
Живи и дай жить..
 
 
 
#20
18.11.2010 10:12:06
вот с этим надо сравнивать:  
 
 
Function getncomb() As Long  
Call GetMem8(StrPtr(scomb), VarPtr(rcomb_b(0&)))  
getncomb = rcomb_b(0&) - 47  
If Len(scomb) > 1& Then getncomb = getncomb + (rcomb_b(2&) - 47&) * 33&  
If Len(scomb) > 2& Then getncomb = getncomb + (rcomb_b(4&) - 47&) * 1089&  
End Function  
 
 
тут примерный паритет.. по минимальным результатам мое процента на 2 быстрее..
Живи и дай жить..
 
 
 
Страницы: 1
Наверх