这是我目前使用位的实现:
Function Array_PowerSet(Self)
Array_PowerSet = Array()
PowerSetUpperBound = -1
For Combination = 1 To 2 ^ (UBound(Self) - LBound(Self)) ' I don't want the null set
Subset = Array()
SubsetUpperBound = -1
For NthBit = 0 To Int(WorksheetFunction.Log(Combination, 2))
If Combination And 2 ^ NthBit Then
SubsetUpperBound = SubsetUpperBound + 1
ReDim Preserve Self(0 To SubsetUpperBound)
Subset(SubsetUpperBound) = Self(NthBit)
End If
Next
PowerSetUpperBound = PowerSetUpperBound + 1
ReDim Preserve Array_PowerSet(0 To PowerSetUpperBound)
Array_PowerSet(PowerSetUpperBound) = Subset
Next
End Function
请忽略滥用变种。 Array_Push
和Array_Size
应该是不言自明的。
以前,我为每个组合生成一个二进制字符串,但这涉及调用另一个效率不高的函数。
除了使用较少的Variants并在内部移动外部函数调用之外,有什么办法可以让它更高效吗?
编辑:这是一个完全独立的版本。Function Array_PowerSet(Self As Variant) As Variant
Dim PowerSet() As Variant, PowerSetIndex As Long, Size As Long, Combination As Long, NthBit As Long
PowerSetIndex = -1: Size = UBound(Self) - LBound(Self) + 1
ReDim PowerSet(0 To 2 ^ Size - 2) ' Don't want null set
For Combination = 1 To 2 ^ Size - 1
Dim Subset() As Variant, SubsetIndex As Long: SubsetIndex = -1
For NthBit = 0 To Int(WorksheetFunction.Log(Combination, 2))
If Combination And 2 ^ NthBit Then
SubsetIndex = SubsetIndex + 1
ReDim Preserve Subset(0 To SubsetIndex)
Subset(SubsetIndex) = Self(NthBit)
End If
Next
PowerSetIndex = PowerSetIndex + 1
PowerSet(PowerSetIndex) = Subset
Next
Array_PowerSet = PowerSet
End Function
测试:
Dim Input_() As Variant, Output_() As Variant, Subset As Variant, Value As Variant
Input_ = Array(1, 2, 3)
Output_ = Array_PowerSet(Input_)
For Each Subset In Output_
Dim StringRep As String: StringRep = "{"
For Each Value In Subset
StringRep = StringRep & Value & ", "
Next
Debug.Print Left$(StringRep, Len(StringRep) - 2) & "}"
Next
答案 0 :(得分:3)
由于子集的数量呈指数增长,所以没有算法真正有效,尽管你正在做的事情还有改进的余地:
var commonProps = typeof(CommonProperty).GetProperties(BindingFlags.Static | BindingFlags.Public);
var itemProps = list.GetType().GenericTypeArguments[0].GetProperties().ToDictionary(k => k.Name, v => v);
var result = list.Select(l => commonProps.ToDictionary(
k => k.GetValue(null),
v => itemProps[v.Name].GetValue(l)
));
,当用于通过单个项目扩展数组时,效率很低,因为它涉及创建一个具有1个以上空间的新数组,然后将旧元素复制到新数组。最好预先分配足够的空间,然后将其缩小到大小:
ReDim Preserve
测试功能:
Function PowerSet(Items As Variant) As Variant
'assumes that Items is a 0-based array
'returns a 0-based jagged array of subsets of Items
'where each subset is a 0-based array
Dim PS As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim subset As Variant
n = 1 + UBound(Items) 'cardinality of the base set
ReDim PS(0 To 2 ^ n - 2)
For i = 1 To 2 ^ n - 1
subset = Array()
ReDim subset(0 To n - 1)
k = -1 'will be highest used index of the subset
For j = 0 To n - 1
If i And 2 ^ j Then
k = k + 1
subset(k) = Items(j)
End If
Next j
ReDim Preserve subset(0 To k)
PS(i - 1) = subset
Next i
PowerSet = PS
End Function
答案 1 :(得分:2)
使用集合来构建集合是一种选择......
Function Generator()
Dim Arr() As Variant: Arr = Array(1, 2, 3, 4)
Dim PSCol As Collection: Set PSCol = PowerSetCol(Arr)
Dim SubSet As Collection, SubSetStr As String
For i = 1 To PSCol.Count
Set SubSet = PSCol.Item(i)
SubSetStr = "{"
For j = 1 To SubSet.Count
SubSetStr = SubSetStr & SubSet.Item(j) & IIf(j = SubSet.Count, "", ", ")
Next j
SubSetStr = SubSetStr & "}"
Debug.Print SubSetStr
Next i
End Function
Function PowerSetCol(Arr As Variant) As Collection
Dim n As Long, i As Long
Dim Temp As New Collection, SubSet As Collection
For i = 1 To 2 ^ (UBound(Arr) + 1) - 1
Set SubSet = New Collection
For n = 0 To UBound(Arr)
If i And 2 ^ n Then SubSet.Add Arr(n)
Next n
Temp.Add SubSet
Next i
Set PowerSetCol = Temp
End Function
*******编辑********
显然通过索引访问集合比枚举项目更加密集。也;您不能像@John Coleman所说的那样直接使用加入,但可以在其中使用单行函数。
希望以下代码是更优化的解决方案
Function Generator()
Dim Arr() As Variant: Arr = Array(1, 2, 3, 4)
Dim PSColl As Collection: Set PSColl = PowerSetColl(Arr)
Dim Str As String, Coll As Collection, Item As Variant
For Each Coll In PSColl
Str = ""
For Each Item In Coll
Str = strJoin(", ", Str, CStr(Item))
Next Item
Debug.Print "{" & Str & "}"
Next Coll
End Function
Function PowerSetColl(Arr As Variant) As Collection
Dim Temp As New Collection, SubSet As Collection
Dim n As Long, i As Long
For i = 1 To 2 ^ (UBound(Arr) + 1) - 1
Set SubSet = New Collection
For n = 0 To UBound(Arr)
If i And 2 ^ n Then SubSet.Add Arr(n)
Next n
Temp.Add SubSet
Next i
Set PowerSetColl = Temp
End Function
Function strJoin(Delimiter As String, Optional Str1 As String, Optional Str2 As String) As String
strJoin = IIf(IsMissing(Str1) Or Str1 = "", Str2, IIf(IsMissing(Str2) Or Str2 = "", Str1, Str1 & Delimiter & Str2))
End Function