JSON-Parsing Survey Tasks: Chicago

This code flattens the Chicago Wildlife Watch data.

library(tidyjson)
library(magrittr)
library(jsonlite)
library(dplyr)
library(stringr)
library(tidyr)
chicago_unfiltered <- read.csv("../data/chicago-wildlife-watch-classifications.csv", stringsAsFactors = F)

First, we need to limit the classification data to the final workflow version and, if necessary, split by task. T0 is clearly the only task we really care about in this dataset (though note the changed format of current site).

# check which workflow version we want:
chicago_unfiltered %>% summarise(., n_distinct(subject_ids), n_distinct(classification_id), n_distinct(workflow_version))

quick_check <- chicago_unfiltered %>% 
     select(., subject_ids, classification_id, workflow_version, annotations) %>%
     as.tbl_json(json.column = "annotations") %>%
     gather_array(column.name = "task_index") %>% # really important for joining later
     spread_values(task = jstring("task"), task_label = jstring("task_label"), value = jstring("value"))  %>% 
     gather_keys %>%
     append_values_string()
quick_check %>% data.frame %>% group_by(., workflow_version, key, task) %>% summarise(., classification_count = n()) %>% print

So filter to the appropriate workflow and get going! Let’s take a quick peek at the data.

chicago <- chicago_unfiltered %>% filter(., workflow_version == 397.41)
chicago$annotations[1] %>% prettify()

[
    {
        "task": "T0",
        "value": [
            {
                "choice": "RCCN",
                "answers": {
                    "HWMN": "1"
                },
                "filters": {

                }
            }
        ]
    }
]
 

# preliminary flat
basic_flat_with_values <- chicago %>% 
     select(., subject_ids, classification_id, workflow_version, annotations) %>%
     as.tbl_json(json.column = "annotations") %>%
     gather_array(column.name = "task_index") %>% # really important for joining later
     spread_values(task = jstring("task"), task_label = jstring("task_label"), value = jstring("value")) 
basic_flat_with_values %>% data.frame %>% head

chicago_summary <-  basic_flat_with_values %>% 
     gather_keys %>%
     append_values_string()
chicago_summary %>% data.frame %>% head # this will have all the classification IDs; if Value is empty, then the field will be null. This will have multiple rows per classification if there are multiple tasks completed

chicago_summary %>% data.frame %>% group_by(., workflow_version, key, task) %>% summarise(., n())

# quick check the filtered original data
chicago %>% summarise(., n_distinct(subject_ids), n_distinct(classification_id), n_distinct(workflow_version))

Now dive into the first nested object, the species choice. Note that if you have different task types that you haven’t filtered out, or if you have null objects, this might break or else drop rows.

# grab choices; append embedded array values just for tracking
# Note that this will break if any of the tasks are simple questions. You would need to split by task before here.
chicago_choices <- basic_flat_with_values %>%
     enter_object("value") %>% json_lengths(column.name = "total_species") %>% 
     gather_array(column.name = "species_index") %>% #each classification is an array. so you need to gather up multiple arrays.
     spread_values(choice = jstring("choice"), answers = jstring("answers")) #append the answers as characters just in case
# if there are multiple species ID'd, there will be multiple rows and array.index will be >1
chicago_choices %>% data.frame %>% head 

chicago_choices %>% group_by(., classification_id) %>% summarise(., count = n(), max(species_index)) %>% arrange(., -count)

Now dive into the second nested object, which is the sub questions. Since these actually aren’t arrays, it’s okay if they’re empty! This still keeps the rows.

# grab answers - for some reason, this keeps rows even if there are no answers! 
# Note that this last bit is the part that would need to be customized per team, I think
chicago_answers <- chicago_choices %>% 
     enter_object("answers") %>% 
     spread_values(how_many = jstring("HWMN"), wow = jstring("CLCKWWFTHSSNWSMPHT"), off_leash = jstring("CLCKSFDGSFFLSH"))
chicago_answers %>% data.frame %>% head      

#chicago_answers %>% group_by(classification_id) %>% summarise(., n())     

Put everything back together, which is important if you’ve dropped rows because of empty arrays and things.

# in theory, you want to tie all of these back together just in case there are missing values
add_choices <- left_join(basic_flat_with_values, chicago_choices)

Joining, by = c("subject_ids", "classification_id", "workflow_version", "task_index", "task", "task_label", "value")

tot <- left_join(add_choices, chicago_answers)

Joining, by = c("subject_ids", "classification_id", "workflow_version", "task_index", "task", "task_label", "value", "total_species", "species_index", "choice", "answers")

flat_data <- tot %>% select(., -task_index, -task_label, -value, -answers)
flat_data %>% data.frame %>% head

Here’s your file out!

write.csv(flat_data, file = "../data/chicago-flattened.csv")