Data Portfolio

Checking out the Discogs API: API Practice 2

2024-02-14T00:00:00+00:00

Introduction: Polars & Discogs API

For this project, I’m calling the Discogs API to create a DF of any album I want within Discog’s album catalog so that I can make it into a data frame. Any album can be called by any artist, but be mindful of the name of the artist and file’s name when saving to .csv

If its desired to do an entire artist’s discography, it would be possible to save multiple URLs to their own objects, source the data using the code below, and then concatenate all the resulting dataframes together using a loop to iterate over them.

…

Setup

# Import libraries: 
import requests as req
import datetime as dt
import polars as pl
import json

# Set URL object and user agent
url = ('https://api.discogs.com/masters/45947')

user_agent = "API-call-Practice/1.0 (************@gmail.com)"

# You can generate your own API token here: https://www.discogs.com/settings/developers
auth_token = "***********************************"

headers = {
        "User-Agent": user_agent,
        "oauth_token": auth_token
}

res = req.get(url).json()

Some APIs need authentication in order to enable calls to be made to their servers, so in the above lines, I’m establishing an ID and name for the project that I’m calling the API from via the “User Agent,” along with a “token” which serves as the secret/password for identification purposes.

The URL in the snippet takes you to the Discogs developers page where you can generate a free-use token and sign up for their services if you’re doing more involved work, like creating an app or service.

Sourcing the Data

# Checks if API call is successful
if res:
    print('Success!')
else:
    print('Error!')

flat_data = []

for track in res.get("tracklist", []):
    extra_artists_names = ", ".join(artist['name'] for artist in track.get("extraartists", []))

    track_info = {
        "master_id": res["id"],
        "album_title": res["title"],
        "track_title": track.get("title", ""),
        "track_position": track.get("position", ""),
        "track_duration": track.get("duration", ""),
        "extra_artists": extra_artists_names,
        "year": res["year"]
    }
    flat_data.append(track_info)
        
df = pl.DataFrame(flat_data)       

This code snippet is what’s “extracting” the data from the API using the credentials I specified above. The first line checks and tells me if the API connection was established or not, printing a statement if success or otherwise.

From there, I make an empty list for the data to go in, I then establish a for loop to iterate over the sections of the JSON that house the “tracklist” data.

I then create another object called “track_info” that pulls the needed columns and flattens them, then appends the track_info object into the empty “flat_data” list I made eariler. From there, I use Polars to make that list into an actual data frame.

…

# Comment out if using on other albums. Change the name in the pl.lit call to the correct artist 
df = df.with_columns(pl.lit('A Tribe Called Quest').alias('artist'))

df = df.select(['master_id', 'album_title', 'track_title', 
                'track_position', 'track_duration', 'artist', 'extra_artists', 'year'])

# Print data frame to check data: 
print(df)

When I thought of this ETL script, though a little basic, I wanted for it to be able to be reused for other artists as well. Essentially, any artist you find on the Discogs page can have their data pulled in the same manner as I did ‘A Tribe Called Quest’ using this script. You’ll just need their API url.

I learned that if the album Midnight Maraders was here: https://www.discogs.com/master/45947-A-Tribe-Called-Quest-Midnight-Marauders

Then the API equivalent of that same album on their site is here: https://api.discogs.com/masters/45947

All you do is switch ‘www.’ to ‘api.’, turn ‘master’ into its plural form ‘masters’ and then give the album ID which is the sequence of numbers at the end without the descriptor.

Write data to .csv

# Comment out, change file name and then re-run 
#df.write_csv("c:\\Users\\xxxxx\\Documents\\atcq_artist_data.csv", separator= ',')

Lastly, all you need to do is write the data to .csv using the line above. The resulting .csv you can use for other projects.

…

Outtro

That’s all there is to it! I’m working on thinking about how I can further expand on this script to do more involved work in the ETL process but this here is just a proof of concept.

Thank you for reading!

Looking at the Switch: API Practice

2024-02-14T00:00:00+00:00

Introduction

In this script, I’m calling an API that houses data for Nintendo Switch titles, so the resulting data frame can be used in other applications. Specifically, I thought it would be interesting to work with the dates contained in the data to visualize everything in a time series.

…

Setup & Extracting the data

# Import appropriate packages:
import requests
import json
import pandas as pd
import numpy as np
import datetime

#Set URL object for API 
url = ('https://api.sampleapis.com/switch/games')

# Get API Request
res = requests.get(url)

The first thing I’ll do here is import then needed packages, set the URL as an object to reference later and make a request to the API to pull that raw data into an object.

…

Working with the JSON

# Render API response to JSON
json = res.json()

# Parse JSON to data frame
data = pd.json_normalize(json, 
                         sep=' -> ',
                         max_level=1)

for col in data.columns:
    if isinstance(data[col].dropna().iloc[0], list):  
        data[col] = data[col].apply(lambda x: ', '.join(x) if x else None)

# Rename columns
data = data.rename(columns={'name': 'title', 'releaseDates -> Japan': 'JP_releaseDate', 'releaseDates -> NorthAmerica': 'US_releaseDate', 
                            'releaseDates -> Europe': 'EU_releaseDate', 'releaseDates -> Australia': 'AUS_releaseDate'})

Here in this snippet, I then call the JSON package to convert the raw data into JSON, which I’m storing as its own object. I then normalize everything, and then apply a loop that grabs the first entry in the lists within the JSON to output only the data contained in the JSON, with no other characters.

Afterwards, I renamed the outputted columns for readabilities sake.

…

Dates, I don’t say that because its Valentine’s Day

# Specify date columns as an object
date_cols = ["JP_releaseDate", "US_releaseDate", "EU_releaseDate", "AUS_releaseDate"]

# Specify non-date values and then replace them with NaNs and actual formatted dates 
non_date_values = ['Unreleased', 'TBA', '2020', 'Q3 2020']

data[date_cols] = data[date_cols].replace(non_date_values, np.nan)

for col in date_cols:
    data[col] = pd.to_datetime(data[col], errors='coerce', format='%B %d, %Y')

So here I wanted to clean up the dates a bit, and to do that I ascribed the date columns as their own object. Then I had Python identify the non-date values contained in the data set, so as to replace them all with NaNs and they would be read by Python as NULL.

Lastly, another loop uses Pandas datetime to coerce the dates into a singular format.

# Check data     
data.head(10)
    
# A function to check if a value is a date or NaN
def is_date_or_nan(val):
    if pd.isna(val):
        return True
    try:
        pd.to_datetime(val, format='%Y-%m-%d')
        return True
    except ValueError:
        return False

# Check for dates in each column
for col in date_cols:
    if not data[col].apply(is_date_or_nan).all():
        print(f"{col} doesn't only have dates in it")
        break
else:
    print("All specified columns contain only dates or NaN")
    
# Write data to csv: 
data.to_csv("C:/Users/bruce/Documents/Python/switch_games.csv", index=False)

From there, I check the data using ‘head’ to read the first ten columns to check for consistency of formatting. Then I employ a function to check if a value is an actual date or a NULL value. I then iterate over the dataset using that function to check if each columns is uniform in content.

Lastly, I wrote the resulting data set to a .csv, which can be used into Tableau, Looker, PowerBI or your favorite BI tool of choice to visualize everything and glean insight fron the data.

Outro

Theres a good amount you can do and not all ETL scripts are alike, yet they all mostly carry out similar functionalities and this is no different. With that said, the Nintendo Switch carries an impressive array of games, consider checking it out.

SQL Query Showcase

2023-08-23T00:00:00+00:00

Introduction:

This is a showcase of sample SQL queries that I made for practice in learning the language. The sources listed before each query link to the direct place the content came from, unless noted otherwise. Each heading represents a concept of SQL that I touched on.

Primary Sources: DataLemur by Nick Singh SQL-practice.com by Boolean-algebra

Common Table Expression (CTE)

Source: Previous Interview Assessment

Context: A restaurant company wants to use this dataset to inform management of trends with how customer order their products

Table: Customers

Index	customerOloRef	firstName	lastName	emailAddress	phoneNumber
0	1210852832	Ashlee	Black	718798@test.com	18539137645
1	1210862959	Karen	Taylor	908278@test.com	17118714180
2	1211222409	Rachel	Glover	990342@test.com	14160108199
3	1210884227	Kevin	Barnett	816118@test.com	16375662719
4	1211205145	Andrew	Oneal	694351@test.com	18535103663
5	1210892053	Matthew	Cobb	403207@test.com	12141628213
6	1210878061	Julie	Rice	107345@test.com	11470213737
7	1210868677	Joshua	Williams	922872@test.com	10627821511
8	1210850046	Kimberly	Miller	734453@test.com	14769450538

…

Table: Orders

Index	orderOloRef	customerOloRef	storeRef	timePlaced	orderedFromFave	source	handoff	paymentType	zipcode
0	1526136030	1212424032	25	2021-08-10	FALSE	CallCenter	CurbsidePickup	CreditCard	60134
1	1636426442	1194539172	44	2021-08-10	FALSE	CallCenter	CurbsidePickup	CreditCard	65708
2	2116129966	1193104823	22	2021-08-10	FALSE	API	CounterPickup	CreditCard	60134
3	2112894463	1192380993	24	2021-08-10	FALSE	API	Dispatch	CreditCard	60543
4	1513983208	1194885843	13	2021-08-10	FALSE	API	Dispatch	CreditCard	60018
5	1645861726	1192678698	9	2021-08-10	FALSE	CallCenter	Dispatch	CreditCard	60004
6	1868589889	1220411684	27	2021-08-10	FALSE	API	CurbsidePickup	CreditCard	60431
7	1874887693	411086145	15	2021-08-10	FALSE	API	Dispatch	CreditCard	60107
8	1917609011	1191607575	37	2021-08-10	FALSE	CallCenter	Dispatch	CreditCard	60452

…

Table: Products

Index	orderOloRef	orderProduct	quantity	cost	orderedFromFave	source	handoff	paymentType	zipcode
0	1332720190	Chicken Tenders 6 Piece	1	8.74	FALSE	CallCenter	CurbsidePickup	CreditCard	60134
1	1377148167	Big Beef Sandwich	1	10.86	FALSE	CallCenter	CurbsidePickup	CreditCard	65708
2	1674285799	Cheeseburger	1	0	FALSE	API	CounterPickup	CreditCard	60134
3	1560588602	Caesar Salad	1	0	FALSE	API	Dispatch	CreditCard	60543
4	1514784642	Large French Fries	3	3.74	FALSE	API	Dispatch	CreditCard	60018
5	1731086029	Cheese Sauce	2	1.24	FALSE	CallCenter	Dispatch	CreditCard	60004
6	1927656374	Chocolate Cake Slice	2	4.36	FALSE	API	CurbsidePickup	CreditCard	60431
7	1621969249	*New Classic Beef Bowl	1	8.49	FALSE	API	Dispatch	CreditCard	60107
8	1781607712	Italian Beef Sandwich	1	8.11	FALSE	CallCenter	Dispatch	CreditCard	60452

…

Step 1: Tell which customers order French Fries in their past orders.

SELECT *, 
    CASE WHEN orderproduct LIKE '%French Fries%' 
      THEN 'TRUE' ELSE 'FALSE' END AS isFrenchFry
FROM "Products"
GROUP BY index, orderproduct, orderoloref, quantity, cost;

Step 2: What is the purchasing frequency of customers that order certain products?

SELECT DISTINCT p1.orderproduct as "product_a", 
                p2.orderproduct as "product_b", 
  COUNT(*) as PurchaseFrequency,
  COUNT(*) * 100.0/ SUM(COUNT(*)) OVER () as PercentFreq
FROM "Products" AS p1
INNER JOIN "Products" AS p2
ON p1.orderproduct <> p2.orderproduct
  AND p1.orderoloref = p2.orderoloref
GROUP BY p1.orderproduct, p2.orderproduct
ORDER BY PurchaseFrequency DESC;

Step 3 & 4: What customers ordered the biggest quanitity of the most popular items on the menu?

WITH porders AS 
  (
    SELECT CONCAT(cust.firstname, ' ', cust.lastname) AS name, 
    cust.emailaddress,
    cust.phonenumber,
    p1.orderproduct as "product_a", 
    p2.orderproduct as "product_b",
    SUM(p1.quantity) as "total_quantity",
    ROUND(SUM(p1.cost::numeric),2) as "total_cost",
    COUNT(*) as PurchaseFrequency,
    ROUND(COUNT(*) * 100.0/ SUM(COUNT(*)) OVER (), 3) as PercentFreq
FROM "Products" AS p1
INNER JOIN "Products" AS p2
ON p1.orderproduct <> p2.orderproduct
    AND p1.orderoloref = p2.orderoloref
JOIN "Orders" AS ord 
  ON ord.orderoloref = p1.orderoloref
JOIN "Customers" AS cust 
  ON cust.customeroloref = ord.customeroloref
WHERE p1.orderproduct 
  LIKE '%French Fries%'
GROUP BY p1.orderproduct, p2.orderproduct, p1.cost, cust.firstname, cust.lastname, cust.emailaddress, cust.phonenumber
ORDER BY PurchaseFrequency DESC
) 
SELECT * 
FROM porders;

…

Source: Previous Interview Assessment

Context: What are the total revenue across months for the organization and what are noticable changes that I can observe from the data overtime for the last calendar year?

WITH CTE AS(
SELECT DATE_TRUNC('month', CURRENT_MONTH) AS month, 
        YEAR(DATE_TRUNC('month', CURRENT_MONTH)) AS year,
        ROUND((SUM(unit_value)) OVER (PARTITION BY DATE_TRUNC('month', CURRENT_MONTH)), 2) AS total_monthly_unit_value,
        ROUND((SUM(mrr_value)) OVER (PARTITION BY DATE_TRUNC('month', CURRENT_MONTH)), 2) AS total_mrr_value,
        ROUND((SUM(transaction_value)) OVER (PARTITION BY DATE_TRUNC('month', CURRENT_MONTH)), 2) AS total_monthly_transaction_value
FROM DATA_ANALYST_INTERVIEW.PUBLIC.HISTORICAL_MRR_TRANSACTIONS
    WHERE CURRENT_MONTH BETWEEN '2021-01-01' AND '2022-12-01'
GROUP BY DATE_TRUNC('month', CURRENT_MONTH)
ORDER BY DATE_TRUNC('month', CURRENT_MONTH)
)

SELECT MONTHNAME(month) AS DATE, year, total_monthly_unit_value, 
    ROUND(((total_monthly_unit_value/lag(total_monthly_unit_value, 1) OVER (ORDER BY DATE_TRUNC('month', month))) - 1) * 100, 1) AS UV_percentage_change,
      total_mrr_value, 
    ROUND(((total_mrr_value/lag(total_mrr_value, 1) OVER (ORDER BY DATE_TRUNC('month', month))) - 1) * 100, 1) AS MRR_percentage_change,
      total_monthly_transaction_value, 
    ROUND(((total_monthly_transaction_value/lag(total_monthly_transaction_value, 1) OVER (ORDER BY DATE_TRUNC('month', month))) - 1) * 100, 1) AS TV_percentage_change,
    ROUND((UV_PERCENTAGE_CHANGE + MRR_PERCENTAGE_CHANGE + TV_PERCENTAGE_CHANGE)/3, 1) as AVERAGE_PERCENTAGE_CHANGE
FROM CTE
GROUP BY month, year, total_monthly_unit_value, total_mrr_value, total_monthly_transaction_value;

-- What is the total revenue by account type? 
SELECT  pda.account_type, ROUND(SUM(hmrr.transaction_value), 2) AS Revenue
FROM DATA_ANALYST_INTERVIEW.PUBLIC.HISTORICAL_MRR_TRANSACTIONS AS hmrr
    JOIN DATA_ANALYST_INTERVIEW.PUBLIC.DIM_ACCOUNTS AS pda ON pda.owner_user_id = hmrr.owner_id
GROUP BY account_type
ORDER BY pda.account_type;

…

