Bellabeat case study
Rahma Saleh
2024-12-12
Introduction
About the company
Urška Sršen and Sando Mur founded Bellabeat, a high-tech company that manufactures health-focused sma products. Sršen used her background as an artist to develop beautifully designed technology that informs and inspires women around the world combining elegance with functionality.
Collecting data on activity, sleep, stress, and reproductive health has allowed Bellabeat to empower women with knowledge about their own health and habits. Since it was founded in 2013, Bellabeat has grown rapidly and quickly positioned itself as a tech-driven wellness company for women.
In this case study, I will analyze data collected from Bellabeat fitness trackers to gain insights into user behavior. The goal is to identify trends and patterns related to fitness activity, sleep, and overall health, which can inform Bellabeat’s marketing strategies and product development initiatives.
ASK PHASE:
- Key stakeholders:
1- Co Founder and Chief Creative : UrškaSršen.
2-Mathematician and Bellabeat’s cofounder:Sando Mur.
3-Bellabeat executive team.
4-Bellabeat’s marketing analytics team.
- Business task:
1- Analyze usage patterns from non-Bellabeat smart devices to identify key trends of their daily habits.
2- Select one Bellabeat product and apply the insights and trends identified to enhance its features and user experience.
3- Give recommendations to influence Bellabeat’s marketing strategy and explore new growth opportunity.
PREPARE PHASE :
Data Import and Exploration
To begin, we will load the dataset and examine its structure to gain an initial understanding of the data. This will help identify key variables and ensure the dataset is ready for analysis.
Installing necessary packages
install.packages("tidyverse")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)install.packages("skimr")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)install.packages("janitor")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)install.packages("ggplot2")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)install.packages("ggthemes") ## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)install.packages("gridExtra") ## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)Loading necessary libraries
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(tidyr)
library(dplyr)
library(lubridate)
library(skimr)
library(janitor)##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.testlibrary(ggplot2)
library(readr)
library(readxl)
library(ggthemes)
library(gridExtra)##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combineLoading the data
daily_activity <-read_csv("dailyActivity_merged.csv")## Rows: 940 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityDate
## dbl (14): Id, TotalSteps, TotalDistance, TrackerDistance, LoggedActivitiesDi...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.daily_calories <- read_csv("dailyCalories_merged.csv")## Rows: 940 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityDay
## dbl (2): Id, Calories
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.daily_intensities <- read_csv("dailyIntensities_merged.csv")## Rows: 940 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityDay
## dbl (9): Id, SedentaryMinutes, LightlyActiveMinutes, FairlyActiveMinutes, Ve...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.daily_steps <- read_csv("dailySteps_merged.csv")## Rows: 940 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityDay
## dbl (2): Id, StepTotal
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.daily_sleep <- read_csv("sleepDay_merged.csv")## Rows: 413 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): SleepDay
## dbl (4): Id, TotalSleepRecords, TotalMinutesAsleep, TotalTimeInBed
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.weight_log <- read_csv("weightLogInfo_merged.csv")## Rows: 33 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Date
## dbl (6): Id, WeightKg, WeightPounds, Fat, BMI, LogId
## lgl (1): IsManualReport
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.hourly_calories <- read_csv("hourlyCalories_merged.csv")## Rows: 24084 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityHour
## dbl (2): Id, Calories
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.hourly_intensities <- read_csv("hourlyIntensities_merged.csv")## Rows: 22099 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityHour
## dbl (3): Id, TotalIntensity, AverageIntensity
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.hourly_steps <- read_csv("hourlySteps_merged.csv")## Rows: 24084 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ActivityHour
## dbl (2): Id, StepTotal
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.minute_sleep <- read_csv("minuteSleep_merged (1).csv")## Rows: 188521 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): date
## dbl (3): Id, value, logId
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Checking the structure and first few rows of the data:
head(daily_activity)## # A tibble: 6 × 15
## Id ActivityDate TotalSteps TotalDistance TrackerDistance
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 1503960366 4/12/16 13162 8.5 8.5
## 2 1503960366 4/13/16 10735 6.97 6.97
## 3 1503960366 4/14/16 10460 6.74 6.74
## 4 1503960366 4/15/16 9762 6.28 6.28
## 5 1503960366 4/16/16 12669 8.16 8.16
## 6 1503960366 4/17/16 9705 6.48 6.48
## # ℹ 10 more variables: LoggedActivitiesDistance <dbl>,
## # VeryActiveDistance <dbl>, ModeratelyActiveDistance <dbl>,
## # LightActiveDistance <dbl>, SedentaryActiveDistance <dbl>,
## # VeryActiveMinutes <dbl>, FairlyActiveMinutes <dbl>,
## # LightlyActiveMinutes <dbl>, SedentaryMinutes <dbl>, Calories <dbl>str(daily_activity)## spc_tbl_ [940 × 15] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:940] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityDate : chr [1:940] "4/12/16" "4/13/16" "4/14/16" "4/15/16" ...
## $ TotalSteps : num [1:940] 13162 10735 10460 9762 12669 ...
## $ TotalDistance : num [1:940] 8.5 6.97 6.74 6.28 8.16 ...
## $ TrackerDistance : num [1:940] 8.5 6.97 6.74 6.28 8.16 ...
## $ LoggedActivitiesDistance: num [1:940] 0 0 0 0 0 0 0 0 0 0 ...
## $ VeryActiveDistance : num [1:940] 1.88 1.57 2.44 2.14 2.71 ...
## $ ModeratelyActiveDistance: num [1:940] 0.55 0.69 0.4 1.26 0.41 ...
## $ LightActiveDistance : num [1:940] 6.06 4.71 3.91 2.83 5.04 ...
## $ SedentaryActiveDistance : num [1:940] 0 0 0 0 0 0 0 0 0 0 ...
## $ VeryActiveMinutes : num [1:940] 25 21 30 29 36 38 42 50 28 19 ...
## $ FairlyActiveMinutes : num [1:940] 13 19 11 34 10 20 16 31 12 8 ...
## $ LightlyActiveMinutes : num [1:940] 328 217 181 209 221 164 233 264 205 211 ...
## $ SedentaryMinutes : num [1:940] 728 776 1218 726 773 ...
## $ Calories : num [1:940] 1985 1797 1776 1745 1863 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityDate = col_character(),
## .. TotalSteps = col_double(),
## .. TotalDistance = col_double(),
## .. TrackerDistance = col_double(),
## .. LoggedActivitiesDistance = col_double(),
## .. VeryActiveDistance = col_double(),
## .. ModeratelyActiveDistance = col_double(),
## .. LightActiveDistance = col_double(),
## .. SedentaryActiveDistance = col_double(),
## .. VeryActiveMinutes = col_double(),
## .. FairlyActiveMinutes = col_double(),
## .. LightlyActiveMinutes = col_double(),
## .. SedentaryMinutes = col_double(),
## .. Calories = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(daily_calories)## # A tibble: 6 × 3
## Id ActivityDay Calories
## <dbl> <chr> <dbl>
## 1 1503960366 4/12/2016 1985
## 2 1503960366 4/13/2016 1797
## 3 1503960366 4/14/2016 1776
## 4 1503960366 4/15/2016 1745
## 5 1503960366 4/16/2016 1863
## 6 1503960366 4/17/2016 1728str(daily_calories)## spc_tbl_ [940 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:940] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityDay: chr [1:940] "4/12/2016" "4/13/2016" "4/14/2016" "4/15/2016" ...
## $ Calories : num [1:940] 1985 1797 1776 1745 1863 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityDay = col_character(),
## .. Calories = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(daily_intensities)## # A tibble: 6 × 10
## Id ActivityDay SedentaryMinutes LightlyActiveMinutes FairlyActiveMinutes
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 1.50e9 4/12/2016 728 328 13
## 2 1.50e9 4/13/2016 776 217 19
## 3 1.50e9 4/14/2016 1218 181 11
## 4 1.50e9 4/15/2016 726 209 34
## 5 1.50e9 4/16/2016 773 221 10
## 6 1.50e9 4/17/2016 539 164 20
## # ℹ 5 more variables: VeryActiveMinutes <dbl>, SedentaryActiveDistance <dbl>,
## # LightActiveDistance <dbl>, ModeratelyActiveDistance <dbl>,
## # VeryActiveDistance <dbl>str(daily_intensities)## spc_tbl_ [940 × 10] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:940] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityDay : chr [1:940] "4/12/2016" "4/13/2016" "4/14/2016" "4/15/2016" ...
## $ SedentaryMinutes : num [1:940] 728 776 1218 726 773 ...
## $ LightlyActiveMinutes : num [1:940] 328 217 181 209 221 164 233 264 205 211 ...
## $ FairlyActiveMinutes : num [1:940] 13 19 11 34 10 20 16 31 12 8 ...
## $ VeryActiveMinutes : num [1:940] 25 21 30 29 36 38 42 50 28 19 ...
## $ SedentaryActiveDistance : num [1:940] 0 0 0 0 0 0 0 0 0 0 ...
## $ LightActiveDistance : num [1:940] 6.06 4.71 3.91 2.83 5.04 ...
## $ ModeratelyActiveDistance: num [1:940] 0.55 0.69 0.4 1.26 0.41 ...
## $ VeryActiveDistance : num [1:940] 1.88 1.57 2.44 2.14 2.71 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityDay = col_character(),
## .. SedentaryMinutes = col_double(),
## .. LightlyActiveMinutes = col_double(),
## .. FairlyActiveMinutes = col_double(),
## .. VeryActiveMinutes = col_double(),
## .. SedentaryActiveDistance = col_double(),
## .. LightActiveDistance = col_double(),
## .. ModeratelyActiveDistance = col_double(),
## .. VeryActiveDistance = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(daily_steps)## # A tibble: 6 × 3
## Id ActivityDay StepTotal
## <dbl> <chr> <dbl>
## 1 1503960366 4/12/2016 13162
## 2 1503960366 4/13/2016 10735
## 3 1503960366 4/14/2016 10460
## 4 1503960366 4/15/2016 9762
## 5 1503960366 4/16/2016 12669
## 6 1503960366 4/17/2016 9705str(daily_steps)## spc_tbl_ [940 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:940] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityDay: chr [1:940] "4/12/2016" "4/13/2016" "4/14/2016" "4/15/2016" ...
## $ StepTotal : num [1:940] 13162 10735 10460 9762 12669 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityDay = col_character(),
## .. StepTotal = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(daily_sleep)## # A tibble: 6 × 5
## Id SleepDay TotalSleepRecords TotalMinutesAsleep TotalTimeInBed
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 1503960366 4/12/2016 12:0… 1 327 346
## 2 1503960366 4/13/2016 12:0… 2 384 407
## 3 1503960366 4/15/2016 12:0… 1 412 442
## 4 1503960366 4/16/2016 12:0… 2 340 367
## 5 1503960366 4/17/2016 12:0… 1 700 712
## 6 1503960366 4/19/2016 12:0… 1 304 320str(daily_sleep)## spc_tbl_ [413 × 5] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:413] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ SleepDay : chr [1:413] "4/12/2016 12:00:00 AM" "4/13/2016 12:00:00 AM" "4/15/2016 12:00:00 AM" "4/16/2016 12:00:00 AM" ...
## $ TotalSleepRecords : num [1:413] 1 2 1 2 1 1 1 1 1 1 ...
## $ TotalMinutesAsleep: num [1:413] 327 384 412 340 700 304 360 325 361 430 ...
## $ TotalTimeInBed : num [1:413] 346 407 442 367 712 320 377 364 384 449 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. SleepDay = col_character(),
## .. TotalSleepRecords = col_double(),
## .. TotalMinutesAsleep = col_double(),
## .. TotalTimeInBed = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(hourly_steps)## # A tibble: 6 × 3
## Id ActivityHour StepTotal
## <dbl> <chr> <dbl>
## 1 1503960366 3/12/2016 12:00:00 AM 0
## 2 1503960366 3/12/2016 1:00:00 AM 0
## 3 1503960366 3/12/2016 2:00:00 AM 0
## 4 1503960366 3/12/2016 3:00:00 AM 0
## 5 1503960366 3/12/2016 4:00:00 AM 0
## 6 1503960366 3/12/2016 5:00:00 AM 0str(hourly_steps)## spc_tbl_ [24,084 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:24084] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityHour: chr [1:24084] "3/12/2016 12:00:00 AM" "3/12/2016 1:00:00 AM" "3/12/2016 2:00:00 AM" "3/12/2016 3:00:00 AM" ...
## $ StepTotal : num [1:24084] 0 0 0 0 0 0 0 0 0 8 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityHour = col_character(),
## .. StepTotal = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(hourly_intensities)## # A tibble: 6 × 4
## Id ActivityHour TotalIntensity AverageIntensity
## <dbl> <chr> <dbl> <dbl>
## 1 1503960366 4/12/2016 12:00:00 AM 20 0.333
## 2 1503960366 4/12/2016 1:00:00 AM 8 0.133
## 3 1503960366 4/12/2016 2:00:00 AM 7 0.117
## 4 1503960366 4/12/2016 3:00:00 AM 0 0
## 5 1503960366 4/12/2016 4:00:00 AM 0 0
## 6 1503960366 4/12/2016 5:00:00 AM 0 0str(hourly_intensities)## spc_tbl_ [22,099 × 4] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:22099] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityHour : chr [1:22099] "4/12/2016 12:00:00 AM" "4/12/2016 1:00:00 AM" "4/12/2016 2:00:00 AM" "4/12/2016 3:00:00 AM" ...
## $ TotalIntensity : num [1:22099] 20 8 7 0 0 0 0 0 13 30 ...
## $ AverageIntensity: num [1:22099] 0.333 0.133 0.117 0 0 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityHour = col_character(),
## .. TotalIntensity = col_double(),
## .. AverageIntensity = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(hourly_calories)## # A tibble: 6 × 3
## Id ActivityHour Calories
## <dbl> <chr> <dbl>
## 1 1503960366 3/12/2016 12:00:00 AM 48
## 2 1503960366 3/12/2016 1:00:00 AM 48
## 3 1503960366 3/12/2016 2:00:00 AM 48
## 4 1503960366 3/12/2016 3:00:00 AM 48
## 5 1503960366 3/12/2016 4:00:00 AM 48
## 6 1503960366 3/12/2016 5:00:00 AM 48str(hourly_calories)## spc_tbl_ [24,084 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:24084] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ ActivityHour: chr [1:24084] "3/12/2016 12:00:00 AM" "3/12/2016 1:00:00 AM" "3/12/2016 2:00:00 AM" "3/12/2016 3:00:00 AM" ...
## $ Calories : num [1:24084] 48 48 48 48 48 48 48 48 48 49 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. ActivityHour = col_character(),
## .. Calories = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(weight_log)## # A tibble: 6 × 8
## Id Date WeightKg WeightPounds Fat BMI IsManualReport LogId
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <lgl> <dbl>
## 1 1503960366 4/5/2016 … 53.3 118. 22 23.0 TRUE 1.46e12
## 2 1927972279 4/10/2016… 130. 286. NA 46.2 FALSE 1.46e12
## 3 2347167796 4/3/2016 … 63.4 140. 10 24.8 TRUE 1.46e12
## 4 2873212765 4/6/2016 … 56.7 125. NA 21.5 TRUE 1.46e12
## 5 2873212765 4/7/2016 … 57.2 126. NA 21.6 TRUE 1.46e12
## 6 2891001357 4/5/2016 … 88.4 195. NA 25.0 TRUE 1.46e12str(weight_log)## spc_tbl_ [33 × 8] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:33] 1.50e+09 1.93e+09 2.35e+09 2.87e+09 2.87e+09 ...
## $ Date : chr [1:33] "4/5/2016 11:59:59 PM" "4/10/2016 6:33:26 PM" "4/3/2016 11:59:59 PM" "4/6/2016 11:59:59 PM" ...
## $ WeightKg : num [1:33] 53.3 129.6 63.4 56.7 57.2 ...
## $ WeightPounds : num [1:33] 118 286 140 125 126 ...
## $ Fat : num [1:33] 22 NA 10 NA NA NA NA NA NA NA ...
## $ BMI : num [1:33] 23 46.2 24.8 21.5 21.6 ...
## $ IsManualReport: logi [1:33] TRUE FALSE TRUE TRUE TRUE TRUE ...
## $ LogId : num [1:33] 1.46e+12 1.46e+12 1.46e+12 1.46e+12 1.46e+12 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. Date = col_character(),
## .. WeightKg = col_double(),
## .. WeightPounds = col_double(),
## .. Fat = col_double(),
## .. BMI = col_double(),
## .. IsManualReport = col_logical(),
## .. LogId = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(minute_sleep)## # A tibble: 6 × 4
## Id date value logId
## <dbl> <chr> <dbl> <dbl>
## 1 1503960366 4/12/2016 2:47:30 AM 3 11380564589
## 2 1503960366 4/12/2016 2:48:30 AM 2 11380564589
## 3 1503960366 4/12/2016 2:49:30 AM 1 11380564589
## 4 1503960366 4/12/2016 2:50:30 AM 1 11380564589
## 5 1503960366 4/12/2016 2:51:30 AM 1 11380564589
## 6 1503960366 4/12/2016 2:52:30 AM 1 11380564589str(minute_sleep)## spc_tbl_ [188,521 × 4] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Id : num [1:188521] 1.5e+09 1.5e+09 1.5e+09 1.5e+09 1.5e+09 ...
## $ date : chr [1:188521] "4/12/2016 2:47:30 AM" "4/12/2016 2:48:30 AM" "4/12/2016 2:49:30 AM" "4/12/2016 2:50:30 AM" ...
## $ value: num [1:188521] 3 2 1 1 1 1 1 2 2 2 ...
## $ logId: num [1:188521] 1.14e+10 1.14e+10 1.14e+10 1.14e+10 1.14e+10 ...
## - attr(*, "spec")=
## .. cols(
## .. Id = col_double(),
## .. date = col_character(),
## .. value = col_double(),
## .. logId = col_double()
## .. )
## - attr(*, "problems")=<externalptr>Checking the names of the columns
colnames(daily_activity)## [1] "Id" "ActivityDate"
## [3] "TotalSteps" "TotalDistance"
## [5] "TrackerDistance" "LoggedActivitiesDistance"
## [7] "VeryActiveDistance" "ModeratelyActiveDistance"
## [9] "LightActiveDistance" "SedentaryActiveDistance"
## [11] "VeryActiveMinutes" "FairlyActiveMinutes"
## [13] "LightlyActiveMinutes" "SedentaryMinutes"
## [15] "Calories"colnames(daily_calories)## [1] "Id" "ActivityDay" "Calories"colnames(daily_intensities)## [1] "Id" "ActivityDay"
## [3] "SedentaryMinutes" "LightlyActiveMinutes"
## [5] "FairlyActiveMinutes" "VeryActiveMinutes"
## [7] "SedentaryActiveDistance" "LightActiveDistance"
## [9] "ModeratelyActiveDistance" "VeryActiveDistance"colnames(daily_sleep)## [1] "Id" "SleepDay" "TotalSleepRecords"
## [4] "TotalMinutesAsleep" "TotalTimeInBed"colnames(daily_steps)## [1] "Id" "ActivityDay" "StepTotal"colnames(hourly_calories)## [1] "Id" "ActivityHour" "Calories"colnames(hourly_intensities)## [1] "Id" "ActivityHour" "TotalIntensity" "AverageIntensity"colnames(hourly_steps)## [1] "Id" "ActivityHour" "StepTotal"colnames(minute_sleep)## [1] "Id" "date" "value" "logId"colnames(weight_log)## [1] "Id" "Date" "WeightKg" "WeightPounds"
## [5] "Fat" "BMI" "IsManualReport" "LogId"PROCESS PHASE:
Data cleaning
In this section, Iam cleaning the data by:
- Rename Columns for Consistency. *fixing formatiing issues.
- Handling missing values.
- Removing irrelevant columns.
- Converting data types.
Step 1:
- Rename Columns for consistencys,fixing formatting issues and creating new variable and dataframe: divided the data into 3 groups: 1-daily data 2-hourly data 3-minutedata
daily data
daily_activity <-
daily_activity %>%
rename(
activity_date = ActivityDate,
total_steps = TotalSteps,
total_distance = TotalDistance,
tracker_distance = TrackerDistance,
logged_activities_d = LoggedActivitiesDistance,
very_active_d = VeryActiveDistance,
moderately_active_d = ModeratelyActiveDistance,
light_active_d = LightActiveDistance,
sedentary_d = SedentaryActiveDistance,
very_active_m = VeryActiveMinutes,
fairly_active_m = FairlyActiveMinutes,
lightly_active_m = LightlyActiveMinutes,
sedentary_m = SedentaryMinutes,
calories = Calories
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
# reformat variable as POSIXct to represent date and time
activity_date = parse_date_time(activity_date, "%m/%d/%y"),
# create new variable and format as date only
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
# create new variables for day of week and time of week
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend")
)daily_calories
daily_calories <-
daily_calories %>%
rename(
activity_date = ActivityDay,
calories = Calories
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_date = parse_date_time(activity_date, "%m/%d/%Y"),
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend")
)daily_intensities
daily_intensities <-
daily_intensities %>%
rename(
activity_date = ActivityDay,
very_active_d = VeryActiveDistance,
moderately_active_d = ModeratelyActiveDistance,
light_active_d = LightActiveDistance,
sedentary_d = SedentaryActiveDistance,
very_active_m = VeryActiveMinutes,
fairly_active_m = FairlyActiveMinutes,
lightly_active_m = LightlyActiveMinutes,
sedentary_m = SedentaryMinutes,
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_date = parse_date_time(activity_date, "%m/%d/%Y"),
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend")
)daily_sleep
daily_sleep <-
daily_sleep %>%
rename(
activity_date = SleepDay,
total_sleep_records = TotalSleepRecords,
total_minutes_asleep = TotalMinutesAsleep,
total_time_in_bed = TotalTimeInBed
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_date = parse_date_time(activity_date, "%m/%d/%Y %I:%M:%S %p"),
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend")
)daily_steps
daily_steps <-
daily_steps %>%
rename(
activity_date = ActivityDay,
step_total = StepTotal
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_date = parse_date_time(activity_date, "%m/%d/%Y"),
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend")
)weight_log
weight_log <-
weight_log %>%
rename(
activity_date = Date,
weight_kg = WeightKg,
weight_lb = WeightPounds,
fat = Fat,
bmi = BMI,
manual_report = IsManualReport,
log_id = LogId
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_date = parse_date_time(activity_date, "%m/%d/%Y %I:%M:%S %p"),
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
activity_time = format(activity_date, format = "%I:%M:%S %p"),
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend"),
hour_of_day = as.POSIXct(activity_date, format = "%I:%M:%S %p")
)2- Hourly data
hourly_calories
hourly_calories <-
hourly_calories %>%
rename(
activity_hour = ActivityHour,
calories = Calories
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_hour = parse_date_time(activity_hour, "%m/%d/%Y %I:%M:%S %p"),
activity_date_ymd = as.Date(activity_hour, "%Y/%m/%d"),
activity_time = format(activity_hour, format = "%I:%M:%S %p"),
day_of_week = weekdays(as.Date(activity_hour)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend"),
hour_of_day = as.POSIXct(activity_time, format = "%I:%M:%S %p")
)hourly_intensities
hourly_intensities <-
hourly_intensities %>%
rename(
activity_hour = ActivityHour,
total_intensity = TotalIntensity,
average_intensity = AverageIntensity
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_hour = parse_date_time(activity_hour, "%m/%d/%Y %I:%M:%S %p"),
activity_date_ymd = as.Date(activity_hour, "%Y/%m/%d"),
activity_time = format(activity_hour, format = "%I:%M:%S %p"),
day_of_week = weekdays(as.Date(activity_hour)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend"),
hour_of_day = as.POSIXct(activity_time, format = "%I:%M:%S %p")
)hourly_steps
hourly_steps <-
hourly_steps %>%
rename(
activity_hour = ActivityHour,
step_total = StepTotal
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_hour = parse_date_time(activity_hour, "%m/%d/%Y %I:%M:%S %p"),
activity_date_ymd = as.Date(activity_hour, "%Y/%m/%d"),
activity_time = format(activity_hour, format = "%I:%M:%S %p"),
day_of_week = weekdays(as.Date(activity_hour)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend"),
hour_of_day = as.POSIXct(activity_time, format = "%I:%M:%S %p")
)3-Minute data ## minute_sleep
minute_sleep <-
minute_sleep %>%
rename(
activity_date = date,
sleep_value = value,
log_id = logId
) %>%
rename_with(
tolower, starts_with("Id")
) %>%
mutate(
activity_date = parse_date_time(activity_date, "%m/%d/%Y %I:%M:%S %p"),
activity_date_ymd = as.Date(activity_date, "%Y/%m/%d"),
activity_time = format(activity_date, format = "%I:%M:00 %p"),
day_of_week = weekdays(as.Date(activity_date)),
time_of_week = case_when(
day_of_week %in% c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday") ~ "Weekday",
day_of_week %in% c("Saturday", "Sunday") ~ "Weekend"),
hour_of_day = as.POSIXct(activity_time, format = "%I:%M:%S %p"),
# sleep_id will be used generate totals per sleep log
sleep_id = str_c(id, "-", log_id),
# Create new variables for sleep values - asleep, restless, and awake
asleep = ifelse(sleep_value == 1, 1, 0),
restless = ifelse(sleep_value == 2, 1, 0),
awake = ifelse(sleep_value == 3, 1, 0)
)Create sleep_summary_0 dataframe :
This shows totals for 3 sleep values per sleep log
sleep_summary_0 <-
minute_sleep %>%
# id_date will be used to generate a daily total
mutate(
id_date = str_c(id, "-", activity_date_ymd)
) %>%
group_by(sleep_id, activity_date_ymd, id_date, id) %>%
dplyr::summarize(
total_asleep = sum(sleep_value == "1"),
total_restless = sum(sleep_value == "2"),
total_awake = sum(sleep_value == "3")
)## `summarise()` has grouped output by 'sleep_id', 'activity_date_ymd', 'id_date'.
## You can override using the `.groups` argument.Create sleep_summary df :
This combines totals for each day per id
sleep_summary <-
sleep_summary_0 %>%
# activity_date will be used to merge with daily_sleep df
mutate(
activity_date = parse_date_time(activity_date_ymd, "%Y/%m/%d")
) %>%
group_by(id_date, activity_date, id) %>%
dplyr::summarize(
total_asleep_merged = sum(total_asleep),
total_restless_merged = sum(total_restless),
total_awake_merged = sum(total_awake)
)## `summarise()` has grouped output by 'id_date', 'activity_date'. You can
## override using the `.groups` argument.# Merge these two daily sleep dfs into one ---------------------------
sleep_data <- merge(x = daily_sleep, y = sleep_summary, by = c("id", "activity_date"), all = TRUE)ANALYZE PHASE:
DAILY:
1- There are 33 users (one user per unique id) in the daily activity dataframe:
n_distinct(daily_activity$id)## [1] 332- There are 24 users (one user per unique id) in the sleep dataframe:
n_distinct(daily_sleep$id)## [1] 243- There are 11 users (one user per unique id) in the weight dataframe:
n_distinct(weight_log$id)## [1] 11HOURLY
Users (one user per unique id) in the hourly dataframe:
n_distinct(hourly_calories$id)## [1] 34n_distinct(hourly_intensities$id)## [1] 33n_distinct(hourly_steps$id)## [1] 34Minutes
There are 24 users (one user per unique id) in the minute dataframe
n_distinct(minute_sleep$id)## [1] 24Observations in each dataframe:
1- Daily
nrow(daily_activity)## [1] 940nrow(daily_sleep)## [1] 413nrow(weight_log)## [1] 33nrow(sleep_data)## [1] 4522-Hourly
nrow(hourly_calories)## [1] 24084nrow(hourly_intensities)## [1] 22099nrow(hourly_steps)## [1] 240843-Minutes
nrow(minute_sleep)## [1] 188521Quick view for :
1-Daily
Daily totals for steps, distance,and calories:
daily_activity %>%
select(
total_steps,
total_distance,
calories
) %>%
summary()## total_steps total_distance calories
## Min. : 0 Min. : 0.000 Min. : 0
## 1st Qu.: 3790 1st Qu.: 2.620 1st Qu.:1828
## Median : 7406 Median : 5.245 Median :2134
## Mean : 7638 Mean : 5.490 Mean :2304
## 3rd Qu.:10727 3rd Qu.: 7.713 3rd Qu.:2793
## Max. :36019 Max. :28.030 Max. :4900Note: The average total steps per day = 7638 which is < than recommended 10,000 step.
Active minute levels per category :
daily_activity %>%
select(
very_active_m,
fairly_active_m,
lightly_active_m,
sedentary_m
) %>%
summary()## very_active_m fairly_active_m lightly_active_m sedentary_m
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.0
## 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.:127.0 1st Qu.: 729.8
## Median : 4.00 Median : 6.00 Median :199.0 Median :1057.5
## Mean : 21.16 Mean : 13.56 Mean :192.8 Mean : 991.2
## 3rd Qu.: 32.00 3rd Qu.: 19.00 3rd Qu.:264.0 3rd Qu.:1229.5
## Max. :210.00 Max. :143.00 Max. :518.0 Max. :1440.0Note:
1-The average “sedentary” = 991.2 minutes per day,which is the highest average of the tracked activity minutes per day. This is just equal to 16.5 hours per day.
2-The average lightly active = 192.8 minutes per day,which the highest among the non-sedentary activity minutes per day (21.16 min - Very Active, 13.56min Fairly Active).
3-Combined daily average of Very Active (21.16) and Fairly Active (13.56) minutes per day is 34.72 min.
Sleep totals
For records, minutes asleep, and time in bed:
daily_sleep %>%
select(
total_sleep_records,
total_minutes_asleep,
total_time_in_bed
) %>%
summary()## total_sleep_records total_minutes_asleep total_time_in_bed
## Min. :1.000 Min. : 58.0 Min. : 61.0
## 1st Qu.:1.000 1st Qu.:361.0 1st Qu.:403.0
## Median :1.000 Median :433.0 Median :463.0
## Mean :1.119 Mean :419.5 Mean :458.6
## 3rd Qu.:1.000 3rd Qu.:490.0 3rd Qu.:526.0
## Max. :3.000 Max. :796.0 Max. :961.0Sleep totals per category :
sleep_data %>%
select(
total_minutes_asleep,
total_time_in_bed,
total_asleep_merged,
total_restless_merged,
total_awake_merged
) %>%
summary()## total_minutes_asleep total_time_in_bed total_asleep_merged
## Min. : 58.0 Min. : 61.0 Min. : 0.0
## 1st Qu.:361.0 1st Qu.:403.0 1st Qu.:325.0
## Median :433.0 Median :463.0 Median :407.5
## Mean :419.5 Mean :458.6 Mean :384.8
## 3rd Qu.:490.0 3rd Qu.:526.0 3rd Qu.:477.0
## Max. :796.0 Max. :961.0 Max. :778.0
## NA's :39 NA's :39
## total_restless_merged total_awake_merged
## Min. : 0.00 Min. : 0.000
## 1st Qu.: 11.00 1st Qu.: 0.000
## Median : 20.00 Median : 3.000
## Mean : 31.17 Mean : 4.469
## 3rd Qu.: 31.00 3rd Qu.: 5.000
## Max. :227.00 Max. :129.000
## Note: 1-Average percentage of time asleep while in bed is 91.5% This is calculated by dividing “Total Minutes Asleep” (419.5) by “Total Time In Bed” (458.6).
Weight totals :
weight_log %>%
select(
weight_lb,
fat,
bmi
) %>%
summary()## weight_lb fat bmi
## Min. :117.5 Min. :10 Min. :21.45
## 1st Qu.:136.0 1st Qu.:13 1st Qu.:24.10
## Median :137.8 Median :16 Median :24.39
## Mean :161.9 Mean :16 Mean :25.73
## 3rd Qu.:189.2 3rd Qu.:19 3rd Qu.:25.76
## Max. :285.7 Max. :22 Max. :46.17
## NA's :31Hourly review:
###hourly calories:
hourly_calories %>%
select(calories)%>%
summary()## calories
## Min. : 42.00
## 1st Qu.: 61.00
## Median : 77.00
## Mean : 94.27
## 3rd Qu.:104.00
## Max. :933.00Note: Average calories burned per hour= 94.27
hourly intensities:
hourly_intensities %>%
select(
total_intensity,
average_intensity
) %>%
summary()## total_intensity average_intensity
## Min. : 0.00 Min. :0.0000
## 1st Qu.: 0.00 1st Qu.:0.0000
## Median : 3.00 Median :0.0500
## Mean : 12.04 Mean :0.2006
## 3rd Qu.: 16.00 3rd Qu.:0.2667
## Max. :180.00 Max. :3.0000Hourly steps :
hourly_steps %>%
select(step_total) %>%
summary()## step_total
## Min. : 0.0
## 1st Qu.: 0.0
## Median : 10.0
## Mean : 286.2
## 3rd Qu.: 289.0
## Max. :10565.0Minute sleep summary :-
minute_sleep %>%
select(
sleep_value,
asleep,
restless,
awake
) %>%
summary()## sleep_value asleep restless awake
## Min. :1.000 Min. :0.0000 Min. :0.00000 Min. :0.0000
## 1st Qu.:1.000 1st Qu.:1.0000 1st Qu.:0.00000 1st Qu.:0.0000
## Median :1.000 Median :1.0000 Median :0.00000 Median :0.0000
## Mean :1.096 Mean :0.9149 Mean :0.07438 Mean :0.0107
## 3rd Qu.:1.000 3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :3.000 Max. :1.0000 Max. :1.00000 Max. :1.0000Including Plots
The idea of walking 10,000 steps a day is common in fitness tracking, but how important is it for your health? Specifically, how do the number of steps you take relate to the calories you burn?
Steps and active minutes
Total steps vs calories plot
ggplot(data = daily_activity, aes(x = total_steps, y = calories)) +
geom_point() +
geom_smooth() + # Trend line with a shadow representing 95% confidence interval
labs(title = "Total steps vs calories") +
ylab("Calories") +
xlab("Total Steps") +
theme_minimal()## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Pearson Correlation Test Between Total Steps and Calories Burned
cor.test(daily_activity$total_steps, daily_activity$calories, method = "pearson")##
## Pearson's product-moment correlation
##
## data: daily_activity$total_steps and daily_activity$calories
## t = 22.472, df = 938, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.5483688 0.6316184
## sample estimates:
## cor
## 0.5915681Note:
This indicates a moderate positive correlation between total steps and calories burned .As the number of steps increases ,the calories burned also tend to increase
What about the connection between being very active and calories?
Very active minutes vs calories plot:
ggplot(data = daily_activity, aes(x = very_active_m, y = calories)) +
geom_point() +
geom_smooth() + # Trend line with a shadow representing 95% confidence interval
labs(title = "Very active minutes vs calories") +
ylab("Calories") +
xlab("Very active minutes") +
theme_minimal()## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Pearson Correlation Test Between Very Active Minutes and Calories Burned:
cor.test(daily_activity$very_active_m, daily_activity$calories, method = "pearson")##
## Pearson's product-moment correlation
##
## data: daily_activity$very_active_m and daily_activity$calories
## t = 23.939, df = 938, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.5745197 0.6540260
## sample estimates:
## cor
## 0.6158383Note:
We observe that as very active minutes increase, the calories burned also go up. This makes sense because intense activity burns more calories.
Very Active Minutes: People spend less time on very intense activities (only about 21 minutes per day), but these activities burn a lot of calories quickly.
Lightly Active Minutes: People spend much more time on lighter activities (about 193 minutes per day). Even though these activities burn fewer calories per minute, the total calorie burn is high because they last so much longer.
Why the Pattern Makes Sense:
Short, intense activity burns calories fast but doesn’t last long. Long, light activity burns calories slowly but adds up because it happens for a much longer time. So, lightly active people burn more calories overall because they’re active for much longer, even if the activity isn’t as intense.
Lightly active minutes vs calories plot:
ggplot(data = daily_activity, aes(x = lightly_active_m, y = calories)) +
geom_point() +
geom_smooth() + # Trend line with a shadow representing 95% confidence interval
labs(title = "Lightly active minutes vs calories") +
ylab("Calories") +
xlab("Lightly active minutes") +
theme_minimal()## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Pearson Correlation Test between Lightly Active Minutes and Calories Burned
cor.test(daily_activity$lightly_active_m, daily_activity$calories, method = "pearson")##
## Pearson's product-moment correlation
##
## data: daily_activity$lightly_active_m and daily_activity$calories
## t = 9.1661, df = 938, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2269361 0.3443464
## sample estimates:
## cor
## 0.2867175Note:
The correlation between lightly_active_m and calories remains positive, but it is noticeably weaker. This suggests that lightly_active_m has a less significant effect on the total calories burned during the day.
Daily calories:
How are calories related to the day of the week?
Create labels and limits for plot:
labels_weekdays <- c(
"Monday" = "Monday", "Tuesday" = "Tuesday",
"Wednesday" = "Wednesday", "Thursday" = "Thursday",
"Friday" = "Friday", "Saturday" = "Saturday",
"Sunday" = "Sunday"
)
limits_weekdays <- c(
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
"Saturday", "Sunday"
)
# Calories vs day of week plot ---------------------------
ggplot(data = daily_activity) +
geom_point(
aes(x = day_of_week, y = calories, color = as.factor(time_of_week)),
position = "jitter",
alpha = 0.3
) +
labs(title = "Daily calories throughout the week", color = "Time of week") +
ylab("Total Calories") +
scale_x_discrete(
"Day",
labels = labels_weekdays,
limits = limits_weekdays,
guide = guide_axis(angle = 45)
) +
stat_summary(
aes(x = day_of_week, y = calories),
fun = mean,
geom = "point",
color = "red",
size = 2,
alpha = 0.7
) +
theme_minimal()
Note:
The average calories burned each day seem similar, with the red dots representing these averages for each day.
Daily sleep:
How does sleep quality vary throughout the week? One might expect people to sleep better on weekends compared to weekdays. Are there any surprising trends?
Total minutes asleep vs time of week
ggplot(data = sleep_data) +
geom_point(
aes(
x = weekdays.POSIXt(activity_date),
y = total_asleep_merged,
color = as.factor(time_of_week)
),
position = "jitter",
alpha = 0.3
) +
labs(title = "Total minutes asleep throughout week") +
guides(color = "none") +
ylab("Minutes asleep") +
scale_x_discrete(
"Day",
labels = labels_weekdays,
limits = limits_weekdays,
guide = guide_axis(angle = 45)
) +
stat_summary(
aes(x = weekdays.POSIXt(activity_date), y = total_asleep_merged),
fun = mean,
geom = "point",
color = "red",
size = 2,
alpha = 0.7
) +
theme_minimal()
Total minutes restless vs time of week
ggplot(data = sleep_data) +
geom_point(
aes(
x = weekdays.POSIXt(activity_date),
y = total_restless_merged,
color = as.factor(time_of_week)
),
position = "jitter",
alpha = 0.3
) +
labs(title = "Total minutes restless throughout week") +
guides(color = "none") +
ylab("Minutes restless") +
scale_x_discrete(
"Day",
labels = labels_weekdays,
limits = limits_weekdays,
guide = guide_axis(angle = 45)
) +
stat_summary(
aes(x = weekdays.POSIXt(activity_date), y = total_restless_merged),
fun = mean,
geom = "point",
color = "red",
size = 2,
alpha = 0.7
) +
theme_minimal()
Total minutes awake vs time of week:
ggplot(data = sleep_data) +
geom_point(
aes(
x = weekdays.POSIXt(activity_date),
y = total_awake_merged,
color = as.factor(time_of_week)
),
position = "jitter",
alpha = 0.3
) +
labs(title = "Total minutes awake throughout week") +
guides(color = "none") +
ylab("Minutes awake") +
scale_x_discrete(
"Day",
labels = labels_weekdays,
limits = limits_weekdays,
guide = guide_axis(angle = 45)
) +
stat_summary(
aes(x = weekdays.POSIXt(activity_date), y = total_awake_merged),
fun = mean,
geom = "point",
color = "red",
size = 2,
alpha = 0.7
) +
theme_minimal()
Note:
Looking at the daily averages on the graphs (represented by red dots), we can observe that:
1-The highest average total sleep minutes occurred on Sunday, Wednesday, and Saturday.
2-The highest averages for minutes awake and minutes restless were seen on Sunday and Saturday.
While people tend to sleep more on weekends, the quality of sleep doesn’t appear to be better, as indicated by the higher minutes awake and restless.
Combining Data:----
From these initial analysis, active minutes seem to provide more useful insights than steps, calories, or sleep. It would be good to combine these dataframes and look into this metric further.
daily_data:
We’ll begin by combining the daily_activity, sleep_data, and weight_log into a single daily_data dataframe. We’ll exclude daily_calories, daily_intensities, and daily_steps since this information is already included in the daily_activity dataframe.
combining daily data into one dataframe:———
daily_data_0 <-
merge(
x = daily_activity, y = sleep_data,
by = c("id", "activity_date_ymd", "day_of_week", "time_of_week"),
all.x = TRUE
)
daily_data <-
merge(
x = daily_data_0, y = weight_log,
by = c("id", "activity_date_ymd", "day_of_week", "time_of_week"), all.x = TRUE
)
# Add two new active minute variables to daily data ---------------------------
daily_data <-
daily_data %>%
mutate(
daily_mod_vig_m = fairly_active_m + very_active_m,
daily_light_sed_m = lightly_active_m + sedentary_m
)hourly_data:------
Next, we’ll merge hourly_calories, hourly_intensities, and hourly_steps into a single hourly_data dataframe.
Merging hourly data into one dataframe:———-
hourly_data_0 <-
merge(
x = hourly_calories, y = hourly_intensities,
by = c(
"id", "activity_hour", "activity_date_ymd", "activity_time", "hour_of_day",
"day_of_week", "time_of_week"
),
all.x = TRUE, no.dups = TRUE
)
hourly_data <-
merge(
x = hourly_data_0, y = hourly_steps,
by = c(
"id", "activity_hour", "activity_date_ymd", "activity_time", "hour_of_day",
"day_of_week", "time_of_week"
),
all.x = TRUE
)weekly_data:-----------
Finally, we’ll create a weekly_data dataframe by aggregating data from the daily_data dataframe.
Create new weekly_data_00 dataframe:———–
weekly_data_0 <-
daily_data %>%
select(
id, activity_date_ymd, day_of_week, activity_date, total_steps, total_distance,
very_active_d, moderately_active_d, light_active_d,
sedentary_d, very_active_m, fairly_active_m,
lightly_active_m, sedentary_m, calories
) %>%
mutate(
week_number = paste0(
"Week ", (as.numeric(format(activity_date_ymd, "%U"))), ", ",
format(activity_date_ymd, "%b %Y")
)
)Summarize totals by week in new weekly_data dataframe:
weekly_data <-
weekly_data_0 %>%
group_by(id, week_number) %>%
dplyr::summarize(
weekly_total_steps = sum(total_steps),
weekly_total_distance = sum(total_distance),
weekly_vigorous_d = sum(very_active_d),
weekly_moderate_d = sum(moderately_active_d),
weekly_light_d = sum(light_active_d),
weekly_sedentary_d = sum(sedentary_d),
weekly_vigorous_m = sum(very_active_m),
weekly_moderate_m = sum(fairly_active_m),
weekly_mod_vig_m = weekly_vigorous_m + weekly_moderate_m,
weekly_light_m = sum(lightly_active_m),
weekly_sedentary_m = sum(sedentary_m),
weekly_light_sed_m = weekly_light_m + weekly_sedentary_m,
weekly_calories = sum(calories)
)## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.Deleting old data:
List all objects in current R workspace :
ls()## [1] "daily_activity" "daily_calories" "daily_data"
## [4] "daily_data_0" "daily_intensities" "daily_sleep"
## [7] "daily_steps" "hourly_calories" "hourly_data"
## [10] "hourly_data_0" "hourly_intensities" "hourly_steps"
## [13] "labels_weekdays" "limits_weekdays" "minute_sleep"
## [16] "sleep_data" "sleep_summary" "sleep_summary_0"
## [19] "weekly_data" "weekly_data_0" "weight_log"Remove old objects:
rm("daily_calories", "daily_intensities", "daily_steps", "daily_sleep",
"weight_log")
rm("hourly_calories", "hourly_intensities", "hourly_steps", "minute_sleep")
rm("daily_data_0", "hourly_data_0", "sleep_summary_0", "weekly_data_0")List all objects again in current R workspace :
ls()## [1] "daily_activity" "daily_data" "hourly_data" "labels_weekdays"
## [5] "limits_weekdays" "sleep_data" "sleep_summary" "weekly_data"Creating new variables for faceting:
To create plots correctly faceted by day of the week or time of day, we need to add a new variable to each of the merged dataframes.
Create day_list for ordered facet grid/wrapping :
hourly_data$day_list <-
factor(hourly_data$day_of_week, levels = c(
"Monday", "Tuesday", "Wednesday", "Thursday",
"Friday", "Saturday", "Sunday"
))
daily_data$day_list <-
factor(daily_data$day_of_week, levels = c(
"Monday", "Tuesday", "Wednesday", "Thursday",
"Friday", "Saturday", "Sunday"
))
# Create time_list for ordered facet grid/wrapping ---------------------------
hourly_data$time_list <-
factor(hourly_data$activity_time,
levels = c(
"12:00:00 AM", "01:00:00 AM", "02:00:00 AM", "03:00:00 AM",
"04:00:00 AM", "05:00:00 AM", "06:00:00 AM", "07:00:00 AM",
"08:00:00 AM", "09:00:00 AM", "10:00:00 AM", "11:00:00 AM",
"12:00:00 PM", "01:00:00 PM", "02:00:00 PM", "03:00:00 PM",
"04:00:00 PM", "05:00:00 PM", "06:00:00 PM", "07:00:00 PM",
"08:00:00 PM", "09:00:00 PM", "10:00:00 PM", "11:00:00 PM"
)
)Before we look at the new summary statistics, we need to answer an important question:
Should we use the mean or the median?
This depends on how much outliers affect the mean. To understand this, we can visualize the data with histograms for each new dataframe.
daily_data:
Daily histogram plot:
daily_hplot <- ggplot(data = daily_data)
# Histogram plot for daily_mod_vig_m ---------------------------
(bw <- nclass.FD(daily_data$daily_mod_vig_m)) # Optimize binwidth for each plot## [1] 24daily_hplot +
geom_histogram(aes(x = daily_mod_vig_m), bins = bw) +
labs(
x = "Minutes",
y = "Count",
title = "Daily moderate/vigorous minutes",
caption = "Median: 21.00 , Mean: 34.87"
) 
# Histogram plot for daily_light_sed_m ---------------------------
(bw <- nclass.FD(daily_data$daily_light_sed_m))## [1] 15daily_hplot +
geom_histogram(aes(x = daily_light_sed_m), bins = bw) +
labs(
x = "Minutes",
y = "Count",
title = "Daily light/sedentary minutes",
caption = "Median: 1333 , Mean: 1183"
)
# Histogram plot for total_steps ---------------------------
(bw <- nclass.FD(daily_data$total_steps))## [1] 26daily_hplot +
geom_histogram(aes(x = total_steps), bins = bw) +
labs(
x = "Total Steps",
y = "Count",
title = "Daily total steps",
caption = "Median: 7439 , Mean: 7652"
)
# Histogram plot for calories ---------------------------
(bw <- nclass.FD(daily_data$calories))## [1] 25daily_hplot +
geom_histogram(aes(x = calories), bins = bw) +
labs(
x = "Calories",
y = "Count",
title = "Daily total calories",
caption = "Median: 2140 , Mean: 2308"
)
# Histogram plot for total_minutes_asleep ---------------------------
daily_hplot +
geom_histogram(aes(x = total_minutes_asleep)) +
labs(
x = "Total Minutes Asleep",
y = "Count",
title = "Daily minutes asleep",
caption = "Median: 433.0 , Mean: 419.5"
)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 530 rows containing non-finite outside the scale range
## (`stat_bin()`).
# Histogram plot for total_time_in_bed ---------------------------
daily_hplot +
geom_histogram(aes(x = total_time_in_bed)) +
labs(
x = "Total Time in Bed",
y = "Count",
title = "Daily total time in bed",
caption = "Median: 463.0 , Mean: 458.6"
)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 530 rows containing non-finite outside the scale range
## (`stat_bin()`).
Remove bindwith object:
rm(bw)Note:
Due to the significant impact of outliers on the mean for certain variables, we should use the median for the daily summary statistics, including daily moderate/vigorous minutes, daily light/sedentary minutes, and daily total steps. However, the mean can still be used for sleep variables and calories.
New summary statistics:
###Daily steps, distance and calories:
daily_data %>%
select(
total_steps,
total_distance,
calories
) %>%
summary()## total_steps total_distance calories
## Min. : 0 Min. : 0.000 Min. : 0
## 1st Qu.: 3795 1st Qu.: 2.620 1st Qu.:1830
## Median : 7439 Median : 5.260 Median :2140
## Mean : 7652 Mean : 5.503 Mean :2308
## 3rd Qu.:10734 3rd Qu.: 7.720 3rd Qu.:2796
## Max. :36019 Max. :28.030 Max. :4900###Active minute levels per category:
daily_data %>%
select(
very_active_m,
fairly_active_m,
lightly_active_m,
sedentary_m,
daily_mod_vig_m,
daily_light_sed_m
) %>%
summary()## very_active_m fairly_active_m lightly_active_m sedentary_m
## Min. : 0.00 Min. : 0.00 Min. : 0 Min. : 0.0
## 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.:127 1st Qu.: 729.0
## Median : 4.00 Median : 7.00 Median :199 Median :1057.0
## Mean : 21.24 Mean : 13.63 Mean :193 Mean : 990.4
## 3rd Qu.: 32.00 3rd Qu.: 19.00 3rd Qu.:264 3rd Qu.:1229.0
## Max. :210.00 Max. :143.00 Max. :518 Max. :1440.0
## daily_mod_vig_m daily_light_sed_m
## Min. : 0.00 Min. : 2
## 1st Qu.: 0.00 1st Qu.: 947
## Median : 21.00 Median :1333
## Mean : 34.87 Mean :1183
## 3rd Qu.: 57.00 3rd Qu.:1432
## Max. :275.00 Max. :1440Daily overall sleep:
daily_data %>%
select(
total_sleep_records,
total_minutes_asleep,
total_time_in_bed
) %>%
summary()## total_sleep_records total_minutes_asleep total_time_in_bed
## Min. :1.000 Min. : 58.0 Min. : 61.0
## 1st Qu.:1.000 1st Qu.:361.0 1st Qu.:403.0
## Median :1.000 Median :433.0 Median :463.0
## Mean :1.119 Mean :419.5 Mean :458.6
## 3rd Qu.:1.000 3rd Qu.:490.0 3rd Qu.:526.0
## Max. :3.000 Max. :796.0 Max. :961.0
## NA's :530 NA's :530 NA's :530Daily sleep by category:
daily_data %>%
select(
total_asleep_merged,
total_restless_merged,
total_awake_merged
) %>%
summary()## total_asleep_merged total_restless_merged total_awake_merged
## Min. : 35.0 Min. : 0.00 Min. : 0.000
## 1st Qu.:353.0 1st Qu.: 13.00 1st Qu.: 1.000
## Median :420.0 Median : 21.00 Median : 3.000
## Mean :413.2 Mean : 32.76 Mean : 4.208
## 3rd Qu.:485.0 3rd Qu.: 32.00 3rd Qu.: 5.000
## Max. :778.0 Max. :227.00 Max. :110.000
## NA's :530 NA's :530 NA's :530Weight logs:
daily_data %>%
select(
weight_lb,
fat,
bmi
) %>%
summary()## weight_lb fat bmi
## Min. :137.8 Min. : NA Min. :24.39
## 1st Qu.:150.6 1st Qu.: NA 1st Qu.:24.71
## Median :163.5 Median : NA Median :25.04
## Mean :163.5 Mean :NaN Mean :25.04
## 3rd Qu.:176.3 3rd Qu.: NA 3rd Qu.:25.36
## Max. :189.2 Max. : NA Max. :25.68
## NA's :941 NA's :943 NA's :941New notes:
Insights on Weekly Activities
Analyzing this sample of people’s weekly activities reveals several notable findings:
1- 46,857 steps: The average weekly step count falls short of the recommended 70,000 steps (10,000 steps/day for 7 days).
2- 6,064 minutes: The average time spent sedentary per week, equivalent to over 4.2 days(6064/60*24) , which is the highest among tracked activity levels.
3- 1,182 minutes: The average weekly time engaged in light-intensity (Lightly Active) activity, making it the most common non-sedentary activity level.
4- 182 minutes: The weekly median for combined moderate- and vigorous-intensity activity.
5- 65.5 minutes: Weekly median for moderate-intensity (Fairly Active) activity.
6-68.5 minutes: Weekly median for vigorous-intensity (Very Active) activity. Interestingly, this is higher than the moderate-intensity median!
7- 91.5%: The average percentage of time spent asleep while in bed, calculated by dividing total sleep time (419.5 minutes) by total time in bed (458.6 minutes).
8- 83 calories/hour: The median rate of calories burned per hour.
These findings highlight trends in activity intensity, sleep efficiency, and caloric expenditure among the sample group.
New exploration:
Hour of day:
Let’s explore potential relationships between the hour of the day and various variables. We’ll create labels_hour_of_day to use in these visualizations:
Create labels for hour of day
Note that we are assigning times to the current date of analysis to ensure
that all times are within the same 24 hour day
labels_hour_of_day <- c(
"2022-01-18 00:00:00" = "00:00",
"2022-01-18 01:00:00" = "01:00",
"2022-01-18 02:00:00" = "02:00",
"2022-01-18 03:00:00" = "03:00",
"2022-01-18 04:00:00" = "04:00",
"2022-01-18 05:00:00" = "05:00",
"2022-01-18 06:00:00" = "06:00",
"2022-01-18 07:00:00" = "07:00",
"2022-01-18 08:00:00" = "08:00",
"2022-01-18 09:00:00" = "09:00",
"2022-01-18 10:00:00" = "10:00",
"2022-01-18 11:00:00" = "11:00",
"2022-01-18 12:00:00" = "12:00",
"2022-01-18 13:00:00" = "13:00",
"2022-01-18 14:00:00" = "14:00",
"2022-01-18 15:00:00" = "15:00",
"2022-01-18 16:00:00" = "16:00",
"2022-01-18 17:00:00" = "17:00",
"2022-01-18 18:00:00" = "18:00",
"2022-01-18 19:00:00" = "19:00",
"2022-01-18 20:00:00" = "20:00",
"2022-01-18 21:00:00" = "21:00",
"2022-01-18 22:00:00" = "22:00",
"2022-01-18 23:00:00" = "23:00",
"2022-01-18 24:00:00" = "24:00"
)Which hours of the day have the highest number of observations per data point? Are there specific times when people are most active?
step_total observations per hour :
ggplot(data = hourly_data, aes(x = as.factor(hour_of_day))) +
geom_bar(aes(weight = step_total), stat = "count") +
labs(title = "'step_total' observations throughout a 24 hour day") +
scale_y_continuous(name = "Count", labels = scales::comma) +
scale_x_discrete(
"Hour of day",
labels = labels_hour_of_day,
guide = guide_axis(angle = 45)
) +
theme_minimal()
calories observations per hour:
ggplot(data = hourly_data, aes(x = as.factor(hour_of_day))) +
geom_bar(aes(weight = calories), stat = "count") +
labs(title = "'calories' observations throughout a 24 hour day") +
scale_y_continuous(name = "Count", labels = scales::comma) +
scale_x_discrete(
"Hour of day",
labels = labels_hour_of_day,
guide = guide_axis(angle = 45)
) +
theme_minimal()
average_intensity observations per hour:
ggplot(data = hourly_data, aes(x = as.factor(hour_of_day))) +
geom_bar(aes(weight = average_intensity), stat = "count") +
labs(title = "'average_intensity' observations throughout a 24 hour day") +
scale_y_continuous(name = "Count", labels = scales::comma) +
scale_x_discrete(
"Hour of day",
labels = labels_hour_of_day,
guide = guide_axis(angle = 45)
) +
theme_minimal()
All three variables — step_total, calories, average_intensity — have similar shapes. The counts are lowest from 12:00-4:00 AM (00:00-04:00), which is when most people are asleep. The two time windows with highest counts of observations are the same across all three graphs:
12:00 - 2:00 PM (12:00 - 14:00) 5:00 - 7:00 PM (17:00 - 19:00)
Average intensity vs time:
What is the relationship between time and average intensity? For instance, are people more active in the morning compared to the evening? How does this data align with the observation counts shown in the plots above?
Average intensity throughout the day :
average_intensity_p <-
ggplot(
data = hourly_data,
aes(x = time_list, y = average_intensity, color = average_intensity)
)average_intensity_p +
geom_jitter(width = 0.3, size = 0.2) +
labs(
x = "Hour",
y = "Average intensity",
color = "Average Intensity",
title = "Average intensity throughout the day"
) +
stat_summary(
aes(x = time_list, y = average_intensity),
fun = mean,
geom = "point",
color = "white",
size = 1,
alpha = 0.7
) +
scale_color_viridis_c() +
theme_solarized(light = FALSE) +
theme(
axis.title.x = element_text(
margin = margin(5, 0, 5, 0),
size = 12
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
plot.title = element_text(
margin = margin(10, 0, 10, 0),
size = 14
),
axis.text.x = element_text(
angle = 45,
vjust = 1,
hjust = 1,
size = 8
)
)## Warning: Removed 23909 rows containing non-finite outside the scale range
## (`stat_summary()`).## Warning: Removed 23909 rows containing missing values or values outside the scale range
## (`geom_point()`).
As anticipated, the average intensity starts to increase around 5:00 AM and remains relatively high throughout the workday, before decreasing around 8:00 PM. This trend is clearly visible by examining the mean for each hour, represented by the white dots in each column. The peak periods align with the observation counts we saw earlier:
12:00 PM - 2:00 PM (12:00 - 14:00)
5:00 PM - 7:00 PM (17:00 - 19:00)
Day-to-day?
Average intensity throughout the week:
average_intensity_p <-
ggplot(
data = hourly_data,
aes(
x = reorder(day_list, desc(day_list)),
y = average_intensity,
color = average_intensity
)
)
average_intensity_p +
geom_jitter(width = 0.3, size = 0.1) +
labs(
x = "Day",
y = "Average intensity",
color = "Average Intensity",
title = "Average intensity throughout the week"
) +
stat_summary(
aes(
x = reorder(day_list, desc(day_list)),
y = average_intensity
),
fun = mean,
geom = "point",
color = "white",
size = 1,
alpha = 0.7
) +
scale_color_viridis_c() +
theme_solarized(light = FALSE) +
theme(
axis.title.x = element_text(
margin = margin(5, 0, 5, 0),
size = 12
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
plot.title = element_text(
margin = margin(10, 0, 10, 0),
size = 14
),
axis.text.x = element_text(
size = 12
)
) +
coord_flip()## Warning: Removed 23909 rows containing non-finite outside the scale range
## (`stat_summary()`).## Warning: Removed 23909 rows containing missing values or values outside the scale range
## (`geom_point()`).
Unlike the hourly observations, there isn’t as distinct a pattern when examining the data day-to-day. This is evident once again by looking at the mean for each day, represented by the white dots in each column. The variation between each dot’s position is minimal in this case.
Now, let’s revisit the relationship between intensity and the hour of the day. Do the trends differ when comparing weekdays to weekends?
average_intensity throughout a 24 hour day :
hd_A <- dplyr::select(hourly_data, -time_of_week)
ggplot(
data = hourly_data,
aes(x = as.factor(hour_of_day), y = average_intensity)
) +
geom_jitter(data = hd_A, color = "grey70", width = 0.4, alpha = 0.6, size = 2) +
geom_jitter(aes(color = time_of_week), width = 0.4, alpha = 0.6, size = 2) +
scale_color_viridis_d(begin = 0, end = .5) +
labs(
title = "Average intensity throughout a 24 hour day",
x = "Hour"
) +
ylab("Average intensity") +
scale_x_discrete(
"Hour of day",
expand = c(0.0002, 0.0002),
labels = labels_hour_of_day,
guide = guide_axis(angle = 45)
) +
stat_summary(
aes(x = as.factor(hour_of_day), y = average_intensity),
fun = mean,
geom = "point",
color = "#fde725",
size = 4
) +
theme_pander() +
theme(
legend.position = "none",
axis.title.x = element_text(
margin = margin(15, 0, 10, 0),
size = 16
),
axis.title.y = element_text(
margin = margin(0, 10, 0, 10),
size = 16
),
plot.title = element_text(
margin = margin(10, 0, 10, 0),
size = 20
),
strip.text.x = element_text(
margin = margin(10, 0, 10, 0),
size = 14
),
axis.text.x = element_text(
size = 12
),
axis.text.y = element_text(
size = 12
)
) +
facet_wrap(vars(time_of_week), nrow = 2)## Warning: Removed 23909 rows containing non-finite outside the scale range
## (`stat_summary()`).## Warning: Removed 47818 rows containing missing values or values outside the scale range
## (`geom_point()`).## Warning: Removed 23909 rows containing missing values or values outside the scale range
## (`geom_point()`).
total_intensity throughout a 24 hour day:
jitter_pos <-
position_jitter(width = 0.25, height = 0, seed = 42)
set.seed(42)
hd_A <-
dplyr::select(hourly_data, -time_of_week)
set.seed(42)
hd_total_intensity_p <-
ggplot(
data = hourly_data,
aes(x = as.factor(hour_of_day), y = total_intensity, color = time_of_week)
)
# total_intensity throughout a 24 hour day ---------------------------
hd_total_intensity_p +
geom_point(
data = transform(hourly_data, time_of_week = NULL),
color = "grey70",
position = position_jitter(width = 0.4, height = 0, seed = 42),
size = 2
) +
geom_point(
position = position_jitter(width = 0.4, height = 0, seed = 42),
size = 2,
alpha = 0.6
) +
labs(
title = "Total intensity throughout a 24 hour day",
x = "Hour"
) +
ylab("Total intensity") +
scale_color_viridis_d(begin = 0, end = .5, guide = "legend") +
scale_x_discrete(
"Hour of day",
expand = c(0.0002, 0.0002),
labels = labels_hour_of_day,
guide = guide_axis(angle = 45)
) +
stat_summary(
aes(x = as.factor(hour_of_day), y = total_intensity),
fun = mean,
geom = "point",
color = "#fde725",
size = 4
) +
theme_pander() +
theme(
legend.position = "none",
axis.title.x = element_text(
margin = margin(15, 0, 10, 0),
size = 16
),
axis.title.y = element_text(
margin = margin(0, 10, 0, 10),
size = 16
),
plot.title = element_text(
margin = margin(10, 0, 10, 0),
size = 20
),
strip.text.x = element_text(
margin = margin(10, 0, 10, 0),
size = 14
),
axis.text.x = element_text(
size = 12
),
axis.text.y = element_text(
size = 12
)
) +
facet_wrap(vars(time_of_week), nrow = 2)## Warning: Removed 23909 rows containing non-finite outside the scale range
## (`stat_summary()`).## Warning: Removed 47818 rows containing missing values or values outside the scale range
## (`geom_point()`).## Warning: Removed 23909 rows containing missing values or values outside the scale range
## (`geom_point()`).
Active vs sedentary:
Create theme for plot formatting:
theme_margin <-
theme(
axis.title.x = element_text(margin = margin(15, 0, 15, 0)),
axis.title.y = element_text(margin = margin(0, 10, 0, 10)),
plot.title = element_text(margin = margin(10, 0, 10, 0)),
strip.text.x = element_text(margin = margin(10, 0, 10, 0)),
)
# Very active minutes vs sedentary minutes ---------------------------
dd02_A <- dplyr::select(daily_data, -time_of_week)
ggplot(daily_data, aes(x = very_active_m, y = sedentary_m)) +
geom_jitter(data = dd02_A, color = "grey70") +
geom_jitter(
aes(x = very_active_m, y = sedentary_m),
color = "#112E51",
width = 0.4,
size = 1
) +
labs(title = "Very active minutes vs sedentary minutes throughout the week") +
ylab("Sedentary minutes") +
xlab("Very active minutes") +
geom_smooth(
aes(x = very_active_m, y = sedentary_m),
color = "#00CFFF",
linetype = "longdash",
alpha = 0.4,
se = FALSE
) +
theme_minimal() +
theme_margin +
facet_grid(~time_of_week ~ .)## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Fairly active minutes vs sedentary minutes :
dd02_A <- dplyr::select(daily_data, -time_of_week)
ggplot(daily_data, aes(x = fairly_active_m, y = sedentary_m)) +
geom_jitter(data = dd02_A, color = "grey70") +
geom_jitter(
aes(x = fairly_active_m, y = sedentary_m),
color = "#112E51",
width = 0.4,
size = 1
) +
labs(
title = "Fairly active minutes vs sedentary minutes throughout the week"
) +
ylab("Sedentary minutes") +
xlab("Fairly active minutes") +
geom_smooth(
aes(x = fairly_active_m, y = sedentary_m),
color = "#00CFFF",
linetype = "longdash",
alpha = 0.6,
se = FALSE
) +
theme_minimal() +
theme_margin +
facet_grid(~time_of_week ~ .)## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Lightly active minutes vs sedentary minutes:
dd02_A <- dplyr::select(daily_data, -time_of_week)
ggplot(daily_data, aes(x = lightly_active_m, y = sedentary_m)) +
geom_jitter(data = dd02_A, color = "grey70") +
geom_jitter(
aes(x = lightly_active_m, y = sedentary_m),
color = "#112E51",
width = 0.4,
size = 1
) +
labs(
title = "Lightly active minutes vs sedentary minutes throughout the week"
) +
ylab("Sedentary minutes") +
xlab("Lightly active minutes") +
geom_smooth(
aes(x = lightly_active_m, y = sedentary_m),
color = "#00CFFF",
linetype = "longdash",
alpha = 0.6,
se = FALSE
) +
theme_minimal() +
theme_margin +
facet_grid(~time_of_week ~ .)## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Active minutes:
A Key Health Metric
Among all the metrics we’ve examined so far, active minutes will be our primary focus moving forward. In this section, we’ll generate visualizations and highlight key findings related to active minutes. Based on this analysis, we will also provide our top high-level content recommendations to share with key stakeholders.
Trends in Active Minutes
Experts advise adults to engage in at least 150 to 300 minutes of moderate to vigorous aerobic activity each week (according to the WHO’s “Every Move Counts” campaign). From the summary analysis above, we can see that the median amount of moderate/vigorous activity these participants are getting is 182 minutes per week. But how many participants are actually meeting this guideline? What strategies can we implement to encourage more consistent activity?
Let’s take a look at the 154 individual weekly activity totals to assess activity levels across the participant group, starting with the weekly_moderate_m totals.
Create labels for week-month-year:
labels_wmy <- c(
"Week 15\nApr-16", "Week 16\nApr-16", "Week 17\nApr-16", "Week 18\nMay-16",
"Week 19\nMay-16"
)create dataframe to use in next plot :
weekly_moderate_150_300 <- as.data.frame(
weekly_data %>%
group_by(
weekly_moderate_m < 150,
(weekly_moderate_m >= 150 & weekly_moderate_m < 300),
weekly_moderate_m >= 300
) %>%
tally()
)
weekly_moderate_150_300_table <-
cbind(c("300+ ", "150 - 300 ", "0 - 150 "), weekly_moderate_150_300[, 4])Create weekly_moderate_p:
weekly_moderate_p <-
ggplot(weekly_data, aes(x = week_number, y = weekly_moderate_m))Add layers to weekly_moderate_p :
weekly_moderate_p +
geom_point(
data = weekly_data[which(weekly_data$weekly_moderate_m >= 300), ],
aes(color = "300+ "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_moderate_m >= 150 & weekly_data$weekly_moderate_m < 300), ],
aes(color = "150 - 300 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_moderate_m < 150), ],
aes(color = "0 - 150 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
scale_x_discrete(name = NULL, labels = labels_wmy) +
scale_y_continuous(
breaks = c(0, 150, 300, 450, 600, 750, 900, 1050),
limits = c(0, 1060)
) +
scale_color_manual(
name = "Minutes",
labels = c("300+ ", "150 - 300 ", "0 - 150 "),
values = c(
"300+ " = "#225ea8",
"150 - 300 " = "#41b6c4",
"0 - 150 " = "#707070"
)
) +
labs(
title = "Moderate activity",
subtitle = "(minutes per week)"
) +
geom_hline(yintercept = 150, linetype = "dashed") +
geom_hline(yintercept = 300, linetype = "dashed") +
ylab("Activity minutes") +
theme_classic() +
theme(
plot.subtitle = element_text(
margin = margin(1, 5, 5, 0),
size = 10,
hjust = 1,
face = "italic"
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
plot.title = element_text(
margin = margin(5, 5, 5, 0),
size = 14,
hjust = 1,
face = "bold"
),
legend.position = "bottom"
) +
guides(color = guide_legend(override.aes = list(size = 3))) +
coord_cartesian(clip = "off") +
theme(
plot.margin = margin(1, 25, 1, 1)
) +
annotation_custom(
grob = tableGrob(weekly_moderate_150_300_table, theme = ttheme_minimal(
base_size = 9,
base_color = "black",
base_family = "",
parse = FALSE,
padding = unit(c(4, 4), "mm"),
core = list(
bg_params = list(fill = c("#225ea8", "#41b6c4", "#707070"),
alpha = .3,
col = NA),
fg_params = list(hjust = 0, x = 0.15, fontface = c(rep("plain", 3)))),
colhead = list(fg_params = list(hjust = 0, x = 0.15))
)),
xmin = 4.5, xmax = 6, ymin = 600, ymax = 1050
)
let’s look at weekly_vigorous_m totals:
Create dataframe to use in next plot :
weekly_vigorous_75_150 <-
as.data.frame(
weekly_data %>%
group_by(
weekly_vigorous_m < 75,
(weekly_vigorous_m >= 75 & weekly_vigorous_m < 150),
weekly_vigorous_m >= 150
) %>%
tally()
)
weekly_vigorous_75_150_table <-
cbind(c("150+ ", "75 - 150 ", "0 - 75 "), weekly_vigorous_75_150[, 4])Create weekly_vigorous_p:
weekly_vigorous_p <-
ggplot(weekly_data, aes(x = week_number, y = weekly_vigorous_m))Add layers to weekly_vigorous_p:
weekly_vigorous_p +
geom_point(
data = weekly_data[which(weekly_data$weekly_vigorous_m >= 150), ],
aes(color = "150+ "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.4
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_vigorous_m >= 75 & weekly_data$weekly_vigorous_m < 150), ],
aes(color = "75 - 150 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.4
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_vigorous_m < 75), ],
aes(color = "0 - 75 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.4
) +
scale_x_discrete(name = NULL, labels = labels_wmy) +
scale_y_continuous(breaks = c(0, 75, 150, 300, 450, 600, 750, 900, 1050),
limits = c(0, 1060)) +
scale_color_manual(
name = "Minutes",
labels = c("150+ ", "75 - 150 ", "0 - 75 "),
values = c(
"150+ " = "#225ea8",
"75 - 150 " = "#41b6c4",
"0 - 75 " = "#707070"
)
) +
labs(
title = "Vigorous activity",
subtitle = "(minutes per week)"
) +
geom_hline(yintercept = 75, linetype = "dashed") +
geom_hline(yintercept = 150, linetype = "dashed") +
ylab("Activity minutes") +
theme_classic() +
theme(
plot.subtitle = element_text(
margin = margin(1, 5, 5, 0),
size = 10,
hjust = 1,
face = "italic"
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
plot.title = element_text(
margin = margin(5, 5, 5, 0),
size = 14,
hjust = 1,
face = "bold"
),
legend.position = "bottom"
) +
guides(color = guide_legend(override.aes = list(size = 3))) +
# Add summary table to weekly_vigorous_p ---------------------------
coord_cartesian(clip = "off") +
theme(
plot.margin = margin(1, 25, 1, 1)
) +
annotation_custom(
grob = tableGrob(
weekly_vigorous_75_150_table,
theme = ttheme_minimal(
base_size = 9,
base_color = "black",
base_family = "",
parse = FALSE,
padding = unit(c(4, 4), "mm"),
core = list(
bg_params = list(
fill = c("#225ea8", "#41b6c4", "#707070"),
alpha = .3,
col = NA),
fg_params = list(hjust = 0, x = 0.15, fontface = c(rep("plain", 3))),
colhead = list(fg_params = list(hjust = 0, x = 0.15))
),
vp = NULL
)
),
xmin = 4.5,
xmax = 6,
ymin = 600,
ymax = 1050
)
While the graphs above for moderate and vigorous minutes are informative, it would be more useful to combine these metrics when evaluating the 150 to 300-minute goal for moderate to vigorous physical activity per week.
Create dataframe to use in next plot:
weekly_moderate_vigorous_150_300 <-
as.data.frame(
weekly_data %>%
group_by(
weekly_mod_vig_m < 150,
(weekly_mod_vig_m >= 150 & weekly_mod_vig_m < 300),
weekly_mod_vig_m >= 300
) %>%
tally()
)
weekly_moderate_vigorous_150_300_table <-
cbind(c("300+ ", "150 - 300 ", "0 - 150 "), weekly_moderate_vigorous_150_300[, 4])Create weekly_moderate_vigorous_p:
weekly_moderate_vigorous_p <-
ggplot(weekly_data, aes(x = week_number, y = weekly_mod_vig_m))Add layers to weekly_moderate_vigorous_p :
weekly_moderate_vigorous_p +
geom_point(
data = weekly_data[which(weekly_data$weekly_mod_vig_m >= 300), ],
aes(color = "300+ "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_mod_vig_m >= 150 & weekly_data$weekly_mod_vig_m < 300), ],
aes(color = "150 - 300 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_mod_vig_m < 150), ],
aes(color = "0 - 150 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
scale_x_discrete(name = NULL, labels = labels_wmy) +
scale_y_continuous(breaks = c(0, 150, 300, 450, 600, 750, 900, 1050), limits = c(0, 1060)) +
scale_color_manual(
name = "Minutes",
labels = c("300+ ", "150 - 300 ", "0 - 150 "),
values = c(
"300+ " = "#225ea8",
"150 - 300 " = "#41b6c4",
"0 - 150 " = "#707070"
)
) +
labs(
title = "Combined moderate/vigorous activity",
subtitle = "(minutes per week)"
) +
geom_hline(yintercept = 150, linetype = "dashed") +
geom_hline(yintercept = 300, linetype = "dashed") +
ylab("Activity minutes") +
theme_classic() +
theme(
plot.subtitle = element_text(
margin = margin(1, 5, 5, 0),
size = 10,
hjust = 1,
face = "italic"
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
plot.title = element_text(
margin = margin(5, 5, 5, 0),
size = 14,
hjust = 1,
face = "bold"
),
legend.position = "bottom"
) +
guides(color = guide_legend(override.aes = list(size = 3))) +
# Add summary table to weekly_moderate_vigorous_p ---------------------------
coord_cartesian(clip = "off") +
theme(
plot.margin = margin(1, 25, 1, 1)
) +
annotation_custom(
grob = tableGrob(
weekly_moderate_vigorous_150_300_table,
theme = ttheme_minimal(
base_size = 9,
base_color = "black",
base_family = "",
parse = FALSE,
padding = unit(c(4, 4), "mm"),
core = list(
bg_params = list(
fill = c("#225ea8", "#41b6c4", "#707070"),
alpha = .3,
col = NA),
fg_params = list(hjust = 0,
x = 0.15,
fontface = c(rep("plain", 3))),
colhead = list(fg_params = list(hjust = 0, x = 0.15))
),
vp = NULL
)
),
xmin = 4.5,
xmax = 6,
ymin = 600,
ymax = 1050
)
Moderate_vigorous_activity_per_week
if (!dir.exists("images")) {
dir.create("images")
}ggsave(filename = "Moderate_vigorous_activity_per_week_color.png", path = "images")## Saving 7 x 5 in imageCreate basic graph showing 154 totals in grey:
weekly_moderate_vigorous_p <-
ggplot(weekly_data, aes(x = week_number, y = weekly_mod_vig_m))
# Add layers ---------------------------
weekly_moderate_vigorous_p +
geom_point(
data = weekly_data[which(weekly_data$weekly_mod_vig_m >= 300), ],
aes(color = "300+ "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_mod_vig_m >= 150 & weekly_data$weekly_mod_vig_m < 300), ],
aes(color = "150 - 300 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
geom_point(
data = weekly_data[which(weekly_data$weekly_mod_vig_m < 150), ],
aes(color = "0 - 150 "),
size = 2,
position = position_jitter(width = .25, height = 0),
alpha = 0.5
) +
scale_x_discrete(name = NULL, labels = labels_wmy) +
scale_y_continuous(breaks = c(0, 150, 300, 450, 600, 750, 900, 1050),
limits = c(0, 1060)) +
scale_color_manual(
name = "Minutes",
labels = c("300+ ", "150 - 300 ", "0 - 150 "),
values = c(
"300+ " = "#707070",
"150 - 300 " = "#707070",
"0 - 150 " = "#707070"
)
) +
labs(
title = "Combined moderate/vigorous activity",
subtitle = "(minutes per week)"
) +
ylab("Activity minutes") +
theme_classic() +
theme(
plot.subtitle = element_text(
margin = margin(1, 5, 5, 0),
size = 10,
hjust = 1,
face = "italic"
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
plot.title = element_text(
margin = margin(5, 5, 5, 0),
size = 14,
hjust = 1,
face = "bold"
),
legend.position = "none"
) +
guides(color = guide_legend(override.aes = list(size = 3)))
Moderate_vigorous_activity_per_week
ggsave(filename = "Moderate_vigorous_activity_per_week_gs.png", path = "images")## Saving 7 x 5 in imageNote:
The data reveals some intriguing patterns in weekly moderate-to-vigorous intensity activity levels.
Specifically:
45% of the weekly totals fall below 150 minutes (70 out of 154).
29% are between 150 and 300 minutes (44 out of 154).
26% exceed 300 minutes (40 out of 154).
This indicates that the largest group of users—45%—spend less than 150 minutes per week engaging in moderate-to-vigorous activity. While these insights highlight overall trends in smart device users’ physical activity, they only scratch the surface. To gain a deeper understanding of individual behaviors, further analysis is essential.
Create labels and limits for week numbers and
Weekly_moderate_vigorous plot
for all 33 participants
labels_week_n <- c("W\n1", "W\n2", "W\n3", "W\n4", "W\n5")
limits_week_n <- c(
"Week 15, Apr 2016", "Week 16, Apr 2016", "Week 17, Apr 2016",
"Week 18, May 2016", "Week 19, May 2016"
)
# Weekly_moderate_vigorous plot ---------------------------
# for all 33 participants
weekly_moderate_vigorous_p <-
weekly_data %>%
{
ggplot(.) +
geom_line(
aes(
x = as.factor(week_number),
y = weekly_mod_vig_m,
group = id,
color = as.factor(id)
),
linejoin = "mitre",
lineend = "butt",
show.legend = FALSE,
size = .5
) +
geom_point(
aes(
x = as.factor(week_number),
y = weekly_mod_vig_m,
group = id,
color = as.factor(id)
),
show.legend = FALSE,
size = 1) +
labs(
title = "Moderate/vigourous activity",
subtitle = "Weekly totals for 33 participants",
y = "Minutes"
) +
scale_x_discrete(
name = NULL,
limits = limits_week_n,
labels = labels_week_n,
expand = c(0, 0)
) +
scale_y_continuous(
breaks = c(0, 150, 300, 450, 600, 750, 900),
limits = c(0, 1060)
) +
scale_color_discrete() +
geom_hline(yintercept = 150, linetype = "dashed") +
geom_hline(yintercept = 300, linetype = "dashed") +
theme_minimal() +
facet_wrap(~id, drop = TRUE, nrow = 3, ncol = 11, scales = "fixed") +
theme(
plot.title = element_text(
margin = margin(5, 5, 5, 0),
size = 14,
hjust = 1,
face = "bold"
),
plot.subtitle = element_text(
margin = margin(1, 5, 5, 0),
size = 10,
hjust = 1,
face = "italic"
),
axis.title.y = element_text(
margin = margin(0, 5, 0, 5),
size = 12
),
panel.spacing.x = unit(.75, "lines")
)
}## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.ggsave(file = "weekly_activity_33.png", path = "images")## Saving 7 x 5 in image
## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?weekly_moderate_vigorous_p## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?
``` r
ggsave(file = "weekly_activity_33.png", path = "images", plot = weekly_moderate_vigorous_p)## Saving 7 x 5 in image
## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?The primary takeaway from the plot is that it displays 33 graphs representing the weekly active minute totals for 33 users. This data allows us to explore each user’s activity patterns on a week-to-week basis. Building on this, the focus shifts to an important metric:
Achievement Rate.
Achievement Rate is defined as the percentage of weeks in which a participant successfully achieves ≥150 minutes of moderate-to-vigorous activity.
We can group these smart device users into three categories based on their achievement rates:
1.Group A: High Rate ➜ Successful in 80–100% of weeks
2.Group B: Regular Rate ➜ Successful in 60–79% of weeks
3.Group C: Low Rate ➜ Successful in 0–59% of weeks
This classification provides valuable insights into how these users engage with physical activity over time.
Group A: high weekly achievement rate:
45.5% of all participants are in this group (15 of 33) 73% of Group A earned ≥ 150 every week! (11 of 15); 33% of all (11/33) Group B: regular achievement rate
6% of all participants are in this group (2 of 33) Group C: low weekly achievement rate
48.5% of all participants are in this group (16 of 33) 63% of Group C earned ≥ 150 minutes per week zero times! (10 of 16); 30% of all (10/33) Let’s use personograph to create icon charts that visualize these groups. We’ll apply their respective percentages to 100:
weekly_achievement_groups plots—————————
weekly_achievement_groups <- c("Group A" = 0.455, "Group B" = 0.06, "Group C" = 0.485)Create a data frame
df <- data.frame(
Group = names(weekly_achievement_groups),
Value = weekly_achievement_groups
)Create a bar plot using ggplot2
ggplot(df, aes(x = Group, y = Value, fill = Group)) +
geom_bar(stat = "identity", show.legend = FALSE) +
scale_fill_manual(values = c("Group A" = "#052049", "Group B" = "#007cbe", "Group C" = "#058488")) +
labs(title = "Weekly Achievement Groups", y = "Achievement Value") +
theme_minimal() +
theme(axis.title.x = element_blank())
png(file = "achievement_groups.png")Group a————-
weekly_achievement_group_a <- c("Group B and C" = 0.545, "Group A" = 0.455)
data_a <- data.frame(
group = names(weekly_achievement_group_a),
proportion = weekly_achievement_group_a
)ggplot(data_a, aes(x = group, y = proportion, fill = group)) +
geom_bar(stat = "identity", width = 0.5) +
scale_fill_manual(values = c("Group B and C" = "grey", "Group A" = "#052049")) +
labs(
title = "Group A: High Weekly Achievement Rate (80-100%)",
x = "Group",
y = "Proportion"
) +
theme_minimal() +
theme(
legend.title = element_blank(),
plot.title = element_text(hjust = 0.5)
)
Group b —————————
weekly_achievement_group_b <- c("Group A and C" = 0.94, "Group B" = 0.06)
data <- data.frame(
group = names(weekly_achievement_group_b),
proportion = weekly_achievement_group_b
)data$fraction = data$proportion / sum(data$proportion)ggplot(data, aes(x = group, y = proportion, fill = group)) +
geom_bar(stat = "identity", width = 0.5) +
scale_fill_manual(values = c("Group A and C" = "grey", "Group B" = "#007cbe")) +
labs(
title = "Group B: Regular Weekly Achievement Rate (60-79%)",
x = "Group",
y = "Proportion"
) +
theme_minimal() +
theme(
legend.title = element_blank(),
plot.title = element_text(hjust = 0.5)
)
Group c —————————
weekly_achievement_group_c <- c("Group A and B" = 0.515, "Group C" = 0.485)
data_c <- data.frame(
group = names(weekly_achievement_group_c),
proportion = weekly_achievement_group_c
)ggplot(data_c, aes(x = group, y = proportion, fill = group)) +
geom_bar(stat = "identity", width = 0.5) +
scale_fill_manual(values = c("Group A and B" = "grey", "Group C" = "#058488")) +
labs(
title = "Group C: Low Weekly Achievement Rate (0-59%)",
x = "Group",
y = "Proportion"
) +
theme_minimal() +
theme(
legend.title = element_blank(),
plot.title = element_text(hjust = 0.5)
)