Solved

# Powerset of an array of single character elements

Posted on 2003-03-03
Medium Priority
453 Views
I have an array of single character elements in each 'cell'. This array is S(). S(1) = a, S(2) = d ....

How can I find the powerset of array S?
A recursive method would be preferred.
0
Question by:clifflui
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 8
• 7
• 4
• +1

LVL 5

Expert Comment

ID: 8056344
Sorry, my english is not good enough to understand: explain better waht you're looking for (powerset of a single value in cell array?)...
0

Author Comment

ID: 8056477
OK, thanks, now more clearly:

S is a simple array of single character strings.
Array S = (a,b,c,d) or more like this: [a|b|c|d]

powerSet(S) would then generate the following: ({a,b,c,d},{a,b,c},{a,b,d},{a,c,d},{b,c,d},{a},{b},{c},{d},{a,b},{a,c},{a,d},{b,c},{b,d},{c,d},{})
0

LVL 5

Expert Comment

ID: 8057498
Option Explicit

Private Sub Command1_Click()
Dim retVar
Dim strResult As String
retVar = thePowerset(Text1.Text, strResult)
Debug.Print retVar
Debug.Print strResult
End Sub
Private Function thePowerset(theStart As String, theResult As String) As String
Dim intCounter As Integer

For intCounter = 0 To Len(theStart) - 1
theResult = theResult & " " & Left(theStart, Len(theStart) - intCounter)
Next intCounter
For intCounter = 1 To Len(theStart) - 1
thePowerset = thePowerset(Right(theStart, Len(theStart) - intCounter - 1), theResult)
Next
End Function
0

LVL 5

Expert Comment

