├── .Rbuildignore ├── .gitignore ├── data ├── RedDeerdata.RData └── RedDeerdata.txt ├── trappingmotion_1.0.tar.gz ├── vignettes ├── VignetteTrappingmotion.pdf ├── Vignette.Rmd ├── trappingmotion Vignette.html └── trappingmotion Vignette_files │ └── MathJax.js.descargar ├── IncludeDataScript.R ├── NAMESPACE ├── R ├── meanspeed.R ├── identbhvs.R ├── dayrange.R └── identbhvs_mixdist.R ├── trappingmotion.Rproj ├── DESCRIPTION ├── man ├── RedDeerdata.Rd ├── meanspeed.Rd ├── identbhvs.Rd ├── dayrange.Rd └── identbhvs_mixdist.Rd ├── README.md └── .Rhistory /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | -------------------------------------------------------------------------------- /data/RedDeerdata.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PabloPalencia/trappingmotion/HEAD/data/RedDeerdata.RData -------------------------------------------------------------------------------- /trappingmotion_1.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PabloPalencia/trappingmotion/HEAD/trappingmotion_1.0.tar.gz -------------------------------------------------------------------------------- /vignettes/VignetteTrappingmotion.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PabloPalencia/trappingmotion/HEAD/vignettes/VignetteTrappingmotion.pdf -------------------------------------------------------------------------------- /IncludeDataScript.R: -------------------------------------------------------------------------------- 1 | 2 | RedDeerdata <- read.table("D:/rprojects/trappingmotion_Rpackage/trappingmotion/data/RedDeerdata.txt", sep = ";", dec=".", header=TRUE, as.is=TRUE) 3 | save(RedDeerdata, file="data/RedDeerdata.RData") 4 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | #exportPattern("^[[:alpha:]]+") 2 | 3 | #export(hello) 4 | import(NbClust) 5 | import(mixdist) 6 | import(ggplot2) 7 | import(tidyverse) 8 | import(dplyr) 9 | export(identbhvs) 10 | export(meanspeed) 11 | export(dayrange) 12 | export(identbhvs_mixdist) 13 | -------------------------------------------------------------------------------- /R/meanspeed.R: -------------------------------------------------------------------------------- 1 | meanspeed <- function(x){ 2 | f1 <- function(x){ 3 | mean <- length(x)/sum(1/x) 4 | se <- mean^2 * sqrt(var(1/x)/length(x)) 5 | c(mean, se) 6 | } 7 | res <- sapply(split(behav_class$speed, behav_class$behaviour), f1) 8 | ss <- as.data.frame(table(behav_class$behaviour)) 9 | speed_data <<- data.frame(speeds=c(res[1,]), 10 | speed_se=c(res[2,]), 11 | n_seq=c(ss$Freq)) 12 | 13 | } 14 | # 15 | -------------------------------------------------------------------------------- /trappingmotion.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageCheckArgs: --as-carn 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: trappingmotion 2 | Type: Package 3 | Title: Integrate camera-trapping in movement and behavioural studies. 4 | Version: 2.0.0 5 | Author: Pablo Palencia 6 | Maintainer: Pablo Palencia 7 | Description: Provides fucntions to identify movement patterns in wildlife from population sampled with camera-traps. Functions to estimate day range (key parameter for estimating population density through REM). 8 | License: MIT 9 | Encoding: UTF-8 10 | LazyData: true 11 | RoxygenNote: 7.1.2 12 | Imports: NbClust, mixdist, ggplot2, tidyverse, dplyr 13 | VignetteBuilder: knitr 14 | Suggests: knitr, rmarkdown 15 | -------------------------------------------------------------------------------- /man/RedDeerdata.Rd: -------------------------------------------------------------------------------- 1 | \name{RedDeerdata} 2 | \alias{RedDeerdata} 3 | \docType{data} 4 | \title{ 5 | Red deer data 6 | \description{ 7 | A dataset that includes the speed and time of each record of a red deer (Cervus elaphus) population sampled with camera-traps in Spain. Speed are estimated in m/s 8 | } 9 | \usage{data("RedDeerdata")} 10 | \format{ 11 | A data frame with 183 observations on the following 2 variables. 12 | \describe{ 13 | \item{\code{Time}}{a character vector of times of day at which animal records occured} 14 | \item{\code{Speed}}{a numeric vector of speeds in m/s} 15 | } 16 | } 17 | \details{ 18 | %% ~~ If necessary, more details than the __description__ above ~~ 19 | } 20 | \source{ 21 | %% ~~ reference to a publication or URL from which the data were obtained ~~ 22 | } 23 | \references{ 24 | Palencia et al. 2020 - in prep 25 | } 26 | \examples{ 27 | data(RedDeerdata) 28 | 29 | } 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # trappingmotion 2 | R package to integrate movement and behaviour ecology from camera-trapping 3 | 4 | Despite a wide range of sensors and biologging devices have been used to monitor movement parameters, camera-traps have been scarcely applied for this purpose. Camera-trapping is a non-invasive methodology with the potential to enlarge the set of species and situations to monitor these parameters. This package includes functions to estimate movement parameters (e.g. day range) from camera-traps data. 5 | 6 | # Installation 7 | 8 | devtools::install_github("PabloPalencia/trappingmotion") 9 | 10 | # Contributions 11 | 12 | Contributors are welcome to fork the package and suggest additions or improvements. If you would like to be included as a contributor, please let me know. 13 | 14 | I found a bug 15 | 16 | Please provide specific details, allowing the error to be reproduced and investigated. Always note the version of R you are using, along with any other relevant software. 17 | -------------------------------------------------------------------------------- /R/identbhvs.R: -------------------------------------------------------------------------------- 1 | identbhvs <- function(dat){ 2 | muestra <-data.frame(dat*100); muestra <- subset(muestra, muestra >0); names(muestra) <- ("speed") 3 | 4 | if(max(muestra) > 600)message("Extreme speed values have been detected (higher than 20km/h -6m/s-). Please explore the presence of outliers, check the speed estimation on the pictures, and discard them if necessary") 5 | 6 | suppressWarnings(invisible(capture.output(res_NC <- NbClust(muestra, diss= NULL, distance = "euclidean", min.nc =2, max.nc=5, method = "kmeans")))) 7 | behav_class0 <- data.frame(cbind(muestra, res_NC$Best.partition)) 8 | names(behav_class0) <- c("speed", "behaviour") 9 | behav_class0$speed <- behav_class0$speed/100 10 | behav_class <<- behav_class0 11 | 12 | plot_bhv <- ggplot(behav_class, aes(x=speed, color=as.factor(behaviour), fill=as.factor(behaviour))) + 13 | coord_cartesian(xlim = c(0, max(behav_class$speed)*1.2)) + 14 | geom_histogram(aes(y=after_stat(density)), alpha=0.5, position="identity", bins = 40) + 15 | scale_color_brewer(palette="Set1")+ 16 | scale_fill_brewer(palette="Set1")+ 17 | theme_classic()+ 18 | xlab(bquote('Speed (m·s'^-1*')'))+ 19 | ylab('Density')+ 20 | geom_density(alpha=.2) + 21 | scale_x_continuous(expand = c(0, 0)) + 22 | scale_y_continuous(expand = c(0, 0)) + 23 | theme(legend.position="none")+ 24 | theme(axis.text=element_text(size=14), 25 | axis.title=element_text(size=20), 26 | panel.border = element_rect(colour = "black", fill=NA, linewidth=1)) 27 | 28 | plot_bhv 29 | 30 | } 31 | -------------------------------------------------------------------------------- /R/dayrange.R: -------------------------------------------------------------------------------- 1 | dayrange <- function(act, act_se, speed_data){ 2 | 3 | if(any(speed_data[,3] < 0 | (speed_data[,2]-speed_data[,1]) > 0 | act > 1 | act < 0)){ 4 | stop("Wrong data. Use ?dayrange and check function description") 5 | }else{ 6 | 7 | speed_data <- speed_data[order(speed_data[,1], decreasing = T), ] 8 | 9 | for(i in 1:length(speed_data[,1])){ 10 | 11 | speed_data[i,4] <- speed_data[i,3]*(speed_data[1,1]/speed_data[i,1]) 12 | 13 | }; names(speed_data)[4] <- "m" 14 | 15 | for(i in 1:length(speed_data[,1])){ 16 | 17 | speed_data[i,5] <- speed_data[i,4]/sum(speed_data[,4]) 18 | 19 | }; names(speed_data)[5] <- "p" 20 | 21 | 22 | Dr <- c(); ses<-c() 23 | for(i in 1:length(speed_data[,1])){ 24 | 25 | sepi <- sqrt((speed_data[i,5]*(1-speed_data[i,5]))/(sum(speed_data[,4])-1)) 26 | ai <- act*speed_data[i,5] 27 | seai <- ai*sqrt((sepi/speed_data[i,5])^2+(act_se/act)^2+((act_se/act)^2*(sepi/speed_data[i,5])^2)) 28 | dri <- speed_data[i,1]*ai 29 | sedri <- dri*sqrt((speed_data[i,2]/speed_data[i,1])^2+(seai/ai)^2+((speed_data[i,2]/speed_data[i,1])^2*(seai/ai)^2)) 30 | 31 | Dr <- sum(Dr, dri) 32 | ses <- c(ses, sedri) 33 | 34 | if(i==length(speed_data[,1])){ 35 | DR <<- Dr*86.4; SES<- c() 36 | for(i in 1:length(speed_data[,1])){ 37 | 38 | SE<- ses[i]^2 39 | SES <- c(SES, SE) 40 | } 41 | 42 | DR_se <<- sqrt(sum(SES))*86.4 43 | } 44 | } 45 | return(cat("Day range (Km/day)", DR, 46 | "\nDay range SE (Km/day)", DR_se)) 47 | 48 | 49 | } 50 | 51 | } 52 | -------------------------------------------------------------------------------- /man/meanspeed.Rd: -------------------------------------------------------------------------------- 1 | \name{meanspeed} 2 | \alias{meanspeed} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Estimate size-biased mean movement speed of a population sampled with camera-traps 6 | } 7 | \description{ 8 | When working with camera-trpas, the probability of sampling a given speed is proportional to itself. To estimate the average movement speed, a specific function should be applied to correct this size-biased sample. Different functions have been described (e.g. log-normal, gamma or Weibull), in this case we applied a Harmonic mean to estimate mean movement speed 9 | } 10 | \usage{ 11 | meanspeed(x) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{x}{ 16 | The output of 'identbehv' function (i.e. a data frame containing in the first colum the speed values, and in the second column the behaviour group). 17 | } 18 | } 19 | \details{ 20 | %% ~~ If necessary, more details than the description above ~~ 21 | } 22 | \value{ 23 | Mean and standard error of each movement state. 24 | } 25 | \references{ 26 | Palencia, P., Fernandez-Lopez, J., Vicente, J., & Acevedo, P. (2021). Innovations in movement and behavioural ecology from camera traps: day range as model parameter. Methods in Ecology and Evolution, doi:10.1111/2041-210X.13609 27 | Rowcliffe, J. M., Jansen, P. A., Kays, R., Kranstauber, B., & Carbone, C. (2016). Wildlife speed cameras: measuring animal travel speed and day range using camera traps. Remote Sensing in Ecology and Conservation, 2(2), 84-94. 28 | } 29 | \author{ 30 | Pablo Palencia 31 | } 32 | \note{ 33 | %% ~~further notes~~ 34 | } 35 | 36 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 37 | 38 | \seealso{ 39 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 40 | } 41 | \examples{ 42 | behav_class <- data.frame(speed = c(runif(20, 0, 0.3), runif(30, 0.4, 0.7), runif(40, 0.8, 1.2)), behaviour = c(rep(1, 20), rep(2, 30), rep(3, 40))) 43 | meanspeed(behav_class) 44 | } 45 | % Add one or more standard keywords, see file 'KEYWORDS' in the 46 | % R documentation directory. 47 | \keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") 48 | \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line 49 | -------------------------------------------------------------------------------- /man/identbhvs.Rd: -------------------------------------------------------------------------------- 1 | \name{identbhvs} 2 | \alias{identbhvs} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Identify movement behaviours(states) in a population sampled with camera-traps. 6 | } 7 | \description{ 8 | Identify the optimal number of movement behaviours(states) by a k-means clustering. On trappingmotion version 2.0.0 I included a simplified version of 'identbhvs' released on version 1.0.0. Please, use 'identbhvs_mixdist' if you want to combine k-means clustering with log-normal mixture distributions when identifying movement behaviours. 9 | Please, explore the presence of outliers in your data before running this function. You can use habitual procedures to identify outliers, such as visualization (boxplot), interquartile range and/or statistical tests (z scores). 'identify_outliers' function from 'rstatix' R package could be also useful. 10 | } 11 | \usage{ 12 | identbhvs(dat) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{dat}{ 17 | A numeric vector of speed data in m/s 18 | } 19 | } 20 | \details{ 21 | %% ~~ If necessary, more details than the description above ~~ 22 | } 23 | \value{ 24 | A data frame in which the first column includes the speeds, and the second column includes the movement behaviour in which each speed has been classified. A density plot with the speed clustering is obtained by default. 25 | } 26 | \references{ 27 | Palencia, P., Fernandez-Lopez, J., Vicente, J., & Acevedo, P. (2021). Innovations in movement and behavioural ecology from camera traps: day range as model parameter. Methods in Ecology and Evolution, doi:10.1111/2041-210X.13609 28 | } 29 | \author{ 30 | Pablo Palencia 31 | } 32 | \note{ 33 | %% ~~further notes~~ 34 | } 35 | 36 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 37 | 38 | \seealso{ 39 | 'meanspeed' function, 'identbhvs_mixdist' function 40 | } 41 | \examples{ 42 | dat2<-c(rnorm(80, 2, 0.8), rnorm(80, 0.2, 0.1), rnorm(30, 1, 0.1)) 43 | identbhvs(dat2) 44 | } 45 | % Add one or more standard keywords, see file 'KEYWORDS' in the 46 | % R documentation directory. 47 | \keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") 48 | \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line 49 | -------------------------------------------------------------------------------- /man/dayrange.Rd: -------------------------------------------------------------------------------- 1 | \name{dayrange} 2 | \alias{dayrange} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Estimate day range (daily distance travelled) 6 | } 7 | \description{ 8 | Estimates the average daily distance travlled by each individual in the population sampled with camera-traps. For that, it is needed activity and speed 9 | } 10 | \usage{ 11 | dayrange(act, act_se, speed_data) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{act}{ 16 | Number of activity rate of the population. Takes values between 0 and 1. See 'fitact' in 'activity' R package for details. 17 | } 18 | \item{act_se}{ 19 | Number of activity rate standard error. 20 | } 21 | \item{speed_data}{ 22 | A data frame containing 3 columns and i rows (the output of 'meanspeed' function). Each row includes parameters for each movement behaviour (state) identified. First column: average movement speed expresed in m/s; second column: standard error of average movement speed; third column: number of animals classified on each behaviour. 23 | } 24 | } 25 | \details{ 26 | %% ~~ If necessary, more details than the description above ~~ 27 | } 28 | \value{ 29 | Day range expresed in km/day 30 | } 31 | \references{ 32 | Palencia, P., Fernandez-Lopez, J., Vicente, J., & Acevedo, P. (2021). Innovations in movement and behavioural ecology from camera traps: day range as model parameter. Methods in Ecology and Evolution, doi:10.1111/2041-210X.13609 33 | \nRowcliffe, J. M., Kays, R., Kranstauber, B., Carbone, C., & Jansen, P. A. (2014). Quantifying levels of animal activity using camera trap data. Methods in Ecology and Evolution, 5(11), 1170-1179. 34 | } 35 | \author{ 36 | Pablo Palencia 37 | } 38 | \note{ 39 | %% ~~further notes~~ 40 | } 41 | 42 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 43 | 44 | \seealso{ 45 | 'identbhvs' and 'meanspeed' functions 46 | } 47 | \examples{ 48 | speed_data <-data.frame(speeds=c(0.6, 0.9, 0.01), speeds_se=c(0.1, 0.2, 0.001), n_seq=c(50, 30, 10)) 49 | dayrange(act =0.68, act_se = 0.05, speed_data = speed_data) 50 | } 51 | % Add one or more standard keywords, see file 'KEYWORDS' in the 52 | % R documentation directory. 53 | \keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") 54 | \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line 55 | -------------------------------------------------------------------------------- /man/identbhvs_mixdist.Rd: -------------------------------------------------------------------------------- 1 | \name{identbhvs_mixdist} 2 | \alias{identbhvs_mixdist} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Identify movement behaviours(states) in a population sampled with camera-traps. 6 | } 7 | \description{ 8 | Identify movement behaviours(states) by a clustering and mixture distribution process. A k-means clustering scheme has been applied to estimate the optimal number of movement behaviours, and log-normal distributions have been considered to classify the speed values. This function apply the procedure described in Palencia et al. 2021 - Innovations in movement and behavioural ecology from camera traps: day range as model parameter. Methods in Ecology and Evolution. 9 | Please, explore the presence of outliers in your data before running this function. You can use habitual procedures to identify outliers, such as visualization (boxplot), interquartile range and/or statistical tests (z scores). 'identify_outliers' function from 'rstatix' R package could be also useful. 10 | } 11 | \usage{ 12 | identbhvs_mixdist(dat) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{dat}{ 17 | A numeric vector of speed data in m/s 18 | } 19 | } 20 | \details{ 21 | %% ~~ If necessary, more details than the description above ~~ 22 | } 23 | \value{ 24 | A data frame in which the first column includes the speeds, and the second column includes the movement behaviour in which each speed has been classified. A density plot with the speed clustering is obtained by default. 25 | } 26 | \references{ 27 | Palencia, P., Fernandez-Lopez, J., Vicente, J., & Acevedo, P. (2021). Innovations in movement and behavioural ecology from camera traps: day range as model parameter. Methods in Ecology and Evolution, doi:10.1111/2041-210X.13609 28 | } 29 | \author{ 30 | Pablo Palencia 31 | } 32 | \note{ 33 | %% ~~further notes~~ 34 | } 35 | 36 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 37 | 38 | \seealso{ 39 | 'meanspeed' function, 'identbhvs' function 40 | } 41 | \examples{ 42 | dat2<-c(rnorm(80, 2, 0.8), rnorm(80, 0.2, 0.1), rnorm(30, 1, 0.1)) 43 | identbhvs_mixdist(dat2) 44 | } 45 | % Add one or more standard keywords, see file 'KEYWORDS' in the 46 | % R documentation directory. 47 | \keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") 48 | \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line 49 | 50 | -------------------------------------------------------------------------------- /data/RedDeerdata.txt: -------------------------------------------------------------------------------- 1 | Time;Speed 2 | 21:49:06;0.15 3 | 0:43:57;0.68 4 | 19:52:12;0.2 5 | 3:35:21;0.20 6 | 4:18:29;0.30 7 | 22:58:52;0.31 8 | 8:40:46;0.70 9 | 3:23:46;0.28 10 | 23:31:23;0.25 11 | 5:20:06;0.33 12 | 7:17:04;0.48 13 | 20:22:20;0.63 14 | 23:34:13;0.46 15 | 8:25:35;0.75 16 | 11:20:17;0.18 17 | 21:01:39;0.01 18 | 2:33:28;0.88 19 | 0:48:06;0.10 20 | 11:09:13;0.09 21 | 20:28:00;0.21 22 | 10:22:51;0.28 23 | 16:12:20;0.33 24 | 19:09:22;0.78 25 | 9:03:02;0.10 26 | 19:39:07;0.04 27 | 5:54:19;0.08 28 | 13:45:12;0.10 29 | 8:11:16;0.01 30 | 9:40:14;0.01 31 | 17:41:21;0.65 32 | 20:29:01;0.02 33 | 20:25:52;0.02 34 | 2:44:00;0.03 35 | 13:43:46;0.20 36 | 18:25:37;0.02 37 | 21:14:19;0.04 38 | 2:09:26;0.01 39 | 3:51:14;0.04 40 | 4:57:49;0.25 41 | 7:24:33;0.09 42 | 8:47:52;0.30 43 | 9:02:13;0.07 44 | 18:05:42;0.17 45 | 8:16:03;0.20 46 | 12:08:58;0.05 47 | 8:37:49;0.17 48 | 13:10:56;0.37 49 | 10:50:04;0.17 50 | 10:51:04;0.50 51 | 14:08:30;0.77 52 | 14:45:47;0.28 53 | 4:15:21;0.80 54 | 8:32:27;0.07 55 | 15:00:42;0.27 56 | 9:09:42;0.27 57 | 8:28:21;0.07 58 | 10:45:49;0.43 59 | 17:00:46;0.50 60 | 5:30:25;0.44 61 | 14:18:24;0.75 62 | 9:32:58;0.93 63 | 10:52:34;0.43 64 | 18:34:47;0.60 65 | 12:21:24;0.09 66 | 15:41:16;0.15 67 | 17:46:35;0.06 68 | 17:52:43;0.17 69 | 9:24:07;0.08 70 | 13:20:18;0.04 71 | 13:48:53;0.03 72 | 9:29:55;0.17 73 | 12:57:40;0.33 74 | 13:57:00;0.18 75 | 12:13:27;0.19 76 | 8:17:38;0.47 77 | 15:23:26;0.22 78 | 18:00:52;0.10 79 | 21:26:54;0.19 80 | 11:05:44;0.12 81 | 14:40:09;0.19 82 | 9:55:44;0.27 83 | 10:20:55;0.04 84 | 20:43:51;0.20 85 | 20:48:27;0.30 86 | 21:04:18;1.20 87 | 22:09:35;0.35 88 | 0:01:41;0.80 89 | 0:45:24;0.80 90 | 5:38:47;1.00 91 | 6:03:57;1.00 92 | 8:11:07;1.50 93 | 18:55:26;1.10 94 | 21:28:12;0.43 95 | 8:37:35;0.50 96 | 18:58:06;0.70 97 | 19:30:47;0.75 98 | 23:14:19;0.86 99 | 23:34:16;2.20 100 | 3:29:03;0.95 101 | 4:11:59;0.90 102 | 9:46:30;0.23 103 | 20:21:26;1.10 104 | 5:08:24;0.90 105 | 22:15:03;1.10 106 | 3:02:09;1.00 107 | 3:15:29;1.10 108 | 23:26:43;0.60 109 | 19:01:12;1.20 110 | 1:58:09;0.80 111 | 8:51:07;0.70 112 | 20:26:22;0.20 113 | 0:35:04;1.70 114 | 0:58:58;0.80 115 | 8:47:36;0.40 116 | 21:11:17;1.90 117 | 23:55:18;1.10 118 | 20:37:33;1.20 119 | 21:03:04;0.70 120 | 8:11:17;1.10 121 | 10:45:22;1.00 122 | 19:13:30;0.25 123 | 20:18:13;0.50 124 | 23:47:13;0.07 125 | 2:11:49;1.10 126 | 11:02:27;0.50 127 | 18:20:41;1.10 128 | 20:14:08;0.90 129 | 20:41:35;0.05 130 | 2:40:13;0.70 131 | 3:31:57;1.10 132 | 21:13:19;1.10 133 | 21:43:03;0.80 134 | 9:57:05;0.60 135 | 11:39:46;1.00 136 | 12:17:59;0.70 137 | 13:46:09;1.10 138 | 20:36:54;0.90 139 | 18:01:48;0.03 140 | 15:23:13;0.19 141 | 8:28:44;0.06 142 | 19:52:34;1.10 143 | 2:28:01;0.70 144 | 10:40:13;1.20 145 | 4:07:45;1.90 146 | 18:20:51;1.50 147 | 19:21:51;0.55 148 | 20:42:30;0.30 149 | 22:23:50;0.24 150 | 9:30:41;2.50 151 | 20:38:59;1.10 152 | 10:53:09;0.30 153 | 18:50:40;0.35 154 | 0:59:52;0.85 155 | 1:10:18;0.26 156 | 1:57:47;0.75 157 | 2:37:18;0.24 158 | 20:08:35;0.20 159 | 20:35:50;0.50 160 | 0:21:35;0.37 161 | 3:09:59;0.90 162 | 4:00:23;0.90 163 | 11:21:00;0.18 164 | 20:34:43;0.22 165 | 13:15:19;0.05 166 | 19:00:10;0.40 167 | 10:08:50;0.15 168 | 23:26:19;0.30 169 | 4:22:44;0.60 170 | 8:33:19;0.90 171 | 11:33:43;0.60 172 | 19:09:40;1.20 173 | 19:58:48;0.50 174 | 19:50:57;1.60 175 | 19:30:28;0.43 176 | 20:35:08;0.01 177 | 14:22:08;0.04 178 | 4:42:49;0.03 179 | 0:52:13;0.12 180 | 9:47:02;0.38 181 | 21:18:47;0.40 182 | 3:29:24;0.18 183 | 2:52:05;0.38 184 | 3:08:05;0.28 185 | -------------------------------------------------------------------------------- /vignettes/Vignette.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "trappingmotion Vignette" 3 | author: "Pablo Palencia" 4 | date: "30 November 2023" 5 | output: rmarkdown::html_vignette 6 | # output: pdf_document 7 | vignette: > 8 | %\VignetteIndexEntry{trappingmotion Vignette} 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\VignetteEncoding{UTF-8} 11 | --- 12 | 13 | ```{r setup, include = FALSE} 14 | knitr::opts_chunk$set( 15 | collapse = TRUE, 16 | comment = "#>" 17 | ) 18 | ``` 19 | 20 | # 1. Introduction 21 | Animal movement plays a crucial role in ecology as a key parameter in spatial distribution, population abundance, and other related processes such as habitat use and disease transmission, among others. Nowadays, movement ecology studies are based on a wide range of sensors, mainly biologging devices, but also satellites and drones. However, camera traps (remotely activated cameras, CT) have been scarcely used for this purpose. Camera trapping has experienced exponential growth during the last two decades. CT are used for a wide range of applications: species inventory, habitat use, abundance estimation, occupancy or species interaction, among others. In *trappingmotion* R package I developed a set of new functions to integrate movement & behavioural ecology in camera trapping studies. Please, see further details in the paper "Innovations in movement and behavioural ecology from camera traps: day range as model parameter"(https://besjournals.onlinelibrary.wiley.com/doi/abs/10.1111/2041-210X.13609) 22 | 23 | # 2. Getting started with *trappingmotion* package. 24 | This vignette will guide you throught the main functions included in the package. Briefly, we will identify movement behaviours (states) in a red deer population sampled with camera traps. We will estimate the average movement speed of each behaviour, and finally, we will estimate day range (i.e. average daily distance travelled by the animals). For that, we will analyse the dataset 'RedDeerdata' provided in the package. 25 | 26 | 27 | First we load the *trappingmotion* library: 28 | ```{r} 29 | 30 | # devtools::install_github("PabloPalencia/trappingmotion") # run this line once for 31 | # installing/updating the package. Version 2.0.0 is available! 32 | library(trappingmotion) 33 | ``` 34 | 35 | The data frame "ReedDeerdata" includes 183 records of a red deer population. Time (first column) and movement speed in m/s (second column) of each animal recorded by the camera traps are included. 36 | 37 | ```{r} 38 | data("RedDeerdata") 39 | head(RedDeerdata) 40 | ``` 41 | 42 | 43 | ## 2.1 Identifying movement behaviours (states) 44 | 45 | Using the `identbhvs` function it is possible to identify different movement behaviours (e.g. animals that were foraging VS animals that were moving between habitat patches) applying a k-means clustering. The optimal number of behaviours (clusters) is determined by comparing a set of 30 indices. 46 | 47 | Before identifying movement behaviours, it is important to explore the **presence of outliers in the speed data**. Habitual procedures to identify outliers, such as visualization (boxplot), interquartile range and/or statistical tests (z scores) can be applied. `identify_outliers` function from `rstatix` R package could be also useful. If outliers are detected, review the speed estimation procedure in those pictures, and/or consider to discard those speeds before indentifying behaviours. 48 | 49 | A more complex behaviour identification procedure including log-normal mixture models to assign the speeds to a group can be applied using `identbhvs_mixdist` function. 50 | 51 | ```{r, warning=FALSE, message=FALSE, fig.keep='last', fig.width=6, fig.height=6} 52 | identbhvs(RedDeerdata$Speed) 53 | ``` 54 | 55 | In this example, three different movement behaviours have been identified in this population. 56 | 57 | ## 2.2 Estimating mean movement speed 58 | A sampling bias to fast movements have been described in camera trapping studies (Rowcliffe et al., 2016). Considering that, the mean speed of each behaviour cannot be estimated by arithmetic mean. To solve this bias we use the function `meanspeed`. 59 | 60 | ```{r} 61 | meanspeed(behav_class) # colums= behaviours, rows= c(mean, SE) 62 | ``` 63 | 64 | From the total of 183 speed estimates in our data, 103 observations were classified in the slowest behaviour (0.07 m/s), 54 in a group with an average speed of 0.70 m/s; and the other 26 observations in the fastest group (average speed 1.27 m/s). As expected, we found high difference in the average speed value of each behaviour: 65 | ```{r} 66 | head(speed_data) 67 | ``` 68 | 69 | ## 2.3 Estimating activity 70 | To estimate day range it is need to get values about activity and speed of the animals. In the first part of this vignette, we have described the procedure to estimate speed. Now, we will describe how to estimate activity rate. For that, we will use the `activity` R package available in CRAN. 71 | 72 | ```{r, fig.width=6, fig.height=6} 73 | library(activity) 74 | 75 | # Estimating radian time of day 76 | RedDeerdata$T_0_1 <- (as.numeric(strptime(RedDeerdata$Time, format="%H:%M:%S") 77 | - as.POSIXct(format(Sys.Date())), units="secs")/86400) 78 | 79 | # Estimating activity value 80 | activityRES <- 2*pi*RedDeerdata$T_0_1 81 | mod1 <- fitact(activityRES, sample="data") 82 | 83 | # Ploting activity patterns 84 | par(mfrow=c(1,1)) 85 | plot(mod1) 86 | 87 | # Fitting activity results 88 | act <- mod1@act[1] 89 | act_se <- mod1@act[2] 90 | 91 | ``` 92 | 93 | 94 | ## 2.4 Estimating day range 95 | 96 | Run the `dayrange` function to estimate day range 97 | 98 | ```{r} 99 | dayrange(act, act_se, speed_data) 100 | ``` 101 | 102 | The day range of this population is 5.07 km per day 103 | 104 | ```{r echo=FALSE} 105 | #para incluir imagenes externas (el logo) 106 | #```{r, out.width='25%', fig.align='center', fig.cap='...'} 107 | #knitr::include_graphics('images/hex-rmarkdown.png') 108 | ``` 109 | -------------------------------------------------------------------------------- /R/identbhvs_mixdist.R: -------------------------------------------------------------------------------- 1 | identbhvs_mixdist <- function(dat){ 2 | muestra <-data.frame(dat*100); muestra <- subset(muestra, muestra >0); names(muestra) <- ("speed") 3 | 4 | if(max(muestra) > 600)message("Extreme speed values have been detected (higher than 20km/h -6m/s-). Please explore the presence of outliers, check the speed estimation on the pictures, and discard them if necessary") 5 | 6 | suppressWarnings(invisible(capture.output(res_NC <- NbClust(muestra, diss= NULL, distance = "euclidean", min.nc =2, max.nc=5, method = "kmeans")))) 7 | resul <- data.frame(cbind(muestra, res_NC$Best.partition)); names(resul) <- c("speed", "KGroup") 8 | 9 | n_c <- length(unique(res_NC$Best.partition)) 10 | res_m <- aggregate(speed ~ KGroup, resul, "mean") 11 | res_m <- res_m[order(res_m$speed),] 12 | res_sd <- aggregate( speed ~ KGroup, resul, sd) 13 | res_sd <- res_sd[order(res_sd$speed),] 14 | res_n <- aggregate( speed ~ KGroup, resul, length) 15 | res_m[1,3] <- res_m[2,2]/res_m[1,2]; res_m[2,3] <- res_m[3,2]/res_m[2,2]; res_m[3,3] <- res_m[4,2]/res_m[3,2]; res_m[4,3] <- res_m[5,2]/res_m[4,2]; 16 | res_m[1,4] <- res_n[1,2]; res_m[2,4] <- res_n[2,2]; res_m[3,4] <- res_n[3,2]; res_m[4,4] <- res_n[4,2]; res_m[5,4] <- res_n[5,2] 17 | res_m <- subset(res_m, V4 > 15) 18 | if (max(na.omit(res_m$V3)) < 2 | length(res_m[,1]) <= 1){ 19 | behav_class1 <- data.frame(dat); names(behav_class1) <- ("speed") 20 | behav_class1$behaviour <- 1 21 | behav_class <<- behav_class1 22 | return(cat("One movement behaviour have been identified")) 23 | 24 | }else{ 25 | res_m$V3[is.na(res_m$V3)] <- 5; res_m <- na.omit(res_m); res_m <- subset(res_m, V3 > 2) 26 | 27 | hh <- hist(muestra[,1], breaks= round(((max(muestra[,1])-min(muestra[,1]))*10), 1), plot = FALSE, warn.unused = FALSE) # length interval=0.1 28 | dd <- as.data.frame(cbind(hh$breaks,hh$counts[+1])) 29 | 30 | ddpar2 <- na.omit(as.data.frame(cbind(c(res_n[1,2]/sum(res_n[,2]), res_n[2,2]/sum(res_n[,2]), res_n[3,2]/sum(res_n[,2]), res_n[4,2]/sum(res_n[,2]), res_n[5,2]/sum(res_n[,2])), c(res_m[1,2], res_m[2,2], res_m[3,2], res_m[4,2], res_m[5,2]), c(res_sd[1,2], res_sd[2,2], res_sd[3,2], res_sd[4,2], res_sd[5,2])))) # reference values 31 | 32 | fitpike2 <- mix(dd, ddpar2, "lnorm", constr = mixconstr(consigma = "CCV"), emsteps = 20) 33 | 34 | cc <- data.frame(fitted(fitpike2)) 35 | ee<-cbind(cc, dd) 36 | 37 | muestra$speed_r <-round((muestra$speed), 1) 38 | 39 | ee$V1 <-round(((trunc(ee$V1*100)/100)*10/10),1) 40 | 41 | colnames(ee)[which(names(ee) == "V1")] <- "speed_r" 42 | jj<-merge(muestra, ee, by= "speed_r", all.x = T) 43 | names(jj)[2]<-"speed" 44 | 45 | 46 | jj <- na.omit(jj) 47 | for(k in 1:length(jj[,1])){ 48 | if(length(fitpike2$parameters[,1]) == 2){ 49 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[1] 50 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 51 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 52 | 53 | if(jj[k,length(jj[1,])] == 0){ 54 | 55 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[2] 56 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 57 | jj[k,length(jj[1,])] <- zz 58 | } 59 | } 60 | 61 | if(length(fitpike2$parameters[,1]) == 3){ 62 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[1] 63 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 64 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 65 | 66 | if(jj[k,length(jj[1,])] == 0){ 67 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[2] 68 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 69 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 70 | } 71 | if(jj[k,length(jj[1,])] == 0){ 72 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[3] 73 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 74 | jj[k,length(jj[1,])] <- zz 75 | } 76 | } 77 | 78 | if(length(fitpike2$parameters[,1]) == 4){ 79 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[1] 80 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 81 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 82 | 83 | if(jj[k,length(jj[1,])] == 0){ 84 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[2] 85 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 86 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 87 | } 88 | if(jj[k,length(jj[1,])] == 0){ 89 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[3] 90 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 91 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 92 | } 93 | if(jj[k,length(jj[1,])] == 0){ 94 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[4] 95 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 96 | jj[k,length(jj[1,])] <- zz 97 | } 98 | } 99 | 100 | if(length(fitpike2$parameters[,1]) == 5){ 101 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[1] 102 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 103 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 104 | 105 | if(jj[k,length(jj[1,])] == 0){ 106 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[2] 107 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 108 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 109 | } 110 | if(jj[k,length(jj[1,])] == 0){ 111 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[3] 112 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 113 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 114 | } 115 | if(jj[k,length(jj[1,])] == 0){ 116 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[4] 117 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 118 | jj[k,length(jj[1,])] <- rbinom(1, 1, (max(jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)])))*zz 119 | } 120 | if(jj[k,length(jj[1,])] == 0){ 121 | zz <- arrange((jj[k,((length(jj[1,])-length(fitpike2$parameters[,1]))):(length(jj[1,])-1)]), decreasing = T)[5] 122 | zz <- as.numeric(sub("conditprob.", "", names(zz))) 123 | jj[k,length(jj[1,])] <- zz 124 | } 125 | } 126 | 127 | } 128 | 129 | 130 | names(jj)[length(jj[1,])] <- "behaviour" 131 | jj$speed <- jj$speed/100 132 | behav_class <<- jj %>% select(speed, behaviour) 133 | 134 | plot_bhv <- ggplot(behav_class, aes(x=speed, color=as.factor(behaviour), fill=as.factor(behaviour))) + 135 | 136 | coord_cartesian(xlim = c(0, max(behav_class$speed)*1.2))+ 137 | geom_histogram(aes(y=..density..), alpha=0.5, 138 | position="identity") + 139 | scale_color_brewer(palette="Set1")+ 140 | scale_fill_brewer(palette="Set1")+ 141 | theme_classic()+ 142 | xlab(bquote('Speed (m·s'^-1*')'))+ 143 | ylab('Density')+ 144 | geom_density(alpha=.2) + 145 | scale_x_continuous(expand = c(0, 0)) + 146 | scale_y_continuous(expand = c(0, 0)) + 147 | theme(legend.position="none")+ 148 | theme(axis.text=element_text(size=14), 149 | axis.title=element_text(size=20), 150 | panel.border = element_rect(colour = "black", fill=NA, size=1)) 151 | plot_bhv 152 | } 153 | 154 | } 155 | -------------------------------------------------------------------------------- /.Rhistory: -------------------------------------------------------------------------------- 1 | library(trappingmotion) 2 | devtools::install_github(“PabloPalencia/trappingmotion”) 3 | library("roxygen2", lib.loc="~/R/win-library/3.6") 4 | load_all() 5 | library(devtools) 6 | library(devtools) 7 | load_all() 8 | library(roxygen2) 9 | git push -u origin 10 | -u origin 11 | -u origin 12 | git checkout master 13 | git branch -f branch-name HEAD 14 | D:/rprojects/trappingmotion_Rpackage/trappingmotion.git 15 | D:rprojects/trappingmotion_Rpackage/trappingmotion.git 16 | D:/rprojects/trappingmotion_Rpackage/trappingmotion.git 17 | D:\rprojects/trappingmotion_Rpackage/trappingmotion.git 18 | git status 19 | gitstatus 20 | remove.packages("trappingmotion", lib="~/R/win-library/3.6") 21 | library(devtools) 22 | install_github("PabloPalencia/trappingmotion") 23 | install_github("PabloPalencia/trappingmotion") 24 | devtools::install_github("PabloPalencia/trappingmotion") 25 | load_all() 26 | devtools::install_github("PabloPalencia/trappingmotion") 27 | library(devtools) 28 | install.packages("rlang") 29 | library("glue", lib.loc="~/R/win-library/3.6") 30 | library("usethis", lib.loc="~/R/win-library/3.6") 31 | devtools::install_github("PabloPalencia/trappingmotion") 32 | library(trappingmotion) 33 | install.packages("glue") 34 | library(trappingmotion) 35 | data("RedDeerdata") 36 | aa <- data("RedDeerdata") 37 | aa <- data(RedDeerdata) 38 | bb <- data(RedDeerdata) 39 | load("D:/rprojects/trappingmotion_Rpackage/trappingmotionOK/trappingmotion/data/RedDeerdata.RData") 40 | View(RedDeerdata) 41 | library(trappingmotion) 42 | identbhvs(RedDeerdata$Speed) 43 | library("trappingmotion", lib.loc="~/R/win-library/3.6") 44 | identbhvs(RedDeerdata$Speed) 45 | meanspeed(RedDeerdata$Speed) 46 | identbhvs(RedDeerdata$Speed) 47 | ?identbhvs 48 | detach("package:trappingmotion", unload=TRUE) 49 | library("trappingmotion", lib.loc="~/R/win-library/3.6") 50 | library("trappingmotion", lib.loc="~/R/win-library/3.6") 51 | load_all() 52 | library(trappingmotion) 53 | identbhvs(RedDeerdata$Speed) 54 | library("trappingmotion", lib.loc="~/R/win-library/3.6") 55 | library(trappingmotion) 56 | data("RedDeerdata") 57 | identbhvs(RedDeerdata$Speed) 58 | meanspeed(behav_class) 59 | ?dayrange 60 | speed_data_ejemplo <-data.frame(speeds=c(0.6, 0.9, 0.01), speeds_se=c(0.1, 0.2, 0.001), n_seq=c(50, 30, 10)) 61 | View(speed_data_ejemplo) 62 | res 63 | res[1,] 64 | View(behav_class) 65 | summary(behav_class$behaviour) 66 | summary(behav_class) 67 | length(which(behav_class$behaviour == "1" )) 68 | length(which(behav_class$behaviour == "2" )) 69 | length(which(behav_class$behaviour == "3" )) 70 | 70+36+77 71 | speed_data <- data.frame(speeds=res[1,], speed_se=res[2,], n_seq=c(length(which(behav_class$behaviour == "1" )), length(which(behav_class$behaviour == "2" )), length(which(behav_class$behaviour == "3" )))) 72 | View(speed_data) 73 | setwd("D:/Recuperado2/IREC/DayRange/DatosReales") 74 | Results <- read.table("ResultsSpainIRECUnido.txt", sep = ";", dec=".", header=TRUE, as.is=TRUE) 75 | df_plot <- subset(Results, dato == "mean") 76 | library(tidyverse) 77 | df_plot2 <-arrange(df_plot, Order) #ordenar especies 78 | df_plot_12 <- subset(df_plot2, RatioSpeed >= 12) 79 | res_plot <- data.frame(1:14, 1:14, 1:14) 80 | names(res_plot) <- c("Row16", "Pal19", "PalNewAutom") 81 | res_plot$Row16 <- as.numeric(df_plot_12$DayRangeRow16) 82 | res_plot$Pal19 <- as.numeric(df_plot_12$DayRangePal19) 83 | res_plot$PalNewAutom <- as.numeric(df_plot_12$DayRangePalNewAutom) 84 | res_plot_m <- data.matrix(res_plot) 85 | trans_res_plot_m <- t(res_plot_m) # transponer 86 | par(mfrow=c(1,1), mar=c(5,6,5,0)) # mar=c(abajo, izq, arriba, derecha) 87 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 88 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("grey30", "palegreen2", "grey90"), 89 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 90 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 91 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("grey30", "palegreen1", "grey90"), 92 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 93 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 94 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("grey30", "palegreen3", "grey90"), 95 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 96 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 97 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("grey30", "palegreen", "grey90"), 98 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 99 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 100 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("grey30", "palegreen2", "grey90"), 101 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 102 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 103 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("grey30", "lightgreen", "grey90"), 104 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 105 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 106 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("red", "lightgreen", "grey90"), 107 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 108 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 109 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("tomato1", "lightgreen", "grey90"), 110 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 111 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 112 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("indianred1", "lightgreen", "grey90"), 113 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 114 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 115 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("indianred1", "lightgreen", "steelblue2"), 116 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 117 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 118 | cex.names=2.5, cex.axis=2.5, las=1, ylim=c(0,35), col=c("indianred1", "lightgreen", "steelblue1"), 119 | names.arg = c("BA", "RO", "RO", "RO", "FD", "FD", "MO", "WB", "WB", "RD", "RD", "RD", "RD", "RD")) 120 | df_plot_error <- subset(Results, dato == "SE") 121 | df_plot_error <-arrange(df_plot_error, Order) 122 | df_plot_error_12 <- subset(df_plot_error, StudyArea == "Astu_2019_tejon" | StudyArea == "Galicia_2019_roed" |StudyArea == "QM_2019_corzo" |StudyArea == "Astu_2019_corzo" |StudyArea == "Astu_2019_gamo" |StudyArea == "VLL_marzo_muflon" |StudyArea == "QM_2019_wb" |StudyArea == "Astu_2019_jabali" |StudyArea == "DHCVLL_oct2017_rede" |StudyArea == "RBD_2018_rede" |StudyArea == "Gredos_mar2018_rede" |StudyArea == "QM_2019_rede" |StudyArea == "RBD_oct2017_rede" | StudyArea == "Gamo_PenasNegr") 123 | res_plot_error <- data.frame(1:14, 1:14, 1:14) 124 | names(res_plot_error) <- c("Row16", "Pal19", "PalNewAutom") 125 | res_plot_error$Row16 <- as.numeric(df_plot_error_12$DayRangeRow16) 126 | res_plot_error$Pal19 <- as.numeric(df_plot_error_12$DayRangePal19) 127 | res_plot_error$PalNewAutom <- as.numeric(df_plot_error_12$DayRangePalNewAutom) 128 | res_plot_error_m <- data.matrix(res_plot_error) 129 | trans_res_plot_error_m <- t(res_plot_error_m) # transponer 130 | error.bar <- function(x, y, upper, lower=upper, length=0.1,...){ 131 | arrows(x,y+upper, x, y-lower, angle=90, code=0, length=length, ...) # code=0, si tope en los errores, code=3 con tope en los errores 132 | } 133 | error.bar(plot, trans_res_plot_m, trans_res_plot_error_m) 134 | setwd("D:/Recuperado2/IREC/DayRange/DatosReales/MarcusPaper2016") 135 | Results <- read.table("ResultsMarcusPaper2016.txt", sep = ";", dec=".", header=TRUE, as.is=TRUE) 136 | df_plot <- subset(Results, dato == "mean") 137 | df_plot2 <-arrange(df_plot, Order) #ordenar especies 138 | df_plot_12 <- subset(df_plot2, RatioSpeed < 12 | StudyArea == "RBD_2018_fox" | StudyArea == "Zorro_RBD17") 139 | res_plot <- data.frame(1:19, 1:19, 1:19) 140 | names(res_plot) <- c("Row16","Pal19", "PalNewAutom") 141 | setwd("D:/Recuperado2/IREC/DayRange/DatosReales") 142 | Results <- read.table("ResultsSpainIRECUnido.txt", sep = ";", dec=".", header=TRUE, as.is=TRUE) 143 | df_plot <- subset(Results, dato == "mean") 144 | library(tidyverse) 145 | df_plot2 <-arrange(df_plot, Order) #ordenar especies 146 | df_plot_12 <- subset(df_plot2, RatioSpeed < 12 | StudyArea == "RBD_2018_fox" | StudyArea == "Zorro_RBD17") 147 | res_plot <- data.frame(1:19, 1:19, 1:19) 148 | names(res_plot) <- c("Row16","Pal19", "PalNewAutom") 149 | res_plot$Row16 <- as.numeric(df_plot_12$DayRangeRow16) 150 | res_plot$Pal19 <- as.numeric(df_plot_12$DayRangePal19) 151 | res_plot$PalNewAutom <- as.numeric(df_plot_12$DayRangePalNewAutom) 152 | res_plot_m <- data.matrix(res_plot) 153 | trans_res_plot_m <- t(res_plot_m) # transponer 154 | par(mfrow=c(1,1), mar=c(5,7,5,0)) # mar=c(abajo, izq, arriba, derecha) 155 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 4, 156 | cex.names=2.2, cex.axis=2.5, las=1, ylim=c(0,30), col=c("indianred1", "lightgreen", "steelblue1"), 157 | names.arg = c("RS", "GE", "MA", "RF", "RF", "RF", "RF", "RF", "RO", "RO", "MO", "WB", "WB", "WB", "WB", "WB", "RD", "RD", "IG")) 158 | df_plot_error <- subset(Results, dato == "SE") 159 | df_plot_error <-arrange(df_plot_error, Order) 160 | df_plot_error_12 <- subset(df_plot_error, StudyArea != "Astu_2019_tejon" & StudyArea != "Galicia_2019_roed" &StudyArea != "QM_2019_corzo" &StudyArea != "Astu_2019_corzo" &StudyArea != "Astu_2019_gamo" &StudyArea != "VLL_marzo_muflon" &StudyArea != "QM_2019_wb" &StudyArea != "Astu_2019_jabali" &StudyArea != "DHCVLL_oct2017_rede" &StudyArea != "RBD_2018_rede" &StudyArea != "Gredos_mar2018_rede" &StudyArea != "QM_2019_rede" &StudyArea != "RBD_oct2017_rede" &StudyArea != "Gamo_PenasNegr") 161 | res_plot_error <- data.frame(1:19, 1:19, 1:19) 162 | names(res_plot_error) <- c("Row16", "Pal19", "PalNewAutom") 163 | res_plot_error$Row16 <- as.numeric(df_plot_error_12$DayRangeRow16) 164 | res_plot_error$Pal19 <- as.numeric(df_plot_error_12$DayRangePal19) 165 | res_plot_error$PalNewAutom <- as.numeric(df_plot_error_12$DayRangePalNewAutom) 166 | res_plot_error_m <- data.matrix(res_plot_error) 167 | trans_res_plot_error_m <- t(res_plot_error_m) # transponer 168 | error.bar <- function(x, y, upper, lower=upper, length=0.1,...){ 169 | arrows(x,y+upper, x, y-lower, angle=90, code=0, length=length, ...) # code=0, si tope en los errores, code=3 con tope en los errores 170 | } 171 | error.bar(plot, trans_res_plot_m, trans_res_plot_error_m) 172 | setwd("D:/Recuperado2/IREC/DayRange/DatosReales/MarcusPaper2016") 173 | Results <- read.table("ResultsMarcusPaper2016.txt", sep = ";", dec=".", header=TRUE, as.is=TRUE) 174 | df_plot <- subset(Results, dato == "mean") 175 | library(tidyverse) 176 | res_plot <- data.frame(1:12, 1:12) 177 | names(res_plot) <- c("Row16", "PalNewAutom") 178 | res_plot$Row16 <- as.numeric(df_plot$DayRangeRow16) 179 | res_plot$PalNewAutom <- as.numeric(df_plot$DayRangePalNewAutom) 180 | res_plot_m <- data.matrix(res_plot) 181 | trans_res_plot_m <- t(res_plot_m) # transponer 182 | par(mfrow=c(1,1), mar=c(7,7,7,7)) 183 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 3.5, 184 | cex.names=2.5, cex.axis=3, las=1, ylim=c(0,13), col=c("indianred1", "steelblue1"), #cex.names es para ajustar el tamaño de las especies 185 | names.arg = c("AG", "AR", "BR", "CO", "MO", "OC", "OP", "PA", "PE", "RA", "SQ", "TA")) 186 | df_plot_error <- subset(Results, dato == "SE") 187 | res_plot_error <- data.frame(1:12, 1:12) 188 | names(res_plot_error) <- c("Row16", "PalNewAutom") 189 | res_plot_error$Row16 <- as.numeric(df_plot_error$DayRangeRow16) 190 | res_plot_error$PalNewAutom <- as.numeric(df_plot_error$DayRangePalNewAutom) 191 | res_plot_error_m <- data.matrix(res_plot_error) 192 | trans_res_plot_error_m <- t(res_plot_error_m) # transponer 193 | error.bar <- function(x, y, upper, lower=upper, length=0.1,...){ 194 | arrows(x,y+upper, x, y-lower, angle=90, code=0, length=length, ...) # code=0, si tope en los errores, code=3 con tope en los errores 195 | } 196 | error.bar(plot, trans_res_plot_m, trans_res_plot_error_m) 197 | setwd("D:/Recuperado2/IREC/DayRange/DatosReales/PaperErizos") 198 | Results <- read.table("ResultsErizos.txt", sep = ";", dec=".", header=TRUE, as.is=TRUE) 199 | df_plot <- subset(Results, dato == "mean") 200 | library(tidyverse) 201 | res_plot <- data.frame(1:6, 1:6) 202 | names(res_plot) <- c("Row16", "PalNewAutom") 203 | res_plot$Row16 <- as.numeric(df_plot$DayRangeRow16) 204 | res_plot$PalNewAutom <- as.numeric(df_plot$DayRangePalNewAutom) 205 | res_plot_m <- data.matrix(res_plot) 206 | trans_res_plot_m <- t(res_plot_m) # transponer 207 | par(mfrow=c(1,1), mar=c(7,7,7,7)) 208 | plot <- barplot(trans_res_plot_m, beside = TRUE, space = c(0,2), ylab = "Day Range (Km/day)", cex.lab = 3.5, 209 | cex.names=2.5, cex.axis=3, las=1, ylim=c(0,4), col=c("indianred1", "steelblue1"), #cex.names es para ajustar el tamaño de las especies 210 | names.arg = c("BR17", "BR18", "IP18", "IP17", "RE16", "SO16" )) 211 | df_plot_error <- subset(Results, dato == "SE") 212 | res_plot_error <- data.frame(1:6, 1:6) 213 | names(res_plot_error) <- c("Row16", "PalNewAutom") 214 | res_plot_error$Row16 <- as.numeric(df_plot_error$DayRangeRow16) 215 | res_plot_error$PalNewAutom <- as.numeric(df_plot_error$DayRangePalNewAutom) 216 | res_plot_error_m <- data.matrix(res_plot_error) 217 | trans_res_plot_error_m <- t(res_plot_error_m) # transponer 218 | error.bar(plot, trans_res_plot_m, trans_res_plot_error_m) 219 | ?dayrange 220 | library(trappingmotion) 221 | ?dayrange 222 | ?dayrange 223 | ?dayrange 224 | ?dayrange 225 | ?dayrange 226 | library(trappingmotion) 227 | ?dayrange 228 | devtools::install_github("PabloPalencia/trappingmotion") 229 | devtools::install_github("PabloPalencia/trappingmotion") 230 | library(trappingmotion) 231 | ?dayrange 232 | ?meanspeed 233 | tinytex::install_tinytex() 234 | install.packages("rmarkdown") 235 | -------------------------------------------------------------------------------- /vignettes/trappingmotion Vignette.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | trappingmotion Vignette 18 | 19 | 32 | 33 | 41 | 42 | 43 | 44 | 52 | 117 | 145 | 146 | 147 | 148 | 149 | 330 | 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 |

