InterimDataTool/Tool_files/Analysis_FMS_Upload_v1u1-csv.Rmd

---
output:
  pdf_document:
    includes:
      in_header: styles.tex
    number_sections: TRUE
    latex_engine: xelatex
    fig_caption: yes
    fig_width: 4
    fig_height: 3
    keep_tex: TRUE
header-includes:
  - \usepackage{titling}
  - \setlength{\droptitle}{5em} 
papersize: a4paper
fontsize: 11pt
mainfont: Calibri
geometry: margin = 3cm
subparagraph: TRUE
graphics: yes
bibliography: References.bib
csl: apa.csl
link-citations: yes
params:
  mainFile: "DEMO_DATA_R9/ESS9CFe03_DE.csv"
---

```{r setup, include = FALSE, error=T}
library(knitr)
library(kableExtra)

knitr::opts_chunk$set(echo = FALSE, results = "hide", message = FALSE, dev = "cairo_pdf", warning = FALSE)
knitr::opts_chunk$set(fig.pos = 'H')

options(knitr.table.format = "latex", knitr.kable.NA = "")

Sys.setlocale("LC_ALL","English")
```

```{r setup2, include = FALSE, error=T}

library(here) 
library(foreign)
library(dplyr)
library(psych)
library(ggplot2)
library(lubridate)
library(wesanderson)
library(colortools) # adjacent works
library(ggthemes) # theme_tufte works
library(varhandle) # coercing factor to numeric variables
library(naniar) # for replacing values with missings
library("Gifi") #Implements categorical principal component analysis
library(matrixStats) #High-performing functions operating on rows and columns of matrice
library(cowplot)
library(tibble)
library(reshape2) #!new in tool for FMS @May

# for tables
library(knitr)
library(kableExtra)
library(formattable) #!new in tool for FMS @May

```

```{r fuctions, error=T}
#Utility functions
source("Utility functions.R")

## More functions
# Response Rate, Non-contact Rate, Refusal Rate, Coop-rate
r1 <- function(net,gross,i) { (net / (gross - i))*100 }
# Rate of Ineligibles
r2 <- function(net,gross){ (net/gross)*100 }

```

```{r theme, error=T}
ESSred <- rgb(.91, .20, .32)
ESSgreen <- rgb(.14, .62, .51)
ESSblue <- rgb(0, .25, .48)
  
ESSColors <- unique(c(adjacent(ESSred, plot = F), square(ESSred, plot = F)))

ESSColors <- c(ESSColors, ESSgreen, ESSblue)
#pizza(ESSColors)

themeESS <- theme_tufte(base_size = 9, base_family = "Calibri") +
    theme(axis.title = element_text(size = 9, face = "plain"),
          axis.text = element_text(size = 9),
          axis.line.x = element_line(),
          plot.title = element_blank(),
          legend.title = element_blank(),
          legend.text = element_text(size = 9),
          strip.text = element_text(size = 9, face = "bold"),
          legend.position = "none",
          legend.direction = "horizontal",
          legend.box = "vertical",
          legend.spacing = unit(0, "line"),
          legend.key.size = unit(.75, "line"))
linebreak <- "\\hspace{\\textwidth}"
```

\newpage
\FloatBarrier
\pagenumbering{gobble}

```{r child = "Titlepage_upload.Rmd", error=T}
```

\pagenumbering{arabic}

\setcounter{tocdepth}{2}
\tableofcontents
\listoftables
\listoffigures

# Introduction {-}

```{r getdata, error=T}

# CF data from Upload Portal with Inwer ID (intnum). Use either params.
  #@May, please change after UI adjustment if necessary
CF <- read.csv2(params$mainFile,  sep = ",", dec=".", stringsAsFactors=F)

#Test - 
#CF <- read.csv2("FMMS_Export_Cases_Slovenia_20210211094405.csv", sep = ",", dec=".", stringsAsFactors=F)

```

```{r fms_metaifno, error=T}
#FMS version
FMSv <- "FMS Upload Portal"
```

```{r countrynames, error=T}
#read country specific data (for variable Country)
Country <- read.csv2("Country names and codes.csv", dec = ".", stringsAsFactors = F) # !Alert! if new country, add country

#This country
CF <- left_join(CF, Country, by = "cntry")
thisCountry <- unique(CF$CountryName)

```

This report presents the results of the analysis of the `r FMSv` for `r thisCountry`. It aims to help national teams to detect interviewer-related issues in the field based on the Contact Forms data. It also provide some information of other indicators from the fieldwork progress which are currently not included in the web version of the FMS.

The indicators presented in the report are saved as CSV files in the “Annex” folder that can be found within the tool. As it is not always possible to read all the information or details directly from the figures, this allows everyone to inspect the source files and use the indicators for further analysis if necessary. 

It should be noted that the FMS Upload Portal has some limitations due to the restriction of the data to weekly uploads. It does not include information on each contact attempt. Therefore some indicators had to be adapted (e.g. the algorithm for outcome codes) or excluded from the report. Some differences with final indicators after data deposit should be expected.

The report is divided into two sections. The first section presents an overview of the state of fieldwork using indicators for all sample units. The section \ref{sec:level1indicators} focuses on interviewer level indicators for cases that are currently assigned to each interviewer. 

Each section includes an explanation on the meaning of the indicator and how is calculated (if applicable). Explanation on how the indicators can be useful to monitor interviewer behaviour are also included, although this are by not means exhaustive. The usefulness of indicators will also depend on the specific characteristics of the fieldwork of the countries as well as the stage and the evolution of fieldwork.

It is recommended to view these indicators as complementary to the information coming from the field and as complementary to each other. They help gain further insights into activities in the field. They do not explain the reasons for deviations or extreme values. It is recommended to discuss the results with colleagues and view the indicators in conjunction with other information available on the fieldwork. 


# Overview of fieldwork {#sec:fiedlworkoverview}

Before inspecting the work conducted by the interviewers, it is recommended to view the overall state of fieldwork. This allows contextualize the work of interviewer in the field . This section provides further indicators on the state of the fieldwork compared to those available in the FMS website.  


