Scatole

Problema delle sei scatole per il workshop su CL

Inizializations

ClearAll["Global`*"]

<<  Graphics`Graphics`

<< Statistics`ContinuousDistributions`
<< Statistics`DiscreteDistributions`

<<  Graphics`Colors`

Try binomial distribution

n = 6;  pn = 1/2;

Newton Problem

N[PDF[BinomialDistribution[6, pn], 1]]

N[PDF[BinomialDistribution[12, pn], 2]]

N[PDF[BinomialDistribution[18, pn], 3]]

Six boxes - inizialization

x = {0, 1, 2, 3, 4, 5}

p0uni = 
        Table[PDF[DiscreteUniformDistribution[6], i], {i, 1, 
            6}];

p0bin = 
        Table[PDF[BinomialDistribution[5, 1/2], x[[i]]], {i, 1, 
            6}];

BarChart[p0uni, BarLabels -> x, PlotRange -> {0, 0.32}, 
      BarStyle -> {Green}]

BarChart[p0bin, BarLabels -> x, PlotRange -> {0, 0.32}, 
      BarStyle -> {Aquamarine}]

LikBlack = Table[(5 - i)/5, {i, 0, 5}];
LikWhite = Table[i/5, {i, 0, 5}];

LikScore =.

LikScore0[b_, w_, f_] := 
      PDF[BinomialDistribution[b + w, f], w]

LikScore[b_, w_, i_] := 
      If[i < 5, 
        If[i > 0, PDF[BinomialDistribution[b + w, i/5], w], 
          Limit[PDF[BinomialDistribution[b + w, eps], w], eps -> 0]], 
        Limit[PDF[BinomialDistribution[b + w, eps], w], eps -> 1]]

BarChart[LikBlack, BarLabels -> x, 
      BarStyle -> {GrayLevel[0.3]}]

BarChart[LikWhite, BarLabels -> x, 
      BarStyle -> {GrayLevel[0.8]}]

1rst Black if Binomial

binB0W0 = p0bin;

binB1W0 = binB0W0*LikBlack/binB0W0  . LikBlack;

BarChart[binB1W0, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 0.375}]

Also second Black

binB2W0 = binB1W0*LikBlack/binB1W0 . LikBlack;

BarChart[binB2W0, BarLabels -> x, 
      BarStyle -> {Aquamarine}]

5 Black, 0 white

nb = 5;  nw = 0;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 1}]

GenBin = binB0W0*GenLik/binB0W0 . GenLik;

BarChart[GenBin, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 0.735}]

8 Black, 0 white

nb = 8;  nw = 0;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 1}]

GenBin = binB0W0*GenLik/binB0W0 . GenLik;

BarChart[GenBin, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 0.85}]

7 Black, 0 white

nb = 7;  nw = 0;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 1}]

GenBin = binB0W0*GenLik/binB0W0 . GenLik;

BarChart[GenBin, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 0.53}]

1rst Black if Uniform

uniB0W0 = p0uni;

uniB1W0 = uniB0W0*LikBlack/uniB0W0  . LikBlack;

BarChart[uniB1W0, BarLabels -> x, BarStyle -> {Green}, 
      PlotRange -> {0, 0.375}]

Also second Black

uniB2W0 = uniB1W0*LikBlack/binB1W0 . LikBlack;

BarChart[uniB2W0, BarLabels -> x, BarStyle -> {Green}]

5 Black, 0 white

nb = 5;  nw = 0;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 1}]

GenUni = uniB0W0*GenLik/uniB0W0 . GenLik;

BarChart[GenUni, BarLabels -> x, BarStyle -> {Green}, 
      PlotRange -> {0, 0.735}]

8 Black, 0 white

nb = 8;  nw = 0;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 1}]

GenUni = uniB0W0*GenLik/uniB0W0 . GenLik;

BarChart[GenUni, BarLabels -> x, BarStyle -> {Green}, 
      PlotRange -> {0, 0.85}]

Mixing the two hypothesis

puni = 0.25;
mixB1W0 = uniB1W0*puni + binB1W0 (1 - puni);

BarChart[mixB1W0, BarLabels -> x, BarStyle -> {Orange}, 
      PlotRange -> {0, 0.375}]

puni = 0.5;
mixB1W0 = uniB1W0*puni + binB1W0 (1 - puni);

