Overlay vertical line on top of histogram in R using Plotly - r

I have an histogram like the one below and I want to plot a vertical line of a specific value on top of the histogram.
My code for the histogram is:
library(plotly)
p <- plot_ly(x = ~rnorm(50,mean = 50,sd = 10), type = "histogram")
p
I want to overlay a line on top of the histogram, for example say,
x <- 42
Can anyone help getting this?

library(plotly)
set.seed(1)
p <- plot_ly(x = ~rnorm(50,mean = 50,sd = 10), type = "histogram") %>%
add_segments(x=42, y=0, xend=42, yend=14, line=list(color="red", width = 4))
p
A different solution (see here for details):
vline <- function(x = 0, color = "red") {
list(
type = "line",
y0 = 0,
y1 = 1,
yref = "paper",
x0 = x,
x1 = x,
line = list(color = color)
)
}
p <- plot_ly(x = ~rnorm(50, mean = 50,sd = 10), type = "histogram") %>%
layout(shapes = list(vline(42)))
p

Related

Remove whiskers and outliers in R plotly

I have continuous data that I'd like to plot using R's plotly with a box or violin plot without the outliers and whiskers:
set.seed(1)
df <- data.frame(group=c(rep("g1",500),rep("g2",700),rep("g3",600)),
value=c(c(rep(0,490),runif(10,10,15)),abs(rnorm(700,1,10)),c(rep(0,590),runif(10,10,15))),
stringsAsFactors = F)
df$group <- factor(df$group, levels = c("g1","g2","g3"))
I know how to remove outliers in plotly:
plotly::plot_ly(x = df$group, y =df$value, type = 'box', color = df$group, boxpoints = F, showlegend = F)
But I'm still left with the whiskers.
I tried using ggplot2 for that (also limiting the height of the y-axis to that of the 75 percentile):
library(ggplot2)
gp <- ggplot(df, aes(group, value, color = group, fill = group)) + geom_boxplot(outlier.shape = NA, coef = 0) +
scale_y_continuous(limits = c(0, ceiling(max(dplyr::summarise(dplyr::group_by(df, group), tile = quantile(value, probs = 0.75))$tile)))) +
theme_minimal() + theme(legend.position = "none",axis.title = element_blank())
But then trying to convert that to a plotly object doesn't maintain that:
plotly::ggplotly(gp)
Any idea?
This is a workaround.
I changed your plot a bit, first.
# box without outliers
p <- plot_ly(df, x = ~group, y = ~value, type = 'box',
color = ~group, boxpoints = F, showlegend = F,
whiskerwidth = 0, line = list(width = 0)) # no whisker, max or min line
Then I add the medians back to the graph. This requires calculating the medians, matching the colors, and creating the shape lists for Plotly.
For the colors, it's odd, the first three default colors are used, but the order is g3, g2, g1...
# the medians
res = df %>% group_by(group) %>%
summarise(med = median(value))
# default color list: https://community.plotly.com/t/plotly-colours-list/11730/2
col = rev(c('#1f77b4', '#ff7f0e', '#2ca02c')) # the plot is colored 3, 2, 1
# discrete x-axis; domain default [0, 1]
# default box margin = .08, three groups, each get 1/3 of space
details <- function(col){ # need everytime basics
list(type = 'line',
line = list(color = col, width = 4),
xref = "paper", yref = "y")
}
# horizontal segments/ median
segs = lapply(1:nrow(res),
function(k){
x1 <- k/3 - .08 # if the domain is [0, 1]
x0 <- (k - 1)/3 + .08
y0 <- y1 <- res[k, ]$med
line = list("x0" = x0, "x1" = x1,
"y0" = y0, "y1" = y1)
deets = details(col[k])
c(deets, line)
})
Finally, I added them back onto the plot.
p %>% layout(shapes = segs)
I made the lines obnoxiously wide, but you get the idea.
If you wanted the IQR outline back, you could do this, as well. I used functions here, as well. I figured that the data you've provided is not the actual data, so the function will serve a purpose.
# include IQR outline
res2 = df %>% group_by(group) %>%
summarise(q1 = setNames(quantile(value, type = 7, 1/4), NULL),
q3 = setNames(quantile(value, type = 7, 3/4), NULL),
med = median(value))
# IQR segments
rects = lapply(1:nrow(res2), # if the domain is [0, 1]
function(k){
x1 <- k/3 - .08
x0 <- (k - 1)/3 + .08
y0 <- res2[k, ]$q1
y1 <- res2[k, ]$q3
line = list(color = col[k], width = 4)
rect = list("x0" = x0, "x1" = x1,
"y0" = y0, "y1" = y1,
type = "rect", xref = "paper",
yref = "y", "line" = line)
rect
})
rects = append(segs, rects)
p %>% layout(shapes = rects)