```{r Varsprep, error=T}

#Change variable names
CF$resulb <- CF$case_resulb 
CF$outnic <- CF$case_outnic 
CF$intnum <- CF$iwer_human_identifier
CF$dateresult <- CF$case_lastoutcome_date
CF$nattempts <- CF$case_ntimes_visited
CF$nvisits <- CF$case_ntimes_visited_face
CF$lastattempt.modeall <- CF$case_lastoutcome_mode

#Add main indicators
CF$lastattempt.mode  <- ifelse(CF$lastattempt.modeall %in% c(1,3), "Personal visit",
                            ifelse(CF$lastattempt.modeall %in% 2, "Telephone",
                                   ifelse(CF$lastattempt.modeall %in% 5, "Video",
                                          ifelse(CF$lastattempt.modeall %in% c(4,6), "Other", NA))))

#Anyrefusal & Ref min code
CF_ref <- dplyr::select(CF, starts_with("outnic"))
CF$anyrefusal <- ifelse(apply(CF_ref, 1, function(r) any(r %in% c(2:4))),"Yes","No")
CF_ref$anyrefusal <- ifelse(apply(CF_ref, 1, function(r) any(r %in% c(2:4))),"Yes","No")
CF_ref <- dplyr::rowwise(CF_ref) %>%
  dplyr::mutate(min())

#CF_ref$min <- ifelse(CF_ref$anyrefusal == "Yes", apply(CF_ref, 1, FUN=min, na.rm=TRUE), NA)
#CF_ref$min <- as.integer(CF_ref$min) + 30
CF$anyrefcode <- ifelse(CF_ref$anyrefusal == "Yes", as.integer(apply(CF_ref, 1, FUN=min, na.rm=TRUE)) + 30, NA)


```


```{r OutcomeSetup1, error=T}
# - Calculate final outcome  - FMS


CF$finalcode <- NA
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb == 1, 10, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb == 2, 11, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 1, 31, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 2, 32, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 3, 33, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 4, 34, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 5, 41, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 6, 42, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 7, 46, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 8, 43, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 9, 51, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 10, 52, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 11, 53, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 12, 44, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb %in% c(3, 4, 5, 8) & CF$outnic == 13, 45, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb == 6, 20, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb == 6 & CF$anyrefusal == "Yes", CF$anyrefcode, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, 
                              ifelse(CF$resulb == 7, 61, NA))
CF$finalcode <- ifelse(!is.na(CF$finalcode), CF$finalcode, ifelse(is.na(CF$finalcode), 0, NA))


# Final code based on the NTS 
CF$NTSoutcome <- NA
CF$NTSoutcome <- ifelse(CF$finalcode == 0, "-: No contact attempted yet", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode %in% c(10,11), "X: (partial) Interview", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode ==30, "D: Refusal because of drop out list", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode %in% c(31,41,45), "H: Broken appointment, respondent unavailable, no interviews for other reasons", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode ==32, "B: Refusal by respondent", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode %in% c(33,34), "C: Refusal by proxy or before selection", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode %in% c(42,46), "G: Mentally / physically unable / ill / sick (short and long term)", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode ==43, "N: R deceased", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode ==51, "M: R moved out of the country", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode %in% c(20,52,53), "E: Noncontact or moved to unknown destination or still in country", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode ==44, "F: Language barrier", CF$NTSoutcome)
CF$NTSoutcome <- ifelse(CF$finalcode ==61, "L: Ineligible (with address not tracable)", CF$NTSoutcome)


#### Function: Overall, aggregated disposition codes ####

AggregateDispositioncodes <- function(CFdat, codename = "finalcode"){
  finalcode <- unlist(CFdat[codename])
  
  code.aggr <- ifelse(finalcode == 10, "INT",
                      ifelse(finalcode == 20, "NC",
                             ifelse(finalcode %in% c(30, 32, 33, 34), "REF",
                                    ifelse(finalcode %in% c(11, 12, 31, 41, 42, 44, 45, 46, 52, 53, 54), "OTH",
                                           ifelse(finalcode %in% c(43, 51, 61, 62, 63, 64, 65, 67), "INELIG",
                                                  ifelse(finalcode %in% c(0, 88), "UND", NA))))))
  
  code.aggr
}

CF$finalcodeaggregated <- AggregateDispositioncodes(CF, codename = "finalcode")


CF$finalcodeaggregated.raw <- CF$finalcodeaggregated
CF <- CF %>%
  dplyr::mutate(finalcodeaggregated=dplyr::recode(finalcodeaggregated,
                                                  "INT" = "Complete and valid interview",
                                                  "NC" = "No contact",
                                                  "REF" = "Refusal",
                                                  "OTH" = "Not able and other nonresponse",
                                                  "INELIG" = "Ineligible",
                                                  "UND" = "Undefined"))

CF_main <- CF[,c("cntry", "Country", "idno", "intnum", "finalcode", "finalcodeaggregated", 
                         "dateresult","lastattempt.mode", "nattempts", "nvisits")]
names(CF)
```

## Outcome breakdown {#sec:outcomebreakdown}

This section provides a breakdown of the outcome code distribution calculated using the simplified version of the ESS algorithm for final outcome code. The simplified algorithm does not fully account for the contact history. It relies on the outcome of the last contact attempt to calculate the outcome codes. 

In order to maximize the value of the partial contact history provided by weekly uploads, any refusal recorded at the last contact attempt from previous weeks have been given priority over non-contacts. Furthermore, refusals by the respondents are prioritized over refusals by proxy, and the latter prioritized over refusal by an undefined person. However, we should expect an underestimation of refusal over other forms of non-response compared to the final outcome codes.  

Furthermore, the simplified algorithm does not prioritize other forms of contact over non‐contacts on the last contact attempt. We can expect non‐contacts in this report to be somewhat overestimated compared to the final outcome codes (coded as non‐contact instead of some other non‐response). 

Finally, the algorithm applied to the FMS has been slighted modified to only considers information from the contact attempts. Therefore, this adapted version of the algorithm does prioritize information coming from the survey administration office over the information provided by interviewers. So, for example, if a sample unit has been incorrectly recorded as a refusal by the interviewer in the contact forms, but it was actually an interview, we would not be able to detect this change unless data on the contact attempts are corrected. Same applies for the invalidation of interviews by the survey agency, which are not reflected as a contact attempts, but instead recorded as an outcome but the survey agency or the Archive. This could result in slight variations of the outcome distribution using the final outcome codes after data deposit.

From the `r length(CF$idno)` cases in the file from `r thisCountry`, a total of  `r length(!is.na(CF$finalcode))` cases had some contact information available that that allowed to calculate their outcome code. 

