I'm working on a project, trying to convert an R function to CUDA C++, but I can't understand some R function call, I'm really new to R and I can't find what I'm really looking after. To be exactly, this is the main R function code:
for (i in 1:ncy) {
res <- apply(allsubset, 2, banddepthforonecurve, xdata=x, ydata=y[,i], tau=tau, use=use)
depth[i] <- sum(res[1,])
localdepth[i] <- sum(res[2,])
}
The part that I can't really understand is "banddepthforonecurve" function call, this is the "banddepthforonecurve" function code:
banddepthforonecurve <- function(x, xdata, ydata, tau, use) {
envsup <- apply(xdata[,x], 1, max)
envinf <- apply(xdata[,x], 1, min)
inenvsup <- ydata <= envsup
inenvinf <- ydata >= envinf
depth <- all(inenvsup) & all(inenvinf)
localdepth <- depth & use(envsup-envinf) <= tau
res <- c(depth,localdepth)
return(res)
}
When it is called in:
res <- apply(allsubset, 2, banddepthforonecurve, xdata=x, ydata=y[,i], tau=tau, use=use)
I don't really get what it set for the first parameter "x" of the "banddepthforonecurve", I supposed its like banddepthforonecurve(i, xdata=x, ydata=y[,i], tau = tau, use=use)
but if I try to run it separately on R studio to try to understand it better I get:
apply(xdata[, x], 1, max) : dim(X) must have a positive length
Why when I compile the whole R project there isn't this error? What it set for the "x" parameter when called in the "res <- apply(...)"? I hope I was clear, sorry for my bad english, Thank you in advance !
# This apply function
res = apply(X = input, MAR = 2, FUN = foo, ...)
# is essentially syntactical sugar for this:
res = list()
for(i in 1:ncol(X)) {
res[[i]] = foo(X[, i], ...)
}
# plus an attempt simplify `res` (e.g., to a matrix or vector)
So in your line:
apply(allsubset, 2, banddepthforonecurve, xdata=x, ydata=y[,i], tau=tau, use=use)
In a single iteration of your for loop, the first parameter of banddepthforonecurve (x) will be allubset[, 1], then allsubset[, 2], ..., allsubset[, ncol(allsubset)].
The xdata parameter is always x, the tau and use parameters are always tau and use, and the for loop iterates over the columns of y to use as the ydata argument. You can think of it as a nested loop, for each column of y, use it as ydata and (via apply) iterate over all columns of allsubset.
(If the MAR argument of apply was 1, then it would iterate over rows instead of columns.)
Related
Is it possible to get the information which arguments are expected by a function and then store it in a character vector?
I know args(foo) but it only prints this information and returns NULL.
Why do I need this?
I want to work with the three dot arguments (dot dot dot, ...) and pass it to different functions.
Let me explain...
The following simple case works.
data <- c(1:10)
cv <- function(x, ...) {
numerator <- mean(x, ...)
denominator <- sd(x, ...)
return(numerator / denominator)
}
cv(data, na.rm = TRUE)
However, in a slightly different case, R will not figure out automatically which aruments match which function.
data <- c(1:10)
roundCv <- function(x, ...) {
numerator <- mean(x, ...)
denominator <- sd(x, ...)
result <- round(numerator / denominator, ...)
return(result)
}
roundCv(data, na.rm = TRUE, digits = 2)
# Error in sd(x, ...) : unused argument (digits = 2)
If I want to separate those arguments, it gets a little hairy. The approach is not generic but has to be adapted to all functions involved.
data <- c(1:10)
roundCv2 <- function(x, ...) {
args <- list(...)
args1 <- args[ names(args) %in% "na.rm"] # For mean/sd
args2 <- args[!names(args) %in% "na.rm"] # For print
numerator <- do.call("mean", c(list(x = x), args1))
denominator <- do.call("sd", c(list(x = x), args1))
tmp <- numerator / denominator
do.call("round", c(list(x = tmp), args2))
}
roundCv2(data, na.rm = TRUE, digits = 2)
Is there a simple way to do this?!
If I would know the arguments each function expects, I could handle it generically. That's why I'm asking:
Is it possible to get the information which arguments are expected by a function and then store it in a character vector?
A shout-out to MrFlick for pointing to similar questions and giving the answer in the comments.
You can use formals() to get a list like object back, bit it won't work for primitive functions. Like names(formals(...))
More details can be found here: https://stackoverflow.com/a/4128401/1553796
I have created a function, say myfunc, which has 4 parameters, say para1, para2, para3 and para4. In my problem, para1 is a matrix, para2 is a real number, para3 is a vector, and para4 is a real number. The function returns a list. I have defined the function in the following manner :
myfunc <- function(para1, para2, para3 = NULL, para4 = 100){
Body ## Body of the function
return(list("A" = a, "B" = b, "C" = c)
}
Now, let lambda <- c(2,3,6,10). I am trying to write a code so that the function outputs the following :
myfunc(my_data, 2, my_vec, 100)
myfunc(my_data, 3, my_vec, 100)
myfunc(my_data, 6, my_vec, 100)
myfunc(my_data, 10, my_vec, 100)
This can be easily done by a for loop, but I was thinking if we can use apply or sapply or tapply function for this purpose. So, keeping the other parameters fixed, I want outputs of the same function with different values (viz. the values in lambda) of para2. Can this be done ?
I found a quite similar question here, and saw some answers. I followed those answers, but I'm getting an error. I wrote the following code :
myfunc <- function(para1, para2, para3 = NULL, para4 = 100) { Body }
para1 <- my_data
para3 <- my_vec
para4 <- 100
lambda <- c(2,3,6,10)
sapply(lambda, myfunc, para1=para1, para3, para4=para4)
Can I please get some assistance ? Thanks in advance.
We can use lapply to loop over the lambda
lapply(lambda, function(x) myfunc(my_data, x, my_vec, 100))
If we are not using lambda function
lapply(lamdba, myfunc, para1 = my_data, para3 = my_ec, para4 = 100)
I have coded following function:
one_way_anova <- function(m, n, sample_means, sample_vars) {
keskiarvo = 1/m*sum(sample_means)
otosv = (sum((sample_means-keskiarvo)^2))/(m-1)
TS = (n*otosv)/(sum(sample_vars)/m)
parvo = 1-pf(TS, m-1, m*(n-1))
return(parvo)
}
And using following data:
set.seed(1)
dat <- matrix(rnorm(300*20), nrow=300)
sample_means <- matrix(rowMeans(dat), nrow=100)
sample_vars <- matrix(apply(dat, 1, var), nrow=100)
m <- nrow(sample_means)
n <- ncol(sample_means)
Now I try to use apply -function to calculate "parvo" with my function one_way_anova for dataset sample_means by individual rows with three samples (matrix is 100x3).
apply(sample_means, 1, one_way_anova)
Which gives following error
Error in FUN(newX[, i], ...) : argument "sample_means" is missing, with no default
Since your function one_way_anova needs multiple arguments, you need to pass all other arguments besides sample_means if you used apply.
If you want to run it over rows in sample_means and sample_vars, maybe you can try sapply like below
sapply(1:m,function(k) one_way_anova(m,n,sample_means[k,],sample_vars[k,]))
I recently asked a similar question (link), but the example that I gave there was a little too simple, and the answers did not work for my actual use case. Again, I am using R and want to apply a function to a vector. The function returns a list, and I want the results to be formatted as a list of vectors, where the names of the output list correspond to the names in the list returned by the function, and the value for each list element is the vector of values over the elements of the input vector. The following example shows a basic set up, together with two ways of calculating the desired output (sum.of.differences and sum.of.differences.2). The first method (sum.of.differences) seems to be the easiest way to understand what the desired output; the second method (sum.of.differences.2) avoids two major problems with the first method -- computing the function twice for each element of the input vector, and being forced to give the names of the list elements explicitly. However, the second method also seems relatively complicated for such a fundamental task. Is there a more idiomatic way to get the desired results in R?
x <- rnorm(n = 10)
a <- seq(from = -1, to = +1, by = 0.01)
sum.of.differences.fun <- function(a) {
d <- x - a
list(
sum.of.absolute.differences = sum(abs(d)),
sum.of.squared.differences = sum(d^2)
)
}
sum.of.differences <- list(
sum.of.absolute.differences = sapply(
X = a,
FUN = function(a) sum.of.differences.fun(a)$sum.of.absolute.differences
),
sum.of.squared.differences = sapply(
X = a,
FUN = function(a) sum.of.differences.fun(a)$sum.of.squared.differences
)
)
sum.of.differences.2 <- (function(lst) {
processed.lst <- lapply(
X = names(lst[[1]]),
FUN = function(name) {
sapply(
X = lst,
FUN = function(x) x[[name]]
)
}
)
names(processed.lst) <- names(lst[[1]])
return(processed.lst)
})(lapply(X = a, FUN = sum.of.differences.fun))
What language did you learn before R? It seems as though you might be using design patterns from a different functional language (I'd guess Lisp). The following code is much simpler and the output is identical (aside from names) as far as I can tell.
x <- rnorm(n = 10)
a <- seq(from = -1, to = +1, by = 0.01)
funs <- c(
sumabsdiff = function(a) sum(abs(x - a)),
sumsquarediff = function(a) sum((x - a) ^ 2)
)
sumdiff <- lapply(
funs,
function(fun) sapply(a, fun)
)
I am trying to create a "for loop" setup that is going calculate different rolling means of a return series, where I use rolling means ranging from the last 2 observations to the last 16 observations. kϵ[2,16]. I've been trying to use a function like this, where the "rollmean" is a function from zoo. This produces the warning "Warning message:
In roll[i] <- rollmean(x, i) :
number of items to replace is not a multiple of replacement length"
Can someone please help me?
rollk <- function(x, kfrom= 2, kto=16){
roll <- as.list(kto-kfrom+1)
for (i in kfrom:kto){
roll[i]<- rollmean(x, i)
return(roll)
}}
I suppose you want
# library(zoo)
rollk <- function(x, kfrom = 2, kto = 16){
roll <- list()
ft <- kfrom:kto
for (i in seq_along(ft)){
roll[[i]]<- rollmean(x, ft[i])
}
return(roll)
}
There are several problems in your function:
You need [[ to access a single list element, not [.
You want a list of length length(krom:kto). Now, i starts at 1, not at kfrom.
Now, roll is returned after the for loop. Hence, the function returns a single list containing all values.
A shorter equivalent of the function above:
rollk2 <- function(x, kfrom = 2, kto = 16)
lapply(seq(kfrom, kto), function(i) na.omit(filter(x, 1 / rep(i, i))))
It does not require loading additional packages.
Try this:
library(zoo)
lapply(2:16, rollmean, x = x)