Behold the Vision

Tidy Tuesday 03/12/2019 Philadelphia Parking Violations

2019-12-03T00:00:00+00:00

Data description

This week’s data is from Open Data Philly - there is over 1 GB of data, but I have filtered it down to <100 MB due to GitHub restrictions. I accomplished this mainly by filtering to data for only 2017 in Pennsylvania that had lat/long data. If you would like to use the entire dataset, please see the link above.

H/t to Jess Streeter for sharing this week’s data!

Some visualizations from Philly Open Data and a news article by NBC Philadelphia.

Packages and data reading

library(tidyverse)
library(patchwork)

tickets <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-12-03/tickets.csv")

Quick look

tickets %>% glimpse()

## Observations: 1,260,891
## Variables: 7
## $ violation_desc <chr> "BUS ONLY ZONE", "STOPPING PROHIBITED", "OVER TIME L...
## $ issue_datetime <dttm> 2017-12-06 12:29:00, 2017-10-16 18:03:00, 2017-11-0...
## $ fine           <dbl> 51, 51, 26, 26, 76, 51, 36, 36, 76, 26, 26, 301, 36,...
## $ issuing_agency <chr> "PPA", "PPA", "PPA", "PPA", "PPA", "POLICE", "PPA", ...
## $ lat            <dbl> 40.03550, 40.02571, 40.02579, 40.02590, 39.95617, 40...
## $ lon            <dbl> -75.08111, -75.22249, -75.22256, -75.22271, -75.1660...
## $ zip_code       <dbl> 19149, 19127, 19127, 19127, 19102, NA, NA, 19106, 19...

How many types of violations?

means <- tickets %>% 
  filter(!is.na(issuing_agency)) %>% 
  group_by(issuing_agency) %>% 
  summarise(mean_fine = mean(fine)) %>%
  mutate(housing_ppa = ifelse(issuing_agency %in% c('HOUSING', 'PPA'),
                              'Y', 'N')) %>% 
  ggplot(aes(reorder(issuing_agency, mean_fine), mean_fine, 
             color = housing_ppa)) +
  geom_point(size = 4) +
  labs(
    title = 'Housing fines are high',
    subtitle = 'While PPA\'s bottom in value',
    x = 'Issuing Agency',
    y = 'Average fine value'
  ) +
  coord_flip() +
  scale_y_continuous(labels = scales::dollar_format()) +
  scale_color_manual(values = c('darkslategrey', 'navyblue'), guide = FALSE) +
  theme_bw() + 
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        strip.placement = 'outside',
        panel.border = element_rect(color = 'lightslategrey'),
        title = element_text(colour = "darkslategrey"),
        strip.text = element_text(color = 'slategrey'),
        axis.ticks = element_line(color = 'lightslategrey'),
        axis.text = element_text(color = 'slategrey'))

means

total_log <- tickets %>% 
  filter(!is.na(issuing_agency)) %>%
  group_by(issuing_agency) %>% 
  summarise(sum_fine = sum(fine)) %>%
  mutate(housing_ppa = ifelse(issuing_agency %in% c('HOUSING', 'PPA'),
                              'Y', 'N')) %>% 
  ggplot(aes(reorder(issuing_agency, sum_fine), sum_fine,
             color = housing_ppa)) +
  geom_point(size = 4) +
  labs(
    title = 'But PPA collects more money',
    subtitle = 'More than 100 times Housing\'s',
    x = NULL,
    y = 'Total collected (log scale)'
  ) + 
  coord_flip() +
  scale_y_log10(labels = scales::label_number_si(prefix = '$')) +
  scale_color_manual(values = c('darkslategrey', 'navyblue'), guide = FALSE) +
  theme_bw() + 
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        strip.placement = 'outside',
        panel.border = element_rect(color = 'slategrey'),
        title = element_text(colour = "darkslategrey"),
        strip.text = element_text(color = 'slategrey'),
        axis.ticks = element_line(color = 'lightslategrey'),
        axis.text = element_text(color = 'slategrey'))

total_log

Using patchwork to get the plots together.

final_plot <- means + total_log +
  plot_annotation(
    title = 'Volume > Value when talking abour Parking Violation Fines',
    subtitle = 'In Philadelphia PPA collects more money from parking tickets besides lowest value for fines issued',
    caption = 'Data from Open Data Philly for 2017',
    theme = theme(
      plot.title = element_text(color = 'darkslategrey'),
      plot.subtitle = element_text(color = 'darkslategrey'),
      plot.caption = element_text(color = 'lightslategrey')
      )
    )

final_plot

Tidy Tuesday 12/11/2019 Code in CRAN Packages

2019-11-12T00:00:00+00:00

Data description

From From TidyTuesdays github:

This week’s data is from the CRAN courtesy of Phillip Massicotte.

He analyzed the lines of code and the different languages in all of the R packages on CRAN.

Packages and data reading

library(tidyverse)

cran_code <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-11-12/loc_cran_packages.csv")

Quick look

cran_code %>% glimpse()

## Observations: 34,477
## Variables: 7
## $ file     <dbl> 2, 1, 23, 3, 30, 5, 1, 11, 10, 16, 6, 2, 1, 6, 15, 7, 1…
## $ language <chr> "R", "HTML", "R", "HTML", "R", "Markdown", "HTML", "R",…
## $ blank    <dbl> 96, 347, 63, 307, 224, 246, 26, 32, 104, 153, 101, 60, …
## $ comment  <dbl> 353, 5, 325, 9, 636, 0, 1, 202, 333, 62, 330, 46, 0, 0,…
## $ code     <dbl> 365, 2661, 676, 1275, 587, 418, 190, 141, 406, 882, 294…
## $ pkg_name <chr> "A3", "aaSEA", "aaSEA", "abbyyR", "abbyyR", "abbyyR", "…
## $ version  <chr> "1.0.0", "1.0.0", "1.0.0", "0.5.5", "0.5.5", "0.5.5", "…

Only one version of the packages?

cran_code %>% 
  select(pkg_name, version) %>% 
  distinct() %>% 
  group_by(pkg_name) %>% 
  count(version) %>% 
  filter(n>1)

## # A tibble: 0 x 3
## # … with 3 variables: pkg_name <chr>, version <chr>, n <int>

With this out of our way I think I’ll look into the tidyverse packages.