Source: (https://datalemur.com/questions/sql-spare-server-capacity)

WITH demands AS (
  SELECT 
    datacenter_id,
    SUM(monthly_demand) AS total_demand
  FROM forecasted_demand
  GROUP BY datacenter_id)


SELECT demands.datacenter_id, demands.total_demand, 
        centers.name, centers.monthly_capacity AS total_capacity 
FROM demands 
  INNER JOIN datacenters AS centers ON demands.datacenter_id = centers.datacenter_id;

Subquery example

Source: (https://datalemur.com/questions/sql-spare-server-capacity)

SELECT centers.datacenter_id, (centers.monthly_capacity -
  demands.total_demand) AS spare_capacity 
FROM ( SELECT datacenter_id,
  SUM(monthly_demand) AS total_demand FROM forecasted_demand GROUP BY
  datacenter_id) AS demands 
INNER JOIN datacenters AS centers ON
  demands.datacenter_id = centers.datacenter_id 
ORDER BY centers.datacenter_id;

Aggregate Functions with SUM

Source: (https://www.sql-practice.com/)

Keyword: SUM, Difficulty: HARD

SELECT CASE WHEN (patient_id % 2 = 0) THEN 'Yes' 
            ELSE 'No' 
        END AS has_insurance, 
        SUM( 
          CASE WHEN patient_id % 2 = 0 THEN 10 
          ELSE 50 
          END) AS cost_after_insurance 
FROM admissions 
GROUP BY has_insurance

Show the provinces that has more patients identified as ‘M’ than ‘F’…

Keyword: HAVING, Difficulty: HARD

--Query A

SELECT pr.province_name 
FROM patients AS pa 
JOIN province_names AS pr ON pa.province_id = pr.province_id 
GROUP BY pr.province_name 
HAVING SUM(gender = 'M') \> SUM(gender = 'F');


--Query B, using COUNT

SELECT pr.province_name 
FROM patients AS pa 
JOIN province_names AS pr ON pa.province_id = pr.province_id 
GROUP BY pr.province_name 
HAVING COUNT(CASE WHEN gender = 'M' THEN 1 END) \> COUNT( CASE WHEN gender = 'F' THEN 1 END);


--Query C, using a subquery and SUM

SELECT province_name 
FROM ( SELECT province_name, SUM(gender = 'M') AS n_male, SUM(gender = 'F') AS n_female 
FROM patients pa 
JOIN province_names pr ON pa.province_id = pr.province_id 
GROUP BY province_name ) 
WHERE n_male \> n_female

Aggregate and then display as a percentage

Keyword: COUNT, Difficulty: HARD

SELECT concat( ROUND( ( SELECT COUNT(*) FROM patients WHERE gender = 'M'
) / CAST(COUNT(*) as FLOAT), 4 ) \* 100, '%' ) AS percent_of_male_patients 
FROM patients 
WHERE gender = 'M' 
GROUP BY gender

--or...

--Query B

SELECT Concat(round(100 \* avg(gender = 'M'), 2),'%') AS percent_of_male_patients 
FROM patients;

--Query C

SELECT round(100 \* avg(gender = 'M'), 2) \|\| '%' AS percent_of_male_patients 
FROM patients;

Window function example RANK()

Source: (https://datalemur.com/questions/sql-third-transaction)

SELECT user_id, spend, transaction_date 
FROM (SELECT user_id, spend, transaction_date, RANK() OVER (PARTITION BY user_id ORDER BY
transaction_date) AS rank_num FROM transactions) AS trans_num 
WHERE rank_num = '3' 
GROUP BY user_id, spend, transaction_date

Sending vs. Opening Snaps (CTE, CASE WHEN, Aggregates)

Source: (https://datalemur.com/questions/time-spent-snaps)

WITH activity AS ( SELECT ab.age_bucket, 
              SUM(CASE WHEN act.activity_type = 'open' THEN act.time_spent ELSE 0 END) AS time_open, 
              SUM(CASE WHEN act.activity_type = 'send' THEN act.time_spent ELSE 0 END) AS time_sent,
              SUM(act.time_spent) as total_time FROM activities act JOIN age_breakdown ab ON act.user_id = ab.user_id 
WHERE act.activity_type IN ('open', 'send') 
GROUP BY ab.age_bucket)

SELECT age_bucket, ROUND(((time_sent / total_time)\* 100.0),2) AS sent_perc, 
                    ROUND(((time_open / total_time)\* 100.0),2) AS open_perc 
FROM activity
ORDER BY age_bucket DESC

Window functions for calculating rolling averages based on tweets

Source: (https://datalemur.com/questions/rolling-average-tweets)

SELECT user_id, tweet_date, TRUNC(AVG(tweet_count) 
  OVER(PARTITION BY user_id ORDER BY tweet_date ROWS BETWEEN 2 PRECEDING AND CURRENT ROW), 2) AS rolling_avg_3days 
FROM (SELECT user_id, tweet_date, count(tweet_date) as tweet_count FROM tweets GROUP BY user_id, tweet_date) AS daily_tweets 
GROUP BY user_id, tweet_date, tweet_count
ORDER BY user_id ASC, tweet_date ASC;

Compensation Outliers

Source: (https://datalemur.com/questions/compensation-outliers)

WITH payout 
AS 
  (SELECT
	employee_id, 
	salary, 
	title,
	(AVG(salary) OVER (PARTITION BY title)) * 2 AS doub_avg,
	(AVG(salary) OVER (PARTITION BY title)) / 2 AS half_avg
FROM employee_pay)

SELECT 
    employee_id,
    salary,
    CASE  
      WHEN salary > doub_avg THEN 'Overpaid'
      WHEN salary < half_avg THEN 'Underpaid'
    END AS status
FROM payout
GROUP BY
  employee_id, salary, doub_avg, half_avg
HAVING
  salary > doub_avg OR
  salary < half_avg
ORDER BY 
  employee_id;

Photoshop Revenue Analysis

Source: (https://datalemur.com/questions/photoshop-revenue-analysis)

SELECT customer_id, 
  SUM(revenue) as revenue
FROM adobe_transactions
WHERE customer_id IN (SELECT customer_id FROM adobe_transactions WHERE product = 'Photoshop') 
  AND product <> 'Photoshop'
GROUP BY customer_id
ORDER BY customer_id ASC

Unique Money Transfer Relationships

Source: (https://datalemur.com/questions/money-transfer-relationships)

SELECT
  COUNT(payer_id) / 2
FROM (SELECT
        payer_id, recipient_id
      FROM payments
INTERSECT
      SELECT
        recipient_id, payer_id
      FROM payments) 
      as relationships;

Youtube Top 20 Content Creators

2023-07-19T00:00:00+00:00

Introduction:

Hello! In this project, I’m breaking down the top content creators on Youtube over 2017-2018. The very first thing i’ll do is load the libraries I’m going to use:

import pandas as pd
import numpy as np
import seaborn as sb
import matplotlib.pyplot as plt
import datetime as dt
import json 
from itables import show

%matplotlib inline

Next, I’m reading the data into a .csv:

ytube = pd.read_csv('C:/Users/bruce/Downloads/archive (1)/USvideos.csv')
ytube = pd.DataFrame(ytube)

Afterwards, here’s what everything looks like:

print(ytube.iloc[0:5])

          video_id                                              title  \
 NDBwsMIXlMk  Marvel’s Agents of S.H.I.E.L.D. | Season 5 Pre...   
 NDBwsMIXlMk  Marvel’s Agents of S.H.I.E.L.D. | Season 5 Pre...   
 NDBwsMIXlMk  Marvel’s Agents of S.H.I.E.L.D. | Season 5 Pre...   
 6ZfuNTqbHE8  Marvel Studios' Avengers: Infinity War Officia...   
 KXHrCBkIxQQ  ALL THE MONEY IN THE WORLD - Official Trailer ...   
...            ...                                                ...   
X2BfTXIwABo                  MARVEL COMICS 2018: A Fresh Start   
X2BfTXIwABo                  MARVEL COMICS 2018: A Fresh Start   
X2BfTXIwABo                  MARVEL COMICS 2018: A Fresh Start   
X2BfTXIwABo                  MARVEL COMICS 2018: A Fresh Start   
X2BfTXIwABo                  MARVEL COMICS 2018: A Fresh Start   

                     channel_title  category_id    category_title  \
        Marvel Entertainment           24     Entertainment   
        Marvel Entertainment           24     Entertainment   
        Marvel Entertainment           24     Entertainment   
        Marvel Entertainment           24     Entertainment   
 Sony Pictures Entertainment           24     Entertainment   
...                            ...          ...               ...   
       Marvel Entertainment            2  Autos & Vehicles   
       Marvel Entertainment            2  Autos & Vehicles   
       Marvel Entertainment            2  Autos & Vehicles   
       Marvel Entertainment            2  Autos & Vehicles   
       Marvel Entertainment            2  Autos & Vehicles   

             publish_time trending_date     views    likes  dislikes  \
2017-11-26 16:00:21    2017-11-27    248455     7174       200   
2017-11-26 16:00:21    2017-11-28    456193     9501       294   
2017-11-26 16:00:21    2017-11-29    537443    10577       341   
2017-11-29 13:26:24    2017-11-30  37736281  1735895     21969   
2017-11-29 20:00:53    2017-11-30    197900     2394       372   
...                   ...           ...       ...      ...       ...   
2018-02-20 15:00:05    2018-02-24    377995     9315       704   
2018-02-20 15:00:05    2018-02-25    385064     9404       712   
2018-02-20 15:00:05    2018-02-26    390321     9485       721   
2018-02-20 15:00:05    2018-02-27    394864     9560       728   
2018-02-20 15:00:05    2018-02-28    400237     9618       732   

       comment_count  comments_disabled  ratings_disabled  err_removed  
          1291              False             False        False  
          1678              False             False        False  
          1971              False             False        False  
        241237              False             False        False  
           432              False             False        False  
...              ...                ...               ...          ...  
         2367              False             False        False  
         2391              False             False        False  
         2419              False             False        False  
         2436              False             False        False  
         2447              False             False        False  

[640 rows x 14 columns]

Now, i’m going to import categories from the JSON file, flatten, then convert into data frame

with open('C:/Users/bruce/Downloads/archive (1)/US_category_id.json','r') as f:
    ytube_cat = json.loads(f.read())
    
ytube_cat = (pd.json_normalize(ytube_cat, record_path = 'items')
                .loc[:,['id', 'snippet.title']]
                .rename(columns = {'id':'category_id', 'snippet.title':'category_title'})
            )

ytube_cat = pd.DataFrame(ytube_cat)

print(ytube_cat)

   category_id         category_title
          1       Film & Animation
          2       Autos & Vehicles
         10                  Music
         15         Pets & Animals
         17                 Sports
         18           Short Movies
         19        Travel & Events
         20                 Gaming
         21          Videoblogging
         22         People & Blogs
        23                 Comedy
        24          Entertainment
        25        News & Politics
        26          Howto & Style
        27              Education
        28   Science & Technology
        29  Nonprofits & Activism
        30                 Movies
        31        Anime/Animation
        32       Action/Adventure
        33               Classics
        34                 Comedy
        35            Documentary
        36                  Drama
        37                 Family
        38                Foreign
        39                 Horror
        40         Sci-Fi/Fantasy
        41               Thriller
        42                 Shorts
        43                  Shows
        44               Trailers

The merge I want to do to these dataframes isn’t working because the column’s data types do not align, so let’s see if we can change that…

ytube.dtypes

video_id                  object
trending_date             object
title                     object
channel_title             object
category_id                int64
publish_time              object
tags                      object
views                      int64
likes                      int64
dislikes                   int64
comment_count              int64
thumbnail_link            object
comments_disabled           bool
ratings_disabled            bool
video_error_or_removed      bool
description               object
dtype: object

Part 2

ytube_cat.dtypes

category_id       object
category_title    object
dtype: object

ytube_cat['category_id'] = ytube_cat['category_id'].astype('int64')

ytube_cat.dtypes

category_id        int64
category_title    object
dtype: object

I could keep the text based columns (description and tags) if I wanted to do a text analysis; I’ll explore that another time maybe…

# Trimming the fat

ytube = (pd.merge(ytube, ytube_cat)
           .rename(columns = {'video_error_or_removed':'err_removed'})
           .loc[:,['video_id', 'title', 'channel_title', 'category_id', 'category_title', 'publish_time', 'trending_date',
                  'views', 'likes', 'dislikes', 'comment_count', 'comments_disabled', 'ratings_disabled', 'err_removed']]
        )

print(ytube.iloc[0:5])

      video_id                                              title  \
NDBwsMIXlMk  Marvel’s Agents of S.H.I.E.L.D. | Season 5 Pre...   
NDBwsMIXlMk  Marvel’s Agents of S.H.I.E.L.D. | Season 5 Pre...   
NDBwsMIXlMk  Marvel’s Agents of S.H.I.E.L.D. | Season 5 Pre...   
6ZfuNTqbHE8  Marvel Studios' Avengers: Infinity War Officia...   
KXHrCBkIxQQ  ALL THE MONEY IN THE WORLD - Official Trailer ...   

                 channel_title  category_id category_title  \
       Marvel Entertainment           24  Entertainment   
       Marvel Entertainment           24  Entertainment   
       Marvel Entertainment           24  Entertainment   
       Marvel Entertainment           24  Entertainment   
Sony Pictures Entertainment           24  Entertainment   

         publish_time trending_date     views    likes  dislikes  \
2017-11-26 16:00:21    2017-11-27    248455     7174       200   
2017-11-26 16:00:21    2017-11-28    456193     9501       294   
2017-11-26 16:00:21    2017-11-29    537443    10577       341   
2017-11-29 13:26:24    2017-11-30  37736281  1735895     21969   
2017-11-29 20:00:53    2017-11-30    197900     2394       372   

   comment_count  comments_disabled  ratings_disabled  err_removed  
         1291              False             False        False  
         1678              False             False        False  
         1971              False             False        False  
       241237              False             False        False  
          432              False             False        False  

#Change date format for trending dates 

ytube['trending_date'] = pd.to_datetime(ytube['trending_date'], format='%y.%d.%m')
print(ytube['trending_date'])

     2017-11-14
     2017-11-14
     2017-11-14
     2017-11-14
     2017-11-14
           ...    
 2018-06-02
 2018-06-03
 2018-06-04
 2018-06-05
 2018-06-06
Name: trending_date, Length: 40949, dtype: datetime64[ns]

Now that everything is pretty much formatted and cleaned, i’m going to plot the only the necessary data.

# Specify the kind of plot st
plt.style.use('default')


# Convert 'publish_time' column to datetime
ytube['publish_time'] = (pd.to_datetime(ytube['publish_time'])
                           .dt.tz_localize(None)
                        )

# Filter out the ytube for the years 2017 and 2018
ytube = ytube[(ytube['publish_time'].dt.year >= 2017) & (ytube['publish_time'].dt.year <= 2018)]

# Group the ytube by 'category_title' and 'publish_date' (by year and month), then sum up the 'views'
ytube_grouped = ytube.groupby([ytube['category_title'], ytube['publish_time'].dt.to_period('M')])['views'].sum().reset_index()

# Pivot the ytube to have 'category_title' as columns and dates as index
ytube_pivoted = ytube_grouped.pivot(index='publish_time', columns='category_title', values='views')

# Plot the time series of each category
ax = ytube_pivoted.plot(kind='line', figsize=(15, 10), colormap = 'tab20')

plt.title('YouTube Views By Category (2017-2018)')
plt.xlabel('Publish Time')
plt.ylabel('Views')


# Change legend title: 
legend = ax.legend()
legend.set_title('Category Title')

plt.show()

# Group the ytube by 'category_title' and 'publish_date' (by year and month), then sum up the 'views'
ytube_grouped = ytube.groupby([ytube['channel_title'], ytube['trending_date'].dt.to_period('M')])['views'].sum().reset_index()

# Get top 10 channels by total views
top_channels = ytube.groupby('channel_title')['views'].sum().nlargest(10).index

# Filter the data to include only the top 10 channels
ytube = ytube[ytube['channel_title'].isin(top_channels)]

# Group the ytube by 'channel_title' and 'publish_date' (by year and month), then sum up the 'views'
ytube_grouped = ytube.groupby([ytube['channel_title'], ytube['publish_time'].dt.to_period('M')])['views'].sum().reset_index()

# Pivot the data to have 'channel_title' as columns and dates as index
ytube_pivoted = ytube_grouped.pivot(index='publish_time', columns='channel_title', values='views')

# Plot the time series of each channel
ax = ytube_pivoted.plot(kind='bar', figsize=(15, 10))

# Change legend title: 
legend = ax.legend()
legend.set_title('Channel Title')

plt.title('YouTube Views By Channel (Top 20 channels, 2017-2018)')
plt.xlabel('Publish Time')
plt.ylabel('Views')
plt.show()

# Group the ytube by 'category_title' and 'publish_date' (by year and month), then sum up the 'views'
ytube_grouped = (ytube.groupby([ytube['channel_title'], ytube['likes'], ytube['dislikes']])['views']
                     .sum()
                     .reset_index())

# Get top 20 channels by total views
top_channels = (ytube.groupby('channel_title')['views']
                    .sum()
                    .nlargest(20)
                    .index)

# Filter the data to include only the top 20 channels
ytube = ytube[ytube['channel_title'].isin(top_channels)]

# Group the data by 'channel_title' and 'publish_date' (by year and month), then sum up the 'views'
ytube_grouped = (ytube.groupby([ytube['channel_title'], ytube['publish_time']])['likes']
                      .sum()
                      .reset_index())

# Pivot the data to have 'channel_title' as columns and dates as index
ytube_pivoted = ytube_grouped.pivot(index='publish_time', columns='channel_title', values='likes')

# Create a scatter plot for each category
fig, ax = plt.subplots(figsize=(15, 10))

# Specify colormap
cmap = plt.get_cmap('tab20')  # Colormap with 20 different colors
colors = cmap(np.linspace(0, 1, len(ytube_pivoted.columns)))

for i, column in enumerate(ytube_pivoted):
    ax.scatter(ytube_pivoted.index, ytube_pivoted[column], label=column, color=colors[i])

    # Find the maximum value for each channel and label it
    max_val_index = ytube_pivoted[column].idxmax()
    max_val = ytube_pivoted.loc[max_val_index, column]

    ax.text(max_val_index, max_val, f'{max_val:.0f}', fontsize=8)

    
plt.title('YouTube Videos By Top 20 Artists, Date and Likes (2017-2018)')
plt.xlabel('Time Period')
plt.ylabel('Likes')


legend = ax.legend(frameon = False)
legend.set_title("Channel Title")

plt.show()

ETL using Rental Store Data? An excursion with SQL and Python

2023-07-19T00:00:00+00:00

Introduction

Hello! I made this script to demonstrate what an ETL process looks like using my local PostgreSQL database, Python, some SQL and a schema with sample data from a DVD rental store. I’d say this is a look into days gone by with what used to be the main form of media in the world.

Otherwise, this is still a work in progress, so anyone looking at this, expect this to see some more polish in the future regarding the code and visualizations. There’s also a bunch of code, so please bear with me and as always, thanks!

…

Setup

Import libaries

import psycopg2
import pandas as pd
import numpy as np
import matplotlib.pyplot as plt
import seaborn as sns
from sqlalchemy import create_engine

Establish a connection with the database

connection = psycopg2.connect(
    host="localhost",
    database="dvdrental",
    user="postgres",
    password="localhost"
)

Extracting the Data

Query the database using SQL and read into a Pandas dataframe:

query = "WITH rental_data as (
                SELECT concat(first_name, ' ', last_name) as name, 
                CASE WHEN active = 1 THEN 'Active' ELSE 'Inactive' END AS active, 
                email, address, city, country, phone, rental_date, return_date, 
                amount, rental_duration, rental_rate, replacement_cost, title as film_title, 
                release_year, length as length_mins, rating, name as language 
                    FROM rental as rent 
                        JOIN customer as cust on cust.customer_id = rent.customer_id 
                        JOIN inventory as items on items.inventory_id = rent.inventory_id 
                        JOIN film on film.film_id = items.film_id 
                        JOIN payment as pay on pay.rental_id = rent.rental_id 
                        JOIN address as addy on addy.address_id = cust.address_id 
                        JOIN city on city.city_id = addy.city_id 
                        JOIN country on country.country_id = city.country_id 
                        JOIN language on language.language_id = film.language_id
                        )              
        SELECT * 
        FROM rental_data 
        WHERE (active = 'Active' AND country = 'United States');"

# Call to turn raw SQL into a Pandas Dataframe         
df = pd.read_sql(query, connection)

…

Transforming

I’ll check for NAs and list the columns I’m working with for any inconsistencies

df.count()

Then, I’ll use a string replace call to make the domains something less lame..

# Replace email string 
df['email'] = df['email'].str.replace("sakilacustomer.org", "live.com")

Some exploratory calls:

Who rented R rated movies?

R_Renters = df[df['rating'].str.contains("R")]['name'].unique()
names_df = pd.DataFrame(R_Renters, columns=['name'])
print(names_df)

Which movie was most rented?

df['film_title'].value_counts()

…

Next, I want to format some of the columns numerically so that I can use that data to make some charts. So to start with, I’ll get the means of the columns of interest so that I can see what some of that data looks like.

# Means for numeric columns 
dfmeans = pd.DataFrame(df.loc[:,['length_mins', 'amount', 'rental_duration', 'rental_rate', 'replacement_cost']]
                         .mean()
                         )

dfmeans.columns =['means']

Now, I’m going to use group by, along with an agg (aggregation) call that mirrors the same functionality in R-dpylr’s summarise

# Summarise the above cell, but for the other columns in the dataset, and then assign it to an object 

summarized = df.groupby('name').agg(
    mean_length=('length_mins', 'mean'),
    mean_rental_duration=('rental_duration', 'mean'),
    mean_rental_rate=('rental_rate', 'mean'),
    replace_cost_mean=('replacement_cost', 'mean'),
    num_person_rented_film=('name', 'count'),
    sum_amount=('amount', 'sum')
).reset_index()

emails = df['email'].unique()
sorted_emails = np.sort(emails)
emails_df = pd.DataFrame(sorted_emails, columns=['email'])

Next, I’ll do a concat call to merge the names and emails with the numbers in the data so that we have people we can attribute the numbers to:

#Merge Data
summarized = pd.concat([summarized, emails_df], axis=1, ignore_index=True)

#Rename columns 
summarized = summarized[[0, 7, 1, 2, 3, 4, 5, 6]].rename(columns={
    0: 'name', 
    7: 'email', 
    1: 'mean_length', 
    2: 'mean_rental_duration', 
    3: 'mean_rental_rate', 
    4: 'replace_cost_mean', 
    5: 'num_person_rented_film', 
    6: 'sum_amount'
})

#Print and check for errors 
print(summarized.head)

…

Some Visuals

With the needed data summarized, I’m going to make a few plots to display what the data looks like based on some questions I had and previous observations.

Scatter Plot:

plt.scatter(summarized['mean_length'], summarized['mean_rental_duration'])
plt.title('Mean Length vs Mean Rental Duration')
plt.xlabel('Mean Length')
plt.ylabel('Mean Rental Duration')
plt.show()

Heatmap:

# Round numbers 
summarized.iloc[:, [2,3,4,5,6,7]] = summarized.iloc[:, [2,3,4,5,6,7]].round(1)

data = summarized[['mean_length', 'mean_rental_duration', 'mean_rental_rate', 
                  'replace_cost_mean', 'num_person_rented_film', 'sum_amount']]

# Enhanced Heatmap
plt.figure(figsize=(12, 10))
sns.heatmap(data.corr(), annot=True, cmap='coolwarm', fmt=".1f", 
            linewidths=0.5, linecolor='white', cbar_kws={"shrink": 0.75},
            annot_kws={"size": 12, "color": 'black'}, vmin=-1, vmax=1)

# Adjust the size of annotations for better readability
plt.xticks(fontsize=12)
plt.yticks(fontsize=12)
plt.title('Correlation Heatmap', fontsize=16)
plt.show()

Bar Chart:

top_10 = summarized.nlargest(10, 'sum_amount')
plt.bar(top_10['name'], top_10['sum_amount'])
plt.title('Top 10 Names based on Sum Amount')
plt.xlabel('Name')
plt.ylabel('Sum Amount')
plt.xticks(rotation=45)
plt.show()

Histogram:

plt.hist(summarized['mean_length'])
plt.title('Distribution of Mean Length')
plt.xlabel('Mean Length')
plt.ylabel('Frequency')
plt.show()

Box Plot:

summarized.boxplot(column='mean_length')
plt.title('Boxplot of Mean Length')
plt.show()

…

Loading…

Lastly, now that the visualizations are out of the way, I’m going to load the dataframes that I sourced from the original tables in my SQL database, back into that same database as different tables using the SQLAlchemy library.

Create a temporary table in PostgreSQL from the DataFrame:

engine = create_engine('postgresql+psycopg2://postgres:localhost@localhost:5432/dvdrental')

Create the tables in the dvdrental database using the existing dataframes with transformed data

df.to_sql('rental_data', engine, if_exists='replace', index = False)
summarized.to_sql('rental_temp', engine, if_exists='replace', index = False)

#Close connection: 
connection.close()

Outro

In short, that was ETL in a nutshell using Python! Thank you for reading.

HR Data Cleaning — A Python test script

2023-07-17T00:00:00+00:00

The following is a script I made to test features in Python, using a dataset I generated from a local PostgreSQL database.

import pandas as pd 
import numpy as np 
import matplotlib.pyplot as plt 
import seaborn as sns 

#itables for viewing data
from itables import init_notebook_mode
from itables import show

#Read data
hr_data = pd.read_csv('~/Documents/Projects/SQL/Generated Data/HR_employee_list_and_salaries.csv')
hr_data = pd.DataFrame(hr_data)

print(hr_data.iloc[0:5])

             Name Department                   Email Address  \
   Steven King  Executive     steven.king@sqltutorial.org   
   Lex De Haan  Executive     lex.de haan@sqltutorial.org   
 Neena Kochhar  Executive   neena.kochhar@sqltutorial.org   
  John Russell      Sales    john.russell@sqltutorial.org   
Karen Partners      Sales  karen.partners@sqltutorial.org   

                           Title  Salary  Min Salary  Max Salary   Hire Date  \
                    President  240000      200000      400000  2007-06-12   
Administration Vice President  170000      150000      300000  2013-01-08   
Administration Vice President  170000      150000      300000  2009-09-16   
                Sales Manager  140000      100000      200000  2016-09-26   
                Sales Manager  135000      100000      200000  2016-12-31   

      City ZIP Code State/Province                   Country  
Seattle    98199     Washington  United States of America  
Seattle    98199     Washington  United States of America  
Seattle    98199     Washington  United States of America  
 Oxford  OX9 9ZB         Oxford            United Kingdom  
 Oxford  OX9 9ZB         Oxford            United Kingdom  

# Testing Information and Summary functions.

## Information calls: 
### Shape
hr_data.shape

(33, 12)

# Index
hr_data.index

RangeIndex(start=0, stop=33, step=1)

# Columns
hr_data.columns

Index(['Name', 'Department', 'Email Address', 'Title', 'Salary', 'Min Salary',
       'Max Salary', 'Hire Date', 'City', 'ZIP Code', 'State/Province',
       'Country'],
      dtype='object')

# Info (seems to be similar to head in R)
hr_data.info

<bound method DataFrame.info of                  Name        Department                      Email Address  \
       Steven King         Executive        steven.king@sqltutorial.org   
       Lex De Haan         Executive        lex.de haan@sqltutorial.org   
     Neena Kochhar         Executive      neena.kochhar@sqltutorial.org   
      John Russell             Sales       john.russell@sqltutorial.org   
    Karen Partners             Sales     karen.partners@sqltutorial.org   
 Michael Hartstein         Marketing  michael.hartstein@sqltutorial.org   
   Nancy Greenberg           Finance    nancy.greenberg@sqltutorial.org   
   Shelley Higgins        Accounting    shelley.higgins@sqltutorial.org   
      Den Raphaely        Purchasing       den.raphaely@sqltutorial.org   
      Hermann Baer  Public Relations       hermann.baer@sqltutorial.org   
 Alexander Hunold                IT   alexander.hunold@sqltutorial.org   
    Daniel Faviet           Finance      daniel.faviet@sqltutorial.org   
  Jonathon Taylor             Sales    jonathon.taylor@sqltutorial.org   
  Jack Livingston             Sales    jack.livingston@sqltutorial.org   
    William Gietz        Accounting      william.gietz@sqltutorial.org   
        John Chen           Finance          john.chen@sqltutorial.org   
       Adam Fripp          Shipping         adam.fripp@sqltutorial.org   
    Matthew Weiss          Shipping      matthew.weiss@sqltutorial.org   
   Payam Kaufling          Shipping     payam.kaufling@sqltutorial.org   
Jose Manuel Urman           Finance  jose manuel.urman@sqltutorial.org   
   Ismael Sciarra           Finance     ismael.sciarra@sqltutorial.org   
  Kimberely Grant             Sales    kimberely.grant@sqltutorial.org   
        Luis Popp           Finance          luis.popp@sqltutorial.org   
     Susan Mavris   Human Resources       susan.mavris@sqltutorial.org   
   Shanta Vollman          Shipping     shanta.vollman@sqltutorial.org   
  Charles Johnson             Sales    charles.johnson@sqltutorial.org   
          Pat Fay         Marketing            pat.fay@sqltutorial.org   
      Bruce Ernst                IT        bruce.ernst@sqltutorial.org   
     David Austin                IT       david.austin@sqltutorial.org   
  Valli Pataballa                IT    valli.pataballa@sqltutorial.org   
  Jennifer Whalen    Administration    jennifer.whalen@sqltutorial.org   
    Diana Lorentz                IT      diana.lorentz@sqltutorial.org   
       Sarah Bell          Shipping         sarah.bell@sqltutorial.org   

                              Title  Salary  Min Salary  Max Salary  \
                       President  240000      200000      400000   
   Administration Vice President  170000      150000      300000   
   Administration Vice President  170000      150000      300000   
                   Sales Manager  140000      100000      200000   
                   Sales Manager  135000      100000      200000   
               Marketing Manager  130000       90000      150000   
                 Finance Manager  120000       82000      160000   
              Accounting Manager  120000       82000      160000   
              Purchasing Manager  110000       80000      150000   
 Public Relations Representative  100000       45000      105000   
                     Programmer   90000       40000      100000   
                     Accountant   90000       42000       90000   
           Sales Representative   86000       60000      120000   
           Sales Representative   84000       60000      120000   
              Public Accountant   83000       42000       90000   
                     Accountant   82000       42000       90000   
                  Stock Manager   82000       55000       85000   
                  Stock Manager   80000       55000       85000   
                  Stock Manager   79000       55000       85000   
                     Accountant   78000       42000       90000   
                     Accountant   77000       42000       90000   
           Sales Representative   70000       60000      120000   
                     Accountant   69000       42000       90000   
 Human Resources Representative   65000       40000       90000   
                  Stock Manager   65000       55000       85000   
           Sales Representative   62000       60000      120000   
       Marketing Representative   60000       40000       90000   
                     Programmer   60000       40000      100000   
                     Programmer   48000       40000      100000   
                     Programmer   48000       40000      100000   
       Administration Assistant   44000       30000       60000   
                     Programmer   42000       40000      100000   
                 Shipping Clerk   40000       25000       55000   

     Hire Date                 City ZIP Code State/Province  \
 2007-06-12              Seattle    98199     Washington   
 2013-01-08              Seattle    98199     Washington   
 2009-09-16              Seattle    98199     Washington   
 2016-09-26               Oxford  OX9 9ZB         Oxford   
 2016-12-31               Oxford  OX9 9ZB         Oxford   
 2016-02-12              Toronto  M5V 2L7        Ontario   
 2014-08-12              Seattle    98199     Washington   
 2014-06-02              Seattle    98199     Washington   
 2014-12-02              Seattle    98199     Washington   
 2014-06-02               Munich    80925        Bavaria   
2009-12-29            Southlake    26192          Texas   
2014-08-11              Seattle    98199     Washington   
2018-03-19               Oxford  OX9 9ZB         Oxford   
2018-04-18               Oxford  OX9 9ZB         Oxford   
2014-06-02              Seattle    98199     Washington   
2017-09-23              Seattle    98199     Washington   
2017-04-05  South San Francisco    99236     California   
2016-07-13  South San Francisco    99236     California   
2015-04-26  South San Francisco    99236     California   
2018-03-02              Seattle    98199     Washington   
2017-09-25              Seattle    98199     Washington   
2019-05-19               Oxford  OX9 9ZB         Oxford   
2019-12-02              Seattle    98199     Washington   
2014-06-02               London      NaN            NaN   
2017-10-05  South San Francisco    99236     California   
2019-12-30               Oxford  OX9 9ZB         Oxford   
2017-08-12              Toronto  M5V 2L7        Ontario   
2011-05-16            Southlake    26192          Texas   
2017-06-20            Southlake    26192          Texas   
2018-01-31            Southlake    26192          Texas   
2007-09-12              Seattle    98199     Washington   
2019-02-02            Southlake    26192          Texas   
2016-01-30  South San Francisco    99236     California   

                     Country  
 United States of America  
 United States of America  
 United States of America  
           United Kingdom  
           United Kingdom  
                   Canada  
 United States of America  
 United States of America  
 United States of America  
                  Germany  
United States of America  
United States of America  
          United Kingdom  
          United Kingdom  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
          United Kingdom  
United States of America  
          United Kingdom  
United States of America  
          United Kingdom  
                  Canada  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  >

# Count number of non-NA values
hr_data.count()

Name              33
Department        33
Email Address     33
Title             33
Salary            33
Min Salary        33
Max Salary        33
Hire Date         33
City              33
ZIP Code          32
State/Province    32
Country           33
dtype: int64

# Summary Statistics: 
## Sum
hr_data['Salary'].sum()

# Cumulative Sum

hr_data['Salary'].cumsum()

    240000
    410000
    580000
    720000
    855000
    985000
   1105000
   1225000
   1335000
   1435000
  1525000
  1615000
  1701000
  1785000
  1868000
  1950000
  2032000
  2112000
  2191000
  2269000
  2346000
  2416000
  2485000
  2550000
  2615000
  2677000
  2737000
  2797000
  2845000
  2893000
  2937000
  2979000
  3019000
Name: Salary, dtype: int64

# Describe

hr_data.describe

<bound method NDFrame.describe of                  Name        Department                      Email Address  \
       Steven King         Executive        steven.king@sqltutorial.org   
       Lex De Haan         Executive        lex.de haan@sqltutorial.org   
     Neena Kochhar         Executive      neena.kochhar@sqltutorial.org   
      John Russell             Sales       john.russell@sqltutorial.org   
    Karen Partners             Sales     karen.partners@sqltutorial.org   
 Michael Hartstein         Marketing  michael.hartstein@sqltutorial.org   
   Nancy Greenberg           Finance    nancy.greenberg@sqltutorial.org   
   Shelley Higgins        Accounting    shelley.higgins@sqltutorial.org   
      Den Raphaely        Purchasing       den.raphaely@sqltutorial.org   
      Hermann Baer  Public Relations       hermann.baer@sqltutorial.org   
 Alexander Hunold                IT   alexander.hunold@sqltutorial.org   
    Daniel Faviet           Finance      daniel.faviet@sqltutorial.org   
  Jonathon Taylor             Sales    jonathon.taylor@sqltutorial.org   
  Jack Livingston             Sales    jack.livingston@sqltutorial.org   
    William Gietz        Accounting      william.gietz@sqltutorial.org   
        John Chen           Finance          john.chen@sqltutorial.org   
       Adam Fripp          Shipping         adam.fripp@sqltutorial.org   
    Matthew Weiss          Shipping      matthew.weiss@sqltutorial.org   
   Payam Kaufling          Shipping     payam.kaufling@sqltutorial.org   
Jose Manuel Urman           Finance  jose manuel.urman@sqltutorial.org   
   Ismael Sciarra           Finance     ismael.sciarra@sqltutorial.org   
  Kimberely Grant             Sales    kimberely.grant@sqltutorial.org   
        Luis Popp           Finance          luis.popp@sqltutorial.org   
     Susan Mavris   Human Resources       susan.mavris@sqltutorial.org   
   Shanta Vollman          Shipping     shanta.vollman@sqltutorial.org   
  Charles Johnson             Sales    charles.johnson@sqltutorial.org   
          Pat Fay         Marketing            pat.fay@sqltutorial.org   
      Bruce Ernst                IT        bruce.ernst@sqltutorial.org   
     David Austin                IT       david.austin@sqltutorial.org   
  Valli Pataballa                IT    valli.pataballa@sqltutorial.org   
  Jennifer Whalen    Administration    jennifer.whalen@sqltutorial.org   
    Diana Lorentz                IT      diana.lorentz@sqltutorial.org   
       Sarah Bell          Shipping         sarah.bell@sqltutorial.org   

                              Title  Salary  Min Salary  Max Salary  \
                       President  240000      200000      400000   
   Administration Vice President  170000      150000      300000   
   Administration Vice President  170000      150000      300000   
                   Sales Manager  140000      100000      200000   
                   Sales Manager  135000      100000      200000   
               Marketing Manager  130000       90000      150000   
                 Finance Manager  120000       82000      160000   
              Accounting Manager  120000       82000      160000   
              Purchasing Manager  110000       80000      150000   
 Public Relations Representative  100000       45000      105000   
                     Programmer   90000       40000      100000   
                     Accountant   90000       42000       90000   
           Sales Representative   86000       60000      120000   
           Sales Representative   84000       60000      120000   
              Public Accountant   83000       42000       90000   
                     Accountant   82000       42000       90000   
                  Stock Manager   82000       55000       85000   
                  Stock Manager   80000       55000       85000   
                  Stock Manager   79000       55000       85000   
                     Accountant   78000       42000       90000   
                     Accountant   77000       42000       90000   
           Sales Representative   70000       60000      120000   
                     Accountant   69000       42000       90000   
 Human Resources Representative   65000       40000       90000   
                  Stock Manager   65000       55000       85000   
           Sales Representative   62000       60000      120000   
       Marketing Representative   60000       40000       90000   
                     Programmer   60000       40000      100000   
                     Programmer   48000       40000      100000   
                     Programmer   48000       40000      100000   
       Administration Assistant   44000       30000       60000   
                     Programmer   42000       40000      100000   
                 Shipping Clerk   40000       25000       55000   

     Hire Date                 City ZIP Code State/Province  \
 2007-06-12              Seattle    98199     Washington   
 2013-01-08              Seattle    98199     Washington   
 2009-09-16              Seattle    98199     Washington   
 2016-09-26               Oxford  OX9 9ZB         Oxford   
 2016-12-31               Oxford  OX9 9ZB         Oxford   
 2016-02-12              Toronto  M5V 2L7        Ontario   
 2014-08-12              Seattle    98199     Washington   
 2014-06-02              Seattle    98199     Washington   
 2014-12-02              Seattle    98199     Washington   
 2014-06-02               Munich    80925        Bavaria   
2009-12-29            Southlake    26192          Texas   
2014-08-11              Seattle    98199     Washington   
2018-03-19               Oxford  OX9 9ZB         Oxford   
2018-04-18               Oxford  OX9 9ZB         Oxford   
2014-06-02              Seattle    98199     Washington   
2017-09-23              Seattle    98199     Washington   
2017-04-05  South San Francisco    99236     California   
2016-07-13  South San Francisco    99236     California   
2015-04-26  South San Francisco    99236     California   
2018-03-02              Seattle    98199     Washington   
2017-09-25              Seattle    98199     Washington   
2019-05-19               Oxford  OX9 9ZB         Oxford   
2019-12-02              Seattle    98199     Washington   
2014-06-02               London      NaN            NaN   
2017-10-05  South San Francisco    99236     California   
2019-12-30               Oxford  OX9 9ZB         Oxford   
2017-08-12              Toronto  M5V 2L7        Ontario   
2011-05-16            Southlake    26192          Texas   
2017-06-20            Southlake    26192          Texas   
2018-01-31            Southlake    26192          Texas   
2007-09-12              Seattle    98199     Washington   
2019-02-02            Southlake    26192          Texas   
2016-01-30  South San Francisco    99236     California   

                     Country  
 United States of America  
 United States of America  
 United States of America  
           United Kingdom  
           United Kingdom  
                   Canada  
 United States of America  
 United States of America  
 United States of America  
                  Germany  
United States of America  
United States of America  
          United Kingdom  
          United Kingdom  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
          United Kingdom  
United States of America  
          United Kingdom  
United States of America  
          United Kingdom  
                  Canada  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  
United States of America  >

# Mean

hr_data['Salary'].mean()

91484.84848484848

hr_data['Salary'].median()

82000.0

# Testing data cleaning functions
## Drop na values and then recount for correctness

hr_data = hr_data.dropna()

hr_data.count()

Name              32
Department        32
Email Address     32
Title             32
Salary            32
Min Salary        32
Max Salary        32
Hire Date         32
City              32
ZIP Code          32
State/Province    32
Country           32
dtype: int64

# Print rows that have executives making over $100,000

hr_data[hr_data['Salary'] >= 100000 ]

	Name	Department	Email Address	Title	Salary	Min Salary	Max Salary	Hire Date	City	ZIP Code	State/Province	Country
0	Steven King	Executive	steven.king@sqltutorial.org	President	240000	200000	400000	2007-06-12	Seattle	98199	Washington	United States of America
1	Lex De Haan	Executive	lex.de haan@sqltutorial.org	Administration Vice President	170000	150000	300000	2013-01-08	Seattle	98199	Washington	United States of America
2	Neena Kochhar	Executive	neena.kochhar@sqltutorial.org	Administration Vice President	170000	150000	300000	2009-09-16	Seattle	98199	Washington	United States of America
3	John Russell	Sales	john.russell@sqltutorial.org	Sales Manager	140000	100000	200000	2016-09-26	Oxford	OX9 9ZB	Oxford	United Kingdom
4	Karen Partners	Sales	karen.partners@sqltutorial.org	Sales Manager	135000	100000	200000	2016-12-31	Oxford	OX9 9ZB	Oxford	United Kingdom
5	Michael Hartstein	Marketing	michael.hartstein@sqltutorial.org	Marketing Manager	130000	90000	150000	2016-02-12	Toronto	M5V 2L7	Ontario	Canada
6	Nancy Greenberg	Finance	nancy.greenberg@sqltutorial.org	Finance Manager	120000	82000	160000	2014-08-12	Seattle	98199	Washington	United States of America
7	Shelley Higgins	Accounting	shelley.higgins@sqltutorial.org	Accounting Manager	120000	82000	160000	2014-06-02	Seattle	98199	Washington	United States of America
8	Den Raphaely	Purchasing	den.raphaely@sqltutorial.org	Purchasing Manager	110000	80000	150000	2014-12-02	Seattle	98199	Washington	United States of America
9	Hermann Baer	Public Relations	hermann.baer@sqltutorial.org	Public Relations Representative	100000	45000	105000	2014-06-02	Munich	80925	Bavaria	Germany

# String replace within a column 

hr_data['Email Address'] = hr_data['Email Address'].str.replace("sqltutorial.org", "repugs.edu")

print(hr_data['Email Address'])

         steven.king@repugs.edu
         lex.de haan@repugs.edu
       neena.kochhar@repugs.edu
        john.russell@repugs.edu
      karen.partners@repugs.edu
   michael.hartstein@repugs.edu
     nancy.greenberg@repugs.edu
     shelley.higgins@repugs.edu
        den.raphaely@repugs.edu
        hermann.baer@repugs.edu
   alexander.hunold@repugs.edu
      daniel.faviet@repugs.edu
    jonathon.taylor@repugs.edu
    jack.livingston@repugs.edu
      william.gietz@repugs.edu
          john.chen@repugs.edu
         adam.fripp@repugs.edu
      matthew.weiss@repugs.edu
     payam.kaufling@repugs.edu
  jose manuel.urman@repugs.edu
     ismael.sciarra@repugs.edu
    kimberely.grant@repugs.edu
          luis.popp@repugs.edu
     shanta.vollman@repugs.edu
    charles.johnson@repugs.edu
            pat.fay@repugs.edu
        bruce.ernst@repugs.edu
       david.austin@repugs.edu
    valli.pataballa@repugs.edu
    jennifer.whalen@repugs.edu
      diana.lorentz@repugs.edu
         sarah.bell@repugs.edu
Name: Email Address, dtype: object


C:\Users\bruce\AppData\Local\Temp\ipykernel_22892&#8291;3629824364.py:3: SettingWithCopyWarning: 
A value is trying to be set on a copy of a slice from a DataFrame.
Try using .loc[row_indexer,col_indexer] = value instead

See the caveats in the documentation: https://pandas.pydata.org/pandas-docs/stable/user_guide/indexing.html#returning-a-view-versus-a-copy
  hr_data['Email Address'] = hr_data['Email Address'].str.replace("sqltutorial.org", "repugs.edu")

print(hr_data.iloc[0:1])

          Name Department           Email Address      Title  Salary  \
0  Steven King  Executive  steven.king@repugs.edu  President  240000   

   Min Salary  Max Salary   Hire Date     City ZIP Code State/Province  \
0      200000      400000  2007-06-12  Seattle    98199     Washington   

                    Country  
0  United States of America  

# Query 
hr_data.query('Salary > 100000')

	Name	Department	Email Address	Title	Salary	Min Salary	Max Salary	Hire Date	City	ZIP Code	State/Province	Country
0	Steven King	Executive	steven.king@repugs.edu	President	240000	200000	400000	2007-06-12	Seattle	98199	Washington	United States of America
1	Lex De Haan	Executive	lex.de haan@repugs.edu	Administration Vice President	170000	150000	300000	2013-01-08	Seattle	98199	Washington	United States of America
2	Neena Kochhar	Executive	neena.kochhar@repugs.edu	Administration Vice President	170000	150000	300000	2009-09-16	Seattle	98199	Washington	United States of America
3	John Russell	Sales	john.russell@repugs.edu	Sales Manager	140000	100000	200000	2016-09-26	Oxford	OX9 9ZB	Oxford	United Kingdom
4	Karen Partners	Sales	karen.partners@repugs.edu	Sales Manager	135000	100000	200000	2016-12-31	Oxford	OX9 9ZB	Oxford	United Kingdom
5	Michael Hartstein	Marketing	michael.hartstein@repugs.edu	Marketing Manager	130000	90000	150000	2016-02-12	Toronto	M5V 2L7	Ontario	Canada
6	Nancy Greenberg	Finance	nancy.greenberg@repugs.edu	Finance Manager	120000	82000	160000	2014-08-12	Seattle	98199	Washington	United States of America
7	Shelley Higgins	Accounting	shelley.higgins@repugs.edu	Accounting Manager	120000	82000	160000	2014-06-02	Seattle	98199	Washington	United States of America
8	Den Raphaely	Purchasing	den.raphaely@repugs.edu	Purchasing Manager	110000	80000	150000	2014-12-02	Seattle	98199	Washington	United States of America

# String matching and query 
hr_data[hr_data['Title'].str.contains("President|Manager")]
hr_data.query('Salary > 100000')
    

	Name	Department	Email Address	Title	Salary	Min Salary	Max Salary	Hire Date	City	ZIP Code	State/Province	Country
0	Steven King	Executive	steven.king@repugs.edu	President	240000	200000	400000	2007-06-12	Seattle	98199	Washington	United States of America
1	Lex De Haan	Executive	lex.de haan@repugs.edu	Administration Vice President	170000	150000	300000	2013-01-08	Seattle	98199	Washington	United States of America
2	Neena Kochhar	Executive	neena.kochhar@repugs.edu	Administration Vice President	170000	150000	300000	2009-09-16	Seattle	98199	Washington	United States of America
3	John Russell	Sales	john.russell@repugs.edu	Sales Manager	140000	100000	200000	2016-09-26	Oxford	OX9 9ZB	Oxford	United Kingdom
4	Karen Partners	Sales	karen.partners@repugs.edu	Sales Manager	135000	100000	200000	2016-12-31	Oxford	OX9 9ZB	Oxford	United Kingdom
5	Michael Hartstein	Marketing	michael.hartstein@repugs.edu	Marketing Manager	130000	90000	150000	2016-02-12	Toronto	M5V 2L7	Ontario	Canada
6	Nancy Greenberg	Finance	nancy.greenberg@repugs.edu	Finance Manager	120000	82000	160000	2014-08-12	Seattle	98199	Washington	United States of America
7	Shelley Higgins	Accounting	shelley.higgins@repugs.edu	Accounting Manager	120000	82000	160000	2014-06-02	Seattle	98199	Washington	United States of America
8	Den Raphaely	Purchasing	den.raphaely@repugs.edu	Purchasing Manager	110000	80000	150000	2014-12-02	Seattle	98199	Washington	United States of America

# I'm telling Python to print column names and list their type, every column in this particular dataset is an object 
print("<{}>".format(hr_data.columns))

# When I run this particular line, Python is telling me which columns are of a particular type
hr_data.dtypes

<Index(['Name', 'Department', 'Email Address', 'Title', 'Salary', 'Min Salary',
       'Max Salary', 'Hire Date', 'City', 'ZIP Code', 'State/Province',
       'Country'],
      dtype='object')>





Name              object
Department        object
Email Address     object
Title             object
Salary             int64
Min Salary         int64
Max Salary         int64
Hire Date         object
City              object
ZIP Code          object
State/Province    object
Country           object
dtype: object

# X axis automatically defaults to count, which is something I wish R did on its own! 

hr_data.plot(kind = 'line', 
             alpha = .5, 
             rot = 45)

<Axes: >

Characteristics of STARs in Florida

2023-06-05T00:00:00+00:00

STARs are workers who are “Skilled Through Alternative Routes”. This population of the workforce comprises of working aged adults who have not attained anything educationally past a High School Diploma, yet, have demonstrated the ability to hone their skill to a competitive edge in the labor market.

Usually, STARs go through military service, community college, training programs, partial college completion, or, most commonly, on-the-job experience. STARs can be found in every sector of the workforce, from retail, travel, and hospitality to health care, information technology, manufacturing, and more. (source: https://www.tearthepaperceiling.org/about-stars)

For the purposes of this analysis, I will only be focusing on STAR presence in the state of Florida.

Setup

#Load libraries

library(tidyverse)
library(ggrepel)
library(scales)
library(knitr)
library(kableExtra)
options(scipen=999)

#Read data
workersdata <- read.csv("C:/Users/bruce/Downloads/Florida Workers - Florida Workers.csv")

Firsly, I’m loading R and using the data set I was provided. For context, this was a dataset of STAR data given to me by an organziation I was in the application and interview process for.

Cleaning

#Exploring data
summary(workersdata)

##     statefip      metro          met2013          perwt             sex             age             race           hispan      
##  Min.   :12   Min.   :0.000   Min.   :    0   Min.   :0.0020   Min.   :1.000   Min.   :25.00   Min.   :1.000   Min.   :0.0000  
##  1st Qu.:12   1st Qu.:3.000   1st Qu.:29460   1st Qu.:0.0540   1st Qu.:1.000   1st Qu.:37.00   1st Qu.:1.000   1st Qu.:0.0000  
##  Median :12   Median :4.000   Median :33100   Median :0.0820   Median :1.000   Median :48.00   Median :1.000   Median :0.0000  
##  Mean   :12   Mean   :3.298   Mean   :31768   Mean   :0.1117   Mean   :1.481   Mean   :47.85   Mean   :2.946   Mean   :0.7616  
##  3rd Qu.:12   3rd Qu.:4.000   3rd Qu.:37340   3rd Qu.:0.1360   3rd Qu.:2.000   3rd Qu.:58.00   3rd Qu.:6.000   3rd Qu.:1.0000  
##  Max.   :12   Max.   :4.000   Max.   :45300   Max.   :1.7600   Max.   :2.000   Max.   :94.00   Max.   :9.000   Max.   :4.0000  
##      educd           empstat       classwkrd         occ            ind          wkswork1        uhrswork       incearn      
##  Min.   :  2.00   Min.   :1.00   Min.   : 0.0   Min.   :  10   Min.   : 170   Min.   : 0.00   Min.   : 0.0   Min.   : -8500  
##  1st Qu.: 63.00   1st Qu.:1.00   1st Qu.:22.0   1st Qu.:1555   1st Qu.:5275   1st Qu.:52.00   1st Qu.:38.0   1st Qu.: 22000  
##  Median : 81.00   Median :1.00   Median :22.0   Median :4020   Median :7380   Median :52.00   Median :40.0   Median : 40000  
##  Mean   : 81.73   Mean   :1.05   Mean   :21.4   Mean   :3883   Mean   :6530   Mean   :46.21   Mean   :38.6   Mean   : 59927  
##  3rd Qu.:101.00   3rd Qu.:1.00   3rd Qu.:22.0   3rd Qu.:5330   3rd Qu.:8191   3rd Qu.:52.00   3rd Qu.:40.0   3rd Qu.: 70000  
##  Max.   :116.00   Max.   :2.00   Max.   :29.0   Max.   :9920   Max.   :9920   Max.   :52.00   Max.   :99.0   Max.   :826000  
##   occ_label          ind_label        
##  Length:83763       Length:83763      
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
## 

head(workersdata)

##   statefip metro met2013 perwt sex age race hispan educd empstat classwkrd  occ  ind wkswork1 uhrswork incearn
## 1       12     2   27260 0.097   2  26    1      0    63       1        25 3645 9690       52       40   34500
## 2       12     4   36740 0.016   1  33    1      0    71       1        22 4251 7770       52       30   15000
## 3       12     4       0 0.140   1  30    1      0    30       1        22 6260  770       52       40   20800
## 4       12     3   45300 0.092   1  37    8      1     2       1        22 6050  290       52        8   18000
## 5       12     2   27260 0.030   1  35    2      0    65       1        22 9620 7580       26       30   10400
## 6       12     3   45300 0.017   1  51    1      0    63       2         0 9920 9920        0        0       0
##                                                occ_label
## 1                                     Medical assistants
## 2                 Landscaping and groundskeeping workers
## 3                                  Construction laborers
## 4                             Other agricultural workers
## 5 Laborers and freight, stock, and material movers, hand
## 6                                                       
##                                                                                                                     ind_label
## 1                                                                                                                  U. S. Navy
## 2                                                                                                        Landscaping services
## 3 Construction (the cleaning of buildings and dwellings is incidental during construction and immediately after construction)
## 4                                                                             Support activities for agriculture and forestry
## 5                                                                                                         Employment services
## 6                                                              Unemployed, last worked 5 years ago or earlier or never worked

str(workersdata)

## 'data.frame':    83763 obs. of  18 variables:
##  $ statefip : int  12 12 12 12 12 12 12 12 12 12 ...
##  $ metro    : int  2 4 4 3 2 3 3 4 4 2 ...
##  $ met2013  : int  27260 36740 0 45300 27260 45300 33100 23540 0 33100 ...
##  $ perwt    : num  0.097 0.016 0.14 0.092 0.03 ...
##  $ sex      : int  2 1 1 1 1 1 1 1 1 1 ...
##  $ age      : int  26 33 30 37 35 51 25 37 34 62 ...
##  $ race     : int  1 1 1 8 2 1 1 8 1 1 ...
##  $ hispan   : int  0 0 0 1 0 0 0 2 0 1 ...
##  $ educd    : int  63 71 30 2 65 63 64 71 101 81 ...
##  $ empstat  : int  1 1 1 1 1 2 1 2 1 2 ...
##  $ classwkrd: int  25 22 22 22 22 0 25 0 25 0 ...
##  $ occ      : int  3645 4251 6260 6050 9620 9920 7340 9920 9030 9920 ...
##  $ ind      : int  9690 7770 770 290 7580 9920 9680 9920 9670 9920 ...
##  $ wkswork1 : int  52 52 52 52 26 0 52 0 52 0 ...
##  $ uhrswork : int  40 30 40 8 30 0 40 0 40 0 ...
##  $ incearn  : int  34500 15000 20800 18000 10400 0 28500 0 33000 0 ...
##  $ occ_label: chr  "Medical assistants" "Landscaping and groundskeeping workers" "Construction laborers" "Other agricultural workers" ...
##  $ ind_label: chr  "U. S. Navy" "Landscaping services" "Construction (the cleaning of buildings and dwellings is incidental during construction and immediately after construction)" "Support activities for agriculture and forestry" ...

##It made sense to do at the time
workersdata[,1] <- "Florida"

##Add ID column to aid with grouping, do prelim resort 
workersdata$id <- rownames(workersdata)
workersdata <- workersdata[,c(19, 1:18)]

##Prelim check totals
sum(workersdata$metro == '0')

## [1] 4263

sum(workersdata$metro == '1')

## [1] 310

sum(workersdata$metro == '2')

## [1] 4600

sum(workersdata$metro == '3')

## [1] 31579

sum(workersdata$metro == '4')

## [1] 43011

Here I’m going to start on cleaning everything up. There was a codebook that accompanied the data that outlined everything that I needed to do to make the columns readable by people. Next, I’m going to recode all the columns.

#Recode Variables

##Metropolitan Status
workersdata$metro [workersdata$metro  == "0"] <- "Metropolitan Status Indeterminable (mixed)"
workersdata$metro [workersdata$metro  == "1"] <- "Not in metropolitan area"
workersdata$metro [workersdata$metro  == "2"] <- "In Principal city"
workersdata$metro [workersdata$metro  == "3"] <- "Not in Principal city"
workersdata$metro [workersdata$metro  == "4"] <- "Principal city Status Indeterminable (mixed)"

##Current Metro Area
workersdata$met2013 [workersdata$met2013  == "0"] <- NA
workersdata$met2013 [workersdata$met2013  == "00000"] <- "Not in identifiable area"
workersdata$met2013 [workersdata$met2013  == "15980"] <- "Cape Coral-Fort Myers"
workersdata$met2013 [workersdata$met2013  == "19660"] <- "Deltona-Daytona Beach-Ormond Beach"
workersdata$met2013 [workersdata$met2013  == "23540"] <- "Gainesville"
workersdata$met2013 [workersdata$met2013  == "26140"] <- "Homosassa Springs"
workersdata$met2013 [workersdata$met2013  == "27260"] <- "Jacksonville"
workersdata$met2013 [workersdata$met2013  == "29460"] <- "Lakeland-Winter Haven"
workersdata$met2013 [workersdata$met2013  == "33100"] <- "Miami-Fort Lauderdale-West Palm Beach"
workersdata$met2013 [workersdata$met2013  == "34940"] <- "Naples-Immokalee-Marco Island"
workersdata$met2013 [workersdata$met2013  == "35840"] <- "North Port-Sarasota-Bradenton"
workersdata$met2013 [workersdata$met2013  == "36100"] <- "Ocala"
workersdata$met2013 [workersdata$met2013  == "36740"] <- "Orlando-Kissimmee-Sanford"
workersdata$met2013 [workersdata$met2013  == "37340"] <- "Palm Bay-Melbourne-Titusville"
workersdata$met2013 [workersdata$met2013  == "37460"] <- "Panama City"
workersdata$met2013 [workersdata$met2013  == "37860"] <- "Pensacola-Ferry Pass-Brent"
workersdata$met2013 [workersdata$met2013  == "38940"] <- "Port St. Lucie"
workersdata$met2013 [workersdata$met2013  == "39460"] <- "Punta Gorda"
workersdata$met2013 [workersdata$met2013  == "42680"] <- "Sebastian-Vero Beach"
workersdata$met2013 [workersdata$met2013  == "45300"] <- "Tampa-St. Petersburg-Clearwater"

###Double check
unique(workersdata$met2013)

##  [1] "Jacksonville"                          "Orlando-Kissimmee-Sanford"             NA                                     
##  [4] "Tampa-St. Petersburg-Clearwater"       "Miami-Fort Lauderdale-West Palm Beach" "Gainesville"                          
##  [7] "Naples-Immokalee-Marco Island"         "Sebastian-Vero Beach"                  "Deltona-Daytona Beach-Ormond Beach"   
## [10] "North Port-Sarasota-Bradenton"         "Pensacola-Ferry Pass-Brent"            "Lakeland-Winter Haven"                
## [13] "Cape Coral-Fort Myers"                 "Port St. Lucie"                        "Ocala"                                
## [16] "Homosassa Springs"                     "Punta Gorda"                           "Palm Bay-Melbourne-Titusville"

##Sex
workersdata$sex [workersdata$sex  == "1"] <- "Male"
workersdata$sex [workersdata$sex  == "2"] <- "Female"

##Race
workersdata$race [workersdata$race  == "1"] <- "White"
workersdata$race [workersdata$race  == "2"] <- "Black/African American"
workersdata$race [workersdata$race  == "3"] <- "American Indian or Alaska Native"
workersdata$race [workersdata$race  == "4"] <- "Chinese"
workersdata$race [workersdata$race  == "5"] <- "Japanese"
workersdata$race [workersdata$race  == "6"] <- "Other Asian or Pacific Islander"
workersdata$race [workersdata$race  == "7"] <- "Other race, nec"
workersdata$race [workersdata$race  == "8"] <- "Two major races"
workersdata$race [workersdata$race  == "9"] <- "Three or more major races"

##Hispanic Ethnicity? 
workersdata$hispan [workersdata$hispan  == "0"] <- "Not Hispanic"
workersdata$hispan [workersdata$hispan  == "1"] <- "Mexican"
workersdata$hispan [workersdata$hispan  == "2"] <- "Puerto Rican"
workersdata$hispan [workersdata$hispan  == "3"] <- "Cuban"
workersdata$hispan [workersdata$hispan  == "4"] <- "Other"
workersdata$hispan [workersdata$hispan  == "9"] <- "Not Reported"

##Employed or Unemployed? 
workersdata$empstat [workersdata$empstat  == "1"] <- "Employed"
workersdata$empstat [workersdata$empstat  == "2"] <- "Unemployed"

##Class of Worker
workersdata$classwkrd [workersdata$classwkrd  == "0"] <- NA
workersdata$classwkrd [workersdata$classwkrd  == "13"] <- "Self-employed, not incorporated"
workersdata$classwkrd [workersdata$classwkrd  == "14"] <- "Self-employed, incorporated"
workersdata$classwkrd [workersdata$classwkrd  == "22"] <- "Wage/salary, private"
workersdata$classwkrd [workersdata$classwkrd  == "23"] <- "Wage/salary at non-profit"
workersdata$classwkrd [workersdata$classwkrd  == "25"] <- "Federal govt employee"
workersdata$classwkrd [workersdata$classwkrd  == "27"] <- "State govt employee"
workersdata$classwkrd [workersdata$classwkrd  == "28"] <- "Local govt employee"
workersdata$classwkrd [workersdata$classwkrd  == "29"] <- "Unpaid family worker"

This long stretch of code here is recoding all the variables as I’ve mentioned while checking for uniqueness, this is going to form the foundation of what we can use to conduct our analysis later.

#Are the workers noted in the data as STARs? 
workersdata <- workersdata %>% mutate(STAR = case_when(educd %in% c(63:81) ~ 1, T ~ 0))
workersdata$STAR [workersdata$STAR == "0"] <- "No"
workersdata$STAR [workersdata$STAR == "1"] <- "Yes"

#Check total weight numbers
total_weight <- workersdata %>% summarise(total = sum(perwt))
total_weight <- as.numeric(total_weight)

#Group rows by "id", then sum each weight and then multiply by 1000 to get the actual weight and person counts
workersdata <- workersdata %>% group_by(id) %>% mutate(person_weights = sum(perwt) * 1000)

#The sum comes out to the total_weight * 1000
total_weight

## [1] 9357.016

sum(workersdata$person_weights)

## [1] 9357016

#Verify totals for STARs/Non-STARs 
totals <- workersdata %>% group_by(STAR) %>% summarise(pop_sum = sum(person_weights))

#Keep the original educd column for grouping purposes
workersdata$educd_id <- workersdata$educd

In our next cleaning steps, we’re asking if we can have the data tell us if each worker is a “STAR” or not. Remember, for each worker, for them to be a STAR, they’ll need to be working age adults without any higher education than a high school diploma.

We’re then going to apply the proper weights to make the data representative of the actual population numbers. I then check each total to make sure that the number I have matches the total population number I was given from the organization. In this case, the total STAR population in Florida is 4,202,823 workers, with 5,154,193 non-STAR workers.

##Recode Educational Attainment, keep the original column as the educd_id 

workersdata$educd [workersdata$educd  == "2"] <- "No schooling completed"
workersdata$educd [workersdata$educd  == "11"] <- "Nursery school, preschool"
workersdata$educd [workersdata$educd  == "12"] <- "Kindergarten"
workersdata$educd [workersdata$educd  == "14"] <- "Grade 1"
workersdata$educd [workersdata$educd  == "15"] <- "Grade 2"
workersdata$educd [workersdata$educd  == "16"] <- "Grade 3"
workersdata$educd [workersdata$educd  == "17"] <- "Grade 4"
workersdata$educd [workersdata$educd  == "22"] <- "Grade 5"
workersdata$educd [workersdata$educd  == "23"] <- "Grade 6"
workersdata$educd [workersdata$educd  == "25"] <- "Grade 7"
workersdata$educd [workersdata$educd  == "26"] <- "Grade 8"
workersdata$educd [workersdata$educd  == "30"] <- "Grade 9"
workersdata$educd [workersdata$educd  == "40"] <- "Grade 10"
workersdata$educd [workersdata$educd  == "50"] <- "Grade 11"
workersdata$educd [workersdata$educd  == "60"] <- "Grade 12"
workersdata$educd [workersdata$educd  == "61"] <- "12th grade, no diploma"
workersdata$educd [workersdata$educd  == "63"] <- "High School Diploma"
workersdata$educd [workersdata$educd  == "64"] <- "GED or alternative credential"
workersdata$educd [workersdata$educd  == "65"] <- "Some college, but less than 1 year"
workersdata$educd [workersdata$educd  == "71"] <- "1 or more years of college credit, no degree"
workersdata$educd [workersdata$educd  == "81"] <- "Associate's degree, type not specified"
workersdata$educd [workersdata$educd  == "101"] <- "Bachelor's degree"
workersdata$educd [workersdata$educd  == "114"] <- "Master's degree"
workersdata$educd [workersdata$educd  == "115"] <- "Professional degree beyond a bachelor's degree"
workersdata$educd [workersdata$educd  == "116"] <- "Doctoral degree"

For this round of recoding, I’m making the education labels for use with our reference tables later.

###Check Ed. attainment totals by region

edmakeup <- workersdata %>% group_by(met2013) %>% filter(educd_id %in% c(63:81)) %>%  count()

#rename a few more columns
workersdata <- workersdata %>% rename(location = met2013)
workersdata <- workersdata %>% rename(education = educd)
workersdata <- workersdata %>% rename(occupation = occ_label)
workersdata <- workersdata %>% rename(industry = ind_label)

###Reorder and oust redundant columns 

workersdata <- workersdata %>% select(1:4, 6, 8, 9, 5, 7, 22, 20, 10:12, 15:19, 21)

For the first function in this chunk, I wanted R to give me a count of educational attainment by region. I then renamed a few columns and reordered everything for balance.

#Calculate hourly wage 
workersdata <- workersdata %>% rowwise %>% 
  mutate(yearlyhours = wkswork1 * uhrswork) %>% 
  mutate(hourly_wage = incearn / yearlyhours)

workersdata$hourly_wage <- round(workersdata$hourly_wage, 2)
workersdata$hourly_wage[is.na(workersdata$hourly_wage)] <- 0

Calculating the Hourly Wage will make for a good reference point when comparing each occupation for potential growth and outlook.

#What percentage of all workers in Florida are STARs? — 55.08% 

##Total Population
pop_sum <- sum(workersdata$person_weights)

##Total STAR Population
pop_STAR <- sum(workersdata$person_weights [workersdata$STAR == "Yes"])

##Total Non-STAR Population
pop_nonSTAR <- sum(workersdata$person_weights [workersdata$STAR == "No"])

###How I found the answer above 
paste0(round(100*pop_STAR/pop_sum, 2), '%')

## [1] "55.08%"

The above is self-explanitory.

Plots

## Florida STAR Worker Breakdown by Race 

#Table data
fig1 <- workersdata %>%
  filter(STAR == "Yes") %>% 
  group_by(race) %>% 
  summarise(total = sum(person_weights)) %>% 
  bind_rows(summarise(.,
                      across(where(is.numeric), sum),
                      across(where(is.character), ~"Total"))) %>% tibble() 

print(fig1)

## # A tibble: 10 × 2
##    race                                total
##    <chr>                               <dbl>
##  1 American Indian or Alaska Native   14014.
##  2 Black/African American            877067.
##  3 Chinese                            12665.
##  4 Japanese                            3334.
##  5 Other Asian or Pacific Islander    85026.
##  6 Other race, nec                   356840.
##  7 Three or more major races          36879.
##  8 Two major races                   990288.
##  9 White                            2778080.
## 10 Total                            5154193.

#Save table as image
fig1 %>%
  kable() %>% 
  kable_material(c("striped", "hover")) %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", font_size = 4)) %>%
  save_kable(file = "fig1.png")


#Plot
workersdata %>% 
  group_by(race) %>% 
  filter(STAR == "Yes") %>% 
  tally(person_weights) %>%          
  mutate(pct = n / sum(n), label = paste0(round(pct*100, 2), '%')) %>% 
  ggplot(., aes(x = pct, y = race, fill = race)) +
  geom_text(aes(label = label),
            position = position_stack(vjust = 1),
            size = 3) +
  geom_col(alpha = .35) +
  labs(title = "How do Florida STARs vary by race?", 
       subtitle = "Breakdown by Percentage", x = "Percentage", y = "") +
  theme_bw() +
  theme(legend.position = "none") +
  scale_x_continuous(labels = scales::percent) 

To further contextualize what I found here: 55.08% of all workers in Florida are STARs, this comes to 5154193 people.

White workers have the most presence among STARs at 53%, “two major races” came in at 19.21%, “three or more major races” reported .72%, other races are at 6.92%, while Asian/Pacific Islanders show 1.65%. The races/ethnicities reporting the least are American Indian/Alaskan Natives at .27%, Chinese at .25%, while Japanese workers have the least presence at .06%.

## Florida STAR Worker Breakdown by Location 

#Table Data
fig2 <- workersdata %>%
  filter(STAR == "Yes") %>% 
  group_by(location) %>% 
  summarise(total = sum(person_weights)) %>% 
  bind_rows(summarise(.,
                      across(where(is.numeric), sum),
                      across(where(is.character), ~"Total"))) %>% tibble() 

print(fig2)

## # A tibble: 19 × 2
##    location                                 total
##    <chr>                                    <dbl>
##  1 Cape Coral-Fort Myers                  187424.
##  2 Deltona-Daytona Beach-Ormond Beach     165086.
##  3 Gainesville                             48615.
##  4 Homosassa Springs                       31813.
##  5 Jacksonville                           385529.
##  6 Lakeland-Winter Haven                  195377.
##  7 Miami-Fort Lauderdale-West Palm Beach 1457097.
##  8 Naples-Immokalee-Marco Island           75930.
##  9 North Port-Sarasota-Bradenton          196109.
## 10 Ocala                                   92208.
## 11 Orlando-Kissimmee-Sanford              656404.
## 12 Palm Bay-Melbourne-Titusville          152315.
## 13 Pensacola-Ferry Pass-Brent             125903.
## 14 Port St. Lucie                         120012.
## 15 Punta Gorda                             43676.
## 16 Sebastian-Vero Beach                    31843.
## 17 Tampa-St. Petersburg-Clearwater        766244.
## 18 <NA>                                   422608.
## 19 Total                                 5154193.

fig2 %>%
  kable() %>% 
  kable_material(c("striped", "hover")) %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", font_size = 4)) %>%
  save_kable(file = "fig2.png")

#Plot 
workersdata %>% 
group_by(location, race, person_weights) %>% 
  filter(STAR == "Yes") %>% 
  summarise(pop_sum = sum(person_weights), label = round(pop_sum, 2)) %>% 
ggplot(aes(x = pop_sum, y = location, fill = race)) +
  geom_col(alpha = .5) +
  labs(title = "Where do STARs mostly reside in Florida?", 
       subtitle = "Breakdown by Metropolitan Area", x = "n", y = "", fill = "Race") +
  theme_bw() +
  theme(legend.position = "bottom")

## `summarise()` has grouped output by 'location', 'race'. You can override using the `.groups` argument.

Notably, the Miami/Ft. Lauderdale/West Palm Beach metropolitan area has the most STARs at 1,457,087 workers, whereas Homosassa Springs has the least at 31813. The plots I generate later show more nuanced information, but understandably, the most diverse cultural centers in Florida have the highest concentration of STARs.

The Broward/Dade County metropolitian area has the highest concentration of immigrant workers and workers who are People of Color generally, with Hillsborogh/Pinellas, Duval and Orange/Seminole/Osceola counties not too far behind. All of these hubs house major universitiy with major arterial highways interconnected within them.

#Lookup Tables for verifying information 

## Employment
employment_tbl <- workersdata %>% 
  group_by(education, occupation, empstat) %>% 
  filter(STAR == "Yes") %>% 
  tally() %>%
  ungroup()

## Industry
industry_tbl <- workersdata %>% 
  group_by(industry, occupation) %>% 
  filter(STAR == "Yes") %>% 
  tally() %>%
  arrange(desc(n)) %>% 
  ungroup()

## Occupation
occ_tbl <- workersdata %>% 
  group_by(occupation) %>% 
  filter(STAR == "Yes") %>% 
  tally() %>%
  arrange(desc(n)) %>% 
  ungroup()

##Tables for different occupational groups
hr_workers <- workersdata %>% 
  group_by(occupation, industry, education, hourly_wage, empstat, classwkrd) %>% 
  filter(STAR == 'Yes',
        occupation == 'Human resources assistants, except payroll and timekeeping' |
         occupation == 'Human resources managers' |
         occupation == 'Human resources workers') %>% 
 summarise(annual_wage = incearn) %>% 
  arrange(desc(classwkrd))

##For averaging wages
hr_workers2 <- workersdata %>% 
  group_by(occupation, education, classwkrd) %>% 
  filter(STAR == 'Yes',
    occupation == 'Human resources assistants, except payroll and timekeeping' |
    occupation == 'Human resources managers' |
    occupation == 'Human resources workers') %>% 
  summarise(annual_wage = incearn, mean_wage = round(mean(hourly_wage),2)) %>% 
  arrange(desc(classwkrd))

## Payroll workers
payroll_timekeep <- workersdata %>% 
  group_by(occupation, industry, education, hourly_wage, empstat, classwkrd) %>% 
  filter(STAR == 'Yes',
         occupation == 'Payroll and timekeeping clerks') %>% 
  summarise(annual_wage = incearn) %>% 
  arrange(desc(classwkrd))
 
## Training and Devleopment workers 
td_workers <- workersdata %>% 
  group_by(occupation, industry, education, hourly_wage, empstat, classwkrd) %>% 
  filter(STAR == 'Yes', occupation == 'Training and development managers' |
           occupation == 'Training and development specialists') %>% 
  summarise(annual_wage = incearn) %>% 
  arrange(desc(classwkrd))

## Compensation workers 
comp_managers <- workersdata %>% 
  group_by(occupation, classwkrd, education, industry) %>% 
  filter(STAR == 'Yes', empstat == "Employed", 
        occupation == 'Compensation and benefits managers' |
      occupation == 'Compensation, benefits, and job analysis specialists') %>% 
  summarise(annual_wage = incearn) %>% 
  arrange(desc(classwkrd)) 

Running the above code isn’t needed for this per say, but running them will condense the data into more digestible tables that can be used to find interesting insights into the STAR population, while providing a lot of context.

Some insights

For example, according to the US Bureau of Labor Statistics, HR Specialists as well as Training and Development Specialists have the most accessibility for STARs—Human Resources Specialists stand at 782,800 open roles at an 8% increase in hiring over the next ten years.

This tracks according to the data, among the STARs, they are the most frequented job titles across education groups in Florida with 243 workers—tied with ‘other office and administrative support workers.’

The top 5 industries with the most HR workers are in Employment services, Management (scientific, and technical consulting), Construction, Nursing care, and Banking. HR managers also share Construction as their leading industry with HR Assistants. Overall, construction businesses offer a viable means of mobility for STAR workers, and should targeted in Florida, along with Management services, Employment services and Banking.

HR Assistants fare well in Construction, libraries, schools, employment services and other executive and legislative bodies as far as industries go. Opportunities exists for workers with GEDs to gain roles as HR, primarily through on-the-job training, upskilling them internally via routes such as certification (via the SHRM, and other certs). Even without upskilling, HR Assistants stand to make $23.55 on average in compensation.

Compensation specialists command a good wage with only a High School Diploma. They also have good diversity among the industries they work in.

Payroll and Timekeeping Clerks command good coverage among STARs with High School Diplomas and 1+ years of college credit, no degree; with an average hourly rate of $23.76/hour.

P&T Clerks also have good coverage among the industries they are in, but they especially have good coverage in Justice and Public Order, outpatient care, schools, accounting firms and construction.

Training and Development personnel hold the highest paying positions in their job titles among those with only High School Diplomas or GEDs. They all hold positions in Construction and Business support services. T&D Specialists and Managers have a good path to mobility for those with only High School Diplomas/GEDs at a mean wage of $48.16/hour. …

#Write .csvs of tables for viewing and reference 

list <- list(comp_managers=comp_managers, industry_tbl=industry_tbl, 
             td_workers=td_workers, occ_tbl=occ_tbl, 
             employment_tbl=employment_tbl, hr_workers=hr_workers, 
             hr_workers2=hr_workers2, payroll_timekeep=payroll_timekeep, 
             workersdata=workersdata)
for(i in names(list)){
  write.csv(list[[i]], paste0(i,".csv"))
}

Here I wrote the tables I made into separate .csvs. I recommend doing this if you want to further visualize the data in other platforms such as Tableau and PowerBI; or God forbid, Excel shudders.

Conclusion

This really illuminated a large base of workers in the United States, for me, a layperson who just found out about STARs. We always knew they existed, they were people without college degrees that graduated High School or obtained a GED. Its very important to see the push going on within insitiutions for these populations, due to the efforts underway that grant opportunties to demographics who are often STARs.

People who were typically passed over for people with college degrees are seeing more and more acceptance in higher-tier roles in orgranizations. These people are usually PoC, the disadvantaged and the disabled. Thanks to think-tanks and non-profits such as Opportuntiy@Work and Tear the Paper Ceiling, gaining employment that enable socioeconomic mobility is much further within reach.

Thank you for reading.

Tableau Visualization Showcase

2023-05-04T00:00:00+00:00

Here’s some samples from my Tableau Public page, which can be found here.

MCP Traffic Stops in the DC Area:

This graphic showcases traffic stops among the various demographics that live in Washington DC and the surrounding area.

…

World Food Programme Global Commodity Analysis

Global Food Prices data from the World Food Programme. See caption in the graphic for more information.

…

Spotify Usage Breakdown

2023-05-04T00:00:00+00:00

Hello! Welcome to my analysis of my Spotify listening history, where I break down all the wonderful things that I’ve found in my listening history. This write-up was inspired by many of the pieces I found looking up project ideas relating to Spotifyr, and needless to say, I was amazed to see the things that I’ve been listening to.

The first thing we’ll do here is load all of the libraries we’re going to use!

library(jsonlite)
library(lubridate)
library(ggrepel)
library(gghighlight)
library(tidyverse)
library(knitr)
library(ggplot2)
library(plotly)
library(pheatmap)
library(spotifyr)

The cool thing about this project is that you’ll need to first request that Spotify sends you your personal account data, and depending on how you use and listen to music on Spotify, this can take a week up to a month for them to give you everything via email.

Spotifyr is the package that houses the tools needed to access the API that houses Spotify’s very comprehensive data on all the music we listen to that is attributed to our user profiles.

You’ll then link your account to the developer.spotify.com part of their website to make an app in order to get your access keys to the API. After we can grab the access keys, we can use the spotifyr package to get everything we need! We’re then going to call the API in order to pull their data into R Studio (or your IDE of choice), so that we can analyze it and manipulate everything.

The data stored in the files Spotify gives you is in JSON, so the jsonlite package parses everything out and sorts the data neatly into a data frame which we can then work with using the tidyverse.

Setting up and Getting the Data

#Streaming history file from Spotify
streamhist <- fromJSON("StreamingHistory0.json", flatten = TRUE)

streamhist <- streamhist %>% 
  as_tibble() %>% 
  mutate_at("endTime", ymd_hm) %>% 
  mutate(endTime = endTime - hours(6)) %>% 
  mutate(date = floor_date(endTime, "day") %>% as_date, minutes = msPlayed / 60000)

#For these last two data frames, we're going to be referencing them later to make our plots 
num_artist_played <- streamhist %>% group_by(artistName) %>% tally() %>% arrange(desc(n))
num_tracks_played <- streamhist %>% group_by(artistName, trackName) %>% tally() %>% arrange(desc(n))

list_of_top_20_artists <- streamhist %>% count(artistName) %>% arrange(desc(n)) %>% slice_head(n = 20)
list_of_top_20_tracks <- streamhist %>% count(artistName, trackName) %>% arrange(desc(n)) %>% slice(1:20)

print(list_of_top_20_artists)

## # A tibble: 20 × 2
##    artistName               n
##    <chr>                <int>
##  1 WWE                    310
##  2 Hank Trill             129
##  3 The Radio Dept.        124
##  4 Kanye West             120
##  5 SZA                    100
##  6 Chance the Rapper       96
##  7 Gorillaz                91
##  8 Guru                    75
##  9 Kendrick Lamar          70
## 10 A Tribe Called Quest    62
## 11 the pillows             62
## 12 Free Nationals          61
## 13 De La Soul              57
## 14 Digable Planets         56
## 15 Terrace Martin          50
## 16 David Bowie             44
## 17 Bodikhuu                43
## 18 Akeem Ali               41
## 19 Outkast                 41
## 20 Scooter                 41

print(list_of_top_20_tracks)

## # A tibble: 20 × 3
##    artistName           trackName                                                n
##    <chr>                <chr>                                                <int>
##  1 Hank Trill           Propane Money 2                                         34
##  2 Hank Trill           Swahili                                                 28
##  3 The Radio Dept.      Never Follow Suit                                       26
##  4 SZA                  Kill Bill                                               24
##  5 Dabeull              Day & Night                                             22
##  6 Chris Crack          Hoes at Trader Joe's                                    19
##  7 Alice Deejay         Better Off Alone                                        18
##  8 Downstait            Kingdom                                                 18
##  9 A Tribe Called Quest Electric Relaxation                                     17
## 10 The Weeknd           Out of Time                                             17
## 11 Ricky Reed           Real Magic                                              16
## 12 Rollergirl           Dear Jessie                                             16
## 13 gum.mp3              Seen It Before                                          16
## 14 Akeem Ali            Keemy Casanova )                                        15
## 15 Dungeon Family       Rollin' (feat. André 3000, Cee-Lo & Society Of Soul)    15
## 16 Kanye West           Believe What I Say                                      15
## 17 Scooter              Nessaja                                                 15
## 18 Butcher Brown        Gum In My Mouth                                         14
## 19 Fugees               Nappy Heads - Remix                                     14
## 20 G Perico             Billie Jean                                             14

First, we’re going to use our “streamhist” data to grab us a list of the top artists that we listen to that are present in our streaming history, then we’ll grab the name of the artists, count the number of times they appear each, rearrange them and them only present the top 20 rows.

Then, I’m summoning the “abridgedtop20data”, using the script below and then saving it to a .csv so that the rest of the analysis can run, and I won’t have to call the API over and over. Along with this, you’ll also make two separate data frames with the number of times each artist and track was played.

The json file being read in the first call is in the ‘my_spotify_data’ file that you get from Spotify directly, titled ‘StreamHistory0.json. For me, this was the only file, but for others it can be several depending on your usage, hence the length of time it takes you to receive the data at hand.

####-----------------

##Calling the API with spotifyr

#For use with your Client ID: 
Sys.setenv(SPOTIFY_CLIENT_ID = 'xxxxxxxxxxxxxxxxxxxxxxxxxx')

#For use with your Client Secret:            
Sys.setenv(SPOTIFY_CLIENT_SECRET ='xxxxxxxxxxxxxxxxxxxxxxxxxx')

#The access token you'll need to use Spotify's API 
get_spotify_authorization_code()
access_token <- get_spotify_access_token()

####-----------------

#Grab audio features for each artists using spotifyr 
favArtist1 <- get_artist_audio_features(artist= "WWE")
favArtist2 <- get_artist_audio_features(artist= "Hank Trill")
favArtist3 <- get_artist_audio_features(artist= "The Radio Dept")
favArtist4 <- get_artist_audio_features(artist= "Kanye West")
favArtist5 <- get_artist_audio_features(artist= "SZA")
favArtist6 <- get_artist_audio_features(artist= "Chance the Rapper")
favArtist7 <- get_artist_audio_features(artist= "Gorillaz")
favArtist8 <- get_artist_audio_features(artist= "Guru")
favArtist9 <- get_artist_audio_features(artist= "Kendrick Lamar")
favArtist10 <- get_artist_audio_features(artist= "A Tribe Called Quest")
favArtist11 <- get_artist_audio_features(artist= "the pillows")
favArtist12 <- get_artist_audio_features(artist= "Free Nationals")
favArtist13 <- get_artist_audio_features(artist= "De La Soul")
favArtist14 <- get_artist_audio_features(artist= "Digable Planets")
favArtist15 <- get_artist_audio_features(artist= "Terrace Martin")
favArtist16 <- get_artist_audio_features(artist= "David Bowie")
favArtist17 <- get_artist_audio_features(artist= "Bodikhuu")
favArtist18 <- get_artist_audio_features(artist= "Akeem Ali")
favArtist19 <- get_artist_audio_features(artist= "Outkast")
favArtist20 <- get_artist_audio_features(artist= "Scooter")

#Bind to singular data frame
top20data <- rbind(favArtist1, favArtist2, favArtist3, favArtist4, favArtist5, 
                   favArtist6, favArtist7, favArtist8, favArtist9, favArtist10, 
                   favArtist11, favArtist12, favArtist13, favArtist14, 
                   favArtist15, favArtist16, favArtist17, favArtist18, 
                   favArtist19, favArtist20)


#Select only relevant columns
abridgedTop20Data <- 
        select(top20data, c('artist_name', 'album_release_date', 'time_signature', 'duration_ms', 'danceability','energy', 
                                   'valence', 'loudness','speechiness',
                                   'acousticness','liveness','instrumentalness',
                                   'tempo','explicit', 'key_mode')) 

#Generate minutes column for later
abridgedTop20Data <- abridgedTop20Data %>% 
  mutate(duration_mins = duration_ms / 60000)

#write .csv  
write.csv(abridgedTop20Data, "abridgedTop20Data.csv", row.names = FALSE)

abridgedTop20Data <- read.csv("abridgedTop20Data.csv", stringsAsFactors = FALSE)

To further break down what’s happening here, the first thing we’re going to do is call the API.

In order to receive your API access keys, you will need to make an app on developer.spotify.com, you can then use these calls to access Spotify’s API. After the script runs your ID and secret, it saves your access token as an object so that the other functions we run can call back to the access token so that it can self-validate.

Below the API call, we’re asking spotifyr to grab the artist audio features of every artist that appeared in our list, we then use rbind to paste all of the resulting data frames together. The information in the data frames that spotifyr generates is very comprehensive, so I’m going to have to grab just the columns we need to produce the data we can use for analysis.

For the purposes of this project, I want to avoid calling the API every time I want to rerun the scripts as it will time you out if you attempt to call the API too many times. So I recommend calling the API first, saving the abridged data to a .csv and then recall it to a new dataframe that the scripts below will use to carry out the rest of the analysis; as I’ve done above.

Exploration

Now, we’re going to take a further look at the data we’ll need to make our visualizations. Thankfully, Spotify’s data is pretty clean and well-formatted on its own, so no real cleaning is needed outside of outliers you’ll find here and there.

#For use with later plots 
meanTop20ArtistsData <- abridgedTop20Data %>%
  group_by(artist_name) %>%
  summarise(mean_danceability = mean(danceability), mean_energy = mean(energy), 
            mean_valence = mean(valence), mean_loudness = mean(loudness), 
            mean_speechiness = mean(speechiness), 
            mean_acousticness = mean(acousticness), 
            mean_liveness = mean(liveness), 
            mean_instrumentalness = mean(instrumentalness), 
            mean_tempo = mean(tempo), mean_explicit = mean(explicit), n = n())

meanTop20ArtistsData[10,1] <- "Guru"

meanTop20ArtistsData <- merge(list_of_top_20_artists, meanTop20ArtistsData, by.x = "artistName", by.y = "artist_name")

# Distributions of songs by artists 
song_distributions <- abridgedTop20Data %>%
  group_by(artist_name) %>%
  summarize(mean_song_length = mean(duration_mins), 
            median_song_length = median(duration_mins),
            sd_song_length = sd(duration_mins),
            min_song_length = min(duration_mins),
            max_song_length = max(duration_mins),
            n_songs = n())

I had all the columns in the abridged version of the Top 20 data set summarized to their mean, as it will make plotting for central tendency much more concise. For song distributions, I did the same thing for each measure of central tendency, so everything would be more to the point when plotting that data.

What does my music look like?

Now that I have my data, let’s make visualizations with it! I formulated some pretty interesting hypotheses that were corroborated through visualization. For example, see below.

#Most frequently mentioned artists & tracks
list_of_top_20_artists %>% group_by(artistName) %>%
  ggplot(., aes(y = artistName, x = n)) +
  geom_col(aes(fill = n)) +
  theme_minimal() + 
  theme(legend.position = "bottom") +
  labs(
    title = "Top Artists by # of Times Played",
    subtitle = "How many times were their songs played from start to finish?",
    y = "Artist Name",
    fill = "n"
  ) 

Here, we asking, “Who were the most frequently played artists in my streaming history?” The resulting plot gave me a great idea in that for the rest of this analysis, because WWE represents such a large number of my consumed music, that I’d omit that outlier to get a better view of my data.

list_of_top_20_tracks %>% group_by(trackName) %>%
  ggplot(., aes(y = trackName, x = n)) +
  geom_col(aes(fill = artistName), show.legend = T) +
  labs(
    title = "Number of Track Spins by Artist",
    subtitle = "How many times was a song played from start to finish?",
    y = "Track Name",
    fill = "Artist Name"
  ) +
  scale_fill_discrete(type = "viridis") +
  theme(legend.position = "bottom")

This one is pretty straight forward, I’m asking of the data “How many times was a song played from start to finish?”. I clearly thought Hank Trill was the best thing since sliced bread, so as such, I’ve listed to “Propane Money 2” a total of 38 times.

#Mean song distributions with Box plot 
song_distributions %>% ggplot(aes(y = mean_song_length)) + 
  geom_boxplot() +
  labs(title = "Mean Song Lengths by Artists", y = "Average Mintues") +
  scale_y_continuous(breaks = seq(0, 5, by = .5)) +
  theme_minimal() +
  theme(axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0))) 

Here, I wanted to get a general view of the song lengths data to check for outliers and things. Nothing too crazy in terms of the numbers.

#Distribution Plots based on Top 20 
song_distributions %>% ggplot() + 
  geom_histogram(aes(x = median_song_length), stat = "density", alpha = .8, bins = 20) + 
  scale_x_continuous(breaks = seq(0, 5, by = .2)) +
  scale_color_brewer(palette = "Set3") +
  labs(
    title = "Median Song Lengths for Top 20 Artists",
    x = "Song Length",
    y = "Density"
  ) +
  theme_minimal()

For this, I specifically took a look at the median song lengths and their density, again, nothing too crazy, I’m more so looking at the spread of the data presented to check for outliers. What’s presented here is consistent with the above chart, the median song length for my data is around 3.75 minutes.

streamhist2 <- streamhist %>% group_by(artistName) %>% summarise(total_min = sum(minutes)) %>% arrange(desc(total_min)) %>% slice(1:20) 

streamhist2 %>% 
  ggplot() + 
  scale_fill_gradient(low = "darkgrey", high = "limegreen") +
  geom_bar(aes(x = total_min, y = artistName, fill = total_min), stat = "identity") + 
  labs(
    title = "Most Played Artists by the Minute",
    subtitle = "Includes both track times and podcasts",
    x = "Total Mins",
    y = "Artist Name",
    fill = ""
  ) +
  theme(plot.title = element_text(face = "bold"), plot.caption = element_text(size = 6.5), legend.position = "bottom") +
  theme_minimal()

For this plot, I wanted to check out the most played artists by the minute, meaning for each artist, how long did I actually listen to their music. Interesting WWE here is very low, but that’s because they only have entrance music and for everytime I played something of theirs, it only last around 3:00 or so each play. Compared to “The Sessions” which is a podcast, that outlier checks out as I listen to those episodes from start to finish.

song_distributions %>% ggplot(aes(x = artist_name, y = max_song_length, color = artist_name, label = artist_name)) + 
  geom_point() +
  geom_label_repel(hjust = 0, vjust = .5, show.legend = F) +
  labs(title = "Max Song Lengths by Artists", x = "Artist", y = "Song Minutes") +
  theme_minimal() +
  theme(axis.text.x = element_blank(), 
        axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0)), 
        axis.ticks.x = element_blank(), legend.position = "") 

Apparently, Scooter and Terrace Martin have songs/sets that are 40 - 80 mins long, accounting for the outliers found above, which I found interesting. I didn’t even know Spotify had tracks that were that long.

top20EnergyValencePlot <- meanTop20ArtistsData %>% 
  ggplot(aes(x = mean_valence, y = mean_energy, color = artistName, label = artistName)) +
  geom_text_repel(hjust = 0, vjust = 0, show.legend = F) +
  geom_point(alpha = 0.5, show.legend = T) +
  scale_size(range = c(0, 12)) +
  geom_vline(xintercept = 0.5) +
  geom_hline(yintercept = 0.5) +
  scale_x_continuous(expand = c(0, 0), limits = c(0, 1)) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
  annotate('text', 0.25 / 2, 0.95, label = "Angry") +
  annotate('text', 1.75 / 2, 0.95, label = "Happy") +
  annotate('text', 1.75 / 2, 0.05, label = "Peaceful") +
  annotate('text', 0.25 / 2, 0.05, label = "Depressing") +
  labs(x = "Valence", y = "Energy") +
  ggtitle("Emotional Quadrant For My Top 20 Artists", "Position based on energy and valence, size based on number of songs (Short Term)") +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold"), plot.caption = element_text(size = 6.5), legend.position = "bottom") +
  guides(col = "none")

plot(top20EnergyValencePlot)

This chart was made to show exactly where my music fell along the four emotional quadrants. For x, Energy is self-explanatory.

However, for y, Spotify’s documentation defines Valence as: “A measure from 0.0 to 1.0 describing the musical positiveness conveyed by a track. Tracks with high valence sound more positive (e.g. happy, cheerful, euphoric), while tracks with low valence sound more negative (e.g. sad, depressed, angry).”

So considering that, each of the four quadrants represents an emotional extreme, so we can see where exactly all of our music falls along those lines.

Everything in the Top 20 of my most listened to tracks are pretty neutral, for the most part. Most of my artists are on the more happy or angry sounding side than not, and there’s a lot of energy present in my music. I guess I’m not the edge lord I thought I was. Hilariously, Scooter’s music was found the be the most angry thing on my list…

So let’s try to answer some more questions.

top20tempo_energyplot <- 
  ggplot(meanTop20ArtistsData, aes(x = mean_tempo, y = mean_energy, 
                                   label = artistName, color = artistName)) +
  geom_point(aes(color = artistName), alpha = .5, show.legend = F) +
  scale_x_continuous(expand = c(0, 0), limits = c(90, 150)) +
  scale_y_continuous(expand = c(0, 0), limits = c(.45, .75)) +
  labs(x = "Tempo", y = "Energy") +
  geom_text_repel(hjust = 0, vjust = 0, show.legend = F) +
  ggtitle("Top 20 Artists by Tempo & Energy", "Are faster songs more energetic?") +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold"))

plot(top20tempo_energyplot)

Here, I’m looking to answer, does the catalog of the top 20 artists I listen have a body of work that is of a certain tempo and energy threshold? Can I reasonably say that there is a correlation between the two? Most the indie stuff that I listen to that’s high tempo does have good energy.

Now, the Rap/Hip-Hop/RnB artists that I listen to are also about right. Considering that those genres of music tend to fall between the 90-120 range as far as tempo goes. The artists that fall into that genre have music that’s high energy, but fall into the range I gave being below 115 BPM.

Next…

top20dance_valplot <- 
  ggplot(meanTop20ArtistsData, aes(x = mean_danceability, y = mean_valence, 
                                   label = artistName, color = artistName)) +
  geom_point(aes(color = artistName), alpha = .5, show.legend = F) +
  scale_x_continuous(expand = c(0, 0), limits = c(.4, .85)) +
  geom_text_repel(hjust = 0, vjust = 0, show.legend = F) +
  labs(x = "Danceability", y = "Valence", 
       title = "Top 20 Artists by Danceability & Valence",
       subtitle = 'Are more happier sounding songs danceable?') +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold"))

plot(top20dance_valplot)

Here we’re looking at Danceability and Valence. Danceability can be described how easy is the artist’s music to dance to and is a number measured from 0 to 1. 0 is least, 1 is most.

Of the artists featured here, nothing should be really surprising. The Radio Department, the pillows, and David Bowie aren’t what I’d call danceable. Fun to chill to, but not danceable music. Pretty much everything from 0.58 or so and up on the danceability scale is Rap/Hip-Hop/RnB.

Also, heck yeah Guru, ATCQ and De La Soul are danceable, way to be spot on Spotify!

Then we have…

top20selplot <- 
  ggplot(meanTop20ArtistsData, aes(x = mean_speechiness, y = mean_explicit, size = mean_loudness, label = artistName)) + 
  geom_text_repel(hjust = 0, vjust = 0, show.legend = F) +
  geom_point(aes(color = artistName), alpha = .5) +
  labs(x = "Speechiness", y = "Explicit", size = "Loudness", color = "Catalog Size", caption = "smallest = Digable Planets") +
  ggtitle("Top 20 Artists by Speechiness, Explicitness and Loudness", "Are the more 'speechy' tracks for top artists inherently explicit and loud?") +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold"), legend.position = "bottom")

plot(top20selplot)

Here, we take a look at a plot that measures the Speechniness of music (that is how much verbal speech it contains).

While acousticness, liveness, and instrumentalness aren’t talked about as much here, but they are important to talk about. The first measures if a given track is acoustic or not. Liveness measures if a track has the presence of an audience in the recording. While the last one predicts whether or not a track contains no vocals.

All of these variables are measured from 0 to 1, which will be of importance later. Regarding speechiness, Spotify’s documentation describes it as: “The more exclusively speech-like the recording (e.g. talk show, audio book, poetry), the closer to 1.0 the attribute value. Values above 0.66 describe tracks that are probably made entirely of spoken words.

Values between 0.33 and 0.66 describe tracks that may contain both music and speech, either in sections or layered, including such cases as rap music. Values below 0.33 most likely represent music and other non-speech-like tracks.”

How Explicit (swears/curses) a given artist’s music is, is what’s being visualized here along with how loud their music is inherently. This is measured between 0 and 1 on the y axis, while values typically range between -60 and 0 db for Loudness and are measured through a given points color.

According to this, you can imagine, most of the Rap/Hip-Hop/RnB artists have music that is the mostly Explicit, while also being speech-heavy and loud. Stereotypes be damned… but seriously, this all tracks as Thundercat and Nujabes make music for a more “chill” demographic and are reflected as such in the data. It’s funny to me how Kendrick Lamar, Chance, Akeem Ali and Hank Trill (being the highest) have music consisting of over 50% swears.

Heatmap

Now for the heatmap I’m doing for this analysis, I stayed far, far away from base R’s syntax because using it took forever to format and it wasn’t all that pretty or customizable, so I used a package called pheatmap.

The first thing I did here was make a copy of the data…

meanTop20ArtistsData_copy <- as.data.frame(meanTop20ArtistsData)
song_distributions_copy <- as.data.frame(song_distributions)

…then I ascribed the names in column 1 to the row names of the data frame

row.names(meanTop20ArtistsData_copy) <- meanTop20ArtistsData_copy[,1]
row.names(song_distributions_copy) <- song_distributions_copy[,1]

Next, I removed both categorical variables and columns where they’re numeric, but they don’t measure from 0 to 1. This is because as its a heatmap, all the values being measured need to equal from 0 to 1, or everything will be thrown off and it won’t make sense because nothing scales meaningfully. So to that end, the names and genres are removed, along with loudness, tempo, and “n” (which represents the size of an artist’s catalog).

meanTop20ArtistsData_copy$artistName <- NULL
meanTop20ArtistsData_copy$genres <- NULL
meanTop20ArtistsData_copy$mean_loudness <- NULL
meanTop20ArtistsData_copy$mean_tempo <- NULL
meanTop20ArtistsData_copy$n.x <- NULL
meanTop20ArtistsData_copy$n.y <- NULL

song_distributions_copy$artist_name <- NULL
song_distributions_copy$n_songs <- NULL
song_distributions_copy$min_song_length <- NULL
song_distributions_copy$max_song_length <- NULL
song_distributions_copy$sd_song_length <- NULL

Now, I’m going to rename the columns for readability’s sake, and turn the data frame into a matrix, because heatmap objects need to be based from numeric matrices in order to be usable.

#Rename columns

colnames(meanTop20ArtistsData_copy) <- c("danceability", "energy", "valence", 
                                         "speechiness", "acousticness", 
                                         "liveness", "instrumentalness", 
                                         "explicit")

#Turn data into matrix
meanTop20ArtistsData_copy <- as.matrix(meanTop20ArtistsData_copy)
song_distributions_copy <- as.matrix(song_distributions_copy)

Now, I’ll make the heatmap in the codes below.

#Make heatmap
top20heatmap <-
  pheatmap(
    meanTop20ArtistsData_copy,
    cluster_rows = T,
    clustering_distance_rows = "correlation",
    legend_breaks = c(0, 0.5, 1),
    legend_labels = c("0", "0.5", "1"),
    cluster_cols = F,
    angle_col = "315",
    color = colorRampPalette(c("slategray3", "white", "green2"))(100),
    display_numbers = T,
    main = "Spotify Top 20 Artists Heatmap"
  )

print(top20heatmap)

Behold! Below I’m making another heat map that details the data as it’s being scaled before rendering it into the plot. Scaling aligns the values so that drastic fluctuations in the data set are toned down

top20heatmapscaled <-
  pheatmap(
    meanTop20ArtistsData_copy,
    cluster_rows = T,
    clustering_distance_rows = "correlation",
    legend_breaks = c(-2, 0, 2),
    legend_labels = c("-2", "0", "2"),
    cluster_cols = F,
    angle_col = "315",
    color = colorRampPalette(c("slategray3", "white", "green2"))(100),
    display_numbers = T,
    scale = "row",
    main = "Spotify Top 20 Artists Heatmap (Short Term, Scaled)"
  )

print(top20heatmapscaled)

As you can see from both heatmaps, they validate many of the assumptions I made in the previous plots. It also makes drawing useful insights more easy, because everything is visualized right in front of you, making comparisons easier.

top20distributions <-
  pheatmap(
    song_distributions_copy,
    cluster_rows = T,
    clustering_distance_rows = "correlation",
    legend_breaks = c(-2, 0, 2),
    legend_labels = c("-2", "0", "2"),
    cluster_cols = F,
    angle_col = "315",
    color = colorRampPalette(c("slategray3", "white", "green2"))(100),
    display_numbers = T,
    main = "Spotify Top 20 Artists Song Lengths"
  )

print(top20distributions)

For this third heatmap, I wanted to take the data of the song length distributions I made earlier to give us a good metric to gauge and make comparisons.

Conclusion

That does it for my Spotify Top 20 short-term Most Listened to Artists! Thank you reading, I hope you enjoyed reading this as much as I had fun making it.

Extra

While you’re here, check out my Ultimate EuroDance Playlist, it’s cheesy, uplifting goodness! Perfect for your working or errand days.

A Particular Group leads in DC Area Traffic Stops

2023-05-04T00:00:00+00:00

This is a project based on a tutorial my friend Carlos made to help me learn R initally. I took the content and expanded on it to make the plots you’ll see below. Much of the syntax is tidyverse, so this should serve as a good primer of things to do when getting acclimated to the language. The data set I’m using here is one based on traffic violations through the D/C and surrounding area.

Loading our libraries

library(tidyverse)
library(lubridate)
library(plotly)
library(sf)
library(ggrepel)

As I mentioned, we’ll be primarily using Tidyverse, along with lubridate, mapview and sf for working with coordinate data.

Exploration

First, we’ll import our data

traffic <-
  read.csv("/Users/bruce/Documents/Old R Projects/bRuce/Data/select_traffic2.csv"
           ,
           stringsAsFactors = FALSE)

‘stringsAsFactors’ makes the column names not inherit the spaces present in the original dataset

Before we get started with cleaning, let’s do some preliminary exploration with our data to get a grasp on what we’re working with.

Below will output the first 20 rows, while summary includes measures of central tendency for evaluating our data.

head(traffic[1:20,])

##   X                                SeqID Date.Of.Stop Agency                                       SubAgency Latitude Longitude Accident
## 1 1 81ebccdf-77d5-4cf1-93d7-bd6eb03ae6a1    4/12/2018    MCP                     3rd District, Silver Spring 38.99958 -76.99601       No
## 2 2 d2584fc9-dc7d-4d2a-ab28-68a6b6930688   11/10/2016    MCP                           4th District, Wheaton 39.05532 -77.05016       No
## 3 3 36426586-974b-416e-b778-d894beb5e936    1/31/2018    MCP                          2nd District, Bethesda 39.05342 -77.08926       No
## 4 4 a453cf70-5fc4-46ed-b902-099b15153342    12/8/2015    MCP 6th District, Gaithersburg / Montgomery Village 39.14160 -77.22586       No
## 5 5 49d2065b-c652-45ac-b4a3-87dcab0be193    9/14/2016    MCP                           4th District, Wheaton 39.05448 -77.05079       No
## 6 6 3dd0f0c6-dd0e-458d-b11c-9cd13e3caa54    5/15/2016    MCP                          2nd District, Bethesda 38.98801 -77.09504       No
##   Belts Personal.Injury Property.Damage Fatal HAZMAT Alcohol State        VehicleType Year Violation.Type Contributed.To.Accident     Race
## 1    No              No              No    No     No      No    MD    02 - Automobile 2010        Warning                   FALSE    BLACK
## 2    No              No              No    No     No      No    MD    02 - Automobile 2010       Citation                   FALSE    BLACK
## 3    No              No              No    No     No      No    MD    02 - Automobile 1999        Warning                   FALSE    OTHER
## 4    No              No              No    No     No      No    MD    02 - Automobile 2004        Warning                   FALSE HISPANIC
## 5    No              No              No    No     No      No    MD 03 - Station Wagon 2012        Warning                   FALSE    BLACK
## 6    No              No              No    No     No      No    VA    02 - Automobile 2003        Warning                   FALSE    WHITE
##   Gender DL.State         Arrest.Type                           Geolocation
## 1      M       MD   A - Marked Patrol                 (38.99958, -76.99601)
## 2      M       MD   A - Marked Patrol         (39.05532, -77.0501583333333)
## 3      F       MD   A - Marked Patrol        (39.053425, -77.0892583333333)
## 4      M       MD   A - Marked Patrol (39.1415966666667, -77.2258616666667)
## 5      M       MD B - Unmarked Patrol         (39.0544816666667, -77.05079)
## 6      F       MD   A - Marked Patrol (38.9880133333333, -77.0950366666667)

summary(traffic)

##        X            SeqID           Date.Of.Stop          Agency           SubAgency            Latitude       Longitude     
##  Min.   :    1   Length:50000       Length:50000       Length:50000       Length:50000       Min.   : 0.00   Min.   :-94.61  
##  1st Qu.:12501   Class :character   Class :character   Class :character   Class :character   1st Qu.:39.02   1st Qu.:-77.19  
##  Median :25001   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Median :39.06   Median :-77.08  
##  Mean   :25001                                                                               Mean   :36.28   Mean   :-71.59  
##  3rd Qu.:37500                                                                               3rd Qu.:39.13   3rd Qu.:-77.03  
##  Max.   :50000                                                                               Max.   :39.70   Max.   :  0.00  
##                                                                                                                              
##    Accident            Belts           Personal.Injury    Property.Damage       Fatal              HAZMAT            Alcohol         
##  Length:50000       Length:50000       Length:50000       Length:50000       Length:50000       Length:50000       Length:50000      
##  Class :character   Class :character   Class :character   Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                                                                                      
##                                                                                                                                      
##                                                                                                                                      
##                                                                                                                                      
##     State           VehicleType             Year      Violation.Type     Contributed.To.Accident     Race              Gender         
##  Length:50000       Length:50000       Min.   :   0   Length:50000       Mode :logical           Length:50000       Length:50000      
##  Class :character   Class :character   1st Qu.:2002   Class :character   FALSE:48822             Class :character   Class :character  
##  Mode  :character   Mode  :character   Median :2007   Mode  :character   TRUE :1178              Mode  :character   Mode  :character  
##                                        Mean   :2006                                                                                   
##                                        3rd Qu.:2011                                                                                   
##                                        Max.   :9999                                                                                   
##                                        NA's   :358                                                                                    
##    DL.State         Arrest.Type        Geolocation       
##  Length:50000       Length:50000       Length:50000      
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
## 

In the code above, we want to run summary, because this will allow us to get a good bird’s eye view on the data to see if there are outliers present and possible maligned data.

Now that I’ve viewed everything, to get started with the cleaning process, I’m going to get rid of all columns and transform others to get the data to a more workable state.

traffic$X <- NULL
traffic <- na.exclude(object = traffic)
accidents <- subset(traffic, traffic$Accident == "Yes")
sapply(accidents, class)

##                   SeqID            Date.Of.Stop                  Agency               SubAgency                Latitude 
##             "character"             "character"             "character"             "character"               "numeric" 
##               Longitude                Accident                   Belts         Personal.Injury         Property.Damage 
##               "numeric"             "character"             "character"             "character"             "character" 
##                   Fatal                  HAZMAT                 Alcohol                   State             VehicleType 
##             "character"             "character"             "character"             "character"             "character" 
##                    Year          Violation.Type Contributed.To.Accident                    Race                  Gender 
##               "integer"             "character"               "logical"             "character"             "character" 
##                DL.State             Arrest.Type             Geolocation 
##             "character"             "character"             "character"

The first call Gets rid of the useless ‘x’ column, then I’m removing NA rows from data set. After, I’m using sapply to see which classes my columns in the datasets are, lapply can work as well, this will come into play later.

accidents$Vehicle.Year <- accidents$Year
accidents$Year <- NULL 
accidents$Vehicle.Year <- as.numeric(accidents$Vehicle.Year)
accidents <- accidents[,c(1:14,23,15:22)]

The above is needed for next steps, I’m changing the column name and type, then reordering everything for neatness sake.

Now, i’m going to make a basic histogram which helps me to visual outliers and other anomalys.

Strangely enough, there’s an outlier ‘0’ that’s throwing off the data, so when I run the below, it should tell me where to find it. I’m also checking for number of rows with 0 within “Vehicle Year”. After, I’m checking for NAs, rerunning summary stats, and then identifying and eliminating outliers.

Lastly, I’ll rerun the histograms to verify numbers

sum(accidents$Vehicle.Year == '0', na.rm=TRUE)

## [1] 1

sum(is.na(accidents))

## [1] 0

summary(accidents)

##     SeqID           Date.Of.Stop          Agency           SubAgency            Latitude       Longitude        Accident        
##  Length:1178        Length:1178        Length:1178        Length:1178        Min.   : 0.00   Min.   :-77.42   Length:1178       
##  Class :character   Class :character   Class :character   Class :character   1st Qu.:39.01   1st Qu.:-77.16   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character   Median :39.06   Median :-77.07   Mode  :character  
##                                                                              Mean   :34.96   Mean   :-68.99                     
##                                                                              3rd Qu.:39.11   3rd Qu.:-77.02                     
##                                                                              Max.   :39.33   Max.   :  0.00                     
##     Belts           Personal.Injury    Property.Damage       Fatal              HAZMAT            Alcohol             State          
##  Length:1178        Length:1178        Length:1178        Length:1178        Length:1178        Length:1178        Length:1178       
##  Class :character   Class :character   Class :character   Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                                                                                      
##                                                                                                                                      
##                                                                                                                                      
##   Vehicle.Year  VehicleType        Violation.Type     Contributed.To.Accident     Race              Gender            DL.State        
##  Min.   :   0   Length:1178        Length:1178        Mode:logical            Length:1178        Length:1178        Length:1178       
##  1st Qu.:2002   Class :character   Class :character   TRUE:1178               Class :character   Class :character   Class :character  
##  Median :2007   Mode  :character   Mode  :character                           Mode  :character   Mode  :character   Mode  :character  
##  Mean   :2017                                                                                                                         
##  3rd Qu.:2012                                                                                                                         
##  Max.   :9999                                                                                                                         
##  Arrest.Type        Geolocation       
##  Length:1178        Length:1178       
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
## 

sum(accidents$Vehicle.Year == '0')

## [1] 1

accidents %>% filter(Vehicle.Year == "0") %>% pull(SeqID)

## [1] "4b24280c-6171-4d6f-b327-cf00fa5c306a"

accidents <- accidents[accidents$Vehicle.Year != 0, ]     
hist(x = accidents$Vehicle.Year, breaks = 1000, 
     xlab = "Vehicle Year", ylab = "n", xlim = c(1940,2019))

There, I’ve gotten rid of all the outliers that would have thrown a wrench in our analysis, next, I’ll make a new column for “Month of Stop” for the histogram below.

accidents$Date.Of.Stop <- mdy(accidents$Date.Of.Stop)
accidents$Month.of.Stop <- month(accidents$Date.Of.Stop)

This will be useful for my analysis later. Now let’s visualize the histogram not using base R which can’t do counts for some reason…

accidents %>% ggplot(aes(x = Month.of.Stop)) + geom_histogram(aes(y = after_stat(count)), bins = 30) 

The histogram above tells us that the most accidents on record for this dataset occurred in December, this can verify that

accidents %>% count(Month.of.Stop)

##    Month.of.Stop   n
## 1              1  97
## 2              2  92
## 3              3  85
## 4              4  82
## 5              5 114
## 6              6 108
## 7              7 101
## 8              8  88
## 9              9  79
## 10            10 112
## 11            11 102
## 12            12 117

Recoding our variables

One of the most important pieces of cleaning data comes into play when we need our data to fit our method of analysis in certain ways. For example, recoding a variable into binary enables a data column to be ‘numeric’ as opposed to ‘character’ which opens up particular ways to analyze everything. See below:

#Accidents 
accidents$Accident = ifelse(accidents$Accident == "Yes", 1 ,0)

#Fatalities 
accidents$Fatal = ifelse(accidents$Fatal == "Yes", 1 ,0)

#Alcohol related accidents
accidents$Alcohol = ifelse(accidents$Alcohol == "Yes", 1 ,0)

#Summarize each by month of accident: 
Num_Accidents <- accidents %>%
  group_by(Month.of.Stop) %>%
  summarise(sum_Accidents = sum(Accident))

Num_Fatal <- accidents %>%
  group_by(Month.of.Stop) %>%
  summarise(sum_Fatal = sum(Fatal))

Num_Alcohol <- accidents %>%
  group_by(Month.of.Stop) %>%
  summarise(sum_Alcohol = sum(Alcohol))

Now that we have our summarised columns, I’ll merge them into one dataset:

#Join variables using merge()

agg_accidents <- merge(Num_Accidents, Num_Alcohol, by = "Month.of.Stop")
agg_accidents <- merge(agg_accidents, Num_Fatal, by = "Month.of.Stop")

#Rename month column 
agg_accidents <- rename(agg_accidents, month = Month.of.Stop)

#Make new month column
agg_accidents$month <- as.factor(month.name)
agg_accidents$month <- factor(agg_accidents$month, levels = month.name)

#Rename columns 
agg_accidents$accidents <-  agg_accidents$sum_Accidents
agg_accidents$fatal <- agg_accidents$sum_Fatal
agg_accidents$alcohol <-agg_accidents$sum_Alcohol

#Remove redundant columns 
agg_accidents <- agg_accidents[,-c(2:4)]

#Factorize the last two columns for plotting
agg_accidents$alcohol = as.factor(x = agg_accidents$alcohol)
agg_accidents$fatal = as.factor(x = agg_accidents$fatal)

Below is a sample plot I used made with the aggregated data:

accidentplot <- 
     ggplot(data = agg_accidents, aes(x = accidents, y = month, color = alcohol)) +
     geom_point() +
     labs(title = "Accidents by Month and Type", x = "n",
        y = "Month") +
   theme_bw()

print(accidentplot)

However, if I were to print the ‘agg_accidents’ data, you’ll see that this doesn’t give us much to work off of.

print(agg_accidents)

##        month accidents fatal alcohol
## 1    January        97     0       0
## 2   February        92     0       0
## 3      March        85     0       0
## 4      April        82     0       0
## 5        May       114     1       1
## 6       June       108     0       0
## 7       July       101     0       0
## 8     August        88     0       0
## 9  September        79     1       0
## 10   October       112     0       0
## 11  November       102     0       0
## 12  December       117     0       1

Considering this, I’m going to take the original data set and re-work it so that I can get more meaning visualization from the data.

Another Approach

I noticed that the data contains coordinate data, so I’m going to use that to plot a map giving us some more detailed information.

First, I’m going to repeating some of my previous cleaning steps, then recode what I find useful.

#Repeating some cleaning steps from before and removing outliers:
traffic$X <- NULL
traffic <- na.exclude(object = traffic)
traffic <- traffic[traffic$Latitude != 0.00, ]
traffic <- traffic[traffic$Longitude != 0.00, ] 
traffic <- traffic[with(traffic, !((Year %in% 0:1931) | (Year %in% 2024:9999))), ]


#Remove null entries from coordinates: 
geo_traffic <- subset(traffic)

#Recode dates
geo_traffic$Date.Of.Stop <- mdy(geo_traffic$Date.Of.Stop)
geo_traffic$Date.Of.Stop <- as.POSIXct(geo_traffic$Date.Of.Stop)


#Editing out a couple of problematic strings by removing unneeded characters 
geo_traffic[,15] <- str_sub(geo_traffic[,15], 6, -1)
geo_traffic[,22] <- str_sub(geo_traffic[,22], 5, -1)

…

Here’s a few examples of some visualizations I made using Tableau, to really a good look at our cleaned data!

So now that we have a representation of what happens in the DC area, as far as traffic stops go, as well as definitive confirmation that our data is in order. What are some questions we can ask of the data, using ggplot2?

…

Plots

Here, I want to ask as many questions of the data as I possible can, so the first thing I’m going to ask here to tell the story of this agencies’ police departments is, “How many traffic stops did each race have by year?”

ggplot(data = geo_traffic, aes(x = Date.Of.Stop)) + 
  geom_histogram(aes(fill = Race, col = I("black")),  
                 stat = "bin", binwidth = 5000000) + 
  labs(title = "Traffic Stops by Year and Race", 
       subtitle = "For DC and the Surrounding Area", x = "Year", 
       y = "n")

This chart offers a more nuanced look at how each race described in the data committed traffic stops by counts and Year; as the previous one represented totals for each year.

ggplot(data = geo_traffic) +
  geom_freqpoly(aes(x = Date.Of.Stop, color = Race), 
                size = 1, 
                alpha = .8, 
                binwidth = 5000000) +
  labs(title = "Count of Traffic Stops by Race", 
       subtitle = "For DC and the Surrounding Area",
       x = "Race", 
       y = "Count") +
  theme(axis.text.x = element_text(angle = 90)) +
        theme_bw()

This chart captures the kinds of Vehicles used in the violations perpetrators committed over a given time period.

ggplot(data = geo_traffic) +
  geom_histogram(aes(y = VehicleType, fill = Violation.Type), stat = "count") +
  labs(title = "Vehicle Types by Violation", x = "Count", 
       y = "Vehicle Type", subtitle = "Chart captures data for violations around the DC Area") +
  scale_fill_discrete(name = "Violation Type") +
  theme_bw() 

Here, we detail the type of arrest, their counts, gender and what kind of violation was committed.

ggplot(data = geo_traffic) +
  geom_histogram(aes(y = Arrest.Type, fill = Violation.Type), stat = "count", bins = 30, binwidth = 10) +
  labs(title = "Arrest Types by Gender and Violation", x = "Count", 
       y = "", subtitle = "Chart captures data for violations around the DC Area") +
  scale_fill_discrete(name = "Violation Type") +
  theme_bw() +
  facet_wrap(.~Gender)

This plot below tells us the amount of accidents that occurred over the given time period.

ggplot(data = geo_traffic, aes(x = Date.Of.Stop, color = Accident)) +
  geom_freqpoly(size = .8, alpha = .7, binwidth = 1000000) +
  labs(title = "Number of Accidents in Traffic Stops", subtitle = "Few Accidents Occured Over an 8 Year Period in the DC Area", x = "Year", 
       y = "Count") +
  theme_bw() +
  theme(legend.position = "none") +
  facet_wrap(.~Accident)

In this chart, we look at the number of fatal accidents. Thankfully, people in the DC area are relatively safe drivers according to our data.

ggplot(data = geo_traffic, aes(x = Date.Of.Stop, color = Fatal)) +
  geom_freqpoly(size = .8, alpha = .7, binwidth = 1000000) +
  labs(title = "Count of Fatal Accidents in DC Area", subtitle = "No Fatalities Occured Over an 8 Year Period", x = "Year", 
       y = "Count") +
  theme_bw()

Before I plot this one, I’m recoding the names of the Sub Agencies before plotting so that they’ll look better. Lastly, this plot shows up the number of arrests made by each police department within the Agency by Year:

geo_traffic$SubAgency[geo_traffic$SubAgency == '1st District, Rockville'] <- "Rockville"
geo_traffic$SubAgency[geo_traffic$SubAgency == '2nd District, Bethesda'] <- "Bethesda"
geo_traffic$SubAgency[geo_traffic$SubAgency == '3rd District, Silver Spring'] <- "Silver Spring"
geo_traffic$SubAgency[geo_traffic$SubAgency == '4th District, Wheaton'] <- "Wheaton"
geo_traffic$SubAgency[geo_traffic$SubAgency == '5th District, Germantown'] <- "Germantown"
geo_traffic$SubAgency[geo_traffic$SubAgency == '6th District, Gaithersburg / Montgomery Village'] <- "Gaithersburg / Montgomery Village"
geo_traffic$SubAgency[geo_traffic$SubAgency == 'Headquarters and Special Operations'] <- "HQ and Spec Ops"

ggplot(data = geo_traffic, aes(x = Date.Of.Stop, fill = SubAgency)) +
  geom_histogram(color = "black", bins = 50, binwidth = 10000000) +
  labs(title = "Number of Arrests by Sub Agency", x = "Year", 
       y = "Count", subtitle = "Chart captures data for arrests made by MCP") +
  scale_fill_discrete(name = "Name") +
  theme_bw() +
  facet_grid(.~SubAgency)

Conclusion

This analysis illustrated a very detailed picture of how traffic stops play out within the Washington DC and surrounding areas. We saw that thankfully, while they are indeed numerous, people are relatively safe drivers. We alas learned that whites committed the most traffic violations over the 8 year period that our data captured. While by number, Native Americas had the least and were likely the least represented.

Visualizations can be fun because looking at data in spreadsheet form can be boring, imagine trying to explain all those number to others without a story or picture to accompany your words! The funny thing is that I feel like i’ve yet to scratch the surface of what ggplot2 can do.

As always thank you for reading!