plotly on R Views

State Unemployment Claims

Thu, 16 Apr 2020 00:00:00 +0000

In today’s Reproducible Finance post, we will explore state-level unemployment claims which get released every Thursday. The last few weeks have shown huge spikes in those claims, of course, due to the coronavirus and statewide lockdown orders, and it got me wondering how these times will look to data scientists in the future.

Let’s start by importing unemployment insurance claims data for Georgia. This is a data series that’s reported by all 50 states.

We can grab this data from FRED using tq_get() from the tidyquant package. The FRED code for Georgia unemployment claims is GAICLAIMS.

ga_claims <- 
  "GAICLAIMS" %>% 
  tq_get(get = "economic.data", 
         from = "1999-01-01") %>% 
  rename(claims = price) 

ga_claims %>% 
  slice(1, n())

# A tibble: 2 x 2
  date       claims
  <date>      <int>
1 1999-01-02   9674
2 2020-04-11 319581

For now, a quick visualization reveals what looks like a season pattern, with regular spikes in unemployment claims.

(
ga_claims %>% 
  ggplot(aes(x = date, y = claims)) +
  geom_line(color = "cornflowerblue")  +
  labs(
    x = "",
    y = "",
    title = "Georgia Unemployment Claims",
    subtitle = str_glue("{min(ga_claims$date)} through {max(ga_claims$date)}")
  ) +
  theme_minimal() +
  scale_y_continuous(labels = scales::comma)
) %>% ggplotly()

Let’s investigate this a bit further and look for a trend in average monthly claims by creating a series of faceted density plots. Notice how we can use str_glue() to pass in the dates for the subtitle, a nice trick learned from a Business Science Learning Lab that I use in almost all my plots now, either for titles, subtitles or hover text in plotly.

ga_claims %>%
  mutate(
    year = year(date),
    month =  month(date, label = T, abbr  = T),
    week = week(date)
  ) %>%
  group_by(year, month) %>%
  filter(n() >= 4) %>% 
  summarise(avg_claims = mean(claims)) %>%
  ggplot(aes(x = avg_claims)) +
  geom_density(aes(fill = as_factor(month))) +
  facet_grid(rows = vars(as_factor(month))) +
  guides(fill = guide_legend(title = "")) +
  labs(
    title = "Distribution of Avg Monthly Claims",
    subtitle = str_glue("{min(ga_claims$date)} through {max(ga_claims$date)}"),
    y = "",
    x = ""
  ) +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank()) +
  scale_x_continuous(labels = scales::comma)

January and December appear to have the density distribution most skewed to the right, meaning those months that have tended to show the highest number of unemployment claims.

Now let’s build a heat map to investigate months by year.

We’ll first create a column to hold the year and month for each observation.

ga_claims %>% 
  mutate(year = year(date),
         month=  month(date, label = T, abbr  = T)) %>% 
  head()

# A tibble: 6 x 4
  date       claims  year month
  <date>      <int> <dbl> <ord>
1 1999-01-02   9674  1999 Jan  
2 1999-01-09  19455  1999 Jan  
3 1999-01-16  20506  1999 Jan  
4 1999-01-23  12932  1999 Jan  
5 1999-01-30  10871  1999 Jan  
6 1999-02-06   7997  1999 Feb

Next, we calculate the average number of claims for each month of each year. We start with a group_by(year, month) before a call to summarise().

ga_claims %>% 
  mutate(year = year(date),
         month=  month(date, label = T, abbr  = T)) %>%
  group_by(year, month) %>%
  summarise(avg_claims = mean(claims)) %>% 
  head()

# A tibble: 6 x 3
# Groups:   year [1]
   year month avg_claims
  <dbl> <ord>      <dbl>
1  1999 Jan       14688.
2  1999 Feb        7871.
3  1999 Mar        6095.
4  1999 Apr        6522.
5  1999 May        5451.
6  1999 Jun        5987.

That’s the data we want to chart but I want to add one more column with a slightly different format, one that uses a k for the thousands place, so we can stick these numbers into a chart. That is, instead of 14687.60, I’d like to display 14.7K.

We can use the number_format() function from the scales package to accomplish this. We set the accuracy to .1 to indicate that we want to round off and show the .1 decimal. We set scale to 1/1000 to indicate the scaling factor and choose k as the suffix.

ga_claims %>%
  mutate(year = year(date),
         month =  month(date, label = T, abbr  = T)) %>%
  group_by(year, month) %>% 
  summarise(avg_claims = mean(claims)) %>%
  mutate(
    avg_claims_labels = scales::number_format(
      accuracy = .1,
      scale = 1 / 1000,
      suffix = "k",
      big.mark = ","
    )(avg_claims)
  ) %>%
  head()

