Shiny Dashboard for Animated plots in R

server.R

library(ggplot2)
library(shiny)
library(gganimate)
library(XML)
library(lubridate)
library(tidyverse)
library(shinydashboard)
library(shinythemes)


#reading in the data
setwd("~/Genpact Internal/White paper contest")
xml <- xmlParse("export.xml")
summary(xml)

df <- XML:::xmlAttrsToDataFrame(xml["//Record"])
df$value <- as.numeric(as.character(df$value))
head(df)
table(df$type)

#make endDate in a date time variable POSIXct using lubridate with indian time zone
df$endDate <-ymd_hms(df$endDate,tz="UTC")


##add in year month date dayofweek hour columns
df$month<-format(df$endDate,"%m")
df$year<-format(df$endDate,"%Y")
df$date<-format(df$endDate,"%Y-%m-%d")
df$dayofweek <-wday(df$endDate, label=TRUE, abbr=FALSE)
df$hour <-format(df$endDate,"%H")

#mean line plot of the heart rate
heart_rate <- df %>%
  filter(type == 'HKQuantityTypeIdentifierHeartRate') %>%
  group_by(date,year,month) %>%
  summarize(heart_rate=mean(value)) 
heart_rate$date <- as.Date(heart_rate$date,"%Y-%m-%d")

#median line plot of the heart rate 
heart_rate1 <- df %>%
  filter(type == 'HKQuantityTypeIdentifierHeartRate') %>%
  group_by(date,year,month) %>%
  summarize(heart_rate=median(value))
heart_rate1$date <- as.Date(heart_rate$date,"%Y-%m-%d")

# daily total steps count
steps <- df %>%
  filter(type == 'HKQuantityTypeIdentifierStepCount') %>%
  group_by(date,year,month) %>%
  summarize(steps=sum(value))

steps$date <- as.Date(steps$date,"%Y-%m-%d")

# weekly mean steps 
step_count <- df %>%
  filter(type == 'HKQuantityTypeIdentifierStepCount') %>%
  filter(year==2019) %>% 
  group_by(dayofweek,year,month) %>%
  summarize(step_count=median(value)) 


#flights count
flight <- df %>%
  filter(type == 'HKQuantityTypeIdentifierFlightsClimbed') %>%
  group_by(year,month) %>%
  summarize(flights=sum(value)) %>%
  print (n=100) 

#distance covered
distance <- df %>%
  filter(type == 'HKQuantityTypeIdentifierDistanceWalkingRunning') %>%
  group_by(year,month) %>%
  summarize(distance=sum(value)) %>%
  print (n=100)

# Active energy burned 
energy <- df %>%
  filter(type == 'HKQuantityTypeIdentifierActiveEnergyBurned') %>%
  group_by(date,year,month) %>%
  summarize(energy_burned=sum(value))

# calendar heatmap: year wise calories burned
f <- df %>%
  filter(type == 'HKQuantityTypeIdentifierActiveEnergyBurned') %>% 
  filter(year==2018) %>% 
  mutate(week_date = ceiling(day(creationDate) / 7)) %>%
  group_by(week_date, month, dayofweek) %>%
  summarise(total_cal = sum(value))


energy$date <- as.Date(energy$date,"%Y-%m-%d")

theme_set(theme_bw())


