Probability density function with triangular distribution of parameters - r

Question

How do you compute this probability density function, with a triangular distribution of parameters (a,b,c)?
f(x)= 0 , x<a
2(x-a)/((b-a)(c-a)) , a <= x <= c
2(b-x)/((b-a)(b-c)) , c < x <=b
0 , x> b

Answer 1

Expanding on #StéphaneLaurent‘s comments, you can define a piecewise function using a series of ifelse() calls (or dplyr::case_when()).
f <- function(x, A, B, C) {
out <- ifelse(
x < A | B < x,
0,
ifelse(
A <= x & x <= C,
(2*(x-A))/((B-A)*(C-A)),
ifelse(
C < x & x <= B,
(2*(B-x))/((B-A)*(B-C)),
NA_real_
)))
if (any((is.na(out) | is.nan(out)) & (!is.na(x) & !is.nan(x)))) {
warning("f(x) undefined for some input values")
}
out
}
Taking it for a spin:
library(ggplot2)
dat <- expand.grid(
x = seq(-1.5, 1.5, by = 0.1),
A = -1:1,
B = -1:1,
C = -1:1
)
dat$y <- with(dat, f(x, A, B, C))
# Warning message:
# In f(x, A, B, C) : f(x) undefined for some input values
ggplot(dat, aes(x, y)) +
geom_line(aes(color = factor(C))) +
facet_grid(B ~ A, labeller = label_both)

Answer 2

Here is an option for a density function and a random function.
dtri <- function(x, A, B, C) {
n <- length(x)
i <- 1:n
if (length(A) == 1) A <- rep(A, n)
if (length(B) == 1) B <- rep(B, n)
if (length(C) == 1) C <- rep(C, n)
abc <- Rfast::rowSort(matrix(c(A, B, C), n, 3))
bln <- x < abc[,2]
p <- 2*abs(x - abc[i + 2*n*!bln])/(abc[,3] - abc[,1])/(abc[i + n*(2 - bln)] - abc[i + n*(1 - bln)])
p[x < abc[,1] | x > abc[,3]] <- 0
p
}
rtri <- function(n, a, b, c) {
if (a > b) {a <- (b - a) + (b <- a)}
if (b > c) {c <- (b - c) + (b <- c)}
fb <- (b - a)/(c - a)
U <- runif(n)
blna <- U < fb
r <-numeric(n)
r[blna] <- a + sqrt(U[blna]*(c - a)*(b - a))
r[!blna] <- c - sqrt((1 - U[!blna])*(c - a)*(c - b))
r
}

Answer 3

Using R's vectorized cabilities:
my_fun <- function(x, a, b, c) {
i1 <- x >= a & x <= c
i2 <- x > c & x <= b
f <- rep(NA, length(x))
f[x < a | x > b] <- 0
f[i1] <- 2 * (x[i1] - a) / ((b - a) * (c - a))
f[i2] <- 2 * (b - x[i2]) / ((b - a) * (b - c))
return(f)
}
Test:
set.seed(123)
x <- sort(rnorm(1000, 0, 5))
a <- runif(1, -10, -2)
c <- runif(1, -2, 2)
b <- runif(1, 2, 10)
f <- my_fun(x, a, b, c)
plot(x, f, type="l")