Best Plot
2024-04-17
BCIT_Schools_raw <- read_excel("61144 Business Certification IT Schools in the US Industry Report Financial Ratios.xlsx", sheet
= "5m-10m")
BCIT_Schools <- BCIT_Schools_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Business Certification IT Schools") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
plumbers_raw <- read_excel("23822B Plumbers in the US Industry Report Financial Ratios.xlsx", sheet = "5m-10m")
plumbers <- plumbers_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Plumbers") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
carpet_cleaning_raw <- read_excel("56174 Carpet Cleaning in the US Industry Report Financial Ratios.xlsx", sheet =
"5m-10m")
carpet_cleaning <- carpet_cleaning_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Carpet Cleaning") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
TES_raw <- read_excel("61171 Testing Educational Support in the US Industry Report Financial Ratios.xlsx", sheet = "5m-10m")
TES <- TES_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Testing Educational Support") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
OTS_raw <- read_excel("OD6038 Online Tutoring Services in the US Industry Report Financial Ratios.xlsx", sheet = "5m-10m")
OTS <- OTS_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Online Tutoring Services") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
TTS_raw <- read_excel("61151 Trade Technical Schools in the US Industry Report Financial Ratios.xlsx", sheet
= "5m-10m")
TTS <- TTS_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Trade Technical Schools") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
operating_systems_raw <- read_excel("51121A Operating Systems Productivity Software Publishing in the US Industry Report Financial Ratios.xlsx", sheet
= "5m-10m")
operating_systems <- operating_systems_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Operating Systems Productivity Software Publishing") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
air_purification_raw <- read_excel("OD4509 Air Purification Equipment Manufacturing in the US Industry Report Financial Ratios.xlsx", sheet
= "5m-10m")
air_purification <- air_purification_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Air Purification Equipment Manufacturing") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
hvac_raw <- read_excel("23822A Heating Air-Conditioning Contractors in the US Industry Report Financial Ratios.xlsx", sheet
= "5m-10m")
hvac <- hvac_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Heating & Air-Conditioning Contractors") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
business_coaching_raw <- read_excel("61143 Business Coaching in the US Industry Report Financial Ratios.xlsx", sheet
= "5m-10m")
business_coaching <- business_coaching_raw %>%
filter(Ratio %in% c("EBITDA/Revenue",
"Return on Assets, %", "Debt/Net Worth", "Current Ratio")) %>%
slice(-n()) %>%
mutate(Sector = "Business Coaching") %>%
pivot_longer(cols = '2017':'2021', names_to = "Year", values_to = "Value") %>%
mutate(ROA = ifelse(Ratio == "Return on Assets, %", Value, NA),
EBITDA = ifelse(Ratio == "EBITDA/Revenue", Value, NA), DNW = ifelse(Ratio == "Debt/Net Worth", Value, NA),CR = ifelse(Ratio == "Current Ratio", Value, NA)) %>%
select(Sector, Year, ROA, EBITDA, DNW, CR) %>%
group_by(Sector, Year) %>%
summarise_all(sum, na.rm = TRUE)
sector_df <- bind_rows(BCIT_Schools, TES, OTS, carpet_cleaning, plumbers, TTS, operating_systems, air_purification, hvac, business_coaching)This plot is intended to compare industry data across multiple sectors. My plot is intended to give me financial insight into which industry would be the most ideal for purchasing a small business in. For this plot in particular, I decided to compare EBITDA to revenue ratios for the perspective industries that I identified. This visualization will give me a good idea about the profitability and cash flow of the sector. A low ratio or erratic ratio would cause me to raise some red flags as to whether purchasing a small business in the given sector would be a plausible idea at the time.
This first plot shows a bar plot comparing by EDITDA to revenue ratio by each sector for every year from 2017-2021.
p1 <- ggplot(sector_df, aes(x = Sector, y = EBITDA, fill = as.factor(Year))) +
geom_bar(stat = "identity", position = position_dodge()) +
labs(title = "EBITDA to Revenue Ratio by Sector and Year",
x = "Sector",
y = "EBITDA/Revenue Ratio",
fill = "Year") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
p1
I found these colors to pose quite brightly and unattractive, so my
first aesthetic change was to change the color palette. I wanted to
ensure that the palette I chose wasn’t as brightly neon as the last and
that the colors of each year are very differential from each other to
dismiss any confusion upon which year is which.
p2 <- p1 +
scale_fill_brewer(palette = "Set3")
p2
For my second aesthetic change, I decide to facet wrap the bar graph.
This goes along with the small multiples approach we learned in class
and makes the data much more digestable. I feel that this format is
better for comparing by year but much work needs to be done to adjust
it.
p3 <- p2 +
facet_wrap(~Year)
p3
For the next aesthetic change, I made multiple changes to help clear up
the new, faceted plot. First, I added the ratio data values to the tops
of each bar to help create a more precise comparison. I then changed the
theme to light which I thought would be a better fit. Last, I got rid of
the x-axis labels, as they were jumbled and did not give any purpose or
value.
p4 <- p3 +
geom_text(aes(label = EBITDA), position = position_dodge(width = 0.9), vjust = -0.25) +
theme_light() + theme(axis.text.x = element_blank())
p4
For this change, I overhauled some of the variables from the original
plot. I changed the fill from sector to year, since the year value is
already being shown via the facet wrap. I adjusted the y-axis so that
none of the data values are cutoff.
p5 <- ggplot(sector_df, aes(x = Sector, y = EBITDA, fill = Sector)) +
geom_bar(stat = "identity", position = position_dodge()) + facet_wrap(~Year) +
geom_text(aes(label = EBITDA), position = position_dodge(width = 0.9),
vjust = -0.25) + ylim(0, max(sector_df$EBITDA) * 1.05) +
labs(title = "EBITDA to Revenue Ratio by Sector and Year",
x = "",
y = "EBITDA/Revenue Ratio",
fill = "Sector") +
theme_light() + theme(axis.text.x = element_blank()) +
scale_fill_brewer(palette = "Set3")
p5
For the next change, I decided to use plotly to make my plot more
interactive. I had to add the text aesthetic to my ggplot to perform
this. I feel by adding the plotly, I can make a more dynamic plot and it
limits the use of the legend. Although, I feel like the legend still
adds value for the color comparison between years, especially with the
new, interactive legend. The hover info and plotly will enable users to
understand the visual with less looking back and forth to the legend. I
also decided to remove the data values above the bars to reduce the
clutter of information that is already repeated.
p6 <- ggplot(sector_df, aes(x = Sector, y = EBITDA, fill = Sector,
text = paste("Sector:", Sector,
"<br>EBITDA/Revenue Ratio:",
EBITDA, "<br>Year:", Year))) +
geom_bar(stat = "identity", position = position_dodge()) + facet_wrap(~Year) +
ylim(0, max(sector_df$EBITDA) * 1.05) +
labs(title = "EBITDA to Revenue Ratio by Sector and Year",
x = "",
y = "EBITDA/Revenue Ratio",
fill = "Sector") +
theme_light() + theme(axis.text.x = element_blank()) +
scale_fill_brewer(palette = "Set3")
p6_interactive <- ggplotly(p6, tooltip = "text")
p6_interactiveLastly, I computed the mean and standard deviation of each sectors ratio. I then added the mean and standard deviation to be one of the hover information points. I feel that this change is important, so that the viewer has an idea of what the distribution of the data looks like. This can be important when comparing which sectors prove to be more or less erratic in terms of EBITDA/REVENUE Ratio.
sector_stats <- sector_df %>%
group_by(Sector) %>%
summarize(
MeanEBITDA = mean(EBITDA, na.rm = TRUE),
SDEBITDA = sd(EBITDA, na.rm = TRUE),
.groups = 'drop'
)
sector_stats_df <- sector_df %>%
left_join(sector_stats, by = "Sector")
p7 <- ggplot(sector_stats_df, aes(x = Sector, y = EBITDA, fill = Sector, text = paste(
"Sector: ", Sector,
"<br>Year: ", Year,
"<br>EBITDA/Revenue Ratio: ", EBITDA,
"<br>Mean EBITDA/Revenue Ratio: ", MeanEBITDA,
"<br>SD EBITDA/Revenue Ratio: ", round(SDEBITDA, 2)
))) +
geom_bar(stat = "identity", position = position_dodge()) + facet_wrap(~Year) +
ylim(0, max(sector_df$EBITDA) * 1.05) +
labs(title = "EBITDA to Revenue Ratio by Sector and Year",
x = "",
y = "EBITDA/Revenue Ratio",
fill = "Sector") +
theme_light() + theme(axis.text.x = element_blank()) +
scale_fill_brewer(palette = "Set3")
p7_interactive <- ggplotly(p7, tooltip = "text")
p7_interactiveI believe plot 6 is the best plot of my assignment. I used some of the principles that we’ve learned throughout the course to help guide my decision and thought process. Obviously the last plot has the most aesthetics, but this does not necessarily make it the best plot. Incorporating the small multiples approach made my data much more useful, in my opinion. I feel that any viewer will be able to process the message much faster due to facet wrap I used. This eliminates plots 1 and 2. Plots 3 and 4 are not very useful at all, and are easily eliminated from best plot consideration. I then eliminated plot 7 due to the reducing clutter principle. Although potentially helpful, I don’t think that adding the statistic values add inherent value nor is necessary for conveying my message of this particular plot. I then eliminated plot 5 due to the integrate text with graphics principle and the reduce clutter principle. The interactivity and dynamic nature of graph 6 put it ahead of the fifth plot in my decision. The comparison of EBIDTA/Revenue ratio across the prospective sectors is a useful and valuable visualization that helps guide me to the best sector of purchase.I fully believe that this plot best encompasses the principles we used in this class and is an adequate addition to my final project.