In Monash-RISE/riseR:

setwd("S:/R-MNHS-SPHPM-EPM-IDEpi/RISE/4. Surveys/Code/RISE-R/RISE_ID/T4_annual_survey")

library (tidyverse)
library (lubridate)
library (kableExtra)
library (tinytex)

knitr::opts_chunk$set(echo = TRUE, warning=FALSE) #this stops warnings from displaying in html
source("O3_T4_ID-summary_FB.R")

Introduction

The objective 3 & 4 annual survey commenced in Indonesia on r min(hhd$today) and the most recent survey was completed on r max(hhd$today). The report is divided into adult and child surveys and child feces sampling:

Each household was approached up to 3 separate times to collect survey data.

Sampling Overview

Sampling Activities Per Site

kable(Table1) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)

'Visits' = # of household visits '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 'House_status' = # visits when someone was home 'Survey' = # completed surveys

Feces Sampling Summary

kable(Table2) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)

Household Survey

Field workers have completed a total of r nrow(hhd) visits (including all return/repeat visits), for an average of r round((nrow(hhd)/nrow(hhds.visited)), digits=2) visit(s) per household. A total of r sum(hhd$house_status == 1) households have started the annual survey, across all 12 settlements.

Within the houses visited, there were r nrow(hhd.new) new households, r nrow(hhd.move.in) households moved from other houses within the settlement and r nrow(departed.hhds) households that had moved out of the houses.

Across the r sum(hhd$house_status == 1) households that started the annual survey, r nrow(departed3) individuals have left their current household and r nrow(new_people_list) individuals have moved into a household in the RISE study. Additionally, a total of r nrow(feces_kit2) feces kits were handed out.

r sum(!is.na(hhd$CE_exoassist)) annual surveys have been fully completed while r sum(hhd$house_status == 1 & is.na(hhd$CE_exoassist)) surveys are incomplete. There have been r sum(hhd$house_status == "not_home" | hhd$house_status == "vacant") surveys that were not started because nobody was home, no one was available to complete the survey, or the household was vacant. There have been r sum(hhd$house_status == "withdrawn_activity" | hhd$house_status == "withdrawn_RISE") withdrawals so far. The remaining r sum(hhd$house_status == "demolished" | hhd$house_status == "flooded") surveys have been recorded as demolished or flooded.

ggplot (hhd_survey_complete, aes (x = settlement_barcode, y = survey)) +
  geom_bar (stat = "identity") + 
  xlab ("Settlement") + ylab ("# annual surveys completed") +
  theme_minimal () + #remove grey background
  theme (panel.grid = element_blank (),              # No underlying grid lines
         axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) +  # rotated x-axis text 
  ggtitle("Fig 1: Number of annual surveys - by settlement")  # Number of annual surveys completed in each community

Child Survey

A total of r sum(!is.na(child_loop$cough)) child surveys have been completed across all 12 settlements. There were r sum(child_loop$child_no_survey, na.rm=TRUE) cases where the caregiver selected not to complete the child survey.

kable(Table3) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)

Feces Samples

A total of r nrow(feces_kit2) feces kits have been delivered to households. There have been r nrow(feces) feces collection visits and r sum(!is.na(feces_pickup_merge$feces_barcode_final)) feces samples have been collected across all 12 settlements for an average of r round(nrow(feces)/sum(!is.na(feces_pickup_merge$feces_barcode_final)), digits=1) visit(s) per sample collected.

ggplot (samples, aes (x = settlement_barcode, y = samples)) +
  geom_bar (stat = "identity") + 
  xlab ("settlement") + ylab ("# faecal samples") +
  theme_minimal () + #remove grey background
  theme (panel.grid = element_blank (),              # No underlying grid lines
         axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) +  # rotated x-axis text 
  ggtitle("Fig 2: Number of feces samples collected - by settlement")  # Number of feces samples collected in each community

Survey Length

On average, surveys took r round(mean(survey_time$dur15), digits = 1) minutes to complete (min=r round(min(survey_time$dur15), digits = 1), max=r round(max(survey_time$dur15), digits = 1)) and the Objective 5 questions took r round(mean(o5$dur), digits = 1) minutes to complete (min=r round(min(o5$dur), digits = 1), max=r round(max(o5$dur), digits = 1)).

LIMS Data:

Feces QC Check

Checking for kits that were given to one household and returned in another. This may occur when the feces transporter enters the wrong house number at pick-up when houses are very close together (i.e. house barcode not scanned), or caregivers switch feces kits by accident with another caregiver.

