Analisar o tempo que o cursor está dentro do alvo.
require(psych)
## Loading required package: psych
require(ggplot2)
## Loading required package: ggplot2
##
## Attaching package: 'ggplot2'
##
## The following object is masked from 'package:psych':
##
## %+%
require(doBy)
## Loading required package: doBy
## Loading required package: survival
## Loading required package: splines
## Loading required package: MASS
require(grid)
## Loading required package: grid
library(doParallel)
## Loading required package: foreach
## Loading required package: iterators
## Loading required package: parallel
library(reshape2)
source("functions.R")
GENERATE_INDIVIDUAL_PATHS <- FALSE
GENERATE_CIRCLEID_CHARTS <- FALSE
GENERATE_SEQUENCE_CHARTS <- FALSE
SAMPLE_INTERVAL <- 25 #milliseconds
# This script generates the graphics with the various selection paths
############################ data
#for the effective target width
fileNameMeasures <- "measures-feup.txt"
files <- list.files(path="data", pattern="transformed-feup.txt")
files
## [1] "transformed-feup.txt"
dataTransformed <- data.frame()
for (file in files) {
print (file)
dat = read.csv(paste("data/", file, sep=""), sep="", head = TRUE)
print(nrow(dat))
dataTransformed <- rbind(dataTransformed, dat)
}
## [1] "transformed-feup.txt"
## [1] 987560
colnames(dataTransformed)
## [1] "NumberDevice" "UserId" "Block"
## [4] "Sequence" "NumberClicks" "NumberCircles"
## [7] "CircleID" "DistanceCenter" "PixelStartCircleX"
## [10] "PixelStartCircleY" "PixelEndCircleX" "PixelEndCircleY"
## [13] "TargetWidth" "ElapsedTime" "MouseX"
## [16] "MouseY" "transfTargetx" "transfTargety"
## [19] "rx" "ry" "inside"
## [22] "percentpath" "speeds" "accels"
## [25] "displacement" "distance" "insidelastcount"
## [28] "insidefirstcount" "distanceToTarget"
#dataTransformed <- read.csv(file="data/transformed.txt", head=TRUE, sep="")
# change column name to get a nicer chart
colnames(dataTransformed)[colnames(dataTransformed)=="NumberDevice"] <- "Device"
# convert the column to factor and name the levels
# LeapMotion=c(0), Mouse=c(1), Touchpad=c(2), LeapMotionTouchless=c(4)
dataTransformed$Device <- as.factor(dataTransformed$Device)
levels(dataTransformed$Device) <- list( Mouse=c(1), LeapMotionHandGrab=c(0), LeapMotionScreenTap=c(4) )
# Analyse only blocks after learning effect
dataTransformed <- dataTransformed[dataTransformed$Block>3 & dataTransformed$Block<8,]
dataTransformed$cuts<-cut(dataTransformed$percentpath, 10)
#Remove user that did not complete
dataTransformed <- dataTransformed[dataTransformed$UserId != 5,]
#calculate the maximum and minimum y and x coords for setting the plots' scales
minX <- min(dataTransformed$rx)
maxX <- max(dataTransformed$rx)
minY <- min(dataTransformed$ry)
maxY <- max(dataTransformed$ry)
print ( paste("X scale: ", minX, maxX, " Y scale: ", minY, maxY))
## [1] "X scale: -648.570526345861 1250.40048087644 Y scale: -997.235948789617 967.794680006076"
# plot the paths for each user and device. a single plot aggregates one entire sequence
if (GENERATE_SEQUENCE_CHARTS == TRUE) {
for (device in unique(dataTransformed$Device) ) {
for (user in unique(dataTransformed$UserId)) {
p <- ggplot(dataTransformed[dataTransformed$Device==device &
dataTransformed$UserId==user,],
aes(x=rx, y=ry, group=Device, colour=Device )) +
geom_path() +
coord_cartesian(xlim = c(minX, maxX), ylim=c(minY, maxY)) +
facet_grid(Block ~ Sequence) +
ylab("Block") +
xlab("Sequence") +
theme(legend.position="none") +
ggtitle(paste("Device: ", device, " User: ", user))
p
filename <- paste("charts/paths/byblocksequence", device, "-user-", user, ".pdf", sep="")
print( filename )
ggsave(file = filename, width=21/2.54, height=29/2.54, dpi=100)
}
}
}
# plot the paths for each user and device. a single plot aggregates one circleid
if (GENERATE_CIRCLEID_CHARTS == TRUE) {
for (device in unique(dataTransformed$Device) ) {
for (user in unique(dataTransformed$UserId)) {
p <- ggplot(dataTransformed[dataTransformed$Device==device &
dataTransformed$UserId==user,],
aes(x=rx, y=ry, group=Device, colour=Device )) +
geom_path() +
coord_cartesian(xlim = c(minX, maxX), ylim=c(minY, maxY)) +
facet_grid(CircleID ~ .) +
ylab("Circle ID") +
xlab("x") +
theme(legend.position="none") +
ggtitle(paste("Device: ", device, " User: ", user))
p
filename <- paste("charts/paths/bycircleid-", device, "-user-", user, ".pdf", sep="")
print( filename )
ggsave(file = filename, width=21/2.54, height=29/2.54, dpi=100)
}
}
}
# plot INDIVIDUAL paths for each user and device.
# PRODUCES LOTS OF FILES
if (GENERATE_INDIVIDUAL_PATHS == TRUE) {
for (device in unique(dataTransformed$Device) ) {
for (user in unique(dataTransformed$UserId)) {
for (block in unique(dataTransformed[dataTransformed$Device==device &
dataTransformed$UserId==user,]$Block)) {
p <- ggplot(dataTransformed[dataTransformed$Device==device &
dataTransformed$Block==block &
dataTransformed$UserId==user,],
aes(x=rx, y=ry, group=Device, colour=Device )) +
geom_path() +
coord_cartesian(xlim = c(minX, maxX), ylim=c(minY, maxY)) +
facet_grid(CircleID ~ Sequence) +
ylab("Circle Id") +
xlab("Block") +
theme(legend.position="none") +
ggtitle(paste("Device: ", device, " User: ", user, " Block: ", block))
p
filename <- paste("charts/paths/individual-", device, "-user-", user, "-block-", block,".pdf", sep="")
print( filename )
ggsave(file = filename, width=29/2.54, height=35/2.54, dpi=100)
}
}
}
}
Analysis of the time it takes for the final positioning times (from the cursor entering the target to selecting the target): 1. after the first target entry 2. after the final target entry 3. how much percentage of the total movement time are 1. and 2.?
# get the selection time for each target selection (the values are repeated, so using max, or min, or mean, is the same)
selectionTime <- aggregate(dataTransformed[, c("ElapsedTime")], dataTransformed[, c("Device", "UserId", "Block", "Sequence", "CircleID")], max)
posTime <- aggregate(dataTransformed[, c("insidefirstcount", "insidelastcount")], dataTransformed[, c("Device", "UserId", "Block", "Sequence", "CircleID")], max)
posTime$ElapsedTime <- selectionTime$x
posTime$insidefirstcount <- posTime$insidefirstcount*SAMPLE_INTERVAL
posTime$insidelastcount <- posTime$insidelastcount*SAMPLE_INTERVAL
finalPosTime <- aggregate(posTime[, c("ElapsedTime", "insidefirstcount", "insidelastcount")], posTime[, c("Device", "UserId", "Block", "Sequence")], mean)
names(finalPosTime)[6] <- "FirstPosTime"
names(finalPosTime)[7] <- "FinalPosTime"
finalPosTime$PercentageFirstPosTime <- 100*finalPosTime$FirstPosTime/finalPosTime$ElapsedTime
finalPosTime$PercentageFinalPosTime <- 100*finalPosTime$FinalPosTime/finalPosTime$ElapsedTime
remove(selectionTime)
# Anova for positioning time
aov.FPT <- aov(FinalPosTime~Device, data=finalPosTime)
#aov.MO
summary(aov.FPT)
## Df Sum Sq Mean Sq F value Pr(>F)
## Device 2 13328777 6664389 503 <2e-16 ***
## Residuals 537 7117528 13254
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
TukeyHSD(aov.FPT)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = FinalPosTime ~ Device, data = finalPosTime)
##
## $Device
## diff lwr upr p adj
## LeapMotionHandGrab-Mouse 230.2 201.7 258.7 0
## LeapMotionScreenTap-Mouse 382.2 353.7 410.7 0
## LeapMotionScreenTap-LeapMotionHandGrab 152.0 123.5 180.5 0
t.FPT<-t.test(finalPosTime$FinalPosTime[finalPosTime$Device == "LeapMotionHandGrab"], finalPosTime$FinalPosTime[finalPosTime$Device == "LeapMotionScreenTap"], paired=T)
t.FPT
##
## Paired t-test
##
## data: finalPosTime$FinalPosTime[finalPosTime$Device == "LeapMotionHandGrab"] and finalPosTime$FinalPosTime[finalPosTime$Device == "LeapMotionScreenTap"]
## t = -10.73, df = 179, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -179.9 -124.0
## sample estimates:
## mean of the differences
## -152
describeMetrics = describeBy(finalPosTime[, c("FirstPosTime","FinalPosTime","ElapsedTime", "PercentageFirstPosTime", "PercentageFinalPosTime")], list(finalPosTime$Device))
a=cbind(describeMetrics$LeapMotionScreenTap, metric=rownames(describeMetrics$LeapMotionScreenTap))
a=cbind(a, Device="LeapMotionScreenTap")
b=cbind(describeMetrics$Mouse, metric=rownames(describeMetrics$Mouse))
b=cbind(b, Device="Mouse")
c=cbind(describeMetrics$LeapMotionHandGrab, metric=rownames(describeMetrics$LeapMotionHandGrab))
c=cbind(c, Device="LeapMotionHandGrab")
describeMetrics = rbind(a, b, c)
describeMetrics$metric <- factor(describeMetrics$metric, levels= c("FirstPosTime","FinalPosTime","ElapsedTime", "PercentageFirstPosTime", "PercentageFinalPosTime"))
levels(describeMetrics$Device) <- list( Mouse=c("Mouse"), LeapMotionHandGrab=c("LeapMotionHandGrab"), LeapMotionScreenTap=c("LeapMotionScreenTap"))
levels(describeMetrics$metric) <- list( "PositioningTime (milliseconds)"=c("FirstPosTime"), FinalPosTime=c("FinalPosTime"), ElapsedTime=c("ElapsedTime"), "Percentage of total time"=c("PercentageFirstPosTime"), PercentageFinalPosTime=c("PercentageFinalPosTime") )
describeMetrics
## vars n mean sd median trimmed mad
## FirstPosTime 1 180 670.56 212.215 632.50 649.83 190.267
## FinalPosTime 2 180 560.63 159.875 528.33 546.04 140.847
## ElapsedTime 3 180 1940.39 512.873 1853.37 1899.31 442.951
## PercentageFirstPosTime 4 180 34.51 5.494 34.44 34.35 5.496
## PercentageFinalPosTime 5 180 29.29 5.532 29.55 29.35 5.010
## FirstPosTime1 1 180 184.57 33.150 184.17 183.98 38.301
## FinalPosTime1 2 180 178.45 32.156 180.00 178.15 39.536
## ElapsedTime1 3 180 812.34 102.408 797.70 805.78 105.561
## PercentageFirstPosTime1 4 180 22.70 2.841 22.74 22.67 2.938
## PercentageFinalPosTime1 5 180 21.96 2.838 22.06 21.90 3.055
## FirstPosTime2 1 180 489.06 167.517 460.83 471.94 159.379
## FinalPosTime2 2 180 408.65 114.756 385.83 401.67 124.786
## ElapsedTime2 3 180 1693.96 550.916 1550.17 1607.50 365.807
## PercentageFirstPosTime2 4 180 29.15 5.701 28.40 28.98 5.501
## PercentageFinalPosTime2 5 180 25.04 6.461 24.21 24.69 5.389
## min max range skew kurtosis se
## FirstPosTime 305.00 1368.33 1063.33 0.89239 0.57243 15.8175
## FinalPosTime 283.33 1116.67 833.33 0.87088 0.58739 11.9164
## ElapsedTime 1038.47 4098.07 3059.60 0.93382 1.48741 38.2273
## PercentageFirstPosTime 18.64 54.41 35.77 0.34903 0.97707 0.4095
## PercentageFinalPosTime 14.00 43.70 29.70 -0.08151 -0.02618 0.4123
## FirstPosTime1 111.67 273.33 161.67 0.15900 -0.75697 2.4708
## FinalPosTime1 106.67 256.67 150.00 0.07982 -0.85409 2.3967
## ElapsedTime1 610.40 1103.00 492.60 0.58084 0.08339 7.6331
## PercentageFirstPosTime1 16.51 30.61 14.10 0.12423 -0.27032 0.2117
## PercentageFinalPosTime1 14.90 28.74 13.84 0.10817 -0.37612 0.2116
## FirstPosTime2 231.67 1223.33 991.67 1.22391 2.38717 12.4860
## FinalPosTime2 195.00 705.00 510.00 0.46358 -0.68881 8.5534
## ElapsedTime2 996.13 4124.47 3128.33 1.68794 3.23439 41.0629
## PercentageFirstPosTime2 14.79 45.20 30.41 0.27632 -0.19712 0.4249
## PercentageFinalPosTime2 12.32 44.28 31.96 0.51519 -0.00533 0.4816
## metric Device
## FirstPosTime PositioningTime (milliseconds) LeapMotionScreenTap
## FinalPosTime FinalPosTime LeapMotionScreenTap
## ElapsedTime ElapsedTime LeapMotionScreenTap
## PercentageFirstPosTime Percentage of total time LeapMotionScreenTap
## PercentageFinalPosTime PercentageFinalPosTime LeapMotionScreenTap
## FirstPosTime1 PositioningTime (milliseconds) Mouse
## FinalPosTime1 FinalPosTime Mouse
## ElapsedTime1 ElapsedTime Mouse
## PercentageFirstPosTime1 Percentage of total time Mouse
## PercentageFinalPosTime1 PercentageFinalPosTime Mouse
## FirstPosTime2 PositioningTime (milliseconds) LeapMotionHandGrab
## FinalPosTime2 FinalPosTime LeapMotionHandGrab
## ElapsedTime2 ElapsedTime LeapMotionHandGrab
## PercentageFirstPosTime2 Percentage of total time LeapMotionHandGrab
## PercentageFinalPosTime2 PercentageFinalPosTime LeapMotionHandGrab
p1 <- ggplot(describeMetrics[describeMetrics$metric=="PositioningTime (milliseconds)", ], aes(x=Device, y=mean, group=Device, colour=Device, fill=Device)) +
#stat_summary(fun.y="mean", geom="bar") +
geom_bar(stat="identity", width=.5, position = position_dodge(width=0.5)) +
geom_errorbar(aes(ymin=abs(mean)-1.96*abs(se), ymax=abs(mean)+1.96*abs(se)), colour="Black",
width=.2, # Width of the error bars
size = .1,
position=position_dodge(.5)) +
#facet_wrap( ~ metric,nrow=1, scales="free") +
ylab("Milliseconds") +
xlab("Final positioning time (FPT)") +
theme(
plot.margin=unit(c(10,1,1,1),"mm"),
legend.position="none", legend.direction="horizontal",
axis.text.x = element_blank()) +
scale_fill_brewer(palette="Set1") +
scale_colour_brewer(palette="Set1") +
theme()
p2 <- ggplot(describeMetrics[ describeMetrics$metric=="Percentage of total time", ], aes(x=Device, y=mean, group=Device, colour=Device, fill=Device)) +
#stat_summary(fun.y="mean", geom="bar") +
geom_bar(stat="identity", width=.5, position = position_dodge(width=0.5)) +
geom_errorbar(aes(ymin=abs(mean)-1.96*abs(se), ymax=abs(mean)+1.96*abs(se)), colour="Black",
width=.2, # Width of the error bars
size = .1,
position=position_dodge(.5)) +
#facet_wrap( ~ metric,nrow=1, scales="free") +
ylab("Percentage") +
xlab("Percentage of FPT in total time") +
theme(
plot.margin=unit(c(10,3,1,1),"mm"),
legend.position=c(-0.1,1.07),
legend.direction="horizontal",
axis.text.x = element_blank()) +
scale_fill_brewer(palette="Set1") +
scale_colour_brewer(palette="Set1") +
theme()
#ggsave(file = paste("charts/","final-positioniningtime.pdf", sep=""), width=14/2.54, height=10/2.54, dpi=100)
pdf(file = paste("charts/","final-positioniningtime.pdf",sep=""), width=14/2.54, height=9/2.54)
multiplot(p1, p2, cols=2)
dev.off()
## pdf
## 2
p1
p2
Effective Target Width
measures <- read.csv(paste("data/", fileNameMeasures, sep=""), sep="", head = TRUE)
measures <- measures[measures$Block>3 & measures$Block<8 & measures$UserId != 5,]
# Calculate effective target width
for ( device in unique(measures$Device)) {
meanX <- mean(measures[measures$Device == device,]$ClickPointX - measures[measures$Device == device,]$TargetX)
meanY <- mean(measures[measures$Device == device,]$ClickPointY - measures[measures$Device == device,]$TargetY )
diffX <- (measures[measures$Device == device,]$ClickPointX - measures[measures$Device == device,]$TargetX)-meanX
diffY <- (measures[measures$Device == device,]$ClickPointY - measures[measures$Device == device,]$TargetY)-meanY
diffSQX <- diffX*diffX
diffSQY <- diffY*diffY
#SD <- sqrt(sum(diffSQX+diffSQY)/(length(diffX)-1))
SD <- sd(measures[measures$Device == device,]$ClickPointX)
We <- 4.133*SD
print(paste(device,":",We))
}
## [1] "4 : 59.3059649900864"
## [1] "1 : 57.4159297892292"
## [1] "0 : 56.9948944595393"
#http://www.sigchi.org/chi96/proceedings/papers/Mithal/Akm_txt.htm
# Descriptive stats
describeBy(dataTransformed[, c("speeds", "accels", "insidecount", "displacement", "distance")], dataTransformed[, c("Device")])
agg <- aggregate(dataTransformed[, c("insidecount", "speeds", "accels")], dataTransformed[, c("Device", "UserId", "Block", "Sequence", "CircleID")], mean)
agg <- aggregate(dataTransformed[, c("displacement", "distance")], dataTransformed[, c("Device", "UserId", "Block", "Sequence", "CircleID")], max)
d <- dataTransformed[ dataTransformed$Block==4 & dataTransformed$UserId ==1 & dataTransformed$Sequence==1 & dataTransformed$CircleID==3, ]
plot(d$speeds)
#d <- dataTransformed[dataTransformed$Device=="Mouse" & dataTransformed$Block==4 & dataTransformed$UserId ==1 & dataTransformed$Sequence==1, ]
#View()
ggplot(d, aes(x=percentpath, y=speeds, group=Device, colour=Device)) +
geom_path() +
geom_point()
speed<-aggregate(dataTransformed$speeds, dataTransformed[,c("displacement", "Device")], mean)
ggplot(speed, aes(x=displacement, y=x, group=Device, colour=Device)) +
#geom_smooth() +
geom_path()
speed<-aggregate(dataTransformed$speeds, dataTransformed[,c("cuts", "Device")], mean)
ggplot(speed, aes(x=cuts, y=x, group=Device, colour=Device)) +
#geom_smooth() +
geom_path()
accel<-aggregate(dataTransformed$accels, dataTransformed[,c("cuts", "Device")], mean)
ggplot(accel, aes(x=cuts, y=x, group=Device, colour=Device)) +
#geom_smooth() +
geom_path()