library(tidyverse)
## ─ Attaching packages ──────────────────── tidyverse 1.3.1 ─
## ✓ ggplot2 3.3.3 ✓ purrr 0.3.4
## ✓ tibble 3.1.2 ✓ dplyr 1.0.6
## ✓ tidyr 1.1.3 ✓ stringr 1.4.0
## ✓ readr 1.4.0 ✓ forcats 0.5.1
## ─ Conflicts ───────────────────── tidyverse_conflicts() ─
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(dplyr)
library(tidyr)
library(ggplot2)
library("Rmisc")
## Loading required package: lattice
## Loading required package: plyr
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
##
## Attaching package: 'plyr'
## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
## The following object is masked from 'package:purrr':
##
## compact
library("plyr")
library("parallel")
library(ggpubr)
##
## Attaching package: 'ggpubr'
## The following object is masked from 'package:plyr':
##
## mutate
library(ggsignif)
library(plotly)
##
## Attaching package: 'plotly'
## The following objects are masked from 'package:plyr':
##
## arrange, mutate, rename, summarise
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
t5<-Sys.time()
#Setting the FPS rate
FPS <- 30
#road data from the folder
file_path <- paste0(getwd(),'/Analysis Data/',list.files(paste0( getwd(),"/Analysis Data/")))
raw_df <- read.csv(file = file_path,header = FALSE) %>% as.data.frame.array()
#read the poject name
poject_name <- raw_df%>% filter(., V1== "scorer") %>% t() %>% unique() %>% .[c(-1),]
#read bodypart list
bodypart_list <- raw_df%>%.[c(-1),] %>% filter(., V1== "bodyparts") %>% t() %>% unique() %>%
.[c(-1),] %>% as.data.frame() %>% .[,1]
#cut the data of each bodyparts, rbind to be total data
n_parts <- sum(table(bodypart_list))
raw_df1<- raw_df %>% .[c(-1),]
#A loop to cut and bind the data of each bodyparts
for (n in 1:n_parts) {
df1 <- raw_df1 %>% .[,c(1,(n*3-1):(n*3+1))] %>% .[c(-1,-2),]
colnames(df1) <- c("coords","x","y","likelihood")
df1 <- transform(df1,
coords=as.integer(coords),
x = as.numeric(x),
y = as.numeric(y),
likelihood = as.numeric(likelihood))
#add x_m1 y_m1, the position of the last frame
df2 <- df1 %>% select(x,y) %>%
mutate(coords=c(1:(nrow(df1))))
colnames(df2) <- c("x_m1","y_m1","coords")
df2$coords <- as.integer(df2$coords)
df1 <- full_join(df1,df2,by= "coords") %>%
.[c(-1,-(nrow(df1)+1)),]%>%
mutate(bodyparts=bodypart_list[n])
#Judge if the df1 is the first one. If so, create total_df. Other then rbind df1 to total_df
if (n==1) {
total_df <- df1
}else{
total_df <- rbind(total_df,df1)
}
}
total_df$bodyparts <- factor(total_df$bodyparts, levels = bodypart_list)
#calculate euclidean
euclidean_df <- total_df %>%
mutate(euclidean=sqrt(( (x-x_m1)-(y-y_m1) )^2),
time= coords/FPS,
speed_frame=euclidean*FPS,
time_s=((coords/FPS)%/%1)+1)
euclidean_df_s <- euclidean_df %>% filter(likelihood > 0.1) %>%
group_by(time_s,bodyparts)%>%
dplyr::summarise(euclidean_s= sum(euclidean))
## `summarise()` has grouped output by 'time_s'. You can override using the `.groups` argument.
g_path <- euclidean_df %>% filter(likelihood > 0.1) %>%
ggplot(aes(x= x,y= -y,color=bodyparts ,fill= bodyparts ))+
geom_path(alpha=0.1)+
facet_grid(.~bodyparts)
g_euclidean_df_s <- euclidean_df_s %>%
ggplot(aes(x= time_s,y= euclidean_s,color=bodyparts ,fill= bodyparts ))+
geom_line(alpha=0.1)
g_path
g_euclidean_df_s
ggsave(file = paste0(getwd(),"/Output/g_path.jpg"), plot = g_path, dpi = 2000, width = 30, height = 8)
ggsave(file = paste0(getwd(),"/Output/g_euclidean_df_s.jpg"), plot = g_euclidean_df_s, dpi = 2000, width = 40, height = 8)
#3D movement trace
fig_path_100 <- euclidean_df %>% filter(speed_frame<170,likelihood > 0.3,bodyparts=="eye",time<100) %>%
plot_ly(., x = ~x, y = ~y, z = ~time, type = 'scatter3d', mode = 'lines',
opacity = 1, line = list(width = ~x, color = ~likelihood, colorscale = list(c(0,'#FCB040'), c(1,'#0072B2')),reverscale = FALSE))%>%
layout(
scene = list( aspectratio = list(x = 1, y = 1, z = 10)))
#OCRの魚の運動痕跡を示す（100秒のデータ）
# X軸＝横、Y軸＝縦、Z軸＝時間、青色＝よく認識している、黄色＝うまく認識できない部分
fig_path_100
#3D movement trace
fig_path <- euclidean_df %>% filter(speed_frame<170,likelihood > 0.3,bodyparts=="eye") %>%
plot_ly(., x = ~x, y = ~y, z = ~time, type = 'scatter3d', mode = 'lines',
opacity = 1, line = list(width = ~x, color = ~likelihood, colorscale = list(c(0,'#FCB040'), c(1,'#0072B2')),reverscale = FALSE))%>%
layout(
scene = list( aspectratio = list(x = 1, y = 1, z = 10)))
# OCRの魚の運動痕跡１時間11分（4200秒のデータ）
# X軸＝横、Y軸＝縦、Z軸＝時間、青色＝よく認識している、黄色＝うまく認識できない部分
fig_path
fig_speed_100 <- euclidean_df %>%
filter(speed_frame<170,likelihood > 0.3,bodyparts=="eye",time<100) %>%
mutate(v=x-x_m1,
u=y-y_m1,
w=0,
) %>%
plot_ly( .,
type="cone",
x= ~x,
y= ~y,
z= ~time,
u= ~u,
v= ~v,
w= ~w,
sizemode= "scaled",
showscale= F,
hoverinfo="u+v+w+text",
sizeref= 10
)%>%
layout(
scene = list( aspectratio = list(x = 1, y = 1, z = 10)))
# OCRの魚の運動痕跡（100秒のデータ）
# X軸＝横、Y軸＝縦、Z軸＝時間、円錐方向＝運動方向、円錐大きさ＝大きいほど速い、円錐色＝速いほど黄色に近い
fig_speed_100
fig_speed <- euclidean_df %>%
filter(speed_frame<170,likelihood > 0.3,bodyparts=="eye") %>%
mutate(v=x-x_m1,
u=y-y_m1,
w=0.1,
) %>%
plot_ly( .,
type="cone",
x= ~x,
y= ~y,
z= ~time,
u= ~u,
v= ~v,
w= ~w,
sizemode= "scaled",
showscale= F,
hoverinfo="u+v+w+text",
sizeref= 100
)%>%
layout(
scene = list( aspectratio = list(x = 1, y = 1, z = 5)))
# OCRの魚の運動痕跡１時間11分（4200秒のデータ）
# X軸＝横、Y軸＝縦、Z軸＝時間、円錐方向＝運動方向、円錐大きさ＝大きいほど速い、円錐色＝速いほど黄色に近い
fig_speed