(*Mathematica 7's Discrete Distributions by Nasser M. Abbasi version December 28, 2013*) Manipulate[ Row[{ Dynamic[Refresh[ Switch[ dynamicsInitialized, {True, True, True, True, True, True, True, True, True, True, True, False}, dynamicsInitialized[[12]] = True; gdist = gdistInitial; gfrom = gfromInitial; gcdf = gcdfInitial, {True, True, True, True, True, True, True, True, True, True, True, True}, gdistInitial = gdist; gfromInitial = gfrom; gcdfInitial = gcdf ]; process[gdist, gfrom, gcdf, barChartColor, quantile], TrackedSymbols :> {quantile, barChartColor, \[Theta], pZipf, nHyperGeometric nBlackHyperGeometric, nTotalHyperGeometric, \[Alpha]BetaNegativeBinomial, \ \[Beta]BetaNegativeBinomial, nBetaNegativeBinomial, nBetaBinomial, \[Alpha]BetaBinomial, \[Beta]BetaBinomial, min, discreteUniformMax, nNegativeBinomial, pNegativeBinomial, nBinomial, pBinomial, pGeometric, pBernoulli, \[Lambda], dynamicsInitialized}] ], Dynamic[ Refresh[dynamicsInitialized[[1]] = True; gdist = PoissonDistribution[\[Lambda]]; gfrom = 0; gcdf = .999; "", TrackedSymbols -> {\[Lambda]}]], Dynamic[ Refresh[dynamicsInitialized[[2]] = True; gdist = BernoulliDistribution[pBernoulli]; gfrom = 0; gcdf = 1; "", TrackedSymbols -> {pBernoulli}]], Dynamic[ Refresh[dynamicsInitialized[[3]] = True; gdist = GeometricDistribution[pGeometric]; gfrom = 0; gcdf = .999; "", TrackedSymbols -> {pGeometric}]], Dynamic[ Refresh[dynamicsInitialized[[4]] = True; gdist = BinomialDistribution[Round[nBinomial], pBinomial]; gfrom = 0; gcdf = .999; "", TrackedSymbols -> {nBinomial, pBinomial}]], Dynamic[ Refresh[dynamicsInitialized[[5]] = True; gdist = NegativeBinomialDistribution[Round[nNegativeBinomial], If[pNegativeBinomial == 0, 0.01, pNegativeBinomial]]; gfrom = 0; gcdf = .999; "", TrackedSymbols -> {nNegativeBinomial, pNegativeBinomial}]], Dynamic[ Refresh[dynamicsInitialized[[6]] = True; gdist = DiscreteUniformDistribution[{min, If[discreteUniformMax < min, discreteUniformMax = min, discreteUniformMax]}]; gfrom = min - 1; gcdf = 1; "", TrackedSymbols -> {discreteUniformMax, min}]], Dynamic[ Refresh[dynamicsInitialized[[7]] = True; gdist = BetaBinomialDistribution[\[Alpha]BetaBinomial, \ \[Beta]BetaBinomial, Round[nBetaBinomial]]; gfrom = 0; gcdf = 1; "", TrackedSymbols -> {\[Alpha]BetaBinomial, \[Beta]BetaBinomial, nBetaBinomial}]], Dynamic[ Refresh[dynamicsInitialized[[8]] = True; gdist = BetaNegativeBinomialDistribution[\[Alpha]\ BetaNegativeBinomial, \[Beta]BetaNegativeBinomial, Round[nBetaNegativeBinomial]]; gfrom = 0; gcdf = .85; "", TrackedSymbols -> {\[Alpha]BetaNegativeBinomial, \ \[Beta]BetaNegativeBinomial, nBetaNegativeBinomial}]], Dynamic[ Refresh[dynamicsInitialized[[9]] = True; gdist = HypergeometricDistribution[ Round[ If[nHyperGeometric > nTotalHyperGeometric, nHyperGeometric = nTotalHyperGeometric, nHyperGeometric]], Round[If[nBlackHyperGeometric > nTotalHyperGeometric, nBlackHyperGeometric = nTotalHyperGeometric, nBlackHyperGeometric]], Round[nTotalHyperGeometric]]; gfrom = 0; gcdf = 1; "", TrackedSymbols -> {nHyperGeometric, nTotalHyperGeometric, nBlackHyperGeometric}]], Dynamic[ Refresh[dynamicsInitialized[[10]] = True; gdist = LogSeriesDistribution[\[Theta]]; gfrom = 0; gcdf = .99; "", TrackedSymbols -> {\[Theta]}]], Dynamic[ Refresh[dynamicsInitialized[[11]] = True; gdist = ZipfDistribution[pZipf]; gfrom = 0; gcdf = .99; "", TrackedSymbols -> {pZipf}]] }], Grid[{ { Labeled[ Control[{{\[Lambda], 5.1, Style["\[Lambda]", 10, AutoSpacing -> False]}, 0.1, 30, .1, ImageSize -> Tiny, Appearance -> "Labeled"}] , Style["Poisson", 10, Bold], {{Top, Left}}], Labeled[ Control[{{pBernoulli, 0.1, Style["p", 10, AutoSpacing -> False]}, 0, 1, .025, ImageSize -> Tiny, Appearance -> "Labeled"}], Style["Bernoulli", 10, Bold], {{Top, Left}}], Labeled[ Control[{{pGeometric, 0.5, Style[" p ", 10, AutoSpacing -> False]}, 0.1, 1, .01, ImageSize -> Tiny, Appearance -> "Labeled"}], Style["Geometric", 10, Bold], {{Top, Left}}] },(*second row *){ Labeled[Grid[{{ Control[{{nBinomial, 40, Style["n", 10, AutoSpacing -> False]}, 1, 100, 1, ImageSize -> Tiny, Appearance -> "Labeled"}]} , {Control[{{pBinomial, 0.1, Style["p", 10, AutoSpacing -> False]}, 0, 1, 0.05, ImageSize -> Tiny, Appearance -> "Labeled" }] }}], Style["Binomial", 10, Bold], {{Top, Left}} ], Labeled[ Grid[ {{ Control[{{nNegativeBinomial, 2, Style["n", 10, AutoSpacing -> False]}, 1, 10, 1, ImageSize -> Tiny, Appearance -> "Labeled" }]} , {Control[{{pNegativeBinomial, 0.26, Style["p", 10, AutoSpacing -> False]}, .1, 1, 0.1, ImageSize -> Tiny, Appearance -> "Labeled" }] }}], Style["Negative Binomial", 10, Bold], {{Top, Left}} ], Labeled[ Grid[ {{ Control[{{min, 2, Style["min ", 10, AutoSpacing -> False]}, -8, 8 - 1, 1, ImageSize -> Tiny, Appearance -> "Labeled" }]} , {Control[{{discreteUniformMax, 8, Style["max ", 10, AutoSpacing -> False]}, -8 + 1, 8, 1, ImageSize -> Tiny, Appearance -> "Labeled" }] }}], Style["Discrete Uniform", 10, Bold], {{Top, Left}}]}, { (*third row *) Labeled[ Grid[ {{ Control[{{\[Alpha]BetaBinomial, .41, Style["\[Alpha]", 10, AutoSpacing -> False]}, 0.01, 2, 0.01, ImageSize -> Tiny, Appearance -> "Labeled" }]} , {Control[{{\[Beta]BetaBinomial, 0.28, Style["\[Beta]", 10, AutoSpacing -> False]}, 0.01, 1, 0.01, ImageSize -> Tiny, Appearance -> "Labeled"}]}, {Control[{{nBetaBinomial, 12, Style["n", 10, AutoSpacing -> False]}, 1, 20, 1, ImageSize -> Tiny, Appearance -> "Labeled"}] }}], Style["Beta Binomial", 10, Bold], {{Top, Left}} ], Labeled[ Grid[ {{ Control[{{\[Alpha]BetaNegativeBinomial, 3, Style["\[Alpha]", 10, AutoSpacing -> False]}, 2.01, 6, 0.1, ImageSize -> Tiny, Appearance -> "Labeled"}]} , {Control[{{\[Beta]BetaNegativeBinomial, .71, Style["\[Beta]", 10, AutoSpacing -> False]}, 0.01, 5, 0.1, ImageSize -> Tiny, Appearance -> "Labeled"}]}, {Control[{{nBetaNegativeBinomial, 6, Style["n", 10, AutoSpacing -> False]}, 1, 10, 1, ImageSize -> Tiny, Appearance -> "Labeled" }] }}], Style["Beta Negative Binomial", 10, Bold], {{Top, Left}} ], Labeled[ Grid[ {{ Control[{{nHyperGeometric, 6, Style["n ", 10, AutoSpacing -> False]}, 0, 40, 1, ImageSize -> Tiny, Appearance -> "Labeled"}]} , {Control[{{nBlackHyperGeometric, 6, Style["\!\(\*SubscriptBox[\(n\), \(\(succ\)\(\\\ \)\)]\)", 10, AutoSpacing -> False]}, 0, 40, 1, ImageSize -> Tiny, Appearance -> "Labeled"}]}, {Control[{{nTotalHyperGeometric, 30, Style["\!\(\*SubscriptBox[\(n\), \(tot\)]\) ", 10, AutoSpacing -> False]}, 1, 40, 1, ImageSize -> Tiny, Appearance -> "Labeled" }] }}], Style["Hypergeometric", 10, Bold], {{Top, Left}} ]}, { (*4th row *) Labeled[ Control[{{\[Theta], 0.5, Style["\[Theta]", 10, AutoSpacing -> False]}, 0.01, 1 - .02, 0.01, ImageSize -> Tiny, Appearance -> "Labeled"}] , Style["Logarithmic Series", 10, Bold], {{Top, Left}}], Labeled[ Control[{{pZipf, 1.5, Style["p", 10, AutoSpacing -> False]}, 1, 4, 0.01, ImageSize -> Tiny, Appearance -> "Labeled" }] , Style["Zipf", 10, Bold], {{Top, Left}}], Grid[{{Labeled[ Control[{{barChartColor, Yellow, ""}, {Red -> Style["Red", sz], LightRed -> Style["Light Red", sz], Green -> Style["Green", sz], LightGreen -> Style["Light Green", sz], Yellow -> Style["Yellow", sz], Blue -> Style["Blue", sz], LightBlue -> Style["Light Blue", sz], Black -> Style["Black", sz], Gray -> Style["Gray", sz], LightGray -> Style["Light Gray", sz], Cyan -> Style["Cyan", sz], LightCyan -> Style["Light Cyan", sz], Magenta -> Style["Magenta", sz], LightMagenta -> Style["Light Magenta", sz], Brown -> Style["Brown", sz], LightBrown -> Style["Light Brown", sz], Orange -> Style["Orange", sz], LightOrange -> Style["Light Orange", sz], Pink -> Style["Pink", sz], LightPink -> Style["Light Pink", sz]}, ControlType -> PopupMenu}], Style["bar color", 10], Bottom], Labeled[ Control[{{quantile, .99, ""}, {.99 -> Style["99%", sz], .98 -> Style["98%", sz], .97 -> Style["97%", sz], .96 -> Style["96%", sz], .95 -> Style["95%", sz], .90 -> Style["90%", sz], .75 -> Style["75%", sz], .50 -> Style["50%", sz], .25 -> Style["25%", sz], .15 -> Style["15%", sz], .05 -> Style["5%", sz], .025 -> Style["2.5%", sz], .01 -> Style["1%", sz]}, ControlType -> PopupMenu}], Style["quantile", 10], Bottom]}}]}} , Frame -> All, FrameStyle -> Directive[AbsoluteThickness[.1], Gray], Spacings -> {0, 2}, ItemSize -> {{20, 20, 22}}], {{gdist, PoissonDistribution[5.2]}, ControlType -> None}, {{gfrom, 0}, ControlType -> None}, {{gcdf, .999}, ControlType -> None}, {{gdistInitial, PoissonDistribution[5.2]}, ControlType -> None}, {{gfromInitial, 0}, ControlType -> None}, {{gcdfInitial, .999}, ControlType -> None}, {{sz, 10}, ControlType -> None}, (*size of labels for controls, see above *) {{plotWidth, 246}, ControlType -> None}, {{plotHeight, 153}, ControlType -> None}, {{plotImagePadding, 32}, ControlType -> None}, {{cdft, Style["cumulative distribution function", Medium, Bold]}, ControlType -> None}, {{pmft, Style["probability mass function", Medium, Bold]}, ControlType -> None}, {{dynamicsInitialized, {False, False, False, False, False, False, False, False, False, False, False, False}}, ControlType -> None}, FrameMargins -> 0, ImageMargins -> 0, ContinuousAction -> False, SynchronousUpdating -> True, AutorunSequencing -> Range[3], Initialization :> ( dynamicsInitialized = {False, False, False, False, False, False, False, False, False, False, False, False}; process[dist_, from_, cdfUpper_, barChartColor_, quantile_] := Module[{label, cdfLabel, mean, var, vquantile, skew, kurtosis, k, pdf, cdf, max, tbl, to}, {mean, var, vquantile, skew, kurtosis} = getStats[dist, quantile]; to = InverseCDF[dist, cdfUpper]; tbl = Table[PDF[dist, k], {k, from, to}]; max = Max[tbl]; pdf = BarChart[tbl, BarSpacing -> None, ChartStyle -> barChartColor, ImageSize -> {plotWidth, plotHeight}, AspectRatio -> 0.48, Frame -> True, AxesOrigin -> {0, 0}, FrameTicks -> {{Automatic, None}, {None, None}}, TicksStyle -> Small, PlotLabel -> None, FrameLabel -> {{None, None}, {None, pmft}}, PlotRange -> {Automatic, {0, 1.4 max}}, ImagePadding -> plotImagePadding, ChartLabels -> Placed[chartLabels[Length[tbl], {from, to}], Axis], LabelingFunction -> (Placed[Style[#, Red, Bold], Tooltip] &) ]; tbl = makeCDFdata[Table[CDF[dist, k], {k, from, to}] , from, to]; cdf = ListPlot[tbl, AspectRatio -> 0.48, Joined -> True, Frame -> True, ImagePadding -> plotImagePadding, TicksStyle -> Small, ImageSize -> {plotWidth, plotHeight}, PlotRange -> {Automatic, {0, 1.1}}, AxesOrigin -> {0, 0}, FrameTicks -> {{Automatic, None}, {Automatic, None}}, FrameLabel -> {{None, None}, {None, cdft}}, PlotLabel -> None, PlotStyle -> {Black, Thick}, Axes -> {True, False} ]; Panel[ Grid[{ { Panel[ Grid[{ {Style[ToString[dist], 11, Red, Bold]}, {Grid[ {{Style["mean", Bold], Style["variance", Bold], Style["quantile", Bold], Style["skew", Bold], Style["kurtosis", Bold]}, {mean, var, vquantile, skew, kurtosis} }, ItemSize -> {{11, 12, 13, 12, 11}}, Alignment -> Center, Spacings -> {0, 0} ] } } ], FrameMargins -> Medium ], SpanFromLeft }, {Grid[{{pdf, cdf}}]} }, Frame -> None, Alignment -> Center, Spacings -> {0, 0}, ItemSize -> {{61}} ], FrameMargins -> 0, Alignment -> Center ] ]; chartLabels[len_, limits_] := Module[{y = 10, r, incr, from = limits[[1]], to = limits[[2]]}, If[len <= y, r = Range[from, to], {incr = Round[len/y]; r = Table["", {i, 0, len - 1}]; For[i = 1, i <= len, i = i + 1, If[Mod[i - 1, incr] == 0, r[[i]] = from + (i - 1)]] }]; r ]; makeCDFdata[data_, from_, to_] := Module[{i, x, d}, x = Table[i, {i, from, to, 1}]; d = Flatten[ Table[ {{ x[[i]], data[[i]]}, {x[[i]] + 1, data[[i]] }}, {i, 1, Length[x]}], 1 ]; Flatten[ Table[ {Tooltip[ d[[i]], N[d[[i, 2]]], LabelStyle -> Directive[Red, Bold]]}, {i, 1, Length[d]}], 1] ]; getStats[dist_, quantile_] := Module[{mean, var, vquantile, skew, kurtosis}, mean = N[Quiet[Mean[dist], {Power::infy, Infinity::indet}]]; If[mean === ComplexInfinity, mean = Infinity]; var = N[Quiet[Variance[dist], {Power::infy, Infinity::indet}]]; If[var === ComplexInfinity, var = Infinity]; vquantile = Quiet[Quantile[dist, quantile], {Power::infy, Infinity::indet}]; If[vquantile === ComplexInfinity, vquantile = Infinity]; skew = N[Quiet[Skewness[dist], {Power::infy, Infinity::indet}]]; If[skew === ComplexInfinity, skew = Infinity]; kurtosis = N[Quiet[Kurtosis[dist], {Power::infy, Infinity::indet}]]; If[kurtosis === ComplexInfinity, kurtosis = Infinity]; {mean, var, vquantile, skew, kurtosis} ]; ), SynchronousInitialization -> True ]