Project2

Resolving overchoice

There are a lot of choices of data sets to look at. This caused the author some indecision. We can use R to take care of some of it though. There are 47 pages, and we need 3 examples, though some seem not quite fit for the assignment. Of course we have set the random seed so this is reproducible.

sample(1:47,10)

##  [1] 30 16  1  3  4 18 19 22 32 44

Evaluation of Page 30

Page 30’s first data set posted is the CDC SMART BRFSS (i.e. Metro area Behavioral Risk Factor). For data currency reasons we are using the 2017 data instead of the 2016 data that is suggested in the post. The extracted xpt file is 356 mb so the remote pull and unzip/load takes a fair amount of time.

mmsaRaw <- rio::import("https://www.cdc.gov/brfss/annual_data/2017/files/MMSA2017_XPT.zip")
kable(head(mmsaRaw[1:3]))

Well that is a lot of data. Unfortunately it looks tidy, there are a lot of data points for each response, but each observation variable is a column, each observation is a row, and each type of observation is broken out (there is only one).

Evaluation of page 16

Page 16 does not have a data set posted.

Evaluation of page 1

The first data set is the Census PINC-03 data set (All races 25 Years+ Total Work Experience) with the appropriate library R can read the xslx

pincRaw <-rio::import("https://www2.census.gov/programs-surveys/cps/tables/pinc-03/2019/pinc03_1_1_1_1.xls")

## New names:
## * `` -> ...2
## * `` -> ...3
## * `` -> ...4
## * `` -> ...5
## * `` -> ...6
## * ... and 6 more problems

kable(head(pincRaw))

The data did not import cleanly so we are going to have to do some work. First we slice off some extra rows, and combine and fill the column structure to get to a reasonable table. We then have to trim off the summary data they provide.

pincRaw <- slice(pincRaw,10:n()-1)
pincCols <- t(fill(as.data.frame(t(pincRaw[3:5,])),c(1,2,3) ))
colnames(pincRaw)<- gsub("Degree Graduate (Incl GED)", "Degree", gsub('(\\sNA)|(NA\\s)', '' ,paste(pincCols[1,],pincCols[2,],pincCols[3,], sep=" ")))
pinc <- slice(pincRaw,append(7,9:(n()-5))) %>% select(-Total)

kable(pinc)

pincTidy <- pinc %>% gather(Education, Thousands, -Characteristic)
pincTidy$Thousands <- as.numeric(pincTidy$Thousands)
kable(head(pincTidy))

earningless <- pincTidy %>% filter(Characteristic == "Without Earnings") %>%  group_by(Education) 
kable(earningless)

earningless[c(1,9),] %>%ggplot(aes( Education, Thousands)) + geom_bar(stat="identity")

Evaluation of Page 3

Page 3 isn’t a specific data set, but the unicef data sets. They are very nice, but there are so many we risk overchoice again, We’ll keep looking.

Evaluation of Page 4

Page 4’s first data post is the Illinois Report card data which is reported to be already tidy.

Evaluation of Page 18

Page 18 gives us unemployment data from the World Bank. We slice off a row, and take out a number of summary columns.

unempRaw<-rio::import("https://github.com/ErindaB/Other/raw/master/Unemployment%20Rate%2C%20seas.%20adj..xlsx")

## New names:
## * `` -> ...1

unempRaw<-slice(unempRaw, 2:n())
unempRaw <- unempRaw %>% select(-c("Advanced Economies"  ,"EMDE East Asia & Pacific"  ,"EMDE Europe & Central Asia"     ,"Emerging Market and Developing Economies (EMDEs)","High Income Countries"   ,"Hong Kong SAR, China" ,"EMDE Latin America & Caribbean"    ,"Low-Income Countries (LIC)"  ,"Middle-Income Countries (MIC)"                   ,"EMDE Middle East & N. Africa"  ,"EMDE South Asia","EMDE Sub-Saharan Africa","World (WBG members)"))

names(unempRaw)[[1]]<-"Year"
kable(head(unempRaw))

unempTidy <-unempRaw %>% gather(Country, UnempRate, -Year) %>% arrange( Country, Year)
unempTidy$UnempRate <- as.numeric(unempTidy$UnempRate)

## Warning: NAs introduced by coercion

kable(head(unempTidy))

worldRate<-unempTidy %>% group_by(Year) %>% summarize(rate=mean(UnempRate, na.rm = TRUE ))
unempTidy %>% group_by(Year) %>% summarize(rate=mean(UnempRate, na.rm = TRUE )) %>% ggplot(aes(Year,rate)) +geom_bar(stat="identity")

spaceOdyessy <- unempTidy %>% filter(Year==2001) %>% filter(!is.na(UnempRate)) %>% arrange(desc(UnempRate)) 
spaceOdyessy$Country <- factor(spaceOdyessy$Country, spaceOdyessy$Country)
spaceOdyessy %>% ggplot(aes(Country, UnempRate)) +geom_bar(stat="identity")

Page 19

Page 19 has no data set

Page 22

Page 22 is a Wikipedia table for Emmy winners. We use rvest to pull it down, and get it into a table. Thankfully rvest takes care of much of the filling. We splice out years before 1966 as a lot of it is misaligned with “modern” data.

emmyHTML <- read_html("https://en.wikipedia.org/wiki/List_of_Primetime_Emmy_Award_winners")
emmyTable<-rvest::html_table(emmyHTML, fill=TRUE)[[1]]
emmyTable<-emmyTable[emmyTable$Year>=1966,]
kable(head(emmyTable))

emmyTable<-gather(emmyTable, Category, Winner, -Year) %>% arrange (Year)
emmyTidy<-emmyTable%>% extract(Winner, c("Winner","Network"), "(.+) \\((.+)\\)")
kable(head(emmyTidy))

networkCount <-emmyTidy %>% group_by(Network) %>% summarize(count=n()) %>% filter(count>8)  %>% arrange(desc(count))
kable(networkCount)

emmyTidy %>% filter(Network %in% networkCount$Network) %>% ggplot(aes(x=Year,color=Network)) +geom_bar()