I have defined a function which I want to reapply to its own output multiple times. I tried
replicate(1000,myfunction)
but realised that this is just applying my function to my initial input 1000 times, rather than applying my function to the new output each time. In effect what I desire is:
function(function(...function(x_0)...))
1000 times over and being able to see the changes at each stage.
I have previous defined b as a certain vector of length 7.
b_0=b
C=matrix(0,7,1000)
for(k in 1:1000){
b_k=myfun(b_(k-1))
}
C=rbind(b_k)
C
Is this the right idea behind what I want?
You could use Reduce for this. For example
add_two <- function(a) a+2
ignore_current <- function(f) function(a,b) f(a)
Reduce(ignore_current(add_two), 1:10, init=4)
# 24
Normally Reduce expects to iterate over a set of new values, but in this case I use ignore_current to drop the sequence value (1:10) so that parameter is just used to control the number of times we repeat the process. This is the same as
add_two(add_two(add_two(add_two(add_two(add_two(add_two(add_two(add_two(add_two(4))))))))))
Pure functional programming approach, use Compose from functional package:
library(functional)
f = Reduce(Compose, replicate(100, function(x) x+2))
#> f(2)
#[1] 202
But this solution does not work for too big n ! Very interesting.
A loop would work just fine here.
apply_fun_n_times <- function(input, fun, n){
for(i in 1:n){
input <- fun(input)
}
return(input)
}
addone <- function(x){x+1}
apply_fun_n_times(1, addone, 3)
which gives
> apply_fun_n_times(1, addone, 3)
[1] 4
you can try a recursive function:
rec_func <- function(input, i=1000) {
if (i == 0) {
return(input)
} else {
input <- myfunc(input)
i <- i - 1
rec_func(input, i)
}
}
example
myfunc <- function(item) {item + 1}
> rec_func(1, i=1000)
[1] 1001
Related
I just read that vectorization increases performance and lowers significantly computation time, and in the case of if() else , best choice is ifelse().
My problem is I got some if statements inside a for loop, and each if statement contains multiple assignments, like the following:
x <- matrix(1:10,10,3)
criteria <- matrix(c(1,1,1,0,1,0,0,1,0,0,
1,1,1,1,1,0,0,1,1,0,
1,1,1,1,1,1,1,1,1,1),10,3) #criteria for the ifs
output1 <- rep(list(NA),10) #storage list for output
for (i in 1:10) {
if (criteria[i,1]>=1) {
output1[[i]] <- colMeans(x)
output1[[i]] <- output1[[i]][1] #part of the somefunction output
} else {
if(criteria[i,2]>=1) {
output1[[i]] <- colSums(x)
output1[[i]] <- output1[[i]][1] #the same
} else {
output1[[i]] <- colSums(x+1)
output1[[i]] <- output1[[i]][1] #the same
}}}
How can I translate this into ifelse?
Thanks in advance!
Note that you don't need a for loop as all operations used are vectorized:
output2 <- ifelse(criteria[, 1] >= 1,
colMeans(x)[1],
ifelse(criteria[, 2] >= 1,
colSums(x)[1],
colSums(x+1)[1]))
identical(output1, as.list(output2))
## [1] TRUE
At least you can convert two assignments into one. So instead of
output[[i]] <- somefunction(arg1,arg2,...)
output[[i]] <- output[[i]]$thing #part of the somefunction output
you can refer directly to the only part you are interested in.
output[[i]] <- somefunction(arg1,arg2,...)$thing #part of the somefunction output
Hope that it helps!
It seems I found the answer trying to build the example:
output2 <- rep(list(NA),10) #storage list for output
for (i in 1:10) {
output2[[i]] <- ifelse(criteria[i,1]>=1,
yes=colMeans(x)[1],
no=ifelse(criteria[i,2]>=1,
yes=colSums(x)[1],
no=colSums(x+1)[1]))}
I have problems storing user defined functions in R list when they are put on it in a for loop.
I have to define some segment-specific functions based on some parameters, so I create functions and put them on a list looping through segments with for-loop. The problem is I get same function everywhere on a result list.
The code looks like this:
n <- 100
segmenty <- 1:n
segment_functions <- list()
for (i in segmenty){
segment_functions[[i]] <- function(){return(i)}
}
When i run the code what I get is the same function (last created in the loop) for all indexes:
## for all k
segment_functions[[k]]()
[1] 100
There is no problem when I put the functions on list manually e.g.
segment_functions[[1]] <- function(){return(1)}
segment_functions[[2]] <- function(){return(2)}
segment_functions[[3]] <- function(){return(3)}
works just fine.
I honsetly have no idea what's wrong. Could you help?
You need to use the force function to ensure that the evaluation of i is done during the assignment into the list:
n <- 100
segmenty <- 1:n
segment_functions <- list()
f <- function(i) { force(i); function() return(i) }
for (i in segmenty){
segment_functions[[i]] <- f(i)
}
I'd use lapply and capture i in a clousre of the wrapper:
segment_functions <- lapply(1:100, function(i) function() i)
I have below function. I cannot alter the function in any way except the first block of code in the function.
In this simple example I want to display apply some function on returning object.
The point is the name of variable returned by function may vary and I'm not able to guess it.
Obviously I also cannot wrap the f function into { x <- f(); myfun(x); x }.
The below .Last.value in my on.exit call represents the value to be returned by f function.
f <- function(param){
# the only code I know - start
on.exit(if("character" %in% class(.Last.value)) message(print(.Last.value)) else message(class(.Last.value)))
# the only code I know - end
# real processing of f()
a <- "aaa"
"somethiiiing"
if(param==1L) return(a)
b <- 5L
"somethiiiing"
if(param==2L) return(b)
"somethiiiing"
return(32)
}
f(1L)
# function
# [1] "aaa"
f(2L)
# aaa
# [1] 5
f(3L)
# integer
# [1] 32
Above code with .Last.value seems to be working with lag (so in fact not working) and also the .Last.value is probably not the way to go as I want to use the value few times like if(fun0(x)) fun1(x) else fun2(x), and because returned value might be a big object, copy it on the side is also bad approach.
Any way to use on.exit or any other function which can help me to run my function on the f function results without knowing result variable name?
In a similar way to how you are modifying the function, you could easily wrap it as well. Here's a reproducible example.
library(data.table)
append.log<-function(x) {
cat(paste("value:",x,"\n"))
}
idx.dt <- data.table:::`[.data.table`
environment(idx.dt)<-asNamespace("data.table")
idx.wrap <- function(...) {
x<-do.call(idx.dt, as.list(substitute(...())), envir=parent.frame())
append.log(if(is(x, "data.table")) {
nrow(x)
} else { NA })
x
}
environment(idx.wrap)<-asNamespace("data.table")
(unlockBinding)("[.data.table",asNamespace("data.table"))
assign("[.data.table",idx.wrap,envir=asNamespace("data.table"),inherits=FALSE)
dt<-data.table(a=1:10, b=seq(2, 20, by=2), c=letters[1:10])
dt[a%%2==0]
Since R 3.2.0 it is fully possible, thanks to new function returnValue.
Working example below.
f <- function(x, err = FALSE){
pt <- proc.time()[[3L]]
on.exit(message(paste("proc.time:",round(proc.time()[[3L]]-pt,4),"\nnrow:",as.integer(nrow(returnValue()))[1L])))
Sys.sleep(0.001)
if(err) stop("some error")
return(x)
}
dt <- data.frame(a = 1:5, b = letters[1:5])
f(dt)
f(dt, err=T)
f(dt)
f(dt[dt$a %in% 2:3 & dt$b %in% c("c","d"),])
I am constructing an approximating function recursively (adaboost). I would like to create the resulting learning function along the way (not to apply the approximation directly to my test data but keep the function that leads to it)
unfortunately, it seems that R updates the value to which a variable name refers to long after it is used.
#defined in plyr as well
id <- function(x) {x}
#my first classifier
modelprevious <- function(inputx, k) { k(0)}
#one step of my superb model
modelf <- function(x) 2*x #for instance
#I update my classifier
modelCurrent <- function(inputx, k)
{ modelprevious(inputx, function(res) {k(res + modelf(inputx))})}
#it works
modelCurrent(2,id) #4
#Problem
modelf <- function(x) 3*x
modelCurrent(2,id) #6 WTF !!
The same function with the same argument return something different, which is quite annoying !
So how is it possible to capture the value represented by modelf so that the resulting function only depends on its argument at the time of the binding, and not of some global state ?
Given that problem I dont see how one can do a recursive function building in R if one can not touch local variable, apart going through ugly hacks of quote/parse
You need a factory:
modelCurrent = function(mf){
return(function(inputx,k){
modelprevious(
inputx,
function(res){
k(res+mf(inputx))
} # function(res)
) # modelprevious
} # inner function
) # return
} # top function
Now you use the factory to create models with the modelf function that you want it to use:
> modelf <- function(x) 2*x
> m1 = modelCurrent(modelf)
> m1(2,id)
[1] 4
> modelf <- function(x) 3*x
> m1(2,id) # no change.
[1] 4
You can always make them on an ad-hoc basis:
> modelCurrent(modelf)(2,id)
[1] 6
and there you can see the factory created a function using the current definition of modelf, so it multiplied by three.
There's one last ginormous WTF!?! that will hit you. Watch carefully:
> modelf <- function(x) 2*x
> m1 = modelCurrent(modelf)
> m1(2,id)
[1] 4
>
> m1 = modelCurrent(modelf) # create a function using the 2* modelf
> modelf <- function(x) 3*x # change modelf...
> m1(2,id) # WTF?!
[1] 6
This is because when the factory is called, mf isn't evaluated - that's because the inner function isn't called, and mf isn't used until the inner function is called.
The trick is to force evaluation of the mf in the outer function, typically using force:
modelCurrent = function(mf){
force(mf)
return(function(inputx,k){
modelprevious(
inputx,
function(res){
k(res+mf(inputx))
} # function(res)
) # modelprevious
} # inner function
) # return
} # top function
This has lead me to premature baldness, because if you forget this and think there's some odd bug going on, and then try sticking print(mf) in place to see what's going on, you'll be evaluating mf and thus getting the behaviour you wanted. By inspecting the data, you changed it! A Heisenbug!
I've written a function that is a simulation, that outputs a vector of 100 elements, and I want to use the *apply functions to run the function many times and store the repeated output in a new vector for each time the simulation is run.
The function looks like:
J <- c(1:100)
species_richness <- function(J){
a <- table(J)
return(NROW(a))
}
simulation <- function(J,gens,ploton=FALSE,v=0.1){
species_richness_output <- rep(NA,gens)
for(rep in 1:gens){
index1 <- sample(1:length(J),1)
if(runif(1,0,1) < v){
J[index1] <- (rep+100)
}
else{
index2 <- sample(1:length(J),1)
while(index1==index2) {
index2 <- sample(1:length(J),1)
}
J[index1] <- J[index2]
}
species_richness_output[rep] <- species_richness(J)
}
species_abundance <- function(J){
a <- table(J)
return(a)
}
abuntable <- species_abundance(J)
print(abuntable)
octaves <- function(abuntable){
oct <- (rep(0,log2(sum(abuntable))))
for(i in 1:length(abuntable)){
oct2 <- floor(log2(abuntable[i])+1)
oct[oct2] <- oct[oct2]+1
}
print(oct)
}
# octaves(c(100,64,63,5,4,3,2,2,1,1,1,1))
if(ploton==TRUE){
hist(octaves(abuntable))
}
print(species_richness(J))
return(J)
}
simulation(J, 10000,TRUE,v=0.1)
So that's my function, it takes J a vector I defined earlier, manipulates it, then returns:
the newly simulated vector J of 100 elements
a function called octave that categorises the new vector
a histogram corresponding to the above "octave"
I have tried a number of variations: using lapply, mapply
putting args=args_from_original_simulation
simulation_repeated <- c(mapply(list, FUN=simulation(args),times=10000))
but I keep getting an error with the match.fun part of the mapply function
Error in match.fun(FUN) :
'simulation(J, 10000, FALSE, 0.1)' is not a function, character or symbol
This is despite the simulation I have written showing as being saved as a function in the workspace.
Does anyone know what this error is pointing to?
In this line:
simulation_repeated <- c(mapply(list, FUN=simulation(args),times=10000))
You are not giving a function to mapply. You are (essentially) passing the result of calling simulation(args) and simulation does not return a function.