Related
I am giving a tutorial on MLE and am trying to figure out how to add a static grouping of points to a plotly graph. Obviously the idea is that as I slide the normal distributions over you can see that the points correspond to a lower or higher likeihood. However, I can only get the points to appear on the first frame.
x <- seq(0, 10, length.out = 1000)
aval <- list()
for (step in 1:6) {
aval[[step]] <- list(
visible = FALSE,
name = paste0('v = ', step),
x = x,
y = dnorm(x, step+1)
)
}
aval[3][[1]]$visible = TRUE
steps <- list()
fig <- plot_ly()
for (i in 1:6) {
fig <-
add_lines(
fig,
x = aval[i][[1]]$x,
y = aval[i][[1]]$y,
visible = aval[i][[1]]$visible,
name = aval[i][[1]]$name,
type = 'scatter',
mode = 'lines',
hoverinfo = 'name',
line = list(color = '00CED1'),
showlegend = FALSE
)
step <- list(args = list('visible', rep(FALSE, length(aval))),method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
}
fig <- fig %>% add_markers(x = c(4.5,5,5.5), y = c(0,0,0))
# add slider control to plot
fig <- fig %>%
layout(sliders = list(list(
active = 0,
currentvalue = list(prefix = "Frequency: "),
steps = steps
)))
fig
Why don't you use plotly's animation capabilities?
But regardless of whether you define custom steps or you use the frame parameter, you'll have to provide the "static" points for each step:
library(plotly)
library(data.table)
f <- 1:6
x <- seq(0, 10, length.out = 1000)
y <- unlist(lapply(f+1, dnorm, x = x))
DT <- CJ(f, x) # like expand.grid()
DT[, y := y]
DT[, step := paste0("step-", f)]
staticDT <- CJ(f, x = c(4.5,5,5.5), y = 0)
staticDT[, step := paste0("step-", f)]
fig <- plot_ly(
data = DT,
x = ~x,
y = ~y,
frame = ~step,
type = 'scatter',
mode = 'lines',
showlegend = FALSE,
color = I('#00CED1')
)
fig <- add_trace(
fig,
data = staticDT,
x = ~x,
y = ~y,
frame = ~step,
type = 'scatter',
mode = 'markers',
showlegend = FALSE,
color = I('red'),
inherit = FALSE
)
fig <- animation_opts(
fig, transition = 0, redraw = FALSE
)
fig <- animation_slider(
fig, currentvalue = list(prefix = "Frequency: ")
)
fig
I am trying to add a second category to x axis with Plotly under R like this:
Here is my code:
library(plotly)
data <- data.frame(day= c(1:4),
visit = c("visit1","visit1", "visit2", "visit2"),
val = c(1:4),
flag = c("","","", 1))
fig <- plot_ly(data= data, x = ~day) %>%
add_trace(y = ~val,
type = 'scatter',
mode = 'lines+markers',
line = list(width = 2,
dash = 'solid')) %>%
add_trace(data= data %>% filter(flag == 1), y = 0,
type = 'scatter',
hoverinfo = "text",
mode = 'markers',
name = "flag",
text = paste("<br>N°",data$ID[data$flag == 1],
"<br>Day",data$day[data$flag == 1]),
marker = list(
color = 'red',
symbol = "x",
size = 12
),
showlegend = T
)
fig
I have tried this, which seems good but the markers disappear from the graph, maybe due to the filter on data.
library(plotly)
data <- data.frame(day= c(1:4),
visit = c("visit1","visit1", "visit2", "visit2"),
val = c(1:4),
flag = c("","","", 1))
fig <- plot_ly(data= data, x = ~list(visit,day)) %>%
add_trace(y = ~val,
type = 'scatter',
mode = 'lines+markers',
line = list(width = 2,
dash = 'solid')) %>%
add_trace(data= data %>% filter(flag == 1), y = 0,
type = 'scatter',
hoverinfo = "text",
mode = 'markers',
name = "flag",
text = paste("<br>N°",data$ID[data$flag == 1],
"<br>Day",data$day[data$flag == 1]),
marker = list(
color = 'red',
symbol = "x",
size = 12
),
showlegend = T
)
fig
You didn't provide a reproducible question, so I've made data. (Well, data I shamelessly stole from here). This creates a bar graph with two sets of x-axis labels. One for each set of bars. One for each group of bars. The content of the x-axis is the same in both traces.
library(plotly)
fig <- plot_ly() %>%
add_bars(x = list(rep(c("first", "second"), each = 2),
rep(LETTERS[1:2], 2)),
y = c(2, 5, 2, 6),
name = "Adults") %>%
add_bars(x = list(rep(c("first", "second"), each = 2),
rep(LETTERS[1:2], 2)),
y = c(1, 4, 3, 6),
name = "Children")
fig
Update
You added data and code trying to apply this to your data. I added an update and apparently missed what the problem was. Sorry about that.
Now that I'm paying attention (let's hope, right?), here is an actual fix to the actual problem.
For this change, I modified your data. Instead of the flag annotated with a one, I changed it to zero. Then I used flag as a variable.
data <- data.frame(day = c(1:4),
visit = c("visit1","visit1", "visit2", "visit2"),
val = c(1:4),
flag = c("","","", 0))
fig <- plot_ly(data= data, x = ~list(visit,day)) %>%
add_trace(y = ~val,
type = 'scatter', mode = 'lines+markers',
line = list(width = 2,
dash = 'solid')) %>%
add_trace(y = ~flag,
type = 'scatter', hoverinfo = "text",
mode = 'markers', name = "flag",
text = paste("<br>N°",data$ID[data$flag == 1],
"<br>Day",data$day[data$flag == 1]),
marker = list(
color = 'red', symbol = "x", size = 12),
showlegend = T)
fig
You're going to get a warning about discrete & non-discrete data, which isn't really accurate, but it shows up, nonetheless.
I am using the R programming language. I trying to learn how to customize hover text in 3d plotly objects as seen here: https://rstudio-pubs-static.s3.amazonaws.com/441420_9a7c15988f3c4f59b2d828eb87ba1634.html
Recently, I have learned how to create a 3d plotly object for some data that I simulated :
library(Rtsne)
library(dplyr)
library(ggplot2)
library(plotly)
library(caret)
library(randomForest)
#data
a = iris
a <- unique(a)
#create two species just to make things easier
s <- c("a","b")
species<- sample(s , 149, replace=TRUE, prob=c(0.3, 0.7))
a$species = species
a$species = as.factor(a$species)
#split data into train/test, and then random forest
index = createDataPartition(a$species, p=0.7, list = FALSE)
train = a[index,]
test = a[-index,]
rf = randomForest(species ~ ., data=train, ntree=50, mtry=2)
#have the model predict the test set
pred = predict(rf, test, type = "prob")
labels = as.factor(ifelse(pred[,2]>0.5, "a", "b"))
confusionMatrix(labels, test$species)
#tsne algorithm
tsne_obj_3 <- Rtsne(test[,-5], perplexity=1, dims=3)
df_m2 <- as.data.frame(tsne_obj_3$Y)
df_m2$labels = test$species
df_m2$color = ifelse(df_m2$labels == "a", "red","blue")
df_m2$petal_length = test$Petal.Length
axis_1 = df_m2$V1
axis_2 = df_m2$V2
axis_3 = df_m2$V3
plot_ly(x=as.vector(axis_1),
y=as.vector(axis_2),
z=axis_3,
type="scatter3d",
mode="markers",
name = "Obs",
marker = list(size = 3)) %>%
add_mesh(x=as.vector(axis_1),
y=as.vector(axis_2),
z=df_m2$pred,
type = "mesh3d",
name = "Preds")
Now, I am trying to customize this plotly object so that different labels appear when you move the mouse over each point, and points corresponding to a given class all have the same color:
p <- plot_ly(type = 'scatter3d', mode = 'markers', colors = "Accent", color = df_m2$color) %>%
add_trace(
x = df_m2$V1,
y = df_m2$V2,
z = df_m2$V3,
marker = list(
size = 3),
name = df_m2$labels,
text = paste("Species: ", df_m2$labels ; "Width: ", df_m2$petal.width ; "color: ", df_m2$color" ),
showlegend = T
) %>%
add_mesh(x=as.vector(axis_1),
y=as.vector(axis_2),
z=df_m2$pred,
type = "mesh3d",
name = "Preds")
%>%
layout(
title = "none",
titlefont = list(
size = 10
),
paper_bgcolor = "#fffff8",
font = t,
xaxis = list(
zeroline = F
),
yaxis = list(
hoverformat = '.2f',
zeroline = F
)
)
p
However, there is an error here. Can someone please show me what I am doing wrong?
Thanks
Not sure what exactly you want to do with the predicted classes, but maybe something like this? (Color corresponds to real species, mouseover also shows prediction).
library(reprex)
reprex({
suppressPackageStartupMessages(invisible(
lapply(c("Rtsne", "dplyr", "ggplot2", "plotly", "caret", "randomForest"),
require, character.only = TRUE)))
#data
a <- unique(iris)
#create two species just to make things easier
set.seed(123)
a$species <- factor(sample(c("a", "b"), 149, replace=TRUE, prob=c(0.3, 0.7)))
#split data into train/test, and then random forest
index = createDataPartition(a$species, p=0.7, list = FALSE)
train = a[index,]
test = a[-index,]
rf <- randomForest(species ~ ., data=train, mtry=2)
#have the model predict the test set
pred <- predict(rf, test, type = "prob")
labels <- predict(rf, test)
confusionMatrix(labels, test$species)
#tsne algorithm
tsne_obj_3 <- Rtsne(test[,-5], perplexity=1, dims=3)
df_m2 <- as.data.frame(tsne_obj_3$Y)
df_m2$labels = toupper(test$species)
df_m2$pred <- labels # you did not define but call pred in plot_ly call
df_m2$color = ifelse(df_m2$labels == "A", "red", "blue")
df_m2$petal_length = test$Petal.Length
axis_1 <- df_m2$V1
axis_2 <- df_m2$V2
axis_3 <- df_m2$V3
plot_ly(type = 'scatter3d', mode = 'markers', colors = c("blue", "red"),
color = df_m2$color) %>%
add_trace(
x = df_m2$V1,
y = df_m2$V2,
z = df_m2$V3,
marker = list(size = 3),
name = df_m2$pred,
text = paste0("Species: ", df_m2$labels, "; Length: ",df_m2$petal_length, "; color: ", df_m2$color),
showlegend = TRUE) %>%
add_mesh(x=as.vector(axis_1),
y=as.vector(axis_2),
z=axis_3, # not sure what z you want here
type = "mesh3d",
name = "Preds") %>%
layout(
title = "none",
titlefont = list(size = 10),
paper_bgcolor = "#fffff8",
font = "Open Sans",
xaxis = list(zeroline = FALSE),
yaxis = list(hoverformat = '.2f', zeroline = FALSE)
)
I am trying to generate multiple graphs in Plotly for 30 different sales offices. Each graph would have 3 lines: sales, COGS, and inventory. I would like to keep this on one graph with 30 buttons for the different offices. This is the closest solution I could find on SO:
## Create random data. cols holds the parameter that should be switched
l <- lapply(1:100, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:100)
colnames(df) <- cols
df[["c"]] <- 1:100
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
type = "scatter",
mode = "lines",
x = ~c,
y= ~df[[cols[[1]]]],
name = cols[[1]])
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[-1]) {
p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = FALSE)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(cols, function(col) {
list(method="restyle",
args = list("visible", cols == col),
label = col)
})
)
)
)
print(p)
It works but only on graphs with single lines/traces. How can I modify this code to do the same thing but with graphs with 2 or more traces? or is there a better solution? Any help would be appreciated!
### EXAMPLE 2
#create fake time series data
library(plotly)
set.seed(1)
df <- data.frame(replicate(31,sample(200:500,24,rep=TRUE)))
cols <- paste0(letters, 1:31)
colnames(df) <- cols
#create time series
timeseries <- ts(df[[1]], start = c(2018,1), end = c(2019,12), frequency = 12)
fit <- auto.arima(timeseries, d=1, D=1, stepwise =FALSE, approximation = FALSE)
fore <- forecast(fit, h = 12, level = c(80, 95))
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly() %>%
add_lines(x = time(timeseries), y = timeseries,
color = I("black"), name = "observed") %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 2], ymax = fore$upper[, 2],
color = I("gray95"), name = "95% confidence") %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 1], ymax = fore$upper[, 1],
color = I("gray80"), name = "80% confidence") %>%
add_lines(x = time(fore$mean), y = fore$mean, color = I("blue"), name = "prediction")
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[2:31]) {
timeseries <- ts(df[[col]], start = c(2018,1), end = c(2019,12), frequency = 12)
fit <- auto.arima(timeseries, d=1, D=1, stepwise =FALSE, approximation = FALSE)
fore <- forecast(fit, h = 12, level = c(80, 95))
p <- p %>%
add_lines(x = time(timeseries), y = timeseries,
color = I("black"), name = "observed", visible = FALSE) %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 2], ymax = fore$upper[, 2],
color = I("gray95"), name = "95% confidence", visible = FALSE) %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 1], ymax = fore$upper[, 1],
color = I("gray80"), name = "80% confidence", visible = FALSE) %>%
add_lines(x = time(fore$mean), y = fore$mean, color = I("blue"), name = "prediction", visible = FALSE)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(cols, function(col) {
list(method="restyle",
args = list("visible", cols == col),
label = col)
})
)
)
)
p
You were very close!
If for example you want graphs with 3 traces,
You only need to tweak two things:
Set visible the three first traces,
Modify buttons to show traces in groups of three.
My code:
## Create random data. cols holds the parameter that should be switched
library(plotly)
l <- lapply(1:99, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:99)
colnames(df) <- cols
df[["c"]] <- 1:100
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
type = "scatter",
mode = "lines",
x = ~c,
y= ~df[[cols[[1]]]],
name = cols[[1]])
p <- p %>% add_lines(x = ~c, y = df[[2]], name = cols[[2]], visible = T)
p <- p %>% add_lines(x = ~c, y = df[[3]], name = cols[[3]], visible = T)
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[4:99]) {
print(col)
p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = F)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(0:32, function(col) {
list(method="restyle",
args = list("visible", cols == c(cols[col*3+1],cols[col*3+2],cols[col*3+3])),
label = paste0(cols[col*3+1], " ",cols[col*3+2], " ",cols[col*3+3] ))
})
)
)
)
print(p)
PD: I only use 99 cols because I want 33 groups of 3 graphs
I tried to run this code and it seems to produce no errors but at the end I don't get the plot for some reason. I had some issues with the variables for the plot but i think that should be fixed now. I can't get the plot in my viewer. Is there an issue with the code or should I reinstall plotly?
library(PortfolioAnalytics)
library(quantmod)
library(PerformanceAnalytics)
library(zoo)
library(plotly)
library(foreach)
library(DEoptim)
library(iterators)
library(fGarch)
library(Rglpk)
library(quadprog)
library(ROI)
library(ROI.plugin.glpk)
library(ROI.plugin.quadprog)
library(ROI.plugin.symphony)
library(pso)
library(GenSA)
library(corpcor)
library(testthat)
library(nloptr)
library(MASS)
library(robustbase)
# Get data
getSymbols(c("MSFT", "SBUX", "IBM", "AAPL", "^GSPC", "AMZN"))
# Assign to dataframe
# Get adjusted prices
prices.data <- merge.zoo(MSFT[,6], SBUX[,6], IBM[,6], AAPL[,6], GSPC[,6], AMZN[,6])
# Calculate returns
returns.data <- CalculateReturns(prices.data)
returns.data <- na.omit(returns.data)
# Set names
colnames(returns.data) <- c("MSFT", "SBUX", "IBM", "AAPL", "^GSPC", "AMZN")
# Save mean return vector and sample covariance matrix
meanReturns <- colMeans(returns.data)
covMat <- cov(returns.data)
# Start with the names of the assets
port <- portfolio.spec(assets = c("MSFT", "SBUX", "IBM", "AAPL", "^GSPC", "AMZN"))
# Box
port <- add.constraint(port, type = "box", min = 0.05, max = 0.8)
# Leverage
port <- add.constraint(portfolio = port, type = "full_investment")
# Generate random portfolios
rportfolios <- random_portfolios(port, permutations = 5000, rp_method = "sample")
# Get minimum variance portfolio
minvar.port <- add.objective(port, type = "Risk", name = "var")
# Optimize
minvar.opt <- optimize.portfolio(returns.data, minvar.port, optimize_method = "random",
rp = rportfolios)
# Generate maximum return portfolio
maxret.port <- add.objective(port, type = "Return", name = "mean")
# Optimize
maxret.opt <- optimize.portfolio(returns.data, maxret.port, optimize_method = "random",
rp = rportfolios)
# Generate vector of returns
minret <- 0.06/100
maxret <- maxret.opt$weights %*% meanReturns
vec <- seq(minret, maxret, length.out = 100)
eff.frontier <- data.frame(Risk = rep(NA, length(vec)),
Return = rep(NA, length(vec)),
SharpeRatio = rep(NA, length(vec)))
frontier.weights <- mat.or.vec(nr = length(vec), nc = ncol(returns.data))
colnames(frontier.weights) <- colnames(returns.data)
for(i in 1:length(vec)){
eff.port <- add.constraint(port, type = "Return", name = "mean", return_target = vec[i])
eff.port <- add.objective(eff.port, type = "Risk", name = "var")
# eff.port <- add.objective(eff.port, type = "weight_concentration", name = "HHI",
# conc_aversion = 0.001)
eff.port <- optimize.portfolio(returns.data, eff.port, optimize_method = "ROI")
eff.frontier$Risk[i] <- sqrt(t(eff.port$weights) %*% covMat %*% eff.port$weights)
eff.frontier$Return[i] <- eff.port$weights %*% meanReturns
eff.frontier$Sharperatio[i] <- eff.port$Return[i] / eff.port$Risk[i]
frontier.weights[i,] = eff.port$weights
print(paste(round(i/length(vec) * 100, 0), "% done..."))
}
feasible.sd <- apply(rportfolios, 1, function(x){
return(sqrt(matrix(x, nrow = 1) %*% covMat %*% matrix(x, ncol = 1)))
})
feasible.means <- apply(rportfolios, 1, function(x){
return(x %*% meanReturns)
})
feasible.sr <- feasible.means / feasible.sd
p <- plot_ly(x = feasible.sd, y = feasible.means, color = feasible.sr,
mode = "markers", type = "scattergl", showlegend = F,
marker = list(size = 3, opacity = 0.5,
colorbar = list(title = "Sharpe Ratio"))) %>%
add_trace(data = eff.frontier, x = 'Risk', y = 'Return', mode = "markers",
type = "scattergl", showlegend = F,
marker = list(color = "#F7C873", size = 5)) %>%
layout(title = "Random Portfolios with Plotly",
yaxis = list(title = "Mean Returns", tickformat = ".2%"),
xaxis = list(title = "Standard Deviation", tickformat = ".2%"),
plot_bgcolor = "#434343",
paper_bgcolor = "#F8F8F8",
annotations = list(
list(x = 0.4, y = 0.75,
ax = -30, ay = -30,
text = "Efficient frontier",
font = list(color = "#F6E7C1", size = 15),
arrowcolor = "white")
))
You have a problem with add_trace() function syntax. If you want markers on the plot you will need to make dimensions of eff.frontier table corresponding to your feasible.sd and feasible.means dimensions, which you set as the first layer of your plot.
Simply, eff.frontier columns length should be the same as for the feasible.sd and feasible.means vectors.
So, if we create an example eff.frontier table with right dimensions we could construct plotly object without any problem:
# create eff.frontier example object
eff.frontier_example <- data.frame(Risk = seq(0.01373, 0.01557, length.out = length(feasible.sd)),
Return = seq(0.0006444, 0.0008915, length.out = length(feasible.sd)))
# create plotly object
p <- plot_ly(x = feasible.sd, y = feasible.means, color = feasible.sr,
mode = "markers", type = "scattergl", showlegend = F,
marker = list(size = 3, opacity = 0.5,
colorbar = list(title = "Sharpe Ratio"))) %>%
add_trace(x = eff.frontier_example$Risk, y = eff.frontier_example$Return, mode = "markers",
type = "scattergl", showlegend = F,
marker = list(color = "#F7C873", size = 5)) %>%
layout(title = "Random Portfolios with Plotly",
yaxis = list(title = "Mean Returns", tickformat = ".2%"),
xaxis = list(title = "Standard Deviation", tickformat = ".2%"),
plot_bgcolor = "#434343",
paper_bgcolor = "#F8F8F8",
annotations = list(
list(x = 0.4, y = 0.75,
ax = -30, ay = -30,
text = "Efficient frontier",
font = list(color = "#F6E7C1", size = 15),
arrowcolor = "white")
))
# show plotly object
p
I'll assume you ran the code exactly as posted. Your last code block assigns the plotly plot to p. Just add the line p to call the plot.
p <- plotly_ly(...)
p