trappingmotion Vignette

342 |

Pablo Palencia

343 |

30 November 2023

344 | 345 | 346 | 347 |
348 |

1. Introduction

349 |

Animal movement plays a crucial role in ecology as a key parameter in 350 | spatial distribution, population abundance, and other related processes 351 | such as habitat use and disease transmission, among others. Nowadays, 352 | movement ecology studies are based on a wide range of sensors, mainly 353 | biologging devices, but also satellites and drones. However, camera 354 | traps (remotely activated cameras, CT) have been scarcely used for this 355 | purpose. Camera trapping has experienced exponential growth during the 356 | last two decades. CT are used for a wide range of applications: species 357 | inventory, habitat use, abundance estimation, occupancy or species 358 | interaction, among others. In trappingmotion R package I 359 | developed a set of new functions to integrate movement & behavioural 360 | ecology in camera trapping studies. Please, see further details in the 361 | paper “Innovations in movement and behavioural ecology from camera 362 | traps: day range as model parameter”(https://besjournals.onlinelibrary.wiley.com/doi/abs/10.1111/2041-210X.13609)

363 |
364 |
365 |

2. Getting started with trappingmotion package.

366 |

This vignette will guide you throught the main functions included in 367 | the package. Briefly, we will identify movement behaviours (states) in a 368 | red deer population sampled with camera traps. We will estimate the 369 | average movement speed of each behaviour, and finally, we will estimate 370 | day range (i.e. average daily distance travelled by the animals). For 371 | that, we will analyse the dataset ‘RedDeerdata’ provided in the 372 | package.

373 |

First we load the trappingmotion library:

374 | 

375 | # devtools::install_github("PabloPalencia/trappingmotion") # run this line once for 
376 | # installing/updating the package. Version 2.0.0 is available! 
377 | library(trappingmotion)
378 |

The data frame “ReedDeerdata” includes 183 records of a red deer 379 | population. Time (first column) and movement speed in m/s (second 380 | column) of each animal recorded by the camera traps are included.

381 | 
data("RedDeerdata")
382 | head(RedDeerdata)
383 | #>       Time Speed
384 | #> 1 21:49:06  0.15
385 | #> 2  0:43:57  0.68
386 | #> 3 19:52:12  0.20
387 | #> 4  3:35:21  0.20
388 | #> 5  4:18:29  0.30
389 | #> 6 22:58:52  0.31
390 |
391 |

2.1 Identifying movement behaviours (states)

392 |

Using the identbhvs function it is possible to identify 393 | different movement behaviours (e.g. animals that were foraging VS 394 | animals that were moving between habitat patches) applying a k-means 395 | clustering. The optimal number of behaviours (clusters) is determined by 396 | comparing a set of 30 indices.

397 |

Before identifying movement behaviours, it is important to explore 398 | the presence of outliers in the speed data. Habitual 399 | procedures to identify outliers, such as visualization (boxplot), 400 | interquartile range and/or statistical tests (z scores) can be applied. 401 | identify_outliers function from rstatix R 402 | package could be also useful. If outliers are detected, review the speed 403 | estimation procedure in those pictures, and/or consider to discard those 404 | speeds before indentifying behaviours.

405 |

A more complex behaviour identification procedure including 406 | log-normal mixture models to assign the speeds to a group can be applied 407 | using identbhvs_mixdist function.

408 | 
identbhvs(RedDeerdata$Speed)
409 |

410 |

In this example, three different movement behaviours have been 411 | identified in this population.

412 |
413 |
414 |

2.2 Estimating mean movement speed

415 |

A sampling bias to fast movements have been described in camera 416 | trapping studies (Rowcliffe et al., 2016). Considering that, the mean 417 | speed of each behaviour cannot be estimated by arithmetic mean. To solve 418 | this bias we use the function meanspeed.

419 | 
meanspeed(behav_class) # colums= behaviours, rows= c(mean, SE)
420 |

From the total of 183 speed estimates in our data, 103 observations 421 | were classified in the slowest behaviour (0.07 m/s), 54 in a group with 422 | an average speed of 0.70 m/s; and the other 26 observations in the 423 | fastest group (average speed 1.27 m/s). As expected, we found high 424 | difference in the average speed value of each behaviour:

425 | 
head(speed_data)
426 | #>       speeds   speed_se n_seq
427 | #> 1 0.07034454 0.01078009   103
428 | #> 2 0.70354412 0.02275782    54
429 | #> 3 1.27210315 0.05293089    26
430 |
431 |
432 |

2.3 Estimating activity

433 |

To estimate day range it is need to get values about activity and 434 | speed of the animals. In the first part of this vignette, we have 435 | described the procedure to estimate speed. Now, we will describe how to 436 | estimate activity rate. For that, we will use the activity 437 | R package available in CRAN.

438 | 
library(activity)
439 | 
440 | # Estimating radian time of day
441 | RedDeerdata$T_0_1 <- (as.numeric(strptime(RedDeerdata$Time, format="%H:%M:%S") 
442 |                                  - as.POSIXct(format(Sys.Date())), units="secs")/86400)
443 | 
444 | # Estimating activity value
445 | activityRES <- 2*pi*RedDeerdata$T_0_1
446 | mod1 <- fitact(activityRES, sample="data") 
447 | 
448 | # Ploting activity patterns
449 | par(mfrow=c(1,1))
450 | plot(mod1)
451 |

452 | 

453 | # Fitting activity results
454 | act <- mod1@act[1]
455 | act_se <- mod1@act[2]
456 |
457 |
458 |

2.4 Estimating day range

459 |

Run the dayrange function to estimate day range

460 | 
dayrange(act, act_se, speed_data)
461 | #> Day range (Km/day) 5.072225 
462 | #> Day range SE (Km/day) 0.6447399
463 |

The day range of this population is 5.07 km per day

464 |
465 |
466 | 467 | 468 | 469 | 470 | 471 | 472 | 473 | 481 | 482 | 483 | 484 | -------------------------------------------------------------------------------- /vignettes/trappingmotion Vignette_files/MathJax.js.descargar: -------------------------------------------------------------------------------- 1 | /* 2 | * /MathJax.js 3 | * 4 | * Copyright (c) 2009-2017 The MathJax Consortium 5 | * 6 | * Licensed under the Apache License, Version 2.0 (the "License"); 7 | * you may not use this file except in compliance with the License. 8 | * You may obtain a copy of the License at 9 | * 10 | * http://www.apache.org/licenses/LICENSE-2.0 11 | * 12 | * Unless required by applicable law or agreed to in writing, software 13 | * distributed under the License is distributed on an "AS IS" BASIS, 14 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | * See the License for the specific language governing permissions and 16 | * limitations under the License. 17 | */ 18 | 19 | if(document.getElementById&&document.childNodes&&document.createElement){if(!(window.MathJax&&MathJax.Hub)){if(window.MathJax){window.MathJax={AuthorConfig:window.MathJax}}else{window.MathJax={}}MathJax.isPacked=true;MathJax.version="2.7.2";MathJax.fileversion="2.7.2";MathJax.cdnVersion="2.7.2";MathJax.cdnFileVersions={};(function(d){var b=window[d];if(!b){b=window[d]={}}var e=[];var c=function(f){var g=f.constructor;if(!g){g=function(){}}for(var h in f){if(h!=="constructor"&&f.hasOwnProperty(h)){g[h]=f[h]}}return g};var a=function(){return function(){return arguments.callee.Init.call(this,arguments)}};b.Object=c({constructor:a(),Subclass:function(f,h){var g=a();g.SUPER=this;g.Init=this.Init;g.Subclass=this.Subclass;g.Augment=this.Augment;g.protoFunction=this.protoFunction;g.can=this.can;g.has=this.has;g.isa=this.isa;g.prototype=new this(e);g.prototype.constructor=g;g.Augment(f,h);return g},Init:function(f){var g=this;if(f.length===1&&f[0]===e){return g}if(!(g instanceof f.callee)){g=new f.callee(e)}return g.Init.apply(g,f)||g},Augment:function(f,g){var h;if(f!=null){for(h in f){if(f.hasOwnProperty(h)){this.protoFunction(h,f[h])}}if(f.toString!==this.prototype.toString&&f.toString!=={}.toString){this.protoFunction("toString",f.toString)}}if(g!=null){for(h in g){if(g.hasOwnProperty(h)){this[h]=g[h]}}}return this},protoFunction:function(g,f){this.prototype[g]=f;if(typeof f==="function"){f.SUPER=this.SUPER.prototype}},prototype:{Init:function(){},SUPER:function(f){return f.callee.SUPER},can:function(f){return typeof(this[f])==="function"},has:function(f){return typeof(this[f])!=="undefined"},isa:function(f){return(f instanceof Object)&&(this instanceof f)}},can:function(f){return this.prototype.can.call(this,f)},has:function(f){return this.prototype.has.call(this,f)},isa:function(g){var f=this;while(f){if(f===g){return true}else{f=f.SUPER}}return false},SimpleSUPER:c({constructor:function(f){return this.SimpleSUPER.define(f)},define:function(f){var h={};if(f!=null){for(var g in f){if(f.hasOwnProperty(g)){h[g]=this.wrap(g,f[g])}}if(f.toString!==this.prototype.toString&&f.toString!=={}.toString){h.toString=this.wrap("toString",f.toString)}}return h},wrap:function(i,h){if(typeof(h)!=="function"||!h.toString().match(/\.\s*SUPER\s*\(/)){return h}var g=function(){this.SUPER=g.SUPER[i];try{var f=h.apply(this,arguments)}catch(j){delete this.SUPER;throw j}delete this.SUPER;return f};g.toString=function(){return h.toString.apply(h,arguments)};return g}})});b.Object.isArray=Array.isArray||function(f){return Object.prototype.toString.call(f)==="[object Array]"};b.Object.Array=Array})("MathJax");(function(BASENAME){var BASE=window[BASENAME];if(!BASE){BASE=window[BASENAME]={}}var isArray=BASE.Object.isArray;var CALLBACK=function(data){var cb=function(){return arguments.callee.execute.apply(arguments.callee,arguments)};for(var id in CALLBACK.prototype){if(CALLBACK.prototype.hasOwnProperty(id)){if(typeof(data[id])!=="undefined"){cb[id]=data[id]}else{cb[id]=CALLBACK.prototype[id]}}}cb.toString=CALLBACK.prototype.toString;return cb};CALLBACK.prototype={isCallback:true,hook:function(){},data:[],object:window,execute:function(){if(!this.called||this.autoReset){this.called=!this.autoReset;return this.hook.apply(this.object,this.data.concat([].slice.call(arguments,0)))}},reset:function(){delete this.called},toString:function(){return this.hook.toString.apply(this.hook,arguments)}};var ISCALLBACK=function(f){return(typeof(f)==="function"&&f.isCallback)};var EVAL=function(code){return eval.call(window,code)};var TESTEVAL=function(){EVAL("var __TeSt_VaR__ = 1");if(window.__TeSt_VaR__){try{delete window.__TeSt_VaR__}catch(error){window.__TeSt_VaR__=null}}else{if(window.execScript){EVAL=function(code){BASE.__code=code;code="try {"+BASENAME+".__result = eval("+BASENAME+".__code)} catch(err) {"+BASENAME+".__result = err}";window.execScript(code);var result=BASE.__result;delete BASE.__result;delete BASE.__code;if(result instanceof Error){throw result}return result}}else{EVAL=function(code){BASE.__code=code;code="try {"+BASENAME+".__result = eval("+BASENAME+".__code)} catch(err) {"+BASENAME+".__result = err}";var head=(document.getElementsByTagName("head"))[0];if(!head){head=document.body}var script=document.createElement("script");script.appendChild(document.createTextNode(code));head.appendChild(script);head.removeChild(script);var result=BASE.__result;delete BASE.__result;delete BASE.__code;if(result instanceof Error){throw result}return result}}}TESTEVAL=null};var USING=function(args,i){if(arguments.length>1){if(arguments.length===2&&!(typeof arguments[0]==="function")&&arguments[0] instanceof Object&&typeof arguments[1]==="number"){args=[].slice.call(args,i)}else{args=[].slice.call(arguments,0)}}if(isArray(args)&&args.length===1&&typeof(args[0])==="function"){args=args[0]}if(typeof args==="function"){if(args.execute===CALLBACK.prototype.execute){return args}return CALLBACK({hook:args})}else{if(isArray(args)){if(typeof(args[0])==="string"&&args[1] instanceof Object&&typeof args[1][args[0]]==="function"){return CALLBACK({hook:args[1][args[0]],object:args[1],data:args.slice(2)})}else{if(typeof args[0]==="function"){return CALLBACK({hook:args[0],data:args.slice(1)})}else{if(typeof args[1]==="function"){return CALLBACK({hook:args[1],object:args[0],data:args.slice(2)})}}}}else{if(typeof(args)==="string"){if(TESTEVAL){TESTEVAL()}return CALLBACK({hook:EVAL,data:[args]})}else{if(args instanceof Object){return CALLBACK(args)}else{if(typeof(args)==="undefined"){return CALLBACK({})}}}}}throw Error("Can't make callback from given data")};var DELAY=function(time,callback){callback=USING(callback);callback.timeout=setTimeout(callback,time);return callback};var WAITFOR=function(callback,signal){callback=USING(callback);if(!callback.called){WAITSIGNAL(callback,signal);signal.pending++}};var WAITEXECUTE=function(){var signals=this.signal;delete this.signal;this.execute=this.oldExecute;delete this.oldExecute;var result=this.execute.apply(this,arguments);if(ISCALLBACK(result)&&!result.called){WAITSIGNAL(result,signals)}else{for(var i=0,m=signals.length;i0&&priority=0;i--){this.hooks.splice(i,1)}this.remove=[]}});var EXECUTEHOOKS=function(hooks,data,reset){if(!hooks){return null}if(!isArray(hooks)){hooks=[hooks]}if(!isArray(data)){data=(data==null?[]:[data])}var handler=HOOKS(reset);for(var i=0,m=hooks.length;ig){g=document.styleSheets.length}if(!i){i=document.head||((document.getElementsByTagName("head"))[0]);if(!i){i=document.body}}return i};var f=[];var c=function(){for(var k=0,j=f.length;k=this.timeout){i(this.STATUS.ERROR);return 1}return 0},file:function(j,i){if(i<0){a.Ajax.loadTimeout(j)}else{a.Ajax.loadComplete(j)}},execute:function(){this.hook.call(this.object,this,this.data[0],this.data[1])},checkSafari2:function(i,j,k){if(i.time(k)){return}if(document.styleSheets.length>j&&document.styleSheets[j].cssRules&&document.styleSheets[j].cssRules.length){k(i.STATUS.OK)}else{setTimeout(i,i.delay)}},checkLength:function(i,l,n){if(i.time(n)){return}var m=0;var j=(l.sheet||l.styleSheet);try{if((j.cssRules||j.rules||[]).length>0){m=1}}catch(k){if(k.message.match(/protected variable|restricted URI/)){m=1}else{if(k.message.match(/Security error/)){m=1}}}if(m){setTimeout(a.Callback([n,i.STATUS.OK]),0)}else{setTimeout(i,i.delay)}}},loadComplete:function(i){i=this.fileURL(i);var j=this.loading[i];if(j&&!j.preloaded){a.Message.Clear(j.message);clearTimeout(j.timeout);if(j.script){if(f.length===0){setTimeout(c,0)}f.push(j.script)}this.loaded[i]=j.status;delete this.loading[i];this.addHook(i,j.callback)}else{if(j){delete this.loading[i]}this.loaded[i]=this.STATUS.OK;j={status:this.STATUS.OK}}if(!this.loadHooks[i]){return null}return this.loadHooks[i].Execute(j.status)},loadTimeout:function(i){if(this.loading[i].timeout){clearTimeout(this.loading[i].timeout)}this.loading[i].status=this.STATUS.ERROR;this.loadError(i);this.loadComplete(i)},loadError:function(i){a.Message.Set(["LoadFailed","File failed to load: %1",i],null,2000);a.Hub.signal.Post(["file load error",i])},Styles:function(k,l){var i=this.StyleString(k);if(i===""){l=a.Callback(l);l()}else{var j=document.createElement("style");j.type="text/css";this.head=h(this.head);this.head.appendChild(j);if(j.styleSheet&&typeof(j.styleSheet.cssText)!=="undefined"){j.styleSheet.cssText=i}else{j.appendChild(document.createTextNode(i))}l=this.timer.create.call(this,l,j)}return l},StyleString:function(n){if(typeof(n)==="string"){return n}var k="",o,m;for(o in n){if(n.hasOwnProperty(o)){if(typeof n[o]==="string"){k+=o+" {"+n[o]+"}\n"}else{if(a.Object.isArray(n[o])){for(var l=0;l="0"&&q<="9"){f[j]=p[f[j]-1];if(typeof f[j]==="number"){f[j]=this.number(f[j])}}else{if(q==="{"){q=f[j].substr(1);if(q>="0"&&q<="9"){f[j]=p[f[j].substr(1,f[j].length-2)-1];if(typeof f[j]==="number"){f[j]=this.number(f[j])}}else{var k=f[j].match(/^\{([a-z]+):%(\d+)\|(.*)\}$/);if(k){if(k[1]==="plural"){var d=p[k[2]-1];if(typeof d==="undefined"){f[j]="???"}else{d=this.plural(d)-1;var h=k[3].replace(/(^|[^%])(%%)*%\|/g,"$1$2%\uEFEF").split(/\|/);if(d>=0&&d=3){c.push([f[0],f[1],this.processSnippet(g,f[2])])}else{c.push(e[d])}}}}else{c.push(e[d])}}return c},markdownPattern:/(%.)|(\*{1,3})((?:%.|.)+?)\2|(`+)((?:%.|.)+?)\4|\[((?:%.|.)+?)\]\(([^\s\)]+)\)/,processMarkdown:function(b,h,d){var j=[],e;var c=b.split(this.markdownPattern);var g=c[0];for(var f=1,a=c.length;f1?d[1]:""));f=null}if(e&&(!b.preJax||d)){c.nodeValue=c.nodeValue.replace(b.postJax,(e.length>1?e[1]:""))}if(f&&!f.nodeValue.match(/\S/)){f=f.previousSibling}}if(b.preRemoveClass&&f&&f.className===b.preRemoveClass){a.MathJax.preview=f}a.MathJax.checked=1},processInput:function(a){var b,i=MathJax.ElementJax.STATE;var h,e,d=a.scripts.length;try{while(a.ithis.processUpdateTime&&a.i1){d.jax[a.outputJax].push(b)}b.MathJax.state=c.OUTPUT},prepareOutput:function(c,f){while(c.jthis.processUpdateTime&&h.i=0;q--){if((b[q].src||"").match(f)){s.script=b[q].innerHTML;if(RegExp.$2){var t=RegExp.$2.substr(1).split(/\&/);for(var p=0,l=t.length;p=parseInt(y[z])}}return true},Select:function(j){var i=j[d.Browser];if(i){return i(d.Browser)}return null}};var e=k.replace(/^Mozilla\/(\d+\.)+\d+ /,"").replace(/[a-z][-a-z0-9._: ]+\/\d+[^ ]*-[^ ]*\.([a-z][a-z])?\d+ /i,"").replace(/Gentoo |Ubuntu\/(\d+\.)*\d+ (\([^)]*\) )?/,"");d.Browser=d.Insert(d.Insert(new String("Unknown"),{version:"0.0"}),a);for(var v in a){if(a.hasOwnProperty(v)){if(a[v]&&v.substr(0,2)==="is"){v=v.slice(2);if(v==="Mac"||v==="PC"){continue}d.Browser=d.Insert(new String(v),a);var r=new RegExp(".*(Version/| Trident/.*; rv:)((?:\\d+\\.)+\\d+)|.*("+v+")"+(v=="MSIE"?" ":"/")+"((?:\\d+\\.)*\\d+)|(?:^|\\(| )([a-z][-a-z0-9._: ]+|(?:Apple)?WebKit)/((?:\\d+\\.)+\\d+)");var u=r.exec(e)||["","","","unknown","0.0"];d.Browser.name=(u[1]!=""?v:(u[3]||u[5]));d.Browser.version=u[2]||u[4]||u[6];break}}}try{d.Browser.Select({Safari:function(j){var i=parseInt((String(j.version).split("."))[0]);if(i>85){j.webkit=j.version}if(i>=538){j.version="8.0"}else{if(i>=537){j.version="7.0"}else{if(i>=536){j.version="6.0"}else{if(i>=534){j.version="5.1"}else{if(i>=533){j.version="5.0"}else{if(i>=526){j.version="4.0"}else{if(i>=525){j.version="3.1"}else{if(i>500){j.version="3.0"}else{if(i>400){j.version="2.0"}else{if(i>85){j.version="1.0"}}}}}}}}}}j.webkit=(navigator.appVersion.match(/WebKit\/(\d+)\./))[1];j.isMobile=(navigator.appVersion.match(/Mobile/i)!=null);j.noContextMenu=j.isMobile},Firefox:function(j){if((j.version==="0.0"||k.match(/Firefox/)==null)&&navigator.product==="Gecko"){var m=k.match(/[\/ ]rv:(\d+\.\d.*?)[\) ]/);if(m){j.version=m[1]}else{var i=(navigator.buildID||navigator.productSub||"0").substr(0,8);if(i>="20111220"){j.version="9.0"}else{if(i>="20111120"){j.version="8.0"}else{if(i>="20110927"){j.version="7.0"}else{if(i>="20110816"){j.version="6.0"}else{if(i>="20110621"){j.version="5.0"}else{if(i>="20110320"){j.version="4.0"}else{if(i>="20100121"){j.version="3.6"}else{if(i>="20090630"){j.version="3.5"}else{if(i>="20080617"){j.version="3.0"}else{if(i>="20061024"){j.version="2.0"}}}}}}}}}}}}j.isMobile=(navigator.appVersion.match(/Android/i)!=null||k.match(/ Fennec\//)!=null||k.match(/Mobile/)!=null)},Chrome:function(i){i.noContextMenu=i.isMobile=!!navigator.userAgent.match(/ Mobile[ \/]/)},Opera:function(i){i.version=opera.version()},Edge:function(i){i.isMobile=!!navigator.userAgent.match(/ Phone/)},MSIE:function(j){j.isMobile=!!navigator.userAgent.match(/ Phone/);j.isIE9=!!(document.documentMode&&(window.performance||window.msPerformance));MathJax.HTML.setScriptBug=!j.isIE9||document.documentMode<9;MathJax.Hub.msieHTMLCollectionBug=(document.documentMode<9);if(document.documentMode<10&&!s.params.NoMathPlayer){try{new ActiveXObject("MathPlayer.Factory.1");j.hasMathPlayer=true}catch(m){}try{if(j.hasMathPlayer){var i=document.createElement("object");i.id="mathplayer";i.classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987";g.appendChild(i);document.namespaces.add("m","http://www.w3.org/1998/Math/MathML");j.mpNamespace=true;if(document.readyState&&(document.readyState==="loading"||document.readyState==="interactive")){document.write('');j.mpImported=true}}else{document.namespaces.add("mjx_IE_fix","http://www.w3.org/1999/xlink")}}catch(m){}}}})}catch(c){console.error(c.message)}d.Browser.Select(MathJax.Message.browsers);if(h.AuthorConfig&&typeof h.AuthorConfig.AuthorInit==="function"){h.AuthorConfig.AuthorInit()}d.queue=h.Callback.Queue();d.queue.Push(["Post",s.signal,"Begin"],["Config",s],["Cookie",s],["Styles",s],["Message",s],function(){var i=h.Callback.Queue(s.Jax(),s.Extensions());return i.Push({})},["Menu",s],s.onLoad(),function(){MathJax.isReady=true},["Typeset",s],["Hash",s],["MenuZoom",s],["Post",s.signal,"End"])})("MathJax")}}; 20 | --------------------------------------------------------------------------------