Enumerables colecciones personalizadas en VBA con características del diccionario como existe -- vba campo con hash-map campo con collections camp codereview Relacionados El problema

Enumerable Custom Collections in VBA with Dictionary features like Exists


11
vote

problema

Español

para recoger o hash

El VBA.Collection tiene una serie de limitaciones, pero es enumerable y puede referirse a los elementos por índice o clave. Pero la implementación de la VBA de una colección está basada en 1, y no tienen ninguna manera de confirmar la membresía, y el método 998877765555443311 devuelve un Variant , por lo que están Linamente escrito. ¿Dije Item MÉTODO ? Sí, eso es correcto, 9988776655544334 es un método. Vamos a hacerlo una propiedad mientras estamos en eso.

Los diccionarios no son enumerables, pero tienen métodos útiles como Exists y RemoveAll . Se implementan como hash-tablas detrás de las escenas, por lo que son más rápidas que las colecciones para recuperar a los miembros y / o para confirmar la membresía.

¿Qué pasaría si pudiera combinar las mejores características de las colecciones y los diccionarios?

  • 0 o 1 basado (usuario configurable)
  • METULO MUJERTO Item MÉTODO
  • Item8 El método es miembro predeterminado, y es una propiedad
  • Exists Método para verificaciones de membresía
  • enumerable
  • Agregue un widget a la colección sin tener que especificar una clave

y por qué no tirar en un método de fábrica, aunque algunos pueden argumentar que es un regreso al año 2000.

Para obtener las enumerables características de una colección, tendré que usar una colección detrás de las escenas, pero aumentaré eso con un diccionario que realiza un seguimiento de las llaves utilizadas en la colección. Luego, cuando quiero probar el método Item06655443310, puedo verificar el diccionario (y obtener toda su bondad de h hash-tabled) en lugar de enumerar la colección o suprimir un error potencial marcando el índice / tecla directamente.

También quiero que la colección esté configurable para que pueda ser 0 o 1 basada según la preferencia. He realizado este ajuste privado a la colección, por lo que depende del desarrollador adaptarse a la mano, pero se podría exponer fácilmente como propiedad o establecerse en un método de fábrica.

Pase el widget

Primero, necesitamos una clase para los objetos que pondremos en nuestra colección personalizada. Un Item1 lo hará muy bien. Nada especial aquí, solo una clase con algunos campos encapsulados, y una propiedad de solo lectura de bonificación para devolver una instancia de sí misma.
  Item2  

Recoge todos los widgets

Entonces necesitamos una clase para mantener todos los widgets. El método todo importante para enumerar la colección es Item3 que tiene un conjunto de atributos especiales <99887766555443314 . La clase también tiene un método de fábrica para crear un widget (sin agregarlo realmente a la colección).

  Item5  

Widget sobre Widget

y poniéndolo para usar:

  Item6  

Salida:

  Item7  

He sacrificado algunas características de la recolección (como poder agregar un widget antes o después de una clave de recolección existente), y no he honrado el comparte de un diccionario, pero estos se agregan fácilmente.

¿He perdido algo? ¿Estoy perdiendo algunos ajustes de rendimiento?

Original en ingles

To Collect or Hash

The VBA.Collection has a number of limitations, but it is enumerable and you can refer to items by index or key. But the VBA implementation of a Collection is 1-based, and they don't have any way of confirming membership, and the Item method returns a Variant, so they're loosely typed. Did I say Item method? Yes, that's right, Item is a method. Let's make it a property while we're at it.

Dictionaries aren't enumerable, but they have useful methods like Exists and RemoveAll. They're implemented as hash-tables behind the scenes, so they're faster than Collections for retrieving members and/or for confirming membership.

What if I could combine the best features of Collections and Dictionaries?

  • 0 or 1 based (user configurable)
  • Strongly typed Item method
  • Item method is default member, and it's a property
  • Exists method for membership checks
  • Enumerable
  • Add a Widget to the collection without having to specify a key

And why not throw in a factory method too, although some might argue it's a return to the year 2000.

