Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 471

# Powerset of an array of single character elements

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
clifflui
• 8
• 7
• 4
• +1
1 Solution

Commented:
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 Commented:
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

Commented:
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

Commented:
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 Commented:
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

Commented:
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

Commented:
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

Commented:
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

Commented:
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 Commented:
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 Commented:
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 Commented:
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

Commented:
>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

Commented:
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

Commented:
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 Commented:
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

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

Author Commented:
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

Commented:
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

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

## Featured Post

• 8
• 7
• 4
• +1
Tackle projects and never again get stuck behind a technical roadblock.