I currently use the following header:
```{r, message=FALSE}
foo <- function(x) message(x)
for(i in 1:10) foo(i)
```
Inside this code chunk, there is a loop over simulated scenarios, with message() function that prints status of currently executed scenario.
I would like to suppress those messages from display in RStudio and final HTML output, but I still want to control the simulation progress and see the message() output in console. Is this achievable? Maybe with other arguments/functions?
You can write/append status to a file (this is a workaround solution, there should be a more direct answer).
For example:
file <- file("status.txt", open = "wt")
sink(file, type = "message")
message("all good")
In this example message won't be displayed - it'll be written to a status.txt file.
In you're using specific function and iterating over a set you can try this example:
foo <- function(x) {
message(x)
}
file <- file("status.txt", open = "wt")
sink(file, type = "message")
for(i in 1:3) {
foo(i)
}
Function foo should return (message) value, however it appends it to a status.txt file.
You can track changes in status.txt file using bash tail command with -f argument. First send R to background and then use tail -f status.txt in your console.
One approach would be to put this in the start of your file.
mymessage <- function (text) {
if(knitr::opts_knit$get('out.format') != NULL) message(text)
}
There are various ways to know if you are within knitr, recent versions have knitr::is_latex_output and similar.
Related
Background
I've often aspired to prototype an R package which serves as a source of truth for styling conventions in (say) diagnostic output, and which enables central updates to those conventions.
After many failed experiments with crayon::hyperlink(), I was excited to stumble across Console hyperlinks to functions like `rlang::last_error()`
which preview documentation when hovered
and execute the code when clicked!
Attempt
On a whim, I prototyped a family of functions (see Code section below) that make universal provisions for such functionality. By inspecting the source code, I was able to replicate the functionality above for other rlang functions. Here we pipe (|>) my function style_run_call0() through cat()
rlang::quo("test") |> style_run_call0() |> cat()
to display in the Console a hyperlink to live code
which previews documentation when hovered
and executes the code when clicked:
Problem
This all works well enough for rlang functions. But for functions from other packages
base::sum(1:10) |> style_run_call0() |> cat()
it wrongly displays a "broken" link:
Even with rlang, the links are broken for any arguments that are calls themselves
rlang::quo(rlang::as_string("test")) |> style_run_call0() |> cat()
and for all private functions
rlang:::ansi_alert() |> style_run_call0() |> cat()
though the links do work for "simple" arguments with operators:
rlang::quo(TRUE || FALSE) |> style_run_call0() |> cat()
#> `rlang::quo(TRUE || FALSE)`
style_run_expr0(TRUE || FALSE) |> cat()
#> `TRUE || FALSE`
Question
I am 99% sure this problem boils down to the rstudio:run: format
style_rlang_run <- function(code) {
style_hyperlink(
paste0("rlang::", code),
paste0("rstudio:run:rlang::", code)
)
}
and its limitations for hyperlinking code.
But why would rlang:::style_rlang_run() need to specify "rlang::" if the "rstudio:run:" accommodated only rlang functions and nothing else?
Code
Text Links
These links are generated from character strings.
# Hyperlink to a URL.
style_hyperlink_url <- function (url, text = NULL, params = NULL) {
# Display text defaults to URL.
if (is.null(text))
text <- url
# Underline the link in blue for classic URL style.
crayon::underline$blue(rlang:::style_hyperlink(text, url, params))
}
# Hyperlink to run code (given as text) interactively in RStudio.
style_run_code <- function(code, text = NULL) {
# Display text defaults to code in backticks.
if (is.null(text))
text <- paste0("`", code, "`")
# Underline the hyperlink in silver to designate code link.
crayon::underline$silver(rlang:::style_hyperlink(text, paste0("rstudio:run:", code)))
}
Live Code
These code links are generated from R language itself.
# Hyperlink to run a (simple) 'call' object as an interactive command in RStudio.
style_run_call <- function(call, text = NULL) {
call_expr <- rlang::get_expr(call)
call_qual <- call_qualify(call_expr)
style_run_code(base::deparse1(call_qual), text)
}
# Hyperlink to run a (simple) literal call as an interactive command in RStudio.
style_run_call0 <- function(call, text = NULL) {
call_quo <- rlang::enquo0(call)
style_run_call(call_quo, text)
}
# Hyperlink to run a (simple) 'expression' object as an interactive command in RStudio.
style_run_expr <- function(expr, text = NULL) {
expr_expr <- rlang::get_expr(expr)
call_quo <- rlang::quo(rlang::eval_bare(!!expr_expr))
# Text defaults to the expression itself, not the code evaluating it.
if (is.null(text))
text <- paste0("`", base::deparse1(expr_expr), "`")
style_run_call(call_quo, text)
}
# Hyperlink to run a (simple) literal 'expression' as an interactive command in RStudio.
style_run_expr0 <- function(expr, text = NULL) {
expr_quo <- rlang::enquo0(expr)
style_run_expr(expr_quo, text)
}
Call Qualification
This function qualifies a call to fn() as pkg::fn().
call_qualify <- function(call) {
if (!rlang::is_call(call))
rlang::abort("`call` must be a call")
if (!rlang::is_call_simple(call))
rlang::abort("`call` must be a simple call")
# Check the namespace that qualifies the function.
call_ns_name <- rlang::call_ns(call)
# Qualify if necessary.
if (is.null(call_ns_name)) {
call_fn <- rlang.call_fn(call)
call_fn_name <- rlang::call_name(call)
call_ns_name <- rlang::ns_env_name(call_fn)
call_ns_sym <- rlang::sym(call_ns_name)
call_fn_sym <- rlang::sym(call_fn_name)
# TODO: Check if namespace exports the function.
if (fn_is_exported(call_fn_name, call_ns_name)) {
qual_sym <- quote(`::`)
} else {
qual_sym <- quote(`:::`)
}
# Assemble the qualified function name.
qual_expr <- quote(`::`(pkg = NULL, name = NULL))
qual_expr[[1]] <- qual_sym
qual_expr$pkg <- call_ns_sym
qual_expr$name <- call_fn_sym
# Assemble the qualified call.
call_expr <- rlang::get_expr(call)
call_expr[[1]] <- qual_expr
call <- rlang::set_expr(call, call_expr)
}
# Return the qualified call.
call
}
Helper Functions
# Function to check if a function is exported (TRUE) from its namespace, or internal (FALSE).
fn_is_exported <- function(fn_name, ns_name) {
# Placeholder.
TRUE
# TODO: Figure out an efficient algorithm.
# Since a function object may be assigned to a new name, perhaps we should match by bytecode instead?
}
# Current styler from "rlang".
.rlang.style_hyperlink <- rlang:::style_hyperlink
# Function to extract the function from a call. Deprecated in "rlang" and reconstructed here.
.rlang.call_fn <- function(call, env = caller_env()) {
expr <- rlang::get_expr(call)
env <- rlang::get_env(call, env)
if (!rlang::is_call(expr)) {
rlang:::abort_call_input_type("call")
}
switch(rlang:::call_type(expr),
recursive = rlang::abort("`call` does not call a named or inlined function"),
inlined = rlang:::node_car(expr),
named = , namespaced = ,
rlang::eval_bare(rlang:::node_car(expr), env)
)
}
Executing base:: functions is explicitly forbidden, see the RStudio PR and discussion in the issue.
If I understand the test code correctly, you can run code of your own package with:
cli::style_hyperlink("show style code", "ide:run:yourpackage::style()")
If yourpackage is not installed, it should just be copied into the console, but not executed.
I'm not really sure what your use case is, but maybe another option would be to generate a link to a help page or vignette in your package?
cli::style_hyperlink("help page", "ide:help:yourpackage::correct_style")
I'm using knitr to knit RMarkdown, and there have been multiple times where I have wanted to add code chunks programmatically, but failed to find a way to do so satisfactorily. Say I want to have knitr play a sound when a file has finished knitting. My way around this problem has been like so:
beep_on_knit <- function(beep_sound=3, sleep=3) {
library(beepr)
last_label <- tail(knitr::all_labels(),n=1)[[1]]
knitr::knit_hooks$set(
.beep_on_last_chunk =
function(before, options) {
if (options$label == last_label & !before) {
beepr::beep(beep_sound)
Sys.sleep(sleep)
invisible(NULL)
}
})
# Sets the options for every chunk so the hook will be run on them
knitr::opts_chunk$set(.beep_on_last_chunk = TRUE)
}
However, having to edit the chunk properties of every single chunk (i.e., knitr::opts_chunk$set(.beep_on_last_chunk = TRUE) means that if I add this function to a document, it invalidates the cache of every previously cached chunk.
Is there a way to set the options of a specific chunk beforehand?
I don't know why you need to set knitr::opts_chunk$set(.beep_on_last_chunk = TRUE) globally for the document. Is it possible for you to set .beep_on_last_chunk = TRUE only on the last chunk as a local chunk option? If this is possible, you won't need to test if (options$label == last_label) in the hook.
Alternatively, you may consider using the document hook, which is executed after the whole document has been knitted, e.g.,
knitr::knit_hooks$set(document = function(x) {
beepr::beep(3)
x
})
For educational purposes we are logging all commands that students type in the rstudio console during labs. In addition we would like to store if call was successful or raised an error, to identify students which struggling to get the syntax right.
The best I can come up with is something like this:
options(error = function(){
timestamp("USER ERROR", quiet = TRUE)
})
This adds an ## ERROR comment on the history log when an exception occurs. Thereby we could analyze history files to see which commands were followed by an ## ERROR comment.
However R's internal history system is not well suited for logging because it is in-memory, limited size and needs to be stored manually with savehistory(). Also I would prefer to store log one-line-per-call, i.e. escape linebreaks for multi-line commands.
Is there perhaps a hook or in the R or RStudio console for logging actual executed commands? That would allow me to insert each evaluated expression (and error) in a database along with a username and timestamp.
A possible solution would be to use addTaskCallback or the taskCallbackManager with a function that writes each top-level command to your database. The callback will only fire on the successful completion of a command, so you would still need to call a logging function on an error.
# error handler
logErr <- function() {
# turn logging callback off while we process errors separately
tcbm$suspend(TRUE)
# turn them back on when we're done
on.exit(tcbm$suspend(FALSE))
sc <- sys.calls()
sclen <- length(sc) # last call is this function call
if(sclen > 1L) {
cat("myError:\n", do.call(paste, c(lapply(sc[-sclen], deparse), sep="\n")), "\n")
} else {
# syntax error, so no call stack
# show the last line entered
# (this won't be helpful if it's a parse error in a function)
file1 <- tempfile("Rrawhist")
savehistory(file1)
rawhist <- readLines(file1)
unlink(file1)
cat("myError:\n", rawhist[length(rawhist)], "\n")
}
}
options(error=logErr)
# top-level callback handler
log <- function(expr, value, ok, visible) {
cat(deparse(expr), "\n")
TRUE
}
tcbm <- taskCallbackManager()
tcbm$add(log, name = "log")
This isn't a complete solution, but I hope it gives you enough to get started. Here's an example of what the output looks like.
> f <- function() stop("error")
f <- function() stop("error")
> hi
Error: object 'hi' not found
myError:
hi
> f()
Error in f() : error
myError:
f()
stop("error")
Is there any way to stop an R program without error?
For example I have a big source, defining several functions and after it there are some calls to the functions. It happens that I edit some function, and want the function definitions to be updated in R environment, but they are not actually called.
I defined a variable justUpdate and when it is TRUE want to stop the program just after function definitions.
ReadInput <- function(...) ...
Analyze <- function(...) ...
WriteOutput <- function(...) ...
if (justUpdate)
stop()
# main body
x <- ReadInput()
y <- Analyze(x)
WriteOutput(y)
I have called stop() function, but the problem is that it prints an error message.
ctrl+c is another option, but I want to stop the source in specific line.
The problem with q() or quit() is that it terminates R session, but I would like to have the R session still open.
As #JoshuaUlrich proposed browser() can be another option, but still not perfect, because the source terminates in a new environment (i.e. the R prompt will change to Browser[1]> rather than >). Still we can press Q to quit it, but I am looking for the straightforward way.
Another option is to use if (! justUpdate) { main body } but it's clearing the problem, not solving it.
Is there any better option?
I found a rather neat solution here. The trick is to turn off all error messages just before calling stop(). The function on.exit() is used to make sure that error messages are turned on again afterwards. The function looks like this:
stop_quietly <- function() {
opt <- options(show.error.messages = FALSE)
on.exit(options(opt))
stop()
}
The first line turns off error messages and stores the old setting to the variable opt. After this line, any error that occurs will not output a message and therfore, also stop() will not cause any message to be printed.
According to the R help,
on.exit records the expression given as its argument as needing to be executed when the current function exits.
The current function is stop_quietly() and it exits when stop() is called. So the last thing that the program does is call options(opt) which will set show.error.messages to the value it had, before stop_quietly() was called (presumably, but not necessarily, TRUE).
There is a nice solution in a mailing list here that defines a stopQuietly function that basically hides the error shown from the stop function:
stopQuietly <- function(...) {
blankMsg <- sprintf("\r%s\r", paste(rep(" ", getOption("width")-1L), collapse=" "));
stop(simpleError(blankMsg));
} # stopQuietly()
> stopQuietly()
I have a similar problem and, based on #VangelisTasoulas answer, I got a simple solution.
Inside functions, I have to check if DB is updated. If it is not, stop the execution.
r=readline(prompt="Is DB updated?(y/n)")
Is DB updated?(y/n)n
if(r != 'y') stop('\r Update DB')
Update DB
Just putting \r in the beginning of the message, overwrite Error: in the message.
You're looking for the function browser.
You can use the following solution to stop an R program without error:
if (justUpdate)
return(cat(".. Your Message .. "))
Just return something at the line you want to quit the function:
f <- function(x, dry=F) {
message("hi1")
if (dry) return(x)
message("hi2")
x <- 2*x
}
y1 <- f(2) # = 4 hi1 hi2
y2 <- f(2, dry=T) # = 2 hi1
In addition to answer from Stibu on Mar 22 '17 at 7:29, if you want to write a message as a part of stop(), this message is not written.
I perceive strange that following two lines have to be used meaning on.exit(options(options(show....))) doesn't work.
opt <- options(show.error.messages = F)
on.exit(options(opt))
I had forgotten the answer to this and needed to look it up and landed here... You posted the hint to the answer in your question...
ctrl+c is another option, but I want to stop the source in specific line.
Signal an error, warning, or message
rlang::inform("Updated Only")
rlang::interrupt()
I've found it good to write a script and run it with source(). In the script, a write exit statements as a special class of error that a tryCatch() can pick up and send back as just a message:
exit <- function(..., .cl = NULL) {
# Use to capture acceptable stop
cond <- structure(
list(.makeMessage(...), .cl),
class = c("exitError", "error", "condition"),
names = c("message", "call")
)
stop(cond)
}
foo <- function() {
exit("quit here")
1
}
tryCatch(
# rather than foo(), you might use source(filename)
foo(),
exitError = function(e) message(e$message)
)
#> quit here
Created on 2022-01-24 by the reprex package (v2.0.1)
You can use with_options() in the withr package to temporarily disable error messages and then you can call stop() directly.
Here is an example:
weird_math <- function(x, y, z) {
if (x > z) {
withr::with_options(
list(show.error.messages = FALSE),
{
print("You can execute other code here if you want")
stop()
}
)
}
# only runs if x <= z
x + y ^ z
}
weird_math(1, 2, 3)
[1] 9
weird_math(3, 2, 1)
[1] "You can execute other code here if you want"
why not just use an if () {} else {}? It's only a couple of characters...
f1 <- function(){}
f2 <- function(){}
if (justUpdate) {
} else {
# main body
}
or even
f1 <- function(){}
f2 <- function(){}
if (!justUpdate) {
# main body
}
The below code work for me stopped without error messages.
opt <- options(show.error.messages = FALSE)
on.exit(options(opt))
break
I have a problem with Sweave + RweaveHTML
I want the output of cat ends to up in the html file being generated. I have a case in which it does not and I can't figure out why :(
test = function()
{
#bla bla;
cat("Result is...")
}
And then in the Rnw file I tried all of these:
<<echo=FALSE, results=html, include=TRUE>>=
test()
#
<<results=html, include=TRUE>>=
test()
#
<<results=html>>=
test()
#
<<>>=
test()
#
But I don't get the cat output in the resulting HTML file.
I'm pretty sure this is supposed to work...
Any ideas of what I'm supposed to do to get the stdout ouput to the final html file?
Thx!
The RweaveHTML driver works differently than the RweaveLatex driver in that to create output, the result from every line of code is processed with the generic function HTML. Other ways of creating output don't work. So to get output from within a function, there are two ways I know of; one is to return a value to be processed by the HTML generic, and the other is to call HTML directly. The following replacement of your test function demonstrates both.
test <- function() {
#bla bla;
HTML("Result is...")
"Return value is"
}
It's also possible to replace cat with HTML; then your original function would work. But it's a bit of a hack and could have unforeseen consequences; you'd put
cat <- HTML
in a (probably hidden) Sweave chunk at the beginning of the document.