cran_code %>% 
  filter(
    pkg_name %in% c(
      "ggplot2",
      "dplyr",
      "tidyr",
      "readr",
      "purrr",
      "tibble",
      "stringr",
      "focats"
    ),
    language == "R"
  ) %>% 
  count(pkg_name, wt = file, sort = TRUE) %>% 
  mutate(pkg_name = fct_reorder(pkg_name, n)) %>% 
  ggplot(aes(pkg_name, n)) +
  geom_col(fill = "navyblue") +
  scale_y_continuous(expand = c(0,2)) +
  labs(
    title = "Number of R files for core tidyverse packages",
    subtitle = "ggplot2's the clear winner in this inception-like visualization",
    caption = "Source: CRAN",
    x = "Package name",
    y = "Number of R files"
  ) +
  coord_flip() +
  theme_bw() + 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        strip.placement = 'outside',
        panel.border = element_rect(color = 'lightslategrey'),
        title = element_text(colour = "slategrey"),
        strip.text = element_text(color = 'slategrey'),
        axis.ticks = element_line(color = 'lightslategrey'),
        axis.text = element_text(color = 'slategrey'))

Tidy Tuesday 05/11/2019 Modes Less Traveled - Bicycling and Walking to Work in the United States: 2008-2012

2019-11-05T00:00:00+00:00

Data description

From From TidyTuesdays github:

This week’s data is from the ACS Survey. The article and underlying data can be found at the Census Website. The PDF report is also available for download if you’d like to try reading in some of the embedded tables.

Please note that the raw excel files are uploaded (6 total), along with the cleaned/tidy data (commute.csv). There is also a cleaned up version of Table 3 from the article, which incorporates summary data around age, gender, race, children, income, and education for modes of travel (bike, walk, other). If you work with the ACS table 3 I’d suggest dplyr::slice() to grab the specific sub-tables from within it!

Packages and reading data

library(tidyverse)

commute_mode <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-11-05/commute.csv")

First look

commute_mode %>% glimpse()

## Observations: 3,496
## Variables: 9
## $ city         <chr> "Aberdeen city", "Acworth city", "Addison village",…
## $ state        <chr> "South Dakota", "Georgia", "Illinois", "California"…
## $ city_size    <chr> "Small", "Small", "Small", "Small", "Small", "Small…
## $ mode         <chr> "Bike", "Bike", "Bike", "Bike", "Bike", "Bike", "Bi…
## $ n            <dbl> 110, 0, 43, 0, 121, 0, 84, 23, 0, 576, 35, 77, 419,…
## $ percent      <dbl> 0.8, 0.0, 0.2, 0.0, 1.5, 0.0, 0.8, 0.2, 0.0, 1.5, 0…
## $ moe          <dbl> 0.5, 0.4, 0.3, 0.5, 1.0, 0.2, 1.1, 0.3, 0.2, 0.4, 0…
## $ state_abb    <chr> "SD", "GA", "IL", "CA", "MI", "MA", "CA", "SC", "AL…
## $ state_region <chr> "North Central", "South", "North Central", "West", …

I’ll look the percents, state_regions and city_size.

commute_mode %>% 
  filter(!is.na(state_region)) %>% 
  ggplot(aes(city_size, percent)) +
  geom_violin(color = "white", fill = "snow") +
  stat_summary(fun.y=mean, geom="point", size = 3, aes(group = 1, color = "mean")) +
  labs(
    title = "Walking and Bycicling to work by city size (US 2008-2012)",
    subtitle = "Some small cites walk/bike a lot, but the averages for all city sizes are very close",
    color = NULL,
    x = "City Size",
    y = "Percentage of population (Estimation)",
    caption = "Source: ACS Survey"
  ) +
  scale_y_continuous(labels = scales::percent_format(scale = 1)) +
  scale_color_manual(values = "darkred")  +
  facet_wrap(~mode) +
  theme_dark() +
  theme(
    title = element_text(colour = "darkslategrey"),
    legend.title = element_text(hjust = .5),
    legend.text = element_text(colour = "darkslategrey"),
    axis.ticks = element_line(color = 'lightslategrey'),
    axis.text = element_text(color = 'darkslategrey'),
    axis.line = element_blank(),
    axis.title.x = element_blank(), 
    panel.background = element_rect(fill = "grey30"),
    strip.background = element_rect(fill = "grey20"),
    legend.key = element_rect(fill = "snow")
  ) 

Makeover Monday 04/11/2019 Las Vegas Convention Attendance & Visitor Traffic

2019-11-04T00:00:00+00:00

2019/W45: Las Vegas Convention Attendance & Visitor Traffic

Data from here

Interactive plot

Load packages and import data

import pandas as pd
import altair as alt

df = pd.read_csv('https://query.data.world/s/n3pj6omagl3flwxbzs6mblkjroi45y', sep='\t', 
                 thousands=',', encoding='utf_16_le')
df.head()

	Year	Months	Visitor Volume	Convention Attendance	Room Inventory	Midweek Occupancy Percentage	Weekend Occupancy Percentage	Overall Occupancy Percentage	LVCVA Room Tax Collections	En/Deplaned Air Passenger	Clark County Gaming Revenue
0	1970	12	6787650	269129	25430	NaN	NaN	68.00%	3751265.0	4086973	369,286,977
1	1971	12	7361783	312347	26044	NaN	NaN	78.30%	4241630.0	4102285	399,410,972
2	1972	12	7954748	290794	26619	NaN	NaN	81.20%	4770716.0	4608764	476,126,720
3	1973	12	8474727	357248	29198	NaN	NaN	84.40%	5556312.0	5397017	588,221,779
4	1974	12	8664751	311908	32826	NaN	NaN	78.70%	6559315.0	5944433	684,714,502

So, every year has 12 months?

df.query('Months != 12')

	Year	Months	Visitor Volume	Convention Attendance	Room Inventory	Midweek Occupancy Percentage	Weekend Occupancy Percentage	Overall Occupancy Percentage	LVCVA Room Tax Collections	En/Deplaned Air Passenger	Clark County Gaming Revenue
49	2019	10	31880200	5164500	149050	86.7%	95.1%	89.2%	NaN	38500861	$7,753,090,000

Yes, except for the current one, 2019.

And a quick describe.

df.describe(include='all')

	Year	Months	Visitor Volume	Convention Attendance	Room Inventory	Midweek Occupancy Percentage	Weekend Occupancy Percentage	Overall Occupancy Percentage	LVCVA Room Tax Collections	En/Deplaned Air Passenger	Clark County Gaming Revenue
