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
Related
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"
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.
I have been trying to make a pipeable assign() function for use in loops in conjunction with paste0().
However I cannot get it to actually assign anything, e.g.
assignp <- function(value, x) {
assign(x, value)
}
assignp(13, "thirteen")
print(thirteen)
returns:
Error in print(thirteen) : object 'thirteen' not found
There are no error messages, it just doesn't assign the value to the variable name specified.
Can anyone tell me what I'm doing wrong?
The code in the question does assign it but the assignment is to the environment (sometimes referred to as a frame) that exists within the running function so when that function exits it is lost. Try this definition instead. Note that it is important that envir be an argument to address the general situation.
assignp <- function(value, x, envir = parent.frame()) {
assign(x, value, envir)
}
Below we discuss using it from the global environment with %>%, within a function using %>% and also in both those cases using |> . Also magrittr defines a sequential pipe but not an operator for it and we show how using that can further simplify this. We also show that assignp is not really needed in the first place and we can just use assign.
Using %>%
Note that if we left out .GlobalEnv then thirteen would get injected into a temporary environment created by the pipe so it would not be accessible in the next leg of the pipe and the following would give an error.
library(magrittr)
if (exists("thirteen")) rm(thirteen)
13 %>% assignp("thirteen", .GlobalEnv) %>% { . + thirteen }
## [1] 26
thirteen
## 13
Calling from function using %>%
By passing the current environment thirteen gets defined in it rather than in any temporary environment created by the pipe. We could alternately use e <- .GlobalEnv if we wanted thirteen to be injected into the global environment.
f <- function(x) {
e <- environment()
x %>%
assignp("thirteen", e) %>%
{ . + thirteen }
}
if (exists("thirteen")) rm(thirteen)
f(13)
## [1] 26
exists("thirteen")
## [1] FALSE
Using |>
|> does not create environments so this works.
if (exists("thirteen")) rm(thirteen)
13 |> assignp("thirteen") |> (\(x) x + thirteen)()
## [1] 26
thirteen
## 13
g <- function(x) x |> assignp("thirteen") |> (\(x) x + thirteen)()
if (exists("thirteen")) rm(thirteen)
g(13)
## [1] 26
exists("thirteen")
## [1] FALSE
Using only assign
Actually we don't really need assignp at all. These all work:
if (exists("thirteen")) rm(thirteen)
13 %>% assign("thirteen", ., .GlobalEnv) %>% { . + thirteen }
f2 <- function(x) {
e <- environment()
x %>%
assign("thirteen", ., e) %>%
{ . + thirteen }
}
if (exists("thirteen")) rm(thirteen)
f2(13)
g2 <- function(x) x |> assign(x = "thirteen") |> (\(x) x + thirteen)()
if (exists("thirteen")) rm(thirteen)
g2(13)
magrittr sequential pipe
magrittr defines a sequential pipe but currently there is no operator for it; however, we can readily define one.
`%s>%` <- pipe_eager_lexical
f3 <- function(x) x %s>% assign("thirteen", .) %>% { . + thirteen }
if (exists("thirteen")) rm(thirteen)
f3(13)
## [1] 26
Update
Expanded and fixed errors.
By default assign assigns value in it's current scope i.e within the function in this case. Specify envir = parent.frame() in assign.
assignp <- function(value, x) {
assign(x, value, envir = parent.frame())
#You can also use .GlobalEnv to assign to global environment directly.
#assign(x, value, envir = .GlobalEnv)
}
assignp(13, "thirteen")
thirteen
#[1] 13
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.
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.