Getting blank animated time series plot with gganimate transition_reveal in r - r

I am trying to create timeseries animated plot using transition_reveal from gganimate but getting a blank plot.
It works without animation.
I have referred some SO post & other links but still no success.
Animated graph using gganimate
http://shanghai.hosting.nyu.edu/data/r/case-2-1-animation.html
df
library(tidyverse)
library(lubridate)
library(scales)
library(gganimate)
file_url1 <- "https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/df_vaccination.csv"
df_vaccination <- read.csv(url(file_url1))
df_vaccination <- df_vaccination %>%
mutate(Updated.On = as.Date(Updated.On))
plot
vaccination_anime1 <- df_vaccination %>%
select(Updated.On, State, Total.Doses.Administered) %>%
mutate(State = as.factor(State)) %>%
filter(!is.na(Total.Doses.Administered),
State %in% c("Delhi","Maharashtra","Karnataka")) %>%
arrange(Updated.On) %>%
#selecting dates divided by 5
filter(as.numeric(Updated.On) %% 5 == 0) %>%
ggplot(aes(x = Updated.On, y = Total.Doses.Administered,
group = State, col = State)) +
geom_line(show.legend = FALSE) +
scale_y_continuous(labels = unit_format(scale = 1e-6, unit = "M"))
Animating plot
vaccination_anime1 +
gganimate::transition_reveal(Updated.On) +
labs(title = "{frame_time}: Vaccination of Indian States",
caption = "created by ViSa")
also tried: gganimate::transition_reveal(along = Updated.On) + but getting same blank plot.

Related

Geom_bar plot only shows one bar per plot

I am trying to compare two NBA players in various stats by using geom_bar but for some reason it is only plotting one bar per stat. I would like to have both bars on each plot to see how the two players compare to each other, or in other words a red and a blue on every plot
This is what I have tried
url <- paste0('https://www.basketball-reference.com/leagues/NBA_2022_per_game.html')
# scrape the url
webpage <- read_html(url)
hp_table <-
html_nodes(webpage, "table")
nba_table <- html_table(hp_table)
# convert to dataframe
df <- as.data.frame(nba_table)
df <- df[,-1]
df
longer <- df %>% pivot_longer(-Player)
player_list <- c('Precious Achiuwa', 'Steven Adams')
filtered <- longer %>% filter(Player == player_list)
ggplot(filtered, aes(x = Player, y = value)) +
geom_bar(aes(fill = Player),
stat = 'identity')+
facet_wrap(~name, scales = 'free_y')+
theme(axis.text.x = element_blank())
url <- paste0('https://www.basketball-reference.com/leagues/NBA_2022_per_game.html')
# scrape the url
webpage <- read_html(url)
hp_table <-
html_nodes(webpage, "table")
nba_table <- html_table(hp_table)
# convert to dataframe
df <- as.data.frame(nba_table)
df <- df[,-1]
df <- df %>% pivot_longer(cols = Pos:PTS) %>%
mutate(value = as.numeric(value)) %>%
filter(!is.na(value)) %>%
filter(Player %in% c("Precious Achiuwa", "Steven Adams"))
ggplot(df, aes(x = Player, fill = Player, y = value)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~name, "free_y") +
theme(axis.text.x = element_blank())
Your pivot_longer was incorrectly specified
Even if it was you would have had overlapping bars because you didn't specify position = "dodge" in your ggplot2 call.

Plot Stacked area with ggplot2 return plot without lines

