10
$\begingroup$

I'm a high school math teacher working on a simple high school math problem involving permutations. I like to try to check answers to some of these problems since it helps "convince" the students that the methods actually work, and it helps me develop my limited Mathematica skills just a bit...

here is the question

How many even numbers of at most three digits can be formed using the digits 0,1,2,3, 4 and 5 without repetition? (I got the answer 68 ways)

Sorry, I meant... I got the answer 68 numbers, using regular "mathematical methods", and I wanted to confirm using Mathematica!

I'm asking just to hopefully learn how to better use Mathematica.

I have the following line which I understand, but it's just part of the solution, and I wondered how to eliminate the values less than 10 (without using another Select, which is what I did but it seemed really messy)

Again, sorry... I assumed I had to get the answer in three steps.. this was the step for "two digit numbers", but I already see one answer that gets the result in one line (I knew there would be nice ways...)

Select[FromDigits /@ Permutations[{0, 1, 2, 3, 4, 5}, {2}], EvenQ]

I figure there must be some clever ways to do this and hoping a few people might share and it would give me some examples to chew on.

$\endgroup$
5
  • 2
    $\begingroup$ "I got the answer 68 ways" is an ambiguous statement. Believe it or not, I first inferred (what I think was) the incorrect meaning. $\endgroup$ Sep 19, 2014 at 15:56
  • $\begingroup$ What's wrong with numbers smaller than 10? $\endgroup$
    – Igor Rivin
    Sep 19, 2014 at 17:18
  • $\begingroup$ Depends on what the underlying question is. If you must use three of the digits then "without repetition" excludes both those and two digit numbers ending in 0. Whether this is the correct interpretation is unclear. $\endgroup$ Sep 19, 2014 at 17:31
  • $\begingroup$ Actually there are currently two answers "that gets the result in one line..." - plus Mr. Wizard's comment. What do you want? 68? Wrong, because you want "to eliminate the values less than 10." 65? (@ybeltukov's answer minus three). 60? $\endgroup$
    – eldo
    Sep 19, 2014 at 18:02
  • $\begingroup$ I am really sorry my question was not clear. In that line I was using Mathematica to try, TRY, to find numbers that worked, but I figured they were supposed to be the values with 2 digits, so not less than 10. It indicates my lack of skill using Mathematica. I do in fact want ALL the possible answers , which includes 1, 2 and 3 digits, and I think the answer is in fact 68. I appreciate all the answers given! $\endgroup$ Sep 19, 2014 at 20:54

4 Answers 4

9
$\begingroup$

The shortest solution I found:

