##############################
##############################
#REMOVE HOUSEHOLDS FROM THE HOUSE
##############################
##############################
# departed.hhds = 6
departed.hhds[duplicated(departed.hhds$name_hhd_id_departed),] #no dup
departed.hhds2 <- departed.hhds %>%
select (settlement_barcode, extract_house_no, name_hhd_id_departed, today, hhd_move_settlement_yn, hhd_move_house_no,
hhd_when_departed) %>%
rename(settlement = settlement_barcode,
house.no = extract_house_no,
hhd_id_final = name_hhd_id_departed) %>%
mutate (date_end = dmy(hhd_when_departed)) %>%
select (settlement, house.no, hhd_id_final, date_end, today,
hhd_move_settlement_yn, hhd_move_house_no) %>%
group_by(settlement, house.no, hhd_id_final) %>% #
mutate (count = row_number()) %>%
filter (count==1) %>%
select (-count)
#left the house - add all people to departed list
departed.hhds_list <- left_join(departed.hhds2, people_data_input, by = c("settlement" = "settlement",
"house.no" = "house.no",
"hhd_id_final" = "hhd_id")) %>% #16 people
mutate (file = "hhds_depart")
#moved in to another house - they are departed from this house, but move to another house; add to new list
departed.hhds3 <- departed.hhds2 %>%
filter (hhd_move_settlement_yn==1) %>% #1
rename (house.no_left = house.no, #this is the house number that they DEPARTED
house.no = hhd_move_house_no, # this is their NEW house #
start_date = date_end) #start date at new house
move.hhds_list <- left_join(departed.hhds3, people_data_input, by = c("settlement" = "settlement",
"house.no_left" = "house.no",
"hhd_id_final" = "hhd_id")) %>% #4 people
mutate (file = "hhds_depart")
rm(departed.hhds2, departed.hhds3)
##############################
##############################
#REMOVE PEOPLE from households - survey data, n=46
##############################
departed[duplicated(departed$person.id_departed2),] #no dup
departed2 <- departed %>%
rename(settlement = settlement_barcode,
house.no = extract_house_no,
person_id = person.id_departed2) %>%
mutate (date_end = dmy(when_departed),
died = ifelse(reason_departed_select_6==1, 1, 0),
duplicate = ifelse(reason_departed_select_15==1, 1, 0)) %>%
select (settlement, house.no, hhd_id_final, person_id, name_departed2, date_end, died, duplicate, today) %>%
group_by(person_id) %>% #
mutate (count = row_number(),
file = "departed people") %>%
filter (count==1) %>%
select (-count)
table(duplicated(departed2)) #check for duplicates
#add in people from departed hhds (from above)
departed.hhds_list2 <- departed.hhds_list %>%
rename(name_departed2 = name) %>%
select (settlement, house.no, hhd_id_final, person_id, name_departed2, date_end, today, file)
#add in people that are new because they moved from another house in settlement
departed_new_people <- new_people_all %>%
filter (!is.na(house.no_left)) %>%
select (-extract_house_no, -hhd_id_final) %>%
rename (settlement = settlement_barcode,
house.no = house.no_left, #house # they LEFT
hhd_id_final = hhd_id_left, #previous hhd_id
date_end = date_start,
person_id = person.id,
name_departed2 = name) %>%
select (settlement, house.no, hhd_id_final, name_departed2,
person_id, today, date_end) %>%
mutate (file = "move in from another house in settlement")
departed3 <- bind_rows (departed2, departed.hhds_list2, departed_new_people) %>% #66
arrange (person_id, today) %>%
group_by (person_id) %>%
mutate (no = row_number()) %>%
filter (no==1) %>% #to remove duplicates
select (-no) #62
departed3[duplicated(departed3$person_id),] #no dup
rm(departed.hhds_list, departed2, departed.hhds_list2, departed_new_people)
#moved in to another house - they are departed from this house, but move to another house; add to new list (below)
#remember, if they didn't know house number, they could leave blank.
move.people_list <- departed %>%
filter (move_settlement_yn == 1) %>%
select (-extract_house_no) %>%
rename (settlement = settlement_barcode,
house.no = move_house_no,
name = name_departed2,
person_id = person.id_departed2) %>%
mutate (start_date = dmy(when_departed),
file = "people departed") %>%
select (settlement, house.no, hhd_id_final, today,
name, person_id, start_date)
#######
########
######## OLD CODE
#manually remove people from settlement - add to departed list
#refer to data officer log sheet; also recorded in:
# S:\R-MNHS-SPHPM-EPM-IDEpi\RISE\4. Surveys\3. Objectives\2. ID\3\20190902_O3_stool sampling\2. Data\2. code\T3_stool_sampling_survey_fixes_FB.xlsx
# ########
# #BAROMBONG
#
# #Kg Nelayan, Barombong #2 - duplicate child added at T1; ID=12807
# #previously removed
#
# #Muh April Muh April 12639 Barombong 71 - passed away
# fix1 <- departed2[1,] %>%
# ungroup() %>%
# mutate (settlement = "Kg Nelayan, Barombong", house.no =71, hhd_id ="Nojeng Dg. Beta",
# person_id =12639, date_end =date("2019-03-19"), died =1, duplicate=0)
#
#
# fixes <- bind_rows(fix1, fix2, fix3, fix4, fix5, fix6, fix8, fix9, fix10,
# fix11, fix12, fix13, fix14, fix15, fix16, fix17, fix18,
# fix19, fix20, fix21, fix22) %>% #21 rows
# mutate (name_departed2=NA)
# rm(fix1, fix2, fix3, fix4, fix5, fix6, fix8, fix9, fix10,
# fix11, fix12, fix13, fix14, fix15, fix16, fix17, fix18,
# fix19, fix20, fix21, fix22)
#
# departed3 <- bind_rows(departed2, fixes) %>% #31+21 = 52
# rename(name = name_departed2)
# rm(departed2, fixes)
# departed3[duplicated(departed3$person_id),] #no dup
##########################
##########################
##########################
#NEW PEOPLE
##########################
#new people from INSIDE and OUTSIDE of settlement (done in merge.R)
# new_people_all #86
new_people_all2 <- left_join(new_people_all, person_id,
by = c("settlement_barcode" = "settlement_barcode",
"extract_house_no" = "extract_house_no",
"hhd_id_final" = "hhd_id_final",
"name" = "combined_names")) %>%
mutate (person_id = ifelse(is.na(person.id.x), person.id.y, person.id.x),
today = if_else (is.na(today.x), today.y, today.x)) %>%
rename(settlement = settlement_barcode,
house.no = extract_house_no,
start_date = date_start) %>%
select(settlement, house.no, hhd_id_final, today,
name, person_id, start_date) %>%
mutate (file = "new people move in")
#PERSON departed and went to new house in settlement
# move.people_list
#HOUSEHOLD departed and went to new house in settlement
move.hhds_list2 <- move.hhds_list %>%
ungroup() %>%
select(settlement, house.no, hhd_id_final, today,
name, person_id, start_date, file)
#COMBINE ALL NEW PEOPLE
new_people_list <- bind_rows(new_people_all2, move.people_list, move.hhds_list2) %>% #105
arrange (person_id, today) %>%
group_by (person_id) %>%
mutate (no = row_number()) %>%
filter (no==1) %>% #to remove duplicates
select (-no) #101
new_people_list[duplicated(new_people_list$person_id),] #no dup
rm(new_people_all2, move.hhds_list2, move.people_list)
#3) manually add from data officer log sheet - OLD CODE
#
# #Untia #26 hhd_id=S. Dg. Lili, should be house #27
# #added to departed (above)
# new1 <- new_people2[1,] %>%
# ungroup() %>%
# mutate (settlement = "Kawasan Untia", house.no =27, hhd_id ="S. Dg. Lili",
# person_id =12842, time_pt_start2=date("2019-10-02"), time_pt_start ="ID_201910_O3")
# new2 <- new_people2[1,] %>%
# ungroup() %>%
# mutate (settlement = "Kawasan Untia", house.no =27, hhd_id ="S. Dg. Lili",
# person_id =12851, time_pt_start2=date("2019-10-02"), time_pt_start ="ID_201910_O3")
# fixes <- bind_rows(new1, new2, new3, new4) %>% #4 rows
# mutate (dob=NA,
# gender= NA,
# person_name_age=NA)
# rm(new1, new2, new3, new4)
#
# new_people3 <- bind_rows(new_people2, fixes) %>% #95+4 = 99
# mutate(dob = dmy(dob),
# gender = ifelse(gender == 0, "female",
# ifelse(gender == 1, "male", NA)))
# rm(fixes, new_people2)
# new_people3[duplicated(new_people3$person_id),] #no dup
######################################
#add to list of people from input sheet
# participants_all is full list of people #2857 - input list
##############################
#remove people from households, n=62
people1 <- full_join (people_data_input, departed3, by = c("person_id"="person_id")) %>%
mutate (settlement = ifelse(is.na(settlement.y), settlement.x, settlement.y),
house.no = ifelse(is.na(house.no.y), house.no.x, house.no.y),
hhd_id_final = ifelse(is.na(hhd_id_final), hhd_id, hhd_id_final))
#checks
people2 <- people1 %>%
mutate (check1 = ifelse(settlement.x==settlement.y, 0, 1),
check2 = ifelse(house.no.x==house.no.y, 0, 1),
check3 = ifelse(hhd_id==hhd_id_final, 0, 1))
#the changes in house no and hhd_id - need to make sure they are reflected in final list **
# this needs to be fixed
#checks
table(is.na(people1$date_end)) #62 - good
#
# ##############################
# #add all new people
#
# people2 <- bind_rows (people1, new_people_list) %>% #add 99 = 2920
# mutate (date_start = if_else(is.na(date_start), time_pt_start2, date_start)) %>%
# select (-time_pt_start2) #2920
# rm(people1)
#
# #############################################
# # Updated list of participants at T4 including movement between houses
#
# # write_csv(people2, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190902_O3_stool sampling/2. Data/4. reports/full_person_list_ID.csv")
# #saved 9 Nov 2019 - full list of all participants and movements
#
# #LIST OF PEOPLE STILL IN THE SETTLEMENT
# people5 <- people2 %>%
# filter(is.na(time_pt_end)) %>%
# filter(is.na(date_end)) %>% #2868
# select (-duplicate, -died)
# # **add codes
#
# # check for duplicates
# people5[duplicated(people5$person_id),]
# #0 duplicates ********
#
# # write_csv(people5, path = "S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/3. Objectives/2. ID/3/20190527_O3_4_6mo_survey/3. ID/2. Data/4. reports/person_list_ID.csv")
# rm(people_data_input)
#
#
# #house status - vacant or demolished
# house.status <- hhd %>%
# select (settlement_barcode, extract_house_no, hhd_id, KEY, house_status, today, gift_yn) %>%
# rename (settlement = settlement_barcode,
# house.no = extract_house_no) %>%
# mutate (count = 1) %>%
# spread (house_status, count) %>%
# group_by(settlement, house.no, hhd_id) %>%
# summarize (at_home = ifelse(max('1', na.rm=TRUE)==-Inf, NA, max('1', na.rm=TRUE)),
# demolished = ifelse(max(demolished, na.rm=TRUE)==-Inf, NA, max(demolished, na.rm=TRUE)),
# not_home = ifelse(max(not_home, na.rm=TRUE)==-Inf, NA, max(not_home, na.rm=TRUE)),
# vacant = ifelse(max(vacant, na.rm=TRUE)==-Inf, NA, max(vacant, na.rm=TRUE)),
# withdrawn_activity = ifelse(max(withdrawn_activity, na.rm=TRUE)==-Inf, NA, max(withdrawn_activity, na.rm=TRUE)),
# gift = ifelse(max(gift_yn, na.rm=TRUE)==-Inf, NA, max(gift_yn, na.rm=TRUE)),
# today = max(today))
#
# #manually add
# hfix1 <- house.status[1,] %>%
# ungroup() %>%
# mutate (settlement = "Kg Bambu-Bambu, Jl Birta", house.no =24, hhd_id ="Jumakari",
# at_home = NA , demolished = 1, not_home=NA, vacant=NA, withdrawn_activity=NA, gift=NA, today=NA)
# hfix2 <- house.status[1,] %>%
# ungroup() %>%
# mutate (settlement = "Kawasan Untia", house.no =58, hhd_id ="Ramlah Gading",
# at_home = NA , demolished = NA, not_home=NA, vacant=1, withdrawn_activity=NA, gift=NA, today=NA)
#
# fixes <- bind_rows(hfix1, hfix2) #2 rows
# rm(hfix1, hfix2)
#
# house.status2 <- bind_rows(house.status, fixes) #268+2 = 270
# rm(house.status, fixes)
#
#
#
#
#
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.