# Getting number of binary digits combinations without “forbidden” patterns

I need to get the number of all combinations of binary digits in an 8-digit binary number, but not including those that follow some "forbidden" patterns like these:

xxxx0xx1
x1xxx0xx
x1xxx0x0


(where x represents any digit)

These shouldn't be in "valid" combinations I would like to count.

My numbers are much larger in fact, so I can't simply enumerate them.

What should I do?

-
The number of fixed digits, m, in a non-overlapping pattern of length, n, reduces the available combinations by an amount 2^(n-m). Finding the set of non-overlapping patterns, e.g. x1xxx0xx and x1xxx0x0 overlap, should compute the remaining available patterns. – image_doctor Nov 13 '12 at 12:26

The following seems fast and less memory bound, because it's based on SatisfiabilityCount[], a wonderful function to count boolean valued functions with boolean arguments:

count[l : {_String ..}] := Module[{x, sp},
sp[s_String, sub_String] := StringPosition[s, sub][[All, 1]];
SatisfiabilityCount[
And @@ Not /@ (And @@@ (x /@ sp[#, "1"] && Not /@ x /@ sp[#, "0"]) & /@ l),
Array[x, StringLength[First@l]]]];

count@ {"xxxx0xx1", "xx1xxx0x"}
(* 144 *)

count@  {"xxxx0xx1", "x1xxx0xx", "x1xxx0x0"}
(* 144 *)


kgulerex={"10x001x1", "0xx0110x", "1000xx01", "01xx01x1", "00x1000x", "111101x1",
"10x00x0x", "0111x0xx", "xx001011", "10x0x010"};
count[kgulerex]
(* 206 *)

count[{"0xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx01"}]
(* 985162418487296 *)


Edit

Let's calculate a really large one (5000 digits, excluding 10 patterns in 10 seconds):

l = StringJoin /@ RandomChoice[{"x", "0", "1"}, {10, 5000}];
N@Timing@Log[10, count[l]]
(* {10.25, 1505.15} *)

-
SatisfiabilityCount, nice. – image_doctor Nov 13 '12 at 14:01
Re: SatisfiabilityCount -- yet another function I've never used! – Mr.Wizard Nov 13 '12 at 14:39
@Mr.Wizard I've learned that one from Yaroslav – Dr. belisarius Nov 13 '12 at 14:42
I need time to digest this, which I don't have now, but I suspect this would have been very useful back in my Project Euler days. Maybe I'll revisit a few problems. – Mr.Wizard Nov 13 '12 at 14:50
Great answer. I came into those functions only a few days ago. Used them when playing around with this – Rojo Nov 14 '12 at 18:47

Unfortunately I'm joining the party a bit late. I had the (what I think analytic) solution earlier, but there was no time to test it and write it down.

## Introduction

What got me thinking was that is is really easy to calculate this with only one forbidden pattern. If you have a word of length n then the number of all possibilities is

$$a = 2^n$$

A forbidden pattern fixes some (say m) of the binary digits. On those places you cannot choose between 0 and 1 anymore and therefore you can calculate the number of forbidden patterns by simply taking the m fixed bits not into accout

$$p=2^{(n-m)}$$

or in our case 2^Count[patt,x]. Now you simply subtract this from a and you have the number of valid combinations. If you have two or more patterns, than this works when the pattern do not interfere. Best example is when you have the same pattern twice. Then obviously you cannot subtract this two times.

The reason for this is that the intersection of those patterns is not empty. They both have the same combinations in it and therefore, we have to take care to subtract them only once. This intersection argument remembered me of the Inclusion-exclusion principle because we basically want the same: We want to count the number of elements in the union of a set of forbidden patterns.

Looking at the formula

\begin{align} \biggl|\bigcup_{i=1}^n A_i\biggr| &= \sum_{k = 1}^{n} (-1)^{k+1} \left( \sum_{1 \leq i_{1} < \cdots < i_{k} \leq n} \left| A_{i_{1}} \cap \cdots \cap A_{i_{k}} \right| \right). \end{align}

shows that we only need an patternIntersection operation and a patternCount operation. The argument of the inner sum in above formula contains nothing more than to count the intersection of all pattern-Subsets of length k.

## Implementation

Let's first start with something very basic: the pattern-intersection. If we have two digits xx and try to think what the intersection of the patterns x1 and 1x is, then we see, that it can only be 11. Therefore, if we want to intersect two patterns, we make this digit by digit. Let's call this function c for combine

c[x, 1] = c[1, x] = c[1, 1] = 1;
c[x, 0] = c[0, x] = c[0, 0] = 0;
c[x, x] = x;
c[0, 1] = c[1, 0] = 3;
c[3, _] := 3;
c[_, 3] := 3;


So if we have (say on the first place) a x in the one pattern and a 1 in the other, the intersection will have a 1 at this place. The only new thing is, that when patterns clash with a 1 and 0, we set this to 3 which means something like both, 0 and 1 appeared.

Now we can define a patternIntersection which takes an arbitrary number of patterns as argument an gives their intersection as output

patternIntersection[p1_List, p2_List] := c @@@ Transpose[{p1, p2}];
patternIntersection[p1_List] := p1;
patternIntersection[p1_List, p2_List, rest__List] :=
patternIntersection[patternIntersection[p1, p2], rest]


Quick test shows what we expect:

patternIntersection[{x, x, 1, x, x, 0}, {1, x, 1, x, 0, 1}]

(* {1, x, 1, x, 0, 3} *)


Now we need a function to count the possibilities. This works as explained above: just count the x in the pattern but if there is a 3 anywhere, the count is 0. This is because there does not exists any word which has a 0 and a 1 in one place:

patternCount[p__List] := With[{pp = patternIntersection[p]},
If[FreeQ[pp, 3], 2^Count[pp, x], 0]
]


Last but not least, we need to write down the formula from the top.

countValidCombinatations[forbidden_] :=
With[{n = Length[First[forbidden]]},
2^n - Sum[(-1)^(k - 1) Total[patternCount @@@ Subsets[forbidden, {k}]],
{k, n}]
]


## Examples

countValidCombinatations[{{x, x, x, x, 0, x, x, 1}, {x, 1, x, x, x, 0,
x, x}, {x, 1, x, x, x, 0, x, 0}}]

(* 144 *)


Testing kguglerex

kgulerex = (ToExpression /@ Characters[#]) & /@ {"10x001x1",
"0xx0110x", "1000xx01", "01xx01x1", "00x1000x", "111101x1",
"10x00x0x", "0111x0xx", "xx001011", "10x0x010"};
countValidCombinatations[kgulerex]

(* 206 *)


or the examples with 5000 digits which belisarius used to time the operation

l = RandomChoice[{x, 0, 1}, {10, 5000}];
N@Timing@Log[10, countValidCombinatations[l]]

(* {9.16457, 1505.15} *)

-
+1. I got a similar idea but alas had no time to implement and write it up. – Leonid Shifrin Nov 14 '12 at 8:38
@LeonidShifrin Thanks. I'm thinking about substituting Subsets by a small code which iterates through all subsets. I'm not sure how much faster (or slower) this will be, but the creating of the Subsets is a bottleneck. Unfortunately Subsets[expr,{k},{j}] is not faster which either means there is no speedup to expect or Subsets is just slow. – halirutan Nov 14 '12 at 8:50
+1 for doing the legwork. I would have done something similar (but likely ugly) if this were a Project Euler problem. – Mr.Wizard Nov 14 '12 at 11:04
Nice +1. Could you test the speed of both solutions head to head on your machine? – Dr. belisarius Nov 14 '12 at 12:33
@belisarius No, unless I don't win I never make exact measurements ;-) – halirutan Nov 14 '12 at 21:17

A straight forward approach is to simply generate all the combinations you don't want and use Complement to remove them from all the possible numbers. You can generate all possible combinations using Tuples:

 expandBinRep[n_]:=n//.{a___,x,b___}:>Sequence[{a,0,b},{a,1,b}]

Complement[Tuples[{0, 1}, {8}], expandBinRep@{{x, x, x, x, 0, x, x, 1}}]


I would emphasise that this might lead you to deal with huge lists of numbers when it might not bee needed.

An alternative route might be to take the description of numbers to exclude {x,1,0,x} and generate descriptions that can generate remaining numbers, for this example; {x,0,x,x} and {x,x,1,x}. This is done simply by making one difference so it doesn't match and letting all other digits be free:

invertDescription[v_]:=Insert[ConstantArray[x,Length[v]-1],
Abs[1 - v[[#]]],#]&/@ Flatten[Position[v,0|1]]


However with this definition the descriptions overlap, so you'd need Union to make them only appear once:

invertDescription[{x, x, x, x, 0, x, x, 1}] // expandBinRep // Union


Update

I believe that this definition solves the problem of overlapping patterns:

 invertDescription[v_] :=
PadRight[Append[v[[1 ;; # - 1]], Abs[1 - v[[#]]]], Length@v, x] &
/@ Flatten[Position[v, 0 | 1]]

-
I got the impression from OP's question that he wanted a lazy approach... – J. M. Nov 13 '12 at 12:12
@J.M. So did I, this is why I added the second less direct approach which keeps the patterns unevaluated. This is essentially a recipe that allows late generation of the numbers, though it does suffer from overlap in the patterns. – jVincent Nov 13 '12 at 12:15
@J.M. I think he only wants to count results – Dr. belisarius Nov 13 '12 at 17:36
 digits = IntegerDigits[Range[0, 255], 2, 8];
inputList = StringJoin /@ RandomChoice[{"x", "0", "1"}, {10, 8}]
(* {"10x001x1", "0xx0110x", "1000xx01", "01xx01x1", "00x1000x", "111101x1",
"10x00x0x", "0111x0xx", "xx001011", "10x0x010"} *)
forbiddenPatterns =  Alternatives @@ (ToExpression /@ Characters /@ inputList /.
x -> Blank[])
(* {1, 0, _, 0, 0, 1, _, 1} | {0, _, _, 0, 1, 1, 0, _} |
{1, 0, 0, 0, _, _, 0, 1} | {0, 1, _, _, 0, 1, _, 1} |
{0, 0, _, 1, 0, 0, 0, _} | {1, 1, 1, 1, 0, 1, _, 1} |
{1, 0, _, 0, 0, _, 0, _} | {0, 1, 1, 1, _, 0, _, _} |
{_, _, 0, 0, 1, 0, 1, 1} | {1, 0, _, 0, _, 0, 1, 0} *)
Count[digits, Except[forbiddenPatterns]]
(* 206 *)

opsExample = {"xxxx0xx1", "x1xxx0xx", "x1xxx0x0"};
inputList2 = Join[inputList, opsExample];
{Count[digits, Except[Alternatives @@ (ToExpression /@ Characters /@
opsExample /. x -> Blank[])]],
Count[digits, Except[Alternatives @@ (ToExpression /@ Characters /@
inputList2 /. x -> Blank[])]]}
(* {144,122} *)


(Note: this is same as Leonid's deleted answer applied to an arbitrary list of forbidden patterns. Posting it just to get a clarification on why this doesn't work.)

-
You could have at least removed Leonids bug. – halirutan Nov 13 '12 at 12:50
@halirutan, what bug? – kglr Nov 13 '12 at 12:58
The one you fixed 2 min ago ;-) – halirutan Nov 13 '12 at 13:01
@halirutan, i see ... – kglr Nov 13 '12 at 13:05

You could try string patterns:

binary = Table[IntegerString[n, 2, 8], {n, 0, 255}];

(*
{"00000000", "00000001", "00000010", "00000011", "00000100", etc.
*)

DeleteCases[StringReplace[binary,
{_ ~~ _ ~~ _ ~~ _ ~~ "0" ~~ _ ~~ _ ~~ "1" -> "",
_ ~~ _ ~~ "1" ~~ _ ~~ _ ~~ _ ~~ "0" ~~ _ ~~ _ -> ""
}
], ""]

(*
{"00000000", "00000010", "00000100", "00000110", etc.
*)


There's probably a nice way to turn your "xxxx0xx1" into a pattern...

-
Regex works nicely: RegularExpression["[01]{4}0[01]{2}1"] – J. M. Nov 13 '12 at 12:29
You don't need to go to strings to do this, DeleteCases[Tuples[{0, 1}, {8}], {_, 1, _, _, _, 0, _, _}] will work too. – jVincent Nov 13 '12 at 12:37