Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Замена многомерному массиву Добавлено: 14.01.12 00:17  

Автор вопроса:  Alex | Web-сайт: starsorion.com
Привет , всем!
Как известно изменять размерность в многомерном массиве можно только в последней размерности , а нужно во всех и с сохранением данных...

И собственно вопрос. Замена существует этому делу? Классы с коллекциями не предлагать) Очень медленно(

Ответить

  Ответы Всего ответов: 6  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 14.01.12 02:30
создать массив максимального размера, а реальные границы хранить в переменных

Ответить

Номер ответа: 2
Автор ответа:
 Alex



Вопросов: 11
Ответов: 40
  Web-сайт: starsorion.com
 Профиль | | #2 		Добавлено: 16.01.12 19:50
Благодарю!
Это ,как вариант, я и использую ,но памяти уходит на это...) Вот и хотелось узнать варианты.

Ответить

Номер ответа: 3
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #3 		Добавлено: 16.01.12 21:21
Вообще я когда писал аудиоплеер, то сделал свою замену коллекции. К любому эл-ту можно обращаться по индексу или ключу.
Суть в том, что сначала для повышения скорости я ограничил максимальный размер коллекции 2^15 элементами и все массивы, 3 штуки, сделал макс. размера. На одни массивы уходило 65536*3шт.*4б = 768Кбайт. И еще это умножаем на кол-во открытых плейлистов. Потом наступило прозрение. Изначально массивы - по 1024 эл-та, если когда добавляем 1025ый, то делаем redim preserve до 2048 и так далее. Правда аналогичное уменьшение я не осилил, там сложности с перестроением массива - это не быстрая операция.
В итоге, в не слишком больших плейлистах, до 1024 эл-тов, на массивы тратится в 64 раза меньше памяти, а расширение происходит не часто, поэтому особо не влияет на скорость.
Я думаю в серьезных системах используется что-то подобное. Например http://docs.oracle.com/javase/1.5.0/docs/api/java/lang/StringBuffer.html#capacity()