Adding Contour Lines to 3D Plots

I am working with the R programming language. I made the following 3 Dimensional Plot using the "plotly" library:
library(dplyr)
library(plotly)
my_function <- function(x,y) {
final_value = (1 - x)^2 + 100*((y - x^2)^2)
}
input_1 <- seq(-1.5, 1.5,0.1)
input_2 <- seq(-1.5, 1.5,0.1)
z <- outer(input_1, input_2, my_function)
plot_ly(x = input_1, y = input_2, z = z) %>% add_surface()
I am now trying to add "contour lines" to the above plot as shown below: https://plotly.com/r/3d-surface-plots/
I am trying to adapt the code from the "plotly website" to make these contours, but I am not sure how to do this:
Graph 1:
# This might have worked?
fig <- plot_ly(z = ~z) %>% add_surface(
contours = list(
z = list(
show=TRUE,
usecolormap=TRUE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
)
fig <- fig %>% layout(
scene = list(
camera=list(
eye = list(x=1.87, y=0.88, z=-0.64)
)
)
)
Graph 2:
# I don't think this worked?
fig <- plot_ly(
type = 'surface',
contours = list(
x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color = 'white'),
z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05)),
x = ~x,
y = ~y,
z = ~z)
fig <- fig %>% layout(
scene = list(
xaxis = list(nticks = 20),
zaxis = list(nticks = 4),
camera = list(eye = list(x = 0, y = -1, z = 0.5)),
aspectratio = list(x = .9, y = .8, z = 0.2)))
fig
Can someone please show me how to correctly adapt these above codes?
You were almost there.
The contours on z should be defined according to min-max values of z:
plot_ly(x = input_1, y = input_2, z = z,
contours = list(
z = list(show = TRUE, start = round(min(z),-2),
end = round(max(z),-2),
size = 100))) %>%
add_surface()
or automatically set by plotly :
plot_ly(x = input_1, y = input_2, z = z,
colors = 'Oranges',
contours = list(
z = list(show = TRUE))) %>%
add_surface()
The contour lines are on your plots, but may not be super visible due to the parameters in the contours.z list. Here's how you can tweak the contour lines to fit your needs:
fig <- plot_ly(z = ~z) %>% add_surface(
contours = list(
z = list(
show = TRUE,
# project=list(z=TRUE) # (don't) project contour lines to underlying plane
# usecolormap = TRUE, # (don't) use surface color scale for contours
color = "white", # set contour color
width = 1, # set contour thickness
highlightcolor = "#ff0000", # highlight contour on hover
start = 0, # include contours from z = 0...
end = 1400, # to z = 1400...
size = 100 # every 100 units
)
)
)
You can draw lines along the other dimensions by passing lists to x or y. (Per follow-up question from OP) you can change the surface color scale using colorscale, either specifying one of the named colorscale options or building your own. Example:
fig <- plot_ly(z = ~z) %>% add_surface(
colorscale = "Picnic",
contours = list(
x = list(show=TRUE, color="#a090b0", width=2, start=0, end=30, size=7.5),
y = list(show=TRUE, color="#a090b0", width=2, start=0, end=30, size=7.5),
z = list(show=TRUE, color="#a090b0", width=2, start=0, end=1400, size=300)
)
)

