1
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – aardvark2012 Sep 9 '17 at 8:01
  • $\begingroup$ I am probably misreading this one, but maybe Pick[lista,listb, 0] // Signature, or some better use of Signature? $\endgroup$ – user1066 Sep 9 '17 at 9:29
1
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

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)

$\endgroup$

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.