This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter.

library(gapminder)
## Warning: package 'gapminder' was built under R version 4.0.3
library(ggplot2)
library(plotly)
## Warning: package 'plotly' was built under R version 4.0.3
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
data(gapminder, package = "gapminder")
gapminder<-data.frame(gapminder)
gg<-ggplot(gapminder, aes(gdpPercap, lifeExp, color = continent))+geom_point(aes(size = pop,frame=year, id=country))
## Warning: Ignoring unknown aesthetics: frame, id
# gg
# ggplotly(gg)
p <- ggplot(mtcars, aes(x = mpg, y = hp, frame = cyl)) + geom_col(position = "dodge2")
p

ggplotly(p)
# p<-ggplot(mtcars, aes(x = mpg, y = hp, frame = cyl)) + geom_col(position=position_dodge2(width=0.5, preserve="total", padding=0))
# p
# ggplotly(p)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(purrr)
weeks <- 96
nx <- 3
ny <- 20
df<-data.frame(rep(seq(24,weeks,24), each = nx * ny), xVar = rep(1:nx, times = weeks/24* ny),zVar=rep(runif(20,min=c(0), max=c(1)),times=4*3),
               w1=rep(seq(1,4,1), each = nx * ny))
colnames(df)<-c('weeks','treatment', 'val','w1')
df<-df[order(df$weeks,df$treatment, df$val),]
df$valF<-NULL
df$valF<-df$val*df$w1*df$treatment*-1
df$valF[1:5]<-df$valF[1:5]*-1
df<-df[order(df$weeks,df$treatment, -df$valF),]
yVar<-rep(1:ny,times=weeks/24*nx)
yVar
##   [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5
##  [26]  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5  6  7  8  9 10
##  [51] 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
##  [76] 16 17 18 19 20  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
## [101]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5
## [126]  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5  6  7  8  9 10
## [151] 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
## [176] 16 17 18 19 20  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
## [201]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20  1  2  3  4  5
## [226]  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
df<-cbind(df,yVar)
df$yVar<-as.factor(df$yVar)
library(ggplot2)
library(plotly)
df$trt[df$treatment==1]<-"NA"
df$trt[df$treatment==2]<-"arm 1"
df$trt[df$treatment==3]<-"arm 2"
df<-data.frame(df)
# ggplot(df,aes(x=trt, y=valF,fill=yVar))+geom_bar(stat="identity",position="dodge")

df$trt<-factor(df$trt,levels=c("NA","arm 1", "arm 2"))

#df$yVar<-factor(df$yVar,levels=c(1:20))


waterfall1<-ggplot(df,aes(x=factor(trt), group=factor(yVar),y=valF, frame=weeks, fill=trt))+geom_col(position=position_dodge2(width=4, preserve="total",padding=-2), aes( fill=trt))
waterfall1

ggplotly(waterfall1)
## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
dfsub<-df[df$weeks==24 & df$treatment %in% c(1,2) | df$weeks==48 & df$treatment %in% c(1,2),]
dfsub<-df[df$weeks %in% c(24,48) & df$treatment %in% c(1,2) ,]

waterfallsub<-ggplot(dfsub,aes(x=trt,  y=valF, frame=weeks))+geom_col(position=position_dodge2(width=2, preserve="total",padding=0.1),colour="blue", aes( fill=factor(weeks)))
waterfallsub

ggplotly(waterfallsub)
## Warning in p$x$data[firstFrame] <- p$x$frames[[1]]$data: number of items to
## replace is not a multiple of replacement length
waterfallsub<-ggplot(dfsub,aes(x=trt,group=factor(yVar), y=valF))+geom_col(position=position_dodge2(width=2, preserve="single",padding=0.1),colour="blue", aes( fill=factor(weeks)))
waterfallsub

ggplotly(waterfallsub)

Here used dodge so, overlapping among bar occurs

waterfall<-ggplot(df,aes(x=factor(trt), group=factor(yVar),y=valF, frame=weeks))+geom_bar(position="dodge",stat="identity" , colour="blue", aes( fill=trt))+
xlab("treatments")+ylab("difference")
waterfall

