failed to convert my ggplot to interactive plot using ggplotly function - r

I'm making a stacked barplot. The width of the bar is set according to variable w.
library(plotly)
library(tidyverse)
df = data.frame(x = c("a","b","c"),
w = c(1.2, 1.3, 4),
y = c(9, 10, 6) )
dat = df %>% mutate(pos = 0.5 * (cumsum(w) + cumsum(c(0, w[-length(w)]))))
g= dat %>% ggplot(aes(x = pos, y = y, fill = x)) +
geom_bar(aes( width = w), stat = "identity") +
scale_x_continuous(labels = df$x, breaks = dat$pos)
ggplotly(g)
The ggplot is fine. But when I tried to convert it to interactive using ggplotly, I got error message as below:
Error in nchar(axisObj$ticktext) : 'nchar()' requires a character vector
Does anyone know why this failed? Thanks.

The Problem is your x-axis scaling.
This should work:
library(plotly)
library(tidyverse)
df = data.frame(x = c("a","b","c"),
w = c(1.2, 1.3, 4),
y = c(9, 10, 6) )
dat = df %>% mutate(pos = 0.5 * (cumsum(w) + cumsum(c(0, w[-length(w)]))))
g= dat %>% ggplot(aes(x = pos, y = y, fill = x)) +
geom_bar(aes(width = w), stat = "identity") +
scale_x_continuous(labels = levels(df$x), breaks = dat$pos)
ggplotly(g)
ggplot seems to keep your x-axis labels as factor-levels which ggplotly doesn't understand.
So you just need to convert them to character.

Related

gganimate - have geom_rect adjust each frame

I have the following data:
library(ggplot2)
library(gganimate)
library(tidyverse)
createData<- function(vintage, id){#create data
# Generate a sequence of dates from 2010-01-01 to 2025-12-31 with a quarterly frequency
Dates <- seq(from = as.Date("2010-01-01"), to = as.Date("2025-12-31"), by = "quarter")
RLG<- cumsum(sample(c(-1, 1), 64, TRUE))
df<- data.frame( Dates,RLG, vintage,id)
return(df)
}
#createData
df<- createData("2018-01-01",1) %>%
rbind(createData("2019-01-01",2))%>%
rbind(createData("2020-01-01",3)) %>%
rbind(createData("2021-01-01",4))%>%
rbind(createData("2022-01-01",5))%>%
rbind(createData("2023-01-01",6))%>%
rbind(createData("2024-01-01",7))%>%
rbind(createData("2025-01-01",8))
Which I use to make the following chart:
options(gganimate.nframes = 8*length(unique(df$vintage)), gganimate.res = 30)
p<- ggplot(df) +
aes(x = Dates, y = RLG, group = as.Date(vintage), colour = "RLG") +
geom_line()+
scale_y_continuous(labels = \(x) paste0(x, "%"))+
theme(axis.title = element_blank(),legend.position="none")+
transition_time(id)+
exit_fade(alpha = 0.5)+
shadow_mark(alpha = 0.2)
animate(p, end_pause = 30)
I would like to add a geom_rect which goes from vintage to max(Dates). At each frame, vintage will increase, so the geom_rect will shrink slightly. How can I do this without interfering with the shadow_mark and exit_fades which I am applying to the lines?
If you mean something like a progress bar you could do it like so:
create an DF for the geom which is a subset of the original
df_geom <- df |>
mutate(vintage = as.Date(vintage)) |>
group_by(id) |>
slice(n())
Use geom_segment with the DF from above.
If you want to leave shadow_mark in you can do shadow_mark(exclude_layer = 2).
p <- ggplot(df) +
aes(x = Dates, y = RLG, group = as.Date(vintage), colour = RLG) +
geom_line()+
scale_y_continuous(labels = \(x) paste0(x, "%"))+
theme(axis.title = element_blank(),legend.position="none") +
geom_segment(
data = df_geom,
mapping = aes(x=vintage, xend=Dates,
y = 18, yend = 18),
size = 10, alpha =.4, color ='lightblue'
) +
transition_time(id)+
exit_fade(alpha = 0.5)
# shadow_mark(alpha = 0.2)
animate(p)

How to highlight points from and hist chart in R

I have some troubles with my code. I'm very very beginner in R, so I would like some help. I have a dataframe and I need to make an hist chart and then highlight some points. But I cannot understand how to find those points in my dataset. Here is and example of what I have.
x <- c("a","b","c","d","f","g","h","i","j","k")
y <- c(197421,77506,130474,18365,30470,22518,70183,15378,29747,11148)
z <- data.frame(x,y)
hist(z$y)
For example, how can I find in the hist where is the "a" and "h" value placed? and in a barplot? I tried the function points, but I cannot find the coordinates. Please let me know how could I make that . Thanks in advance.
Here is a way with dplyr and ggplot2. The approach is to cut the y variable into bins and then use summarise to create the counts and the labels.
library(dplyr)
library(ggplot2)
z %>%
mutate(bins = cut(y, seq(0, 200000, 50000))) %>%
group_by(bins) %>%
summarise(xes = paste0(x, collapse = ", "),
count = n()) %>%
ggplot() +
geom_bar(aes(x = bins, y = count), stat = "identity", color = "black", fill = "grey") +
geom_text(aes(x = bins, y = count + 0.5, label = xes)) +
xlab("y")
Here is a more complicated way that makes a plot that looks more like what hist() produces.
z2 <- z %>%
mutate(bins = cut(y, seq(0, 200000, 50000))) %>%
group_by(bins) %>%
summarise(xes = paste0(x, collapse = ", "),
count = n()) %>%
separate(bins, into = c("start", "end"), sep = ",") %>%
mutate(across(start:end, ~as.numeric(str_remove(., "\\(|\\]"))))
ggplot() +
geom_histogram(data = z, aes(x = y), breaks = seq(0, 200000, 50000),
color = "black", fill = "grey") +
geom_text(data = z2, aes(x = (start + end) / 2, y = count + 0.5, label = xes))

How to pass break values to stat_contour by facet or group

I am trying to use the ks library to calculate the 95% home range for groups within a data set. The problem is that the "break" values which define the cut-off for the 95% contours differ between groups. So far, I have been able to get my plots, but I have to manually add the break values for each group/level and I would really like to find a solution where I can create figures in ggplot where the break values are imported automatically.
require(ks)
require(dplyr)
require(ggplot2)
# define the ks function to pass to a grouped_df
ksFUN = function(data){
H = Hpi(data[,c("x","y")], binned = TRUE) * 1
fhata = kde(data[,c("x","y")], H = H, compute.cont = TRUE,
xmin = c(minX, minY), xmax = c(maxX, maxY))
res95 = data.frame(HR = contourSizes(fhata, cont = 95, approx = TRUE))
dimnames(fhata[['estimate']]) = list(fhata[["eval.points"]][[1]],
fhata[["eval.points"]][[2]])
dat = reshape2::melt(fhata[['estimate']])
dat$breaks50 = fhata[["cont"]]["50%"]
dat$breaks95 = fhata[["cont"]]["5%"]
return(dat)
}
set.seed(100)
# create some data
df1 = data.frame(x = rnorm(100, 0, 5),
y = rnorm(100, 0, 5),
Group = "Test1")
df2 = data.frame(x = rnorm(100, 10, 5),
y = rnorm(100, 10, 5),
Group = "Test2")
df = rbind(df1, df2)
# Set the minimum and maximum x and y values outside
# of the ksFUN to keep the data on the same scale
minX = min(df$x, na.rm = T); maxX = max(df$x, na.rm = T)
minY = min(df$y, na.rm = T); maxY = max(df$y, na.rm = T)
xx = df %>%
group_by(Group) %>%
do(as.data.frame(ksFUN(.)))
# extract the break value for the 95% contour (home range) and 50% (core area)
breaks = xx %>%
group_by(Group) %>%
summarize(breaks95 = mean(breaks95),
breaks50 = mean(breaks50))
breaks
# The only way I have been able to add the breaks is to manually add them
ggplot(data = xx, aes(x = Var1, y = Var2, fill = Group)) +
geom_point(data = df, aes(x = x, y = y, col = Group)) +
stat_contour(data = xx[xx$Group == "Test1",], aes(z = value),
breaks = 0.000587, alpha = 0.3, geom = "polygon") +
stat_contour(data = xx[xx$Group == "Test2",], aes(z = value),
breaks = 0.000527, alpha = 0.3, geom = "polygon")
I would really like to find a solution where I don't have to explicitly pass the break values to the stat_contour functions
Is there a problem with using the breaks column in breaks? e.g.
# base plot
pl <- ggplot(data = xx, aes(x = Var1, y = Var2, fill = Group)) +
geom_point(data = df, aes(x = x, y = y, col = Group))
groups <- unique(xx$Group)
# loop and add for each group
for(i in groups){
pl <- pl + stat_contour(data = xx[xx$Group == i,], aes(z = value),
breaks = breaks[breaks$Group == i, ]$breaks,
alpha = 0.3, geom = "polygon")
}
pl
I get some weird plots, at the edges, especially when I remove the breaks part from stat_contour, which leads me to think there might be a bug in ksFUN

Converting ggplot object to plotly object creates axis title that overlaps tick values

I had the same issue described in this question:
R: ggplot and plotly axis margin won't change
but when I implemented the solution, I got the following error:
Warning: Ignoring unknown aesthetics: text We recommend that you use the dev version of ggplot2 with ggplotly() Install it with: devtools::install_github('hadley/ggplot2') Error in tmp[[2]] : subscript out of bounds
This code will produce this error on my machine:
library(gapminder)
library(plotly)
library(ggplot2)
lead <- rep("Fred Smith", 30)
lead <- append(lead, rep("Terry Jones", 30))
lead <- append(lead, rep("Henry Sarduci", 30))
proj_date <- seq(as.Date('2017-11-01'), as.Date('2017-11-30'), by = 'day')
proj_date <- append(proj_date, rep(proj_date, 2))
set.seed(1237)
actHrs <- runif(90, 1, 100)
cummActHrs <- cumsum(actHrs)
forHrs <- runif(90, 1, 100)
cummForHrs <- cumsum(forHrs)
df <- data.frame(Lead = lead, date_seq = proj_date,
cActHrs = cummActHrs,
cForHrs = cummForHrs)
makePlot <- function(dat=df, man_level = 'Lead') {
p <- ggplot(dat, aes_string(x='date_seq', y='cActHrs',
group = man_level,
color = man_level),
linetype = 1) +
geom_line() +
geom_line(data=df,
aes_string(x='date_seq', y = 'cForHrs',
group = man_level,
color = man_level),
linetype = 2)
p <- p + geom_point(aes(text=sprintf('%s\nManager: %s\n MTD Actual Hrs: %s\nMTD Forecasted Hrs: %s',
date_seq, Lead, round(cActHrs, 2), round(cForHrs, 2))))
p <- p + theme_classic() + ylab('Hours') + xlab('Date')
gp <- ggplotly(p, tooltip = "text") %>% layout(hovermode = "compare")
### FIX IMPLEMENTED HERE ###
gp[['x']][['layout']][['annotations']][[2]][['x']] <- -0.1
gp %>% layout(margin = list(l = 75))
return(gp)
}
## run the example
p1 <- makePlot()
Try this:
makePlot <- function(dat=df, man_level = "Lead") {
dat$var <- dat[,man_level]
dat$grp <- ""
p <- ggplot(dat, aes(x=date_seq, y=cActHrs,
group = var, color = var,
text=paste0("Manager:", date_seq,"<br>MTD Actual Hrs:", round(cActHrs, 2),
"<br>MTD Forecasted Hrs:", round(cForHrs, 2))),
linetype = 1) +
geom_line() +
geom_line(data=dat,
aes(x=date_seq, y = cForHrs,
group = var, color = var),
linetype = 2) +
geom_point() +
theme_classic() + ylab("Hours") + xlab("Date") +
scale_color_discrete(name=man_level) +
facet_wrap(~grp)
gp <- ggplotly(p, tooltip = "text")
# Set y-axis label position
gp[["x"]][["layout"]][["annotations"]][[2]][["x"]] <- -0.06
# Set legend label position
gp[["x"]][["layout"]][["annotations"]][[3]][["y"]] <- 0.93
gp <- gp %>% layout(margin = list(l = 120, b=70), hovermode = "compare")
return(gp)
}
The problem in your case is the opposite of the linked question. Your axis title is a real axis title, not an annotation. Currently there is no solution to move axis titles in any direction (see https://github.com/lleslie84/plotly.js/pull/1).
Workarounds like adding line breaks to the axis title or adding spaces to the tick labels don't work in your case.
One possible workaround would be to add an annotation with your axis title. The annotation can then be freely moved.
gp <- layout(gp, yaxis = list(title = ""),
margin = list(l = 100),
annotations = c(list(text = "Hours",
x = -0.15,
xref = "paper",
showarrow = F,
textangle = -90))
)
Complete code
library(gapminder)
library(plotly)
library(ggplot2)
lead <- rep("Fred Smith", 30)
lead <- append(lead, rep("Terry Jones", 30))
lead <- append(lead, rep("Henry Sarduci", 30))
proj_date <- seq(as.Date('2017-11-01'), as.Date('2017-11-30'), by = 'day')
proj_date <- append(proj_date, rep(proj_date, 2))
set.seed(1237)
actHrs <- runif(90, 1, 100)
cummActHrs <- cumsum(actHrs)
forHrs <- runif(90, 1, 100)
cummForHrs <- cumsum(forHrs)
df <- data.frame(Lead = lead, date_seq = proj_date,
cActHrs = cummActHrs,
cForHrs = cummForHrs)
makePlot <- function(dat=df, man_level = 'Lead') {
p <- ggplot(dat, aes_string(x='date_seq', y='cActHrs',
group = man_level,
color = man_level),
linetype = 1) +
geom_line() +
geom_line(data=df,
aes_string(x='date_seq', y = 'cForHrs',
group = man_level,
color = man_level),
linetype = 2)
p <- p + geom_point(aes(text=sprintf('%s\nManager: %s\n MTD Actual Hrs: %s\nMTD Forecasted Hrs: %s',
date_seq, Lead, round(cActHrs, 2), round(cForHrs, 2))))
p <- p + theme_classic() + ylab('Hours') + xlab('Date')
gp <- ggplotly(p, tooltip = "text") %>% layout(hovermode = "compare")
### FIX IMPLEMENTED HERE ###
gp <- layout(gp,
yaxis = list(title = ""),
margin = list(l = 100),
annotations = c(list(text = "Hours",
x = -0.15,
xref = "paper",
showarrow = F,
textangle = -90))
)
return(gp)
}
## run the example
p1 <- makePlot()
p1

Plotting x axes with increasing and decreasing x-values in R

I have been trying to plot x axes with increasing and the decreasing data values in R
i.e x-axes have values from [60 to 90 to 60], corresponding to different y-values
how can I do this?
This might not be an exact answer but you can use ggplot() and facet_wrap to achieve something similar:
library(ggplot2)
library(dplyr)
library(gridExtra)
# GGPLOT2
x = c(1:50, 50:1)
y = x + rnorm(1000)
group = rep(c("A", "B"), each = 50)
df <- data.frame(x, y, group)
p1 <- df %>%
filter(group == "A") %>%
ggplot(aes(x, y, color = "A")) + geom_point() + ggtitle("UP") + guides(color = F)
p2 <- df %>%
filter(group == "B") %>%
ggplot(aes(x, y, color = "B")) + geom_point() + scale_x_reverse() + ggtitle("DOWN") + guides(color = F)
grid.arrange(p1, p2, nrow = 1)
Recently the plotly package has been receiving a lot of attention. You could do the following using ploy_ly():
# PLOTLY
library(plotly)
p <- df %>%
filter(group == "A") %>%
plot_ly(x = x, y = y, mode = "markers") %>%
layout(xaxis = list(domain = c(0, 0.5)))
p <- df %>%
filter(group == "A") %>%
add_trace(p, x = x, y = y, mode = "markers", xaxis = "x2", yaxis = "y2", data = .) %>%
layout(xaxis2 = list(autorange = "reversed",
domain = c(0.5, 1)),
yaxis2 = list(overlaying = "y",
side = "right"))
p
Is this what you are looking for?
x = c(1,2,3,4,5,6,7,6,5,4,3,2,1)
y = c(4,5,6,7,8,11,12,23,45,25,11,16,2)
ggplot(data.frame(x=1:length(x), y))+
geom_point(aes(x=x, y=y))+
scale_x_discrete(labels = as.character(x))
This will not work so well if x is not in the proper order or has missing values. You should consider adding a MWE along with your attempts in your question.

Resources