แผนที่ภาพเคลื่อนไหวใน R

ทุกคนขอโทษที่รบกวน แต่ฉันค่อนข้างใหม่กับ r ต้องเผชิญกับ difficuty สำคัญ: ฉันต้องการสร้างแผนที่เคลื่อนไหวของ Russin กับการเปลี่ยนแปลงในการว่างงานกับปีที่แตกต่างเช่น ในภาพคุณสามารถดูข้อมูลเป็นเวลาหนึ่งปี

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

ผลลัพธ์ที่ฉันยินดีที่จะได้รับคือภาพเคลื่อนไหวที่นี่: http://spatial.ly/2011/02/mapping-londons-population-change-2011-2030/ อย่างไรก็ตามฉันไปมากอ่านเนื้อหามากมาย ในhttp://stackoverflow.comรวมถึงสิ่งต่อไปนี้: การสร้างภาพยนตร์จากซีรี่ส์ของเรื่องใน Rแต่ไม่สามารถทำสิ่งที่ถูกต้องได้

ขอบคุณล่วงหน้า!

ฉันเคยคิดแบบนี้ทุกคนช่วยบอกฉันทีว่ามีความผิดพลาดอยู่ที่ไหน:

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

นี่คือข้อมูลเพื่อให้สามารถทำซ้ำรหัสได้

นี่คือเท่าที่ฉันไป คุณควรจะสามารถคิดออกตามรหัสนี้ อีกครั้งเนื่องจากปัญหาของคุณไม่สามารถทำซ้ำได้ฉันต้องสร้างข้อมูลจำลองเพื่อแสดงวิธีแก้ปัญหา สิ่งหนึ่งที่แปลกประหลาดในการใช้ spplot ก็คือเนื่องจากมันใช้ lattice เพื่อสร้างพล็อตที่คุณต้องสร้างวัตถุแล้วพิมพ์วัตถุ มิฉะนั้นคุณจะไม่ได้รับพล็อต

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

ลองดูแพ็คเกจภาพเคลื่อนไหว หนึ่งในฟังก์ชั่นที่ควรค่าแก่การสำรวจซึ่งไม่ต้องการซอฟต์แวร์บุคคลที่สามคือ "saveHTML"

การใช้ฟังก์ชั่น "saveHTML" ในแพคเกจแอนิเมชันนั้นตรงไปตรงมามาก นี่คือตัวอย่างรหัสที่ฉันสร้างภาพเคลื่อนไหวของการเปลี่ยนแปลงประชากรแบบสุ่ม อาร์กิวเมนต์ "expr" กำหนดฟังก์ชั่นการพล็อตที่คุณต้องการส่งผ่านไปยังแอนิเมชั่น อย่างที่คุณเห็นในรหัสด้านล่างฉันใช้สำหรับวนรอบเพื่อพล็อตคอลัมน์จำลองแต่ละอัน

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

ฉันแก้ไขโพสต์เพื่อให้ตัวอย่างที่เกี่ยวข้องมากขึ้นตามคอลัมน์รูปหลายเหลี่ยม

ภาพเคลื่อนไหวที่คุณเชื่อมโยง (ด้านล่าง) เป็นภาพเคลื่อนไหวภาพ GIF

มันเป็นชุดของภาพที่ขี่จักรยานผ่านซึ่งสร้างผลภาพเคลื่อนไหว ลองคิดดูเช่นคลิกผ่านชุดสไลด์หนึ่งภาพทุกวินาทีหรือมากกว่านั้น

สิ่งที่คุณต้องทำเพื่อสร้างภาพเคลื่อนไหวคือ:

1) สร้าง 'เฟรม' ของแต่ละบุคคลที่จะแสดง

2) สร้าง GIF เอง มีหลายเว็บไซต์ที่จะทำสิ่งนี้เพื่อคุณ:

http://www.createagif.net/

http://makeagif.com/

เว็บไซต์เหล่านี้ส่วนใหญ่จะอนุญาตให้คุณควบคุมขนาดและความเร็วของภาพเคลื่อนไหว

คำถาม StackOverflow คุณเชื่อมโยงไปยังควรให้คุณมีทุกอย่างที่คุณจำเป็นต้องรู้เพื่อการดำเนินการนี้ในอาร์ขอให้สังเกตว่าคุณต้องติดตั้งแพคเกจของบุคคลที่ 3 เป็นครั้งแรก

แก้ไข : ด้านล่างเป็นรุ่นที่ปรับปรุงแล้วของรหัสจากลิงก์ StackOverflow ด้านบนเนื่องจากดูเหมือนว่าจะมีความสับสนเล็กน้อย

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

รหัสด้านบนนี้ใช้เวลาแต่ละแปลงที่คุณสร้างใน R และแปลงเป็นภาพเคลื่อนไหวโดยวนซ้ำแต่ละภาพและใช้ImageMagickซึ่งคุณต้องติดตั้ง

นี่คือคำตอบขอบคุณ 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")