Select[Range[0,999], # ⋂ Range[0, 5] == Sort@# &@IntegerDigits@# && EvenQ@# &]

{0,2,4,10,12,14,20,24,30,32,34,40,42,50,52,54,102,104,120,124,130,132,134,140,142,150,152,154,204,210,214,230,234,240,250,254,302,304,310,312,314,320,324,340,342,350,352,354,402,410,412,420,430,432,450,452,502,504,510,512,514,520,524,530,532,534,540,542}

There are 68 numbers exactly. Here # ⋂ Range[0, 5] == Sort@# & check that all digits are in the set {0,1,2,3,4,5} and there is no repetitions simultaneously.

$\endgroup$
6
  • $\begingroup$ +1 But: "I wondered how to eliminate the values less than 10 (without using another Select)" $\endgroup$
    – eldo
    Sep 19, 2014 at 17:14
  • $\begingroup$ @Eldo - eliminating numbers less than 100 (vice less than 10): Select[Range[0, 999], # \[Intersection] Range[0, 5] == Sort@# &@IntegerDigits@# && EvenQ@# && Length@IntegerDigits@# == 3 &] gives 52 numbers $\endgroup$
    – Bob Hanlon
    Sep 19, 2014 at 18:24
  • $\begingroup$ @Eldo - for eliminating numbers less than 10: Select[Range[0, 999], # \[Intersection] Range[0, 5] == Sort@# &@IntegerDigits@# && EvenQ@# && Length@IntegerDigits@# > 1 &] gives 65 numbers $\endgroup$
    – Bob Hanlon
    Sep 19, 2014 at 18:37
  • $\begingroup$ I appreciate your answer, totally different approach. I did want 68, my questions was badly worded. I know the end of that command is something I need to learn more about... not using Mathematica a lot, it's concise and probably clear, but I can't navigate all the @# && once it gets beyond a certain level! Thank you for your answer! $\endgroup$ Sep 19, 2014 at 21:05
  • 2
    $\begingroup$ +1 Nice. You could count count in twos and eliminate the EvenQ test for even shorter code Select[Range[0,999,2],#⋂0~Range~5==Sort@#&@*IntegerDigits] $\endgroup$ Sep 19, 2014 at 22:42
7
$\begingroup$
Cases[Union[FromDigits /@ Permutations[Range[0, 5], {2, 3}]], n_?EvenQ /; n >= 10]
{10, 12, 14, 20, 24, 30, 32, 34, 40, 42, 50, 52, 54, 102, 104, 120, 124, 130, 132, 134, 140, 142, 
 150, 152, 154, 204, 210, 214, 230, 234, 240, 250, 254, 302, 304, 310, 312, 314, 320, 324, 340, 
 342, 350, 352, 354, 402, 410, 412, 420, 430, 432, 450, 452, 502, 504, 510, 512, 514, 520, 524, 
 530, 532, 534, 540, 542}
Length@%
65

Edit based on the clarification by the OP:

Select[Union[FromDigits /@ Permutations[Range[0, 5], 3]], EvenQ]
{0, 2, 4, 10, 12, 14, 20, 24, 30, 32, 34, 40, 42, 50, 52, 54, 102, 104, 120, 124, 130, 132, 134, 
 140, 142, 150, 152, 154, 204, 210, 214, 230, 234, 240, 250, 254, 302, 304, 310, 312, 314, 320, 
 324, 340, 342, 350, 352, 354, 402, 410, 412, 420, 430, 432, 450, 452, 502, 504, 510, 512, 514, 
 520, 524, 530, 532, 534, 540, 542}
Length@%
68

Or

Cases[Union[FromDigits /@ Permutations[Range[0, 5], 3]], _?EvenQ]//Length
68
$\endgroup$
3
  • $\begingroup$ I agree with your excellent answer. As the question is posed the only correct result is 65 :) $\endgroup$
    – eldo
    Sep 19, 2014 at 19:05
  • $\begingroup$ I will admit to a poorly worded question. As I understand it, the answer is 68, and this answer was helpful, I did this... it works for me, I understand it, and I learned something from the n_? pattern which I am unfamiliar with, thank you Cases[Union[FromDigits /@ Permutations[Range[0, 5], 3]], n_?EvenQ] // Length $\endgroup$ Sep 19, 2014 at 20:59
  • $\begingroup$ @TomDeVries I made an edit based on your comment. For Cases there is no n needed in n_?EvenQ, if you don't use it for further pattern matching. $\endgroup$
    – Karsten 7.
    Sep 19, 2014 at 22:44
5
$\begingroup$
Select[FromDigits /@ Permutations[{0, 1, 2, 3, 4, 5}, {3}], EvenQ] // Length

60

Update based upon OP's comment to ybeltukov's answer:

Union @ Select[Flatten @ Map[FromDigits,
   Map[Permutations[Range @ 6 - 1, {#}] &, Range @ 3], {2}], EvenQ] // Length

68

$\endgroup$
4
  • 1
    $\begingroup$ There are Binomial[6, 3] 3! == 120 total permutations, and half of the original digits are odd. I wonder where the supposed remaining eight would be hiding. :^) (i.e. I agree with this answer.) $\endgroup$
    – Mr.Wizard
    Sep 19, 2014 at 15:14
  • $\begingroup$ Eliminating numbers less than 100: Select[FromDigits /@ Permutations[{0, 1, 2, 3, 4, 5}, {3}], EvenQ@# && Length@IntegerDigits@# == 3 &] // Length gives 52 $\endgroup$
    – Bob Hanlon
    Sep 19, 2014 at 18:21
  • $\begingroup$ You are missing out all even two digit numbers with a 0 as the last digit. $\endgroup$
    – Karsten 7.
    Sep 19, 2014 at 18:34
  • $\begingroup$ ...and 1 digit numbers, but I blame that on my poorly worded question, thank you for this answer $\endgroup$ Sep 19, 2014 at 20:55
1
$\begingroup$

"From first principles :) ", all integer with three different digits

SetAttributes[inRange, Listable];
inRange[x_] := Or @@ Array[x == # &, 6, 0];
evenQ@c_ := IntegerPart[c/2] == c/2
sols = {a, b, c} /.  Solve[a != 0 && c != a != b && And @@ inRange@{a, b, c} && evenQ@c, {a, b, c}]

Grid@Map[FromDigits, GatherBy[sols, First], {2}]

Mathematica graphics

$\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.