r sum(feces.compare_final$check_settlement==1 | feces.compare_final$check_house_no==1) kits that appear to be mismatched: r feces.compare_final2 <- feces.compare_final %>% filter(check_settlement==1 | check_house_no==1)

kable(feces.compare_final2) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

Field and LIMS Feces QC: Feces given out in field, picked up, but never returned to lab. Consider if these feces samples were expired and never processed at laboratory.

I have found r nrow(feces_check2) cases where feces kits were given out in the field, picked up with feces, but never returned to the lab.

kable(feces_check2) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

Field and LIMS Feces QC: Feces kits given out in field, never reported picked up or returned to lab. Kits that have a distrubtion date near the date of this report may still be in circulation and are pending pick-up. Kits that are older than 5 days were likely returned empty and still appear on this list.

I have found r sum(!is.na(feces_check$date.handout) & is.na(feces_check$date.pickup) & is.na(feces_check$Date_receipt)) cases where feces kits were given out in the field and never picked up or returned to the lab:

kable(feces_check3) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

Field and LIMS Feces QC: Feces returned to lab, never reported given out in field.

There are r sum(is.na(feces_check$date.handout) & !is.na(feces_check$Date_receipt)) cases where feces kits were returned to the lab but reportedly never given out in the field:

kable(feces_check4) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

Field and LIMS Feces QC: Feces returned to lab, never reported picked up by transporter.

There are r sum(is.na(feces_check$date.pickup) & !is.na(feces_check$Date_receipt)) cases where feces kits were returned to the lab but reportedly never picked up by the transporter:

kable(feces_check5) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

LIMS Feces QC: human feces registered at sample reception but no corresponding feces aliquot sample.

I have found r sum(is.na(feces_aliquot$Date_process)) cases where a feces sample was registered at sample reception but no feces aliquot sample was found:

r feces_aliquot_final <- feces_aliquot %>% filter (is.na(Date_process)) %>% select (Barcode_sample, Date_receipt, Sample_type, Date_process, Barcode_aliquot1, Volume_aliquot1, Cryobox1) %>% rename (Sample_reception_date = Date_receipt)

kable(feces_aliquot_final) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

LIMS KK1 and KK2 QC: number of KK1 samples equal number of KK2 samples.

I have found r sum(is.na(feces_kk$date.kk1) | is.na(feces_kk$date.kk2)) cases where the number of KK1 samples does not equal the number KK2 samples:

r feces_kk_QC <- feces_kk %>% filter (is.na(feces_kk$date.kk1) | is.na(feces_kk$date.kk2)) %>% select (Barcode_sample, Date_receipt, Sample_type, Barcode_kk_slide, date.kk1, date.kk2) %>% rename (Sample_reception_date = Date_receipt, KK1_date = date.kk1, KK2_date = date.kk2)

kable(feces_kk_QC) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

LIMS KK1 and Mac1 QC: number of KK1 and Mac1 samples correspond to human feces aliquot entered into sample reception.

I have found r sum(is.na(aliquotQC$Barcode_kk_slide) | is.na(aliquotQC$Barcode_macconkey)) cases where there is no KK1 sample or Mac1 sample that corresponds with a feces aliquot barcode number:

r aliquotQC_final <- aliquotQC %>% filter(is.na(aliquotQC$Barcode_kk_slide) | is.na(aliquotQC$Barcode_macconkey))

kable(aliquotQC_final) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

LIMS Mac1 and Mac2 QC: number of Mac1 samples equal number of Mac2 samples.

I have found r sum((is.na(feces_mac$Date_process.y) | is.na(feces_mac$Date_process.x)) - (is.na(feces_mac$Date_process.y) & is.na(feces_mac$Date_process.x))) cases where the number of Mac1 samples does not equal the number Mac2 samples:

r mac_temp <- feces_mac %>% filter(is.na(feces_mac$Date_process.y) | is.na(feces_mac$Date_process.x))

r feces_mac_QC <- mac_temp %>% filter (!is.na(mac_temp$Date_process.x) | !is.na(mac_temp$Date_process.y)) %>% select (Barcode_sample, Date_receipt, Sample_type, Barcode_macconkey, Date_process.x, Date_process.y) %>% rename (Sample_reception_date = Date_receipt, Mac1_date = Date_process.x, Mac2_date = Date_process.y)

kable(feces_mac_QC) %>%
   kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed",     "responsive"), full_width = F)

Monash-RISE/riseR documentation built on Dec. 11, 2019, 9:49 a.m.