Ryan Quan

NYC Playgrounds by Neighborhood

Mon, 09 Feb 2015 00:00:00 -0500

If you’ve never found yourself wishing to be young again, New York City will certainly change that. With access to over 1200+ recreational play areas chock-full of fun and interactive playthings, life is good for an NYC kid. Heck, some playgrounds are even equipped with spinning water wheels, climbing walls, and giant building blocks. Jealous yet? Well, you should be.

But is life good for every NYC kid?

According to the Park Department’s website, the agency has “worked hard to provide play spaces that match the developmental needs and diversional demands of New York’s youngest residents and visitors.” Given this information, the (Sim) city planner in me became curious: are playgrounds allocated to neighborhoods in a way that reflects the population of children in that neighborhood? Or is there perhaps another mechanism for deciding where playgrounds should go?

Let’s answer these questions with some data.

Playgrounds Per 1K Children

To make it possible to compare the number of playgrounds between neighborhoods on a map, we have to standardize the count by the resident population. Thanks to OpenData, we can use the Neighborhood Tabulation Area (NTA) to get this information. However, since playgrounds are not typically intended for all ages (I don’t usually see newborns or grandmas playing on swing sets), I chose to standardize using the estimated population of the target audience - children ages 3 to 11 years old - to make our comparison metric more interpretable.

That led me to this map of the city:

</img>

If the distribution of playgrounds in NYC were based on the population of children, we expect the playground metric used above to have minimum variation. Graphically speaking, the shade of green should be fairly uniform across neighborhoods. However, from this map, we can that there are clear clusters of neighborhoods with high and low playground densities.

Note that there are a few caveats to keep in mind. For one, NTAs are aggregations of population estimates at the census tract level. I do not take into account margin of errors here. Second, regions with little to no residents, such as parks and cemetery spaces, were not included in the calculations and appear on the map as gray areas. As such, a neighborhood’s proximity to a park may affect the interpretation of the results. For example, let’s say neighborhoods around Central Park have relatively low numbers of playgrounds per children. However, given the copious amount of playgrounds located within the nearby super-park, I wouldn’t be so quick to call these neighborhoods “playground deserts.”

Median Household Income

Okay, so if playgrounds aren’t distributed with respect to the population of children living in each neighborhood, how exactly are they distributed? Maybe it has to do with how rich or poor a neighborhood is?

</img>

Not quite. The median household income and the playgrounds per children rate has a weak correlation of only 0.196. However, considering the many confounding factors in this relationship, this statistic should be taken with a grain of salt. As the author of this peer-reviewed study explains, “while parks may be equitably distributed across neighborhoods, the quality of the parks may be highly variable.” The same logic an be applied for playgrounds - in order to overcome the limitation of these analyses, we simply need more and better data.

Neighborhoods with the Most Playgrounds Per 1K Children

Alright, now that you have an idea of some of the assumptions I made in this quick analysis, let’s end this post with the juicy stuff - which neighborhoods dominate the playground market?

</img>

Interesting. There appears to be the most playgrounds per children in Lower Manhattan and North Brooklyn - popular tourist areas. Perhaps the Park Department is catering more towards the demand of New York’s youngest visitors rather its residents?

Neighborhoods with the Least Playgrounds Per 1K Children

Now let’s see which neighborhoods rank in the bottom:

</img>

Excluding the neighborhoods that are located near park areas, perhaps this list can serve as a starting point for city planners looking to develop new playgrounds.

Resources

As there are many more questions to explore, I encourage you to check out the data for yourself. To get you started, I published a GitHub repo with all the public datasets and scripts needed to replicate the charts above (and then some). You can also download the datasets piecemeal via the links below:

NYC Planning

OpenData.City

Median Household Income 2010, Census Tracts

NYC Parks

NYC Playgrounds Data

Big thanks to Ben Wellington from IQuantNY for providing inspiration and to NYC Open Data for making this all this work possible within a weekend!

Sleep Data Analysis with R

Wed, 28 Jan 2015 00:00:00 -0500

I have been keeping track of my sleep for over two years using the Sleep Cycle app for the iPhone. I initially downloaded the app for its smart alarm feature, which promises to wake you up without feeling tired (every person’s dream). The app allegedly achieves this feat by triggering the alarm when you are in light sleep, which is determined by the detection of your movements in bed. When you are finally able to wake up, you are treated to a nice summary of last night’s slumber:

</img>

Clearly, I had trouble sleeping that night.

But what’s even more interesting is the ability to export data for each night of sleep. While Sleep Cycle does not (yet) allow the user to have access to fine-grained data like movement at various time intervals, we can still get the time we went to bed, the time we woke up, sleep quality, wake up mood, resting heart rate, and more. Since I have been using this app for quite some time, I am fortunate enough to have collected over 500 data points. This makes it easy for a quantified selfer like myself to conduct his own sleep analysis.

That being said, let’s fire up R and and answer some questions with ggplot2!

Bedtime Hours

The first thing I wanted to know right off the bat was the most common hours I went to bed. Taking a rule from Tufte’s visualization philosophy, I made sure to keep my data-to-ink ratio low since I’m only plotting one piece of information.

