My problem is when assigning values to overlay.
library(raster)
beginCluster(10)
r <- raster(ncol=10, nrow=10)
r1 <- init(r, fun=runif)
r2 <- init(r, fun=runif)
s=stack(r1,r2,r2,r1,r2,r1)
wi=c(3,5,7)
fun1 = function(x) {overlay(x, fun=function(x) movingFun(x, fun=mean, n=3))}
vm = clusterR(s, fun1, progress = "text")
no problem!
but when I assign n to wi it did not work
for(i in 1:3) {
fun1 = function(x) {overlay(x, fun=function(x) movingFun(x, fun=mean, n=wi[i]))}
vm = clusterR(s, fun1, progress = "text")
}
I got this error
cannot use this formula, probably because it is not vectorized"
Everything inside the function has to be passed to it - it doesn't pick anything up from your environment because of the way the cluster operates.
So pass wi and i to your function:
fun2 = function(x, wi, i) {
overlay(x,
fun=function(x) movingFun(x, fun=mean, n=wi[i]))}
and list them as args in the call to clusterR:
for(i in 1:3){
vm = clusterR(s, fun2, list(wi, i), progress = "text")
}
Related
How can I repeat this code for each subject (xxx), so that the results are added to the data.frame (centralities)?
fullDataDetrend_xxx <- subset(fullDataDetrend, subjno == xxx, select=c(subjno,depressed,sad,tired,interest,happy,neg_thoughts,concentration_probl,ruminating,activity,datevar,timestamp,dayno,beepno))
model_xxx <- var1(
fullDataDetrend_xxx)
model_xxx_omega <- getmatrix(model_xxx, "omega_zeta")
centrality_model_xxx_omega <- centrality(model_xxx_omega )
centralities[nrow(centralities) + 1,] <- c("xxx",centrality_model_xxx_omega$InExpectedInfluence)
Did as suggested:
fullDataDetrend_split <- split(fulldataDetrend, fulldataDetrend$subjno)
then, to estimate network, pull centrality estimates, and write to centralities in global environment:
analyze_one <- function(dataframe){
network_model <- var1(
dataframe,
vars = useVars,
contemporaneous = "ggm",
dayvar = "dayno",
beepvar = "beepno",
estimator = "FIML",
verbose = TRUE,
omega_zeta = "full")
model_omega <- getmatrix(network_model, "omega_zeta")
centrality_omega<- centrality(model_omega)
model_beta <- getmatrix(network_model, "beta")
centrality_beta<- centrality(model_beta)
subjno <- as.list(dataframe[1,2])
centralities[nrow(centralities) + 1,] <- c(subjno,centrality_omega$InExpectedInfluence,centrality_beta$InExpectedInfluence,centrality_beta$OutExpectedInfluence)
assign('centralities',centralities, envir=.GlobalEnv)
}
then rerun the code with lapply for all dataframes (with ignoring errors):
lapply_with_error <- function(X,FUN,...){
lapply(X, function(x, ...) tryCatch(FUN(x, ...),
error=function(e) NULL))
}
lapply_with_error(fullDataDetrend_split, FUN = analyze_one)
I'm not familiar with R, and I want to speed up calculation while doing pixel-wise regression over two large datasets(abot 4GB each) in R, but I got the error Error in clusterR(gim_mod, calc, args = list(fun = coeff)) : cluster error.
Can anyone tell me what's wrong in my code and help me out. here are my codes that got an error:
gim_mod <- stack(gimms_dis_re,modis_re)
coeff <- function(x){
if (is.na(x[1])){
NA
}
else {
lm(x[1:156] ~ x[157:312])$coefficients
}
}
beginCluster(n = 5)
coef_gm <- clusterR(gim_mod,calc, args = list(fun = coeff))
endCluster()
the gimms_dis_re and modis_re are two Rasterstacks that each contains 156 Rasterlayers, and I want to do pixel-wise regression over them.
The function used in calc should return the same number of values for each cell. Your function returns an NA when there is only one number; but two values when there is not.
The below works for me (minimal example data).
Example data
library(raster)
r <- raster(nrow=10, ncol=10)
set.seed(321)
s1 <- lapply(1:12, function(i) setValues(r, rnorm(ncell(r), i, 3)))
s2 <- lapply(1:12, function(i) setValues(r, rnorm(ncell(r), i, 3)))
s1 <- stack(s1)
s2 <- stack(s2)
s1[1:5] = NA
Regression of values in one RasterStack with another
s <- stack(s1, s2)
fun <- function(x) {
if (is.na(x[1])) {
c(NA, NA)
} else {
lm(x[1:12] ~ x[13:24])$coefficients
}
}
# works without cluster
x <- calc(s, fun)
# and with cluster
beginCluster(n = 2)
g <- clusterR(s, calc, args = list(fun = fun))
endCluster()
I met a problem adding two functions together to a new function in R. For example, fun_1<-function(w)... fun_2<-function(w)... now I need to get a function fun(w)=fun_1(w)+fun_2(w) how could I do it?
Do you mean this ?
fun_1 <- function(x){
x ^ 2
}
fun_2 <- function(x){
x + 1
}
fun_3 <- function(x){
fun_1(x) + fun_2(x)
}
fun_3(1)
returns 3
k <- NA
fun <- function(w){
for (i in 1:100){
k[i] <- (-i/100)^2 + exp(w)
}
sum(k)
}
fun(1)
returns 305.6632
You can use get with envir = parent.frame() and just use paste to specify the function name.
# define functions
for(i in 1:100) assign(paste0('fun',i), function(w) (-i/100)^2+exp(w) )
# sum them
sum.fun <- function(x){
out <- 0
for(i in 1:100){
fun <- get(paste0('fun',i), envir = parent.frame())
out <- out + fun(x)
}
out
}
sum.fun(2)
I am trying to create new functions from a list of function and a list of parameters to be passed to these functions, but am unable to do so so far. Please see the example below.
fun_list <- list(f = function(x, params) {x+params[1]},
z = function(a, params) {a * params[1] * params[2]})
params_list <- list(f = 1, z = c(3, 5))
# goal is to create 2 new functions in global environment
# fnew <- function(x) {x+1}
# znew <- function(a) {a*3*5}
# I've tried
for(x in names(fun_list)){
force(x)
assign(paste0(x, "new"), function(...) fun_list[[x]] (..., params = params_list[[x]]))
}
The goal is to do this dynamically for arbitrary functions and parameters.
Well, force() doesn't work in a for-loop because for loops do not create new environments. Based on a previous question of mine, I created a capture() function
capture <- function(...) {
vars <- sapply(substitute(...()), deparse);
pf <- parent.frame();
Map(assign, vars, mget(vars, envir=pf, inherits = TRUE), MoreArgs=list(envir=pf))
}
this allows
for(x in names(fun_list)) {
f = local({
capture(x);
p = params_list[[x]];
f = fun_list[[x]];
function(x) f(x, p)
})
assign(paste0(x, "new"), f)
}
where we create a local, private environment for the functions to store their default parameter values.
Which gives
fnew(2)
# [1] 3
znew(2)
# [1] 30
How about this:
for(x in names(fun_list)) {
formals(fun_list[[x]])$params <- params_list[[x]]
assign(paste0(x, "new"), fun_list[[x]])
}
This is similar in spirit:
ps <- list(fp=1,zp=c(3,5))
f0s <- substitute(list(f=function(x)x+fp,z=function(a)a*zp1*zp2),as.list(unlist(ps)))
f0s # list(f = function(x) x + 1, z = function(a) a * 3 * 5)
fs <- eval(f0s)
fs$f(1) # 2
To do the fancy thing described in the OP, you'd probably have to mess with formals.
Consider the following example:
q1.func <- function(x) {
num <- (cos(30.2 * x^(1/2)))^2
denom <- (x^0.7) * exp(0.9*x)
num / denom
}
method1 <- function(n) {
x <- runif(n,min = 0, max = 1.7)
f <- q1.func(x)
(1.7) * sum((1/n) * f)
}
draw.graph <- function() {
n <- seq(1,1000,1)
x <- c()
for(i in 1:length(n)) {
x <- append(x, method1(n[i]))
}
plot(n, x, type = "p", xlab = "N",ylab = "value" ,main = "method1 plot",col = "black")
}
My point is that I want to be able to perform: draw.graph(method1(n)). But R wouldnt allow me to do that. I dont understand why is this happening??? My ultimate goal is that I would be able to pass method2 / method3 /.... as argument of draw.graph() function. But how??? Right now, I am only interested in solutions that allow me to pass method1 as an argument of the draw.graph function. Please dont ask me to write method1 WITHIN the draw.graph function, because I already know that it works. But I am more interested in passing method1 as an argument of the draw.graph function. Thanks
I'll make a simpler example to illustrate the main point (there are other issues with the code you proposed).
fun1 = function(x) cos(x)
fun2 = function(x) sin(x)
# function where one argument is a function
wrapper = function(a = 2, fun = fun1){
x = 1:10
return(data.frame(x = x, y = a*fun(x)))
}
# testing behaviour
wrapper()
wrapper(fun = fun2)
Your draw.graph function lacks an argument.
Why not simply use the return value of an function as argument of the next function?
draw.graph <- function(y) {
plot(seq_along(y), y)
}
method1 <- function(n) {
return(runif(n, min=0, max=1.7))
}
draw.graph(method1(100))
If you really need a function as argument you could try the following (please read ?match.fun):
## stupid example
calc <- function(x, fun) {
fun <- match.fun(fun)
return(fun(x))
}
calc(1:10, sum)
EDIT:
To fulfill the OP question/comments I add this specific example:
q1.func <- function(x) {
num <- cos(30.2 * sqrt(x))^2
denom <- x^0.7 * exp(0.9*x)
return(num/denom)
}
method1 <- function(n) {
x <- runif(n, min=0, max=1.7)
return(1.7*sum(1/n*q1.func(x)))
}
draw.graph <- function(n, fun) {
fun <- match.fun(fun)
y <- unlist(lapply(n, fun))
plot(n, y)
}
draw.graph(1:1000, method1)