Library cleanup

components/VSI.R

@@ -0,0 +1,140 @@
+# checks the data, returns FALSE in case something is not OK
+check_data <- function (dataset) {
+  if (!is.null(dataset$VSI1) && !is.null(dataset$VSI2) && !is.null(dataset$VSI3) && !is.null(dataset$idno)) {
+    cat ("All the required variables are present, continuing with the analysis.  ")
+    
+    return (TRUE)
+    
+  } else {
+    if (is.null(dataset$VSI1)) {
+      cat ("VSI1 variable is missing in the dataset.  ");
+    }
+    if (is.null(dataset$VSI2)) {
+      cat ("VSI2 variable is missing in the dataset.  ");
+    }
+    if (is.null(dataset$VSI3)) {
+      cat ("VSI3 variable is missing in the dataset.  ");
+    }
+    if (is.null(dataset$idno)) {
+      cat ("idno variable (interview ID) is missing in the dataset.  ");
+    }
+    
+    cat ("**Please check your dataset and try again**")
+    return (FALSE)
+  }  
+}
+
+
+
+# Extracts access points fingerprints from the data (5 APs from 1 VSI)
+extract_ap <- function (source) {
+  return (c(substr(source,0,7),
+            substr(source,16,23),
+            substr(source,32,39),
+            substr(source,48,55),
+            substr(source,64,71)));  
+}
+
+# Checks whether at least 3 of 5 APs are present during an interview
+match_within <- function (t1,t2,t3) {
+  
+  matched_within = 0
+  
+  for (a in seq(1,5)) {
+    
+    if (t1[a] %in% t2 && t1[a] %in% t3) {
+      matched_within=matched_within + 1
+    }
+  }
+  if (matched_within >= 3) {
+    return (TRUE)
+  }
+  else {
+    return (FALSE)
+    
+  }
+  
+}
+
+# Checks whether any of other cases have 3 or more same APs (i.e. same location)
+
+match_outside <- function (a_t1, a_t2, a_t3, b_t1, b_t2, b_t3) {
+  
+  matched = FALSE
+  
+  # only take cases that match !WITHIN!
+  if (match_within(a_t1, a_t2, a_t3) == FALSE || match_within(b_t1, b_t2, b_t3) == FALSE) {
+    return (FALSE) # no match, as we can't even do it within
+  }
+  
+  
+  matches=0
+  
+  # we iterate through all 5 APs. If at least three are repeated across
+  # all time points in both surveys (a_t1... b_t3) we have a match
+  
+  for (a in seq(1,5)) {
+    
+    if (a_t1[a] %in% b_t1 && a_t1[a] %in% b_t2 && a_t1[a] %in% b_t3 &&
+        a_t2[a] %in% b_t1 && a_t2[a] %in% b_t2 && a_t2[a] %in% b_t3 &&
+        a_t3[a] %in% b_t1 && a_t3[a] %in% b_t2 && a_t3[a] %in% b_t3) 
+    {
+      matches=matches+1
+    }
+  }
+  
+  if (matches >= 3) {
+    return (TRUE)
+  }
+  else {
+    return (FALSE)
+  }
+}
+
+
+
+
+# Checks existing pairings and add it to appropriate position
+# example:
+# in raw data, matches are found between cases 22<->23; 23<->38; 40<->41
+
+# This can be summarized into:
+# Matched cases: 22, 23, 38 ; as well as 40, 41
+
+# This function takes a pair (e.g. c(23,38)) and checks if any of them is
+# already in any of the matches.
+
+# if it is, it adds new case to the appropriate list.
+# if not, it adds a new offset with the new pair
+
+group_pairs <- function (groups, pair) {
+  
+  # if we receive an empty list, just populate it...
+  if (length(groups) == 0) {
+    groups <- list (c(pair[1], pair[2]))
+    return (groups)
+  }  
+  
+  # find both elements in the groupings
+  loc_1 <- which(sapply(groups, FUN=function(X) pair[1] %in% X))
+  loc_2 <- which(sapply(groups, FUN=function(X) pair[2] %in% X))
+  
+  # none in existing list
+  if (length(loc_1) == 0 && length(loc_2) == 0) {
+    
+    groups[[length(groups)+1]] <- c(pair[1], pair[2])
+    
+  } else if (length(loc_1) != 0 && length(loc_2) == 0) {
+    
+    # let's add the second (not present) to the first's offset
+    groups[[loc_1]] <- c(groups[[loc_1]], pair[2])
+    
+  } else if (length(loc_1) == 0 && length(loc_2) != 0) {
+    
+    # let's add the first (not present) to the second's offset
+    groups[[loc_2]] <- c(groups[[loc_2]], pair[1])
+    
+  }
+  # yes, we can have both present (else) - no need to do anything then.
+  return (groups)
+}

