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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
#' @title Access help page of learner functions.
#'
#' @description Interactive function that gives the user quick access to the
#' help pages associated with various functions involved in the given learner.
#' @template arg_learner
#' @export
#' @family learner
#' @family help
helpLearner = function(learner) {
learner = checkLearner(learner)
callees = learner$callees
if (identical(callees, "")) {
callees = character(0L)
}
mlr.help = utils::help(learner$id, package = "mlr")
if (length(mlr.help) > 0) {
# we can give some more help
callees = c("mlr specifics", callees)
}
if (length(callees) > 0) {
n = 1
if (length(callees) > 1) {
repeat {
cat("Choose help page:\n")
cat(stri_join(seq_along(callees), " : ", callees, "\n", collapse = ""))
n = readline("0 : cancel\n...: ")
n = suppressWarnings(as.integer(n))
if (is.finite(n) && n >= 1 && n <= length(callees)) {
break
}
if (identical(n, 0L)) {
return(invisible(NULL))
}
catf("Invalid input. Enter a number between 0 and %d", length(callees))
}
}
if (length(mlr.help) > 0 && n == 1) {
return(mlr.help)
}
for (pkg_ref in stri_replace_all(learner$package, "", regex = "[+!_]")) {
h = utils::help(callees[n], package = (pkg_ref))
if (length(h) > 0) {
return(h)
}
}
}
catf("No information about learner %s found.",
coalesce(learner$name, learner$shortname, learner$id))
invisible(NULL)
}
#' @title Get specific help for a learner's parameters.
#'
#' @description Print the description of parameters of a given learner. The description
#' is automatically extracted from the help pages of the learner, so it may be incomplete.
#'
#' @template arg_learner
#' @param param (`character` | NULL)\cr
#' Parameter(s) to describe. Defaults to NULL, which prints information on the documentation
#' status of all parameters.
#' @export
#' @family learner
#' @family help
helpLearnerParam = function(learner, param = NULL) {
learner = checkLearner(learner)
if (!inherits(learner, "RLearner")) {
current.learner = learner
repeat {
next.learner = current.learner$next.learner
if (is.null(next.learner)) {
break
}
if (inherits(next.learner, "RLearner")) {
messagef("The learner '%s' is a wrapped learner. Showing documentation of '%s' instead.",
learner$id, next.learner$id)
return(Recall(next.learner, param))
}
current.learner = next.learner
}
stop("The learner does not provide documentation.")
}
if (is.null(param)) {
if (length(learner$help.list) > 0) {
cat("Documentation for the following parameters is present:\n")
for (p in names(learner$help.list)) {
catf("- %s (%s)", p,
stri_match_first_regex(learner$help.list[[p]], "(?<= )[^ ]*::[^\\n]*"))
}
}
missingdoc = setdiff(getParamIds(learner$par.set), names(learner$help.list))
if (length(missingdoc) > 0) {
catf("The following parameters are missing documentation:\n%s",
collapse(strwrap(collapse(missingdoc, sep = ", "), indent = 2), "\n"))
}
return(invisible(NULL))
}
assertCharacter(param, any.missing = FALSE)
all.param = getParamIds(learner$par.set)
not.found.param = param[!param %in% all.param]
if (length(not.found.param) > 0) {
stopf("Parameters not found: %s", collapse(not.found.param, sep = ", "))
}
# put param in the same order as par.set
param = all.param[all.param %in% param]
values = getHyperPars(learner)
for (p in param) {
catf(" *%s*:", p)
print(learner$par.set$pars[[p]])
req = learner$par.set$pars[[p]]$requires
if (!is.null(req)) {
cat("Requires: ")
print(req)
}
if (!is.null(values[[p]])) {
catf("Value: %s",
ifelse(testScalar(values[[p]]), values[[p]], capture.output(print(values[[p]]))))
}
if (p %in% names(learner$help.list)) {
output = learner$help.list[[p]]
cat(collapse(strwrap(output), sep = "\n"), "\n\n")
} else {
catf("No documentation found. Try to consult helpLearner(\"%s\").\n", getLearnerId(learner))
}
}
}
# remove nesting levels of XML tags
simplifyNode = function(node) {
children = XML::xmlChildren(node)
lens = nchar(stri_trim(vcapply(children, XML::xmlValue)))
if (length(lens) < 1) {
return(NULL)
}
if (sum(lens) == max(lens)) {
return(simplifyNode(children[[which.max(lens)]]))
} else {
children = children[lens != 0]
firstchild = simplifyNode(children[[1]])
if (length(firstchild) > 0) {
children = c(firstchild, children[-1])
}
return(children)
}
}
# collect all <li><code>xxx</code>yyy</li> in the document
# and form a data.frame with two columns corresponding to xxx and yyy.
codeListToTable = function(html) {
lis = XML::getNodeSet(html, "//li")
lislis = lapply(lis, function(li) {
lichi = simplifyNode(li)
if (length(lichi) < 2 || names(lichi)[1] != "code") {
return(NULL)
}
parname = XML::xmlValue(lichi[[1]])
pardesc = stri_join_list(lapply(lichi[-1], XML::xmlValue), collapse = " ")
stri_trim(c(parname, pardesc), pattern = c("[a-zA-Z0-9_.]", "\\P{Wspace}"))
})
as.data.frame(do.call(rbind, lislis), stringsAsFactors = FALSE)
}
# Remove superfluous newlines.
prepareString = function(string) {
# turn 'a \n \n \n b' into 'a\n\nb'
string = stri_replace_all(string, "\n\n", regex = " *\n *(\n *)+")
# turn 'a \n b' into 'a b'
string = stri_replace_all(string, " ", regex = "(?<!\n) *\n *(?!\n)")
# turn ' \n\n ' into '\n'
# strwrap does this for us, apparently.
# string = stri_replace_all(string, "\n", regex = " *\n\n *")
return(string)
}
makeParamHelpList = function(funs, pkgs, par.set) {
help.list = list()
par.ids = getParamIds(par.set)
pkgs = stri_replace_all(pkgs, "", regex = "[+!_]")
h = NULL
for (f in rev(funs)) {
for (pkg_ref in pkgs) {
h = utils::help(f, package = (pkg_ref))
if (length(h) > 0) {
break
}
}
if (length(h) == 0) {
# catf("nothing found: %s", f)
next
}
ghf = get(".getHelpFile", mode = "function", envir = getNamespace("utils"))
html = capture.output(tools::Rd2HTML(ghf(h)))
html = XML::htmlParse(html)
# try to extract the 'R argblock' table
tab = XML::getNodeSet(html, "//table[@summary='R argblock']")
if (!length(tab)) {
# R help html is not perfectly reliable in tagging the argblock table.
# In that case, use the first table under the '<h3>Arguments</h3>' heading.
tab = XML::getNodeSet(html, "//h3[text()='Arguments']/following-sibling::table")
}
if (length(tab) < 1) {
next
}
tbl = do.call(rbind, lapply(tab, function(t) {
tbl = XML::readHTMLTable(t, header = FALSE, stringsAsFactors = FALSE)
if (identical(ncol(tbl), 2L)) {
tbl
}
}))
# we also try to extract generally all lists that begin with a code string.
# this gets appended to the front, so that the (more trustworthy) html table
# extract will overwrite the <li>-extract if a param occurs in both.
tbl = rbind(codeListToTable(html), tbl)
if (is.null(tbl)) {
next
}
for (row in seq_len(nrow(tbl))) {
# the following loop handles occasions where multiple parameters are mentioned in
# one row, separated by commas.
for (par.name in stri_split(tbl[row, 1], regex = ", *")[[1]]) {
if (par.name %in% par.ids) {
help.list[[par.name]] = stri_join("Argument of: ",
pkg_ref, "::", f, "\n\n", prepareString(tbl[row, 2]))
} else {
# catf("not interesting: %s par %s", f, par.name)
}
}
}
}
return(help.list)
}
# helper function to get learner's undocumented functions.
listUndocumentedPars = function(learner) {
learner = checkLearner(learner)
setdiff(getParamIds(learner$par.set), names(learner$help.list))
}
|
