osos <- read.csv("utm unificadas.csv")

require(lubridate); require(plyr); require(magrittr)
osos$datetime <- mdy_hms(paste(osos$date, osos$time))
osos <- arrange(osos, id, datetime)

map data

require(mapdata)
map("worldHires", xlim = range(osos$x) + c(-2,2), ylim = range(osos$y) + c(-2,2), col = "lightgrey", fill = TRUE, bor = "darkgrey")
box()
require(scales)

n.bears <- length(levels(osos$id))
palette(topo.colors(n.bears))
d_ply(osos, "id", 
      function(oso) with(oso, points(x,y, col = alpha(as.integer(id), .2), cex = 0.5, pch = 19, type = "o")))

Ay muchos osos!

summary table

require(magrittr)
oso.summary <- ddply(osos, "id", summarize, start = min(datetime), end = max(datetime), n.obs = length(id))

Hay un problema con Uula! Que vive 30 anos.

subset(osos, id == "Uula") %>% arrange(datetime) %>% tail
##      id     date     time        x        y sex session zone  x_utm
## 69 Uula 8/3/2009 22:43:54 30.35461 66.19668   0      38  36V 651023
## 70 Uula 7/3/2010 22:09:51 30.58473 66.03675   0       8  36V 662393
## 71 Uula 7/3/2011 18:10:50 30.39495 65.96875   0       9  36V 654213
## 72 Uula 7/3/2012  6:10:51 30.13223 65.93403   0      10  36V 642481
## 73 Uula 7/3/2012 18:11:50 30.05094 65.97847   0      10  36V 638545
## 74 Uula 7/3/2029 22:30:44 30.06086 66.19576   0      27  36V 637812
##      y_utm            datetime
## 69 7345879 2009-08-03 22:43:54
## 70 7328651 2010-07-03 22:09:51
## 71 7320601 2011-07-03 18:10:50
## 72 7316114 2012-07-03 06:10:51
## 73 7320881 2012-07-03 18:11:50
## 74 7345099 2029-07-03 22:30:44

Echamos ese punto:

osos <- subset(osos, datetime < ymd("2019-01-01"))

gglot of durations

require(ggplot2)
ggplot(osos %>% arrange(datetime) %>% mutate(id = factor(id, levels = unique(id))), aes(datetime, id, col = id)) + 
       geom_point(cex = 0.5) + ylab("")

The gaps are all the winters

Ok, hacemos una animacion de Heikki in 2003:

Simple idea: (a) make a bunch of images, (b) combine into a movie.

heikki2003 <- subset(osos, id == "Heikki" & year(datetime) == 2003)
with(heikki2003, plot(x,y, type="l"))

Hay monton de datos, aun por un año (entre Marzo 31 y Noviembre 30)!

dim(heikki2003)
## [1] 1554   11
range(heikki2003$datetime)
## [1] "2003-03-31 04:32:36 UTC" "2003-11-30 14:15:56 UTC"
range(yday(heikki2003$datetime))
## [1]  90 334

Mejor - creo - hacer un imagen por dia, pero incluir todos los dados. Me ayudan esa foncion:

plotUpToDay <- function(bear, day, ...){
    plot(bear$x, bear$y, type = "n", ...)
    b <- subset(bear, yday(datetime) <= day) 
    lines(b$x, b$y, col = "darkgrey")
    with(b[nrow(b),], points(x, y, pch = 21, bg = "yellow", col = "darkred", cex = 2))
    title(b$date[nrow(b)])
}

Asi que se se puede facilmente hacer muchos dibujos:

par(mfrow = c(3,4), mar = c(1,1,4,1), tck = 0.01, mgp = c(1,.25,0), bty = "l")
for(day in round(seq(90,334, length = 12)))
plotUpToDay(heikki2003, day)

To make an animation, we loop through all of the days and make separate images.

for(day in 90:300){
png(paste0("heikki/heikki", sprintf("%03d", day), ".png"), width = 1200, height = 1000, res = 100)
    plotUpToDay(heikki2003, day)
dev.off()
}

To animate these images (combine them into an “mpeg”) there is a package called mapmate:

require(mapmate)
ffmpeg("heikki", pattern = "heikki%03d.png", output = "heikki.mp4", rate = 10, start = 90)

The start = 90 is important: it means that the first picture it looks for is #90. Otherwise it won’t work. This should make a file called: heikki.mp4 in your working directory … Click link to see it.

Ahora, lo hacemos sobre una mapa mas bonita

To do this, I wrote a special function in a package that we work with called above - you can install it from GitHub like this:

require(devtools)
install_github("ABoVE-AotM/above")

This package is a monster that depends on lots of other packages, so there might be trouble with it!

Ayways, I made a function that downloads any basemap image from this set: http://leaflet-extras.github.io/leaflet-providers/preview/. The function is called getBasemapRaster, and there are some instructions here: https://terpconnect.umd.edu/~egurarie/research/ABoVE/MapviewRasterMapping/BasemapRaster.html

For this bit of Finland/Russia,maybe a nice map is the Esri.DeLorme. ALl you need to give the function is the x and y limits:

apply(heikki2003[,c("x","y")], 2, range)
##             x        y
## [1,] 30.06457 63.70468
## [2,] 32.25963 64.10724
require(above)
heikki.basemap <- getBasemapRaster(29.7, 32.5, 63.6, 64.3, "Esri.DeLorme")

This is a static, 3 layer RGB (red-green-blue) raster of Heikki’s territory. Highly recommended to save it as a raster object:

writeRaster(heikki.basemap, file = "HeikkiDeLorme.tif")

You can now load it and to plot with, e.g.:

heikki.basemap <- stack("HeikkiDeLorme.tif")
plotRGB(heikki.basemap)
with(heikki2003, lines(x,y, col = "purple"))

Now, we slightly modify our plotting function and make a fun animation of Heikki running around:

plotUpToDay <- function(bear, day, ...){
    plotRGB(heikki.basemap)
    b <- subset(bear, yday(datetime) <= day) 
    lines(b$x, b$y, col = "darkblue", lwd = 2)
    with(b, points(x, y, pch = 21, bg = rgb(seq(0.5,1,length = nrow(b)), 0, 
                                            seq(1,0.3,length = nrow(b)))))
    with(b[nrow(b),], points(x, y, pch = 21, bg = "yellow", col = "red", cex = 2, lwd = 1.5))
    title(b$date[nrow(b)])
}
plotUpToDay(heikki2003, 200)

And low, loop through all of the days and make separate images again.

for(day in 90:300){
png(paste0("heikkiWithBasemap/heikki", sprintf("%03d", day), ".png"), width = 1200, height = 800, res = 100)
    plotUpToDay(heikki2003, day)
dev.off()
}

And, finally, make an animation:

require(mapmate)
ffmpeg("heikkiWithBasemap", pattern = "heikki%03d.png", output = "heikkiWithBasemap.mp4", rate = 10, start = 90)

!Miralo! heikkiWithBasemap.mp4