# CensoredDistribution fails for some custom distributions

Let this generating function

g[x_, M_, DD_, t_, d_, c_] :=
((c/DD)/x + (DD - t - c)/DD + (t - d) x/DD + (d/DD) x^2)^M


Now I define the following distribution

dist[M_,DD_:6,t_:2,d_:0,c_:0]:=ProbabilityDistribution[
If[-M <= k <= 2 M, Coefficient[g[x, M, DD, t, d, c], x, k],
0],{k,-M,2M,1},
Assumptions -> {DD ∈ Integers && DD > 0, t ∈ Integers && 1 <= t < DD,
d ∈ Integers && 0 <= d <= t, c ∈ Integers && 0 <= c <= DD - t}]


what works as expected. But when I try to censor the above distribution with this code

censoredDist[M_,DD_:6,t_:2,d_:0,c_:0]:=CensoredDistribution[{0,M},dist[M,DD,t,d,c]]


the censored distribution is totally wrong. Of course I can define, in various different ways, the censored distribution and provide a working code but I want to know if there is a way to fix this behavior of the command CensoredDistribution.

By example: strangely if I define the censored distribution using a more complicated method like this

p[x_, DD_, t_, d_, c_] :=
InterpolatingPolynomial[{{-1,
c/DD}, {0, (DD - t - c)/DD}, {1, (t - d)/DD}, {2, d/DD}}, x]

atomicDist[DD_: 6, t_: 2, d_: 0, c_: 0] :=
ProbabilityDistribution[p[k, DD, t, d, c], {k, -1, 2, 1},
Assumptions -> {DD ∈ Integers && DD > 0,
t ∈ Integers && 1 <= t < DD,
d ∈ Integers && 0 <= d <= t,
c ∈ Integers && 0 <= c <= DD - t}]

censoredDist2[M_: 5, DD_: 6, t_: 2, d_: 0, c_: 0] :=
CensoredDistribution[{0, M},
TransformedDistribution[Sum[a[i], {i, M}],
Table[a[i] \[Distributed] atomicDist[DD, t, d, c], {i, M}]
]]


it works perfectly fine (except that this way to do it is very slow).

UPDATE: I will add an example to show what is going on

DiscretePlot[Evaluate@PDF[#[5, 6, 2, 1, 1], j], {j, -5, 10},
ExtentSize -> 1/2] & /@ {dist, censoredDist}

• It would be helpful if you stated explicitly an example as to how it "is totally wrong". – JimB Mar 27 '17 at 4:21

2nd Update

Given your added example and replacing the function Coefficient by SeriesCoefficient, everything works fine. Here is the complete code:

g[x_, M_, DD_, t_, d_, c_] := ((c/DD)/x + (DD - t - c)/DD + (t - d) x/DD + (d/DD) x^2)^M

dist[M_, DD_: 6, t_: 2, d_: 0, c_: 0] :=
ProbabilityDistribution[
If[-M <= k <= 2 M,
SeriesCoefficient[g[x, M, DD, t, d, c], {x, 0, k}], 0], {k, -M,
2 M, 1},
Assumptions -> {DD ∈ Integers && DD > 0,
t ∈ Integers && 1 <= t < DD,
d ∈ Integers && 0 <= d <= t,
c ∈ Integers && 0 <= c <= DD - t}]

censoredDist[M_, DD_: 6, t_: 2, d_: 0, c_: 0] :=
CensoredDistribution[{0, M}, dist[M, DD, t, d, c]]

DiscretePlot[Evaluate@PDF[#[5, 6, 2, 1, 1], j], {j, -5, 10},
ExtentSize -> 1/2] & /@ {dist, censoredDist}


Looking at the individual probabilities we have the following for the uncensored and censored distributions:

pUncensored = Table[Evaluate[{k, PDF[dist[5, 6, 2, 1, 1], k]}], {k, -5, 10}]


pCensored = Table[Evaluate[{k, PDF[censoredDist[5, 6, 2, 1, 1], k]}], {k, -5, 10}]


As a check we can perform a brute force calculation from the uncensored probabilities to obtain the censored probabilities:

pBruteForce = pUncensored;
pBruteForce[[{1, 2, 3, 4, 5}, 2]] = 0;
pBruteForce[[{12, 13, 14, 15, 16}, 2]] = 0;
pBruteForce[[6, 2]] = Total[pUncensored[[{1, 2, 3, 4, 5, 6}, 2]]];
pBruteForce[[11, 2]] = Total[pUncensored[[{11, 12, 13, 14, 15, 16}, 2]]];
pBruteForce


We see that use of the CensoredDistribution function gives the same values as the brute force approach.

Update

I left off a change I made in the definition of the non-censored distribution. I replaced the Coefficient function with the SeriesCoefficient function (as suggested by @J.M. in a previous question by the OP). I've now given the complete set of code below.

Here is how to make things work with CensoredDistribution:

(* Generating function *)
g[x_, M_, DD_, t_, d_,
c_] := ((c/DD)/x + (DD - t - c)/DD + (t - d) x/DD + (d/DD) x^2)^M

(* Define non-censored distribution *)
dist[M_, DD_: 6, t_: 2, d_: 0, c_: 0] :=
ProbabilityDistribution[
SeriesCoefficient[g[x, M, DD, t, d, c], {x, 0, k}], {k, -M, 2 M, 1},
Assumptions -> {DD ∈ Integers && DD > 0,
t ∈ Integers && 1 <= t < DD,
d ∈ Integers && 0 <= d <= t,
c ∈ Integers && 0 <= c <= DD - t}]

(* Define censored distribution *)
censoredDist[M_, DD_: 6, t_: 2, d_: 0, c_: 0] :=
CensoredDistribution[{0, M}, dist[M, DD, t, d, c]]

(*Set parameters*)
{MM, DDD, tt, dd, cc} = {8, 6, 2, 1, 1};

(* Check on assupmptions *)
MM > 0
DDD > 1
1 <= tt < DDD
0 <= dd <= tt
0 <= cc <= DDD - tt

(* Determine the non-censored distribution *)
prob = Table[
Evaluate[PDF[dist[MM, DDD, tt, dd, cc], k]], {k, -MM, 2 MM, 1}];

(* Calculate the censored distribution but summing the appropriate
values from the non-censored distribution *)
longWay = Flatten[{Sum[prob[[i]], {i, 1, MM + 1}],
Table[prob[[i]], {i, MM + 2, 2 MM}],
Sum[prob[[i]], {i, 2 MM + 1, 3 MM + 1}]}]
(* {19853/93312,4505/34992,30649/209952,15155/104976,52759/419904,
10157/104976,4639/69984,1411/34992,32869/839808} *)

(* Now determine the censored probabilities from the use of CensoredDistribution *)
directWay = Table[Evaluate[PDF[censoredDist[MM, DDD, tt, dd, cc], k]], {k, 0, MM}]
(* {19853/93312,4505/34992,30649/209952,15155/104976,52759/419904,
10157/104976,4639/69984,1411/34992,32869/839808} *)

longWay == directWay
(* True *)


I've had to include an Evaluate function otherwise I get the following:

(* Determine the non-censored distribution *)
prob = Table[Evaluate[PDF[dist[MM, DDD, tt, dd, cc], k]], {k, -MM, 2 MM, 1}]

(* {1/1679616, 1/69984, 65/419904, 211/209952, 3689/839808, 2905/209952,
4627/139968, 487/7776, 164047/1679616,
PDF[ProbabilityDistribution[4505/34992, {\[FormalX], -8, 16, \[FormalX]},
Assumptions -> {True, True, True, True}],
1], 30649/209952, 15155/104976, 52759/419904, 10157/104976,
4639/69984, 1411/34992, 36751/1679616, 733/69984, 623/139968,
343/209952, 49/93312, 29/209952, 13/419904, 1/209952, 1/1679616} *)


I can't explain why that one element in the table needs Evaluate[] to work. It seems to only happen when k=1 (on the few examples I've tried).

• Please give an example of "fails completely". – JimB Mar 27 '17 at 15:30
• I'm sorry I've not been clear: Please add a non-working example to your question and show the output that causes the concern. The following works fine for me: Table[Evaluate[PDF[dist[5, 10, 2, 1, 1], k]], {k, -5, 10, 1}] Table[Evaluate[PDF[censoredDist[5, 10, 2, 1, 1], k]], {k, 0, 5}]. – JimB Mar 27 '17 at 15:39
• Your example shows exactly what should occur. I think you might not understand what a censored distribution is. All of the probability associated with -5, -4, -3, -2, -1, and 0 are summed and placed on zero in the censored distribution. Just as the probability of 5, 6, 7, 8, 9, and 10 are summed and place on 5 in the censored distribution. Might you really want a truncated distribution? – JimB Mar 27 '17 at 15:49