Table \ref{tab:Outcomebreakdown_tab} shows the distribution of the outcome codes for `r thisCountry` based on the data uploaded to the FMS. These are grouped within their respective classification used for calculation of the outcome rates in the ESS.


```{r OutcomeTable, error=T}

names(CF)
#Outcome variables only
CF_outcome <- CF_main[,c("cntry", "Country", "idno", "intnum", "finalcode", "finalcodeaggregated", 
                         "dateresult","lastattempt.mode", "nattempts", "nvisits")]


# Information on all final codes
allfinalcodes <- read.csv2("Final codes.csv", dec = ".", stringsAsFactors = F) # !Alert! check if codes have changed

## Helpers to avoid missing finalcodes#

### Country
# vector with all countries
cntries <- unique(CF_outcome$cntry)
### Finalcodes
# how many countries x are included?
count_countries <- length(unique(CF_outcome$cntry))
# how many finalcodes y are included?
count_finalcode <- length(unique(allfinalcodes$code))
# repeat each country y times
Country_finalcode <- rep(cntries, each=count_finalcode)
Country_finalcode <- as.data.frame(Country_finalcode)
Country_finalcode <-  dplyr::rename(Country_finalcode, Country=Country_finalcode)
# repeat allcodes x-times
allcodes <- allfinalcodes %>% slice(rep(row_number(), count_countries))
# merge countries to codes
allcodes <- bind_cols(allcodes, Country_finalcode)
### Finalcodesaggregated
# how many finalcodeaggregated z are included?
count_aggregated <- length(unique(allfinalcodes$aggregated))
# repeat each country z times
Country_aggregated <- rep(cntries, each=count_aggregated)
Country_aggregated <- as.data.frame(Country_aggregated)
Country_aggregated <-  dplyr::rename(Country_aggregated, Country=Country_aggregated)
#repeat allcodesaggregated z-times
allcodesaggregated <- as.data.frame(unique(allfinalcodes$aggregated))
allcodesaggregated <- allcodesaggregated %>%
  dplyr::rename(code=`unique(allfinalcodes$aggregated)`) %>%
  arrange(code) %>%
  slice(rep(row_number(), count_countries))
allcodesaggregated <- bind_cols(allcodesaggregated, Country_aggregated)


## finalcode##
CF_outcome_finalcode_n <- CF_outcome %>% 
  dplyr::group_by(cntry) %>% 
  dplyr::count(finalcode) %>%
  dplyr::rename(Freq=n, Country=cntry, code=finalcode) %>%
  dplyr::right_join(allcodes,CF_outcome,by=c("Country","code")) %>%
  dplyr::mutate(Freq = ifelse(is.na(Freq), 0, Freq)) %>%
  dplyr::mutate(code=as.character(code)) %>%
  dplyr::mutate(classification="finalcode", type="n") 

CF_outcome_finalcode_prob <- CF_outcome %>% 
  dplyr::group_by(cntry) %>% 
  dplyr::count(finalcode) %>%
  dplyr::mutate(Freq = prop.table(n)) %>%
  dplyr::select(-n) %>%
  dplyr::rename(Country=cntry, code=finalcode) %>%
  dplyr::right_join(allcodes,CF_outcome,by=c("Country","code")) %>%
  dplyr::mutate(Freq = ifelse(is.na(Freq), 0, Freq)) %>%
  dplyr::mutate(code=as.character(code)) %>%
  dplyr::mutate(classification="finalcode", type="prop") 

# finalcodeaggregated #

CF_outcome_finalcodeaggregated_n <- CF_outcome %>% 
  dplyr::group_by(cntry) %>% 
  dplyr::count(finalcodeaggregated) %>%
  dplyr::rename(Freq=n, Country=cntry, code=finalcodeaggregated) %>%
  dplyr::right_join(allcodesaggregated,CF_outcome,by=c("Country","code")) %>%
  dplyr::mutate(Freq = ifelse(is.na(Freq), 0, Freq)) %>%
  dplyr::mutate(code=as.character(code)) %>%
  dplyr::mutate(classification="finalcodeaggregated", type="n") 

CF_outcome_finalcodeaggregated_prop <- CF_outcome %>% 
  dplyr::group_by(cntry) %>% 
  dplyr::count(finalcodeaggregated) %>%
  dplyr::mutate(Freq = prop.table(n)) %>%
  dplyr::select(-n) %>%
  dplyr::rename(Country=cntry, code=finalcodeaggregated) %>%
  dplyr::right_join(allcodesaggregated,CF_outcome,by=c("Country","code")) %>%
  dplyr::mutate(Freq = ifelse(is.na(Freq), 0, Freq)) %>%
  dplyr::mutate(code=as.character(code)) %>%
  dplyr::mutate(classification="finalcodeaggregated", type="prop") 

## Combine cases   ###

CF_outcome_breakdown <- dplyr::union_all(CF_outcome_finalcode_n, CF_outcome_finalcode_prob) %>%
  dplyr::union_all(., CF_outcome_finalcodeaggregated_n) %>%
  dplyr::union_all(., CF_outcome_finalcodeaggregated_prop) %>%
  arrange(classification,type,code,Country)

# add country names to dataset ##
CF_outcome_breakdown <- left_join(CF_outcome_breakdown, Country, by = c("Country"="cntry")  , all = TRUE, sort = FALSE)
CF_outcome_breakdown <- CF_outcome_breakdown %>%
  ungroup() %>%
  select(-c(Country, CountryName)) %>%
  dplyr::rename(Country=Country.y)

```


