Last active
November 19, 2019 07:07
-
-
Save akshat3096/23108139ecddcc966637a1be6f1c0e59 to your computer and use it in GitHub Desktop.
Shiny Dashboard for Animated plots in R
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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")) | |
)) | |
)) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment