Time Series Heat Map - r

I wish to create a single heatmap using ggplot including following factors:
year-month, mkt_name, mp_price
str(df)
'data.frame': 2655 obs. of 5 variables:
$ year : int 2012 2012 2012 2012 2012 2012 2012 2012 2012 2012 ...
$ yearmonthf: Factor w/ 48 levels "Jan 2012","Feb 2012",..: 1 2 3 4 5 6 7 8 9 10 ...
$ month : int 1 2 3 4 5 6 7 8 9 10 ...
$ mkt_name : Factor w/ 63 levels "Base","Birambo",..: 2 2 2 2 2 2 2 2 2 2 ...
$ mp_price : num 145 136 160 163 181 ...
df <- read.csv('/Users/shashankshekhar/Desktop/R Food Price/Foodprice/datasets/Correlation/Heatmap/Potatoesheat.csv')
df$date <- as.Date(df$date) # format date
df <- df[df$year >= 2012, ] # filter reqd years
# Create Month Week
df$yearmonth <- as.yearmon(df$date)
df$yearmonthf <- factor(df$yearmonth)
df <- df[, c("year", "yearmonthf", "month", "mkt_name", "mp_price")]
head(df)
year yearmonthf month mkt_name mp_price
15 2012 Jan 2012 1 Birambo 145.00
16 2012 Feb 2012 2 Birambo 136.25
17 2012 Mar 2012 3 Birambo 160.00
18 2012 Apr 2012 4 Birambo 162.75
19 2012 May 2012 5 Birambo 181.00
20 2012 Jun 2012 6 Birambo 170.00
Heatmap ggplot
ggplot(df, aes(mkt_name, year, fill = mp_price)) +
geom_tile(colour = "white") +
facet_grid(year~mkt_name) +
scale_fill_gradient(low="red", high="green") +
labs(x="Week of Month",
y="",
title = "Time-Series Calendar Heatmap",
subtitle="Potato Price",
fill="Price")

I think you mis-attributed your variables. Instead try:
ggplot(df, aes(x = yearmonth, y = mkt_name, fill = mp_price))+
geom_tile()+
scale_x_date(date_labels = "%b %Y")+
scale_fill_gradient(low="red", high="green") +
labs(x="Week of Month",
y="",
title = "Time-Series Calendar Heatmap",
subtitle="Potato Price",
fill="Price")
Does it answer your question ?
reproducible example
df <- data.frame(mkt_name = rep("Birambo",6),
year = 2012,
yearmonth = seq(as.Date("2012-01-01", format = "%Y-%m-%d"), as.Date("2012-06-01", format = "%Y-%m-%d"), by = "month"),
month = 1:6,
mp_price = c(145,136.25,160,162.75,181,170))

Related

CREATE A TIME SERIES PLOT in r with ggplot

I have problems with coding of BIG DATA.
view(data)
Year
Month
Deaths
1998
1
200
1998
2
40
1998
3
185
1998
4
402
1998
5
20
1998
6
48
1998
7
290
1998
8
15
1998
9
252
1998
10
409
1998
11
233
1998
12
122
My data goes until 2014. I would like to create a time series. In the x-Axis only some years are available in 5 year step. In the y axis the deaths of all month during the 2000 years are shown. I don't know how can I code that?
I am not sure if it is right because I didn't have any data. I have this from a programming book
data$date = as.Date(paste(data$Year, data$Month,1), format = "%Y %m %d")
ggplot(data,
aes(
x = date,
y = Deaths,
)) +
geom_line() +
ggtitle("Time series") +
xlab("Year") +
ylab("Deaths")
Update if you want a month break, you can use
scale_x_date(date_breaks = "year", date_labels = "%Y", date_minor_breaks = "month")

How to get the smooth line for monthly rainfall using ggplot?

