10

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.

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
Tom De Vries
  • 3,758
  • 18
  • 36
  • 2
    "I got the answer 68 ways" is an ambiguous statement. Believe it or not, I first inferred (what I think was) the incorrect meaning. – Daniel Lichtblau Sep 19 '14 at 15:56
  • What's wrong with numbers smaller than 10? – Igor Rivin Sep 19 '14 at 17:18
  • 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. – Daniel Lichtblau Sep 19 '14 at 17:31
  • 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? – eldo Sep 19 '14 at 18:02
  • 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! – Tom De Vries Sep 19 '14 at 20:54

4 Answers4

9

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.

ybeltukov
  • 43,673
  • 5
  • 108
  • 212
  • +1 But: "I wondered how to eliminate the values less than 10 (without using another Select)" – eldo Sep 19 '14 at 17:14
  • @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 – Bob Hanlon Sep 19 '14 at 18:24
  • @Eldo - for eliminating numbers less than 10: Select[Range[0, 999], # \[Intersection] Range[0, 5] == Sort@# &@IntegerDigits@# && EvenQ@# && Length@IntegerDigits@# > 1 &] gives 65 numbers – Bob Hanlon Sep 19 '14 at 18:37
  • 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! – Tom De Vries Sep 19 '14 at 21:05
  • @TomDeVries There is an equivalent form: Cases[Range[0, 999], x_ /; Module[{id = IntegerDigits[x]}, id ⋂ Range[0, 5] == Sort[id] && EvenQ[x]]]. However I recommend you to read What the @#%^&*?! do all those funny signs mean?. It is a really fun part of Mathematica which allows you to write a very compact code. – ybeltukov Sep 19 '14 at 21:44
  • 2
    +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] – Simon Woods Sep 19 '14 at 22:42
7
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
Karsten7
  • 27,448
  • 5
  • 73
  • 134
  • I agree with your excellent answer. As the question is posed the only correct result is 65 :) – eldo Sep 19 '14 at 19:05
  • 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 – Tom De Vries Sep 19 '14 at 20:59
  • @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. – Karsten7 Sep 19 '14 at 22:44
5
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

eldo
  • 67,911
  • 5
  • 60
  • 168
  • 1
    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.) – Mr.Wizard Sep 19 '14 at 15:14
  • Eliminating numbers less than 100: Select[FromDigits /@ Permutations[{0, 1, 2, 3, 4, 5}, {3}], EvenQ@# && Length@IntegerDigits@# == 3 &] // Length gives 52 – Bob Hanlon Sep 19 '14 at 18:21
  • You are missing out all even two digit numbers with a 0 as the last digit. – Karsten7 Sep 19 '14 at 18:34
  • ...and 1 digit numbers, but I blame that on my poorly worded question, thank you for this answer – Tom De Vries Sep 19 '14 at 20:55
1

"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

Dr. belisarius
  • 115,881
  • 13
  • 203
  • 453