4

(The Goal is to create a program that given an input set, yields an output showing the Power Set of the entered set without using the built-in mathematica function" "When I enter this code into Mathmetica and run it, it ONLY GOES THROUGH THE LOOP ONCE AND ENDS THERE. Not sure what I'm doing wrong.)

MyIterativeSubsets[inlist_] :=
   Module[
    {
    listLength,
    powerSetLength,
    myPowerSet,
    pointer,
    counter,
    currentElement,
    newSet,
    DebugFlag = True
      },
 If[! ListQ[inlist], Return["Please enter a list"], 
  listLength = Length[inlist];
  myPowerSet = {{}};
  pointer = 1;
  If[DebugFlag == True, 
  Print["What was entered"];
  Print[inlist];

  Print["List Length"];
  Print[listLength];

  Print["Power Set is"];
  Print[myPowerSet];
];
While[pointer <= listLength,
    currentElement = inlist[[pointer]];
    powerSetLength = Length[myPowerSet];
    counter = 1;
    newSet = {};
 If[DebugFlag == True,
   Print["Current Element is"];
   Print[currentElement];

   Print["powerSetLength is"];
   Print[powerSetLength];

   Print["Counter is"];
   Print[counter];
  ];
    While[counter <= powerSetLength,
        newSet = 
   Append[newSet, Append[myPowerSet[[counter]], currentElement]];
        myPowerSet = Union[myPowerSet, newSet];
        counter++;
  If[DebugFlag == True,
   Print["New Set is"];
   Print[newSet];

   Print["My Power Set is"];
   Print[myPowerSet];

   Print["Counter is"];
   Print[counter];
   ];
  ];
  Print["This is the current Power Set"];
  Return[myPowerSet]
  pointer++;
  ]
 ]
]
m_goldberg
  • 107,779
  • 16
  • 103
  • 257
Yaseen Ayuby
  • 71
  • 3
  • You're calling Return in the body of the While. Also you know Subsets is a thing, right? Like it's a function you can use. Generally a procedural implementation of a function will be less efficient. – b3m2a1 Sep 16 '17 at 02:05
  • Should it be right after the while – Yaseen Ayuby Sep 16 '17 at 02:06
  • You don't need to call Return at all. Just put myPowerSet at the end of the Module. – b3m2a1 Sep 16 '17 at 02:06
  • See this to get you started on the right path. Mathematica programming is very different from Java or C++ or python (although python to a lesser extent). It'll take some readjustment. – b3m2a1 Sep 16 '17 at 02:07
  • Ok I do that and it actually runs through the loops however i still don't get the desired output. The output yields "Null Return[{{}, {a}, {b}, {c}, {a, b}, {a, c}, {b, c}, {c, c}}]" but the last element should be {a,b,c} Does this have to do with my Append statement. – Yaseen Ayuby Sep 16 '17 at 02:09
  • See AppendTo. I don't know what your input is, but I think you should really read about the language before you go any further. MSE is not a code debugging service and you seem to need a good primer on the language. By the way, just do this: Subsets[{a, b, c}]. – b3m2a1 Sep 16 '17 at 02:11
  • Lol the point of the project is to create a code without using Mathematica's built in function Subsets. I will look into AppendTo tho, thanks! – Yaseen Ayuby Sep 16 '17 at 02:15
  • One thing to beware of: doing it yourself will be a lot slower. – b3m2a1 Sep 16 '17 at 02:16
  • 1
    Just to back that statement up, the efficient subsets function from my answer is still 16 times slower than the built-in version. – b3m2a1 Sep 16 '17 at 06:26

3 Answers3

5

Using m_goldberg's insight and Carl Woll's note on three-argument Pick, here's a one-liner version of this:

subsets[set_List] :=
 Pick[set, #, 1] & /@ IntegerDigits[Range[2^Length[set]] - 1, 2, Length[set]]

We use Pick and use 1 as True, 0 as False in the standard way.

This is then ~13 times slower than Subsets:

subsets[Range[16]] // RepeatedTiming // First

0.17

Subsets[Range[16]] // RepeatedTiming // First

0.013

LegionMammal978 points out that we can just use Tuples[{0,1}, Length[set]]:

subsets[set_List] :=
 Pick[set, #, 1] & /@ Tuples[{0,1}, Length[set]]

With that tweak it's only 10 times slower than Subsets

subsets[Range[16]] // RepeatedTiming // First

0.14

Subsets[Range[16]] // RepeatedTiming // First

0.013
b3m2a1
  • 46,870
  • 3
  • 92
  • 239
4

The following fixes up the syntax of your code, but the logic is still wrong.

MyIterativeSubsets[inlist_] :=
  Module[
      {listLength, powerSetLength, myPowerSet, pointer, counter, 
       currentElement, newSet, DebugFlag = True},
    If[! ListQ[inlist], Return["Please enter a list"]];
    listLength = Length[inlist];
    myPowerSet = {{}};
    pointer = 1;
    If[DebugFlag == True,
      Print["What was entered ", inlist];
      Print["List Length ", listLength];
      Print["Power Set is", myPowerSet]];
    While[pointer <= listLength,
      currentElement = inlist[[pointer]];
      powerSetLength = Length[myPowerSet];
      counter = 1;
      newSet = {};
      If[DebugFlag == True,
        Print["Current Element is ", currentElement];
        Print[powerSetLength];
        Print["Counter is ", counter]];
      While[counter <= powerSetLength, 
        newSet = 
          Append[newSet, Append[myPowerSet[[counter]], currentElement]];
        myPowerSet = Union[myPowerSet, newSet];
        counter++;
        If[DebugFlag == True,
          Print["New Set is ", newSet];
          Print["My Power Set is ", myPowerSet];
          Print["Counter is ", counter]]];
      pointer++];
    myPowerSet]

Perhaps the rewritten code will help you to debug your logic,

My own logic, when applied to the problem, tells me that finding a power set should involve the power of 2 of the number of elements of the set. Using this insight, I come up with

subsets[set_List] :=
  Module[{n, pwr, templates, rules},
    n = Length[set];
    pwr = 2^n;
    templates = Position[#, 1] & /@ IntegerDigits[Range[pwr] - 1, 2, n];
    rules = Table[{i} -> set[[i]], {i, n}];
    Sort[templates /. rules]]

This is not even close to optimum, but does implement my understanding of a power set in a direct way. It is certainly simpler and more efficient than your approach.

Here are some test cases.

subsets[{}]

{{}}}

subsets[{a}]

{{}, {a}}

subsets[{a, b, c, d}]

{{}, {a}, {b}, {c}, {d}, {a, b}, {a, c}, {a, d}, {b, c}, {b, d}, {c, d}, {a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}, {a, b, c, d}}

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
  • Your rules could be done with MapIndexed[Rule[#2, #]&,set] – b3m2a1 Sep 16 '17 at 04:34
  • @b3m2a1. Sure, but I wanted to keep things simple. I thought the OP would be more comfortable with Table. Maybe I am, too :-) – m_goldberg Sep 16 '17 at 04:37
  • Makes sense. By the way, I liked the insight. Very clever. – b3m2a1 Sep 16 '17 at 04:38
  • @b3m2a1. I considered using Pick as you did, but I also considered the OP's demonstrated level of Mathematica knowledge. I was not interested in playing code golf with this problem. – m_goldberg Sep 16 '17 at 04:40
  • Again, very reasonable. I thought the code-golf-y implementation kinda fun, so I posted that as an answer, too. – b3m2a1 Sep 16 '17 at 04:41
  • @b3m2a1. I am happy that you did. Some of more sophisticated readers of this question will surely appreciate it. – m_goldberg Sep 16 '17 at 04:43
1

Rather than try to debug your code I thought I'd have a fresh go at the problem (I'm happy to delete if it's deemed off-topic).

As mentioned in the comments, you should check out AppendTo and look into how Modules and Functions work. There are any number of ways to build this function. I stayed away from any of the obvious functions (like, say, Subsets), and also from indexed approaches such as Table, While and the like.

powerset[list_] := 
  Join @@ NestList[
    With[{subsetlist = #}, 
      DeleteDuplicatesBy[Sort] @ Flatten[
        With[{le = #}, 
          If[MemberQ[#, le], Nothing, Join[{le}, #]] & /@ subsetlist
        ] & /@ list,
      1]] &, 
  {{}}, Length[list]];

Then

testlist = RandomSample[Alphabet[], 14];
powerset[testlist] == Subsets[testlist]

(* True *)

It's not terribly efficient -- in particular, it seems like there should be an easy way to avoid DeleteDuplicatesBy, but I couldn't think of anything that didn't involve indexing.

aardvark2012
  • 5,424
  • 1
  • 11
  • 22