Analysing the movements of a cat

March 1, 2016
By

(This article was first published on Revolutions, and kindly contributed to R-bloggers)

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,]

Track_plot

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$timevacation_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))

Teddy_months

Teddy_august

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:

To leave a comment for the author, please follow the link and comment on their blog: Revolutions.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)