# A tibble: 6 x 4
# Groups:   year [1]
   year month avg_claims avg_claims_labels
  <dbl> <ord>      <dbl> <chr>            
1  1999 Jan       14688. 14.7k            
2  1999 Feb        7871. 7.9k             
3  1999 Mar        6095. 6.1k             
4  1999 Apr        6522. 6.5k             
5  1999 May        5451. 5.5k             
6  1999 Jun        5987. 6.0k

I called the new column avg_claims_labels because it’s a character column for display on the chart, not for any numerical use.

Here’s a first crack at the heat map. I’m going to put the months on the x-axis and years on the y-axis, and I want to fill according to avg_claims. Next we add a geom_tile().

ga_claims %>%
  mutate(year = year(date),
         month =  month(date, label = T, abbr  = T)) %>%
  group_by(year, month) %>%
  filter(n() >= 4) %>% 
  summarise(avg_claims = mean(claims)) %>%
  mutate(
    avg_claims_labels = scales::number_format(
      accuracy = 1,
      scale = 1 / 1000,
      suffix = "k",
      big.mark = ","
    )(avg_claims)
  ) %>%
  ggplot(aes(
    x = month,
    y = year,
    fill = avg_claims,
    label = avg_claims_labels
  )) +
  geom_tile()

That gives us a sense that January has been the worst month in most years, and that 2009 was no picnic coming off the financial crisis. Let’s do a bit more cleanup by adding
color = "white", size = .8, aes(height = 1) to geom_tile().

ga_claims %>%
  mutate(year = year(date),
         month =  month(date, label = T, abbr  = T)) %>%
  group_by(year, month) %>%
  filter(n() >= 4) %>% 
  summarise(avg_claims = mean(claims)) %>%
  mutate(
    avg_claims_labels = scales::number_format(
      accuracy = 1,
      scale = 1 / 1000,
      suffix = "k",
      big.mark = ","
    )(avg_claims)
  ) %>%
  ggplot(aes(
    x = month,
    y = year,
    fill = avg_claims,
    label = avg_claims_labels
  )) +
  geom_tile(color = "white", size = .8, aes(height = 1))

We’re not done yet! I don’t love the shades of blue contrast here as it doesn’t really hammer home how bad a month March of 2020 was (Did your eye even get drawn to it? Mine didn’t initially), and we have not made use of our labels created with number_format().

Let’s add our own fill colors with scale_fill_gradient(low = "blue", high = "red", labels = scales::comma). If you’re wondering why I included labels = scales::comma when creating a gradient, it’s because I want the commas to show up in the legend.

We add our text labels with geom_text(), which picks up our lable = avg_claims_labels aesthetic. Let’s also add a text() aesthetic with str_glue() and pass the object to ggplotly() for interactivity.

