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}) }
Related
gregexpr returns a list containing a vector with some additional data:
[[1]]
[1] 21 136 409 512 587 693
attr(,"match.length")
[1] 3 4 5 5 4 9
How do I extract just one element with a corresponding attribute at once?
[[1]]
[1] 409
attr(,"match.length")
[1] 5
UPD: The final object must be compatible with regmatches function.
In general, there's no way for R to know that elements of the vector correspond 1-1 with elements of one of its attributes.
If you know this is true (as it is with gregexpr results), then the way to tell R about it is to set a class on the object, and write your own subsetting code. For example,
`[.gregexpr_result` <- function(x, i) {
attrs <- lapply(x, function(element) {
allattrs <- attributes(element)
allattrs[["match.length"]] <- allattrs[["match.length"]][i]
allattrs
})
x <- lapply(x, `[`, i)
for (j in seq_along(x))
attributes(x[[j]]) <- attrs[[j]]
x
}
x <- paste(letters[1:2], letters[1:2])
result <- gregexpr("b", x)
class(result) <- "gregexpr_result"
result
#> [[1]]
#> [1] -1
#> attr(,"match.length")
#> [1] -1
#> attr(,"index.type")
#> [1] "chars"
#> attr(,"useBytes")
#> [1] TRUE
#>
#> [[2]]
#> [1] 1 3
#> attr(,"match.length")
#> [1] 1 1
#> attr(,"index.type")
#> [1] "chars"
#> attr(,"useBytes")
#> [1] TRUE
#>
#> attr(,"class")
#> [1] "gregexpr_result"
result[2]
#> [[1]]
#> [1] NA
#> attr(,"match.length")
#> [1] NA
#> attr(,"index.type")
#> [1] "chars"
#> attr(,"useBytes")
#> [1] TRUE
#>
#> [[2]]
#> [1] 3
#> attr(,"match.length")
#> [1] 1
#> attr(,"index.type")
#> [1] "chars"
#> attr(,"useBytes")
#> [1] TRUE
Created on 2022-11-20 with reprex v2.0.2
We may do
out <- lapply(lst1, `[`, 3)
attr(out, "match.length") <- attr(lst1, "match.length")[3]
-output
> out
[[1]]
[1] 409
attr(,"match.length")
[1] 5
data
lst1 <- structure(list(c(21, 136, 409, 512, 587, 693)),
match.length = c(3,
4, 5, 5, 4, 9))
I want to generate all subset of {1,2,3,4} with only consecutive numbers. (For example I want subset {1}, {1,2} or {2,3,4} but not {2,4}. )
This is what I have been trying:
library(ggm)
p2<-powerset(1:4, sort = TRUE, nonempty = TRUE)
m2<-p2
for (i in 1:length(p2)){
ifelse(length(p2[[i]]) <2, m2<-m2, ifelse(max(diff(as.numeric(p2[[i]])))>1, m2<-m2[-
c(i)],m2<-m2))
}
I want to first generate power set of {1,2,3,4} and exclude subsets with inconsecutive numbers. But when I am doing the
m2<-m2[- c(i)]
command in the 2nd ifelse to exclude subsets with inconsecutive numbers, I believe I change the index of power set so I keep getting the wrong subsets as I desired.
Any suggestions on how to do it correctly?
Thanks!
You can get all unique ascending sequences between 1 and 4 in base R with the following one-liner:
apply(which(upper.tri(diag(4), TRUE), TRUE), 1, function(x) x[1]:x[2])
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 1 2
#>
#> [[3]]
#> [1] 2
#>
#> [[4]]
#> [1] 1 2 3
#>
#> [[5]]
#> [1] 2 3
#>
#> [[6]]
#> [1] 3
#>
#> [[7]]
#> [1] 1 2 3 4
#>
#> [[8]]
#> [1] 2 3 4
#>
#> [[9]]
#> [1] 3 4
#>
#> [[10]]
#> [1] 4
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)
I am new to R. I am attempting to create a vector containing the cubic of integers from 1:10000. When I try using the cube function that I made with the sapply function. It works fine with smaller numbers, but I cannot figure out how to make it work with larger numbers.
Here is my code:
n <- 10000
cube <- function(x){
return(x*x*x)
}
vec <- c()
vec <- sapply(seq_len(n), cube)
print(vec)
I expected to get a vector containing, vec(1^3, 2^3, ..., 10000^3)
But instead I am getting an incredible number of this error:
Warning in x * x * x : NAs produced by integer overflow
Warning in x * x * x : NAs produced by integer overflow
Warning in x * x * x : NAs produced by integer overflow
Warning in x * x * x : NAs produced by integer overflow
There are many workarounds for this issue (>32-bit integers); here is a potential solution using the bit64 package
library(bit64)
#> Loading required package: bit
#>
#> Attaching package: 'bit'
#> The following object is masked from 'package:base':
#>
#> xor
#> Attaching package bit64
#> package:bit64 (c) 2011-2017 Jens Oehlschlaegel
#> creators: integer64 runif64 seq :
#> coercion: as.integer64 as.vector as.logical as.integer as.double as.character as.bitstring
#> logical operator: ! & | xor != == < <= >= >
#> arithmetic operator: + - * / %/% %% ^
#> math: sign abs sqrt log log2 log10
#> math: floor ceiling trunc round
#> querying: is.integer64 is.vector [is.atomic} [length] format print str
#> values: is.na is.nan is.finite is.infinite
#> aggregation: any all min max range sum prod
#> cumulation: diff cummin cummax cumsum cumprod
#> access: length<- [ [<- [[ [[<-
#> combine: c rep cbind rbind as.data.frame
#> WARNING don't use as subscripts
#> WARNING semantics differ from integer
#> for more help type ?bit64
#>
#> Attaching package: 'bit64'
#> The following objects are masked from 'package:base':
#>
#> :, %in%, is.double, match, order, rank
n <- 10000
cube <- function(x){
bigx <- as.integer64(x)
cubed <- bigx * bigx * bigx
return(cubed)
}
vec <- c()
vec <- lapply(1:n, cube)
head(vec)
#> [[1]]
#> integer64
#> [1] 1
#>
#> [[2]]
#> integer64
#> [1] 8
#>
#> [[3]]
#> integer64
#> [1] 27
#>
#> [[4]]
#> integer64
#> [1] 64
#>
#> [[5]]
#> integer64
#> [1] 125
#>
#> [[6]]
#> integer64
#> [1] 216
tail(vec)
#> [[1]]
#> integer64
#> [1] 998500749875
#>
#> [[2]]
#> integer64
#> [1] 998800479936
#>
#> [[3]]
#> integer64
#> [1] 999100269973
#>
#> [[4]]
#> integer64
#> [1] 999400119992
#>
#> [[5]]
#> integer64
#> [1] 999700029999
#>
#> [[6]]
#> integer64
#> [1] 1000000000000
Created on 2022-04-06 by the reprex package (v2.0.1)
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).