Analysing the movements of a cat

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<vacation_start | track$time>vacation_end,]

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.