NDMA_Deidentification_HHA_KIA_MUAC_August 2024
Pheroze
2024-10-18
NDMA Data De-Identification
The following are steps undertaken for deidentifying NDMA data. This dataset covers the month of August 2024 for HHA, KIA and MUAC. Since the geocoordinates in the HHA dataset represent household coordinates, we will mask them (random displacement) using the Haversine Formula to randomly distribute a point around a central coordinate within a radius of 2.5 KM and drop other P.I.I.s in the relevant sheets.
1. HHA
# Load required libraries
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.2library(geosphere)## Warning: package 'geosphere' was built under R version 4.3.3## The legacy packages maptools, rgdal, and rgeos, underpinning the sp package,
## which was just loaded, will retire in October 2023.
## Please refer to R-spatial evolution reports for details, especially
## https://r-spatial.org/r/2023/05/15/evolution4.html.
## It may be desirable to make the sf package available;
## package maintainers should consider adding sf to Suggests:.
## The sp package is now running under evolution status 2
## (status 2 uses the sf package in place of rgdal)library(openxlsx)## Warning: package 'openxlsx' was built under R version 4.3.3file_path <- "C:/Users/AAH USER/Downloads/HHA_KIA _ MUAC July 2024.xlsx"
# Read the specific HHA sheet into a data frame
hha_aug_2024 <- read.xlsx(file_path, sheet = "HHA", startRow = 2)The dataset contains household coordinates in columns “Lat” and “Long” which are considered P.I.I’s so we mask the coordinates, verify by plotting a histogram of the distribution of displacement distances of the original and displaced coordinates to establish uniformity.
We check for and deal with outliers if any in the “Lat” and “Long” columns
# Verify the dataset
summary(hha_aug_2024$Lat)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -4.54834 -1.70087 -0.09924 -0.14605 1.41716 24.26686summary(hha_aug_2024$Long)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 34.87 36.78 37.87 38.03 39.55 91.48There seems to be an erroneous entry since the max values in the “Lat” and “Long” columns are well above the mean. We deal with this entry.
# Calculate the mean for Lat and Long, ignoring NA values
lat_mean <- mean(hha_aug_2024$Lat, na.rm = TRUE)
lon_mean <- mean(hha_aug_2024$Long, na.rm = TRUE)
lat_sd <- sd(hha_aug_2024$Lat, na.rm = TRUE)
lon_sd <- sd(hha_aug_2024$Long, na.rm = TRUE)
# Calculate Z-scores
hha_aug_2024 <- hha_aug_2024 %>%
mutate(lat_z = (Lat - lat_mean) / lat_sd,
lon_z = (Long - lon_mean) / lon_sd)
# Set threshold for identifying outliers
threshold <- 3 # Common threshold for Z-scores
# Replace outliers with NA
hha_aug_2024 <- hha_aug_2024 %>%
mutate(Lat = ifelse(abs(lat_z) > threshold & !is.na(lat_z), NA, Lat),
Long = ifelse(abs(lon_z) > threshold & !is.na(lon_z), NA, Long))
# Remove the Z-score columns
hha_aug_2024 <- hha_aug_2024 %>%
select(-lat_z, -lon_z)
# Verify the dataset
summary(hha_aug_2024$Lat)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -4.54834 -1.70087 -0.09924 -0.15152 1.41714 4.08371 1summary(hha_aug_2024$Long)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 34.87 36.78 37.87 38.02 39.55 41.86 1Only one row is affected by the outlier and it is replaced with NA. We proceed to mask the coordinates.
# Create backup columns for original coordinates
hha_aug_2024$Original_Lat <- hha_aug_2024$Lat
hha_aug_2024$Original_Long <- hha_aug_2024$Long
# Function to generate random displaced coordinates with uniform distance distribution
mask_coordinates_uniform <- function(lat, lon, radius_km) {
R <- 6371 # Earth radius in kilometers
# Random bearing angle (in radians)
bearing <- runif(1, 0, 2 * pi)
# Random distance uniformly sampled from [0, radius_km]
rand_dist <- runif(1, 0, radius_km) / R # Uniformly sampled distance in radians
# Convert original coordinates to radians
lat_rad <- lat * pi / 180
lon_rad <- lon * pi / 180
# Calculate new latitude (in radians)
new_lat <- asin(sin(lat_rad) * cos(rand_dist) +
cos(lat_rad) * sin(rand_dist) * cos(bearing))
# Calculate new longitude (in radians)
new_lon <- lon_rad + atan2(sin(bearing) * sin(rand_dist) * cos(lat_rad),
cos(rand_dist) - sin(lat_rad) * sin(new_lat))
# Convert back to degrees
new_lat <- new_lat * 180 / pi
new_lon <- new_lon * 180 / pi
return(c(new_lat, new_lon))
}
# Set displacement radius in kilometers
radius_km <- 2.5
# Generate masked coordinates for each row using the modified function
masked_coords <- t(apply(hha_aug_2024, 1, function(row) {
mask_coordinates_uniform(as.numeric(row["Original_Lat"]), as.numeric(row["Original_Long"]), radius_km)
}))
# Replace the original Lat and Long columns with the masked coordinates
hha_aug_2024$Lat <- masked_coords[, 1]
hha_aug_2024$Long <- masked_coords[, 2]We then evaluate the distribution of the displacement distances before dropping the original coordinates by plotting a histogram and a scatter plot.
# Calculate displacement distances (in kilometers) as before
displacement_distances <- distHaversine(
cbind(hha_aug_2024$Long, hha_aug_2024$Lat), # Masked coordinates
cbind(hha_aug_2024$Original_Long, hha_aug_2024$Original_Lat) # Original coordinates
) / 1000 # Convert meters to kilometers
# Add displacement distances to the dataset for further analysis
hha_aug_2024$Displacement_Distance <- displacement_distances
# Plot: Histogram of displacement distances
ggplot(hha_aug_2024, aes(x = Displacement_Distance)) +
geom_histogram(binwidth = 0.1, fill = "skyblue", color = "black") +
labs(title = "Distribution of Displacement Distances",
x = "Displacement Distance (km)", y = "Count") +
theme_minimal()## Warning: Removed 1 rows containing non-finite values (`stat_bin()`).
There are no significant peaks or valleys in the histogram, suggesting that the displacements are indeed more uniformly distributed, as intended.
# Plot: Original vs Masked Coordinates Scatterplot
ggplot() +
geom_point(data = hha_aug_2024, aes(x = Original_Long, y = Original_Lat, color = "Original"),
alpha = 0.5, size = 1, shape = 16) +
geom_point(data = hha_aug_2024, aes(x = Long, y = Lat, color = "Displaced"),
alpha = 0.5, size = 1, shape = 16) +
labs(title = "Original vs Displaced Coordinates",
x = "Longitude", y = "Latitude", color = "Coordinate Type") + # Legend title
scale_color_manual(values = c("Original" = "red", "Displaced" = "blue")) + # Custom colors
theme_minimal() +
coord_fixed() # Ensures aspect ratio is 1:1 for accurate geographic representation## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Removed 1 rows containing missing values (`geom_point()`).
The scatterplot displays the original coordinates in red and the displaced coordinates in blue. It helps visualize how the coordinates were shifted.
We then drop the original coordinates column leaving only the masked coordinates columns. We also drop other PII’s which are the “HouseholdName”, “HouseHoldHead”, and “RespondentName”.
# Drop the specified PII columns along with original coordinates
hha_aug_2024 <- hha_aug_2024 %>%
select(-c(Original_Lat, Original_Long, Displacement_Distance, HouseholdName, HouseHoldHead, RespondentName))
# Check the updated dataset
head(hha_aug_2024)## QID County SubCounty Ward LivelihoodZone Month Year Lat
## 1 527205 Isiolo Isiolo North Burat Agro Pastoral August 2024 0.27227735
## 2 527206 Isiolo Isiolo North Burat Agro Pastoral August 2024 0.28467362
## 3 527207 Isiolo Isiolo North Burat Agro Pastoral August 2024 0.05826931
## 4 527209 Isiolo Isiolo North Burat Agro Pastoral August 2024 0.27749474
## 5 527211 Isiolo Isiolo North Burat Agro Pastoral August 2024 0.28666799
## 6 527212 Isiolo Isiolo North Burat Agro Pastoral August 2024 0.30099157
## Long InterviewDate HouseholdCode HeadEducationLevel
## 1 37.55846 45506.41 ISL0430 1. Primary
## 2 37.53927 45520.30 ISL0409 None
## 3 37.66513 45517.59 ISL0406 None
## 4 37.52770 45523.31 ISL0418 1. Primary
## 5 37.54909 45520.31 ISL0414 1. Primary
## 6 37.52991 45520.32 ISL0412 None
## MainHHIncomeSource HeadGender RespondentGender
## 1 4. Casual labour Female Female
## 2 4. Casual labour Female Female
## 3 4. Casual labour Female Female
## 4 2. Sale of livestock and livestock products Female Female
## 5 4. Casual labour Female Female
## 6 2. Sale of livestock and livestock products Female Female
## MaleMembers FemaleMembers ChildrenBelow5 KeepLivestock MilkAnimals MilkSource
## 1 4 2 2 FALSE FALSE <NA>
## 2 5 2 2 TRUE FALSE <NA>
## 3 3 4 2 TRUE FALSE <NA>
## 4 3 2 2 TRUE FALSE <NA>
## 5 5 2 1 TRUE FALSE <NA>
## 6 5 3 2 TRUE FALSE <NA>
## HowOftenMilked AverageMilkedPerDay AverageMilkConsumedPerDay
## 1 NA NA NA
## 2 NA NA NA
## 3 NA NA NA
## 4 NA NA NA
## 5 NA NA NA
## 6 NA NA NA
## WhoDrankMilk AverageMilkPrice HarvestedInLastWeeks AcresHarvested
## 1 <NA> NA TRUE NA
## 2 <NA> NA TRUE NA
## 3 Children under 5 years NA TRUE NA
## 4 <NA> NA TRUE NA
## 5 <NA> NA TRUE NA
## 6 <NA> NA TRUE NA
## BagsHarvested HaveFoodStock FoodStockSources DaysStockLast WaterSource1
## 1 NA TRUE Production 3 Rivers
## 2 NA FALSE <NA> NA Rivers
## 3 NA FALSE <NA> NA Rivers
## 4 NA FALSE <NA> NA Rivers
## 5 NA FALSE <NA> NA Rivers
## 6 NA FALSE <NA> NA Rivers
## WaterSource2 WaterSource3 NormalWaterSource WhyNotNormalWaterSource
## 1 <NA> <NA> TRUE <NA>
## 2 <NA> <NA> TRUE <NA>
## 3 <NA> <NA> TRUE <NA>
## 4 <NA> <NA> TRUE <NA>
## 5 <NA> <NA> TRUE <NA>
## 6 <NA> <NA> TRUE <NA>
## DaysWaterSourceExpectedToLast DistanceFromWaterSource NoWaterJerryCans
## 1 12 2.5 8
## 2 12 2.5 8
## 3 12 2.6 8
## 4 12 2.6 9
## 5 12 2.5 10
## 6 12 2.5 4
## JerryCansCost NormalHHWaterConsumption HHPayForWater CostTransportJerryCan
## 1 NA 5 FALSE NA
## 2 NA 5 FALSE NA
## 3 NA 5 FALSE NA
## 4 NA 5 FALSE NA
## 5 NA 2 FALSE NA
## 6 NA 2 FALSE NA
## TreatWaterBeforeDrinking WaterTreatmentMethodUsed CSI_ReliedOnLess
## 1 FALSE <NA> 2
## 2 FALSE <NA> 3
## 3 FALSE <NA> 3
## 4 FALSE <NA> 2
## 5 FALSE <NA> 3
## 6 FALSE <NA> 3
## CSI_BorrowedFood CSI_ReducedNoOfMeals CSI_ReducedPortionMealSize
## 1 1 2 2
## 2 0 3 2
## 3 0 2 2
## 4 0 3 2
## 5 0 2 3
## 6 0 2 2
## CSI_QuantityForAdult CSI_SoldHouseholdAssets CSI_ReducedNonFoodExpenses
## 1 2 1 1
## 2 2 1 1
## 3 3 1 1
## 4 2 1 1
## 5 3 1 1
## 6 3 1 1
## CSI_SoldProductiveAssets CSI_SpentSavings CSI_BorrowedMoney CSI_SoldHouseLand
## 1 1 1 1 1
## 2 1 1 1 1
## 3 1 1 1 1
## 4 1 1 1 1
## 5 1 1 1 1
## 6 1 1 1 1
## CSI_WithdrewChildrenSchool CSI_SoldLastFemaleAnimal CSI_Begging
## 1 1 1 1
## 2 1 1 1
## 3 1 1 1
## 4 1 1 1
## 5 1 1 1
## 6 1 1 1
## CSI_SoldMoreAnimals HFC_GrainDays HFC_GrainSource HFC_RootsDays
## 1 1 7 5 NA
## 2 1 7 5 NA
## 3 1 7 5 NA
## 4 1 7 5 NA
## 5 1 7 5 NA
## 6 1 7 5 NA
## HFC_RootsSource HFC_PulsesNutsDays HFC_PulsesNutsSource HFC_OrangeVegDays
## 1 NA 0 NA NA
## 2 NA 0 NA NA
## 3 NA 0 NA NA
## 4 NA 0 NA NA
## 5 NA 0 NA NA
## 6 NA 0 NA NA
## HFC_OrangeVegSource HFC_GreenLeafyDays HFC_GreenLeafySource HFC_OtherVegDays
## 1 NA NA NA 3
## 2 NA NA NA 2
## 3 NA NA NA 3
## 4 NA NA NA 3
## 5 NA NA NA 2
## 6 NA NA NA 2
## HFC_OtherVegSource HFC_OrangeFruitsDays HFC_OrangeFruitsSource
## 1 5 NA NA
## 2 5 NA NA
## 3 5 NA NA
## 4 5 NA NA
## 5 5 NA NA
## 6 5 NA NA
## HFC_OtherFruitsDays HFC_OtherFruitsSource HFC_MeatDays HFC_MeatSource
## 1 2 5 0 NA
## 2 2 5 0 NA
## 3 2 5 0 NA
## 4 3 5 0 NA
## 5 0 NA 0 NA
## 6 0 NA 0 NA
## HFC_LiverDays HFC_LiverSource HFC_FishDays HFC_EggsDays HFC_EggsSource
## 1 NA NA NA NA NA
## 2 NA NA NA NA NA
## 3 NA NA NA NA NA
## 4 NA NA NA NA NA
## 5 NA NA NA NA NA
## 6 NA NA NA NA NA
## HFC_MilkDays HFC_MilkSource HFC_OilDays HFC_OilSource HFC_SugarDays
## 1 3 5 6 5 6
## 2 0 NA 7 5 5
## 3 2 5 5 5 6
## 4 3 1 6 5 6
## 5 0 NA 7 5 7
## 6 5 1 7 5 7
## HFC_SugarSource HFC_CondimentsDays HFC_CondimentsSource
## 1 5 0 NA
## 2 5 0 NA
## 3 5 0 NA
## 4 5 0 NA
## 5 5 0 NA
## 6 5 0 NA
## MainIncomeSource MaleCasualLabour FemaleCasualLabour
## 1 4. Casual labour 1 1
## 2 4. Casual labour NA 1
## 3 3. Sale of livestock products NA NA
## 4 2. Sale of livestock NA NA
## 5 4. Casual labour 1 1
## 6 3. Sale of livestock products NA 1
## CasualLabourEarn CharcoalSaleEarn WoodSaleEarn DivisionID CountyID SiteID
## 1 1500 NA NA 39 4 1
## 2 NA NA NA 39 4 1
## 3 NA NA NA 39 4 1
## 4 NA NA NA 39 4 1
## 5 1200 NA NA 39 4 1
## 6 NA NA NA 39 4 1
## LivelihoodZoneID DateCaptured
## 1 2 NA
## 2 2 NA
## 3 2 NA
## 4 2 NA
## 5 2 NA
## 6 2 NAWe also have to ensure that the “InterviewDate” column is parsed correctly as a date before saving the worksheet to the new workbook.
# Ensure the column is numeric
hha_aug_2024$InterviewDate <- as.numeric(hha_aug_2024$InterviewDate)
# Convert the numeric date to Date format
hha_aug_2024$InterviewDate <- as.Date(hha_aug_2024$InterviewDate, origin = "1899-12-30")
# View the first few dates to verify the conversion
head(hha_aug_2024$InterviewDate)## [1] "2024-08-02" "2024-08-16" "2024-08-13" "2024-08-19" "2024-08-16"
## [6] "2024-08-16"We save the sheet to a new workbook for the deidentified data for NDMA August 2024. We will write subsequent deidentified KIA and MUAC sheets to this workbook.
# Define the path for the new workbook
new_file_path <- "C:/Users/AAH USER/OneDrive - Action Against Hunger USA/Documents/NDMA_DeIdentified/HHA_KIA_MUAC_August_2024.xlsx"
# Create a new workbook
wb <- createWorkbook()
# Add the HHA data to the new workbook
addWorksheet(wb, "HHA")
writeData(wb, "HHA", hha_aug_2024)
# Save the new workbook
saveWorkbook(wb, new_file_path, overwrite = TRUE)2. KIA
# Load required libraries
library(dplyr)
library(ggplot2)
library(geosphere)
library(openxlsx)
file_path <- "C:/Users/AAH USER/Downloads/HHA_KIA _ MUAC July 2024.xlsx"
# Read the specific HHA sheet into a data frame
kia_aug_2024 <- read.xlsx(file_path, sheet = "KIA", startRow = 2)The dataset contains coordinates, however these are not household coordinates so we do not need to mask them. We ensure the Interview date column is parsed correctly and save this subsequent sheet to the workbook.
# Ensure the column is numeric
kia_aug_2024$InterviewDate <- as.numeric(kia_aug_2024$InterviewDate)
# Convert the numeric date to Date format
kia_aug_2024$InterviewDate <- as.Date(kia_aug_2024$InterviewDate, origin = "1899-12-30")
# View the first few dates to verify the conversion
head(kia_aug_2024$InterviewDate)## [1] "2024-08-13" "2024-08-13" "2024-08-13" "2024-08-09" "2024-08-07"
## [6] "2024-08-10"We save this new sheet alongside the previous in the workbook created
# Define the path for the existing Excel workbook
existing_file_path <- "C:/Users/AAH USER/OneDrive - Action Against Hunger USA/Documents/NDMA_DeIdentified/HHA_KIA_MUAC_August_2024.xlsx"
# Load the existing workbook
wb <- loadWorkbook(existing_file_path)
# Add the KIA data to the existing workbook
addWorksheet(wb, "KIA ")
writeData(wb, "KIA ", kia_aug_2024)
# Save the updated workbook
saveWorkbook(wb, existing_file_path, overwrite = TRUE)3. MUAC
# Load required libraries
library(dplyr)
library(ggplot2)
library(geosphere)
library(openxlsx)
file_path <- "C:/Users/AAH USER/Downloads/HHA_KIA _ MUAC July 2024.xlsx"
# Read the specific HHA sheet into a data frame
muac_aug_2024 <- read.xlsx(file_path, sheet = "MUAC", startRow = 2)This data set has P.I.I’s in the “ChildName” column so we will drop that, ensure the Interview date column is parsed correctly and save this subsequent sheet to the workbook.
# Drop the specified PII column
muac_aug_2024 <- muac_aug_2024 %>%
select(-ChildName)
# Ensure the column is numeric
muac_aug_2024$InterviewDate <- as.numeric(muac_aug_2024$InterviewDate)
# Convert the numeric date to Date format
muac_aug_2024$InterviewDate <- as.Date(muac_aug_2024$InterviewDate, origin = "1899-12-30")
# Check the updated dataset
head(muac_aug_2024)## MUACIndicatorID QID County SubCounty Ward LivelihoodZone
## 1 1446324 517860 Kitui Mwingi North Tseikuru Marginal Mixed Farming
## 2 1446325 517860 Kitui Mwingi North Tseikuru Marginal Mixed Farming
## 3 1446326 517860 Kitui Mwingi North Tseikuru Marginal Mixed Farming
## 4 1446327 517860 Kitui Mwingi North Tseikuru Marginal Mixed Farming
## 5 1446373 517876 Kitui Mwingi North Tseikuru Marginal Mixed Farming
## 6 1446374 517876 Kitui Mwingi North Tseikuru Marginal Mixed Farming
## Month Year HouseholdCode Gender MUAC MUAC_Color AgeInMonths
## 1 August 2024 KTI0429 Male 136 <NA> 8
## 2 August 2024 KTI0429 Male 145 <NA> 26
## 3 August 2024 KTI0429 Female 146 <NA> 50
## 4 August 2024 KTI0429 Female 137 <NA> 22
## 5 August 2024 KTI0430 Male 130 <NA> 25
## 6 August 2024 KTI0430 Female 132 <NA> 18
## LiveInHousehold SufferedIllnesses InterviewDate DivisionID CountyID SiteID
## 1 TRUE <NA> 2024-08-05 81 17 1454
## 2 FALSE <NA> 2024-08-05 81 17 1454
## 3 FALSE <NA> 2024-08-05 81 17 1454
## 4 FALSE <NA> 2024-08-05 81 17 1454
## 5 TRUE <NA> 2024-08-05 81 17 1454
## 6 FALSE <NA> 2024-08-05 81 17 1454
## LivelihoodZoneID
## 1 6
## 2 6
## 3 6
## 4 6
## 5 6
## 6 6We save this new sheet alongside the previous two in the workbook created
# Define the path for the existing Excel workbook
existing_file_path <- "C:/Users/AAH USER/OneDrive - Action Against Hunger USA/Documents/NDMA_DeIdentified/HHA_KIA_MUAC_August_2024.xlsx"
# Load the existing workbook
wb <- loadWorkbook(existing_file_path)
# Add the MUAC data to the existing workbook
addWorksheet(wb, "MUAC ")
writeData(wb, "MUAC ", muac_aug_2024)
# Save the updated workbook
saveWorkbook(wb, existing_file_path, overwrite = TRUE)