BarChart[mixB1W0, BarLabels -> x, BarStyle -> {Orange}, 
      PlotRange -> {0, 0.375}]

puni = 0.75;
mixB1W0 = uniB1W0*puni + binB1W0 (1 - puni);

BarChart[mixB1W0, BarLabels -> x, BarStyle -> {Orange}, 
      PlotRange -> {0, 0.375}]

10  extractions

7 Black, 3 white

nb = 7;  nw = 3;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 0.215}]

GenBin = binB0W0*GenLik/binB0W0 . GenLik;

BarChart[GenBin, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 0.625}]

GenUni = uniB0W0*GenLik/uniB0W0 . GenLik;

BarChart[GenUni, BarLabels -> x, BarStyle -> {Green}, 
      PlotRange -> {0, 0.625}]

30  extractions

23 Black, 7 white

nb = 23;  nw = 7;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 0.157}]

GenBin = binB0W0*GenLik/binB0W0 . GenLik;

BarChart[GenBin, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 0.87}]

GenUni = uniB0W0*GenLik/uniB0W0 . GenLik;

BarChart[GenUni, BarLabels -> x, BarStyle -> {Green}, 
      PlotRange -> {0, 0.87}]

50  extractions

41 Black, 9 white

nb = 41;  nw = 9;

GenLik = Table[LikScore[nb, nw, i], {i, 0, 5}];

BarChart[GenLik, BarLabels -> x, BarStyle -> {GrayLevel[0.5]}, 
      PlotRange -> {0, 0.15}]

GenBin = binB0W0*GenLik/binB0W0 . GenLik;

BarChart[GenBin, BarLabels -> x, BarStyle -> {Aquamarine}, 
      PlotRange -> {0, 1}]

GenUni = uniB0W0*GenLik/uniB0W0 . GenLik;

BarChart[GenUni, BarLabels -> x, BarStyle -> {Green}, 
      PlotRange -> {0, 1}]

``Upper limits"

nw = 0;

ProbNotH0Bin = 
        Table[{i, 2  i}, {i, 0, 30}];
ProbNotH0Uni = 
        Table[{i, 2  i}, {i, 0, 30}];
ProbH0Bin = 
        Table[{i, 2  i}, {i, 0, 30}];
ProbH0Uni = 
        Table[{i, 2  i}, {i, 0, 30}];
ProbRatio = Table[{i, 2  i}, {i, 0, 30}];

ProbH0Uni[[3, 1]]

Do[If[nb > 0, 
        GenLik = 
          Table[LikScore[nb, nw, i], {i, 0, 5}]; 
GenBin = 
          binB0W0*GenLik/binB0W0 . GenLik; 
GenUni = 
          uniB0W0*GenLik/
              uniB0W0 . GenLik; 
ProbH0Bin[[nb + 1, 
              2]] = N[
            GenBin[[1]]]; 
ProbH0Uni[[nb + 1, 2]] = 
          N[GenUni[[1]]]; 
ProbRatio[[nb + 1, 2]] = 
          N[GenBin[[1]]]/
            N[GenUni[[1]]]; 
ProbNotH0Bin[[nb + 1, 
              2]] = N[
            1 - GenBin[[1]]]; 
ProbNotH0Uni[[nb + 1, 
              2]] = N[
            1 - GenUni[[1]]], 
ProbH0Bin[[1, 2]] = 
          p0bin[[1]]; 
ProbH0Uni[[1, 2]] = 
          p0uni[[1]]; 
ProbRatio[[1, 2]] =  
          p0bin[[1]]/
            p0uni[[1]]; 
ProbNotH0Bin[[1, 2]] = 
          N[1 - p0bin[[1]]]; 
ProbNotH0Uni[[1, 
              2]] = N[1 - p0uni[[1]]]], 
{nb, 0, 
        30}]

N[ProbRatio[[2, 2]]]

PlotBin = ListPlot[ProbRatio, PlotRange -> {0, 1}]

PlotBin = 
      ListPlot[ProbH0Bin, PlotRange -> {{0, 30}, {0.01, 1}}]

<< Graphics`MultipleListPlot`

MultipleListPlot[ProbH0Uni, ProbH0Bin, 
      PlotRange -> {{0, 30}, {0.0, 1}}]

ProbH0Uni[[15, 1]]
ProbH0Uni[[15, 2]]

ProbH0Bin[[22, 1]]
ProbH0Bin[[22, 2]]