Refactor call features and fix bug with countmostfrequentcontact
parent
21d07d83bc
commit
91c24a652a
|
@ -175,8 +175,8 @@ maxduration seconds The duration of the longest call of a
|
|||
stdduration seconds The standard deviation of the duration of all the calls of a particular ``call_type`` during a particular ``day_segment``.
|
||||
modeduration seconds The mode of the duration of all the calls of a particular ``call_type`` during a particular ``day_segment``.
|
||||
entropyduration nats The estimate of the Shannon entropy for the the duration of all the calls of a particular ``call_type`` during a particular ``day_segment``.
|
||||
timefirstcall hours The time in hours between 12:00am (midnight) and the first call of ``call_type``.
|
||||
timelastcall hours The time in hours between 12:00am (midnight) and the last call of ``call_type``.
|
||||
timefirstcall minutes The time in minutes between 12:00am (midnight) and the first call of ``call_type``.
|
||||
timelastcall minutes The time in minutes between 12:00am (midnight) and the last call of ``call_type``.
|
||||
countmostfrequentcontact calls The number of calls of a particular ``call_type`` during a particular ``day_segment`` of the most frequent contact throughout the monitored period.
|
||||
========================= ========= =============
|
||||
|
||||
|
|
|
@ -0,0 +1,71 @@
|
|||
filter_by_day_segment <- function(data, day_segment) {
|
||||
if(day_segment %in% c("morning", "afternoon", "evening", "night"))
|
||||
data <- data %>% filter(local_day_segment == day_segment)
|
||||
else if(day_segment == "daily")
|
||||
return(data)
|
||||
else
|
||||
return(data %>% head(0))
|
||||
}
|
||||
|
||||
Mode <- function(v) {
|
||||
uniqv <- unique(v)
|
||||
uniqv[which.max(tabulate(match(v, uniqv)))]
|
||||
}
|
||||
|
||||
base_call_features <- function(call, call_type, day_segment, requested_features){
|
||||
# Output dataframe
|
||||
features = data.frame(local_date = character(), stringsAsFactors = FALSE)
|
||||
|
||||
# The name of the features this function can compute
|
||||
base_features_names <- c("count", "distinctcontacts", "meanduration", "sumduration", "minduration", "maxduration", "stdduration", "modeduration", "entropyduration", "timefirstcall", "timelastcall", "countmostfrequentcontact")
|
||||
|
||||
# The subset of requested features this function can compute
|
||||
features_to_compute <- intersect(base_features_names, requested_features)
|
||||
|
||||
# Filter rows that belong to the calls type and day segment of interest
|
||||
calls <- calls %>% filter(call_type == ifelse(type == "incoming", "1", ifelse(type == "outgoing", "2", "3"))) %>%
|
||||
filter_by_day_segment(day_segment)
|
||||
print(calls)
|
||||
# If there are not features or data to work with, return an empty df with appropiate columns names
|
||||
if(length(features_to_compute) == 0)
|
||||
return(features)
|
||||
if(nrow(calls) < 1)
|
||||
return(cbind(features, read.csv(text = paste(paste("call", call_type, day_segment, features_to_compute, sep = "_"), collapse = ","), stringsAsFactors = FALSE)))
|
||||
|
||||
for(feature_name in features_to_compute){
|
||||
print(feature_name)
|
||||
if(feature_name == "countmostfrequentcontact"){
|
||||
# Get the number of messages for the most frequent contact throughout the study
|
||||
feature <- calls %>% group_by(trace) %>%
|
||||
mutate(N=n()) %>%
|
||||
ungroup() %>%
|
||||
filter(N == max(N)) %>%
|
||||
head(1) %>% # if there are multiple contacts with the same amount of messages pick the first one only
|
||||
group_by(local_date) %>%
|
||||
summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := N) %>%
|
||||
replace(is.na(.), 0)
|
||||
|
||||
features <- merge(features, feature, by="local_date", all = TRUE)
|
||||
} else {
|
||||
feature <- calls %>%
|
||||
group_by(local_date)
|
||||
|
||||
feature <- switch(feature_name,
|
||||
"count" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := n()),
|
||||
"distinctcontacts" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := n_distinct(trace)),
|
||||
"meanduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := mean(call_duration)),
|
||||
"sumduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := sum(call_duration)),
|
||||
"minduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := min(call_duration)),
|
||||
"maxduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := max(call_duration)),
|
||||
"stdduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := sd(call_duration)),
|
||||
"modeduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := Mode(call_duration)),
|
||||
"entropyduration" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := entropy.MillerMadow(call_duration)),
|
||||
"timefirstcall" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := first(local_hour) * 60 + first(local_minute)),
|
||||
"timelastcall" = feature %>% summarise(!!paste("call", call_type, day_segment, feature_name, sep = "_") := last(local_hour) * 60 + last(local_minute)))
|
||||
|
||||
features <- merge(features, feature, by="local_date", all = TRUE)
|
||||
}
|
||||
}
|
||||
|
||||
return(features)
|
||||
}
|
|
@ -1,66 +1,18 @@
|
|||
source("renv/activate.R")
|
||||
|
||||
source("src/features/call/call_base.R")
|
||||
library(dplyr)
|
||||
library(entropy)
|
||||
library(robustbase)
|
||||
|
||||
filter_by_day_segment <- function(data, day_segment) {
|
||||
if(day_segment %in% c("morning", "afternoon", "evening", "night"))
|
||||
data <- data %>% filter(local_day_segment == day_segment)
|
||||
|
||||
return(data %>% group_by(local_date))
|
||||
}
|
||||
|
||||
Mode <- function(v) {
|
||||
uniqv <- unique(v)
|
||||
uniqv[which.max(tabulate(match(v, uniqv)))]
|
||||
}
|
||||
|
||||
compute_call_feature <- function(calls, requested_feature, day_segment){
|
||||
if(requested_feature == "countmostfrequentcontact"){
|
||||
# Get the most frequent contact
|
||||
calls <- calls %>% group_by(trace) %>%
|
||||
mutate(N=n()) %>%
|
||||
ungroup() %>%
|
||||
filter(N == max(N))
|
||||
|
||||
return(calls %>%
|
||||
filter_by_day_segment(day_segment) %>%
|
||||
summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := n()))
|
||||
} else {
|
||||
calls <- calls %>% filter_by_day_segment(day_segment)
|
||||
feature <- switch(requested_feature,
|
||||
"count" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := n()),
|
||||
"distinctcontacts" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := n_distinct(trace)),
|
||||
"meanduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := mean(call_duration)),
|
||||
"sumduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := sum(call_duration)),
|
||||
"minduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := min(call_duration)),
|
||||
"maxduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := max(call_duration)),
|
||||
"stdduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := sd(call_duration)),
|
||||
"modeduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := Mode(call_duration)),
|
||||
"hubermduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := huberM(call_duration)$mu),
|
||||
"varqnduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := Qn(call_duration)),
|
||||
"entropyduration" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := entropy.MillerMadow(call_duration)),
|
||||
"timefirstcall" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := first(local_hour) + (first(local_minute)/60)),
|
||||
"timelastcall" = calls %>% summarise(!!paste("call", type, day_segment, requested_feature, sep = "_") := last(local_hour) + (last(local_minute)/60)))
|
||||
return(feature)
|
||||
}
|
||||
}
|
||||
|
||||
calls <- read.csv(snakemake@input[[1]], stringsAsFactors = FALSE)
|
||||
day_segment <- snakemake@params[["day_segment"]]
|
||||
requested_features <- snakemake@params[["features"]]
|
||||
type <- snakemake@params[["call_type"]]
|
||||
call_type <- snakemake@params[["call_type"]]
|
||||
features = data.frame(local_date = character(), stringsAsFactors = FALSE)
|
||||
|
||||
calls <- calls %>% filter(call_type == ifelse(type == "incoming", "1", ifelse(type == "outgoing", "2", "3")))
|
||||
# Compute base Call features
|
||||
features <- merge(features, base_call_features(calls, call_type, day_segment, requested_features), by="local_date", all = TRUE)
|
||||
|
||||
for(requested_feature in requested_features){
|
||||
feature <- compute_call_feature(calls, requested_feature, day_segment)
|
||||
features <- merge(features, feature, by="local_date", all = TRUE)
|
||||
}
|
||||
|
||||
if("countmostfrequentcontact" %in% requested_features)
|
||||
features <- features %>% mutate_at(vars(contains('countmostfrequentcontact')), funs(ifelse(is.na(.), 0, .)))
|
||||
if(ncol(features) != length(requested_features) + 1)
|
||||
stop(paste0("The number of features in the output dataframe (=", ncol(features),") does not match the expected value (=", length(requested_features)," + 1). Verify your Call feature extraction functions"))
|
||||
|
||||
write.csv(features, snakemake@output[[1]], row.names = FALSE)
|
||||
|
|
Loading…
Reference in New Issue