library(tidyverse)
## -- Attaching packages ------------------------------------------------------------------------------------------------------------------------- tidyverse 1.3.0 --
## v tibble  3.0.3     v stringr 1.4.0
## v tidyr   1.1.2     v forcats 0.5.0
## v readr   1.4.0
## -- Conflicts ---------------------------------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks plotly::filter(), stats::filter()
## x dplyr::lag()    masks stats::lag()
library(gganimate)
## Warning: package 'gganimate' was built under R version 4.0.3
library(gapminder)
library(av)
## Warning: package 'av' was built under R version 4.0.3
# theme_set(theme_classic())
# 
# dataForAnim <- gapminder %>%
#   filter(continent == "Americas") %>%
#   group_by(year) %>%
#   mutate(
#     rank = as.numeric(min_rank(-gdpPercap)),
#     label = if_else(rank > 10, "", paste(country, " ")),
#     label2 = if_else(rank > 10, "", paste(" $", format(gdpPercap, nsmall = 0, big.mark = ","))),
#     gdpPercap = if_else(rank > 10, gdpPercap[rank == 10], gdpPercap),
#     gdpPercap2 = gdpPercap / max(gdpPercap) * 100, # percentage of max
#     rank = if_else(rank > 10, 10, rank),
#   ) %>%
#   ungroup()
# 
# animatedPlot <- ggplot(data = dataForAnim) + # this is the data
#   geom_tile(
#     mapping = aes( # these aesthetics change with the data
#       x = rank,
#       y = gdpPercap2 / 2,
#       height = gdpPercap2,
#       fill = as.factor(country) # group is not needed
#       # colour = as.factor(country)
#     ),
#     width = 0.9, # these aesthetics are constant
#     alpha = 1 # hide bars for rank > 10
#   ) +
# 
#   # text in x-axis (requires clip = "off" in coord_*)
#   # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1
#   # leads to weird artifacts in text spacing.
#     geom_text(
#         mapping = aes(
#             x = rank,
#             y = 0,
#             label = label
#         ),
#         vjust = 0.2,
#         hjust = 1
#     ) +
#     geom_text(
#         mapping = aes(
#             x = rank,
#             y = gdpPercap2,
#             label = label2
#         ),
#         vjust = 0.2,
#         hjust = 0
#     ) +
# 
#   coord_flip(
#     clip = "off",
#     expand = FALSE,
#     xlim = c(0.45, 10.55) # show rank 1 to 10
#   ) +
#   scale_y_continuous(labels = scales::comma) +
#   scale_x_reverse() + # put rank 1 at the top
#   guides(color = FALSE, fill = FALSE) +
# 
#   labs(title = "{closest_state}", x = "", y = "GDP per capita (% of max)") +
#   theme(
#     plot.title = element_text(hjust = 0.5, size = 32),
#     axis.ticks.y = element_blank(), # These relate to the axes post-flip
#     axis.text.y = element_blank(), # These relate to the axes post-flip
#     plot.margin = margin(1, 3, 1, 4, "cm")
#   ) +
# 
#   transition_states(year, transition_length = 4, state_length = 1) +
#   ease_aes("cubic-in-out")
# 
# print(animatedPlot)

##take very long time to run this chunk for animation disable it

dfsub<-df[df$weeks %in% c(24,48,72,96) & df$treatment %in% c(1,2) ,]

dfsub$cat<-paste(dfsub$trt,dfsub$yVar)
dfsub$valF<-round(dfsub$valF,2)

dfsub$cat<-factor(dfsub$cat, levels=c("NA 1",   "NA 2", "NA 3", "NA 4", "NA 5", "NA 6", "NA 7", "NA 8", "NA 9", "NA 10",    "NA 11",    "NA 12",    "NA 13",    "NA 14",    "NA 15",    "NA 16",    "NA 17",    "NA 18",    "NA 19",    "NA 20",    "arm 1 1",  "arm 1 2",  "arm 1 3",  "arm 1 4",  "arm 1 5",  "arm 1 6",  "arm 1 7",  "arm 1 8",  "arm 1 9",  "arm 1 10", "arm 1 11", "arm 1 12", "arm 1 13", "arm 1 14", "arm 1 15", "arm 1 16", "arm 1 17", "arm 1 18", "arm 1 19", "arm 1 20"
  ))
# ggplot(dfsub,aes(cat, group=trt,fill=as.factor(trt),color=as.factor(trt), height=.5, frame=weeks))+
#   geom_tile(aes(y=valF/2,height=valF, width=0.8), alpha=0.8, color=NA)+
#   # text in x-axis (requires clip = "off" in coord_*)
#   # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1
#   #   leads to weird artifacts in text spacing.
#  # geom_text(aes(x = cat, y = 0, label = paste(trt, " ")), vjust = 0.2, hjust = 1) +
#  # geom_text(aes(x=cat,y=valF, label=paste(valF,"")),vjust = 0.5, hjust = 0.2)+
#   scale_y_continuous(labels = scales::comma) +
#   scale_x_discrete("",breaks=c("NA 10","arm 1 10"),labels=c("NA", "Arm 1"))+
#   guides(color = FALSE, fill = FALSE) +
# 
#   labs(title='{closest_state}', x = "", y = "Difference") +
#   theme(plot.title = element_text(hjust = 0.5, size = 32),
#         #axis.ticks.x = element_blank(),  # These relate to the axes post-flip
#         #axis.text.x  = element_blank(),  # These relate to the axes post-flip
#         plot.margin = margin(1,1,1,4, "cm"))+
#    transition_states(weeks, transition_length = 4, state_length = 1) +
#   ease_aes('cubic-in-out')

