File: autoplot.calibrateType1.R

package info (click to toggle)
r-cran-lavasearch2 2.0.3%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,832 kB
  • sloc: cpp: 28; sh: 13; makefile: 2
file content (157 lines) | stat: -rw-r--r-- 6,816 bytes parent folder | download
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
### autoplot.calibrateType1.R --- 
##----------------------------------------------------------------------
## Author: Brice Ozenne
## Created: apr  5 2018 (13:20) 
## Version: 
## Last-Updated: Jan 11 2022 (16:46) 
##           By: Brice Ozenne
##     Update #: 30
##----------------------------------------------------------------------
## 
### Commentary: 
## 
### Change Log:
##----------------------------------------------------------------------
## 
### Code:

## * Documentation
##' @title Graphical Display of the Bias or Type 1 Error
##' @description Graphical display of the bias or type 1 error
##' for the output of \code{\link{calibrateType1}}.
##' @name autoplot_calibrateType1
##' 
##' @param object output of \code{\link{calibrateType1}}.
##' @param type [character] if type equals \code{"bias"} the bias will be displayed.
##' Otherwise if it equals \code{"type1error"} the type 1 error will be displayed.
##' @param plot [logical] should the plot be displayed?
##' @param color.threshold [character] the color for the line representing the expected value(s).
##' @param type.bias [character] if type.bias equals \code{"absolute"} the absolute bias will be used.
##' Otherwise if it equals \code{"relative"} the relative bias will be used.
##' Only relevant when type equals \code{"bias"}.
##' @param alpha [numeric, 0-1] the significance threshold to consider.
##' Only relevant when type equals \code{"type1error"}.
##' @param nrow.legend [integer, >0] the number of rows for the legend.
##' Only relevant when type equals \code{"type1error"}.
##' @param name2label [named character vector] the label for the legend.
##' The vector should contain the method names (see details).
##' Only relevant when type equals \code{"type1error"}.
##' @param color [character vector] a vector of colours to be used to color the lines.
##' Only relevant when type equals \code{"type1error"}.
##' @param keep.method [character vector] the methods names for which the type 1 error should be displayed.
##' Only relevant when type equals \code{"type1error"}.
##' @param ... [internal] Only used by the generic method.
##' 
##' @details Method names:
##' \itemize{
##' \item \code{p.Ztest}
##' \item \code{p.Satt}
##' \item \code{p.KR}
##' \item \code{p.robustZtest}
##' \item \code{p.robustSatt}
##' \item \code{p.robustKR}
##' }
##' @return An list containing:
##' \itemize{
##' \item plot: a ggplot object.
##' \item data: the dataset used to generate the ggplot object.
##' }
##' 


## * plotBias.calibrateType
##' @rdname autoplot_calibrateType1
##' @method autoplot calibrateType1
##' @export
autoplot.calibrateType1 <- function(object, type = "bias", plot = TRUE, color.threshold = "red",
                                    type.bias = "absolute",
                                    alpha = 0.05, nrow.legend = NULL, name2label = NULL, color = NULL, keep.method = NULL,
                                    ...){

    type <- match.arg(type, choices = c("bias","type1error"))

    ## ** display bias
    if(type == "bias"){
        ## *** data
        type.bias <- match.arg(type.bias, choices = c("absolute","relative"))

        if(type.bias == "absolute"){
            object$bias$bias.ML <- object$bias$estimate.truth-object$bias$estimate.ML
            object$bias$bias.MLcorrect <- object$bias$estimate.truth-object$bias$estimate.MLcorrect
        }else if(type.bias == "relative"){
            object$bias$bias.ML <- object$bias$estiamte.truth-object$bias$estiamte.ML
            object$bias$bias.MLcorrect <- object$bias$estimate.truth-object$bias$estimate.MLcorrect
        }

        df1 <- cbind(object$bias[,c("n","rep","name","type","bias.ML")], corrected = FALSE)
        names(df1)[5] <- "bias"
        df2 <- cbind(object$bias[,c("n","rep","name","type","bias.MLcorrect")], corrected = TRUE)
        names(df2)[5] <- "bias"

        df.gg <- rbind(df1,df2)

        ## *** display
        gg <- ggplot2::ggplot() + ggplot2::geom_boxplot(data = df.gg, aes_string(x = "type", y = "bias")) 
        gg <- gg + ggplot2::facet_wrap(corrected ~ n, labeller = ggplot2::label_both)
        df.line <- data.frame(x = c(-Inf,Inf), y = 0)
        gg <- gg + ggplot2::geom_line(data = df.line, aes_string(x = "x", y = "y"), color = color.threshold)
        
    }

    ## ** display type 1 error
    if(type == "type1error"){
        df.gg <- summary(object, alpha = alpha, type = type, display = FALSE)
        
        ## *** display
        if(is.null(keep.method)){
            keep.method <- as.character(unique(df.gg$method))
        }
        if(is.null(name2label)){
            name2label <- stats::setNames(unique(paste0(df.gg$statistic,", ",df.gg$correction)),unique(df.gg$method))
        }
        if(is.null(color)){
            ## from ggthemes::colorblind_pal()(8)
            color <- c("#000000","#E69F00","#56B4E9","#009E73","#F0E442","#0072B2","#D55E00","#CC79A7")
        }

        label.method <- name2label[keep.method]
        n.method <- length(keep.method)

       y.range <- range(c(alpha,df.gg$type1error))
        gg <- ggplot2::ggplot(df.gg, aes_string(x = "n", y = "type1error", group = "method", color = "method", shape = "method"))
        gg <- gg + ggplot2::geom_point(size = 3) + ggplot2::geom_line(size = 2)
        gg <- gg + ggplot2::facet_grid(~link, labeller = ggplot2::label_parsed)
        gg <- gg + ggplot2::geom_abline(intercept = alpha, slope = 0, color = color.threshold)
        gg <- gg + ggplot2::xlab("sample size")
        gg <- gg + ggplot2::ylab("type 1 error rate")
        gg <- gg + ggplot2::theme(legend.position = "bottom")
        gg <- gg + ggplot2::coord_cartesian(ylim = y.range)

        if(!is.null(nrow.legend)){
            gg <- gg + ggplot2::guides(color = ggplot2::guide_legend(nrow=nrow.legend,byrow=TRUE))
        }
        
        gg <- gg + ggplot2::scale_color_manual("",
                                               breaks = keep.method,
                                               label = label.method,
                                               values = color[1:n.method])
        gg <- gg + ggplot2::scale_shape_manual("",
                                               breaks = keep.method,
                                               label = label.method,
                                               values = seq(15,by=1,length=n.method))
        
         
    }
    
    ## ** export
    if(plot){
        print(gg)
    }
    rownames(df.gg) <- NULL
    return(invisible(list(plot = gg,
                          data = df.gg)))
}


######################################################################
### autoplot.calibrateType1.R ends here