august final version

2026-08-20 18:01:17 +02:00
parent f3c6aac782
commit baeae7b0ea
2 changed files with 121 additions and 1 deletions
@@ -0,0 +1,41 @@
+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)