Related
I need to achieve the scatter plot with color, size, symbol and text.
My goal is setting text with different color variable from scatter plot.
The color is from Species
The size is from Sepal.Width
The shape is from shape_1
The text is from Sepal.Width with color from color_1
If I run the first chunk code, it is correct.
Then if I add_trace to display the text, the color messed up
Any idea will be great
dt <- iris
dt$shape_1 <- c("Yes","No")
dt$color_1 <- c("Medium","Large","Small")
plot_ly(dt,
x=1:nrow(iris),
y=~Sepal.Length,
type="scatter",
mode='markers',
color=~Species,
colors = c("#4477AA","#DDCC77","#CC6677"),
size = ~Sepal.Width,
symbol = ~shape_1,
symbols = c("triangle-up", "circle"),
inherit = F,
sizes = c(10, 100) * 10)
dt <- iris
dt$shape_1 <- c("Yes","No")
dt$color_1 <- c("Medium","Large","Small")
plot_ly(dt,
x=1:nrow(iris),
y=~Sepal.Length,
type="scatter",
mode='markers',
color=~Species,
colors = c("#4477AA","#DDCC77","#CC6677"),
size = ~Sepal.Width,
symbol = ~shape_1,
symbols = c("triangle-up", "circle"),
inherit = F,
sizes = c(10, 100) * 10) %>%
add_trace(type="scatter",
mode = "text",
text=~Sepal.Width,
textposition = "top right",
color = ~color_1,
colors = c("black","green","blue"),
textfont = list(size = 10)
)
You can change the text argument in the add_trace() function to use the same color scale as the rest of the markers, also the colour codes should match, that's where the issue is.
plot_ly(
dt,
x = 1:nrow(iris),
y = ~ Sepal.Length,
type = "scatter",
mode = 'markers',
color = ~ Species,
colors = c("#4477AA", "#DDCC77", "#CC6677"),
size = ~ Sepal.Width,
symbol = ~ shape_1,
symbols = c("triangle-up", "circle"),
inherit = F,
sizes = c(10, 100) * 10
) %>%
add_trace(
type = "scatter",
mode = "text",
text = ~ Sepal.Width,
textposition = "top right",
color = ~ Species,
colors = c("#4477AA", "#DDCC77", "#CC6677"),
textfont = list(size = 10
)
)
I'm trying to show a legend in R plotly based on 3 levels.
cols <- c(Poor = "steelblue",
Fair = "slateblue",
Good = "grey45")
I have read multiple entries stating the column must be class factor. Even with that mutate "showlegend = T" does not display a legend. Is it possible do do this without adding all 3 markers separately?
plot_data <- plot_data %>% mutate(label_col = as.factor(label_col))
p <- plot_ly(data = plot_data,
x = ~r_score,
y = ~b_score,
type = "scatter",
marker = list( title = "Rating",
size = ~plot_data$TTM_Units ,
color = ~cols[plot_data$label_col],
line = list(color = 'rgba(1, 0, 0, .8)',
width = 2),
opacity = .5),
showlegend = TRUE,
inherit = TRUE)
You could achieve your desired result by mapping a variable on the color attribute and setting you desired color palette via the colors argument.
Making use of the ggplot2::diamonds dataset as example data:
cols <- c(
Poor = "steelblue",
Fair = "slateblue",
Good = "grey45"
)
library(plotly)
plot_data <- diamonds %>%
filter(cut %in% names(cols))
plot_ly(
data = plot_data,
x = ~carat,
y = ~price,
color = ~cut,
size = ~depth,
type = "scatter",
mode = "markers",
colors = cols,
marker = list(
title = "Rating",
line = list(
color = "rgba(1, 0, 0, .8)",
width = 2
),
opacity = .5
)
)
#> Warning: `line.width` does not currently support multiple values.
#> Warning: `line.width` does not currently support multiple values.
I am trying to produce a heatmap with ggplot2 or plotly in R, where the values associated with a block or tile are used as labels in the respective tile. This was not so difficult, but I have removed the legend and would like to change the colours of the labels conditional on their values to increase their visibility.
Here a reproducible examples to show what I mean.
Data (using data.table and dplyr):
sig <- rep(c("sig1", "sig2", "sig3"), 100, replace = TRUE, prob = c(0.4, 0.35, 0.25))
date <- c("2019-11-01", "2019-11-02", "2019-11-03")
another <- as.data.table(expand.grid(sig, date))
test_dat_numerics <- another[, number_ok := sample(0:100, 900, replace = TRUE)]
setnames(test_dat_numerics, c("Var1", "Var2"), c("sig", "date"))
test_dat_numerics <- test_dat_numerics[, avg := mean(number_ok), by = .(date, sig)] %>%
dplyr::select(-number_ok) %>%
dplyr::rename(number_ok = avg) %>%
dplyr::mutate(prop = ifelse(number_ok > 50, 1, 0))
dplyr::distinct()
The heatmap (with ggplot2):
ggp <- ggplot(test_dat_numerics, aes(date, sig, fill = number_ok)) +
geom_tile() +
geom_text(aes(label = test_dat_numerics$number_ok)) +
theme(legend.position="none")
This results in
The darker a block becomes the less visible the text becomes. To prevent this, my intention is to make the text white when a value is below 50 and black otherwise. This is the part where I failed both with ggplot2 and plotly until now and would be grateful for help.
With plotly:
p <- test_dat_numerics %>%
plot_ly(type = "heatmap",
x = ~date,
y = ~sig,
z = ~number_ok,
# zmax = 100,
# zmin = 0,
showscale = FALSE,
colorscale = "Blues") %>%
add_annotations(text = as.character(test_dat_numerics$number_ok),
showarrow = FALSE,
color = list(if (test_dat_numerics$number_ok[i] > 50) {"black"} else {"white"})) %>%
layout(title = "Test Heatmap",
# titlefont = t,
xaxis = list(title = "Datum"), yaxis = list(title = "Signal")
)
I found a great plotly example here, but I couldn't manage to get to work for my case. Here the annotation part of my code:
ann <- list()
for (i in 1:length(unique(test_dat_numerics$sig))) {
for (j in 1:length(unique(test_dat_numerics$date))) {
for (k in 1:(length(unique(test_dat_numerics$sig))*length(unique(test_dat_numerics$date)))) {
ann[[k]] <- list(
x = i,
y = j,
font = list(color = if (test_dat_numerics$number_ok[i] > 50) {"black"} else {"white"}),
text = as.character(test_dat_numerics$number_ok[[k]]),
xref = "x",
yref = "y",
showarrow = FALSE )
}
}
}
p_test_num_heat <- layout(p, annotations = ann)
Here, one of numerous attempts with ggplot2:
ggp <- ggplot(test_dat_numerics, aes(date, sig, fill = number_ok)) +
geom_tile() +
geom_text(aes(label = test_dat_numerics$number_ok)) +
geom_label(aes(colour = factor(test_dat_numerics$prop))) +
theme(legend.position="none")
(This code produces the plot in the image above if the second to last line is removed.)
I'm pretty stuck on this one... Thanks in advance for any advice!
With ggplot2, you can use colour in the aes of geom_text (+ scale_colour_manual):
ggplot(test_dat_numerics, aes(date, sig, fill = number_ok)) +
geom_tile() +
geom_text(aes(label = number_ok, colour =ifelse(number_ok>50, "black", "white"))) +
scale_colour_manual(values=c("white"="white", "black"="black")) +
theme(legend.position="none")
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
)
When plotting with plotly in R, how does one specify a color and a symbol based on a value? For example with the mtcars example dataset, how to plot as a red square if mtcars$mpg is greater or less than 18?
For example:
library(plotly)
p <- plot_ly(type = "scatter", data = mtcars, x = rownames(mtcars), y = mtcars$mpg,
mode = "markers" )
How to get all points above 20 as yellow squares?
you could do something like this:
plot_ly(type = "scatter", data = mtcars, x = rownames(mtcars), y = mtcars$mpg,
mode = "markers", symbol = ~mpg > 20, symbols = c(16,15),
color = ~mpg > 20, colors = c("blue", "yellow"))
https://plot.ly/r/line-and-scatter/#mapping-data-to-symbols
yes it's possible, I'd make all of your grouping and shape/color specification outside of plot_ly() with cut() first. And then take advantage of the literal I() syntax inside of plot_ly() when referencing your new color and shape vars:
data(mtcars)
mtcars$shape <- cut(mtcars$mpg,
breaks = c(0,18, 26, 100),
labels = c("square", "circle", "diamond"))
mtcars$color <- cut(mtcars$mpg,
breaks = c(0,18, 26, 100),
labels = c("red", "yellow", "green"))
plot_ly(type = "scatter", data = mtcars, x = rownames(mtcars), y = mtcars$mpg,
mode = "markers", symbol = ~I(shape), color = ~I(color))