##flip x axis with y axis take too much time to run

# ggplot(dfsub,aes(cat, group=trt,fill=as.factor(trt),color=as.factor(trt), height=.5, frame=weeks))+
#   geom_tile(aes(y=valF/2,height=valF, width=0.8), alpha=0.8, color=NA)+
#   # text in x-axis (requires clip = "off" in coord_*)
#   # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1 
#   #   leads to weird artifacts in text spacing.
# geom_text(aes(y=valF, label=paste(valF,"")),vjust = 0.5, hjust = 0)+
#  
#   #scale_y_continuous(labels = scales::comma) +
#   scale_x_discrete("",breaks=c("NA 10","arm 1 10"),labels=c("NA", "Arm 1"))+
#   guides(color = FALSE, fill = FALSE) +
#    ylim(1,-8)+
#   labs(title='changes based on weeks interval {closest_state}', y="Difference") +
#   theme(plot.title = element_text(hjust = 0.5, size = 12),
#         #axis.ticks.x = element_blank(),  # These relate to the axes post-flip
#         #axis.text.x  = element_blank(),  # These relate to the axes post-flip
#         plot.margin = margin(1,1,1,4, "cm"))+
#   coord_flip()+
#      transition_states(weeks, transition_length = 4, state_length = 1) +
#   ease_aes('cubic-in-out')
ggplot(dfsub,aes(cat, group=trt,fill=as.factor(trt),color=as.factor(trt), height=.5, frame=weeks))+
  geom_tile(aes(y=valF,height=valF, width=0.8), alpha=0.8, color=NA)

ggplot(dfsub,aes(cat, group=trt,fill=as.factor(trt),color=as.factor(trt), height=.5, frame=weeks))+
  geom_tile(aes(y=valF/2,height=valF, width=0.8), alpha=0.8, color=NA)

dfsub<-df[df$weeks %in% c(24,48,72,96) & df$treatment %in% c(1,2) ,]

dfsub$cat<-paste(dfsub$trt,dfsub$yVar)
dfsub$valF<-round(dfsub$valF,2)

dfsub$cat<-factor(dfsub$cat, levels=c("NA 1",   "NA 2", "NA 3", "NA 4", "NA 5", "NA 6", "NA 7", "NA 8", "NA 9", "NA 10",    "NA 11",    "NA 12",    "NA 13",    "NA 14",    "NA 15",    "NA 16",    "NA 17",    "NA 18",    "NA 19",    "NA 20",    "arm 1 1",  "arm 1 2",  "arm 1 3",  "arm 1 4",  "arm 1 5",  "arm 1 6",  "arm 1 7",  "arm 1 8",  "arm 1 9",  "arm 1 10", "arm 1 11", "arm 1 12", "arm 1 13", "arm 1 14", "arm 1 15", "arm 1 16", "arm 1 17", "arm 1 18", "arm 1 19", "arm 1 20"
  ))

test<-ggplot(dfsub,aes(cat, group=trt,fill=as.factor(trt),color=as.factor(trt), height=.5, frame=weeks))+
  geom_tile(aes(y=valF/2,height=valF, width=0.8), alpha=0.8, color=NA)+
  # text in x-axis (requires clip = "off" in coord_*)
  # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1 
  #   leads to weird artifacts in text spacing.
 # geom_text(aes(x = cat, y = 0, label = paste(trt, " ")), vjust = 0.2, hjust = 1) +
  #geom_text(aes(y=valF, label=paste(valF,"")),vjust = 5, hjust =4)+
  scale_y_continuous(labels = scales::comma) +
  scale_x_discrete("",breaks=c("NA 10","arm 1 10"),labels=c("NA", "Arm 1"))+
  guides(color = FALSE, fill = FALSE) +
  
  labs(title='changes based on weeks interval', y="Difference") +
  theme(plot.title = element_text(hjust = 0.5, size = 12),
        #axis.ticks.x = element_blank(),  # These relate to the axes post-flip
        #axis.text.x  = element_blank(),  # These relate to the axes post-flip
        plot.margin = margin(1,1,1,4, "cm"))

