RISE_ID/T4_annual_survey/O3_T4_ID-data_check.R
In Monash-RISE/riseR:
#DATA CHECKS FOR DAILY REPORT
# THINGS TO CHECK:
# counts of surveys
# #new household consents collected
# #new child consents collected
# #############################################
# # survey length
# #############################################
# #FULL SURVEY
survey_time <- hhd %>%
filter (gift_yn==1) %>% #only surveys that progressed; someone at home
mutate (dur15 = duration15/60)
summary(survey_time$dur15)
#collective efficacy and action
o5 <- hhd %>%
filter (gift_yn==1) %>% #only surveys that progressed; someone at home
mutate (t12 = ymd_hms (time12),
t13 = ymd_hms (time13),
dur = (t13 - t12)/60)
summary(as.integer(o5$dur))
#VISITS
#how many visits to each settlement
table (hhd$today, hhd$settlement_barcode) # settlements so far
table (feces$today, feces$settlement_barcode) # settlements so far
#number of households visited
hhds.visited <- hhd %>%
group_by(settlement_barcode, extract_house_no, hhd_id_final) %>%
summarize (hhd_visits = n())
hhd_survey_complete <- hhd %>%
filter (!is.na(CE_exoassist)) %>%
group_by(settlement_barcode) %>%
summarize(survey = n())
#samples collected
samples <- feces_pickup_merge %>%
filter (!is.na(feces_barcode_final)) %>%
group_by(settlement_barcode) %>%
summarize(samples = n())
# 1 Completed survey; no return visit required
# 2 Completed survey; return visit required for at least one child
# 3 Incomplete survey
# 4 Child exceeded age cut-off of 5 years old
# 5 No one home
# 6 No one available to complete the survey
# 7 Previously consented but refused to participate in the survey
# 8 No previous consent and did not want to consent today.
# -77 Other
table (hhd$survey_status, hhd$respondent_yes, exclude = TRUE)
table (hhd$house_status, hhd$respondent_yes, exclude = TRUE)
# *****************
# *****************
# FECES CHECKS
#are there any duplicate barcodes at pickup?
check <- feces_pickup_merge %>%
filter (!is.na(feces_barcode_final))
check[duplicated(check$feces_barcode_final),] #0 duplicates
rm(check)
table(feces$feces_sample_yn, exclude = NULL) # 51 visits with no sample pick up (0); #34 with samples (1)
x <- feces_pickup_merge %>% #samples per house
select (settlement_barcode, extract_house_no, feces_sample_yn, feces_barcode_final) %>%
group_by(settlement_barcode, extract_house_no) %>%
summarize (count = n())
summary(x$count) #up to 4 samples per house
rm(x)
#TABLE 1
# 'Departed' = # individuals who have moved out of the household
# 'Moved_In' = # individuals who have moved into the household
# 'Total' = # of people currently living in the household
# 'New Household' = new household consent was given
# 'New_Child_Consent' = new child consent was collected
# 'Household_status' = 1 if the someone home or 0 if nobody home
# 'Survey' = survey was 100% completed
T1_visits <- hhd %>%
group_by(settlement_barcode) %>%
summarize(visits = n())
T1_depart <- departed %>%
group_by(settlement_barcode) %>%
summarize(departed = n())
T1_move_in <- new_people_all %>%
group_by(settlement_barcode) %>%
summarize(moved_in = n())
T1_total <- person_id %>%
group_by(settlement_barcode) %>%
summarize(total = n())
T1_hhd_consent <- hhd %>%
filter (consented_any_form1 == 1) %>%
group_by(settlement_barcode) %>%
summarize(hhd_consent = n())
T1_child_consent <- feces_kit2 %>%
filter (consented_any_form3 == 1) %>%
group_by(settlement_barcode) %>%
summarize(child_consent = n())
# table(is.na(feces_kit2$consented_any_form3)) #check
T1_hhd_status <- hhd %>%
filter (house_status == 1) %>%
group_by(settlement_barcode) %>%
summarize(house_status = n())
T1_survey <- hhd %>%
filter (!is.na(CE_exoassist)) %>%
group_by(settlement_barcode) %>%
summarize(survey = n())
T1_1 <- full_join(T1_visits, T1_depart, by = c("settlement_barcode" = "settlement_barcode")) %>%
rename(settlement = settlement_barcode)
T1_2 <- full_join(T1_1, T1_move_in, by = c("settlement" = "settlement_barcode"))
T1_3 <- full_join(T1_2, T1_total, by = c("settlement" = "settlement_barcode"))
T1_4 <- full_join(T1_3, T1_hhd_consent, by = c("settlement" = "settlement_barcode"))
T1_5 <- full_join(T1_4, T1_child_consent, by = c("settlement" = "settlement_barcode"))
T1_6 <- full_join(T1_5, T1_hhd_status, by = c("settlement" = "settlement_barcode"))
T1_7 <- full_join(T1_6, T1_survey, by = c("settlement" = "settlement_barcode"))
Table1 <- T1_7 %>%
adorn_totals("row")
rm(T1_1, T1_2, T1_3, T1_4, T1_5, T1_6, T1_7)
rm(T1_visits, T1_depart, T1_move_in, T1_total, T1_hhd_consent, T1_child_consent, T1_hhd_status, T1_survey)
#TABLE 2 - FECES SAMPLES SUMMARY
T2_children <- person_id %>% #total number of under 5 year olds in each household visited
filter (person_age_under5_counter==1) %>%
group_by(settlement_barcode) %>%
summarize('# children<5' = n())
T2_kits <- feces_kit2 %>%
filter (!is.na(feces_barcode_final)) %>%
group_by(settlement_barcode) %>%
summarize('# feces kits' = n())
T2_visits_collect <- feces_pickup_merge %>%
group_by(settlement_barcode) %>%
summarize('pickup visits' = n())
T2_samples <- feces_pickup_merge %>%
filter (!is.na(feces_barcode_final)) %>%
group_by(settlement_barcode) %>%
summarize('samples collected' = n())
T2_1 <- full_join(T2_children, T2_kits, by = c("settlement_barcode" = "settlement_barcode")) %>%
rename(settlement = settlement_barcode)
T2_2 <- full_join(T2_1, T2_visits_collect, by = c("settlement" = "settlement_barcode"))
T2_3 <- full_join(T2_2, T2_samples, by = c("settlement" = "settlement_barcode"))
Table2 <- T2_3 %>%
adorn_totals("row")
rm(T2_children, T2_kits, T2_visits_collect, T2_samples,
T2_1, T2_2, T2_3)
#TABLE 3 - CHILD SURVEYS
T3 <- child_loop %>%
mutate(survey_complete = ifelse(!is.na(skin), 1, 0),
female = ifelse(child_gender=="female", 1, 0),
doctor = ifelse(doctor_yn>0, 1, 0),
hospital = ifelse(hospital_yn>0, 1, 0)) %>%
group_by(settlement_barcode) %>%
summarise(survey_complete = sum(survey_complete, na.rm = TRUE),
no.children = n(),
no.female = sum(female, na.rm = TRUE),
mean.age = mean(age_child, na.rm = TRUE),
diarrhea = sum(diarrhea1, na.rm = TRUE),
doctor = sum(doctor, na.rm = TRUE),
hospital = sum(hospital, na.rm = TRUE))
Table3 <- T3 %>%
adorn_totals("row") %>%
mutate ('% female' = round((no.female/no.children)*100, digits = 1)) %>%
rename(settlement = settlement_barcode) %>%
select (settlement, no.children, '% female', mean.age, diarrhea, doctor, hospital)
# table(child_loop$child_gender)
# 1. feces kits handed out vs. collected
feces.kits <- feces_kit2 %>%
select (settlement_barcode, extract_house_no, feces_barcode_final, today) %>%
rename (feces.kits = feces_barcode_final,
date.handout = today) %>%
filter (!is.na(feces.kits)) #remove any NA values
feces.recd <- feces_pickup_merge %>%
select (settlement_barcode, extract_house_no, feces_barcode_final, today) %>%
rename (feces.recd = feces_barcode_final,
date.pickup = today) %>%
filter (!is.na(feces.recd))
feces.compare <- full_join (feces.kits, feces.recd,
by = c("settlement_barcode" = "settlement_barcode",
"extract_house_no" = "extract_house_no",
"feces.kits" = "feces.recd")) %>%
group_by(settlement_barcode, extract_house_no) %>%
mutate (count = n())
table(duplicated(feces.compare$feces.kits)) #2 duplicates in barcodes
feces.compare[duplicated(feces.compare$feces.kits),] #no dup
#this returns the duplicates: -
#compare house given out and house picked up
feces.compare_final <- full_join (feces.kits, feces.recd, by = c("feces.kits" = "feces.recd")) %>%
filter (!is.na(date.pickup)) %>% #only those with pickup
rename (Site_Out = settlement_barcode.x,
Site_In = settlement_barcode.y,
House_Out = extract_house_no.x,
House_In = extract_house_no.y,
Date_Out = date.handout,
Date_Collected = date.pickup) %>%
mutate (check_settlement = ifelse(Site_Out==Site_In, 0, 1),
check_house_no = ifelse(House_Out==House_In, 0, 1))
feces.compare_final2 <- feces.compare_final %>% filter(check_settlement==1 | check_house_no==1)
#
# #use this list to check for feces kits that have not been picked up:
# #write_csv(feces.compare, path = "Z:/Data Files/Data Files Objective 3/Reports/Child Sampling/feces.compare.csv")
# rm(feces.kits, feces.recd)
########################
#household changes
########################
#COMPARE MOVE OUT AND MOVE IN
#PULL TOGETHER IN A LIST OF PEOPLE
# departed = people departed
#departed.hhds = hhds departed
# hhd.new and hhd.move.in
# new_people_inside2 - from within
# new_people_outside2 - from outside
hhd.change <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, new_hhd_move,
new_hhd_old_house_no, new_hhd_id_no2, hhd_id_check, new_hhd_id_no3, hhd_id_final,
hhd_id_no_depart) %>%
filter (!is.na(hhd_id_no))
hhd.new <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, new_hhd_move,new_hhd_id_no3, hhd_id_final,
house_no_final) %>%
filter (hhd_id_no==0 & new_hhd_move==0) #27 brand new hhds
hhd.move.in <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, new_hhd_move,
new_hhd_old_house_no, new_hhd_id_no2, hhd_id_check, new_hhd_id_no3, hhd_id_final,
house_no_final, KEY) %>%
filter (new_hhd_move==1) #6 have moved from other houses in settlement
# #departed hhds
nrow(departed.hhds) #10 hhds left
#MOVED IN
#came from another house in settlement
m1 <- left_join(hhd.move.in, final.people.names, by = c("KEY" = "PARENT_KEY")) %>% #
filter (!is.na(combined_names2)) %>% #28
select(settlement_barcode, extract_house_no, hhd_id_final, combined_names2,
new_hhd_old_house_no, combined_dob) %>%
rename (old_house_no = new_hhd_old_house_no,
name = combined_names2,
dob = combined_dob)
person_move.in <-hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_final,
new_people_move1, old_house_no, new_hhd_id_no, KEY)
m2 <- right_join(person_move.in, new.people.3, by = c("KEY" = "PARENT_KEY")) %>% #
filter (!is.na(new_all_names2)) %>% #4
select (settlement_barcode, extract_house_no, hhd_id_final, new_all_names2,
old_house_no) %>%
rename (name = new_all_names2)
#COMBINE
move_in <- bind_rows(m1, m2) %>%
mutate(move_in = 1)
rm(m1, m2, person_move.in)
#MOVED OUT
#went to another house in settlement
m3 <- left_join(departed.hhds, final.people.names, by = c("KEY" = "PARENT_KEY")) %>% #
filter (!is.na(combined_names2)) %>% #35
filter (hhd_move_settlement_yn==1) %>%
select (settlement_barcode, extract_house_no, hhd_id_final, combined_names2, hhd_move_house_no) %>%
rename (old_house_no = hhd_move_house_no,
name = combined_names2)
m4 <- departed %>%
filter(move_settlement_yn==1) %>%
select(settlement_barcode, extract_house_no, hhd_id_final, name_departed2, move_house_no) %>%
rename (old_house_no = move_house_no,
name = name_departed2)
#COMBINE
move_out <- bind_rows(m3, m4) %>%
mutate(out = 1)
colnames(move_out) <- paste( "out", colnames(move_out), sep = "_")
rm(m3, m4)
#MERGE
move_combine <- full_join (move_in, move_out, by = c("settlement_barcode" = "out_settlement_barcode",
"extract_house_no" = "out_old_house_no",
"old_house_no" = "out_extract_house_no",
"name" = "out_name"))
# ***not done
#is child consent pulling through?
#hhd.members.filter - this is list of names ; merge this with new hhd from within settlement
c1 <- left_join(hhd.move.in, hhd.members.filter, by = c("KEY" = "PARENT_KEY")) %>% #40
filter(!is.na(all_names2)) #26 - looks like they are pulling through
# #revisits?
revisits <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, revisit_yn, note_why_no_participate2, verify1, survey_status) %>%
filter (!is.na(revisit_yn)) #10 revisits?
# # 1 Completed survey; no return visit required
# # 2 Completed survey; return visit required for at least one child
# # 3 Completed survey; return visit required for desired adult
# # 4 Incomplete survey
# # 5 Child exceeded age cut-off of 5 years old
# # 6 No one home
# # 7 No one available to complete the survey
# # 8 Previously consented but refused to participate in the survey
# # 9 No previous consent and did not want to consent today.
# # -77 Other
#############
#RESPONDENT
respondent.info <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no,
respondent1, respondent2,respondent3, respondent4, respondent5,
note_why_no_participate, respondent_name, respondent_name_text,
respondent_person.id, respondent_yes) %>%
filter (!is.na(hhd_id_no)) #230
#############
# #check demographics
#############
demog.check <- hhd_person_details2 %>%
select (settlement_barcode, extract_house_no, hhd_id_final, today,
survey_yes, respondent_name_text, respondent_yes, gift_yn,
confirm_gender1, confirm_gender2, person_pull_gender_final)
#child surveys
table(child_loop$child_no_survey) #4 that decided not to do survey
# #child_no_survey == 4 children that respondent refused to do survey for **keep an eye on this
#adult survey
adult.survey <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, today,
confirm_respondent, adult_respondent, adult_no_survey_why, respondent_name2,
satis_overall, CE_exoassist) %>%
filter (!is.na(hhd_id_no))
#collective efficiacy questions
CE_Q <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, today,
CE_set:CE_exoassist) %>%
filter (!is.na(hhd_id_no))
table(CE_Q$CE_set<0)
table(CE_Q$CE_achieve<0)
table(CE_Q$CE_motiv<0)
############
#check for duplicate surveys
############
check.hhd <- hhd %>%
select(settlement_barcode, extract_house_no, hhd_id_final, today, house_status, flood1_freq, verify1) %>%
filter(!is.na(verify1)) %>%
arrange(settlement_barcode, extract_house_no, hhd_id_final, today) %>%
group_by(settlement_barcode, extract_house_no, hhd_id_final) %>%
mutate (count = row_number()) %>%
filter (count>1) %>%
select (settlement_barcode, extract_house_no, hhd_id_final, today)
check.child <- child_loop %>%
select(settlement_barcode, extract_house_no, hhd_id_final, today, child_id) %>%
filter (!is.na(child_id)) %>%
group_by(child_id) %>%
mutate (count = row_number()) %>%
filter (count>1)
#old script
# #DETERMINE THE FECES FAILURE RATE; TOTAL # GIVEN OUT VS #SAMPLES REC'D
# #to do ***********
#
#
# #COUNT TOTAL NUMBER OF VISITS FOR FECES COLLECTION
# #summarising data by child - # visits to each house and # samples
# # visits must be on different days (so if more than one on same day = 1 visit)
# # The no_visits_feces count is not correct... need to use nrow(feces) to get
# # number of feces visits for now - Jeff F - 12/10/2019
# visits_feces <- full_join (feces, feces.sample, by = c("KEY" = "PARENT_KEY")) %>%
# mutate (barcode = ifelse (is.na(barcode_feces), barcode_feces_text, barcode_feces)) %>%
# mutate (barcode_yes = ifelse (!is.na(barcode), 1, 0)) %>%
# group_by(settlement_barcode, extract_house_no, today) %>%
# summarise (test = n(),
# no_samples = sum(barcode_yes, na.rm = TRUE)) %>% #note - there are quite a few re-visits on the same day
# group_by(settlement_barcode, extract_house_no) %>%
# summarise(no_visits_feces = n(),
# no_samples = sum(no_samples))
#
# visits_feces_summ <- visits_feces %>%
# group_by (settlement_barcode) %>%
# summarise(no_visits_feces = sum (no_visits_feces, na.rm = TRUE),
# no_samples = sum (no_samples, na.rm = TRUE)) %>%
# mutate (test = 1)
# visits_feces_summ2 <- visits_feces_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits_feces = sum (no_visits_feces, na.rm = TRUE),
# no_samples = sum (no_samples, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# visits_feces_summ$test <- NULL
# visits_feces_summary <- rbind (visits_feces_summ, visits_feces_summ2)
# rm(visits_feces_summ, visits_feces_summ2)
# # write_csv(visits_feces_summary, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/visits_feces_summary.csv")
#
# # NUMBER OF KITS HANDED OUT
# feces.kits <- annual.merge %>%
# select (settlement_barcode, extract_house_no, feces_kit_barcode, feces_kit_barcode_note, today) %>%
# mutate (no.feces.kits = ifelse(!is.na(feces_kit_barcode) | !is.na(feces_kit_barcode_note), 1, 0)) %>%
# group_by(settlement_barcode, extract_house_no, today) %>%
# summarise (no.feces.kits = sum(no.feces.kits, na.rm = TRUE)) %>%
# group_by(settlement_barcode, extract_house_no) %>%
# summarise(no.feces.kits = sum(no.feces.kits, na.rm = TRUE))
#
# feces.kits_summ <- feces.kits %>%
# group_by(settlement_barcode) %>%
# summarise(no.feces.kits = sum(no.feces.kits, na.rm = TRUE)) %>%
# mutate (test = 1)
# feces.kits_summ2 <- feces.kits_summ %>% #add totals
# group_by (test) %>%
# summarise (no.feces.kits = sum(no.feces.kits, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# feces.kits_summ$test <- NULL
# feces.kits_summary <- rbind (feces.kits_summ, feces.kits_summ2)
# rm(feces.kits_summ, feces.kits_summ2)
#
# feces.summary <- full_join (feces.kits_summary, visits_feces_summary,
# by = c("settlement_barcode" = "settlement_barcode"))
# rm(feces.kits_summary, visits_feces_summary)
# # write_csv(visits_feces_summary, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/visits_feces_summary.csv")
#
# # feces sample summary table
# child_count <- annual %>% group_by (settlement_barcode) %>%
# summarise (children = sum(no_children_under5 == 1)) %>%
# mutate (test = 1)
# child_count_temp <- child_count %>% group_by (test) %>%
# summarise (children = sum(children, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# child_count$test <- NULL
# child_count_temp2 <- rbind(child_count, child_count_temp)
#
# feces_temp <- feces %>% group_by (settlement_barcode) %>%
# summarise (no_visits = n()) %>%
# mutate (test = 1)
# feces_temp2 <- feces_temp %>% group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# feces_temp$test <- NULL
# feces_temp3 <- rbind (feces_temp, feces_temp2)
#
# feces_summary_final1 <- full_join (feces.summary, feces_temp3,
# by = "settlement_barcode") %>%
# select (-no_visits_feces) %>%
# rename ('# feces kits' = no.feces.kits, '# pickup visits' = no_visits,
# '# samples collected' = no_samples)
#
# feces_summary_final <- full_join(feces_summary_final1, child_count_temp2,
# by = "settlement_barcode") %>%
# rename (settlement = settlement_barcode) %>%
# select (settlement, children, '# feces kits', '# pickup visits', '# samples collected')
# rm(child_count, child_count_temp, child_count_temp2, feces_temp, feces_temp2, feces_temp3, feces_summary_final1)
#
# ##summarising data by settlement/house - # visits
# #lets get new_people first
# new_people <- annual.new_people %>%
# distinct (settlement_barcode, extract_house_no, hhd_id_no, new_person_name,
# .keep_all = TRUE) %>%
# rename (settlement = settlement_barcode, house_no = extract_house_no) %>%
# mutate (moved_in = ifelse(is.na(new_person_name), 0, 1)) %>%
# group_by (settlement, house_no, hhd_id_no) %>%
# summarise (moved_in = sum(moved_in, na.rm = TRUE)) %>%
# mutate (moved_in = ifelse(is.infinite(moved_in), NA, moved_in))
#
# new_people2 <- new_people %>% mutate (test2 = 1)
#
# new_people_summ <- new_people2 %>% group_by(settlement) %>%
# summarise (moved_in = sum(moved_in, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# new_people_summ2 <- new_people_summ %>% group_by (test) %>%
# summarise (moved_in = sum(moved_in, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# new_people_summ$test <- NULL
# new_people_summary <- rbind (new_people_summ, new_people_summ2)
# rm(new_people_summ, new_people_summ2)
#
# #now lets get people that departed:
# new_departed <- annual.departed %>%
# distinct (settlement_barcode, extract_house_no, hhd_id_no, name_departed2,
# .keep_all = TRUE) %>%
# rename (settlement = settlement_barcode, house_no = extract_house_no) %>%
# mutate (departed = ifelse(is.na(name_departed2), 0, 1)) %>%
# group_by (settlement, house_no, hhd_id_no) %>%
# summarise (departed = sum(departed, na.rm = TRUE)) %>%
# mutate (departed = ifelse(is.infinite(departed), NA, departed))
#
# departed2 <- new_departed %>% mutate (test2 = 1)
#
# departed_summ <- departed2 %>% group_by(settlement) %>%
# summarise (departed = sum(departed, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# departed_summ2 <- departed_summ %>% group_by (test) %>%
# summarise (departed = sum(departed, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# departed_summ$test <- NULL
# departed_summary <- rbind (departed_summ, departed_summ2)
# rm(departed_summ, departed_summ2)
#
# abc <- annual.merge %>% select (settlement_barcode, extract_house_no, hhd_id_no, consented_any_form3)
#JEFF's script
# annual_samples_summ2 <- annual_samples_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# new_hhd_consent = sum(new_hhd_consent, na.rm = TRUE),
# new_child_consent = sum(new_child_consent, na.rm = TRUE),
# total = sum(total, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# annual_samples_summ$test <- NULL
# annual_samples_summary <- rbind (annual_samples_summ, annual_samples_summ2)
# rm(annual_samples_summ, annual_samples_summ2)
#
#
#
#
#
#
#
#
#
#
#
# annual_samples <- full_join(hhd, hhd_child_feces_kit, by = c("KEY" = "PARENT_KEY")) %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, hhd_id_no, name_feces, no_people,
# house_status,
# consented_any_form1, consented_any_form3,
# respondent_problems) %>%
# mutate (total = ifelse(is.na(no_people) | no_people == 0, 0, no_people),
# new_hhd_consent = ifelse(consented_any_form1 == 1, 1, 0),
# new_child_consent = ifelse(consented_any_form3 == 1, 1, 0),
# household_status = ifelse(house_status != 1, 0, 1),
# survey = ifelse(is.na(respondent_problems), 0, 1)) %>%
# rename (settlement = settlement_barcode,
# house_no = extract_house_no) %>%
# group_by (settlement, house_no, hhd_id_no, name_feces) %>%
# summarise (no_visits = n(),
# total = max(total, na.rm = TRUE),
# new_hhd_consent = max(new_hhd_consent, na.rm = TRUE),
# new_child_consent = max(new_child_consent, na.rm = TRUE),
# household_status = max(household_status, na.rm = TRUE),
# survey = max(survey, na.rm = TRUE)) %>%
# mutate (total = ifelse(is.infinite(total), NA, total),
# new_hhd_consent = ifelse(is.infinite(new_hhd_consent), NA, new_hhd_consent),
# new_child_consent = ifelse(is.infinite(new_child_consent), NA, new_child_consent),
# household_status = ifelse(is.infinite(household_status), NA, household_status),
# survey = ifelse(is.infinite(survey), NA, survey))
#
# # write_csv(child_samples, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/child_samples.csv")
# #field supervisor needs to check every day with their list
#
# annual_samples2 <- annual_samples %>%
# mutate (test = ifelse(household_status == 1, 1, 0), test2 = 1) %>%
# select (-household_status)
#
#
# #summarising data by settlement
# annual_samples_summ <- annual_samples2 %>%
# group_by(settlement) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# new_hhd_consent = sum(new_hhd_consent, na.rm = TRUE),
# new_child_consent = sum(new_child_consent, na.rm = TRUE),
# total = sum(total, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# annual_samples_summ2 <- annual_samples_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# new_hhd_consent = sum(new_hhd_consent, na.rm = TRUE),
# new_child_consent = sum(new_child_consent, na.rm = TRUE),
# total = sum(total, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# annual_samples_summ$test <- NULL
# annual_samples_summary <- rbind (annual_samples_summ, annual_samples_summ2)
# rm(annual_samples_summ, annual_samples_summ2)
#
# #now just add in moved_in with the data:
# annual_samples_summary <- cbind(annual_samples_summary, new_people_summary[,2, drop = FALSE]) %>%
# select (settlement, no_visits, moved_in, new_hhd_consent,
# new_child_consent, total, survey)
# #now add in departed with the data:
# annual_samples_summary <- cbind(annual_samples_summary, departed_summary[,2, drop = FALSE]) %>%
# select (settlement, no_visits, departed, moved_in, new_hhd_consent,
# new_child_consent, total, survey)
#
# annual_sampling_summary <- full_join(annual_samples_summary, feces.summary,
# by = c("settlement" = "settlement_barcode"))
#
#
#
#
# # write_csv(child_sampling_summary, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/2. ID/3. Objectives/3/20190225_child sampling/3. ID/2. Data/4. reports/child_sampling_summary.csv")
# # of new household data
###############
# # CHILD data
#
# annual.merge_child <- left_join (annual, annual_child, by = c("KEY" = "PARENT_KEY")) %>%
# filter (no_children_under15 > 0)
#
# child_samples <- annual.merge_child %>%
# mutate (gender = ifelse(child_gender == 'male', 1, 0),
# caregiver_present = ifelse(caregiver_yn == 1, 1, 0),
# doctor = ifelse(doctor_yn > 0, 1, 0),
# hospital = ifelse(hospital_yn > 0, 1, 0),
# cough = ifelse(cough > 0, 1, 0),
# toothache = ifelse(toothache > 0 , 1, 0),
# breathing = ifelse(breathing > 0, 1, 0),
# diarrhea = ifelse(diarrhea1 > 0, 1, 0),
# fever = ifelse(fever > 0, 1, 0),
# skin = ifelse(skin > 0, 1, 0),
# injury = ifelse(injury > 0, 1, 0),
# survey = ifelse(is.na(child_no_survey), 1, 0)) %>%
# rename (settlement = settlement_barcode,
# house_no = extract_house_no) %>%
# group_by (settlement, house_no, hhd_id_no, child_name2) %>%
# summarise (no_visits = n(),
# age = max(age_child, na.rm = TRUE),
# gender = max(gender, na.rm = TRUE),
# doctor = max(doctor, na.rm = TRUE),
# hospital = max(hospital, na.rm = TRUE),
# cough = max(cough, na.rm = TRUE),
# toothache = max(toothache, na.rm = TRUE),
# breathing = max(breathing, na.rm = TRUE),
# diarrhea = max(diarrhea, na.rm = TRUE),
# fever = max(fever, na.rm = TRUE),
# skin = max(skin, na.rm = TRUE),
# injury = max(injury, na.rm = TRUE),
# survey = max(survey, na.rm = TRUE)) %>%
# mutate (age = ifelse(is.infinite(age), NA, age),
# gender = ifelse(is.infinite(gender), NA, gender),
# doctor = ifelse(is.infinite(doctor), NA, doctor),
# hospital = ifelse(is.infinite(hospital), NA, hospital),
# cough = ifelse(is.infinite(cough), NA, cough),
# toothache = ifelse(is.infinite(toothache), NA, toothache),
# breathing = ifelse(is.infinite(breathing), NA, breathing),
# diarrhea = ifelse(is.infinite(diarrhea), NA, diarrhea),
# fever = ifelse(is.infinite(fever), NA, fever),
# injury = ifelse(is.infinite(injury), NA, injury),
# survey = ifelse(is.infinite(survey), NA, survey)) #remove Inf
#
# write_csv(child_samples, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/child_samples.csv")
#field supervisor needs to check every day with their list
#
# child_samples2 <- child_samples %>%
# mutate (test = ifelse(!is.na(child_name2), 1, 0), test2 = 1) %>%
# select (-child_name2)
#
# #summarising data by settlement
# child_samples_summ <- child_samples2 %>%
# group_by(settlement) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# no_children = sum(test, na.rm = TRUE),
# cough = sum(cough, na.rm = TRUE),
# toothache = sum(toothache, na.rm = TRUE),
# breathing = sum(breathing, na.rm = TRUE),
# fever = sum(fever, na.rm = TRUE),
# injury = sum(injury, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE),
# gender = mean(gender, na.rm = TRUE),
# diarrhea = sum(diarrhea, na.rm = TRUE),
# doctor = sum(doctor, na.rm = TRUE),
# hospital = sum(hospital, na.rm = TRUE),
# age = mean(age, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# child_samples_summ2 <- child_samples_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# no_children = sum(no_children, na.rm = TRUE),
# cough = sum(cough, na.rm = TRUE),
# toothache = sum(toothache, na.rm = TRUE),
# breathing = sum(breathing, na.rm = TRUE),
# fever = sum(fever, na.rm = TRUE),
# injury = sum(injury, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE),
# gender = mean(gender, na.rm= TRUE),
# diarrhea = sum(diarrhea, na.rm = TRUE),
# doctor = sum(doctor, na.rm = TRUE),
# hospital = sum(hospital, na.rm = TRUE),
# age = mean(age, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# child_samples_summ$test <- NULL
# child_samples_summary <- rbind (child_samples_summ, child_samples_summ2) %>%
# rename (mean_age = age) %>%
# mutate ('% male' = format(round(gender*100, 1), nsmall = 1),
# age = format(round(mean_age, 1), nsmall = 1)) %>%
# select(settlement, no_visits, no_children, survey, '% male', age,
# cough, breathing, breathing, fever, injury, diarrhea,
# doctor, hospital)
# rm(child_samples_summ, child_samples_summ2)
#
# child_sampling_summary <- full_join(child_samples_summary, feces.summary,
# by = c("settlement" = "settlement_barcode")) %>%
# select(settlement, no_visits, no_children, survey, '% male', age,
# cough, breathing, breathing, fever, injury, diarrhea,
# doctor, hospital, no.feces.kits, no_visits_feces, no_samples)
#
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.
#DATA CHECKS FOR DAILY REPORT
# THINGS TO CHECK:
# counts of surveys
# #new household consents collected
# #new child consents collected
# #############################################
# # survey length
# #############################################
# #FULL SURVEY
survey_time <- hhd %>%
filter (gift_yn==1) %>% #only surveys that progressed; someone at home
mutate (dur15 = duration15/60)
summary(survey_time$dur15)
#collective efficacy and action
o5 <- hhd %>%
filter (gift_yn==1) %>% #only surveys that progressed; someone at home
mutate (t12 = ymd_hms (time12),
t13 = ymd_hms (time13),
dur = (t13 - t12)/60)
summary(as.integer(o5$dur))
#VISITS
#how many visits to each settlement
table (hhd$today, hhd$settlement_barcode) # settlements so far
table (feces$today, feces$settlement_barcode) # settlements so far
#number of households visited
hhds.visited <- hhd %>%
group_by(settlement_barcode, extract_house_no, hhd_id_final) %>%
summarize (hhd_visits = n())
hhd_survey_complete <- hhd %>%
filter (!is.na(CE_exoassist)) %>%
group_by(settlement_barcode) %>%
summarize(survey = n())
#samples collected
samples <- feces_pickup_merge %>%
filter (!is.na(feces_barcode_final)) %>%
group_by(settlement_barcode) %>%
summarize(samples = n())
# 1 Completed survey; no return visit required
# 2 Completed survey; return visit required for at least one child
# 3 Incomplete survey
# 4 Child exceeded age cut-off of 5 years old
# 5 No one home
# 6 No one available to complete the survey
# 7 Previously consented but refused to participate in the survey
# 8 No previous consent and did not want to consent today.
# -77 Other
table (hhd$survey_status, hhd$respondent_yes, exclude = TRUE)
table (hhd$house_status, hhd$respondent_yes, exclude = TRUE)
# *****************
# *****************
# FECES CHECKS
#are there any duplicate barcodes at pickup?
check <- feces_pickup_merge %>%
filter (!is.na(feces_barcode_final))
check[duplicated(check$feces_barcode_final),] #0 duplicates
rm(check)
table(feces$feces_sample_yn, exclude = NULL) # 51 visits with no sample pick up (0); #34 with samples (1)
x <- feces_pickup_merge %>% #samples per house
select (settlement_barcode, extract_house_no, feces_sample_yn, feces_barcode_final) %>%
group_by(settlement_barcode, extract_house_no) %>%
summarize (count = n())
summary(x$count) #up to 4 samples per house
rm(x)
#TABLE 1
# 'Departed' = # individuals who have moved out of the household
# 'Moved_In' = # individuals who have moved into the household
# 'Total' = # of people currently living in the household
# 'New Household' = new household consent was given
# 'New_Child_Consent' = new child consent was collected
# 'Household_status' = 1 if the someone home or 0 if nobody home
# 'Survey' = survey was 100% completed
T1_visits <- hhd %>%
group_by(settlement_barcode) %>%
summarize(visits = n())
T1_depart <- departed %>%
group_by(settlement_barcode) %>%
summarize(departed = n())
T1_move_in <- new_people_all %>%
group_by(settlement_barcode) %>%
summarize(moved_in = n())
T1_total <- person_id %>%
group_by(settlement_barcode) %>%
summarize(total = n())
T1_hhd_consent <- hhd %>%
filter (consented_any_form1 == 1) %>%
group_by(settlement_barcode) %>%
summarize(hhd_consent = n())
T1_child_consent <- feces_kit2 %>%
filter (consented_any_form3 == 1) %>%
group_by(settlement_barcode) %>%
summarize(child_consent = n())
# table(is.na(feces_kit2$consented_any_form3)) #check
T1_hhd_status <- hhd %>%
filter (house_status == 1) %>%
group_by(settlement_barcode) %>%
summarize(house_status = n())
T1_survey <- hhd %>%
filter (!is.na(CE_exoassist)) %>%
group_by(settlement_barcode) %>%
summarize(survey = n())
T1_1 <- full_join(T1_visits, T1_depart, by = c("settlement_barcode" = "settlement_barcode")) %>%
rename(settlement = settlement_barcode)
T1_2 <- full_join(T1_1, T1_move_in, by = c("settlement" = "settlement_barcode"))
T1_3 <- full_join(T1_2, T1_total, by = c("settlement" = "settlement_barcode"))
T1_4 <- full_join(T1_3, T1_hhd_consent, by = c("settlement" = "settlement_barcode"))
T1_5 <- full_join(T1_4, T1_child_consent, by = c("settlement" = "settlement_barcode"))
T1_6 <- full_join(T1_5, T1_hhd_status, by = c("settlement" = "settlement_barcode"))
T1_7 <- full_join(T1_6, T1_survey, by = c("settlement" = "settlement_barcode"))
Table1 <- T1_7 %>%
adorn_totals("row")
rm(T1_1, T1_2, T1_3, T1_4, T1_5, T1_6, T1_7)
rm(T1_visits, T1_depart, T1_move_in, T1_total, T1_hhd_consent, T1_child_consent, T1_hhd_status, T1_survey)
#TABLE 2 - FECES SAMPLES SUMMARY
T2_children <- person_id %>% #total number of under 5 year olds in each household visited
filter (person_age_under5_counter==1) %>%
group_by(settlement_barcode) %>%
summarize('# children<5' = n())
T2_kits <- feces_kit2 %>%
filter (!is.na(feces_barcode_final)) %>%
group_by(settlement_barcode) %>%
summarize('# feces kits' = n())
T2_visits_collect <- feces_pickup_merge %>%
group_by(settlement_barcode) %>%
summarize('pickup visits' = n())
T2_samples <- feces_pickup_merge %>%
filter (!is.na(feces_barcode_final)) %>%
group_by(settlement_barcode) %>%
summarize('samples collected' = n())
T2_1 <- full_join(T2_children, T2_kits, by = c("settlement_barcode" = "settlement_barcode")) %>%
rename(settlement = settlement_barcode)
T2_2 <- full_join(T2_1, T2_visits_collect, by = c("settlement" = "settlement_barcode"))
T2_3 <- full_join(T2_2, T2_samples, by = c("settlement" = "settlement_barcode"))
Table2 <- T2_3 %>%
adorn_totals("row")
rm(T2_children, T2_kits, T2_visits_collect, T2_samples,
T2_1, T2_2, T2_3)
#TABLE 3 - CHILD SURVEYS
T3 <- child_loop %>%
mutate(survey_complete = ifelse(!is.na(skin), 1, 0),
female = ifelse(child_gender=="female", 1, 0),
doctor = ifelse(doctor_yn>0, 1, 0),
hospital = ifelse(hospital_yn>0, 1, 0)) %>%
group_by(settlement_barcode) %>%
summarise(survey_complete = sum(survey_complete, na.rm = TRUE),
no.children = n(),
no.female = sum(female, na.rm = TRUE),
mean.age = mean(age_child, na.rm = TRUE),
diarrhea = sum(diarrhea1, na.rm = TRUE),
doctor = sum(doctor, na.rm = TRUE),
hospital = sum(hospital, na.rm = TRUE))
Table3 <- T3 %>%
adorn_totals("row") %>%
mutate ('% female' = round((no.female/no.children)*100, digits = 1)) %>%
rename(settlement = settlement_barcode) %>%
select (settlement, no.children, '% female', mean.age, diarrhea, doctor, hospital)
# table(child_loop$child_gender)
# 1. feces kits handed out vs. collected
feces.kits <- feces_kit2 %>%
select (settlement_barcode, extract_house_no, feces_barcode_final, today) %>%
rename (feces.kits = feces_barcode_final,
date.handout = today) %>%
filter (!is.na(feces.kits)) #remove any NA values
feces.recd <- feces_pickup_merge %>%
select (settlement_barcode, extract_house_no, feces_barcode_final, today) %>%
rename (feces.recd = feces_barcode_final,
date.pickup = today) %>%
filter (!is.na(feces.recd))
feces.compare <- full_join (feces.kits, feces.recd,
by = c("settlement_barcode" = "settlement_barcode",
"extract_house_no" = "extract_house_no",
"feces.kits" = "feces.recd")) %>%
group_by(settlement_barcode, extract_house_no) %>%
mutate (count = n())
table(duplicated(feces.compare$feces.kits)) #2 duplicates in barcodes
feces.compare[duplicated(feces.compare$feces.kits),] #no dup
#this returns the duplicates: -
#compare house given out and house picked up
feces.compare_final <- full_join (feces.kits, feces.recd, by = c("feces.kits" = "feces.recd")) %>%
filter (!is.na(date.pickup)) %>% #only those with pickup
rename (Site_Out = settlement_barcode.x,
Site_In = settlement_barcode.y,
House_Out = extract_house_no.x,
House_In = extract_house_no.y,
Date_Out = date.handout,
Date_Collected = date.pickup) %>%
mutate (check_settlement = ifelse(Site_Out==Site_In, 0, 1),
check_house_no = ifelse(House_Out==House_In, 0, 1))
feces.compare_final2 <- feces.compare_final %>% filter(check_settlement==1 | check_house_no==1)
#
# #use this list to check for feces kits that have not been picked up:
# #write_csv(feces.compare, path = "Z:/Data Files/Data Files Objective 3/Reports/Child Sampling/feces.compare.csv")
# rm(feces.kits, feces.recd)
########################
#household changes
########################
#COMPARE MOVE OUT AND MOVE IN
#PULL TOGETHER IN A LIST OF PEOPLE
# departed = people departed
#departed.hhds = hhds departed
# hhd.new and hhd.move.in
# new_people_inside2 - from within
# new_people_outside2 - from outside
hhd.change <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, new_hhd_move,
new_hhd_old_house_no, new_hhd_id_no2, hhd_id_check, new_hhd_id_no3, hhd_id_final,
hhd_id_no_depart) %>%
filter (!is.na(hhd_id_no))
hhd.new <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, new_hhd_move,new_hhd_id_no3, hhd_id_final,
house_no_final) %>%
filter (hhd_id_no==0 & new_hhd_move==0) #27 brand new hhds
hhd.move.in <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, new_hhd_move,
new_hhd_old_house_no, new_hhd_id_no2, hhd_id_check, new_hhd_id_no3, hhd_id_final,
house_no_final, KEY) %>%
filter (new_hhd_move==1) #6 have moved from other houses in settlement
# #departed hhds
nrow(departed.hhds) #10 hhds left
#MOVED IN
#came from another house in settlement
m1 <- left_join(hhd.move.in, final.people.names, by = c("KEY" = "PARENT_KEY")) %>% #
filter (!is.na(combined_names2)) %>% #28
select(settlement_barcode, extract_house_no, hhd_id_final, combined_names2,
new_hhd_old_house_no, combined_dob) %>%
rename (old_house_no = new_hhd_old_house_no,
name = combined_names2,
dob = combined_dob)
person_move.in <-hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_final,
new_people_move1, old_house_no, new_hhd_id_no, KEY)
m2 <- right_join(person_move.in, new.people.3, by = c("KEY" = "PARENT_KEY")) %>% #
filter (!is.na(new_all_names2)) %>% #4
select (settlement_barcode, extract_house_no, hhd_id_final, new_all_names2,
old_house_no) %>%
rename (name = new_all_names2)
#COMBINE
move_in <- bind_rows(m1, m2) %>%
mutate(move_in = 1)
rm(m1, m2, person_move.in)
#MOVED OUT
#went to another house in settlement
m3 <- left_join(departed.hhds, final.people.names, by = c("KEY" = "PARENT_KEY")) %>% #
filter (!is.na(combined_names2)) %>% #35
filter (hhd_move_settlement_yn==1) %>%
select (settlement_barcode, extract_house_no, hhd_id_final, combined_names2, hhd_move_house_no) %>%
rename (old_house_no = hhd_move_house_no,
name = combined_names2)
m4 <- departed %>%
filter(move_settlement_yn==1) %>%
select(settlement_barcode, extract_house_no, hhd_id_final, name_departed2, move_house_no) %>%
rename (old_house_no = move_house_no,
name = name_departed2)
#COMBINE
move_out <- bind_rows(m3, m4) %>%
mutate(out = 1)
colnames(move_out) <- paste( "out", colnames(move_out), sep = "_")
rm(m3, m4)
#MERGE
move_combine <- full_join (move_in, move_out, by = c("settlement_barcode" = "out_settlement_barcode",
"extract_house_no" = "out_old_house_no",
"old_house_no" = "out_extract_house_no",
"name" = "out_name"))
# ***not done
#is child consent pulling through?
#hhd.members.filter - this is list of names ; merge this with new hhd from within settlement
c1 <- left_join(hhd.move.in, hhd.members.filter, by = c("KEY" = "PARENT_KEY")) %>% #40
filter(!is.na(all_names2)) #26 - looks like they are pulling through
# #revisits?
revisits <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, revisit_yn, note_why_no_participate2, verify1, survey_status) %>%
filter (!is.na(revisit_yn)) #10 revisits?
# # 1 Completed survey; no return visit required
# # 2 Completed survey; return visit required for at least one child
# # 3 Completed survey; return visit required for desired adult
# # 4 Incomplete survey
# # 5 Child exceeded age cut-off of 5 years old
# # 6 No one home
# # 7 No one available to complete the survey
# # 8 Previously consented but refused to participate in the survey
# # 9 No previous consent and did not want to consent today.
# # -77 Other
#############
#RESPONDENT
respondent.info <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no,
respondent1, respondent2,respondent3, respondent4, respondent5,
note_why_no_participate, respondent_name, respondent_name_text,
respondent_person.id, respondent_yes) %>%
filter (!is.na(hhd_id_no)) #230
#############
# #check demographics
#############
demog.check <- hhd_person_details2 %>%
select (settlement_barcode, extract_house_no, hhd_id_final, today,
survey_yes, respondent_name_text, respondent_yes, gift_yn,
confirm_gender1, confirm_gender2, person_pull_gender_final)
#child surveys
table(child_loop$child_no_survey) #4 that decided not to do survey
# #child_no_survey == 4 children that respondent refused to do survey for **keep an eye on this
#adult survey
adult.survey <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, today,
confirm_respondent, adult_respondent, adult_no_survey_why, respondent_name2,
satis_overall, CE_exoassist) %>%
filter (!is.na(hhd_id_no))
#collective efficiacy questions
CE_Q <- hhd %>%
select (settlement_barcode, extract_house_no, hhd_id_no, today,
CE_set:CE_exoassist) %>%
filter (!is.na(hhd_id_no))
table(CE_Q$CE_set<0)
table(CE_Q$CE_achieve<0)
table(CE_Q$CE_motiv<0)
############
#check for duplicate surveys
############
check.hhd <- hhd %>%
select(settlement_barcode, extract_house_no, hhd_id_final, today, house_status, flood1_freq, verify1) %>%
filter(!is.na(verify1)) %>%
arrange(settlement_barcode, extract_house_no, hhd_id_final, today) %>%
group_by(settlement_barcode, extract_house_no, hhd_id_final) %>%
mutate (count = row_number()) %>%
filter (count>1) %>%
select (settlement_barcode, extract_house_no, hhd_id_final, today)
check.child <- child_loop %>%
select(settlement_barcode, extract_house_no, hhd_id_final, today, child_id) %>%
filter (!is.na(child_id)) %>%
group_by(child_id) %>%
mutate (count = row_number()) %>%
filter (count>1)
#old script
# #DETERMINE THE FECES FAILURE RATE; TOTAL # GIVEN OUT VS #SAMPLES REC'D
# #to do ***********
#
#
# #COUNT TOTAL NUMBER OF VISITS FOR FECES COLLECTION
# #summarising data by child - # visits to each house and # samples
# # visits must be on different days (so if more than one on same day = 1 visit)
# # The no_visits_feces count is not correct... need to use nrow(feces) to get
# # number of feces visits for now - Jeff F - 12/10/2019
# visits_feces <- full_join (feces, feces.sample, by = c("KEY" = "PARENT_KEY")) %>%
# mutate (barcode = ifelse (is.na(barcode_feces), barcode_feces_text, barcode_feces)) %>%
# mutate (barcode_yes = ifelse (!is.na(barcode), 1, 0)) %>%
# group_by(settlement_barcode, extract_house_no, today) %>%
# summarise (test = n(),
# no_samples = sum(barcode_yes, na.rm = TRUE)) %>% #note - there are quite a few re-visits on the same day
# group_by(settlement_barcode, extract_house_no) %>%
# summarise(no_visits_feces = n(),
# no_samples = sum(no_samples))
#
# visits_feces_summ <- visits_feces %>%
# group_by (settlement_barcode) %>%
# summarise(no_visits_feces = sum (no_visits_feces, na.rm = TRUE),
# no_samples = sum (no_samples, na.rm = TRUE)) %>%
# mutate (test = 1)
# visits_feces_summ2 <- visits_feces_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits_feces = sum (no_visits_feces, na.rm = TRUE),
# no_samples = sum (no_samples, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# visits_feces_summ$test <- NULL
# visits_feces_summary <- rbind (visits_feces_summ, visits_feces_summ2)
# rm(visits_feces_summ, visits_feces_summ2)
# # write_csv(visits_feces_summary, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/visits_feces_summary.csv")
#
# # NUMBER OF KITS HANDED OUT
# feces.kits <- annual.merge %>%
# select (settlement_barcode, extract_house_no, feces_kit_barcode, feces_kit_barcode_note, today) %>%
# mutate (no.feces.kits = ifelse(!is.na(feces_kit_barcode) | !is.na(feces_kit_barcode_note), 1, 0)) %>%
# group_by(settlement_barcode, extract_house_no, today) %>%
# summarise (no.feces.kits = sum(no.feces.kits, na.rm = TRUE)) %>%
# group_by(settlement_barcode, extract_house_no) %>%
# summarise(no.feces.kits = sum(no.feces.kits, na.rm = TRUE))
#
# feces.kits_summ <- feces.kits %>%
# group_by(settlement_barcode) %>%
# summarise(no.feces.kits = sum(no.feces.kits, na.rm = TRUE)) %>%
# mutate (test = 1)
# feces.kits_summ2 <- feces.kits_summ %>% #add totals
# group_by (test) %>%
# summarise (no.feces.kits = sum(no.feces.kits, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# feces.kits_summ$test <- NULL
# feces.kits_summary <- rbind (feces.kits_summ, feces.kits_summ2)
# rm(feces.kits_summ, feces.kits_summ2)
#
# feces.summary <- full_join (feces.kits_summary, visits_feces_summary,
# by = c("settlement_barcode" = "settlement_barcode"))
# rm(feces.kits_summary, visits_feces_summary)
# # write_csv(visits_feces_summary, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/visits_feces_summary.csv")
#
# # feces sample summary table
# child_count <- annual %>% group_by (settlement_barcode) %>%
# summarise (children = sum(no_children_under5 == 1)) %>%
# mutate (test = 1)
# child_count_temp <- child_count %>% group_by (test) %>%
# summarise (children = sum(children, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# child_count$test <- NULL
# child_count_temp2 <- rbind(child_count, child_count_temp)
#
# feces_temp <- feces %>% group_by (settlement_barcode) %>%
# summarise (no_visits = n()) %>%
# mutate (test = 1)
# feces_temp2 <- feces_temp %>% group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE)) %>%
# rename (settlement_barcode = test) %>%
# mutate (settlement_barcode = "Totals")
# feces_temp$test <- NULL
# feces_temp3 <- rbind (feces_temp, feces_temp2)
#
# feces_summary_final1 <- full_join (feces.summary, feces_temp3,
# by = "settlement_barcode") %>%
# select (-no_visits_feces) %>%
# rename ('# feces kits' = no.feces.kits, '# pickup visits' = no_visits,
# '# samples collected' = no_samples)
#
# feces_summary_final <- full_join(feces_summary_final1, child_count_temp2,
# by = "settlement_barcode") %>%
# rename (settlement = settlement_barcode) %>%
# select (settlement, children, '# feces kits', '# pickup visits', '# samples collected')
# rm(child_count, child_count_temp, child_count_temp2, feces_temp, feces_temp2, feces_temp3, feces_summary_final1)
#
# ##summarising data by settlement/house - # visits
# #lets get new_people first
# new_people <- annual.new_people %>%
# distinct (settlement_barcode, extract_house_no, hhd_id_no, new_person_name,
# .keep_all = TRUE) %>%
# rename (settlement = settlement_barcode, house_no = extract_house_no) %>%
# mutate (moved_in = ifelse(is.na(new_person_name), 0, 1)) %>%
# group_by (settlement, house_no, hhd_id_no) %>%
# summarise (moved_in = sum(moved_in, na.rm = TRUE)) %>%
# mutate (moved_in = ifelse(is.infinite(moved_in), NA, moved_in))
#
# new_people2 <- new_people %>% mutate (test2 = 1)
#
# new_people_summ <- new_people2 %>% group_by(settlement) %>%
# summarise (moved_in = sum(moved_in, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# new_people_summ2 <- new_people_summ %>% group_by (test) %>%
# summarise (moved_in = sum(moved_in, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# new_people_summ$test <- NULL
# new_people_summary <- rbind (new_people_summ, new_people_summ2)
# rm(new_people_summ, new_people_summ2)
#
# #now lets get people that departed:
# new_departed <- annual.departed %>%
# distinct (settlement_barcode, extract_house_no, hhd_id_no, name_departed2,
# .keep_all = TRUE) %>%
# rename (settlement = settlement_barcode, house_no = extract_house_no) %>%
# mutate (departed = ifelse(is.na(name_departed2), 0, 1)) %>%
# group_by (settlement, house_no, hhd_id_no) %>%
# summarise (departed = sum(departed, na.rm = TRUE)) %>%
# mutate (departed = ifelse(is.infinite(departed), NA, departed))
#
# departed2 <- new_departed %>% mutate (test2 = 1)
#
# departed_summ <- departed2 %>% group_by(settlement) %>%
# summarise (departed = sum(departed, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# departed_summ2 <- departed_summ %>% group_by (test) %>%
# summarise (departed = sum(departed, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# departed_summ$test <- NULL
# departed_summary <- rbind (departed_summ, departed_summ2)
# rm(departed_summ, departed_summ2)
#
# abc <- annual.merge %>% select (settlement_barcode, extract_house_no, hhd_id_no, consented_any_form3)
#JEFF's script
# annual_samples_summ2 <- annual_samples_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# new_hhd_consent = sum(new_hhd_consent, na.rm = TRUE),
# new_child_consent = sum(new_child_consent, na.rm = TRUE),
# total = sum(total, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# annual_samples_summ$test <- NULL
# annual_samples_summary <- rbind (annual_samples_summ, annual_samples_summ2)
# rm(annual_samples_summ, annual_samples_summ2)
#
#
#
#
#
#
#
#
#
#
#
# annual_samples <- full_join(hhd, hhd_child_feces_kit, by = c("KEY" = "PARENT_KEY")) %>%
# select (settlement_barcode, extract_house_no, hhd_id_final, hhd_id_no, name_feces, no_people,
# house_status,
# consented_any_form1, consented_any_form3,
# respondent_problems) %>%
# mutate (total = ifelse(is.na(no_people) | no_people == 0, 0, no_people),
# new_hhd_consent = ifelse(consented_any_form1 == 1, 1, 0),
# new_child_consent = ifelse(consented_any_form3 == 1, 1, 0),
# household_status = ifelse(house_status != 1, 0, 1),
# survey = ifelse(is.na(respondent_problems), 0, 1)) %>%
# rename (settlement = settlement_barcode,
# house_no = extract_house_no) %>%
# group_by (settlement, house_no, hhd_id_no, name_feces) %>%
# summarise (no_visits = n(),
# total = max(total, na.rm = TRUE),
# new_hhd_consent = max(new_hhd_consent, na.rm = TRUE),
# new_child_consent = max(new_child_consent, na.rm = TRUE),
# household_status = max(household_status, na.rm = TRUE),
# survey = max(survey, na.rm = TRUE)) %>%
# mutate (total = ifelse(is.infinite(total), NA, total),
# new_hhd_consent = ifelse(is.infinite(new_hhd_consent), NA, new_hhd_consent),
# new_child_consent = ifelse(is.infinite(new_child_consent), NA, new_child_consent),
# household_status = ifelse(is.infinite(household_status), NA, household_status),
# survey = ifelse(is.infinite(survey), NA, survey))
#
# # write_csv(child_samples, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/child_samples.csv")
# #field supervisor needs to check every day with their list
#
# annual_samples2 <- annual_samples %>%
# mutate (test = ifelse(household_status == 1, 1, 0), test2 = 1) %>%
# select (-household_status)
#
#
# #summarising data by settlement
# annual_samples_summ <- annual_samples2 %>%
# group_by(settlement) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# new_hhd_consent = sum(new_hhd_consent, na.rm = TRUE),
# new_child_consent = sum(new_child_consent, na.rm = TRUE),
# total = sum(total, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# annual_samples_summ2 <- annual_samples_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# new_hhd_consent = sum(new_hhd_consent, na.rm = TRUE),
# new_child_consent = sum(new_child_consent, na.rm = TRUE),
# total = sum(total, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# annual_samples_summ$test <- NULL
# annual_samples_summary <- rbind (annual_samples_summ, annual_samples_summ2)
# rm(annual_samples_summ, annual_samples_summ2)
#
# #now just add in moved_in with the data:
# annual_samples_summary <- cbind(annual_samples_summary, new_people_summary[,2, drop = FALSE]) %>%
# select (settlement, no_visits, moved_in, new_hhd_consent,
# new_child_consent, total, survey)
# #now add in departed with the data:
# annual_samples_summary <- cbind(annual_samples_summary, departed_summary[,2, drop = FALSE]) %>%
# select (settlement, no_visits, departed, moved_in, new_hhd_consent,
# new_child_consent, total, survey)
#
# annual_sampling_summary <- full_join(annual_samples_summary, feces.summary,
# by = c("settlement" = "settlement_barcode"))
#
#
#
#
# # write_csv(child_sampling_summary, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/2. ID/3. Objectives/3/20190225_child sampling/3. ID/2. Data/4. reports/child_sampling_summary.csv")
# # of new household data
###############
# # CHILD data
#
# annual.merge_child <- left_join (annual, annual_child, by = c("KEY" = "PARENT_KEY")) %>%
# filter (no_children_under15 > 0)
#
# child_samples <- annual.merge_child %>%
# mutate (gender = ifelse(child_gender == 'male', 1, 0),
# caregiver_present = ifelse(caregiver_yn == 1, 1, 0),
# doctor = ifelse(doctor_yn > 0, 1, 0),
# hospital = ifelse(hospital_yn > 0, 1, 0),
# cough = ifelse(cough > 0, 1, 0),
# toothache = ifelse(toothache > 0 , 1, 0),
# breathing = ifelse(breathing > 0, 1, 0),
# diarrhea = ifelse(diarrhea1 > 0, 1, 0),
# fever = ifelse(fever > 0, 1, 0),
# skin = ifelse(skin > 0, 1, 0),
# injury = ifelse(injury > 0, 1, 0),
# survey = ifelse(is.na(child_no_survey), 1, 0)) %>%
# rename (settlement = settlement_barcode,
# house_no = extract_house_no) %>%
# group_by (settlement, house_no, hhd_id_no, child_name2) %>%
# summarise (no_visits = n(),
# age = max(age_child, na.rm = TRUE),
# gender = max(gender, na.rm = TRUE),
# doctor = max(doctor, na.rm = TRUE),
# hospital = max(hospital, na.rm = TRUE),
# cough = max(cough, na.rm = TRUE),
# toothache = max(toothache, na.rm = TRUE),
# breathing = max(breathing, na.rm = TRUE),
# diarrhea = max(diarrhea, na.rm = TRUE),
# fever = max(fever, na.rm = TRUE),
# skin = max(skin, na.rm = TRUE),
# injury = max(injury, na.rm = TRUE),
# survey = max(survey, na.rm = TRUE)) %>%
# mutate (age = ifelse(is.infinite(age), NA, age),
# gender = ifelse(is.infinite(gender), NA, gender),
# doctor = ifelse(is.infinite(doctor), NA, doctor),
# hospital = ifelse(is.infinite(hospital), NA, hospital),
# cough = ifelse(is.infinite(cough), NA, cough),
# toothache = ifelse(is.infinite(toothache), NA, toothache),
# breathing = ifelse(is.infinite(breathing), NA, breathing),
# diarrhea = ifelse(is.infinite(diarrhea), NA, diarrhea),
# fever = ifelse(is.infinite(fever), NA, fever),
# injury = ifelse(is.infinite(injury), NA, injury),
# survey = ifelse(is.infinite(survey), NA, survey)) #remove Inf
#
# write_csv(child_samples, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190225_child sampling/3. ID/2. Data/4. reports/child_samples.csv")
#field supervisor needs to check every day with their list
#
# child_samples2 <- child_samples %>%
# mutate (test = ifelse(!is.na(child_name2), 1, 0), test2 = 1) %>%
# select (-child_name2)
#
# #summarising data by settlement
# child_samples_summ <- child_samples2 %>%
# group_by(settlement) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# no_children = sum(test, na.rm = TRUE),
# cough = sum(cough, na.rm = TRUE),
# toothache = sum(toothache, na.rm = TRUE),
# breathing = sum(breathing, na.rm = TRUE),
# fever = sum(fever, na.rm = TRUE),
# injury = sum(injury, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE),
# gender = mean(gender, na.rm = TRUE),
# diarrhea = sum(diarrhea, na.rm = TRUE),
# doctor = sum(doctor, na.rm = TRUE),
# hospital = sum(hospital, na.rm = TRUE),
# age = mean(age, na.rm = TRUE)) %>%
# mutate (test = 1)
#
# child_samples_summ2 <- child_samples_summ %>% #add totals
# group_by (test) %>%
# summarise (no_visits = sum(no_visits, na.rm = TRUE),
# no_children = sum(no_children, na.rm = TRUE),
# cough = sum(cough, na.rm = TRUE),
# toothache = sum(toothache, na.rm = TRUE),
# breathing = sum(breathing, na.rm = TRUE),
# fever = sum(fever, na.rm = TRUE),
# injury = sum(injury, na.rm = TRUE),
# survey = sum(survey, na.rm = TRUE),
# gender = mean(gender, na.rm= TRUE),
# diarrhea = sum(diarrhea, na.rm = TRUE),
# doctor = sum(doctor, na.rm = TRUE),
# hospital = sum(hospital, na.rm = TRUE),
# age = mean(age, na.rm = TRUE)) %>%
# rename (settlement = test) %>%
# mutate (settlement = "Totals")
# child_samples_summ$test <- NULL
# child_samples_summary <- rbind (child_samples_summ, child_samples_summ2) %>%
# rename (mean_age = age) %>%
# mutate ('% male' = format(round(gender*100, 1), nsmall = 1),
# age = format(round(mean_age, 1), nsmall = 1)) %>%
# select(settlement, no_visits, no_children, survey, '% male', age,
# cough, breathing, breathing, fever, injury, diarrhea,
# doctor, hospital)
# rm(child_samples_summ, child_samples_summ2)
#
# child_sampling_summary <- full_join(child_samples_summary, feces.summary,
# by = c("settlement" = "settlement_barcode")) %>%
# select(settlement, no_visits, no_children, survey, '% male', age,
# cough, breathing, breathing, fever, injury, diarrhea,
# doctor, hospital, no.feces.kits, no_visits_feces, no_samples)
#
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.