анимированная карта в 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 Edit: что не так с кодом?
whuber

Поскольку ваш пример не воспроизводим, его трудно устранить. Несколько вещей выпадают 1) вы применяете пространственное преобразование в цикле, поэтому вы делаете это многократно 2) вы создаете объект с именем "try", который также является функцией R 3) вы можете перебирать реальные имена столбцов, т.е. ., для (я в 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" определяет функцию построения, которую вы хотите передать анимации. Как вы можете видеть в приведенном ниже коде, я использовал цикл for для построения каждого имитируемого столбца.

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

Я отредактировал пост, чтобы предоставить более релевантный пример на основе столбцов многоугольника.


Спасибо, однако, это первое, что я на самом деле сделал, начав исследовать этот вопрос, однако он не дал мне результата, так как я не мог понять, какое выражение должно быть в качестве аргумента.
Рувин Рафаилов

О, я думаю, что это уместно, постараюсь оптимизировать для моих нужд, как только закончу с подготовкой данных. Большое спасибо, как только это сработает, я приму ответ. И сразу возникает вопрос: можно ли здесь использовать spplot вместо plot, разве вы не пробовали?
Рувин Рафаилов

Я отредактировал основной вопрос, чтобы показать мои идеи относительно вашего кода, но я уверен, что допустил ряд ошибок, поскольку он не работает должным образом. Вы можете помочь с этим?
Рувин Рафаилов

7

Анимация, которую вы связали (ниже), представляет собой анимированное GIF-изображение .

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

По сути, это серия изображений, которые циклически повторяются, что создает эффект анимации. Думайте об этом, как о просмотре серии слайдов, по одной каждую секунду или около того.

Что вам нужно сделать, чтобы создать анимацию:

1) Создайте каждый отдельный «кадр», который будет показан.

2) Создайте сам GIF. Есть несколько сайтов, которые сделают это для вас:

http://www.createagif.net/

http://makeagif.com/

Большинство из этих сайтов позволят вам контролировать размер и скорость анимации.

Вопрос StackOverflow, на который вы ссылаетесь, должен предоставить вам все, что вам нужно знать для выполнения этой задачи в R. Обратите внимание, что сначала вам нужно установить сторонний пакет.

РЕДАКТИРОВАТЬ : Ниже приведена обновленная версия кода по ссылке выше 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.