mapa animado en R


9

todos, disculpen las molestias, pero estoy siendo bastante nuevo con r enfrentado una dificultad crucial: quiero crear un mapa animado de Russin con cambios en el desempleo con diferentes años, como. En la imagen puedes ver datos de un añoingrese la descripción de la imagen aquí

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="Unemployment in Russia by region")

El resultado, que estoy dispuesto a obtener, es algo así como una animación aquí: http://spatial.ly/2011/02/mapping-londons-population-change-2011-2030/ Sin embargo, busqué mucho en Google, leí varios temas. en http://stackoverflow.com que incluye lo siguiente: Crear una película a partir de una serie de tramas en R , pero aún no podía hacer lo correcto.

¡gracias de antemano!

Se me ocurrió algo como esto, ¿alguien puede decirme dónde está el 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="Unemployment in Russia by region")
},img.name = "map", htmlfile = "unrus2.html")

Aquí hay datos para poder reproducir el código


Re La edición: ¿qué está mal con el código?
whuber

Como su ejemplo no es reproducible, es difícil solucionarlo. Algunas cosas saltan a la vista 1) está aplicando una transformación espacial en un bucle, por lo que lo está haciendo repetidamente 2) está creando un objeto llamado "try" que también es una función R 3) podría iterar a través de nombres de columnas reales, es decir ., para (i en c ("Var1", "Var2")) la forma en que lo tiene codificado actualmente es muy complicada 4) su llamada a spplot no es correcta, le está pasando un vector sin sentido.
Jeffrey Evans

Lamento mucho no comprenderlo, pero esta es mi primera experiencia real con R, agregué los datos en la pregunta principal, si no te molesta, por favor, sugiere formas de mejora, ya que realmente corrió ut de ideas
Ruvin Rafailov

Respuestas:


4

Esto es lo más lejos que puedo llegar. Debería poder resolverlo según este código. Una vez más, dado que su problema no es reproducible, tuve que crear datos ficticios para ilustrar la solución. Un aspecto extraño al usar spplot es que, dado que usa una red para crear el diagrama, necesita crear un objeto y luego imprimir el objeto. De lo contrario, no obtendrá una trama.

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

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

# Set color palette
myPalette <- brewer.pal(6,"Purples")

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

# Create dummy unployment data with 10% change in gadm object 
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) 

# Coerce into factors with defined levels
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("Unemployment in Russia", i, sep=" - ") )
      print( sp.plot )
},img.name = "map", htmlfile = "unrus2.html")

¡Gracias! Lo intentaré de inmediato. Solo una pregunta gadm @ data $ uemp2001 <- gadm @ data $ uemp2000 + (gadm @ data $ uemp2000 * 0.10) ¿puedo cargar aquí datos txt en lugar de darlos al azar, no se realizará ninguna solución de problemas?
Ruvin Rafailov

Sí, ese código solo está asociado con la creación de datos de ejemplo. Desea usar sus propios datos.
Jeffrey Evans

9

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í hay un código de ejemplo donde creo una animación de un cambio aleatorio de población. El argumento "expr" define la función de trazado que desea pasar a la animación. Como puede ver en el siguiente código, utilicé un bucle for para trazar cada columna simulada.

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

# Load your data and add random population change column
    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) 
       }

# Create HTML animation using for loop for each simulated column    
    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("Population Change",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="RandPopChange", htmlfile="SimPopChange.html",
           single.opts = "'controls': ['first', 'previous', 'play', 'next', 'last', 'loop', 'speed'], 'delayMin': 0",      
            description=c("Random population change:"))  

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


Gracias, sin embargo, esto es lo primero que hice en realidad, comenzar a explorar esta pregunta, sin embargo, no me dio el resultado ya que no podía entender qué expresión debería ser como argumento.
Ruvin Rafailov

Oh, creo que es apropiado, trataré de optimizar mis necesidades tan pronto como termine con la preparación de datos. Muchas gracias, tan pronto como funcione, aceptaré una respuesta. Y solo la pregunta que surge de inmediato: ¿es posible usar spplot aquí en lugar de plot, no lo has intentado?
Ruvin Rafailov

He editado la pregunta principal para mostrar mis ideas sobre su código, pero estoy seguro de que cometí varios errores, ya que no funciona correctamente. ¿Me puedes ayudar con esto?
Ruvin Rafailov

7

La animación que vinculó (a continuación) es una imagen GIF animada .

ingrese la descripción de la imagen aquí

Es esencialmente una serie de imágenes que se reciclan, lo que crea el efecto de animación. Piense en ello como hacer clic en una serie de diapositivas, una cada segundo más o menos.

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

1) Cree cada 'marco' individual que se mostrará.

2) Crea el GIF en sí. Hay varios sitios web que harán esto por usted:

http://www.createagif.net/

http://makeagif.com/

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

La pregunta de StackOverflow a la que se vinculó debe proporcionarle todo lo que necesita saber para realizar esta tarea en R. Tenga en cuenta que primero debe instalar un paquete de terceros.

EDITAR : a continuación se muestra 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 ha creado en R y las convierte en una animación haciendo un bucle sobre cada una y usando ImageMagick , que debe haber instalado.


Gracias, pero soy un tipo que necesita animación dentro de R sin otros sitios web y realmente no entiendo cómo funciona este código y esta idea en stockoverflow, de lo contrario, ni siquiera preguntaría
Ruvin Rafailov,

Creo que la respuesta de intercambio de pila puede ser un poco confusa porque la respuesta rompió el código con un bloque de texto. Editaré mi respuesta con una versión actualizada de ese código.
Radar

Gracias por la actualización, pero todavía hay varios problemas, que pueden ser estúpidos y fáciles, pero desafortunadamente no tengo experiencia en la administración de ellos. Si no le importa, le preguntaré: 1) ¿Qué significa jpeg (...) en este código? como Rstudio emite un error de no poder abrir el archivo 2) Rstudio informa sobre la inexistencia de la función my.plot, aunque todo lo que aquí se resuelve está instalado. Puede que sea yo quien opere incorrectamente, si puede dar algún consejo. Gracias por adelantado.
Ruvin Rafailov

2

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

¡Oh, me gusta el uso de la biblioteca de espacio-tiempo!
Jeffrey Evans
Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.