library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.8
## ✓ tidyr 1.2.0 ✓ stringr 1.4.0
## ✓ readr 2.1.2 ✓ 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
library(ggridges)
library(animation)
library(gganimate)
library(magick)
## Linking to ImageMagick 6.9.12.3
## Enabled features: cairo, fontconfig, freetype, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fftw, ghostscript, x11
t5<-Sys.time()
#Setting the FPS rate
FPS <- 25
#road data from the folder
file_path <- paste0(getwd(),'/Analysis Data/',list.files(paste0( getwd(),"/Analysis Data/")))
file_name <- list.files(paste0( getwd(),"/Analysis Data/"))
for (i in 1:length(file_path)) {
raw_df <- read.csv(file = file_path[i],header = FALSE) %>% as.data.frame.array()
strloca_name <- str_locate(file_name[1],"DLC_resnet50") %>% .[1]
project_name <- substr(file_name[i],1,strloca_name-1)
raw_df[1,1] <- project_name
#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))
#A loop to cut and bind the data of each bodyparts
for (n in 1:n_parts) {
df1 <- raw_df %>% .[c(-1),] %>% .[,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],
project= project_name)
#Judge if the df1 is the first one. If so, create total_df. Other then rbind df1 to total_df
if (i==1&n==1) {
total_df <- df1
}else{
total_df <- rbind(total_df,df1)
}
}
}
total_df$bodyparts <- factor(total_df$bodyparts, levels = bodypart_list)
#生データ
head(raw_df)
## V1
## 1 220304_Dh31R_PDFR_line6DL
## 2 bodyparts
## 3 coords
## 4 0
## 5 1
## 6 2
## V2
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 L_eye
## 3 x
## 4 690.5647583007812
## 5 690.3234252929688
## 6 690.5126342773438
## V3
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 L_eye
## 3 y
## 4 114.31448364257812
## 5 114.34988403320312
## 6 114.19969940185547
## V4
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 L_eye
## 3 likelihood
## 4 0.9999979734420776
## 5 0.9999979734420776
## 6 0.9999979734420776
## V5
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 R_eye
## 3 x
## 4 689.5978393554688
## 5 689.302001953125
## 6 689.5855712890625
## V6
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 R_eye
## 3 y
## 4 114.51762390136719
## 5 114.59358978271484
## 6 114.56562042236328
## V7
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 R_eye
## 3 likelihood
## 4 0.9999967813491821
## 5 0.9999967813491821
## 6 0.9999967813491821
## V8
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 Body
## 3 x
## 4 701.2509765625
## 5 700.9491577148438
## 6 701.2818603515625
## V9
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 Body
## 3 y
## 4 111.60865783691406
## 5 111.70645904541016
## 6 111.59416961669922
## V10
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 Body
## 3 likelihood
## 4 0.9999951124191284
## 5 0.9999951124191284
## 6 0.999994158744812
## V11
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 Genitalia
## 3 x
## 4 712.5408935546875
## 5 712.2828369140625
## 6 712.744873046875
## V12
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 Genitalia
## 3 y
## 4 108.55668640136719
## 5 108.53118896484375
## 6 108.43194580078125
## V13
## 1 DLC_resnet50_Drosophila_shock_walkFeb1shuffle1_100000
## 2 Genitalia
## 3 likelihood
## 4 0.9999997615814209
## 5 0.9999998807907104
## 6 0.9999998807907104
#解析したデータ
head(total_df)
## coords x y likelihood x_m1 y_m1 bodyparts
## 2 1 1217.224 89.37142 0.9999896 1221.237 89.50925 L_eye
## 3 2 1214.312 88.91428 0.9999341 1217.224 89.37142 L_eye
## 4 3 1209.471 86.52196 0.9999590 1214.312 88.91428 L_eye
## 5 4 1205.151 86.99076 0.9999934 1209.471 86.52196 L_eye
## 6 5 1199.864 87.96617 0.9999903 1205.151 86.99076 L_eye
## 7 6 1198.328 87.71018 0.9999424 1199.864 87.96617 L_eye
## project
## 2 220304_Dh31R_PDFR_2_line1
## 3 220304_Dh31R_PDFR_2_line1
## 4 220304_Dh31R_PDFR_2_line1
## 5 220304_Dh31R_PDFR_2_line1
## 6 220304_Dh31R_PDFR_2_line1
## 7 220304_Dh31R_PDFR_2_line1
geno_list <- read_csv(paste0(getwd(),"/project.csv"))
## Rows: 12 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): project, genotype
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
total_df <- left_join(total_df,geno_list,by= "project")
total_df$genotype <- factor(total_df$genotype, levels = c("w","Dh31R10974","PDFR5304" , "Double mt" ))
#ES
es_time <- c(180,190,240,250,300,310)
#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 %>%
group_by(time_s,bodyparts,project,genotype)%>%
dplyr::summarise(euclidean_s= sum(euclidean))
## `summarise()` has grouped output by 'time_s', 'bodyparts', 'project'. You can
## override using the `.groups` argument.
g_path <- euclidean_df %>%
ggplot(aes(x= x,y= -y,fill= bodyparts ))+
theme_classic()+
geom_path(alpha=0.3,aes(colour = bodyparts))+
facet_wrap(genotype~project,ncol=3)
g_path
g_euclidean_df_s <- euclidean_df_s %>%
ggplot(aes(x= time_s,y= euclidean_s,color=bodyparts ,fill= bodyparts ))+
theme_classic()+
geom_line(alpha=0.4)+
facet_wrap(genotype~project,ncol=3)
g_euclidean_df_s
euclidean_df_project <- euclidean_df %>%
group_by(time_s,project,genotype)%>%
dplyr::summarise(euclidean_average= sum(euclidean)/n_parts)
## `summarise()` has grouped output by 'time_s', 'project'. You can override using
## the `.groups` argument.
g_sbd_tile<- euclidean_df_s %>% filter(euclidean_s<60) %>%
mutate(time_10s=(time_s%/%10)*10+10) %>%group_by(bodyparts,project,genotype,time_10s) %>%
dplyr::summarise(euclidean=sum(euclidean_s)) %>%
ggplot() +
geom_tile(aes(x=time_10s,y=project,fill = euclidean))+
theme_classic()+
scale_fill_gradient(low ="white" ,high = "red")+
facet_grid(genotype~., scales = "free", space = "free_y")+
geom_vline(aes(xintercept=180),colour="black", linetype=2)+
geom_vline(aes(xintercept=190),colour="black", linetype=2)+
geom_vline(aes(xintercept=240),colour="black", linetype=2)+
geom_vline(aes(xintercept=250),colour="black", linetype=2)+
geom_vline(aes(xintercept=300),colour="black", linetype=2)+
geom_vline(aes(xintercept=310),colour="black", linetype=2)
## `summarise()` has grouped output by 'bodyparts', 'project', 'genotype'. You can
## override using the `.groups` argument.
g_sbd_tile
g_sbd_tile_geno<- euclidean_df_project %>%
mutate(time_10s=(time_s%/%10)*10+10) %>% group_by(project,genotype,time_10s) %>%
dplyr::summarise(euclidean=sum(euclidean_average)) %>%
ggplot() +
geom_tile(aes(x=time_10s,y=genotype,fill = euclidean))+
scale_x_continuous(breaks = scales::breaks_width(60))+
scale_fill_gradient(low ="white" ,high = "red")+
theme_classic()+
geom_vline(aes(xintercept=180),colour="black", linetype=2)+
geom_vline(aes(xintercept=190),colour="black", linetype=2)+
geom_vline(aes(xintercept=240),colour="black", linetype=2)+
geom_vline(aes(xintercept=250),colour="black", linetype=2)+
geom_vline(aes(xintercept=300),colour="black", linetype=2)+
geom_vline(aes(xintercept=310),colour="black", linetype=2)
## `summarise()` has grouped output by 'project', 'genotype'. You can override
## using the `.groups` argument.
g_sbd_tile_geno
euclidean_df_s %>%
ggplot()+
geom_density_ridges(alpha=0.4,aes(x=euclidean_s,y=project,color=genotype,fill=genotype))
## Picking joint bandwidth of 7.93
ggsave(file = paste0(getwd(),"/Output/g_path.jpg"), plot = g_path, dpi = 1000, width = 15, height = 10)
ggsave(file = paste0(getwd(),"/Output/g_euclidean_s.jpg"), plot = g_euclidean_df_s, dpi = 1000, width = 15, height = 10)
ggsave(file = paste0(getwd(),"/Output/g_sbd_tile.jpg"), plot = g_sbd_tile, dpi = 1000, width = 15, height = 4)
ggsave(file = paste0(getwd(),"/Output/g_sbd_tile_geno.jpg"), plot = g_sbd_tile_geno, dpi = 1000, width = 15, height = 2)
g_euclidean_before_bar<- euclidean_df_s %>% filter(time_s<180) %>% group_by(project,genotype) %>% dplyr::summarise(
mean_euclidean=mean(euclidean_s)
) %>%
ggplot(.,aes(genotype, mean_euclidean,color=genotype,fill = genotype))+
geom_jitter(color= "black",alpha=.5,size=1.5,width = .05,show.legend = FALSE)+
theme_classic()+
theme(axis.title=element_text(size=14, lineheight=.9, family="Times"),
axis.text.x = element_text(size=12,angle = 45,hjust=1),
plot.title=element_text(size=14, lineheight=.9, family="Times"))+
stat_summary(fun = "mean", fun.min = function(x)mean(x), fun.max = function(x)mean(x), geom = "bar",colour="grey", width = 0.5,alpha= 0.8,show.legend = FALSE)+
stat_summary(fun.min = function(x)mean(x) - sd(x), fun.max = function(x)mean(x) + sd(x), geom = "errorbar", colour = "black", width = 0.2)+
labs(x="",y = "Activities",title = "Activities Before")
## `summarise()` has grouped output by 'project'. You can override using the
## `.groups` argument.
g_euclidean_during_bar<- euclidean_df_s %>% filter(time_s>180&time_s<360) %>% group_by(project,genotype) %>% dplyr::summarise(
mean_euclidean=mean(euclidean_s)
) %>%
ggplot(.,aes(genotype, mean_euclidean,color=genotype,fill = genotype))+
geom_jitter(color= "black",alpha=.5,size=1.5,width = .05,show.legend = FALSE)+
theme_classic()+
theme(axis.title=element_text(size=14, lineheight=.9, family="Times"),
axis.text.x = element_text(size=12,angle = 45,hjust=1),
plot.title=element_text(size=14, lineheight=.9, family="Times"))+
stat_summary(fun = "mean", fun.min = function(x)mean(x), fun.max = function(x)mean(x), geom = "bar",colour="grey", width = 0.5,alpha= 0.8,show.legend = FALSE)+
stat_summary(fun.min = function(x)mean(x) - sd(x), fun.max = function(x)mean(x) + sd(x), geom = "errorbar", colour = "black", width = 0.2)+
labs(x="",y = "Activities",title = "Activities during")
## `summarise()` has grouped output by 'project'. You can override using the
## `.groups` argument.
g_euclidean_after_bar<- euclidean_df_s %>% filter(time_s>360) %>% group_by(project,genotype) %>% dplyr::summarise(
mean_euclidean=mean(euclidean_s)
) %>%
ggplot(.,aes(genotype, mean_euclidean,color=genotype,fill = genotype))+
geom_jitter(color= "black",alpha=.5,size=1.5,width = .05,show.legend = FALSE)+
theme_classic()+
theme(axis.title=element_text(size=14, lineheight=.9, family="Times"),
axis.text.x = element_text(size=12,angle = 45,hjust=1),
plot.title=element_text(size=14, lineheight=.9, family="Times"))+
stat_summary(fun = "mean", fun.min = function(x)mean(x), fun.max = function(x)mean(x), geom = "bar",colour="grey", width = 0.5,alpha= 0.8,show.legend = FALSE)+
stat_summary(fun.min = function(x)mean(x) - sd(x), fun.max = function(x)mean(x) + sd(x), geom = "errorbar", colour = "black", width = 0.2)+
labs(x="",y = "Activities",title = "Activities After")
## `summarise()` has grouped output by 'project'. You can override using the
## `.groups` argument.
#Tukey HSD aov
avo_euclidean_before <- euclidean_df_s %>% filter(time_s<180) %>% group_by(project,genotype) %>% dplyr::summarise(
mean_euclidean=mean(euclidean_s)
) %>% ungroup()%>%aov(mean_euclidean~genotype,data=.)%>%TukeyHSD()
## `summarise()` has grouped output by 'project'. You can override using the
## `.groups` argument.
avo_euclidean_during <- euclidean_df_s %>% filter(time_s>180&time_s<360) %>% group_by(project,genotype) %>% dplyr::summarise(
mean_euclidean=mean(euclidean_s)
) %>% ungroup()%>%aov(mean_euclidean~genotype,data=.)%>%TukeyHSD()
## `summarise()` has grouped output by 'project'. You can override using the
## `.groups` argument.
avo_euclidean_after <- euclidean_df_s %>% filter(time_s>360) %>% group_by(project,genotype) %>% dplyr::summarise(
mean_euclidean=mean(euclidean_s)
) %>% ungroup()%>%aov(mean_euclidean~genotype,data=.)%>%TukeyHSD()
## `summarise()` has grouped output by 'project'. You can override using the
## `.groups` argument.
avo_euclidean_before
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = mean_euclidean ~ genotype, data = .)
##
## $genotype
## diff lwr upr p adj
## Dh31R10974-w -14.74788 -64.065144 34.56939 0.7761115
## PDFR5304-w 65.61020 16.292938 114.92747 0.0117919
## Double mt-w 40.95161 -8.365652 90.26888 0.1075902
## PDFR5304-Dh31R10974 80.35808 31.040815 129.67535 0.0035562
## Double mt-Dh31R10974 55.69949 6.382225 105.01676 0.0280528
## Double mt-PDFR5304 -24.65859 -73.975857 24.65868 0.4293635
g_euclidean_before_bar
avo_euclidean_during
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = mean_euclidean ~ genotype, data = .)
##
## $genotype
## diff lwr upr p adj
## Dh31R10974-w 10.3732978 -44.51177 65.25836 0.9275726
## PDFR5304-w 30.4654914 -24.41957 85.35056 0.3491000
## Double mt-w 29.4999873 -25.38508 84.38505 0.3735375
## PDFR5304-Dh31R10974 20.0921936 -34.79287 74.97726 0.6591530
## Double mt-Dh31R10974 19.1266894 -35.75837 74.01175 0.6905895
## Double mt-PDFR5304 -0.9655042 -55.85057 53.91956 0.9999301
g_euclidean_during_bar
avo_euclidean_after
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = mean_euclidean ~ genotype, data = .)
##
## $genotype
## diff lwr upr p adj
## Dh31R10974-w 17.0326343 -48.99122 83.05649 0.8407852
## PDFR5304-w 16.6603262 -49.36353 82.68418 0.8490189
## Double mt-w 37.5469460 -28.47691 103.57080 0.3309930
## PDFR5304-Dh31R10974 -0.3723082 -66.39616 65.65155 0.9999977
## Double mt-Dh31R10974 20.5143116 -45.50954 86.53817 0.7564957
## Double mt-PDFR5304 20.8866198 -45.13723 86.91047 0.7468662
g_euclidean_after_bar
ggsave(file = paste0(getwd(),"/Output/g_euclidean_before_bar.jpg"), plot = g_euclidean_before_bar, dpi = 300, width = 2.5, height = 5)
ggsave(file = paste0(getwd(),"/Output/g_euclidean_during_bar.jpg"), plot = g_euclidean_during_bar, dpi = 300, width = 2.5, height = 5)
ggsave(file = paste0(getwd(),"/Output/g_euclidean_after_bar.jpg"), plot = g_euclidean_after_bar, dpi = 300, width = 2.5, height = 5)
r_1 <- raw_df%>%.[c(-1),] %>% filter(., V1== "bodyparts") %>% t() %>% as.data.frame()
colnames(r_1) <- c("bodyparts")
r_2 <- raw_df%>%.[c(-1),] %>% filter(., V1== "coords") %>% t() %>% as.data.frame()
colnames(r_2) <- c("coords")
df_degree <- raw_df%>%.[c(-1:-3),]
colnames(df_degree) <- cbind(r_1,r_2) %>% mutate(NO_body= paste0(bodyparts,"_",coords)) %>% .[,3]
makenumcols<-function(df){
df<-as.data.frame(df)
df[] <- lapply(df, as.character)
cond <- apply(df, 2, function(x) {
x <- x[!is.na(x)]
all(suppressWarnings(!is.na(as.numeric(x))))
})
numeric_cols <- names(df)[cond]
df[,numeric_cols] <- sapply(df[,numeric_cols], as.numeric)
return(df)
}
specify_decimal <- function(x, k) trimws(format(round(x, k), nsmall=k))
df_degree<-makenumcols(df_degree)%>%
filter(Body_likelihood>0.3,Genitalia_likelihood>0.3) %>%
mutate( time_s= bodyparts_coords/FPS,
degree_eye_body=floor(atan2(( ((L_eye_y+R_eye_y)/2)-Body_y),(((L_eye_x+R_eye_x)/2)-Body_x))*180/pi),
degree_body_genitalia= floor(atan2((Body_y-Genitalia_y ),(Body_x-Genitalia_x))*180/pi)
)
g_df_degree_eb <- df_degree %>% group_by(degree_eye_body) %>%
dplyr::summarise(n_num=n()) %>% makenumcols()
g_df_degree_bg <- df_degree %>% group_by(degree_body_genitalia) %>%
dplyr::summarise(n_num=n()) %>% makenumcols()
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
g_degree_eb<- ggplot(g_df_degree_eb, aes( degree_eye_body,n_num,fill=n_num))+
stat_summary(fun = "mean", fun.min = function(x)mean(x), fun.max = function(x)mean(x), geom = "bar",show.legend = FALSE)+
scale_fill_gradient(low="grey", high="red")+
scale_x_continuous(breaks = scales::breaks_width(30))+
theme_light()+
coord_polar()
g_degree_bg<- ggplot(g_df_degree_bg, aes( degree_body_genitalia,n_num,fill=n_num))+
stat_summary(fun = "mean", fun.min = function(x)mean(x), fun.max = function(x)mean(x), geom = "bar",alpha= 0.9,show.legend = FALSE)+
scale_fill_gradient(low="grey", high="orange")+
scale_x_continuous(breaks = scales::breaks_width(30))+
theme_light()+
coord_polar()
g1 <- ggarrange(g_degree_eb,g_degree_bg,ncol=2, nrow=1,common.legend = T, legend = "none"
)
ggsave(file = paste0(getwd(),'/Output/',"g_degree_merge.png"), plot = g1, dpi = 400, width = 10, height = 10)
g1
r_1 <- raw_df%>%.[c(-1),] %>% filter(., V1== "bodyparts") %>% t() %>% as.data.frame()
colnames(r_1) <- c("bodyparts")
r_2 <- raw_df%>%.[c(-1),] %>% filter(., V1== "coords") %>% t() %>% as.data.frame()
colnames(r_2) <- c("coords")
df_degree <- raw_df%>%.[c(-1:-3),]
colnames(df_degree) <- cbind(r_1,r_2) %>% mutate(NO_body= paste0(bodyparts,"_",coords)) %>% .[,3]
makenumcols<-function(df){
df<-as.data.frame(df)
df[] <- lapply(df, as.character)
cond <- apply(df, 2, function(x) {
x <- x[!is.na(x)]
all(suppressWarnings(!is.na(as.numeric(x))))
})
numeric_cols <- names(df)[cond]
df[,numeric_cols] <- sapply(df[,numeric_cols], as.numeric)
return(df)
}
specify_decimal <- function(x, k) trimws(format(round(x, k), nsmall=k))
f_degree <- function(likelihood){
df1 <- makenumcols(df_degree)%>%
filter( Body_likelihood>likelihood,Genitalia_likelihood>likelihood) %>%
mutate( time_s= bodyparts_coords/FPS,
degree_body_genitalia= floor(atan2((Body_y-Genitalia_y ),(Body_x-Genitalia_x))*180/pi)
) %>% group_by(degree_body_genitalia) %>%
dplyr::summarise(n_num=n())%>% makenumcols()
n_total <- sum(df1$n_num)
g_degree_bb <- ggplot(df1, aes( degree_body_genitalia,n_num,fill=n_num))+
stat_summary(fun = "mean", fun.min = function(x)mean(x), fun.max = function(x)mean(x), geom = "bar",alpha= 0.9,show.legend = FALSE)+
scale_fill_gradient(low="grey", high="blue")+
theme_classic()+
labs(title = paste0("likelihood > ",likelihood," Num = ",n_total))+
scale_x_continuous(breaks = scales::breaks_width(30))+
coord_polar()
ggsave(file = paste0(getwd(),'/Output/degree/',"g_degree_bb_",likelihood,".png"), plot = g_degree_bb, dpi = 400, width = 6, height = 6)
}
sapply(c(seq(0.1, 1, by = 0.1),0.95,0.99,0.999) ,f_degree)
## [1] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.1.png"
## [2] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.2.png"
## [3] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.3.png"
## [4] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.4.png"
## [5] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.5.png"
## [6] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.6.png"
## [7] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.7.png"
## [8] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.8.png"
## [9] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.9.png"
## [10] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_1.png"
## [11] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.95.png"
## [12] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.99.png"
## [13] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.999.png"
img_list <- list.files(paste0(getwd(),'/Output/degree'),full.names = TRUE)
img_list
## [1] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.1.png"
## [2] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.2.png"
## [3] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.3.png"
## [4] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.4.png"
## [5] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.5.png"
## [6] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.6.png"
## [7] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.7.png"
## [8] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.8.png"
## [9] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.9.png"
## [10] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.95.png"
## [11] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.99.png"
## [12] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.999.png"
## [13] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_0.png"
## [14] "/Users/leelv/Documents/Programing/R/Deeplabcut_Drosophila_walk v1.3/Output/degree/g_degree_bb_1.png"
degree_gif <- image_read(img_list) %>% image_join() %>% image_animate(fps=2)
degree_gif%>% image_write( path = paste0(getwd(),"/Output/degree.gif"))
plot(degree_gif)
#3D movement trace
fig_path_100 <- euclidean_df %>% filter(project== project_name[1], likelihood > 0.3,bodyparts=="L_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))
)
#ハエの運動痕跡を示す（100秒のデータ）
# X軸＝横、Y軸＝縦、Z軸＝時間、青色＝よく認識している、黄色＝うまく認識できない部分
fig_path_100
fig_speed_100 <- euclidean_df %>%
filter(project== project_name[1],speed_frame<170,likelihood > 0.3,bodyparts=="L_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= 50
)%>%
layout(
scene = list( camera=list(
L_eye = list(x=0.1, y=-0.7, z=-4)
), aspectratio = list(x = 1, y = 1, z = 10))
)
# ハエの運動痕跡（100秒のデータ）
# X軸＝横、Y軸＝縦、Z軸＝時間、円錐方向＝運動方向、円錐大きさ＝大きいほど速い、円錐色＝速いほど黄色に近い
fig_speed_100