Вот кстати код, хотя само по себе не заработает:-)
  1. '    Copyright 2009, 2010 Makarov Andrey
  2. '
  3. '    This file is part of Audica - Open Simple Audio Player.
  4. '
  5. '    Audica is free software: you can redistribute it and/or modify
  6. '    it under the terms of the GNU General Public License as published by
  7. '    the Free Software Foundation, either version 3 of the License, or
  8. '    (at your option) any later version.
  9. '
  10. '    Audica is distributed in the hope that it will be useful,
  11. '    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. '    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. '    GNU General Public License for more details.
  14. '
  15. '    You should have received a copy of the GNU General Public License
  16. '    along with Audica.  If not, see <http://www.gnu.org/licenses/>.
  17.  
  18. Option Explicit
  19. Private Const MAX_ITEMS As Long = 65536
  20. Private Const EXP_QUANT As Long = 1024 'how many items are added when expanding
  21. Private UITEM As Long
  22. Private Declare Sub Exchange_ Lib "audicabase.dll" Alias "Exchange" (ByRef tblIdxLookup As Long, ByRef tblKeyLookup As Long, ByVal i As Long, ByVal j As Long)
  23. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
  24. Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal length As Long, ByVal Fill As Byte)
  25. Public Enum efcitemid
  26.     PII_NOITEM = -1
  27.     '... item ids
  28. End Enum
  29. Private tblItems() As Object 'Массив данных
  30. Private tblIdxLookup() As efcitemid 'Массив ключ->индекс
  31. Private tblKeyLookup() As efcitemid 'Массив индекс->ключ
  32. Private lenTblsLookup As Long
  33. Private tblFreeKeys() As efcitemid 'Массив свободных ключей
  34. Private lenFreeKeys As Long
  35. Private m_cust_keys As Boolean 'User wants to set keys manually
  36. Public Enum efcitemidtype
  37.     PIIT_IDX = 0
  38.     PIIT_KEY = 1
  39. End Enum
  40.  
  41. Private Sub Class_Initialize()
  42.     UITEM = -1
  43.     Call expand 'expand space to one EXP_QUANT cells
  44. End Sub
  45.  
  46. 'using dynamic arrays helps to reduce memory usage
  47. Private Sub expand()
  48.     Dim i As Long
  49.     If lenTblsLookup = MAX_ITEMS Then Err.Raise vbObjectError + 1, "FCollection", "No more space"
  50.     If UITEM < MAX_ITEMS - EXP_QUANT Then
  51.         ReDim Preserve tblItems(UITEM + EXP_QUANT) As Object
  52.         ReDim Preserve tblIdxLookup(UITEM + EXP_QUANT) As efcitemid
  53.         ReDim Preserve tblKeyLookup(UITEM + EXP_QUANT) As efcitemid
  54.         ReDim Preserve tblFreeKeys(UITEM + EXP_QUANT) As efcitemid
  55.         Call FillMemory(tblIdxLookup(UITEM + 1), EXP_QUANT * 4, &HFF) 'init with -1
  56.         UITEM = UITEM + EXP_QUANT
  57.         For i = 0 To EXP_QUANT - 1
  58.             tblFreeKeys(lenFreeKeys + i) = UITEM - i
  59.         Next i
  60.         lenFreeKeys = lenFreeKeys + EXP_QUANT
  61.     End If
  62. End Sub
  63.  
  64. 'Adds new item, returns it's key
  65. Public Function Add(obj As Object, Optional ByVal before As Long = -1, Optional ByVal idtype As efcitemidtype = PIIT_KEY, Optional ByVal Key As efcitemid = PII_NOITEM) As efcitemid
  66.     If lenTblsLookup = UITEM + 1 Then Call expand
  67.     If m_cust_keys Then
  68.         '/key/ param is used to set special keys for items, e.g. if FCollection1
  69.         'has subset of items from FCollection2 u may want to have same keys.
  70.         'U must be sured that key is free
  71.         If Key >= 0 And Key <= UITEM Then
  72.             If tblIdxLookup(Key) = PII_NOITEM Then
  73.                 lenFreeKeys = 0
  74.                 tblFreeKeys(0) = Key 'Virtually set current last free key to /Key/
  75.             Else: Err.Raise vbObjectError + 1, "FCollection", "This key is in use - " & Key
  76.             End If
  77.         Else: Err.Raise vbObjectError + 1, "FCollection", "Custom key is out of bounds"
  78.         End If
  79.     Else
  80.         lenFreeKeys = lenFreeKeys - 1
  81.     End If
  82.     If before = -1 Then 'Add
  83.         tblKeyLookup(lenTblsLookup) = tblFreeKeys(lenFreeKeys)
  84.         tblIdxLookup(tblFreeKeys(lenFreeKeys)) = lenTblsLookup
  85.     Else
  86.         'convert key to index (same as keyByIndex(before))
  87.         If idtype = PIIT_KEY Then _
  88.             If before >= 0 And before <= UITEM Then _
  89.                 before = tblIdxLookup(before) Else before = -1
  90.         If before >= 0 And before <= lenTblsLookup - 1 Then
  91.             'Insert
  92.             Dim i As Long
  93.             For i = before To lenTblsLookup - 1
  94.                 tblIdxLookup(tblKeyLookup(i)) = i + 1 '= tblIdxLookup(tblKeyLookup(i)) + 1
  95.             Next i
  96.             CopyMemory tblKeyLookup(before + 1), tblKeyLookup(before), (lenTblsLookup - before) * 4
  97.             tblKeyLookup(before) = tblFreeKeys(lenFreeKeys)
  98.             tblIdxLookup(tblFreeKeys(lenFreeKeys)) = before
  99.         Else: qError "FCollection", "Function Add", "Wrong /before/ param=", before
  100.         End If
  101.     End If
  102.     Set tblItems(tblFreeKeys(lenFreeKeys)) = obj
  103.     lenTblsLookup = lenTblsLookup + 1
  104.     Add = tblFreeKeys(lenFreeKeys) 'return key
  105. End Function
  106.  
  107. ''Update object
  108. 'Public Function Replace(obj As PlayItem, ByVal id As Long, Optional ByVal idtype As eplayitemidtype = PIIT_KEY, Optional ByVal key As eplayitemid = PII_NOITEM)
  109. '    If idtype = PIIT_IDX Then
  110. '        If Not inBounds(id, 0, lenTblsLookup - 1) Then Err.Raise 2, "FCollection", "No such an item=" & id
  111. '        Set tblItems(tblKeyLookup(id)) = obj
  112. '    Else
  113. '        If Not inBounds(id, 0, UITEM) Then Err.Raise 2, "FCollection", "Key is out of bounds"
  114. '        Set tblItems(id) = obj
  115. '    End If
  116. 'End Function
  117.  
  118. 'Delete item by pos or key (deletion from last to first is faster)
  119. Public Sub Remove(ByVal id As Long, Optional ByVal getby As efcitemidtype = PIIT_IDX)
  120.     Dim i As Long, index As Long
  121.     If getby = PIIT_IDX Then
  122.         If Not (id >= 0 And id <= lenTblsLookup - 1) Then Err.Raise 2, "FCollection", "No such an item=" & id
  123.         index = id 'save index
  124.         id = tblKeyLookup(id) 'get key
  125.     Else
  126.         If Not (id >= 0 And id <= UITEM) Then Err.Raise 2, "FCollection", "Key is out of bounds"
  127.         index = tblIdxLookup(id) 'get index
  128.     End If
  129.     If Not m_cust_keys Then
  130.         tblFreeKeys(lenFreeKeys) = id
  131.         lenFreeKeys = lenFreeKeys + 1
  132.     End If
  133.     tblIdxLookup(id) = PII_NOITEM 'index is not associated with key anymore
  134.     'do not free memory, it isn't very expensive today:)
  135. '    Set tblItems(id) = Nothing
  136.     If index < lenTblsLookup - 1 Then 'not last index
  137.         For i = index + 1 To lenTblsLookup - 1
  138.             tblIdxLookup(tblKeyLookup(i)) = i - 1 'tblIdxLookup(tblKeyLookup(i)) - 1
  139.         Next i
  140.         CopyMemory tblKeyLookup(index), tblKeyLookup(index + 1), (lenTblsLookup - (index + 1)) * 4
  141.     End If
  142.     lenTblsLookup = lenTblsLookup - 1
  143. End Sub
  144.  
  145. 'Public Sub RemoveBunch(ByRef idxs() As eplayitemid)
  146. '    Dim i As Long, C As Long, index As Long, key As Long
  147. '    For C = uubound(idxs) To 0 Step -1
  148. '        index = idxs(C)
  149. '        If Not (index >= 0 And index <= lenTblsLookup - 1) Then Err.Raise 2, "FCollection", "No such an item=" & index
  150. '        key = tblKeyLookup(index) 'get key
  151. '        If Not m_cust_keys Then
  152. '            tblFreeKeys(lenFreeKeys) = key
  153. '            lenFreeKeys = lenFreeKeys + 1
  154. '        End If
  155. '        tblIdxLookup(key) = PII_NOITEM 'index is not associated with key anymore
  156. '        'do not free memory, it isn't very expensive today:)
  157. ''        Set tblItems(key) = Nothing
  158. '        If index < lenTblsLookup - 1 Then 'not last index
  159. '            For i = index + 1 To lenTblsLookup - 1
  160. '                tblIdxLookup(tblKeyLookup(i)) = i - 1 'tblIdxLookup(tblKeyLookup(i)) - 1
  161. '            Next i
  162. '            CopyMemory tblKeyLookup(index), tblKeyLookup(index + 1), (lenTblsLookup - (index + 1)) * 4
  163. '        End If
  164. '        lenTblsLookup = lenTblsLookup - 1
  165. '    Next C
  166. 'End Sub
  167.  
  168. Public Property Get item(ByVal id As Long, Optional ByVal getby As efcitemidtype = PIIT_IDX) As Object
  169. On Error GoTo 1:
  170.     If getby = PIIT_IDX Then Set item = tblItems(tblKeyLookup(id)) _
  171.     Else Set item = tblItems(id)
  172. Exit Property
  173. 1: qError "FCollection", "Get item", "No such an item, id=", id, "getby=", getby
  174. End Property
  175.  
  176. Public Property Get keyByIndex(ByVal index As Long) As efcitemid
  177.     If index >= 0 And index <= lenTblsLookup - 1 Then _
  178.         keyByIndex = tblKeyLookup(index) _
  179.     Else keyByIndex = -1
  180. End Property
  181.  
  182. Public Property Get indexByKey(ByVal Key As Long) As efcitemid
  183.     If Key >= 0 And Key <= UITEM Then _
  184.         indexByKey = tblIdxLookup(Key) _
  185.     Else indexByKey = -1
  186. End Property
  187.  
  188. Public Property Get Count() As Long
  189.     Count = lenTblsLookup
  190. End Property
  191.  
  192. Public Property Get hBound() As Long
  193.     hBound = lenTblsLookup - 1
  194. End Property
  195.  
  196. Public Sub Exchange(ByVal i As Long, ByVal j As Long)
  197.     Exchange_ tblIdxLookup(0), tblKeyLookup(0), i, j
  198. 'MOVED TO AUDICABASE PROJECT
  199. '    Dim temp As Long
  200. '    temp = tblKeyLookup(i)
  201. '    tblIdxLookup(temp) = j
  202. '    tblIdxLookup(tblKeyLookup(j)) = i
  203. '    tblKeyLookup(i) = tblKeyLookup(j)
  204. '    tblKeyLookup(j) = temp
  205. End Sub
  206.  
  207. Public Sub Sort(ByVal key1 As Long, ByVal key2 As Long)
  208.     Dim i As Long, index1 As Long, index2 As Long
  209.     If key1 >= 0 And key1 <= UITEM Then index1 = tblIdxLookup(key1) Else index1 = -1 'indexByKey(key1)
  210.     If key2 >= 0 And key2 <= UITEM Then index2 = tblIdxLookup(key2) Else index2 = -1 'indexByKey(key1)
  211.     If (index1 >= 0 And index1 <= lenTblsLookup - 1) And _
  212.     (index2 >= 0 And index2 <= lenTblsLookup - 1) And index1 <> index2 Then
  213.         If index1 > index2 Then
  214.             For i = index2 To index1 - 1
  215.                 tblIdxLookup(tblKeyLookup(i)) = i + 1 'tblIdxLookup(tblKeyLookup(i)) + 1
  216.             Next i
  217.             i = tblKeyLookup(index1)
  218.             tblIdxLookup(i) = index2
  219.             CopyMemory tblKeyLookup(index2 + 1), tblKeyLookup(index2), (index1 - index2) * 4
  220.             tblKeyLookup(index2) = i
  221.         Else
  222.             For i = index1 + 1 To index2
  223.                 tblIdxLookup(tblKeyLookup(i)) = i - 1 'tblIdxLookup(tblKeyLookup(i)) - 1
  224.             Next i
  225.             i = tblKeyLookup(index1)
  226.             tblIdxLookup(i) = index2
  227.             CopyMemory tblKeyLookup(index1), tblKeyLookup(index1 + 1), (index2 - index1) * 4
  228.             tblKeyLookup(index2) = i
  229.         End If
  230.     Else
  231.         con.WriteLine "Wrong item ids to sort: {0} and {1}", d_ERROR, index1, index2
  232.     End If
  233. End Sub
  234.  
  235. 'Turn on/off custom keys
  236. 'You must use /Key/ param in /Add/ func; must be sure that all keys are unique
  237. Public Property Let CustomKeys(ByVal bool As Boolean)
  238.     Dim i As Long, tmpdic As New Dictionary, used As Long
  239.     m_cust_keys = bool
  240.     If Not bool Then
  241.         For i = 0 To lenTblsLookup - 1 'build dictionary of used keys
  242.             tmpdic.Add tblKeyLookup(i), Nothing
  243.         Next i
  244.         lenFreeKeys = 0
  245.         For i = UITEM To 0 Step -1
  246.             If Not tmpdic.Exists(i) Then
  247.                 tblFreeKeys(lenFreeKeys) = UITEM
  248.                 lenFreeKeys = lenFreeKeys + 1
  249.             Else
  250.                 used = used + 1
  251.             End If
  252.         Next i
  253. '        Debug.Print "used", used, lenFreeKeys, lenTblsLookup
  254.     End If
  255. End Property
  256.  
  257. Public Property Get CustomKeys() As Boolean
  258.     CustomKeys = m_cust_keys
  259. End Property
  260.  
  261. Public Function GetKeys() As efcitemid()
  262.     If lenTblsLookup Then 'not empty
  263.         ReDim tmp(lenTblsLookup - 1) As Long
  264.         CopyMemory tmp(0), tblKeyLookup(0), lenTblsLookup * 4
  265.         GetKeys = tmp
  266.     End If
  267. End Function
  268.  
  269. Private Function UUBound(ByRef arr() As efcitemid) As efcitemid
  270. On Error GoTo 1:
  271.     UUBound = UBound(arr)
  272. Exit Function
  273. 1:  UUBound = PII_NOITEM
  274. End Function
  275.  
  276. Public Property Get Capacity() As Long
  277.     Capacity = UITEM + 1
  278. End Property
  279.  
  280. 'Expand internal arrays for /newcap/ elements.
  281. 'Can be useful when using custom keys, e.g. filtering - new list
  282. 'should have same capacity, so keys from old list are all available
  283. Public Property Let Capacity(ByVal newcap As Long)
  284.     Dim i As Long
  285.     If newcap >= Capacity And newcap <= MAX_ITEMS Then
  286.         For i = ceil(Capacity / EXP_QUANT) + 1 To _
  287.                 ceil(newcap / EXP_QUANT)
  288.             Call expand
  289.         Next i
  290.     Else: qError "FCollection", "Let Capacity", "Cannot decrease capacity or exceed MAX_ITEMS"
  291.     End If
  292. End Property
  293.  
  294. Private Function ceil(ByRef pval As Double) As Long
  295.     ceil = -Int(-pval)
  296. End Function
  297.  
  298. 'Find first occurence of /object/ in collection
  299. 'Returns -1 if no item matched.
  300. Public Function indexOf(ByRef value As Object) As efcitemid
  301.     Dim i As Long
  302.     indexOf = PII_NOITEM
  303.     For i = 0 To hBound
  304.         If tblItems(i) Is value Then
  305.             indexOf = i
  306.             Exit Function
  307.         End If
  308.     Next i
  309. End Function

Ответить

Номер ответа: 4
Автор ответа:
 Alex



Вопросов: 11
Ответов: 40
  Web-сайт: starsorion.com
 Профиль | | #4 		Добавлено: 21.01.12 20:44
Сенкс!
В коде я не стал разбираться...( Но на первый взгляд используются одномерные массивы ( даже в случае , что они связаны), а мне это неприемлемо. У меня предполагается около 35-40 индексов многомерного массива (т.е. это 35-40 одномерных , но мне нужны многомерные (3х размерные)) Т.е. умножаем ещё на 3... Это я умотаюсь их объявлять)) Неприемлемо!

Ответить

Номер ответа: 5
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
  Профиль | | #5 Добавлено: 22.01.12 03:17
Делай как в дотнете - создается новый массив нужного размера, в него копируются данные из старого

Ответить

Номер ответа: 6
Автор ответа:
 Alex



Вопросов: 11
Ответов: 40
  Web-сайт: starsorion.com
 Профиль | | #6 		Добавлено: 22.01.12 23:53
Над этим можно подумать... Поэкспериментирую и потестирую. Сравню скорости и возможности)

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам