[A] Please describe the format of the data files.

For illustration, we show here the head of one of the state files (Alaska), showing the structure of the data as distributed.

file.head("data/AK.TXT.gz", n = 10)
# AK,F,1910,Mary,14
# AK,F,1910,Annie,12
# AK,F,1910,Anna,10
# AK,F,1910,Margaret,8
# AK,F,1910,Helen,7
# AK,F,1910,Elsie,6
# AK,F,1910,Lucy,6
# AK,F,1910,Dorothy,5
# AK,F,1911,Mary,12
# AK,F,1911,Margaret,7

The data for each state are stored in tall format in a comma separated list. Each row has five values:

• State: the 2-letter code of the state.
• Gender: one letter, M|F.
• Year: the year of birth for this record, in 4-digit format.
• Name: the name.
• Count: an integer for the number of times this name occurred in that state in that year.

A few additional notes:

• Entries are grouped (sorted) by gender, then year, and finally in decreasing order of counts. If there are multiple names with the same number of occurrences, they are then sorted alphabetically.

• It is important to note that for each state+year subset only names with at least five occurrences are reported in this public data set (out of privacy concerns).

• The total number of distinct names in the data set is 29828, and of these 2852 have been used for both females and males.

This is an example of the entries in the data frame where I loaded and combined all the data, a sample of random rows:

df[sample(1:nrow(df), 12), ]
# Source: local data frame [12 x 5]
# 
#    state gender year       name count
# 1     NC      F 1979    Georgia     9
# 2     IL      M 1996    Zackery    16
# 3     SC      F 2007      Emily   256
# 4     IA      F 1944      Pearl     7
# 5     MN      M 1999  Nathanial     6
# 6     DC      F 1922 Marguerite    21
# 7     GA      M 1951      Cleve     7
# 8     NY      F 2013       Izel     5
# 9     MI      M 2001    Kendall    19
# 10    MO      M 1948       Doug    12
# 11    RI      F 1945   Meredith    18
# 12    CA      F 1953      Dolly    20

[B] Can you identify any limitations or distortions of the data?

I did not get a chance to explore the data in much detail (and not for lack of interest) and at this stage my main concern, perhaps the only one for now, is about the effect of the cutoff imposed on the release of names with fewer than 5 occurrences in a state.

First off, given the wide range of state populations (about a factor of 50), this threshold at a fixed value effectively introduces a distortion in the data in the sense that \(n\ge5\) truncates the distribution of names at different levels depending on a state population (taken as a proxy for number of births). On the other hand, we are dealing with an inherently discrete quantity and below 5 there are always only four other “levels” 1, 2, 3, 4, no matter how large is a state population. So, it is not clear to me how much is the impact of the cutoff in practice. One pertinent question is how much data would be there, and a good starting point is looking at how the available data are distributed.

As with many things in nature, the distribution of the number of names vs. their frequency follows fairly closely a power law distribution. Here are a couple of examples, for two states, with data added over a 5-year period. Please note that this is a log-log plot, the best way to look at data following a power law distribution, which comes out just like a straight line. Pink symbols show the distribution of female names, blue symbols that for male names. Red and blue dashed lines are the best fit with a linear regression model to the log-log data (points covered by a grey square were exclude from the fit.)

Data were binned, with bin width \(0.25 \log_{10}(5)\), and the plots show the counts in each bin, not a density (i.e. count divided by bin width).

par(fig = c(0, 1, 0, 1), mar = c(5, 4, 4, 1)+0.1, cex.axis = 1.0)
single_panel_mar <- c(2, 2, 2, 1)
single_panel_oma <- c(0 ,0, 2, 0)
gr_par <- list( mar = single_panel_mar, oma = single_panel_oma, 
                cex = 1.0, cex.axis = 0.8, cex.lab = 1.0, 
                las = 0, mgp = c(1.0, 0.0, 0),
                tcl = 0.3)

par(gr_par)

mat.layout <- matrix(1:2, nrow = 1, byrow = TRUE)
layout(mat.layout)
plot_hist_state_year_with_fit(data = df, STATE = "OK", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "TX", YEAR = 2009:2013, subset = quote(y > log10(25)))

par(fig = c(0, 1, 0, 1), mar = c(5, 4, 4, 1)+0.1, cex.axis = 1.0)
title("Examples of Distributions of Names by Count", cex.main = 1.25, outer = TRUE)

Data are sometimes noisy and bumpy, but overall, for all states and time intervals (provided that these latter were long enough to build up a decent statistic in states with low counts), these distributions are well modeled with steep declining power laws, possibly with an exponential cutoff at high counts. Assess that vs. simply a drop in statistics would require more careful analysis.

The slope of the power law is around \(-1\) (it would \(-2\) for density), and if extrapolated back below the cutoff at 5 counts it would translate into a large number of names with low-count, as much as 10 times more than the names accounted for.

One way of checking at a large scale level if this could indeed be the case, could be do compare the total counts of birth accounted for by these data with more comprehensive census of birth by state and year. Unfortunately I did not get a chance to pursue this avenue.

Frankly I was surprised to see that the certainly expected power law continued apparently undeterred until the lowest count limit. My naive expectation was that before that point it would begin to taper off and eventually drop, though perhaps below the 5-count limit. I can’t help but wonder how realistic/reasonable it is to imagine that there could be several thousands of “hidden” names caught by the \(n\ge5\) filter.
How many babies are given names that is unique to them (in a state and year)?!

What is the most popular name of all time? (Of either gender.)

• Ignoring gender, the most popular given-name in this data set is James.
  
• For female name it is Mary.
• For male names James.

For a little more information, here is the Table of Top 10 rankings, left to right, irrespective of gender, female-given names, male-given names.

# Source: local data frame [10 x 6]
# 
#    AnyGender   N_any    Female N_female    Male  N_male
# 1      James 4942431      Mary  3728041   James 4924235
# 2       John 4834422  Patricia  1567405    John 4818746
# 3     Robert 4718787 Elizabeth  1490772  Robert 4703680
# 4    Michael 4297230  Jennifer  1460272 Michael 4280040
# 5    William 3822209     Linda  1445838 William 3811998
# 6       Mary 3737679   Barbara  1422631   David 3541625
# 7      David 3549801  Margaret  1120006 Richard 2526927
# 8    Richard 2531924     Susan  1107916  Joseph 2467298
# 9     Joseph 2472917   Dorothy  1051262 Charles 2237170
# 10   Charles 2244693   Jessica  1036257  Thomas 2209169

[A] What is the most gender ambiguous name in 2013?

First, how many names were used for both female and male babies in 2013?
494, a relatively small fraction of the set of 2852 names that “historically” have been used for both females and males.

With the data ready, we can answer the question in a few different ways.

# diff = 0, sorted by total number
top2013a <- filter(c2013, diff == 0) %>% arrange(desc(N_tot)) %>% as.data.frame(.) %>% head( . , N_show)
kable(top2013a, row.names = TRUE)

# diff > 0, sorted by normalized difference
top2013a <- filter(c2013, diff > 0) %>% arrange(diff_norm) %>% as.data.frame(.) %>% head( . , N_show)
kable(top2013a, row.names = TRUE)

top2013 <- filter(c2013, diff_norm <= rn) %>% arrange(desc(N_tot)) %>% as.data.frame(.) %>% head( . , N_show)
kable(top2013, row.names = TRUE)

single_panel_mar <- c(3, 3, 2, 2)
single_panel_oma <- c(0 ,0, 2, 0)
gr_par <- list( mar = single_panel_mar, oma = single_panel_oma, 
                cex = 1.2, cex.axis = 1.0, cex.lab = 1.2, cex.main = 1.0,
                las = 0, mgp = c(1.75, 0.5, 0),
                tcl = 0.3)
par(gr_par)
lab_x <- top2013[, "N_female"]
lab_y <- top2013[, "N_male"]
lab_s <- top2013[, "Name"]
lab_pos <- rep(c(4, 2), length.out = N_show)

x  <- seq(5, 30000, by = 100)
y1 <- (1 - rn)/(1 + rn)*x
y2 <- (1 + rn)/(1 - rn)*x

plot(c2013$N_female, c2013$N_male, log = "xy", 
     xlim = c(4, 20000), ylim = c(4, 20000), asp = 1,
     pch = 21, col = "orangered2", bg = rgb(0.8, 0.3, 0, 0.3),
     xlab = "N female",
     ylab = "N male",
     main = "Male/Female Counts of Ambiguous Names (2013)")
points(c2013$N_female[c2013$diff_norm <= abs(rn)], c2013$N_male[c2013$diff_norm <= abs(rn)], pch = 23, col = "darkgreen", bg = rgb(0, 0.9, 0, 0.3))
points(c2013$N_female[c2013$diff == 0], c2013$N_male[c2013$diff == 0], pch = 23, col = "blue2", bg = rgb(0, 0, 0.9, 0.3))
lines(x, y1, lty = 4, lwd = 1.5, col = "forestgreen")
lines(x, y2, lty = 4, lwd = 1.5, col = "forestgreen")
grid()
text(lab_x, lab_y, labels = lab_s, pos = lab_pos, cex = 0.9, adj = c(NA, 0))

[B] In 1945?

We skip the two less smart approaches and show directly the results from Approach 3, with table and figure.
The total number of bisex names for 1945 is 237.

top1945 <- filter(c1945, diff_norm <= rn) %>% arrange(desc(N_tot)) %>% as.data.frame(.) %>% head( . , N_show)
kable(top1945, row.names = TRUE)

par(gr_par)
lab_x <- top1945[, "N_female"]
lab_y <- top1945[, "N_male"]
lab_s <- top1945[, "Name"]

plot(c1945$N_female, c1945$N_male, log = "xy", 
     xlim = c(4, 20000), ylim = c(4, 20000), asp = 1,
     pch = 21, col = "orangered2", bg = rgb(0.8, 0.3, 0, 0.3),
     xlab = "N female",
     ylab = "N male",
     main = "Male/Female Counts of Ambiguous Names (1945)")
points(c1945$N_female[c1945$diff_norm <= abs(rn)], c1945$N_male[c1945$diff_norm <= abs(rn)], 
       pch = 23, col = "darkgreen", bg = rgb(0, 0.9, 0, 0.3))
points(c1945$N_female[c1945$diff == 0], c1945$N_male[c1945$diff == 0], 
       pch = 23, col = "blue2", bg = rgb(0, 0, 0.9, 0.3))
lines(x, y1, lty = 4, lwd = 1.5, col = "forestgreen")
lines(x, y2, lty = 4, lwd = 1.5, col = "forestgreen")
grid()
text(lab_x, lab_y, labels = lab_s, pos = lab_pos, cex = 0.9, adj = c(NA, 0))

[A] Of the names represented in the data, find the name that has had the largest percentage increase in popularity since 1980.

Taking the straightforward approach of defining percentage increase as the ratio between the difference 2013 and 1980 counts over the 1980 counts, i.e. \((n_{2013} - n_{1980})/n_{1980}\), these are the names whose adoption increased the most between those two reference years:

tab4a <- arrange(inboth_names, desc(change_pct)) %>% dplyr::select( . , -ntot, -rev_pct) 
kable(head(tab4a, N_show), row.names = TRUE, digits = 0)

frac_up_F_20 <- sum(head(tab4a, 20)$gender == "F")/20
frac_up_F_50 <- sum(head(tab4a, 50)$gender == "F")/50

The majority of them barely made into the 1980 dataset because they total count is 5, meaning that they entered this data set only in one state for that year (there are 238 names with a count of only 5 in 1980 for the 1980-2013 common data set, 206 in 2013).

[B] Largest decrease?

For the largest decrease we do the same calculation and obtain the 5 worst performers shown in the following table. To allow a more direct comparison with the changes reported for the increases, we added to this table a column with the percentage change computed with 2013 as baseline (“rev_pct”).

tab4b <- arrange(inboth_names, change_pct) %>% dplyr::select( . , -ntot)
digits_vec <- rep(0, ncol(tab4b)) 
digits_vec[which(colnames(tab4b)=="change_pct")] <- 2
kable(head(tab4b, N_show), row.names = TRUE, digits = digits_vec)

frac_down_F_20 <- sum(head(tab4b, 20)$gender == "F")/20
frac_down_F_50 <- sum(head(tab4b, 50)$gender == "F")/50

Again, not surprisingly, several of the most forgotten names show up right at the minimum possible number of occurrences to enter the data set.

NOTE on gender and dramatic changes: it is interesting, though at this level little more than anedoctal, that the majority of the names that exhibit the most dramatic changes are female names: they comprise 60% of the 20 largest (measurable) increases and 95% of the 20 largest (measurable) decrease (60% and 84% of the top 50 increase/decreases).

Can you identify names that may have had an even larger increase or decrease in popularity?

There may be names that enjoyed (suffered) an even larger increase (decrease) in popularity in the 2-point comparison between 1980 and 2013 and not appear in the preceding analyses because they were below threshold for inclusion in the data set in either 1980 or 2013.

• Names present in 2013 but not in 1980 could have in principle jumped up more than the 182320% of Avery. The largest increase one of these names could have experienced is if they started with a count of 1 in 1980.
  Of course, in principle some of the names recorded only in 2013 could truly not have “existed” in 1980, thus earning an “infinite” increase. However, we can quite handle properly the possibility that a 2013 name was not actually given to anybody in 1980 because we are blind to what “happened” below the 5-count threshold. Therefore we restrict our estimate to the scenario whereby we assign to every name a count equal to 1 for the epochs for which it is not present.

• Viceversa, names present in 1980 but not in 2013, could have dropped more than 46016.7% of Misty and gone under threshold.

Assigning, as noted, a count = 1 for 1980 to names existing in 2013 and not in 1980, we compute their hypothetical percentage increase from 1 to their actual 2013 count.

tab5a <- filter(in2013_not1980, change_if_1 > max_increase) %>% arrange(desc(change_if_1))

kable(head(tab5a, N_show), row.names = TRUE, digits = 2)

tab5b <- filter(in1980_not2013, rev_change_if_1 > max_rev_decrease) %>% arrange(desc(rev_change_if_1))

kable(head(tab5b, N_show), row.names = TRUE, digits = 0)

NOTE: if we wanted to split hairs and be excruciatingly obsessive in estimating the largest potential increase, we could add to the total count for a name a “free \(+4\) contribution” for any state for which it does not appear in the data. That would be the maximum extra number of occurrences not accounted for. Viceversa for pushing the estimate for largest decrease we could add \(4\) free counts for each state where a name does not appear in 1980.
With a little R magic it would not be difficult but it is beyond the scope of this report. Moreover, considering that in the most extreme scenario of a name appearing for only one state, this would add \(200\) counts, it looks like it would not change substantially the rankings presented above.

Number of Distinct Names vs. Time

Right after WW2, or so it seems, female names’ variety started to grow while the used pool of male names remained fairly stable until the end of the 1960’s.
After that point male names have expanded but it does not look like the can catch up. Please note that the Y-axis scale is logarithmic, hence constant spacing means constant ratio (instead of constant difference).

colors_FM <- c("pink2", "dodgerblue2")

ggplot(by_year_by_gender, aes(x = year, y = n_dist)) + theme_bw() + 
            theme(legend.position = c(0.15, 0.85),
                axis.title = element_text(size = 14),
                axis.text= element_text(size = 12),
                axis.line = element_line(size = 1)
                ) +
       scale_color_manual(values = colors_FM) + 
       scale_fill_manual(values = colors_FM) + 
       scale_y_log10(breaks = c(1000, 2000, 4000)) + 
       # scale_y_log10(breaks = c(500, 1000, 1500, 2000, 2500, 3000, 3500, 4000, 4500, 8000)) + 
       labs(title = "Number of Distinct Names") + 
       ylab("Count") +
       geom_line(aes(color = gender), size = 1.2) + 
       geom_point(aes(fill = gender), alpha = 0.75, pch = 21, size = 3) 

Total Counts vs. Time

