Reorganising the folder structure and create a classification notebook for the new citizen shield data - currently the classification is young vs old using determinants to do with mask usage - main finding is that older people have more faith in masks to stop spread

work_motivation/work_motivation_EDA_requirements.txt

@@ -0,0 +1,11 @@
+jmspack==0.0.3
+matplotlib==3.3.4
+numpy==1.19.2
+pandas==1.2.3
+seaborn==0.11.1
+session_info==1.0.0
+IPython==7.21.0
+jupyter_client==6.1.7
+jupyter_core==4.7.1
+jupyterlab==2.2.6
+notebook==6.2.0

work_motivation/work_motivation_RNs.Rmd

@@ -0,0 +1,289 @@
+---
+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 = ""))
+```

work_motivation/work_motivation_extras.py

@@ -0,0 +1,28 @@
+sum_scores_columns = ['Intrinsic',
+ 'Identified',
+ 'Introjected',
+ 'ExternalSocial',
+ 'ExternalMaterial',
+ 'Amotivation',
+ 'ExternalTotal',
+ 'AutonomySat',
+ 'CompetenceSat',
+ 'RelatedSat',
+ 'AutonomyFrust',
+ 'CompetenceFrust',
+ 'RelatedFrust',
+ 'Vigor',
+ 'Dedication',
+ 'Absorption',
+ 'WorkEngagement',
+ 'SelfControl',
+ 'Congruence',
+ 'Interest',
+ 'Control',
+ 'AutonomousFunctioning',
+ 'IncStructResources',
+ 'DecHinderDemands',
+ 'IncChallengeDemands',
+ 'IncSocialResources',
+ 'Resilience',
+ 'Optimism']