count	50.00000	50.000000	5.000000e+01	5.000000e+01	50.000000	37	37	50	4.900000e+01	5.000000e+01	50
unique	NaN	NaN	NaN	NaN	NaN	27	27	44	NaN	NaN	50
top	NaN	NaN	NaN	NaN	NaN	81.60%	93.50%	89.10%	NaN	NaN	476,126,720
freq	NaN	NaN	NaN	NaN	NaN	4	4	2	NaN	NaN	1
mean	1994.50000	11.960000	2.539469e+07	3.051318e+06	92756.660000	NaN	NaN	NaN	9.983591e+07	2.589947e+07	NaN
std	14.57738	0.282843	1.256754e+07	2.224790e+06	45366.843933	NaN	NaN	NaN	8.887047e+07	1.544387e+07	NaN
min	1970.00000	10.000000	6.787650e+06	2.691290e+05	25430.000000	NaN	NaN	NaN	3.751265e+06	4.086973e+06	NaN
25%	1982.25000	12.000000	1.204321e+07	8.432370e+05	50834.750000	NaN	NaN	NaN	1.907066e+07	1.030479e+07	NaN
50%	1994.50000	12.000000	2.860824e+07	2.804525e+06	89303.000000	NaN	NaN	NaN	7.687679e+07	2.743886e+07	NaN
75%	2006.75000	12.000000	3.737544e+07	5.106924e+06	133126.250000	NaN	NaN	NaN	1.648218e+08	4.119840e+07	NaN
max	2019.00000	12.000000	4.293610e+07	6.646200e+06	150593.000000	NaN	NaN	NaN	2.825960e+08	4.971658e+07	NaN

Some numeric values are not in the right type. So I’ll take a look and transform them.

df['Clark County Gaming Revenue']

      369,286,977
      399,410,972
      476,126,720
      588,221,779
      684,714,502
      770,336,695
      845,975,652
    1,015,463,342
    1,236,235,456
    1,423,620,102
   1,617,194,799
   1,676,148,606
   1,751,421,394
   1,887,451,717
   2,008,155,460
   2,256,762,736
   2,431,237,168
   2,789,336,000
   3,136,901,000
   3,430,851,000
   4,104,001,000
   4,152,407,000
   4,381,710,000
   4,727,424,000
   5,430,651,000
   5,717,567,000
   5,783,735,000
   6,152,415,000
   6,346,958,000
   7,210,700,000
   7,671,252,000
   7,636,547,000
   7,630,562,000
   7,830,856,000
   8,711,426,000
   9,717,322,000
  10,630,387,000
  10,868,464,000
   9,796,749,000
   8,838,261,000
   8,908,574,000
   9,222,677,000
   9,399,845,000
   9,674,404,000
   9,553,864,000
   9,617,671,000
   9,713,930,000
   9,978,503,000
  10,249,964,000
  $7,753,090,000
Name: Clark County Gaming Revenue, dtype: object

One value has a $ that is impeding the transformation to numeric. I’ll fix this and alo some other changes to make the data looks better in the plot and creating a new column to see proportion as

df_clean = df.copy()
df_clean['Clark County Gaming Revenue'] = pd.to_numeric(df_clean['Clark County Gaming Revenue'].str.replace('[,$]',''),
                                                       downcast='integer')
df_clean['Midweek Occupancy Percentage'] = pd.to_numeric(df_clean['Midweek Occupancy Percentage'].str.replace('%',''))
df_clean['Weekend Occupancy Percentage'] = pd.to_numeric(df_clean['Weekend Occupancy Percentage'].str.replace('%',''))
df_clean['Overall Occupancy Percentage'] = pd.to_numeric(df_clean['Overall Occupancy Percentage'].str.replace('%',''))

#Create new column
df_clean['Proportion'] = df_clean['Convention Attendance']/df_clean['Visitor Volume']
df_clean['Year'] = pd.to_datetime(df_clean['Year'], format='%Y')

df_clean.dtypes

Year                            datetime64[ns]
Months                                   int64
Visitor Volume                           int64
Convention Attendance                    int64
Room Inventory                           int64
Midweek Occupancy Percentage           float64
Weekend Occupancy Percentage           float64
Overall Occupancy Percentage           float64
LVCVA Room Tax Collections             float64
En/Deplaned Air Passenger                int64
Clark County Gaming Revenue              int64
Proportion                             float64
dtype: object

So the values are now in the correct format. Let’s see if there are NAs and make the visualization.

df_clean.isnull().sum()

Year                             0
Months                           0
Visitor Volume                   0
Convention Attendance            0
Room Inventory                   0
Midweek Occupancy Percentage    13
Weekend Occupancy Percentage    13
Overall Occupancy Percentage     0
LVCVA Room Tax Collections       1
En/Deplaned Air Passenger        0
Clark County Gaming Revenue      0
Proportion                       0
dtype: int64

Three variables have NA values but I’ll redo the original plot with two plots.

brush = alt.selection_interval(encodings=['x'],empty='all')

base_line_bar = alt.Chart(df_clean).encode(
    x=alt.X('Year', title=None),
    color=alt.condition(brush, alt.ColorValue('darkblue'), alt.ColorValue('gray')),
    tooltip=alt.Tooltip('year(Year):N')
).add_selection(
    brush
)

#Convention line/scatter
chart_convention = base_line_bar.mark_line(point=True, size=3).encode( 
    y=alt.Y('Convention Attendance', title='Number of attendees',
           axis=alt.Axis(format='~s'))
).properties(
    title='Convention Attendance',
    width=400,
    height=300*14/45
) 

#Visitor line/scatter
chart_visitors = base_line_bar.mark_line(point=True, size=3).encode( 
    y=alt.Y('Visitor Volume', title='Number of visitors',
           axis=alt.Axis(format='~s'))
).properties(
    title='Visitor Volume',
    width=400,
    height=300
)

#Conventionas proportion of total visitors
chart_proportion = base_line_bar.mark_bar().encode(
    y=alt.Y('Proportion', title=None,
           axis=alt.Axis(format='%'))
).properties(
    title='Share of Visitors from Conventions',
    width=400,
    height=300*14/45
) 

#Gaming Spending
chart_spending = base_line_bar.mark_line(
    point=True, size=3
).encode(
    y=alt.Y('Clark County Gaming Revenue', title='Dollars',
           axis=alt.Axis(format='~s')),
    color=alt.condition(brush, alt.ColorValue('darkgreen'), alt.ColorValue('gray'))
).properties(
    title='Clark County Gaming Revenue',
    width=400,
    height=300
)

final_chart = (
    (
        chart_convention & chart_visitors
    ) | (
        chart_proportion & chart_spending
    )
).properties(
    title = 'Las Vegas Visitors Info 1979 - 2019(October)'
).configure(
    background='Snow'
).configure_axis(
    grid=False,
    domain=False,
    titleFontSize=13,
    titleFontWeight='normal',
    titleColor='dimgray',
    labelColor='dimgray'
).configure_view(
    strokeWidth=0
).configure_title(
    fontSize=15,
    anchor='middle',
    color='darkslategray'
)

final_chart.save("../docs/assets/images/2019_11_04_MM.png")
final_chart.save('2019_11_04_MM.html')
final_chart

Tidy Tuesday 29/10/2019 NYC Squirrel Census

2019-10-29T00:00:00+00:00

Data description

From From TidyTuesdays github:

This week’s data is from the NYC Squirrel Census - raw data at NY Data portal.

H/t to Sara Stoudt for sharing this data, and Mine Cetinkaya-Rundel for her squirrel data package using the same data.

CityLab’s Linda Poon wrote an article using this data.

Data importing

library(tidyverse)

Now reading the data (using RCurl because my connection with regular curl is weird)

nyc_squirrels <- readr::read_csv(RCurl::getURL("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-29/nyc_squirrels.csv"))

Quick look

glimpse(nyc_squirrels)

## Observations: 3,023
## Variables: 36
## $ long                                       <dbl> -73.95613, -73.95704,…
## $ lat                                        <dbl> 40.79408, 40.79485, 4…
## $ unique_squirrel_id                         <chr> "37F-PM-1014-03", "37…
## $ hectare                                    <chr> "37F", "37E", "02E", …
## $ shift                                      <chr> "PM", "PM", "AM", "PM…
## $ date                                       <dbl> 10142018, 10062018, 1…
## $ hectare_squirrel_number                    <dbl> 3, 3, 3, 5, 1, 2, 2, …
## $ age                                        <chr> NA, "Adult", "Adult",…
## $ primary_fur_color                          <chr> NA, "Gray", "Cinnamon…
## $ highlight_fur_color                        <chr> NA, "Cinnamon", NA, N…
## $ combination_of_primary_and_highlight_color <chr> "+", "Gray+Cinnamon",…
## $ color_notes                                <chr> NA, NA, NA, NA, NA, N…
## $ location                                   <chr> NA, "Ground Plane", "…
## $ above_ground_sighter_measurement           <chr> NA, "FALSE", "4", "3"…
## $ specific_location                          <chr> NA, NA, NA, NA, NA, N…
## $ running                                    <lgl> FALSE, TRUE, FALSE, F…
## $ chasing                                    <lgl> FALSE, FALSE, FALSE, …
## $ climbing                                   <lgl> FALSE, FALSE, TRUE, T…
## $ eating                                     <lgl> FALSE, FALSE, FALSE, …
## $ foraging                                   <lgl> FALSE, FALSE, FALSE, …
## $ other_activities                           <chr> NA, NA, NA, NA, "unkn…
## $ kuks                                       <lgl> FALSE, FALSE, FALSE, …
## $ quaas                                      <lgl> FALSE, FALSE, FALSE, …
## $ moans                                      <lgl> FALSE, FALSE, FALSE, …
## $ tail_flags                                 <lgl> FALSE, FALSE, FALSE, …
## $ tail_twitches                              <lgl> FALSE, FALSE, FALSE, …
## $ approaches                                 <lgl> FALSE, FALSE, FALSE, …
## $ indifferent                                <lgl> FALSE, FALSE, TRUE, F…
## $ runs_from                                  <lgl> FALSE, TRUE, FALSE, T…
## $ other_interactions                         <chr> NA, "me", NA, NA, NA,…
## $ lat_long                                   <chr> "POINT (-73.956134493…
## $ zip_codes                                  <dbl> NA, NA, NA, NA, NA, N…
## $ community_districts                        <dbl> 19, 19, 19, 19, 19, 1…
## $ borough_boundaries                         <dbl> 4, 4, 4, 4, 4, 4, 4, …
## $ city_council_districts                     <dbl> 19, 19, 19, 19, 19, 1…
## $ police_precincts                           <dbl> 13, 13, 13, 13, 13, 1…

I’ll look at how high the squirrels go.

How high care the squirrels?

nyc_squirrels %>% 
  select(location, above_ground_sighter_measurement) %>% 
  summary()

##    location         above_ground_sighter_measurement
##  Length:3023        Length:3023                     
##  Class :character   Class :character                
##  Mode  :character   Mode  :character

Not a lot of sense in above_ground being a character, let’s change that. And since I’ll be making two bar plots it’s easier to make two datasets.

squirrels_above_below <- nyc_squirrels %>% 
  select(location) %>% 
  filter(!is.na(location)) %>% 
  count(location, name = "location_prop") %>% 
  mutate(location_prop = location_prop/sum(location_prop))

squirrels_above_below

## # A tibble: 2 x 2
##   location     location_prop
##   <chr>                <dbl>
## 1 Above Ground         0.285
## 2 Ground Plane         0.715

Now making a data frame for the squirrels sighter measurements.

squirrels_sight_measures <- nyc_squirrels %>% 
  filter(location == "Above Ground") %>% 
  select(above_ground_sighter_measurement) %>% 
  mutate(above_ground_sighter_measurement = parse_number(above_ground_sighter_measurement))

squirrels_sight_measures %>% summary()

##  above_ground_sighter_measurement
##  Min.   :  0.00                  
##  1st Qu.:  5.00                  
##  Median : 10.00                  
##  Mean   : 15.21                  
##  3rd Qu.: 20.00                  
##  Max.   :180.00                  
##  NA's   :50

So the values have 50 NAs, and mostly distributed around 5 and 20.

squirrels_sight_measures <- squirrels_sight_measures %>% 
  mutate(height_category = case_when(
    is.na(above_ground_sighter_measurement) ~ "Unknown",
    above_ground_sighter_measurement < 5 ~ "0-5",
    above_ground_sighter_measurement < 10 ~ "5-10",
    above_ground_sighter_measurement < 15 ~ "10-15",
    above_ground_sighter_measurement < 20 ~ "15-20",
    above_ground_sighter_measurement >= 20 ~ ">20"
  ),
  height_category = factor(height_category, levels = c("Unknown", "0-5", "5-10", 
                                                  "10-15", "15-20", ">20"),
                           ordered = TRUE)
  ) %>% 
  count(height_category, name = "above_prop") %>% 
  mutate(above_prop = above_prop/sum(above_prop))

Great, so now I’ll make a stacked bar chart.

ggplot() +
  geom_col(data = squirrels_above_below,
           aes(x = 1, y = location_prop, fill = location),
           position ="fill", width = .5, color = "white") +
  geom_text(data = squirrels_above_below, 
            aes(x = 1, y = location_prop,  label = location, group = location),
            color = "white", position = position_stack(.8, reverse = FALSE)) +
  geom_col(data = squirrels_sight_measures, 
           aes(x = 2, y = above_prop, fill = height_category), 
           position = position_fill(reverse = TRUE), width = .5, color = "white") + 
  geom_text(data = squirrels_sight_measures,
           aes(x = 2, y = above_prop, label = scales::percent(above_prop)),
           color = "white", position = position_stack(.5)) + 
  geom_segment(data = squirrels_above_below %>% filter(location == "Ground Plane"), 
               aes(x = 1 + .5/2, xend = 2-.5/2, y = location_prop, yend = 0),
               color = "white") +
  geom_segment(aes(x = 1 + .5/2, xend = 2-.5/2, y = .999, yend = .999),
               color = "white") +
  labs(
    title = "Most squirrels are spoted at ground level",
    subtitle = "But the ones that are seen above can go really high",
    caption = "Source: NYC Squirrel Census"
  ) +
  scale_fill_manual("Height of\n sighting",
                    values = c(">20" = "#08519c", "15-20" = "#3182bd",
                               "10-15" = "#6baed6", "5-10" = "#9ecae1",
                               "0-5" = "#c6dbef", "Unknown" = "grey60",
                               "Above Ground" = "darkblue",
                               "Ground Plane" = "grey30"),
                    breaks=c(">20", "15-20", "10-15", "5-10", "0-5",
                             "Unknown", NULL, NULL)) +
  scale_y_continuous(NULL, labels = scales::percent) +
  scale_x_continuous(NULL, labels = NULL, breaks = NULL, expand = c(.1,.1)) +
    theme(panel.background = element_rect(fill = "grey10"),
          panel.grid = element_blank())  

