Проблема демографического пакета с агрегированием данных - PullRequest
0 голосов
/ 17 января 2019
    # Function to construct a mortality demogdata object from HMD
hmd.mx <- function(country, username, password, label=country){
 path <- paste("https://www.mortality.org/hmd/", country, "/STATS/", "Mx_1x1.txt", sep = "")
  }
  userpwd <- paste(username, ":", password, sep = "")
  txt <- RCurl::getURL(path, userpwd = userpwd)
  con <- textConnection(txt)
  mx <- try(utils::read.table(con, skip = 2, header = TRUE, na.strings = "."),TRUE)
  close(con)
  if(class(mx)=="try-error")
    stop("Connection error at www.mortality.org. Please check username, password and country label.")

  path <- paste("https://www.mortality.org/hmd/", country, "/STATS/", "Exposures_1x1.txt", sep = "")
 userpwd <- paste(username, ":", password, sep = "")
  txt <- RCurl::getURL(path, userpwd = userpwd)
  con <- textConnection(txt)
  pop <- try(utils::read.table(con, skip = 2, header = TRUE, na.strings = "."),TRUE)
  close(con)
  if(class(pop)=="try-error")
    stop("Exposures file not found at www.mortality.org")
  obj <- list(type="mortality",label=label,lambda=0)
  obj$year <- sort(unique(mx[, 1]))
  #obj$year <- ts(obj$year, start=min(obj$year))
  n <- length(obj$year)
  m <- length(unique(mx[, 2]))
  obj$age <- mx[1:m, 2]
  obj$rate <- obj$pop <- list()
  for (i in 1:n.mort)
      { obj$rate[[i]] <- matrix(mx[, i + 2], nrow = m, ncol = n)
        obj$rate[[i]][obj$rate[[i]] < 0] <- NA
        obj$pop[[i]] <- matrix(pop[, i + 2], nrow = m, ncol = n)
        obj$pop[[i]][obj$pop[[i]] < 0] <- NA
        dimnames(obj$rate[[i]]) <- dimnames(obj$pop[[i]]) <- list(obj$age, obj$year)
       }
  names(obj$pop) = names(obj$rate) <- tolower(mnames)
  obj$age <- as.numeric(as.character(obj$age))
  if (is.na(obj$age[m])) {        
    obj$age[m] <- 2 * obj$age[m - 1] - obj$age[m - 2]            }
  return(structure(obj, class = "demogdata"))
}

Выше приведен код, который мы используем для импорта данных о населении в .

NLdata <- hmd.mx(country = "NLD",username = "username",password="password")

Это будет конкретный код для получения данных на голландском языке.

Кто-нибудь случайно не знает, как добавить несколько стран в одну и поместить эти данные в один фрейм данных (в том же формате, что и загружаемые нами пакеты демографических данных)? Так, например, показатели смертности для (Нидерланды + Франция + Норвегия) / 3 в одном пакете.

Object format that we would like

1 Ответ

0 голосов
/ 17 января 2019

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

C1 <- data.frame(Year = 1980:2018, value1 = rnorm(39), value2 = rnorm(39), Cat =rbinom(39,1,0.5), Country = "France")
C2 <- data.frame(Year = 1980:2018, value1 = rnorm(39), value2 = rnorm(39), Cat =rbinom(39,1,0.5),Country = "England")
C3 <- data.frame(Year = 1970:2018, value1 = rnorm(49), value2 = rnorm(49), Cat =rbinom(49,1,0.5),Country = "Netherlands")

C1 <- split(C1, C1$Cat)
C2 <- split(C2, C2$Cat)
C3 <- split(C3, C3$Cat)


list_all <- list(rbind(C1[[1]],C2[[1]],C3[[1]]),rbind(C1[[2]],C2[[2]],C3[[2]]))


Final_list <- lapply(list_all, function(x) x  %>% group_by(Year) %>% summarise(Val1 = mean(value1), Val2 = mean(value2), Country = "All") %>% as.data.frame)
...