```{r Outcomebreakdown_tab, results = "asis", error=T}

OutcomeCodes <- CF_outcome_breakdown[,c("code", "Country", "Freq", "classification", "type", "label", "aggregated", "NTS")]

## Outcome breakdown table
temp <- merge(reshape2::dcast(subset(OutcomeCodes, classification == "finalcode"), code ~ type, # !Alert! change country
                              value.var = "Freq") %>%
                mutate(code = as.numeric(as.character(code))), 
              allfinalcodes, by = "code", all.y = T) %>%
  mutate(aggregated = factor(aggregated, levels = c("Complete and valid interview",
                                                    "No contact",
                                                    "Refusal",
                                                    "Not able and other nonresponse",
                                                    "Ineligible",
                                                    "Undefined")))
#temp$n[is.na(temp$n)] <- 0
#temp$prop[is.na(temp$prop)] <- 0
temp <- temp[order(temp$aggregated),]
temp <- temp[,c("code", "label", "n", "prop")]
temp$code <- with(temp, as.character(code))

kable(rbind(temp, sumrow(temp)) %>% mutate(prop = formattable::percent(prop)), # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      col.names = c("", "", "n", "%"), 
      caption = paste("\\label{tab:Outcomebreakdown_tab} Detailed breakdown of current FMS response outcomes (simplified algorithm),",
                      thisCountry))  %>% # !Alert! change country
  kable_styling(latex_options = c("HOLD_position")) %>%
  column_spec(2, width = "9cm")  %>%
  kableExtra::group_rows(index = c("Complete and valid interview" = 1, "No contact" = 1, "Refusal" = 4, "Not able and other nonresponse" = 11, "Ineligible" = 8, "Undefined" = 2, "Total sample units" = 1)) 
#%>%
#footnote(general = FMS)
```

\newpage

## Overview of outcome rates {#sec:overviewrates}

The outcome rates are calculated based on outcome code presented in the previous section. Table \ref{tab:rates_tab} shows the outcome rates, the definition for how they are calculated and the reference to their equivalent in the AAPOR Standards [@aapor2016].   

```{r rates, results = "asis", error=T}

#Calcualte rates
NGROSS <- as.numeric(nrow(CF_main))
OutcomeAggregated <- with(CF_main, data.frame(table(finalcodeaggregated)))
INT <- as.numeric(nrow(CF_main[CF_main$finalcodeaggregated == "Complete and valid interview",]))
INELIG <- as.numeric(nrow(CF_main[CF_main$finalcodeaggregated == "Ineligible",]))
NC <- as.numeric(nrow(CF_main[CF_main$finalcodeaggregated == "No contact",]))
REF <- as.numeric(nrow(CF_main[CF_main$finalcodeaggregated == "Refusal",]))
INTPREF <- INT + REF + as.numeric(nrow(CF_main[CF_main$finalcode == 11,]))

rr <- r1(INT,NGROSS,INELIG)
ri <- r2(INELIG, NGROSS)
refr <- r1(REF, NGROSS, INELIG)
coopr <- r2(INT, INTPREF)
ncr <- r1(NC, NGROSS, INELIG)


#Create table for rates
a <- c("Response Rate", 
       "Refusal Rate", 
       "Cooperation Rate", 
       "Non-Contact Rate", 
       "Rate of Ineligibles")

b <- c("rr", 
       "refr", 
       "coopr", 
       "nonr", 
       "ri")

c <- c(rr,refr,coopr,ncr,ri)

d <- c("Interviews / (Gross sample - Ineligibles)", 
       "Refusals / (Gross sample - Ineligibles)", 
       "Interviews / (Interviews + Partial Interviews + Refusals)", 
       "Non-contacts / (Gross sample - Ineligibles)", 
       "Ineligibles / Gross sample")

e <- c("RR1", 
       "REF1", 
       "COOP3", 
       "1 - CON1", 
       ".")

rates <- data.frame(a,c,d,e) %>% 
  dplyr::rename(rates = a,
                value = c,
                definitions = d,
                AAPOR_Standard = e)
#Plot
kable(rates,
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:rates_tab} Outcome rates,", thisCountry))  %>% 
  kable_styling(latex_options = c("HOLD_position")) %>%
  column_spec(3, width = "10em")
  

```
\newpage

## Contacting sample units {#sec:contacting}

Figure \ref{fig:nca_plot} shows how many contacts attempts have been made to the sample units so far. Figure \ref{fig:npv_plot} focused on only on personal visits made to the sample units

```{r ca, error=T}

ncainfo <- as.numeric(count(!is.na(CF_main$attempts)))

```


```{r nca_plot, fig.width = 7, fig.cap = paste("\\label{fig:nca_plot} Contact attempts to sample units"), fig.scap="Contact attempts to sample units", error=T}

## Cases plot
ggplot(CF_main %>% 
         mutate(nattempts), 
       aes(x = nattempts, fill = nattempts < 1)) +
  geom_bar(col = "white") +
  scale_x_continuous(name = "Number of contact attempts", breaks = seq(0, max(CF_main$nattempts), 1)) +
  scale_y_continuous(name = "Sample units") +
  expand_limits(x = c(0, max(CF_main$nattempts))) +
  scale_fill_manual(values = c("FALSE" =  ESSColors[8], 
                               "TRUE" = "gray")) +
  themeESS

```


```{r npv_plot, fig.width = 7, fig.cap = paste("\\label{fig:npv_plot} Personal visits to sample units"), fig.scap="Personal visits to sample units", error=T}

## Cases plot
ggplot(CF_main %>% 
         mutate(nvisits), 
       aes(x = nvisits, fill = nvisits < 1)) +
  geom_bar(col = "white") +
  scale_x_continuous(name = "Number of personal visits", breaks = seq(0, max(CF_main$nvisits), 1)) +
  scale_y_continuous(name = "Sample units") +
  expand_limits(x = c(0, max(CF_main$nvisits))) +
  scale_fill_manual(values = c("FALSE" =  ESSColors[8], 
                               "TRUE" = "gray")) +
  themeESS

```

## Mode of contact attempts {#sec:modeca}

Observing the mode of contact attempts provides a better understanding of how fieldwork activities are being conducted and allows checking compliance with the ESS Specification.
Due to the limitation of the data on contact attempts in the FMS Upload Portal, only the information on the mode of the last contact attempt is available. Figure \ref{fig:modelastca_plot} shows the mode of the last contact attempt to the sample units.

```{r modeca, error=T}

modelastca <- with(CF_main, data.frame(prop.table(table(lastattempt.mode))))
nmodelastca <- as.numeric(count(!is.na(CF$lastattempt.mode)))

```


```{r modelastca_plot, fig.width = 7, fig.height = 1.5, fig.cap = paste("\\label{fig:modelastca_plot} Mode of last contact attempt"), fig.scap="Mode of last contact attempt", error=T}

## Cases plot
ggplot(modelastca,aes(x = 1, y = Freq, fill = lastattempt.mode)) +
  geom_bar(stat = "identity", col = "white") +
  coord_flip() +
  scale_y_continuous(breaks = seq(0, 1, .1), limits = c(0, 1), labels = scales::percent) +
  themeESS +
  theme(axis.title = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.line.x = element_line(),
        legend.position = "bottom",
        legend.direction = "vertical")

```