Makeover Monday 28/10/2019 World Cities Ranked by Annual Sunshine Hours

2019-10-28T00:00:00+00:00

Week 44 World Cities Ranked by Annual Sunshine Hours

Data from here

Load packages and import data

import pandas as pd
import altair as alt

df = pd.read_excel('https://query.data.world/s/k5e6ouinen6qpkowpudpowkepydrah')
df.head()

	Continent	Country	City	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec	Year
0	Africa	Ivory Coast	Gagnoa	183.0	180.0	196.0	188.0	181.0	118.0	97.0	80.0	110.0	155.0	171.0	164.0	1823.0
1	Africa	Ivory Coast	Bouaké	242.0	224.0	219.0	194.0	208.0	145.0	104.0	82.0	115.0	170.0	191.0	198.0	2092.0
2	Africa	Ivory Coast	Abidjan	223.0	223.0	239.0	214.0	205.0	128.0	137.0	125.0	139.0	215.0	224.0	224.0	2296.0
3	Africa	Ivory Coast	Odienné	242.0	220.2	217.3	214.7	248.8	221.8	183.5	174.5	185.4	235.8	252.0	242.6	2638.6
4	Africa	Ivory Coast	Ferké	279.0	249.0	253.0	229.0	251.0	221.0	183.0	151.0	173.0	245.0	261.0	262.0	2757.0

So we have a line for each country/city and a column for each month. In ggplot, and probably Altair, it’s not ideal, so I’ll try to create a month column.

df_pivot = df.melt(['Continent', 'Country', 'City', 'Year'], var_name= 'Month', value_name = 'Sunshine')
df_pivot.head()

	Continent	Country	City	Year	Month	Sunshine
0	Africa	Ivory Coast	Gagnoa	1823.0	Jan	183.0
1	Africa	Ivory Coast	Bouaké	2092.0	Jan	242.0
2	Africa	Ivory Coast	Abidjan	2296.0	Jan	223.0
3	Africa	Ivory Coast	Odienné	2638.6	Jan	242.0
4	Africa	Ivory Coast	Ferké	2757.0	Jan	279.0

Now creating variables for minimum/maximum monthly sunshine.

#### data frame with max vs min sunshine time
df_plot=df.drop(columns='Year')
df_plot['max_sunshine']=df_plot.loc[:, 'Jan':'Dec'].max(1)
df_plot['min_sunshine']=df_plot.loc[:, 'Jan':'Dec'].min(1)
df_plot.head()

	Continent	Country	City	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec	max_sunshine	min_sunshine
0	Africa	Ivory Coast	Gagnoa	183.0	180.0	196.0	188.0	181.0	118.0	97.0	80.0	110.0	155.0	171.0	164.0	196.0	80.0
1	Africa	Ivory Coast	Bouaké	242.0	224.0	219.0	194.0	208.0	145.0	104.0	82.0	115.0	170.0	191.0	198.0	242.0	82.0
2	Africa	Ivory Coast	Abidjan	223.0	223.0	239.0	214.0	205.0	128.0	137.0	125.0	139.0	215.0	224.0	224.0	239.0	125.0
3	Africa	Ivory Coast	Odienné	242.0	220.2	217.3	214.7	248.8	221.8	183.5	174.5	185.4	235.8	252.0	242.6	252.0	174.5
4	Africa	Ivory Coast	Ferké	279.0	249.0	253.0	229.0	251.0	221.0	183.0	151.0	173.0	245.0	261.0	262.0	279.0	151.0

selection = alt.selection_multi(fields=['Continent'])
color = alt.condition(selection,
                    alt.Color('Continent:N'),
                    alt.value('lightgray'))

base_chart = alt.Chart(df_plot).mark_point().encode(
    y=alt.Y('min_sunshine', title='Minimun monthly sunshine hours'),
    x=alt.X('max_sunshine',scale=alt.Scale(domain=[50, 450]),
            title='Maximum monthly sunshine hours'),
    color=color,
    tooltip=['Country','City']
).add_selection(
    selection
)

df_line = pd.DataFrame({'x': [250], 'y': [150]})
v_line = alt.Chart(df_line).mark_rule(color='black', strokeWidth=1).encode(x='x:Q')
h_line = alt.Chart(df_line).mark_rule(color='black', strokeWidth=1).encode(y='y:Q')

chart = (base_chart+v_line+h_line).configure(
    background='Snow'
).properties(
    title='How does sunshine hours change between the sunniest and least sunny months?',
    width=600,
    height=450
).configure_legend(
    orient='top',
    title=None,
    offset=5
).configure_axis(
    grid=False,
    domain=False,
    titleFontSize=11,
    titleFontWeight='normal',
    titleColor='slategray',
    labelColor='slategray'
).configure_view(
    strokeWidth=1,
    stroke='slategrey'
).configure_title(
    fontSize=15,
    anchor='start',
    color='gray'
)

chart.save("../docs/assets/images/2019_10_28_MM.png")
chart.save('2019_10_28_MM.html')

Static view of the plot as a png:

Interactive view:

Tidy Tuesday 22/10/2019 Horror Movies Metadata

2019-10-22T00:00:00+00:00

Data description

From From TidyTuesdays github:

This week’s data is from the IMDB by way of Kaggle.

H/t to Georgios Karamanis for sharing the data this week.

Thrillist did a 75 Best Horror Movies of all Time article. There’s also a Stephen Follows article about horror movies exploring data around profit, popularity and ratings.

Last year for Halloween we focused on Horror Movie Profit - feel free to take a peek at that data as well on our GitHub.

Import data and packages

library(tidyverse) #data collection, manipulation and plots
library(tidytext) #text manipulation
library(scales) #number format transforming
library(here) #make sure the figures are in the right place
library(RCurl) #because curl is giving me a headache

horror_movies <- readr::read_csv(RCurl::getURL(
  "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-22/horror_movies.csv"
  ))

Data

glimpse(horror_movies)

## Observations: 3,328
## Variables: 12
## $ title             <chr> "Gut (2012)", "The Haunting of Mia Moss (2017)…
## $ genres            <chr> "Drama| Horror| Thriller", "Horror", "Horror",…
## $ release_date      <chr> "26-Oct-12", "13-Jan-17", "21-Oct-17", "23-Apr…
## $ release_country   <chr> "USA", "USA", "Canada", "USA", "USA", "UK", "U…
## $ movie_rating      <chr> NA, NA, NA, "NOT RATED", NA, NA, "NOT RATED", …
## $ review_rating     <dbl> 3.9, NA, NA, 3.7, 5.8, NA, 5.1, 6.5, 4.6, 5.4,…
## $ movie_run_time    <chr> "91 min", NA, NA, "82 min", "80 min", "93 min"…
## $ plot              <chr> "Directed by Elias. With Jason Vail, Nicholas …
## $ cast              <chr> "Jason Vail|Nicholas Wilder|Sarah Schoofs|Kirs…
## $ language          <chr> "English", "English", "English", "English", "I…
## $ filming_locations <chr> "New York, USA", NA, "Sudbury, Ontario, Canada…
## $ budget            <chr> NA, "$30,000", NA, NA, NA, "$3,400,000", NA, N…

I think I’ll go for some text mining and look for the plots. First some tokenizing.

#creating a ata frame with digrams
horror_token <- horror_movies %>% 
  select(plot, genres) %>%
  unnest_tokens("genre", genres, token = "ngrams", n =2) %>% 
  filter(str_detect(genre, "fi", negate = TRUE),
         str_detect(genre, "horror")) %>% 
  distinct()

I’ll make a pie chart with the proportion of released movies in all years. But first I have to create the labels.

#vector with the 5 most common digrams
most_common <- horror_token %>% 
  group_by(genre) %>% 
  summarise(n = n()) %>% 
  top_n(5, n) %>% 
  select(genre) %>% 
  as_vector() %>% 
  unname()

#fucntion to capitalize categories. Stolen from R 
 .simpleCap <- function(x) {
    s <- strsplit(x, " ")[[1]]
    paste(toupper(substring(s, 1, 1)), substring(s, 2),
          sep = "", collapse = " ")
}

Then I create a table with the proportion of each of the selected categories.

 horror_token %>% 
  mutate(top = case_when(
    genre == "horror sci" ~ "Sci-fi",
    genre %in% most_common ~  str_remove(genre, "\\s?horror\\s?"),
    TRUE ~ "Other"
  )) %>%
  group_by(top) %>%
  count() %>% 
  ungroup() %>% 
  transmute(n = n/sum(n),
            top = map_chr(top, .simpleCap),
         top = fct_reorder(top, n)) %>% 
  ggplot(aes(x = "", y = n, fill = top)) +
  geom_bar(stat = "identity", width = 1, size = 1, color = "grey30") +
  geom_text(aes(label = percent(n, accuracy = 1)),
            position = position_stack(vjust = .55),
            color = "snow", fontface = "bold") +
  labs(
    title = "Rejoice horror fans... \'cause it\'s thriller night", 
    subtitle = "Thriller was the genre that most appeared associated with horror in 2011-2017",
    fill ="Other genre in \nhorror movies",
    caption = "Source: Imdb"
  ) +
  guides(fill = guide_legend(reverse = TRUE, override.aes = c(size = .5))) +
  scale_fill_manual(values = c("#FF8500", "#090714", "#792B17",
                               "#7C12A6", "#2A361E", "#181393")) +
  coord_polar("y", start = 0) +
  theme_minimal() +
  theme(
    plot.background = element_rect(fill = "grey20"),
    plot.title = element_text(color = "snow", face = "bold"),
    plot.subtitle = element_text(color = "snow"),
    plot.caption = element_text(color = "snow",
                                hjust = 1.41),
    panel.grid = element_blank(),
    legend.background = element_rect(fill = "grey20",
                                     color = "grey20"),
    legend.text = element_text(color = "snow"),
    legend.title = element_text(color = "snow"),
    legend.box.margin = margin(1,3,1,1),
    axis.line = element_blank(),
    axis.text = element_blank(),
    axis.title = element_blank()
  )

Makeover Monday 21/10/2019 The age at which most people are dying by suicide

2019-10-21T00:00:00+00:00

Data description

Week 43 of Makeover Monday in 2019.

Number of people dying by suicide by single year of age, England and Wales, deaths registered between 1993 and 2017

About the visualization

Idecided to look down 3 age groups and see how each of them changed with time. This way reminding the audience that any age group can be affected and maybe opening space for some insights.

I tried to make the visualization as respectful as possible since the data is from a delicate matter.

Plot

Made in excel and turned into a gif. Here is the gif and then the visualizations. They also work in a scrolling manner.

Gif

Plots

Tidy Tuesday 15/10/2019 Big Mtcars

2019-10-15T00:00:00+00:00

Data description

From From TidyTuesdays github:

This week’s data is from the EPA. The full data dictionary can be found at fueleconomy.gov.

It’s essentially a much much larger and updated dataset covering mtcars, the dataset we all know a bit too well!

H/t to Ellis Hughes who had a recent blogpost covering this dataset.

Import data and packages

library(tidyverse)
library(scales)
library(Cairo)

big_epa_cars <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv")

Data

str(big_epa_cars)

## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 41804 obs. of  83 variables:
##  $ barrels08      : num  15.7 30 12.2 30 17.3 ...
##  $ barrelsA08     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ charge120      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ charge240      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ city08         : num  19 9 23 10 17 21 22 23 23 23 ...
##  $ city08U        : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ cityA08        : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ cityA08U       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ cityCD         : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ cityE          : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ cityUF         : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ co2            : num  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ co2A           : num  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ co2TailpipeAGpm: num  0 0 0 0 0 0 0 0 0 0 ...
##  $ co2TailpipeGpm : num  423 808 329 808 468 ...
##  $ comb08         : num  21 11 27 11 19 22 25 24 26 25 ...
##  $ comb08U        : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ combA08        : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ combA08U       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ combE          : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ combinedCD     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ combinedUF     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ cylinders      : num  4 12 4 8 4 4 4 4 4 4 ...
##  $ displ          : num  2 4.9 2.2 5.2 2.2 1.8 1.8 1.6 1.6 1.8 ...
##  $ drive          : chr  "Rear-Wheel Drive" "Rear-Wheel Drive" "Front-Wheel Drive" "Rear-Wheel Drive" ...
##  $ engId          : num  9011 22020 2100 2850 66031 ...
##  $ eng_dscr       : chr  "(FFS)" "(GUZZLER)" "(FFS)" NA ...
##  $ feScore        : num  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ fuelCost08     : num  1900 3600 1450 3600 2600 1800 1600 1650 1550 1600 ...
##  $ fuelCostA08    : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ fuelType       : chr  "Regular" "Regular" "Regular" "Regular" ...
##  $ fuelType1      : chr  "Regular Gasoline" "Regular Gasoline" "Regular Gasoline" "Regular Gasoline" ...
##  $ ghgScore       : num  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ ghgScoreA      : num  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ highway08      : num  25 14 33 12 23 24 29 26 31 30 ...
##  $ highway08U     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ highwayA08     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ highwayA08U    : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ highwayCD      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ highwayE       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ highwayUF      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ hlv            : num  0 0 19 0 0 0 0 0 0 0 ...
##  $ hpv            : num  0 0 77 0 0 0 0 0 0 0 ...
##  $ id             : num  1 10 100 1000 10000 ...
##  $ lv2            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ lv4            : num  0 0 0 0 14 15 15 13 13 13 ...
##  $ make           : chr  "Alfa Romeo" "Ferrari" "Dodge" "Dodge" ...
##  $ model          : chr  "Spider Veloce 2000" "Testarossa" "Charger" "B150/B250 Wagon 2WD" ...
##  $ mpgData        : chr  "Y" "N" "Y" "N" ...
##  $ phevBlended    : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ pv2            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ pv4            : num  0 0 0 0 90 88 88 89 89 89 ...
##  $ range          : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ rangeCity      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ rangeCityA     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ rangeHwy       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ rangeHwyA      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ trany          : chr  "Manual 5-spd" "Manual 5-spd" "Manual 5-spd" "Automatic 3-spd" ...
##  $ UCity          : num  23.3 11 29 12.2 21 ...
##  $ UCityA         : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ UHighway       : num  35 19 47 16.7 32 ...
##  $ UHighwayA      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ VClass         : chr  "Two Seaters" "Two Seaters" "Subcompact Cars" "Vans" ...
##  $ year           : num  1985 1985 1985 1985 1993 ...
##  $ youSaveSpend   : num  -2250 -10750 0 -10750 -5750 ...
##  $ guzzler        : logi  NA TRUE NA NA NA NA ...
##  $ trans_dscr     : chr  NA NA "SIL" NA ...
##  $ tCharger       : logi  NA NA NA NA TRUE NA ...
##  $ sCharger       : chr  NA NA NA NA ...
##  $ atvType        : chr  NA NA NA NA ...
##  $ fuelType2      : logi  NA NA NA NA NA NA ...
##  $ rangeA         : logi  NA NA NA NA NA NA ...
##  $ evMotor        : logi  NA NA NA NA NA NA ...
##  $ mfrCode        : logi  NA NA NA NA NA NA ...
##  $ c240Dscr       : logi  NA NA NA NA NA NA ...
##  $ charge240b     : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ c240bDscr      : logi  NA NA NA NA NA NA ...
##  $ createdOn      : chr  "Tue Jan 01 00:00:00 EST 2013" "Tue Jan 01 00:00:00 EST 2013" "Tue Jan 01 00:00:00 EST 2013" "Tue Jan 01 00:00:00 EST 2013" ...
##  $ modifiedOn     : chr  "Tue Jan 01 00:00:00 EST 2013" "Tue Jan 01 00:00:00 EST 2013" "Tue Jan 01 00:00:00 EST 2013" "Tue Jan 01 00:00:00 EST 2013" ...
##  $ startStop      : logi  NA NA NA NA NA NA ...
##  $ phevCity       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ phevHwy        : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ phevComb       : num  0 0 0 0 0 0 0 0 0 0 ...
##  - attr(*, "problems")=Classes 'tbl_df', 'tbl' and 'data.frame': 26930 obs. of  5 variables:
##   ..$ row     : int  4430 4431 4432 4433 4442 4443 4444 4448 4449 4450 ...
##   ..$ col     : chr  "guzzler" "guzzler" "guzzler" "guzzler" ...
##   ..$ expected: chr  "1/0/T/F/TRUE/FALSE" "1/0/T/F/TRUE/FALSE" "1/0/T/F/TRUE/FALSE" "1/0/T/F/TRUE/FALSE" ...
##   ..$ actual  : chr  "G" "G" "G" "G" ...
##   ..$ file    : chr  "'https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv'" "'https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv'" "'https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv'" "'https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv'" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   barrels08 = col_double(),
##   ..   barrelsA08 = col_double(),
##   ..   charge120 = col_double(),
##   ..   charge240 = col_double(),
##   ..   city08 = col_double(),
##   ..   city08U = col_double(),
##   ..   cityA08 = col_double(),
##   ..   cityA08U = col_double(),
##   ..   cityCD = col_double(),
##   ..   cityE = col_double(),
##   ..   cityUF = col_double(),
##   ..   co2 = col_double(),
##   ..   co2A = col_double(),
##   ..   co2TailpipeAGpm = col_double(),
##   ..   co2TailpipeGpm = col_double(),
##   ..   comb08 = col_double(),
##   ..   comb08U = col_double(),
##   ..   combA08 = col_double(),
##   ..   combA08U = col_double(),
##   ..   combE = col_double(),
##   ..   combinedCD = col_double(),
##   ..   combinedUF = col_double(),
##   ..   cylinders = col_double(),
##   ..   displ = col_double(),
##   ..   drive = col_character(),
##   ..   engId = col_double(),
##   ..   eng_dscr = col_character(),
##   ..   feScore = col_double(),
##   ..   fuelCost08 = col_double(),
##   ..   fuelCostA08 = col_double(),
##   ..   fuelType = col_character(),
##   ..   fuelType1 = col_character(),
##   ..   ghgScore = col_double(),
##   ..   ghgScoreA = col_double(),
##   ..   highway08 = col_double(),
##   ..   highway08U = col_double(),
##   ..   highwayA08 = col_double(),
##   ..   highwayA08U = col_double(),
##   ..   highwayCD = col_double(),
##   ..   highwayE = col_double(),
##   ..   highwayUF = col_double(),
##   ..   hlv = col_double(),
##   ..   hpv = col_double(),
##   ..   id = col_double(),
##   ..   lv2 = col_double(),
##   ..   lv4 = col_double(),
##   ..   make = col_character(),
##   ..   model = col_character(),
##   ..   mpgData = col_character(),
##   ..   phevBlended = col_logical(),
##   ..   pv2 = col_double(),
##   ..   pv4 = col_double(),
##   ..   range = col_double(),
##   ..   rangeCity = col_double(),
##   ..   rangeCityA = col_double(),
##   ..   rangeHwy = col_double(),
##   ..   rangeHwyA = col_double(),
##   ..   trany = col_character(),
##   ..   UCity = col_double(),
##   ..   UCityA = col_double(),
##   ..   UHighway = col_double(),
##   ..   UHighwayA = col_double(),
##   ..   VClass = col_character(),
##   ..   year = col_double(),
##   ..   youSaveSpend = col_double(),
##   ..   guzzler = col_logical(),
##   ..   trans_dscr = col_character(),
##   ..   tCharger = col_logical(),
##   ..   sCharger = col_character(),
##   ..   atvType = col_character(),
##   ..   fuelType2 = col_logical(),
##   ..   rangeA = col_logical(),
##   ..   evMotor = col_logical(),
##   ..   mfrCode = col_logical(),
##   ..   c240Dscr = col_logical(),
##   ..   charge240b = col_double(),
##   ..   c240bDscr = col_logical(),
##   ..   createdOn = col_character(),
##   ..   modifiedOn = col_character(),
##   ..   startStop = col_logical(),
##   ..   phevCity = col_double(),
##   ..   phevHwy = col_double(),
##   ..   phevComb = col_double()
##   .. )

