Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit14877e1

Browse files
committed
fixed plot_SATE
1 parentf6b1355 commit14877e1

File tree

2 files changed

+26
-14
lines changed

2 files changed

+26
-14
lines changed

‎R/plot_ATE.R‎

Lines changed: 21 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -322,7 +322,8 @@ plot_PATE <- function(.model, type = c('histogram', 'density'), ci_80 = FALSE, c
322322
#' @param reference numeric. Show a vertical reference line at this x-axis value
323323
#' @param .mean TRUE/FALSE. Show the mean reference line
324324
#' @param .median TRUE/FALSE. Show the median reference line
325-
#' @param view_overlap enter overlap rules to view how different bartCause removal rules would have influenced results. If set to an argument other than NULL the common support rule of your bartCause model is automatically included.
325+
#' @param check_overlap TRUE/FALSE. Check if any overlap rules are applicable
326+
#' @param overlap_rule enter overlap rules to view how different bartCause removal rules would have influenced results. Only applicable if check_overlap is TRUE.
326327
#'
327328
#' @author George Perrett, Joseph Marlo
328329
#'
@@ -342,14 +343,19 @@ plot_PATE <- function(.model, type = c('histogram', 'density'), ci_80 = FALSE, c
342343
#' )
343344
#' plot_SATE(model_results)
344345
#' }
345-
plot_SATE<-function(.model,type= c('histogram','density'),ci_80=FALSE,ci_95=FALSE,reference=NULL,.mean=FALSE,.median=FALSE,view_overlap=c(NULL,'none','sd','chisq')){
346+
plot_SATE<-function(.model,type= c('histogram','density'),ci_80=FALSE,ci_95=FALSE,reference=NULL,.mean=FALSE,.median=FALSE,check_overlap=FALSE,overlap_rule= c('none','sd','chisq')){
346347

347348
validate_model_(.model)
348349
type<- tolower(type[1])
349350

351+
if(isFALSE(check_overlap)){
352+
overlap_rule<-.model$commonSup.rule
353+
}
354+
350355
if (type %notin% c('histogram','density')) stop("type must be 'histogram' or 'density'")
356+
if (sum(overlap_rule[order(overlap_rule)] %notin% c('chisq','none','sd'))>0) stop("'none', 'se' and 'chisq' are only accepted overlap rules")
351357

352-
# set title
358+
# set title
353359
.title<-switch(
354360
.model$estimand,
355361
ate="Posterior of Sample Average Treatment Effect",
@@ -372,10 +378,13 @@ plot_SATE <- function(.model, type = c('histogram', 'density'), ci_80 = FALSE, c
372378
sate_overlap<- apply_overlap_rules(.model)
373379

374380
# get different sates
381+
sates<- tibble(
382+
none= apply(sate.samples,2,mean),
383+
sd= apply(sate.samples[!sate_overlap$ind_sd_removed,],2,mean),
384+
chisq= apply(sate.samples[!sate_overlap$ind_chisq_removed,],2,mean)
385+
)
375386

376-
sates<- tibble(none= apply(sate.samples,2,mean))
377-
sates$sd<- apply(sate.samples[!sate_overlap$ind_sd_removed,],2,mean)
378-
sates$chisq<-apply(sate.samples[!sate_overlap$ind_chisq_removed,],2,mean)
387+
sates<-sates[,overlap_rule]
379388

380389
# pivot to long form now we just have name(what type of sate) and value
381390
sates<- pivot_longer(sates,cols=1:length(sates))
@@ -420,22 +429,22 @@ plot_SATE <- function(.model, type = c('histogram', 'density'), ci_80 = FALSE, c
420429
x= toupper(.model$estimand))
421430

422431
# apply overlap rules
423-
if(!is.null(view_overlap)){
424-
if(.model$commonSup.rule %notin%view_overlap){
425-
view_overlap<- c(view_overlap,.model$commonSup.rule)
432+
if(isTRUE(check_overlap)){
433+
if(.model$commonSup.rule %notin%overlap_rule){
434+
overlap_rule<- c(overlap_rule,.model$commonSup.rule)
426435
}
427436
# facet if removal rules would create different results
428437
.facet_lab<- vector()
429438

430-
if('none'%in%view_overlap){
439+
if('none'%in%overlap_rule){
431440
.facet_lab<- c(.facet_lab,`none`="No overlap rule applied: 0 cases (0%) were removed")
432441
}
433442

434-
if('sd'%in%view_overlap){
443+
if('sd'%in%overlap_rule){
435444
.facet_lab<- c(.facet_lab,`sd`= paste0("Standard deviation overlap rule applied:",sate_overlap$sum_sd_removed,' cases (',round((sate_overlap$sum_sd_removed/nrow(sate.samples)*100),2) ,'%) were removed'))
436445
}
437446

438-
if('chisq'%in%view_overlap){
447+
if('chisq'%in%overlap_rule){
439448
.facet_lab<- c(.facet_lab,`chisq`= paste0("Chi-squard overlap rule applied:",sate_overlap$sum_chisq_removed,' cases (',round((sate_overlap$sum_chisq_removed/nrow(sate.samples)*100),2) ,'%) were removed'))
440449
}
441450

‎man/plot_SATE.Rd‎

Lines changed: 5 additions & 2 deletions
Some generated files are not rendered by default. Learn more aboutcustomizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp