Code
# install.packages("tidyverse")
# install.packages(lubridate)
# install.packages(ggridges)This project is a culmination of the topics learned so far:
Exploratory Data Analysis
Visualizing Data
Tidying Data
Data Transformations
With these concepts mentioned in the previous subsection, the focus of this project will be to take 3 datasets and to practice preparing them for analysis. In addition, this project will focus on using long-formatted datasets rather than a wide tabular dataset.
Lastly, this project will also assist and improve upon drawing conclusions, interpreting results and the skill of choosing which plot is appropriate for the data and the question being asked.
This dataset was obtained from Kaggle.com and contains information regarding:
Movies
Genre of Movies
Popularity
Rating
The data was culminated from public information.
This dataset was obtained from Kaggle.com and contains information about Zara’s products.
The data was culminated from several public datasets from Github and Kaggle.
This dataset is a fictional dataset provided by classmate Renee Watson, which contains information about patients visited in different medical facility in the year 2025.
Due to this project having 3 different datasets to work with. the workflow will be similar:
Upload .csv to Github
Import to R
Column Names
Normalizing Values
Handle Missing Values
Handling Inconsistencies
Column Type Conversion
Creating Summary Tables
Visualization Plots
Interpret the result
.qmd document to check for grammar, spelling, code procedure.Remove the ‘#’ to install package if you do not have it install already.
# install.packages("tidyverse")
# install.packages(lubridate)
# install.packages(ggridges)library(tidyverse)
library(lubridate)
library(ggridges)
set.seed(11235)raw_data1 <- read.csv("https://raw.githubusercontent.com/HaiderrX/CUNY-SPS-MSDS/refs/heads/main/DATA607/Projects/Project_2/datasets/Top%20Movies%20dataset.csv")
head(raw_data1, 3) Release_Date Title
1 15/12/2021 Spider-Man: No Way Home
2 01/03/2022 The Batman
3 25/02/2022 No Exit
Overview
1 Peter Parker is unmasked and no longer able to separate his normal life from the high-stakes of being a super-hero. When he asks for help from Doctor Strange the stakes become even more dangerous, forcing him to discover what it truly means to be Spider-Man.
2 In his second year of fighting crime, Batman uncovers corruption in Gotham City that connects to his own family while facing a serial killer known as the Riddler.
3 Stranded at a rest stop in the mountains during a blizzard, a recovering addict discovers a kidnapped child hidden in a car belonging to one of the people inside the building which sets her on a terrifying struggle to identify who among them is the kidnapper.
Popularity Vote_Count Vote_Average Original_Language
1 5083.954 8940 8.3 en
2 3827.658 1151 8.1 en
3 2618.087 122 6.3 en
Genre
1 Action, Adventure, Science Fiction
2 Crime, Mystery, Thriller
3 Thriller
Poster_Url
1 https://image.tmdb.org/t/p/original/1g0dhYtq4irTY1GPXvft6k4YLjm.jpg
2 https://image.tmdb.org/t/p/original/74xTEgt7R36Fpooo50r9T25onhq.jpg
3 https://image.tmdb.org/t/p/original/vDHsLnOWKlPGmWs0kGfuhNF4w5l.jpg
Working.URL
1 https://image.tmdb.org/t/p/original/1g0dhYtq4irTY1GPXvft6k4YLjm.jpg
2 https://image.tmdb.org/t/p/original/74xTEgt7R36Fpooo50r9T25onhq.jpg
3 https://image.tmdb.org/t/p/original/vDHsLnOWKlPGmWs0kGfuhNF4w5l.jpg
Upon Inspection on the raw data the following must be done:
Column names need to be changed
Change column to correct types
Get rid of certain columns such as Overview and Poster_Url
Converting from Wide format to Long format
movies_renamed <- raw_data1 |>
select(
release_date = Release_Date,
title = Title,
popularity_score = Popularity,
vote_count = Vote_Count,
vote_avg = Vote_Average,
genre = Genre,
language = Original_Language
)
head(movies_renamed, 3) release_date title popularity_score vote_count vote_avg
1 15/12/2021 Spider-Man: No Way Home 5083.954 8940 8.3
2 01/03/2022 The Batman 3827.658 1151 8.1
3 25/02/2022 No Exit 2618.087 122 6.3
genre language
1 Action, Adventure, Science Fiction en
2 Crime, Mystery, Thriller en
3 Thriller en
glimpse(movies_renamed)Rows: 9,837
Columns: 7
$ release_date <chr> "15/12/2021", "01/03/2022", "25/02/2022", "24/11/2021…
$ title <chr> "Spider-Man: No Way Home", "The Batman", "No Exit", "…
$ popularity_score <dbl> 5083.954, 3827.658, 2618.087, 2402.201, 1895.511, 175…
$ vote_count <chr> "8940", "1151", "122", "5076", "1793", "33", "821", "…
$ vote_avg <chr> "8.3", "8.1", "6.3", "7.7", "7", "6.6", "6.8", "6.3",…
$ genre <chr> "Action, Adventure, Science Fiction", "Crime, Mystery…
$ language <chr> "en", "en", "en", "en", "en", "en", "en", "en", "en",…
We need to change the following columns to these typings:
release_date: chr \(\to\) date
vote_count: chr \(\to\) dbl
vote_avg: chr \(\to\) dbl
Note: release_date has DD/MM/YEAR format
clean_movies_wide <- movies_renamed |>
mutate(across(c(vote_count, vote_avg), as.numeric)) |>
mutate(release_date = dmy(release_date))
glimpse(clean_movies_wide)Rows: 9,837
Columns: 7
$ release_date <date> 2021-12-15, 2022-03-01, 2022-02-25, 2021-11-24, 2021…
$ title <chr> "Spider-Man: No Way Home", "The Batman", "No Exit", "…
$ popularity_score <dbl> 5083.954, 3827.658, 2618.087, 2402.201, 1895.511, 175…
$ vote_count <dbl> 8940, 1151, 122, 5076, 1793, 33, 821, 206, 114, 4726,…
$ vote_avg <dbl> 8.3, 8.1, 6.3, 7.7, 7.0, 6.6, 6.8, 6.3, 5.3, 7.2, 5.9…
$ genre <chr> "Action, Adventure, Science Fiction", "Crime, Mystery…
$ language <chr> "en", "en", "en", "en", "en", "en", "en", "en", "en",…
Note: release_date is now YEAR-MM-DD format
clean_movies_wide| Variable | Meaning |
|---|---|
release_date |
The release date for the movie |
title |
Movie’s title |
popularity_score |
User Interest in the movie through searching, engagement, etc. |
vote_count |
The number of people that voted a rating for the movie |
vote_avg |
Average Movie Rating |
|
The genre(s) the movie are categorized as The original language that the movie was in |
clean_movies_wide %>%
filter(is.na(genre) | genre == "" | trimws(genre) == "") release_date title popularity_score vote_count vote_avg
1 2013-10-20 Pixie Hollow Bake Off NA NA NA
2 <NA> NA NA NA
3 <NA> NA NA NA
4 <NA> NA NA NA
5 <NA> NA NA NA
6 <NA> NA NA NA
7 <NA> NA NA NA
8 <NA> NA NA NA
9 <NA> NA NA NA
10 <NA> NA NA NA
11 <NA> 61.328 7.1 NA NA
genre language
1
2
3
4
5
6
7
8
9
10
11 https://image.tmdb.org/t/p/original/6iXYe7AkQ1QIfMFuvXsSCT2zF7s.jpg
There is only 1 movie with missing information, which I can only find the genres for this movie. However for the other metrics, I cannot be certain to replace it with what I can find online as these are different measurements, so I will leave it blank.
fixed_clean_movies_wide <- clean_movies_wide
fixed_clean_movies_wide$genre[1106] <- "Animation, Comedy, Family, Fantasy"sum(is.na(fixed_clean_movies_wide))[1] 42
fixed_clean_movies_wide %>%
filter(if_any(everything(), is.na)) %>%
View()It appears that we have 42 missing rows, so the approach will be to drop every NA row, but preserve the “Pixie Hollow Bake Off” as we have the genre for it, but no numerical metric value.
final_clean_movies_wide <- fixed_clean_movies_wide %>%
filter(
title == "Pixie Hollow Bake Off" |
if_all(everything(), ~ !is.na(.x))
)# separate Genre because more than 1
# then take the popularity and votes columns and categorize them as metrics
clean_movies_long <- final_clean_movies_wide |>
separate_rows(genre, sep = ", ") |>
pivot_longer(
cols = c(popularity_score, vote_count, vote_avg),
names_to = "metric",
values_to = "value"
)
head(clean_movies_long, 10)# A tibble: 10 × 6
release_date title genre language metric value
<date> <chr> <chr> <chr> <chr> <dbl>
1 2021-12-15 Spider-Man: No Way Home Action en popular… 5084.
2 2021-12-15 Spider-Man: No Way Home Action en vote_co… 8940
3 2021-12-15 Spider-Man: No Way Home Action en vote_avg 8.3
4 2021-12-15 Spider-Man: No Way Home Adventure en popular… 5084.
5 2021-12-15 Spider-Man: No Way Home Adventure en vote_co… 8940
6 2021-12-15 Spider-Man: No Way Home Adventure en vote_avg 8.3
7 2021-12-15 Spider-Man: No Way Home Science Fiction en popular… 5084.
8 2021-12-15 Spider-Man: No Way Home Science Fiction en vote_co… 8940
9 2021-12-15 Spider-Man: No Way Home Science Fiction en vote_avg 8.3
10 2022-03-01 The Batman Crime en popular… 3828.
clean_movies_long| Variable | Meaning |
|---|---|
release_date |
The release date for the movie |
title |
Movie’s title |
genre |
The genre(s) the movie are categorized as in separate rows |
language |
The original language that the movie was in |
metric |
Contains information such as popularity_score, vote_count, vote_avg |
value |
Contains values for said metric respectively |
genre_table <- clean_movies_long %>%
group_by(genre) %>%
summarise(
movie_counts= n_distinct(title),
.groups = "drop"
) %>%
mutate(
Total_Percent = round((movie_counts / sum(movie_counts)) * 100, 1)
) %>%
arrange(desc(movie_counts))
genre_table# A tibble: 19 × 3
genre movie_counts Total_Percent
<chr> <int> <dbl>
1 Drama 3661 14.5
2 Comedy 3002 11.9
3 Action 2629 10.4
4 Thriller 2425 9.6
5 Adventure 1814 7.2
6 Romance 1444 5.7
7 Animation 1436 5.7
8 Horror 1414 5.6
9 Family 1384 5.5
10 Fantasy 1277 5
11 Science Fiction 1248 4.9
12 Crime 1220 4.8
13 Mystery 759 3
14 History 423 1.7
15 War 306 1.2
16 Music 295 1.2
17 Documentary 215 0.8
18 TV Movie 214 0.8
19 Western 135 0.5
ggplot(genre_table, aes(x=reorder(genre, movie_counts), y=movie_counts, fill = genre)) +
geom_col() +
coord_flip() +
geom_text(
aes(label = movie_counts),
vjust = 0.5,
hjust = -0.05,
color = "black",
size = 3
) +
scale_y_continuous(expand = expansion(mult = c(0, 0.1))) +
labs(
title = "Counts of Genres",
subtitle = "Arranged from greatest to least",
x = "Genre",
y = "Counts",
fill = "Movie Genres"
) +
theme_minimal() +
theme(
legend.position = "right",
) +
guides(fill = guide_legend(ncol = 2)) With a summary plot and the provided bar plot, we can see that the majority of movies have the genre ‘Drama’ in this dataset by \(14.5\%\). Which is followed by ‘Comedy’ with \(11.9\%\) and going all the way down to ‘Western’ which has a \(0.5\%\) appearance in this dataset.
genre_table %>%
summarize(avg = round(mean(movie_counts), 1),
median = median(movie_counts),
St.Dev = round(sd(movie_counts), 1))# A tibble: 1 × 3
avg median St.Dev
<dbl> <int> <dbl>
1 1332. 1277 1016.
With this statistical summary table, we can see that there is a huge variation within the genre counts in this dataset. Which begs the question, are the metrics skewed or have a higher spread?
In this part, we will examine the popularity metric using the statistical summaries and plotting it.
In this dataset and in general for movies, popularity is defined as:
How much attention a movie gets
Viewer Engagement
Search Traffic
as opposed to how one would rate a movie based on what is being presented to them.
popularity_table <- clean_movies_long %>%
group_by(genre) %>%
filter(metric == "popularity_score") %>%
summarise(
Mean = mean(value, na.rm = TRUE),
Median = median(value, na.rm = TRUE),
Standard_Deviation = sd(value, na.rm = TRUE),
.groups = "drop"
)
popularity_table# A tibble: 19 × 4
genre Mean Median Standard_Deviation
<chr> <dbl> <dbl> <dbl>
1 Action 50.9 24.5 144.
2 Adventure 53.7 25.5 155.
3 Animation 52.4 27.4 111.
4 Comedy 37.9 20.6 83.3
5 Crime 44.7 19.9 159.
6 Documentary 29.2 19.3 33.3
7 Drama 30.1 19.1 46.2
8 Family 46.6 24.9 100.
9 Fantasy 53.1 26.0 117.
10 History 28.4 19.3 41.2
11 Horror 38.3 21.8 78.5
12 Music 33.8 18.7 81.1
13 Mystery 40.1 21.0 154.
14 Romance 30.9 19.3 44.0
15 Science Fiction 49.5 24.7 162.
16 TV Movie 30.0 18.7 34.3
17 Thriller 42.9 21.2 138.
18 War 35.3 19.2 112.
19 Western 36.2 18.9 74.5
ggplot(popularity_table, aes(y = reorder(genre, Standard_Deviation))) +
geom_errorbarh(aes(xmin = pmax(0.1, Mean - Standard_Deviation), xmax = Mean + Standard_Deviation),
height = 0.2, color = "cornsilk4", linewidth = 0.7) +
geom_point(aes(x = Mean, color = "Mean"), size = 2.5) +
geom_point(aes(x = Median, color = "Median"), size = 2.5) +
scale_color_manual(values = c("Mean" = "midnightblue", "Median" = "red4")) +
scale_x_log10() +
labs(
title = "Genre Popularity Spreads",
subtitle = "Arranged by Standard Deviation",
x = "Popularity Score (Log 10 Scale)",
y = "Genre",
color = "Statistical Metric"
) +
theme_minimal() +
theme(
legend.position = "bottom"
)With this plot and the summary table, we can see that this plot represents
Standard Deviation
A point of Mean and Median per genre
Scaled by \(log_{10}\)
In this plot, we can see that the median and means are spread apart in some genres and are relatively close in some. However interestingly in with the error bars (the standard deviation), we can see that there is more spread on the genres at the top, Science Fiction, Crime, Adventure.
What this is telling us that those genres are more unpredictable as anything can happen with good plot lines, and other conditions that causes them to create engagement or not. For example one of the Sci-Fi movies, Spider-Man: No Way Home, it created massive engagement due to the nature of the movie and the character itself versus another movie where it would have a lower engagement between viewers.
Knowing this, any movie within a certain genre can be prone to what makes something popular:
Character
Plot
Company producing the movie
Age group
With these factors it creates unpredictability for what makes something popular.
Similar to what we did previously, we will examine the vote average of genres.
Vote Average is defined by a collection of a viewer’s rating for a movie and then aggregating it into an average.
vote_avg_table <- clean_movies_long %>%
group_by(genre) %>%
filter(metric == "vote_avg") %>%
summarise(
Mean = mean(value, na.rm=TRUE),
Median = median(value, na.rm=TRUE),
Standard_Deviation = sd(value, na.rm=TRUE),
.groups = "drop"
)
vote_avg_table# A tibble: 19 × 4
genre Mean Median Standard_Deviation
<chr> <dbl> <dbl> <dbl>
1 Action 6.33 6.4 1.13
2 Adventure 6.46 6.6 1.13
3 Animation 6.85 6.9 1.01
4 Comedy 6.38 6.5 1.04
5 Crime 6.55 6.6 0.974
6 Documentary 6.66 7.1 1.93
7 Drama 6.71 6.8 1.05
8 Family 6.58 6.7 0.958
9 Fantasy 6.53 6.6 1.12
10 History 6.97 7 0.763
11 Horror 5.94 6 1.03
12 Music 6.88 7 1.18
13 Mystery 6.43 6.4 1.10
14 Romance 6.56 6.65 1.08
15 Science Fiction 6.26 6.4 1.21
16 TV Movie 6.44 6.6 1.04
17 Thriller 6.25 6.3 0.987
18 War 6.95 7 0.864
19 Western 6.75 6.9 0.859
clean_movies_long %>%
filter(metric == "vote_avg") %>%
ggplot(aes(x = value, y = reorder(genre, value, FUN=mean, na.rm = TRUE), fill = genre)) +
geom_density_ridges(
quantile_lines = TRUE,
quantiles = 2,
alpha = 0.6,
show.legend = FALSE,
color = "grey30"
) +
scale_x_continuous(limits=c(0,10), breaks = 0:10) +
labs(
title = "Distribution of Movie Ratings by Genre",
subtitle = "Vertical lines inside the ridges represent the Median rating",
x = "Vote Average (0 - 10 Scale)",
y = "Genre"
) +
theme_minimal() +
theme(
panel.grid.minor = element_blank(),
)With the summary table and the provided ridgeplot, we can see the distribution across all genres provided with the mean, median, and standard deviation. However in the ridgeplot, the choice was to use the median as the vertical line as we cannot use an average for an aggregated result in the distribution.
Across all genres, the median seems to be around \([6,7]\) and the mean seems to be within a 6. There is not that much of a spread across each genre respectively just by going through the numbers.
One thing to note, that the lowest genre rating is Horror and the highest seems to be War. Such factors could include:
Poor writing
Less promotion to promote a movie
Insufficient budget for a movie
However, it is worth noting that even though there may not be as much movies for a certain genre it still has a higher statistic than others, such as War versus Sci-Fi, and crime.
When it comes to films, regardless of it being a movie, television, or anything, it can create enjoyment and entertainment for a viewer.
In this dataset, it was discovered that certain genres have more spreads of popularity than others such as: sci-fi, crime, animation, to list a few.
With the supplied voter average, we can see what the real story is when it comes to how viewers rate a movie based on plot in an aggregated way.
This part is where the contrast is interesting as a movie can create engagement in terms of how good or awful the writing was, the CGI, the acting, and other factors. Whereas one can vote how they feel about the movie as they would have seen it which is where the contrast comes in.
In horror where the average vote is lower than all of them, it still causes a lot of engagement due to the theme of it as well as some people enjoying the aspect of the genre.
raw_data2 <- read_delim("https://raw.githubusercontent.com/HaiderrX/CUNY-SPS-MSDS/refs/heads/main/DATA607/Projects/Project_2/datasets/Zara_sales_EDA.csv", delim= ";")
head(raw_data2, 3)# A tibble: 3 × 17
`Product ID` `Product Position` Promotion `Product Category` Seasonal
<dbl> <chr> <chr> <chr> <chr>
1 185102 Aisle Yes clothing Yes
2 188771 Aisle Yes clothing No
3 180176 End-cap Yes clothing Yes
# ℹ 12 more variables: `Sales Volume` <dbl>, brand <chr>, url <chr>,
# name <chr>, description <chr>, price <dbl>, currency <chr>, terms <chr>,
# section <chr>, season <chr>, material <chr>, origin <chr>
glimpse(raw_data2)Rows: 20,252
Columns: 17
$ `Product ID` <dbl> 185102, 188771, 180176, 112917, 192936, 117590, 189…
$ `Product Position` <chr> "Aisle", "Aisle", "End-cap", "Aisle", "End-cap", "E…
$ Promotion <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "No", "Ye…
$ `Product Category` <chr> "clothing", "clothing", "clothing", "clothing", "cl…
$ Seasonal <chr> "Yes", "No", "Yes", "No", "Yes", "Yes", "No", "Yes"…
$ `Sales Volume` <dbl> 1243, 1429, 1168, 1348, 1602, 1282, 688, 1711, 857,…
$ brand <chr> "Zara", "Zara", "Zara", "Zara", "Zara", "Zara", "Za…
$ url <chr> "https://www.zara.com/us/en/basic-puffer-jacket-p06…
$ name <chr> "BASIC PUFFER JACKET", "TUXEDO JACKET", "SLIM FIT S…
$ description <chr> "Puffer jacket made of tear-resistant ripstop fabri…
$ price <dbl> 78.99, 14.99, 71.95, 30.99, 22.99, 25.95, 87.99, 24…
$ currency <chr> "USD", "USD", "USD", "USD", "USD", "USD", "USD", "U…
$ terms <chr> "jackets", "jackets", "jackets", "jackets", "jacket…
$ section <chr> "MAN", "MAN", "WOMAN", "MAN", "WOMAN", "WOMAN", "MA…
$ season <chr> "Winter", "Autumn", "Autumn", "Spring", "Winter", "…
$ material <chr> "Polyester", "Cotton", "Polyester", "Polyester", "W…
$ origin <chr> "Brazil", "Turkey", "Morocco", "China", "China", "T…
For this data cleaning process, we are going to have to do the following:
Keep certain columns
Rename Columns
Convert from wide to long format
Which is less than the previous dataset, but will have to inspect the new subset to see if anything else needs to be done
subset_data_zara <- raw_data2 %>%
select(
product_id = 'Product ID',
product_name = name,
promotion = Promotion,
seasonal = Seasonal,
units_sold = 'Sales Volume',
price = price,
type_clothing = terms,
material = material,
country_manufacturer = origin
)
head(subset_data_zara)# A tibble: 6 × 9
product_id product_name promotion seasonal units_sold price type_clothing
<dbl> <chr> <chr> <chr> <dbl> <dbl> <chr>
1 185102 BASIC PUFFER JAC… Yes Yes 1243 79.0 jackets
2 188771 TUXEDO JACKET Yes No 1429 15.0 jackets
3 180176 SLIM FIT SUIT JA… Yes Yes 1168 72.0 jackets
4 112917 STRETCH SUIT JAC… Yes No 1348 31.0 jackets
5 192936 DOUBLE FACED JAC… Yes Yes 1602 23.0 jackets
6 117590 CONTRASTING COLL… Yes Yes 1282 26.0 jackets
# ℹ 2 more variables: material <chr>, country_manufacturer <chr>
glimpse(subset_data_zara)Rows: 20,252
Columns: 9
$ product_id <dbl> 185102, 188771, 180176, 112917, 192936, 117590, 1…
$ product_name <chr> "BASIC PUFFER JACKET", "TUXEDO JACKET", "SLIM FIT…
$ promotion <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "No", "…
$ seasonal <chr> "Yes", "No", "Yes", "No", "Yes", "Yes", "No", "Ye…
$ units_sold <dbl> 1243, 1429, 1168, 1348, 1602, 1282, 688, 1711, 85…
$ price <dbl> 78.99, 14.99, 71.95, 30.99, 22.99, 25.95, 87.99, …
$ type_clothing <chr> "jackets", "jackets", "jackets", "jackets", "jack…
$ material <chr> "Polyester", "Cotton", "Polyester", "Polyester", …
$ country_manufacturer <chr> "Brazil", "Turkey", "Morocco", "China", "China", …
Need to change product_id to chr as it is a categorical value
Can keep “yes” and “no” as is, no need to convert to binary 0 or 1
No need to map certain values to numbers, such as the type_clothing or material column.
clean_zara_wide_1 <- subset_data_zara %>%
mutate(product_id = as.character(product_id))
glimpse(clean_zara_wide_1)Rows: 20,252
Columns: 9
$ product_id <chr> "185102", "188771", "180176", "112917", "192936",…
$ product_name <chr> "BASIC PUFFER JACKET", "TUXEDO JACKET", "SLIM FIT…
$ promotion <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "No", "…
$ seasonal <chr> "Yes", "No", "Yes", "No", "Yes", "Yes", "No", "Ye…
$ units_sold <dbl> 1243, 1429, 1168, 1348, 1602, 1282, 688, 1711, 85…
$ price <dbl> 78.99, 14.99, 71.95, 30.99, 22.99, 25.95, 87.99, …
$ type_clothing <chr> "jackets", "jackets", "jackets", "jackets", "jack…
$ material <chr> "Polyester", "Cotton", "Polyester", "Polyester", …
$ country_manufacturer <chr> "Brazil", "Turkey", "Morocco", "China", "China", …
Problem: This dataset has 2 values, price and units_sold so to convert to a long formatted dataset, cutting down on columns will need to happen.
clean_zara_wide_2 <- clean_zara_wide_1 %>%
select(
product_name,
promotion,
type_clothing,
units_sold,
price
)
head(clean_zara_wide_2)# A tibble: 6 × 5
product_name promotion type_clothing units_sold price
<chr> <chr> <chr> <dbl> <dbl>
1 BASIC PUFFER JACKET Yes jackets 1243 79.0
2 TUXEDO JACKET Yes jackets 1429 15.0
3 SLIM FIT SUIT JACKET Yes jackets 1168 72.0
4 STRETCH SUIT JACKET Yes jackets 1348 31.0
5 DOUBLE FACED JACKET Yes jackets 1602 23.0
6 CONTRASTING COLLAR JACKET Yes jackets 1282 26.0
clean_zara_wide_2 %>%
filter(if_any(everything(), is.na))# A tibble: 1 × 5
product_name promotion type_clothing units_sold price
<chr> <chr> <chr> <dbl> <dbl>
1 <NA> No jackets 789 23.0
# We are going to drop it as it is only 1 row
clean_zara_wide_3 <- clean_zara_wide_2 %>%
drop_na()
clean_zara_wide_3 %>%
filter(if_any(everything(), is.na))# A tibble: 0 × 5
# ℹ 5 variables: product_name <chr>, promotion <chr>, type_clothing <chr>,
# units_sold <dbl>, price <dbl>
clean_zara_wide_3| Variable | Meaning |
|---|---|
product_name |
Name of the product. |
promotion |
If there was a promotion happening for the product. |
units_sold |
How many units of that product was sold. |
price |
How much that product costed as 1 unit. |
clean_zara_long <- clean_zara_wide_3 %>%
pivot_longer(
cols = c(units_sold, price),
names_to = "metric",
values_to = "value"
)
head(clean_zara_long)# A tibble: 6 × 5
product_name promotion type_clothing metric value
<chr> <chr> <chr> <chr> <dbl>
1 BASIC PUFFER JACKET Yes jackets units_sold 1243
2 BASIC PUFFER JACKET Yes jackets price 79.0
3 TUXEDO JACKET Yes jackets units_sold 1429
4 TUXEDO JACKET Yes jackets price 15.0
5 SLIM FIT SUIT JACKET Yes jackets units_sold 1168
6 SLIM FIT SUIT JACKET Yes jackets price 72.0
clean_zara_long| Variable | Meaning |
|---|---|
product_name |
Name of the product. |
promotion |
If there was a promotion happening for the product. |
type_clothing |
Identifies what type of clothing it is, like a jacket, or shoes, or jeans. |
metric |
Contains price or units_sold. |
value |
Contains value of the price or the unit sold. |
head(clean_zara_long,3)# A tibble: 3 × 5
product_name promotion type_clothing metric value
<chr> <chr> <chr> <chr> <dbl>
1 BASIC PUFFER JACKET Yes jackets units_sold 1243
2 BASIC PUFFER JACKET Yes jackets price 79.0
3 TUXEDO JACKET Yes jackets units_sold 1429
clothing_type_table <- clean_zara_long %>%
group_by(type_clothing) %>%
summarise(
clothing_counts = n_distinct(product_name),
.groups = "drop"
) %>%
mutate(
Total_Percent = round((clothing_counts / sum(clothing_counts)) * 100, 1)
) %>%
arrange(desc(clothing_counts))
clothing_type_table# A tibble: 5 × 3
type_clothing clothing_counts Total_Percent
<chr> <int> <dbl>
1 jackets 10290 53.8
2 sweaters 3176 16.6
3 t-shirts 2580 13.5
4 shoes 2411 12.6
5 jeans 656 3.4
ggplot(clothing_type_table, aes(x=reorder(type_clothing, -clothing_counts), y=clothing_counts, fill = type_clothing)) +
geom_col() +
#coord_flip() +
geom_text(
aes(label = clothing_counts),
vjust = -0.3,
color = "black",
size = 3
) +
labs(
title = "Count of Clothing Types",
subtitle = "Arranged from highest mean to lowest",
x = "Clothing Type",
y = "Counts",
fill = "Clothing Type"
) +
theme_minimal()In this dataset, we can see that there are more jackets in this dataset, with a presence of \(53.8\%\), than any other piece of clothing. The least amount of presence in this dataset happens to be jeans which covers \(3.4\%\). Which gives us a few questions for this dataset:
For each clothing type, what were the total units sold?
What are the average price for each clothing type?
Are the prices different with or without a promotion per clothing type?
total_units_sold_table <- clean_zara_long %>%
group_by(type_clothing) %>%
filter(metric == "units_sold") %>%
summarise(
Total = sum(value, na.rm = TRUE),
.groups = "drop"
)
total_units_sold_table# A tibble: 5 × 2
type_clothing Total
<chr> <dbl>
1 jackets 12347354
2 jeans 721308
3 shoes 2676982
4 sweaters 3598743
5 t-shirts 2879378
ggplot(total_units_sold_table, aes(x=reorder(type_clothing, -Total), y=Total, fill = type_clothing)) +
geom_col() +
#coord_flip() +
geom_text(
aes(label = Total),
vjust = -0.1,
color = "black",
size = 3
) +
labs(
title = "Total Units Sold per Clothing Type",
subtitle = "Arranged from greatest to least",
x = "Clothing Type",
y = "Counts",
fill = "Clothing Type"
) +
theme_minimal()With the provided plot, these total units sold seems to be consistent with the previous findings of how many clothing types there are in this dataset. These total units sold are ordered in the same way by how much they appear in the dataset. Jackets seem to be the most popular and jeans aren’t as popular, as the gap between shoes and jeans are by a lot.
statistic_price_table <- clean_zara_long %>%
group_by(type_clothing) %>%
filter(metric == "price") %>%
summarise(
Mean = round(mean(value, na.rm = TRUE),2),
Median = median(value, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(Mean))
statistic_price_table# A tibble: 5 × 3
type_clothing Mean Median
<chr> <dbl> <dbl>
1 t-shirts 43.2 36.0
2 jeans 42.9 36.0
3 shoes 42.4 36.0
4 sweaters 41.8 36.0
5 jackets 41.6 35
clean_zara_long %>%
filter(metric == "price") %>%
ggplot(aes(x=reorder(type_clothing, -value, FUN=mean), y = value, fill = type_clothing)) +
geom_boxplot() +
labs(
title = "Price Distribution per Clothing Type",
subtitle = "Arranged from highest mean to lowest",
x = "Clothing Type",
y = "Price ($)",
fill = "Clothing Type"
) +
theme_minimal() +
theme(legend.position = "bottom")This part of the analysis is considered an “answer” as to why things are being sold more than others or not. In this case, we can see that on average, t-shirts have a higher price of $43.15 than any of the other categories, with jackets being the lowest on average with $41.56.
With the added boxplot, we can see that there are several outliers for almost all clothing categories except for jeans.
An assumption can be drawn that more people buy their jackets as they are slightly a bit cheaper than the other items on offer at their store.
clean_zara_long %>%
filter(metric == "price") %>%
ggplot(aes(x = promotion, y = value, color = promotion)) +
geom_jitter(width = 0.2, height = 0, size = 2.5, alpha = 0.7) +
scale_color_manual(values = c("Yes" = "#2ECC71", "No" = "#E74C3C")) +
facet_wrap(~ type_clothing, scales = "free_x") +
labs(
title = "Price Distribution Broken Down by Clothing Type",
subtitle = "Comparing prices with and without active promotions",
x = "Promotion Active",
y = "Price ($)",
color = "Promotion"
) +
theme_minimal() +
theme(
legend.position = "bottom"
)The last visualization is to measure how much of a difference prices are with or without promotions. Like previously mentioned in the boxplot, the assumption is that the jackets have a better price offering than the other categories, and in this plot we can see that jackets get more promotion sales than anything else. Jeans would get the least amount. Which verifies that people would spend their money when something is on sale or at a reasonable price.
Throughout this analysis, it was interesting to find that the jackets are the most sold, yet on average their prices are the lowest.
Yet the jackets have the most outliers when it comes to pricing as Zara may be putting higher prices on certain products such as seasonal items, collectibles, or something currently trendy.
This could be due to the nature of the dataset as it contains \(53.8\%\) of information about jackets and everything else falling between \(3.4\%\) to \(16.6\%\).
Additionally jeans do not get a lot of promotional notice whereas jackets and other clothing types do. Which means that if they wanted to sell more jeans, they could balance the price with the other stores that sell jeans as well as create more promotional notice.
raw_data3 <- read.csv("https://raw.githubusercontent.com/HaiderrX/CUNY-SPS-MSDS/refs/heads/main/DATA607/Projects/Project_2/datasets/monthly_patients_project_2.csv")
head(raw_data3) Clinic Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov
1 Harbor Community Health Center 245 231 260 278 290 301 315 309 287 295 310
2 Riverside Family Health Clinic 190 205 198 220 235 241 250 263 255 270 268
3 Central Community Health Center 310 298 325 340 355 348 370 365 380 392 401
4 Eastside Family Clinic 155 162 170 168 180 195 201 210 205 218 225
5 Westview Community Health Center 270 265 280 295 310 320 318 330 342 350 360
6 Northside Health Clinic 225 218 240 251 260 272 280 275 290 298 305
Dec
1 325
2 280
3 415
4 230
5 375
6 315
glimpse(raw_data3)Rows: 10
Columns: 13
$ Clinic <chr> "Harbor Community Health Center", "Riverside Family Health Clin…
$ Jan <int> 245, 190, 310, 155, 270, 225, 180, 290, 205, 165
$ Feb <int> 231, 205, 298, 162, 265, 218, 175, 282, 212, 170
$ Mar <int> 260, 198, 325, 170, 280, 240, 192, 300, 220, 182
$ Apr <int> 278, 220, 340, 168, 295, 251, 205, 315, 230, 190
$ May <int> 290, 235, 355, 180, 310, 260, 215, 325, 242, 198
$ Jun <int> 301, 241, 348, 195, 320, 272, 220, 340, 250, 205
$ Jul <int> 315, 250, 370, 201, 318, 280, 230, 350, 245, 215
$ Aug <int> 309, 263, 365, 210, 330, 275, 238, 345, 260, 220
$ Sep <int> 287, 255, 380, 205, 342, 290, 242, 360, 268, 228
$ Oct <int> 295, 270, 392, 218, 350, 298, 250, 372, 275, 235
$ Nov <int> 310, 268, 401, 225, 360, 305, 255, 380, 285, 240
$ Dec <int> 325, 280, 415, 230, 375, 315, 265, 395, 292, 250
There is nothing to clean about this dataset. However, the months shortened to three characters is enough clarity for the reader to understand, but nonetheless it will be changed to their full name.
As well as format the column names properly
Convert from wide to long
clean_data_wide_patients <- raw_data3 %>%
rename(
clinic_name = Clinic,
january = Jan,
february = Feb,
march = Mar,
april = Apr,
may = May,
june = Jun,
july = Jul,
august = Aug,
september = Sep,
october = Oct,
november = Nov,
december = Dec
)
colnames(clean_data_wide_patients) [1] "clinic_name" "january" "february" "march" "april"
[6] "may" "june" "july" "august" "september"
[11] "october" "november" "december"
clean_date_wide_patients| Variable | Meaning |
|---|---|
clinic_name |
Name of the clinic. |
january |
Visited patients for this month. |
february |
Visited patients for this month. |
march |
Visited patients for this month. |
april |
Visited patients for this month. |
may |
Visited patients for this month. |
june |
Visited patients for this month. |
july |
Visited patients for this month. |
august |
Visited patients for this month. |
september |
Visited patients for this month. |
october |
Visited patients for this month. |
november |
Visited patients for this month. |
december |
Visited patients for this month. |
clean_patients_long <- clean_data_wide_patients %>%
pivot_longer(
cols = c(january, february, march, april, may, june, july, august, september, october, november, december),
names_to = "month",
values_to = "value"
)
head(clean_patients_long)# A tibble: 6 × 3
clinic_name month value
<chr> <chr> <int>
1 Harbor Community Health Center january 245
2 Harbor Community Health Center february 231
3 Harbor Community Health Center march 260
4 Harbor Community Health Center april 278
5 Harbor Community Health Center may 290
6 Harbor Community Health Center june 301
glimpse(clean_patients_long)Rows: 120
Columns: 3
$ clinic_name <chr> "Harbor Community Health Center", "Harbor Community Health…
$ month <chr> "january", "february", "march", "april", "may", "june", "j…
$ value <int> 245, 231, 260, 278, 290, 301, 315, 309, 287, 295, 310, 325…
clean_patients_long| Variable | Meaning |
|---|---|
clinic_name |
Name of the clinic. |
month |
Listing months from January to December. |
value |
Visited patients for the respective month for that clinic. |
month_patient_counts <- clean_patients_long %>%
group_by(month) %>%
summarise(
month_counts = sum(value, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(month_counts))
month_patient_counts# A tibble: 12 × 2
month month_counts
<chr> <int>
1 december 3142
2 november 3029
3 october 2955
4 september 2857
5 august 2815
6 july 2774
7 june 2692
8 may 2610
9 april 2492
10 march 2367
11 january 2235
12 february 2218
ggplot(month_patient_counts, aes(x=reorder(month, month_counts), y = month_counts, fill = month)) +
geom_col() +
coord_flip() +
geom_text(
aes(label = month_counts),
vjust = 0.5,
hjust = -0.05,
color = "black",
size = 3
) +
labs(
title = "Patients per Month",
subtitle = "Arranged from greatest to least",
x = "Month",
y = " Counts",
fill = "Months"
) +
theme_minimal() +
theme(
legend.position = "bottom"
) +
guides(fill = guide_legend(nrow = 2)) We can see that in the month of December they have the most patients across all hospitals followed by November, October, … all the way down to February.
Interestingly, it seems that the fall season has more patients visiting than the summer or spring season. This could be due to the seasons changing and people’s bodies getting adjusted to the weather.
frequent_visited_hospital <- clean_patients_long %>%
group_by(clinic_name) %>%
summarise(
total_patient_counts = sum(value, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
total_percent = round((total_patient_counts / sum(total_patient_counts)) * 100, 1)
) %>%
arrange(desc(total_patient_counts))
frequent_visited_hospital# A tibble: 10 × 3
clinic_name total_patient_counts total_percent
<chr> <int> <dbl>
1 Central Community Health Center 4299 13.4
2 Lakeside Community Clinic 4054 12.6
3 Westview Community Health Center 3815 11.9
4 Harbor Community Health Center 3446 10.7
5 Northside Health Clinic 3229 10
6 Parkview Health Center 2984 9.3
7 Riverside Family Health Clinic 2875 8.9
8 Greenwood Family Health Center 2667 8.3
9 Hillcrest Community Clinic 2498 7.8
10 Eastside Family Clinic 2319 7.2
ggplot(frequent_visited_hospital, aes(x = reorder(clinic_name, total_patient_counts), y = total_patient_counts, fill = clinic_name)) +
geom_col() +
coord_flip() +
geom_text(
aes(label = total_patient_counts),
vjust = 0.5,
hjust = 0.09,
color = "black",
size = 2.5
) +
labs(
title = "Total Patients Visited per Hospital",
subtitle = "Arranged from greatest to least",
x = "Clinic",
y = "Counts",
fill = "Clinic Name"
) +
theme_minimal() +
theme(legend.position = "bottom") +
guides(fill = guide_legend(nrow=4))The range of patients visiting a hospital falls within \(7.2\%\) to \(13.4\%\) which is fairly balanced distribution for this dataset. As noted there are certain hospitals which are not visited as much compared to others. This could be due to:
Professionalism in the workplace
Availability
Location
Needs
However without more information it is hard to say or investigate exactly what makes a hospital more prominent than another.
Given that this dataset only contains information about the clinic and how many patients visited that clinic for each month, there are heavy limitations with what can be done with the data. The only thing we can do is create plots and table for the volume of patients visiting a hospital and monthly patient visits across all hospitals.
Working with different datasets require being able to think:
What does the dataset need?
What are you trying to accomplish
What are the limitations of the dataset?
What are the appropriate plots for each dataset?
The most common theme were bar plots as it can be read easily