Total number of births as counted from this dataset. These would be the figures to compare with accurate data about birthrates, to investigate the effect of the low-count threshold for inclusion in the data.

The fact that the total counts for female and male births are systematically offset from each other by an amount that would seem hard to explain with natural causes, may be related to the presence of the threshold. The count distributions for female names are steeper than those for males, quite systematically independently of the state and by a larger degree in more recent decades. Steeper power law distributions, if they continue to lower counts below the threshold would resuls in a larger loss of data for female names and male names. This in turn would bias the cumulative counts by gender.

ggplot(by_year_by_gender, aes(x = year, y = tot_count)) + theme_bw() + 
       theme(legend.position = c(0.15, 0.85),
           axis.title = element_text(size = 14),
           axis.text= element_text(size = 12),
           axis.line = element_line(size = 1)
           ) +
       scale_color_manual(values = colors_FM) + 
       scale_fill_manual(values = colors_FM) + 
       scale_y_log10(breaks = 100*2**(1:7)) +
       coord_cartesian(ylim = c(300, 3000)) +
       # scale_y_log10(breaks = c(1000, 2000, 4000)) + 
       labs(title = "Total count (~ total number of births?)") +
       ylab("Count (thousands)") +
       geom_line(aes(color = gender), size = 1.2) + 
       geom_point(aes(fill = gender), alpha = 0.75, pch = 21, size = 3) 

Names Coverage

How far do popular names stretch?
How many distinct names are necessary to cover a given fraction of the new babies?

The curves in the following figure shows the fraction of the distinct names needed to cumulatively cover 90, 95, 99% of the new babies, as a function of time. The lines were largely flat or even decreasing until the 1950’s, when the highest percentile line started a long term upward trend. All percentiles unambiguously started an increasing trend at the beginning of the 1990’s.

At first glance I don’t see a reason why this trend could caused by population growth given that these lines represent the fraction of names given in a year, a relative measure. If population growth leads to the more names, as perhaps suggested by one of the previous figures, this by itself as a mass effect would not automatically cause a shift in the percentile lines.

My impression is that the trends reflect an increasing spreading of the tails of the distribution, with their cores able to account a decreasing portion of the population.

The spreading could be due to increased creativity, less

by_year_coverage <- group_by(df, year, name) %>% summarize(tot_count = sum(count)) %>% 
                                                 arrange(year, desc(tot_count))
by_year_coverage <- group_by(df, year, name) %>% summarize(tot_count = sum(count)) %>% 
                                                 arrange(year, desc(tot_count)) %>% mutate()

for_coverage2a <- group_by(df, year, name) %>% summarize(tot_count = sum(count)) %>% 
                                               arrange(year, desc(tot_count)) %>% 
                                               summarise(fn90 = get_coverage(tot_count, 90)$Fcov,
                                                         fn95 = get_coverage(tot_count, 95)$Fcov,
                                                         fn99 = get_coverage(tot_count, 99)$Fcov)

for_coverage2 <- gather(for_coverage2a, cutoff, fcov, fn90, fn95, fn99, -year)

cols <- c("red2", "blue2", "orange")
ggplot(for_coverage2, aes(x = year, y = fcov)) + theme_bw() + 
            theme(legend.position = c(0.2, 0.85),
                  axis.title = element_text(size = 14),
                  axis.text= element_text(size = 12),
                  axis.line = element_line(size = 1)
                  ) +
            scale_color_manual(values = cols) + 
            scale_fill_manual(values = cols) + 
            coord_cartesian(ylim = c(0.0, 0.8)) +
            labs(title = "Fraction of Names Needed to Cover Given Fraction of Newborn)") + 
            geom_line(aes(color = cutoff), size = 1.2) + 
            geom_point(aes(fill = cutoff), alpha = 0.75, pch = 21, size = 3) 

Examples

First a few more examples of the count distributions. They are all for the period 2009-2013, for eight states in different regions and of different size. In all of them the female name counts distributions are steeper than the male’s. Because broadly speaking their total integral should be approximately similar, their different slopes mean that they will cross-over, and so there are many more names with high-count among male names, and many more names with low-count among female names.

