Re: Re: equiprobable intervals with triangular pdf
- To: mathgroup at smc.vnet.net
- Subject: [mg41493] Re: [mg41475] Re: equiprobable intervals with triangular pdf
- From: Bobby Treat <drmajorbob+MathGroup3528 at mailblocks.com>
- Date: Thu, 22 May 2003 06:57:44 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Bob,
I corrected a couple of errors (dist undefined in equiProb, x arguments
not needed in Mean, Variance, Mode, etc.) and I extended the code to
asymmetric triangular distributions. I learned a lot in the process,
but not enough, I'm thinking!
I even started handling the two special cases, where the mode is at one
of the endpoints. That got really complicated if I defined those to be
TriangularDistribution[a_,a_,c_] or TriangularDistribution[a_,c_,c_],
and it got really tedious (hence unfinished) when I gave those
distributions their own names. I wonder if there's a best way to
handle that? (The tedious way, I'm thinking.)
OVER and OVER I ran into problems getting things to Simplify properly.
For instance CDF applied to the results of equiProb doesn't simplify,
if we leave things symbolic.
The behavior of UnitStep precisely at 0 was often a problem, too. That
made the following line necessary:
TriangularDistribution /: Quantile[TriangularDistribution[a_, b_, c_],
1] := c
Very annoying. I was free to use Which or If in some cases but held to
UnitStep instead -- and that may have caused some of my problems. But,
for the PDF at least, I needed UnitStep.
ClearAll[TriangularDistribution, DescendingTriangularDistribution,
AscendingTriangularDistribution, a, b, c, x, dist];
TriangularDistribution::usage = "TriangularDistribution[a, b, c]
represents
the triangular distribution defined on the interval [a, c] with
peak at \
b.\n TriangularDistribution[a, c] is TriangularDistribution[a, (a+c)/2,
c].";
DescendingTriangularDistribution::usage = \
"DescendingTriangularDistribution[a, b] is equivalent to \
TriangularDistribution[a, a, b]";
AscendingTriangularDistribution::usage =
"AscendingTriangularDistribution[a, \
b] is equivalent to TriangularDistribution[a, b, b]";
TriangularDistribution[args__] /; ! OrderedQ[{args}] := \
TriangularDistribution @@ Sort[{args}]
TriangularDistribution[a_, b_, b_] :=
AscendingTriangularDistribution[a, b]
TriangularDistribution[a_, a_, b_] :=
DescendingTriangularDistribution[a, b]
TriangularDistribution[a_, c_] := TriangularDistribution[a, (a + c)/2,
c]
AscendingTriangularDistribution /:
PDF[AscendingTriangularDistribution[a_,
c_], x_] :=
Evaluate[Simplify[((2*(-a + x))/((a - c)*(a - c)))*(UnitStep[x - a]
-
UnitStep[x - c])]]
DescendingTriangularDistribution /:
PDF[DescendingTriangularDistribution[a_, \
c_], x_] :=
Evaluate[Simplify[(-((2*(c - x))/((a - c)*(-a + \
c))))*(UnitStep[x - a] - UnitStep[x - c])]]
TriangularDistribution /: PDF[TriangularDistribution[a_, b_, c_], x_]
:=
Evaluate[Block[{one, two}, one = (2*(-a + x))/((a - b)*(a - c));
two = -((2*(c - x))/((b - c)*(-a + c)));
Simplify[UnitStep[x - a]*one + UnitStep[x - b]*(two -
one) - UnitStep[x - c]*two]]]
TriangularDistribution /: CDF[TriangularDistribution[a_, b_,
c_], x_] :=
Evaluate[FullSimplify[Integrate[PDF[TriangularDistribution[
a, b, c], x], x], a < b < c]]
TriangularDistribution /: Mean[TriangularDistribution[a_,
b_, c_]] := Simplify[(a + b + c)/3];
TriangularDistribution /: Mode[TriangularDistribution[a_, b_, c_]] := b;
TriangularDistribution /: Variance[TriangularDistribution[a_, b_, c_]]
:= \
Simplify[((a + b + c)^2 - 3*(a*b + b*c + a*c))/18];
TriangularDistribution /: StandardDeviation[TriangularDistribution[a_,
b_, \
c_]] := Sqrt[Simplify[((a + b + c)^2 - 3*(a*b + b*c + a*c))/18]];
TriangularDistribution /: Moment[
TriangularDistribution[a_, b_,
c_], (n_Integer)?NonNegative] :=
Simplify[(2*(a^(2 + n)*b - a*
b^(2 + n) - a^(2 + n)*c + b^(2 + n)*c + (a -
b)*c^(2 + \
n)))/((a - b)*(a - c)*(b - c)*(1 + n)*(2 + n))]
TriangularDistribution /: Quantile[TriangularDistribution[a_,
b_, c_], 1] := c
TriangularDistribution /: Quantile[TriangularDistribution[
a_, b_, c_], q_] := Evaluate[Block[{cutoff = (a - b)/(a - c),
one = a - Sqrt[a - b]*Sqrt[a - c]*Sqrt[q], two =
c - Sqrt[(-(a - c))*(b - c)*(-1 + q)]},
UnitStep[q]*one + UnitStep[q - cutoff]*(two - one) - UnitStep[q -
1]*two]]
TriangularDistribution /: equiProb[TriangularDistribution[a_, b_,
c_], (n_Integer)?
Positive] := Partition[Table[Quantile[TriangularDistribution[a, b,
c], k/
n], {k, 0, n}], 2, 1];
dist = TriangularDistribution[0, 1, 1/7];
Plot[Evaluate[#[dist,
x] & /@ {PDF, CDF, Quantile, x &}], {x, 0, 1}, PlotStyle ->
{Yellow, \
Red, Blue, Black}, AspectRatio -> Automatic, ImageSize -> 150];
Bobby
-----Original Message-----
From: Bob Hanlon <bobhanlon at aol.com>
To: mathgroup at smc.vnet.net
Subject: [mg41493] [mg41475] Re: equiprobable intervals with triangular pdf
It is generally better to define piecewise continuous functions with
UnitStep.
It is also recommended that you follow the conventions used in
Statistics`ContinuousDistributions` for defining distributions so that
use of
your distribution is consistent with use of the standard distributions.
<<snip>>