animowana mapa w R.


9

wszystkim przepraszam, że przeszkadzam, ale jestem całkiem nowy, ponieważ stanąłem przed kluczową trudnością: chcę stworzyć animowaną mapę Russina ze zmianami bezrobocia w różnych latach. Na zdjęciu widać dane z jednego rokuwprowadź opis zdjęcia tutaj

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

Rezultat, który chcę uzyskać, przypomina coś w rodzaju animacji tutaj: http://spatial.ly/2011/02/mapping-londons-population-change-2011-2030/ Jednak często googlowałem, czytałem wiele tematów w http://stackoverflow.com, w tym: Tworzenie filmu z serii fabuł w R , ale nadal nie można zrobić właściwej rzeczy.

z góry dziękuję!

Wymyśliłem coś takiego: czy ktoś może mi powiedzieć, gdzie jest błąd:

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

Oto dane umożliwiające odtworzenie kodu


Re Edycja: co jest nie tak z kodem?
whuber

Ponieważ twój przykład nie jest powtarzalny, trudno jest go rozwiązać. Wyskakuje kilka rzeczy 1) stosujesz transformację przestrzenną w pętli, więc robisz to wielokrotnie 2) tworzysz obiekt o nazwie „try”, który jest również funkcją R 3) możesz iterować po rzeczywistych nazwach kolumn tj. ., dla (i in c („Var1”, „Var2”)) sposób, w jaki obecnie go kodujesz, jest bardzo skomplikowany 4) twoje wezwanie do spplotu jest nieprawidłowe, przekazujesz mu nonsensowny wektor.
Jeffrey Evans,

Naprawdę przepraszam, że jestem taki niezrozumiały, ale to moje pierwsze prawdziwe doświadczenie z R, dodałem dane w głównym pytaniu, jeśli nie będzie ci to przeszkadzać, możesz zasugerować sposoby poprawy, ponieważ naprawdę natrafiłem na pomysły
Ruvin Rafailov,

Odpowiedzi:


4

To jest tak daleko, jak tylko mogę. Powinieneś być w stanie to rozgryźć na podstawie tego kodu. Ponownie, ponieważ twój problem nie jest powtarzalny, musiałem stworzyć fikcyjne dane, aby zilustrować rozwiązanie. Jednym z dziwnych aspektów korzystania ze spplotu jest to, że ponieważ używa on siatki do utworzenia wykresu, musisz utworzyć obiekt, a następnie wydrukować obiekt. W przeciwnym razie nie otrzymasz fabuły.

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

Dziękuję Ci! Spróbuję natychmiast. Tylko jedno pytanie gadm @ data $ uemp2001 <- gadm @ data $ uemp2000 + (gadm @ data $ uemp2000 * 0.10) czy mogę tutaj załadować dane txt zamiast podanego losowo, nie będzie żadnego rozwiązywania problemów?
Ruvin Rafailov,

Tak, ten kod jest tylko powiązany z tworzeniem przykładowych danych. Chciałbyś użyć własnych danych.
Jeffrey Evans,

9

Spójrz na pakiet animacji . Jedną z funkcji wartych poznania, która nie wymaga oprogramowania innych firm, jest „saveHTML”.

Korzystanie z funkcji „saveHTML” w pakiecie animacji jest bardzo proste. Oto przykładowy kod, w którym tworzę animację losowej zmiany populacji. Argument „expr” definiuje funkcję drukowania, którą chcesz przekazać do animacji. Jak widać w poniższym kodzie, użyłem pętli for do wykreślenia każdej symulowanej kolumny.

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

Zredagowałem post, aby podać bardziej odpowiedni przykład oparty na kolumnach wielokąta.


Dziękuję, jednak, to pierwsza rzecz, którą faktycznie zrobiłem, zaczynając badać to pytanie, jednak nie dało mi to rezultatu, ponieważ nie mogłem zrozumieć, które wyrażenie powinno być argumentem.
Ruvin Rafailov

Och, myślę, że jest to właściwe, postaram się zoptymalizować pod kątem moich potrzeb, jak tylko zakończymy przygotowywanie danych. Dziękuję bardzo, jak tylko zadziała, przyjmuję odpowiedź. I tylko pytanie, które pojawia się natychmiast: czy można tu użyć spplotu zamiast fabuły, nie próbowałeś?
Ruvin Rafailov

Zredagowałem główne pytanie, aby pokazać moje pomysły dotyczące twojego kodu, ale jestem pewien, że popełniłem wiele błędów, ponieważ nie działa on poprawnie. Czy możesz w tym pomóc?
Ruvin Rafailov

7

Animacja, którą połączyłeś (poniżej), jest animowanym obrazem GIF .

wprowadź opis zdjęcia tutaj

Zasadniczo jest to seria obrazów, które są cyklicznie przewijane, co tworzy efekt animacji. Pomyśl o tym, jak klikanie serii slajdów, co sekundę lub mniej więcej.

Aby utworzyć animację, musisz:

1) Utwórz każdą „ramkę”, która będzie wyświetlana.

2) Utwórz sam GIF. Istnieje kilka stron internetowych, które zrobią to za Ciebie:

http://www.createagif.net/

http://makeagif.com/

Większość tych stron pozwala kontrolować rozmiar i szybkość animacji.

StackOverflow pytanie ty związana powinien zapewnić Ci wszystko, co musisz wiedzieć, aby wykonać to zadanie w R. Zauważ, że należy najpierw zainstalować 3rd paczka party.

EDYCJA : Poniżej znajduje się zaktualizowana wersja kodu z linku StackOverflow powyżej, ponieważ wydaje się, że jest trochę zamieszania.

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

Powyższy kod pobiera poszczególne wykresy utworzone w R i przekształca je w animację, zapętlając każdy z nich i używając programu ImageMagick , który musisz zainstalować.


Dziękuję, ale jestem pewien, że potrzebuję animacji do wykonania wewnątrz R bez innych stron internetowych i naprawdę nie rozumiem, jak działa ten kod i pomysł przy przepływie zapasów, w przeciwnym razie nawet nie zapytałbym
Ruvin Rafailov

Myślę, że odpowiedź wymiany stosu może być nieco myląca, ponieważ odpowiedź rozdzieliła kod blokiem tekstu. Zmienię swoją odpowiedź za pomocą zaktualizowanej wersji tego kodu.
Radar

Dzięki za aktualizację, ale wciąż istnieje wiele problemów, które mogą być głupie i łatwe, ale niestety nie mam doświadczenia w zarządzaniu nimi. Jeśli nie masz nic przeciwko, zapytam: 1) Co oznacza jpeg (...) w tym kodzie? ponieważ Rstudio popełnia błąd polegający na tym, że nie może otworzyć pliku 2) Rstudio mówi o nieistnieniu funkcji my.plot, chociaż wszystko, co tu wymyślono, jest zainstalowane. Może to ja źle działam, jeśli możesz udzielić porady. Z góry dziękuję.
Ruvin Rafailov

2

Oto odpowiedź, dzięki Oscarowi Perpiñánowi.

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, podoba mi się korzystanie z biblioteki czasoprzestrzeni!
Jeffrey Evans,
Korzystając z naszej strony potwierdzasz, że przeczytałeś(-aś) i rozumiesz nasze zasady używania plików cookie i zasady ochrony prywatności.
Licensed under cc by-sa 3.0 with attribution required.