How to pass arguments into the mapply function in R? - r

Question

Background.
I'm reading the the paper and tried to find the (tau1*, tau2*) = arg max P_D(tau1, tau2) (Eq.(30)). In the paper (page 6, table 1) you can see the result obtained by authors (column -- Chair-Varshney rule). I have variated the initial parameters tau1, tau2 in the range [1, 15] by hand, and my result is close to the original result.
The figure shows the results when the initial parameters were tau1=tau2=1 (blue line) and tau1=tau2=15 (red line) with comparing to the "Chair-Varshney rule" (black points).
My code is below.
fun_PD <- function(par, alpha, N){
t1 <- par[[1]]; t2 <- par[[2]]
lambdab <- 10
lambdac <- c(0.625, 0.625)
sigma2_w <- 10
p<-c(); q<-c()
# Compute P-values, complementary CDF
p[1]<- 1 - pnorm((t1 - lambdab - lambdac[1])/sqrt(sigma2_w + lambdab + lambdac[1])) # (5)
p[2]<- 1 - pnorm((t2 - lambdab - lambdac[2])/sqrt(sigma2_w + lambdab + lambdac[2])) # (6)
q[1] <- 1 - pnorm((t1 - lambdab)/sqrt(sigma2_w + lambdab)) # (7)
q[2] <- 1 - pnorm((t2 - lambdab)/sqrt(sigma2_w + lambdab)) # (8)
Q00 <- (1-q[1])*(1-q[2]); Q01 <- (1-q[1])*q[2] # page 4
Q10 <- q[1]*(1-q[2]); Q11 <- q[1]*q[2]
P00 <- (1-p[1])*(1-p[2]); P01 <- (1-p[1])*p[2] # page 5
P10 <- p[1]*(1-p[2]); P11 <- p[1]*p[2]
C <- c(log((P10*Q00)/(P00*Q10)), log((P01*Q00)/(P00*Q01))) # (13)
mu0 <- N * (C[1]*q[1] + C[2]*q[2]) # (14)
mu1 <- N * (C[1]*p[1] + C[2]*p[2]) # (16)
sigma2_0 <- N * (C[1]^2*q[1]*(1-q[1]) + C[2]^2*q[2]*(1-q[2])) # (15)
sigma2_1 <- N * (C[1]^2*q[1]*(1-q[1]) + C[2]^2*q[2]*(1-q[2])) # (17)
sigma0 <- sqrt(sigma2_0)
sigma1 <- sqrt(sigma2_1)
#Compute critical values, inverse of the CCDF
PA <- qnorm(alpha, lower.tail=FALSE)
gamma <- sigma0 * PA + mu0 # (20)
out <- 1 - pnorm((gamma - mu1)/sigma1) # (30)
return(out)
} # fun_PD
###########################################################################
dfb <- data.frame(a=c(0.01, 0.05, 0.1, 0.2, 0.3, 0.4, 0.5),
r=c(.249, .4898, .6273, .7738, .8556, .9076, .9424))
df <- data.frame()
a <- seq(0,1,0.05)
n <- length(a)
for(i in 1:n) {
tau_optimal <- optim(par=c(t1=1,t2=1), # parameter
fn=fun_PD,
control=list(fnscale=-1), # maximization
method="CG",
alpha = a[i], # const
N = 100) # const
df = rbind(df, c(tau_optimal$par[1], tau_optimal$par[2], a[i], tau_optimal$value))
}
colnames(df) <- c("tau1", "tau2", "alpha", "P_d")
df
After some simulations I understud that the function fun_P_D can has some local minimas and maximas, and I have tried to use the graphical approuch from the R-User-guide to detect the local minimas and maximas of the function:
Edit 2. After the Marcelo's updated answer:
fun_PDtest <- function(x, y){
mapply(fun_PD, x, y, MoreArgs = list(N=100, alpha=0.1))
}
x<-(1:10); y<-c(1:10)
fun_PDtest(x,y)
# Error in (function (par, alpha, N) : unused argument (dots[[2]][[1]])
My question is: How to pass vectors x, y into the mapply function?

Answer 1

outer expands the the 2 vectors and expects the function to take 2 vectors of the same size. Instead of rewriting fun_PD to take vectors, you can use mapply and call the original function inside fun_PDtest. You can also create a function that receives a vector to be used in optmin
Complete code:
#Rewrite function to use x, y instead of receiving a vector
fun_PD <- function(x , y, alpha, N) {
t1<-y
t2<-x
N<-100
alpha<-0.1
lambdab <- 10
lambdac <- c(0.625, 0.625)
sigma2_w <- 10
p<-c(); q<-c()
# Compute P-values, complementary CDF
p[1]<- 1 - pnorm((t1 - lambdab - lambdac[1])/sqrt(sigma2_w + lambdab + lambdac[1])) # (5)
p[2]<- 1 - pnorm((t2 - lambdab - lambdac[2])/sqrt(sigma2_w + lambdab + lambdac[2])) # (6)
q[1] <- 1 - pnorm((t1 - lambdab)/sqrt(sigma2_w + lambdab)) # (7)
q[2] <- 1 - pnorm((t2 - lambdab)/sqrt(sigma2_w + lambdab)) # (8)
Q00 <- (1-q[1])*(1-q[2]); Q01 <- (1-q[1])*q[2] # page 4
Q10 <- q[1]*(1-q[2]); Q11 <- q[1]*q[2]
P00 <- (1-p[1])*(1-p[2]); P01 <- (1-p[1])*p[2] # page 5
P10 <- p[1]*(1-p[2]); P11 <- p[1]*p[2]
C <- c(log((P10*Q00)/(P00*Q10)), log((P01*Q00)/(P00*Q01))) # (13)
mu0 <- N * (C[1]*q[1] + C[2]*q[2]) # (14)
mu1 <- N * (C[1]*p[1] + C[2]*p[2]) # (16)
sigma2_0 <- N * (C[1]^2*q[1]*(1-q[1]) + C[2]^2*q[2]*(1-q[2])) # (15)
sigma2_1 <- N * (C[1]^2*q[1]*(1-q[1]) + C[2]^2*q[2]*(1-q[2])) # (17)
sigma0 <- sqrt(sigma2_0)
sigma1 <- sqrt(sigma2_1)
#Compute critical values, inverse of the CCDF
PA <- qnorm(alpha, lower.tail=FALSE)
gamma <- sigma0 * PA + mu0 # (20)
out <- 1 - pnorm((gamma - mu1)/sigma1) # (30)
return(out)
}
x<-seq(1,15, len=50)
y<-seq(1,15, len=50)
# then I rewrite my function without passing alpha and N
fun_PDimage <- function(x, y){
mapply(fun_PD,x,y, MoreArgs = list(N=100, alpha=0.1))
# the body is the same as in fun_PD(par, alpha, N)
} # fun_PDimage
z <-outer(x, y, fun_PDimage) # errors are here
# Rewrite function for use in optim
fun_PDoptim <- function(v){
x<-v[1]
y<-v[2]
fun_PD(x, y, 0.1, 100)
} # fun_PDoptim
#Create the image
image(x,y,z, col=heat.colors(100))
contour(x,y,z,add=T)
# Find the max using optmin
res<-optim(c(2,2),fun_PDoptim, control = list(fnscale=-1))
print(res$par)
#Add Point to image
points(res$par[1], res$par[2],pch=3)
Here is the result:
Points where the function has a maximum:
> print(res$par)
[1] 12.20753 12.20559
Image: