Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 201839

Create a more aesthetically pleasing timeline in R and ggplot2? [closed]

$
0
0

I've been working on a timeline for my company that displays each new country that has had a business engagement for that year, basically the SQL queries fetch the information from the database and then the timeline is created through ggplot2 and other packages, making a transparent PNG image in the end.

It can be updated through another app that other developers created, so it's fully automated and simple for marketing folks to generate.

Unfortunately, it doesn't look too appealing and I've been instructed to spruce it up!

The colors are necessary as it goes with the colors of the countries that I have on a separate map.

I would really appreciate any suggestions and recommendations!

Here is the code:

library(ggplot2)

library(dplyr)

library(ggalt)

library(cowplot)

library(tibble)

library(lubridate)

library(RODBC)

#Connecting to the SQL server

con <-odbcDriverConnect("Driver={ODBC Driver 13 for SQL Server};

Server=ceasql-east.database.windows.net; Database=Central_Prod;

Uid=data_importer; Pwd=NotAddingTheRealPasswordLOL")

sqldf <- sqlQuery(con, "

SELECT

CASE WHEN Country_Name_en = 'Dominican Republic' THEN 'Dominican R.' ELSE Country_Name_en END AS Country_Name_en,

CAST(DATEADD(yy, DATEDIFF(yy, 0, CEA_ACTIVE_SINCE), 0) AS DATE) CleanYear,

Row_Number() OVER (PARTITION BY ISNULL(CAST(DATEPART(year, CEA_ACTIVE_SINCE) AS Varchar(500)), 'Not Yet') ORDER BY Country_Name_en)*-.03 + -.1 AS Distance,

ISNULL(CAST(DATEPART(year, CEA_ACTIVE_SINCE) AS Varchar(500)), 'Not Yet') as ActiveYear,

CASE WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2008 THEN '#61799b'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2009 THEN '#6f8cb0'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2010 THEN '#84a1c2'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2011 THEN '#9eb8d5'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2012 THEN '#649166'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2013 THEN '#5e9764'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2014 THEN '#5ba168'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2015 THEN '#63a768'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2016 THEN '#fc992b'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2017 THEN '#ffae3d'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2018 THEN '#fbce61'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2019 THEN '#ffae58'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2020 THEN '#9c28ba'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2021 THEN '#761c8d'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2022 THEN '#571967'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2023 THEN '#500b63'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2024 THEN '#c57269'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2025 THEN '#9f3c3c'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2026 THEN '#762121'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2027 THEN '#540f0f'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2028 THEN '#b838ac'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2029 THEN '#ce2fbf'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2030 THEN '#df1bcd'

WHEN DATEPART(year, CEA_ACTIVE_SINCE) = 2031 THEN '#ec0fd7'

ELSE '#E2E2E2'

END AS Color

FROM location_Countries

WHERE CEA_ACTIVE_SINCE IS NOT NULL")

#Selecting The relevant data

newdata <- data.frame(sqldf$Country_Name_en, sqldf$ActiveYear, sqldf$CleanYear,

sqldf$Distance, sqldf$Color)

colnames(newdata)[1] <- "Countries"

colnames(newdata)[2] <- "status"

colnames(newdata)[3] <- "Year"

colnames(newdata)[4] <- "displ"

colnames(newdata)[5] <- "Color"

data <- newdata

#Function to shift x-axis to 0 adapted from link shown above

shift_axis <- function(p, xmin, xmax, y=0){

g <- ggplotGrob(p)

dummy <- data.frame(y=y)

ax <- g[["grobs"]][g$layout$name == "axis-b"][[1]]

p + annotation_custom(grid::grobTree(ax, vp = grid::viewport(y=1, height=sum(ax$height))),

ymax=y, ymin=y) +

annotate("segment", y = 0, yend = 0, x = xmin, xend = xmax,

arrow = arrow(length = unit(0.1, "inches"))) +

theme(axis.text.x = element_blank(),

axis.ticks.x=element_blank())}

#Conditionally set whether text will be above or below the point

vjust = ifelse(data$displ > 0, -.2, -2)

data <- data[order(data$Year), ]

status_levels <- unique(data$status)

status_colors <- unique(as.character(data$Color))

data$status <- factor(data$status, levels=status_levels, ordered=FALSE)

nrow(data)

#plotting the data and specifying the limits

p1 <- data %>%

ggplot(aes(Year, displ, col=status)) +

scale_color_manual(values=status_colors, labels=status_levels, drop = FALSE) +

geom_text(aes(x = Year, y = displ, label = Countries), data = data,

hjust = 0, vjust = vjust, size = 3.5, fontface ="bold", show.legend = FALSE) +

theme(axis.title = element_blank(),

axis.text.y = element_blank(),

axis.ticks.y = element_blank(),

axis.line = element_blank(),

axis.text.x = element_text(size = 8),

legend.position = "none") +

expand_limits(x = c(ymd(20080101), ymd(20200101)), y = 1) +

scale_x_date(breaks = scales::pretty_breaks(n = 20))

p1 + theme(legend.position="none")

#and run the function from above

timeline <- shift_axis(p1, ymd(20080101), ymd(20200101))

#Saving the timeline into a PNG file

timeline <- timeline + ggpubr::theme_transparent()

ggsave(filename = "CEATimeLine.png",

plot = timeline,

bg = "transparent",

width = 17, height = 11.5, units = "in")

?ggsave

timeline

The timeline generated


Viewing all articles
Browse latest Browse all 201839

Trending Articles