(
  ga_claims %>%
    mutate(
      year = year(date),
      month =  month(date, label = T, abbr  = T)
    ) %>%
    group_by(year, month) %>%
    filter(n() >= 4) %>% 
    summarise(avg_claims = mean(claims)) %>%
    mutate(
      avg_claims_labels = scales::number_format(
        accuracy = 1,
        scale = 1 / 1000,
        suffix = "k",
        big.mark = ","
      )(avg_claims)
    ) %>%
    ggplot(
      aes(
        x = month,
        y = year,
        fill = avg_claims,
        label = avg_claims_labels,
        text = str_glue("average claims:
                        {scales::comma(avg_claims)}")
      )
    ) +
    geom_tile(color = "white", size = .8, aes(height = 1)) +
    scale_fill_gradient(
      low = "blue",
      high = "red",
      labels = scales::comma
    ) +
    geom_text(color = "white" , size = 3.5) +
    theme_minimal() +
    theme(
      plot.caption = element_text(hjust = 0),
      panel.grid.major.y = element_blank(),
      legend.key.width = unit(1, "cm"),
      panel.grid = element_blank()
    ) +
    labs(
      y  = "",
      title = "Heatmap of Monthly Avg Unemployment Insurance Claims",
      fill = "Avg Claims",
      x = ""
    ) +
    scale_y_continuous(breaks =  scales::pretty_breaks(n = 18))
) %>% ggplotly(tooltip = "text")

We can see that January is a terrible month, but March of 2020 is the worst month we’ve had in 20 years (though note I’m not adjusting for population growth in Georgia). We can use that hover text to embed whatever data we wish - for me, the magic of str_glue() has been a game changer.

We have done some work on monthly averages, but our recent experience might motivate us to dig in at the weekly level. For example, in each year since 1999, what has been the worst week of the year for unemployment claims? In the chart below, we’ll grab the worst week for each year, plotting it as a column whose height is equal to the number of claims, and coloring it by month.

(
  ga_claims %>%
    mutate(
      month = month(date, label = TRUE, abbr = FALSE),
      year = year(date)
    ) %>%
    group_by(year) %>%
    mutate(
      max_claims = max(claims),
      max_week_color = case_when(claims == max_claims ~ as.character(date),
                                 TRUE ~ "NA")
    ) %>%
    filter(max_week_color != "NA") %>%
    ggplot(aes(
      x = max_week_color,
      y = claims,
      fill = month,
      text = str_glue("{date}
                      claims: {scales::comma(claims)}")
    )) +
    geom_col(width = .5) +
    labs(
      x = "",
      title = str_glue("Highest Unemployment Claims Week, by Year
                                in Georgia"),
      y = ""
    ) +
    scale_y_continuous(
      labels = scales::comma,
      limits = c(0, NA),
      breaks = scales::pretty_breaks(n = 6)
    ) +
    scale_fill_brewer(palette = "Dark2") +
    theme_minimal() +
    theme(
      axis.text.x = element_text(angle = 45),
      plot.title = element_text(hjust = .5)
    )
) %>% ggplotly(tooltip = "text")

2020 is the only year in which we see a month other than January or December as the worst week of the year. That surprised me, as I thought we might see unusual behavior during the Global Financial Crisis that spanned roughly mid-2007 to early-2009. Here’s a chart of that period, with the worst unemployment claims of each month displayed.

(
  ga_claims %>%
    mutate(
      month = month(date, label = TRUE, abbr = FALSE),
      year = year(date)
    ) %>%
    filter(between(
      date, ymd("2007-05-01"), ymd("2009-05-01")
    )) %>%
    group_by(year, month) %>%
    mutate(
      max_claims = max(claims),
      max_week_color = case_when(claims == max_claims ~ as.character(date),
                                 TRUE ~ "NA")
    ) %>%
    filter(max_week_color != "NA") %>%
    ggplot(aes(
      x = max_week_color,
      y = claims,
      fill = month,
      text = str_glue("{date}
                      claims: {scales::comma(claims)}")
    )) +
    geom_col(width = .5) +
    labs(
      x = "",
      title = str_glue("Worst Unemployment Claims Week of Each Month
                                mid-2007 to mid-2009"),
      y = "",
      fill = ""
    ) +
    scale_y_continuous(
      labels = scales::comma,
      limits = c(0, NA),
      breaks = scales::pretty_breaks(n = 6)
    ) +
    theme_minimal() +
    theme(
      axis.text.x = element_text(angle = 45),
      plot.title  = element_text(hjust = .5)
    )
) %>% ggplotly(tooltip = "text")

The worst weeks during this period were December and January of 2008 and 2009, with 35,000 and 41,000 claims. As if we needed more evidence, we are currently living strange times, here’s that same chart for the last 2 years.

(
  ga_claims %>%
    mutate(
      month = month(date, label = TRUE, abbr = FALSE),
      year = year(date)
    ) %>%
    filter(between(
      date, ymd("2018-04-01"), ymd("2020-05-01")
    )) %>%
    group_by(year, month) %>%
    mutate(
      max_claims = max(claims),
      max_week_color = case_when(claims == max_claims ~ as.character(date),
                                 TRUE ~ "NA")
    ) %>%
    filter(max_week_color != "NA") %>%
    ggplot(aes(
      x = max_week_color,
      y = claims,
      fill = month,
      text = str_glue("{date}
                      claims: {scales::comma(claims)}")
    )) +
    geom_col(width = .5) +
    labs(
      x = "",
      title = str_glue("Worst Unemployment Claims Week of Each Month
                                mid-2018 to mid-2020"),
      y = "",
      fill = ""
    ) +
    scale_y_continuous(
      labels = scales::comma,
      limits = c(0, NA),
      breaks = scales::pretty_breaks(n = 6)
    ) +
    theme_minimal() +
    theme(
      axis.text.x = element_text(angle = 45),
      plot.title  = element_text(hjust = .5)
    )
) %>% ggplotly(tooltip = "text")

The last week of March 2020 comes in at 133,000 claims for Georgia, a number we never even got close to approaching during the financial crisis. And the first week of April is at 390,000.

If we like some of these visualizations, we can expand our analysis out to all 50 states.

Just as Georgia’s data is available from FRED using the code GAICLAIMS, any state’s data can be access with the state’s abbreviation appended to ICLAIMS. Luckily, the core R datasets package comes with a data set of abbreviations called state.abb.

datasets::state.abb %>% 
  head()

[1] "AL" "AK" "AZ" "AR" "CA" "CO"

We want to write a function that loops through these 50 abbreviations, pulls data from FRED for each state and saves them as a tibble. We can use str_glue() inside a custom function and map_dfr as the looping engine to accomplish this.

First, let’s create the function and just test the creation of the FRED code.

all_state_claims_importer <- function(state_abbreviation){
  fred_code <- str_glue("{state_abbreviation}ICLAIMS")
  
  fred_code %>% 
    tibble()
}

all_state_claims_importer("GA")

# A tibble: 1 x 1
  .        
  <glue>   
1 GAICLAIMS

What happens when we apply this to the state.abb data set.

map_dfr(state.abb, all_state_claims_importer) %>% 
  head()

# A tibble: 6 x 1
  .        
  <chr>    
1 ALICLAIMS
2 AKICLAIMS
3 AZICLAIMS
4 ARICLAIMS
5 CAICLAIMS
6 COICLAIMS

We get the FRED code for all fifty states.

The hard part is done. Now we pass those codes to tq_get(), and use map_dfr() to iteratively pass each abbreviation to FRED. the _dfr will bind our results together, row wise, into a `tibble.

all_state_claims_importer <- function(state_abbrevation) {
  fred_code <- str_glue("{state_abbrevation}ICLAIMS")
  
  fred_code %>%
    tq_get(get = "economic.data",
           from = "1999-01-01") %>%
    mutate(state = state_abbrevation) %>%
    rename(claims = price) %>%
    select(date, state, claims)
}

all_state_claims_tibble <-
map_dfr(state.abb, all_state_claims_importer) 


all_state_claims_tibble %>% 
  group_by(state) %>% 
  slice(1, n())

# A tibble: 100 x 3
# Groups:   state [50]
   date       state claims
   <date>     <chr>  <int>
 1 1999-01-02 AK      2234
 2 2020-04-11 AK     12007
 3 1999-01-02 AL      9899
 4 2020-04-11 AL     77515
 5 1999-01-02 AR      9477
 6 2020-04-11 AR     35629
 7 1999-01-02 AZ      1534
 8 2020-04-11 AZ     98531
 9 1999-01-02 CA     47297
10 2020-04-11 CA    655472
# … with 90 more rows

We can recreate any of those previous visualizations for the state of our choice, by using filter(state == "state of choice"). Let’s take a look at one of the charts for Florida.

(
  all_state_claims_tibble %>%
    filter(state == "FL") %>%
    mutate(
      month = month(date, label = TRUE, abbr = FALSE),
      year = year(date)
    ) %>%
    group_by(year) %>%
    mutate(
      max_claims = max(claims),
      max_week_color = case_when(claims == max_claims ~ as.character(date),
                                 TRUE ~ "NA")
    ) %>%
    filter(max_week_color != "NA") %>%
    ggplot(aes(
      x = max_week_color,
      y = claims,
      fill = month,
      text = str_glue("{date}
                      claims: {scales::comma(claims)}")
    )) +
    geom_col(width = .5) +
    labs(
      x = "",
      title = str_glue("Highest Unemployment Claims Week, by Year
                                in Florida"),
      y = ""
    ) +
    scale_y_continuous(
      labels = scales::comma,
      limits = c(0, NA),
      breaks = scales::pretty_breaks(n = 6)
    ) +
    scale_fill_brewer(palette = "Dark2") +
    theme_minimal() +
    theme(
      axis.text.x = element_text(angle = 45),
      plot.title = element_text(hjust = .5)
    )
) %>% ggplotly(tooltip = "text")

Interesting to see that Florida does not display that same concentration of high unemployment weeks in January. July is the month that most frequently has the worst week for unemployment claims. I imagine that’s because summer is the big tourist season in Florida and things start to slow down after July. Whatever the explanation, this has some big implications as we hopefully emerge from our crisis. We can imagine Georgia and Florida having very different recovery paths as we are already approaching what is traditionally Florida’s big tourist season. Summer in Georgia is not the same as summer in Florida when it comes to employment trends.

Let’s end on a more positive note and examine the months in Florida when claims are at their lowest, which is the most positive for the employment situation. We can tweak the code flow above by replacing max with min in a few places.

(
  all_state_claims_tibble %>%
    filter(state == "FL") %>%
    mutate(
      month = month(date, label = TRUE, abbr = FALSE),
      year = year(date)
    ) %>%
    group_by(year) %>%
    mutate(
      min_claims = min(claims),
      min_week_color = case_when(claims == min_claims ~ as.character(date),
                                 TRUE ~ "NA")
    ) %>%
    filter(min_week_color != "NA") %>%
    ggplot(aes(
      x = min_week_color,
      y = claims,
      fill = month,
      text = str_glue("{date}
                      claims: {scales::comma(round(claims, digits = 0))}")
    )) +
    geom_col(width = .5) +
    labs(
      x = "",
      title = str_glue("Lowest Unemployment Claims Week, by Year
                                in Florida"),
      y = ""
    ) +
    scale_y_continuous(
      labels = scales::comma,
      limits = c(0, NA),
      breaks = scales::pretty_breaks(n = 6)
    ) +
    scale_fill_brewer(palette = "Dark2") +
    theme_minimal() +
    theme(
      axis.text.x = element_text(angle = 45),
      plot.title = element_text(hjust = .5)
    )
) %>% ggplotly(tooltip = "text")

November, December and January tend to contain the best week in each year in Florida, yet we still saw that summer tendency for the max claims.

That’s all for today, thanks for reading the latest Reproducible Finance post. Next time we’ll move on to part 2 and explore how some social data can be layered onto these charts. In the future, we can hope to extend this work to look at how quickly we have recovered and started to see unemployment claims drop there.

Stay safe out there!

Tech Dividends, Part 1

Wed, 07 Aug 2019 00:00:00 +0000

In a previous post, we explored the dividend history of stocks included in the SP500. Today, we’ll extend that analysis to cover the Nasdaq because, well, because in the previous post I said I would do that. We’ll also explore a different source for dividend data, do some string cleaning and check out ways to customize a tooltip in plotly. Bonus feature: we’ll get into some animation too. We have a lot to cover, so let’s get to it.

We need to load up our packages for the day.

library(tidyverse)
library(tidyquant)
library(janitor)
library(plotly)

First, we need all the companies listed on the Nasdaq. Not so long ago, it wasn’t easy to import that information into R. Now we can use tq_exchange("NASDAQ") from the tidyquant package.

nasdaq <-
  tq_exchange("NASDAQ")

nasdaq %>% 
  head()

# A tibble: 6 x 7
  symbol company     last.sale.price market.cap ipo.year sector  industry  
  <chr>  <chr>                 <dbl> <chr>         <dbl> <chr>   <chr>     
1 YI     111, Inc.              3.5  $285.81M       2018 Health… Medical/N…
2 PIH    1347 Prope…            5.02 $30.18M        2014 Finance Property-…
3 PIHPP  1347 Prope…           25.6  $17.93M          NA Finance Property-…
4 TURN   180 Degree…            1.95 $60.56M          NA Finance Finance/I…
5 FLWS   1-800 FLOW…           19.1  $1.23B         1999 Consum… Other Spe…
6 BCOW   1895 Banco…            9.46 $46.13M        2019 Finance Banks

Notice how the market.cap column is of type character? Let’s coerce it to a dbl with as.numeric and while we’re at it, let’s remove the periods in all the column names with clean_names from the janitor package.

nasdaq %>% 
  clean_names() %>%
  mutate(market_cap = as.numeric(market_cap)) %>% 
  select(symbol, market_cap) %>% 
  head()

# A tibble: 6 x 2
  symbol market_cap
  <chr>       <dbl>
1 YI             NA
2 PIH            NA
3 PIHPP          NA
4 TURN           NA
5 FLWS           NA
6 BCOW           NA

Not exactly what we had in mind. The presence of those M, B and $ characters are causing as.numeric() to coerce the column to NAs. If we want to do any sorting by market cap, we’ll need to clean that up and it’s a great chance to explore some stringr. Let’s start with str_remove_all and remove those non-numeric characters. The call is market_cap %>% str_remove_all("\\$|M|B"), and then an arrange(desc(market_cap)) so that the largest cap company is first.

nasdaq %>% 
  clean_names() %>%
  mutate(market_cap = market_cap %>% str_remove_all("\\$|M|B") %>% as.numeric()) %>%
  arrange(desc(market_cap)) %>% 
  head()

# A tibble: 6 x 7
  symbol company    last_sale_price market_cap ipo_year sector  industry   
  <chr>  <chr>                <dbl>      <dbl>    <dbl> <chr>   <chr>      
1 CIVBP  Civista B…            69      698280        NA Finance Major Banks
2 ASRVP  AmeriServ…            28.9    606900        NA Finance Major Banks
3 ESGRP  Enstar Gr…            26.7    427040        NA Finance Property-C…
4 AGNCN  AGNC Inve…            25.9    336700        NA Consum… Real Estat…
5 SBFGP  SB Financ…            16.2    243669.       NA Finance Major Banks
6 ESGRO  Enstar Gr…            26.5    116644        NA Finance Property-C…

Well, that wasn’t too bad!

Wait, that looks weird, where’s AMZN and MSFT shouldn’t they be at the top of the market cap? Look closely at market_cap and notice it’s been coerced to a numeric value as we intended but we didn’t account for the fact that those M and B letters were abbreviating values and standing place for a whole bunch of zeroes. The first symbol above, CIVBP, didn’t have an M or B because it’s market cap is low, so it didn’t have any zeroes lopped off of it. We need a way to remove the M and the B account for those zeroes that got removed. Here’s how I chose to tackle this:

Find all the cells that do not have an M or a B, remove the $ sign, convert to numeric and divide by 1000. We do that with if_else(str_detect(market_cap, "M|B", negate = TRUE), str_remove_all(market_cap, "\\$") %>% as.numeric() %>%/(1000).
Find all the cells that have a B, remove the B and the $ sign, convert to numeric and multiply by 1000. We do that with if_else(str_detect(market_cap, "B"), str_remove_all(market_cap, "\\$|B") %>% as.numeric() %>%*(1000).
Find all the cells that have an M, remove the M and the $ sign, convert to numeric and don’t multiply or divide. We do that with str_remove_all(market_cap, "\\$|M") %>% as.numeric())).

Here’s the full call:

nasdaq %>% 
  clean_names() %>%
  mutate(market_cap = 
          if_else(str_detect(market_cap, "M|B", negate = TRUE), 
                  str_remove_all(market_cap, "\\$") %>% as.numeric() %>% `/`(1000),
          if_else(str_detect(market_cap, "B"), 
                  str_remove_all(market_cap, "\\$|B") %>% as.numeric() %>% `*`(1000), 
          str_remove_all(market_cap, "\\$|M") %>% as.numeric()))) %>%
  arrange(desc(market_cap))

# A tibble: 3,507 x 7
   symbol company   last_sale_price market_cap ipo_year sector  industry   
   <chr>  <chr>               <dbl>      <dbl>    <dbl> <chr>   <chr>      
 1 MSFT   Microsof…           135.    1028410.     1986 Techno… Computer S…
 2 AAPL   Apple In…           197      890280      1980 Techno… Computer M…
 3 AMZN   Amazon.c…          1788.     884360      1997 Consum… Catalog/Sp…
 4 GOOGL  Alphabet…          1171.     812020        NA Techno… Computer S…
 5 GOOG   Alphabet…          1170.     811240      2004 Techno… Computer S…
 6 FB     Facebook…           185.     526400      2012 Techno… Computer S…
 7 CSCO   Cisco Sy…            52.6    225170      1990 Techno… Computer C…
 8 INTC   Intel Co…            47.0    208030        NA Techno… Semiconduc…
 9 CMCSA  Comcast …            42.1    191210        NA Consum… Television…
10 PEP    Pepsico,…           126.     176800        NA Consum… Beverages …
# … with 3,497 more rows

That finally looks how we were expecting, the top five by market cap are MSFT, AMZN, GOOG, FB and CSCO. Let’s save that as an object called nasdaq_wrangled.

nasdaq_wrangled <- 
  nasdaq %>% 
  clean_names() %>%
  mutate(market_cap = 
          if_else(str_detect(market_cap, "M|B", negate = TRUE), 
                  str_remove_all(market_cap, "\\$") %>% as.numeric() %>% `/`(1000),
          if_else(str_detect(market_cap, "B"), 
                  str_remove_all(market_cap, "\\$|B") %>% as.numeric() %>% `*`(1000), 
          str_remove_all(market_cap, "\\$|M") %>% as.numeric()))) %>%
  arrange(desc(market_cap))

Now, let’s dig in to the dividends paid by these Nasdaq-listed companies that have IPO’d in the last ten years. It’s a bit anticlimactic because most haven’t paid any dividends but here we go. First, let’s pull just the tickers for companies that IPO’d after 2007, by setting filter(ipo_year > 2007).

nasdaq_tickers <- 
nasdaq_wrangled %>% 
  filter(ipo_year > 2007) %>% 
  pull(symbol)

nasdaq_tickers %>% 
  head()

[1] "FB"   "AVGO" "TSLA" "JD"   "TEAM" "NXPI"

We will import the dividend data using tq_get(source = 'dividends'), which is a wrapper for quantmod::getDividends() and sources dividend data from Yahoo! Finance.

We are passing 1120 symbols to this function but only those that pay a dividend will come back to us. It takes a while to run this because we still have to check on all 1120.

nasdaq_dividends <-
nasdaq_tickers %>%
  tq_get(get = 'dividends') %>%
  select(-value)

After a huge data import task like that, I like to use slice(1) to grab the first observation from each group, which in this case will be each symbol. We can count the number symbols for which we have a dividend and it’s 130.

nasdaq_dividends %>% 
 group_by(symbol) %>% 
  slice(1) %>% 
  glimpse()

Observations: 130
Variables: 3
Groups: symbol [130]
$ symbol    <chr> "AGNC", "AMAL", "ATAI", "AVGO", "AY", "BKEP", "BLMN", …
$ date      <date> 2009-03-31, 2018-11-15, 2011-06-28, 2010-12-13, 2014-…
$ dividends <dbl> 0.850, 0.060, 0.430, 0.070, 0.037, 0.110, 0.060, 0.003…

We could also get a sense for how these first dividend payments cluster into years by using count(year). Note we need to ungroup() first.

nasdaq_dividends %>% 
 group_by(symbol) %>% 
  slice(1) %>% 
  mutate(year = year(date)) %>% 
  ungroup() %>% 
  count(year)

# A tibble: 11 x 2
    year     n
   <dbl> <int>
 1  2009     3
 2  2010     8
 3  2011     6
 4  2012     9
 5  2013    14
 6  2014    12
 7  2015    15
 8  2016    12
 9  2017    12
10  2018    28
11  2019    11

And a chart will help to communicate these yearly frequencies.

nasdaq_dividends %>% 
 group_by(symbol) %>% 
  slice(1) %>% 
  mutate(year = year(date)) %>% 
  ungroup() %>% 
  count(year) %>% 
  ggplot(aes(year, n)) + 
  geom_col(fill = "cornflowerblue", width = .5) +
  scale_x_continuous(breaks = 2008:2019) + 
  scale_y_continuous(breaks = scales::pretty_breaks(n = 15)) +
  labs(y = "number of first dividends by year", x = "")

Hmmm, interesting. I expected the numbers to steadily increase year by year as companies became more mature and cash flow positive, but that is not the pattern we see in that plot

Now, let’s create a quick chart of the last dividend paid by each of these 130 companies, using slice(n()). This time we’ll plot a dot with geom_point().

nasdaq_dividends %>%
  group_by(symbol) %>% 
  slice(n()) %>% 
  mutate(year = year(date)) %>% 
  ggplot(aes(x = year, y = dividends, color = symbol)) + 
  geom_point() + 
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_continuous(breaks = 2008:2019) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5))

Not quite as useful as a lot of the dots are right on top of each other. We do see a couple of massive outliers. Let’s add the label for each symbol with geom_label(aes(label = symbol)).

nasdaq_dividends %>%
  group_by(symbol) %>% 
  slice(n()) %>% 
  ggplot(aes(x = date, y = dividends, color = symbol)) + 
  geom_point() + 
  geom_label(aes(label = symbol)) +
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5))

MACK and FWP paid some huge dividends. Let’s investigate.

nasdaq_dividends %>%
  filter(symbol == "MACK" | symbol == "FWP")

# A tibble: 2 x 3
  symbol date       dividends
  <chr>  <date>         <dbl>
1 MACK   2017-05-30     106. 
2 FWP    2017-09-12      23.1

These were most likely special dividends of some sort and that might be worth investigating but it’s not our project today so let’s filter those two out of the data and then recreate the plot. Let’s remove the geom_label so we see just the dots again, this time by date instead of year.

nasdaq_dividends %>%
  filter(symbol != "MACK" & symbol != "FWP") %>% 
  group_by(symbol) %>% 
  slice(n()) %>% 
  ggplot(aes(x = date, y = dividends, color = symbol)) + 
  geom_point() + 
 # geom_label(aes(label = symbol)) +
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5))

That’s a snapshot of the last dividend paid by each company and we can see the clustering a bit better. Quite a few companies paid their last dividend before 2019, which might indicate it’s not a regular dividend. Let’s check out the entire history of each company by removing slice(n()).

nasdaq_dividends %>%
  filter(symbol != "MACK" & symbol != "FWP") %>% 
  group_by(symbol) %>%  
  ggplot(aes(x = date, y = dividends, color = symbol)) + 
  geom_point() + 
 # geom_label(aes(label = symbol)) +
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5))

If you’re like me, you’re just itching to hover on, say, that reddish dot between $5 and $7 and see which company it is, maybe even click the dot and isolate it. Good news, we can wrap that chart in a call to ggplotly() and get part of that functionality out of the box. We will need to add the legend back to the plot by removing legend.position = "none".

library(plotly)

ggplotly(
  nasdaq_dividends %>%
  filter(symbol != "MACK" & symbol != "FWP") %>% 
  group_by(symbol) %>%
  ggplot(aes(x = date, y = dividends, color = symbol)) + 
  geom_point() + 
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(plot.title = element_text(hjust = 0.5)) 
)

Hover on that orange-red dot between $5 and $7 and notice it’s the symbol ATAI. If you double click on ATAI in the legend, it will isolate just those dots on the chart. And we can see that this was probably a special dividend.

Now, it might be nice to have the name of the company and the sector displayed when we mouse hover, instead of just the symbol. Let’s add back the name and sector data by left_join()ing our wrangled data object.

nasdaq_dividends %>% 
  left_join(nasdaq_wrangled, by = "symbol") %>% 
  head()

# A tibble: 6 x 9
  symbol date       dividends company last_sale_price market_cap ipo_year
  <chr>  <date>         <dbl> <chr>             <dbl>      <dbl>    <dbl>
1 AVGO   2010-12-13      0.07 Broadc…            266.     106060     2009
2 AVGO   2011-03-16      0.08 Broadc…            266.     106060     2009
3 AVGO   2011-06-15      0.09 Broadc…            266.     106060     2009
4 AVGO   2011-09-15      0.11 Broadc…            266.     106060     2009
5 AVGO   2011-12-15      0.12 Broadc…            266.     106060     2009
6 AVGO   2012-03-15      0.13 Broadc…            266.     106060     2009
# … with 2 more variables: sector <chr>, industry <chr>

Once the company name data is joined, we can incorporate into the plot by adding label_tooltip = company to ggplot(aes(...)) and then setting tooltip = "label_tooltip", to alert plotly about the new tooltip data.

ggplotly(
nasdaq_dividends %>%
  filter(symbol != "MACK" & symbol != "FWP") %>% 
  left_join(nasdaq_wrangled, by = "symbol") %>% 
  group_by(symbol) %>% 
  ggplot(aes(x = date, y = dividends, color = symbol, label_tooltip = company)) + 
  geom_point() + 
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(plot.title = element_text(hjust = 0.5)),
tooltip = "label_tooltip"
)

Alright, we have the company name, but we lost the symbol so we won’t know quite where to click on the legend. I think we’d like both the symbol and the company name in tooltip. That means we need to store that information somewhere, and might as well add the sector at the same time. Note that we could add any data we want here.

We will use mutate to create a new column that holds our label information. I want to display the date, company and symbol on different lines, so we will include line breaks with <br>.

ggplotly(
nasdaq_dividends %>%
  filter(symbol != "MACK" & symbol != "FWP") %>% 
  left_join(nasdaq_wrangled, by = "symbol") %>% 
  group_by(symbol) %>% 
  mutate(info = paste(date,
                  '<br>company:', company, 
                  '<br>symbol:', symbol,
                  '<br>div: $', dividends)) %>% 
  ggplot(aes(x = date, 
             y = dividends, 
             color = symbol, 
             label_tooltip = info)) + 
  geom_point() + 
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(plot.title = element_text(hjust = 0.5)),
tooltip = "label_tooltip"
)

Note how we can quickly add other information, like the sector, by adding the column sector to the paste string. Indeed, we can paste any column data into that string. There might be a better way to customize the tooltip in plotly - and suggestions most definitely welcome! - but I find this to be a pretty darn good way to add data from our columns.

ggplotly(
nasdaq_dividends %>%
  filter(symbol != "MACK" & symbol != "FWP") %>% 
  left_join(nasdaq_wrangled, by = "symbol") %>% 
  group_by(symbol) %>% 
  mutate(info = paste(date,
                  '<br>company:', company,
                  '<br>sector:', sector,
                  '<br>symbol:', symbol,
                  '<br>div: $', dividends)) %>% 
  ggplot(aes(x = date, 
             y = dividends, 
             color = symbol, 
             label_tooltip = info)) + 
  geom_point() + 
  scale_y_continuous(labels = scales::dollar)  +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  labs(x = "", y = "div/share", title = "Nasdaq dividends") +
  theme(plot.title = element_text(hjust = 0.5)),
tooltip = "label_tooltip"
)

Next time we’ll apply what we’ve done here today to a recent article in Barron’s. Before we close, though…

If you like this sort of code through check out my book, Reproducible Finance with R.

Not specific to finance but several of the stringr and ggplot tricks in this post came from this awesome Business Science University course.

I’m also going to be posting weekly code snippets on linkedin, connect with me there if you’re keen for some R finance stuff.

Thanks for reading and see you next time!