How can I add scatter point to an existing 3D scatter plot in plotly

I created a 3D scatter plot using plotly in R but I have trouble adding more data to the 3D plot.
library(plotly)
names(b) <- c('m1','m2','m3','clust')
umap_1 <- b$m1
umap_2 <- b$m2
umap_3 <- b$m3
clust <- b$clust
palette <- c('#e86e41','#d9b53f','#9857ba','#57ba64','#57b7ba')
p <- plot_ly(x = umap_1, y = umap_2, z =umap_3,
color = b$clust,
colors = palette,
marker = list(size = 1, width=1),
text = b$clust,
hoveringinfo = 'text'# controls size of points
)
I would like to add to this scatter plot other points with other size and color.
I thought first about adding a fifth column to my dataset and using this in marker with something like ifelse(b$V4=='something'], size=1, size=5)
but it doesn't work.
So i thought about adding element using %>% like :
p <- plot_ly(x = umap_1, y = umap_2, z =umap_3,
color = b$clust,
colors = palette,
marker = list(size = 1, width=1),
text = b$clust,
hoveringinfo = 'text'
)
p <- p >%> add_something(x,y,z, marker = list(size = 5, width=1))
But there is no function to add scatter point to a 3D plot.
Is there a way to do so ?
You can add several traces as in the example below.
fig <- plot_ly(data = df, x = ~x, y = ~y, z = ~z) %>%
add_trace(
data = df2
, x = ~x
, y = ~y
, z = ~z
, color= ~group
, mode = "markers"
, type = "scatter3d"
, marker = list(size = 5))
See for a related example: Mixing surface and scatterplot in a single 3D plot
In python, you can do:
fig = px.line_3d(...)
fig.add_scatter3d(...)

Is output from ggplotly not a full-featured plotly object?

