Skip to content

Fix mean and variance with mode le truncated min #2

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
rjvdboon wants to merge 2 commits into
base: main
Choose a base branch
from
Open

Fix mean and variance with mode le truncated min #2

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
943135f
Fix mean and var when mode is lower than trunc min
robert-vanderboon Mar 24, 2023
c86a6d0
More flexible Simulation.R for easier debugging
robert-vanderboon Mar 24, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 6 additions & 6 deletions 02-Truncated-Triangular-Distribution.Rmd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -317,11 +317,11 @@ $$
Case 3 ($M \leq a \leq b \leq U$):

$$
E(X)=\frac{\int_{M}^{b} x \cdot \frac{2(U-x)}{(U-L)(U-M)} dx}{F(b)-F(a)}
E(X)=\frac{\int_{a}^{b} x \cdot \frac{2(U-x)}{(U-L)(U-M)} dx}{F(b)-F(a)}
$$

$$
= \frac{\frac{3b^2U-3M^2U-2b^3+2M^3}{3\left(U-L\right)\left(U-M\right)}}{F(b)-F(a)}
= \frac{\frac{-2a^3+b^2\left(2b-3U\right)+3a^2 U}{3\left(L-U\right)\left(U-M\right)}}{F(b)-F(a)}
$$

### Median
Expand Down Expand Up @@ -378,11 +378,11 @@ $$
Case 3 ($M \leq a \leq b \leq U$):

$$
\text{Var}(X)=\frac{\int_{M}^{b} x^{2} \cdot \frac{2(U-x)}{(U-L)(U-M)} dx}{F(b)-F(a)}-E(X)^{2}
\text{Var}(X)=\frac{\int_{a}^{b} x^{2} \cdot \frac{2(U-x)}{(U-L)(U-M)} dx}{F(b)-F(a)}-E(X)^{2}
$$

$$
= \frac{\frac{4b^3U-4M^3U-3b^4+3M^4}{6\left(U-L\right)\left(U-M\right)}}{F(b)-F(a)}-E(X)^{2}
= \frac{\frac{-3a^4+4a^3U+b^3(3b-4U)}{6\left(L-U\right)\left(U-M\right)}}{F(b)-F(a)}-E(X)^{2}
$$

