James Twose
290 lines
8.8 KiB
Plaintext
290 lines
8.8 KiB
Plaintext
---
|
|
title: "Recurrence Networks of Daily questionnaires on work motivation"
|
|
subtitle: " "
|
|
author:
|
|
- "James Twose"
|
|
output:
|
|
html_notebook:
|
|
code_folding: hide
|
|
---
|
|
|
|
## Using recurrence networks to summarise time series of MS users in APPS MS
|
|
|
|
#### Read in necessary libraries, functions and look up tables
|
|
|
|
```{r echo=TRUE, warning=FALSE, message=FALSE}
|
|
library(igraph)
|
|
library(qgraph)
|
|
library(casnet)
|
|
library(plyr)
|
|
library(dplyr)
|
|
library(tidyr)
|
|
library(caret)
|
|
library(psych)
|
|
library(lme4)
|
|
library(reshape2)
|
|
library(lubridate)
|
|
library(parallel)
|
|
library(wesanderson)
|
|
library(stringr)
|
|
library(matrixStats)
|
|
library(ggthemes)
|
|
library(gridExtra)
|
|
library(cowplot)
|
|
library(DataExplorer)
|
|
|
|
|
|
# save the original plotting space parameters
|
|
og_par <- par()
|
|
```
|
|
|
|
##### Show the session information
|
|
```{r}
|
|
devtools::session_info()
|
|
```
|
|
|
|
#### Read in data
|
|
|
|
```{r, echo=FALSE, warning=FALSE, message=FALSE}
|
|
# dai_df <- read.csv("data/relapse_w_matched_users_key_clusters.csv", row.names = "X")
|
|
dai_df <- read.csv("data/moti_feasibility_james_daily_pivot.csv", row.names = "X")
|
|
feature_of_interest <- "dedication"
|
|
```
|
|
|
|
```{r}
|
|
plot_intro(dai_df)
|
|
plot_bar(dai_df)
|
|
plot_correlation(dai_df)
|
|
```
|
|
|
|
|
|
```{r, echo=True, warning=FALSE, message=FALSE}
|
|
example_user <- "Moti143"
|
|
df <- dai_df[dai_df["User"] == example_user, ]
|
|
# vars <- colnames(dai_df)[5:8]#[3:60]
|
|
vars <- c("absorption", "amotivation", "autonomy", "competence", "dedication", "emotional_drain", "enjoyment",
|
|
"external.pressure", "importance", "interest", "internal.pressure", "productivity_work", "relatedness", "satisfaction_work", "time_pressure", "vigor")
|
|
vars
|
|
```
|
|
|
|
### Split the keystroke df into a list of dfs based on User
|
|
|
|
```{r}
|
|
# head(dai_df)
|
|
# dai_df %>% group_by(User) %>% summarize(count = n())
|
|
|
|
df_list <- split(dai_df[c("User", vars)], dai_df["User"])
|
|
```
|
|
|
|
### Define the functions which will be applied to each user individually
|
|
|
|
```{r, echo=FALSE, warning=FALSE, message=FALSE}
|
|
# Impute missing values with Classification And Regression Trees / Random Forests
|
|
# RF and CART return (identical) discrete numbers
|
|
# imp.cart <- mice::mice(df[vars], method = 'cart', remove.constant = TRUE, remove.collinear = TRUE, printFlag = FALSE)
|
|
# df_imp <- mice::complete(imp.cart)
|
|
|
|
quiet <- function(x) {
|
|
sink(tempfile())
|
|
on.exit(sink())
|
|
invisible(force(x))
|
|
}
|
|
|
|
apply_imputation <- function(df, vars){
|
|
imp.cart <- mice::mice(df[1:60, vars], method = 'cart', remove.constant = TRUE, remove.collinear = TRUE, printFlag = FALSE)
|
|
# imp.cart <- mice::mice(df[vars], method = 'cart', remove.constant = TRUE, remove.collinear = TRUE, printFlag = FALSE)
|
|
df_imp <- mice::complete(imp.cart)
|
|
df_imp["User"] <- df["User"]
|
|
return(df_imp)
|
|
}
|
|
|
|
|
|
apply_scaling <- function(df, vars) {
|
|
df_scal <- data.frame(apply(df[vars], 2, elascer))
|
|
df_scal["User"] <- df["User"]
|
|
return(df_scal)
|
|
}
|
|
|
|
apply_RP_measures <- function(df, vars, emDim, emLag) {
|
|
|
|
RPs <- plyr::llply(1:length(vars), function(r) rp(y1 = df[1:60, r], emDim = emDim, emLag = emLag, emRad = NA, targetValue = 0.05))
|
|
# RPs <- plyr::llply(1:length(vars), function(r) rp(y1 = df[, r], emDim = emDim, emLag = emLag, emRad = NA, targetValue = 0.05))
|
|
print(df[1, "User"])
|
|
RP_measures_list <- plyr::llply(RPs, function(r) rp_measures(RM=r,
|
|
emRad = 0.05,
|
|
DLmin = 2,
|
|
VLmin = 2,
|
|
HLmin = 2,
|
|
silent = TRUE))
|
|
|
|
user_rp_measures_df <- reshape::merge_all(RP_measures_list)
|
|
user_rp_measures_df <- user_rp_measures_df[order(as.numeric(rownames(user_rp_measures_df))), ]
|
|
user_rp_measures_df["feature"] <- vars
|
|
user_rp_measures_df["User"] <- df["User"]
|
|
return(user_rp_measures_df)
|
|
}
|
|
|
|
|
|
apply_RN_plots <- function(df, feature_of_interest, emDim, emLag) {
|
|
RN <- rn(y1 = df[1:60, feature_of_interest], emDim = emDim, emLag = emLag, emRad = NA, targetValue = 0.05)
|
|
# RN <- rn(y1 = df[, feature_of_interest], emDim = emDim, emLag = emLag, emRad = NA, targetValue = 0.05)
|
|
|
|
arcs <- 6
|
|
User <- df[1, "User"]
|
|
|
|
g1 <- igraph::graph_from_adjacency_matrix(RN, mode="undirected", diag = FALSE)
|
|
igraph::V(g1)$size <- igraph::degree(g1)
|
|
g1r <- casnet::make_spiral_graph(g1,
|
|
# type = "Euler",
|
|
arcs = arcs,
|
|
epochColours = getColours(arcs),
|
|
title = paste("User ==", User),
|
|
markTimeBy = TRUE)
|
|
ggsave(paste0("images/spiral_graph_short", User, ".png"))
|
|
return(g1r)
|
|
}
|
|
|
|
apply_RN_measures <- function(df, feature_of_interest, emDim, emLag) {
|
|
RN <- rn(y1 = df[1:60, feature_of_interest], emDim = emDim, emLag = emLag, emRad = NA, targetValue = 0.05)
|
|
# RN <- rn(y1 = df[, feature_of_interest], emDim = emDim, emLag = emLag, emRad = NA, targetValue = 0.05)
|
|
|
|
arcs <- 6
|
|
User <- df[1, "User"]
|
|
|
|
g1 <- igraph::graph_from_adjacency_matrix(RN, mode="undirected", diag = FALSE)
|
|
network_measures <- rn_measures(g1, silent = TRUE)
|
|
graph_measures_df <- network_measures$graph_measures
|
|
graph_measures_df["User"] <- df["User"]
|
|
|
|
return(graph_measures_df)
|
|
}
|
|
|
|
```
|
|
|
|
### Select users with long enough time series
|
|
```{r}
|
|
user_row_lengths_list <- lapply(df_list, function(x) length(rownames(x)))
|
|
user_row_lengths_df <- t(data.frame(user_row_lengths_list))
|
|
user_row_lengths_df <- data.frame(cbind(user_row_lengths_df, unique(dai_df$User)))
|
|
|
|
user_row_lengths_df$X1 <- as.numeric(user_row_lengths_df$X1)
|
|
|
|
# User_list <- user_row_lengths_df[user_row_lengths_df["X1"] > 30, "X2"]
|
|
# User_list <- unique(dai_df$User)
|
|
# User_list <- c('Moti148', 'Moti143', 'Moti140', 'Moti156', 'Moti151')
|
|
User_list <- c(
|
|
# 'Moti114',
|
|
# 'Moti147',
|
|
'Moti149',
|
|
'Moti164',
|
|
'Moti106',
|
|
'Moti121',
|
|
'Moti137',
|
|
'Moti138',
|
|
'Moti150',
|
|
'Moti157',
|
|
'Moti148',
|
|
'Moti143',
|
|
'Moti140',
|
|
'Moti156',
|
|
'Moti151')
|
|
|
|
df_list <- df_list[names(df_list) %in% User_list]
|
|
# df_list_imp_scal <- df_list_imp_scal[names(df_list_imp_scal) %in% User_list]
|
|
```
|
|
|
|
### Prepare the data (impute and min max scale) and plot an example feature
|
|
|
|
```{r}
|
|
df_list_imp <- lapply(df_list, apply_imputation, vars)
|
|
df_list_imp_scal <- lapply(df_list_imp, apply_scaling, vars)
|
|
df_list_imp[example_user]
|
|
df_list_imp_scal[example_user]
|
|
```
|
|
|
|
### Remove users from the imputed and scaled dfs list that had too many missing values
|
|
|
|
```{r}
|
|
user_drop_list <- c()
|
|
for (User in User_list) {
|
|
missing_amount <- sum(sapply(df_list_imp_scal[[as.character(User)]], function(x) sum(is.na(x))))
|
|
# print(User)
|
|
# print(missing_amount)
|
|
if (missing_amount > 0) {
|
|
print(User)
|
|
print(missing_amount)
|
|
user_drop_list <- c(user_drop_list, as.character(User))
|
|
}
|
|
}
|
|
|
|
df_list_imp_scal <- df_list_imp_scal[!names(df_list_imp_scal) %in% user_drop_list]
|
|
|
|
```
|
|
|
|
```{r, echo=FALSE, message=FALSE, results='hide'}
|
|
emLag <- 2
|
|
emDim <- 2
|
|
|
|
RP_measures_list <- quiet(lapply(df_list_imp_scal, apply_RP_measures, vars, emLag, emDim))
|
|
|
|
```
|
|
|
|
```{r}
|
|
# for (User in unique(dai_df$User)) {
|
|
# print(User)
|
|
# apply_RP_measures(df_list_imp_scal[as.character(User)], vars, emLag, emDim)
|
|
# }
|
|
|
|
```
|
|
|
|
|
|
### Identify the feature with the most variable Determinism (variance within users) and assign this the feature of interest for the rest of the analysis.
|
|
|
|
```{r, fig.width=15, fig.height=7}
|
|
all_RP_measures_df <- reshape::merge_all(RP_measures_list)
|
|
|
|
rqa_feature <- "ENT_dl" #TT_vl DET
|
|
|
|
all_RP_measures_df_long <- melt(all_RP_measures_df[, c("feature", rqa_feature)], id.vars = "feature")
|
|
|
|
g <- ggplot(all_RP_measures_df_long, aes(x=feature, y=value)) +
|
|
geom_boxplot(outlier.colour="#e58038", outlier.shape=8,
|
|
outlier.size=4) +
|
|
theme(axis.text.x = element_text(angle = 90))
|
|
print(g)
|
|
|
|
agg_RP_measures_df <- aggregate(all_RP_measures_df[, c(rqa_feature)], list(all_RP_measures_df$feature), var, na.rm=TRUE)
|
|
colnames(agg_RP_measures_df) <- c("feature", rqa_feature)
|
|
|
|
feature_of_interest <- agg_RP_measures_df[which(agg_RP_measures_df[rqa_feature]==max(agg_RP_measures_df[rqa_feature])), "feature"][1]
|
|
|
|
print("New feature of interest:")
|
|
feature_of_interest
|
|
|
|
```
|
|
|
|
### Spiral graphs of the feature of interest per user with embedding lag and embedding dimension the same across all users
|
|
|
|
```{r, echo=FALSE, message=FALSE, results='hide'}
|
|
# lapply(X=df_list_imp_scal, FUN=nrow)
|
|
feature_of_interest
|
|
# RNs_list <- lapply(df_list_imp_scal, apply_RNs, feature_of_interest, emLag, emDim)
|
|
RN_plots_list <- lapply(df_list_imp_scal, apply_RN_plots, feature_of_interest, emLag, emDim)
|
|
RN_measures_list <- lapply(df_list_imp_scal, apply_RN_measures, feature_of_interest, emLag, emDim)
|
|
|
|
```
|
|
```{r}
|
|
plot.ts(x=df_list_imp_scal[["Moti156"]]$enjoyment)
|
|
plot.ts(x=df_list[["Moti156"]]$enjoyment)
|
|
```
|
|
|
|
|
|
```{r}
|
|
feature_of_interest_RN_measures_df <- reshape::merge_all(RN_measures_list)
|
|
```
|
|
|
|
```{r}
|
|
# write.csv(feature_of_interest_RN_measures_df,
|
|
# file=paste("data/", feature_of_interest, "_RN_measures.csv", sep = ""))
|
|
```
|