</img>

Clearly, I should be sleeping earlier. According to this graph, the most common hour I fall asleep is 2 in the morning. However, I should be mindful of bias since I am less likely to initialize the Sleep Cycle app when I’m super tired - as is often the case when I fall asleep before midnight.

Sleep Duration

Next up on this sleep analysis journey is determining how often I slept for when I did fall asleep. This can be answered with a simple histogram:

</img>

An approximately normal distribution as expected with the large sample size. On average, I slept about 355 minutes, or 5 hours and 55 minutes per night. Take note that the mean is pulled up by an outlier, the result of a 12 hour hibernation on a warm summer night last year.

Sleep Duration Over Time

How has the duration of my sleep changed over the past two years? One interesting note I should mention is that I moved from Berkeley, CA to New York, NY in August 2013 for grad school. Did this change of environment affect my sleep in any way? Let’s check it out:

</img>

Interesting. To make the graph more interpretable, I fitted a LOESS curve through the data so we can see how my average sleep duration changed over time. According to this visualization, I appeared to adjust well to the notoriously loud New York City. However, during the months of November and December of 2013, my average sleep duration dropped. This trend may be the result of finals season taking over my life. Since then, however, I’ve been on a mission to repair my sleep schedule.

Sleep Quality Over Time

In the graph above, red dots indicated “poor” sleep quality whereas blue dots indicated “good” sleep quality. The cutoff between poor and good was made at 60%, the median of all sleep quality values.

But what the heck is this “sleep quality” variable even about?

According to the Sleep Cycle FAQ, this metric is affected by two factors:

Total time asleep
Amount of movement

Since we don’t have access to the movement data, we can’t verify the relationship between movement and sleep quality. However, we can check to see if there is a linear relationship between sleep duration and sleep quality:

</img>

Given this information, it is possible for sleep quality to increase even when sleep duration decreases, especially if I’m moving around less in bed. So perhaps even though I’m sleeping for shorter durations in NYC, I’m getting better sleep overall. Let’s plot sleep quality over time to find out if this is true:

</img>

Notice how the LOESS curve is similar to the LOESS curve in the graph depicting sleep duration over time. So maybe I’m sleeping more peacefully, but sleep duration is heavily weighted in Sleep Cycle’s sleep quality formula. Or maybe my movements in bed are fairly consistent and I just need to sleep for longer periods.

Probably the latter.

Resources

If you want to play around with sleep data, but don’t have the Sleep Cycle app, I published a GitHub repo with a sample dataset and the R code I used to generate these graphs. You can also download the dataset and use the Gist below for your convenience. Happy self-quantifying!

Download the sleep data here.

Knn Faces

Mon, 15 Dec 2014 00:00:00 -0500

In Yo Face Machine Learning

Objective
Data Description
Method
Code
Conclusions

Objective

The goal of this project is to build a simple classifier using the k-nearest neighbors algorithm in order to identify unique faces from the Extended Yale Faces Database B. This task will require us to wrangle image data and create new features so that we can pass our data into our knn method.

Data Description

The extended Yale Faces Database B contains 16128 images of 28 human subjects under 9 poses and 64 illumination conditions. For this analysis, we will be exclusively using the cropped images under 4 different pose/lighting conditions to improve processing time. The cropped images are in the portable graymap format (PGM) and have the dimensions of 192 pixels by 168 pixels.

Method

To build our k-nearest neighbors classifier, we will take the following approach:

Pre-processing

Recursively iterate the data directory to find the appropriate image data.
Read the image data into R as a list of matrices (192 x 168)
Transform the list of matrices into rows of pixels with each row representing one image and each column representing one pixel.
Label the rows with appropriate subject ID number.

Building the Model

Partition the dataset into training and testing sets.
Run principal component analysis on training and testing sets to mitigate effects of the curse of dimensionality.
Train k-nearest neighbors classifier; tune the k parameter.

Assessing the Model

Use kNN classifier to predict subject ID labels of testing set.
Tweak parameters to assess model stability.
???
Profit.

Code

Functions

newPar <- function(row, col, margin = TRUE) {
    #     Sets new settings for graphics device.
    #     Args:
    #         row: number of rows in image grid.
    #         col: number of columns in image grid.
    #         margin: If TRUE, keep margins. If not, remove.
    #     Returns:
    #         new settings for par()
    if (margin) {
        op <- par(mfrow = c(row, col))
    } else {
        op <- par(mfrow = c(row, col))
        op <- par(oma = c(0,0,0,0),
                  mar = c(0,0,1,0),
                  mai = c(0,0,0,0))
    }
    return(op)
}

createFileNames <- function(pics, views, dir) {
    #     Creates a list of file names from the Yale Faces database.
    #     
    #     Args:
    #         pics: a numeric vector representing the subjects
    #         views: a character vector representing the views
    #         dir: a character vector representing file paths
    #     Returns: a list of filenames
    filenames <- list() # initialize empty list
    for (i in 1:length(pics)) {
        for (j in 1:length(views)) {
            # generate string denoting filepath
            filename <- sprintf("CroppedYale/%s/%s_%s.pgm",
                                dir[pics[i]] , 
                                dir[pics[i]] , 
                                views[j])
            # append the filename to files
            filenames <- append(filenames, filename)
        }
    } 
    return(filenames)
}

loadPics <- function(filenames, pics, views) {
    #     Loads a list of pictures and converts to a list of matrices.
    #     
    #     Arg:
    #         filenames: a list of filenames
    #     Return:
    #         A list of matrices, each corresponding to one image.
    pic_data <- vector("list",length(pics)*length(views)) # pre-allocate list 
    pic_data <- lapply(filenames, read.pnm) 
    pic_matrix <- lapply(pic_data, getChannels) # convert to matrix (192 x 168)
    return(pic_matrix)
}

flattenMatrix <- function(pic_matrix) {
    #     Convert a list of matrices into a a list of vectors.
    #     
    #     Args:
    #         faces_matrix_list: a list of matrices representing images
    #     Returns:
    #         A list of vectors, each row reprsenting one image.
    # Pre-allocate a matrix with dimensions (number of pictures) 
    # x (number of pixels per picture)
    num_pixels <- prod(dim(pic_matrix[[1]]))
    
    flat_matrix <- matrix(nrow = length(pic_matrix), ncol = num_pixels)
    for (i in 1:length(pic_matrix)) {   
        flat_matrix[i, ] <- as.vector(pic_matrix[[i]])
    }
    return(flat_matrix)
}

createLabels <- function(pics, views, dir) {
    #     Creates a data frame of labels from the Yale Faces database.
    #     
    #     Args:
    #         pics: a numeric vector representing the subjects
    #         views: a character vector representing the views
    #         dir: a character vector representing file paths
    #     Returns: a data frame with columns for subject and view
    subject <- vector()
    view <- vector()
    for (i in 1:length(pics)) {
        for (j in 1:length(views)) {
            subject <- append(subject, dir[pics[i]])
            view <- append(view, views[j])
        }
    }
    df <- data.frame(subject, view)
    return(df)
}

createDataPartition <- function(face_matrix, 
                                labels, 
                                n_seed = NULL, 
                                pr_train = 0.8) {
    #     Creates a dpart object with training/testing set partition.
    #     Args:
    #         face_matrix: the pre-processed face dataset
    #         labels: a vector of corresponding labels for the face_matrix
    #         n_seed: numeric. a seed for the PRN generator
    #         pr_train: numeric. proportion of dataset allocated to training
    #     Returns: a dpart object with the following:
    #         X_train: features in the training set
    #         X_test: features in the testing set
    #         y_train: labels in the training set
    #         y_test: labels in the testing set
    #         in_train: index number of training observations
    #         in_test: index number of testing observations
    fm_size <- dim(face_matrix)
    ntrain <- floor(fm_size[1]*pr_train)
    
    set.seed(n_seed)
    in_train <- sample(1:fm_size[1], ntrain)
    in_test <- c(1:fm_size[1])[-in_train]
    
    X_train <- face_matrix[in_train, ]
    X_test <- face_matrix[in_test, ]
    y_train <- labels[in_train, 1]
    y_test <- labels[in_test, 1]
    
    dpart <- list("X_train" = X_train, 
                  "X_test" = X_test, 
                  "y_train" = y_train, 
                  "y_test" = y_test,
                  "in_train" = in_train,
                  "in_test" = in_test)
    return(dpart)
}

preProcessPCA <- function(dpart, pc_num = 25) {
    #     Runs principal component analysis on a dpart object.
    #     Args:
    #         dpart: a dpart object
    #         pc_num: the number of principal components to use
    #     Returns: 
    #         data_pca: pre-processed training and testing set
    mean_face <- colMeans(dpart$X_train)
    X_train <- t(apply(dpart$X_train, 1, function(row) {
        row - mean_face}))
    X_test <- t(apply(dpart$X_test, 1, function(row) {
        row - mean_face}))
    
    pca <- prcomp(X_train, center = TRUE, scale = FALSE)
    
    X_train_pca <- X_train %*% pca$rotation[, 1:pc_num] 
    X_test_pca <- X_test %*% pca$rotation[, 1:pc_num]
    
    data_pca <- list("X_train_pca" = X_train_pca,
                     "X_test_pca" = X_test_pca)
    return(data_pca)
}

predictKNN <- function(dpart, pc_num = NULL, k = 1) {
    #     Trains a k-nearest neighbors classifier on a dpart object.
    #     Args:
    #         dpart: a dpart object
    #         pc_num: the number of principal components to use, if any
    #         k: the number of nearest neighbors to use
    #     Returns: 
    #         knn_pred: a vector of predictions 
    if (is.null(pc_num)) {
        knn_pred <- knn(dpart$X_train, dpart$X_test, dpart$y_train, k = k)
    } else {
        pca <- preProcessPCA(dpart, pc_num)
        knn_pred <- knn(pca$X_train, pca$X_test, dpart$y_train, k = k)
    }
    correct <- sum(knn_pred == dpart$y_test)
    incorrect <- sum(knn_pred != dpart$y_test)
    test_error <- incorrect / (correct + incorrect)
    
    cat(paste("Correctly Identified: ", correct, "\n", sep = ""))
    cat(paste("Incorrectly Identified: ", incorrect, "\n", sep = ""))
    cat(paste("Test Error: ", test_error, "\n", sep = ""))
    return(knn_pred)
}

