Get name of variable passed as function parameter - r

I am trying to catch the name of a variable passed to a function, the right way. The name of interest noi is a data frame column or a vector. Below is my minimum working example. Ideally, I would like to receive a character vector which contains only "noi"
library(dplyr)
df <- data.frame(noi = seq(1:3))
example_fun <- function( x ){
deparse(substitute(x))
}
The result depends on the way I structure my input. Now I have an idea why this happens, but how would I do it correctly to have the desired result, regardless of how I call the function.
# Base
example_fun(df$noi)
[1] "df$noi"
# Pipe
df$noi %>% example_fun()
[1] "."
# Mutate
df %>% mutate(example_fun(noi))
noi example_fun(noi)
1 1 noi
2 2 noi
3 3 noi
Thanks in advance!

Perhaps decorate that variable with a "comment" attribute in another function? Note that the variable you want to decorate has to be wrapped directly in the decoration function z; otherwise, an error is raised (by design and for robustness).
example_fun <- function(x){
attr(x, "comment")
}
z <- function(x) {
nm <- substitute(x)
nm <- as.character(
if (is.symbol(nm) && !identical(nm, quote(.))) {
nm
} else if (length(nm) > 1L && (identical(nm[[1L]], quote(`[[`)) || identical(nm[[1L]], quote(`$`)))) {
tail(nm, 1L)
} else {
stop("not a valid symbol or extract operator.", call. = match.call())
}
)
`comment<-`(x, nm)
}
Output
> example_fun(z(df$noi))
[1] "noi"
> z(df$noi) %>% (function(x) x + 1) %>% example_fun()
[1] "noi"
> df %>% mutate(example_fun(z(noi)))
noi example_fun(z(noi))
1 1 noi
2 2 noi
3 3 noi
> z(df[["noi"]]) %>% example_fun()
[1] "noi"
> with(df, z(noi)) %>% example_fun()
[1] "noi"
> z(with(df, noi)) %>% example_fun()
Error in z(with(df, noi)) : not a valid symbol or extract operator.
> df$noi %>% z()
Error in z(.) : not a valid symbol or extract operator.
... but this may not be a robust method. It is extremely difficult to achieve what you want in a robust way, especially when a pipeline is involved. I think you should read Hadley's Advanced R and learn more about how bindings and environments work.

Related

R: Using output from one function to set all attributes of another function

I want the output of one function to be able to set all, or possibly only the needed/given, attributes of another. I want to use the output of myFunction1() on its own, which does some calculations and based on that produces multiple needed values, or in combination with myFunction2(), which is supposed to use those values in a plot or similar. The code would look something like this:
myFunction1() >%> myFunction2()
I'm aware that I can possibly put the function that needs the output inside the first function, like:
myFunction1=function(x, logical){
x=x^2
y=""
if(x>100){
y="hello"
}else{
y="goodbye"
}
if(logical){
return(list(x=x,y=y,logical=logical))
}else{
return(myFunction2(x,y,logical))
}
} ##end myFunction1()
myFunction2=function(x, y, z){
a=paste0(x, y, z)
return(a)
}
or use the output with the $-operator
myOutput = myFunction(1, TRUE)
myOutput2 = myFunction2(myOutput$x, myOutput$y, myOutput$logical)
But is there a way to have a list output (or anything that can contain different data types) be able to set all attributes without the need of addressing the output via $ or index?
(First post so feedback regarding the wrongs would be appreciated aswell)
If the question is asking how to create a pipeline from myFunction1 and myFunction2 assuming we can modify myFunction1 but not myFunction2 then remove the test from myFunction1 and put it into the pipeline as shown.
myFunction1 <- function(x, logical) {
y <- if (x^2 > 100) "hello" else "goodbye"
list(x = x, y = y, logical = logical)
}
myFunction2 <- function(x, y, z) {
paste0(x, y, z)
}
# tests - 3 alternatives
library(magrittr)
# 1 - with
myFunction1(1, TRUE) %>%
with(if (logical) myFunction2(x, y, logical) else .)
## [1] "1goodbyeTRUE"
# 2 - magrittr %$%
myFunction1(1, TRUE) %$%
if (logical) myFunction2(x, y, logical) else .
## [1] "1goodbyeTRUE"
# 3 - do.call
myFunction1(1, TRUE) %>%
{ if (.$logical) do.call("myFunction2", unname(.)) else . }
## [1] "1goodbyeTRUE"
If we can modify both we could have myFunction2 accept a list.
myFunction2 <- function(List) {
if (List$logical) do.call("paste0", List) else List
}
myFunction1(1, TRUE) %>% myFunction2
## [1] "1goodbyeTRUE"

Anonymous Recursive Pipes in R

