How can I list all symbols used in a call? - r

I would like to list all symbols or names used in a call.
I found the following way but surely there is a more idiomatic or efficient approach ?
expr <- quote(a + b * (a / b))
expr <- as.list(expr)
while(!identical(expr, (expr <- unlist(lapply(expr,as.list))))){}
unique(expr)
#> [[1]]
#> `+`
#>
#> [[2]]
#> a
#>
#> [[3]]
#> `*`
#>
#> [[4]]
#> b
#>
#> [[5]]
#> `(`
#>
#> [[6]]
#> `/`
Created on 2019-08-27 by the reprex package (v0.3.0)

You can use all.names to get all symbols used in a call:
expr <- quote(a + b * (a / b))
unique(all.names(expr))
#[1] "+" "a" "*" "b" "(" "/"

Related

append a globally defined list from inside of a function in R

I am using the walk function to iterate over my list of lists and append a list element to every sub-list.
.insideFunction <- function(sublistName, arg2){
newListElement <- "Hello"
newListElement <- as.list(newListElement)
names(newListElement) <- "newListElement"
myList[[sublistName]] <- append(myList[[sublistName]], newListElement)
}
walk(names(myList), .insideFunction, someTable)
The problem is that the list myList, which is defined globally doesn't change.
I am currently using the global assignment operator inside of the .insideFunction to force R to overwrite the sublist.
myList[[sublistName]] <<- append(myList[[sublistName]], newListElement)
How can I avoid using the global assignment operator, but still append the globally defined list from inside a function?
Use map instead of walk to create a modified version of a list by applying a function to every element e.g. add 2 to each sub list:
library(purrr)
data <- list(
list("foo", 1),
list("bar", 1)
)
data
#> [[1]]
#> [[1]][[1]]
#> [1] "foo"
#>
#> [[1]][[2]]
#> [1] 1
#>
#>
#> [[2]]
#> [[2]][[1]]
#> [1] "bar"
#>
#> [[2]][[2]]
#> [1] 1
newListElement <- "Hello"
newListElement <- as.list(newListElement)
names(newListElement) <- "newListElement"
data %>% map(~ .x %>% c(newListElement))
#> [[1]]
#> [[1]][[1]]
#> [1] "foo"
#>
#> [[1]][[2]]
#> [1] 1
#>
#> [[1]]$newListElement
#> [1] "Hello"
#>
#>
#> [[2]]
#> [[2]][[1]]
#> [1] "bar"
#>
#> [[2]][[2]]
#> [1] 1
#>
#> [[2]]$newListElement
#> [1] "Hello"
Created on 2022-04-22 by the reprex package (v2.0.0)

Coerce arguments to simplest type

When dealing with user input using packages shiny or plumber one often needs to convert character arguments to numeric or logical.
I would like to do it automatically, what's an efficient way to do it ?
expected (this or similar) :
convert_args <- ...
fun <- function(a, b, c, d){
convert_args()
dplyr::lst(a, b, c , d)
}
fun("na","true","1","foo")
#> $a
#> [1] NA
#>
#> $b
#> [1] TRUE
#>
#> $c
#> [1] 1
#>
#> $d
#> [1] "foo"
One option is to use readr::parse_guess which as the name suggests tries to guess the type of the character vector.
convert_args <- function(x) {
lapply(x, readr::parse_guess)
}
convert_args(c("NA","true","1","foo"))
#[[1]]
#[1] NA
#[[2]]
#[1] TRUE
#[[3]]
#[1] 1
#[[4]]
#[1] "foo"
This doesn't directly work when we have "na"
readr::parse_guess("na")
#[1] "na"
but as #Moody_Mudskipper mentions it can be resolved specifying na argument in parse_guess
readr::parse_guess("na", c("na", "NA"))
#[1] NA
I built a wrapper around readr::parse_guess thanks to #Ronak's solution to get exactly the expected output.
I also added an option to evaluate the unconverted character input as it's a common task as well.
convert_args <- function(na = c("", "NA"), locale = readr::default_locale(),
trim_ws = TRUE, guess_integer = FALSE, eval = FALSE){
if(!requireNamespace("readr"))
stop("convert_args() requires package readr to be installed")
args <- as.list(eval.parent(quote(match.call())))[-1]
args <- lapply(args, readr::parse_guess, na, locale, trim_ws, guess_integer)
if (eval){
args <- lapply(args, function(arg) {
if(is.character(arg))
eval(parse(text = arg, parent.frame(2)))
else
arg
})
}
list2env(args, envir = parent.frame())
invisible(NULL)
}
fun <- function(a, b, c, d){
convert_args()
dplyr::lst(a, b, c , d)
}
fun("NA","true","1","head(cars,2)")
#> Loading required namespace: readr
#> $a
#> [1] NA
#>
#> $b
#> [1] TRUE
#>
#> $c
#> [1] 1
#>
#> $d
#> [1] "head(cars,2)"
fun2 <- function(a, b, c, d){
convert_args(eval = TRUE, na = c("na","NA"))
dplyr::lst(a, b, c , d)
}
fun2("na","true","1","head(cars,2)")
#> $a
#> [1] NA
#>
#> $b
#> [1] TRUE
#>
#> $c
#> [1] 1
#>
#> $d
#> speed dist
#> 1 4 2
#> 2 4 10
Created on 2019-06-21 by the reprex package (v0.3.0)

