plotly in r 3d arrows between two points - r

I would like to draw arrows between two points. This is the problem, where I made the three arrows with a graphical program to explain my problem.
That is my source code:
require(plotly)
a <- c(5,16,16,17,18,23,25,27,37,42,5)
b <- c(13,12,26,15,14,6,10,22,14,25,17)
c <- c(12,14,25,26,8,9,27,30,31,26.5,12)
ap <- c(5,12,16,17,11,23,25,27,37,21.5,5)
bp <- c(13,12,26,15,14,6,10,22,14,12.5,17)
cp <- c(12,14,25,26,8,9,27,30,31,26,12)
rnn <- c("U1", "U2", "U3", "U4", "U5", "U6", "U7", "U8", "U9", "U10", "U11")
m <- list( symbol = 200, size = 8, line = list( color = toRGB("yellow"), width = 2 ) )
m1 <- list( symbol = "triangle", color="black", sizemod = "diameter", size = 5, line = list( color = "black", width = 2 ) )
plot_ly(x = ap, y = bp, z = cp) %>%
add_trace(marker = m1, type = "scatter3d", mode = "text+markers",
name = "projected", linetypes = NULL, text = rnn) %>%
add_trace(x = a, y = b, z = c, marker = m, type = "scatter3d", mode = "text+markers",
name = "original", linetypes = NULL, text = rnn)
Many thanks.

Not exactly what you are looking for, but you could try this:
aaa <- c(16, 12)
bbb <- c(12, 12)
ccc <- c(14, 14)
aaaa <- c(18, 11)
bbbb <- c(14, 14)
cccc <- c(8, 8)
aaaaa <- c(42, 21.5)
bbbbb <- c(25, 12.5)
ccccc <- c(26.5, 26)
plot_ly() %>%
add_trace(x = aaa, y = bbb, z = ccc, type = "scatter3d", mode = "lines",
name = "lines", showlegend = FALSE) %>%
add_trace(x = aaaa, y = bbbb, z = cccc, type = "scatter3d", mode = "lines",
name = "lines", showlegend = FALSE) %>%
add_trace(x = aaaaa, y = bbbbb, z = ccccc, type = "scatter3d", mode = "lines",
name = "lines", showlegend = FALSE) %>%
add_trace(x = ap, y = bp, z = cp, marker = m1, type = "scatter3d", mode = "text+markers",
name = "projected", linetypes = NULL, text = rnn) %>%
add_trace(x = a, y = b, z = c, marker = m, type = "scatter3d", mode = "text+markers",
name = "original", linetypes = NULL, text = rnn)

Related

How can I add a subcategory to axis in Plotly with R?

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.

How to add multiple shapes on plot_ly slider chart?

