07_Inference.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<center> <img style=\"float: center;\" src=\"images/CI_horizontal.png\" width=\"450\">\n",
    "<center>\n",
    "    <span style=\"font-size: 1.5em;\">\n",
    "        <a href='https://www.coleridgeinitiative.org'>Website</a>\n",
    "    </span> "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# <center>Inference: Imputing Missing Values in a Dataset</center>\n",
    "<br>\n",
    "<center>Rukhshan Mian, Maryah Garner, Brian Kim</center>\n",
    "<br>\n",
    "<a href=\"https://doi.org/10.5281/zenodo.6463899\"><img src=\"https://zenodo.org/badge/DOI/10.5281/zenodo.6463899.svg\" alt=\"DOI\"></a>\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Introduction: Missing Data \n",
    "\n",
    "Datasets often contain variables with missing (or unknown) data. This notebook explores methods for treating missing values in a dataset. Unfortunately, there is usually no single *right* answer for how to treat missing values. But it is possible to impute missing values to infer--or provide a best guess for--each missing point's true value. \n",
    "\n",
    "\n",
    "\n",
    "### Learning Objectives\n",
    "\n",
    "#### Explore common methods for dealing with missing values:\n",
    "- [Dropping all \"missing\" values](#dropping-values)\n",
    "    \n",
    "**Imputation methods**\n",
    "- [Substituting missing values with the mean of a group](#mean-imputation) \n",
    "- [Regression imputation](#regression-imputation)\n",
    "- [Mode imputation (for categorical variables)](#mode-imputation)\n",
    "\n",
    "\n",
    "<span style=\"color:blue\">**The notebook will walk through imputing missing values for age at dissertation for the 2015 cohort.**</span>\n",
    "***"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## R Setup\n",
    "\n",
    "As always, start by importing the required libraries, as well as creating the connection to the database."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "options(warn=-1)                     # turn off warnings\n",
    "\n",
    "suppressMessages(library(odbc))      #database interaction imports\n",
    "\n",
    "suppressMessages(library(tidyverse)) # for data manipulation/visualization\n",
    "\n",
    "suppressMessages(library(scales))    # scaling data, calculating percentages, overriding default graphing\n",
    " \n",
    "suppressMessages(library(survey))    # adding weights\n",
    "\n",
    "# to better view images\n",
    "# For easier viewing of graphs\n",
    "# Adjust repr.plot.width and repr.plot.height to change the size of graphs\n",
    "theme_set(theme_gray(base_size = 24))\n",
    "options(repr.plot.width = 20, repr.plot.height = 12)\n",
    "options(scipen=999)\n",
    "options(warn=0)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Connect to the database\n",
    "con <- DBI::dbConnect(odbc::odbc(),\n",
    "                     Driver = \"SQL Server\",\n",
    "                     Server = \"msssql01.c7bdq4o2yhxo.us-gov-west-1.rds.amazonaws.com\",\n",
    "                     Trusted_Connection = \"True\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Read in data"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# See how many missing ages there are\n",
    "# Get the count of non-null values for age at dissertation and the count of all rows\n",
    "query <- \"\n",
    "SELECT count(age_at_dissertation) AS age_at_dissertation_count, \n",
    "    count(*) AS total_count, \n",
    "    count(*)-count(age_at_dissertation) AS total_missing\n",
    "FROM ds_nsf_ncses.dbo.nsf_sed;\n",
    "\"\n",
    "dbGetQuery(con,query)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# First, confirm the data type of the age_at_dissertation variable\n",
    "query <- \"\n",
    "SELECT age_at_dissertation, drf_id, phdinst\n",
    "FROM ds_nsf_ncses.dbo.nsf_sed;\n",
    "\"\n",
    "df <- dbGetQuery(con, query)\n",
    "\n",
    "class(df$age_at_dissertation)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Checking for Missing Data \n",
    "\n",
    "Our example focuses on the `age_at_dissertation` variable in the `nsf_sed` table, where there are a lot of missing values for age."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "> Given that there are a sizable amount of observations with missing ages, imputation might be suitable if you wanted to include age at dissertation in your analysis. The following subsections will walk through different methods of imputation."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<a id=\"dropping-values\"></a>\n",
    "# \n",
    "### Method 1. Dropping missing values"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Oftentimes, missing values are treated by ignoring them (dropping them). However, ignoring missing values assumes that they represent the same distribution as the present one. \n",
    "> Dropping missing values is often called listwise deletion and essentially assumes that missing values are missing completely at random (MCAR), which is not always the case.\n",
    "\n",
    "**We recommend you do not ignore missing values.** However, if you are going to drop missing values, dig deeper to understand who is part of the cohort being dropped. For example: *What is the gender/racial composition of the cohort that is being dropped? Are there specific genders/races that are being dropped?*"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<br>\n",
    "\n",
    "Before dropping missing values, we create labeled variables for **srceprim** (primary source of support), **sex**, and **race** (based on the data dictionary for SED) to perform additional data exploration and see if there are certain types of doctorate students who are being dropped."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Let's get the SED table\n",
    "query <- \"\n",
    "SELECT drf_id, age_at_dissertation, phdfield_name, srceprim, sex, race\n",
    "FROM ds_nsf_ncses.dbo.nsf_sed\n",
    "\"\n",
    "sed <- dbGetQuery(con,query)\n",
    "\n",
    "# In order to use sex and race, we would need to create labeled variables. \n",
    "\n",
    "sed <- sed %>%\n",
    "    #creating source_cat – this is similar to what we did in Module 2\n",
    "    mutate(source_cat = case_when(srceprim %in% c(\"A\", \"B\") ~ \"Fellowship Grant\",\n",
    "                                  srceprim == \"C\" ~ \"Teaching Assistantship\", \n",
    "                                  srceprim == \"D\" ~ \"Research Assistantship\",\n",
    "                                  srceprim %in% c(\"H\", \"I\", \"J\") ~ \"Own Funds/Loan\", \n",
    "                                  srceprim %in% c(\"E\", \"F\", \"G\", \"K\", \"L\", \"M\",\"N\") ~ \"Other\",\n",
    "                                  srceprim == '' ~ 'Unknown')\n",
    "        ) %>%\n",
    "    #creating sex_cat: we are creating these categories based off the Data Dictionary\n",
    "    mutate(sex_cat = case_when(sex == \"\" ~ \"Unknown\",\n",
    "                            sex == \"1\" ~ \"Male\", \n",
    "                            sex == \"2\" ~ \"Female\")) %>%\n",
    "\n",
    "    #creating race_cat: we are creating these categories based off the Data Dictionary\n",
    "    mutate(race_cat = case_when(race == \"NA\" ~ \"Unknown\",\n",
    "                               race == \"-1\" ~ \"Refused\", \n",
    "                               race == \"1\" ~ \"American Indian or Alaskan Native\", \n",
    "                               race == \"2\" ~ \"Asian/Pacific Islander\", \n",
    "                               race == \"3\" ~ \"Asian\", \n",
    "                               race == \"4\" ~ \"Native Hawaiian or other Pacific Islander\", \n",
    "                               race == \"5\" ~ \"Black or African American\", \n",
    "                               race == \"6\" ~ \"Puerto Rican\", \n",
    "                               race == \"7\" ~ \"Mexican or Chicano\", \n",
    "                               race == \"8\" ~ \"Cuban\",\n",
    "                               race == \"9\" ~ \"Other Hispanic - Specify\", \n",
    "                               race == \"10\" ~ \"White\",\n",
    "                               race == \"11\" ~ \"Multiple racial responses cannot be prioritized into another category\",\n",
    "                               race == \"12\" ~ \"Other\"))\n",
    "\n",
    "# drop the original sex, race and srceprim columns \n",
    "# we will not be needing these as we just created labelled versions (source_cat, sex_cat, race_cat)\n",
    "sed <- sed %>% \n",
    "    select(-c(sex, race, srceprim))\n",
    "\n",
    "head(sed)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### Who is being dropped?\n",
    "\n",
    "Here, we see if there are any sex, race, or PhD field categories that are being dropped more often than others when we drop missing values in **age_at_dissertation** to calculate the mean age."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "##### **Sex**"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "sed %>%\n",
    "    # group by sex\n",
    "    group_by(sex_cat) %>% \n",
    "    # count the number of unique ids\n",
    "    mutate(complete_count = n_distinct(drf_id)) %>%\n",
    "    # ungroup\n",
    "    ungroup() %>%\n",
    "    # keep non missing age_at_dissertation\n",
    "    filter(!is.na(age_at_dissertation)) %>% \n",
    "    # regroup by sex\n",
    "    group_by(sex_cat) %>% \n",
    "    # get the counts for each case: \n",
    "    summarize(complete_count = mean(complete_count), # complete count\n",
    "              count_after_dropping_missing = n_distinct(drf_id), # count after dropping missing ages\n",
    "             count_with_just_missing = complete_count-count_after_dropping_missing) %>%  # count when we just keep missing ages\n",
    "    ungroup() %>% # ungroup\n",
    "    mutate(percentage_dropped = round((count_with_just_missing/complete_count)*100, 1)) # calculated rounded percentages\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We observe how the most values being dropped are for the Unknown category."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "##### **Race**"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "sed %>%\n",
    "    # group by race\n",
    "    group_by(race_cat) %>% \n",
    "    # count the number of unique ids\n",
    "    mutate(complete_count = n_distinct(drf_id)) %>%\n",
    "    # ungroup\n",
    "    ungroup() %>%\n",
    "    # keep non missing age_at_dissertation\n",
    "    filter(!is.na(age_at_dissertation)) %>% \n",
    "    # regroup by race\n",
    "    group_by(race_cat) %>% \n",
    "    # get the counts for each case: \n",
    "    summarize(complete_count = mean(complete_count), # complete count\n",
    "              count_after_dropping_missing = n_distinct(drf_id), # count after dropping missing ages\n",
    "             count_with_just_missing = complete_count-count_after_dropping_missing) %>%  # count when we just keep missing ages\n",
    "    ungroup() %>% # ungroup\n",
    "    mutate(percentage_dropped = round((count_with_just_missing/complete_count)*100, 1)) # calculated rounded percentages\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Here, we observe what happens to categories of race when we drop missing values in **age_at_dissertation**. We see that the Unknown and Refused categories are primarily dropped."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "##### **PhD Field of Study**"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "sed %>%    \n",
    "    # group by phdfield name\n",
    "    group_by(phdfield_name) %>% \n",
    "    # count the number of unique ids\n",
    "    mutate(complete_count = n_distinct(drf_id)) %>%\n",
    "    # ungroup\n",
    "    ungroup() %>%\n",
    "    # keep non missing age_at_dissertation\n",
    "    filter(!is.na(age_at_dissertation)) %>% \n",
    "    # regroup by phd field name\n",
    "    group_by(phdfield_name) %>% \n",
    "    # get the counts for each case: \n",
    "    summarize(complete_count = mean(complete_count), # complete count\n",
    "              count_after_dropping_missing = n_distinct(drf_id), # count after dropping missing ages\n",
    "             count_with_just_missing = complete_count-count_after_dropping_missing) %>%  # count when we just keep missing ages\n",
    "    ungroup() %>% # ungroup\n",
    "    mutate(percentage_dropped = round((count_with_just_missing/complete_count)*100, 1)) # calculated rounded percentages"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "In this case, we see that the category for Unknown Field is primarily dropped. The goal of this exercise is not to see why certain categories are being dropped but just to better understand the data we are using."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<a id=\"mean-imputation\"></a>\n",
    "## Method 2. Mean Imputation\n",
    "\n",
    "Imputed values will be **approximations**, and must be treated as such. If choosing to impute missing values in your project or future work, acknowledge the process you use and clearly state for which variables the values are imputed.\n",
    "\n",
    "One of the simplest ways of imputing values is by taking the mean and filling it in for the missing values. It's possible to do this by using the overall mean, as well as by certain subgroups. \n",
    "\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### Calculating Mean"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Find the overall mean by excluding missing values\n",
    "overall_mean = mean(sed$age_at_dissertation, na.rm=TRUE)\n",
    "\n",
    "overall_mean"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# set missing means to the overall mean\n",
    "complete_sed <- sed %>%\n",
    "    # using ifelse to replace missing ages with mean age\n",
    "    mutate(age_at_dissertation = ifelse(is.na(age_at_dissertation),  # missing age\n",
    "                  overall_mean,                # value to replace missing age with \n",
    "                  age_at_dissertation))              # value if age is not missing"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "head(complete_sed)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# \n",
    "# \n",
    "\n",
    "Imputation can also be used with more granular **subgroup means**, like within each combination of **phdfield_name**&mdash;**race_cat**. This assumes that the missing **age_at_dissertation** values are conditional on PhD field name and race."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# calculate non-missing ages within each phdfield_name, sex and race\n",
    "mean_by_group <- sed %>%\n",
    "                # grouping by phd field and race\n",
    "                group_by(phdfield_name, race_cat) %>%\n",
    "                # calculating mean by phd field and race after removing missing values\n",
    "                summarise(mean_by_group = mean(age_at_dissertation, na.rm=TRUE))\n",
    "\n",
    "head(mean_by_group)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Next, we find the number of combinations for whom we have a missing mean."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# checking to see missing values for mean_by_group\n",
    "table(is.na(mean_by_group$mean_by_group))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "mean_by_group %>%\n",
    "    filter(is.na(mean_by_group))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We can not impute the age at disertation for SED respondance who have unknown values for both phdfield_name and race_cat. \n",
    "\n",
    "\n",
    "After calculating the mean non-missing ages within each PhD field and race, these means can be joined to the original `sed` data frame."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# join mean_by_group with sed by phdfield_name\n",
    "sed_phd <- sed %>%\n",
    "    # performing an inner join based on phd field and race\n",
    "    inner_join(mean_by_group, by = c('phdfield_name', 'race_cat'))\n",
    "\n",
    "head(sed_phd)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The imputed ages can now be calculated where missing **age_at_dissertation** values will take on the appropriate **mean_by_group** calculation and non-missing values will remain the same."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# create imputed age column\n",
    "sed_phd <- sed_phd %>%\n",
    "    mutate(\n",
    "        # create imp age\n",
    "        imp_age = ifelse( # using ifelse\n",
    "            is.na(age_at_dissertation), # if age_at_dissertation is missing\n",
    "            mean_by_group, # replace imp_age with mean_by_group (mean by phd field & race combination)\n",
    "            age_at_dissertation # else replace imp_age with non-missing age_at_dissertation value\n",
    "        )\n",
    "    )\n",
    "\n",
    "head(sed_phd)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# see means after imputation\n",
    "mean(sed_phd$imp_age, na.rm=TRUE)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<a id=\"regression-imputation\"></a>\n",
    "### Method 3. Regression Imputation\n",
    "\n",
    "Regression can also be used to try to compute more accurate values. A regression equation will be built with the observations for which the age is known, and then applied to essentially predict the missing values. This is, in effect, an extension of the mean imputation by subgroup. Here, the **primary source of support** as well as the **PhD field** and **race** variables will be used as predictors to generate the regression.\n",
    "\n",
    "> Note: Here the assumptions associated with linear regressions are not checked, as this example is aimed at merely displaying how to use a linear regression for imputation. If planning on using regression imputation, please check all assumptions before employing a predictive model."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Since the model will be built based on information only from the members of the cohort with non-missing age values, the `sed` dataset can be split into two datasets: one for training (`sed_nona`), without any missing data for the training of the model&mdash;and one for testing (`sed_na`), with only missing data to use for prediction."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Create a dataset with no missing data, for the training of the model\n",
    "sed_nona <- sed %>%\n",
    "            drop_na()"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Create a dataset with only missing data, to use for prediction\n",
    "# Remove a column with age as it is always null\n",
    "sed_na <- sed %>%\n",
    "    filter(is.na(age_at_dissertation)) %>%\n",
    "    select(-c(age_at_dissertation))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# \n",
    "The model creation process for a linear regression can be done using the `lm()` function. The variable to predict is on the left-hand side of `lm()` before the `~`, and the predictors (**phdfield_name**, **source_cat**, **race_cat** in this case) are on the right-hand side of the `~`."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# run model and fit coefficients\n",
    "model <- lm(age_at_dissertation ~ phdfield_name + source_cat + race_cat, data = sed_nona)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now that the model has been fit, the missing ages can be predicted using the coefficients."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# predict age for test set\n",
    "pred_age <- data.frame(age_at_dissertation = predict(model, newdata=sed_na))\n",
    "\n",
    "head(pred_age)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Because the output for `predict()` retains the same order of rows from `sed`, the **age_at_dissertation** variable from **pred_age** can be easily added into the existing `sed` data frame."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# save updated data frame\n",
    "sed_na_w_age <- cbind(sed_na, pred_age)\n",
    "\n",
    "# see the first 6 rows of the updated data frame\n",
    "head(sed_na_w_age)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# \n",
    "Finally, before seeing the effects of the imputation method, the training set should be combined to get the full set of **age_at_dissertation** values, both imputed and previously known ones."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# save combined training and testing sets\n",
    "sed_all <- rbind(sed_na_w_age, sed_nona)\n",
    "\n",
    "head(sed_all)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The entire age distribution can now be viewed."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# see age distribution for full cohort\n",
    "summary(sed_all$age_at_dissertation)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# see age distribution for imputed portion of cohort\n",
    "summary(sed_na_w_age$age_at_dissertation)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<a id=\"mode-imputation\"></a>\n",
    "# \n",
    "## Method 4. Mode Imputation (for Categorical Variables)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "For categorical variables, it is impossible to apply mean imputation because there is not a mean to calculate. A method for imputing missing categorical values is to find the most frequent value (mode), and impute using the mode.\n",
    "\n",
    "This example will cover using mode imputation for missing values of primary source of funding (**source_cat**) based on each **phdfield_name**&mdash;**race_cat** combination."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "First, as exhibited in previous methods, remove the observations with missing values. Then, find the most frequent race per field of study. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# create a dataframe with only non-missing source of support\n",
    "no_miss_prim <- sed %>% \n",
    "    filter(source_cat != 'Unknown')"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# \n",
    "# \n",
    "The `group_by` function, in combination with `top_n`, can be used together to isolate the most common **source of support** value within each **phdfield_name**&mdash;**race_cat** combination."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Get only the most frequent race values per phdfield-race group\n",
    "prim_mode <- no_miss_prim %>%\n",
    "                # grouping by phd field and race\n",
    "                group_by(phdfield_name, race_cat) %>%\n",
    "                # counting each source of support within each phd field and race combination\n",
    "                count(source_cat) %>%\n",
    "                # keeping the source of support with the highest count\n",
    "                top_n(1) %>%\n",
    "                # removing the count variable (n -> created when we run count(source_cat) above)\n",
    "                select(-c(n))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "`prim_mode` can now function as a lookup table with the most frequent value of source of support per PhD field and race combination. This lookup table can now be joined with the original `sed` table. This will create two columns: **source_cat.x** (original value for source of support) and **source_cat.y** (source of support value from the lookup table)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# merge original and lookup tables\n",
    "merged <- left_join(sed, prim_mode, by=c('phdfield_name', 'race_cat'))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    ">The NA values in the **source_cat.x** column can be replaced with the known values in the column **source_cat.y**, and then these two columns (**source_cat.y** and **source_cat.x**) can be removed, leaving a new column \"**source_imp**\" with the imputed source of funding."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Replace the NA values in the `source_cat.x` column with the known values in the column `source_cat.y`\n",
    "merged <- merged %>%\n",
    "    mutate(\n",
    "        # using ifelse to replace missing sources of support with imputed sources of support\n",
    "        source_imp = ifelse(source_cat.x == \"Unknown\", source_cat.y, source_cat.x)\n",
    "    ) %>%\n",
    "    # deselecting unnecessary columns\n",
    "    select(-c(source_cat.x, source_cat.y))\n",
    "\n",
    "head(merged)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Examine the imputed mode for each category of funding\n",
    "table(merged$source_imp)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Compare to the original category\n",
    "table(sed$source_cat)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Important\n",
    "\n",
    "While performing imputations, there are a few things that we might need to look into further. If you observe that your results are changing dramatically, it is important to check if the imputation method you utilized is driving your results. If you are imputing missing values, it is recommended that you utilize several methods and compare the results.\n",
    "\n",
    "Furthermore, one major challenge that you may face in your research when imputing values with a lot of missingness is that some groups do not get imputed at all. We encourage you to identify these groups (or categories) to better understand why we see missing values even after imputation.\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Closing the database connection"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Close the database connection\n",
    "dbDisconnect(con)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": []
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "3.6.3"
  },
  "toc": {
   "nav_menu": {},
   "number_sections": false,
   "sideBar": true,
   "skip_h1_title": false,
   "toc_cell": false,
   "toc_position": {},
   "toc_section_display": "block",
   "toc_window_display": false
  }
 },
 "nbformat": 4,
 "nbformat_minor": 4
}