Combine vector and single row of data frame into a list

I am trying to assemble a list out of a vector and a row of a data
frame. The list will be passed to do.call() as the arguments to a
function. If the vector is length 1, no problem.
tbl <- tibble::tibble(a = 1:4,
b = letters[1:4])
vec <- 1
works <- c(avec = vec, as.list(tbl[1,]))
testit <- function(avec, a, b){
length(avec) + length(a) + length(b)
}
do.call(testit, works)
#> [1] 3
But it also needs to work with longer vectors
vec <- 1:2
broken <- c(avec = vec, as.list(tbl[2,]))# breaks apart avec
do.call(testit, broken)
#> Error in (function (avec, a, b) : unused arguments (avec1 = 1, avec2 = 2)
toomany <- list(avec = vec, as.list(tbl[2,]))#too many layers
do.call(testit, toomany)
#> Error in (function (avec, a, b) : argument "b" is missing, with no default
#what I want:
whatIwant <- list(avec = 1:2, a = 2, b = "b")
do.call(testit, whatIwant)
#> [1] 4
It doesn’t matter if a data frame, and I want solution to work with both
tibbles and dataframes anyhow.
adf <- data.frame(a = 1:4,
b = letters[1:4], stringsAsFactors = FALSE)
list(avec = vec, as.list(adf[1,]))
#> $avec
#> [1] 1 2
#>
#> [[2]]
#> [[2]]$a
#> [1] 1
#>
#> [[2]]$b
#> [1] "a"
Other things I’ve tried.
purrr::flatten(toomany) # breaks up avec again
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
#>
#> $a
#> [1] 2
#>
#> $b
#> [1] "b"
c(avec = vec, as.list(adf[1,]), recursive = TRUE)
#> avec1 avec2 a b
#> "1" "2" "1" "a"
list(avec = vec, as.vector(adf[1,]))
#> $avec
#> [1] 1 2
#>
#> [[2]]
#> a b
#> 1 1 a
list(vec, unlist(adf[1,]))
#> [[1]]
#> [1] 1 2
#>
#> [[2]]
#> a b
#> "1" "a"
I didn’t think this would be so hard! Do I have to assemble the list in
text and parse it? I’m missing something. Created on 2019-03-01 by the
reprex package (v0.2.0).

Tracing functions in R

