Creando mapa animado utilizando R

Question

Estoy siendo bastante nuevo con R.

Quiero crear un mapa animado de Rusia con cambios en el desempleo en diferentes años, como. En la imagen se puede ver datos para un año.

require(sp)
require(maptools)

require(RColorBrewer)
require(rgdal)
 rus<-url("http://www.filefactory.com/file/4h1hb5c1cw7r/n/RUS_adm1_RData")
print(load(rus))

unempl <- read.delim2(file="C:\\unempl1.txt", header = TRUE, 
        sep = ";",quote = "", dec=",", stringsAsFactors=F)

gadm_names <-gadm$NAME_1
total <- length(gadm_names)
pb <- txtProgressBar(min = 0, max = total, style = 3) 

order <- vector()
for (i in 1:total){  

  order[i] <- agrep(gadm_names[i], unempl$region, 
                     max.distance = 0.2)[1]
 setTxtProgressBar(pb, i)               # update progress bar
}

col_no <- as.factor(as.numeric(cut(unempl$data[order],
                    c(0,2.5,5,7.5,10,15,100))))

levels(col_no) <- c("<2,5%", "2,5-5%", "5-7,5%",
                    "7,5-10%", "10-15%", ">15%")

gadm$col_no <- col_no
myPalette<-brewer.pal(6,"Purples")

proj4.str <- CRS("+init=epsg:3413 +lon_0=105")
gadm.prj <- spTransform(gadm, proj4.str)

spplot(gadm.prj, "col_no", col=grey(.9), col.regions=myPalette,
main="Desempleo en Rusia por región")

El resultado, que deseo obtener es algo así como la animación aquí: http://spatial.ly/2011/02/mapping-londons-population-change-2011-2030/ Sin embargo, he buscado mucho, leí una serie de temas en http://stackoverflow.com incluyendo el siguiente: Creando una película a partir de una serie de gráficos en R, pero aún no pude hacer lo correcto.

He llegado a algo como esto.

¿Alguien puede decirme dónde está mi error?

require(animation)
    require(sp)
    require(RColorBrewer) 
    require(classInt)     
require(rgdal)
 rus<-url("http://www.filefactory.com/file/4h1hb5c1cw7r/n/RUS_adm1_RData")
print(load(rus))

unempl1 <- read.delim2(file="C:\\unempl11.txt", header = TRUE, 
        sep = ";",quote = "", dec=",", stringsAsFactors=F)
unempl2<- read.delim2(file="C:\\unempl12.txt", header = TRUE, 
        sep = ";",quote = "", dec=",", stringsAsFactors=F)

gadm_names <-gadm$NAME_1

total <- length(gadm_names)
pb <- txtProgressBar(min = 0, max = total, style = 3) 

order <- vector()

for (i in 1:total){  

  order[i] <- agrep(gadm_names[i], unempl1$region, 
                     max.distance = 0.2)[1]
 setTxtProgressBar(pb, i)               # update progress bar
}

for (l in 1:total){  

  order[l] <- agrep(gadm_names[l], unempl2$region, 
                     max.distance = 0.2)[1]
 setTxtProgressBar(pb, i)               # update progress bar
}

col_no_1 <- as.factor(as.numeric(cut(unempl1$data[order],
                    c(0,2.5,5,7.5,10,15,100))))

col_no_2<- as.factor(as.numeric(cut(unempl2$data[order],
                    c(0,2.5,5,7.5,10,15,100))))
saveHTML(
      for(k in 1:2) {
        try<-get(paste("col_no_", k, sep = ""))

levels(try) <- c("<2,5%", "2,5-5%", "5-7,5%",
                    "7,5-10%", "10-15%", ">15%")

gadm$col_no <- try

myPalette<-brewer.pal(6,"Purples")

proj4.str <- CRS("+init=epsg:3413 +lon_0=105")
gadm.prj <- spTransform(gadm, proj4.str)

spplot(gadm.prj, "col_no", col=grey(.9), col.regions=myPalette,
main="Desempleo en Rusia por región")
},img.name = "map", htmlfile = "unrus2.html")

Answer 1

Echa un vistazo al paquete de animación. Una de las funciones que vale la pena explorar, que no requiere software de terceros, es "saveHTML".

Usar la función "saveHTML" en el paquete de animación es muy sencillo. Aquí tienes un código de ejemplo donde creo una animación de un cambio poblacional aleatorio. El argumento "expr" define la función de graficación que quieres pasar a la animación. Como puedes ver en el código a continuación, utilicé un bucle for para graficar cada columna simulada.

    require(animation)
    require(sp)
    require(RColorBrewer) 
    require(classInt)     

# Carga tus datos y añade una columna de cambio poblacional aleatorio
    load(url("http://www.gadm.org/data/rda/GBR_adm2.RData"))
      for( i in 1:10 ) {
        gadm@data[paste("Year",i, sep="")] <- runif(dim(gadm)[1],0,1) 
       }

# Crea una animación HTML usando un bucle for para cada columna simulada    
    saveHTML(
      for(x in names(gadm@data)[19:28]) { 
      ani.options(interval = 0.5)  
       plotvar <- gadm@data[,x]
          nclr <- 9
         plotclr <- rev(brewer.pal(nclr,"BuPu"))
          cuts <- classIntervals(plotvar, style="fixed", 
               fixedBreaks=c(0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,1))
               colcode <- findColours(cuts, plotclr)
          plot(gadm, col=colcode, border=NA, ylim=c(bbox(gadm)[,1][2], bbox(gadm)[,2][2]),
            xlim=c(bbox(gadm)[,1][1], bbox(gadm)[,2][1]))
            text(min(bbox(gadm)[1]), min(bbox(gadm)[2]), paste("Cambio Poblacional",x,sep=" "))
          box()
        legend("topleft", legend=c("0-10%","10-20%","20-30%","30-40%","40-50%",
               "50-60%","60-70%","70-80%","80-100%"),
                 fill=attr(colcode, "palette"), cex=0.6, bty="n")   
        ani.pause() 
        },
           img.name="CambioPobAleatorio", htmlfile="SimCambioPoblacional.html",
           single.opts = "'controls': ['first', 'previous', 'play', 'next', 'last', 'loop', 'speed'], 'delayMin': 0",      
            description=c("Cambio poblacional aleatorio:"))  

