Rolling Dices

compBinomialDistr[
     np_] := {Table[
      PDF[BinomialDistribution[np, 1./6], k], {k, 0, np}], np/6, 
     np*(1 - 1/6)*1/6}; 
   compSumDistr[np_] := 
    Module[{dst}, 
     dst = CoefficientList[Expand[Plus @@ (x^Range[6])^np]/6^np, 
       x]; {dst, compMean[dst, -1], compVar[dst, False]}]; 
   compMean[list_, offset_] := 
    Module[{np, rng, tot}, tot = Plus @@ list; 
     If[tot == 0, "", np = Length[list]; rng = Range[np]; 
      offset + Plus @@ (rng*list)/Plus @@ list]]; 
   compVar[list_, isSample_] := 
    Module[{np, rng, tot, mean}, tot = Plus @@ list; 
     If[tot < 2 && isSample, "", np = Length[list]; rng = Range[np]; 
      mean = Plus @@ (rng*list)/tot; 
      Plus @@ ((rng - mean)^2*list)/(tot - If[isSample, 1, 0])]]

Manipulate[
 Text@Row[{
    Column[{
      Grid[choiceGr, 
       Frame -> {None, 
         None, # -> True & /@ Position[choiceGr, Except[""]]}, 
       Background -> {None, None, # -> Pink & /@ sixes}], 
      Row[{Style[
         "number of sixes (last roll): " <> ToString[nsixes]]}], 
      Row[{Style["sum of dice (last roll): " <> ToString[sum]]}],
      Grid[{{
         Button["new roll", rollMany[1, num]], SpanFromLeft, 
         SpanFromLeft}, {Button["100 rolls", rollMany[100, num]], 
         Button["1000 rolls", rollMany[1000, num]], 
         Button["reset", 
          distr = ConstantArray[0, #] & /@ (1 + {1, 5} num); nrun = 0;
           choiceGr = 
           Partition[
            PadRight[Table[Image[ConstantArray[1, {24, 24}]], {num}], 
             5*Ceiling[num/5], ""], 5]; sixes = {}; nsixes = 0; 
          sum = 0]}}]}], "  ",
    Column[{
      Row[{Style["show data for:  "],
        PopupMenu[
         Dynamic[graphToShow], {1 -> "number of 6's", 
          2 -> "sum of dice"}]}], 
      Show[DiscretePlot[((1 - Boole[showFreq])*(Max[{nrun, 1}] - 
              100) + 100)*distributions[[graphToShow, 1, k + 1]], 
        Evaluate[{{k, 0, num}, {k, num, 6 num}}[[graphToShow]]], 
        ExtentSize -> Scaled[0.85], PlotStyle -> Opacity[0], 
        FillingStyle -> 
         Directive[{Yellow, Green}[[graphToShow]], 
          Opacity[Dynamic[If[showPDF, 0.65, 0]]]], 
        PlotRange -> {All, {0, All}}], 
       ListPlot[
        distr[[graphToShow]]/(Boole[
             showFreq]*(0.01 Max[{nrun, 1}] - 1) + 1), Filling -> 0, 
        FillingStyle -> Directive[Blue, Thickness[0.002]], 
        DataRange -> {{0, num}, {num, 6 num}}[[graphToShow]], 
        PlotRange -> All],
       ImageSize -> {400, 300}, PlotRange -> All, 
       Epilog -> 
        If[showMean, {Inset[
           Style[Grid[{{"", "empirical", "theoretical"}, {"μ", 
               compMean[
                 distr[[graphToShow]], {-1, num - 1}[[graphToShow]]] //
                 N, distributions[[graphToShow, 2]] // 
                N}, {"\!\(\*SuperscriptBox[\(σ\), \(2\)]\)", 
               compVar[distr[[graphToShow]], True] // N, 
               distributions[[graphToShow, 3]] // N}}, Frame -> All], 
            Medium], Scaled[{0.8, 0.87}]]}, {}]], 
      Row[{(If[n != num, 
          distr = ConstantArray[0, #] & /@ (1 + {1, 5} n); 
          distributions = {compBinomialDistr[n], 
            compSumDistr[n] // N}; nrun = 0; 
          choiceGr = 
           Partition[
            PadRight[Table[Image[ConstantArray[1, {24, 24}]], {n}], 
             5*Ceiling[n/5], ""], 5]; sixes = {}; nsixes = 0; sum = 0;
           num = n]; "number of rolls = " <> ToString[nrun])}], 
      Spacer[{1, 90}]}, Alignment -> Center]}], {{n, 30, 
   "number of dice in one roll"}, 5, 50, 1, 
  Appearance -> {"Medium", "Labeled"}}, {{showPDF, False, 
   "theoretical distribution"}, {False, True}},
 {{showFreq, False, "percentage frequencies"}, {False, 
   True}}, {{showMean, False, "show mean and variance"}, {False, 
   True}}, {{dice, {, , , , , }}, 
  None}, {{blank, Image[ConstantArray[1, {24, 24}]]}, 
  None}, {{sixes, {}}, 
  None}, {{choiceGr, 
   With[{ni = 30}, 
    Partition[
     PadRight[Table[Image[ConstantArray[1, {24, 24}]], {ni}], 
      5*Ceiling[ni/5], ""], 5]]}, 
  None}, {{distr, 
   With[{ni = 30}, ConstantArray[0, #] & /@ (1 + {1, 5} ni)]}, 
  None}, {{distributions, 
   With[{ni = 30}, {compBinomialDistr[ni], compSumDistr[ni] // N}]}, 
  None}, {{nsixes, 0}, None}, {{sum, 0}, None}, {{nrun, 0}, 
  None}, {choice, None}, {{graphToShow, 1}, None}, {{num, 30}, 
  None}, {{rollMany, (Do[choice = RandomChoice[dice, #2]; 
      nsixes = Count[choice, ]; distr[[1, 1 + nsixes]]++; 
      sum = Plus @@ ((Position[dice, #[[1]]]*#[[2]]) & /@ 
           Tally[choice] // Flatten); 
      distr[[2, 1 + sum - #2]]++, {#1}]; 
     choiceGr = Partition[PadRight[choice, 5*Ceiling[#2/5], ""], 5]; 
     sixes = Position[choiceGr, ]; nrun += #1) &}, None}, SaveDefinitions->True]