I have overlayed two contour plots:
library(plotly)
cluster_count <- 5
volcan <- plot_ly(z = ~volcano,
type = "contour",
contours = list(
coloring= "fill",
showlines = F
))
cluster_matrix <- volcano
cluster_matrix[cluster_matrix < 100] <- 1
cluster_matrix[cluster_matrix <= 120 & cluster_matrix >= 100] <- 2
cluster_matrix[cluster_matrix < 140 & cluster_matrix >= 120] <- 3
cluster_matrix[cluster_matrix <= 160 & cluster_matrix >= 140] <- 4
cluster_matrix[cluster_matrix > 160] <- 5
cluster_name_matrix <- cluster_matrix
cluster_name_matrix[cluster_matrix ==1] <- "Eins"
cluster_name_matrix[cluster_matrix ==2] <- "Zwei"
cluster_name_matrix[cluster_matrix ==3] <- "Drei"
cluster_name_matrix[cluster_matrix ==4] <- "Vier"
cluster_name_matrix[cluster_matrix ==5] <- "Funf"
volcan %>% add_contour(cluster_matrix,
type = "contour",
opacity =1,
text=cluster_name_matrix,
hovertemplate = 'Cluster: %{text}<extra></extra>',
autocontour = F,
line=list(color="orange"),
contours = list(
start = 1,
showlabels = T,
coloring= "lines",
end = cluster_count,
size = 1,
showlines = T
))
Is it possible to have a plot like this:
Like I did for the hovering text? Thanks for tips and suggestions in advance!
What you've been looking for is the add_annotations() function. In the code below, I write a function that retrieves a random coordinate pair for each level and then passes the corresponding coordinates to the add_annotations() function. Note that I stored your contour plot in the variable p:
library(purrr)
# Custom function
find_rand_annotation_index <- function(name_matrix, string){
d <- which(name_matrix == string, arr.ind = TRUE)
d2 <- as.data.frame(d[sample(nrow(d), size = 1), , drop = FALSE])
cbind(d2, string)
}
# Get 5 random coordinates to plot the labels
text_coords <- purrr::map_dfr(c("Eins", "Zwei", "Drei", "Vier", "Funf"), ~ find_rand_annotation_index(cluster_name_matrix, .x))
# Plot the annotations on the contour plot
p %>%
add_annotations(
x = text_coords$col,
y = text_coords$row,
text = text_coords$string,
font = list(color = "IndianRed"),
showarrow = F
)
The positioning of the labels may not be to your liking (because the coordinates are chosen randomly), but you may want to do something about it in your code.
I have tried to plot a simple graph using the following code;
plot(y = Et, x = t, type = "l", col = 1,
xlab = "Time", ylab= "Equity ($)",
main = "Figure 1–3: Randomly Generated Equity Curves")
grid()
abline(h = 10000)
lines(y = Et2, x = t, col = 2)
lines(y = Eb, x = t, col = 8)
Then I try to add a legend to the plot
legend(x = "topleft", col = c(1,2,8), lwd = 2, legend = c("Curve 1",
"Curve 2",
"SPY"))
And the result I obtain is the following;
Where am I going wrong?
EDIT 1: I restarted R studio and re-ran the plots and got the following result.
EDIT 2: Reproducible code:
library(quantmod)
options("getSymbols.warning4.0" = FALSE,
"getSymbols.auto.assign" = FALSE)
SPY <- getSymbols(c("SPY"), from = "2016-09-01")
SPY <- as.numeric(SPY$SPY.Close)
set.seed(123)
#create a time index
t <- 1:(length(SPY)-1)
#tradable capital vector
Vt <- c(rep(10000, length(t)))
#Benchmark return series
Rb <- rep(NA, length(t))
for(i in 2:length(t)) {
Rb[i] <- (SPY[i] / SPY[i - 1]) - 1
}
#Benchmark equity curve
Eb <- rep(NA, length(t))
Eb[1] <- Vt[1]
for(i in 2:length(t)) {
Eb[i] <- Eb[i - 1] * (1 + Rb[i])
}
#Randomy simulated return series 1
Rt <- rep(NA, length(t))
for(i in 2:length(t)) {
Rt[i] <- Rb[i] + rnorm(n = 1,
mean = 0.24/length(t),
sd = 2.5 * sd(Rb, na.rm = TRUE))
}
#Randomly simulated return series 2
Rt2 <- rep(NA, length(t))
for(i in 2:length(t)) {
Rt2[i] <- Rb[i] + rnorm(n = 1,
mean = 0.02/length(t),
sd = 0.75 * sd(Rb, na.rm = TRUE))
}
# Randomly Simulated Equity Curve 1
Et <- rep(NA, length(t))
Et <- Vt[1]
for(i in 2:length(t)) {
Et[i] <- Et[i-1] * (1 + Rt[i])
}
# Randomly Simulated Equity Curve 2
Et2 <- rep(NA, length(t))
Et2 <- Vt[1]
for(i in 2:length(t)) {
Et2[i] <- Et2[i-1] * (1 + Rt2[i])
}
#Plot of Et1 against the SPY Portfolio
plot(y = Et, x = t, type = "l", col = 1,
xlab = "Time", ylab= "Equity ($)",
main = "Figure 1-3: Randomly Generated Equity Curves")
grid()
abline(h = 10000)
lines(y = Et2, x = t, col = 2)
lines(y = Eb, x = t, col = 8)
legend(x = "topleft", col = c(1,2,8), lwd = 2, legend = c("Curve 1",
"Curve 2",
"SPY"))
The above code is what I have ran in order to produce the graphs above. If you are able to run it and get the same error let me know.
I just need help for the first loop! I would like to run the loop for each certain value of m (see first line in code) but its running only for 1:10? The outcome shoud be stored in the last rows msediff1 to msediff100! Also i need the graphics for each value of m!Thanks in advance!
m = c(1,2,3,4,5,6,7,8,9,10,25,50,100)
for (m in 1:length(unique(m))){
n <- 150
x1 <- rnorm(n = n, mean = 10, sd = 4)
R <- 100 # Number of reps
results.true <- matrix(NA , ncol = 2, nrow = R)
colnames(results.true) <- c("beta0.hat", "beta1.hat")
results.diff <- matrix(NA, ncol = 2, nrow = R)
colnames(results.diff) <- c("beta0.hat", "betadiff.hat")
sigma <- 1.2
beta <- c(1.2)
X <- cbind(x1)
if (m==1){d0 <- .7071; d <- c(-.7071)}
if (m==2){d0 = .8090; d = c(-.5,-.309)}
if (m==3){d0 = .8582; d = c(-.3832,-.2809,-.1942) }
if (m==4){d0 = .8873; d = c(-.3090,-.2464,-.1901,-.1409)}
if (m==5){d0 <- .9064; d <- c(-.2600,-.2167,-.1774,-.1420,-.1103)}
if (m==6){d0 = .92; d = c(-.2238,-.1925,-.1635,-.1369,-.1126,-.0906)}
if (m==7){d0 = .9302; d = c(-.1965,-.1728,-.1506,-.1299,-.1107,-.093,-.0768)}
if (m==8){d0 = .9380; d = c(-.1751,-.1565,-.1389,-.1224,-.1069,-.0925,-.0791,-.0666)}
if (m==9){d0 = .9443; d = c(-.1578,-.1429,-.1287,-.1152,-.1025,-.0905,-.0792,-.0687,-.0538)}
if (m==10){d0 <- .9494;
d <- c(-.1437, -.1314, -.1197, -.1085, -.0978, -.0877, -.0782, -.0691, -.0606, -.0527)}
if (m==25){d0 <- 0.97873;
d <- c(-0.06128, -0.05915, -0.05705, -0.05500, -0.05298, -0.05100, -0.04906, -0.04715, -0.04528, -0.04345, -0.04166, -0.03990, -0.03818, -0.03650, -0.03486, -0.03325, -0.03168, -0.03015, -0.02865, -0.02719,
-0.02577, -0.02438, -0.02303, -0.02171, -0.02043) }
if (m==50) {d0 <- 0.98918;
d <- c(-0.03132, -0.03077, -0.03023, -0.02969, -0.02916, -0.02863, -0.02811, -0.02759, -0.02708, -0.02657, -0.02606, -0.02556, -0.02507, -0.02458, -0.02409, -0.02361, -0.02314, -0.02266, -0.02220, -0.02174, -0.02128, -0.02083, -0.02038, -0.01994, -0.01950, -0.01907, -0.01864, -0.01822, -0.01780, -0.01739,-0.01698,-0.01658,-0.01618,-0.01578,-0.01539,-0.01501,-0.01463,-0.01425,-0.01388,-0.01352,
-0.01316,-0.01280,-0.01245,-0.01210,-0.01176,-0.01142,-0.01108,-0.01075,-0.01043,-0.01011) }
if (m==100) { d0 <- 0.99454083;
d <- c(-0.01583636,-0.01569757,-0.01555936,-0.01542178,-0.01528478,-0.01514841,-0.01501262,-0.01487745,-0.01474289,-0.01460892,
-0.01447556,-0.01434282,-0.01421067,-0.01407914,-0.01394819,-0.01381786,-0.01368816,-0.01355903,-0.01343053,-0.01330264,
-0.01317535,-0.01304868,-0.01292260,-0.01279714,-0.01267228,-0.01254803,-0.01242439,-0.01230136,-0.01217894,-0.01205713,
-0.01193592,-0.01181533,-0.01169534,-0.01157596,-0.01145719,-0.01133903,-0.01122148,-0.01110453,-0.01098819,-0.01087247,
-0.01075735,-0.01064283,-0.01052892,-0.01041563,-0.01030293,-0.01019085,-0.01007937,-0.00996850,-0.00985823,-0.00974857,
-0.00963952,-0.00953107,-0.00942322,-0.00931598,-0.00920935,-0.00910332,-0.00899789,-0.00889306,-0.00878884,-0.00868522,
-0.00858220,-0.00847978,-0.00837797,-0.00827675,-0.00817614,-0.00807612,-0.00797670,-0.00787788,-0.00777966,-0.00768203,
-0.00758500,-0.00748857,-0.00739273,-0.00729749,-0.00720284,-0.00710878,-0.00701532,-0.00692245,-0.00683017,-0.00673848,
-0.00664738,-0.00655687,-0.00646694,-0.00637761,-0.00628886,-0.00620070,-0.00611312,-0.00602612,-0.00593971,-0.00585389,
-0.00576864,-0.00568397,-0.00559989,-0.00551638,-0.00543345,-0.00535110,-0.00526933,-0.00518813,-0.00510750,-0.00502745) }
for(r in 1:R){
u <- rnorm(n = n, mean = 0, sd = sigma)
y <- X%*%beta + u
yy = d0* y[(m+1):n]; Xd <- d0* x1[(m+1):n];
for (i in 1:m) { yy <- yy + d[i]* y[(m+1-i):(n-i) ]
Xd = Xd + d[i]* x1[(m+1-i):(n-i)] }
reg.true <- lm(y ~ x1)
reg.diff <- lm(yy ~ Xd)
results.true[r, ] <- coef(reg.true)
results.diff[r, ] <- coef(reg.diff)
}
results.true
results.diff
beta
apply(results.true, MARGIN = 2, FUN = mean)
apply(results.diff, MARGIN = 2, FUN = mean)
co <- 2
dens.true <- density(results.true[, co])
dens.diff <- density(results.diff[, co])
win.graph()
plot(dens.true,
xlim = range(c(results.true[, co], results.diff[, co])),
ylim = range(c(dens.true$y, dens.diff$yy)),
main = "beta estimation true vs. diff", lwd = 2,)
lines(density(results.diff[, co]), col = "red", lwd = 2)
abline(v = beta, col = "blue", lwd = 2)
legend(x=1.24,y=12,c("outcome true","outcome diff"),lty=c(1,1),col =c("black","red") )
legend(x=1.12,y=12,c("m=",m))
#Mean Squared Error
mse=mean(reg.true$residuals^2)
if (m==1) {msediff1=mean(reg.diff$residuals^2)}
if (m==2) {msediff2=mean(reg.diff$residuals^2)}
if (m==3) {msediff3=mean(reg.diff$residuals^2)}
if (m==4) {msediff4=mean(reg.diff$residuals^2)}
if (m==5) {msediff5=mean(reg.diff$residuals^2)}
if (m==6) {msediff6=mean(reg.diff$residuals^2)}
if (m==7) {msediff7=mean(reg.diff$residuals^2)}
if (m==8) {msediff8=mean(reg.diff$residuals^2)}
if (m==9) {msediff9=mean(reg.diff$residuals^2)}
if (m==10) {msediff10=mean(reg.diff$residuals^2)}
if (m==25) {msediff25=mean(reg.diff$residuals^2)}
if (m==50) {msediff50=mean(reg.diff$residuals^2)}
if (m==100) {msediff100=mean(reg.diff$residuals^2)}
}
I can see an error in the code.
m = c(1,2,3,4,5,6,7,8,9,10,25,50,100)
for (m in 1:length(unique(m))){
As soon as the loop starts, m is changed. It's not what's in the first line anymore...
Try, for (ind in 1:length(unique(m))){ if that's not the intention.
I was wondering how to make the numbers currently plotted on the curve line below to move a bit outward such that however a and b in my R code are changed the distance between the numbers and the curve line remain the same (i.e., constant)?
Please see my R code below the following image:
a = 0 ; b = 1
curve( dnorm(x, mean = a, sd = b ), -4, 4, axes = F, ann = F)
xx <- -4:4
yy <- dnorm(xx, mean = a, sd = b)
text(xx, yy, paste(round(yy, 2) ), font = 2 )
As other colleagues also mentioned, the calculation of this distance can be taken care of by text() itself. One of the most suitable arguments in text() for this purpose is pos. Per R documentation pos takes 4 integer values, each of which move the text in one one of the 4 main directions: see ?text. In this case, 3 produces the desired effect.
Thus, the following might resolve the problem:
a = 0 ; b = 1
curve( dnorm(x, mean = a, sd = b ), -4, 4, axes = F, ann = F)
xx <- -4:4
yy <- dnorm(xx, mean = a, sd = b)
text(xx, yy, paste(round(yy, 2) ), font = 2, pos = 3 )
a = 0
b = 1
#Draw curve
curve(dnorm(x, mean = a, sd = b ), -4, 4, axes = F, ann = F)
#Assign curve to 'cc' and determine the length of points on the curve
cc = curve(dnorm(x, mean = a, sd = b ), -4, 4, axes = F, ann = F)
l_cc = length(cc$x)
xx <- -4:4
yy <- dnorm(xx, mean = a, sd = b)
#Find indices of values in cc$x closest ot xx
slope_inds = findInterval(xx, cc$x)
#Calculate approximate slope of cc for each xx
slope = numeric(0)
for (i in 1:length(slope_inds)){
if (slope_inds[i] == 1){
n = 1
}else if (slope_inds[i] == l_cc){
n = l_cc - 1
}else{
n = slope_inds[i]
}
slope[i] = round(diff(cc$y[n:(n+1)])/diff(cc$x[n:(n+1)]), 1)
}
#Assign pos value based on slope of cc. For ~zero slope, put text on top
# For other slopes assign values accordingly
positions = integer(0)
positions[slope == 0] = 3
positions[slope > 0] = 2
positions[slope < 0] = 4
#Write text
points(xx,yy)
text(xx, yy, paste(round(yy, 2) ), font = 2, pos = positions)
Anyone know of a non-raster method to achieve the following?
require(raster)
d = data.frame(rasterToPoints(raster(volcano)))
head(d)
x y layer
1 0.008196721 0.9942529 100
2 0.024590164 0.9942529 100
3 0.040983607 0.9942529 101
4 0.057377049 0.9942529 101
5 0.073770492 0.9942529 101
6 0.090163934 0.9942529 101
Cheers.
One way would be to use the row and col command:
library(raster)
data(volcano)
df <- data.frame(
x = as.vector(col(volcano)),
y = (yy <- as.vector(row(volcano)))[length(yy):1],
val = as.vector(volcano)
)
raster rescales the range to 0 - 1, if not specified differently, so we would to have to do this too:
## rescale
df$x <- with(df, (x - min(x)) / (max(x) - min(x)))
df$y <- with(df, (y - min(x)) / (max(y) - min(y)))
Finally lets check, that the results are the same:
## Using raster df1 <- data.frame(rasterToPoints(raster(volcano)))
cols <- colorRampPalette(c('white', "blue",'red')) df$col <-
cols(20)[as.numeric(cut(df$val, breaks = 20))] df1$col <-
cols(20)[as.numeric(cut(df1$layer, breaks = 20))]
par(mfrow = c(1, 2)) plot(df[, 1:2], col = df$col, pch = 20, main =
"matrix")
plot(df1[, 1:2], col = df1$col, pch = 20, main = "raster")
Note:
While the results appear the same visually, they are not. The resolution of the raster command is most likely different, and hence there are different nrows for df and df1.
Faster for large matrices:
data.frame(
x = rep(1:ncol(m), each=nrow(m)),
y = rep(nrow(m):1, ncol(m)),
val = as.vector(m)
)