## Non-contacts {#sec:nnonc}

The ESS Specifications indicate that sample units need to be visited at least four times in person before can be abandoned as ‘non‐productive.’ Personal visits are even more relevant, if no contact at all has been achieved with the sample unit yet (the definition of non‐contacts in the ESS algorithm for outcome codes). Investing the necessary effort in contacting sample units is fundamental for achieving the best results in the field.

Figure \ref{fig:pv2nc_plot} shows the number of personal visits conducted to cases currently considered as non‐ contacts. Non‐contacts with less than 4 personal shown in grey. To provide a broader view to the contacting efforts made to non‐contacts so far, figure \ref{fig:ca2nc_plot} shows the distribution of non-contacts based on the number of contact attempts made to them.

```{r ca2nc, error=T}
nnc <- as.numeric(count(CF$finalcode== 20))
```


```{r pv2nc_plot, fig.width = 7, fig.cap = paste("\\label{fig:pv2nc_plot} Personal visits to non-contacts",  linebreak, "Note:", "n =", nnc), fig.scap="Personal visits to non-contacts", error=T}

## Cases plot
ggplot(subset(CF_main, finalcode == 20) %>% 
         mutate(nvisits), 
       aes(x = nvisits, fill = nvisits >= 4)) +
  geom_bar(col = "white") +
  scale_x_continuous(name = "Number of personal visits", breaks = seq(0, max(CF_main$nvisits), 1)) +
  scale_y_continuous(name = "Number of non-contacts") +
  expand_limits(x = c(0, max(CF_main$nvisits))) +
  scale_fill_manual(values = c("FALSE" = "grey", 
                               "TRUE" = ESSColors[8])) +
  themeESS

```


```{r ca2nc_plot, fig.width = 7, fig.cap = paste("\\label{fig:ca2nc_plot} Contact attempts to non-contacts",  linebreak, "Note:", "n =", nnc), fig.scap="Contact attempts  to non-contacts", error=T}

## Cases plot
ggplot(subset(CF_main, finalcode == 20) %>% 
         mutate(nattempts), 
       aes(x = nattempts)) +
  geom_bar(col = "white") +
  scale_x_continuous(name = "Number of contact attempts", breaks = seq(0, max(CF_main$nattempts), 1)) +
  scale_y_continuous(name = "Number of non-contacts") +
  expand_limits(x = c(0, 20)) +
  themeESS


```

## Interviewer workforce {#sec:workforce}

Currently `r length(unique(CF$intnum))` interviewers have sample units assigned to them in the FMS Upload Portal. `r length(unique(CF[CF$nattempts>0,]$intnum))` interviewers carried out at least one contact attempt on any of their assigned cases. 
Due to the limitations of the FMS it is not possible to know whether there were other interviewer engaged in fieldwork activities outside those currently showns as having assigned cases.

\newpage

# Interviewer indicators based on current assignment {#sec:level1indicators}

In this section, we look at indicators at the interviewer level based on the current assignment of cases. For this, we assume that the interviewer that conducted the last contact attempt to a sample unit is responsible for fieldwork activities related to the case. 

We look at the distribution of cases currently assigned to interviewers, the response rate, refusal rate per interviewer and the non-contacts per interviews.


```{r IwerIndicators1, error=T}

#### Iwer Indicators based on Last Attempt - QI1 ####

# N cases currently assigned to interviewers
IwerCurrentWork <- aggregate(idno ~ cntry + intnum, FUN = function(x) length(unique(x)), 
                             data = CF) %>% 
  rename(ncurrentcases = idno)

# N nonrespondents currently assigned to interviewers
IwerCurrentNonResp <- aggregate(idno ~ cntry + intnum, FUN = function(x) length(unique(x)),
                                data = filter(CF,
                                              CF$finalcodeaggregated != "INT" & 
                                                CF$finalcodeaggregated != "INELIG")) %>% 
  rename(ncurrentnonresp = idno)

# N noncontacts with less than 4 contact attempts

CF_ncless4ca <- subset(CF_main, 
                       CF_main$finalcode ==  20 &
                         CF_main$nattempts < 4)
a <- CF_ncless4ca %>% dplyr::group_by(intnum) %>%
         dplyr::count(intnum) %>%
         dplyr::rename("ncless4ca" = "n")
b <- CF_main %>% dplyr::group_by(intnum) %>%
         dplyr::count(intnum) %>%
         dplyr::transmute(n = 0) %>%
         dplyr::rename("ncless4ca" = "n") 
ifelse(nrow(CF_ncless4ca)>0, 
       IwerNCless4ca <- a, 
       IwerNCless4ca <- b)

# N noncontacts with less than 4 personal visits

CF_ncless4pv <- subset(CF_main, 
                       CF_main$finalcode ==  20 &
                         CF_main$nvisits < 4)
a <- CF_ncless4pv %>% dplyr::group_by(intnum) %>%
         dplyr::count(intnum) %>%
         dplyr::rename("ncless4pv" = "n")
b <- CF_main %>% dplyr::group_by(intnum) %>%
         dplyr::count(intnum) %>%
         dplyr::transmute(n = 0) %>%
         dplyr::rename("ncless4pv" = "n") 
ifelse(nrow(CF_ncless4pv)>0, 
       IwerNCless4pv <- a, 
       IwerNCless4pv <- b)

# Outcomes per interviewer
IwerFinalcode <- CF %>%
  dplyr::group_by(intnum) %>%
  dplyr::count(finalcode) %>%
  dplyr::group_by(finalcode) %>%
  tidyr::spread(finalcode, n, fill = 0, sep = "_")

IwerFinalcodeAggr <- CF %>%
  dplyr::group_by(intnum) %>%
  dplyr::count(finalcodeaggregated.raw) %>%
  dplyr::group_by(finalcodeaggregated.raw) %>%
  tidyr::spread(finalcodeaggregated.raw, n, fill = 0) #Merge with iwerWL to substitute NGROSS with idno. 
#IwerFinalcodeAggr$NGROSS <- rowSums(IwerFinalcodeAggr[,c("INELIG","INT","NC","OTH","REF")], na.rm=TRUE)
IwerFinalcodeAggr <- full_join(IwerFinalcodeAggr, IwerCurrentWork[,c("intnum","ncurrentcases")]) %>%
  dplyr::rename(NGROSS = "ncurrentcases")
IwerFinalcodeAggr$NGROSS <- ifelse(IwerFinalcodeAggr$NGROSS == IwerFinalcodeAggr$UND,
                                    NA,
                                    IwerFinalcodeAggr$NGROSS) 
IwerFinalcodeAggr$INTREF <- rowSums(IwerFinalcodeAggr[,c("INT","REF")], na.rm=TRUE)
IwerFinalcodeAggr <- IwerFinalcodeAggr %>%
  dplyr::mutate(r1(INT,NGROSS,INELIG)) %>%
  dplyr::mutate(r2(INELIG,NGROSS)) %>%
  dplyr::mutate(r1(REF,NGROSS,INELIG)) %>%
  dplyr::mutate(r2(INT,INTREF)) %>%
  dplyr::mutate(r1(NC,NGROSS,INELIG)) %>%
  dplyr::rename(rr = "r1(INT, NGROSS, INELIG)") %>%
  dplyr::rename(ri = "r2(INELIG, NGROSS)") %>%
  dplyr::rename(refr = "r1(REF, NGROSS, INELIG)") %>%
  dplyr::rename(coopr = "r2(INT, INTREF)") %>%
  dplyr::rename(ncr = "r1(NC, NGROSS, INELIG)")


IwerQI1 <- full_join(IwerCurrentWork, IwerCurrentNonResp)
IwerQI1 <- full_join(IwerQI1, IwerFinalcodeAggr)
IwerQI1 <- full_join(IwerQI1, IwerFinalcode)
IwerQI1 <- full_join(IwerQI1, IwerNCless4ca)
IwerQI1$ncless4ca <- tidyr::replace_na(IwerQI1$ncless4ca,0)
IwerQI1 <- full_join(IwerQI1, IwerNCless4pv)
IwerQI1$ncless4pv <- tidyr::replace_na(IwerQI1$ncless4pv,0)

```

