-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtestNpRR.Rmd
46 lines (34 loc) · 1.42 KB
/
testNpRR.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
---
title: "testnpRR"
output: html_document
date: '2022-03-09'
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
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)
```
```{r}
preds <- predict(fit_RR, W)
data.table(preds)
data.table(round(LRR,3), preds , do.call(cbind, lapply(fit_RR$LRR_learners, `[[`,"LRR_pred")))
```