PRISMdownload.R

######################################################################################
# PROGRAM: download.prism 
# USE: BATCH DOWNLOAD AND UNCOMPRESSION OF PRISM DAILY OR MONTHLY GRIDDED DATA
#        PRISM URL: http://prism.nacse.org/
# REQUIRES: >= R 3.0, RCurl
#
# ARGUMENTS:
#     data.type             TYPE OF CLIMATE DATA ("ppt","tmin","tmax","tmean")
#     date.range            A VECTOR WITH START AND END DATA IN y/m/d FORMAT 
#     time.step             DEFINES TIMESTEP OF PRODUCT ("daily"/"monthly") 
#     download.folder       LOCAL DOWNLOAD DIRECTORY (DEFAILT IS CURRENT wd)
#     by.year               CREATES A DIRECTORY FOR EACH YEAR (TRUE/FALSE) 
#     unzip.file            UNZIP FILE ON DOWNLOAD (TRUE/FALSE)  
#     ftp.site              PRISM ftp ADDRESS ("ftp://prism.oregonstate.edu")
#
# VALUE:
#     COMPRESSED OR UNCOMPRESSED PRISM FILES (CURRENTLY bil RASTER FORMAT) 
# 
# NOTES: 
#     FTP DOWNLOAD SITES FOR 400m GRIDDED DAILY/MONTHLY CLIMATE DATA
#       ftp://prism.oregonstate.edu/daily
#       ftp://prism.oregonstate.edu/monthly
#    
#    MONTHLY DATA 1895-1980 IS IN A SINGLE ZIP FILE FORMAT FOR ALL MONTHS
#
#     NAMING CONVENTION:
#       PRISM_<var>_<stability>_<scale&version>_<date>_bil.zip
#         i.e., "PRISM_ppt_stable_4kmD1_20100208_bil.zip" 
# 
#     PRISM DATA DESCRIPTION: 
#       http://prism.nacse.org/documents/PRISM_datasets_aug2013.pdf   
#
#  EXAMPLE:
#     setwd("D:/TMP/PRISM")
#
#     # DOWNLOAD MONTHLY PRECIPITATION DATA JAN 1st 2000 TO DEC 30th 2001 (n=24)
#     download.prism("ppt", date.range=c("2000/1/1","2001/12/30"), time.step="monthly", by.year=TRUE)
#					 
#     # DOWNLOAD DAILY PRECIPITATION DATA JAN 1st 2000 TO FEB 10th 2000 (n=41)  
#     download.prism("ppt", date.range=c("2000/1/1","2000/2/10"), time.step="daily", by.year=TRUE)					 					 
#    	                               
# CONTACT: 
#     Jeffrey S. Evans 
#     Senior Landscape Ecologist 
#     The Nature Conservancy,
#     Development by Design
#     Affiliate Assistant Professor
#     University of Wyoming,
#     Zoology & Physiology 
#     Laramie, WY
#     (970)672-6766
#     jeffrey_evans@tnc.org
######################################################################################
download.prism <- function(data.type, date.range, time.step="monthly", download.folder=getwd(),  
             by.year=FALSE, unzip.file=TRUE, ftp.site="ftp://prism.oregonstate.edu") 
    {
    if (!require (RCurl)) stop("RCurl PACKAGE MISSING")  
      if(!( data.type=="ppt" | data.type=="tmin" |
	  	    data.type=="tmax" | data.type=="tmean") ) 
	  	      stop("Not a valid dataset")	  
	avl.years=seq(1895,2014,by=1) 
	  startdate=as.Date(date.range[1])
	    enddate=as.Date(date.range[2])   
	if(format(startdate,"%Y") %in% avl.years == FALSE) stop("Start year is not avaliable") 
	  if(format(enddate,"%Y") %in% avl.years == FALSE) stop("End year is not avaliable") 	
        getContent <- function(dirs) {
          urls <- paste(dirs, "/", sep="")	
            fls <- strsplit(getURL(urls, dirlistonly=TRUE), "\r*\n")
              ok <- sapply(fls, length) > 0
            unlist(mapply(paste, urls[ok], fls[ok], sep="", 
			       SIMPLIFY=FALSE), use.names=FALSE)
          }
		  
	ftp.site <- paste(ftp.site,  time.step, data.type, sep="/" )
      setwd(download.folder)	  
	  
	if( time.step == "monthly" ) {		
	  dates=seq.Date(startdate, enddate, by="month")
	  }
	if( time.step == "daily" ) {		
	  dates=seq.Date(startdate,enddate,by="day")
	  }	
	  years.ch=format(dates,"%Y")
	    years <- unique(years.ch)
	      months.ch=format(dates,"%m")
	       days.ch=format(dates,"%d")
	      
	dl.list <- lapply(years, function(x) NULL)
	  for(y in 1:length(dl.list) ) {
	    dl.list[[y]] <- getContent(paste(ftp.site,years[y],sep="/"))
       }		
	
	date.format <- dates
	  dates <- as.character(dates) 
        for(i in 1:length(dates)) { 
	      dates[i] <- paste(unlist(strsplit(as.character(dates[i]), "-")),sep="", collapse="")
        } 
		 
    if(time.step == "monthly") for(i in 1:length(dates)) { dates[i] <- substr(dates[i], 1, 6)  }  
	  for(i in 1:length(dl.list)) { 
	    rm.vector <- vector()
	      tmp.vector <- dl.list[[i]]
	        for(j in 1:length(tmp.vector) ) {
			  if( as.numeric(unlist(strsplit(tmp.vector[[j]], "_")[1])[5]) > 1980 ) {
                if( unlist(strsplit(tmp.vector[[j]], "_")[1])[5] %in% dates == FALSE)
                  rm.vector <- append(rm.vector, j)			
			  }
	  	    }			
          if(length(rm.vector) > 0) { 		  
	        tmp.vector <- tmp.vector[-rm.vector] 
	  	  dl.list[[i]] <- tmp.vector
        }		
      }   
	
	print(paste("Downloading", data.type, "for dates..." , sep=" ") )
	  print(dates)	
	
    for (i in 1:length(dl.list)) {
	  if(by.year) {
	    dir.create(file.path(download.folder, years[i]), showWarnings=FALSE)
	      setwd(file.path(download.folder, years[i]))
		}
        for(f in 1:length(dl.list[[i]])) {
          file.name <- dl.list[[i]][f] 		
	      try( download.file(file.name, destfile=paste(getwd(), 
		       unlist(strsplit(file.name, "/"))[7], sep="/")) )
		    if(unzip.file == TRUE) unzip( unlist(strsplit(file.name, "/"))[7] )	
        }		  
      setwd(download.folder)
	}	
}