big_epa_cars %>%
  select(make, youSaveSpend, year, fuelType1) %>% 
  group_by(make) %>% 
  mutate(count = n()) %>% 
  ungroup() %>% 
  mutate(isSaving = factor(ifelse(
    youSaveSpend > 0, "yes", "no"
  ), levels = c("yes", "no"))) %>% 
  ggplot(aes(year, youSaveSpend)) + 
  geom_point(aes(color = isSaving), size = .3) +
  geom_smooth(se = FALSE, color = "blue3", size = .7) +
  labs(
    title = "Some type of fuels are more associated with economical cars",
    subtitle = "Gasoline cars are moving towards bigger savings",
    y = "Savings compared to an average car over 5 years",
    color = "Is saving?"
  ) +
  facet_wrap(~fuelType1)+
  scale_color_manual(values = c("#01d28e", "#e25822")) + 
  scale_y_continuous(label = number_format(scale = 1/1000, prefix = "$",
                                         suffix = "k")) + 
  guides(color = guide_legend(override.aes = list(size=1.3))) +
  theme_dark() +
  theme(
    title = element_text(colour = "darkslategrey"),
    legend.title = element_text(hjust = .5),
    panel.grid = element_blank(),
    legend.text = element_text(colour = "darkslategrey"),
    axis.ticks = element_line(color = 'lightslategrey'),
    axis.text = element_text(color = 'darkslategrey'),
    axis.line = element_blank(),
    axis.title.x = element_blank(), 
    panel.background = element_rect(fill = "grey30"),
    strip.background = element_rect(fill = "grey20")
  ) 

Storytelling with data 10/2019 Improve this table

2019-10-09T00:00:00+00:00

My first Storytelling with data challenge. From October 2019.

Data description

From From Storytelling with data:

Import packages

library(tidyverse)
library(scales)
library(Cairo)
theme_set(theme_classic())

Data

Ex_1 <- tribble(
~Tier,	~Number_Account,	~Percentage_Accounts, ~Revenue_M, ~Percentage_Revenue,
'A',	77, 	7.08,	4.68,	25,
  'A+',	19, 	1.75,	3.93,	21,
  'B',	338, 	31.07,	5.98,	32,
  'C',	425, 	39.06,	2.81,	15,
  'D',	24, 	2.21,	0.37,	2
) %>% 
  mutate(
    class = ifelse((Percentage_Accounts - Percentage_Revenue) < 0, 'blue', 'slategrey')
    )

Plot

I decided to make a modified slope graph to show the differences between the two tipes of shares. Looking back it would probably be better with two stacked, and connected, bar graphs but it was worth a shot.

First some accessory variables.

left_label <- Ex_1$Tier
positions_y <- Ex_1$Percentage_Accounts
positions_y[c(2,5)] <- positions_y[c(2,5)] + c(-.5,.5)

Then the plot.

ggplot(Ex_1) + 
  geom_segment(aes(x=1, xend=2, y=Percentage_Accounts, yend=Percentage_Revenue, col=class), 
               size=.75, show.legend=F) + 
  geom_vline(xintercept=1, linetype="dashed", size=.1, color = 'lightslategrey') + 
  geom_vline(xintercept=2, linetype="dashed", size=.1, color = 'lightslategrey') +
  scale_color_manual(labels = c("Up", "Down"), 
                     values = c("slategrey"="slategrey", "blue"="blue")) +  # color of lines
  labs(x="", y="",
       title = 'New Client tier share changes when looking at Accounts or Revenue') +  # Axis labels
  scale_x_continuous(limits = c(.5, 2.5), breaks = NULL) + 
  scale_y_continuous(
    limits = c(0,(1.1*(max(Ex_1$Percentage_Accounts, Ex_1$Percentage_Revenue)))),
    labels = percent_format(scale = 1)
    ) +
  geom_text(
    label=left_label, y=positions_y, 
    x=c(.99,1.005,.99,.99,.99), hjust=1.2, size=3
    ) +
  geom_text(
    label=left_label, y=Ex_1$Percentage_Revenue, 
    x=c(2.01,2.01,2.01,2.01,2.01), hjust=-.2, size=3
  ) +
  geom_text(
    label="Participation\nin Accounts", x=.68, y = 1.1*(max(Ex_1$Percentage_Accounts, Ex_1$Percentage_Revenue)),
    hjust=0, size=4.3, color = 'darkslategrey') +
  geom_text(
    label="Participation\nin Revenue", x=2.02, y = 1.1*(max(Ex_1$Percentage_Accounts, Ex_1$Percentage_Revenue)),
    hjust=0, size=4.3, color = 'darkslategrey') +
  geom_text(
    label = "C tier has low participation in \nrevenues despite the biggest \nshare of new accounts.",
    x = 2.1, y = 30, hjust = 0, size = 3.5, color = 'slategrey'
  ) +
  geom_text(
    label = "Together A and A+ make up for \nalmost half of the revenue \ndespite low share of \naccounts.",
    x = 2.1, y = 20, hjust = 0, size = 3.5, color = 'blue'
  ) +
  theme(panel.background = element_blank(), 
        panel.grid = element_blank(),
        axis.ticks.y = element_line(color = 'lightslategrey'),
        axis.text.x = element_blank(),
        axis.line.x = element_blank(),
        axis.line.y = element_line(color = 'lightslategrey'),
        axis.text.y = element_text(color = 'lightslategrey'),
        panel.border = element_blank(),
        title = element_text(colour = "darkslategrey", face = 'bold'))

Saved with Cairo package because windows render is not so good.

path <- paste0(here::here("docs", "assets", "images"),"/", '2019_10_SWD.png')
ggsave(path, type = 'cairo', scale = 1.5)