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.

$\endgroup$

6 Answers 6

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

$\endgroup$
1
  • $\begingroup$ All of these answers are useful, but this one best matches what I was looking for. $\endgroup$ Commented Sep 20, 2013 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}
$\endgroup$
4
  • 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$ Commented Sep 20, 2013 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
    Commented Sep 20, 2013 at 11:39
  • $\begingroup$ @Kuba: I took yours cause I like it best! But a good challenge is always welcome, more will come! $\endgroup$ Commented Sep 20, 2013 at 11:40
  • $\begingroup$ @PinguinDirk Indeed, it's the motor of the progress. :) and hank you, I'm glad you like it. $\endgroup$
    – Kuba
    Commented Sep 20, 2013 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
$\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]
$\endgroup$
2
  • $\begingroup$ What does the :> operator do? Could you link me to the documentation page? $\endgroup$ Commented Sep 20, 2013 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
    Commented Sep 20, 2013 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}

$\endgroup$
3
  • $\begingroup$ Ok, I've posted something faster than Tuples :) $\endgroup$
    – Kuba
    Commented Sep 20, 2013 at 7:39
  • $\begingroup$ you win :) @Kuba $\endgroup$ Commented Sep 20, 2013 at 10:08
  • $\begingroup$ I think the case is still open :) Thanks for the kick. $\endgroup$
    – Kuba
    Commented Sep 20, 2013 at 10:12
2
$\begingroup$

Here's a solution using GroupBy[]:

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