## Assigned cases per interviewer {#sec:assignediwer}

Figure \ref{fig:iwerassigned_plot} shows the current assignment of cases (with at least one contact attempt) to interviewers. It provides an overview of how cases are distributed across the interviewer workforce. On its own, this indicator might not be very informative, but it helps contextualize other indicators (e.g response rates). 


```{r iwerassigned, results = "asis", error=T}

## Assigned cases per iwer
#Descriptives#
IwerQI1_ncasesdescr <- psych::describe(IwerQI1$ncurrentcases, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

IwerQI1_nnonrespdescr <- psych::describe(IwerQI1$ncurrentnonresp, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

kable(IwerQI1_ncasesdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for current assignment of cases per interviewer"))  %>% # !Alert! change country
  kable_styling(latex_options = c("HOLD_position"))

```

```{r iwerassigned_plot,  fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:iwerassigned_plot} Assigned of cases per interviewer",  linebreak, "Note: Assignment is based on interviewer who made the last contact attempt. Mean and ± 2 standard deviations shown (unless negative value)"), fig.scap="Assigned of cases per interviewer", error=T}

## Cases plot
a <- ggplot(IwerQI1,
       aes(ncurrentcases, as.factor(intnum))) +
  labs(x = "Cases currently assigned",
       y = "Interviewers") +
  geom_vline(xintercept = IwerQI1_ncasesdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_ncasesdescr$mean + IwerQI1_ncasesdescr$sd*2) +
  geom_point()

b <- a + geom_vline(xintercept = IwerQI1_ncasesdescr$mean + IwerQI1_ncasesdescr$sd*-2)

if(((IwerQI1_ncasesdescr$mean + IwerQI1_ncasesdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}

```

## Interviews and response rate per interviewer {#sec:rriwers}

The number of completed interviews provides an absolute indicator of the performance of interviewers, while the response rate provide a performance indicator relative to the other outcomes and the number of cases assigned to the interviewer. Extremely high or extremely low response rate can be indicators of deviation from the standards of the ESS or weakness in the training for contacting and gaining cooperation of respondents. Response rates should be evaluated in the national context. 

Figure \ref{fig:iwerint_plot} shows the number of interviews per interviewers. Figure \ref{fig:iwerrr_plot} shows the distribution of response rates per interviewers. Only interviewers with 5 or more cases that have valid outcome codes are included in the analysis. The mean response rate across interviewer and ± 2 standard deviations are highlighted in the figure to help provide a relative reference across interviewers.  

Detailed investigation of the characteristics of the cases assigned to interviewers that noticeably high or low response rates is necessary as they can differ greatly depending on the assignment (e.g. number of cases, outcomes, regional and PSU characteristics, respondent characteristics).


```{r iwerrr, results = "asis", error=T}
## Response rates per iwer
#Descriptives#
IwerQI1_rrdescr <- psych::describe(IwerQI1$rr, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

IwerQI1_intdescr <- psych::describe(IwerQI1$INT, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

kable(IwerQI1_intdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for interviews per interviewer"))  %>% 
  kable_styling(latex_options = c("HOLD_position"))

kable(IwerQI1_rrdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for response rates per interviewer"))  %>% 
  kable_styling(latex_options = c("HOLD_position"))

```

```{r iwerint_plot,  fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:iwerint_plot} Interviews per Interviewer",  linebreak, "Note: based on interviewer who made last contact attempt. Mean and ± 2 standard deviations shown (unless negative value)"), fig.scap="Interviews per Interviewer", error=T}

## Cases plot
a <- ggplot(IwerQI1,
       aes(INT, as.factor(intnum))) +
  labs(x = "Number of completed interviews",
       y = "Interviewers") +
  geom_vline(xintercept = IwerQI1_intdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_intdescr$mean + IwerQI1_intdescr$sd*2) +
  geom_point()

b <- a + geom_vline(xintercept = IwerQI1_intdescr$mean + IwerQI1_intdescr$sd*-2)

if(((IwerQI1_intdescr$mean + IwerQI1_intdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}

```

