如何在R中将参数传递给mapply函数？

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: