In r trying to create a Gant chart - r

I'm trying to use ggplot2 to create a Gant chart.
library(ggplot2)
# Create an example dataframe with date-time values
phase_summary <- data.frame(
Phase = c("Phase 1", "Phase 2", "Phase 3", "Phase 4"),
Starts = as.POSIXct(c("2021-01-01 09:00:00", "2021-02-01 12:30:00", "2021-03-01 10:15:00", "2021-04-01 08:45:00")),
Finishes = as.POSIXct(c("2021-01-31 16:00:00", "2021-02-28 17:30:00", "2021-03-31 14:45:00", "2021-04-30 13:15:00"))
)
# Create a Gantt chart
ggplot(data = phase_summary, aes(x = Phase, y = 1, yend = 1, xmin = Starts, xmax = Finishes)) +
geom_linerange(size = 5, color = "steelblue") +
scale_y_continuous(breaks = 1, labels = "") +
scale_x_datetime(date_labels = "%b %d\n%Y", expand = c(0.1, 0)) +
labs(title = "Project Timeline",
x = "Phases",
y = "") +
theme_bw()
I'm getting the following error:
Error: Invalid input: time_trans works with objects of class POSIXct
only.
This is confusing me as Starts and Finises are POSIXct

Here is my suggestion:
# Create an example dataframe with date-time values
phase_summary <- data.frame(
Phase = c("Phase 1", "Phase 2", "Phase 3", "Phase 4"),
Starts = as.POSIXct(c("2021-01-01 09:00:00", "2021-02-01 12:30:00", "2021-03-01 10:15:00", "2021-04-01 08:45:00")),
Finishes = as.POSIXct(c("2021-01-31 16:00:00", "2021-02-28 17:30:00", "2021-03-31 14:45:00", "2021-04-30 13:15:00"))
)
# Create a Gantt chart
ggplot(data = phase_summary, aes(x = Starts, xend=Finishes,y = Phase, yend = Phase, color=Phase)) +
scale_x_datetime(date_labels = "%b %d\n%Y", expand = c(0.1, 0))+
labs(title = "Project Timeline",
x = "Time",
y = "Phase") +
theme_bw() + geom_segment(size=8)

Your problem is that you have assigned x = Phase. Although Start and Finish are POSIXct, the plot is attempting to map a character variable to a date-time axis and failing.
To get the kind of style you are looking for, you can do:
ggplot(data = within(phase_summary, Phase <- factor(Phase, rev(Phase))),
aes(y = Phase, xmin = Starts, xmax = Finishes, group = Phase)) +
geom_linerange(size = 5, color = "steelblue") +
geom_text(aes(y = "Phase 4", label = Phase,
x = Starts + (Finishes - Starts)/2), nudge_y = -0.5) +
scale_x_datetime(date_labels = "%b %d\n%Y", expand = c(0.1, 0),
breaks = seq(as.POSIXct("2021-01-01"),
by = "month", len = 12), name = "Phases") +
labs(title = "Project Timeline") +
theme_bw() +
theme(axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank())

Related

How to update to custom tool tip for ggbarplot when converting to ggplotly / plotly?

I am creating a bar plot using ggbarplot. I am converting the ggbarplot to plotly so that the graph is interactive in the Shiny app. I want the tooltip to not only show the x and y axis but additional detail (i.e. Frequency).
I know in ggplot you can add the text parameter and include that in the ggplotly function. I am not sure how I can achieve the same result when I am using ggbarplot.
Here is my data and code:
data <- structure(list(`concept name` = structure(4:1, .Label = c("NERVOUS SYSTEM",
"ANTIBACTERIALS FOR SYSTEMIC USE", "ANTIINFECTIVES FOR SYSTEMIC USE",
"CARDIOVASCULAR SYSTEM"), class = "factor", scores = structure(c(`ANTIBACTERIALS FOR SYSTEMIC USE` = 189734,
`ANTIINFECTIVES FOR SYSTEMIC USE` = 200931, `CARDIOVASCULAR SYSTEM` = 201684,
`NERVOUS SYSTEM` = 188122), .Dim = 4L, .Dimnames = list(c("ANTIBACTERIALS FOR SYSTEMIC USE",
"ANTIINFECTIVES FOR SYSTEMIC USE", "CARDIOVASCULAR SYSTEM", "NERVOUS SYSTEM"
)))), `# of Patients` = c(201684, 200931, 189734, 188122), w_cond_rate = c(0.8921,
0.8888, 0.8392, 0.8321), w_exp_rate = c(85.26, 83.92, 73.55,
69.24), freq = c(89.21, 88.88, 83.93, 83.21)), class = c("data.table",
"data.frame"), row.names = c(NA, -4L), .internal.selfref = <pointer: 0x55b1b7cd6e90>)
p <- ggbarplot(
data = data,
y = "# of Patients",
x = "concept name",
orientation = "horiz",
fill = "#D91E49",
color = "#D91E49",
ylab = "Cohort Population",
xlab = "",
width = .5,
text = paste("Freq:", data$freq)
) + theme(legend.title = element_blank()) +
theme(plot.title = element_text(vjust = 1)) +
theme_bw() +
ggtitle("Distribution of Drug Treatments in US population") +
theme(plot.title = element_text(size = 10, face = "bold")) +
theme(plot.caption = element_text(size = 7, color = "red")) +
theme(legend.title = element_blank())
ggplotly(p)
I want to add values from column 'freq' displayed in the hovertext.
Link Shows the solution for ggplot with ggplolty. I am looking to do the same with ggbarplot.
You you achieve your desired result via + aes(text = paste("Freq:", freq)) which adds your tooltip to the set of global aesthetics:
library(ggpubr)
library(plotly)
p <- ggbarplot(
data = data,
y = "# of Patients",
x = "concept name",
orientation = "horiz",
fill = "#D91E49",
color = "#D91E49",
ylab = "Cohort Population",
xlab = "",
width = .5
) +
aes(text = paste("Freq:", freq)) +
theme(legend.title = element_blank()) +
theme(plot.title = element_text(vjust = 1)) +
theme_bw() +
ggtitle("Distribution of Drug Treatments in US population") +
theme(plot.title = element_text(size = 10, face = "bold")) +
theme(plot.caption = element_text(size = 7, color = "red")) +
theme(legend.title = element_blank())
ggplotly(p)

Using ggplot, how does plot the type lines in legend?

Let's suppose that I have the following dataset
Date_spill<-rev(seq(as.Date("2019-02-28"), length = 3135, by = "-1 day"))
Total_var<-data.frame(Total_H1=runif(3135, min=0.5, max = 0.7), Total_H7=runif(3135, min=0.6, max = 0.8), Total_H30=runif(3135, min=0.5, max = 0.8))
CPM_period<-data.frame(x= Date_spill[c(702, 702, 1402, 1402)],
y=c(10, max(Total$Total_H7), max(Total$Total_H7), 10),
period=c("a", "a", "a", "a"))
I want to plot a graph that combines different information. For that reason, each line has a specific color and type. My problem is that using the following code:
library(ggplot2)
Graph<-ggplot()+
theme_test() +
geom_vline(xintercept= Date_spill[667 ], linetype=4)+ #salida swanbank_B
geom_vline(xintercept= Date_spill[1630], linetype=3, color="turquoise4", size=0.8)+ # NEM
geom_vline(xintercept= Date_spill[2900], linetype=1, color="yellow4")+ #Blackout and higher demand
geom_line(aes(x= Date_spill, y = Total_var$Total_H1, color="Total_var$Total_H1"), linetype="dashed", alpha=0.5 )+
geom_line(aes(x= Date_spill, y = Total_var$Total_H7, color="Total_var$Total_H7"), linetype="solid", alpha=0.8)+
geom_line(aes(x= Date_spill, y = Total_var$Total_H30, color="Total_var$Total_H30"), linetype="twodash", alpha = 0.5)+
scale_color_manual(values = c("darkseagreen3", "skyblue3", "firebrick3"), labels= c("Forecast horizon H = 2", "Forecast horizon H = 7", "Forecast horizon H = 30"))+
coord_cartesian(expand=c(0,0), ylim = c(10, 60)) +
geom_polygon(aes(x=CPM_period$x, y=CPM_period$y), colour="gray", alpha=0.2)+
theme(axis.text.x = element_text(angle = 45), legend.position = c(.80, .80)) +
scale_x_date(breaks = seq(min(Date_spill), max(Date_spill), by="6 month"), date_labels = "%Y - %m")+
labs(x = "", y="Aggregated Index",color = NULL, fill = NULL)
The type of lines in the legend is not the type defined for each time series.
What would be an option for getting the type lines in the legend?
You are making things harder for yourself because you are not mapping the aesthetics like linetype and color to variables in your data frame. You can try the following modifications (I have had to modify your data slightly as well because your dummy data did not fit inside the plot boundaries you had set)
Note that it is much easier to map to an aesthetic if your data is in long format (rather than the wide format in your example). We can easily swap that round with tidyr::pivot_longer
df <- tidyr::pivot_longer(Total_var, -1)
ggplot(df, aes(x = Date_spill, y = value, color = name, linetype = name)) +
geom_line() +
geom_vline(xintercept = Date_spill[667 ], linetype = 4) +
geom_vline(xintercept = Date_spill[1630], linetype = 3,
color = "turquoise4", size = 0.8) +
geom_vline(xintercept = Date_spill[2900],
linetype = 1, color = "yellow4") +
geom_polygon(aes(x = x, y = y), data = CPM_period, colour = "gray",
alpha = 0.2, inherit.aes = FALSE) +
scale_color_manual(values = c("darkseagreen3", "skyblue3", "firebrick3"),
labels = c("Forecast horizon H = 2",
"Forecast horizon H = 7",
"Forecast horizon H = 30")) +
scale_linetype_manual(values = 1:3,
labels = c("Forecast horizon H = 2",
"Forecast horizon H = 7",
"Forecast horizon H = 30")) +
scale_x_date(breaks = seq(min(Date_spill), max(Date_spill), by = "6 month"),
date_labels = "%Y - %m") +
coord_cartesian(expand = 0, ylim = c(0.5, 1)) +
theme_test() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = c(.80, .80),
legend.title = element_blank()) +
labs(x = "", y = "Aggregated Index")
Data used
Date_spill <- rev(seq(as.Date("2019-02-28"),
length = 3135, by = "-1 day"))
Total_var <- data.frame(Date_spill,
Total_H1 = runif(3135, 0.5, 0.7),
Total_H7 = runif(3135, 0.6, 0.8),
Total_H30 = runif(3135, 0.5, 0.8))
CPM_period <- data.frame(x = Date_spill[c(702, 702, 1402, 1402)],
y = c(0.5, Inf, Inf, 0.5),
period = c("a", "a", "a", "a"))
Is is important to understand, that plotting especially with ggplot2 works with data table in long format, while your total is in wide format.
So first we have to add the date to the table Total$date_spill = Date_spill and then to transform it to long format
library(reshape2)
total.long = melt(Total, id.vars = "date_spill")
then your plotting could be based on this
ggplot()+
theme_test() +
geom_vline(xintercept= Date_spill[667 ], linetype=4)+ #salida swanbank_B
geom_vline(xintercept= Date_spill[1630], linetype=3, color="turquoise4", size=0.8)+ # NEM
geom_vline(xintercept= Date_spill[2900], linetype=1, color="yellow4")+ #Blackout and higher demand
geom_line(data = total.long, aes(x= date_spill, y = value, group = variable, color=variable,linetype=variable), alpha=0.5 )+
scale_color_manual(values = c("darkseagreen3", "skyblue3", "firebrick3"), labels= c("Forecast horizon H = 2", "Forecast horizon H = 7", "Forecast horizon H = 30"))+
scale_linetype_manual(values=c(2,4,6), labels= c("Forecast horizon H = 2", "Forecast horizon H = 7", "Forecast horizon H = 30"))
Your MWE is a bit erroneous, so the rest produces garbage. But I think you got the idea.

Difficulty Plotting Time Series in R

I have been trying to plot time series data in R. I consulted several different sources online and somehow I am still having problems creating this plots. I have simulated some data below that represents daily information a fictitious company received from 2014 to 2016:
#create data
date_decision_made = seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
date_decision_made <- format(as.Date(date_decision_made), "%Y/%m/%d")
property_damages_in_dollars <- rnorm(731,100,10)
car_damages_in_dollars <- rnorm(731,105,8)
other_damages_in_dollars <- rnorm(731,104,9)
location <- c("canada","usa")
location <- sample(location, 731, replace=TRUE, prob=c(0.3, 0.7))
type_of_house <- c("single","townhome", "rental" )
type_of_house<- sample(type_of_house , 731, replace=TRUE, prob=c(0.5, 0.3, 0.2))
response_variable <- c("claim_approved","claim_rejected")
response_variable<- sample(response_variable, 731, replace=TRUE, prob=c(0.4, 0.6))
final_dataset <- cbind(date_decision_made, property_damages_in_dollars, car_damages_in_dollars, other_damages_in_dollars, location, type_of_house, response_variable)
final_dataset <- as.data.frame(final_dataset)
final_dataset$other_damages_in_dollars = as.numeric(final_dataset$other_damages_in_dollars)
final_dataset$property_damages_in_dollars = as.numeric(final_dataset$property_damages_in_dollars)
final_dataset$car_damages_in_dollars = as.numeric(final_dataset$car_damages_in_dollars)
prop_damage <-subset(final_dataset, select = c(date_decision_made, property_damages_in_dollars))
car_damage <-subset(final_dataset, select = c(date_decision_made, car_damages_in_dollars))
other_damage <-subset(final_dataset, select = c(date_decision_made, other_damages_in_dollars))
new <-subset(final_dataset, select = c(date_decision_made, property_damages_in_dollars, car_damages_in_dollars, other_damages_in_dollars))
Based on this data, I have tried to plot this data as a time series in R. I tried several methods and all of them are producing errors. I have tried to resolve these problems but I just can't seem to figure them out. Could someone please help me?
#first way (error)
library(ggplot2)
library(reshape2) library(dplyr)
ggplot() + geom_line(data = prop_damage, aes(x = date_decision_made, y = property_damages_in_dollars, group = 1), color = "red")
+ scale_x_date(date_breaks = "days" , date_labels = "%b %d %a")+
geom_line(data = car_damage, aes(x = date_decision_made, y = car_damages_in_dollars, group =1 ), color = "blue")
+ geom_line(data = other_damage, aes(x = date_decision_made, y = other_damages_in_dollars, group =1), color = "green")
+ xlab('data_date') + ylab('percent.change')
#second way (error)
ggplot(data = new, aes(x = date_decision_made)) +
geom_line(aes(y = property_damages_in_dollars, colour = "property_damages_in_dollars")) +
geom_line(aes(y = car_damages_in_dollars, colour = "car_damages_in_dollars")) +
geom_line(aes(y =other_damages_in_dollars, colour = "other_damages_in_dollars")) +
scale_colour_manual("",
breaks = c("property_damages_in_dollars", "car_damages_in_dollars", "other_damages_in_dollars"),
values = c("red", "green", "blue")) +
xlab(" ") +
scale_y_continuous("Dollars", limits = c(0,10000)) +
labs(title="demo graph")
#3rd way error
##Subset the necessary columns
dd_sub = new[,c(1,2,3,4)]
##Then rearrange your data frame
library(reshape2)
dd = melt(dd_sub, id=c("date_decision_made"))
ggplot(dd) + geom_line(aes(x=date_decision_made, y=value, colour=variable, group=1)) + scale_x_date(date_breaks = "days" , date_labels = "%b %d %a")+ scale_colour_manual(values=c("red","green","blue"))
#4th error
mymts = ts(new,
frequency = 1,
start = c(2014, 1))
autoplot(mymts) +
ggtitle("Time Series Plot") +
theme(plot.title = element_text(hjust = 0.5))
#5th Method error
x1 = ts(prop_damage, frequency = 1, start = c(2014,1))
x2 = ts(other_damage, frequency = 1, start = c(2014,1))
ts.plot(x, y, gpars = list(col = c("black", "red")))
ts.plot(date_decision_made,gpars= list(col=rainbow(10)))
#6th method error
##Subset the necessary columns
dd_sub = new[,c(1,2,3,4)]
##Then rearrange your data frame
library(reshape2)
dd = melt(dd_sub, id=c("date_decision_made"))
qplot(date_decision_made,value,data=dd,geom='line',color=variable)
#7th way error
x1 = ts(prop_damage, frequency = 1, start = c(2014,1))
x2 = ts(other_damage, frequency = 1, start = c(2014,1))
comb_ts <- cbind(x1, x2)
plot.ts(comb_ts, plot.type = "single")
Could someone please show me what I am doing wrong in these codes? Thanks
Try this approach and be careful with the dates. There are plenty of dates because of years:
#Data
##Then rearrange your data frame
library(reshape2)
dd = melt(dd_sub, id=c("date_decision_made"))
dd$date_decision_made <- as.Date(as.character(dd$date_decision_made),'%Y/%m/%d')
#Plot
ggplot(dd) +
geom_line(aes(x=date_decision_made, y=value, colour=variable, group=1))+
scale_x_date(date_breaks = "months" ,breaks = '12 months', date_labels = "%b %d %a")+
scale_colour_manual(values=c("red","green","blue"))+
theme(axis.text.x = element_text(angle=90))
Output:
Another option is to use pivot_longer from tidyr
library(dplyr)
library(tidyr)
library(ggplot2)
library(lubridate)
dd_sub %>%
pivot_longer(cols = -date_decision_made) %>%
mutate(date_decision_made = ymd(date_decision_made)) %>%
ggplot() +
geom_line(aes(x = date_decision_made, y=value, colour = name, group = 1)) +
scale_x_date(date_breaks = "months", breaks = '12 months',
date_labels = "%b %d %a")+
scale_colour_manual(values=c("red","green","blue"))+
theme(axis.text.x = element_text(angle = 90))