I am trying to visualize multiple periods in a time-series/candlestick chart, highlighting certain dates by vertical lines. Similar to the sinus wave example here: https://plotly.com/r/sliders/
aval <- list(setNames(xts(matrix(data = rnorm(1:28), ncol = 4), as.Date(1:7)), c("Open","High","Low","Close")),
setNames(xts(matrix(data = rnorm(1:52), ncol = 4), as.Date(1:13)), c("Open","High","Low","Close")),
setNames(xts(matrix(data = rnorm(1:20), ncol = 4), as.Date(1:5)), c("Open","High","Low","Close")))
Looping through the list, I can achieve my desired result with respect to the vertical lines:
for (i in 1:length(aval)) {
fig <- plot_ly()
b <- data.frame(Date=index(aval[[i]]), coredata(aval[[i]]))
line <- list(type = "line", line = list(color = 'magenta'), # , dash = "dot", width = 0.5
xref = "x", yref = "paper", x0 = NA, x1 = NA, y0 = 0, y1 = 1)
l <- list(line, line)
l[[1]][['x0']] <- l[[1]][['x1']] <- b[1+1,1]
l[[2]][['x0']] <- l[[2]][['x1']] <- b[nrow(b)-1,1]
fig <- add_trace(fig, type = "candlestick", x = b[,1], open = b[,2], close = b[,5], high = b[,3], low = b[,4],
showlegend = FALSE) %>%
layout(xaxis = list(rangeslider = list(visible = F), type = "category"), shapes = l, font = list(size = 10))
fig <- fig %>% config(displayModeBar = FALSE)
print(fig)
}
However, using the slider layout, I am only able to use one vertical line, see:
n <- length(aval)
steps <- list()
fig <- plot_ly()
for (i in 1:length(aval)) {
b <- data.frame(Date=index(aval[[i]]), coredata(aval[[i]])[,c('Open','High','Low','Close')])
toggle <- ifelse(i == 1, TRUE, FALSE)
line <- list(type = "line", line = list(color = 'magenta', dash = "dot", width = 0.5),
xref = "x", yref = "paper", x0 = b[1+1,1], x1 = b[1+1,1], y0 = 0, y1 = 1)
fig <- add_trace(fig, type = "candlestick", x = b[,1], open = b[,2], close = b[,5], high = b[,3], low = b[,4],
visible = toggle, showlegend = FALSE) %>%
layout(xaxis = list(rangeslider = list(visible = F), type = "category"), shapes = line, font = list(size = 10))
step <- list(args = list('visible', rep(FALSE, length(aval))), label = i, method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
}
fig <- fig %>% layout(sliders = list(list(active = 0, steps = steps))) %>% config(displayModeBar = FALSE)
fig
Using a list of shapes, analog to my first example, does not seem to work:
steps <- list()
fig <- plot_ly()
for (i in 1:length(aval)) {
b <- data.frame(Date=index(aval[[i]]), coredata(aval[[i]])[,c('Open','High','Low','Close')])
toggle <- ifelse(i == 1, TRUE, FALSE)
line <- list(type = "line", line = list(color = 'magenta', dash = "dot", width = 0.5),
xref = "x", yref = "paper", x0 = NA, x1 = NA, y0 = 0, y1 = 1)
l <- list(line, line)
l[[1]][['x0']] <- l[[1]][['x1']] <- b[1+1,1] # as.character
l[[2]][['x0']] <- l[[2]][['x1']] <- b[nrow(b)-1,1]
fig <- add_trace(fig, type = "candlestick", x = b[,1], open = b[,2], close = b[,5], high = b[,3], low = b[,4],
visible = toggle, showlegend = FALSE) %>%
layout(xaxis = list(rangeslider = list(visible = F), type = "category"), shapes = l, font = list(size = 10))
step <- list(args = list('visible', rep(FALSE, length(aval))), label = i, method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
}
fig <- fig %>% layout(sliders = list(list(active = 0, steps = steps))) %>% config(displayModeBar = FALSE)
fig
Can anybody help me? Is this related to the visibility argument in steps, perhaps?

How can I round decimals in plotly?

Is there a way to round decimals in plotly? For example,
I am getting the values as 24.32544 M.
Instead of this, can I get as 24.32 M?
asd <- data.frame(a = c(1,2,3,4), b = c(24325443,35345442,3245353453,345353523), c = c(5435352345,234534534,324534534,23453532))
plot_ly(asd, x = ~a, y = ~b, name = 'b', type = 'scatter', mode = 'lines') %>%
add_trace(y = ~c, name = 'c', mode = 'lines') %>%
layout(xaxis = list(title = paste0("Week"),showgrid = F,rangemode = "tozero"),
yaxis = list(title = "",showgrid = F,rangemode = "tozero"),
legend = legend_cus,
hovermode = 'x unified')
p <- ggplot(asd, aes(a, b,
text = paste0("a: ", round(a), "</br></br>b: ", round(b))))
+ geom_point()
ggplotly(p, tooltip = "text")
To conver to million format see: Format numbers with million (M) and billion (B) suffixes

How to add Data markers in Waterfall chart in Plotly

I am trying to plot waterfall chart with the following code. The only issue I am facing currently is the data marker which is not at the correct place. I want the data marker to be just below the end of each bar.
source('./r_files/flatten_HTML.r')
library("plotly")
dataset <- data.frame(Category = c("Akash Jain","Ankit Jain","Pankaj Jain","Nitin Pandey","Gopal Pandit","Ramnath Agarwal"),
TH = c(-62,-71,-1010,44,-44,200))
#dataset <- data.frame(Category = Values$Category, TH = Values$TH)
#dataset <- as.data.frame(cbind(Values$Category,Values$TH))
dataset$Category = dataset$Category
dataset$TH = dataset$TH
dataset$SortedCategoryLabel <- sapply(dataset$Category, function(x) gsub(" ", " <br> ", x))
dataset$SortedCategory <- factor(dataset$SortedCategoryLabel, levels = dataset$SortedCategoryLabel)
dataset$id <- seq_along(dataset$TH)
dataset$type <- ifelse(dataset$TH > 0, "in", "out")
dataset$type <- factor(dataset$type, levels = c("out", "in"))
dataset$end <- cumsum(dataset$TH)
dataset$start <- c(0, head(dataset$end, -1))
Hover_Text <- paste(dataset$Category, "= ", dataset$TH, "<br>")
dataset$colors <- ifelse(dataset$type =="out","red","green")
g <- plot_ly(dataset, x = ~SortedCategory, y = ~start, type = 'bar', marker = list(color = 'rgba(1,1,1, 0.0)'), hoverinfo = 'text') %>%
add_trace(y = dataset$TH , marker = list(color = ~colors), hoverinfo = "text", text = Hover_Text ) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
margin = list(l = 50, r = 30, b = 50, t = 20),
showlegend = FALSE) %>%
add_annotations(text = dataset$TH,
x = dataset$SortedCategoryLabel,
y = dataset$end,
xref = "dataset$SortedCategoryLabel",
yref = "dataset$end",
font = list(family = 'Arial',
size = 14,
color = "black"),
showarrow = FALSE)
g
Attached the screenshot of the waterfall chart.
So for the first bar, I need the data marker to be just below the end of red bar. Currently it is overlapping with the bar. And similarly for others.
Any help would be really appreciated.
Regards,
Akash
You should specify valign and height inside add_annotations:
vert.align <- c("bottom","top")[as.numeric(dataset$TH>0)+1]
g <- plot_ly(dataset, x = ~SortedCategory, y = ~start, type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)'), hoverinfo = 'text') %>%
add_trace(y = dataset$TH , marker = list(color = ~colors), hoverinfo = "text",
text = Hover_Text ) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
margin = list(l = 50, r = 30, b = 50, t = 20),
showlegend = FALSE) %>%
add_annotations(text = dataset$TH,
x = dataset$SortedCategoryLabel,
y = dataset$end,
xref = "x",
yref = "y",
valign=vert.align, height=40,
font = list(family = 'Arial',
size = 14,
color = "black"),
showarrow = FALSE)
g

