42 lines
882 B
R
42 lines
882 B
R
source(here::here("R", "create_Q.R"))
|
|
|
|
calc_deriv_a <- function(k, i, matrix_X, a, K, qFa, fv){
|
|
# Quantile levels
|
|
q1 <- k / K
|
|
q0 <- (k - 1) / K
|
|
|
|
# F^{-1}_a at the two quantiles
|
|
z1 <- qFa(q1)
|
|
z0 <- qFa(q0)
|
|
|
|
# a' X_j for all j
|
|
aTX <- as.vector(matrix_X %*% a)
|
|
|
|
# f_v(z - a'X_j)
|
|
f1 <- fv(z1 - aTX)
|
|
f0 <- fv(z0 - aTX)
|
|
|
|
# X_j - X_i
|
|
Xi <- matrix_X[i, ]
|
|
XminusXi <- sweep(matrix_X, 2, Xi, "-")
|
|
|
|
# compute fraction
|
|
term1 <- (fv(z1 - aTX[i]) / sum(f1)) * colSums(XminusXi * f1)
|
|
term0 <- (fv(z0 - aTX[i]) / sum(f0)) * colSums(XminusXi * f0)
|
|
|
|
# Difference
|
|
return(term1 - term0)
|
|
|
|
}
|
|
X <- matrix(seq(1,15, 1), ncol=3)
|
|
a <- c(1, -2, 1)
|
|
Fv <- pnorm
|
|
K <- 3
|
|
|
|
Fa <- make_distribution_func(a=a, X_matrix = X, Fv=Fv)
|
|
Q <- create_matrix_Q(Fa, a, K, Fv, matrix_X = X)
|
|
|
|
qFa <- make_quantile_function(Fa)
|
|
|
|
deriv <- calc_deriv_a(1, 1, X, a, K, qFa, dnorm)
|