################################################################################ ## behavior classification ## 04-02_model_application - exploratory ## ## author: Max Kroeschel ## info: explore results from model application ################################################################################ ## load required ressources ################################################################################ Sys.setenv(TZ='UTC') library("zoo") library("manipulate") library("maptools") library("data.table") library("lubridate") load(file = "../data/model_application_dataset.RData") pos_Rheinebene <- matrix(c(8.00, 48.67), nrow=1) behaviors <- c("l", "s", "b", "w", "t", "g", "o") col_behaviors <- c("blue", "purple", "green", "yellow", "orange", "red", "darkgrey") par_default <- par(no.readonly = T) ## explore states ################################################################################ # total number of active states nrow(active_states) # calculate the mean number of active states per day mean(tapply(as.Date(active_states$to_active), as.Date(active_states$to_active), length)) sd(tapply(as.Date(active_states$to_active), as.Date(active_states$to_active), length)) # calculate the mean duration of active states mean(as.numeric(active_states$duration)) sd(as.numeric(active_states$duration)) # calculate the mean duration of resting states mean(active_states$to_active[2:nrow(active_states)] - active_states$end_active[1:(nrow(active_states)-1)]) sd(active_states$to_active[2:nrow(active_states)] - active_states$end_active[1:(nrow(active_states)-1)]) # plot histogram of the duration of active states hist(as.numeric(active_states$duration), breaks = seq(0,250, by = 5), main = "Duration of active states", ylab = "", xlab = "minutes") # calculate the proportion of time in state active for day and night # first subdivide the observation period into minutes # and assign each minute as active/passive and day/night state_table <- data.table(minute = seq(trunc(min(acc_data$ts), "mins"), trunc(max(acc_data$ts), "mins"), by = "mins"), active = 0) # mark all minutes that intersect with active states for (i in 1:nrow(active_states)) { state_table[minute >= active_states$to_active[i] & minute <= active_states$end_active[i], active := 1]} state_table[,date := as.Date(minute)] # calculate the total and daily proportion of active behavior state_table[, .N, by = active][,N/sum(N)] state_table[active == 1, .(proportion_active = round(.N/1440,2)), by = date] ## calculate the proportion of active minutes per day and night # calculate the nighttimes for March 2015 ss <- crepuscule(pos_Rheinebene, as.POSIXct(c("2013-02-28",unique(strftime(acc_data$ts, format = "%Y-%m-%d")))), solarDep=c(0), direction="dusk", POSIXct.out=TRUE)$time sr <- crepuscule(pos_Rheinebene, as.POSIXct(c(unique(strftime(acc_data$ts, format = "%Y-%m-%d")),"2013-03-31")), solarDep=c(0), direction="dawn", POSIXct.out=TRUE)$time nighttime <- data.frame(ss, sr) # each date covers two distinct night which doesn't make sence for this analysis # --> I define a day from sunrise in the morning to sunrise of the next day # (a day covers one full day and the following night) state_table[, night := 0] for (i in 1:nrow(nighttime)){ state_table[minute >= nighttime$sr[i] & minute < nighttime$sr[i+1], date_sr := as.Date(nighttime$sr[i]),] state_table[minute >= nighttime$ss[i] & minute < nighttime$sr[i], night := 1,]} propactive <- state_table[,.(night = round(sum(night == 1 & active == 1) / sum(night==1),4), day = round(sum(night == 0 & active == 1) / sum(night==0),4), total = round(sum(active == 1)/.N,4)), by = .(date_sr)] plot(as.numeric(propactive$date_sr), propactive$day, type="b", ylim = c(0,1), col = "orange") lines(as.numeric(propactive$date), propactive$night, type="b", col="blue") lines(as.numeric(propactive$date), propactive$total, type="b", col="black") # plot states over time of day manipulate({ data_temp <- acc_data[as.Date(ts) == date_d,] plot(data_temp[,ts], data_temp[,prop_active], type = "h", col = rgb(0,0,1,0.5), cex = 0.1, xaxt = "n", xlab = "time of day", ylab = expression('p'[active])) axis.POSIXct(1, at=seq(range(data_temp$ts)[1], range(data_temp$ts)[2]+hours(1),by="hour"), format = "%H:%M", lwd.ticks= 1) # add threshold value lines(data_temp[,ts], rollapply(data_temp[,prop_active], partial = T, width = 7, FUN = mean), col = "red") abline(h=0.05, col = "black") # add active states active_states_temp <- active_states[as.Date(active_states$to_active)== date_d | as.Date(active_states$end_active) == date_d,] for (i in 1:nrow(active_states_temp)){ lines(x=c(active_states_temp[i,"to_active"], active_states_temp[i,"end_active"]), y = rep(0.05, times = 2), lwd = 4, col = "black")} # add gps col_gps = c("blue","green") gps_data_temp <- gps_data[as.Date(gps_data$ts) == date_d,] points(gps_data_temp$ts, rep(-0.02, times = nrow(gps_data_temp)), col = col_gps[gps_data_temp$active_state + 1], pch = 20) points(gps_data_temp$ts[ !is.na(gps_data_temp$prop_vigilance)], rep(-0.02, times = length(gps_data_temp$ts[!is.na(gps_data_temp$prop_vigilance)])), col = "black", lwd = 1.5, cex = 0.8) }, date_d = picker(as.list(as.character(unique(acc_data[, as.Date(ts)]))))) ## plot active states and proportion of active behavior ################################################################################ # local function for calculating time of day in minutes tod.f<- function(x) {ceiling(as.numeric(as.difftime(strftime(x, format = "%H:%M:%S", tz = "UTC"), format = "%H:%M:%S", units = "mins")))} # some active states range over two days --> split these into two states first active_states_plot <- active_states for (i in 1 : nrow(active_states_plot)){ if (as.Date(active_states_plot$to_active[i]) != as.Date(active_states_plot$end_active[i])) { active_states_plot <- rbind(active_states_plot, data.frame("to_active"= trunc(active_states_plot$end_active[i], "days"), "end_active"= active_states_plot$end_active[i], "duration" = NA)) active_states_plot$end_active[i] <- trunc(active_states_plot$end_active[i], "days")-seconds(1)} } # create temporary sequence for plotting date_seq <- as.Date(seq(from = trunc(min(active_states$to_active), "days"), to = trunc(max(active_states$to_active), "days"), by = "days")) # plot layout(matrix(c(1,1,1,1,2), 1, 5, byrow = TRUE)) par(mar = c(5.1, 6.1, 4.1, 0)) plot(0,0, xlim = c(0,60*24), ylim = c(as.integer(min(date_seq))-0.5, as.integer(max(date_seq))+0.5), type = "n", axes=FALSE, xlab = "time of day", ylab = "") abline(h=as.integer(date_seq)[c(1,5,10,15,20,25,30)], col = "black", lty=3) for (i in 1:length(date_seq)){ rect(xleft = tod.f(active_states_plot$to_active[ as.Date(active_states_plot$to_active)== date_seq[i]]), ybottom = as.integer(date_seq[i])-0.45 , xright =tod.f(active_states_plot$end_active[ as.Date(active_states_plot$to_active)== date_seq[i]]), ytop = as.integer(date_seq[i])+0.45, col = "blue", border = NA)} axis(1, at = seq(0,1440, by = 120), labels = paste(seq(0,24,by = 2),rep("00",12), sep =":")) axis(2,at = as.integer(date_seq)[c(1,5,10,15,20,25,30)], labels= F, line = -0.5) axis(2, as.integer(date_seq)[c(1,5,10,15,20,25,30)], tick = F, labels = date_seq[c(1,5,10,15,20,25,30)], las = 2, line = -0.7) lines( tod.f(nighttime$ss), as.integer(as.Date(nighttime$ss)), lwd = 6, col = adjustcolor( "yellow", alpha.f = 0.9)) lines( tod.f(sr), as.integer(as.Date(ss)), lwd = 6, col = adjustcolor( "yellow", alpha.f = 0.9)) rect(0,min(date_seq)-0.45,1440,max(date_seq+0.45)) par(mar = c(5.1, 0.5, 4.1, 1)) plot(0,0, xlim = c(0,100), ylim = c(as.integer(min(date_seq))-0.5, as.integer(max(date_seq))+0.5), type = "n", axes=FALSE, xlab = "proportion of time \n in state active (%)", ylab = "") abline(h=as.integer(date_seq)[c(1,5,10,15,20,25,30)], col = "black", lty=3) for (i in seq(20,100,by = 20)) {lines(c(i,i),c(min(date_seq), max(date_seq)), lty=3)} #abline(v=seq(0,1,by = 0.2), col = "black", lty=3) legend(x = c(45,100), y = c(min(date_seq),min(date_seq)+days(3)), yjust=0, legend = c("total", "daytime", "nighttime"), fill = c("black", "orange", "blue"), cex = 0.9, bg = "white", box.col = "white", text.width = 2) lines(propactive$day *100 ,propactive$date_sr, type = "b", pch = 20, cex =1, col = "orange", lwd = 1.5) lines(propactive$night *100 ,propactive$date_sr, type = "b", pch = 20, cex =1, col = "blue", lwd = 1.5) lines(propactive$total *100 ,propactive$date_sr, type = "b", pch = 20, cex =1, col = "black", lwd = 1.5) axis(1) rect(0,min(date_seq)-0.45,100,max(date_seq+0.45)) par(par_default) rm(list = c('active_states_plot', 'date_seq')) # total time active per day mean(tapply(as.integer(active_states$duration), as.Date(active_states$to_active), sum)) sd(tapply(as.integer(active_states$duration), as.Date(active_states$to_active), sum)) ## behavior ################################################################################ # table of animal behavior behavior_total <- acc_data[,factor(unlist(strsplit(behavior_pred, split = " ")), levels = behaviors)] behavior_total <- round(table(behavior_total)/length(behavior_total)*100, 2) behavior_resting <- acc_data[active_state == 0, factor(unlist(strsplit(behavior_pred, split = " ")) , levels = behaviors)] behavior_resting <- round(table(behavior_resting)/length(behavior_resting)*100, 2) behavior_active <- acc_data[active_state ==1, factor(unlist(strsplit(behavior_pred, split = " ")) , levels = behaviors)] behavior_active <- round(table(behavior_active)/length(behavior_active)*100, 2) behavior_summary <- rbind(behavior_total, behavior_resting, behavior_active) rm(behavior_total, behavior_resting, behavior_active) behavior_summary barplot(t(behavior_summary), col = col_behaviors, beside = T, ylim = c(0,100), yaxt = "n") abline(h=seq(0,100,10), lty = 3) axis(2, at = seq(0,100, by = 20), labels = c("0%","20%","40%","60%","80%","100%"), las = 2) par(fig = c(0, 1, 0, 1), oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0), new = TRUE, xpd=T) plot(0, 0, type = "n", bty = "n", xaxt = "n", yaxt = "n") legend("bottom" , inset = c(0,0.04), legend = c("lying", "standing", "browsing", "walking", "trotting", "galopping", "others"), fill = col_behaviors, cex=0.7, horiz = T) par(par_default) ## vigilance behavior ################################################################################ # Histogram of proportion of time spent vigilant hist(gps_data$prop_vigilance, breaks = seq(0,1,by = 0.01), main = "proportion of vigilance behavior", xlab = "proportion vigilance") # mean proportion of time spent vigilant round(mean(gps_data$prop_vigilance, na.rm =T),4) * 100 round(sd(gps_data$prop_vigilance, na.rm =T),4) * 100 # Boxplot of vigilance behavior over hour of the day boxplot(gps_data$prop_vigilance ~ as.integer(gps_data$hour), at = seq(0.5,23.5, by = 1), varwidth = T, xlab = "time of day", ylab = "", border = "white", axes = F ) sr <- crepuscule(pos_Rheinebene, as.POSIXct("2013-03-15"), solarDep=c(0), direction="dawn", POSIXct.out=TRUE)$time ss <- crepuscule(pos_Rheinebene, as.POSIXct("2013-03-15"), solarDep=c(0), direction="dusk", POSIXct.out=TRUE)$time abline(v= c( as.numeric(strftime(sr, format = "%H")) + as.numeric(strftime(sr, format = "%M"))/60, as.numeric(strftime(ss, format = "%H")) + as.numeric(strftime(ss, format = "%M"))/60), col = c( "yellow", "yellow"), lwd = 3) boxplot(gps_data$prop_vigilance ~ as.integer(gps_data$hour), add= TRUE, at = seq(0.5,23.5, by = 1), varwidth = T, axes = F) axis(1, at = seq(0,24, by = 1),labels = paste(seq(0,24,by = 1),rep("00",25), sep =":")) axis(2, at = seq(0,0.8, by = 0.20), labels = c("0%","20%","40%","60%","80%"), las = 2)