анімована карта в R


9

всім, вибачте за занепокоєння, але я вже зовсім новий, що зіткнувся з найважливішим завданням: я хочу створити анімовану карту Руссіна зі змінами безробіття з різними роками, як. На зображенні можна побачити дані за один ріквведіть тут опис зображення

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

Ось дані для відтворення коду


Re редагування: що не так з кодом?
whuber

Оскільки ваш приклад не відтворюється, його важко усунути. Кілька речей вискакують 1) ви застосовуєте просторове перетворення в циклі, тому ви робите це повторно 2) ви створюєте об'єкт під назвою "спробувати", який також є функцією R 3) ви могли б повторити через фактичні назви стовпців, тобто ., для (i in c ("Var1", "Var2")) те, що у вас зараз це закодовано, дуже перекручено 4) ваш виклик spplot невірний, ви передаєте йому безглуздий вектор.
Джефрі Еванс

Мені дуже шкода за те, що я так не розумію, але це мій перший реальний досвід роботи з R коли-небудь, я додав дані в головне питання, якщо це не буде турбувати, ви можете, будь ласка, запропонуйте шляхи вдосконалення, як я насправді виступив з ідеями
Рувін Рафаїлов

Відповіді:


4

Це наскільки я йду. Ви повинні мати змогу розібратися в цьому на основі цього коду. Ще раз, оскільки ваша проблема не відтворюється, мені довелося створити фіктивні дані, щоб проілюструвати рішення. Одним із незвичайних аспектів використання spplot є те, що оскільки він використовує ґрати для створення ділянки, вам потрібно створити об'єкт, а потім надрукувати його. Інакше у вас не виходить сюжет.

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

Дякую! Я спробую це негайно. Лише одне запитання gadm @ data $ uemp2001 <- gadm @ data $ uemp2000 + (gadm @ data $ uemp2000 * 0.10) чи можу я тут завантажувати txt дані замість заданих випадкових випадків, жодне усунення несправностей не відбудеться?
Рувін Рафаїлов

Так, цей код просто пов'язаний із створенням прикладних даних. Ви хочете використовувати власні дані.
Джефрі Еванс

9

Погляньте на анімаційний пакет. Однією з функцій, яку варто вивчити, яка не вимагає стороннього програмного забезпечення, є "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:"))  

Я відредагував публікацію, щоб надати більш релевантний приклад на основі стовпців багатокутника.


Дякую, однак, це перше, що я насправді зробив, починаючи досліджувати це питання, однак це не дало мені результату, оскільки я не міг зрозуміти, який вираз має бути аргументом.
Рувін Рафаїлов

О, я думаю, що це доречно, спробую оптимізувати для моїх потреб, як тільки закінчую підготовку даних. Дуже дякую, як тільки це працює, я прийму відповідь. І лише питання, яке виникає негайно: чи можна тут використовувати сплот замість сюжету, ви не пробували?
Рувін Рафаїлов

Я відредагував головне питання, щоб показати свої ідеї щодо вашого коду, але я впевнений, що допустив ряд помилок, оскільки він не працює належним чином. Чи можете ви допомогти у цьому?
Рувін Рафаїлов

7

Анімація, яку ви пов’язали (нижче), - це анімоване зображення GIF .

введіть тут опис зображення

По суті це цикл зображень, які проходять циклом, що створює ефект анімації. Подумайте про це як про клацання через серію слайдів один раз на секунду.

Що потрібно зробити, щоб створити анімацію, це:

1) Створіть кожен окремий 'кадр', який буде показаний.

2) Створіть сам GIF. Існує кілька веб-сайтів, які зроблять це за вас:

http://www.createagif.net/

http://makeagif.com/

Більшість із цих веб-сайтів дозволять вам контролювати розмір та швидкість анімації.

Питання StackOverflow, з яким ви пов’язані, повинно надавати вам усе, що вам потрібно знати, щоб виконати це завдання в Р. Зауважте, що вам потрібно спочатку встановити пакет сторонніх розробників.

EDIT : Нижче наведено оновлену версію коду за посиланням 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 , який ви повинні встановити.


Дякую, але я, начебто, потребую анімації, щоб робити всередині R без інших веб-сайтів, і я дійсно не розумію, як працює цей код і ідея в stockoverflow, інакше я б навіть не запитував
Рувін Рафаїлов

Я думаю, що відповідь на обмін стеком може бути дещо заплутаною, оскільки відповідь розбила код разом з текстовим блоком. Я відредагую свою відповідь оновленою версією цього коду.
Радар

Дякую за оновлення, але все ж є ряд проблем, які можуть бути дурними та простими, але, на жаль, я не маю досвіду управління ними. Якщо ви не заперечуєте, я запитаю: 1) Що означає jpeg (...) у цьому коді? оскільки Rstudio видає помилку, що не може відкрити файл 2) Rstudio розповідає про відсутність функції my.plot, хоча тут все встановлено. Можливо, це я неправильно дію, якщо ви можете, будь ласка, дати поради. Заздалегідь спасибі.
Рувін Рафаїлов

2

Ось відповідь, завдяки Оскару Перпіньяну.

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

О, мені подобається використання бібліотеки простору часу!
Джефрі Еванс
Використовуючи наш веб-сайт, ви визнаєте, що прочитали та зрозуміли наші Політику щодо файлів cookie та Політику конфіденційності.
Licensed under cc by-sa 3.0 with attribution required.