Pre-Processing

## specify the images to be used in the analysis
views_4a <- c('P00A+000E+00', 'P00A+005E+10', 'P00A+005E-10', 'P00A+010E+00' )
pic_list <- 1:38
# get directory structure
dir_list_1 <- dir(path="CroppedYale/", all.files = FALSE)
dir_list_2 <- dir(path="CroppedYale/", all.files = FALSE, recursive = TRUE)

file_list <- createFileNames(pic_list, views_4a, dir_list_1)
face_images_4a <- loadPics(file_list, pic_list, views_4a)
face_matrix_4a <- flattenMatrix(face_images_4a)

labels_4a <- createLabels(pic_list, views_4a, dir_list_1)

Building the Model

face_4a <- createDataPartition(face_matrix_4a, 
                               labels_4a, 
                               n_seed = 1, 
                               pr_train = 0.8)

Some quality assurance for good measure - are we getting what we expect?

# first 5 files in training set
head(labels_4a[face_4a$in_train, ], 5)

##     subject         view
## 41  yaleB11 P00A+000E+00
## 57  yaleB16 P00A+000E+00
## 86  yaleB23 P00A+005E+10
## 136 yaleB35 P00A+010E+00
## 30  yaleB08 P00A+005E+10

# first 5 files in testing set
head(labels_4a[face_4a$in_test, ], 5)

##    subject         view
## 5  yaleB02 P00A+000E+00
## 12 yaleB03 P00A+010E+00
## 18 yaleB05 P00A+005E+10
## 20 yaleB05 P00A+010E+00
## 21 yaleB06 P00A+000E+00

Let’s build a 1-NN classifier. Since 1-NN is a low bias model and fits to our training set very tightly, we expect the model to be a poor classifier due to high variance.

predictKNN(face_4a, pc_num = 25, k = 1)

## Correctly Identified: 31
## Incorrectly Identified: 0
## Test Error: 0

##  [1] yaleB02 yaleB03 yaleB05 yaleB05 yaleB06 yaleB06 yaleB08 yaleB09
##  [9] yaleB09 yaleB10 yaleB10 yaleB15 yaleB15 yaleB18 yaleB19 yaleB20
## [17] yaleB20 yaleB21 yaleB25 yaleB25 yaleB26 yaleB28 yaleB30 yaleB30
## [25] yaleB31 yaleB31 yaleB31 yaleB32 yaleB33 yaleB37 yaleB39
## 38 Levels: yaleB01 yaleB02 yaleB03 yaleB04 yaleB05 yaleB06 ... yaleB39

Interesting! There were no misclassified faces even though we predicted using a 1NN classifier. What gives? Perhaps it has to do with the variability of the lighting conditions? Let’s test this hypothesis.

Assessing the Model

Lighting Conditions

# Use different lighting conditions
views_4c = c('P00A-035E+15', 'P00A-050E+00', 'P00A+035E+15', 'P00A+050E+00')

file_list <- createFileNames(pic_list, views_4c, dir_list_1)
face_images_4c <- loadPics(file_list, pic_list, views_4c)
face_matrix_4c <- flattenMatrix(face_images_4c)

labels_4c <- createLabels(pic_list, views_4c, dir_list_1)

face_4c <- createDataPartition(face_matrix_4c,
                               labels_4c,
                               n_seed = 2,
                               pr_train = 0.8)

# first 5 files in training set
head(labels_4c[face_4c$in_train, ], 5)

##     subject         view
## 29  yaleB08 P00A-035E+15
## 107 yaleB28 P00A+035E+15
## 86  yaleB23 P00A-050E+00
## 26  yaleB07 P00A-050E+00
## 140 yaleB36 P00A+050E+00

# first 5 files in testing set
head(labels_4c[face_4c$in_test, ], 5)

##    subject         view
## 3  yaleB01 P00A+035E+15
## 5  yaleB02 P00A-035E+15
## 8  yaleB02 P00A+050E+00
## 9  yaleB03 P00A-035E+15
## 16 yaleB04 P00A+050E+00

Again, let’s build another 1-NN classifier.

knn_pred <- predictKNN(face_4c, pc_num = 25, k = 1)

## Correctly Identified: 4
## Incorrectly Identified: 27
## Test Error: 0.870967741935484

Aha! We have quite a few misclassified faces this time around. Let’s plot them and see what the deal is:

misclass_pred_idx <- which(knn_pred != face_4c$y_test)
misclass_test_idx <- face_4c$in_test[misclass_pred_idx]

par(newPar(5, 6, margin = FALSE))
for (i in 1:length(face_images_4c[misclass_test_idx])) {
    plot(pixmapGrey(face_images_4c[misclass_test_idx][[i]]))
    title(knn_pred[misclass_pred_idx][i])
}