## An Object to Hold These Properties
Expand Down Expand Up @@ -455,7 +455,7 @@ generate.truncated.triangular <- function(a, b, orig.tri.dist) {
result.numerator / result.denominator
} else if (M <= a & a <= b) {
result.numerator <-
(3 * b ^ 2 * U - 3 * a ^ 2 * U - 2 * b ^ 3 + 2 * a ^ 3) / (3 * (U - L) * (U - M))
(-2 * (a ^ 3) + (b ^ 2)* (2 * b - 3 * U) + 3 * (a ^ 2) * U) / (3* (L - U) * (U - M))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
result.numerator / result.denominator
Expand Down Expand Up @@ -497,7 +497,7 @@ generate.truncated.triangular <- function(a, b, orig.tri.dist) {
(result.numerator / result.denominator) - trun.tri.mean ^ 2
} else if (M <= a & a <= b) {
result.numerator <-
(4 * (b ^ 3) * U - 4 * (a ^ 3) * U - 2 * b ^ 4 + 3 * a ^ 4) / (6 * (U - L) * (U - M))
(-3 * (a ^ 4) + 4 * (a ^ 3) * U + (b ^ 3) * (3 * b - 4 * U)) / (6 * (L - U) * (U - M))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
(result.numerator / result.denominator) - trun.tri.mean ^ 2
Expand Down
58 changes: 19 additions & 39 deletions Scripts/Generate-Truncated-Triangular.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ generate.truncated.triangular <- function(a, b, orig.tri.dist) {
L <- orig.tri.dist$tri.lower
U <- orig.tri.dist$tri.upper

## Throw an error if the new bounds do not fall witin the old bounds of the triangular pdf.
## Throw an error if the new bounds do not fall within the old bounds of the triangular pdf.
if (a < L | b > U) {
stop("The new bounds of the pdf do not fall within the original range")
}
Expand Down Expand Up @@ -47,27 +47,17 @@ generate.truncated.triangular <- function(a, b, orig.tri.dist) {
}

## Create a vector of length 1 that describes the mean of the distribution
trun.tri.mean <- if (a <= b & b < M) {
result.numerator <-
(2 * (-3 * L * ((b ^ 2) / 2 - (a ^ 2) / 2) + b ^ 3 - a ^ 3)) / (3 * (U - L) * (M - L))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
result.numerator / result.denominator
trun.tri.denominator <- (orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a))
trun.tri.meanNumerator <- if (a <= b & b < M) {
(2 * (-3 * L * ((b ^ 2) / 2 - (a ^ 2) / 2) + b ^ 3 - a ^ 3)) / (3 * (U - L) * (M - L))
} else if (a < M & b >= M) {
result.numerator <-
(
-M ^ 3 * U - 2 * a ^ 3 * U + 3 * L * a ^ 2 * U + 3 * M * b ^ 2 * U - 3 * L * b ^ 2 * U + L * M ^ 3 + 2 * M * a ^ 3 - 3 * L * M * a ^ 2 - 2 * M * b ^ 3 + 2 * L * b ^ 3
) / (3 * (U - L) * (M - L) * (U - M))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
result.numerator / result.denominator
(
-M ^ 3 * U - 2 * a ^ 3 * U + 3 * L * a ^ 2 * U + 3 * M * b ^ 2 * U - 3 * L * b ^ 2 * U + L * M ^ 3 + 2 * M * a ^ 3 - 3 * L * M * a ^ 2 - 2 * M * b ^ 3 + 2 * L * b ^ 3
) / (3 * (U - L) * (M - L) * (U - M))
} else if (M <= a & a <= b) {
result.numerator <-
(3 * b ^ 2 * U - 3 * a ^ 2 * U - 2 * b ^ 3 + 2 * a ^ 3) / (3 * (U - L) * (U - M))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
result.numerator / result.denominator
(-2 * (a ^ 3) + (b ^ 2)* (2 * b - 3 * U) + 3 * (a ^ 2) * U) / (3* (L - U) * (U - M))
}
trun.tri.mean <- (trun.tri.meanNumerator / trun.tri.denominator)

## Create a vector of length 1 that describes the median of the distribution

Expand All @@ -89,28 +79,17 @@ generate.truncated.triangular <- function(a, b, orig.tri.dist) {
trun.tri.lower <- a

## Create a vector of length 1 that describes the variance of the distribution
trun.tri.var <- if (a <= b & b < M) {
result.numerator <-
(-4 * L * ((b ^ 3) / 3 - (a ^ 3) / 3) + b ^ 4 - a ^ 4) / (2 * (U - L) * (M - L))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
(result.numerator / result.denominator) - trun.tri.mean ^ 2
trun.tri.varNumerator <- if (a <= b & b < M) {
(-4 * L * ((b ^ 3) / 3 - (a ^ 3) / 3) + b ^ 4 - a ^ 4) / (2 * (U - L) * (M - L))
} else if (a < M & b >= M) {
result.numerator <-
(
-M ^ 4 * U - 3 * a ^ 4 * U + 4 * L * a ^ 3 * U + 4 * M * b ^ 3 * U - 4 * L * b ^ 3 * U + L * M ^ 4 + 3 * M * a ^ 4 - 4 * L * M * a ^ 3 - 3 * M * b ^ 4 + 3 * L * b ^ 4
) / (6 * (U - L) * (M - L) * (U - M))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
(result.numerator / result.denominator) - trun.tri.mean ^ 2
(
-M ^ 4 * U - 3 * a ^ 4 * U + 4 * L * a ^ 3 * U + 4 * M * b ^ 3 * U - 4 * L * b ^ 3 * U + L * M ^ 4 + 3 * M * a ^ 4 - 4 * L * M * a ^ 3 - 3 * M * b ^ 4 + 3 * L * b ^ 4
) / (6 * (U - L) * (M - L) * (U - M))
} else if (M <= a & a <= b) {
result.numerator <-
(4 * (b ^ 3) * U - 4 * (a ^ 3) * U - 2 * b ^ 4 + 3 * a ^ 4) / (6 * (U - L) * (U - M))
result.denominator <-
orig.tri.dist$cdf(b) - orig.tri.dist$cdf(a)
(result.numerator / result.denominator) - trun.tri.mean ^ 2
(-3 * (a ^ 4) + 4 * (a ^ 3) * U + (b ^ 3) * (3 * b - 4 * U)) / (6 * (L - U) * (U - M))
}

trun.tri.var <- (trun.tri.varNumerator / trun.tri.denominator) - (trun.tri.mean ^ 2)

## Build the list and return it. This list contains all major properties of the truncated triangular distribution
return(
list(
Expand All @@ -122,7 +101,8 @@ generate.truncated.triangular <- function(a, b, orig.tri.dist) {
trun.tri.mode = trun.tri.mode,
trun.tri.upper = trun.tri.upper,
trun.tri.lower = trun.tri.lower,
trun.tri.var = trun.tri.var
trun.tri.var = trun.tri.var,
trun.tri.originalarguments = list(L=L,a=a,M=M,b=b,U=U)
)
)
}
Loading