基于R软件XML包的NSFC资助项目查询脚本笔记

国家自然基金委网站提供基金项目资助的项目检索功能，但需要提交字段较多，且有验证码，不太适合网页抓取。

Medsci和LetPub两个科研服务网站提供了免费的查询功能，也有更高级收费分析服务，无钱只能白嫖的我更倾心LetPub，LetPub可选择多个字段，也无需登陆，get方式传递参数。（2020年7月更新，letpub现在已经改成了post参数传递，且提供Excel下载，非常方便了）

获取2015年以来生态学/植物学经费资助比较大的项目以了解前言进展，以下为代码笔记

###以下为网页读取测试##
url = "http://www.sciencenet.cn/"
p1 <- readLines(url,encoding="UTF-8")
library(RCurl)
p1 <- getURL(url = url)
r1 <- grep("题目.+td>",p1,value = TRUE)


##利用XML包读取letpub网站上提供的基金检索信息###
##信息来源https://www.letpub.com.cn/##
library(XML)
### 生态学重点项目##
remove(list = ls())
url1 <- c("http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=&money2=&subcategory=%E9%87%8D%E7%82%B9%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C03&addcomment_s3=&addcomment_s4=&currentpage=1#fundlisttable",
        "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=&money2=&subcategory=%E9%87%8D%E7%82%B9%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C03&addcomment_s3=&addcomment_s4=&currentpage=2#fundlisttable",
        "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=&money2=&subcategory=%E9%87%8D%E7%82%B9%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C03&addcomment_s3=&addcomment_s4=&currentpage=3#fundlisttable"
         );
###植物学重点项目###
url2 <- c("http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=&money2=&subcategory=%E9%87%8D%E7%82%B9%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C02&addcomment_s3=&addcomment_s4=&currentpage=1#fundlisttable",
          "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=&money2=&subcategory=%E9%87%8D%E7%82%B9%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C02&addcomment_s3=&addcomment_s4=&currentpage=2#fundlisttable",
          "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=&money2=&subcategory=%E9%87%8D%E7%82%B9%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C02&addcomment_s3=&addcomment_s4=&currentpage=3#fundlisttable")

###生态学无重大项目###

###植物学重大项目###
url3 <- c("http://www.letpub.com.cn/?page=grant&name=&person=&no=&company=&addcomment_s1=C&addcomment_s2=C02&addcomment_s3=&addcomment_s4=&money1=&money2=&startTime=2015&endTime=2019&subcategory=%E9%87%8D%E5%A4%A7%E9%A1%B9%E7%9B%AE&searchsubmit=true&submit.x=62&submit.y=18#fundlisttable")

####生态学 2015年以来的经费大于100万的国际（地区）合作与交流项目###
url4 <- c("http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=100&money2=500&subcategory=%E5%9B%BD%E9%99%85%EF%BC%88%E5%9C%B0%E5%8C%BA%EF%BC%89%E5%90%88%E4%BD%9C%E4%B8%8E%E4%BA%A4%E6%B5%81%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C03&addcomment_s3=&addcomment_s4=&currentpage=1#fundlisttable",
          "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=100&money2=500&subcategory=%E5%9B%BD%E9%99%85%EF%BC%88%E5%9C%B0%E5%8C%BA%EF%BC%89%E5%90%88%E4%BD%9C%E4%B8%8E%E4%BA%A4%E6%B5%81%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C03&addcomment_s3=&addcomment_s4=&currentpage=2#fundlisttable",
          "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=100&money2=500&subcategory=%E5%9B%BD%E9%99%85%EF%BC%88%E5%9C%B0%E5%8C%BA%EF%BC%89%E5%90%88%E4%BD%9C%E4%B8%8E%E4%BA%A4%E6%B5%81%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C03&addcomment_s3=&addcomment_s4=&currentpage=3#fundlisttable"
          )

###2015年以来的经费大于100万的植物学国际（地区）合作与交流项目###
url5 <- c("http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=100&money2=500&subcategory=%E5%9B%BD%E9%99%85%EF%BC%88%E5%9C%B0%E5%8C%BA%EF%BC%89%E5%90%88%E4%BD%9C%E4%B8%8E%E4%BA%A4%E6%B5%81%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C02&addcomment_s3=&addcomment_s4=&currentpage=1#fundlisttable",
          "http://www.letpub.com.cn/index.php?page=grant&name=&person=&no=&company=&startTime=2015&endTime=2019&money1=100&money2=500&subcategory=%E5%9B%BD%E9%99%85%EF%BC%88%E5%9C%B0%E5%8C%BA%EF%BC%89%E5%90%88%E4%BD%9C%E4%B8%8E%E4%BA%A4%E6%B5%81%E9%A1%B9%E7%9B%AE&addcomment_s1=C&addcomment_s2=C02&addcomment_s3=&addcomment_s4=&currentpage=2#fundlisttable"
          )


###以下为通用代码，修改url向量名及文件名res即可###
url <- url5
titles <- c()
info <- data.frame()
for (u in url) {
  tbl <-readHTMLTable(u,stringsAsFactors = FALSE, which=4)
  titles <- c(titles,c(tbl[tbl$V1=="题目",]$V2))
  info <- rbind(info,tbl[!is.na(tbl$V7),][-1,])
    
}
res <- cbind(info,titles)
write.csv(res,file="res.csv")

 由于博客园网站目前不允许上传pdf附件，整理汇总结果见附件ZIP

数据抓取日期：2019-12-6