How to show calculated values on top of stacked bar chart in r

Using the code below, I have a stacked bar chart as shown.
myDF <- structure(list(Group = structure(1:3, .Label = c("2017-04-02",
"2017-04-09", "2017-04-16"), class = "factor"), Passive = c(4,
1, 0), Promoter = c(12, 1, 4), Detractors = c(0, 0, 0)), .Names = c("Group",
"Passive", "Promoter", "Detractors"), row.names = c(NA, -3L), class = "data.frame")
x <- list(
title = ""
)
y <- list(
title = "Count"
)
p <- plot_ly(myDF, x = ~Group)
if ("Detractors" %in% colnames(myDF[-1])){
p <- add_trace(p, y = ~`Detractors`, name = 'Detractors', type = 'bar',
marker = list(color = '#D52728')) #red
}
if ("Passive" %in% colnames(myDF[-1])){
p <- add_trace(p, y = ~`Passive`, name = 'Passive', type = 'bar',
marker = list(color = '#1F78B4')) #orange
}
if ("Promoter" %in% colnames(myDF[-1])){
p <- add_trace(p, y = ~`Promoter`, name = 'Promoter', type = 'bar',
marker = list(color = '#2BA02D')) #green
}
p <- layout(p, xaxis = x, yaxis = y, barmode = 'stack', legend = list(orientation = 'h'), showlegend=T)
p
I want to show the Net Promoter Scores on top of each bar. The formula I use for calculating the NPS is:
(Number of Promoters — Number of Detractors) / (Number of Respondents) x 100.
So for the first bar it would be ((12 - 0)/16) * 100 = 75. I want to show NPS: 75 on top of the first bar. Similarly for the second and third bar, the number on top will be (1-0)/2*100 = 50 and (4-0)/4*100 = 100 respectively. I will be getting more data for coming weeks, so there will be a bar for each week of data in the future. Is there a way to show this calculated value on top on the bars?
You could add annotations to your layout where the x values are your dates, the y values are the stacked values and the text is the Net Promoter Score, e.g.
df = data.frame(x = c('A', 'B', 'C', 'D'),
y = c(1,3,2,4),
calculated_values = c(20,30,10,50)
)
annotations <- list()
for (i in 1:length(df$calculated_values)) {
annotations[[i]] <- list(x = df$x[[i]],
y = df$y[[i]],
text = df$calculated_values[[i]],
yanchor='bottom',
showarrow = FALSE)
}
plot_ly(df,
x = ~x,
y = ~y,
type = 'bar') %>%
layout(annotations = annotations)
Or for this particular example replace the last two lines of your code with:
annotations <- list()
for (row in rownames(myDF)) {
annotations[[as.integer(row)]] = list(x = as.character(myDF[row,]$Group),
y = sum(myDF[row,][-1]),
text = ((myDF[row,][[3]] - myDF[row,][[4]]) / sum(myDF[row,][-1])) * 100,
yanchor='bottom',
showarrow = FALSE)
}
p <- layout(p, xaxis = x, yaxis = y, barmode = 'stack', legend = list(orientation = 'h'), showlegend=T,
annotations = annotations)
p

Resources