#Perception and Action exam
---
title: "Mousetracking Analysis"
author: "Sofie & Marie"
date: "12/12/2022"
output: html_document
---
The documentation for the package can be found here: <https://www.rdocumentation.org/packages/mousetrap/versions/3.1.5/topics/mousetrap>.
Use this page to solve the following steps by finding and applying appropriate mousetrap functions. Also, writing ?function_name() in the console is great way of reading about the function in question.
## Install packages and load in the data
```{r}
# loading packages
pacman::p_load(mousetrap, tidyverse,grid, gridExtra, dplyr, mt_example_raw)
# loading in data individually
d_subject1 <- read_csv('logfiles/subject-1.csv')
d_subject2 <- read_csv('logfiles/subject-2.csv')
d_subject3 <- read_csv('logfiles/subject-3.csv')
d_subject4 <- read_csv('logfiles/subject-4.csv')
d_subject5 <- read_csv('logfiles/subject-5.csv')
d_subject6 <- read_csv('logfiles/subject-6.csv')
d_subject7 <- read_csv('logfiles/subject-7.csv')
d_subject8 <- read_csv('logfiles/subject-8.csv')
#d_subject9 <- read_csv('logfiles/subject-9.csv')
# if we also want to create a df with all the data
#temp = list.files(pattern="logfiles/*.csv")
#myfiles = lapply(temp, read.delim)
#... or
#logfiles <- list.files(path = 'logfiles')
#data = data.frame() #create empty df
#
#for (i in logfiles){ #loop over list of files
# file = read.csv(i) #import the current file
# data = rbind(data, file) #add current file to the final dataframe
#}
d_subject1 <- d_subject1 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject2 <- d_subject2 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject3 <- d_subject3 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject4 <- d_subject4 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject5 <- d_subject5 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject6 <- d_subject6 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject7 <- d_subject7 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject8 <- d_subject8 %>%
select(-contains("_Trial"), -contains("_green"), -contains("_red"), -contains("_P"), -contains("_training"), -contains("_Intro"), -contains("_endofexperiment"), -contains("_taining"), -contains("_test1"), -contains("time_resetfeedback_test"))
d_subject1 <- d_subject1 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0)) #when the trial is incongruent or the response is correct (==1) the column will be dummy coded to one, else it is called 0
d_subject2 <- d_subject2 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject3 <- d_subject3 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject4 <- d_subject4 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject5 <- d_subject5 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject6 <- d_subject6 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject7 <- d_subject7 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject8 <- d_subject8 %>%
mutate(dummy = case_when(Correct_response == "none" & avg_rt > 5999 ~ 1,
TRUE ~ 0),
dummy = case_when(dummy == 1 | correct == 1 ~ 1,
TRUE ~ 0))
d_subject1 <- d_subject1[ , colSums(is.na(d_subject1))==0] #removing NA
d_subject2 <- d_subject2[ , colSums(is.na(d_subject2))==0] #removing NA
d_subject3 <- d_subject3[ , colSums(is.na(d_subject3))==0] #removing NA
d_subject4 <- d_subject4[ , colSums(is.na(d_subject4))==0] #removing NA
d_subject5 <- d_subject5[ , colSums(is.na(d_subject5))==0] #removing NA
d_subject6 <- d_subject6[ , colSums(is.na(d_subject6))==0] #removing NA
d_subject7 <- d_subject7[ , colSums(is.na(d_subject7))==0] #removing NA
d_subject8 <- d_subject8[ , colSums(is.na(d_subject8))==0] #removing NA
```
## Clean data
```{r}
#remove unnecessary columns (unnecessary demographic information and mouse data from the training trials)
d_subject1 <- subset(d_subject1, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject2 <- subset(d_subject2, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject3 <- subset(d_subject3, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject4 <- subset(d_subject4, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject5 <- subset(d_subject5, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject6 <- subset(d_subject6, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject7 <- subset(d_subject7, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
d_subject8 <- subset(d_subject8, select = -c(Consent,
Hearing,
Righthand,
Vision,
correct_SoundTest_Adjust,
correct_new_sketchpad,
foreground,
fullscreen,
keyboard_backend))
# d_subject9 <- subset(d_subject9, select = -c(Consent,
# Hearing,
#Righthand,
#Vision,
#timestamps_mousetrap_red,
#timestamps_mousetrap_green,
#xpos_mousetrap_red,
#xpos_mousetrap_green,
#ypos_mousetrap_red,
#ypos_mousetrap_green)) %>%
# select(-contains("_train")) %>%
# select(-contains("_training"))
#d_subject10 <- subset(d_subject10, select = -c(Consent,
# Hearing,
# Righthand,
# Vision,
#timestamps_mousetrap_red,
#timestamps_mousetrap_green,
# xpos_mousetrap_red,
# xpos_mousetrap_green,
# ypos_mousetrap_red,
# ypos_mousetrap_green)) %>%
# select(-contains("_train")) %>%
# select(-contains("_training"))
```
## Turn the data into a mousetrap object
```{r}
m1 <- mt_import_mousetrap(d_subject1)
m2 <- mt_import_mousetrap(d_subject2)
m3<- mt_import_mousetrap(d_subject3)
m4 <- mt_import_mousetrap(d_subject4)
m5 <- mt_import_mousetrap(d_subject5)
m6 <- mt_import_mousetrap(d_subject6)
m7 <- mt_import_mousetrap(d_subject7)
m8 <- mt_import_mousetrap(d_subject8)
#m9 <- mt_import_mousetrap(d_subject9)
```
## Make a quick plot using the mt_plot() function
```{r}
# initial plot
mt_plot(m1)
mt_plot(m2)
mt_plot(m3)
mt_plot(m4)
mt_plot(m5)
mt_plot(m6)
mt_plot(m7)
mt_plot(m8)
#mt_plot(m9)
#mt_plot(m10)
# specified
pm1 <- mt_plot(data = m1, use = 'trajectories') + ggtitle("subject1")
pm2 <- mt_plot(data = m2, use = 'trajectories') + ggtitle("subject2")
pm3 <- mt_plot(data = m3, use = 'trajectories') + ggtitle("subject3")
pm4 <- mt_plot(data = m4, use = 'trajectories') + ggtitle("subject4")
pm5 <- mt_plot(data = m5, use = 'trajectories') + ggtitle("subject5")
pm6 <- mt_plot(data = m6, use = 'trajectories') + ggtitle("subject6")
pm7 <- mt_plot(data = m7, use = 'trajectories') + ggtitle("subject7")
pm8 <- mt_plot(data = m8, use = 'trajectories') + ggtitle("subject8")
#pm9 <- mt_plot(data = m9, use = 'trajectories') + ggtitle("subject9")
grid.arrange(pm1, pm2, pm3, pm4, pm5, pm6, pm7, pm8, nrow=3)
```
## Make a plot in which the lines are coloured by condition
The demo-experiment had different trial types for which we have different predictions. Make a plot that distinguishes these two conditions, e.g. by different colors.
```{r}
by_con_pm1 <- mt_plot(m1, color = 'Trial_type') + ggtitle("subject1")
by_con_pm2 <-mt_plot(m2, color = 'Trial_type') + ggtitle("subject2")
by_con_pm3 <-mt_plot(m3, color = 'Trial_type') + ggtitle("subject3")
by_con_pm4 <-mt_plot(m4, color = 'Trial_type') + ggtitle("subject4")
by_con_pm5 <-mt_plot(m5, color = 'Trial_type') + ggtitle("subject5")
by_con_pm6 <-mt_plot(m6, color = 'Trial_type') + ggtitle("subject6")
by_con_pm7 <-mt_plot(m7, color = 'Trial_type') + ggtitle("subject7")
by_con_pm8 <-mt_plot(m8, color = 'Trial_type') + ggtitle("subject8")
#by_con_pm9 <-mt_plot(m9, color = 'Trial_type') + ggtitle("subject9")
grid.arrange(by_con_pm1, by_con_pm2, by_con_pm3, by_con_pm4, by_con_pm5, by_con_pm6, by_con_pm7,by_con_pm8, nrow=4)
```
## Mirror-symmetric mapping of movements
Find a function that does a mirror-symmetric mapping of all the movements from the right side to the left side so that all movements overlap. Plot again...
```{r}
# align the mouse trajectories to one side
ms1 <- mt_remap_symmetric(
m1,
use = 'trajectories',
remap_xpos = "left"
)
ms2 <- mt_remap_symmetric(
m2,
use = 'trajectories',
remap_xpos = "left"
)
ms3 <- mt_remap_symmetric(
m3,
use = 'trajectories',
remap_xpos = "left"
)
ms4 <- mt_remap_symmetric(
m4,
use = 'trajectories',
remap_xpos = "left"
)
ms5 <- mt_remap_symmetric(
m5,
use = 'trajectories',
remap_xpos = "left"
)
ms6 <- mt_remap_symmetric(
m6,
use = 'trajectories',
remap_xpos = "left"
)
ms7 <- mt_remap_symmetric(
m7,
use = 'trajectories',
remap_xpos = "left"
)
ms8 <- mt_remap_symmetric(
m8,
use = 'trajectories',
remap_xpos = "left"
)
#ms9 <- mt_remap_symmetric(
# m9,
# use = 'trajectories',
# remap_xpos = "left"
# )
#ms10 <- mt_remap_symmetric(
# m10,
# use = 'trajectories',
# remap_xpos = "left"
# )
#plot again
pms1 <- mt_plot(
ms1,
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject1")
pms2 <- mt_plot(
ms2,
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject2")
pms3 <- mt_plot(
ms3,
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject3")
pms4 <- mt_plot(
ms4,
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject4")
pms5 <- mt_plot(
ms5,
use = 'trajectories',
color = 'Trial_type'
) + ggtitle("subject5")
pms6 <- mt_plot(
ms6,
use = 'trajectories',
color = 'Trial_type'
) + ggtitle("subject6")
pms7 <- mt_plot(
ms7,
use = 'trajectories',
color = 'Trial_type'
) + ggtitle("subject7")
pms8 <- mt_plot(
ms8,
use = 'trajectories',
color = 'Trial_type'
) + ggtitle("subject8")
grid.arrange(pms1, pms2, pms3, pms4, pms5, pms6, pms7, pms8, nrow=4)
# turns the data upside down, so it resembles the actual mouse tracking task
```
## Plot timestamps by xpos
The standard plotting function shows x and y coordinates. Modify it so you plot timestamps by xpos. What do you see? What is this line in the beginning?
```{r}
by_xpos_pm1 <- mt_plot(
m1,
x = 'timestamps', # modifying the x-axis to plot timestamps
y = 'xpos', # modifying the y-axis to plot the xpos
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject1")
by_xpos_pm2 <- mt_plot(
m2,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject2")
by_xpos_pm3 <- mt_plot(
m3,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject3")
by_xpos_pm4 <- mt_plot(
m4,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject4")
by_xpos_pm5 <- mt_plot(
m5,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject5")
by_xpos_pm6 <- mt_plot(
m6,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject6")
by_xpos_pm7 <- mt_plot(
m7,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject7")
by_xpos_pm8 <- mt_plot(
m8,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject8")
grid.arrange(by_xpos_pm1, by_xpos_pm2, by_xpos_pm3, by_xpos_pm4, by_xpos_pm5, by_xpos_pm6, by_xpos_pm7, by_xpos_pm8, nrow=4)
```
## Find a function that removes the initial phase without mouse-movement
```{r}
m1_without_initialphase <- mt_exclude_initiation(m1)
m2_without_initialphase <- mt_exclude_initiation(m2)
m3_without_initialphase <- mt_exclude_initiation(m3)
m4_without_initialphase <- mt_exclude_initiation(m4)
m5_without_initialphase <- mt_exclude_initiation(m5)
m6_without_initialphase <- mt_exclude_initiation(m6)
m7_without_initialphase <- mt_exclude_initiation(m7)
m8_without_initialphase <- mt_exclude_initiation(m8)
```
```{r}
by_time_pm1 <- mt_plot(
m1_without_initialphase,
x = 'timestamps', # modifying the x-axis to plot timestamps
y = 'xpos', # modifying the y-axis to plot the xpos
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject1")
by_time_pm2 <- mt_plot(
m2_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject2")
by_time_pm3 <- mt_plot(
m3_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject3")
by_time_pm4 <- mt_plot(
m4_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject4")
by_time_pm5 <- mt_plot(
m5_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject5")
by_time_pm6 <- mt_plot(
m6_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject6")
by_time_pm7 <- mt_plot(
m7_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject7")
by_time_pm8 <- mt_plot(
m8_without_initialphase,
x = 'timestamps',
y = 'xpos',
use = 'trajectories',
color = 'Trial_type'
)+ ggtitle("subject8")
grid.arrange(by_time_pm1, by_time_pm2, by_time_pm3, by_time_pm4, by_time_pm5, by_time_pm6,by_time_pm7, by_time_pm8, nrow=4)
```
## Time-normalize the data
```{r}
#we can't time-normalize the data from the no/go-trials, as all the participants didn't move their mouse... We can work around this through the next few steps:
# Calculate number of logged positions
mt_example1 <- mt_count(m1_without_initialphase, save_as = "data")
# Table of number of logged positions
table(mt_example1$data$nobs)
# Check if there are trials with 2 or fewer logged positions
table(mt_example1$data$nobs<=2)
# Only keep trials with more than 2 logged positions
mt_example1 <- mt_subset(mt_example1, nobs>2)
# Calculate variance of positions for each trial
m1_without_initialphase$data$pos_var <- apply(m1_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m1_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
# Check if there are trials with 0 variance (i.e., all positions are identical)
table(m1_without_initialphase$data$pos_var==0)
# Only keep trials where positions varied
m1_without_initialphase <- mt_subset(m1_without_initialphase, pos_var>0)
# subject 2
mt_example2 <- mt_count(m2_without_initialphase, save_as = "data")
table(mt_example2$data$nobs)
table(mt_example2$data$nobs<=2)
mt_example2 <- mt_subset(mt_example2, nobs>2)
m2_without_initialphase$data$pos_var <- apply(m2_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m2_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m2_without_initialphase$data$pos_var==0)
m2_without_initialphase <- mt_subset(m2_without_initialphase, pos_var>0)
# subject 3
mt_example3 <- mt_count(m3_without_initialphase, save_as = "data")
table(mt_example3$data$nobs)
table(mt_example3$data$nobs<=2)
mt_example3 <- mt_subset(mt_example3, nobs>2)
m3_without_initialphase$data$pos_var <- apply(m3_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m3_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m3_without_initialphase$data$pos_var==0)
m3_without_initialphase <- mt_subset(m3_without_initialphase, pos_var>0)
# subject 4
mt_example4 <- mt_count(m4_without_initialphase, save_as = "data")
table(mt_example4$data$nobs)
table(mt_example4$data$nobs<=2)
mt_example4 <- mt_subset(mt_example4, nobs>2)
m4_without_initialphase$data$pos_var <- apply(m4_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m4_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m4_without_initialphase$data$pos_var==0)
m4_without_initialphase <- mt_subset(m4_without_initialphase, pos_var>0)
# subject 5
mt_example5 <- mt_count(m5_without_initialphase, save_as = "data")
table(mt_example5$data$nobs)
table(mt_example5$data$nobs<=2)
mt_example5 <- mt_subset(mt_example5, nobs>2)
m5_without_initialphase$data$pos_var <- apply(m5_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m5_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m5_without_initialphase$data$pos_var==0)
m5_without_initialphase <- mt_subset(m5_without_initialphase, pos_var>0)
# subject 6
mt_example6 <- mt_count(m6_without_initialphase, save_as = "data")
table(mt_example6$data$nobs)
table(mt_example6$data$nobs<=2)
mt_example6 <- mt_subset(mt_example6, nobs>2)
m6_without_initialphase$data$pos_var <- apply(m6_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m6_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m6_without_initialphase$data$pos_var==0)
m6_without_initialphase <- mt_subset(m6_without_initialphase, pos_var>0)
# subject 7
mt_example7 <- mt_count(m7_without_initialphase, save_as = "data")
table(mt_example7$data$nobs)
table(mt_example7$data$nobs<=2)
mt_example7 <- mt_subset(mt_example7, nobs>2)
m7_without_initialphase$data$pos_var <- apply(m7_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m7_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m7_without_initialphase$data$pos_var==0)
m7_without_initialphase <- mt_subset(m7_without_initialphase, pos_var>0)
# subject 8
mt_example8 <- mt_count(m8_without_initialphase, save_as = "data")
table(mt_example8$data$nobs)
table(mt_example8$data$nobs<=2)
mt_example8 <- mt_subset(mt_example8, nobs>2)
m8_without_initialphase$data$pos_var <- apply(m8_without_initialphase$trajectories[,,"xpos"],1,var,na.rm=TRUE) + apply(m8_without_initialphase$trajectories[,,"ypos"],1,var,na.rm=TRUE)
table(m8_without_initialphase$data$pos_var==0)
m8_without_initialphase <- mt_subset(m8_without_initialphase, pos_var>0)
#Apply the function “mt_time_normalize”
m1_time_normalized <- mt_time_normalize(m1_without_initialphase)
m2_time_normalized <- mt_time_normalize(m2_without_initialphase)
m3_time_normalized <- mt_time_normalize(m3_without_initialphase)
m4_time_normalized <- mt_time_normalize(m4_without_initialphase)
m5_time_normalized <- mt_time_normalize(m5_without_initialphase)
m6_time_normalized <- mt_time_normalize(m6_without_initialphase)
m7_time_normalized <- mt_time_normalize(m7_without_initialphase)
m8_time_normalized <- mt_time_normalize(m8_without_initialphase)
```
## Plot the normalized trajectories
Find out how to plot the normalized trajectories instead of the raw data.
```{r}
normalized_trajectories_pm1 <-
mt_plot(
m1_time_normalized,
use = 'tn_trajectories', # hvad er tn_trajectories hos os???
color = 'Trial_type'
)+ ggtitle("subject1")
normalized_trajectories_pm2 <-
mt_plot(
m2_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject2")
normalized_trajectories_pm3 <-
mt_plot(
m3_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject3")
normalized_trajectories_pm4 <-
mt_plot(
m4_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject4")
normalized_trajectories_pm5 <-
mt_plot(
m5_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject5")
normalized_trajectories_pm6 <-
mt_plot(
m6_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject6")
normalized_trajectories_pm7 <-
mt_plot(
m7_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject6")
normalized_trajectories_pm8 <-
mt_plot(
m8_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
)+ ggtitle("subject6")
grid.arrange(normalized_trajectories_pm1,
normalized_trajectories_pm2,
normalized_trajectories_pm3,
normalized_trajectories_pm4,
normalized_trajectories_pm5,
normalized_trajectories_pm6,
normalized_trajectories_pm7,
normalized_trajectories_pm8, nrow=4)
```
## Aggregated plots
Now we want to visualize our “findings”. Find a function that will plot averages of all the “similar” movements and all the “dissimilar” movements.
Think: Which trajectories do we need to use, the original or the time normalized? Why? Try plotting both to see whether you were right.
```{r}
pm1_aggregated <- mt_plot_aggregate(
m1_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 1')
pm2_aggregated <- mt_plot_aggregate(
m2_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 2')
pm3_aggregated <- mt_plot_aggregate(
m3_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 3')
pm4_aggregated <- mt_plot_aggregate(
m4_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 4')
pm5_aggregated <- mt_plot_aggregate(
m5_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 5')
pm6_aggregated <- mt_plot_aggregate(
m6_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 6')
pm7_aggregated <- mt_plot_aggregate(
m7_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 7')
pm8_aggregated <- mt_plot_aggregate(
m8_time_normalized,
use = 'tn_trajectories',
color = 'Trial_type'
) +
labs(
title = 'Subject 8')
grid.arrange(pm1_aggregated,
pm2_aggregated,
pm3_aggregated,
pm4_aggregated,
pm5_aggregated,
pm6_aggregated,
pm7_aggregated,
pm8_aggregated,
nrow=4) +
labs(
title = 'Aggregated time-normalized mouse trajectories')
```
## Apply the function mt_measures()
Apply the function “mt_measures” and look at the outcome in your data variable.
```{r}
m1_mt_measures <- mt_measures(m1_time_normalized, use = 'tn_trajectories')
m2_mt_measures <- mt_measures(m2_time_normalized, use = 'tn_trajectories')
m3_mt_measures <- mt_measures(m3_time_normalized, use = 'tn_trajectories')
m4_mt_measures <- mt_measures(m4_time_normalized, use = 'tn_trajectories')
m5_mt_measures <- mt_measures(m5_time_normalized, use = 'tn_trajectories')
m6_mt_measures <- mt_measures(m6_time_normalized, use = 'tn_trajectories')
m7_mt_measures <- mt_measures(m7_time_normalized, use = 'tn_trajectories')
m8_mt_measures <- mt_measures(m8_time_normalized, use = 'tn_trajectories')```
## Aggregating measures
Now find a function that helps you aggregate some measures of your pleasing over the two trial_types.
```{r}
m1_mt_measures_ag <- mt_aggregate(
m1_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'), # if you want all of the measures, exclude this line
use2_variables = 'Trial_type'
)
m1_mt_measures_ag
m2_mt_measures_ag <- mt_aggregate(
m2_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m2_mt_measures_ag
m3_mt_measures_ag <- mt_aggregate(
m3_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m3_mt_measures_ag
m4_mt_measures_ag <- mt_aggregate(
m4_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m4_mt_measures_ag
m5_mt_measures_ag <- mt_aggregate(
m5_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m5_mt_measures_ag
m6_mt_measures_ag <- mt_aggregate(
m6_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m6_mt_measures_ag
m7_mt_measures_ag <- mt_aggregate(
m7_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m7_mt_measures_ag
m8_mt_measures_ag <- mt_aggregate(
m8_mt_measures,
use = 'measures',
use_variables = c('MAD', 'xpos_flips','AUC', 'RT'),
use2_variables = 'Trial_type'
)
m8_mt_measures_ag
```
### Discussion of mt_align
Would the function ‘mt_align’ be useful for this data? Why or why not?
It can do the same as mt_remap symmetric, but it can also be used to rescale (here 'space-normalize') the data.
You could align the starting and end position, as we are only interested in the trajectory of the mouse movement, not the endpoint in it self. Also, because the end point could be anywhere within the stimulus (circle or square), it looks nice to drag the trajectories to the same point.
As we only have one participant, I wouldn't say it is necessary (or beneficial, besides it looks nice).
```{r}
m1_align <- mt_align(
m1_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m2_align <- mt_align(
m2_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m3_align <- mt_align(
m3_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m4_align <- mt_align(
m4_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m5_align <- mt_align(
m5_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m6_align <- mt_align(
m6_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m7_align <- mt_align(
m7_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
m8_align <- mt_align(
m8_mt_measures,
use = 'trajectories',
dimensions = c("xpos", "ypos"),
coordinates = c(0,0,-350,250),
align_start = T,
align_end = T
)
# plot again
pm1_align <- mt_plot(
m1_align,
use = 'trajectories',
) + ggtitle("subject1")
pm2_align <- mt_plot(
m2_align,
use = 'trajectories',
) + ggtitle("subject2")
pm3_align <- mt_plot(
m3_align,
use = 'trajectories',
) + ggtitle("subject3")
pm4_align <- mt_plot(
m4_align,
use = 'trajectories',
) + ggtitle("subject4")
pm5_align <- mt_plot(
m5_align,
use = 'trajectories',
) + ggtitle("subject5")
pm6_align <- mt_plot(
m6_align,
use = 'trajectories',
) + ggtitle("subject6")
pm7_align <- mt_plot(
m7_align,
use = 'trajectories',
) + ggtitle("subject7")
pm8_align <- mt_plot(
m7_align,
use = 'trajectories',
) + ggtitle("subject7")
grid.arrange(pm1_align, pm2_align, pm3_align, pm4_align, pm5_align, pm6_align, pm7_align, pm8_align, nrow=4)
```
### ggplot
As the mt_plot function uses ggplot, you can easily add themes, titles and such to make your plots look nice. Have a go at it!
```{r}
pm1_ggplot <- mt_plot(
m1_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 1', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm2_ggplot <- mt_plot(
m2_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 2', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm3_ggplot <- mt_plot(
m3_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 3', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm4_ggplot <- mt_plot(
m4_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 4', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm5_ggplot <- mt_plot(
m5_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 5', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm6_ggplot <- mt_plot(
m6_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 6', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm7_ggplot <- mt_plot(
m7_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 7', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
pm8_ggplot <- mt_plot(
m8_align,
use = 'trajectories',
color = 'Trial_type'
) +
theme_minimal() +
labs(title = 'Subject 8', x = 'Postition (x)', y = 'Postistion(y)', color = 'Trial Type')
grid.arrange(pm1_ggplot, pm2_ggplot, pm3_ggplot, pm4_ggplot, pm5_ggplot, pm6_ggplot, pm7_ggplot, pm8_ggplot, nrow=4)
```
Google Drive
Gist
Clipboard
Sign in with Wallet
