1
$\begingroup$

A monotone binary function is defined as follows:

Given binary vectors $\bf x$ and $\bf y$ (each having $n$ bits) with $\bf x\geq \bf y$, a function $f:\bf x\rightarrow\{0,1\}$ is called monotone if $$f(\bf x)\geq \it f(\bf y)$$

Here $\bf x\geq \bf y$ means $x_i\geq y_i$ for all $i$.

Example: $n=3$, binary vector $\bf x$ takes the following values:

000
001
010
011
100
101
110
111

Here if $f(001)=1$ then $f(011)=1$, $f(101)=1$, $f(111)=1$ must be true. Assume also that $f(000)=0$, then if $f(010)=1$, $f(110)=1$ is another must.The last one $f(100)=0$ and $f(100)=1$ can also be chosen. Accordingly two valid vectors are

$$f_1=\{0,1,1,1,0,1,1,1\}\, \mbox{and}\, f_2=\{0,1,1,1,1,1,1,1\}$$

I am looking for an algorithm to list all such posible vectors. I can do it with exhaustive search but I have the feeling that there should be an effective way of finding all such vectors given $n$.

Do you have any ideas about how to go about this problem?

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Can you be more specific? Have you tried Tuples[{0, 1}, 8] ? $\endgroup$ – J42161217 Oct 27 '18 at 20:42
  • $\begingroup$ @J42161217 Tuples lists all possible $f$ functions but I am looking for all possible $f$ functions which are monotone. For example $f_1=\{0,1,1,1,0,1,1,1\}$ is valid but $f_1=\{0,1,1,1,0,0,1,1\}$ is invalid or $f_1=\{0,1,1,0,0,1,1,1\}$ is also in valid. etc.. because they do not satisfy the monotonicity condition.. $\endgroup$ – Seyhmus Güngören Oct 27 '18 at 20:46
  • $\begingroup$ do you want to fix f[0,0,0] =0 and f[1,1,1] =1 ? Or, are ConstantArray[0, 2^n] and ConstantArray[1, 2^n] monotone? $\endgroup$ – kglr Oct 27 '18 at 23:00
  • $\begingroup$ @kglr they are monotone. see please $\geq$. I think for $n=3$ there are $20$ such vectors (table from a book), which are monotone. I wont use all zeros and all ones actually. $\endgroup$ – Seyhmus Güngören Oct 27 '18 at 23:03
  • $\begingroup$ so for n=2 the full list is {{0, 0, 0, 1}, {0, 0, 1, 1}, {0, 1, 1, 1}, {0, 1, 0, 1}}? $\endgroup$ – kglr Oct 27 '18 at 23:10
1
$\begingroup$
ClearAll[lessEqual, monotonicQ, monotonicSequences]
lessEqual[n_Integer] := And @@ Thread[LessEqual @@ IntegerDigits[{##}, 2, n]] &
monotonicQ[n_] := Function[x, And @@ 
  Join[If[lessEqual[n][##], x[#] <= x[#2], ## &[]] & @@@ Subsets[Range[0, 2^n - 1], {2}], 
     Array[0 <= x[#] <= 1 &, 2^n, 0]]]
monotonicSequences = Module[{s = Array[x, 2^#, 0]}, 
   s /. Solve[monotonicQ[#][x], s, Integers] ] &;

Examples:

Length[monotonicSequences@#] & /@ Range[2, 5]

{6, 20, 168, 7581}

monotonicSequences @ 2 // Column // TeXForm

$\begin{array}{l} \{0,0,0,0\} \\ \{0,0,0,1\} \\ \{0,0,1,1\} \\ \{0,1,0,1\} \\ \{0,1,1,1\} \\ \{1,1,1,1\} \\ \end{array}$

monotonicSequences@3 // Column // TeXForm

$\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,0,0,0,1\} \\ \{0,0,0,1,0,0,1,1\} \\ \{0,0,0,1,0,1,0,1\} \\ \{0,0,0,1,0,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,1,0,0,1,1\} \\ \{0,0,1,1,0,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,1,0,1,0,1\} \\ \{0,1,0,1,0,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,1,0,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

First[RepeatedTiming[monotonicSequences @ #]] & /@ {2, 3, 4, 5}

{0.0019, 0.0064, 0.0380, 2.25}

$\endgroup$
3
$\begingroup$

Here's an approach using Reduce.

The first step is to construct all of the inequalities. Consider a bit vector $b(1, 0, 1, 0)$. The inequalities that can be generated with this vector are $b(1, 0, 1, 0 \ge b(0, 0, 1, 0)$ and $b(1, 0, 1, 0) \ge b(1, 0, 0, 0)$. Basically, for each bit vector, subtract 1 from each nonzero position, and create the inequality. Here is some code that does this:

monotone[n_, max_] := Module[{ineq, tup, z = Array[w, 2^n, 0]},
    eqns = Flatten @ Table[
        If[Min[t - UnitVector[n, k]]>=0,
            w[toNumber[t, n]] >= w[toNumber[t-UnitVector[n,k], n]],
            Nothing
        ],
        {t, Rest @ Tuples[Range[0, 1], n]},
        {k, n}
    ];
    res = Reduce[
        And@@eqns && Min[z]>=0 && Max[z]<=max,
        z,
        Integers
    ];
    Values @ {ToRules @ res}
]

toNumber[t_, n_] := NumberCompose[t, 2^Range[n-1, 0, -1]]

Let's check the two simple cases:

monotone[2, 1]
% //Length

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

6

monotone[3, 1]
% //Length

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

20

The case with $n=4$ takes a bit more time:

s = monotone[4, 1]; //AbsoluteTiming
s //Length

{37.3793, Null}

168

in agreement with the linked reference. Finally, an example that isn't just 0s and 1s:

monotone[2, 2]
% //Length

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

20

$\endgroup$
  • $\begingroup$ Thank you very much. Yes this is great. I am still wondering something. How did the guys of that book/paper were able to find the total number of such functions for $n=6$? It seems to me that even $n=5$ will require a lot of time if not infeasible. Btw the paper refers to a book which was published about $70$ years ago. One more thing: I don't have the book, and I guess the owners of the paper probably run a computer program but $10^19$ is something huge. They even don't mention about it. $\endgroup$ – Seyhmus Güngören Oct 28 '18 at 10:47
  • $\begingroup$ NumberCompose seems not to be defined at least in Mathematica 10. $\endgroup$ – Seyhmus Güngören Oct 28 '18 at 12:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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