We noted above that the steeper slope of the female names distribution combined with the low-count threshold may have something to do with the offset between total number of female and male births counted from these data.

In a few of these plots there is a hint of a possible “knee” in the distribution of male names, between the power law part (left / lower counts side).

par(fig = c(0, 1, 0, 1), mar = c(5, 4, 4, 1)+0.1, cex.axis = 1.0)
single_panel_mar <- c(2, 2, 2, 1)
single_panel_oma <- c(0 ,0, 2, 0)
gr_par <- list( mar = single_panel_mar, oma = single_panel_oma, 
                cex = 1.0, cex.axis = 0.8, cex.lab = 1.0, 
                las = 0, mgp = c(1.0, 0.0, 0),
                tcl = 0.3)

par(gr_par)

mat.layout <- matrix(1:8, nrow = 4, byrow = TRUE)
layout(mat.layout)

plot_hist_state_year_with_fit(data = df, STATE = "AZ", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "CA", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "CO", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "DE", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "OK", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "SC", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "TN", YEAR = 2009:2013, subset = quote(y > log10(25)))
plot_hist_state_year_with_fit(data = df, STATE = "TX", YEAR = 2009:2013, subset = quote(y > log10(25)))

par(fig = c(0, 1, 0, 1), mar = c(5, 4, 4, 1)+0.1, cex.axis = 1.0)
title("Distributions", cex.main = 1.25, outer = TRUE)

Summary Plots of Power Law Fits

We split the data by state, decade and gender, binned them up and fit a linear regression model (lm()) to each name count distribution. Please note that the “decades” are actually partially overlapping, in the sense that we used a 10-year wide sliding window, moving it in steps of 5 years. So, consecutive data/models are not fully independent as they overlap for half of the time intervals.

The next three plots show the values of the slope of the female names distributions, the slope of the male names distributions and they difference. Points for each state are connected over time.
The thick long-dashed grey line connects the mean values at each time value.

The main observations from these figures are that:

• The power law slope for the distributions of female names has been steadily decreasing since the 1960’s, shifting from about \(-0.75\) to \(-1.1\).
• The slope of the male names has remained pretty stable at around \(-0.75\)
• Looking at the means, we can appreciate that the slope for female names has been steeper than that of male names since the 1960’s.
• This is illustrate more directly in the third figure, plotting the difference of the two slopes. It has been increasing for almost a century.

ggplot(powerlaw_fits, aes(x = Time, y = slopeF, color = State)) + theme_bw() + 
        theme(legend.position = "top", legend.title = element_blank()) +
        guides(col = guide_legend(nrow = 4, byrow = TRUE)) + 
        ylim(-2.2, -0.3) +
        geom_line(aes(group = State)) + 
        geom_point() +
        stat_summary(fun.y = "mean", geom = "line", aes(group=1), size = 2.0, lty = 5) +
        labs(title = "Slope of Power Law Fit to Female Names Count Distributions")

ggplot(powerlaw_fits, aes(x = Time, y = slopeM, color = factor(State))) + theme_bw() + 
        theme(legend.position = "top", legend.title = element_blank()) +
        guides(col = guide_legend(nrow = 4, byrow = TRUE)) + 
        ylim(-2.2, -0.3) +
        geom_line(aes(group = State)) + 
        geom_point() +
        stat_summary(fun.y = "mean", geom = "line", aes(group=1), size = 2.0, lty = 5) +
        labs(title = "Slope of Power Law Fit to Male Names Count Distributions")

ggplot(powerlaw_fits, aes(x = Time, y = slopeM-slopeF, color = factor(State))) + theme_bw() + 
        theme(legend.position = "top", legend.title = element_blank()) +
        guides(col = guide_legend(nrow = 4, byrow = TRUE)) + 
        ylim(-0.3, 0.9) +
        geom_line(aes(group = State)) + 
        geom_point() + 
        stat_summary(fun.y = "mean", geom = "line", aes(group=1), size = 2.0, lty = 5) +
        geom_abline(slope = 0, lty = 2, col = "grey40", size = 1) +
        labs(title = "Difference b/w Male and Female Power Law Slopes")