I will be looking at data from the American Community Survey and try to find patterns in the way Americans date, marry and divorce. This is still work in progress but I figured I’d add some plots and maps to begin with.
and looked at the ratio of single men to single women aged 18 - 35 with a college degree. Here’s the graph below. It’s not looking so good for the ladies I am afraid. Move your mouse over any state to find more detailed information.
I am also including the code. I used ACS census data and some munging to get the ratios by state then used the plot_ly
function to plot the maps and graphs above.
library ( ggplot2 )
library ( plotly )
library ( leaflet )
library ( dplyr )
load ( "/Users/alexpapiu/Documents/R/ACS Census EDA/census.Rd" )
ysingles <- filter ( cens , AGEP >= 18 , AGEP <= 35 , MAR %in% c ( 2 , 3 , 4 , 5 ))
ysingles.college <- filter ( ysingles , SCHL %in% 20 : 24 )
singbysex <- table ( ysingles $ SEX , ysingles $ ST )
ratios <- singbysex [ 1 ,] / singbysex [ 2 ,] #ratios
singbysex.col <- table ( ysingles.college $ SEX , ysingles.college $ ST )
ratios.col <- singbysex.col [ 1 ,] / singbysex.col [ 2 ,] #ratios for college
df <- read.csv ( "https://raw.githubusercontent.com/plotly/datasets/master/2011_us_ag_exports.csv" )
ggplotly ( ggplot ( cens.over15 , aes ( x = AGEP , ..count.. , fill = as.factor ( MAR ))) +
geom_density ( position = 'identity' , alpha = 0.4 ) +
xlab ( "Age" ) + ylab ( "Count" ) +
scale_fill_discrete ( name = "Marital Status" ,
labels = c ( "Married" , "Widowed" , "Divorced" ,
"Separated" , "Never Married" )))
singles.state <- data.frame ( code = df $ code , ratios = ratios [ -11 ],
ratios.col = ratios.col [ -11 ]) #no washingoton DC
singles.state $ men <- floor ( singles.state $ ratios * 100 )
singles.state $ mencol <- floor ( singles.state $ ratios.col * 100 )
singles.state $ state <- df $ state
singles.state $ hover1 <- with ( singles.state ,
paste ( state , "<br>" , men , " single men per 100 single women" ) )
singles.state $ hover2 <- with ( singles.state ,
paste ( state , "<br>" , mencol , " single men for every 100 single women" ) )
g <- list (
scope = 'usa' ,
projection = list ( type = 'albers usa' ),
showlakes = TRUE ,
lakecolor = toRGB ( 'white' )
)
#singles ratios
plot_ly ( singles.state , z = ratios , locations = code , type = 'choropleth' ,
locationmode = 'USA-states' , color = ratios , colors = 'Purples' ,
text = hover1 , colorbar = list ( title = "Ratio" )) %>%
layout ( title = 'Ratio of Single Men to Women Aged 18 to 35
<br> (Hover for breakdown)' , geo = g )
#college singles ratios
plot_ly ( singles.state , z = ratios.col , locations = code , type = 'choropleth' ,
locationmode = 'USA-states' , color = ratios.col , colors = 'Purples' ,
text = hover2 , colorbar = list ( title = "Ratio" )) %>%
layout ( title = 'Ratio of Colege Educated Single Men to Women <br> (Hover for breakdown)' , geo = g )