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.

Improve this question
$\endgroup$
  • 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$ – Daniel Lichtblau Sep 19 '14 at 15:56
  • $\begingroup$ What's wrong with numbers smaller than 10? $\endgroup$ – Igor Rivin Sep 19 '14 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$ – Daniel Lichtblau Sep 19 '14 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 '14 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$ – Tom De Vries Sep 19 '14 at 20:54
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.

Improve this answer
$\endgroup$
  • $\begingroup$ +1 But: "I wondered how to eliminate the values less than 10 (without using another Select)" $\endgroup$ – eldo Sep 19 '14 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 '14 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 '14 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$ – Tom De Vries Sep 19 '14 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$ – Simon Woods Sep 19 '14 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
Improve this answer
$\endgroup$
  • $\begingroup$ I agree with your excellent answer. As the question is posed the only correct result is 65 :) $\endgroup$ – eldo Sep 19 '14 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$ – Tom De Vries Sep 19 '14 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 '14 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

Improve this answer
$\endgroup$
  • 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 '14 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 '14 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 '14 at 18:34
  • $\begingroup$ ...and 1 digit numbers, but I blame that on my poorly worded question, thank you for this answer $\endgroup$ – Tom De Vries Sep 19 '14 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

Improve this answer
$\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.