```{r iwerrr_plot, fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:rriwer_plot} Response rate per interviewer for current assignment",  linebreak, "Note: Interviewers less than 5 cases have been excluded from the analysis. Mean and ± 2 standard deviations shown"), fig.scap="Response rate per interviewer for current assignment", error=T}

# RR Plot
a <- ggplot(IwerQI1[IwerQI1$NGROSS > 4,], #Filter out iwer with 5 or less cases (based on NGROSS > 4 for those havign some outcome only (not contacted at all excluded))
       aes(rr, as.factor(intnum))) +
  labs(x = "Response Rate",
       y = "Interviewers (with min 5 cases)") +
  geom_vline(xintercept = IwerQI1_rrdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_rrdescr$mean + IwerQI1_rrdescr$sd*2) +
  geom_point()

b <- a + geom_vline(xintercept = IwerQI1_rrdescr$mean + IwerQI1_rrdescr$sd*-2)

if(((IwerQI1_rrdescr$mean + IwerQI1_rrdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}

```

## Refusal rate per interviewer {#sec:refriwers}

The refusal rate of each can also help evaluate the performance of interviewers in the field. Very high refusal rates can be an indication of departure from the ESS standards or problems in the training of interviewers in refusal avoidance. Extremely low refusal rates relative to other interviewers could also indicate issues in correctly recording the outcome of interactions with respondents or poor interviewer behaviour. 

Figure\ref{fig:iwerrefr_plot} shows the refusal rates of each interviewer based on their assigned cases. Only interviewers with 5 or more cases that have valid outcome codes are included in the analysis. The mean refusal rate across interviewers and ± 2 standard deviations are highlighted in the figure to help provide a relative reference across interviewers.

