14
$\begingroup$

I am looking for the correct method for accomplishing the unknown piece in the following code snippet:

rolls = Tuples[Range[1, 4], {2}]

{{1, 1}, {1, 2}, {1, 3}, {1, 4}, {2, 1}, {2, 2}, {2, 3}, {2, 4}, {3, 1}, {3, 2}, 
{3, 3}, {3, 4}, {4, 1}, {4, 2}, {4, 3}, {4, 4}}

Tally[rolls, Min[#1] == Min[#2] &]

{{{1, 1}, 7}, {{2, 2}, 5}, {{3, 3}, 3}, {{4, 4}, 1}}

(*Unknown List Manipulation Code*)

(1*7 + 2*5 + 3*3 + 4*1)/Length[rolls]  
(*where previous result is of the form {{{a, b}, c}, ...}
the numerator is the sum of Min[a,b]*c for every item in the list that is the previous result*)

I can imagine some very complex solutions, but I suspect that there is an elegant functional solution that I am missing.

| improve this question | |
$\endgroup$
10
$\begingroup$ 
rolls = Tuples[Range[1, 4], {2}];
tally = Tally[rolls, Min[#1] == Min[#2] &];
lis = {{{1, 1}, 7}, {{2, 2}, 5}, {{3, 3}, 3}, {{4, 4}, 1}}
Total[Min@#[[1]]*#[[2]] & /@ lis]/Length[rolls]

Which gives:

15/8

| improve this answer | |
$\endgroup$
  • $\begingroup$ All of these answers are useful, but this one best matches what I was looking for. $\endgroup$ – Techrocket9 Sep 20 '13 at 2:31
12
$\begingroup$

Is this what you want?

Min /@ Tuples[Range[1, 4], {2}] // Mean

15/8

Pinguin Dirk forced me to post this:

f[n_, k_] := Range[n, k].Reverse@Range[1, 2 (k - n + 1), 2]/(k - n + 1)^2

it appears to be 10 times faster than:

Plus @@ Times @@@ Transpose@{##, Range[2 Length[#] - 1, 1, -2]
                            }/Length[#]^2 &@Range[50, 10000] // AbsoluteTiming

{0.010001, 100500125/29853}

f[50, 10000] // AbsoluteTiming

{0.001000, 100500125/29853}
| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ @Kuba: forced you? :) But I like the implementation! I was just inspired by other Q&As where people discuss how to avoid Tuples and its friends (and this was an easy one). Nice work $\endgroup$ – Pinguin Dirk Sep 20 '13 at 11:14
  • $\begingroup$ @PinguinDirk I totally agree, but you know: "let's test Kuba's solution... 1000 times slower". I had to respond :p $\endgroup$ – Kuba♦ Sep 20 '13 at 11:39
  • $\begingroup$ @Kuba: I took yours cause I like it best! But a good challenge is always welcome, more will come! $\endgroup$ – Pinguin Dirk Sep 20 '13 at 11:40
  • $\begingroup$ @PinguinDirk Indeed, it's the motor of the progress. :) and hank you, I'm glad you like it. $\endgroup$ – Kuba♦ Sep 20 '13 at 11:42
11
$\begingroup$

If it should be functional programming style, try this:

Plus @@ (Min @ #1  #2& @@@ {
  {{1, 1}, 7}, {{2, 2}, 5}, {{3, 3}, 3}, {{4, 4}, 1}})/Length[rolls]

15/8
| improve this answer | |
$\endgroup$
9
$\begingroup$

You want the sum of Min[a, b] c for every {{a, b}, c} in the list? You can quite literally do that.

rolls = Tuples[Range[1, 4], {2}];
tally = Tally[rolls, Min[#1] == Min[#2] &];
numerator = Total[tally /. {{a_, b_}, c_} :> Min[a, b] c]
result = numerator/Length[rolls]
| improve this answer | |
$\endgroup$
  • $\begingroup$ What does the :> operator do? Could you link me to the documentation page? $\endgroup$ – Techrocket9 Sep 20 '13 at 2:08
  • 3
    $\begingroup$ @Techrocket9 it's called RuleDelayed, you can just type :> in mathematica and hit F1 to get the documentation $\endgroup$ – ssch Sep 20 '13 at 2:08
6
$\begingroup$

I am assuming a sorted list as input - else Sort it first

Looking at the problem you want to solve, I suggest not to use Tuples, as this will get slow, the more rolls you have. So here's a way to solve it without Tuples, but rather basic combinatorics:

 Plus @@ Times @@@ Transpose@{##, Range[2 Length[#] - 1, 1, -2]}/Length[#]^2 &@Range[4]

15/8

To compare speed, I chose the nice solution of @Kuba, using Range[5,10000] (explicitly another starting point, to see if solutions agree) (note: Range[5,10000,2] etc also works)

Plus @@ Times @@@ Transpose@{##, Range[2 Length[#] - 1, 1, -2]}/
   Length[#]^2 &@Range[50, 10000] // AbsoluteTiming

{0.006532, 100500125/29853}

Min /@ Tuples[Range[50, 10000], {2}] // Mean // AbsoluteTiming

{6.524025, 100500125/29853}

| improve this answer | |
$\endgroup$
  • $\begingroup$ Ok, I've posted something faster than Tuples :) $\endgroup$ – Kuba♦ Sep 20 '13 at 7:39
  • $\begingroup$ you win :) @Kuba $\endgroup$ – Pinguin Dirk Sep 20 '13 at 10:08
  • $\begingroup$ I think the case is still open :) Thanks for the kick. $\endgroup$ – Kuba♦ Sep 20 '13 at 10:12
2
$\begingroup$

Here's a solution using GroupBy[]:

Total[KeyValueMap[Times, GroupBy[rolls, Min, Length]]]/Length[rolls]
   15/8
| 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.