Image and plotly plot side by side in R markdown - r

I am trying to show an image and a plot (plotly gauge) side-by-side in R markdown, however only a blank graph shows for the image. I have imported the image into plotly and am attempting to use subplot to show them side by side. Any advice on what I'm missing?
# Photo
photo <- plot_ly(domain = list(x = c(0, 0.5), y = c(0, 1)))%>%
layout(
images = list(source = "C:/Users/Name/Documents//Image.PNG"
))
# Gauge value
x <- mean(df$variable)
# Plot
fig1 <- plot_ly(
value = x,
number = list(suffix = "%"),
title = list(text = "Title"),
type = "indicator",
mode = "gauge+number",
gauge = list(
axis =list(range = list(NULL, 100)),
steps = list(
list(range = c(0, 78), color = "white"),
list(range = c(78, 88), color = "green"),
list(range = c(88, 100), color = "white")),
bar = list(color = "black")),
domain = list(x = c(0.5, 1), y = c(0, 1)))
subplot(photo, add_trace(fig1))

I didn't try in RMarkdown but I would try this:
library(plotly)
library(EBImage) # BiocManager::install("EBImage")
p1 <- plot_ly(economics, x = ~pop)
img <- readImage("mobiussolid.png")
p2 <- plot_ly(type = "image", z = img*255) %>%
layout(margin=list(l=10, r=10, b=0, t=0),
xaxis=list(showticklabels=FALSE, ticks=""),
yaxis=list(showticklabels=FALSE, ticks=""))
subplot(p1, p2)

Related

How to center the axes in Plotly on a 3d scatter plot in R?

I have a 3d scatter plot that I created with Plotly in R - is there anyway to move the axes to the middle? My plot right now looks similar to this plot that I made real quick in R:
But I would like to remove the grid background, the axis ticks, and move the axes to the middle of the plot to make it look similar to this:
My main problem is moving the axes to the middle while maintaining the x, y, and z labels on them. I have used traces to simulate the central axes, but then I have the issue of no axis labels when I remove the background grid and axes. What is the best way to go about this?
The code to recreate the first plot is below as well:
coords = list("x"=c(), "y"=c(), "z"=c())
for(phi in seq(0, 2*pi, 0.2)) {
for(theta in seq(0, pi, 0.2)) {
x = (8 * sin(theta) * cos(phi))
y = (8 * sin(theta) * sin(phi))
z = (8 * cos(theta))
coords$x = append(coords$x, x)
coords$y = append(coords$y, y)
coords$z = append(coords$z, z)
}
}
df = data.frame("x"=coords$x, "y"=coords$y, "z"=coords$z)
fig = plot_ly(df, x=~x, y=~y, z=~z, type="scatter3d",
mode="markers", marker=list(size=3))
fig = layout(fig, scene=list(xaxis=list(range=c(-12, 12)),
yaxis=list(range=c(-12, 12)),
zaxis=list(range=c(-12, 12))))
fig
How about this?
If you make the text bold:
I think it would look better if I could make the text bold. In the object annots that will be made in the function getvals. Where you see text = "x" (y or z), if you prefer bold, annotate like text = "<b>x</b>".
I tried to make this dynamic so that it could be more readily repurposed, but I didn't test any Plotly possible extremes. It is based on the assumption that there is only 1 trace and that that trace is a scatter3d.
I want to point out that marking the lines as mode = "lines" was continuously trumped by Plotly, rendering as lines+markers. If I didn't designate it as lines+markers, I couldn't control the markers, either. That's why you see markers called but essentially hidden.
getvals <- function(plt) {
plt <- plotly_build(plt) # ensure data is in object
if(isTRUE(length(plt$x$data) == 1)) {
df1 <- data.frame(x = plt$x$data[[1]]$x, # extract data
y = plt$x$data[[1]]$y,
z = plt$x$data[[1]]$z)
mx <- max(df1$x); my <- max(df1$y); mz <- max(df1$z) # for segments
nx <-.25 * mx; ny <- .25 * my; nz <- .25 * mz # for line segment size
d <- colMeans(df1)
dx <- d[[1]]; dy <- d[[2]]; dz <- d[[3]] # line segment center
hx <- dx + nx; hy <- dy + ny; hz <- dz + nz # line segment high
lx <- dx - nx; ly <- dy - ny; lz <- dz - nz # line segment low
plt <- plt %>% # add the traces for the internal axes indic.
add_trace(x = c(lx, hx), y = c(dy, dy), z = c(dz, dz), # x axis line
mode = "lines+markers",
hoverinfo = "skip", marker = list(size = .01),
line = list(color = "black", width = 3)) %>%
add_trace(x = c(dx, dx), y = c(ly, hy), z = c(dz, dz), # y axis line
mode = "lines+markers",
hoverinfo = "skip", marker = list(size = .01),
line = list(color = "black", width = 3)) %>%
add_trace(x = c(dx, dx), y = c(dy, dy), z = c(lz, hz), # z axis line
mode = "lines+markers",
hoverinfo = "skip", marker = list(size = .01),
line = list(color = "black", width = 3)) %>%
add_trace(x = dx, y = dy, z = dz, type = "scattered", # center ball
mode = "markers", hoverinfo = "skip",
marker = list(size = 8, color = "black"))
annots <- list( # text annotations x, y, z
list(showarrow = F, x = hx, y = dy, z = dz,
text = "x", xanchor = "right", xshift = -5,
font = list(size = 20)),
list(showarrow = F, x = dx, y = hy, z = dz,
text = "y", xshift = -5,
font = list(size = 20)),
list(showarrow = F, x = dx, y = dy, z = hz,
text = "z", xshift = -5,
font = list(size = 20)))
assign("annots", annots, envir = .GlobalEnv)
plt # return plot; send annotations to the global env
}
}
Using that function
Take your original plot, less the call for layout. I added showlegend = F, because when the other traces are added, it would have created a legend. You could pipe this to the plot, or do it like this.
fig = plot_ly(df, x = ~x, y = ~y, z = ~z, type = "scatter3d",
mode = "markers", marker = list(size = 3),
showlegend = F)
fig %>% getvals() %>%
layout(
scene = list(
aspectratio = list(x = 1, y = 1, z = 1),
camera = list(
center = list(x = 0, y = 0, z = 0),
eye = list(x = -.5, y = .5, z = .6)),
up = list(x = 0, y = 0, z = 1),
xaxis = list(showgrid = FALSE, zeroline = FALSE, range = c(-12, 12),
showticklabels = FALSE, title = list(text = "")),
yaxis = list(showgrid = FALSE, zeroline = FALSE, range = c(-12, 12),
showticklabels = FALSE, title = list(text = "")),
zaxis = list(showgrid = FALSE, zeroline = FALSE, range = c(-12, 12),
showticklabels = FALSE, title = list(text = "")),
dragmode = "turntable",
annotations = annots
), margin = list(t = 30, r = 30, l = 30, b = 30, padding = 2))

