In [10]:
if(!require(lattice)) { install.packages("lattice"); library(lattice) }
if(!require(mvtnorm)) { install.packages("mvtnorm"); library(mvtnorm) }
if(!require(numDeriv)) { install.packages("numDeriv"); library(numDeriv) }
if(!require(ellipse)) { install.packages("ellipse"); library(ellipse) }
if(!require(grDevices)) { install.packages("grDevices"); library(grDevices) }
if(!require(wesanderson)) { install.packages("wesanderson"); library(wesanderson) }
In [11]:
plotTrajectory <- function (start) {
current_gen = start
polygon(ellipse(0.8, centre = current_gen, level = 0.3), col = wes_palette("Royal1")[1])
segments(current_gen[1] - v1[1], current_gen[2] - v1[2],
current_gen[1] + v1[1], current_gen[2] + v1[2], lwd = 2)
segments(current_gen[1] - v2[1], current_gen[2] - v2[2],
current_gen[1] + v2[1], current_gen[2] + v2[2], lwd = 2)
points(current_gen[1], current_gen[2], pch = 19)
net_beta = c(0, 0)
for(i in 1:gen){
beta = grad(W_bar, t(current_gen))
net_beta = net_beta + beta
next_gen = current_gen + G%*%beta
arrows(current_gen[1], current_gen[2],
next_gen[1], next_gen[2], pch = 18, length = 0.14, lwd = 2.5, col = "black")
arrows(current_gen[1], current_gen[2],
current_gen[1] + beta[1]/5, current_gen[2] + beta[2]/5,
pch = 18, length = 0.14, lwd = 3, col = wes_palette("Rushmore")[3])
current_gen = next_gen
}
arrows(start[1], start[2],
start[1] + net_beta[1]/5, start[2] + net_beta[2]/5,
pch = 18, length = 0.14, lwd = 2.5, col = wes_palette("FantasticFox")[5])
# net_delta = G %*% net_beta
# arrows(start[1], start[2],
# start[1] + net_delta[1], start[2] + net_delta[2],
# pch = 18, length = 0.14, lwd = 2.5, col = 'black')
}
In [12]:
w_cov = matrix(c(1.0, 0.7,
0.7, 1.0), ncol = 2)
G = matrix(c(1.0, 0.8,
0.8, 1.0)/2, ncol = 2)
es = eigen(cov2cor(G))$values
v1 = sqrt(es[1])/1.2 * eigen(cov2cor(G))$vectors[,1]
v2 = sqrt(es[2])/1.2 * eigen(cov2cor(G))$vectors[,2]
gen = 8 # Número de gerações
step = 0.1 # Resolução da superfície
mypalette = colorRampPalette(c(wes_palette(10, name = "Zissou", type = "continuous"), "darkred"))
In [13]:
#################################
# Multiple Peaks
#################################
W_bar = function(x) {
log(
dmvnorm(x, mean = c(4, 5), sigma = w_cov) +
1.1*dmvnorm(x, mean = c(1, 5), sigma = w_cov) +
dmvnorm(x, mean = c(2, 2), sigma = w_cov) +
dmvnorm(x, mean = c(7, 5), sigma = w_cov) +
dmvnorm(x, mean = c(5, 2), sigma = w_cov))
}
x <- seq(-1.5, 8.5, step) ## valores para mu
y <- seq(-1.5, 8.5, step)
X <- as.matrix(expand.grid(x, y))
Z <- vector()
for(i in 1:nrow(X)){
Z[i] <- W_bar(c(X[i,1], X[i,2]))
}
Z = exp(Z - log(sum(exp(Z))))
b <- matrix(Z, length(x))
filled.contour(x, y, z = b, color.palette = mypalette,
plot.axes = {
axis(1);
axis(2);
plotTrajectory(c( 1.8,4.03))
plotTrajectory(c(0.25,0.25))
plotTrajectory(c(5 ,4 ))
})