Based on AUC of difference of probability

Iohexol

Threshold

Here, we compute the AUC of difference between 2 density plot (ref and all pts validation or 3 pts validation or 1 pt validation) applying a threshold.

## Iohexol
# calculate AUC by summing interval*height for the density estimate at each point
prob_min<-run10$final$popPoints %>% slice_min(prob) %>% select(prob)
a<-density(run10$final$popPoints$CL0, bw = 0.1)
aze <- tibble(l=a$x, z=a$y) %>% filter(l>0)
ba<-run11$final$postPoints%>% filter(prob>prob_min$prob)  %>% select(CL0)
b<-density(ba$CL0, bw = 0.1)
bze<-tibble(l=b$x, z=b$y) %>% filter(l>0)
ca<-run13$final$postPoints%>% filter(prob>prob_min$prob)  %>% select(CL0)
c<-density(ca$CL0, bw = 0.1)
cze<-tibble(l=c$x, z=c$y) %>% filter(l>0)
da<-run15$final$postPoints%>% filter(prob>prob_min$prob)  %>% select(CL0)
d<-density(da$CL0, bw = 0.1)
dze<-tibble(l=d$x, z=d$y) %>% filter(l>0)
## ref area
area_ref=area_between(aze, h=0)
## all pts
result_area_all <- area_between(aze,bze)
(sum(abs(result_area_all$area_by_type %>% select(area)))/area_ref$area)*(length(ba$CL0)/run10$final$popPoints %>% summarise(n=n()))
##           n
## 1 0.3677787
plot_area(result_area_all, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Warning: Removed 1006 row(s) containing missing values (geom_path).

## 3 pts
result_area_3pts <- area_between(aze,cze)
(sum(abs(result_area_3pts$area_by_type %>% select(area)))/area_ref$area)*(length(ca$CL0)/run10$final$popPoints %>% summarise(n=n()))
##           n
## 1 0.4177358
plot_area(result_area_3pts, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Removed 1006 row(s) containing missing values (geom_path).

## 1 pt
result_area_1pts <- area_between(aze,dze)
(sum(abs(result_area_1pts$area_by_type %>% select(area)))/area_ref$area)*(length(da$CL0)/run10$final$popPoints %>% summarise(n=n()))
##          n
## 1 1.889424
plot_area(result_area_1pts, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Removed 1006 row(s) containing missing values (geom_path).

## summary plot
plot_area(result_area_all, show_uncertainty=F)/plot_area(result_area_3pts, show_uncertainty=F)/plot_area(result_area_1pts, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Removed 1006 row(s) containing missing values (geom_path).
## Warning: Removed 1006 rows containing missing values (geom_point).
## Warning: Removed 1006 row(s) containing missing values (geom_path).
## Warning: Removed 1006 rows containing missing values (geom_point).
## Warning: Removed 1006 row(s) containing missing values (geom_path).

without threshold

Here, we compute the AUC of difference between 2 density plot (ref and all pts validation or 3 pts validation or 1 pt validation) without threshold.

## Iohexol
# calculate AUC by summing interval*height for the density estimate at each point
a<-density(run10$final$popPoints$CL0, bw = 0.1)
aze <- tibble(l=a$x, z=a$y) %>% filter(l>0)
ba_w<-run11$final$postPoints  %>% select(CL0)
b_w<-density(ba_w$CL0, bw = 0.1)
bze_w<-tibble(l=b_w$x, z=b_w$y) %>% filter(l>0)
ca_w<-run13$final$postPoints  %>% select(CL0)
c_w<-density(ca_w$CL0, bw = 0.1)
cze_w<-tibble(l=c_w$x, z=c_w$y) %>% filter(l>0)
da_w<-run15$final$postPoints  %>% select(CL0)
d_w<-density(da_w$CL0, bw = 0.1)
dze_w<-tibble(l=d_w$x, z=d_w$y) %>% filter(l>0)
## ref area
area_ref=area_between(aze, h=0)
## all pts
result_area_all_w <- area_between(aze,bze_w)
(sum(abs(result_area_all_w$area_by_type %>% select(area)))/area_ref$area)*(length(ba_w$CL0)/run10$final$popPoints %>% summarise(n=n()))
##           n
## 1 0.7309704
plot_area(result_area_all_w, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Warning: Removed 1006 row(s) containing missing values (geom_path).

## 3 pts
result_area_3pts_w <- area_between(aze,cze_w)
(sum(abs(result_area_3pts_w$area_by_type %>% select(area)))/area_ref$area)*(length(ca_w$CL0)/run10$final$popPoints %>% summarise(n=n()))
##         n
## 1 1.18411
plot_area(result_area_3pts_w, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Removed 1006 row(s) containing missing values (geom_path).

## 1 pt
result_area_1pts_w <- area_between(aze,dze_w)
(sum(abs(result_area_1pts_w$area_by_type %>% select(area)))/area_ref$area)*(length(da_w$CL0)/run10$final$popPoints %>% summarise(n=n()))
##          n
## 1 4.029222
plot_area(result_area_1pts_w, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Removed 1006 row(s) containing missing values (geom_path).

## summary plot
plot_area(result_area_all_w, show_uncertainty=F)/plot_area(result_area_3pts_w, show_uncertainty=F)/plot_area(result_area_1pts_w, show_uncertainty=F)
## Warning: Removed 1006 rows containing missing values (geom_point).
## Removed 1006 row(s) containing missing values (geom_path).
## Warning: Removed 1006 rows containing missing values (geom_point).
## Warning: Removed 1006 row(s) containing missing values (geom_path).
## Warning: Removed 1006 rows containing missing values (geom_point).
## Warning: Removed 1006 row(s) containing missing values (geom_path).

Tacrolimus

Threshold

## Tacrolimus
prob_min_t<-final.5$popPoints %>% slice_min(prob) %>% select(prob)
at<-density(1000/final.5$popPoints$FAIV*final.5$popPoints$alpha, bw = 1)
azt <- tibble(l=at$x, z=at$y) %>% filter(l>0)
bat<-final.7$postPoints %>% filter(prob>prob_min_t$prob) %>% mutate(CL=1000/FAIV*alpha) %>% select(CL)
bt<-density(bat$CL, bw = 1)
bzt<-tibble(l=bt$x, z=bt$y) %>% filter(l>0)
cat<-final.6$postPoints %>% filter(prob>prob_min_t$prob) %>% mutate(CL=1000/FAIV*alpha) %>% select(CL)
ct<-density(cat$CL, bw = 1)
czt<-tibble(l=ct$x, z=ct$y) %>% filter(l>0)
dat<-final.10$postPoints %>% filter(prob>prob_min_t$prob) %>% mutate(CL=1000/FAIV*alpha) %>% select(CL)
dt<-density(dat$CL, bw = 1)
dzt<-tibble(l=dt$x, z=dt$y) %>% filter(l>0)
## ref area
area_ref_t=area_between(azt, h=0)
## all pts
result_area_allpts_t <- area_between(azt, bzt)
(sum(abs(result_area_allpts_t$area_by_type %>% select(area))/area_ref_t$area))*(length(bat$CL)/final.5$popPoints %>% summarise(n=n()))
##          n
## 1 1.110657
plot_area(result_area_allpts_t, show_uncertainty=F)
## Warning: Removed 860 rows containing missing values (geom_point).
## Warning: Removed 860 row(s) containing missing values (geom_path).

## 3 pts
result_area_3pts_t <- area_between(azt,czt)
plot_area(result_area_3pts_t, show_uncertainty=F)
## Warning: Removed 1000 rows containing missing values (geom_point).
## Warning: Removed 1000 row(s) containing missing values (geom_path).

(sum(abs(result_area_3pts_t$area_by_type %>% select(area))/area_ref_t$area))*(length(cat$CL)/final.5$popPoints %>% summarise(n=n()))
##          n
## 1 1.495447
## 1 pts
result_area_1pt_t <- area_between(azt,dzt)
plot_area(result_area_1pt_t, show_uncertainty=F)
## Warning: Removed 1020 rows containing missing values (geom_point).
## Warning: Removed 1020 row(s) containing missing values (geom_path).

(sum(abs(result_area_1pt_t$area_by_type %>% select(area))/area_ref_t$area))*(length(dat$CL)/final.5$popPoints %>% summarise(n=n()))
##          n
## 1 1.857452
## summary plot
plot_area(result_area_allpts_t, show_uncertainty=F)/plot_area(result_area_3pts_t, show_uncertainty=F)/plot_area(result_area_1pt_t, show_uncertainty=F)
## Warning: Removed 860 rows containing missing values (geom_point).
## Warning: Removed 860 row(s) containing missing values (geom_path).
## Warning: Removed 1000 rows containing missing values (geom_point).
## Warning: Removed 1000 row(s) containing missing values (geom_path).
## Warning: Removed 1020 rows containing missing values (geom_point).
## Warning: Removed 1020 row(s) containing missing values (geom_path).

without Threshold

## Tacrolimus
at<-density(1000/final.5$popPoints$FAIV*final.5$popPoints$alpha, bw = 0.1)
azt <- tibble(l=at$x, z=at$y) %>% filter(l>0)
bat_w<-final.7$postPoints  %>% mutate(CL=1000/FAIV*alpha) %>% select(CL)
bt_w<-density(bat_w$CL, bw = 0.1)
bzt_w<-tibble(l=bt_w$x, z=bt_w$y) %>% filter(l>0)
cat_w<-final.6$postPoints  %>% mutate(CL=1000/FAIV*alpha) %>% select(CL)
ct_w<-density(cat_w$CL, bw = 0.1)
czt_w<-tibble(l=ct_w$x, z=ct_w$y) %>% filter(l>0)
dat_w<-final.10$postPoints  %>% mutate(CL=1000/FAIV*alpha) %>% select(CL)
dt_w<-density(dat_w$CL, bw = 0.1)
dzt_w<-tibble(l=dt_w$x, z=dt_w$y) %>% filter(l>0)
## ref area
area_ref_t=area_between(azt, h=0)
## all pts
result_area_allpts_t_w <- area_between(azt, bzt_w)
(sum(abs(result_area_allpts_t_w$area_by_type %>% select(area))/area_ref_t$area))*(length(bat_w$CL)/final.5$popPoints %>% summarise(n=n()))
##         n
## 1 2.88097
plot_area(result_area_allpts_t_w, show_uncertainty=F)
## Warning: Removed 1016 rows containing missing values (geom_point).
## Warning: Removed 1016 row(s) containing missing values (geom_path).

## 3 pts
result_area_3pts_t_w <- area_between(azt,czt_w)
plot_area(result_area_3pts_t_w, show_uncertainty=F)
## Warning: Removed 1016 rows containing missing values (geom_point).
## Removed 1016 row(s) containing missing values (geom_path).

(sum(abs(result_area_3pts_t_w$area_by_type %>% select(area))/area_ref_t$area))*(length(cat_w$CL)/final.5$popPoints %>% summarise(n=n()))
##         n
## 1 3.28156
## 1 pts
result_area_1pt_t_w <- area_between(azt,dzt_w)
plot_area(result_area_1pt_t_w, show_uncertainty=F)
## Warning: Removed 1016 rows containing missing values (geom_point).
## Removed 1016 row(s) containing missing values (geom_path).

(sum(abs(result_area_1pt_t_w$area_by_type %>% select(area))/area_ref_t$area))*(length(dat_w$CL)/final.5$popPoints %>% summarise(n=n()))
##          n
## 1 2.384144
## summary plot
plot_area(result_area_allpts_t_w, show_uncertainty=F)/plot_area(result_area_3pts_t_w, show_uncertainty=F)/plot_area(result_area_1pt_t_w, show_uncertainty=F)
## Warning: Removed 1016 rows containing missing values (geom_point).
## Removed 1016 row(s) containing missing values (geom_path).
## Warning: Removed 1016 rows containing missing values (geom_point).
## Warning: Removed 1016 row(s) containing missing values (geom_path).
## Warning: Removed 1016 rows containing missing values (geom_point).
## Warning: Removed 1016 row(s) containing missing values (geom_path).

Based on variance of probability of supports point

Iohexol

threshold

tibble(all_pts=1-var(bze$z)/var(aze$z),
`3pts`=1-var(cze$z)/var(aze$z),
`1pt`=1-var(dze$z)/var(aze$z))
## # A tibble: 1 × 3
##   all_pts `3pts`  `1pt`
##     <dbl>  <dbl>  <dbl>
## 1  -0.877 -0.202 0.0190

without threshold

tibble(all_pts=1-var(bze_w$z)/var(aze$z),
`3pts`=1-var(cze_w$z)/var(aze$z),
`1pt`=1-var(dze_w$z)/var(aze$z))
## # A tibble: 1 × 3
##   all_pts `3pts` `1pt`
##     <dbl>  <dbl> <dbl>
## 1  -0.238  0.141 0.240

Tacrolimus

threshold

at<-density(1000/final.5$popPoints$FAIV*final.5$popPoints$alpha, bw = 1)
azt <- tibble(l=at$x, z=at$y) %>% filter(l>0)
tibble(all_pts=var(bzt$z)/var(azt$z),
`3pts`=var(czt$z)/var(azt$z),
`1pt`=var(dzt$z)/var(azt$z))
## # A tibble: 1 × 3
##   all_pts `3pts` `1pt`
##     <dbl>  <dbl> <dbl>
## 1    2.21   1.31  1.12

without threshold

at<-density(1000/final.5$popPoints$FAIV*final.5$popPoints$alpha, bw = 1)
azt <- tibble(l=at$x, z=at$y) %>% filter(l>0)
tibble(all_pts=var(bzt_w$z)/var(azt$z),
`3pts`=var(czt_w$z)/var(azt$z),
`1pt`=var(dzt_w$z)/var(azt$z))
## # A tibble: 1 × 3
##   all_pts `3pts` `1pt`
##     <dbl>  <dbl> <dbl>
## 1    10.7   9.62  9.42