RISE_ID/T4_annual_survey/O3_T4_ID-summary_FB.R
In Monash-RISE/riseR:
# OBJECTIVE 3&4 ANNUAL SURVEY IN INDONESIA - NOVEMBER 2019 TO ??? 2019/2020
library (tidyverse)
library (lubridate)
library (stringr)
library (readxl)
library (zscorer)
library(janitor) #to add totals to bottom of table
rm(list = ls())
# setwd("Z:/Data Files/Practice Data/ID_T4_annual_v1")
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20191118_T4_annual_survey/2. Data/1. raw data")
# ANNUAL SURVEY
hhd <- read_csv (file="T4_ID_annual_v1.csv")
hhd_child_loop <- read_csv (file="T4_ID_annual_v1-child_loop.csv")
hhd_child_feces_kit <- read_csv (file="T4_ID_annual_v1-feces_kit.csv") #1
#DEMOGRAPHICS
hhd_person_details <- read_csv (file="T4_ID_annual_v1-person_details1.csv") %>%
filter (!is.na(person_index)) # remove all of hhd_person_details with person_index==NA- these are blank rows of survey
#CHILD FECES KIT HANDOUT
hhd_child_feces_kit <- read_csv (file="T4_ID_annual_v1-feces_kit.csv")
#PEOPLE MOVING:
#departed
hhd.depart <- read_csv (file="T4_ID_annual_v1-household-hhds_depart.csv") #hhds depart
hhd.members.filter <- read_csv (file = "T4_ID_annual_v1-hhd_members-filters_revise.csv") ##people depart
hhd.members.reason <- read_csv (file = "T4_ID_annual_v1-hhd_members-reason_departed.csv") #reason people depart
#new people from WITHIN settlement
new.people.3 <- read_csv (file = "T4_ID_annual_v1-new_people-new_people3-new_revise.csv") #
#new people from OUTSIDE settlement
new.people.2 <- read_csv (file = "T4_ID_annual_v1-new_people-new_people2.csv") #
#combined list of new people - in and out of settlement
new.people.names <- read_csv (file = "T4_ID_annual_v1-new_people-combined2_names.csv") #
#combined revised list of all people in each household
final.people.names <- read_csv (file = "T4_ID_annual_v1-combined1_names.csv") #
#information about new people
new.people.info <- read_csv (file="T4_ID_annual_v1-new_people-new_people_info.csv")
# FECES COLLECTION
feces <- read_csv (file="T4_ID_feces_v4.csv")
feces_collect <- read_csv (file="T4_ID_feces_v4-feces_collection.csv")
#############################################
# coding fixes
#############################################
# FIX ALL DATES *****************************
fix_date <- function(x_date){
x_date <- ifelse(!is.na(ymd_hms(x_date)), ymd_hms(x_date),
ifelse(!is.na(dmy_hms(x_date)), dmy_hms(x_date), mdy_hms(x_date))) # Check the format and return the correct integer-date
x_date <- as.POSIXct(x_date, origin = "1970-01-01", tz = "UTC") # Convert the integer-date to a consistent format
}
hhd$starttime <- fix_date(hhd$starttime)
feces$starttime <- fix_date(feces$starttime)
####### DATE RANGE ********************************
a <- hhd %>%
select (today)
b <- feces %>%
select (today)
dates <- rbind (a, b)
rm(a, b)
summary (dates$today)
start <- min (dates$today)
end <- max (dates$today)
rm(dates)
# ******************************
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
#############################################
# CORRECTIONS
source("O3_T4_ID-corrections.R")
#check for barcode duplicates - child feces
barcode.dup <- hhd_child_feces_kit %>%
mutate (barcode = ifelse(is.na(feces_kit_barcode), feces_kit_barcode_note, feces_kit_barcode)) %>%
filter(!is.na(barcode))
barcode.dup[duplicated(barcode.dup$barcode),] #0 duplicates
rm(barcode.dup)
#############################################
# MERGE
#############################################
source("O3_T4_ID-merge.R")
#this includes list of departed participants
# do manual fixes in person_list.R
#############################################
## DATA CHECKING FOR DAILY REPORT ##
#############################################
source("O3_T4_ID-data_check.R")
#############################################
## RUN LIMS CHECKS ##
#############################################
#GET FILES:
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/2. Laboratory QA/LIMS/20191111_ID_annual")
# setwd("Z:/Data Files/Practice Data/ID_T4_annual_v1/LIMS Data")
sample_reception <- read_excel("Obj3_Data.xls", "Sample Reception")
LIMS_KK1 <- read_excel("Obj3_Data.xls", sheet = "Feces_KK1") %>%
rename (date_KK1 = Date_process,
time_KK1 = Time_process) %>%
select (-Lab_tech, -Comments)
LIMS_KK2 <- read_excel("Obj3_Data.xls", sheet = " Feces_KK2") %>%
rename(date_KK2 = Date_process,
time_start_KK2 = Start_time,
time_end_KK2 = End_time) %>%
select (date_KK2, time_start_KK2, time_end_KK2, Barcode_KKslide)
KK1 <- read_excel("Obj3_Data.xls", "Feces_KK1")
feces_aliq <- read_excel("Obj3_Data.xls", "Feces_Aliquots")
feces_mac1 <- read_excel("Obj3_Data.xls", "Feces_Macconkey1")
feces_mac2 <- read_excel("Obj3_Data.xls", "Feces_Macconkey2")
KK2 <- read_excel("Obj3_Data.xls", " Feces_KK2")
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
source("O3_T4_ID-LIMS_QC.R")
# then run weekly report .Rmd - Zainal will do this and send out every Friday
####zainal can stop script here #################
#############################################
# NEW PERSON IDS
#############################################
#GENERATE NEW PERSON_IDS for new people
#create list of new people from OUTSIDE SETTLEMENT
# new_people_outside <- new_people_all %>%
# filter (is.na(person.id))
# nrow(new_people_outside) #this has been merged with hhd info; n=82
# table(is.na(new_people_outside$person.id)) #none have person_id
#
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/4. Participants tracking/2. ID/2. code")
# source("ID_T4_201911_O3_participants_list.R")
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
#
# hhd.people.new - has new ids for people; n=82 new
# departed is list of people removed=46
#hhd.depart is list of households that have left = 6
#add new ids to full person_id list
# person_id1 <- person_id %>% #rename; 1330
# filter(name_filter1>0) %>% #1111
# filter (!is.na(combined_names)) #1065
# table(is.na(person_id1$combined_person.id), person_id1$combined_new) #82 ids missing
#
# x <- hhd.people.new %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, name, dob, person_id)
# person_id <- left_join (person_id1, x, by = c("settlement_barcode" = "settlement_barcode",
# "extract_house_no"="extract_house_no",
# "hhd_id_final"="hhd_id_final",
# "combined_names"="name",
# "combined_dob" = "dob")) %>%
# mutate (person.id = ifelse(is.na(combined_person.id), person_id, combined_person.id)) %>%
# select (-person_id, -combined_person.id) %>%
# arrange (person.id)
# rm(x, person_id1)
# table(is.na(person_id$person.id)) #1065 ids
##############
############################
############################
#add in missing person_ids - adult_respondent, respondent_name2
############################
############################
############################
# ids1 <- person_id %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, combined_names, person.id, person_index1) %>%
# filter (!is.na(combined_names))
#
# adult_respondent_id <- hhd %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, adult_respondent) %>%
# filter (!is.na(adult_respondent))
#
# adult_respondent_id1 <- left_join(adult_respondent_id, ids1, by = c("settlement_barcode" = "settlement_barcode",
# "extract_house_no"="extract_house_no",
# "hhd_id_final"="hhd_id_final",
# "adult_respondent"="person_index1")) %>%
# rename (adult_respondent_person.id = person.id,
# respondent_name2= combined_names) #2
# rm(ids1)
#add back into hhd survey
# hhd2 <- left_join(hhd, adult_respondent_id1, by = c("settlement_barcode" = "settlement_barcode",
# "extract_house_no"="extract_house_no",
# "hhd_id_final"="hhd_id_final",
# "adult_respondent"="adult_respondent")) %>%
# mutate (respondent_name2 = respondent_name2.y) %>%
# select (-respondent_name2.x, -respondent_name2.y)
# table(is.na(hhd2$adult_respondent_person.id)) #2 have an id!
# table(is.na(hhd2$respondent_name2))
# hhd <- hhd2
# rm(hhd2)
# rm( adult_respondent_id1)
#############################################
## create final list of people ## this is not finished - more to do **********
#############################################
#START WITH DATA INPUT FILE for this survey
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20191118_T4_annual_survey/1. Final Surveys/data input")
# people_data_input <- read_csv (file="person_list_ID_201910.csv") %>% #2857 - data from Oct 2019;
# select (-code, -code1, -code2, number_hhd)
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
#
# source("O3_T4_ID-person_list.R")
#do all manual fixes in this script, including manually add departed people
#############################################
# PULL TOGETHER CONSENT LISTS
#############################################
# PULL TOGETHER FINAL LIST OF CONSENTS
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
#setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/1. FJ/3/20190930_child sampling/3. Data/2. code/Jeff's finalised scripts/20191002")
#source("O3_T1_FJ_consent_update.R")
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
#setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/1. FJ/3/20190930_child sampling/3. Data")
# this includes corrections to consent
#############################################
#############
#FINAL CORRECTIONS TO PEOPLE'S NAMES, ETC.
#############
# source("O3_T1_ID-corrections_names.R")
#############################################
## create data files for users / analysis ##
# and for use in next survey ##
#############################################
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
# source("O3_T1_ID-data_extract.R")
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
Monash-RISE/riseR documentation built on Dec. 11, 2019, 9:49 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# OBJECTIVE 3&4 ANNUAL SURVEY IN INDONESIA - NOVEMBER 2019 TO ??? 2019/2020
library (tidyverse)
library (lubridate)
library (stringr)
library (readxl)
library (zscorer)
library(janitor) #to add totals to bottom of table
rm(list = ls())
# setwd("Z:/Data Files/Practice Data/ID_T4_annual_v1")
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20191118_T4_annual_survey/2. Data/1. raw data")
# ANNUAL SURVEY
hhd <- read_csv (file="T4_ID_annual_v1.csv")
hhd_child_loop <- read_csv (file="T4_ID_annual_v1-child_loop.csv")
hhd_child_feces_kit <- read_csv (file="T4_ID_annual_v1-feces_kit.csv") #1
#DEMOGRAPHICS
hhd_person_details <- read_csv (file="T4_ID_annual_v1-person_details1.csv") %>%
filter (!is.na(person_index)) # remove all of hhd_person_details with person_index==NA- these are blank rows of survey
#CHILD FECES KIT HANDOUT
hhd_child_feces_kit <- read_csv (file="T4_ID_annual_v1-feces_kit.csv")
#PEOPLE MOVING:
#departed
hhd.depart <- read_csv (file="T4_ID_annual_v1-household-hhds_depart.csv") #hhds depart
hhd.members.filter <- read_csv (file = "T4_ID_annual_v1-hhd_members-filters_revise.csv") ##people depart
hhd.members.reason <- read_csv (file = "T4_ID_annual_v1-hhd_members-reason_departed.csv") #reason people depart
#new people from WITHIN settlement
new.people.3 <- read_csv (file = "T4_ID_annual_v1-new_people-new_people3-new_revise.csv") #
#new people from OUTSIDE settlement
new.people.2 <- read_csv (file = "T4_ID_annual_v1-new_people-new_people2.csv") #
#combined list of new people - in and out of settlement
new.people.names <- read_csv (file = "T4_ID_annual_v1-new_people-combined2_names.csv") #
#combined revised list of all people in each household
final.people.names <- read_csv (file = "T4_ID_annual_v1-combined1_names.csv") #
#information about new people
new.people.info <- read_csv (file="T4_ID_annual_v1-new_people-new_people_info.csv")
# FECES COLLECTION
feces <- read_csv (file="T4_ID_feces_v4.csv")
feces_collect <- read_csv (file="T4_ID_feces_v4-feces_collection.csv")
#############################################
# coding fixes
#############################################
# FIX ALL DATES *****************************
fix_date <- function(x_date){
x_date <- ifelse(!is.na(ymd_hms(x_date)), ymd_hms(x_date),
ifelse(!is.na(dmy_hms(x_date)), dmy_hms(x_date), mdy_hms(x_date))) # Check the format and return the correct integer-date
x_date <- as.POSIXct(x_date, origin = "1970-01-01", tz = "UTC") # Convert the integer-date to a consistent format
}
hhd$starttime <- fix_date(hhd$starttime)
feces$starttime <- fix_date(feces$starttime)
####### DATE RANGE ********************************
a <- hhd %>%
select (today)
b <- feces %>%
select (today)
dates <- rbind (a, b)
rm(a, b)
summary (dates$today)
start <- min (dates$today)
end <- max (dates$today)
rm(dates)
# ******************************
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
#############################################
# CORRECTIONS
source("O3_T4_ID-corrections.R")
#check for barcode duplicates - child feces
barcode.dup <- hhd_child_feces_kit %>%
mutate (barcode = ifelse(is.na(feces_kit_barcode), feces_kit_barcode_note, feces_kit_barcode)) %>%
filter(!is.na(barcode))
barcode.dup[duplicated(barcode.dup$barcode),] #0 duplicates
rm(barcode.dup)
#############################################
# MERGE
#############################################
source("O3_T4_ID-merge.R")
#this includes list of departed participants
# do manual fixes in person_list.R
#############################################
## DATA CHECKING FOR DAILY REPORT ##
#############################################
source("O3_T4_ID-data_check.R")
#############################################
## RUN LIMS CHECKS ##
#############################################
#GET FILES:
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/2. Laboratory QA/LIMS/20191111_ID_annual")
# setwd("Z:/Data Files/Practice Data/ID_T4_annual_v1/LIMS Data")
sample_reception <- read_excel("Obj3_Data.xls", "Sample Reception")
LIMS_KK1 <- read_excel("Obj3_Data.xls", sheet = "Feces_KK1") %>%
rename (date_KK1 = Date_process,
time_KK1 = Time_process) %>%
select (-Lab_tech, -Comments)
LIMS_KK2 <- read_excel("Obj3_Data.xls", sheet = " Feces_KK2") %>%
rename(date_KK2 = Date_process,
time_start_KK2 = Start_time,
time_end_KK2 = End_time) %>%
select (date_KK2, time_start_KK2, time_end_KK2, Barcode_KKslide)
KK1 <- read_excel("Obj3_Data.xls", "Feces_KK1")
feces_aliq <- read_excel("Obj3_Data.xls", "Feces_Aliquots")
feces_mac1 <- read_excel("Obj3_Data.xls", "Feces_Macconkey1")
feces_mac2 <- read_excel("Obj3_Data.xls", "Feces_Macconkey2")
KK2 <- read_excel("Obj3_Data.xls", " Feces_KK2")
setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
source("O3_T4_ID-LIMS_QC.R")
# then run weekly report .Rmd - Zainal will do this and send out every Friday
####zainal can stop script here #################
#############################################
# NEW PERSON IDS
#############################################
#GENERATE NEW PERSON_IDS for new people
#create list of new people from OUTSIDE SETTLEMENT
# new_people_outside <- new_people_all %>%
# filter (is.na(person.id))
# nrow(new_people_outside) #this has been merged with hhd info; n=82
# table(is.na(new_people_outside$person.id)) #none have person_id
#
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/4. Participants tracking/2. ID/2. code")
# source("ID_T4_201911_O3_participants_list.R")
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
#
# hhd.people.new - has new ids for people; n=82 new
# departed is list of people removed=46
#hhd.depart is list of households that have left = 6
#add new ids to full person_id list
# person_id1 <- person_id %>% #rename; 1330
# filter(name_filter1>0) %>% #1111
# filter (!is.na(combined_names)) #1065
# table(is.na(person_id1$combined_person.id), person_id1$combined_new) #82 ids missing
#
# x <- hhd.people.new %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, name, dob, person_id)
# person_id <- left_join (person_id1, x, by = c("settlement_barcode" = "settlement_barcode",
# "extract_house_no"="extract_house_no",
# "hhd_id_final"="hhd_id_final",
# "combined_names"="name",
# "combined_dob" = "dob")) %>%
# mutate (person.id = ifelse(is.na(combined_person.id), person_id, combined_person.id)) %>%
# select (-person_id, -combined_person.id) %>%
# arrange (person.id)
# rm(x, person_id1)
# table(is.na(person_id$person.id)) #1065 ids
##############
############################
############################
#add in missing person_ids - adult_respondent, respondent_name2
############################
############################
############################
# ids1 <- person_id %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, combined_names, person.id, person_index1) %>%
# filter (!is.na(combined_names))
#
# adult_respondent_id <- hhd %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, adult_respondent) %>%
# filter (!is.na(adult_respondent))
#
# adult_respondent_id1 <- left_join(adult_respondent_id, ids1, by = c("settlement_barcode" = "settlement_barcode",
# "extract_house_no"="extract_house_no",
# "hhd_id_final"="hhd_id_final",
# "adult_respondent"="person_index1")) %>%
# rename (adult_respondent_person.id = person.id,
# respondent_name2= combined_names) #2
# rm(ids1)
#add back into hhd survey
# hhd2 <- left_join(hhd, adult_respondent_id1, by = c("settlement_barcode" = "settlement_barcode",
# "extract_house_no"="extract_house_no",
# "hhd_id_final"="hhd_id_final",
# "adult_respondent"="adult_respondent")) %>%
# mutate (respondent_name2 = respondent_name2.y) %>%
# select (-respondent_name2.x, -respondent_name2.y)
# table(is.na(hhd2$adult_respondent_person.id)) #2 have an id!
# table(is.na(hhd2$respondent_name2))
# hhd <- hhd2
# rm(hhd2)
# rm( adult_respondent_id1)
#############################################
## create final list of people ## this is not finished - more to do **********
#############################################
#START WITH DATA INPUT FILE for this survey
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20191118_T4_annual_survey/1. Final Surveys/data input")
# people_data_input <- read_csv (file="person_list_ID_201910.csv") %>% #2857 - data from Oct 2019;
# select (-code, -code1, -code2, number_hhd)
# setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")
#
# source("O3_T4_ID-person_list.R")
#do all manual fixes in this script, including manually add departed people
#############################################
# PULL TOGETHER CONSENT LISTS
#############################################
# PULL TOGETHER FINAL LIST OF CONSENTS
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
#setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/1. FJ/3/20190930_child sampling/3. Data/2. code/Jeff's finalised scripts/20191002")
#source("O3_T1_FJ_consent_update.R")
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
#setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/1. FJ/3/20190930_child sampling/3. Data")
# this includes corrections to consent
#############################################
#############
#FINAL CORRECTIONS TO PEOPLE'S NAMES, ETC.
#############
# source("O3_T1_ID-corrections_names.R")
#############################################
## create data files for users / analysis ##
# and for use in next survey ##
#############################################
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
# source("O3_T1_ID-data_extract.R")
#setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.