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
|
### summary.modelsearch2.R ---
#----------------------------------------------------------------------
## author: Brice Ozenne
## created: aug 30 2017 (10:46)
## Version:
## last-updated: Jan 11 2022 (16:44)
## By: Brice Ozenne
## Update #: 116
#----------------------------------------------------------------------
##
### Commentary:
##
### Change Log:
#----------------------------------------------------------------------
##
### Code:
## * method summary.modelsearch2
#' @title summary Method for modelsearch2 Objects
#' @description summary method for modelsearch2 objects.
#'
#' @param object output of the \code{modelsearch2} function.
#' @param print should the summary be printed in the terminal.
#' @param ... [internal] only used by the generic method.
#'
#' @method summary modelsearch2
#'
#' @details
#' The column \code{dp.Info} contains the percentage of extended models (i.e. model with one additional link)
#' for which the information matrix evaluated at the value of the parameters of the initial model is non positive definie.
#'
#' @export
summary.modelsearch2 <- function(object, print = TRUE, ...){
p.value <- NULL # [:for CRAN check] subset
## ** extract data from object
n.step <- nStep(object)
tableTest <- do.call(rbind,lapply(object$sequenceTest, function(iTest){
out <- iTest[which.max(iTest$statistic), c("link","statistic","p.value","adjusted.p.value","dp.Info","selected","nTests")]
out[,"dp.Info"] <- mean(iTest[,"dp.Info"], na.rm = TRUE)
return(out)
}))
n.selected <- sum(tableTest$selected)
keep.cols <- c("link","nTests","statistic","adjusted.p.value")
## ** output
out <- list()
out$message.pre <- paste0("Sequential search for local dependence using the score statistic \n")
if(n.selected==0){
out$message.pre <- c(out$message.pre,
"The variable selection procedure did not retain any variable \n")
}else{
out$message.pre <- c(out$message.pre,
paste0("The variable selection procedure retained ",n.selected," variable",
if(n.selected>1){"s"},":\n")
)
}
out$table <- tableTest
rownames(out$table) <- NULL
out$message.post <- paste0("Confidence level: ",1-object$alpha," (two sided, adjustement: ",object$method.p.adjust,")\n")
## ** display
if(print){
cat(out$message.pre,sep="")
print(out$table)
cat(out$message.post,sep="")
if(any(stats::na.omit(out$table[,"dp.Info"])<1)){
cat("WARNING: some of the score tests could not be correctly computed, probably because extended models are not all identifiable\n",
" consider using the argument \'link\' to specify only identifiable models \n")
}
}
## ** export
return(invisible(out))
}
#----------------------------------------------------------------------
### summary.modelsearch2.R ends here
|