Okay, so the first set of images had no misidentified subjects for a test error of 0%. The second set of images had 27 misidentified subjects for a test error of 87.1%. Why did this happen?

By preprocessing our data using PCA, we are projecting our data onto a feature space that captures the most variance in our data. In the second set of images, most of the variance in the image data is found in the shadows cast by the different lighting views. As such, the projection of our image data onto the first 25 principal components would result in data that does not capture many of the distingushing features of each subject, which is needed to train our model to accurately predict the subject labels.

Varying the Training/Testing Set Divide

Alright, let’s do one more test to see how minute changes can affect our prediction accuracy. What if we varied how we partitioned our training and testing sets?

pr_train <- seq(0.25, 0.90, length.out = 10)

for (i in 1:length(pr_train)) {
    dpart <- createDataPartition(face_matrix_4c,
                                 labels_4c,
                                 n_seed = 2,
                                 pr_train = pr_train[i])
    print(sprintf("Training: %s, Testing: %s", 
                  round(pr_train[i], 3), 
                  round(1-pr_train[i], 3)))
    predictKNN(dpart, pc_num = 25, k = 1)
}

## [1] "Training: 0.25, Testing: 0.75"
## Correctly Identified: 22
## Incorrectly Identified: 92
## Test Error: 0.807017543859649
## [1] "Training: 0.322, Testing: 0.678"
## Correctly Identified: 16
## Incorrectly Identified: 88
## Test Error: 0.846153846153846
## [1] "Training: 0.394, Testing: 0.606"
## Correctly Identified: 15
## Incorrectly Identified: 78
## Test Error: 0.838709677419355
## [1] "Training: 0.467, Testing: 0.533"
## Correctly Identified: 13
## Incorrectly Identified: 69
## Test Error: 0.841463414634146
## [1] "Training: 0.539, Testing: 0.461"
## Correctly Identified: 14
## Incorrectly Identified: 57
## Test Error: 0.802816901408451
## [1] "Training: 0.611, Testing: 0.389"
## Correctly Identified: 12
## Incorrectly Identified: 48
## Test Error: 0.8
## [1] "Training: 0.683, Testing: 0.317"
## Correctly Identified: 8
## Incorrectly Identified: 41
## Test Error: 0.836734693877551
## [1] "Training: 0.756, Testing: 0.244"
## Correctly Identified: 8
## Incorrectly Identified: 30
## Test Error: 0.789473684210526
## [1] "Training: 0.828, Testing: 0.172"
## Correctly Identified: 3
## Incorrectly Identified: 24
## Test Error: 0.888888888888889
## [1] "Training: 0.9, Testing: 0.1"
## Correctly Identified: 1
## Incorrectly Identified: 15
## Test Error: 0.9375

These numbers shows us how different divisions of the data into testing and training sets can influence the prediction accuracy (testing error) of our model. Too little training data and our paramter estimates will have greater variance, resulting in a larger test error. Moreover, we might be trying to fit a model onto a training set in which there is no corresponding label in the test set. Too little testing data and our performance statistic itself will have greater variance.

Conclusions

In this project, we built a simple 1-NN classifier to identify unique subjects within a set of cropped face images. While more sophisticated algorithms for facial recognition already exist, this report can serve as a gentle introduction to the world of image recognition.

Resolving EntityRef - Expecting ';'

Thu, 20 Nov 2014 00:00:00 -0500

