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
  • Last Modified:

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
Asked:
clifflui
  • 8
  • 7
  • 4
  • +1
1 Solution
 
CimperialiCommented:
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
 
cliffluiAuthor 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
 
CimperialiCommented:
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.

 
CimperialiCommented:
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
 
cliffluiAuthor 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
 
CimperialiCommented:
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
 
sazhagianambiCommented:
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
 
CimperialiCommented:
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
 
sazhagianambiCommented:
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
 
cliffluiAuthor 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
 
cliffluiAuthor 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
 
cliffluiAuthor 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
 
CimperialiCommented:
>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
 
sazhagianambiCommented:
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
 
CimperialiCommented:
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
 
cliffluiAuthor 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
 
CleanupPingCommented:
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
 
cliffluiAuthor 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
 
sazhagianambiCommented:
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
 
CimperialiCommented:
Hi!
No matter of points for me: happy if I could help...
Have a nice day,
Cesare Imperiali
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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