I've the following Problem:
I'm using the opencpu package to provide my R Package as a web application. In my package I created a RefClass lets call that
.A <- setRefClass(
".A",
fields = c(
id = "integer",
text = "character"
)
)
plus a constructor function:
A <- function(id,text ){return(.A(id,text))}
and on top I wrote a method "toJSON" for the class and also provided an S4 method like this:
.A$methods(
toJSON = function(){
return(sprintf('{\"id\": %s, \"text\": %s}',id,text))
})
setMethod("toJSON", c(".A"),function(x,...){
x$toJSON()
})
So far everthing is fine. When I install the package and run opencpu, I can call the A method without a problem: (POST with parameters e.g.: {id: 123, text: "Hallo World"})
SERVERADRESS/ocpu/library/PACKAGENAME/R/A
But when I want the returned value to be directly converted into JSON I get the following error:
No method for S4 class:.A
A look at the opencpu site, tells that the procedure which is called in this case is:
library(jsonlite)
args <- fromJSON('{"id": 123, "text": "Hallo World"}')
output <- do.call(PKGNAME::A,args)
toJSON(output)
However this runs fine if I run it in a regular R session. But the error becomes reproducable if I change the last line from toJSON(output) to jsonlite::toJSON(output)
Hence I think this might be the problem and I was wundering if I can add my "toJSON" S4 method with signature ".A" to the Namespace of "jsonlite" within my package?
Any Ideas?
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 have a simple function in my Plumber API that looks like the following:
library(methods)
library(plumber)
# Other functions...
#' #param elist The list of events to process as a string
#' #get /process
process_events <- function(elist=""){
setClass("EventPattern", representation(sequence="character", probability="numeric", endProbs="data.frame"))
q <- new("EventPattern", sequence=elist, probability=1, endProbs=data.frame(None=0))
# Further code that should make use of q
}
I start Plumber (locally) and point it to the script containing the api (the above) as:
r <- plumb('/path/to/script/forecast.R')
r$run(port=8000, swagger = TRUE)
And call the function on the address (using PostMan):
http://localhost:8000/process?elist="abcd"
But what I end up getting is 'An Exception Occurred' with the R console saying that:
<simpleError: No method for S4 class:EventPattern>
I realize that the error suggests that a method (a generic) is required, but when I type:
q <- new("EventPattern", sequence=elist, probability=1, endProbs=data.frame(None=0))
locally on my machine (in the R console) it works fine. It suggests to me that something is not fully loaded or available to Plumber, but I have no idea how to fix it. Any ideas?
I have not used setClass and new before. But I've worked with plumber last year. I found using your example that it is trying to return q, and throwing an error because of it.
Adding a print statement seems to prevent an error:
library(methods)
library(plumber)
# Other functions...
#' #param elist The list of events to process as a string
#' #get /process
process_events <- function(elist=""){
setClass("EventPattern", representation(sequence="character", probability="numeric", endProbs="data.frame"))
q <- new("EventPattern", sequence=elist, probability=1, endProbs=data.frame(None=0))
print("Not returning 'q'")
# Further code that should make use of q
}
In a package I am working on, I would like to use data from another package (say, "pckg"). That package is imported ("Imports: pckg" in DESCRIPTION and import(pckg) in NAMESPACE). In one of the functions, I have the following:
someFunc <- function() {
data(pckgdata)
foo <- pckgdata$whatever
}
This results in the following error message when checking the package:
someFunc: no visible binding for global variable ‘pckgdata’
someFunc : <anonymous>: no visible binding for global variable
‘pckgdata’
Undefined global functions or variables:
pckgdata
How should I correctly use data sets from other packages in my own package?
Here is the description of the answer from #hrbmstr (see comments to the question). In short: first, create a global variable holding a new environment. Then, load the data into that environment. Then, access the data through the global variable:
.myenv <- new.env(parent=emptyenv())
someFunc <- function() {
data("pckgdata", package="pckg", envir=.myenv)
foo <- .myenv$pckgdata$whatever
}
Inside an R package, I'm trying to patch the base::library() function in R to specifically set the position of the loaded packages in the search path. I haveve defined several environments (all named env:<something>) and want to make sure that libraries are placed below these environments in the search path.
# wrap around library function.
library = function(..., pos = NULL) {
print("NEW LIBRARY FUNCTION!")
if (is.null(pos)) {
pos <- grep("env:", search())
pos <- if (length(pos) == 0) 2 else max(pos) + 1
}
base::library(..., pos=pos)
}
When I assign this function in the console, everything runs fine:
> library(stats)
[1] "NEW LIBRARY FUNCTION!"
> eval(parse(text = "library(stats)"))
[1] "NEW LIBRARY FUNCTION!"
> eval(parse(text = "library(stats)"), envir = globalenv())
[1] "NEW LIBRARY FUNCTION!"
When I define the above wrapper function inside my package, build it and load it in a new R Session, the following executes as expected:
> library(mypackage)
> mypackage:::library(stats)
[1] "NEW LIBRARY FUNCTION!"
But, when using eval() with the envir argument inside a function in mypackage, my new definition of library() is not retrieved:
# Functions defined in mypackage
testlibrary1 = function(...) {
library(...)
}
testlibrary2 = function(code) {
eval(parse(text = code))
}
testlibrary3 = function(code) {
eval(parse(text = code), envir = globalenv())
}
In console, I get the following results:
> mypackage:::testlibrary1(stats)
[1] "NEW LIBRARY FUNCTION!"
> mypackage:::testlibrary2("library(stats)")
[1] "NEW LIBRARY FUNCTION!"
> mypackage:::testlibrary3("library(stats)")
>
The last function, testlibrary3(), did not use the new wrapper function.
I want all functions that call library() inside mypackage to use my wrapper function. Can somebody help me out?
I guess the problem is the following, but as your question did not include a fully reproducible example (i.e., by uploading the package somewhere) it is difficult to tell.
As long as your library function is not exported from your package via the NAMESPACE it is not visible. Consequently, the only available library function to eval is base::library().
Note that while your function resides in the namespace of the package the calling environment for mypackage:::testlibraryX() is still the global environment. There your library functions is not available. Try to export is and see if this helps.
I created a function which produces a matrix as a result, but I can't figure out how to make the output of this function usable outside of the function environment, so that I could for instance save it in csv file.
My code for function is the following:
created function which takes url's from specific site and returns page title:
getTitle <- function(url) {
webpage <- readLines(url)
first.row <- webpage[1]
start <- regexpr("<title>", first.row)
end <- regexpr("</title>", first.row)
title <- substr(first.row,start+7,end-1)
return(title)
}
created function which takes vector of urls and returns n*2 matrix with urls and page titles:
getTitles <- function(pages) {
my.matrix <- matrix(NA, ncol=2, nrow=nrow(pages))
for (i in seq_along(1:nrow(pages))) {
my.matrix[i,1] <- as.character(pages[i,])
my.matrix[i,2] <- getTitle(as.character(pages[i,])) }
return(my.matrix)
print(my.matrix)}
After running this functions on a sample file from here http://goo.gl/D9lLZ which I import with read.csv function and name "mypages" I get the following output:
getTitles(mypages)
[,1] [,2]
[1,] "http://support.google.com/adwords/answer/1704395" "Create your first ad campaign - AdWords Help"
[2,] "http://support.google.com/adwords/answer/1704424" "How costs are calculated in AdWords - AdWords Help"
[3,] "http://support.google.com/adwords/answer/2375470" "Organizing your account for success - AdWords Help"
This is exactly what I need, but I'd love to be able to export this output to csv file or reuse for further manipulations. However, when I try to print(my.matrix), I am getting an error saying "Error: object 'my.matrix' not found"
I feel like it's quite basic gap in my knowledge, but have not been working with R for a while and could not solve that.
Thanks!
Sergey
That's easy: use <<- for assignment to a global.
But then again, global assignment is evil and not functional. Maybe you'd rather return
a list with several results from your function? Looking at your code, it seems that your second function may confuse the return and print. Make sure you return the correct data structure.
A little about functional programming. First of all, when you define your function:
getTitles <- function(pages) {
[...]
return(my.matrix)
print(my.matrix)
}
know that when the function is called it will never reach the print statement. Instead, it will exit right before, with return. So you can remove that print statement, it is useless.
Now the more important stuff. Inside your function, you define and return my.matrix. The object only exists within the scope of the function: as the function exits, what is returned is an unnamed object (and my.matrix is lost.)
In your session, when you call
getTitles(mypages)
the result is printed because you did not assign it. Instead, you should do:
out.matrix <- getTitles(mypages)
Now the result won't be printed but you can definitely do so by typing print(out.matrix) or just out.matrix on a single line. And because you have stored the result in an object, you can now reuse it for further manipulations.
If it help you grasp the concept, this is all the same as calling the c() function from the command line:
c(1, 5, 2) # will return and print a vector
x <- c(1, 5, 2) # will return and assign a vector (not printed.)
Bonus: Really, I don't think you need to define getTitles, but you can use one of the *apply functions. I would try this:
url <- as.character(mypages)
title <- sapply(url, getTitle)
report <- data.frame(url, title)
write.csv(report, file = "report.csv", row.names = FALSE)
Can't you just use <<- to assign it the object to the workspace? The following code works for me and saves the amort_value object.
amortization <- function(cost, downpayment, interest, term) {
amort_value <<- (cost)*(1-downpayment/100)*(interest/1200)*((1+interest/1200)^(term*12))/((1+interest/1200)^(term*12)-1)
sprintf("$%.2f", amort_value)
}
amortization(445000,20,3,15)
amort_value
At the end of the function, you can return the result.
First define the function:
getRangeOf <- function (v) {
numRange <- max(v) - min(v)
return(numRange)
}
Then call it and assign the output to a variable:
scores <- c(60, 65, 70, 92, 99)
scoreRange <- getRangeOf(scores)
From here on use scoreRange in the environment. Any variables or nested functions within your defined function is not accessible to the outside, unless of course, you use <<- to assign a global variable. So in this example, you can't see what numRange is from the outside unless you make it global.
Usually, try to avoid global variables at an early stage. Variables are "encapsulated" so we know which one is used within the current context ("environment"). Global variables are harder to tame.