I love the package but I was wondering how I could change one rule from the tidyverse style: I'd like to keep "=" instead of "<-" for assignment.
I've read that note: http://styler.r-lib.org/articles/customizing_styler.html#implementation-details
But I still don't get how to simply change that rule.
I've tried the very naive:
library(styler)
force_assignment_op <- function (pd)
{
to_replace <- pd$token == "LEFT_ASSIGN"
pd$token[to_replace] <- "EQ_ASSIGN"
pd$text[to_replace] <- "="
pd
}
tidyverse_style()$token$force_assignment_op = force_assignment_op
But get the following error:
Error in tidyverse_style()$token$force_assignment_op =
force_assignment_op :
invalid (NULL) left side of assignment
I would like to modify it in a way that I can simply run the styler addin afterwards.
The problem is that tidyverse_style()$token is a list, not an environment, so you can't modify it. (Well, you can modify it, but you're modifying a copy, not the original.)
You need to write your own function to replace the tidyverse_style function, and use it instead. For example, assuming you keep your force_assignment_op function:
LaSy_style <- function(...) {
ts <- tidyverse_style(...)
ts$token$force_assignment_op <- force_assignment_op
ts
}
Then
style_text(c("ab <- 3", "a <-3"), strict = FALSE, style = LaSy_style)
(one of the examples from ?tidyverse_style) will print
ab = 3
a = 3
(This is ugly, the original tidyverse_style is better, but I won't stop you.)
Related
I am writing a server program in R where I upload PDF files and which later extracts data from the tables inside the pdf.
If required table and data is there, it works fine. But if not, it gives me error for files[i][[1]][[3]] and files[i][[1]][[4]].
error: subscript out of bounds
I want to default the value of buy and sell price at NA, if the table is not there.
all_data <- eventReactive(input$done, {
req(input$files)
files = {}
cost_price_list = {}
sell_price_list = {}
df <- data.frame(cost_price_list = character(), sell_price_list = character())
files <- lapply(input$files$datapath, extract_tables)
for (i in 1:length(input$files$datapath))
{
tryCatch(
{
cost_price_list <- files[i][[1]][[3]]
sell_price_list <- files[i][[1]][[4]]
},
error=function(cond) {
cost_price_list[i] = NA
sell_price_list[i] = NA
}
)
df[nrow(df) + 1,] <- c(cost_price_list[i],sell_price_list[i])
}
#return dataframe as table
df
})
But the above code doesn't work for me if the table is not there in pdf.
What am i doing wrong?
Please help.
There are multiple problems with your code.
First of, files = {} works but almost certainly doesn’t do what you intended. Did you mean files = list()? Otherwise, the idiomatic way of expressing what your code does is to write files = NULL in R. A more idiomatic way would be not to assign an empty object at all. In fact, your code overrides this initial value of files anyway, so files = {} is entirely redundant; and so are the next two assignments.
Next, since files is a list, you need to use double brackets to extract single elements from it: files[[i]], not files[i].
Another problem with your code is that assignment in R is always local. So cost_price_list[i] = NA creates a local variable inside the error handler function, even though cost_price_list exists in an outer scope.
If you want to assign to the outer variable, you need to explicitly specify the scope (or use <<-, but I recommend against this practice):
…
outer = environment()
for (i in 1:length(input$files$datapath))
{
tryCatch(
{
cost_price_list <- files[i][[1]][[3]]
sell_price_list <- files[i][[1]][[4]]
},
error=function(cond) {
outer$cost_price_list[i] = NA
outer$sell_price_list[i] = NA
}
)
df[nrow(df) + 1,] <- c(cost_price_list[i],sell_price_list[i])
}
…
But this still won’t work, because these variables do not have a value that can be meaningfully subset into (and it is not entirely clear what your code is attempting to do). Still, I hope the above gives you a foundation to work with.
I've written an import function that gets a single file from an aws s3-bucket.
That function itself is a wrapper around aws.s3::s3read_using() which takes a reading function as its first argument.
Why do I wrap around aws.s3::s3read_using() ? Because I need to do some special error-handling and want the wrapping function to do some Recall() up to a limit... but that's a different story.
Now that i've successfully build and tested my wrapping function i want to do another wrapping arround that:
I want to iterate n times over my wrapper to bind the downloaded files together. I now have the difficulty to hand the 'reading_function' to the FUN argument of aws.s3::s3read_using().
I could do that by simply using ... - BUT!
I want to make clear to the USER of my wrapping wrapper, that he needs to specify that argument.
So I've decided to use rlangs rlang::enexpr() to capture the argument and to hand it over to my first wrapper via !! - which in return captures that argument again with rlang::enexpr() and hands it over - finally - to aws.s3::s3read_using() via rlang::expr(aws.s3::s3read_using(FUN = !!reading_fn, object = s3_object))
That works perfectly fine and smooth. My Problem is with testing that function construct using testthat and mockery
Here is some broadly simplyfied code:
my_workhorse_function <- function(fn_to_work_with, value_to_work_on) {
fn <- rlang::enexpr(fn_to_work_with)
# Some other magic happens here - error handling, condition-checking, etc...
out <- eval(rlang::expr((!!fn)(value_to_work_on)))
}
my_iterating_function <- function(fn_to_iter_with, iterate_over) {
fn <- rlang::enexpr(fn_to_iter_with)
out <- list()
for(i in seq_along(iterate_over)) {
out[[i]] <- my_workhorse_function(!!fn, iterate_over[i])
}
return(out)
}
# Works just fine
my_iterating_function(sqrt, c(9:16))
Now, to the test:
# Throws an ERROR: 'Error in `!fn`: invalid argument type'
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function", mock_1)
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
I've used a workarround, but that just doesn't feel right, even though, it works:
# Test passed
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function",
function(fn_to_work_with, value_to_work_on) {
fn <- rlang::enexpr(fn_to_work_with)
out <- mock_1(fn, value_to_work_on)
out})
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
I'm using version of R: 4.1.1
I'm using versions of testthat(3.1.1), mockery(0.4.2), rlang(0.4.12)
I think you're complicating things here, although maybe I'm not fully understanding your end goal. You can directly pass functions through arguments without any issue. Your example code above can be easily simplified to (keeping the loop just to match your test_that() call):
library(testthat)
library(mockery)
my_workhorse_function <- function(fn_to_work_with, value_to_work_on) {
fn_to_work_with(value_to_work_on)
}
my_iterating_function <- function(fn_to_iter_with, iterate_over) {
out <- list()
for(i in seq_along(iterate_over)) {
out[[i]] <- my_workhorse_function(fn_to_iter_with, iterate_over[i])
}
return(out)
}
# Works just fine
my_iterating_function(sqrt, c(9:16))
#> [[1]]
#> [1] 3
#>
#> ...
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function", mock_1)
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
#> Test passed 🥇
You can just pass FUN directly through all of your nested functions. The functions you're wrapping with enexpr() were never going to be evaluated in the first place until you explicitly call them. You usually use enexpr when users are supplying expressions, not just functions.
I want to detect if a variable is missing inside a function without calling the missing() function. I've found two alternatives, but they both seem crude.
Alternative 1
It seems that a variable that is missing has the environmnent class "name" but it seems intuitively wrong to use this construct:
a <- function(a, b){
e <- environment()
if(class(e[["b"]]) == "name")
e$b <- a
print(b)
}
Alternative 2
I guess a possible solution is to use parse and eval but it seems just as crude as the previous solution:
a <- function(a, b){
e <- environment()
if(eval(parse(text = sprintf("missing(%s)", "b"))))
e$b <- a
print(b)
}
Background
I need this as I'm changing the API and I would like to loop over all the old argument names within the ... and send a warning that the user should update to the new parameter names. This is why missing() doesn't work, my current setup is:
# Warnings due to interface changes in 1.0
API_changes <-
c(rowname = "rnames",
headings = "header",
halign = "align.header")
dots <- list(...)
fenv <- environment()
for (i in 1:length(API_changes)){
old_name <- names(API_changes)[i]
new_name <- API_changes[i]
if (old_name %in% names(dots)){
if (class(fenv[[new_name]]) == "name"){
fenv[[new_name]] <- dots[[old_name]]
dots[[old_name]] <- NULL
warning("Deprecated: '", old_name, "'",
" argument is now '", new_name ,"'",
" as of ver. 1.0")
}else{
stop("You have set both the old parameter name: '", old_name, "'",
" and the new parameter name: '", new_name, "'.")
}
}
}
Gosh,-- do we really have to point you to the appropriate fortune entry concerning eval(parse()) ?
Anyway,what's wrong with looping over the contents of dots<-list(...) ? It's not a time-pig by any means.
But my fundamental response is: you've made a mistake by allowing valid or invalid arguments within the ... entries. I don't know why you set up your previous function that way, but it's probably much cleaner, and safer, in the long run to eliminate this construct from your updated release. There's a reason that functions&packages come with help pages. Much as I approve of back-compatibility, I don't think you're doing anyone a favor here. Further, it's not clear to me how or why you'd want a required argument to be passed via ... . And if it's not required, then you don't want to emulate missing in the first place.
Your users will very quickly :-) realize that they've got invalid argument names. Regardless of whether you provide this transitional set of warning messages, they'll either adapt, or emigrate from your code to other options.
My problem is as follows: I'm trying to write a function that sets a collection of attributes on an object in a given environment. I'm trying to mimic a metadata layer, like SAS does, so you can set various attributes on a variable, like label, decimal places, date format, and many others.
Example:
SetAttributes(object = "list$dataframe$column", label="A label", width=20, decDigits=2,
dateTimeFormat="....", env=environment())
But I have to set attributes on different levels of objects, say:
comment(list$dataframe$column) <- "comment on a column of a dataframe in a list"
comment(dataframe$column) <- "comment on a column of a dataframe"
comment(list) <- "comment on a list/dataframe/vector"
Alternatively it can be done like this:
comment("env[[list]][[dataframe]][[column]]) <- "text"
# (my function recognizes both formats, as a variable and as a string with chain of
# [[]] components).
So I have implemented it this way:
SetAttributes <- function(varDescription, label="", .........., env=.GlobalEnv) {
parts <- strsplit( varDescription, "$", fixed=TRUE)[[1]]
if(length(parts) == 3) {
lst <- parts[1]
df <- parts[2]
col <- parts[3]
if(!is.na(label)) comment(env[[lst]][[df]][[col]]) <- label
if(!is.na(textWidth)) attr(env[[lst]][[df]][[col]], "width") <- textWidth
....
} else if(length(parts) == 2) {
df <- varTxtComponents[1]
col <- varTxtComponents[2]
if(!is.na(label)) comment(env[[df]][[col]]) <- label
if(!is.na(textWidth)) attr(env[[df]][[col]], "width") <- textWidth
....
} else if(length(parts) == 1) {
....
You see the problem now: I have three blocks of similar code for length(parts) == 3, 2 and 1
When I tried to automatize it this way:
path <- c()
sapply(parts, FUN=function(comp){ path <<- paste0(path, "[[", comp, "]]") )}
comment(eval(parse(text=paste0(".GlobalEnv", path)))) <- "a comment"
I've got an error:
Error in comment(eval(parse(text = paste0(".GlobalEnv", path)))) <- "a comment" :
target of assignment expands to non-language object
Is there any way to get an object on any level and set attributes for it not having a lot of repeated code?
PS: yes, I heard thousand times that changing external variables from inside a function is an evil, so please don't mention it. I know what I want to achieve.
Just to make sure you hear it 1001 times, it's a very bad idea for a function to have side effects like this. This is a very un R-like way to program something like this. If you're going to write R code, it's better to do things the R way. This means returning modified objects that can optionally be reassigned. This would make life much easier.
Here's a simplified version which only focuses on the comment.
SetComment <- function(varDescription, label=NULL, env=.GlobalEnv) {
obj <- parse(text= varDescription)[[1]]
eval(substitute(comment(X)<-Y, list(X=obj, Y=label)), env)
}
a<-list(b=4)
comment(a$b)
# NULL
SetComment("a$b", "check")
comment(a$b)
# [1] "check"
Here, rather than parsing and splitting the string, we build an expression that we evaluate in the proper context. We use substitute() to pop in the values you want to the actual call.
R allows for assignment via <- and =.
Whereas there a subtle differences between both assignment operators, there seems to be a broad consensus that <- is the better choice than =, as = is also used as operator mapping values to arguments and thus its use may lead to ambiguous statements. The following exemplifies this:
> system.time(x <- rnorm(10))
user system elapsed
0 0 0
> system.time(x = rnorm(10))
Error in system.time(x = rnorm(10)) : unused argument(s) (x = rnorm(10))
In fact, the Google style code disallows using = for assignment (see comments to this answer for a converse view).
I also almost exclusively use <- as assignment operator. However, the almost in the previous sentence is the reason for this question. When = acts as assignment operator in my code it is always accidental and if it leads to problems these are usually hard to spot.
I would like to know if there is a way to turn off assignment via = and let R throw an error any time = is used for assignment.
Optimally this behavior would only occur for code in the Global Environment, as there may well be code in attached namespaces that uses = for assignment and should not break.
(This question was inspired by a discussion with Jonathan Nelson)
Here's a candidate:
`=` <- function(...) stop("Assignment by = disabled, use <- instead")
# seems to work
a = 1
Error in a = 1 : Assignment by = disabled, use <- instead
# appears not to break named arguments
sum(1:2,na.rm=TRUE)
[1] 3
I'm not sure, but maybe simply overwriting the assignment of = is enough for you. After all, `=` is a name like any other—almost.
> `=` <- function() { }
> a = 3
Error in a = 3 : unused argument(s) (a, 3)
> a <- 3
> data.frame(a = 3)
a
1 3
So any use of = for assignment will result in an error, whereas using it to name arguments remains valid. Its use in functions might go unnoticed unless the line in question actually gets executed.
The lint package (CRAN) has a style check for that, so assuming you have your code in a file, you can run lint against it and it will warn you about those line numbers with = assignments.
Here is a basic example:
temp <- tempfile()
write("foo = function(...) {
good <- 0
bad = 1
sum(..., na.rm = TRUE)
}", file = temp)
library(lint)
lint(file = temp, style = list(styles.assignment.noeq))
# Lint checking: C:\Users\flodel\AppData\Local\Temp\RtmpwF3pZ6\file19ac3b66b81
# Lint: Equal sign assignemnts: found on lines 1, 3
The lint package comes with a few more tests you may find interesting, including:
warns against right assignments
recommends spaces around =
recommends spaces after commas
recommends spaces between infixes (a.k.a. binary operators)
warns against tabs
possibility to warn against a max line width
warns against assignments inside function calls
You can turn on or off any of the pre-defined style checks and you can write your own. However the package is still in its infancy: it comes with a few bugs (https://github.com/halpo/lint) and the documentation is a bit hard to digest. The author is responsive though and slowly making improvements.
If you don't want to break existing code, something like this (printing a warning not an error) might work - you give the warning then assign to the parent.frame using <- (to avoid any recursion)
`=` <- function(...){
.what <- as.list(match.call())
.call <- sprintf('%s <- %s', deparse(.what[[2]]), deparse(.what[[3]]))
mess <- 'Use <- instead of = for assigment '
if(getOption('warn_assign', default = T)) {
stop (mess) } else {
warning(mess)
eval(parse(text =.call), envir = parent.frame())
}
}
If you set options(warn_assign = F), then = will warn and assign. Anything else will throw an error and not assign.
examples in use
# with no option set
z = 1
## Error in z = 1 : Use <- instead of = for assigment
options(warn_assign = T)
z = 1
## Error in z = 1 : Use <- instead of = for assigment
options(warn_assign = F)
z = 1
## Warning message:
## In z = 1 : Use <- instead of = for assigment
Better options
I think formatR or lint and code formatting are better approaches.