forked from PYannick/HighFrequencyChecks
-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathassessmentdailyvalidsurveys.R
113 lines (103 loc) · 4.8 KB
/
assessmentdailyvalidsurveys.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
# WARNING - Generated by {fusen} from dev/function_documentation.Rmd: do not edit by hand
#' @name assessmentDailyValidSurveys
#' @rdname assessmentDailyValidSurveys
#' @title Daily number of filled forms per consent status
#' @description This function display the number of filled forms conducted per day per consent status.
#'
#' @param ds dataset containing the survey (from kobo): labelled data.frame
#' @param checkperiod if not null number of day before today when the check should be made
#' @param surveyDate name of the field in the dataset where the date of the survey is stored: string
#' @param dateFormat format used for the date: string ('\%m/\%d/\%Y')
#' @param surveyConsent name of the field in the dataset where the survey consent is stored: string
#' @param consentForValidSurvey value defined in the kobo form to acknowledge the surveyed person gave his consent: string
#' @param attempt name of the field in the dataset where the interview attempt output is stored: string
#'
#' @return result a list that includes:
#' * dst same dataset as the inputed one but with survey marked for deletion if errors are found and delete = TRUE (or NULL)
#' * ret_log list of the errors found (or NULL)
#' * var a list of value (or NULL)
#' * graph graphical representation of the results (or NULL)
#'
#' @export assessmentDailyValidSurveys
#' @examples
#' load(system.file("sample_dataset.RData", package = "HighFrequencyChecks"))
#' ds <- sample_dataset
#' surveyDate <- "survey_date"
#' dateFormat <- "%m/%d/%Y"
#' surveyConsent <- "survey_consent"
#' result <- assessmentDailyValidSurveys(
#' ds = ds,
#' surveyDate = surveyDate,
#' dateFormat = dateFormat,
#' surveyConsent = surveyConsent)
#'
#' knitr::kable(head(result[["ret_log"]], 10))
#' print(result[["graph"]])
#'
assessmentDailyValidSurveys <- function(ds = NULL,
surveyDate = NULL,
dateFormat = NULL,
surveyConsent = NULL,
attempt = NULL){
if(is.null(ds) | nrow(ds) == 0 | !is.data.frame(ds)){
stop("Please provide the dataset")
}
if(is.null(surveyDate) | !is.character(surveyDate)){
stop("Please provide the field where the survey date is stored")
}
if(is.null(dateFormat) | !is.character(dateFormat)){
stop("Please provide the format used for the date ('%m/%d/%Y')")
}
if(is.null(surveyConsent) | !is.character(surveyConsent)){
stop("Please provide the field where the survey consent is stored")
}
if( is.null(attempt) ) {
tmp <- ds %>%
dplyr::mutate( calldate = format(as.Date(.data[[surveyDate]]), "%d-%m") )%>%
dplyr::group_by(calldate) %>%
dplyr::count(.data[[surveyConsent]])
} else {
tmp <- ds %>%
dplyr::mutate( calldate = format(as.Date(.data[[surveyDate]]), "%d-%m") )%>%
dplyr::group_by(calldate,
attempt = .data[[attempt]]) %>%
dplyr::count(.data[[surveyConsent]])
}
# tmp1 <- tmp %>%
# # --------------------------------------------------------------
# # change 1: convert haven_labelled variables to factors ----
# mutate_if(haven::is.labelled, haven::as_factor) %>%
# # change 2: convert variable labels to variable names ----
# sjlabelled::label_to_colnames()
# # --------------------------------------------------------------
#
# tmp <- tmp %>%
# dplyr::mutate( label = sjlabelled::get_labels(attempt) )
#
# tmp$label <- sjlabelled::get_labels(tmp$attempt)[tmp$attempt]
#
# sjlabelled::get_labels(tmp$attempt)
# colnames(tmp)[2] <- "surveyConsent"
# tmp$surveydate <- as.Date(tmp[[surveyDate]], dateFormat)
# tmp <- tmp[with(tmp, order(surveydate)), ]
# ret_log <- reshape2::dcast(tmp,surveydate ~ surveyConsent, value.var = "n")
# ret_log [is.na(ret_log )] <- 0
ret_log <- tmp
graph <- ggplot2::ggplot(tmp, ggplot2::aes(x = calldate,
y = n,
fill = attempt)) +
ggplot2::geom_col() +
# ggplot2::facet_wrap(~ attempt ) +
unhcrthemes::theme_unhcr(font_size = 14) +
ggplot2::theme(panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor.x = ggplot2::element_blank()) +
ggplot2::labs(title = "Daily number of filled forms per consent status",
x = "Dates",
y="Number of surveys",
fill="Consent status")
result <- list( dst = NULL, # same dataset as the inputed one but with survey marked for deletion if errors are found and delete=TRUE (or NULL)
ret_log = ret_log , # list of the errors found (or NULL)
var =NULL, # a list of value (or NULL)
graph = graph) # graphical representation of the results (or NULL)
return(result)
}