国家自然科学基金结题项目简介&全文下载

想从科学基金共享服务网找点相关的材料看一下。该网站下载的全文是swf而非pdf格式，需要的话还得用虚拟打印机转换成pdf。检索出来的条目比较多，一个个手动下载比较繁琐（重命名是一项），遂写了一个R函数解决。函数只需要每个基金的pid号和目标文件夹的名字2个参数便可下载该项目的基本情况介绍和全文swf，如果不提供全文则会提示“#---该结题报告全文暂时尚未公开！”。

#' Title 
#'
#' @param pid 
#' @param dir_nam 
#'
#' @return
#' @export
#'
#' @examples
#' pid <- c("79670003", "30371054", "50608020")
#' pid %>% lapply(function(i) grant_ex(i, dir_nam="intro"))

grant_ex <- function(pid, dir_nam) {
  library(rvest)
  library(tidyverse)
  # intro
  url <- paste0("http://npd.nsfc.gov.cn/projectDetail.action?pid=", pid) %>% read_html
  content <- url %>% html_nodes(".jben") %>% html_text
  auth <- content %>% str_extract("项目负责人.*") %>% .[!is.na(.)] %>% str_replace("项目负责人", "")
  year <- content %>% str_extract("研究期限.*") %>% .[!is.na(.)] %>% str_extract_all("\\d{4}") %>% 
    unlist %>% .[2]
  titl <- url %>% html_nodes(".title") %>% html_text
  titl <- paste(auth, year, titl, sep = " - ")
  if (!dir.exists(paste0("./output/", dir_nam, "/"))) 
    dir.create(paste0("./output/", dir_nam))
  write(content, file = paste0(paste0("./output/", dir_nam, "/"), titl, ".txt"))
  # swf
  url <- paste0("http://npd.nsfc.gov.cn/projectDetail!showPDF.action?code=", pid, "&pid=", year)
  id <- url %>% readLines %>% str_extract_all("resource.*swf") %>% unlist %>% .[nchar(.) > 1] %>% .[1]
  if (is.na(id)) {
    cat("#---该结题报告(", pid, ")全文暂时尚未公开！\n")
  } else {
    download.file(paste0("http://npd.nsfc.gov.cn/", id), destfile = paste0("./output/", dir_nam, 
                                                                           "/", paste0(titl, ".swf")), mode = "wb")
    cat("#---", paste0("./output/", dir_nam, "/", paste0(titl, ".swf")), pid, "downloaded! \n")
  }
}