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
}
让它旋转一下:
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)
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
}
2条答案
按热度按时间eoxn13cs1#
扩展@StéphaneLaurent的注解,可以使用一系列
ifelse()
调用(或dplyr::case_when()
)定义分段函数。让它旋转一下:
waxmsbnn2#
这里有一个用于密度函数和随机函数的选项。