I have created the following dataframe object and graph using plotly and ggplot
library(ggplot2)
library(plotly)
rdate <- function(x,
min = paste0(format(Sys.Date(), '%Y'), '-01-01'),
max = paste0(format(Sys.Date(), '%Y'), '-12-31'),
sort = TRUE) {
dates <- sample(seq(as.Date(min), as.Date(max), by = "day"), x, replace=TRUE)
if (sort == TRUE) {
sort(dates)
} else {
dates
}
}
DF<-data.frame(Date = rdate(100))
DF$variable<-LETTERS[seq( from = 1, to = 10 )]
DF$Value<-round(runif(1:nrow(DF),min = 10, max = 50))
Next I have created a plot object with ggplot
p <- ggplot(DF, aes(x = Date, y = Value, colour = variable)) +
geom_line() +
ylab(label="Sellcount") +
xlab("Sell Week")
p<-p + scale_y_continuous(sec.axis = dup_axis())
ggplotly(p)
IF i plot p using plot(p), the graph has 2 yaxes as I expect. However, when I use ggplotly(p) to plot the graph, only one Y axis is generated. I am unable to find any literature on the internet regarding the same. I request someone to help me in this.
A simple workaround is to add the second axis manually:
ay <- list(
tickfont = list(size=11.7),
titlefont=list(size=14.6),
overlaying = "y",
nticks = 5,
side = "right",
title = "Second y axis"
)
ggplotly(p) %>%
add_lines(x=~Date, y=~Value, colors=NULL, yaxis="y2",
data=DF, showlegend=FALSE, inherit=FALSE) %>%
layout(yaxis2 = ay)
Related
For some reason when producing a plotly graph with the ggplotly function, the filtering does not seem to resize the y-axis. The filtered portion are simply removed, while yaxis stays at it's original length. Please see this example:
library(plotly)
library(ggplot2)
library(dplyr)
lab <- paste("Vertical Label", c(1, 2, 3, 4, 5))
ds <- data.frame(x = sample(lab, size = 1000, replace = T),
y = sample(LETTERS[1:5], size = 1000, replace = T)) %>%
group_by(x,y) %>% summarise(count= n())
ggplotly(
ggplot(ds, aes(x = x,y=count, fill = y)) +
geom_col() +
theme(axis.text.x = element_text(angle = 90))
)
Same approach with plot_ly function works. However, I needed similar results with ggploty
plot_ly(ds, x = ~x, y = ~count, type = 'bar', color = ~y
) %>% layout(title = "Vertical Axis Lables",
xaxis = list(title = ""),
yaxis = list(title = ""), barmode = 'stack')
I couldn't find anything helpful in stack overflow or google. Just came across an incomplete answer here:
https://community.rstudio.com/t/ggplotly-bar-chart-not-resizing-after-filtering/115675/3
Any help will be greatly appreciated.
Applying a tip from R Plotly Legend Filtering enables re-stacking and similar ordering, while enabling auto-scaling provides y-axis adaptation:
library(plotly)
library(ggplot2)
library(dplyr)
lab <- paste("Vertical Label", c(1, 2, 3, 4, 5))
ds <- data.frame(x = sample(lab, size = 1000, replace = T),
y = sample(LETTERS[1:5], size = 1000, replace = T)) %>%
group_by(x,y) %>% summarise(count= n())
p <- ggplotly(
ggplot(ds, aes(x = x,y=count, fill = y)) +
geom_col() +
theme(axis.text.x = element_text(angle = 90))
)
for (i in 1:length(p$x$data)) {
p$x$data[[i]]$base <- c()
tmp <- p$x$data[[i]]
p$x$data[[i]] <- p$x$data[[length(p$x$data) - i + 1]]
p$x$data[[length(p$x$data) - i + 1]] <- tmp
}
p
It is only necessary to reset the base of the plotly variable for each of the x-axis elements that will be plotted.
for (i in 1:length(p$x$data)) {
p$x$data[[i]]$base <- c()
}
In the above example, if you reset the order, (1) D does not resize and (2) purple overlays A (A is never seen unless purple is filtered).
I'd like to plot histogram and density on the same plot. What I would like to add to the following is custom y-axis label which would be something like sprintf("[%s] %s", ..density.., ..count..) - two numbers at one tick value. Is it possible to obtain this with scale_y_continuous or do I need to work this around somehow?
Below current progress using scales::trans_new and sec_axis. sec_axis is kind of acceptable but the most desirable output is as on the image below.
set.seed(1)
var <- rnorm(4000)
binwidth <- 2 * IQR(var) / length(var) ^ (1 / 3)
count_and_proportion_label <- function(x) {
sprintf("%s [%.2f%%]", x, x/sum(x) * 100)
}
ggplot(data = data.frame(var = var), aes(x = var, y = ..count..)) +
geom_histogram(binwidth = binwidth) +
geom_density(aes(y = ..count.. * binwidth)) +
scale_y_continuous(
# this way
trans = trans_new(name = "count_and_proportion",
format = count_and_proportion_label,
transform = function(x) x,
inverse = function(x) x),
# or this way
sec.axis = sec_axis(trans = ~./sum(.),
labels = percent,
name = "proportion (in %)")
)
I've tried to create object with breaks before basing on the graphics::hist output - but these two histogram differs.
bins <- (max(var) - min(var))/binwidth
hdata <- hist(var, breaks = bins, right = FALSE)
# hist generates different bins than `ggplot2`
At the end I would like to get something like this:
Would it be acceptable to add percentage as a secondary axis? E.g.
your_plot + scale_y_continuous(sec.axis = sec_axis(~.*2, name = "[%]"))
Perhaps it would be possible to overlay the secondary axis on the primary one, but I'm not sure how you would go about doing that.
You can achieve your desired output by creating a custom set of labels, and adding it to the plot:
library(tidyverse)
library(ggplot2)
set.seed(1)
var <- rnorm(400)
bins <- .1
df <- data.frame(yvals = seq(0, 20, 5), labels = c("[0%]", "[10%]", "[20%]", "[30%]", "[40%]"))
df <- df %>% tidyr::unite("custom_labels", labels, yvals, sep = " ", remove = TRUE)
ggplot(data = data.frame(var = var), aes(x = var, y = ..count..)) +
geom_histogram(aes(y = ..count..), binwidth = bins) +
geom_density(aes(y = ..count.. * bins), color = "black", alpha = 0.7) +
ylab("[density] count") +
scale_y_continuous(breaks = seq(0, 20, 5), labels = df$custom_labels)
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")
I am creating animated plotly graph for my assignment in r, where I am comparing several models with various number of observations. I would like to add annotation showing what is the RMSE of the current model - this means I would like to have text that changes together with slider. Is there any easy way how to do that?
Here is my dataset stored on GitHub. There already is created variable with RMSE: data
The base ggplot graphic is as follows:
library(tidyverse)
library(plotly)
p <- ggplot(values_predictions, aes(x = x)) +
geom_line(aes(y = preds_BLR, frame = n, colour = "BLR")) +
geom_line(aes(y = preds_RLS, frame = n, colour = "RLS")) +
geom_point(aes(x = x, y = target, frame = n, colour = "target"), alpha = 0.3) +
geom_line(aes(x = x, y = sin(2 * pi * x), colour = "sin(2*pi*x)"), alpha = 0.3) +
ggtitle("Comparison of performance) +
labs(y = "predictions and targets", colour = "colours")
This is converted to plotly, and I have added an animation to the Plotly graph:
plot <- ggplotly(p) %>%
animation_opts(easing = "linear",redraw = FALSE)
plot
Thanks!
You can add annotations to a ggplot graph using the annotate function: http://ggplot2.tidyverse.org/reference/annotate.html
df <- data.frame(x = rnorm(100, mean = 10), y = rnorm(100, mean = 10))
# Build model
fit <- lm(x ~ y, data = df)
# function finds RMSE
RMSE <- function(error) { sqrt(mean(error^2)) }
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
annotate("text", x = Inf, y = Inf, hjust = 1.1, vjust = 2,
label = paste("RMSE", RMSE(fit$residuals)) )
There seems to be a bit of a problem converting between ggplot and plotly. However this workaround here shows a workaround which can be used:
ggplotly(plot) %>%
layout(annotations = list(x = 12, y = 13, text = paste("RMSE",
RMSE(fit$residuals)), showarrow = F))
Here's an example of adding data dependent text using the built in iris dataset with correlation as text to ggplotly.
library(plotly)
library(ggplot2)
library(dplyr)
mydata = iris %>% rename(variable1=Sepal.Length, variable2= Sepal.Width)
shift_right = 0.1 # number from 0-1 where higher = more right
shift_down = 0.02 # number from 0-1 where higher = more down
p = ggplot(mydata, aes(variable1,variable2))+
annotate(geom = "text",
label = paste0("Cor = ",as.character(round(cor.test(mydata$variable1,mydata$variable2)$estimate,2))),
x = min(mydata$variable1)+abs(shift_right*(min(mydata$variable1)-max(mydata$variable1))),
y = max(mydata$variable2)-abs(shift_down*(min(mydata$variable2)-max(mydata$variable2))), size=4)+
geom_point()
ggplotly(p) %>% style(hoverinfo = "none", traces = 1) # remove hover on text
I have data in following format.
X ID Mean Mean+Error Mean-Error
61322107 cg09959428 0.39158198 0.39733463 0.38582934
61322255 cg17147820 0.30742542 0.31572314 0.29912770
61322742 cg08922201 0.47443355 0.47973039 0.46913671
61322922 cg08360511 0.06614797 0.06750279 0.06479315
61323029 cg00998427 0.05625839 0.05779519 0.05472160
61323113 cg15492820 0.10606674 0.10830587 0.10382761
61323284 cg02950427 0.36187007 0.36727818 0.35646196
61323413 cg01996653 0.35582920 0.36276991 0.34888849
61323667 cg14161454 0.77930230 0.78821970 0.77038491
61324205 cg25149253 0.93585347 0.93948514 0.93222180
How can i plot error bar plot with column(bars)
enter image description here
where X-Axis is having X value. So each bar will be plotted at X of fixed width.
I'll try answering. I am using a package called plotly. You can look here for more details.
df <- read.csv('test.csv')
colnames(df) <- c("x", "id", "mean", "mean+error", "mean-error")
df$`mean+error` = df$`mean+error` - df$mean
df$`mean-error` = df$mean - df$`mean-error`
library(plotly)
p <- ggplot(df, aes(factor(x), y = mean)) + geom_bar(stat = "identity")
p <- plotly_build(p)
length(p$data)
p$layout$xaxis
plot_ly(df, x = 1:10, y = mean, type = "bar",
error_y = list(symmetric = F,
array = df$`mean+error`,
arrayminus = df$`mean-error`,
type = "data")) %>%
layout(xaxis = list(tickmode = "array",tickvals = 1:10,ticktext = df$x))
I get this:
The most popular approach would probably be using geom_errorbar() in ggplot2.
library("ggplot2")
ggplot(df, aes(x=ID, y = Mean)) +
geom_bar(stat="identity", fill="light blue") +
geom_errorbar(aes(ymin = Mean.Error, ymax = Mean.Error.1))
where Mean.Error and Mean.Error.1 are the header names for mean +/- error you get when you try to read in your example as text.