So Frank and I were scraping data off the web (with permission, of course) using R’s XML package when suddenly a wild error appeared! A quick search brought up a few StackOverflow posts and blogs offering common solutions. At first glance, we thought that the URL query string was the culprit of our woes - the xmlParse()` function could not read the unescaped ampersands!

doc <- "http://somesite.com/xml.php?Y2=2005&max=100"
xmlParse(doc)

Error: EntityRef: expecting ';'

However, whether we passed the URL without the escaped ampersands:

"somesite.com/results_xml.php?Y2=2005**&**max=100"

or with the escaped ampersands:

"somesite.com/results_xml.php?Y2=2005**&**max=100"

we still received the same exact error:

Error: EntityRef: expecting ';'

On the verge of nearly pulling our hairs out, we decided to examine the XML data more thoroughly. Only then did we find our problem child:

</img>

There were unescaped ampersands in the XML file itself! These sneaky guys were throwing the “EntityRef” error in the xmlParse() function all along. With this in mind, we tweak our approach to replace all unescaped ampersands in the XML file with the appropriate encoding:

So lesson learned: always check to see if you have a valid XML file before attempting to parse the data using any sort of scraper.

NYC Open Data Presentation

Sun, 16 Nov 2014 00:00:00 -0500

Back in October, I gave a brief presentation on the benefits of NYC Open Data for tracking issues on a district-level. This was primarily motivated from my work at the New York City Council and will be the basis of my MPH thesis, in which I will be creating a knowledge management system to quantify and visualize the 311 data for better communication in the policy arena.

However, what I wanted to share with everyone in this post is the idea of reproducible slides using slidify. I wrote the slides entirely in R and the plots were generated using R’s ggplot2 library.

The motivation behind this was being able to host my slides on github and push new updates and changes as I received feedback during my presentations.

Check it out by following the links below:

Visualizing Introspection

Thu, 23 Oct 2014 00:00:00 -0400

Visualizing Introspection by Country

Objective

I am using the two most recent waves of the World Values Survey to examine the responses to the following survey question:

How frequently do you think about meaning and purpose in life?

The graph that I will be making will attempt to convey the following:

A comparison of the response breakdown between countries within the same wave
A comparison of the response breakdown within countries across different waves.

This information can be represented by a stacked horizontal bar plot that has the proportion of survey responses on the horizontal axis and the countries on the vertical axis.

Moreover, this particular survey question has five responses of interest:

Often
Sometimes
Rarely
Never
Don’t know

Applying the appropriate color palette could help the viewer to more easily interpret the breakdown of each country’s response. For example, we could use similar, positive colors for responses indicating a greater frequency of “thinking about meaning and purpose”.

Data Description

Before we wrangle our dataset into the appropriate long format for ggplot, let’s first define the target shape of our data.

{wave: "", country: "", meaning: "", proportion: ""}

Here are possible values that each column could take:

wave: “2005-2009”, “2010-2014”
country: “Afghanistan…”
meaning: “Often”, “Sometimes”, “Rarely”, “Never”, “Don’t Know”
proportion: “numeric”

Since the objective is to compare all countries that have values in both waves, we do not yet know the exact length of this particular variable.

Code

Let’s declare our dependencies and define some helper functions so we can keep our environment clean:

library(ggplot2)
library(dplyr)
library(reshape2)
library(scales)
library(RColorBrewer)

########################
# FUNCTIONS
########################
selectVars <- function(df, code, name) {
    # Select survey variables to include in the subsetted data frame.
    # Args:
    #   df: a data.frame of the WVS survey data
    #   code: a vector of strings corresponding to survey codes
    #   name: a vector of strings corresponding to desired varname
    # Returns:
    #   A subsetted and named data.frame 
    if (length(code) != length(name)) {
    stop("Length of code and name vectors do not match.")
    }
    ## pre-allocate size of list
    varList <- vector("list", length(code))
    varList <- df[code]
    ## create data.frame from list
    dfNames <- data.frame(varList)
    names(dfNames) <- name
    return(dfNames)
}

factorizeVars <- function(df) {
    # Convert all variables into factors
    # Args:
    #   df: a data.frame
    # Returns:
    # a data.frame of variables of class "factor"
    data.frame(apply(df, 2, as.factor))
}

labelValues <- function(var, df, sep = ":") {
    # Reads in codebook from the current directory
    # and creates factor labels for the given variable.
    # If no codebook is found, no labeling is done.
    # Args:
    #   var: string. the name of the variable to be labeled
    #   df: data.frame. the data.frame containing the variable
    #   sep: string. the delimiter used in the codebook
    # Returns:
    #   A vector of class "factor" with the corresponding labels
    filename <- paste(var, ".txt", sep = "")
    if(file.exists(filename)) {
        dfLabels <- read.delim(filename, header = FALSE, sep = sep)
        labeledVar <- factor(df[, var],
                              levels = dfLabels$V1,
                              labels = dfLabels$V2)
        labeledVar
    } else {
        cat(sprintf("%s does not exist in the current directory. \n", filename))
        cat(sprintf("No labeling done for %s.", var))
        df[, var]
    }
}

labelDataFrame <- function(df, sep = ":") {
    # A wrapper for the above function to vectorize the labeling
    # process for all column variables.
    listLabeled <- sapply(colnames(df), function(var) {
        labelValues(var, df, sep = sep)
    })
    dfLabeled <- data.frame(listLabeled)
    return(dfLabeled)
}

reorderResponses <- function(df, var, newLevels) {
    # Reorder factor levels of response variable.
    # Args:
    #   df: data.frame. the data.frame containing the var to be reordered
    #   var: string. the name of variable to be ordered
    #   newLevels: a vector of strings to denote new var order
    # Returns:
    #   A data.frame
    df[, var] <- factor(df[, var],levels = newLevels)
    return(df)
}

handleMissingValues <- function(df, missingLabels) {
    # Remove missing responses from the dataset
    # Args:
    #   df: data.frame. the data.frame 
    #   missingLabels: string. a vector of reponse values to be removed
    # Returns:
    #   A data.frame with missing responsed removed
    df <- filter(df, !(meaning %in% missingLabels))
    return(df)
}

subsetByCountriesInBothWaves <- function(df, wave1, wave2) {
    # Subsets the data.frame by countries that have responses in both waves.
    # Args:
    #   df: data.frame. the data.frame 
    #   wave1: string. the year of the first wave to match against
    #   wave2: string. the year of the second wave to match against
    # Returns:
    #   A data.frame with countries that have responses in wave 1 and wave 2.
    firstWave <- df %>% filter(wave == wave1)
    secondWave <- df %>% filter(wave == wave2)
    
    firstWave <- firstWave[which(firstWave$country %in% secondWave$country), ]
    secondWave <- secondWave[which(secondWave$country %in% firstWave$country), ]
    
    df <- rbind(firstWave, secondWave)
    return(df)
}

reorderCountriesByProportion <- function(df, refWave) {
    # Reorders the levels of the country factor variable by
    # the proportion of responses from the reference wave.
    # Args:
    #   df: the data.frame
    #   refWave: string. the reference wave to sort by
    # Returns:
    #   A sorted data.frame
    countryIndex <- df %>%
        group_by(meaning) %>%
        filter(wave == refWave) %>%
        filter(meaning == "Often") %>%
        arrange(desc(proportion))
    
    countryIndex <- data.frame(countryIndex)
    df$country <- factor(df$country, levels = countryIndex$country)
    return(df)
}

Visualization

Alright, now let’s run the script to wrangle and visualize the dataset so we can answer our key question:

## globals
newLevels <- c("Often", "Sometimes", "Rarely", "Never", "No answer",
               "Not asked in survey", "Missing: Unknown", "Don´t know")
missingLabels <- c("No answer", "Missing: Unknown", "Not asked in survey")

## reading in the data
df <- load("WVS_Longitudinal.rdata")
df <- `WVS_Longitudinal_1981-2014_rdata_v_2014_11_25`

df %>%
    # pre-processing
    selectVars(code = c("S002", "S003", "S020", "F001"),
               name = c("wave", "country", "year", "meaning")) %>%
    factorizeVars() %>%
    labelDataFrame() %>%
    reorderResponses(var = "meaning", newLevels = newLevels) %>%
    handleMissingValues(missingLabels = missingLabels) %>%
    
    ## get proportion of responses for each country by wave
    group_by(wave, country, meaning) %>%
        summarise(count = n()) %>%
        mutate(proportion = count/sum(count)) %>%
        arrange(meaning, desc(proportion)) %>%
    
    ## prep data for plotting
    subsetByCountriesInBothWaves(wave1 = "2005-2009",
                                 wave2 = "2010-2014") %>%
    reorderCountriesByProportion(refWave = "2005-2009") %>%
    
    ## generate the plot
    ggplot(aes(country, proportion, fill = meaning)) +
    geom_bar(stat = "identity", alpha = 7/8) + facet_grid(~wave) +
    ggtitle("How frequently do you think about meaning and purpose in life?") +
    xlab("Country") + ylab("Proportion of Survey Responses") +
    ## display proportion as percent
    scale_y_continuous(label = percent) +
    scale_fill_manual(values = rev(brewer.pal(n = 5, "RdYlBu"))) +
    coord_flip() + 
    ## minimalist theme
    theme_bw() +
    theme(legend.position = "bottom",
          legend.title = element_blank(),
          ## make reference lines darker
          panel.grid.major.x = element_line(color = "black"),
          panel.grid.major.y = element_blank(),
          panel.border = element_blank(),
          strip.background = element_blank(),
          axis.ticks = element_blank())

## Warning in `levels<-`(`*tmp*`, value = if (nl == nL) as.character(labels)
## else paste0(labels, : duplicated levels in factors are deprecated

## year.txt does not exist in the current directory. 
## No labeling done for year.

Image Compression with PCA

Tue, 07 Oct 2014 00:00:00 -0400

Ever wonder how various graphics software are able to reduce the file size of your image without a significant loss in quality? Welcome to the world of image compression! Expanding on a previous post in which I used principal component analysis (PCA) to generate so-called “eigenfaces”, I will be using the infamous Lenna image to demonstrate how the same technique can be used to compress images and reduce file size.

Before we dive into the demonstration, however, let’s briefly go over PCA in the context of color images. As most of you know, the smallest representation of a digital image on a display is called a “pixel.” PNG color images, like the ones we will be using, are typically comprised of pixels in RGB space. Here is a visual representation of one RGB pixel for more clarity:

So each pixel has three dimensions associated with it - red, green, and blue.

Now let’s say we have an PNG file that has the dimensions 512 x 512. The representation of this square image in RGB color space is therefore 512 x 512 x 3, a 3-D array. This may be hard to imagine, so for the purposes of interpretation, let’s split this image into its individual color spaces and focus only on the red dimension, a 512 x 512 matrix.

Now that we are working with a matrix, we can do some fun statistics. Grossly summarizing the algorithm, we can use PCA to find new directions in our red color space that describe the most information (maximizing the variance of our data). We can then project our red pixel values onto this new space, being sure to choose a smaller number of dimensions without resulting in too much information loss.

We could then extend PCA to both the green and blue color spaces and stitch back individual 512 x 512 matrices into the original 3-D array.

So what does this look like? How many principal components must we use to get a similar image quality to the original while still reducing the overall file size? Check out the gallery below:

Interesting! But did we reduce the file size at all?

Awesome! We can even see how the first few principal components captures most of the information (variability) and how the reduction in file size for subsequent components decreases - just as PCA says it should!

As always, I encourage you to try it for yourself. Here’s some R code so you can go wild:

Denoising a PNG Image with kNN Imputation

Fri, 26 Sep 2014 00:00:00 -0400

Given a PNG image with noise, where noise is defined as having an RGB value equal to [0, 0, 0], we can use k-nearest neighbors imputation to fill in the zeros using nearest neighbor averaging. For each row with a zero value, we find the k-nearest neighbors using a Euclidean metric, confined to columns for which that row is not zero. The accuracy of this image restoration technique will vary depending on how we set our k parameter.

Here, we attempt to denoise Lena.png. The target image can be downloaded here. See what happens when we vary the k parameter.

So which value of k do you think produces the best image? Try denoising the image yourself with the script provided below:

Principal Component Analysis and Eigenfaces

Tue, 23 Sep 2014 00:00:00 -0400

After an afternoon of playing around with Python’s sklearn library, I present to you a short little experiment in dimensionality reduction using the Extended Yale Faces Database B. The extended Yale Face Database B contains 16128 images of 28 human subjects under 9 poses and 64 illumination conditions. Here are some example images from this paper:

Eigenfaces

Reconstruction using PCA

Although facial recognition now employs far more sophisticated algorithms to classify faces, principal component analysis (PCA) is still used in many modern approaches for pre-processing, either as a means of dimension reduction or to form basis images for different modes of variation. So even though the proposed use of PCA for facial characterization dates all the way back to 1987, we are still seeing the so-called “eigenface” approach being used today - now that’s something!

Access the iPython notebook here.

Exploring New York City Council Meetings Data

Thu, 11 Sep 2014 00:00:00 -0400

If you haven’t noticed from my previous blog posts on New York City 311 complaints and webscraping legislation, I am a huge fan of using data to improve local politics and municipal policies. We often hear of data science in the context of training recommendation engines for behemoths like Amazon and Netflix, but with cities like New York pushing for open data, even a small-time data wrangler like myself can provide (hopefully) useful insights for my community.

So what lessons can be learned by exploring the rather inaccessible meetings data provided by the New York City Council Legislative Research Center? Let’s dive into the data!

Exploring Annual Trends

When I first started looking at the meetings data, I immediately wanted to know if there were any annual trends - how has the number of meetings held each year changed over time within each city council committee?

After a little cleaning and some fun with Hadley Wickham’s dplyr package and ggplot2 facets, we can generate an exploratory visualization to answer our question:

Interpreting the Graph

Let’s examine a few of the interesting features:

Finance. Wow, the Committee on Finance sure holds a lot of meetings each year! Since they are responsible for overseeing the budget process, this makes a lot of “cents” - follow the money and you’ll be sure to find council members willing to congregate.

Truncated Plots. A few of the plots are shorter than the rest - for example, the Committee on Technology and the Committee on Community Development only cover the last few years, suggesting that they have only been formed recently.

Land Use. The Committee on Land Use shows a clear trend upwards with respect to the number of meetings held each year. As New York City faces a shortage in affordable housing units, the approval process for commercial development projects becomes ever more difficult and may lend to this increase in calendared meetings.

City Council Stated. Every two weeks the New York City Council is supposed to meet for what is called the Stated Meeting to introduce and pass legislation. The flat line suggests that the frequency of meetings has remained relatively consistent over time.

The Unethical Spike

The spike in the number of meetings held by the Committee on Standards and Ethics in 2004, however, is by far the most glaring outlier. What exactly is going on here?

A little digging through the New York Times archive in 2004 for scandals reveals this little nugget of history in New York City politics:

So was this scandal responsible for the spike in our graph? A quick browse through the meeting details on Legistar confirms this to be true.

Caveats

We consider the period from 2000 to 2013 because data was incomplete for the years 1999 (the earliest recorded meeting year for this dataset) and 2014.
We removed deferred meetings to consider calendared meetings only.
We removed subcommittees, special task forces, town halls, and inactive committees to capture the primary committees that are currently active.

TODO

Continue adding features to the nycc-legistar repo
Feed HTML from the .aspx framework into R to for real-time updates
Text analysis of the meeting topics
Proportion of meetings deferred by committee

Ryan Quan

NYC Playgrounds by Neighborhood

Playgrounds Per 1K Children

Median Household Income

Neighborhoods with the Most Playgrounds Per 1K Children

Neighborhoods with the Least Playgrounds Per 1K Children

Resources

Sleep Data Analysis with R

Bedtime Hours

Sleep Duration

Sleep Duration Over Time

Sleep Quality Over Time

Resources

Knn Faces

In Yo Face Machine Learning

rcquan

December 15, 2014

Objective

Data Description

Method

Code

Functions

Pre-Processing

Building the Model

Assessing the Model

Lighting Conditions

Varying the Training/Testing Set Divide

Conclusions

Resolving EntityRef - Expecting ';'

NYC Open Data Presentation

Visualizing Introspection

Visualizing Introspection by Country

rcquan

October 23, 2014

Objective

Data Description

Code

Visualization

Image Compression with PCA

Denoising a PNG Image with kNN Imputation

Principal Component Analysis and Eigenfaces

Eigenfaces

Reconstruction using PCA

Exploring New York City Council Meetings Data

Exploring Annual Trends

Interpreting the Graph

The Unethical Spike

Caveats

TODO