mappa animata in R


9

a tutti, scusate il disturbo, ma sono abbastanza nuovo con una difficoltà cruciale: voglio creare una mappa animata dei russi con cambiamenti nella disoccupazione con anni diversi, come. Nell'immagine puoi vedere i dati per un annoinserisci qui la descrizione dell'immagine

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

Il risultato, che voglio ottenere è qualcosa di simile all'animazione qui: http://spatial.ly/2011/02/mapping-londons-population-change-2011-2030/ Tuttavia, ho cercato su Google molto, ho letto un numero di temi in http://stackoverflow.com incluso quanto segue: Creazione di un film da una serie di trame in R , ma non è ancora possibile fare la cosa giusta.

Grazie in anticipo!

Ho escogitato qualcosa del genere, qualcuno può dirmi dov'è l'errore:

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

Ecco i dati per poter riprodurre il codice


Ri La modifica: cosa non va nel codice?
whuber

Poiché il tuo esempio non è riproducibile, è difficile risolvere i problemi. Alcune cose saltano fuori 1) stai applicando una trasformazione spaziale in un ciclo, quindi lo stai facendo ripetutamente 2) stai creando un oggetto chiamato "try" che è anche una funzione R 3) potresti iterare attraverso nomi di colonne effettivi ., per (i in c ("Var1", "Var2")) il modo in cui lo hai attualmente codificato è molto contorto 4) la tua chiamata a spplot non è corretta, stai passando un vettore senza senso.
Jeffrey Evans,

Mi dispiace davvero per essere una tale non comprensione, ma questa è la mia prima vera esperienza con R, ho aggiunto i dati nella domanda principale, se non ti disturba puoi suggerire modi di miglioramento come davvero correva idee
Ruvin Rafailov il

Risposte:


4

Questo per quanto mi riguarda. Dovresti essere in grado di capirlo in base a questo codice. Ancora una volta, poiché il tuo problema non è riproducibile, ho dovuto creare dati fittizi per illustrare la soluzione. Un aspetto strano nell'uso di spplot è che, poiché utilizza il reticolo per creare la trama, è necessario creare un oggetto e quindi stampare l'oggetto. Altrimenti non si ottiene 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")

Grazie! Ci proverò immediatamente. Solo una domanda gadm @ data $ uemp2001 <- gadm @ data $ uemp2000 + (gadm @ data $ uemp2000 * 0.10) posso caricare qui i dati txt anziché i dati casuali, non verrà eseguita alcuna risoluzione dei problemi?
Ruvin Rafailov,

Sì, quel codice è appena associato alla creazione di dati di esempio. Vorresti usare i tuoi dati.
Jeffrey Evans,

9

Dai un'occhiata al pacchetto di animazione . Una delle funzioni che vale la pena esplorare, che non richiede software di terze parti, è "saveHTML".

L'uso della funzione "saveHTML" nel pacchetto di animazione è molto semplice. Ecco un esempio di codice in cui creo un'animazione di un cambio di popolazione randomizzato. L'argomento "expr" definisce la funzione di disegno che si desidera passare all'animazione. Come puoi vedere nel codice seguente ho usato un ciclo for per tracciare ogni colonna simulata.

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

Ho modificato il post per fornire un esempio più pertinente basato su colonne poligonali.


Grazie, tuttavia, questa è la prima cosa che ho effettivamente fatto, iniziando a esplorare questa domanda, tuttavia non mi ha dato il risultato in quanto non riuscivo a capire quale espressione dovesse essere come argomento.
Ruvin Rafailov,

Oh, penso che sia appropriato, cercherò di ottimizzare per le mie esigenze non appena finito con la preparazione dei dati. Grazie mille, non appena funzionerà accetterò una risposta. E solo la domanda che sorge immediatamente: è possibile usare spplot qui invece della trama, non hai provato?
Ruvin Rafailov,

Ho modificato la domanda principale per mostrare le mie idee sul tuo codice, ma sono sicuro di aver commesso numerosi errori in quanto non funziona correttamente. Potete aiutarmi con questo?
Ruvin Rafailov,

7

L'animazione che hai collegato (sotto) è un'immagine GIF animata .

inserisci qui la descrizione dell'immagine

È essenzialmente una serie di immagini che vengono ciclicate, creando l'effetto di animazione. Pensa a come fare clic su una serie di diapositive, una al secondo circa.

Quello che devi fare per creare l'animazione è:

1) Crea ogni singolo "frame" che verrà mostrato.

2) Crea la GIF stessa. Esistono diversi siti Web che lo faranno per te:

http://www.createagif.net/

http://makeagif.com/

La maggior parte di questi siti Web ti consentirà di controllare le dimensioni e la velocità dell'animazione.

La domanda StackOverflow a cui ti sei collegato dovrebbe fornirti tutto ciò che devi sapere per eseguire questa attività in R. Nota che devi prima installare un pacchetto di terze parti.

EDIT : Di seguito è riportata una versione aggiornata del codice dal link StackOverflow sopra poiché sembra esserci un po 'di confusione.

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

Questo codice sopra prende ciascuno dei singoli grafici che hai creato in R e li converte in un'animazione eseguendo il ciclo su ciascuno di essi e usando ImageMagick , che devi aver installato.


Grazie, ma sono un tipo che ha bisogno di animazioni da realizzare all'interno di R senza altri siti Web e non capisco davvero come funzioni questo codice e questa idea su stockoverflow, altrimenti non lo farei nemmeno
Ruvin Rafailov il

Penso che la risposta dello scambio di stack possa essere un po 'confusa perché la risposta ha spezzato il codice con un blocco di testo. Modificherò la mia risposta con una versione aggiornata di quel codice.
Radar,

Grazie per l'aggiornamento, ma ci sono ancora numerosi problemi, che possono essere stupidi e facili, ma sfortunatamente non ho esperienza con la loro gestione. Se non ti dispiace ti chiederò: 1) Cosa significa jpeg (...) in questo codice? dato che Rstudio dà un errore di impossibile aprire il file 2) Rstudio racconta della non esistenza della funzione my.plot, sebbene tutto ciò che è stato immaginato qui sia installato. Potrei essere io a operare in modo errato, se puoi, per favore, dare qualche consiglio. Grazie in anticipo.
Ruvin Rafailov,

2

Ecco la risposta, grazie 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")

Ooh, mi piace l'uso della libreria dello spaziotempo!
Jeffrey Evans,
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.