I am trying to program the basic Vanilla TrueSkill (3.1) algorithm in R but am getting some strange results.
My code is the following:
# A simple test between two players repeatedly laying one another
betaSq = 0.1
obs = 10000
p1_skills = 0.333
p2_skills = 0
p1_draws = rnorm(obs, p1_skills, sqrt(betaSq))
p2_draws = rnorm(obs, p2_skills, sqrt(betaSq))
p1_pred_mu = rep(NA, obs+1)
p1_pred_sigmaSq = rep(NA, obs+1)
p2_pred_mu = rep(NA, obs+1)
p2_pred_sigmaSq = rep(NA, obs+1)
# Initial values
p1_pred_mu[1] = 0
p1_pred_sigmaSq[1] = 1
p2_pred_mu[1] = 0
p2_pred_sigmaSq[1] = 1
results = p1_draws > p2_draws
probs = rep(NA, obs)
# Run TrueSkill
for (i in seq(2,obs+1)) {
probs[i-1] = predictProb(p1_pred_mu[i-1], p1_pred_sigmaSq[i-1], p2_pred_mu[i-1], p2_pred_sigmaSq[i-1], betaSq)
out = updateSkill(p1_pred_mu[i-1], p1_pred_sigmaSq[i-1], p2_pred_mu[i-1], p2_pred_sigmaSq[i-1], betaSq, results[i-1])
# Now update based on the out
p1_pred_mu[i] = out$mu1
p1_pred_sigmaSq[i] = out$sigmaSq1
p2_pred_mu[i] = out$mu2
p2_pred_sigmaSq[i] = out$sigmaSq2
}
# Output results
dev.new()
mu = p1_pred_mu
lower = qnorm(0.05, p1_pred_mu, p1_pred_sigmaSq)
upper = qnorm(0.95, p1_pred_mu, p1_pred_sigmaSq)
plot(mu, ylim = c(min(lower), max(upper)), main = "p1")
lines(lower)
lines(upper)
dev.new()
mu = p2_pred_mu
lower = qnorm(0.05, p2_pred_mu, p2_pred_sigmaSq)
upper = qnorm(0.95, p2_pred_mu, p2_pred_sigmaSq)
plot(mu, ylim = c(min(lower), max(upper)), main = "p2")
lines(lower)
lines(upper)
a = filter(probs, rep(1, 20))/20
dev.new()
plot(a)
print(sprintf("Mean p1: %g", mean(p1_pred_mu)))
print(sprintf("Mean p2: %g", mean(p2_pred_mu)))
print(sprintf("Mean results: %g", mean(results)))
print(sprintf("Mean predicted results: %g", mean(probs)))
The functions that are called are:
# Functions
updateSkill <- function(mu1, sigmaSq1, mu2, sigmaSq2, betaSq, result) {
# http://papers.nips.cc/paper/3331-trueskill-through-time-revisiting-the-history-of-chess.pdf
c = 2*betaSq + sigmaSq1 + sigmaSq2
if (result == 1) {
# Player 1 wins
v = dnorm((mu1-mu2)/c)/pnorm((mu1-mu2)/c)
w = v*(v+(mu1-mu2)/c)
mu1 = mu1 + (sigmaSq1/c)*v
mu2 = mu2 - (sigmaSq2/c)*v
sigmaSq1 = sigmaSq1 * sqrt(1 - (sigmaSq1/c^2)*w)
sigmaSq2 = sigmaSq2 * sqrt(1 - (sigmaSq2/c^2)*w)
} else if (result == 0) {
# Player 2 wins
v = dnorm((mu2-mu1)/c)/pnorm((mu2-mu1)/c)
w = v*(v+(mu2-mu1)/c)
mu1 = mu1 - (sigmaSq1/c)*v
mu2 = mu2 + (sigmaSq2/c)*v
sigmaSq1 = sigmaSq1 * sqrt(1 - (sigmaSq1/c^2)*w)
sigmaSq2 = sigmaSq2 * sqrt(1 - (sigmaSq2/c^2)*w)
}
return(list(mu1=mu1, mu2=mu2, sigmaSq1=sigmaSq1, sigmaSq2=sigmaSq2))
}
predictProb <- function(mu1, sigmaSq1, mu2, sigmaSq2, betaSq) {
# Try to predict the probability of player 1 beating player 2 using Trueskill model
mean1 = mu1
mean2 = mu2
var1 = sigmaSq1 + betaSq
var2 = sigmaSq2 + betaSq
# Now the dist of player1 - player2 is N(mean1 - mean2, sqrt(var1 + var2))
prob1Wins = pnorm(0, mean2 - mean1, sqrt(var1 + var2))
return(prob1Wins)
}
I hate to post the massive code blob but I really cannot figure out where things are going wrong.
This program runs and the predicted skills (distributed to a N(mu, sigma)) converge. However the predicted probabilities they are giving are not converging to the true probabilities for the results!
A sample output is:
[1] "Mean p1: 0.0762161"
[1] "Mean p2: -0.0762161"
[1] "Mean results: 0.7733"
[1] "Mean predicted results: 0.631424"
Any idea what is going wrong?
The reason this didn't work is because in the 3rd line of the updateSkills function it should read
c = sqrt(2*betaSq + sigmaSq1 + sigmaSq2)
not
c = 2*betaSq + sigmaSq1 + sigmaSq2
Related
I tried to run code from https://cran.r-project.org/web/packages/MultiBD/vignettes/SIR-MCMC.pdf on my R software - they are still running but no output until now but I can run the following code on an online R compiler. This is the codes:
library(MultiBD)
data(Eyam)
Eyam
loglik_sir <- function(param, data) {
alpha <- exp(param[1]) # Rates must be non-negative
beta <- exp(param[2])
# Set-up SIR model
drates1 <- function(a, b) { 0 }
brates2 <- function(a, b) { 0 }
drates2 <- function(a, b) { alpha * b }
trans12 <- function(a, b) { beta * a * b }
sum(sapply(1:(nrow(data) - 1), # Sum across all time steps k
function(k) {
log(
dbd_prob( # Compute the transition probability matrix
t = data$time[k + 1] - data$time[k], # Time increment
a0 = data$S[k], b0 = data$I[k], # From: S(t_k), I(t_k)
drates1, brates2, drates2, trans12,
a = data$S[k + 1], B = data$S[k] + data$I[k] - data$S[k + 1],
computeMode = 4, nblocks = 80 # Compute using 4 threads
)[1, data$I[k + 1] + 1] # To: S(t_(k+1)), I(t_(k+1))
)
}))
}
logprior <- function(param) {
log_alpha <- param[1]
log_beta <- param[2]
dnorm(log_alpha, mean = 0, sd = 100, log = TRUE) +
dnorm(log_beta, mean = 0, sd = 100, log = TRUE)
}
library(MCMCpack)
alpha0 <- 3.39
beta0 <- 0.0212
post_sample <- MCMCmetrop1R(fun = function(param) { loglik_sir(param, Eyam) + logprior(param)
}, theta.init = log(c(alpha0, beta0)), mcmc = 500, burnin = 100)
plot(as.vector(post_sample[,1]), type = "l", xlab = "Iteration", ylab =
expression(log(alpha)))
plot(as.vector(post_sample[,2]), type = "l", xlab = "Iteration", ylab = expression(log(beta)))
library(ggplot2)
x = as.vector(post_sample[,1])
y = as.vector(post_sample[,2])
df <- data.frame(x, y)
ggplot(df,aes(x = x,y = y)) +
stat_density2d(aes(fill = ..level..), geom = "polygon", h = 0.26) +
scale_fill_gradient(low = "grey85", high = "grey35", guide = FALSE) +
xlab(expression(log(alpha))) +
ylab(expression(log(beta)))
quantile(exp(post_sample[,1]), probs = c(0.025,0.975))
quantile(exp(post_sample[,2]), probs = c(0.025,0.975))
I realize that this is the part of the codes that took long time to run but produce no output :
post_sample <- MCMCmetrop1R(fun = function(param) { loglik_sir(param, Eyam) + logprior(param)},
theta.init = log(c(alpha0, beta0)), mcmc = 500, burnin = 100)
I think my R software is the problem but what is it?
I'm moving some code from Matlab to R and I'm facing some difficulties in a particular case of the handle function. This is my Matlab code:
function Application_ChFun
clear;close all;clc;warning('off');
StepsYr = 10;
%% --parameters-- %%
S0 = 1;
r = 0.0;
t0 = 0;
T2 = 5;
gamma = 0.5;
kappa = 0.3;
rho = -0.6;
vBar = 0.05;
v0 = 0.04;
NoOfPaths = 5e4;
NoOfSteps = StepsYr*T2;
%% --Define model-- %%
cf = #(u,T)ChFun(u, T, kappa,vBar,gamma,rho, v0, r);
Vc = #(t,x)MktFun(cf,t,x,log(S0));
% Define bump size
bump_T = 1e-4;
bump_K = #(T)1e-4;
% Define derivatives
dC_dT = #(T,K) (Vc(T + bump_T,K) - Vc(T ,K)) / bump_T;
dC_dK = #(T,K) (Vc(T,K + bump_K(T)) - Vc(T,K - bump_K(T))) / (2 * bump_K(T));
d2C_dK2 = #(T,K) (Vc(T,K + bump_K(T)) + Vc(T,K-bump_K(T)) - 2*Vc(T,K)) / bump_K(T)^2;
t = t0;
S = S0+zeros(NoOfPaths,1);
for i = 1:NoOfSteps
if i==1
t_adj = 1/NoOfSteps;
t = t_adj;
end
% AAA perfectly matches with the R equivalent, but AAB and AAC do not.
AAA = dC_dT(t,S);
AAB = dC_dK(t,S);
AAC = d2C_dK2(t,S);
end
function value = MktFun(cf,T,x,x0)
value = CM_Proxy(cf,T,x,x0);
function value = CM_Proxy(ChF,T,K,x0)
K(K<1e-5)=1e-5;
alpha = 0.75;
c = 3e2;
N_CM = 2^12;
eta = c/N_CM;
b = pi/eta;
u = [0:N_CM-1]*eta;
lambda = 2*pi/(N_CM*eta);
i = complex(0,1);
u_new = u-(alpha+1)*i;
cf = exp(i*u_new*x0).*ChF(u_new,T);
psi = cf./(alpha^2+alpha-u.^2+i*(2*alpha+1)*u);
SimpsonW = 3+(-1).^[1:N_CM]-[1,zeros(1,N_CM-1)];
SimpsonW(N_CM) = 0;
SimpsonW(N_CM-1) = 1;
FFTFun = exp(i*b*u).*psi.*SimpsonW;
payoff = real(eta*fft(FFTFun)/3);
strike = exp(-b:lambda:b-lambda);
payoff_specific = spline(strike,payoff,K);
value = exp(-log(K)*alpha).*payoff_specific/pi;
function cf=ChFun(u, tau, kappa,vBar,gamma,rho, v0, r)
i = complex(0,1);
D_1 = sqrt(((kappa -i*rho*gamma.*u).^2+(u.^2+i*u)*gamma^2));
g = (kappa- i*rho*gamma*u-D_1)./(kappa-i*rho*gamma*u+D_1);
C = (1/gamma^2)*(1-exp(-D_1*tau))./(1-g.*exp(-D_1*tau)).*(kappa-gamma*rho*i*u-D_1);
A = i*u*r*tau + kappa*vBar*tau/gamma^2 * (kappa-gamma*rho*i*u-D_1)-2*kappa*vBar/gamma^2*log((1-g.*exp(-D_1*tau))./(1-g));
cf = exp(A + C * v0);
where MktFun is a standard function. When g=dC_dK(t,S) is called first of all bump_K(T) is evaluated and then Vc(T,K + bump_K(T)) and Vc(T,K-bump_K(T)).
In R I have the following:
Application_ChFun <- function(){
StepsYr = 10
## --parameters-- ##
S0 = 1
r = 0.0
t0 = 0
T2 = 5
gamma = 0.5
kappa = 0.3
rho = -0.6
vBar = 0.05
v0 = 0.04
NoOfPaths = 5e4
NoOfSteps = StepsYr*T2
## --Define model-- ##
cf <- function(u,T) ChFun(u,T,kappa,vBar,gamma,rho, v0, r)
Vc <- function(t,x) MktFun(cf,t,x,log(S0))
# Define bump size
bump_T = 1e-4
bump_K <- function(T) 1e-4
# Define derivatives
dC_dT <- function(T,K) (Vc(T + bump_T,K) - Vc(T ,K)) / bump_T
dC_dK <- function(T,K) (Vc(T,K + bump_K(T)) - Vc(T,K - bump_K(T))) / (2 * bump_K(T))
d2C_dK2 <- function(T,K) (Vc(T,K + bump_K(T)) + Vc(T,K - bump_K(T)) - 2*Vc(T,K)) / bump_K(T)^2
t = t0
S = S0+rep(0,NoOfPaths)
for (i in 1:NoOfSteps){
t_real = t
if (i==1){
t_adj = 1/NoOfSteps;
t = t_adj
}
# AAA perfectly matches with the R's equivalent. But AAB and AAC do not.
AAA = dC_dT(t,S)
AAB = dC_dK(t,S)
AAC = d2C_dK2(t,S)
}
}
MktFun <- function(cf,T,x,x0){
return(CM_Proxy(cf,T,x,x0))
}
CM_Proxy <- function(ChF,T,K,x0){
K[K<1e-5] = 1e-5
alpha = 0.75
c = 3e2
N_CM = 2^12
eta = c/N_CM
b = pi/eta
u = (0:(N_CM-1))*eta
lambda = 2*pi/(N_CM*eta)
i = complex(real = 0, imaginary = 1)
u_new = u - (alpha+1)*i # European call option.
cf = exp(i*u_new*x0)*ChF(u_new,T)
psi = cf/(alpha^2+alpha-u^2+i*(2*alpha+1)*u)
SimpsonW = 3+(-1)^(1:N_CM)-c(1,rep(0,N_CM-1))
SimpsonW[N_CM] = 0
SimpsonW[N_CM-1] = 1
FFTFun = exp(i*b*u)*psi*SimpsonW
payoff = Re(eta*fft(FFTFun)/3)
strike = exp(seq(-b,b-lambda,lambda))
K = as.vector(K)
payoff_specific = stinepack::stinterp(strike,payoff,K)
value = exp(-log(K)*alpha)*payoff_specific$y/pi
return(value)
}
ChFun <- function(u, tau, kappa,vBar,gamma,rho, v0, r){
i = complex(real = 0, imaginary = 1)
D_1 = sqrt(((kappa - i*rho*gamma*u)^2 + (u^2+i*u)*gamma^2))
g = (kappa - i*rho*gamma*u - D_1) / (kappa - i*rho*gamma*u + D_1)
C = (1/gamma^2)*(1-exp(-D_1*tau))/(1-g*exp(-D_1*tau))*(kappa-gamma*rho*i*u-D_1)
A = i*u*r*tau + kappa*vBar*tau/gamma^2 * (kappa-gamma*rho*i*u-D_1) +
-2*kappa*vBar/gamma^2*log((1-g*exp(-D_1*tau))/(1-g))
cf = exp(A + C * v0)
return(cf)
}
The problem is that in this case is that g=dC_dK(t,S) calls directly Vc instead of calling bump_k(T) first. Could someone please suggest a solution?
The evaluation order of functions is not necessarily inside-out (as it appears you are expected) so much as the order as needed. R tries to do things lazily, so if you include an expensive operation that is never actually referenced, it is not realized.
Take this example:
f1 <- function(a) { message("f1"); a + 1; }
f2 <- function(b) { message("f2"); f1(b) + 2; }
f3 <- function(d) { message("f3"); f2(f1(d) + 3) / f2(f1(d) + 4); }
f3(2)
# f3
# f2
# f1
# f1
# f2
# f1
# f1
# [1] 0.9
When f3 is called, the calls to f2 are the next to be evaluated. When f2 is first called (with f1(d)+3), f2 is called with the unevaluated argument. Once f2 tries to use its b, only then is it evaluated and f1 is called.
If I look at the call stack on the first call to f1, then we see:
Browse[2]> where
where 1 at #1: f1(b)
where 2 at #1: f2(f1(d) + 3)
where 3 at #1: f3(2)
showing the order of functions is f3 called first, then f2, then from there f1.
I want to implement a dynamic copula based on the GAS framework of Creal et all (2013). I'm starting with a bivariate Student's copula and considering that the updating equation for the parameter of the copula is:
where
is the score of the log density of the copula, I derive this score for the copula (like Ayala and Blazsek https://www.tandfonline.com/doi/full/10.1080/1351847X.2018.1464488?src=recsys, here there is also the copula density function):
My problem is that when I try to optimize the Maximum Likelihood parameter estimates don't converge in any way. I don't know if it is a problem related to the constraints on the parameters or if it is wrong the cycle that I inserted in the function to determine .
This is the code
loglik_t = function(param) {
dfactor = numeric()
rho = numeric()
score = numeric()
tau = cor(u_sp, u_eu, method = "kendall")
dfactor[1] = tau
tu = qt(u_sp, nu)
tv = qt(u_eu, nu)
omega = param[1]
dA = exp(param[2])
dB = exp(param[3])/(1 + exp(param[3]))
x2 = log(gamma((nu + 2)/2)) + log(gamma(nu/2)) - log(digamma((nu + 1)/2))
LL = 0
for (i in 1:length(u_sp)){
rho[i] = sin((pi/2)*dfactor[i])
#log-likelihood for observation i
x1 = -0.5*log(1 - rho[i]^2)
x3 =((-nu + 2)/2)*log(1 + (tu[i]^2+tv[i]^2-2*rho[i]*tu[i]*tv[i])/(nu*(1-rho[i]^2)))
x4 = ((-nu + 1)/2)*log(1 + tu[i]^2/nu) + ((-nu + 1)/2)*log(1 + tv[i]^2/nu)
c_t = x1 + x2 + x3 - x4
LL = LL + c_t
#GAS dynamic
x1score = rho[i]/(1 - rho[i]^2)
x2score = (nu + 2)/(rho[i]^2 - 1)
x3score = rho[i]*(tu[i]^2 + tv[i]^2) - (rho[i]^2 + 1)*tu[i]*tv[i]
x4score = tu[i]^2 + tv[i]^2 - 2*rho[i]*tu[i]*tv[i] - nu*(rho[i]^2 - 1)
score[i] = x1score + x2score*(x3score/x4score)
dfactor[i + 1] = omega + dA*score[i] + dB*rho[i]
}
return(list(LL, rho, score))
}
n = length(u_sp)
qlogL.hat = -10^10
for (i in (1:10)) {
# Initial values
start.theta = runif(3, min = 0.01, max = 0.9999)
qml.fit = optim(start.theta, fn = function(x) loglik_t(x)[[1]],
hessian = TRUE, method = "L-BFGS-B",
lower = c(-2,0.0001,0.0001),
upper = c(0.9999, 0.999, 0.9999),
control = list(trace = 1, fnscale = -1))
if (qml.fit$value > qlogL.hat) {
theta.hat = qml.fit$par
inv.J.hat = solve(-qml.fit$hessian/(n-1))
jacobian.hat = pracma:: jacobian(loglik_t1,theta.hat)
I.hat = (t(jacobian.hat) %*% jacobian.hat)/(n-1)
sd.hat = sqrt(diag(inv.J.hat %*% I.hat %*% inv.J.hat)/(n-1))
qlogL.hat = qml.fit$value
i
}
}
pval.dist.sim = function(n, sigma_x, rho, reps = 2500){
p = 5; sigma = sqrt(2)
beta = c(0.5, 0.5, 0, 0.25, 0)
mu = 10
# generate vector for pvals
pval.list = numeric(reps)
for(r in 1:reps){
# generate design matrix
X = gen_X(n = n, p = 5, rho = rho, sigma_x = sigma_x, mu = mu)
# generate the XtXinv portion of equation
XtXinv = qr.solve(crossprod(X))
sqrtXtXinv55 = sqrt(XtXinv[5,5])
y = X %*% beta + rnorm(n = n)
beta.hat = XtXinv %*% crossprod(X, y)
sE = sqrt(sum((y - X %*% beta.hat)^2)/(n-p))
t.val = beta.hat[3]/(sE * sqrtXtXinv55)
pval.list[r] = 2 * pt(-abs(t.val), df = n - p)
}
return(pval.list)
}
Above is the pval.dist simulation. I need to run this function to build my p.values to build my power curve
set.seed(3701)
# givens
p = 5; d = 2; mu = 10; sigmasqrd = 2; reps = 2500
n.list = seq(from=10, to=150, by=10)
# create a vector for the estimates of the power
est.power = numeric(length(n.list))
# create a vector for the left endpoints of the 95% CI
LB.list = numeric(length(n.list))
# create a vector for the right endpoints of the 95% CI
UB.list = numeric(length(n.list))
for(j in 1:length(n.list)){
# perform the test reps times
pvals = pval.dist.sim(n = n.list[j], sigma_x = 1.5, rho = 0.2, reps = reps )
# record the simulated estimate of the power
est.power[j] = mean(pvals<0.05)
# compute the 95% conf int
bounds = binom.test(x=sum(pvals < 0.05), n = reps, conf.level = 0.95)$conf.int[1:2]
LB.list[j] = bounds[1]
UB.list[j] = bounds[2]
}
## plot the power curve estimation
plot(n.list, est.power, t = "l", xlab = "n",ylab = "Power")
I am having the issue that my pvalues, when plugged in, are drastically low. I am getting values in the single digit percentage. What am I doing wrong?
Given two Gaussian density curves, how do I identify 'v', such that 'v' equally separate area under overlap?
The following code will create the visualisation of my problem. I am interested in calculating the area 'A' and then find the x-value 'v', which exactly splits the area in two?
# Define Gaussian parameters
mu1 = 10
sd1 = 0.9
mu2 = 12
sd2 = 0.6
# Visualise, set values
sprd = 3
xmin = min(c(mu1-sprd*sd1,mu2-sprd*sd2))
xmax = max(c(mu1+sprd*sd1,mu2+sprd*sd2))
x = seq(xmin,xmax,length.out=1000)
y1 = dnorm(x,mean=mu1,sd=sd1)
y2 = dnorm(x,mean=mu2,sd=sd2)
ymin = min(c(y1,y2))
ymax = max(c(y1,y2))
# Visualise, plot
plot(x,y1,xlim=c(xmin,xmax),ylim=c(ymin,ymax),type="l",col=2,ylab="Density(x)")
lines(x,y2,col=3)
abline(v=c(mu1,mu2),lty=2,col=c(2,3))
abline(h=0,lty=2)
legend("topleft",legend=c("N(mu1,sd1)","N(mu2,sd2)","mu1","mu2"),lty=c(1,1,2,2),col=c(2,3))
text(11,0.05,"A",cex=2)
Based on the comments on this post, I have written I have written my own proposal for a solution:
gaussIsect = function(mu1,mu2,sd1,sd2){
sd12 = sd1**2
sd22 = sd2**2
sqdi = sd12-sd22
x1 = (mu2 * sd12 - sd2*( mu1*sd2 + sd1*sqrt( (mu1-mu2)**2 + 2*sqdi * log(sd1/sd2) ) )) / sqdi
x2 = (mu2 * sd12 - sd2*( mu1*sd2 - sd1*sqrt( (mu1-mu2)**2 + 2*sqdi * log(sd1/sd2) ) )) / sqdi
return(c(x1,x2))
}
gaussSplitOlap = function(mu1,mu2,sd1,sd2){
if( mu1 > mu2 ){
tmp = c(mu1,mu2)
mu1 = tmp[2]
mu2 = tmp[1]
tmp = c(sd1,sd2)
sd1 = tmp[2]
sd2 = tmp[1]
}
isct = gaussIsect(mu1=mu1,mu2=mu2,sd1=sd1,sd2=sd2)
isct = isct[which(mu1 < isct & isct < mu2)]
a1 = 1-pnorm(isct,mean=mu1,sd=sd1)
a2 = pnorm(isct,mean=mu2,sd=sd2)
A = a1 + a2
v1 = qnorm(1-A/2,mean=mu1,sd=sd1)
v2 = qnorm(A/2,mean=mu2,sd=sd2)
results = list(isct=isct,A=A,v1=v1,v2=v2)
return(results)
}
test = gaussSplitOlap(mu1 = 10,sd1 = 0.9,mu2 = 12,sd2 = 0.6)
print(test)
The output from running this test is as follows
$isct
[1] 11.09291
$A
[1] 0.1775984
$v1
[1] 11.21337
$v2
[1] 11.19109
I would have assumed that the v1and v2 values were equal?
First solve analitycally the problem of finding the point x where it overlaps (this is deg 2 polynomial equation).
Then given this x the area is the sum of the two tails:
area = min(pnorm(x, mean = mu1, sd = sd1), 1 - pnorm(x, mean = mu1, sd = sd1)) +
min(pnorm(x, mean = mu2, sd = sd2), 1 - pnorm(x, mean = mu2, sd = sd2))
Like I said in the comment, you can to this using simple Monte Carlo simulation:
prob<-c()
med<-c()
for(i in 1:1000){
randomX<-runif(1000000,xmin,xmax)
randomY<-runif(1000000,0,0.3)
cond<-(randomY<dnorm(randomX,mean=mu1,sd=sd1) & randomY<dnorm(randomX,mean=mu2,sd=sd2))
prob<-c(prob,sum(cond)/1000000*(xmax-xmin)*0.3)
med<-c(med,median(randomX[which(cond==1)]))
}
cat("Area of A is equal to: ", mean(prob),"\n")
# Area of A is equal to: 0.1778459
cat("Value of v is equal to: ",mean(med),"\n")
# Value of v is equal to: 11.21008
plot(x,y1,xlim=c(xmin,xmax),ylim=c(ymin,ymax),type="l",col=2,ylab="Density(x)")
lines(x,y2,col=3)
abline(v=c(mu1,mu2,mean(med)),lty=2,col=c(2,3,4))
abline(h=0,lty=2)
legend("topleft",legend=c("N(mu1,sd1)","N(mu2,sd2)","mu1","mu2"),lty=c(1,1,2,2),col=c(2,3))
text(11,0.05,"A",cex=2)