-1
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ It would be helpful if you stated explicitly an example as to how it "is totally wrong". $\endgroup$ – JimB Mar 27 '17 at 4:21
3
$\begingroup$

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}

Uncensored and censored figures

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}]

Uncensored probabilities

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

Censored probabilities

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

Censored probabilities by brute force

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).

$\endgroup$
  • $\begingroup$ Please give an example of "fails completely". $\endgroup$ – JimB Mar 27 '17 at 15:30
  • $\begingroup$ 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}]. $\endgroup$ – JimB Mar 27 '17 at 15:39
  • $\begingroup$ 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? $\endgroup$ – JimB Mar 27 '17 at 15:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.