I'm trying to plot cumulative values as stacked area plot, but in return, the image that I get do not consist stacked area, only background and legends are there. Initially, I thought the function doesn't recognize duplicate dates, so I tried to use group by function but it still return the same result. Does anyone know what is going on here?
The dataset that I'm using can be found on kaggle.
covid datset
Update:
I'm able to do ggplot(aes(..., text = count)) but not:
ggplot(aes(..., text = comma(count))) or
ggplot(aes(..., text = paste(count))) or
ggplot(aes(..., text = text)) where text is a mutated column
if (!require("pacman")) install.packages("pacman")
# load packages
pacman::p_load(pacman, installr, rio, dplyr, tidyr, ggplot2, stringr, scales, viridis, hrbrthemes, plotly, htmlwidgets)
daily_covid <- import("./worldometer_coronavirus_daily_data.csv")
daily_covid <-
daily_covid %>%
replace(is.na(.), 0) %>%
mutate(date = as.Date(date))
data <-
daily_covid %>%
group_by(date) %>%
summarise(
cumulative_total_cases = sum(cumulative_total_cases, na.rm = T),
cumulative_total_deaths = sum(cumulative_total_deaths, na.rm = T),
) %>% # actually na.rm is not needed
gather(categories, count,
cumulative_total_cases, cumulative_total_deaths) %>%
# adding this section of code, the dataframe looks fine
rowwise() %>%
mutate(text =
paste(
str_to_title(str_replace_all(categories, "_", " ")),
"Count:", count
)
) %>%
# section end
arrange(date) # this is just to check if text is appended properly
data # a small section of this data is shown below this block
# write.csv(data, paste0(out_data_path, "temp.csv"))
# (subset(data, is.na(text))) # enable this to check if something is na
q3 <- # V here is the problem
ggplot(data, aes(x=date, y=count, fill=categories, text = text)) +
geom_area() +
facet_wrap(~categories, scales = "free_y")
# scale_fill_viridis(discrete = TRUE) +
# theme(legend.position="none") +
# ggtitle("Cumulative Covid Cases Stacked Area plot") +
# theme_ipsum() +
# theme(legend.position="none")
q3
#
itrt_q3 <- ggplotly(q3, tooltip = "text")
itrt_q3
This is a small piece of the manipulated data data shown above
"date","categories","count","text"
2020-01-22,"cumulative_total_cases",571,"Cumulative Total Cases Count: 571"
2020-01-22,"cumulative_total_deaths",17,"Cumulative Total Deaths Count: 17"
After you add na.rm = TRUE the graph should print.
data <-
daily_covid %>%
group_by(date) %>%
summarise(
cumulative_total_cases = sum(cumulative_total_cases),
cumulative_total_deaths = sum(cumulative_total_deaths, na.rm = TRUE),
) %>%
mutate(text =
paste(
"Cumulative Cases:",
cumulative_total_cases,
"\nCumulative Deaths:",
cumulative_total_deaths
)
) %>%
gather(categories, count,
cumulative_total_cases, cumulative_total_deaths) %>%
ungroup() %>%
arrange(date) %>%
group_by(date, text, categories)
data %>%
ggplot(aes(x=date, y=count, fill=categories)) +
geom_area()

x-axis starting value for diverging plot

