peta animasi di R

9

semua orang, maaf untuk gangguan, tetapi saya menjadi cukup baru dengan r menghadapi kesulitan penting: saya ingin membuat peta animasi Russin dengan perubahan pengangguran dengan tahun-tahun yang berbeda, seperti. Pada gambar Anda dapat melihat data selama satu tahunmasukkan deskripsi gambar di sini

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

Hasilnya, yang saya ingin dapatkan adalah sesuatu seperti animasi di sini: http://spatial.ly/2011/02/mapping-londons-population-change-2011-2030/ Namun, saya sering googled, membaca sejumlah tema di http://stackoverflow.com termasuk yang berikut: Membuat Film dari Seri Plot di R , tetapi tidak bisa melakukan hal yang benar.

Terima kasih sebelumnya!

Saya sudah datang dengan sesuatu seperti ini, bisa ada yang bilang di mana kesalahannya:

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

Berikut adalah data untuk dapat mereproduksi kode

Ruvin Rafailov
sumber
Re Sunting: apa yang salah dengan kode?
whuber
Karena contoh Anda tidak dapat direproduksi, sulit untuk memecahkan masalah. Beberapa hal melompat keluar 1) Anda menerapkan transformasi spasial dalam satu lingkaran, sehingga Anda melakukannya berulang kali 2) Anda membuat objek yang disebut "coba" yang juga merupakan fungsi R 3) Anda bisa beralih melalui nama kolom aktual yaitu ., untuk (i in c ("Var1", "Var2")) cara Anda saat ini berkode sangat berbelit-belit 4) panggilan Anda ke spplot tidak benar, Anda memberikannya vektor omong kosong.
Jeffrey Evans
Saya benar-benar minta maaf karena tidak mengerti, tetapi ini adalah pengalaman nyata pertama saya dengan R, saya telah menambahkan data dalam pertanyaan utama, jika itu tidak mengganggu Anda dapatkah Anda menyarankan cara untuk perbaikan karena saya benar-benar berlari ide
Ruvin Rafailov

Jawaban:

4

Sejauh ini yang saya lakukan. Anda harus bisa mengetahuinya berdasarkan kode ini. Sekali lagi, karena masalah Anda tidak dapat diulang, saya harus membuat data tiruan untuk menggambarkan solusinya. Salah satu aspek aneh dalam menggunakan spplot adalah karena menggunakan kisi untuk membuat plot Anda perlu membuat objek dan kemudian mencetak objek. Kalau tidak, Anda tidak akan mendapatkan plot.

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")
Jeffrey Evans
sumber
Terima kasih! Saya akan segera mencobanya. Hanya satu pertanyaan gadm @ data $ uemp2001 <- gadm @ data $ uemp2000 + (gadm @ data $ uemp2000 * 0.10) dapatkah saya memuat data txt alih-alih diberikan secara acak, tidak ada pemecahan masalah yang terjadi?
Ruvin Rafailov
Ya, kode itu hanya dikaitkan dengan membuat contoh data. Anda ingin menggunakan data Anda sendiri.
Jeffrey Evans
9

Lihatlah paket animasi . Salah satu fungsi yang perlu ditelusuri, yang tidak memerlukan perangkat lunak pihak ketiga, adalah "saveHTML".

Menggunakan fungsi "saveHTML" dalam paket animasi sangat mudah. Berikut adalah contoh kode tempat saya membuat animasi perubahan populasi secara acak. Argumen "expr" mendefinisikan fungsi merencanakan yang ingin Anda sampaikan ke animasi. Seperti yang Anda lihat dalam kode di bawah ini saya menggunakan loop for untuk memplot setiap kolom yang disimulasikan.

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

Saya mengedit posting untuk memberikan contoh yang lebih relevan berdasarkan kolom poligon.

Jeffrey Evans
sumber
Terima kasih, Namun, Ini adalah hal pertama yang sebenarnya saya lakukan, mulai mengeksplorasi pertanyaan ini, namun itu tidak memberi saya hasilnya karena saya tidak dapat memahami ungkapan mana yang harus dijadikan argumen.
Ruvin Rafailov
Oh, saya pikir itu tepat, akan mencoba mengoptimalkan untuk kebutuhan saya segera setelah selesai dengan persiapan data. Terima kasih banyak, segera setelah berfungsi saya akan menerima jawaban. Dan hanya pertanyaan yang langsung muncul: apakah mungkin menggunakan spplot di sini sebagai ganti plot, bukankah Anda sudah mencoba?
Ruvin Rafailov
Saya telah mengedit pertanyaan utama untuk menunjukkan ide-ide saya mengenai kode Anda, tetapi saya yakin saya membuat sejumlah kesalahan karena tidak berfungsi dengan baik. Bisakah Anda membantu dengan ini?
Ruvin Rafailov
7

Animasi yang Anda tautkan (di bawah) adalah gambar GIF animasi .

masukkan deskripsi gambar di sini

Ini pada dasarnya adalah serangkaian gambar yang didaur ulang, yang menciptakan efek animasi. Pikirkan itu seperti mengklik serangkaian slide, satu setiap detik atau lebih.

Yang perlu Anda lakukan untuk membuat animasi adalah:

1) Buat 'bingkai' masing-masing individu yang akan ditampilkan.

2) Buat GIF itu sendiri. Ada beberapa situs web yang akan melakukan ini untuk Anda:

http://www.createagif.net/

http://makeagif.com/

Sebagian besar situs web ini akan memungkinkan Anda untuk mengontrol ukuran dan kecepatan animasi.

Pertanyaan StackOverflow yang Anda tautkan harus memberi Anda semua yang perlu Anda ketahui untuk melakukan tugas ini di R. Perhatikan bahwa Anda harus menginstal paket pihak ke-3 terlebih dahulu.

EDIT : Di bawah ini adalah versi terbaru dari kode dari tautan StackOverflow di atas karena sepertinya ada sedikit kebingungan.

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

Kode di atas mengambil masing-masing plot yang Anda buat di R dan mengubahnya menjadi animasi dengan mengulangi masing-masing dan menggunakan ImageMagick , yang harus Anda instal.

Radar
sumber
Terima kasih, tapi saya semacam perlu animasi untuk dilakukan di dalam R tanpa situs web lain dan saya benar-benar tidak mengerti bagaimana kode dan ide ini bekerja di stockoverflow, kalau tidak saya tidak akan bertanya
Ruvin Rafailov
Saya pikir jawaban pertukaran stack mungkin agak membingungkan karena jawabannya memecahkan kode terpisah dengan blok teks. Saya akan mengedit jawaban saya dengan versi terbaru dari kode itu.
Radar
Terima kasih telah memperbarui, tetapi masih ada sejumlah masalah, yang mungkin bodoh dan mudah, tetapi sayangnya saya tidak memiliki pengalaman dalam mengelola mereka. Jika Anda tidak keberatan, saya akan bertanya: 1) Apa artinya jpeg (...) dalam kode ini? karena Rstudio memberikan kesalahan karena tidak dapat membuka file 2) Rstudio bercerita tentang tidak adanya fungsi my.plot, meskipun semua yang ada di sini terinstal. Mungkin saya yang beroperasi secara salah, jika Anda dapat memberikan nasihat. Terima kasih sebelumnya.
Ruvin Rafailov
2

Inilah jawabannya, terima kasih kepada 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")
Ruvin Rafailov
sumber
Ooh, saya suka menggunakan perpustakaan ruangwaktu!
Jeffrey Evans