From d5049a0c60cad5090ecad3afddafcb68979df364 Mon Sep 17 00:00:00 2001 From: Galyfray Date: Sun, 9 Jul 2023 21:59:08 +0200 Subject: [PATCH 1/2] portage du nouveau graphique sur les fichiers non recentrer --- MR52_OBRECHT_Cyril.Rmd | 935 +++++++++++++++++++++++ MR52_OBRECHT_Cyril_annexe.Rmd | 303 ++++++++ RScripts/Graphiques/GraphiquesCadrants.R | 27 + RScripts/RythmaFUNZIP5.7.R | 2 +- RScripts/Souris/SourisCadrants.R | 42 + RScripts/Souris/SourisGraphiques.1.1.R | 12 +- RScripts/Souris/SourisMain.1.0.R | 5 +- RScripts/Souris/SourisMoveAnalyse.1.0.R | 9 +- Rythma.5.7.R | 2 +- 9 files changed, 1330 insertions(+), 7 deletions(-) create mode 100644 MR52_OBRECHT_Cyril.Rmd create mode 100644 MR52_OBRECHT_Cyril_annexe.Rmd create mode 100644 RScripts/Graphiques/GraphiquesCadrants.R create mode 100644 RScripts/Souris/SourisCadrants.R diff --git a/MR52_OBRECHT_Cyril.Rmd b/MR52_OBRECHT_Cyril.Rmd new file mode 100644 index 0000000..96a857d --- /dev/null +++ b/MR52_OBRECHT_Cyril.Rmd @@ -0,0 +1,935 @@ +--- +title: "MR52 - Traitement, visualisation et analyse des mouvements de souris dans + les jeux à recentrage, homogénéisation des résultats des données souris" +output: + pdf_document: + toc: no + highlight: kate + html_document: + df_print: paged + toc: yes +header-includes: + - \usepackage{caption} + - \usepackage{fancyhdr} + - \pagestyle{fancy} + - \fancyhead[LO,LE]{MR52 - A2022} + - \fancyhead[LE,RO]{OBRECHT Cyril} +--- + +\newpage + +\setcounter{tocdepth}{5} +\tableofcontents + +\newpage +\listoffigures +\newpage + +## Introduction + + Le jeu vidéo est un médium complexe, basé sur l'art de la vidéo, il doit déjà s'exprimer par le biais des images qu'il nous montre et du son qu'il émet. Cependant, le jeu vidéo n'est pas un film, il est interactif. Il serait simpliste de résumé l'émotion que génère les jeux vidéos que par leur visuel, scénario et bande sonore. Il nous transmet aussi un sens par la gestuelle qu'il nous faut exécuter pour le jouer, le jeu vidéo peut par exemple nous choquer en nous forçant à faire des actions que l'on réprouve moralement. De facto, le joueur n'est plus qu'un simple spectateur, mais devient acteur. Le jeu fait réfléchir, de manière évidente pour les "puzzles" ou les "points and clic", ou moins comme pour les jeux d'aventure où le joueur écrit son histoire. Que cette réflexion soit flagrante ou non, consciente ou non, elle finit par se traduire par une action, un clic, un mouvement de stick, un geste Wii mote en main. Cette action, qui a germé dans les neurones du joueur, est matérialisé par le biais de ses muscles pour finir transmise au jeu par un signal électrique, sous la forme d'information. + + Il est difficile, voir impossible, de capturer chaque partie du processus, observer quel neurone a choisi l'activation de quel muscle et quand. Mais il est possible de capturer le clic, l'information qu'il produit. Cette capture est aisée, tous nos jeux la font. Ce n'est qu'avec cette information que les jeux nous transmettent ce qu'ils veulent nous faire ressentir. La rythmanalyse est un procédé qui se propose d'analyser ce que le jeu voie du joueur, ce que le jeu demande au joueur de faire. Cette méthode permet de répondre à la question "qu'arrive-t-il si aux jeux vidéo, je retire la vidéo ?", là où la réponse à la question inverse est toute trouvée : le let's play. +Cette méthode occulte une grande partie des biais par lesquels le jeu s'exprime pour mieux analyser ce qui reste. Il est ainsi possible d'analyser avec rigueur les variations de gameplay interne au jeu, mais aussi de le comparer à d'autres. La rythmanalyse permet de mieux étudier ce qui différencie tant cet art des autres : les manières qu'ont les joueurs d'y jouer. + + Aucune méthode n'est parfaite, toutes peuvent être améliorées. Le médium du jeu vidéo n'est pas uniforme, il y a une pluralité de technologie et de manière d'interagir avec. Ceci produit des données hétérogènes qu'il faut traiter pour pouvoir les comparer et les afficher afin de les comprendre. Visualiser pour interpréter. L'une des manières pour le joueur d'interagir avec le jeu est par le biais de la souris. Cependant, certains jeux interagissent aussi avec cette souris, pour des raisons techniques. Cette interaction prend la forme d'un recentrage. Régulièrement, le jeu repositionne le curseur au centre qu'il a défini. Cette inférence du jeu dans la position de la souris est transparente pour le joueur, mais pas pour la rythmanalyse. En effet, ces recentrages effectués fréquemment par le jeu rendent les données très difficiles à exploiter. Si difficile que désactiver l'analyse de ses données a été préféré au risque de mal analyser le jeu. L'objectif de ce rapport est de revisiter ce problème épineux et de proposer une manière robuste d'analyser ces données. + +\newpage + +## Traitement des données recentrées + +### Inspection des données + +Cette section est dédiée à une inspection préliminaire des données. L'objectif est d’étudier la forme et la manière dont les données brutes se répartissent afin de mieux pouvoir les exploiter. +```{r include = FALSE} + +rm(list=ls()) + +packages <- c("ggplot2", "gridExtra","RColorBrewer","treemapify","dplyr","data.table","rstudioapi","ggpubr","knitr") +if (length(setdiff(packages, rownames(installed.packages()))) > 0) { + install.packages(setdiff(packages, rownames(installed.packages()))) +} + +#chargement auto de tout les packages (evite q'un package manque a l'appel) +for(package in packages){ + library(package,character.only = T,warn.conflicts = F) +} + +session <- list.files (path = "Data", pattern = ".zip") # Recuperer liste des fichiers .zip dans le repertoire de travail + +source("RScripts/ImportScript.R") +import.script() + +# on importe les donnees et dezippe les fichiers +ImportZip (paste("Data",session [101],sep="/"), 0, "max") + +mouseData <- d.M[M.EVENEMENT == "mouse move",] +rm(d.K) +``` +Le jeu de données choisi contient un total de `r length(d.M$M.XPOS)` entrées. Ici, seules les entrées représentant un mouvement de la souris sont nécessaires. Cela nous laisse un total de `r length(mouseData$M.XPOS)` entrées à exploiter. + +Le graphique ci-dessous présente la répartition des différentes valeurs pour les coordonnées x et y du jeu de données étudié. + + +```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} + +info_x <- summary(mouseData$M.XPOS) + +histo_x <- ggplot(mouseData,aes(x = M.XPOS)) + + geom_histogram(binwidth = ((info_x[6]-info_x[1])/10)) + + ggtitle("Histograme des valeurs de X") + +histo_x_75 <- ggplot(mouseData[mouseData$M.XPOS > info_x[2] & mouseData$M.XPOS < info_x[5],],aes(x = M.XPOS)) + + geom_histogram(binwidth = ((info_x[5]-info_x[2])/10)) + + ggtitle(strwrap("Histograme des valeurs de X comprisent entre en le 1er et 3ème quartile (75% des valeurs)", 50)) + +print(ggarrange(histo_x, histo_x_75, + ncol = 2, nrow = 1)) +``` +\captionof{figure}{Répartition initiale de la composante X des coordonées} +```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} +info_y <- summary(mouseData$M.YPOS) + +histo_y <- ggplot(mouseData,aes(x = M.YPOS)) + + geom_histogram(binwidth = ((info_y[6]-info_y[1])/10)) + + ggtitle("Histograme des valeurs de Y") + +histo_y_75 <- ggplot(mouseData[mouseData$M.YPOS > info_y[2] & mouseData$M.YPOS < info_y[5],],aes(x = M.YPOS)) + + geom_histogram(binwidth = ((info_y[5]-info_y[2])/10)) + + ggtitle("Histograme des valeurs de Y\ncomprisent entre en le 1er et\n3ème quartile (75% des valeurs)") + +print(ggarrange(histo_y, histo_y_75, + ncol = 2, nrow = 1)) +``` +\captionof{figure}{Répartition initiale de la composante Y des coordonées} +\newpage +Un grand pic est présent que ce soit pour les X ou pour les Y. Une possible explication de ces pics serait que le logiciel de capture enregistre les mouvements de recentrage. + + +```{r} +count_x <- sort(table(mouseData$M.XPOS), decreasing = TRUE) +count_y <- sort(table(mouseData$M.YPOS), decreasing = TRUE) + +count_xy <- sort(table(paste(mouseData$M.XPOS,mouseData$M.YPOS)), decreasing = TRUE) + +max_xy <- count_xy[paste(names(count_x[1]),names(count_y[1]))] +xy_prop <- max_xy/ length(mouseData$M.XPOS) +``` + +Cependant, bien que les valeurs qui produisent ces pics sont compatibles avec cette hypothèse (`r names(count_y[1]) ` pour les Y et `r names(count_x[1])` pour les X) on peut observer qu'il y a très peu d'entrées correspondant à ces deux coordonnées en même temps. En effet, lorsque l'on prend le couple (X, Y) : `r max_xy` on obtient `r round(xy_prop*100,2)`% des entrées. Cela qui parait être bien peu de recentrage.
+On peut donc aisément conclure de ces observations que le logiciel d'enregistrement n'enregistre pas, au moins pas toujours, les mouvements de recentrage causés par le jeu. + +### Détection du centre +Dans cette section, une méthode, la plus fiable possible, pour trouver le centre du jeu sera élaborée. La fiabilité de cette méthode est cruciale, puisque si l'on se trompe ici, alors la totalité des résultats suivants, qui seront dépendants de cette valeur, seront inutilisables en pratique.
+Il est tout d'abord important de remarquer qu'une méthode est déjà présente, on pourrait donc supposer qu'elle a déjà fait ces preuves et ainsi passer à la suite. Cependant, cette méthode a été mise au point avec l’objectif de servir l’ancienne méthode de retraitement de ces données. L’ancienne méthode visait à détecter les recentrages et estimer les mouvements du joueur afin d’obtenir des données qui seraient celles qui auraient été enregistrées si le jeu ne recentrait pas. + +La solution présente consiste à prendre la valeur médiane des X et des Y comme étant les coordonnées du centre. Cette méthode a besoin, pour fonctionner, que les mouvements soient globalement répartis de manière équivalente entre la gauche et la droite, entre le bas et le haut, ou que le pic de valeur soit suffisamment prononcé pour absorber le décalage. + +Une solution qui apparaît satisfaisante serait de prendre comme centre le milieu de l'écran. En effet, le logiciel de capture enregistre la taille de l'écran, il serait donc tout à fait faisable de récupérer cette valeur. Cette solution a cependant de nombreuses failles. La première est que toutes les versions du logiciel n'enregistraient pas cette valeur. Ceci signifie que les enregistrements plus anciens seraient lésés. On peut également remarquer que lorsque l'on a deux écrans, le logiciel n'enregistre les dimensions que d'un seul écran. Écran qui n'est pas forcément celui sur-lequel le jeu est. Enfin, il est par ailleurs important de noter que tout le monde ne joue pas tout le temps en plein écran, la barre des tâches et les contours de la fenêtre du jeu vont décaler le centre. Toutes ces raisons font que cette solution qui paraissait, de prime abord, parfaite est en réalité bien moins fiable que la solution présente. + +À la vue de la taille des pics correspondant au centre, une autre solution pourrait être de prendre la valeur de ces pics comme valeur de centre. Pour que cette solution puisse être considérée comme fiable, il est nécessaire de comprendre pourquoi ces pics existent afin de savoir s'il s'agit d'un indicateur fiable. On peut distinguer deux hypothèses de travail : la première est que les recentrages sont détectés, la seconde est son opposée. + +Bien qu'aucun enregistrement n'ait montré que le logiciel de capture enregistre les recentrages, il reste nécessaire de prendre en compte ce cas puisque rien ne prouve qu'il ne se produira jamais. Si jamais le logiciel capture les recentrages, alors, il y aura une proportion anormalement élevée de mouvement effectué en direction du centre. Ce surplus de mouvement vers le centre aura pour effet certain de produire un pic notable aux coordonnées correspondant au centre. On peut donc conclure que cette méthode sera fiable dans le cas où les recentrages sont enregistrés. + +Si les recentrages ne sont pas enregistrés, il n'est pas possible d'assurer la présence des pics. On peut cependant aisément se convaincre qu'ils seront présents puisque chaque mouvement vers le haut augmentera la prépondérance de la valeur X centrale, de même, chaque mouvement vertical augmentera la prépondérance de la valeur Y centrale. La faille de cette méthode se trouve dans les mouvements diagonaux. En effet, si la majeure partie des mouvements effectués sont des diagonales, alors il y aura deux pics situés de part et d'autre de la valeur centrale. + +Il est tout à fait possible en théorie de détecter ce cas de figure, il suffira donc de passer par la méthode des médianes pour obtenir une estimation des coordonnées du centre. + +```{r} + +get_center <- function(data){ + med <- median(data) + maxs <- sort(table(data), decreasing = TRUE) + + if(med == as.integer(names(maxs[1])) ){ + return(med) + } + + test <- as.integer(names(maxs)) maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ + if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ + # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. + # La valeur médianne est alors ce qui ce rapproche le plus du centre + return(med) + } else { + # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et + # que la valeur maximal soit le vrai centre. + return(as.integer(names(maxs[1]))) + } + } else { + # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. + # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure + return(as.integer(names(maxs[1]))) + } + +} + + +center_x <- get_center(mouseData$M.XPOS) +center_y <- get_center(mouseData$M.YPOS) +``` + + +### Nettoyage des données +Lorsque l'on travaille sur des données, il est toujours nécessaire de les nettoyer, de supprimer le superflu inintéressant pour la question que l'on traite, d'atténuer le bruit causé par l'imperfection du mode d'acquisition. Ces données ne font pas exceptions, il est nécessaire de retirer des entrées du jeu de données. + +La première action qui sera prise est de retirer les doublons. Avant de chercher à les supprimer, nous allons tout d'abord les chercher et évaluer leur quantité. + +```{r} +is_duplcate <- duplicated(rleid(mouseData$M.XPOS,mouseData$M.YPOS)) +``` + +La fonction `rleid` génère un vecteur d'identifiant qui ne se répète que lorsque les valeurs de X et de Y sont les mêmes plusieurs fois d'affiler. Ceci nous permet de supprimer deux entrés consécutives pour une même coordonnée sans pour autant interdire la même coordonnée de revenir plus tard dans la liste. + +On obtient ainsi que `r round(length(is_duplcate[is_duplcate])/length(is_duplcate)*100,2)`% des entrées sont des duplicatas. Cette valeur est bien importante. Il est peu probable qu'autant de données ne cache pas d'information utile. Afin de ne pas risquer de supprimer de l'information qui pourrait être utile plus tard (pour moi ou pour autrui) seule les doublons situer en milieux de chaîne comme sur l'exemple ci-dessous seront supprimés. + +```{r echo=F,results='asis'} +olen <- length(mouseData$M.XPOS) + +kable(data.table(X = c(960,960,960,961,961,961,961), Y = c(530,530,531,531,531,531,531),DUPLICATE=c(F,T,F,F,T,T,T),KEPT=c(T,T,T,T,F,F,T))) + +``` +```{r} +to_remove <- which(is_duplcate) +to_remove <- to_remove[is_duplcate[to_remove+1]] +mouseData <- mouseData[-to_remove,] +``` + +Cette opération aura supprimé `r round(length(to_remove)/olen*100,2)`% des entrées. Le vaste décalage entre cette valeur et la précédente laisse supposer que la majeure partie des doublons viennent seul. Il est possible que ces doublons soient des sous produits causé par le recentrage : j'effectue un mouvement vers le haut, après un déplacement d'un pixel le jeu recentre ma souris, le logiciel ne détecte pas ce recentrage, je continue mon mouvement et repasse par le même pixel que précédemment. Il est aussi possible que ces doublons soient des indicateurs de fin et début de mouvement. + +Maintenant que les doublons ont été traités, nous allons chercher une méthode pour supprimer les données enregistrer hors du jeu. Par exemple lorsque l'on démarre ou arrête l'enregistrement. + +La méthode actuelle pour supprimer ces données consiste à chercher un unique seuil tel que : la somme des coordonnées plus éloignée du centre que le seuil représente environ 15% des données. Ces 15% de données sont ensuite supprimées. Cette méthode a fait ces preuves, mais il est sans doute possible de faire mieux. + +Deux défauts à la méthode actuelle peuvent être constatés. Le premier peut être sujet à débat : la méthode de sélection par seuil restreint à une zone carrée autour du centre. Il me parait plus naturel de restreindre à l'aide de la distance au centre. Le mouvement de la souris dans les jeux usant du recentrage est somme tout assez analogue à celui d'un stick d'une manette, aussi cela me parait plus logique d'utiliser une distance comme métrique sur laquelle appliquer un seuil. Le second défaut que j'observe est double : le seuil est très granuleux, mais aussi très limité. En effet, on considère des sauts de 20 pixels par 20 pixels (10 de part et d'autre du centre) mais surtout le seuil est limité à 50 pixels autour du centre. Cela, c'est jusqu'ici prouver suffisant avec les tests effectué sur des enregistrements provenant d'un moniteur en full HD. Cependant, rien n'indique que ce soit nécessairement le cas, entre autre, pour des jeux upscale sur des moniteurs en 4k. + +La limite de 85% arbitraire pourrait être amélioré, mais aucune méthode efficace afin de raffiner cette valeur n'a été trouvée, aussi, nous continuerons avec cette stratégie faute de mieux. + +La solution proposée est donc la suivante : + +```{r} +mouseData$M.DISTANCE <- sqrt( + (mouseData$M.XPOS - center_x) ^ 2 + + (mouseData$M.YPOS - center_y) ^ 2 +) + +mouseData <- mouseData[mouseData$M.DISTANCE < quantile(mouseData$M.DISTANCE,.85),] +``` +\newpage +Après nettoyage, les données peuvent de nouveaux être présentées sous la forme d'un graphique : + +```{r echo=FALSE} + +clean_data <- function(d.M){ + + is_duplcate <- duplicated(rleid(d.M$M.XPOS,d.M$M.YPOS)) + to_remove <- which(is_duplcate) + to_remove <- to_remove[is_duplcate[to_remove+1]] + d.M <- d.M[-to_remove,] + + + center_x <- get_center(d.M$M.XPOS) + + center_y <- get_center(d.M$M.YPOS) + + d.M$M.DISTANCE <- sqrt( + (d.M$M.XPOS - center_x) ^ 2 + + (d.M$M.YPOS - center_y) ^ 2 + ) + + d.M <- d.M[d.M$M.DISTANCE < quantile(d.M$M.DISTANCE,.85),] + + return(d.M) +} + +make_graph <- function(d.M) { + + info_x <- summary(d.M$M.XPOS) + info_y <- summary(d.M$M.YPOS) + + center_x <- get_center(d.M$M.XPOS) + + center_y <- get_center(d.M$M.YPOS) + + select_x <- "1er-3ème quartile" + select_y <- "1er-3ème quartile" + + if(info_x[5] - info_x[2] < 7){ + info_x[5] <- info_x[3] + 3 + info_x[2] <- info_x[3] - 3 + select_x <- "médiane +/- 3" + } + + sub_x <- d.M[d.M$M.XPOS >= info_x[2] & d.M$M.XPOS <= info_x[5],] + sub_x$isCenter <- sub_x$M.XPOS==center_x + + if(info_y[5] - info_y[2] < 7){ + info_y[5] <- info_y[3] + 3 + info_y[2] <- info_y[3] - 3 + select_y <- "médiane +/- 3" + } + + sub_y <- d.M[d.M$M.YPOS >= info_y[2] & d.M$M.YPOS <= info_y[5],] + sub_y$isCenter <- sub_y$M.YPOS==center_y + + histo_x <- ggplot(sub_x,aes(x = M.XPOS,fill= isCenter)) + + geom_histogram(binwidth = 1) + + ggtitle(paste("Histograme des valeurs de X com\n-prise entre ",select_x,sep=""))+ + scale_x_continuous(breaks = seq(min(sub_x$M.XPOS),max(sub_x$M.XPOS)))+ + theme(axis.text.x = element_text(angle = 45, hjust=1)) + + histo_y <- ggplot(sub_y,aes(x = M.YPOS,fill= isCenter)) + + geom_histogram(binwidth = 1) + + ggtitle(paste("Histograme des valeurs de Y com\n-prise entre ",select_y,sep=""))+ + scale_x_continuous(breaks = seq(min(sub_y$M.YPOS),max(sub_y$M.YPOS)))+ + theme(axis.text.x = element_text(angle = 45, hjust=1)) + + + return(ggarrange(histo_x,histo_y)) + +} +``` +```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} +make_graph(mouseData) +``` + +\captionof{figure}{Répartition des composante X et Y des coordonées après pré traitement.} + +## Visualisation des données recentré +Dans cette section, nous allons produire une visualisation des données recentrer. Je me suis inspiré de la visualisation des données du D pad. L'idée, l'objectif est de visualiser les directions de mouvement privilégié durant la session. + +Le graphique souhaité se compose donc plusieurs "part de gâteaux" dont la taille angulaire décrit la proportion du cercle qu'il représente et dont la hauteur est proportionnelle au nombre des points qu'il englobe. + +Nous allons dans un premier temps transformer nos coordonnées en nombre complexe afin d'ensuite en récupérer l'argument. Cette valeur d'angle qui nous est renvoyé est comprise entre $[-pi;pi[$ ce qui n'est pas tout à fait pratique. Nous allons ainsi décaler ces résultats vers $[frac{pi}{8}; 2pi+frac{pi}{8}[$. Il suffit après cela de répartir les angles produits en huit groupes, un par arc de cercle. + +Mathématiquement l'argument du complexe 0 est non défini, cepandant R concidère que l'argument de 0 est 0 malgré l'existance d'un symbole plus adapté à ce cas dans le langage. Il est donc important de retirer du calcule toute les coordonées qui sont égale au centre sans quoi un des axes véra sa valeur biaiser. + +\newpage +```{r, out.height="30%", fig.asp="1", fig.align="center"} + +cadrans <- 8:1 + +coords <- (mouseData$M.XPOS-center_x) +1i*(mouseData$M.YPOS-center_y) +coords <- coords[coords != 0] + +coords <- Arg(coords) +coords[coords maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ + if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ + # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. + # La valeur médianne est alors ce qui ce rapproche le plus du centre + return(med) + } else { + # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et + # que la valeur maximal soit le vrai centre. + return(as.integer(names(maxs[1]))) + } + } else { + # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. + # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure + return(as.integer(names(maxs[1]))) + } +} + +get_centers <- function(data){ + + maxs_x <- sort(table(data$M.XPOS), decreasing = TRUE) + maxs_y <- sort(table(data$M.YPOS), decreasing = TRUE) + + if( # Les pics sont adjacents + abs( as.integer(names(maxs_x[1])) - as.integer(names(maxs_x[2])) ) == 1 & + abs( as.integer(names(maxs_y[1])) - as.integer(names(maxs_y[2])) ) == 1 + ){ + # Les pics sont de taille comparable + if ( maxs_x[2]/maxs_x[1] > 0.9 & maxs_y[2]/maxs_y[1] > 0.9 ){ + center_x = min(as.integer(names(maxs_x[1])),as.integer(names(maxs_x[2]))) + center_y = min(as.integer(names(maxs_y[1])),as.integer(names(maxs_y[2]))) + # Décalage des données pour compacter le centre sur 1 pixel + + data$M.XPOS[data$M.XPOS > center_x] <- data$M.XPOS[data$M.XPOS > center_x] - 1 + data$M.YPOS[data$M.YPOS > center_y] <- data$M.YPOS[data$M.YPOS > center_y] - 1 + + return(c(center_x,center_y,data)) + + } + } + center_x <- get_center(median(data$M.XPOS),maxs_x) + center_y <- get_center(median(data$M.YPOS),maxs_y) + + return(c(center_x,center_y,data)) + +} + +``` +```{r echo=FALSE} +clean_data <- function(d.M){ + + is_duplcate <- duplicated(rleid(d.M$M.XPOS,d.M$M.YPOS)) + to_remove <- which(is_duplcate) + to_remove <- to_remove[is_duplcate[to_remove+1]] + d.M <- d.M[-to_remove,] + + + data <- get_centers(d.M) + + d.M <- data.frame(data[c(-1,-2)]) + + center_y <- data[[2]] + center_x <- data[[1]] + + d.M$M.DISTANCE <- sqrt( + (d.M$M.XPOS - center_x) ^ 2 + + (d.M$M.YPOS - center_y) ^ 2 + ) + + d.M <- d.M[d.M$M.DISTANCE < quantile(d.M$M.DISTANCE,.85),] + + return(d.M) +} + +make_graph <- function(d.M) { + + info_x <- summary(d.M$M.XPOS) + info_y <- summary(d.M$M.YPOS) + + data <- get_centers(d.M) + + d.M <- data.frame(data[c(-1,-2)]) + + center_y <- data[[2]] + center_x <- data[[1]] + + select_x <- "1er-3ème quartile" + select_y <- "1er-3ème quartile" + + if(info_x[5] - info_x[2] < 7){ + info_x[5] <- info_x[3] + 3 + info_x[2] <- info_x[3] - 3 + select_x <- "médiane +/- 3" + } + + sub_x <- d.M[d.M$M.XPOS >= info_x[2] & d.M$M.XPOS <= info_x[5],] + sub_x$isCenter <- sub_x$M.XPOS==center_x + + if(info_y[5] - info_y[2] < 7){ + info_y[5] <- info_y[3] + 3 + info_y[2] <- info_y[3] - 3 + select_y <- "médiane +/- 3" + } + + sub_y <- d.M[d.M$M.YPOS >= info_y[2] & d.M$M.YPOS <= info_y[5],] + sub_y$isCenter <- sub_y$M.YPOS==center_y + + histo_x <- ggplot(sub_x,aes(x = M.XPOS,fill= isCenter)) + + geom_histogram(binwidth = 1) + + ggtitle(paste("Histograme des valeurs de X comprise\nentre ",select_x,sep=""))+ + scale_x_continuous(breaks = seq(min(sub_x$M.XPOS),max(sub_x$M.XPOS)))+ + theme(axis.text.x = element_text(angle = 45, hjust=1)) + + histo_y <- ggplot(sub_y,aes(x = M.YPOS,fill= isCenter)) + + geom_histogram(binwidth = 1) + + ggtitle(paste("Histograme des valeurs de Y comprise\nentre ",select_y,sep=""))+ + scale_x_continuous(breaks = seq(min(sub_y$M.YPOS),max(sub_y$M.YPOS)))+ + theme(axis.text.x = element_text(angle = 45, hjust=1)) + + + return(ggarrange(histo_x,histo_y)) +} + +``` +```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} +ImportZip (paste("Data",session [102],sep="/"), 0, "max") +mouseData <- d.M[M.EVENEMENT == "mouse move",] +rm(d.K) +make_graph(clean_data(mouseData)) +``` +\captionof{figure}{Répartition des composante X et Y des coordonées après pré traitement. - My time at portia} +```{r echo=FALSE, out.height="30%", fig.asp="1", fig.align="center"} +data <- get_centers(mouseData) + +mouseData <- data.frame(data[c(-1,-2)]) + +center_y <- data[[2]] +center_x <- data[[1]] + +is_duplcate <- duplicated(rleid(mouseData$M.XPOS,mouseData$M.YPOS)) + +to_remove <- which(is_duplcate) +to_remove <- to_remove[is_duplcate[to_remove+1]] +mouseData <- mouseData[-to_remove,] + +mouseData$M.DISTANCE <- sqrt( + (mouseData$M.XPOS - center_x) ^ 2 + + (mouseData$M.YPOS - center_y) ^ 2 +) + +mouseData <- mouseData[mouseData$M.DISTANCE < quantile(mouseData$M.DISTANCE,.85),] + +cadrans <- 8:1 + +coords <- (mouseData$M.XPOS-center_x) +1i*(mouseData$M.YPOS-center_y) +coords <- coords[coords != 0] + +coords <- Arg(coords) +coords[coords 0) { + install.packages(setdiff(packages, rownames(installed.packages()))) +} + +#chargement auto de tout les packages (evite q'un package manque a l'appel) +for(package in packages){ + library(package,character.only = T,warn.conflicts = F) +} + +session <- list.files (path = "Data", pattern = ".zip") # Recuperer liste des fichiers .zip dans le repertoire de travail + +source("RScripts/ImportScript.R") +import.script() + + +``` + +```{r include = FALSE} + +get_center <- function(med,maxs){ + if(med == as.integer(names(maxs[1])) ){ + return(c(med,"both")) + } + + test <- as.integer(names(maxs)) maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ + if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ + # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. + # La valeur médianne est alors ce qui ce rapproche le plus du centre + return(c(med,"med: rivière")) + } else { + # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et + # que la valeur maximal soit le vrai centre. + return(c(names(maxs[1]),"max: bruit")) + } + } else { + # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. + # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure + return(c(names(maxs[1]),"max: pic")) + } + +} + + +get_centers <- function(data){ + + maxs_x <- sort(table(data$M.XPOS), decreasing = TRUE) + maxs_y <- sort(table(data$M.YPOS), decreasing = TRUE) + + if( # Les pics sont adjacents + abs( as.integer(names(maxs_x[1])) - as.integer(names(maxs_x[2])) ) == 1 & + abs( as.integer(names(maxs_y[1])) - as.integer(names(maxs_y[2])) ) == 1 + ){ + # Les pics sont de taille comparable + if ( maxs_x[2]/maxs_x[1] > 0.9 & maxs_y[2]/maxs_y[1] > 0.9 ){ + center_x = min(as.integer(names(maxs_x[1])),as.integer(names(maxs_x[2]))) + center_y = min(as.integer(names(maxs_y[1])),as.integer(names(maxs_y[2]))) + # Décalage des données pour compacter le centre sur 1 pixel + + data$M.XPOS[data$M.XPOS > center_x] <- data$M.XPOS[data$M.XPOS > center_x] - 1 + data$M.YPOS[data$M.YPOS > center_y] <- data$M.YPOS[data$M.YPOS > center_y] - 1 + + return(c(center_x,center_y,"quad","quad",data)) + + } + } + center_x <- get_center(median(data$M.XPOS),maxs_x) + center_y <- get_center(median(data$M.YPOS),maxs_y) + + return(c(center_x[1],center_y[1],center_x[2],center_y[2],data)) + +} + +filter_datasets <- function(dataset_name) { + # on importe les donnees et dezippe les fichiers + ImportZip (paste("Data",dataset_name,sep="/"), 0, "max") + name <- substr(dataset_name,15,nchar(dataset_name)-4) + d.M <- d.M[M.EVENEMENT == "mouse move",] + + cond1 <- fivenum(d.M$M.XPOS)[4] - fivenum(d.M$M.XPOS)[2] + cond2 <- fivenum(d.M$M.YPOS)[4] - fivenum(d.M$M.YPOS)[2] + if(cond1 < 20 & cond2 < 20){ + return(c(name,d.M)) + } else { + return(NA) + } +} + +clean_data <- function(d.M){ + + name <-d.M[[1]] + d.M <- data.frame(d.M[-1]) + + is_duplcate <- duplicated(rleid(d.M$M.XPOS,d.M$M.YPOS)) + to_remove <- which(is_duplcate) + to_remove <- to_remove[is_duplcate[to_remove+1]] + # If a duplicated value is at the end of the list it produce a NA + to_remove <- to_remove[!is.na(to_remove)] + + d.M <- d.M[-to_remove,] + centers <- get_centers(d.M) + + center_x <- as.integer(centers[1]) + center_y <- as.integer(centers[2]) + + d.M <- data.frame(centers[c(-1,-2,-3,-4)]) + + d.M$M.DISTANCE <- sqrt( + (d.M$M.XPOS - center_x) ^ 2 + + (d.M$M.YPOS - center_y) ^ 2 + ) + + d.M <- data.table(d.M[d.M$M.DISTANCE < quantile(d.M$M.DISTANCE,.85),]) + + return(c(name,centers[3],centers[4],d.M)) +} + +make_graph <- function(d.M) { + name <-d.M[[1]] + + meth_x <- d.M[[2]] + meth_y <- d.M[[3]] + + d.M <- data.frame(d.M[c(-1,-2,-3)]) + + info_x <- summary(d.M$M.XPOS) + info_y <- summary(d.M$M.YPOS) + + + centers <- get_centers(d.M) + + center_x <- centers[1] + center_y <- centers[2] + + d.M <- data.frame(centers[c(-1,-2,-3,-4)]) + + select_x <- "1er-3ème quartile" + select_y <- "1er-3ème quartile" + + if(info_x[5] - info_x[2] < 7){ + info_x[5] <- info_x[3] + 3 + info_x[2] <- info_x[3] - 3 + select_x <- "médiane +/- 3" + } + + sub_x <- d.M[d.M$M.XPOS >= info_x[2] & d.M$M.XPOS <= info_x[5],] + sub_x$isCenter <- sub_x$M.XPOS==center_x + + if(info_y[5] - info_y[2] < 7){ + info_y[5] <- info_y[3] + 3 + info_y[2] <- info_y[3] - 3 + select_y <- "médiane +/- 3" + } + + sub_y <- d.M[d.M$M.YPOS >= info_y[2] & d.M$M.YPOS <= info_y[5],] + sub_y$isCenter <- sub_y$M.YPOS==center_y + + histo_x <- ggplot(sub_x,aes(x = M.XPOS,fill= isCenter)) + + geom_histogram(binwidth = 1) + + ggtitle(paste("Histograme des valeurs de X comprise\nentre ",select_x," (",meth_x,")",sep=""))+ + scale_x_continuous(breaks = seq(min(sub_x$M.XPOS),max(sub_x$M.XPOS)))+ + theme(axis.text.x = element_text(angle = 45, hjust=1)) + + histo_y <- ggplot(sub_y,aes(x = M.YPOS,fill= isCenter)) + + geom_histogram(binwidth = 1) + + ggtitle(paste("Histograme des valeurs de Y comprise\nentre ",select_y," (",meth_y,")",sep=""))+ + scale_x_continuous(breaks = seq(min(sub_y$M.YPOS),max(sub_y$M.YPOS)))+ + theme(axis.text.x = element_text(angle = 45, hjust=1)) + + + return(annotate_figure(ggarrange(histo_x,histo_y),top = paste(name,": ",round(max(d.M$M.TEMPS)/60,2), "min",sep = ""))) + +} +``` +```{r include = FALSE} +datas <- lapply(session, filter_datasets) + +datas <- datas[!is.na(datas)] + +names <- unlist(lapply(datas, `[[`, 1)) + +datas <- lapply(datas, clean_data) + +graphs <- lapply(datas, make_graph) + +``` + +```{r histograms, echo=FALSE, dev='pdf', fig.show='hide'} +# fig.height=4,fig.width=9, +for( p in graphs){ + print(p) +} +``` +\clearpage +\newpage +```{r, echo=FALSE, out.height="40%", fig.cap=names} +include_graphics(fig_chunk(label = "histograms", ext = "pdf", number = 1:length(graphs))) +``` + +```{r} +cadran <- function(data,nb.cadran=8){ + cadrans <- nb.cadran:1 + name <-data[[1]] + + meth_x <- data[[2]] + meth_y <- data[[3]] + + data <- data.frame(data[c(-1,-2,-3)]) + + x<- data$M.XPOS + y<- data$M.YPOS + + centers <- get_centers(data) + + cx <- as.integer(centers[1]) + cy <- as.integer(centers[2]) + + coords <- (x-cx) +1i*(y-cy) + + coords <- coords[coords != 0] + + coords <- Arg(coords) + coords[coords Date: Sun, 9 Jul 2023 22:37:50 +0200 Subject: [PATCH 2/2] =?UTF-8?q?Cr=C3=A9ation=20du=20nouveau=20graphqie=20p?= =?UTF-8?q?our=20les=20donn=C3=A9e=20recentrer?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- MR52_OBRECHT_Cyril.Rmd | 935 ------------------------ MR52_OBRECHT_Cyril_annexe.Rmd | 303 -------- RScripts/RythmaFUNZIP5.7.R | 2 +- RScripts/Souris/SourisCadrants.R | 93 ++- RScripts/Souris/SourisGraphiques.1.1.R | 13 +- RScripts/Souris/SourisMoveAnalyse.1.0.R | 2 +- Rythma.5.7.R | 1 - 7 files changed, 97 insertions(+), 1252 deletions(-) delete mode 100644 MR52_OBRECHT_Cyril.Rmd delete mode 100644 MR52_OBRECHT_Cyril_annexe.Rmd diff --git a/MR52_OBRECHT_Cyril.Rmd b/MR52_OBRECHT_Cyril.Rmd deleted file mode 100644 index 96a857d..0000000 --- a/MR52_OBRECHT_Cyril.Rmd +++ /dev/null @@ -1,935 +0,0 @@ ---- -title: "MR52 - Traitement, visualisation et analyse des mouvements de souris dans - les jeux à recentrage, homogénéisation des résultats des données souris" -output: - pdf_document: - toc: no - highlight: kate - html_document: - df_print: paged - toc: yes -header-includes: - - \usepackage{caption} - - \usepackage{fancyhdr} - - \pagestyle{fancy} - - \fancyhead[LO,LE]{MR52 - A2022} - - \fancyhead[LE,RO]{OBRECHT Cyril} ---- - -\newpage - -\setcounter{tocdepth}{5} -\tableofcontents - -\newpage -\listoffigures -\newpage - -## Introduction - - Le jeu vidéo est un médium complexe, basé sur l'art de la vidéo, il doit déjà s'exprimer par le biais des images qu'il nous montre et du son qu'il émet. Cependant, le jeu vidéo n'est pas un film, il est interactif. Il serait simpliste de résumé l'émotion que génère les jeux vidéos que par leur visuel, scénario et bande sonore. Il nous transmet aussi un sens par la gestuelle qu'il nous faut exécuter pour le jouer, le jeu vidéo peut par exemple nous choquer en nous forçant à faire des actions que l'on réprouve moralement. De facto, le joueur n'est plus qu'un simple spectateur, mais devient acteur. Le jeu fait réfléchir, de manière évidente pour les "puzzles" ou les "points and clic", ou moins comme pour les jeux d'aventure où le joueur écrit son histoire. Que cette réflexion soit flagrante ou non, consciente ou non, elle finit par se traduire par une action, un clic, un mouvement de stick, un geste Wii mote en main. Cette action, qui a germé dans les neurones du joueur, est matérialisé par le biais de ses muscles pour finir transmise au jeu par un signal électrique, sous la forme d'information. - - Il est difficile, voir impossible, de capturer chaque partie du processus, observer quel neurone a choisi l'activation de quel muscle et quand. Mais il est possible de capturer le clic, l'information qu'il produit. Cette capture est aisée, tous nos jeux la font. Ce n'est qu'avec cette information que les jeux nous transmettent ce qu'ils veulent nous faire ressentir. La rythmanalyse est un procédé qui se propose d'analyser ce que le jeu voie du joueur, ce que le jeu demande au joueur de faire. Cette méthode permet de répondre à la question "qu'arrive-t-il si aux jeux vidéo, je retire la vidéo ?", là où la réponse à la question inverse est toute trouvée : le let's play. -Cette méthode occulte une grande partie des biais par lesquels le jeu s'exprime pour mieux analyser ce qui reste. Il est ainsi possible d'analyser avec rigueur les variations de gameplay interne au jeu, mais aussi de le comparer à d'autres. La rythmanalyse permet de mieux étudier ce qui différencie tant cet art des autres : les manières qu'ont les joueurs d'y jouer. - - Aucune méthode n'est parfaite, toutes peuvent être améliorées. Le médium du jeu vidéo n'est pas uniforme, il y a une pluralité de technologie et de manière d'interagir avec. Ceci produit des données hétérogènes qu'il faut traiter pour pouvoir les comparer et les afficher afin de les comprendre. Visualiser pour interpréter. L'une des manières pour le joueur d'interagir avec le jeu est par le biais de la souris. Cependant, certains jeux interagissent aussi avec cette souris, pour des raisons techniques. Cette interaction prend la forme d'un recentrage. Régulièrement, le jeu repositionne le curseur au centre qu'il a défini. Cette inférence du jeu dans la position de la souris est transparente pour le joueur, mais pas pour la rythmanalyse. En effet, ces recentrages effectués fréquemment par le jeu rendent les données très difficiles à exploiter. Si difficile que désactiver l'analyse de ses données a été préféré au risque de mal analyser le jeu. L'objectif de ce rapport est de revisiter ce problème épineux et de proposer une manière robuste d'analyser ces données. - -\newpage - -## Traitement des données recentrées - -### Inspection des données - -Cette section est dédiée à une inspection préliminaire des données. L'objectif est d’étudier la forme et la manière dont les données brutes se répartissent afin de mieux pouvoir les exploiter. -```{r include = FALSE} - -rm(list=ls()) - -packages <- c("ggplot2", "gridExtra","RColorBrewer","treemapify","dplyr","data.table","rstudioapi","ggpubr","knitr") -if (length(setdiff(packages, rownames(installed.packages()))) > 0) { - install.packages(setdiff(packages, rownames(installed.packages()))) -} - -#chargement auto de tout les packages (evite q'un package manque a l'appel) -for(package in packages){ - library(package,character.only = T,warn.conflicts = F) -} - -session <- list.files (path = "Data", pattern = ".zip") # Recuperer liste des fichiers .zip dans le repertoire de travail - -source("RScripts/ImportScript.R") -import.script() - -# on importe les donnees et dezippe les fichiers -ImportZip (paste("Data",session [101],sep="/"), 0, "max") - -mouseData <- d.M[M.EVENEMENT == "mouse move",] -rm(d.K) -``` -Le jeu de données choisi contient un total de `r length(d.M$M.XPOS)` entrées. Ici, seules les entrées représentant un mouvement de la souris sont nécessaires. Cela nous laisse un total de `r length(mouseData$M.XPOS)` entrées à exploiter. - -Le graphique ci-dessous présente la répartition des différentes valeurs pour les coordonnées x et y du jeu de données étudié. - - -```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} - -info_x <- summary(mouseData$M.XPOS) - -histo_x <- ggplot(mouseData,aes(x = M.XPOS)) + - geom_histogram(binwidth = ((info_x[6]-info_x[1])/10)) + - ggtitle("Histograme des valeurs de X") - -histo_x_75 <- ggplot(mouseData[mouseData$M.XPOS > info_x[2] & mouseData$M.XPOS < info_x[5],],aes(x = M.XPOS)) + - geom_histogram(binwidth = ((info_x[5]-info_x[2])/10)) + - ggtitle(strwrap("Histograme des valeurs de X comprisent entre en le 1er et 3ème quartile (75% des valeurs)", 50)) - -print(ggarrange(histo_x, histo_x_75, - ncol = 2, nrow = 1)) -``` -\captionof{figure}{Répartition initiale de la composante X des coordonées} -```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} -info_y <- summary(mouseData$M.YPOS) - -histo_y <- ggplot(mouseData,aes(x = M.YPOS)) + - geom_histogram(binwidth = ((info_y[6]-info_y[1])/10)) + - ggtitle("Histograme des valeurs de Y") - -histo_y_75 <- ggplot(mouseData[mouseData$M.YPOS > info_y[2] & mouseData$M.YPOS < info_y[5],],aes(x = M.YPOS)) + - geom_histogram(binwidth = ((info_y[5]-info_y[2])/10)) + - ggtitle("Histograme des valeurs de Y\ncomprisent entre en le 1er et\n3ème quartile (75% des valeurs)") - -print(ggarrange(histo_y, histo_y_75, - ncol = 2, nrow = 1)) -``` -\captionof{figure}{Répartition initiale de la composante Y des coordonées} -\newpage -Un grand pic est présent que ce soit pour les X ou pour les Y. Une possible explication de ces pics serait que le logiciel de capture enregistre les mouvements de recentrage. - - -```{r} -count_x <- sort(table(mouseData$M.XPOS), decreasing = TRUE) -count_y <- sort(table(mouseData$M.YPOS), decreasing = TRUE) - -count_xy <- sort(table(paste(mouseData$M.XPOS,mouseData$M.YPOS)), decreasing = TRUE) - -max_xy <- count_xy[paste(names(count_x[1]),names(count_y[1]))] -xy_prop <- max_xy/ length(mouseData$M.XPOS) -``` - -Cependant, bien que les valeurs qui produisent ces pics sont compatibles avec cette hypothèse (`r names(count_y[1]) ` pour les Y et `r names(count_x[1])` pour les X) on peut observer qu'il y a très peu d'entrées correspondant à ces deux coordonnées en même temps. En effet, lorsque l'on prend le couple (X, Y) : `r max_xy` on obtient `r round(xy_prop*100,2)`% des entrées. Cela qui parait être bien peu de recentrage.
-On peut donc aisément conclure de ces observations que le logiciel d'enregistrement n'enregistre pas, au moins pas toujours, les mouvements de recentrage causés par le jeu. - -### Détection du centre -Dans cette section, une méthode, la plus fiable possible, pour trouver le centre du jeu sera élaborée. La fiabilité de cette méthode est cruciale, puisque si l'on se trompe ici, alors la totalité des résultats suivants, qui seront dépendants de cette valeur, seront inutilisables en pratique.
-Il est tout d'abord important de remarquer qu'une méthode est déjà présente, on pourrait donc supposer qu'elle a déjà fait ces preuves et ainsi passer à la suite. Cependant, cette méthode a été mise au point avec l’objectif de servir l’ancienne méthode de retraitement de ces données. L’ancienne méthode visait à détecter les recentrages et estimer les mouvements du joueur afin d’obtenir des données qui seraient celles qui auraient été enregistrées si le jeu ne recentrait pas. - -La solution présente consiste à prendre la valeur médiane des X et des Y comme étant les coordonnées du centre. Cette méthode a besoin, pour fonctionner, que les mouvements soient globalement répartis de manière équivalente entre la gauche et la droite, entre le bas et le haut, ou que le pic de valeur soit suffisamment prononcé pour absorber le décalage. - -Une solution qui apparaît satisfaisante serait de prendre comme centre le milieu de l'écran. En effet, le logiciel de capture enregistre la taille de l'écran, il serait donc tout à fait faisable de récupérer cette valeur. Cette solution a cependant de nombreuses failles. La première est que toutes les versions du logiciel n'enregistraient pas cette valeur. Ceci signifie que les enregistrements plus anciens seraient lésés. On peut également remarquer que lorsque l'on a deux écrans, le logiciel n'enregistre les dimensions que d'un seul écran. Écran qui n'est pas forcément celui sur-lequel le jeu est. Enfin, il est par ailleurs important de noter que tout le monde ne joue pas tout le temps en plein écran, la barre des tâches et les contours de la fenêtre du jeu vont décaler le centre. Toutes ces raisons font que cette solution qui paraissait, de prime abord, parfaite est en réalité bien moins fiable que la solution présente. - -À la vue de la taille des pics correspondant au centre, une autre solution pourrait être de prendre la valeur de ces pics comme valeur de centre. Pour que cette solution puisse être considérée comme fiable, il est nécessaire de comprendre pourquoi ces pics existent afin de savoir s'il s'agit d'un indicateur fiable. On peut distinguer deux hypothèses de travail : la première est que les recentrages sont détectés, la seconde est son opposée. - -Bien qu'aucun enregistrement n'ait montré que le logiciel de capture enregistre les recentrages, il reste nécessaire de prendre en compte ce cas puisque rien ne prouve qu'il ne se produira jamais. Si jamais le logiciel capture les recentrages, alors, il y aura une proportion anormalement élevée de mouvement effectué en direction du centre. Ce surplus de mouvement vers le centre aura pour effet certain de produire un pic notable aux coordonnées correspondant au centre. On peut donc conclure que cette méthode sera fiable dans le cas où les recentrages sont enregistrés. - -Si les recentrages ne sont pas enregistrés, il n'est pas possible d'assurer la présence des pics. On peut cependant aisément se convaincre qu'ils seront présents puisque chaque mouvement vers le haut augmentera la prépondérance de la valeur X centrale, de même, chaque mouvement vertical augmentera la prépondérance de la valeur Y centrale. La faille de cette méthode se trouve dans les mouvements diagonaux. En effet, si la majeure partie des mouvements effectués sont des diagonales, alors il y aura deux pics situés de part et d'autre de la valeur centrale. - -Il est tout à fait possible en théorie de détecter ce cas de figure, il suffira donc de passer par la méthode des médianes pour obtenir une estimation des coordonnées du centre. - -```{r} - -get_center <- function(data){ - med <- median(data) - maxs <- sort(table(data), decreasing = TRUE) - - if(med == as.integer(names(maxs[1])) ){ - return(med) - } - - test <- as.integer(names(maxs)) maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ - if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ - # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. - # La valeur médianne est alors ce qui ce rapproche le plus du centre - return(med) - } else { - # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et - # que la valeur maximal soit le vrai centre. - return(as.integer(names(maxs[1]))) - } - } else { - # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. - # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure - return(as.integer(names(maxs[1]))) - } - -} - - -center_x <- get_center(mouseData$M.XPOS) -center_y <- get_center(mouseData$M.YPOS) -``` - - -### Nettoyage des données -Lorsque l'on travaille sur des données, il est toujours nécessaire de les nettoyer, de supprimer le superflu inintéressant pour la question que l'on traite, d'atténuer le bruit causé par l'imperfection du mode d'acquisition. Ces données ne font pas exceptions, il est nécessaire de retirer des entrées du jeu de données. - -La première action qui sera prise est de retirer les doublons. Avant de chercher à les supprimer, nous allons tout d'abord les chercher et évaluer leur quantité. - -```{r} -is_duplcate <- duplicated(rleid(mouseData$M.XPOS,mouseData$M.YPOS)) -``` - -La fonction `rleid` génère un vecteur d'identifiant qui ne se répète que lorsque les valeurs de X et de Y sont les mêmes plusieurs fois d'affiler. Ceci nous permet de supprimer deux entrés consécutives pour une même coordonnée sans pour autant interdire la même coordonnée de revenir plus tard dans la liste. - -On obtient ainsi que `r round(length(is_duplcate[is_duplcate])/length(is_duplcate)*100,2)`% des entrées sont des duplicatas. Cette valeur est bien importante. Il est peu probable qu'autant de données ne cache pas d'information utile. Afin de ne pas risquer de supprimer de l'information qui pourrait être utile plus tard (pour moi ou pour autrui) seule les doublons situer en milieux de chaîne comme sur l'exemple ci-dessous seront supprimés. - -```{r echo=F,results='asis'} -olen <- length(mouseData$M.XPOS) - -kable(data.table(X = c(960,960,960,961,961,961,961), Y = c(530,530,531,531,531,531,531),DUPLICATE=c(F,T,F,F,T,T,T),KEPT=c(T,T,T,T,F,F,T))) - -``` -```{r} -to_remove <- which(is_duplcate) -to_remove <- to_remove[is_duplcate[to_remove+1]] -mouseData <- mouseData[-to_remove,] -``` - -Cette opération aura supprimé `r round(length(to_remove)/olen*100,2)`% des entrées. Le vaste décalage entre cette valeur et la précédente laisse supposer que la majeure partie des doublons viennent seul. Il est possible que ces doublons soient des sous produits causé par le recentrage : j'effectue un mouvement vers le haut, après un déplacement d'un pixel le jeu recentre ma souris, le logiciel ne détecte pas ce recentrage, je continue mon mouvement et repasse par le même pixel que précédemment. Il est aussi possible que ces doublons soient des indicateurs de fin et début de mouvement. - -Maintenant que les doublons ont été traités, nous allons chercher une méthode pour supprimer les données enregistrer hors du jeu. Par exemple lorsque l'on démarre ou arrête l'enregistrement. - -La méthode actuelle pour supprimer ces données consiste à chercher un unique seuil tel que : la somme des coordonnées plus éloignée du centre que le seuil représente environ 15% des données. Ces 15% de données sont ensuite supprimées. Cette méthode a fait ces preuves, mais il est sans doute possible de faire mieux. - -Deux défauts à la méthode actuelle peuvent être constatés. Le premier peut être sujet à débat : la méthode de sélection par seuil restreint à une zone carrée autour du centre. Il me parait plus naturel de restreindre à l'aide de la distance au centre. Le mouvement de la souris dans les jeux usant du recentrage est somme tout assez analogue à celui d'un stick d'une manette, aussi cela me parait plus logique d'utiliser une distance comme métrique sur laquelle appliquer un seuil. Le second défaut que j'observe est double : le seuil est très granuleux, mais aussi très limité. En effet, on considère des sauts de 20 pixels par 20 pixels (10 de part et d'autre du centre) mais surtout le seuil est limité à 50 pixels autour du centre. Cela, c'est jusqu'ici prouver suffisant avec les tests effectué sur des enregistrements provenant d'un moniteur en full HD. Cependant, rien n'indique que ce soit nécessairement le cas, entre autre, pour des jeux upscale sur des moniteurs en 4k. - -La limite de 85% arbitraire pourrait être amélioré, mais aucune méthode efficace afin de raffiner cette valeur n'a été trouvée, aussi, nous continuerons avec cette stratégie faute de mieux. - -La solution proposée est donc la suivante : - -```{r} -mouseData$M.DISTANCE <- sqrt( - (mouseData$M.XPOS - center_x) ^ 2 + - (mouseData$M.YPOS - center_y) ^ 2 -) - -mouseData <- mouseData[mouseData$M.DISTANCE < quantile(mouseData$M.DISTANCE,.85),] -``` -\newpage -Après nettoyage, les données peuvent de nouveaux être présentées sous la forme d'un graphique : - -```{r echo=FALSE} - -clean_data <- function(d.M){ - - is_duplcate <- duplicated(rleid(d.M$M.XPOS,d.M$M.YPOS)) - to_remove <- which(is_duplcate) - to_remove <- to_remove[is_duplcate[to_remove+1]] - d.M <- d.M[-to_remove,] - - - center_x <- get_center(d.M$M.XPOS) - - center_y <- get_center(d.M$M.YPOS) - - d.M$M.DISTANCE <- sqrt( - (d.M$M.XPOS - center_x) ^ 2 + - (d.M$M.YPOS - center_y) ^ 2 - ) - - d.M <- d.M[d.M$M.DISTANCE < quantile(d.M$M.DISTANCE,.85),] - - return(d.M) -} - -make_graph <- function(d.M) { - - info_x <- summary(d.M$M.XPOS) - info_y <- summary(d.M$M.YPOS) - - center_x <- get_center(d.M$M.XPOS) - - center_y <- get_center(d.M$M.YPOS) - - select_x <- "1er-3ème quartile" - select_y <- "1er-3ème quartile" - - if(info_x[5] - info_x[2] < 7){ - info_x[5] <- info_x[3] + 3 - info_x[2] <- info_x[3] - 3 - select_x <- "médiane +/- 3" - } - - sub_x <- d.M[d.M$M.XPOS >= info_x[2] & d.M$M.XPOS <= info_x[5],] - sub_x$isCenter <- sub_x$M.XPOS==center_x - - if(info_y[5] - info_y[2] < 7){ - info_y[5] <- info_y[3] + 3 - info_y[2] <- info_y[3] - 3 - select_y <- "médiane +/- 3" - } - - sub_y <- d.M[d.M$M.YPOS >= info_y[2] & d.M$M.YPOS <= info_y[5],] - sub_y$isCenter <- sub_y$M.YPOS==center_y - - histo_x <- ggplot(sub_x,aes(x = M.XPOS,fill= isCenter)) + - geom_histogram(binwidth = 1) + - ggtitle(paste("Histograme des valeurs de X com\n-prise entre ",select_x,sep=""))+ - scale_x_continuous(breaks = seq(min(sub_x$M.XPOS),max(sub_x$M.XPOS)))+ - theme(axis.text.x = element_text(angle = 45, hjust=1)) - - histo_y <- ggplot(sub_y,aes(x = M.YPOS,fill= isCenter)) + - geom_histogram(binwidth = 1) + - ggtitle(paste("Histograme des valeurs de Y com\n-prise entre ",select_y,sep=""))+ - scale_x_continuous(breaks = seq(min(sub_y$M.YPOS),max(sub_y$M.YPOS)))+ - theme(axis.text.x = element_text(angle = 45, hjust=1)) - - - return(ggarrange(histo_x,histo_y)) - -} -``` -```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} -make_graph(mouseData) -``` - -\captionof{figure}{Répartition des composante X et Y des coordonées après pré traitement.} - -## Visualisation des données recentré -Dans cette section, nous allons produire une visualisation des données recentrer. Je me suis inspiré de la visualisation des données du D pad. L'idée, l'objectif est de visualiser les directions de mouvement privilégié durant la session. - -Le graphique souhaité se compose donc plusieurs "part de gâteaux" dont la taille angulaire décrit la proportion du cercle qu'il représente et dont la hauteur est proportionnelle au nombre des points qu'il englobe. - -Nous allons dans un premier temps transformer nos coordonnées en nombre complexe afin d'ensuite en récupérer l'argument. Cette valeur d'angle qui nous est renvoyé est comprise entre $[-pi;pi[$ ce qui n'est pas tout à fait pratique. Nous allons ainsi décaler ces résultats vers $[frac{pi}{8}; 2pi+frac{pi}{8}[$. Il suffit après cela de répartir les angles produits en huit groupes, un par arc de cercle. - -Mathématiquement l'argument du complexe 0 est non défini, cepandant R concidère que l'argument de 0 est 0 malgré l'existance d'un symbole plus adapté à ce cas dans le langage. Il est donc important de retirer du calcule toute les coordonées qui sont égale au centre sans quoi un des axes véra sa valeur biaiser. - -\newpage -```{r, out.height="30%", fig.asp="1", fig.align="center"} - -cadrans <- 8:1 - -coords <- (mouseData$M.XPOS-center_x) +1i*(mouseData$M.YPOS-center_y) -coords <- coords[coords != 0] - -coords <- Arg(coords) -coords[coords maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ - if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ - # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. - # La valeur médianne est alors ce qui ce rapproche le plus du centre - return(med) - } else { - # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et - # que la valeur maximal soit le vrai centre. - return(as.integer(names(maxs[1]))) - } - } else { - # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. - # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure - return(as.integer(names(maxs[1]))) - } -} - -get_centers <- function(data){ - - maxs_x <- sort(table(data$M.XPOS), decreasing = TRUE) - maxs_y <- sort(table(data$M.YPOS), decreasing = TRUE) - - if( # Les pics sont adjacents - abs( as.integer(names(maxs_x[1])) - as.integer(names(maxs_x[2])) ) == 1 & - abs( as.integer(names(maxs_y[1])) - as.integer(names(maxs_y[2])) ) == 1 - ){ - # Les pics sont de taille comparable - if ( maxs_x[2]/maxs_x[1] > 0.9 & maxs_y[2]/maxs_y[1] > 0.9 ){ - center_x = min(as.integer(names(maxs_x[1])),as.integer(names(maxs_x[2]))) - center_y = min(as.integer(names(maxs_y[1])),as.integer(names(maxs_y[2]))) - # Décalage des données pour compacter le centre sur 1 pixel - - data$M.XPOS[data$M.XPOS > center_x] <- data$M.XPOS[data$M.XPOS > center_x] - 1 - data$M.YPOS[data$M.YPOS > center_y] <- data$M.YPOS[data$M.YPOS > center_y] - 1 - - return(c(center_x,center_y,data)) - - } - } - center_x <- get_center(median(data$M.XPOS),maxs_x) - center_y <- get_center(median(data$M.YPOS),maxs_y) - - return(c(center_x,center_y,data)) - -} - -``` -```{r echo=FALSE} -clean_data <- function(d.M){ - - is_duplcate <- duplicated(rleid(d.M$M.XPOS,d.M$M.YPOS)) - to_remove <- which(is_duplcate) - to_remove <- to_remove[is_duplcate[to_remove+1]] - d.M <- d.M[-to_remove,] - - - data <- get_centers(d.M) - - d.M <- data.frame(data[c(-1,-2)]) - - center_y <- data[[2]] - center_x <- data[[1]] - - d.M$M.DISTANCE <- sqrt( - (d.M$M.XPOS - center_x) ^ 2 + - (d.M$M.YPOS - center_y) ^ 2 - ) - - d.M <- d.M[d.M$M.DISTANCE < quantile(d.M$M.DISTANCE,.85),] - - return(d.M) -} - -make_graph <- function(d.M) { - - info_x <- summary(d.M$M.XPOS) - info_y <- summary(d.M$M.YPOS) - - data <- get_centers(d.M) - - d.M <- data.frame(data[c(-1,-2)]) - - center_y <- data[[2]] - center_x <- data[[1]] - - select_x <- "1er-3ème quartile" - select_y <- "1er-3ème quartile" - - if(info_x[5] - info_x[2] < 7){ - info_x[5] <- info_x[3] + 3 - info_x[2] <- info_x[3] - 3 - select_x <- "médiane +/- 3" - } - - sub_x <- d.M[d.M$M.XPOS >= info_x[2] & d.M$M.XPOS <= info_x[5],] - sub_x$isCenter <- sub_x$M.XPOS==center_x - - if(info_y[5] - info_y[2] < 7){ - info_y[5] <- info_y[3] + 3 - info_y[2] <- info_y[3] - 3 - select_y <- "médiane +/- 3" - } - - sub_y <- d.M[d.M$M.YPOS >= info_y[2] & d.M$M.YPOS <= info_y[5],] - sub_y$isCenter <- sub_y$M.YPOS==center_y - - histo_x <- ggplot(sub_x,aes(x = M.XPOS,fill= isCenter)) + - geom_histogram(binwidth = 1) + - ggtitle(paste("Histograme des valeurs de X comprise\nentre ",select_x,sep=""))+ - scale_x_continuous(breaks = seq(min(sub_x$M.XPOS),max(sub_x$M.XPOS)))+ - theme(axis.text.x = element_text(angle = 45, hjust=1)) - - histo_y <- ggplot(sub_y,aes(x = M.YPOS,fill= isCenter)) + - geom_histogram(binwidth = 1) + - ggtitle(paste("Histograme des valeurs de Y comprise\nentre ",select_y,sep=""))+ - scale_x_continuous(breaks = seq(min(sub_y$M.YPOS),max(sub_y$M.YPOS)))+ - theme(axis.text.x = element_text(angle = 45, hjust=1)) - - - return(ggarrange(histo_x,histo_y)) -} - -``` -```{r echo=FALSE, fig.align="center", fig.width=10,out.width="100%"} -ImportZip (paste("Data",session [102],sep="/"), 0, "max") -mouseData <- d.M[M.EVENEMENT == "mouse move",] -rm(d.K) -make_graph(clean_data(mouseData)) -``` -\captionof{figure}{Répartition des composante X et Y des coordonées après pré traitement. - My time at portia} -```{r echo=FALSE, out.height="30%", fig.asp="1", fig.align="center"} -data <- get_centers(mouseData) - -mouseData <- data.frame(data[c(-1,-2)]) - -center_y <- data[[2]] -center_x <- data[[1]] - -is_duplcate <- duplicated(rleid(mouseData$M.XPOS,mouseData$M.YPOS)) - -to_remove <- which(is_duplcate) -to_remove <- to_remove[is_duplcate[to_remove+1]] -mouseData <- mouseData[-to_remove,] - -mouseData$M.DISTANCE <- sqrt( - (mouseData$M.XPOS - center_x) ^ 2 + - (mouseData$M.YPOS - center_y) ^ 2 -) - -mouseData <- mouseData[mouseData$M.DISTANCE < quantile(mouseData$M.DISTANCE,.85),] - -cadrans <- 8:1 - -coords <- (mouseData$M.XPOS-center_x) +1i*(mouseData$M.YPOS-center_y) -coords <- coords[coords != 0] - -coords <- Arg(coords) -coords[coords 0) { - install.packages(setdiff(packages, rownames(installed.packages()))) -} - -#chargement auto de tout les packages (evite q'un package manque a l'appel) -for(package in packages){ - library(package,character.only = T,warn.conflicts = F) -} - -session <- list.files (path = "Data", pattern = ".zip") # Recuperer liste des fichiers .zip dans le repertoire de travail - -source("RScripts/ImportScript.R") -import.script() - - -``` - -```{r include = FALSE} - -get_center <- function(med,maxs){ - if(med == as.integer(names(maxs[1])) ){ - return(c(med,"both")) - } - - test <- as.integer(names(maxs)) maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ - if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ - # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. - # La valeur médianne est alors ce qui ce rapproche le plus du centre - return(c(med,"med: rivière")) - } else { - # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et - # que la valeur maximal soit le vrai centre. - return(c(names(maxs[1]),"max: bruit")) - } - } else { - # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. - # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure - return(c(names(maxs[1]),"max: pic")) - } - -} - - -get_centers <- function(data){ - - maxs_x <- sort(table(data$M.XPOS), decreasing = TRUE) - maxs_y <- sort(table(data$M.YPOS), decreasing = TRUE) - - if( # Les pics sont adjacents - abs( as.integer(names(maxs_x[1])) - as.integer(names(maxs_x[2])) ) == 1 & - abs( as.integer(names(maxs_y[1])) - as.integer(names(maxs_y[2])) ) == 1 - ){ - # Les pics sont de taille comparable - if ( maxs_x[2]/maxs_x[1] > 0.9 & maxs_y[2]/maxs_y[1] > 0.9 ){ - center_x = min(as.integer(names(maxs_x[1])),as.integer(names(maxs_x[2]))) - center_y = min(as.integer(names(maxs_y[1])),as.integer(names(maxs_y[2]))) - # Décalage des données pour compacter le centre sur 1 pixel - - data$M.XPOS[data$M.XPOS > center_x] <- data$M.XPOS[data$M.XPOS > center_x] - 1 - data$M.YPOS[data$M.YPOS > center_y] <- data$M.YPOS[data$M.YPOS > center_y] - 1 - - return(c(center_x,center_y,"quad","quad",data)) - - } - } - center_x <- get_center(median(data$M.XPOS),maxs_x) - center_y <- get_center(median(data$M.YPOS),maxs_y) - - return(c(center_x[1],center_y[1],center_x[2],center_y[2],data)) - -} - -filter_datasets <- function(dataset_name) { - # on importe les donnees et dezippe les fichiers - ImportZip (paste("Data",dataset_name,sep="/"), 0, "max") - name <- substr(dataset_name,15,nchar(dataset_name)-4) - d.M <- d.M[M.EVENEMENT == "mouse move",] - - cond1 <- fivenum(d.M$M.XPOS)[4] - fivenum(d.M$M.XPOS)[2] - cond2 <- fivenum(d.M$M.YPOS)[4] - fivenum(d.M$M.YPOS)[2] - if(cond1 < 20 & cond2 < 20){ - return(c(name,d.M)) - } else { - return(NA) - } -} - -clean_data <- function(d.M){ - - name <-d.M[[1]] - d.M <- data.frame(d.M[-1]) - - is_duplcate <- duplicated(rleid(d.M$M.XPOS,d.M$M.YPOS)) - to_remove <- which(is_duplcate) - to_remove <- to_remove[is_duplcate[to_remove+1]] - # If a duplicated value is at the end of the list it produce a NA - to_remove <- to_remove[!is.na(to_remove)] - - d.M <- d.M[-to_remove,] - centers <- get_centers(d.M) - - center_x <- as.integer(centers[1]) - center_y <- as.integer(centers[2]) - - d.M <- data.frame(centers[c(-1,-2,-3,-4)]) - - d.M$M.DISTANCE <- sqrt( - (d.M$M.XPOS - center_x) ^ 2 + - (d.M$M.YPOS - center_y) ^ 2 - ) - - d.M <- data.table(d.M[d.M$M.DISTANCE < quantile(d.M$M.DISTANCE,.85),]) - - return(c(name,centers[3],centers[4],d.M)) -} - -make_graph <- function(d.M) { - name <-d.M[[1]] - - meth_x <- d.M[[2]] - meth_y <- d.M[[3]] - - d.M <- data.frame(d.M[c(-1,-2,-3)]) - - info_x <- summary(d.M$M.XPOS) - info_y <- summary(d.M$M.YPOS) - - - centers <- get_centers(d.M) - - center_x <- centers[1] - center_y <- centers[2] - - d.M <- data.frame(centers[c(-1,-2,-3,-4)]) - - select_x <- "1er-3ème quartile" - select_y <- "1er-3ème quartile" - - if(info_x[5] - info_x[2] < 7){ - info_x[5] <- info_x[3] + 3 - info_x[2] <- info_x[3] - 3 - select_x <- "médiane +/- 3" - } - - sub_x <- d.M[d.M$M.XPOS >= info_x[2] & d.M$M.XPOS <= info_x[5],] - sub_x$isCenter <- sub_x$M.XPOS==center_x - - if(info_y[5] - info_y[2] < 7){ - info_y[5] <- info_y[3] + 3 - info_y[2] <- info_y[3] - 3 - select_y <- "médiane +/- 3" - } - - sub_y <- d.M[d.M$M.YPOS >= info_y[2] & d.M$M.YPOS <= info_y[5],] - sub_y$isCenter <- sub_y$M.YPOS==center_y - - histo_x <- ggplot(sub_x,aes(x = M.XPOS,fill= isCenter)) + - geom_histogram(binwidth = 1) + - ggtitle(paste("Histograme des valeurs de X comprise\nentre ",select_x," (",meth_x,")",sep=""))+ - scale_x_continuous(breaks = seq(min(sub_x$M.XPOS),max(sub_x$M.XPOS)))+ - theme(axis.text.x = element_text(angle = 45, hjust=1)) - - histo_y <- ggplot(sub_y,aes(x = M.YPOS,fill= isCenter)) + - geom_histogram(binwidth = 1) + - ggtitle(paste("Histograme des valeurs de Y comprise\nentre ",select_y," (",meth_y,")",sep=""))+ - scale_x_continuous(breaks = seq(min(sub_y$M.YPOS),max(sub_y$M.YPOS)))+ - theme(axis.text.x = element_text(angle = 45, hjust=1)) - - - return(annotate_figure(ggarrange(histo_x,histo_y),top = paste(name,": ",round(max(d.M$M.TEMPS)/60,2), "min",sep = ""))) - -} -``` -```{r include = FALSE} -datas <- lapply(session, filter_datasets) - -datas <- datas[!is.na(datas)] - -names <- unlist(lapply(datas, `[[`, 1)) - -datas <- lapply(datas, clean_data) - -graphs <- lapply(datas, make_graph) - -``` - -```{r histograms, echo=FALSE, dev='pdf', fig.show='hide'} -# fig.height=4,fig.width=9, -for( p in graphs){ - print(p) -} -``` -\clearpage -\newpage -```{r, echo=FALSE, out.height="40%", fig.cap=names} -include_graphics(fig_chunk(label = "histograms", ext = "pdf", number = 1:length(graphs))) -``` - -```{r} -cadran <- function(data,nb.cadran=8){ - cadrans <- nb.cadran:1 - name <-data[[1]] - - meth_x <- data[[2]] - meth_y <- data[[3]] - - data <- data.frame(data[c(-1,-2,-3)]) - - x<- data$M.XPOS - y<- data$M.YPOS - - centers <- get_centers(data) - - cx <- as.integer(centers[1]) - cy <- as.integer(centers[2]) - - coords <- (x-cx) +1i*(y-cy) - - coords <- coords[coords != 0] - - coords <- Arg(coords) - coords[coords 0.9 & maxs_y[2]/maxs_y[1] > 0.9 ){ + center_x = min(as.integer(names(maxs_x[1])),as.integer(names(maxs_x[2]))) + center_y = min(as.integer(names(maxs_y[1])),as.integer(names(maxs_y[2]))) + # Décalage des données pour compacter le centre sur 1 pixel + + clickData$M.XPOS[clickData$M.XPOS > center_x] <- clickData$M.XPOS[clickData$M.XPOS > center_x] - 1 + clickData$M.YPOS[clickData$M.YPOS > center_y] <- clickData$M.YPOS[clickData$M.YPOS > center_y] - 1 + multicenters <- TRUE; + } + } + + get_center <- function(med,maxs) { + if(med == as.integer(names(maxs[1])) ){ + return(med) + } + + test <- as.integer(names(maxs)) maxs[as.character(med)] & max_left[1]>maxs[as.character(med)]){ + if(min(max_right[1],max_left[1])/maxs[1] > 0.8){ + # Si les deux pics sont de taille comparable alors on as un creux au niveaux médiane. + # La valeur médianne est alors ce qui ce rapproche le plus du centre + return(med) + } else { + # Si les deux pics ne sont pas comparable alors il semble plus probable que l'un des pics soit issus d'un bruit et + # que la valeur maximal soit le vrai centre. + return(as.integer(names(maxs[1]))) + } + } else { + # Toute les valeurs qui ce situe d'un coté de la médianne sont inférieure à la médianne. + # Ceci signifie que le jeux force a toujours bouger dans la même direction. La méthode de la médianne n'est donc pas fiable dans ce cas de figure + return(as.integer(names(maxs[1]))) + } + } + + if(!multicenters){ + center_x <- get_center(median(clickData$M.XPOS),maxs_x) + center_y <- get_center(median(clickData$M.YPOS),maxs_y) + } + + # nettoyage des données phase deux + + clickData$M.DISTANCE <- sqrt( + (clickData$M.XPOS - center_x) ^ 2 + + (clickData$M.YPOS - center_y) ^ 2 + ) + + # 85% est une valeur magique qui fonctione raisonablement bien. + # Il serait bon de trouvé un methode pour supprimer le bruit avant/après / au milieux des enregistrement lors des alt+tab par exemples. + clickData <- clickData[clickData$M.DISTANCE < quantile(clickData$M.DISTANCE,.85),] + + # Pour finir : on centre les données. + centred <- data.frame( + M.XPOS = clickData$M.XPOS - center_x, + M.YPOS = clickData$M.YPOS - center_y + ) + } else { # Première étape : centrer les données centred <- data.frame( M.XPOS = clickData$M.XPOS[-1] - clickData$M.XPOS[-length(clickData$M.XPOS)], - M.YPOS = clickData$M.YPOS[-1] - clickData$M.YPOS[-length(clickData$M.YPOS)], - M.TEMPS = clickData$M.TEMPS[-1] + M.YPOS = clickData$M.YPOS[-1] - clickData$M.YPOS[-length(clickData$M.YPOS)] ) } diff --git a/RScripts/Souris/SourisGraphiques.1.1.R b/RScripts/Souris/SourisGraphiques.1.1.R index 2236e92..b2999a1 100644 --- a/RScripts/Souris/SourisGraphiques.1.1.R +++ b/RScripts/Souris/SourisGraphiques.1.1.R @@ -47,6 +47,12 @@ souris.graphiques <- function (clickData, "Appuis" ) + graphiques.cadrants( + cadrants, + "Répartition en cadrants des mouvements Souris", + infobaz, + paste (infobaz, ".M.cdnt", ".png", sep = "") + ) if (recentrer) { dataSample <- @@ -57,12 +63,5 @@ souris.graphiques <- function (clickData, paste(infobaz, "\n", "Mouvement Souris"), paste (infobaz, ".M.map", ".png", sep = "") ); - - graphiques.cadrants( - cadrants, - "Répartition en cadrants des mouvements Souris", - infobaz, - paste (infobaz, ".M.cdnt", ".png", sep = "") - ) } } diff --git a/RScripts/Souris/SourisMoveAnalyse.1.0.R b/RScripts/Souris/SourisMoveAnalyse.1.0.R index f47fa99..927b4e5 100644 --- a/RScripts/Souris/SourisMoveAnalyse.1.0.R +++ b/RScripts/Souris/SourisMoveAnalyse.1.0.R @@ -55,7 +55,7 @@ souris.move.analyse <- function(data) { M.Vit<-NA moveData <- NA - cadrants <- data_frame(cadrants = NA); + cadrants <- souris.cadrant(data, TRUE); } #M.Vit # Moyenne des vitesses instantanes diff --git a/Rythma.5.7.R b/Rythma.5.7.R index 53a0766..1b4e94c 100644 --- a/Rythma.5.7.R +++ b/Rythma.5.7.R @@ -43,7 +43,6 @@ source("RScripts/RythmaFUNZIP5.7.R") #charge la fonction d'analyse ## Placer dans le repertoire de travail les .zip session <- list.files (path = "Data", pattern = ".zip") # Recuperer liste des fichiers .zip dans le repertoire de travail -session <- session[8:9] resultats <- lapply(session, Rythmanalyse, debut = 0, fin = "max", graph = TRUE) # On applique la fonction d'analyse #resultats <- lapply(session, Rythmanalyse, debut = 1, fin = 3, graph = TRUE) # On applique la fonction d'analyse resultats <- do.call("rbind",resultats) # On aggrege les resultats