The purpose of the code is to produce an interactive plotly chart with shaded vertical areas on specified subsets on X-axis.
The first step is to construct a ggplot2 object, with shaded vertical areas constructed using geom_rect, then use ggplotly to produce a plotly object.
Since ggplotly does not produce an output which contains the shaded vertical areas anymore, I am adding them to ggplotly output (which is is a plotly object) by using plotly function add_lines.
However, this approach does not work. The approach that works is to start from a natively-built plotly object and then using plotly function add_lines.
Does this mean that output from ggplotly is not a full-featured plotly object?
The reproducible example is below. One can change values of logical variables useOnlyPlotly (line 67) and useGeomRect (line 66) to see the behaviors described above
require(tidyverse)
require(plotly)
require(lubridate)
plotShadedAreaUsingGeomBarsFunc <- function(colorArea, dataY){
ggplot2::geom_bar(data = trimmedRecessionsDates, inherit.aes = FALSE,
aes_(x = quote(MidPoint), y = base::max(dataY)), # y = Inf doesn't work
stat = "identity",width = 0.1,
# position = "stack",
fill = colorArea, alpha = 0.2)
}
plotShadedAreaUsingGeomRectFunc <- function(colorArea, dataY){
ggplot2::geom_rect(data = trimmedRecessionsDates, inherit.aes = FALSE,
aes(xmin = as.Date(Peak), xmax = as.Date(Trough), ymin = -Inf, ymax = +Inf),
fill = colorArea,
alpha = 0.2)
}
# dates
dateOne <- lubridate::ymd("2000-1-1")
dateTwo <- lubridate::ymd("2004-1-1")
dateThree <- lubridate::ymd("2009-1-1")
dateFour <- lubridate::ymd("2013-1-1")
dateFive <- lubridate::ymd("2017-12-31")
PeakDates <- c(lubridate::ymd("2001-03-01"), lubridate::ymd("2007-12-01"))
TroughDates <- c(lubridate::ymd("2001-11-01"), lubridate::ymd("2008-08-31"))
sequenceDates <- seq(dateOne, dateFive, by="month")
sequenceInRecession <- c(rep(0,length(sequenceDates)))
sequenceInRecession <- base::replace(sequenceInRecession, list = c(15,16,17,18,19,20,21,22,23,96,97,98,99,100), values = c(rep(1,14)))
sequenceInRecession <- base::replace(sequenceInRecession, list = c(101,102,103,104,105,106,107,108,109,110,111,112,113,114), values = c(rep(1,14)))
dataFrameRecessionDates <- data.frame(Dates = sequenceDates, InRecession = sequenceInRecession)
dataFrameRecessionDates$Dates <- lubridate::as_date(dataFrameRecessionDates$Dates)
#data
theDataFrame <- data.frame(Dates = c(dateOne, dateTwo, dateThree, dateFour, dateFive), SomeValues = c(0.2, 2.8, 4.5, 9.8, -0.3),
season = c("SeasOne","SeasTwo","SeasOne","SeasOne","SeasTwo"))
trimmedRecessionsDates <- data.frame(Peak = PeakDates, Trough = TroughDates)
# define midPoint as middle point between Peak and Trough
trimmedRecessionsDates$MidPoint = trimmedRecessionsDates$Peak + floor((trimmedRecessionsDates$Trough - trimmedRecessionsDates$Peak)/2)
trimmedRecessionsDates$MidPoint <- base::as.Date(trimmedRecessionsDates$MidPoint)
colNamesDataFrame <- colnames(theDataFrame)[2:2]
valMax <- base::max(sapply(theDataFrame[colNamesDataFrame], max, na.rm = TRUE))
valMin <- base::min(sapply(theDataFrame[colNamesDataFrame], min, na.rm = TRUE))
dataFrameRecessionDates$InRecession[dataFrameRecessionDates$InRecession %in% 1] <- valMax + 0.2*base::abs(valMax)
dataFrameRecessionDates$InRecession[dataFrameRecessionDates$InRecession %in% 0] <- valMin - 0.2*base::abs(valMin)
ggplotObjUsingGeomBar <- ggplot2::ggplot(data = theDataFrame, aes(x = Dates, y = SomeValues, color = season)) +
ggplot2::geom_line() +
plotShadedAreaUsingGeomBarsFunc('turquoise3', theDataFrame$SomeValues)
ggplotObjUsingGeomRect <- ggplot2::ggplot(data = theDataFrame, aes(x = Dates, y = SomeValues)) +
ggplot2::geom_line() +
plotShadedAreaUsingGeomRectFunc('turquoise3', theDataFrame$SomeValues)+
ggplot2::theme_bw()
useGeomRect = TRUE
useOnlyPlotly = TRUE
thePlotlyObjToAnalyze <- plot_ly()
if (useOnlyPlotly)
{
thePlotlyObjToAnalyze <- plot_ly(data = theDataFrame, x = ~Dates, y = ~SomeValues) %>%
add_lines(data = theDataFrame, x = ~Dates, y = ~SomeValues,
line = list(width = 3), hoverinfo = "x + y")
} else {
if (useGeomRect)
{
thePlotlyObjToAnalyze <- hide_legend(ggplotly(ggplotObjUsingGeomRect))
} else {
thePlotlyObjToAnalyze <- hide_legend(ggplotly(ggplotObjUsingGeomBar))
}
}
(thePlotlyObjToAnalyze %>%
plotly::add_lines(data = dataFrameRecessionDates,
x = ~Dates, y = ~InRecession,
line = list(width = 0),
fill = "tozerox",
fillcolor = "rgba(64, 64, 64, 0.3)",
showlegend = F,
hoverinfo = "none"))
Update: Below is code based on answer provided in enter link description here, but unfortunately it did not work for me
library(plotly)
library(ggplot2)
useOnlyPlotly <- FALSE
thePlot <- plot_ly()
if (useOnlyPlotly)
{
thePlot <- plot_ly() %>%
add_trace(data = economics, x = ~date, y = ~unemploy, type="scatter", mode = "lines")
}else{
theGgplot2Obj <- ggplot(data = economics, aes(x = date, y = unemploy)) + geom_line()
thePlot <- ggplotly(theGgplot2Obj)
thePlot[['x']][['layout']][['shapes']] <- c()
}
( thePlot <- layout(thePlot,
shapes = list(
list(type = "rect",
fillcolor = "blue", line = list(color = "blue"), opacity = 0.5,
x0 = "1980-01-01", x1 = "1990-01-01",
y0 = 6000, y1 = 8000
)
)
)
)
Your idea of using add_lines combined with filltozero is good but the gaps between your shades will be problematic, you would probably need to add NaN in between to get it right.
The real problem is that your input dates are strings and Plotly stores the dates as integers (milliseconds since the epoch). So we would need to convert the dates first and then plot them.
x0 = as.integer(as.POSIXct(trimmedRecessionsDates$Peak[[i]])) * 1000
thePlotlyObjToAnalyze$x$layout$shape <- c()
shapes = list()
for (i in 1:length(trimmedRecessionsDates$MidPoint)) {
shapes[[i]] = list(type = "rect",
fillcolor = "blue", line = list(color = "blue"), opacity = 0.5,
x0 = as.integer(as.POSIXct(trimmedRecessionsDates$Peak[[i]])) * 1000,
x1 = as.integer(as.POSIXct(trimmedRecessionsDates$Trough[[i]])) * 1000,
y0 = 0,
y1 = 1,
yref = 'paper'
)
}
thePlotlyObjToAnalyze <- layout(thePlotlyObjToAnalyze,
shapes = shapes
)