ggplot2: x axis breaks doesn't work with 7 days breaks

I'm trying to figure it out why this function for x axis breaks works perfectly for 2 to 6 days breaks, but gives me an error when I change to 7 days (Error: breaks and labels must have the same length). Thank you
Data Frame
library(tidyverse)
df <- data.frame(date = seq(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"))
df$counts <-sample(seq(from = 20, to = 50, by = 5), size = 365, replace = TRUE)
df<- df %>%
mutate(date = as.Date(date),
counts = as.numeric(counts))
Code
breaks_daily = seq(from = min(df$date), to = max(df$date), by = "1 day")
# Then make the 7 days interval labels
labels_7_days = format(seq(from = min(df$date), to = max(df$date), by = "7 days"), "%b-%d")
labels_final = c(sapply(labels_7_days, function(x) {
c(x, rep("", 6))
}))
#
if ((length(breaks_daily) %% 7) == 0) {
labels_final <- labels_final
} else {
labels_final<- labels_final[-length(labels_final)]
}
myplot <- ggplot(df,
aes(y = counts, x = date)) +
geom_bar(stat = "identity", position = "dodge", fill = "#99CCFF", width=1) +
labs(x="Date", y="Quantity of Fruits") +
scale_x_date(labels = labels_final, breaks = breaks_daily, expand=c(0,0)) +
scale_y_continuous(limits = c(0, 70),
breaks = seq(0, 70, 10),
expand = c(0, 0)) +
ggtitle(paste0("Figure 2: Fruits Example" )) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, size = 35),
axis.text.y = element_text(size = 35),
axis.text = element_text(size = 35),
axis.title = element_text(size = 40, face="bold"),
axis.title.y = element_text(vjust = -2),
axis.title.x = element_text(vjust = -1),
axis.ticks.length = unit(.5, "cm"))
myplot
Not a direct answer to your question, but why don't you just use the inbuilt functionality? Sometimes it is not necessary to reinvent the wheel... ?
library(tidyverse)
df <- data.frame(date = seq(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"))
df$counts <-sample(seq(from = 20, to = 50, by = 5), size = 365, replace = TRUE)
ggplot(df, aes(y = counts, x = date)) +
geom_col() +
scale_x_date(date_breaks = "1 week",date_labels = "%b %d")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
update
Here how to keep the ticks in-between (although I don't think your visualisation gains a lot with it)
You need to bring the two vectors to the same length. When using your label creator, you are creating six empty spaces for each week until the maximum (and including it!), then of course making "too many labels". Just subset the vector by using only the length of your breaks.
P.S. geom_col is identical to geom_bar(stat = "identity") , and in your example you don't need position = position_dodge, as you have no group defined. This argument only makes sense when you are dodging by a group.
library(tidyverse)
df <- data.frame(date = seq(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"))
df$counts <-sample(seq(from = 20, to = 50, by = 5), size = 365, replace = TRUE)
breaks_daily <- seq(from = min(df$date), to = max(df$date), by = "1 day")
labels_7_days <- format(seq(from = min(df$date), to = max(df$date), by = "7 days"), "%b-%d")
labels_final <- c(sapply(labels_7_days, function(x) {
c(x, rep("", 6))
})) [1:length(breaks_daily)] #that is the crucial bit
ggplot(df, aes(y = counts, x = date)) +
geom_col(fill = "#99CCFF", width=1) +
labs(x="Date", y="Quantity of Fruits") +
scale_x_date(labels = labels_final, breaks = breaks_daily, expand=c(0,0)) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
Created on 2020-05-30 by the reprex package (v0.3.0)

Facet by year, with overlapping data

I'm trying to visualize places where I've been over the last few years.
See the code below: I want to facet g1 by year (g2). Do I need to add year-end / year-beginning points to the data frame, or am I missing something obvious?
I've tried setting group = 1, but I'm not entirely sure what it's attempting to do.
My vision is for the final output to look something like this:
Or alternatively, like this, with some tweaking with mapping the "status" column to geom_line
Also, please point out any bad habits / inefficient code.
library("reshape2")
library("ggplot2")
library("scales")
travel <- structure(list(place = c("Brighton", "Madrid", "Home", "Berlin",
"Geneva", "Home", "New York & Canada", "Home", "Isle of Wight",
"Home", "Copenhagen", "Home"), day.out = c("2009-09-06", "2012-07-23",
"2012-07-27", "2012-11-21", "2012-11-23", "2012-11-26", "2013-04-04",
"2013-04-15", "2013-08-26", "2013-08-29", "2014-03-14", "2014-03-17"
), day.back = c("2012-07-22", "2012-07-26", "2012-11-20", "2012-11-22",
"2012-11-25", "2013-04-03", "2013-04-14", "2013-08-25", "2013-08-28",
"2014-03-13", "2014-03-16", "2014-03-30"), status = c("Live",
"Travel", "Live", "Travel", "Travel", "Live", "Travel", "Live",
"Travel", "Live", "Travel", "Live")), .Names = c("place", "day.out",
"day.back", "status"), class = "data.frame", row.names = c(NA,
-12L))
travel$day.out <- as.Date(travel$day.out)
travel$day.back <- as.Date(travel$day.back)
travel$midpoint <- travel$day.out + floor((travel$day.back-travel$day.out)/2)
travel$day.out <- as.character(travel$day.out)
travel$day.back <- as.character(travel$day.back)
travel <- melt(travel, measure.vars = c("day.out", "day.back"))
travel <- travel[order(travel$value, decreasing = TRUE), ]
travel$status <- factor(travel$status)
travel$value <- as.Date(travel$value)
travel$label <- travel$place
travel$label[seq(2, dim(travel)[1], 2)] <- ""
travel$year <- as.numeric(format(travel$value, "%Y"))
pos <- c(-2.5, 2.5)
travel$vjust <- rep(pos, times = dim(travel)[1]/4 , each = 2)
rm(pos)
g1 <- ggplot(travel, aes(y = 0, colour = place)) +
geom_line(aes(x = value, alpha = status), size = 8) +
geom_text(aes(x = midpoint, label = label, vjust = vjust), size = 4) +
scale_y_continuous(breaks = NULL) +
scale_x_date(breaks = date_breaks("1 month"), labels = date_format("%b")) +
labs(list(title = "g1", y = "", x = "")) +
theme_bw() +
theme(axis.text.y = element_blank(),
legend.position = "none")
g2 <- ggplot(travel, aes(y = 0, colour = place)) +
geom_line(aes(x = value, alpha = status), size = 8) +
geom_text(aes(x = midpoint, label = label, vjust = vjust), size = 4) +
scale_y_continuous(breaks = NULL) +
scale_x_date(breaks = date_breaks("1 month"), labels = date_format("%b")) +
labs(list(title = "g2", y = "", x = "")) +
theme_bw() +
theme(axis.text.y = element_blank(),
legend.position = "none") +
facet_grid(year ~ .)
g1
g2
UPDATE 1
I've (manually) added year-beginning / year-end points, which is not ideal (is there a programmatic way to do this?), which has brought a new problem. The dates are of class Date, so faceting by year half-works (see code). I've played with space = "free_x", scales = "free-x", with no success. Also, the code to set the vjust value for geom_text to either 2.5 or 2.5 has gone out of whack, is there a better way to set this?
library("reshape2")
library("ggplot2")
library("scales")
travel <- structure(list(place = c("Brighton", "Brighton", "Brighton",
"Brighton", "Madrid", "Home", "Berlin", "Geneva", "Home", "Home",
"New York & Canada", "Home", "Isle of Wight", "Home", "Home",
"Copenhagen", "Home"), day.out = c("2009-09-06", "2010-01-01",
"2011-01-01", "2012-01-01", "2012-07-23", "2012-07-27", "2012-11-21",
"2012-11-23", "2012-11-26", "2013-01-01", "2013-04-04", "2013-04-15",
"2013-08-26", "2013-08-29", "2014-01-01", "2014-03-14", "2014-03-17"
), day.back = c("2009-12-31", "2010-12-31", "2011-12-31", "2012-07-22",
"2012-07-26", "2012-11-20", "2012-11-22", "2012-11-25", "2012-12-31",
"2013-04-03", "2013-04-14", "2013-08-25", "2013-08-28", "2013-12-31",
"2014-03-13", "2014-03-16", "2014-03-30"), status = c("Live",
"Live", "Live", "Live", "Travel", "Live", "Travel", "Travel",
"Live", "Live", "Travel", "Live", "Travel", "Live", "Live", "Travel",
"Live")), .Names = c("place", "day.out", "day.back", "status"
), class = "data.frame", row.names = c(NA, -17L))
travel$day.out <- as.Date(travel$day.out)
travel$day.back <- as.Date(travel$day.back)
travel$midpoint <- travel$day.out + floor((travel$day.back-travel$day.out)/2)
travel$day.out <- as.character(travel$day.out)
travel$day.back <- as.character(travel$day.back)
travel <- melt(travel, measure.vars = c("day.out", "day.back"))
travel <- travel[order(travel$value, decreasing = TRUE), ]
travel$status <- factor(travel$status)
travel$value <- as.Date(travel$value)
travel$label <- travel$place
travel$label[seq(2, dim(travel)[1], 2)] <- ""
travel$year <- as.numeric(format(travel$value, "%Y"))
# pos <- c(-2.5, -2.5, 2.5, 2.5)
# travel$vjust <- rep(pos, times = dim(travel)[1]/4)
# rm(pos)
g1 <- ggplot(travel, aes(y = 0, colour = place)) +
geom_line(aes(x = value, alpha = status), size = 8) +
geom_text(aes(x = midpoint, label = label), size = 4) +
scale_y_continuous(breaks = NULL) +
scale_x_date(breaks = date_breaks("1 month"), labels = date_format("%b")) +
labs(list(title = "g1", y = "", x = "")) +
theme_bw() +
theme(axis.text.y = element_blank(),
legend.position = "none") +
facet_grid(year ~ .)
g1
UPDATE 2
Hi all,
Haven't had any success with this problem, maybe I over-elaborated in the initial question?
I thought I saw that someone had replied suggesting something with facet_wrap, but the problem from UPDATE 1 (Date class) remains.
You were almost there actually!
The value and midpoint values are specifying the year that you also want to facet over. You need to remove the "year" information from these values if you want the facets to work properly. I simply changed the values to all be this year instead:
travel$value <- as.Date(format(travel$value, "%m-%d"), "%m-%d")
travel$midpoint <- as.Date(format(travel$midpoint, "%m-%d"), "%m-%d")
The only problem I see with your vjust values is that you are trying to replicate them 34/4=8.5 times each, which will round down to 8 and give you an error. You can instead dynamically set the number of replicates using length.out
travel$vjust <- rep(pos, length.out=nrow(travel))
So you can add the vjust back in to your code now:
g1 <- ggplot(travel, aes(y = 0, colour = place)) +
geom_line(aes(x = value, alpha = status), size = 8) +
geom_text(aes(x = midpoint, label = label, vjust=vjust), size = 4) +
scale_y_continuous(breaks = NULL) +
scale_x_date(breaks = date_breaks("1 month"), labels = date_format("%b")) +
labs(list(title = "g1", y = "", x = "")) +
theme_bw() +
theme(axis.text.y = element_blank(),
legend.position = "none") +
facet_grid(year ~ .)
Hope this helps!

Resources