5
$\begingroup$

I have a set of numbers from 0 to 9

numbers=Range[0,9,1]

I want to determine the combination of three numbers between 0 and 9. There is a correct combination through the conditions below:

1 - There is a true number in the correct position

enter image description here

condition1={6,8,2};
Permutations[condition1]

{{6,8,2},{6,2,8},{8,6,2},{8,2,6},{2,6,8},{2,8,6}}

2 - There is a true number, however, in the wrong position

enter image description here

condition2={6,1,4};
Permutations[condition2]

{{6, 1, 4}, {6, 4, 1}, {1, 6, 4}, {1, 4, 6}, {4, 6, 1}, {4, 1, 6}}

3 - There are two true numbers, however, in incorrect positions

enter image description here

condition3 = {2, 0, 6};
Permutations[condition3]

{{2, 0, 6}, {2, 6, 0}, {0, 2, 6}, {0, 6, 2}, {6, 2, 0}, {6, 0, 2}}

4 - All Fake Numbers

enter image description here

condition4 = {7, 3, 8};
Complement[numbers, condition4]

{0, 1, 2, 4, 5, 6, 9}

5 - There is a true number, however, in the wrong position

enter image description here

condition5 = {7, 8, 0};
Permutations[condition5]

{{7, 8, 0}, {7, 0, 8}, {8, 7, 0}, {8, 0, 7}, {0, 7, 8}, {0, 8, 7}}

I tried combining these solutions, but I did not get a answer through a code. I only have the result using my logic ...

enter image description here

$\endgroup$
3
  • $\begingroup$ does "a true number, however, in the wrong position" mean "a true number, however,not necessarily in the correct position" or "a single true number, AND it is in the wrong position"? Similarly for "two true numbers, however, in incorrect positions"? $\endgroup$
    – kglr
    Apr 17, 2020 at 20:10
  • 1
    $\begingroup$ .. are the three numbers distinct? $\endgroup$
    – kglr
    Apr 17, 2020 at 20:20
  • 1
    $\begingroup$ Can you please edit and streamline your question? Trivial example: Range[0,9] (not Range[0,9,1]). But those unnecessary graphics require us to scroll needlessly. The whole thing can be sharpened up; it will attract more helpers. Also you can be clearer if you distinguish between digit and number. After all, $423$ is a number, but you don't want it to be considered as such. Needlessly confusing! $\endgroup$ Apr 17, 2020 at 23:21

3 Answers 3

8
$\begingroup$

Assuming (1) possible codes are triples with distinct elements and (2) "in the wrong position" means not necessarily in the correct position:

ClearAll[containsOneCP, containsOne, containsTwo, containsNone]

containsOneCP[lst_] :=  Module[{abc = MapThread[Equal, {#, lst}]}, 
    BooleanCountingFunction[{1}, 3][## & @@ abc]] &;

containsOne[lst_] := Length[Intersection[#, lst]] == 1 &;

containsTwo[lst_] := Length[Intersection[#, lst]] == 2 &;

containsNone[lst_] := ContainsNone[lst];

conditions = {condition1, condition2, condition3, condition4, condition5};

funcs = {containsOneCP, containsOne, containsTwo, containsNone, containsOne};

flist = MapThread[# @ #2 &, {funcs, conditions}];

Select[And @@ Through[flist @ #] &] @ Permutations[Range[0, 9], {3}]
{{0, 1, 2},{0, 4, 2},{1, 0, 2},{4, 0, 2},{6, 0, 5},{6, 0, 9},{6, 5, 0},{6, 9, 0}}

Update: If "a true number / two true numbers, however, in the wrong position" means the one digit is (the two digits are) not in their correct positions, we need to add the condition (And @@ MapThread[Unequal, {#, lst}]) to containsOne and containsTwo:

containsOneWP[lst_] := (And @@ MapThread[Unequal, {#, lst}]) && 
    Length[Intersection[#, lst]] == 1 &;

containsTwoWP[lst_] := (And @@ MapThread[Unequal, {#, lst}]) && 
    Length[Intersection[#, lst]] == 2 &;

With this modification we get a unique result that matches OP's manually obtained result:

funcs2 = {containsOneCP, containsOneWP, containsTwoWP, containsNone, containsOneWP};

flist2 = MapThread[#@#2 &, {funcs2, conditions}];

Select[And @@ Through[flist2@#] &]@Permutations[Range[0, 9], {3}]
 {{0, 4, 2}}
$\endgroup$
6
$\begingroup$
Cases[Permutations[Range[0,9],{3}],
  v:{a_,b_,c_}/;
  And[
    (a==6||b==8||c==2)&&Length[v⋂{6,8,2}]==1,
    (a!=6&&b!=1&&c!=4)&&Length[v⋂{6,1,4}]==1,
    (a!=2&&b!=0&&c!=6)&&Length[v⋂{2,0,6}]==2,
    (a!=7&&b!=3&&c!=8),
    (a!=7&&b!=8&&c!=0)&&Length[v⋂{7,8,0}]==1
  ]
]

{{0, 4, 2}}

$\endgroup$
1
$\begingroup$

One possible interpretation?

Permutations[Range[0,9,1],{3}]//condition1//condition2//condition3

{{0, 4, 2}}

 condition1:=Cases[#, {6, Except[8|2], Except[2|8]}|
      {Except[6|2], 8, Except[2|6]} |
      {Except[6|8], Except[8|6], 2}]&

  condition2:=Cases[#, {Except[6], 6|4, Except[4]} |
      {Except[6], Except[1], 1|6}|
      {1|4, Except[1], Except[4]}]&

  condition3:=Cases[#, {Except[2], 2|6, 2|0} | 
        {0|6, Except[0], 2|0}|
        {6|0,6|2,Except[6]}]&
$\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.