test

ggplotly(test, tooltip = NULL)%>%layout(showlegend=FALSE)

try the horizontal direction

test<-ggplot(dfsub,aes(cat, group=trt,fill=as.factor(trt),color=as.factor(trt), height=.5, frame=weeks, text=valF))+
  geom_tile(aes(y=valF/2,height=valF, width=0.8), alpha=0.8, color=NA)+
  # text in x-axis (requires clip = "off" in coord_*)
  # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1 
  #   leads to weird artifacts in text spacing.
#geom_text(aes(y=valF, label=paste(valF,"")),vjust = 8, hjust = -8)+
#geom_text(aes(y=valF, label=paste(valF,"")),position=position_dodge2(width=0.6, padding=2))+
  #geom_text(aes(y=valF, label=paste(valF,"")),vjust = 5, hjust =4)+
  #scale_y_continuous(labels = scales::comma) +
  scale_x_discrete("",breaks=c("NA 10","arm 1 10"),labels=c("NA", "Arm 1"))+
  guides(color = FALSE, fill = FALSE) +
  ylim(1,-8)+
  labs(title='changes based on weeks interval', y="Difference") +
  theme(plot.title = element_text(hjust = 0.5, size = 12),
        #axis.ticks.x = element_blank(),  # These relate to the axes post-flip
        #axis.text.x  = element_blank(),  # These relate to the axes post-flip
        plot.margin = margin(1,1,1,4, "cm"))+
  coord_flip()

test

ggplotly(test, tooltip=NULL)%>%layout(showlegend=FALSE)%>%style(text=dfsub$valF, textposition="auto")

#another way by using highcharter package #can see correct tooltip but can not give different color to treatment group

library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
library(highcharter)
## Warning: package 'highcharter' was built under R version 4.0.3
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## Highcharts (www.highcharts.com) is a Highsoft software product which is
## not free for commercial and Governmental use
df$valF<-round(df$valF,2)
wide<-dcast(df, treatment+yVar~weeks, value.var="valF" )
colnames(wide)<-c('treatment', 'yVar','w24', 'w48','w72','w96')

for (i in 1:60){wide$value[i]=list(list(sequence = c(wide$w24[i],wide$w48[i],wide$w72[i],wide$w96[i]
)))}



highchart() %>%
  hc_yAxis(max =1, min = -12)%>%
  #hc_xAxis(categories = categories_grouped) %>% 
  hc_add_series(data = wide$value[1:60], type = "column",  showInLegend = FALSE, color="skyblue")%>%
    hc_motion(enabled = TRUE,
            labels = c("week24", "week48","week72","week96"),
            series = c(0))
highchart() %>%
  hc_yAxis(max =1, min = -12)%>%
  #hc_xAxis(categories = categories_grouped) %>% 
  hc_add_series(data = wide$value[1:20], type = "column",  showInLegend = FALSE, color="skyblue")%>%
  hc_add_series(data = wide$value[21:40], type = "column",  showInLegend = FALSE, color="blue")%>%
  hc_add_series(data = wide$value[41:60], type = "column",  showInLegend = FALSE, color="red")%>%
    hc_motion(enabled = TRUE,
            labels = c("week24", "week48","week72","week96"),
            series = c(0,1,2))

Reference: https://plotly-r.com/animating-views.html https://towardsdatascience.com/create-animated-bar-charts-using-r-31d09e5841da https://stackoverflow.com/questions/31687397/ggplot2-geom-bar-with-group-position-dodge-and-fill https://github.com/ropensci/plotly/issues/1544 https://community.rstudio.com/t/trying-to-create-animated-bar-plot-with-sliding-bars-that-overtake-each-other/46528 https://community.rstudio.com/t/trying-to-create-animated-bar-plot-with-sliding-bars-that-overtake-each-other/46528/5 https://ggplot2.tidyverse.org/articles/ggplot2-specs.html https://stackoverflow.com/questions/15277292/grouping-of-axis-labels-ggplot2 https://stackoverflow.com/questions/50967753/how-to-turn-off-tooltip-showing-all-of-my-data-in-plotly

highcharter https://rstudio-pubs-static.s3.amazonaws.com/304105_70f2ad540827454e934117e3d90f6c1a.html https://www.highcharts.com/blog/tutorials/highcharts-for-r-users/ https://github.com/dantonnoriega/highcharter https://cran.r-project.org/web/packages/highcharter/highcharter.pdf