1
$\begingroup$

In the course of a programming problem I stumbled upon the following sub-problem.

Given an arbitrary, but fixed, number of Boolean variables, I would like to be able to pick a subset of the variables and combine them in such a way that I get a numbering of the unique cases that the subset possesses.

To give an example, let $A, B, C$ be three Boolean variables. The truth table has the form

$$\begin{array} {|c|} \hline A & B & C \\ \hline 1 & 1 & 1 \\ \hline 0 & 1 & 1 \\ \hline 1 & 0 & 1 \\ \hline 0 & 0 & 1 \\ \hline 1 & 1 & 0 \\ \hline 0 & 1 & 0 \\ \hline 1 & 0 & 0 \\ \hline 0 & 0 & 0 \\ \hline \end{array}$$

Take the subset of variables to be $\{A,C\}$. It would be great to get a numbering of the different cases implied by $A$ and $C$ in the following way,

$$\begin{array} {|c|} \hline A & C & Numbering \\ \hline 1 & 1 & 1 \\ \hline 0 & 1 & 2 \\ \hline 1 & 1 & 1 \\ \hline 0 & 1 & 2 \\ \hline 1 & 0 & 3 \\ \hline 0 & 0 & 4 \\ \hline 1 & 0 & 3 \\ \hline 0 & 0 & 4 \\ \hline \end{array}$$

What would be the most efficient way to getting the vector containing the numbering of the different cases? I thought of generating the truth table, combining the truth values of the chosen variables into a unique symbol, i.e. the string consisting of the respective truth values, 1 1 -> "11", eliminating the redundant symbols in that vector and mapping back the indices of the symbols in that smaller vector to the symbols in the vector containing the redundant symbols.

However, that seems to be horribly inefficient. Is there a Mathematica-specific way to optimize this, possibly one which would allow it to be extended to multi-valued variables?

Edit: It seems to be inefficient because the choice of the subset and the total number of variables uniquely determine the numbering vector.

$\endgroup$
1
  • $\begingroup$ @kguler I came up with an answer before noticing it's nearly the same as your idea. I think numbering = (2^Length[#] - FromDigits[Reverse@#, 2]) & gives the OP's numbering. $\endgroup$
    – Michael E2
    Jun 30, 2014 at 13:17

2 Answers 2

0
$\begingroup$

Step for step:

m = {{1, 1}, {0, 1}, {1, 1}, {0, 1}, {1, 0}, {0, 0}, {1, 0}, {0, 0}};

a = DeleteDuplicates@m

{{1, 1}, {0, 1}, {1, 0}, {0, 0}}

b = Range@Length@a

{1, 2, 3, 4}

c = MapThread[Rule, {a, b}]

{{1, 1} -> 1, {0, 1} -> 2, {1, 0} -> 3, {0, 0} -> 4}

d = m /. c

{1, 2, 1, 2, 3, 4, 3, 4}

Join[m, List /@ d, 2] // TableForm

enter image description here

This can be reduced to a oneliner:

Join[m, List /@ m /. MapThread[Rule, {#, Range@Length@#}] &[DeleteDuplicates@m], 2]

If you want to remove the duplicates:

Join[m, List /@ d, 2] // DeleteDuplicates

{{1, 1, 1}, {0, 1, 2}, {1, 0, 3}, {0, 0, 4}}

$\endgroup$
1
$\begingroup$

Here's a way than works for any number of variables:

numbering = 2^(Length[#] - 1) (2 - FromDigits[#, 1/2]) &;

tablesubset = Reverse /@ Reverse@Tuples[{0, 1}, {3}][[All, {1, 3}]]; (* {A, C} *)

Grid@Join[#, List /@ numbering /@ #, 2] &@ tablesubset

Mathematica graphics

(If all you want is a numbering, then just FromDigits[#, 2] & seems quite easy, as well as intuitive for those familiar with base 2.)

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.