demo_data/main.csv

@@ -13,12 +13,22 @@
 12;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 13;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 14;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
-15;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+15;"SI";"g0e11dcd6d02d45s229037c022d7b1873a11d120a4843235bc73c363a783a3d3c3e3e835a383a3df";"30313d3b6d0234353230373022272187aa12d222a2833353b475c6724732a2d1c3e54845578d344f";"d541fd4berf2dg5432g5474062jhbrteza5461u57j8trz76jcr6tbh467h574jk6872657nathgatdf"
 16;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 17;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 18;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 19;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 20;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+31;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+32;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+33;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+34;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+35;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+36;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+37;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+38;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+39;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+40;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 21;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 22;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 23;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
@@ -26,3 +36,6 @@
 25;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 26;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
 27;"SI";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df";"d0e11dcb6d02d455229087c022d7b187aa11d120a4843255bc7ecb62a78da4dfc1e2e8e5a78da4df"
+28;"SI";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df"
+29;"SI";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df"
+30;"SI";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df";"e0e11dcb5d02d455339087c022d7b187bb11d120a4843255bc9ecb62a78da4dfc2e2e8e5a78da4df"

vsi.Rmd

@@ -23,7 +23,7 @@ link-citations: yes
 params:
   mainFile: ""
   intFile: ""
-  version: "0.2"
+  version: "1.0 beta"
   
 
 ---
@@ -45,21 +45,10 @@ Sys.setlocale("LC_ALL","English")
 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
 
-# for tables
-library(knitr)
-
-#New packages:
-library(cowplot)
-library(tibble)
 
 ```
 
@@ -69,15 +58,10 @@ ESSred <- rgb(.91, .20, .32)
 ESSgreen <- rgb(.14, .62, .51)
 ESSblue <- rgb(0, .25, .48)
 
+# now some adjacent and square colors (colortools has been removed from CRAN)
+ESS_colors_extra <- c(rgb(.44,.2,.91),rgb(.2,.91,.79),rgb(.68,.91,.2),rgb(.91,.2,.68),rgb(.91,.44,.2))
 
-
-ESSColors <- unique(c(adjacent(ESSred, plot = F), square(ESSred, plot = F)))
-
-
-
-
-ESSColors <- c(ESSColors, ESSgreen, ESSblue)
-# pizza(ESSColors)
+ESSColors <- c(ESSred, ESS_colors_extra, ESSgreen, ESSblue)
 
 themeESS <- theme_tufte(base_size = 9, base_family = "Calibri") +
   theme(axis.title = element_text(size = 9, face = "plain"),
@@ -104,10 +88,107 @@ linebreak <- "\\hspace{\\textwidth}"
 ```
 
 \pagenumbering{arabic}
-
+\newpage
 \setcounter{tocdepth}{2}
-\tableofcontents
-\listoftables
-\listoffigures
 
 # Introduction {-}