I'm trying to do anonymous recursion in R and also playing with pipes to learn. The code below works well
sorttt <- function(list){
if (length(list) == 0) c() else c(max(list), Recall(list[list < max(list)]))
}
example %>% sorttt
But this code errors out with the error: Error in example %>% function(list) { : invalid formal argument list for "function"
example %>% function(list){if (length(list) == 0) c() else c(max(list), Recall(list[list < max(list)]))}
Does anyone know why these two might act differently? These seem to be logically the same thing.
You need to wrap anonymous functions in parentheses for them to work with pipes.
## doesn't work
1:10 %>% function(x) {mean(x)}
# Error in 1:10 %>% function(x) { :
# invalid formal argument list for "function"
## works with parens
1:10 %>% (function(x) {mean(x)})
# [1] 5.5
Same thing for your function:
1:3 %>%
(function(list){if (length(list) == 0) c() else c(max(list), Recall(list[list < max(list)]))})
# [1] 3 2 1
This is because function is itself a function. A %>% function(x){...} is interpreted as function(A, x){...}. The parentheses make sure the whole function definition is run before the pipe inserts an argument.

Learning how to deal with ... in functions in R

This is my function. Basically I want to include a if else statement inside it but controlling by the length of the arguments that I use in ...:
This is what Ive tried so far, and it is wrong:
soma_mtcars<-function(data,...){
if(length(...) < 2){
sum_df<- data %>% group_by() %>% summarise(total = sum(disp))
}
else(
sum_df<- data %>% group_by() %>% summarise(total = sum(disp))
)
}
Of course the problem is in length(...) < 2. How can I deal with it?
And I would like to have, for example, outputs for: soma_mtcars(mtcars,cyl) and soma_mtcars(mtcars, cyl, disp)
You can use nargs(), which gives you the total number of arguments (i.e. including your data argument):
soma_mtcars <- function (data, ...) {
if (nargs() < 3L) { …
}
… or you can pass ... list, and get the length of its result:
soma_mtcars <- function (data, ...) {
if (length(list(...)) < 2L) { …
}
Either of these will return the length of dot dot dot. The first one does it without evaluating dot dot dot.
len_noeval <- function(...) ...length()
len_eval <- function(...) length(list(...))
# test
len_noeval(11, print(12), 13)
## [1] 3
len_eval(11, print(12), 13)
## [1] 12
## [1] 3

as.character removes backticks from parsed R script

I'm searching R scripts and not sure why as.character() drops the `[`. Is there some way to get the code back correctly as a vector of strings?
Notice the `[`(. < 5) turns into (. < 5)[]
Note: I'm not looking for better ways to make this call as this isn't my code.
code <-
"1:10 %>% `[`(. < 5) %>% mean()
a <- 1:3"
# fine
parse(text = code)
#> expression(1:10 %>% `[`(. < 5) %>% mean(), a <- 1:3)
# not fine
as.character(parse(text = code))
#> [1] "1:10 %>% (. < 5)[] %>% mean()"
#> [2] "a <- 1:3"
Created on 2020-07-01 by the reprex package (v0.3.0)
The issue is that I need to substitute out parts of the code so that my function works. The function finds reactive commands and changes them to functions for the user to access in their environment. It's part of my shinyobjects package (shameless plug).
a <- reactive({
input$n * 100
})
and converts it to
a <- function() {
input$n *100
}
The methods I have been using have been fine until this edge case with the `[`.
The solution should be able to return each expression as something I can manipulate. This is a more complex example and should return a string vector of length 5. I'm also happy to take this discussion offline as I'm open to a better method overall for this functionality. You can find my contact here
code <-
'library(tidyverse)
library(shiny)
1:10 %>% `[`(. < 5) %>% mean()
df <- reactive({
mpg %>%
filter(cty > input$cty)
})
renderPlot(
ggplot(df(), aes(class)) +
geom_bar()
)'
(I've edited this a bit to explain the behaviour some more):
The problem is that magrittr's pipe operator uses non-standard evaluation inconsistently.
The expression
`[`(. < 5)
is legal R code that is equivalent to what was deparsed:
(. < 5)[]
However, it's a weird enough expression that magrittr gets confused by it, and doesn't transform
1:10 %>% (. < 5)[]
the same way it would transform
1:10 %>% `[`(. < 5)
I wouldn't call this a bug in magrittr (it's documented behaviour, if you look closely enough), but it's certainly an inconvenience caused by the inconsistent handling of dots. Normally if you put a dot in a term in a magrittr chain, that's the only place that the previous result is put in. For example, this doesn't print "foobar" twice:
"foobar" %>% cat("arg1", ., "arg3")
However, if the dot is in a function call in the chain, it is also inserted at the start:
"foobar" %>% cat("arg1", identity(.), "arg3")
does print it twice.
magrittr is evaluating 1:10 %>% [(. < 5) as
`[`(1:10, 1:10 < 5)
i.e.
(1:10)[1:10 < 5]
Really for consistency it would require you to type
1:10 %>% `[`(., . < 5)
but it is trying to be helpful, which is what is so unhelpful for what you want to do.
I suppose you could write a function to detect these cases yourself, and insert the extra dot explicitly.
Edited to add: Here's such a function:
explicitDots <- function(expr) {
nestedDot <- function(lang) {
if (is.call(lang)) {
for (i in seq_along(lang)) {
if (nestedDot(lang[[i]]))
return(TRUE)
}
return(FALSE)
} else
identical(lang, quote(.))
}
fixLang <- function(lang) {
if (is.call(lang)) {
fn <- lang[[1]]
if (as.character(fn) == "%>%") {
lang[[2]] <- fixLang(lang[[2]])
lang[[3]] <- fixLang(lang[[3]])
} else {
hasTopLevelDot <- FALSE
hasNestedDot <- FALSE
for (i in seq_along(lang)[-1]) {
if (identical(lang[[i]], quote(.))) {
hasTopLevelDot <- TRUE
break
}
hasNestedDot <- hasNestedDot || nestedDot(lang[[i]])
}
if (hasNestedDot && !hasTopLevelDot) {
# Insert a dot in position 2
lang <- lang[c(1,seq_along(lang))]
lang[[2]] <- quote(.)
}
}
}
lang
}
expr <- removeSource(expr)
for (i in seq_along(expr)) {
expr[[i]] <- fixLang(expr[[i]])
}
expr
}
And here's an example using it:
code <-
"1:10 %>% `[`(. < 5) %>% mean()
a <- 1:3"
p <- parse(text = code)
explicitDots(p)
which produced this output:
expression(1:10 %>% .[. < 5] %>% mean(), a <- 1:3)
If we need to get a vector of strings, one option is strsplit on the nextline character followed by zero or more spaces
out <- strsplit(code, "\n\\s*")[[1]]
out
#[1] "1:10 %>% `[`(. < 5) %>% mean()"
#[2] "a <- 1:3"
sapply(out, function(x) eval(parse(text = x)))
#$`1:10 %>% `[`(. < 5) %>% mean()`
#[1] 2.5
#$`a <- 1:3`
#[1] 1 2 3
First of all, you should be aware of the "never use parse " rule -- there are always better ways.
Next, what you get back is an expression , not an object which tells you about an expression.
Similarly, you're explicitly barred from trying to pull this trick with a closure:
bar <- as.character(function(x) x+3)
Error in as.character(function(x) x + 3) :
cannot coerce type 'closure' to vector of type 'character'
Now,
foo <- parse(text = code)
as.character(deparse(foo))
[1] "structure(expression(1:10 %>% (. < 5)[] %>% mean(), a <- 1:3), srcfile = <environment>, wholeSrcref = structure(c(1L, "
[2] "0L, 3L, 0L, 0L, 0L, 1L, 3L), srcfile = <environment>, class = \"srcref\"))"
Should give you a feel for what you're dealing with.
But it's not clear why you want/need to take a string, parse it, and then try to get it back again. Either follow akrun's approach or take another route to turn poorly structured text into executable commands.

Pass subset argument through a function to subset

I would like to have a function which calls subset, and passes on a subset argument:
df <- data.frame(abc=c("A","A","B","B"),value=1:4)
subset(df,abc=="A")
## works of course:
# abc value
#1 A 1
#2 A 2
mysubset <- function(df,ssubset)
subset(df,ssubset)
mysubset(df,abc=="A")
## Throws an error
# Error in eval(expr, envir, enclos) : object 'abc' not found
mysubset2 <- function(df,ssubset)
subset(df,eval(ssubset))
mysubset2(df,expression(abc=="A"))
## Works, but needs expression
I tried with substitute, but was not able to find the right combination. How can I get this working?
You need eval() and parse() in there too:
mysubset <- function(df, ssubset) {
subset(df, eval(parse(text=ssubset)))
}
mysubset(df, "abc=='A'")
# abc value
# 1 A 1
# 2 A 2
Note that you need to nest quotes, so switch back and forth between " and ' as necessary.
Based on your comment, perhaps something like this is also of interest:
mysubset <- function(df, ...) {
ssubset <- deparse(substitute(...))
subset(df, eval(parse(text = ssubset)))
}
USAGE: mysubset(df, abc=='A')
The A5C1D2H2I1M1N2O1R2T1 answer works, but you can skip the whole deparse/parse cycle by simply using:
mysubset <- function(df, p) {
ps <- substitute(p)
subset(df, eval(ps))
}

Resources