In order to get the enumerable features of a Collection, I'll have to use a Collection behind the scenes, but I'll augment that with a Dictionary that keeps track of the keys used in the Collection. Then, when I want to test the Exists method, I can check the Dictionary (and get all of it's hash-tabled goodness) instead of enumerating the Collection or suppressing a potential error by checking the index/key directly.

I also want to make the Collection configurable so that it can be 0 or 1 based according to preference. I've made this setting private to the Collection, so it's up to the developer to adjust for the purpose at hand, but it could easily be exposed as property or set in a factory method.

Pass the Widget

First, we need a class for the objects that we'll put into our custom collection. A Widget will do nicely. Nothing special here - just a class with a few encapsulated fields, and a bonus read-only property for returning an instance of itself.
VERSION 1.0 CLASS BEGIN   MultiUse = -1  'True END Attribute VB_Name = "Widget" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Attribute VB_Description = "The Widget is the core of our business." Option Explicit  Private Type TWidget   ID As String   Name As String   ReleaseDate As Date End Type  Private this As TWidget  Public Property Get ID() As String Attribute ID.VB_Description = "The unique identifier of the Widget"   ID = this.ID End Property  Public Property Let ID(ByVal Value As String)   this.ID = Value End Property  Public Property Get Name() As String Attribute Name.VB_Description = "The name of the Widget"   Name = this.Name End Property  Public Property Let Name(ByVal Value As String)   this.Name = Value End Property  Public Property Get ReleaseDate() As Date Attribute ReleaseDate.VB_Description = "The release date of the Widget"   ReleaseDate = this.ReleaseDate End Property  Public Property Let ReleaseDate(ByVal Value As Date)   this.ReleaseDate = Value End Property  Public Property Get Self() As Widget Attribute Self.VB_Description = "Returns an instance of this Widget"   Set Self = Me End Property 

Collect all the Widgets

Then we need a class to hold all of the widgets. The all important method for enumerating the collection is NewEnum which has a special attribute VB_UserMemId = -4 set. The class also has a factory method for creating a Widget (Without actually adding it to the collection).

VERSION 1.0 CLASS BEGIN   MultiUse = -1  'True END Attribute VB_Name = "Widgets" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Attribute VB_Description = "A custom collection for enumerating Widgets." Option Explicit  Private Enum CollectionBase   Base0 = 0   Base1 = 1 End Enum  Private Const COLLECTION_BASE As Long = CollectionBase.Base0  Private Type TWidgets   Collection As Collection   Keys As Scripting.Dictionary End Type  Private this As TWidgets  Private Sub Class_Initialize()   Set this.Collection = New Collection   Set this.Keys = New Scripting.Dictionary End Sub  Public Function NewEnum() As IUnknown Attribute NewEnum.VB_UserMemId = -4 Attribute NewEnum.VB_Description = "The magic enumerator method with UserMemId = -4."   Set NewEnum = this.Collection.[_NewEnum] End Function  Public Sub Add(ByRef Widget As Widget) Attribute Add.VB_Description = "Adds a widget to the collection."    Dim Key As String   Key = Widget.ID    If Not this.Keys.Exists(Key) Then     this.Collection.Add Widget, Key     this.Keys.Add Key, this.Collection.Count   Else     Err.Raise 457, "Widget.Add", "The key '" & Key & "' is already associated with an element of this collection"   End If  End Sub  Public Function CreateWidget(ByVal ID As String, ByVal Name As String, ByVal ReleaseDate As Date) As Widget Attribute CreateWidget.VB_Description = "A factory method for creating a new Widget."    With New Widget      .ID = ID     .Name = Name     .ReleaseDate = ReleaseDate      Set CreateWidget = .Self    End With  End Function  Property Get Count() As Long Attribute Count.VB_Description = "Returns the number Widgets in the collection."    Count = this.Keys.Count  End Property  Public Function Exists(ByVal ID As String) As Boolean Attribute Exists.VB_Description = "Confirms whether a particular Widget exists in the collection."    Exists = this.Keys.Exists(ID)  End Function  Public Property Get Item(ByVal IDOrIndex As Variant) As Widget Attribute Item.VB_Description = "Default Property. Returns a Widget by ID or Index." Attribute Item.VB_UserMemId = 0    Dim index As Long   If this.Keys.Exists(IDOrIndex) Then     index = this.Keys(IDOrIndex)   Else     If IsLongInteger(IDOrIndex) Then       index = CLng(IDOrIndex) + (1 - COLLECTION_BASE)       If index < 1 Or index > this.Collection.Count Then         Err.Raise 9, "Widgets.Item", "Index " & IDOrIndex & " is out of range. Widgets is " & COLLECTION_BASE & "-based"""         Exit Property       End If     Else       Err.Raise 9, "Widgets.Item", "ID '" & IDOrIndex & "' is out of range."       Exit Property     End If   End If    Set Item = this.Collection.Item(index)  End Property  Public Sub Remove(ByVal IDOrIndex As Variant) Attribute Remove.VB_Description = "Removes a Widget by ID/Key or Index."    Dim oneBasedIndex As Long   Dim Key As String   If this.Keys.Exists(IDOrIndex) Then     Key = IDOrIndex     oneBasedIndex = this.Keys(Key)   Else     If IsLongInteger(IDOrIndex) Then       oneBasedIndex = CLng(IDOrIndex) + (1 - COLLECTION_BASE)       If oneBasedIndex >= 1 And oneBasedIndex <= this.Collection.Count Then         Key = this.Keys.Keys(oneBasedIndex - 1)       Else         Err.Raise 9, "Widgets.Remove", "Index " & IDOrIndex & " is out of range. Widgets is " & COLLECTION_BASE & "-based"       End If     Else         Err.Raise 9, "Widgets.Remove", "Key '" & IDOrIndex & "' is out of range."     End If   End If    this.Collection.Remove oneBasedIndex   this.Keys.Remove Key    Dim Keys As Variant   Keys = this.Keys.Keys    Dim items As Variant   items = this.Keys.items    Dim nextkey As String   Dim nextIndex As Long   'Now decrement the indexes for all subsequent keys   For nextIndex = oneBasedIndex - 1 To this.Keys.Count - 1     nextkey = this.Keys.Keys(nextIndex)     this.Keys.Item(nextkey) = nextIndex + 1     items = this.Keys.items     Keys = this.Keys.Keys   Next nextIndex  End Sub  Public Sub RemoveAll() Attribute RemoveAll.VB_Description = "Removes all Widgets in the collection."   Set this.Collection = New Collection   Set this.Keys = New Scripting.Dictionary End Sub  Public Function Keys() As Variant Attribute Keys.VB_Description = "Returns a Variant array of the Widget IDs in the collection."   Keys = this.Keys.Keys End Function  Private Function IsLongInteger(ByVal Expression As Variant) As Boolean Attribute IsLongInteger.VB_Description = "Private helper to see if a key is a numeric index."    IsLongInteger = False   If IsNumeric(Expression) Then     If CLng(Expression) = Expression Then       IsLongInteger = True       Exit Function     End If   End If  End Function 

Widget upon Widget

And putting it to use:

Sub foo()    Dim coll As Widgets   Dim widg As Widget    Set coll = New Widgets   coll.Add coll.CreateWidget("ABC", "ABC Widget", Now())   coll.Add coll.CreateWidget("BCD", "BCD Widget", Now())   coll.Add coll.CreateWidget("CDE", "CDE Widget", Now())   coll.Add coll.CreateWidget("DEF", "DEF Widget", Now())    'Enumerate the collection   For Each widg In coll     Debug.Print widg.Name   Next    'Check a Widget exists by ID   If coll.Exists("DEF") Then     Debug.Print coll("DEF").ReleaseDate   End If    'Remove by 0-based index   coll.Remove 0    'Remove by Widget ID   coll.Remove "DEF"    'Enumerate the collection   For Each widg In coll     Debug.Print widg.ID   Next  End Sub 

Output:

ABC Widget BCD Widget CDE Widget DEF Widget 23/02/2017 3:10:45 PM  BCD CDE 

I've sacrificed a few features of Collection (like being able to add a Widget before or after an existing collection key), and I haven't honored the CompareMethod of a Dictionary, but these are easily added.

Have I missed anything? Am I missing some performance tweaks?

        
       
       

Lista de respuestas

4
 
vote

Algunos comentarios:

  1. ¿Por qué todo el VB_Description atribuye? Un usuario promedio de su clase estará haciendo todo a través de la VBE, y así no verá a a menos que abra la navegador de objetos. Y para miembros privados como IsLongInteger , ni siquiera es posible.
  2. Mientras estamos viendo IsLongInteger , ¿qué sucede si paso en la cadena "4" ?
  3. ¿Por qué el pImpl , como un enfoque similar al que declara un 99887776655544335 dentro de un Class ?
  4. que exige que la clase miembro tenga una propiedad 9988776655544337 es un olor a código.
  5. ¿Por qué todas las propiedades en Widget mutable?
  6. Exit Property no es necesario después de IsLongInteger0 .
  7. ¿Considerar extraer un método privado para manejar el "ID o índice o índice repetido?" lógica.

Podría volver a mejorar como este.

IsLongInteger1 :

  IsLongInteger2  

IsLongInteger3 :

  IsLongInteger4  
 

Some comments:

  1. Why all the VB_Description attributes? An average user of your class will be doing everything through the VBE, and so won't see those unless she opens Object Browser. Andxc2xa0for private members like IsLongInteger, not even that is possible.
  2. While we're looking at IsLongInteger, what happens if I pass in the string "4"?
  3. Why the pImplxe2x80x93like approach where you declare a Type inside a Class?
  4. Requiring the member class to have a .Self property is a code smell.
  5. Why is every property on Widget mutable?
  6. Exit Property is not needed after Err.Raise.
  7. Consider extracting a private method to handle the repeated xe2x80x9cID or index?xe2x80x9d logic.

I might rexc3xafmplement like this.

Widget.cls:

VERSION 1.0 CLASS BEGIN   MultiUse = -1  'True END Attribute VB_Name = "Widget" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Attribute VB_Description = "The Widget is the core of our business." Option Explicit  Private m_ID As String Private m_Name As String Private m_ReleaseDate As Date  Public Property Get ID() As String Attribute ID.VB_UserMemId = 0     ID = m_ID End Property  Public Property Get Name() As String     Name = m_Name End Property  Public Property Get ReleaseDate() As Date     ReleaseDate = m_ReleaseDate End Property  Public Sub Setup(ID As String, Name As String, ByVal ReleaseDate As Date) ' ID must be a unique identifier     m_ID = ID     m_Name = Name     m_ReleaseDate = ReleaseDate End Sub 

Widgets.cls:

VERSION 1.0 CLASS BEGIN   MultiUse = -1  'True END Attribute VB_Name = "Widgets" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Attribute VB_Description = "A custom collection for enumerating Widgets." Option Explicit  Private Const BASE_INDEX As Long = 0  Private m_coll As Collection Private m_dict As Dictionary  Private Sub Class_Initialize()     Set m_coll = New Collection     Set m_dict = New Dictionary End Sub  Public Property Get Item(IDOrIndex As Variant) As Widget Attribute Item.VB_UserMemId = 0     Set Item = m_coll.Item(GetBase1Index(IDOrIndex)) End Property  Public Sub Add(Widget As Widget)     Dim Key As String     Key = Widget.ID      If Not m_dict.Exists(Key) Then         m_coll.Add Widget, Key         m_dict.Add Key, m_coll.Count     Else         Err.Raise 457, "Widget.Add", "The key '" & Key & "' is already associated with an element of this collection"     End If End Sub  Property Get Count() As Long     Count = m_dict.Count End Property  Public Function CreateWidget(ID As String, Name As String, ByVal ReleaseDate As Date) As Widget     Set CreateWidget = New Widget     CreateWidget.Setup ID, Name, ReleaseDate End Function  Public Function Exists(ID As String) As Boolean     Exists = m_dict.Exists(ID) End Function  Public Function Keys() As Variant     Keys = m_dict.Keys End Function  Public Function NewEnum() As IUnknown Attribute NewEnum.VB_UserMemId = -4     Set NewEnum = m_coll.[_NewEnum] End Function  Public Sub Remove(IDOrIndex As Variant)     Dim Base1Index As Long, ID As String     Base1Index = GetBase1Index(IDOrIndex)     ID = m_coll(Base1Index).ID      m_coll.Remove Base1Index     m_dict.Remove ID      ' now decrement the indexes for all subsequent keys     Dim nextkey As String, NextBase0Index As Long     For NextBase0Index = Base1Index - 1 To m_dict.Count - 1         nextkey = m_dict.Keys(NextBase0Index)         m_dict.Item(nextkey) = NextBase0Index + 1     Next NextBase0Index End Sub  Public Sub RemoveAll()     Set m_coll = New Collection     Set m_dict = New Dictionary End Sub  Private Function GetBase1Index(IDOrIndex As Variant) As Long     If IsLongOrInteger(IDOrIndex) Then         ' numeric index         GetBase1Index = IDOrIndex + 1 - BASE_INDEX     ElseIf m_dict.Exists(IDOrIndex) Then         ' ID code         GetBase1Index = m_dict(IDOrIndex)     Else         Err.Raise 9, "Widgets.Item", "ID '" & IDOrIndex & "' is out of range."     End If      If GetBase1Index < 1 Or GetBase1Index > m_coll.Count Then         Err.Raise 9, "Widget.Item", "Index " & IDOrIndex & " is out of range. Widgets is " & BASE_INDEX & "-based"     End If End Function  Private Function IsLongOrInteger(Expression As Variant) As Boolean     IsLongOrInteger = VarType(Expression) = vbLong Or VarType(Expression) = vbInteger End Function 
 
 
         
         

Relacionados problema

3  Algoritmo de detección de intersección  ( Intersection detection algorithm ) 
Este es un algoritmo de detección de intersección que desarrollé como un método alternativo para el desarrollado para mis cursos. No publicaré algunas de las ...

7  Colecciones vacías en caché  ( Cached empty collections ) 
A menudo necesito devolver las colecciones vacías. Uno de esos días, escribí lo siguiente para devolver una instancia en caché: public static class Array<...

2  Eliminar la lista de archivos de otra lista de archivos por su nombre  ( Remove list of files from another list of files by their name ) 
En Groovy, tengo una lista de archivos A y también otra lista de archivos B. Quiero eliminar todos los archivos de A que tienen un nombre de archivo que tambi...

1  Visualización de datos trazados en orden serpentino  ( Displaying plotted data in serpentine order ) 
Tengo que mostrar un conjunto de: datos en orden serpentina. En un experimento hay replicación, gama y parcela. Las repeticiones contienen una parcela. U...

48  Lista <T> Implementación para VB6 / VBA  ( Listt implementation for vb6 vba ) 
Recientemente, decidí que el 998877665555544330 no fue suficiente para mis necesidades, así que decidí implementar algo como C # 's List<T> . Aquí está la ...

10  Clasificación de una colección  ( Sorting a collection ) 
relacionado con, pero no exactamente un seguimiento de esta pregunta . Después de solucionar algunos problemas descubiertos en la última revisión, agregué un...

11  LinkedHashMap como caché LRU  ( Linkedhashmap as lru cache ) 
Tengo una implementación simple para un caché LRU usando LinkedHashMap . Quiero que sea lo más genérico posible. Esto no es para uso de la producción, s...

3  Generando todos los subconjuntos de un conjunto dado  ( Generating all subsets of a given set ) 
Estoy aprendiendo marco de colecciones Java. ¿Puede alguien mirar este código para generando todos los subconjuntos de un conjunto dado y dígame algún probl...

10  Más imitación de enumerable en VBA  ( More imitation of enumerable in vba ) 
Me inspiró en yo cómo se pregunta para ver qué tan lejos podría impulsar una imitación de . La clase enumerable de la red . Las nuevas funciones pueden ma...

3  Definiendo la transposición en una colección de colecciones irregulares  ( Defining transpose on a collection of irregular collections ) 
Me pidieron que presentara mi solicitud de revisión de código en https: //stackoverflow.com/questions/10672046/defining-transpose-on-a-collection-of-irregula...




© 2022 respuesta.top Reservados todos los derechos. Centro de preguntas y respuestas reservados todos los derechos