0 
    # 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 合一的死亡率。

我们想要的对象格式

4

1 回答 1

0

You can try this code. However I could not run your demography package. So you might need to edit the code a bit. Perhaps someone else can fill in the second part? I saw that no one has reacted yet. 

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)
于 2019-01-17T14:54:37.993 回答