How can I change the "x-axis starting value" from the diverging bar chart below (extracted from here), so that the vertical axis is set at 25 instead of 0. And therefore the bars are drawn from 25 and not 0.
For instance, I want this chart:
To look like this:
EDIT
It it not the label I want to change, it is how the data is plotted. My apologies if I wasn't clear. See example below:
Another example to make it clear:
You can provide computed labels to an (x-)scale via scale_x_continuous(labels = function (x) x + 25).
If you also want to change the data, you’ll first need to offset the x-values by the equivalent amount (in the opposite direction):
Example:
df = tibble(Color = c('red', 'green', 'blue'), Divergence = c(5, 10, -5))
offset = 2
df %>%
mutate(Divergence = Divergence - offset) %>%
ggplot() +
aes(x = Divergence, y = Color) +
geom_col() +
scale_x_continuous(labels = function (x) x + offset)
I'm still not 100% clear on your intended outcome but you can "shift" your data by adding/subtracting 25 from each value, e.g.
Original plot:
library(tidyverse)
library(gapminder)
set.seed(123)
gapminder_subset <- gapminder %>%
pivot_longer(-c(country, continent, year)) %>%
filter(year == "1997" | year == "2007") %>%
select(-continent) %>%
filter(name == "gdpPercap") %>%
pivot_wider(names_from = year) %>%
select(-name) %>%
mutate(gdp_change = ((`2007` - `1997`) / `1997`) * 100) %>%
sample_n(15)
ggplot(data = gapminder_subset,
aes(x = country, y = gdp_change)) +
geom_bar(stat = "identity") +
coord_flip()
subtract 25:
library(tidyverse)
library(gapminder)
set.seed(123)
gapminder_subset <- gapminder %>%
pivot_longer(-c(country, continent, year)) %>%
filter(year == "1997" | year == "2007") %>%
select(-continent) %>%
filter(name == "gdpPercap") %>%
pivot_wider(names_from = year) %>%
select(-name) %>%
mutate(gdp_change = ((`2007` - `1997`) / `1997`) * 100) %>%
sample_n(15)
ggplot(data = gapminder_subset,
aes(x = country, y = gdp_change)) +
geom_bar(stat = "identity") +
coord_flip()
If you combine that with my original relabelling I think that's the solution:
ggplot(data = gapminder_subset,
aes(x = country, y = gdp_change - 25)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_y_continuous(breaks = c(-25, 0, 25, 50),
labels = c(0, 25, 50, 75))
The answers that existed at the time that I'm writing this are suggesting to change the data or to change the label. Here, I'm proposing to change neither the data nor the labels, and instead just change where the starting position of a bar is.
First, for reproducibility, I took #jared_mamrot's approach for the data subset.
library(gapminder)
library(tidyverse)
set.seed(123)
gapminder_subset <- gapminder %>%
pivot_longer(-c(country, continent, year)) %>%
filter(year == "1997" | year == "2007") %>%
select(-continent) %>%
filter(name == "gdpPercap") %>%
pivot_wider(names_from = year) %>%
select(-name) %>%
mutate(gdp_change = ((`2007` - `1997`) / `1997`) * 100) %>%
sample_n(15)
Then, you can set xmin = after_scale(25). You'll get a warning that xmin doesn't exists, but it does exist after the bars are reparameterised to rectangles in the ggplot2 internals (which is after the x-scale has seen the data to determine limits). This effectively changes the position where bars start.
ggplot(gapminder_subset,
aes(gdp_change, country)) +
geom_col(aes(xmin = after_scale(25)))
#> Warning: Ignoring unknown aesthetics: xmin
Created on 2021-06-28 by the reprex package (v1.0.0)

Group Width and Height in R so it can be plotted in a barchart

I have a data frame that contains over 2000 rows of Width and Heights. When I try to plot them there are no room for all data, so I was thinking that I can group the Width and Height into groups, then count how many exists in each group and plot that.
I was thinking the following groups (but I am not sure if this is the best groups):
groups <- c("Below 200x200", "200x200", "720x480", "720x576 ", "128x720",
"1920x1080 ", "3840×2160", "Over 3840x2160")
After some googling I've seen that tidyverse has grouping. Can it be used? I tried some code from it but it doesn't work
starwars %>%
group_by(df = cut(df$Width, breaks=groups)) %>%
tally()
My code:
# Library
library(ggplot2)
library(tidyverse)
# 1. Read data
df = read.csv2(text = "ID;Width;Height
1;255;298
2;600;900
3;333;459
4;333;459
5;800;574
6;512;768
7;768;1024
8;768;1024
9;800;574
10;512;768
11;640;1136
12;1200;1600
13;255;298
14;600;900
15;600;900
16;255;298
17;512;768
18;600;900
19;255;298
20;600;900
21;768;1024
22;255;298
23;640;1136
24;640;1136
25;333;459
26;255;340
27;1200;1600
28;640;1136
29;255;298
30;255;298")
# Groups
groups <- c("0x0", "200x200", "720x480", "720x576 ", "128x720", "1920x1080 ", "3840×2160", Inf)
starwars %>%
group_by(df = cut(df$Width, breaks=groups)) %>%
tally()
# Plot bar chart
df %>%
mutate(dimensions = paste(Width, "x ", Height)) %>%
add_count(dimensions, name = "Freq") %>%
arrange(Width, Height) %>%
mutate(labelpos = Freq + 0.2) %>%
ggplot(aes(x = fct_inorder(dimensions) %>% fct_rev())) +
geom_bar() +
coord_flip() +
labs(x="Dimensions",
y="Frequency") +
theme_classic() +
geom_text(aes(label = paste0(Freq), y = labelpos), size=3)

Manipulate y-axis scale using ggforce facet_zoom

I am plotting a time series and I want to zoom on few observations. This can be done using facet_zoom() from ggforce package.
library(dplyr)
library(ggplot2)
library(ggforce)
library(stringr)
airquality %>%
mutate(month_day = seq(as.Date("2000/1/1"),
by = "month",
length.out = n())) %>%
ggplot(aes(x = month_day, y = Temp)) +
geom_line() +
facet_zoom(x = month_day > "2010/1/1" & month_day < "2010/9/1")
Resulting plot:
However, I would like to manipulate the scale on y-axis of the lower panel plot, making it smaller. Is there a way to do this?
Use xy instead of x, and set horizontal to TRUE to auto fit the y-axis:
airquality %>%
mutate(month_day = seq(as.Date("2000/1/1"),
by = "month",
length.out = n())) %>%
ggplot(aes(x = month_day, y = Temp)) +
geom_line() +
facet_zoom(xy = month_day > "2010/1/1" & month_day < "2010/9/1", horizontal = FALSE)

Resources