Centred handler

RScripts/Graphiques/GraphiquesCadrants.R

@@ -0,0 +1,27 @@
+
+
+# data <- moveResult[[3]]
+# titre <- "Répartition en cadrants des mouvements Souris";
+# 
+# save.file <- paste (infobaz, ".M.cdnt", ".png", sep = "");
+# save<-TRUE
+# width <- 15
+# height <- 7
+
+graphiques.cadrants<-function(data,titre,infobaz,save.file,save=TRUE,width = 15,height = 7){
+
+  plot <- ggplot(data, aes(x = cadrans,color="dummy")) +
+    coord_polar(direction=1,start=pi/2 - pi/8)+
+    geom_bar(width = 1)+ 
+    xlab("")+
+    ylab("")+
+    theme(legend.position = "none" , axis.text.y = element_blank() , axis.ticks = element_blank())+
+    scale_color_manual(values=c("#000000")) +
+    ggtitle (label = titre, subtitle = infobaz)
+  if (save){
+    ggsave(filename = save.file , width = width, height = height)
+  }
+
+  return(plot)
+
+}

RScripts/RythmaFUNZIP5.7.R

@@ -6,7 +6,7 @@
 # debut <-0
 # fin <- "max"
 # graph <- TRUE
-# nomfichier <- session [1] 
+# nomfichier <- session [2]
 # data.dir <- "Data"
 
 Rythmanalyse <- function (nomfichier, debut = 0, fin = "max", graph = TRUE,data.dir="Data"){ # type : "2014.02.16.MT.Doom.s1.zip"

RScripts/Souris/SourisCadrants.R

@@ -0,0 +1,127 @@
+
+#==#==#==#==#
+
+# Fonction souris.cadrant : sythetise les movements de la souris en les regrooupant par portion d'arc de cercles
+
+# Return : Un dataframe avec une colonne de factor indiquant l'appartenance a un cadrant d'une donnée.
+
+#==#==#==#==#
+
+# clickData <- d.M;
+# recentrer <- TRUE;
+
+souris.cadrant <- function(clickData, recentrer) {
+  clickData <- clickData[M.EVENEMENT == "mouse move",]
+  centred <- clickData;
+  if (recentrer) {
+    # Première étape : centrer les données
+
+    # On nettoie les données
+
+    is_duplcate <- duplicated(rleid(clickData$M.XPOS,clickData$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)]
+
+    clickData <- clickData[-to_remove,]
+
+    # On cherche le centre :
+
+    maxs_x <- sort(table(clickData$M.XPOS), decreasing = TRUE)
+    maxs_y <- sort(table(clickData$M.YPOS), decreasing = TRUE)
+
+    multicenters <- FALSE;
+
+    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
+
+        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))<med
+      max_left <- maxs[test]
+      max_right <- maxs[!test]
+      if(max_right[1] > 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)]
+    )
+  }
+
+  cadrans <- 8:1;
+
+  # Deuxième étape : calcul des angles des points
+
+  coords <- centred$M.XPOS + 1i * centred$M.YPOS;
+  coords <- coords[coords != 0]
+
+  coords <- Arg(coords)
+  # Rotation des angles pour pouvoir grouper de manière plus naturelle. Le 8 vient directement du nombre de segment.
+  coords[coords<pi/8] <- coords[coords<pi/8] + 2*pi
+
+  splited_data <- factor(length(coords),levels = cadrans)
+
+  # Regroupement des donnée en fonction du cadrant.
+  d <- lapply(cadrans, function(c){
+    splited_data[coords <= 2*pi*c/8 + pi/8] <<- c
+  })
+
+  return(data.frame(cadrans = splited_data));
+}

RScripts/Souris/SourisGraphiques.1.1.R

@@ -1,7 +1,7 @@
 
 #==#==#==#==#
 
-# Fonction souris.graphiques : Cr�er les diff�rent 
+# Fonction souris.graphiques : Cr?er les diff?rent 
 
 # Return : rien
 
@@ -12,7 +12,8 @@ souris.graphiques <- function (clickData,
                                moveData,
                                duree,
                                infobaz,
-                               recentrer) {
+                               recentrer,
+                               cadrants) {
   graphiques.density(
     clickData,
     down.time,
@@ -46,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 <-
@@ -55,6 +62,6 @@ souris.graphiques <- function (clickData,
       dataSample,-M.XPOS,-M.YPOS,
       paste(infobaz, "\n", "Mouvement Souris"),
       paste (infobaz, ".M.map", ".png", sep = "")
-    )
+    );
   }
 }

RScripts/Souris/SourisMain.1.0.R

@@ -7,6 +7,8 @@
 
 #==#==#==#==#
 
+# data <- d.M;
+
 souris.main <- function(data, infobaz, graph) {
   # Analyse des Clicks
   clickResult <- souris.click.analyse(data)
@@ -21,7 +23,8 @@ souris.main <- function(data, infobaz, graph) {
                       moveResult[[2]],
                       clickResult[[1]]$M.DuM,
                       infobaz,
-                      moveResult[[1]]$M.VitTrueXY)
+                      moveResult[[1]]$M.VitTrueXY,
+                      moveResult[[3]]);
   }
 
   return (cbind(clickResult[[1]], moveResult[[1]]))

RScripts/Souris/SourisMoveAnalyse.1.0.R

@@ -4,8 +4,9 @@
 # Fonction souris.move.analyse : analyse les donnees des mouvement de la souris
 
 # Return : un vecteur avec :
-# - resultat: les resultat obtenus des diff�rents calcul sous la forme d'un data frame
+# - resultat: les resultat obtenus des diff?rents calcul sous la forme d'un data frame
 # - moveData: les donnees de mouvement retraiter s'il y as eux rencentrage brut sinon
+# - cadrant: Un dataframe avec une colonne de factor indiquant l'appartenance a un cadrant d'une donnée.
 
 #==#==#==#==#
 
@@ -29,6 +30,8 @@ souris.move.analyse <- function(data) {
     moveData <- data.table(data$M.XPOS, data$M.YPOS, data$M.TEMPS)
     names(moveData) <- c("M.XPOS", "M.YPOS", "M.TEMPS")
 
+    cadrants <- souris.cadrant(data, FALSE);
+
   } else {
     #moveData <- souris.decentrage(data)
     #moveEnd <- moveData$MoveEnd
@@ -51,12 +54,14 @@ souris.move.analyse <- function(data) {
     # M.Vit <- sum (distance) / (max (d.M$M.TEMPS) - min(d.M$M.TEMPS))
     M.Vit<-NA
     moveData <- NA
+
+    cadrants <- souris.cadrant(data, TRUE);
   }
 
   #M.Vit # Moyenne des vitesses instantanes
   #M.VitTrueXY #si la vitesse est calculer a partir des vraies coordonnees ou apres une modification
 
   resultats <- data.table(M.Vit, M.VitTrueXY)
 
-  return (list(resultats, moveData))
+  return (list(resultats, moveData, cadrants))
 }

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
-
 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