Edité la publicación para proporcionar un ejemplo más relevante basado en columnas de polígonos.

Answer 2

La animación que has enlazado (abajo) es una imagen animada en formato GIF.

Essencialmente, es una serie de imágenes que se ciclan, lo que crea el efecto de animación. Piensa en ello como si estuvieras pasando por una serie de diapositivas, una cada segundo aproximadamente.

Lo que necesitas hacer para crear la animación es:

1) Crear cada 'cuadro' individual que se mostrará.

2) Crear el GIF en sí. Hay varios sitios web que pueden hacer esto por ti:

http://www.createagif.net/

http://makeagif.com/

La mayoría de estos sitios web te permitirán controlar el tamaño y la velocidad de la animación.

La pregunta de StackOverflow a la que enlazaste debería proporcionarte todo lo que necesitas saber para realizar esta tarea en R. Observa que primero debes instalar un paquete de terceros.

EDITAR: A continuación se presenta una versión actualizada del código del enlace de StackOverflow anterior, ya que parece haber un poco de confusión.

jpeg("/tmp/foo%02d.jpg")
for (i in 1:5) {
  my.plot(i)
}      
make.mov <- function(){
     unlink("plot.mpg")
     system("convert -delay 0.5 plot*.jpg plot.mpg")
}

dev.off()

Este código anterior toma cada una de las parcelas individuales que has creado en R y las convierte en una animación recorriendo cada una y utilizando ImageMagick, el cual debes tener instalado.

Answer 3

Esto es hasta donde llego. Deberías ser capaz de entenderlo basándote en este código. Una vez más, como tu problema no es reproducible, tuve que crear datos ficticios para ilustrar la solución. Un aspecto extraño al usar spplot es que ya que utiliza lattice para crear el gráfico, necesitas crear un objeto y luego imprimirlo. De lo contrario, no obtendrás un gráfico.

require(animation)
require(sp)
require(RColorBrewer) 
require(classInt)     
require(rgdal)

load(url("http://www.filefactory.com/file/4h1hb5c1cw7r/n/RUS_adm1_RData"))
closeAllConnections()

# Establecer paleta de colores
myPalette <- brewer.pal(6,"Purples")

# Reproyectar datos
gadm <- spTransform(gadm, CRS("+init=epsg:3413 +lon_0=105"))

# Crear datos de desempleo ficticios con un cambio del 10% en el objeto gadm
gadm@data$uemp2000 <- runif(dim(gadm)[1],0,50)
gadm@data$uemp2001 <- gadm@data$uemp2000 + (gadm@data$uemp2000 * 0.10) 
gadm@data$uemp2002 <- gadm@data$uemp2001 + (gadm@data$uemp2001 * 0.10) 
gadm@data$uemp2003 <- gadm@data$uemp2002 + (gadm@data$uemp2002 * 0.10) 
gadm@data$uemp2004 <- gadm@data$uemp2003 + (gadm@data$uemp2003 * 0.10) 
gadm@data$uemp2005 <- gadm@data$uemp2004 + (gadm@data$uemp2004 * 0.10) 

# Convertir en factores con niveles definidos
for( i in c("uemp2000","uemp2001","uemp2002","uemp2003","uemp2004","uemp2005") ) {
  gadm@data[,i] <- as.factor(as.numeric(cut(gadm@data[,i], 
                             c(0,2.5,5,7.5,10,15,100)))) 
    levels(gadm@data[,i]) <- c("<2,5%", "2,5-5%", "5-7,5%",
                               "7,5-10%", "10-15%", ">15%")                          
    } 

saveHTML(
  for(i in c("uemp2000","uemp2001","uemp2002","uemp2003","uemp2004","uemp2005")) {
    sp.plot <- spplot(gadm, i, col=grey(.9), col.regions=myPalette,
                      main=paste("Desempleo en Rusia", i, sep=" - ") )
      print( sp.plot )
},img.name = "map", htmlfile = "unrus2.html")

Answer 4

Aquí está la respuesta, gracias a Oscar Perpiñán.

library(sp)
library(rgdal)
library(spacetime)
library(animation)
rus <- url("http://www.filefactory.com/file/4h1hb5c1cw7r/n/RUS_adm1_RData")
load(rus)
proj4.str <- CRS("+init=epsg:3413 +lon_0=105")
gadm.prj <- spTransform(gadm, proj4.str)
N <- nrow(gadm.prj)
pols <- geometry(gadm.prj)
nms<-gadm$NAME_1
vals1  <- read.csv2("C:\\unempl11.txt")
ord1 <- match(nms, vals1$region)
vals1 <- vals1[ord1,]

vals2 <- read.csv2("C:\\unempl12.txt")
ord2 <- match(nms, vals2$region)
vals2 <- vals2[ord2,]

nDays <- 2
tt <- seq(as.Date('2011-01-01'), by='year', length=nDays)
vals <- data.frame(unempl=rbind(vals1, vals2)[,-1])

gadmST <- STFDF(pols, time=tt, data=vals)

stplot(gadmST, animate=1, do.repeat=FALSE)

saveHTML(stplot(gadmST, animate=1, do.repeat=FALSE)
, img.name = "unemplan",  htmlfile = "unan.html")