ID: 8057519
The previous code uses strings, that is:
you pass a string containing a number like "1234" and it retiurns a string with powerset values separated by spaces
(ie:
"1234 123 12 1 234 ..."
0

Author Comment

ID: 8057593
WOW! I am impressed by your coding - it works, but it appears that there are many repeated trailing elements when the subsets change to a reduced size.

I tried to reduce that but I failed. Perhaps you could give it a try?

Thanks a lot. Perhaps an empty set character could also be implemented.
0

LVL 5

Expert Comment

ID: 8057650
whoops ...a mistake... I solved it using a bollean to quit anticipate...
Option Explicit
Dim ended As Boolean
Private Sub Command1_Click()
Dim retVar
Dim strResult As String
ended = False
retVar = thePowerset(Text1.Text, strResult)
Debug.Print retVar
Debug.Print strResult
End Sub
Private Function thePowerset(theStart As String, theResult As String) As String
Dim intCounter As Integer
Dim intCounter2 As Integer

For intCounter = 0 To Len(theStart) - 1
theResult = theResult & " " & Left(theStart, Len(theStart) - intCounter)
Next intCounter
If Len(theStart) = 1 Then
ended = True
Exit Function
End If
For intCounter2 = 1 To Len(theStart) - 1
If ended = True Then
Exit Function
End If
thePowerset = thePowerset(Right(theStart, Len(theStart) - intCounter2), theResult)
Next
End Function

0

LVL 1

Expert Comment

ID: 8062448
Hi,

I have attached Some code here. This is Obtained the Subsets which are placed in order Only. Ie, Nambi is the Input,
We can't able to acheive the Combination like manbi,ibman.... .

Public Function subset(stri As String)
Dim midi, Text As String, TempText
Dim i
Text = ""
If Len(stri) = 1 Or bool = True Then
bool = True
Exit Function
End If
For i = 0 To Len(stri)
Text = Text & "  " & Mid(stri, i + 1, Len(stri))
Debug.print Text
Next
Dim j
For j = 1 To Len(stri)
subset (Mid(stri, j + 1, Len(stri)))
Next
End Function

fortunately /Unfortunately  Cimperiali code also achive some what Similar Result in Different Manner.

Regards,
Nambi
0

LVL 5

Expert Comment

ID: 8063045
Having had more time to thimnk it about, I solved the recursive Powerset algorithm in a more elegant (and correct) way (without the need of modular variable):
Private Sub Command2_Click()
Dim strResult As String
Call theCorrectPowerset(Text1.Text, strResult)
Debug.Print strResult
End Sub

Private Sub theCorrectPowerset(theStart As String, theResult As String)
Dim intCounter As Integer
For intCounter = 0 To Len(theStart) - 1
theResult = theResult & " " & Left(theStart, Len(theStart) - intCounter)
Next intCounter

theStart = Right(theStart, Len(theStart) - 1)
Do While Len(theStart) > 0
Call theCorrectPowerset(theStart, theResult)
Loop
End Sub
0

LVL 1

Expert Comment

ID: 8064764
Hi Cimperiali,

Again Name. Yes This Time You Avoid Repatations in Your Code. Just Have a look on My Code also. I hope We Neatly Achieving the Subset Of the Strings. But To Find Out the Powerset of String. Still we need to do Something. I am also Try For that. Waitng For Best Result. Apart From Cliffui  i am also so intrest in this Prolem

Public Function subset(stri As String)
Dim midi, Text As String, TempText
Dim i
Text = ""
If Len(stri) = 1 Or bool = True Then
bool = True
Exit Function
End If
For i = 0 To Len(stri)
Text = Text & "  " & Mid(stri, i + 1, Len(stri))
'Debug.Print Text
Next
Debug.Print Text
Dim j
For j = 1 To Len(stri)
subset (Mid(stri, j, Len(stri) - 1))
Next
End Function

Regards,
Nambi
0

Author Comment

ID: 8064828
Ah, so Cimperiali assumes I input the text without spaces inbetween elements. Let me try some formatting things out and see what to accept as an answer. You people are really really helpful!
0

Author Comment

ID: 8065217
I test run Cimperiali's code and found that for input "abcde", the output is: "abcde abcd abc ab a bcde bcd bc b cde cd c de d e". Some sets e.g. ae, be, ce are missing. Must be something wrong there.
0

Author Comment

ID: 8065318
Here is a pseudocode implementation:

'    Powerset(S) {
'       if (S is empty)
'           return {-0-}
'       Else
'           remove an element e from S
'           P' = P = Powerset(S)
'           For Each element x In P'
'               x = x UNION {e}
'           return P UNION P'
'    }

I tried and tried to no avail. Perhaps you have more skill.
S can be an array S() or perhaps a string. Best to have the output formatted as in {{0},{a,b},{a},{b}} for input "ab".
0

LVL 5

Expert Comment

ID: 8066355
>Some sets e.g. ae, be, ce are missing.
That because I misunderstood the task---did not think you wanted also the between...Sorry, no time to implement more, now. May be I will have a look tomorrow...
Have nice days, you all
0

LVL 1

Accepted Solution

sazhagianambi earned 60 total points
ID: 8077807
Hi Clifflui,

At Last With Result Of More and More Hard Work Here I achive the Result as You Want. Please Place one List Item Command Button. And Check out This.  But The Points You Assigned to this Problem is Too Less. Plz Increase That.

Private Sub Command1_Click()
bool = False
Call subset("ABC")
End Sub

Public Function subset(stri As String)
Dim midi, Text As String, TempText
Dim i
Text = ""
If Len(stri) = 1 Or bool = True Then
bool = True
Exit Function
End If
For i = 0 To Len(stri)
Text = Text & "  " & Mid(stri, i + 1, Len(stri))
Debug.Print Text
Call ListPermutation(Text)
Text = ""
Next
Dim j
For j = 1 To Len(stri)
subset (Mid(stri, j, Len(stri) - 1))
Next
End Function

Public Function ListPermutation(InputStr As String)

Dim a() As String
Dim str As String
Dim str1 As String
Dim first As String
Dim count As Integer
Dim Maxcount As Integer
Dim temp
ReDim a(Len(Trim(InputStr)))
Dim i
For i = 0 To Len(Trim(InputStr))
a(i) = Mid(Trim(InputStr), i + 1, 1)
Next
If Len(Trim(InputStr)) <= 1 Then
If Len(Trim(InputStr)) = 1 Then
Else
End If
Exit Function
End If

first = a(0)
count = 0
Dim j
For j = 0 To UBound(a)
str1 = str1 & a(j)
Next
Maxcount = 1
For i = 1 To Len(Trim(InputStr)) - 1
Maxcount = Maxcount * i
Next
While count < Maxcount

For i = 0 To UBound(a) - 1
str = ""
For j = 0 To UBound(a) - 1
str = str & a(j)
Next
'MsgBox str
If i <> UBound(a) - 1 Then
temp = a(0)
Dim k
For k = 1 To UBound(a) - 1
a(k - 1) = a(k)
Next
a(UBound(a) - 1) = temp
End If
Next
Dim X, temp1
For X = 0 To UBound(a) - 1
temp1 = a(0)
If a(X) = first Then
a(X) = a(0)
a(0) = first
Exit For
End If
Next
str = ""
For j = 0 To UBound(a) - 1
str = str & a(j)
Next

If str = str1 Then
temp = a(UBound(a) - 1)
a(UBound(a) - 1) = a(UBound(a) - 2)
a(UBound(a) - 2) = temp
End If

str = ""
For j = 0 To UBound(a) - 1
str = str & a(j)
Next

count = count + 1

Wend
' Here Find out The Combination Like ABCD,BCDA,CDAB,DABC....
End Function

Note it will Work Upto 7 combinations like abcdefg

Regards,
Nambi
0

LVL 5

Expert Comment

ID: 8078500
Have also a look here:
'**************************************************
Combinations:
http://www.freevbcode.com/ShowCode.Asp?ID=3017
'The following is source in Vb for calculating combinations, permuations and dispositions (which I think should really suite you- matter is: comments are in italian...)
http://www.flanguasco.org/VisualBasic/CalcComb.ZIP
'**************************************************
Permutations:
http://www.vb-helper.com/howto_permute.html

http://www.planet-source-code.com/xq/ASP/txtCodeId.12732/lngWId.1/qx/vb/scripts/ShowCode.htm

http://www.freevbcode.com/ShowCode.Asp?ID=3965

http://www.vbexplorer.com/VBExplorer/files/permutation.zip
0

Author Comment

ID: 8080746
Thank you all for your kind attention, wish I had something other than points. Well, s'pose if the code works then I'll put it up to 70, what do you think? I'm off to Thailand for a while, so I'll check back upon my return.
0

Expert Comment

ID: 8900867
clifflui:
Experts: Post your closing recommendations!  Who deserves points here?
0

Author Comment

ID: 8908204
Hmm, considering their hard work and dedication, I must assign them all points. But the solutions fail the question. A big hand to Cimperiali for its help.
0

LVL 1

Expert Comment

ID: 8922206
Ya!

I am also agree with u Cimperiali 's Code do the things Perfectly. Ponits Not a Problem, Solution is the ultimate . Possible Please reassign the Ponits to Cimperiali .

Nambi
0

LVL 5

Expert Comment

ID: 8924704
Hi!
No matter of points for me: happy if I could help...
Have a nice day,
Cesare Imperiali
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code oâ€¦
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library aâ€¦
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can launâ€¦
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This lâ€¦
###### Suggested Courses
Course of the Month13 days, 4 hours left to enroll