I have written this function
tippett <- function(p1, p2) {
t <- 1 - (1 - min(p1, p2))^2
return(list(p.value=t))
}
and I would like to apply it in a matrix of generated numbers horizontally. For instance in this matrix: z <- matrix(c(rbeta(5, 1, 5), rbeta(5, 1, 10)), ncol=2).
Unfortunately apply does not seem to work and using it in this fashion s<-apply(z,1,tippett)
generates this error
Error in FUN(newX[, i], ...) : argument "p2" is missing, with no default
Could you please tell me how I could circumvent that? It is my hope to generalize this procedure to thousands of rows and I can't imagine doing it manually.
Thank you.
I think you could change your function...
tippett<-function(p){
t<-1-(1-min(p))^2
return(list(p.value=t))
}
Then your function call should work. (I have not tested this though...)
s<-apply(z,1,tippett)
Alternatively, if you cannot change this function, you could try something like...
s <- sapply(seq_along(nrow(z)), function(i) tippett(z[i,1], z[i,2]))
I think that should all work. Sorry, running some code currently and cannot verify/test it.
Try this in one line:
tippet2 = function(z) as.list(1-(1-do.call(pmin, as.data.frame(z)))^ncol(z))
tippet2(z)
This is vectorized.
This applies to your matrix or a matrix with more columns.
Related
I am trying to solve the following a constrained maximization problem.
The example here is simply me trying to recreate a simple example.
I have a dataframe as follows:
Obs=c(1,2,3,4,5)
Var1=c(11,15,16,19,20)
Var2=c(1.5,22,0.9,1.7,.1)
Var3=c(2.6,2.5,3.5,3.6,2.1)
Value_One = c(10,12.5,8.4,7.5,2.6)
Cost = c(1.1,1.2,1.3,1.6,1.7)
Value_overall = c(10,21,31,4,29)
df=data.frame(Obs,Var1,Var2,Var3,Value_One,Cost,Value_overall)
var_sel=c('Var1','Var2')
coeff_sel=c(2.5,4.5)
gamma=.7
I have to run a constrained optimization problem an example of which is as follows (Note the exact values, does not matter. Please feel free to change them as you please):
Value_func = function(x){
Value_var=x$Cost
# - since the contrained optimum function is for minima.
-((x$Value_overall+gamma*(x$Value_null-
(as.matrix(x[var_sel])%*%(as.matrix(coeff_sel)))))-2*x[Cost])
}
#Please feel free to change the values below.
#I just want to know where I am going wrong. The exact values do not matter here.
for (i2 in 1:nrow(df)){
x=df[i2,]
zzz=constrOptim(-1.2, Value_func, NULL,ui=1,ci=-1.3)
}
What I want to do is to run the above for each row of the dataframe. When I run the above example, I get the following error:
Error: $ operator is invalid for atomic vectors
Called from: f(theta, ...)
I tried to look for a solution and this is what I got but it does not seem to be applicable in my case (R $ operator is invalid for atomic vectors in constraOptim).
Please help. Thanks in advance.
This makes a result without error. Changes to your code include:
Added Value_null to the data.frame
Changed the function argument to costs and modify the function after the matrix stuff.
Saved the results to zzz as a list instead of static.
If you design this as a matrix in the first place, you could utilize apply.
df <- data.frame(Obs=c(1,2,3,4,5)
,Var1=c(11,15,16,19,20)
,Var2=c(1.5,22,0.9,1.7,.1)
,Var3=c(2.6,2.5,3.5,3.6,2.1)
,Value_One = c(10,12.5,8.4,7.5,2.6)
,Cost = c(1.1,1.2,1.3,1.6,1.7)
,Value_overall = c(10,21,31,4,29)
#added to match
,Value_null = 5
)
var_sel=c('Var1','Var2')
coeff_sel=c(2.5,4.5)
gamma=.7
Value_func = function(costs){
# - since the contrained optimum function is for minima.
-((x$Value_overall+gamma*(x$Value_null-
(as.matrix(x[var_sel])%*%(as.matrix(coeff_sel)))))-2*costs)
}
for (i2 in 1:nrow(df)){
x=df[i2,]
zzz[[i2]]=constrOptim(1, Value_func, NULL,ui=1,ci=-1.3, x$Cost)
}
Or the apply approach. I don't like that I'm assigning x <<- z but it gives results.
Value_func = function(costs){
# - since the contrained optimum function is for minima.
-((x['Value_overall']+gamma*(x['Value_null']-
(x[var_sel]%*%(coeff_sel))))-2*costs)
}
apply(df, 1, function(z) {
x<<- z
constrOptim(1, Value_func, NULL, ui = 1, ci = -1.3, z['Cost'])
}
)
First, my English is not so correct, so I apologize in advance for any grammar mistakes/errors in my question.
I have this general function:
.my_fun <- function(x,y,...){
<body>
return(
list(
fun1 <- function(x){
<bodyfun1>
},
fun2 <- function(y){
<bodyfun2>
}, ....
)
)
}
to be used as auxiliary of:
.my_funfun <- .my_fun(x,y,...)
and use ".my_funfun" as a code starter given the args of "my_fun"
I have to return values on the given order and of course return the result of the functions included on the body of the list. Normally, I would process the functions separately, store the results in separate objects and put the values of those objects in a list, and return that list (simplest way to do it), but I'm required to keep the structure I showed before.
My question is: is there any way to solve the functions in the body of the list and return those values, keeping the given structure? Or is it impossible to use return that way? I have used return() as a premature function stopper and as a fancy printer for objects in control structures, but this usage is new to me.
If you need the specific code elements I can provide them.
Thanks in advance.
You could do this:
my_fun <- function(x,y) {
fun1 <- function(x) {
length(x)
}
fun2 <- function(y) {
sum(y)
}
list(fun1(x),fun2(y))
}
Ok, doing stuff around, I realized what my mistake on the code was. The thing is that when i call
myfun$fun1
I got no answer. The right way to make the list is
.my_fun <- function(x,y,...){
<body>
return(
list(
fun1 = function(x){
<bodyfun1>
},
fun2 = function(y){
<bodyfun2>
}, ....
)
)
}
So i can use the name s"fun1, fun2 (...) as names to call in axiliary function.s
Example:I want to make a linear congruent random generator, with the following code:
.rCongLin <- function(a, c, m, x0){
v1 <- x0
return(
list(seed=function(xw){
v1 <- xw},
nxt=function(){
v2 <- ((a*v1)+c)%%m
v3 <- v2/m
v1<<-v2
return(v3)
},
shw=function(){
return(list(a=a,c=c,m=m,x0=x0))}
)
)
}
The instruction:
.rCL <- .rCongLin(51864,35186,4153,1515)
starts the number generation given the function:
rCL=function(n){
replicate(n,.rCL$nxt())}
rCL(45)
where seed() restarts x0, nxt() calculates the numbers and shw() shows the internal state (values for calculation). rCL(n) returns n number of replicas.
The thing is that .rCL$x() (where x() is any fun of those mentioned) returns NOTHING if you use '<-' operator (change it so u have a demonstration of what im talking about), but it does return with '='.
The answer is that the functions work with '=' because names are ASSIGNED on the lists with '=' (u name things in lists with '=') and not with '<-'. Therefore, in order to make the funtions... "citable" in the body of the return(list(fun1, fun2...) you need to assign the names fun1, fun2... using '='.
It was a simple answer. Got confused in using '=' and '<-' because in the original code every assignment is done with '='. Its prone to confuse novel programmers like me :(
Thanks a lot for your help!
Again Im sorry for any gramatical mistakes in this answer.
I hope this helps more people.
I am a beginner in R and i know the way i have done is wrong and slow. I would like to fill a matrix and i need to compute each term. I have tried two for loops, here is the code. Do you know a better way to do it?
KernelGaussianMatrix <- function(x,delta){
Mat = matrix(0,nrow=length(x),ncol=length(x))
for (i in 1:length(x)){
for (j in 1:length(x)){
Mat[i,j] = KernelGaussian(x[i],x[j],delta)
}
}
return(Mat)
}
Thx
you want to use the function outer as in:
Mat <- outer(x,x,KernelGaussian,delta)
note that any arguments after the third argument in outer are provided as additional arguments to the function provided as the third argument to outer
If a for loop is required to generate the values than your method is fine.
If the values are already in an array values you can try mat = matrix(values, nrow=n, ncol=p) or something similar.
I have a question regarding R apply (and all its variants). Is there a way to update the arguments of the function while apply is working?
For example, I have a function NextSol(Prev_Sol) that generates a new solution from Prev_Sol, compares it with the original one in some way and then returns either the original or the new, depending on the result of the comparison. I need to save all the solutions returned. Currently, I am doing this:
for( i in 2:N ) {
Results[[i]] <- NextSol(Results[[i-1]])
}
But maybe there is a (faster) way to do it using apply? I have seen also that Reduce could help but I have no idea of how can I use it. Any help will be much appreciated!
As Thomas said, the for loop is the standard way of looping when one iteration depends on a previous one. (Just make sure that you correctly handle the case of N = 1 in your code.)
An alternative is to use the Reduce function. This example is adapted from the one on the ?Reduce help page.
NextSol <- function(x) x + 1 #Or whatever you want
Funcall <- function(f, ...) f(...)
Reduce(Funcall, rep.int(list(NextSol), 5), 0, right = TRUE)
## [1] 5
It's unlikely that this will be much faster, and it's arguably harder to read, so you may well decide to stick with a for loop.
Well, I suppose we can make it easier to read by wrapping it in an Iterate function.
Iterate <- function(f, init, n)
{
Reduce(
function(f, ...) f(...),
rep.int(list(f), n),
init,
right = TRUE
)
}
Iterate(NextSol, 0, 5) #same as before
There is a data.frame() for which's columns I'd like to calculate quantiles:
tert <- c(0:3)/3
data <- dbGetQuery(dbCon, "SELECT * FROM tablename")
quans <- mapply(quantile, data, probs=tert, name=FALSE)
But the result only contains the last element of quantiles return list and not the whole result. I also get a warning longer argument not a multiple of length of shorter. How can I modify my code to make it work?
PS: The function alone works like a charme, so I could use a for loop:
quans <- quantile(a$fileName, probs=tert, name=FALSE)
PPS: What also works is not specifying probs
quans <- mapply(quantile, data, name=FALSE)
The problem is that mapply is trying to apply the given function to each of the elements of all of the specified arguments in sequence. Since you only want to do this for one argument, you should use lapply, not mapply:
lapply(data, quantile, probs=tert, name=FALSE)
Alternatively, you can still use mapply but specify the arguments that are not to be looped over in the MoreArgs argument.
mapply(quantile, data, MoreArgs=list(probs=tert, name=FALSE))
I finally found a workaround which I don't like but kinda works. Perhaps someone can tell the right way to do it:
q <- function(x) { quantile(x, probs=c(0:3)/3, names=FALSE) }
mapply(q, data)
works, no Idea where the difference is.