Setting colours in plotly R is not working (factors) in add markers

I'm trying to set the colour in R for "points" or markers in plotly with a custom palette. It doesn't work. I'm also trying to add a title to the graph, but it won't appear. In addition, I'd like to remove some elements of the legend (like the extra "z") and add a title to the legend elements. Nothing seems to work, even if it is present in the code.
library(plotly)
library(tidyverse)
set.seed(123456)
pal <- c("black", "orange", "darkgreen", "pink")
pal <- setNames(pal, levels(as.factor(c("gr1","gr2","gr3","gr4"))))
linedat = data.frame(x = rep(mean(1:50),2),
y = rep(mean(1:50),2),
z = c(0,1))
zoom = 3
pg = plotly::plot_ly(x = 1:50,
y = 1:50,
z = outer(1:50,1:50,"+")/100) %>%
add_surface(contours = list(
z = list(show = TRUE, start = 0, end = 1, size = 0.05)),
opacity = 1) %>%
add_markers(x = rnorm(50,25,5),
y = rnorm(50,25,5),
marker = list(opacity = 0.9),
type="scatter3d",
mode = "markers",inherit = FALSE,
colors = pal,
color = as.factor(sample(1:4,50,replace = T)),
z = rbinom(50,1,.5)) %>%
layout(scene=list(title = "Title won't show up????",
xaxis = list(title = 'trait1'),
yaxis = list(title = 'trait1',autorange = "reversed"),
camera = list(eye = list(x = cos(0.8*pi)*zoom, y = sin(pi*1.3)*zoom, z= 2.00)),
legend = list(title=list(text='<b> Groups </b>')))) %>%
add_trace(data=linedat, x=~x, y=~y, z=~z,
type="scatter3d", mode="lines",
line = list(color = pal[1],
width = 14),name = "Avg. data1")%>%
add_trace(data=linedat, x=~x+20, y=~y+20, z=~z,
type="scatter3d", mode="lines",
line = list(color = pal[4],
width = 14),name = "Avg. data2")
pg
See how here I'm able to set the colour of the points, but I'm not able to get the names of the colours to show in the legend (I modified the code to match what #Kat suggested):
library(plotly)
library(tidyverse)
set.seed(123456)
pal <- c("black", "orange", "darkgreen", "pink")
pal <- setNames(pal, levels(as.factor(c("gr1","gr2","gr3","gr4"))))
linedat = data.frame(x = rep(mean(1:50),2),
y = rep(mean(1:50),2),
z = c(0,1))
zoom = 3
pg = plotly::plot_ly(x = 1:50,
y = 1:50,
z = outer(1:50,1:50,"+")/100) %>%
add_surface(contours = list(
z = list(show = TRUE, start = 0, end = 1, size = 0.05)),
opacity = 1, colorbar = list(title = "Only one Z")) %>%
add_markers(x = rnorm(50,25,5),
y = rnorm(50,25,5),
marker = list(color = pal[as.factor(sample(1:4,50,replace = T))],opacity = 0.9),
type="scatter3d",
mode = "markers",inherit = FALSE,
colors = pal,
z = rbinom(50,1,.5)) %>%
layout(title = "Title that won't show",
margin = list(t = 40),
legend = list(title = list(
text = "<br>Legends deserve names, too")),
scene=list(xaxis = list(title = 'trait1'),
yaxis = list(title = 'trait1',autorange = "reversed"),
camera = list(eye = list(x = cos(0.8*pi)*zoom,
y = sin(pi*1.3)*zoom, z= 2.00)))) %>%
add_trace(data=linedat, x=~x, y=~y, z=~z,
type="scatter3d", mode="lines",
line = list(color = pal[1],
width = 14),name = "Avg. data1")%>%
add_trace(data=linedat, x=~x+20, y=~y+20, z=~z,
type="scatter3d", mode="lines",
line = list(color = pal[4],
width = 14),name = "Avg. data2");pg
Your original plot_ly call and add_trace calls can remain as is. I've included the changes needed for the layout call and added the call needed for colorbar.
The layout first.
layout(title = "Title that won't show", # <------ give my plot a name
margin = list(t = 40), # don't smash that title, either
legend = list(title = list(
text = "<br>Legends deserve names, too")), # <--- name my legend
scene=list(title = "Title won't show up????", # <- this can go away
xaxis = list(title = 'trait1'),
yaxis = list(title = 'trait1',autorange = "reversed"),
camera = list(eye = list(x = cos(0.8*pi)*zoom,
y = sin(pi*1.3)*zoom, z= 2.00)),
legend = list(title=list(text='<b> Groups </b>')))) %>%
colorbar(title = "Only one Z") # <--- give me one z colorbar title
(Some colors are different in the image; I didn't realize I had the pal object...sigh)
Update
This addresses your additional questions.
First, I'm not getting an error from the method in which I title the color bar. You'll have to share what error you're getting.
I didn't realize that it was ignoring the colors you set in markers, either. The easiest way to address this is to call that trace first. Since nothing else was declared within markers, I called opacity outside of the list, but it's fine the way you have it.
First, I commented out the setNames call, because that won't work for the marker's trace and it doesn't matter to the other traces.
library(plotly)
set.seed(123456)
pal <- c("black", "orange", "darkgreen", "pink")
# pal <- setNames(pal, levels(as.factor(c("gr1","gr2","gr3","gr4"))))
linedat = data.frame(x = rep(mean(1:50),2),
y = rep(mean(1:50),2),
z = c(0,1))
zoom = 3
I made plot_ly() empty and put all the data for the surface in that trace. I also added inherit = false so that the layout could go at the end without the data errors.
set.seed(123456)
pg = plotly::plot_ly() %>%
add_trace(inherit = F,
x = rnorm(50,25,5),
y = rnorm(50,25,5),
type="scatter3d",
mode = "markers",
opacity = .8,
colors = pal,
color = as.factor(sample(1:4, 50, replace = T)),
z = rbinom(50,1,.5)) %>%
add_surface(x = 1:50,
y = 1:50,
z = outer(1:50,1:50,"+")/100,
colorscale = "Viridis",
contours = list(
z = list(show = TRUE, start = 0, end = 1, size = 0.05)),
opacity = 1) %>%
add_trace(data=linedat, x=~x, y=~y, z=~z,
type="scatter3d", mode="lines",
line = list(color = pal[1],
width = 14),name = "Avg. data1", inherit = F) %>%
add_trace(data=linedat, x=~x+20, y=~y+20, z=~z,
type="scatter3d", mode="lines",
line = list(color = pal[4],
width = 14),name = "Avg. data2", inherit = F) %>%
The last part is the layout, but this is not different than my original answer.
layout(title = "Title that won't show", # <------ give my plot a name!
margin = list(t = 40), # don't smash that title, either
legend = list(title = list(
text = "<br>Legends deserve names, too"),
tracegroupgap = 350), # <--- name my legend!
scene=list(title = "Title won't show up????", # <--- this can go away!
xaxis = list(title = 'trait1'),
yaxis = list(title = 'trait1',autorange = "reversed"),
camera = list(eye = list(x = cos(0.8*pi)*zoom,
y = sin(pi*1.3)*zoom, z= 2.00)),
legend = list(title=list(text='<b> Groups </b>')))) %>%
colorbar(title = "Only one Z") # <--- give me one z for the title!
pg

Secondary axis in plotly does not work for different scales

How can I reproduce the following graph in plotly
library(dplyr)
library(ggplot2)
tibble(x =1:10, y = 1:10) %>%
ggplot(aes(x,y)) +
geom_line() +
scale_y_continuous(sec.axis = ~.*2)
I tried the following code based on this answer here
library(dplyr)
library(plotly)
tibble(x =1:10, y = 1:10) %>%
mutate(y2 = y*2) %>%
plot_ly() %>%
add_lines(x =~x, y =~y) %>%
add_lines(x= ~x, y=~y2,
yaxis = "y2", color = I("transparent"),
hoverinfo='skip', showlegend=FALSE) %>%
layout(yaxis2 = list(side = "right", overlaying = "y", showgrid = FALSE),
margin = list(r = 50))
While at first glance it appears to work, it only provides a partial solution, since if I interactively try to change the scale of the main (left) y axis on the produced graph (by dragging it up or down), the right axis does not move with the graph (because it is linked only to the second invisible graph). This of course is not acceptable as it does not allow using any of interactive features of plotly reliably which is the reason I wanted to use it to begin with instead of ggplot.
Edit: Just realized that this plotly solution does not seem to work at all in the case of non linear transformation between the axes (while ggplot handles it beautifully).
You just need to set up dtick and tick0 for plotly to have the same graph as ggplot2 one. See below;
library(plotly)
library(dplyr)
tibble(x =1:10, y = 1:10) %>%
mutate(y2 = y*2) -> df1
n0 <- 4
y0 <- max(df1$y)/n0
x0 <- max(df1$x)/n0
df1 %>%
plot_ly(data = . , x = ~x, y = ~y,
type = "scatter", mode = "lines", width = 800,
color = I("red"), name = "") %>%
add_trace(x = ~x, y = ~y2, yaxis = "y2",
color = I("red"), name = "") %>%
layout(yaxis = list(showline = FALSE, side = "left",
title = "", color = "red",
dtick = y0, tick0 = y0, fixedrange=TRUE),
yaxis2 = list(showline = FALSE, side = "right", overlaying = "y", position = 1,
title = "", anchor = "free", color = "blue",
dtick = 2*y0, tick0 = 2*y0, fixedrange=TRUE),
xaxis = list(showline = FALSE, zeroline = FALSE, title = "",
dtick = x0, tick0 = x0),
showlegend = FALSE,
margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4)
)
Created on 2020-06-19 by the reprex package (v0.3.0)

How to highlight the centers of particular clusters(K-means Clustering) in graph using plotly R?

I have a data frame named(inputdata_transaction_cluster) that looks like:
I successfully plotted the graph for this data frame using plotly R for cluster analysis(K means clustering).
My code is below:
nClust <- 3
kmeans_output <- kmeans(inputdata_transaction_cluster, centers = nClust)
inputdata_transaction_cluster$cluster = kmeans_output$cluster
cols <- brewer.pal(nClust, "Set1")
for(i in 1:nClust){
inputdata_transaction_cluster$color[inputdata_transaction_cluster$cluster == i] <- cols[i]
}
plot_ly(inputdata_transaction_cluster, x =~timeStamp, y =~elapsed,type="scatter", mode = "markers", showlegend = FALSE,
hoverinfo = "x+y+text", text =~paste("Cluster:", cluster),
marker = list(opacity = 0.6,
color =~color,
size = 15,
line = list(color = "#262626", width = 3)))%>%
layout(
title = "CLUSTER",
xaxis = list(
title = ""),
yaxis = list(
title = "RESPONSE TIME")
)%>%
layout(xaxis=ax,yaxis = ay) %>%
layout(hovermode = "closest",
showlegend = F,
title = paste("CLUSTER DIAGRAM :",unique(inputdata_transaction1$label)),
titlefont = list(color = "rgb(30,144,255)", size = 18))
I obtained a graph that looks like:
But as you can see the plot doesn't highlight the centers of each particular clusters.So is there any way i can achieve this in plot using plotly R?
When i run kmeans_output$centers ,i get the values for each cluster but how i can show that in graph.
Thanks In advance for any help.
I've made a mockup of your problem below. You can highlight the centers using points or annotations (or both). I've used mock data since yours is not available.
library("plotly")
library("RColorBrewer")
nClust <- 3
inputdata_transaction_cluster <- as.data.frame(matrix(rnorm(100), ncol=4))
colnames(inputdata_transaction_cluster) <- c("timeStamp", "elapsed", "color",
"label")
kmeans_output <- kmeans(inputdata_transaction_cluster, centers = nClust)
inputdata_transaction_cluster$cluster = kmeans_output$cluster
cols <- brewer.pal(nClust, "Set1")
for(i in 1:nClust){
inputdata_transaction_cluster$color[inputdata_transaction_cluster$cluster == i] <- cols[i]
}
plot_ly(inputdata_transaction_cluster,
x =~timeStamp,
y =~elapsed,
type="scatter", mode = "markers", showlegend = FALSE,
hoverinfo = "x+y+text", text =~paste("Cluster:", cluster),
marker = list(opacity = 0.6,
color =~color,
size = 15,
line = list(color = "#262626", width = 3)))%>%
layout(
title = "CLUSTER",
xaxis = list(
title = ""),
yaxis = list(
title = "RESPONSE TIME")
)%>%
layout(hovermode = "closest",
showlegend = F,
title = paste("CLUSTER DIAGRAM :",
unique(inputdata_transaction_cluster$label)),
titlefont = list(color = "rgb(30,144,255)", size = 18)) %>%
## Relevant part:
add_markers(data=as.data.frame(kmeans_output$centers),
x=~timeStamp,
y=~elapsed,
inherit = FALSE,
color = c("red", "green", "blue"),
size = 15) %>%
add_annotations(data=as.data.frame(kmeans_output$centers),
x=~timeStamp, y=~elapsed, color = c("red", "green", "blue"),
text = paste("Cluster: ", rownames(kmeans_output$centers)))

Plot a chart with percentage as secondary Y axis using R

I want to plot a dual axis chart and I want the secondary Y axis (vcr) to be shown in percentage format. I tried multiplying the column by 100 and putting a % as ticksuffix to it but because the range of the data varies from 20% to 70% the Y axis labels are not shown clearly I get an output like shown in the attached image:
ay <- list(
tickfont = list(color = "black"),
overlaying = "y",
showtickprefix = "all",
ticksuffix = "%",
#range = c(20,70),
tickfix = "%",
dtick = 0.5,
side = "right"
)
a <- list(
title = ""
)
b <- list(
title = ""
)
m = list(
l = 50,
r = 50,
b = 25,
t = 0,
pad = 4
)
p <- plot_ly(data = ctv_graph, x = impression_date, y = impressions , name = "Impressions",type="bar",marker = list(color = toRGB("#00C0EF"))) %>%
add_trace(x = impression_date, y = vcr, name = "VCR", yaxis = "y2") %>%config(displayModeBar=FALSE)%>%
layout(xaxis=a, yaxis=b, yaxis2 = ay, legend = list(x = 0, y = 1.15), margin = m)
})

Resources