Analysing the movements of a cat
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
by Verena Haunschmid
Since I have a cat tracker, I wanted to do some analysis of the behavior of my cats. I have shown how to do some of these things here.
Data Collection
The data was collected using the Tractive GPS Pet Tracker over a period of about one year from January 2014 to November 2014 (with breaks). From March to November I additionally took notes in an Excel sheet which cat was carrying the tracker.
Libraries you need
If you want to reproduce my example you need the following libraries:
- XML
- plyr
- xlsx
- devtools
- leaflet (installed via devtools::install_github(“rstudio/leaflet”))
Loading the data into R
There are some methods to read .gpx files in R, but since I just wanted to use it for this one specific file I created my own method:
readTrackingFile<-function(filename) {
library(XML)
library(plyr)
xmlfile <- xmlParse(filename)
xmltop <- xmlRoot(xmlfile)
tracking <- ldply(xmlToList(xmltop[['trk']][['trkseg']]),
function(x) {data.frame(x)
})
tracking <- data.frame("ele"=tracking$ele[seq(1, nrow(tracking), 2)],
“time” = as.character(tracking$time
[seq(1, nrow(tracking), 2)]),
“lat” = tracking$.attrs[seq(1, nrow(tracking), 2)],
“lon” = tracking$.attrs[seq(2, nrow(tracking), 2)])
tracking$ele <- as.numeric(levels(tracking$ele))[tracking$ele]
tracking$lat <- as.numeric(levels(tracking$lat))[tracking$lat]
tracking$lon <- as.numeric(levels(tracking$lon))[tracking$lon]
time_pattern <- "%Y-%m-%dT%H:%M:%SZ"
tracking$time <- strptime(as.character(tracking$time), time_pattern)
tracking$min <- 60*tracking$time$hour + tracking$time$min
message(paste(“read”, nrow(tracking), “tracking points”))
return(tracking)
}
Then I used this method to read the tracks:
track <- readTrackingFile("../../data/LJWSIZUT.gpx")
And made a rudimentary plot to see where the data was:
# showed that some were far off
plot(track$lon, track$lat, pch=19, cex=0.5)
track <- track[track$lat > 30,]
Since we also used our tracker to track our vacation, I had to filter that out:
time_pattern <- "%Y-%m-%dT%H:%M:%SZ"
vacation_start <- strptime("2015-07-23T04:00:00Z", time_pattern)
vacation_end <- strptime("2015-08-04T22:00:00Z", time_pattern)
track_cat <- track[track$time
To be able to distinguish the tracks I loaded the Excel file I use to take notes. I matched the dates in the Excel file with the ones in my data.frame.
cats <- read.xlsx("../tractive/data/Katzen1.xlsx", sheetIndex=1,
header=FALSE, stringsAsFactors = FALSE)
names(cats) <- c("TrackingDate", "Cat")
cats <- cats[!is.na(cats$Cat),]
time_pattern <- "%d. %B %Y"
cats$TrackingDate <- strptime(paste(cats$TrackingDate, "2015"),
format = time_pattern)
# add cat name
track_cat$cat <- "Unknown"
for (i in 1:nrow(track_cat)) {
cat_idx <- which((cats$TrackingDate$mday ==
track_cat[i,”time”]$mday)
& (cats$TrackingDate$mon+1 ==
track_cat[i,”time”]$mon+1)
& (cats$TrackingDate$year+1900 ==
track_cat[i,”time”]$year+1900))
if (length(cat_idx) == 1) {
track_cat[i,”cat”]<-cats[cat_idx, "Cat"]
}
}
After the vacation I did not take notes anymore because Teddy was the only one who use the tracker:
track_cat[track_cat$time > vacation_end,”cat”] <- "Teddy"
Since there were some points far off and I noticed those also had very wrong elevation, I decided it would make sense to remove all that deviated to far from the elevation. I guess there are other more scientific ways to do this, but it did the trick 🙂
track_cat_teddy <- track_cat[abs(track_cat$ele-423) < 30 & track_cat$cat=="Teddy",]
Create a map
To create the map I used the leaflet package. Since it did not work with the rainbow() function (I guess it can only take color as hex numbers) I defined a vector with colors. I Also defined a vector with the months I had data for. This of course be done in a nicer way (without hard coding the colors and the months), but since I currently only have this data set and don’t need to create anything dynamically, I’ll stick with the easiest way.
monthCol <- c("blue", "green", "yellow", "purple", "brown", "orange")
month < -c("March", "May", "June", "July", "August", "November")
I use the two methods leaflet() and addTiles() without any parameters which creates a default world map with tiles.
If you are wondering about %>%, this is the piping operator from the package magrittr.
catMap <- leaflet() %>% addTiles()
Then I loop over the unique months.
Using <- assigns the variable catMap a new map with a new polyline. The last line, catMap renders the map in the View tab of RStudio.
for (i in 1:length(unique(track_cat_teddy$time$mon))) {
m<-unique(track_cat_teddy$time$mon)[i]
catMap <- catMap %>%
addPolylines(track_cat_teddy[track_cat_teddy$time$mon
==m,”lon”],
track_cat_teddy[track_cat_teddy$time$mon
==m,”lat”],
col=monthCol[i], group=m)
}
catMap
You might note that I added a parameter group to the method and assigned the value of the month.
This value is used to define a control to the map where you can select/unselect certain months. Unfortunately the legend does not display the color of the line.
catMap %>%
addLayersControl(
overlayGroups = month,
options = layersControlOptions(collapsed = FALSE))
You can now use these checkboxes to select/deselect different polylines.
Where to use this map
You can do some useful things with this created map.
- You can use R shiny to create nice app that includes your map.
- You can export the HTML from the Viewer window clicking at “Export” > “Save as Web Page…”
Code and further links:
- The code is available in my github repo.
- I recently published my collected data on my own blog.
- The other data is also available in a github repo.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.