In Larsvanderlaan/npcausalML: Nonparametric estimation of the relative risk function

knitr::opts_chunk$set(echo = TRUE)

 n <- 5000
  W1 <- runif(n, -1 , 1)
  W2 <- runif(n, -1 , 1)# rbinom(n, 1 , plogis(W1))
  W <- cbind(W1, W2)
  A <- rbinom(n, 1 , plogis(0.5*(W1 + W2 )))
  Y <- rpois(n, plogis( W1 + W2 ) * exp(A*(1+ 0.5*(sin(5*W1) + cos(5*W2)))))
  quantile(Y)
  LRR <- (1+ 0.5*(sin(5*W1) + cos(5*W2)))
  true_coefs <- c(1, 0.5, 0.5)
  R <- as.numeric(1:n %in% c(which(Y>0), which(Y==0)[rbinom(sum(Y==0), size = 1, prob = 0.5)==1]))
  R <- rep(1,n)
  pR0 <- mean(R[Y==0])
  pR1 <- mean(R[Y>0])
  weights <- R / ifelse(Y>0, pR1, pR0)


  sl3_Learner_EYAW <- Lrnr_hal9001$new(family = "poisson", smoothness_orders =1, num_knots = c(10,5), max_degree = 2)
  sl3_Learner_pA1W <- Lrnr_gam$new()


  list_of_sieves <- list(NULL, fourier_basis$new(orders = c(3,1)))
  fit_RR <- npRR(list(Lrnr_gam$new(),Lrnr_hal9001$new(num_knots = 10, max_degree = 1, fit_control = list(cv_select = F), family = binomial(), lambda = c(1e-9, 1e-4, 1e-3))),
                 W= W, A = A, Y = Y, V = W, weights = weights, sl3_Learner_EYAW = sl3_Learner_EYAW, sl3_Learner_pA1W = sl3_Learner_pA1W, outcome_type = "continuous", list_of_sieves = list_of_sieves,cross_validate_LRR = TRUE) 

preds <- predict(fit_RR, W)
data.table(preds)
data.table(round(LRR,3), preds , do.call(cbind, lapply(fit_RR$LRR_learners, `[[`,"LRR_pred")))

Larsvanderlaan/npcausalML documentation built on July 30, 2023, 4:32 p.m.