# forward or backward IntegerDigits in pairs must yield different results

I have some pair configurations same as {0,1,1,1,0,1} with {1,0,1,1,0,1} or {1,1,0,1,0,1,1,1} with {1,1,0,0,1,1,1,1}. I wish to define a function whose duty is distinguish the first pair from the second ones.

For the first pair all digits are same except two first digits 01 and 10

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


For the last pair, all digits are same except the middle digits 10 and 01.

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


I wish to define a function that when it faces to the first pairs, in which 01 in ( for example {0,1,1,1,0,1} ) is ahead of 10 in ( for example {1,0,1,1,0,1}) yields -1 and for the second configuration yields +1.

The number of digits and the positions of them are not important. For a pair, being forward or backward of 01 is important.

I wrote the below line, for example for the last pairs

Do[
If[Quotient[
FromDigits[{1, 1, 0, 1, 0, 1, 1, 1}, 2] -
FromDigits[{1, 1, 0, 0, 1, 1, 1, 1}, 2], 2^(k - 1)] == 1,
Print@k], {k, 1, 8}]


and for the first pair

Do[If[Quotient[
FromDigits[{0, 1, 1, 1, 0, 1}, 2] -
FromDigits[{1, 0, 1, 1, 0, 1}, 2], 2^(k - 1)] == -1 &&
Mod[FromDigits[{0, 1, 1, 1, 0, 1}, 2] -
FromDigits[{1, 0, 1, 1, 0, 1}, 2], 2^(k - 1)] == 0 ,
Print@k], {k, 1, 6}]


In general we can say:

If[Quotient[
FromDigits[list1, 2] -
FromDigits[list2, 2], 2] < 0 &&
Mod[FromDigits[list1, 2] -
FromDigits[list2, 2], 2] == 0, Print[list1,list2]]


in which list1 and list2 are ordered above pairs, can make a reasonable difference between pairs.

• Sorry, but I'm still not sure what you mean, in particular, by "For a pair, being forward or backward of 01 is important." It seems that If[#1 > #2, 1, -1] &[firstnumber, secondnumber] gives the output you want for those examples, but I'm guessing that's not what you're after in general. Sep 9, 2017 at 8:01
• I am probably misreading this one, but maybe Pick[lista,listb, 0] // Signature, or some better use of Signature? Sep 9, 2017 at 9:29

Since the operation is on zeros and ones then you may use Bitwise Operations like BitXor.

f[x_, y_] := Subtract @@ Pick[x, BitXor[x, y], 1]


Then

f[{0, 1, 1, 1, 0, 1}, {1, 0, 1, 1, 0, 1}]

-1


and

f[{1, 1, 0, 1, 0, 1, 1, 1}, {1, 1, 0, 0, 1, 1, 1, 1}]

1


Hope this helps.

Does the following work for you?

order[l : {a___, b_, c_, d___}, {a___, c_, b_, d___}] /; MatchQ[l, {(0 | 1) ..}] := b - c
order[_, _] := "Invalid" (*optional, provides fallback if the two arguments are invalid*)

order[{0, 1, 1, 1, 0, 1}, {1, 0, 1, 1, 0, 1}]
(* -1 *)

order[{1, 1, 0, 1, 0, 1, 1, 1}, {1, 1, 0, 0, 1, 1, 1, 1}]
(* 1 *)


The first definition only matches if you have two lists with two of their elements flipped. The Condition (/;) makes sure that the lists only consist of 0 and 1 (you can drop it if you don't need to be so strict)