server <- function(input, output,session) {
  
  #putting the animations into the body
  output$plot1 <- renderImage({

    outfile <- tempfile(fileext='.gif')
    
    # now make the animation
    p =ggplot(heart_rate,aes(x=date, y=heart_rate, group=year)) + 
      geom_line(aes(colour=year))+
      ggtitle("Daily Mean heartrate")+
      xlab("Month/Year")+transition_reveal(as.numeric(date))
    
    anim_save("outfile.gif", animate(p,width = 400, height = 400)) 
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
    },deleteFile = TRUE)
    
  output$plot2 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p1 =  ggplot(heart_rate1,aes(x=date, y=heart_rate, group=year)) + 
      geom_line(aes(colour=year))+
      ggtitle("Daily Median heartrate")+
      xlab("Month/Year")+
      transition_reveal(as.numeric(date))
    
    anim_save("outfile.gif", animate(p1,width = 400, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
  
  output$plot3 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p2 = ggplot(steps,aes(x=date, y=steps, group=year)) + 
      geom_line(aes(colour=year))+
      ggtitle("Total Steps Everyday")+
      xlab("Month/Year")+transition_reveal(as.numeric(date))
    
    
    anim_save("outfile.gif", animate(p2,width = 400, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
    
  
  output$plot4 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p3 = ggplot(step_count,aes(x=month, y=step_count, group=dayofweek)) + 
      geom_line(aes(colour=dayofweek),size=1.5)+
      theme_minimal()+
      ggtitle("Weekly median stepcount for 2019")+
      geom_point() +
      transition_reveal(as.numeric(month))
    
    anim_save("outfile.gif", animate(p3,width = 400, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
  
  output$plot5 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p4 =  ggplot(flight,aes(x=month, y=flights, fill=year)) + 
      geom_bar(position='dodge', stat='identity') +
      scale_y_continuous(labels = scales::comma) +
      theme(panel.grid.major = element_blank())+
      ggtitle("Total flight of stairs climbed")+transition_states(month, wrap = FALSE) +
      shadow_mark()
      
    anim_save("outfile.gif", animate(p4,width = 400, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
  
  output$plot6 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p4 =  ggplot(distance,aes(x=month, y=distance, fill=year)) + 
      geom_bar(position='dodge', stat='identity') +
      scale_y_continuous(labels = scales::comma) +
      theme(panel.grid.major = element_blank())+transition_states(month, wrap = FALSE) +
      shadow_mark()+ enter_fade() + 
      exit_shrink()
    
    anim_save("outfile.gif", animate(p4,width = 400, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
  
  output$plot7 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p4 =  ggplot(energy,aes(x=date, y=energy_burned, group=year)) + 
      geom_line(aes(colour=year))+
      ggtitle("Total Energy burned")+transition_reveal(as.numeric(date))
    
    anim_save("outfile.gif", animate(p4,width = 400, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
  
  output$plot8 <- renderImage({
    outfile <- tempfile(fileext='.gif')
    
    #animation
    p4 = ggplot(f,
                aes(dayofweek, week_date, fill = f$total_cal)) +
      ggtitle("Calendar Heatmap for Total Calories burned in 2018")+
      geom_tile(colour = "white") +
      facet_wrap(~month) +
      theme_bw() +
      scale_fill_gradient(name = "Total \nCalories",
                          low ="#56B1F7" , high = "#132B43") +
      labs(x = "Week of the Month",
           y = "Week number") +
      scale_y_continuous(trans = "reverse")+ transition_states(dayofweek, wrap = FALSE)
    
    anim_save("outfile.gif", animate(p4,width = 800, height = 400))
    
    list(src = "outfile.gif",
         contentType = 'image/gif')
  },deleteFile = TRUE)
  
  }  

shinyApp(ui, server)

ui.R

library(ggplot2)
library(shiny)
library(gganimate)
library(XML)
library(lubridate)
library(tidyverse)
library(shinydashboard)
library(shinythemes)


#reading in the data
setwd("~/Genpact Internal/White paper contest")
xml <- xmlParse("export.xml")
summary(xml)

df <- XML:::xmlAttrsToDataFrame(xml["//Record"])
df$value <- as.numeric(as.character(df$value))
head(df)
table(df$type)

#make endDate in a date time variable POSIXct using lubridate with indian time zone
df$endDate <-ymd_hms(df$endDate,tz="UTC")


##add in year month date dayofweek hour columns
df$month<-format(df$endDate,"%m")
df$year<-format(df$endDate,"%Y")
df$date<-format(df$endDate,"%Y-%m-%d")
df$dayofweek <-wday(df$endDate, label=TRUE, abbr=FALSE)
df$hour <-format(df$endDate,"%H")

#mean line plot of the heart rate
heart_rate <- df %>%
  filter(type == 'HKQuantityTypeIdentifierHeartRate') %>%
  group_by(date,year,month) %>%
  summarize(heart_rate=mean(value)) 
heart_rate$date <- as.Date(heart_rate$date,"%Y-%m-%d")

#median line plot of the heart rate 
heart_rate1 <- df %>%
  filter(type == 'HKQuantityTypeIdentifierHeartRate') %>%
  group_by(date,year,month) %>%
  summarize(heart_rate=median(value))
heart_rate1$date <- as.Date(heart_rate$date,"%Y-%m-%d")

# daily total steps count
steps <- df %>%
  filter(type == 'HKQuantityTypeIdentifierStepCount') %>%
  group_by(date,year,month) %>%
  summarize(steps=sum(value))

steps$date <- as.Date(steps$date,"%Y-%m-%d")

# weekly mean steps 
step_count <- df %>%
  filter(type == 'HKQuantityTypeIdentifierStepCount') %>%
  filter(year==2019) %>% 
  group_by(dayofweek,year,month) %>%
  summarize(step_count=median(value)) 


#flights count
flight <- df %>%
  filter(type == 'HKQuantityTypeIdentifierFlightsClimbed') %>%
  group_by(year,month) %>%
  summarize(flights=sum(value)) %>%
  print (n=100) 

#distance covered
distance <- df %>%
  filter(type == 'HKQuantityTypeIdentifierDistanceWalkingRunning') %>%
  group_by(year,month) %>%
  summarize(distance=sum(value)) %>%
  print (n=100)

# Active energy burned 
energy <- df %>%
  filter(type == 'HKQuantityTypeIdentifierActiveEnergyBurned') %>%
  group_by(date,year,month) %>%
  summarize(energy_burned=sum(value))

# calendar heatmap: year wise calories burned
f <- df %>%
  filter(type == 'HKQuantityTypeIdentifierActiveEnergyBurned') %>% 
  filter(year==2018) %>% 
  mutate(week_date = ceiling(day(creationDate) / 7)) %>%
  group_by(week_date, month, dayofweek) %>%
  summarise(total_cal = sum(value))


energy$date <- as.Date(energy$date,"%Y-%m-%d")

theme_set(theme_bw())

ui <- fluidPage(theme = shinytheme("sandstone"),
  titlePanel("Your own fitness tracker dashboard"),
  tabsetPanel(
    tabPanel("Introduction",
             fluidRow(
               column(4,textAreaInput("summary","   
                                      Introduction"))
             )),
    tabPanel("Static plots vs Animated plots",
             fluidRow(
               column(4,textAreaInput("summary","Comparison"))
             )),
    tabPanel("Active Heart Rate Analysis",
             fluidRow(
               column(3,plotOutput("plot1"))
             ,column(3,textAreaInput("summary", "Observations Drawn",
                                     "Normal resting heart-rate should be somewhere between 60-100 bpm and the normal active heart-rate should be between 100-120 bpm.There have been times when the heart rate has crossed these boundaries. It could potentially be that there was some extra activity done on those days. Could the data points be outliers? Let's look at the median heart-rate values to figure this out",width="400px",height="400px"),offset = 3))
             ,column(8, plotOutput("plot2"))),
    tabPanel("Step count Analysis",
             fluidRow(
               column(3,plotOutput("plot3")),
               column(3,textAreaInput("summary","Observations Drawn","Many recent studies reveal that you need to take a certain amount of steps per day to stay healthy. For the purposes of our project here, we'll assume the below categories apply:
Less than 5,000 steps a day - sedentary
Between 5,000-7,500 - low on activity
Between 7,500 and 10,000 - somewhat active
More than 10,000 - really active
This plot shows I was somewhat active till May 2018 and then started taking more steps daily. An increasing trend is clearly visible till 2018 after which it begins to decrease in 2019",width="400px",height="400px"),offset=3),
               column(8,plotOutput("plot4"))
             )),
    tabPanel("Stairs Climbed",
             fluidRow(
               column(3,plotOutput("plot5")),
               column(3,textAreaInput("summary","Observations Drawn","The maximum number of stairs climbed is in September and November 2018. There's a logical explanation to that - I was part of the organizing team at a conference. Hence, the spike in the data.

Now here, we can correlate our findings with the burned energy plot we saw earlier. We saw a decreasing trend in the energy burned in 2019, right? Notice how the number of stairs climbed is decreasing in 2019. That's partly down to inadequate data again in April 2019",width="400px",height="400px"),offset = 3)
             )),
    tabPanel("Distance Covered",
             fluidRow(
               column(3,plotOutput("plot6")),
               column(3,textAreaInput("summary","Observations Drawn","Aggregating the distance traveled (in kilometers) for different months corresponding to their respective years.As expected, the distance traveled in November 2018 really stands out.",width = "400px",height = "400px"),offset=3)
             )),
    tabPanel("Active Energy burned",
             fluidRow(
               column(3,plotOutput("plot7")),
               column(3,plotOutput("plot8"),offset = 3),
               column(8,textAreaInput("summary","Observations Drawn","A good amount of active calories have been burnt on most days. The range falls between 400-600 kcal daily. But there are a number of observations where the calories burnt are between 0-200 kcal.

So, in order to transition to a healthier lifestyle, I should burn about 500 calories every day in order to lose 1 pound in a week.

There is a sharp decline towards the end of our plot due to an inadequate number of observations for April 2019.
                                      To understand which days require more physical activity to burn the required amount of calories, we can draw up a heatmap. Let's do this in a way such that every day of every month is taken into account.",width = "400px",height = "400px"))
               
             )) 
    
  ))