plotly linetype poperty setting in R

I am trying to set the line type("solid", "dash", "dot" etc) for multiple lines in plotly. I have a column(factor variable) in my data frame which specifies the type of line.
Below is the sample code I am working with.
mydf <- data.frame(x = c(1:10), y1 = c(11:20), y2 = c(21:30))
mydf1 <- gather(mydf,'var', 'val', -x)
mydf1$lt <- factor(c(rep("solid",10),rep("dot",10)))
pal <- RColorBrewer::brewer.pal(nlevels(mydf1$lt),"Set1")
p <-plot_ly(mydf1, x = x, y = val, type = 'line', color = var,colors = pal,line = list(width = 3, dash = lt))
p<- layout(p,title = "Hello", annotations = list(x = mydf1$x, y = mydf1$var))
p
mydf1$lt specifies the required line type.
For the above example, y1 must be solid line and y2 must be dotted line.
I can solve the issue by individually adding lines using add_trace(). I am looking for a more concised, elegant way of doing the same. Below is one possible solution.
p1 <- plot_ly(mydf)
p1 <- add_trace(p1, x = x, y = y1, line = list(dash = "dash"))
p1 <- add_trace(p1, x = x, y = y2, line = list(dash = "solid"))
p1
For the above example, y1 must be solid line and y2 must be dotted
line.
You could do
library(ggplot2)
library(tidyr)
library(plotly)
mydf <- data.frame(x = c(1:10), y1 = c(11:20), y2 = c(21:30))
mydf1 <- gather(mydf,'var', 'val', -x)
mydf1$lt <- factor(c(rep("solid",10),rep("dot",10)))
pal <- RColorBrewer::brewer.pal(nlevels(mydf1$lt),"Set1")
p <-plot_ly(
transform(mydf1, lt=c(solid="solid", dot="3")[lt]),
x = x,
y = val,
type = 'line',
color = var,
colors = pal,
line = list(dash = lt)
)
p <- layout(
p,
title = "Hello",
annotations = list(x = mydf1$x, y = mydf1$var)
)
p
Or c(solid="3", dot="solid")[lt] if you want it the other way around.

Resources