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)
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!
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"))
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
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.
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