Refusal indicators should be observed in conjunction with cooperation rates which exclude non-contacts and other non-responses from the equation. (see section \ref{#sec:coopriwer}) 

```{r iwerrefr, results = "asis", error=T}
## Refusal rates per iwer
#Descriptives
IwerQI1_refrdescr <- psych::describe(IwerQI1$refr, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

kable(IwerQI1_refrdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for refusal rates per interviewer"))  %>% 
  kable_styling(latex_options = c("HOLD_position"))

```

```{r iwerrefr_plot, fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:refriwer_plot} Refusal rate per interviewer for current assignment",  linebreak, "Note: Interviewers less than 5 cases have been excluded from the analysis. Mean and ± 2 standard deviations shown"), fig.scap="Refusal rate per interviewer for current assignment", error=T}

#Plot
a <- ggplot(IwerQI1[IwerQI1$NGROSS > 4,], #Filter out iwer with 5 or less cases (based on NGROSS > 4 for those havign some outcome only (not contacted at all excluded))
       aes(refr, as.factor(intnum))) +
  labs(x = "Refusal Rate",
       y = "Interviewers (with min 5 cases)") +
  geom_vline(xintercept = IwerQI1_refrdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_refrdescr$mean + IwerQI1_refrdescr$sd*2) +
  geom_point()

b <- a +   geom_vline(xintercept = IwerQI1_refrdescr$mean + IwerQI1_refrdescr$sd*-2)

if(((IwerQI1_refrdescr$mean + IwerQI1_refrdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}


```

## Cooperation rate per interviewer {#sec:coopriwer}

Figure \ref{fig:iwerassigned_stage_plot} shows the cooperation rate gained by each interviewer. Cooperation rate is calculated by dividing the number of interviews by the sum of the refusal plus the completed interviews. Like the refusal rate, the cooperation rate helps evaluate the performance of interviewers in the field. However, it focus explicitly on cases that have been contacted and attempts for cooperation to participate in the survey has been clearly. Please note that for the interviewer breakdown partial interviews have been excluded.

```{r iwercoopr, results = "asis", error=T}
## Cooperation rate per iwer
#Descriptives
IwerQI1_cooprdescr <- psych::describe(IwerQI1$coopr, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

kable(IwerQI1_cooprdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for cooperation rates per interviewer"))  %>% 
  kable_styling(latex_options = c("HOLD_position"))

```

```{r iwercoopr_plot, fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:iwercoopr_plot} Cooperation rate per interviewer for current assignment",  linebreak, "Note: Interviewers less than 5 cases have been excluded from the analysis (interviews + refusals). Mean and ± 2 standard deviations shown"), fig.scap="Cooperation rate per interviewer for current assignment", error=T}

#Plot
a <- ggplot(IwerQI1[IwerQI1$INTREF > 4,], #Filter out iwer with 5 or less cases (based on INTREF > 4 for those having either a refusal or an interview)
       aes(coopr, as.factor(intnum))) +
  labs(x = "Cooperation Rate",
       y = "Interviewers (with min 5 cases)") +
  geom_vline(xintercept = IwerQI1_cooprdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_cooprdescr$mean + IwerQI1_cooprdescr$sd*2) +
  geom_point()

b <- a +   geom_vline(xintercept = IwerQI1_cooprdescr$mean + IwerQI1_cooprdescr$sd*-2)

if(((IwerQI1_cooprdescr$mean + IwerQI1_cooprdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}


```


## Non-contacts per interviewer {#sec:nonciwer}

Figure \ref{fig:iwernc_plot} shows sample units currently coded as non-contact and how they are distributed across interviewer. Depending on the fieldwork stage, this indicator can be useful for detecting “bottle necks” of sample units among few interviewers and evaluating the re-issuing of cases. 

To account for the number of cases assigned to each interviewer, we need to view the rate of non-contacts. Figure \ref{fig:iwerncr_plot} shows the non-contact rate per interviewer. This indicator complements the other rates already presented, but it laso helps identify interviewers with the largest potential for interviews if cases are contacted. We should bear in mind the number of personal visits and contact attempts made to non-contacts in order to account for the effort already carried out by the interviewers (see sections \ref{sec:noncless4}).


```{r iwernoncontact, results = "asis", error=T}
## Non-contact per iwer
#Descriptives rate
IwerQI1_ncdescr <- psych::describe(IwerQI1$NC, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)
#Descriptives rate
IwerQI1_ncrdescr <- psych::describe(IwerQI1$ncr, quant=c(.05,.95)) %>%
  select(mean, median, sd, Q0.05, Q0.95)

kable(IwerQI1_ncdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for non-contacts per interviewer"))  %>% 
  kable_styling(latex_options = c("HOLD_position"))

kable(IwerQI1_ncrdescr,  # !Alert! sumrow is utility function
      row.names = FALSE, booktabs = T, 
      caption = paste("\\label{tab:iwerassigned_tab} Descriptive stats for non-contact rates per interviewer"))  %>% 
  kable_styling(latex_options = c("HOLD_position"))

```

```{r iwernc_plot, fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:refriwer_plot} Distribution of non-contacts per interviewer",  linebreak, "Note: Mean and ± 2 standard deviations shown (unless negative value)"), fig.scap="Distribution of non-contacts per interviewer", error=T}

## Cases plot
a <- ggplot(IwerQI1,
       aes(NC, as.factor(intnum))) +
  labs(x = "Number of non-contact",
       y = "Interviewers") +
  geom_vline(xintercept = IwerQI1_ncdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_ncdescr$mean + IwerQI1_ncdescr$sd*2) +
  geom_point()

b <- a + geom_vline(xintercept = IwerQI1_ncdescr$mean + IwerQI1_ncdescr$sd*-2)

if(((IwerQI1_ncdescr$mean + IwerQI1_ncdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}

```


```{r iwerncr_plot, fig.height = 9, fig.width = 7, fig.cap = paste("\\label{fig:refriwer_plot} Non-contact rate per interviewer for current assignment",  linebreak, "Note: Interviewers less than 5 cases have been excluded from the analysis. Mean and ± 2 standard deviations shown"), fig.scap="Non-contact rate per interviewer for current assignment", error=T}

#Plot
a <- ggplot(IwerQI1[IwerQI1$NGROSS > 4,], #Filter out iwer with 5 or less cases (based on NGROSS > 4 for those havign some outcome only (not contacted at all excluded))
       aes(ncr, as.factor(intnum))) +
  labs(x = "Non-contact rate",
       y = "Interviewers (with min 5 cases)") +
  geom_vline(xintercept = IwerQI1_ncrdescr$mean, color = wes_palette(n=1, name = "Zissou1")) +
  geom_vline(xintercept = IwerQI1_ncrdescr$mean + IwerQI1_ncrdescr$sd*2) +
  geom_point()

b <- a + geom_vline(xintercept = IwerQI1_ncrdescr$mean + IwerQI1_ncrdescr$sd*-2)

if(((IwerQI1_ncrdescr$mean + IwerQI1_ncrdescr$sd*-2)>0)) #Exclude negative value from standard deviation
  {print(b)} else {print(a)}

```


## Non-contacts with less than 4 personal visits or contact attempts {#sec:noncless4}

As mentioned in section \ref{sec:nnonc}, ESS Specifications indicate that sample units need to be visited at least fort times in person before can be abandoned as ‘non‐productive’. Identifying interviewers with large number of non‐contacts without at least 4 personal visits or contact attempts helps detect issues in the workforce, keep oversight on their work and activeness, and allow for reissuing of sample units to other interviewers if necessary. Especially at later stages of the fieldwork, it is important to evaluate non-contacts carefully to avoid leaving sample units with less effort than the minimum required by the ESS standards. 

Figure \ref{fig:iwerncless4pv_plot} shows the number of non‐contacts with less than 4 personal visits assigned to each interviewers. 
Figure \ref{fig:iwerncless4ca_plot} widens the focus of the analysis to any type of contact attempt, showing the number of non‐contacts with less than 4 contact attempts per interviewer. 


```{r iwerncless4pv_plot, fig.height = 8, fig.width = 7, fig.cap = paste("\\label{fig:iwerncless4pv_plot} Distribution of non-contacts with less than 4 personal visits per interviewer",  linebreak, "Note: Mean and ± 2 standard deviations shown (unless negative value)"), fig.scap="Distribution of non-contacts with less than 4 personal visits per interviewer", error=T}

## Cases plot
a <- ggplot(IwerNCless4pv,
       aes(ncless4pv, as.factor(intnum))) +
  labs(x = "Number of non-contacts with less than 4 personal visits",
       y = "Interviewers (not shown if x equal 0)") +
  scale_x_continuous(limits = c(0,(max(IwerQI1$ncless4pv)+1))) +
  geom_point(color='orangered3')

b <- ggplot(IwerQI1,
       aes(ncless4pv, as.factor(intnum))) +
  labs(x = "Number of non-contacts with less than 4 personal visits",
       y = "Interviewers") +
  scale_x_continuous(limits = c(0,(max(IwerQI1$ncless4pv)+1))) +
  geom_point(color='green4')

## Show only if higher than 0
##if(nrow(CF_ncless4ca)>0) {print(a)} 
ifelse(nrow(CF_ncless4pv)>0, print(a), print(b))

```


```{r iwerncless4ca_plot, fig.height = 8, fig.width = 7, fig.cap = paste("\\label{fig:iwerncless4ca_plot} Distribution of non-contacts with less than 4 contact attemtps per interviewer",  linebreak, "Note: Mean and ± 2 standard deviations shown (unless negative value)"), fig.scap="Distribution of non-contacts with less than 4 contact attemtps per interviewer", error=T}

## Cases plot
a <- ggplot(IwerNCless4ca,
       aes(ncless4ca, as.factor(intnum))) +
  labs(x = "Number of non-contacts with less than 4 contact attempts",
       y = "Interviewers (not shown if x equal 0)") +
  scale_x_continuous(limits = c(0,(max(IwerQI1$ncless4ca)+1))) +
  geom_point(color='orangered3')

b <- ggplot(IwerQI1,
       aes(ncless4ca, as.factor(intnum))) +
  labs(x = "Number of non-contacts with less than 4 contact attempts",
       y = "Interviewers") +
  scale_x_continuous(limits = c(0,(max(IwerQI1$ncless4ca)+1))) +
  geom_point(color='green4')

## Show only if higher than 0
##if(nrow(CF_ncless4ca)>0) {print(a)} 
ifelse(nrow(CF_ncless4ca)>0, print(a), print(b))

```


```{r writecsv, error=T}

#Version for csv in name
FMSinfo <- "_FMSup"

## CF with main indicators
write.table(CF_main, 
            file=paste("Annex/", thisCountry, FMSinfo, " CF main indicators.csv",  sep=""), 
            sep = ";", row.names = F)


write.table(CF_outcome_breakdown[,c("code", "Country", "Freq", "classification", "type", "label", "aggregated", "NTS")], 
            file=paste("Annex/", thisCountry, FMSinfo, " breakdown outcome indicators.csv",  sep=""), 
            sep = ";", row.names = F)


#Iwer Indicator 1 based on current cases
write.table(IwerQI1, 
            file=paste("Annex/", thisCountry, FMSinfo, " all interviewer indicators for current cases.csv",  sep=""), 
            sep = ";", row.names = F)


```


# References