I am trying to understand how the function blogdown::serve_site works. Its code, in R console, is shown as below:
> blogdown::serve_site
function (..., .site_dir = NULL)
{
serve = switch(generator(), hugo = serve_it(), jekyll = serve_it(baseurl = get_config2("baseurl",
""), pdir = get_config2("destination", "_site")),
hexo = serve_it(baseurl = get_config2("root", ""),
pdir = get_config2("public_dir", "public")),
stop("Cannot recognize the site (only Hugo, Jekyll, and Hexo are supported)"))
serve(..., .site_dir = .site_dir)
}
<bytecode: 0x000002919ec4f158>
<environment: namespace:blogdown>
Within the switch function, the function generator() does not seem to be either a base-R function or a blogdown function. Its code can not be viewed through the R console. What does this function generator() do and how can I view its code?
Related
I'd like to find the minimal hack to be able to say module::obj when module is not a package but a list or environment.
After some digging, I see the following works for the new use case, but breaks the native one:
module = structure(list(f = \(x) x + 1), class = "module_cls")
`::` = function(mod, key) UseMethod("::")
`::.default` = function(mod, key) .Primitive("::")
`::.module_cls` = function(mod, key) mod[[as.character(substitute(key))]]
module::f(1) # works!
base::sum(1, 1) # Error in base::sum : object 'base' not found
The problem seems to be either in the definition of the default method
or how anything that is not module_cls is depatched to default.
I want my function to print nice-looking tables, whether it's called from base R or from an RStudio Notebook (.Rmd file). The function should figure out where it's being called from, and adjust the table accordingly. I want the function to be easy to use, and don't want the user to have to specify anything about where the function is being called from.
I can achieve some of this with huxtable, but the user still has to modify the code a little. (I think this would work similarly with kable.)
Here is the function definition:
library(huxtable)
func = function() {
table = hux(head(iris))
# Color of table border: white on screen / base R, black in HTML
color = if(isTRUE(all.equal(getOption('huxtable.print') , huxtable::print_screen))) "white" else "black"
table = set_all_borders(table, brdr(color = color))
print(table)
}
In base R, I can just call the function:
# Base R
func()
But in an RStudio Notebook, I need to make a couple of changes when calling the function, namely:
{r, results="asis"}
options("huxtable.print" = huxtable::print_html)
The call looks like this:
```{r, results="asis"}
# RStudio
options("huxtable.print" = huxtable::print_html)
func()
```
Is there a better solution where the user can call the function the same way in base R and RStudio?
Maybe something like this?
library(huxtable)
func = function(table) {
html_output = isTRUE(all.equal(getOption('huxtable.print') ,
huxtable::print_html) ||
guess_knitr_output_format() == "html"
color = if(html_output) "black" else "white"
table = set_all_borders(table, brdr(color = color))
print(table)
}
Thanks to #dash2 for giving me the idea. Here is the function that does what I want:
library(huxtable)
func = function() {
table = hux(head(iris))
if (guess_knitr_output_format() == "") { # base R
table = set_all_borders(table, brdr(color = "white"))
print(table, colnames = FALSE)
} else { # knitr / RStudio
table = set_all_borders(table, brdr(color = "black"))
huxtable:::knit_print.huxtable(table, colnames = FALSE)
}
}
func()
I'm using slackr to send alert messages to a Slack channel. It works great except the message format is not great and I want to improve it.
install_github("hrbrmstr/slackr")
library(slackr)
slackr_setup(channel="#alerts", username="Mark Davis",
incoming_webhook_url = "https://hooks.slack.com/services/T31P8UDAB/BCH4HKQSC/*********",
api_token = "*********", echo = F)
alert="On Monday, 2018-09-03 # 2pm Pacific..."
slackr(alert)
Here is an example of how a message from slackr looks in Slack:
Here is an example of how I'd like it to look:
slackr doesn't seem to have many options in the way of formatting. I was thinking of building an image and inserting that, but I'm having trouble building an image out of a text file using R.
Perhaps there is another api I could call that could take my text and format it for slack?
I'm open to any suggestions.
Addendum:
Slackr has an option to upload files, so my latest attempt is to create an image from the text message and upload that object.
I am able to create a png file from the text message using the magick library. I created an image with a colored background, and I simply add the message text to the image:
library(magick)
alert_picture <- image_read('alert_480x150_dark_red.png')
alert_picture=image_annotate(alert_picture, DreamCloud_Alert, size = 20, gravity = "southwest",
color = "white", location = "+10+10")
image_write(alert_picture, path = "alert_picture.png", format = "png")
The image looks pretty good (although there doesn't seem to be an easy way to bold or underline specific words in the message), but the obstacle now is that I can't get the upload command to work.
slackr_upload(filename = "alert_picture.png")
I don't get any error messages but nothing is uploaded to slack.
I got around this issue by using the httr package to execute the post image function to slack.
Thanks to Adil B. for providing the solution:
Post Image to Slack Using HTTR package in R
I am not sure this is what you meant, but I solved allowing formatting like in a regular slack message by altering the slackr_bot() function and just removing the 2 sets of 3 back-ticks at the end of the code where it says text. Then just call it slackr_bot1() or something, and then you can post formatted messages. This is the function after the back-ticks removal:
slackr_bot1 <- function(...,
channel=Sys.getenv("SLACK_CHANNEL"),
username=Sys.getenv("SLACK_USERNAME"),
icon_emoji=Sys.getenv("SLACK_ICON_EMOJI"),
incoming_webhook_url=Sys.getenv("SLACK_INCOMING_URL_PREFIX")) {
if (incoming_webhook_url == "") {
stop("No incoming webhook URL specified. Did you forget to call slackr_setup()?", call. = FALSE)
}
if (icon_emoji != "") { icon_emoji <- sprintf(', "icon_emoji": "%s"', icon_emoji) }
resp_ret <- ""
if (!missing(...)) {
# mimics capture.output
# get the arglist
args <- substitute(list(...))[-1L]
# setup in-memory sink
rval <- NULL
fil <- textConnection("rval", "w", local = TRUE)
sink(fil)
on.exit({
sink()
close(fil)
})
# where we'll need to eval expressions
pf <- parent.frame()
# how we'll eval expressions
evalVis <- function(expr) withVisible(eval(expr, pf))
# for each expression
for (i in seq_along(args)) {
expr <- args[[i]]
# do something, note all the newlines...Slack ``` needs them
tmp <- switch(mode(expr),
# if it's actually an expresison, iterate over it
expression = {
cat(sprintf("> %s\n", deparse(expr)))
lapply(expr, evalVis)
},
# if it's a call or a name, eval, printing run output as if in console
call = ,
name = {
cat(sprintf("> %s\n", deparse(expr)))
list(evalVis(expr))
},
# if pretty much anything else (i.e. a bare value) just output it
integer = ,
double = ,
complex = ,
raw = ,
logical = ,
numeric = cat(sprintf("%s\n\n", as.character(expr))),
character = cat(sprintf("%s\n\n", expr)),
stop("mode of argument not handled at present by slackr"))
for (item in tmp) if (item$visible) { print(item$value, quote = FALSE); cat("\n") }
}
on.exit()
sink()
close(fil)
# combined all of them (rval is a character vector)
output <- paste0(rval, collapse="\n")
loc <- Sys.getlocale('LC_CTYPE')
Sys.setlocale('LC_CTYPE','C')
on.exit(Sys.setlocale("LC_CTYPE", loc))
resp <- POST(url = incoming_webhook_url, encode = "form",
add_headers(`Content-Type` = "application/x-www-form-urlencoded",
Accept = "*/*"), body = URLencode(sprintf("payload={\"channel\": \"%s\", \"username\": \"%s\", \"text\": \"%s\"%s}",
channel, username, output, icon_emoji)))
warn_for_status(resp)
}
return(invisible())
}
slackr_bot1("*test* on time")
Consider either function which (for rstudio) will open something in the viewer if y = TRUE and in your browser if y = FALSE. You can force the whatever to open in your browser via options(viewer = NULL) (and then you need to reset to before), but I can't get this to work inside functions using the normal on.exit approach. Tested on windows and osx.
f <- function(x, y = TRUE) {
if (y) {
oo <- getOption('viewer')
on.exit(options(viewer = oo))
options(viewer = NULL)
} else options(viewer = NULL)
print(getOption('viewer'))
DT::datatable(x)
}
g <- function(x, y = TRUE) {
if (y) {
oo <- getOption('viewer')
on.exit(options(viewer = oo))
options(viewer = NULL)
} else options(viewer = NULL)
print(getOption('viewer'))
htmlTable::htmlTable(x)
}
## in rstudio, returns the viewer function
getOption('viewer')
# function (url, height = NULL)
# ...
## opens in viewer despite `options(viewer = NULL)`
g(mtcars)
# NULL
## again returns the function, ie, reset my options to before g call successfully
getOption('viewer')
# function (url, height = NULL)
# ...
## opens in browser but leaves `options(viewer = NULL)` after exiting
g(mtcars, FALSE)
# NULL
getOption('viewer')
# NULL
It seems like the viewer isn't respecting my options within the function environment with either just some html (g) or a widget (f). I thought both would use viewer = NULL inside the function and return my options the way they were upon exiting so that I can control where I want to view the result.
Or is there a better way of doing this for both html and widgets? I have tried the options argument in DT::datatable to no avail, but this wouldn't help for the htmlTable::htmlTable case.
The only other approach I can think of is to write all the code to a temp file and use if (rstudio) rstudio::viewer(tempfile) else browseURL(tempfile) which I think is a lot of work for something seemingly so straight-forward.
Although this isn't a fix, I think it illustrates what's going on. Try adding a Sys.sleep() call in the on.exit() handler:
f <- function(x) {
viewer <- getOption("viewer")
on.exit({
print("Restoring viewer...")
Sys.sleep(3)
options(viewer = viewer)
}, add = TRUE)
options(viewer = NULL)
DT::datatable(x)
}
## opens in viewer despite `options(viewer = NULL)`
f(mtcars)
You'll notice that RStudio doesn't 'decide' what to do with the result of DT::datatable() call until after the on.exit() handler has finished execution. This means that, by the time RStudio wants to figure out to do with the result, the viewer has already been restored! Odds are, RStudio waits until R is no longer 'busy' to decide how to display the resulting content, and by then is too late for temporary changes to the viewer option.
Note that this doesn't explain the htmlTable behaviour. My best guess is that there is some kind of race condition going on; the lost viewer option seems to go away with strategically placed Sys.sleep() calls...
Unfortunately, working around this means avoiding the use of on.exit() call -- unless we can figure out to handle this in RStudio, of course.
Here's one way you could get this functionality by writing the code to a temporary file and using browseURL or whatever you like.
The gist of both f and g are the same, so you could have one function to handle any type of html code or widget I suppose. And probably widgets need to be selfcontained = TRUE.
f <- function(x, y = TRUE) {
x <- if ((inherits(x, 'iplot'))) x else DT::datatable(x)
if (!y) {
htmlFile <- tempfile(fileext = '.html')
htmlwidgets::saveWidget(x, htmlFile, selfcontained = TRUE)
utils::browseURL(htmlFile)
} else x
}
g <- function(x, y = TRUE) {
x <- htmlTable::htmlTable(x)
if (!y) {
htmlFile <- tempfile(fileext = '.html')
writeLines(x, con = htmlFile)
utils::browseURL(htmlFile)
} else x
}
## opens in viewer
g(mtcars)
## opens in browser
g(mtcars, FALSE)
## same for widgets
f(mtcars)
f(mtcars, FALSE)
f(qtlcharts::iplot(1:5, 1:5), FALSE)
## and my options haven't changed
getOption('viewer')
# function (url, height = NULL)
# ...
Side note that this is actually the proper way to have htmlTable::htmlTable use a different viewer, but g should work for any html.
library('htmlTable')
print(htmlTable(mtcars), useViewer = utils::browseURL)
I am trying to export a 3D plot that was made using the plot3d function from the rgl package using the WrtieWebGL function for web viewing. I don't really understand the example in the WriteWebGL documentation because it saves to a temp directory. Could someone please provide an example on how to use this function and/or point out my error(s) with usage? Thank you for your time and help.
attach(dataset1)
plot3d(Days_Prep_Time,ACT_Score,Coffee,size=5,col="blue", type="s")
writeWebGL(dir = "webGL", filename = file.path(dir, "index.html"),
template = system.file(file.path("WebGL", "template.html"), package = "rgl",
snapshot = TRUE, font = "Arial")
I get the following error:
Error in writeWebGL(dir = "webGL", filename = file.path(dir, "index.html"), :
template ‘’ does not contain %WebGL%
In addition: Warning message:
In file(con, "r") :
file("") only supports open = "w+" and open = "w+b": using the former
You are adding the snapshot and font parameters to the system.file function, not the writeWebGL function:
writeWebGL(dir = "webGL", filename = file.path(dir, "index.html"),
template = system.file(file.path("WebGL", "template.html"), package = "rgl"),
snapshot = TRUE, font = "Arial")
In particular, note that
system.file(file.path("WebGL", "template.html"), package = "rgl")
returns the correct path from console, whereas
system.file(file.path("WebGL", "template.html"), package = "rgl", snapshot = TRUE, font = "Arial")
returns "".