+
+This tools checks the Virtual Surrounding Impression data and reports on the cases that are suspicious. In essence, it conducts two analysis:
+
+- checks for intra-case VSI match to report on cases that most likely weren't interviewed on a single location (missing intra-case VSI match)
+- checks for accross-dataset VSI matches to report on cases what were most likely taken on the same location by the same interviewer using the same machine  
+
+The results should always be combined with other methods of detecting undesired interviewer behaviour.
+
+**Data check**
+
+```{r datacheck, echo=FALSE, results='asis', error=TRUE}
+
+dataset <- read.csv2("demo_data/main.csv", dec=".", stringsAsFactors=F)
+# add interviewer file, too!
+
+
+# include VSI functions
+
+source('components/VSI.R')
+
+# exit if data is not OK
+if (check_data(dataset) == FALSE) {
+  knitr::knit_exit()
+}
+
+
+```
+
+\pagenumbering{arabic}
+\newpage
+
+# Case level analysis
+
+Checking for individual cases that seem to be taken at multiple locations (change of location during a single interview).  
+Please read the results with the grain of salt as sometimes the VSI might change due to weak signal. Multiple locations per interview are possible when the interview was taken at multiple sittings.  
+When the WiFi is turned off, the "VSI" doesn't detect any intra-case change. 
+  
+
+```{r intra-case, echo=FALSE, results='asis', error=TRUE}
+
+  intra_case <- c()
+  extra_full_list <- list()  
+  
+  for(current_row in 1:nrow(dataset)) {
+    vsi_t1_exploded <- extract_ap(dataset[current_row,]$VSI1);
+    vsi_t2_exploded <- extract_ap(dataset[current_row,]$VSI2);
+    vsi_t3_exploded <- extract_ap(dataset[current_row,]$VSI3);
+    
+    # checking within
+    if (!match_within(vsi_t1_exploded,vsi_t2_exploded,vsi_t3_exploded)) {
+      intra_case <- c(intra_case, dataset[current_row,]$idno)
+    }
+    
+    # compare against all other cases
+    for (compare_against in (current_row+1):nrow(dataset)) {
+      
+      t1_oth <- extract_ap(dataset[compare_against,]$VSI1);
+      t2_oth <- extract_ap(dataset[compare_against,]$VSI2);
+      t3_oth <- extract_ap(dataset[compare_against,]$VSI3);    
+      
+      if (match_outside (vsi_t1_exploded, vsi_t2_exploded, vsi_t3_exploded, t1_oth, t2_oth, t3_oth)) {
+        extra_full_list <- group_pairs(extra_full_list, c(dataset[compare_against,]$idno, dataset[current_row,]$idno))
+  
+      }
+    }
+  }
+
+if (length(intra_case) == 0) {
+  cat ("**No cases where the location changed during the interview detected.**")
+} else {
+  cat ("**There are ", length(intra_case) , " cases which seem to have the location changed during the interview**  \n  \n  \n")
+  cat ("**IDNOs: **", paste(as.character(intra_case), collapse=", "))  
+}
+
+```
+
+\pagenumbering{arabic}
+\newpage
+
+# Accross-dataset analysis
+
+Checking for cases that seem to have the same location.  
+This can happen if WiFi is OFF (all cases from given interviewer have the same location).  
+
+```{r extra-case, echo=FALSE, results='asis', error=TRUE}
+
+if (length(extra_full_list) == 0) {
+  cat ("**There are no multiple cases that seem to have been taken at the same location.**")
+} else {
+  cat ("**There are ", length(extra_full_list) , " location where multiple interviews seem to be conducted**  \n  \n  \nPlease see them grouped by location below:  \n  \n  \n")
+  
+  for (location in 1:length(extra_full_list)) {
+    cat (paste("**Location ", location, ":**  \n"))
+    cat ("\tIDNOs ", paste(as.character(extra_full_list[[location]]), collapse=", "), "  \n  \n  \n")  
+  }
+  
+}
+
+```
+