I am trying to plot the monthly rainfall data from 1986 to 2016 using ggplot. My dataframe looks like this:
head(df)
Year Month Station Rainfall Remarks
1 1986 Jan stn1 0.0 Observed
2 1986 Feb stn1 10.4 Observed
3 1986 Mar stn1 16.5 Estimated
4 1986 Apr stn1 34.0 Observed
5 1986 May stn1 27.0 Observed
6 1986 Jun stn1 159.4 Observed
str(df)
'data.frame': 1488 obs. of 5 variables:
$ Year : chr "1986" "1986" "1986" "1986" ...
$ Month : Ord.factor w/ 12 levels "Jan"<"Feb"<"Mar"<..: 1 2 3 4 5 6 7 8 9 10 ...
$ Station : Factor w/ 4 levels "stn1","stn2",..: 1 1 1 1 1 1 1 1 1 1 ...
$ Rainfall: num 0 10.4 16.5 34 27 ...
$ Remarks : Factor w/ 2 levels "Estimated","Observed": 2 2 1 2 2 2 2 2 2 2 ...
I tried the following code:
library(ggplot2)
ggplot(df, aes(x=Year, y=Rainfall, col=Station)) + geom_line()
However the above code results in vertical lines plot, while I want to have smooth varying lines.
I want to plot all the four station (stn1 to stn4) such that the color of each line be based on the df$Remarks.
Also is it possible to have unique color for each station?
Your help would be appreciated
Here is one approach if you create a month-year variable:
library(ggplot2)
library(zoo)
df$Mo_Yr <- as.yearmon(paste0(df$Year, '-', df$Month), "%Y-%b")
ggplot(df, aes(x=Mo_Yr, y=Rainfall, col=Station)) +
geom_line() +
scale_x_yearmon()
If you want to use different color points for Remarks (Observed and Estimated), for a single Station, you could try the following:
ggplot(df, aes(x=Mo_Yr, y=Rainfall)) +
geom_point(aes(col = Remarks)) +
geom_line() +
scale_x_yearmon()
If you want to plot 2 lines for Observed and Estimated, you could add col argument to geom_line as below. Note I added some example data to illustrate. Depending on what data you have available this may (or may not) be what you need.
ggplot(df, aes(x=Mo_Yr, y=Rainfall)) +
geom_line(aes(col=Remarks)) +
scale_x_yearmon()
Data (for last example)
df <- read.table(text =
"Year Month Station Rainfall Remarks
1986 Jan stn1 0.0 Observed
1986 Feb stn1 10.4 Observed
1986 Mar stn1 16.5 Estimated
1986 Apr stn1 34.0 Observed
1986 May stn1 27.0 Observed
1986 Jun stn1 159.4 Observed
1986 Jul stn1 83.1 Estimated
1986 Aug stn1 55.7 Observed
1986 Sep stn1 12.3 Estimated", header = T, stringsAsFactors = T)
You might want to try passing the stat_smooth parameter
ggplot(df) +
geom_line(aes(y= Rainfall, x= Year, color= Station)) +
stat_smooth(aes(y= Rainfall, x= Year), method = lm, formula = y ~ poly(x, 10), se = FALSE)

keep a column when expanding dataframe to fill using tidyr::complete

Regarding how to fill missing rows in a data frame i used this example
df <- read.table(textConnection("car,year,month,country,amount
Mazda,2012,02,JP,2344
Ford,2012,04,US,235234
Mazda,2012,03,JP,3455
Mazda,2012,04,JP,43554
Mazda,2012,05,JP,9854
Mazda,2012,06,JP,32556
Ford, 2013,01,US,345"), sep = ",", header = TRUE)
> df
car year month country amount
1 Mazda 2012 2 JP 2344
2 Ford 2012 4 US 235234
3 Mazda 2012 3 JP 3455
4 Mazda 2012 4 JP 43554
5 Mazda 2012 5 JP 9854
6 Mazda 2012 6 JP 32556
7 Ford 2013 1 US 345
I use tidyr::complete to fill missing rows for month and year this way:
tidyr::complete(df, car = unique(car), year = 2012:2014, month=1:12, fill=list(amount=0))
but country is lost. i've read tidyr documentation but it's really short and could'nt find any other SO answer on this.
# A tibble: 108 x 5
car year month country amount
<fct> <int> <int> <fct> <dbl>
1 " Ford" 2012 1 NA 0
2 " Ford" 2012 2 NA 0
3 " Ford" 2012 3 NA 0
4 " Ford" 2012 4 US 235234
5 " Ford" 2012 5 NA 0
6 " Ford" 2012 6 NA 0
7 " Ford" 2012 7 NA 0
8 " Ford" 2012 8 NA 0
9 " Ford" 2012 9 NA 0
10 " Ford" 2012 10 NA 0
# ... with 98 more rows
How to preserve it?
We can place it in nesting
library(tidyverse)
df %>%
complete(car = unique(car), year = 2012:2014, month = 1:12,
nesting(country), fill = list(amount = 0))
Since you neglected to note that you opened a new question in the second-ask on the original, just maintain a metadata data frame:
read.table(textConnection("car,year,month,amount
Mazda,2012,02,2344
Ford,2012,04,235234
Mazda,2012,03,3455
Mazda,2012,04,43554
Mazda,2012,05,9854
Mazda,2012,06,32556
Ford,2013,01,2345"),
sep = ",", header = TRUE, stringsAsFactors = FALSE) -> xdf
merge(
expand.grid(car = unique(xdf$car), year =2012:2014, month=1:12),
xdf, by = c("car", "year", "month"), all.x = TRUE
) -> x2
x2$amount <- ifelse(is.na(x2$amount), 0, x2$amount)
data.frame(
car = c("Mazda", "Ford"),
country = c("JP", "US"),
stringsAsFactors = FALSE
) -> car2country_df
merge(x2, car2country_df)
or via tidyverse:
tidyr::complete(
xdf, car = unique(car), year = 2012:2014, month=1:12, fill=list(amount=0)
) %>%
dplyr::left_join(car2country_df)

generate seasonal plot, but with fiscal year start/end dates

Hello! Is there a way to index a chart to start and end at specific points
(which may be out of numeric order)?
I have data that begins October 1st, and ends September 31st the following year. The series repeats through multiple years past, and i want to build a daily seasonality chart. The challenge is the X axis is not from low to high, it runs 10-11-12-1-2-3-4-5-6-7-8-9.
Question 1:
Can you order the index by month 10-11-12-1-2-3-4-5-6-7-8-9?
while, being compatible with %m-%d formatting, as the real problem is in
daily format, but for the sake of brevity, I am only using months.
the result should look something like this...sorry i had to use excel...
Question 2:
Can we remove the connected chart lines, or will the solution to 1, naturally fix
question 2? examples in the attempts below.
Question 3:
Can the final formatting of the solution allow to take a moving average, or other
mutations of the initial data? The table in attempt #2 would allow to take the average of each month by year. Since July 17 is 6 and July 18 is 12, we would plot a 9 in the chart, ect for the entire plot.
Question 4:
Is there and XTS equivalent to solve this problem?
THANK YOU, THANK YOU, THANK YOU!
library(ggplot2)
library(plotly)
library(tidyr)
library(reshape2)
Date <- seq(as.Date("2016-10-1"), as.Date("2018-09-01"), by="month")
values <- c(2,3,4,3,4,5,6,4,5,6,7,8,9,10,8,9,10,11,12,13,11,12,13,14)
YearEnd <-c(2017,2017,2017,2017,2017,2017,2017,2017,2017,2017,2017,2017,
2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018)
df <- data.frame(Date,values,YearEnd)
## PLOT THE TIMESERIES
plot_ly(df, x = ~Date, y = ~values, type = "scatter", mode = "lines")
## PLOT THE DATA BY MONTH: attempt 1
df$Month <- format(df$Date, format="%m")
df2 <- df %>%
select(values, Month, YearEnd)
plot_ly(df2, x = ~Month, y = ~values, type = "scatter", mode = "lines",
connectgaps = FALSE)
## Plot starts on the 10th month, which is good, but the index is
## in standard order, not 10-11-12-1-2-3-4-5-6-7-8-9
## It also still connects the gaps, bad.
## CREATE A PIVOTTABLE: attempt 2
table <- spread(df2,YearEnd, values)
df3 <- melt(table , id.vars = 'Month', variable.name = 'series')
plot_ly(df3, x = ~Month, y = ~values, type = "scatter", mode = "lines",
connectgaps = FALSE)
## now the data are in the right order, but the index is still wrong
## I also do not understand how plotly is ordering it correctly, as 2
## is not the starting point in January.
You just need to set the desired levels for the Month inside factor
library(magrittr)
library(tidyverse)
library(lubridate)
library(plotly)
Date <- seq(as.Date("2016-10-1"), as.Date("2018-09-01"), by = "month")
values <- c(2, 3, 4, 3, 4, 5, 6, 4, 5, 6, 7, 8, 9, 10, 8, 9, 10, 11, 12, 13, 11, 12, 13, 14)
YearEnd <- c(
2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017,
2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018
)
df <- data.frame(Date, values, YearEnd)
# to fiscal year order
df %<>%
mutate(
Month = month(Date),
YearEnd = factor(YearEnd)) %>%
mutate(Month = factor(Month,
levels = c(10:12, 1:9),
labels = c(month.abb[10:12], month.abb[1:9])))
df
#> Date values YearEnd Month
#> 1 2016-10-01 2 2017 Oct
#> 2 2016-11-01 3 2017 Nov
#> 3 2016-12-01 4 2017 Dec
#> 4 2017-01-01 3 2017 Jan
#> 5 2017-02-01 4 2017 Feb
#> 6 2017-03-01 5 2017 Mar
#> 7 2017-04-01 6 2017 Apr
#> 8 2017-05-01 4 2017 May
#> 9 2017-06-01 5 2017 Jun
#> 10 2017-07-01 6 2017 Jul
#> 11 2017-08-01 7 2017 Aug
#> 12 2017-09-01 8 2017 Sep
...
p1 <- ggplot(df, aes(
x = Month, y = values,
color = YearEnd,
group = YearEnd)) +
geom_line() +
theme_classic(base_size = 12)
ggplotly(p1)
Edit: to plot by Julian day, we use a similar method to the 3rd one from this answer
# Generate random data
set.seed(2018)
date = seq(from = as.Date("2016-10-01"), to = as.Date("2018-09-30"),
by = "days")
values = c(rnorm(length(date)/2, 8, 1.5), rnorm(length(date)/2, 16, 2))
dat <- data.frame(date, values)
df <- dat %>%
tbl_df() %>%
mutate(jday = factor(yday(date)),
Month = month(date),
Year = year(date),
# only create label for the 1st day of the month
myLabel = case_when(day(date) == 1L ~ format(date, "%b-%d"),
TRUE ~ NA_character_)) %>%
# create fiscal year column
mutate(fcyear = case_when(Month > 9 ~ as.factor(Year + 1),
TRUE ~ as.factor(Year))) %>%
mutate(Month = factor(Month,
levels = c(10:12, 1:9),
labels = c(month.abb[10:12], month.abb[1:9])))
df
#> # A tibble: 730 x 7
#> date values jday Month Year myLabel fcyear
#> <date> <dbl> <fct> <fct> <dbl> <chr> <fct>
#> 1 2016-10-01 7.37 275 Oct 2016 Oct-01 2017
#> 2 2016-10-02 5.68 276 Oct 2016 <NA> 2017
#> 3 2016-10-03 7.90 277 Oct 2016 <NA> 2017
#> 4 2016-10-04 8.41 278 Oct 2016 <NA> 2017
#> 5 2016-10-05 10.6 279 Oct 2016 <NA> 2017
#> 6 2016-10-06 7.60 280 Oct 2016 <NA> 2017
#> 7 2016-10-07 11.1 281 Oct 2016 <NA> 2017
#> 8 2016-10-08 9.30 282 Oct 2016 <NA> 2017
#> 9 2016-10-09 7.08 283 Oct 2016 <NA> 2017
#> 10 2016-10-10 8.96 284 Oct 2016 <NA> 2017
#> # ... with 720 more rows
# Create a row number for plotting to make sure ggplot plot in
# the exact order of a fiscal year
df1 <- df %>%
group_by(fcyear) %>%
mutate(order = row_number()) %>%
ungroup()
df1
#> # A tibble: 730 x 8
#> date values jday Month Year myLabel fcyear order
#> <date> <dbl> <fct> <fct> <dbl> <chr> <fct> <int>
#> 1 2016-10-01 7.37 275 Oct 2016 Oct-01 2017 1
#> 2 2016-10-02 5.68 276 Oct 2016 <NA> 2017 2
#> 3 2016-10-03 7.90 277 Oct 2016 <NA> 2017 3
#> 4 2016-10-04 8.41 278 Oct 2016 <NA> 2017 4
#> 5 2016-10-05 10.6 279 Oct 2016 <NA> 2017 5
#> 6 2016-10-06 7.60 280 Oct 2016 <NA> 2017 6
#> 7 2016-10-07 11.1 281 Oct 2016 <NA> 2017 7
#> 8 2016-10-08 9.30 282 Oct 2016 <NA> 2017 8
#> 9 2016-10-09 7.08 283 Oct 2016 <NA> 2017 9
#> 10 2016-10-10 8.96 284 Oct 2016 <NA> 2017 10
#> # ... with 720 more rows
# plot with `order` as x-axis
p2 <- ggplot(df1,
aes(x = order, y = values,
color = fcyear,
group = fcyear)) +
geom_line() +
theme_classic(base_size = 12) +
xlab(NULL)
# now replace `order` label with `myLabel` created above
x_break <- df1$order[!is.na(df1$myLabel)][1:12]
x_label <- df1$myLabel[x_break]
x_label
#> [1] "Oct-01" "Nov-01" "Dec-01" "Jan-01" "Feb-01" "Mar-01" "Apr-01"
#> [8] "May-01" "Jun-01" "Jul-01" "Aug-01" "Sep-01"
p3 <- p2 +
scale_x_continuous(
breaks = x_break,
labels = x_label) +
theme(axis.text.x = element_text(angle = 90)) +
scale_color_brewer("Fiscal Year", palette = "Dark2") +
xlab(NULL)
p3
ggplotly(p3)
Created on 2018-09-09 by the reprex package (v0.2.0.9000).
Consider this an appendix to Tung's excellent answer. Here I've made it obvious how to alter the code for different start and end months of financial (or production) years which varies by country (and industry), with the Parameter EndMonth. I've also added an annual average, which seems like a pretty obvious thing to want as well (though outside the OP's request).
library(tidyverse)
library(lubridate)
## Generate random data
set.seed(2018)
date = seq(from = as.Date("2016-06-01"), to = as.Date("2016-06-01")+729,
by = "days") # about 2 years, but even number of days
values = c(rnorm(length(date)/2, 8, 1.5), rnorm(length(date)/2, 16, 2))
dat <- data.frame(date, values)
EndMonth <- 5 #i.e. if last month of financial year is May, use 5 for 5th month of calendar year
df <- dat %>%
tbl_df() %>%
mutate(jday = factor(yday(date)),
Month = month(date),
Year = year(date),
# only create label for the 1st day of the month
myLabel = case_when(day(date) == 1L ~ format(date, "%b%e"),
TRUE ~ NA_character_)) %>%
# create fiscal year column
mutate(fcyear = case_when(Month > EndMonth ~ as.factor(Year + 1),
TRUE ~ as.factor(Year))) %>%
mutate(Month = factor(Month,
levels = c((EndMonth+1):12, 1:(EndMonth)),
labels = c(month.abb[(EndMonth+1):12], month.abb[1:EndMonth])))
df
#make 2 (or n) year average
df_mean <- df %>%
group_by(jday) %>%
mutate(values = mean(values, na.rm=TRUE)) %>%
filter(fcyear %in% c("2017")) %>% #note hard code for first fcyear in dataset
mutate(fcyear = "Average")
#Add average to data frame
df <- bind_rows(df, df_mean)
# Create a row number for plotting to make sure ggplot plot in
# the exact order of a fiscal year
df1 <- df %>%
group_by(fcyear) %>%
mutate(order = row_number()) %>%
ungroup()
df1
# plot with `order` as x-axis
p2 <- ggplot(df1,
aes(x = order, y = values,
color = fcyear,
group = fcyear)) +
geom_line() +
theme_classic(base_size = 12) +
xlab(NULL)
p2
# now replace `order` label with `myLabel` created above
x_break <- df1$order[!is.na(df1$myLabel)][1:12]
x_label <- df1$myLabel[x_break]
x_label
p3 <- p2 +
scale_x_continuous(
breaks = x_break,
labels = x_label) +
theme(axis.text.x = element_text(angle = 90)) +
scale_color_brewer("Fiscal Year", palette = "Dark2") +
xlab(NULL)
p3

Grouped barplot in ggplot2 in R

I would like to make a grouped bar plot. An example of my data is as follows:
site code year month gear total value
678490 2012 3 GL 13882
678490 2012 4 GL 50942
678490 2012 5 GL 54973
678490 2012 6 GL 63938
678490 2012 7 GL 23825
678490 2012 8 GL 8195
678490 2012 9 GL 14859
678490 2012 9 RT 3225
678490 2012 10 GL 981
678490 2012 10 RT 19074
678490 2012 11 SD 106384
678490 2012 11 RT 2828
678490 2012 12 GL 107167
678490 2012 12 RT 4514
There are 17 site code options, four year options, twelve month options, and four gear options.
What I would to produce is a plot per site, per year, showing the 'total value' for each gear, for each month, as a bar.
So far I have managed to produce a plot, specific to site and year, but with the total values displayed in one bar per month, not separated into separate bars per month (can not include image in first post!)
But for months 9, 10, 11 and 12 there were two gears used so I want there to be two bars for these months.
I am using the following piece of code:
ggplot(subset(cdata, year %in% c("2012") & site code %in% c("678490")),
aes(x = factor(month), y = total value)) +
geom_bar(stat = "identity") +
labs(x = "Month", y = "Total value")
Any help on this would be greatly appreciated.
If you want separate bars for each gear, then you should add fill=gear to the aes in geom_bar:
ggplot(cdata[cdata$year==2012 & cdata$sitecode==678490,],
aes(x = factor(month), y = totalvalue, fill=gear)) +
geom_bar(stat = "identity", position="dodge") +
labs(x = "Month", y = "Total value")
this gives:
When you want to make a plot per site, per year, showing the 'total value' for each gear, for each month, as a bar, you can use facet_grid. For example:
ggplot(cdata, aes(x = factor(month), y = totalvalue, fill=gear)) +
geom_bar(stat = "identity", position="dodge") +
labs(x = "Month", y = "Total value") +
facet_grid(sitecode ~ year)
this gives:
Some additional comments:
It's probably better not to use spaces in your column names (in the code above I removed the spaces)
Add an example to your question which illustrative for the problem you are facing. In this case, it's better to give an example dataset that includes several sitecodes and several years.
I therefore made up some data:
df1 <- read.table(text="sitecode year month gear totalvalue
678490 2012 3 GL 13882
678490 2012 4 GL 50942
678490 2012 5 GL 54973
678490 2012 6 GL 63938
678490 2012 7 GL 23825
678490 2012 8 GL 8195
678490 2012 9 GL 14859
678490 2012 9 RT 3225
678490 2012 10 GL 981
678490 2012 10 RT 19074
678490 2012 11 SD 106384
678490 2012 11 RT 2828
678490 2012 12 GL 107167
678490 2012 12 RT 4514", header= TRUE)
df2 <- df1
df2$sitecode <- 7849
df2$year <- 2013
df3 <- df1
df3$sitecode <- 7849
df4 <- df1
df4$year <- 2013
cdata <- rbind(df1,df2,df3,df4)

Resources