I want to trace a function so that it prints all of its arguments at the call
and it prints the return value together with the arguments when it returns the result.
The function trace allows to define action to be performed on entering and on exiting a function call.
Is there a function returning the list of arguments within the function, and is there a way of getting the result value without doing each one of multiple branches
where each branch exits the function?
in the following example, tracing should print a list of both input parameters
(or the function call as text itself) at the call and the return value when the function exits in any one of the branches.
myfun <- function(a,b){
if (a==1) return(b+1)
if (a==2) return(b*10)
return(b)
}
You're looking for the functions match.call() and returnValue():
myfun <- function(a,b){
if (a==1) return(b+1)
if (a==2) return(b*10)
return(b)
}
trace("myfun", tracer = substitute(print(as.list(match.call()))),
exit = substitute(print(returnValue())))
#> [1] "myfun"
myfun(1, 2)
#> Tracing myfun(1, 2) on entry
#> [[1]]
#> myfun
#>
#> $a
#> [1] 1
#>
#> $b
#> [1] 2
#>
#> Tracing myfun(1, 2) on exit
#> [1] 3
#> [1] 3
myfun(2, 2)
#> Tracing myfun(2, 2) on entry
#> [[1]]
#> myfun
#>
#> $a
#> [1] 2
#>
#> $b
#> [1] 2
#>
#> Tracing myfun(2, 2) on exit
#> [1] 20
#> [1] 20
myfun(3, 2)
#> Tracing myfun(3, 2) on entry
#> [[1]]
#> myfun
#>
#> $a
#> [1] 3
#>
#> $b
#> [1] 2
#>
#> Tracing myfun(3, 2) on exit
#> [1] 2
#> [1] 2
Created on 2018-10-07 by the reprex package (v0.2.1)
As Moody_Mudskipper mentions, in the comments, you can also use quote() rather than substitute():
myfun <- function(a,b){
if (a==1) return(b+1)
if (a==2) return(b*10)
return(b)
}
trace("myfun", tracer = quote(print(as.list(match.call()))),
exit = quote(print(returnValue())))
#> [1] "myfun"
myfun(1, 2)
#> Tracing myfun(1, 2) on entry
#> [[1]]
#> myfun
#>
#> $a
#> [1] 1
#>
#> $b
#> [1] 2
#>
#> Tracing myfun(1, 2) on exit
#> [1] 3
#> [1] 3
myfun(2, 2)
#> Tracing myfun(2, 2) on entry
#> [[1]]
#> myfun
#>
#> $a
#> [1] 2
#>
#> $b
#> [1] 2
#>
#> Tracing myfun(2, 2) on exit
#> [1] 20
#> [1] 20
myfun(3, 2)
#> Tracing myfun(3, 2) on entry
#> [[1]]
#> myfun
#>
#> $a
#> [1] 3
#>
#> $b
#> [1] 2
#>
#> Tracing myfun(3, 2) on exit
#> [1] 2
#> [1] 2
Created on 2018-10-07 by the reprex package (v0.2.1)
For an illustration of the difference between the two, see this Stack Overflow question.
Just overlap it with .trace in name?
myfun.trace <- function(a,b){
if (a==1) return({{"a","b"},{a,b}},{b+1})
if (a==2) return({{"a","b"},{a,b}},{b*10})
return({{"a","b"},{a,b}},{b}) }

R grep(): How to search for letter "l"?

I have a problem with R's grep() function apparently finding an "l" everywhere:
> l <- list(list(), list("a"), list("a","l"))
> grep("a",l)
[1] 2 3
> grep("l",l)
[1] 1 2 3
> grep("l",l,fixed=TRUE)
[1] 1 2 3
This problem seems to occur only with the letter "l". Does anyone have a hint on that?
Many thanks,
Cord
If you look at the documentation for the argument x in grep you'll see that it should be
a character vector where matches are sought, or an object which can be coerced by as.character to a character vector.
If you try that operation you'll see what goes wrong:
> as.character(l)
[1] "list()" "list(\"a\")" "list(\"a\", \"l\")"
so the same "problem" happens if you grep for i, s etc.
You could try the following instead
sapply(l, function(i) grep("l", i))
which produces
[[1]]
integer(0)
[[2]]
integer(0)
[[3]]
[1] 2
Interesting post, I never knew grep convert the x vector like this:
l <- list(list(), list("a"), list("a","l"))
l
#> [[1]]
#> list()
#>
#> [[2]]
#> [[2]][[1]]
#> [1] "a"
#>
#>
#> [[3]]
#> [[3]][[1]]
#> [1] "a"
#>
#> [[3]][[2]]
#> [1] "l"
Internally grep is converting l to a character vector
grep
#> function (pattern, x, ignore.case = FALSE, perl = FALSE, value = FALSE,
#> fixed = FALSE, useBytes = FALSE, invert = FALSE)
#> {
#> if (!is.character(x))
#> x <- structure(as.character(x), names = names(x))
#> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
#> .Internal(grep(as.character(pattern), x, ignore.case, value,
#> perl, fixed, useBytes, invert))
#> }
#> <bytecode: 0x0000000012e18610>
#> <environment: namespace:base>
So now l is actually:
structure(as.character(l), names = names(l))
#> [1] "list()" "list(\"a\")" "list(\"a\", \"l\")"
Which has "l" in each.
You could unlist l first to get expected results:
ul <- unlist(l)
ul
#> [1] "a" "a" "l"
grep("a",l)
#> [1] 2 3
grep("a",ul)
#> [1] 1 2
grep("l",l)
#> [1] 1 2 3
grep("l",ul)
#> [1] 3
grep("l",l,fixed=TRUE)
#> [1] 1 2 3
grep("l",ul,fixed=TRUE)
#> [1] 3

Resources