---
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 <- "DET" #TT_vl

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 = ""))
```