diff --git a/RScripts/Graphiques/GraphiquesCadrants.R b/RScripts/Graphiques/GraphiquesCadrants.R new file mode 100644 index 0000000..3470569 --- /dev/null +++ b/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) + +} diff --git a/RScripts/RythmaFUNZIP5.7.R b/RScripts/RythmaFUNZIP5.7.R index f66c312..ec225fb 100644 --- a/RScripts/RythmaFUNZIP5.7.R +++ b/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" diff --git a/RScripts/Souris/SourisCadrants.R b/RScripts/Souris/SourisCadrants.R new file mode 100644 index 0000000..6fe9d17 --- /dev/null +++ b/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)) 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