?
Solved

Powerset of an array of single character elements

Posted on 2003-03-03
20
Medium Priority
?
453 Views
Last Modified: 2008-02-01
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
Comment
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
  • Learn & ask questions
  • 8
  • 7
  • 4
  • +1
20 Comments
 
LVL 5

Expert Comment

by:Cimperiali
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

by:clifflui
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

by:Cimperiali
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 5

Expert Comment

by:Cimperiali
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

by:clifflui
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

by:Cimperiali
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

by:sazhagianambi
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

by:Cimperiali
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

by:sazhagianambi
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

by:clifflui
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

by:clifflui
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

by:clifflui
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

by:Cimperiali
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

by:
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
     List1.AddItem InputStr
  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
            List1.AddItem 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

by:Cimperiali
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

by:clifflui
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

by:CleanupPing
ID: 8900867
clifflui:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
Experts: Post your closing recommendations!  Who deserves points here?
0
 

Author Comment

by:clifflui
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

by:sazhagianambi
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

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

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

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

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question