Project

General

Profile

« Previous | Next » 

Revision f67776b9

Added by Benoit Parmentier over 8 years ago

initial commit for function script for global product assessment part 1

View differences:

climate/research/oregon/interpolation/global_product_assessment_part1_functions.R
1
####################################  INTERPOLATION OF TEMPERATURES  #######################################
2
#######################  Assessment of product part 1 functions: mosaic and accuracy ##############################
3
#This script contains functions and uses the worklfow code applied to the globe. Results currently reside on NEX/PLEIADES NASA.
4
#Combining tables and figures for individual runs for years and tiles.
5
#AUTHOR: Benoit Parmentier 
6
#CREATED ON: 05/24/2016  
7
#MODIFIED ON: 05/24/2016            
8
#Version: 1
9
#PROJECT: Environmental Layers project     
10
#COMMENTS: Initial commit, script based on part NASA biodiversity conference 
11
#TODO:
12
#1) Add plot broken down by year and region 
13
#2) Modify code for overall assessment accross all regions and year
14
#3) Clean up
15

  
16
#First source these files:
17
#Resolved call issues from R.
18
#source /nobackupp6/aguzman4/climateLayers/sharedModules2/etc/environ.sh 
19
#
20
#setfacl -Rmd user:aguzman4:rwx /nobackupp8/bparmen1/output_run10_1500x4500_global_analyses_pred_1992_10052015
21

  
22
#################################################################################################
23

  
24
### Loading R library and packages        
25
#library used in the workflow production:
26
library(gtools)                              # loading some useful tools 
27
library(mgcv)                                # GAM package by Simon Wood
28
library(sp)                                  # Spatial pacakge with class definition by Bivand et al.
29
library(spdep)                               # Spatial pacakge with methods and spatial stat. by Bivand et al.
30
library(rgdal)                               # GDAL wrapper for R, spatial utilities
31
library(gstat)                               # Kriging and co-kriging by Pebesma et al.
32
library(fields)                              # NCAR Spatial Interpolation methods such as kriging, splines
33
library(raster)                              # Hijmans et al. package for raster processing
34
library(gdata)                               # various tools with xls reading, cbindX
35
library(rasterVis)                           # Raster plotting functions
36
library(parallel)                            # Parallelization of processes with multiple cores
37
library(maptools)                            # Tools and functions for sp and other spatial objects e.g. spCbind
38
library(maps)                                # Tools and data for spatial/geographic objects
39
library(reshape)                             # Change shape of object, summarize results
40
library(plotrix)                             # Additional plotting functions
41
library(plyr)                                # Various tools including rbind.fill
42
library(spgwr)                               # GWR method
43
library(automap)                             # Kriging automatic fitting of variogram using gstat
44
library(rgeos)                               # Geometric, topologic library of functions
45
#RPostgreSQL                                 # Interface R and Postgres, not used in this script
46
library(gridExtra)
47
#Additional libraries not used in workflow
48
library(pgirmess)                            # Krusall Wallis test with mulitple options, Kruskalmc {pgirmess}
49
library(colorRamps)
50
library(zoo)
51
library(xts)
52
library(lubridate)
53

  
54
###### Function used in the script #######
55
  
56
#Used to load RData object saved within the functions produced.
57
load_obj <- function(f){
58
  env <- new.env()
59
  nm <- load(f, env)[1]
60
  env[[nm]]
61
}
62

  
63
pre_process_raster_mosaic_fun <- function(i,list_param){
64
  
65
  
66
  ## Extract parameters
67
  
68
  lf <- list_param$lf
69
  python_bin <- list_param$python_bin
70
  infile_mask <- list_param$infile_mask
71
  scaling <- list_param$scaling
72
  mask_pred <- list_param$mask_pred
73
  NA_flag_val <- list_param$NA_flag_val
74
  out_suffix <- list_param$out_suffix
75
  out_dir <- list_param$out_dir
76
  
77
  raster_name_in <- lf[i]
78
  
79
  #Step 1: match extent and resolution
80
  
81
  lf_files <- c(raster_name_in) #match to mask
82
  rast_ref <- infile_mask
83
  ##Maching resolution is probably only necessary for the r mosaic function
84
  #Modify later to take into account option R or python...
85
  list_param_raster_match <- list(lf_files,rast_ref,file_format,python_bin,out_suffix,out_dir)
86
  names(list_param_raster_match) <- c("lf_files","rast_ref","file_format","python_bin","out_suffix","out_dir_str")
87
  r_pred_matched <- raster_match(1,list_param_raster_match)
88
  raster_name_in <- c(r_pred_matched)
89

  
90
  #Step 2: mask
91
  if(mask_pred==TRUE){
92
    r_mask <- raster(infile_mask)
93
    extension_str <- extension(raster_name_in)
94
    raster_name_tmp <- gsub(extension_str,"",basename(raster_name_in))
95
    raster_name <- file.path(out_dir,paste(raster_name_tmp,"_masked.tif",sep = ""))
96
    r_pred <- mask(raster(raster_name_in),r_mask,filename = raster_name,overwrite = TRUE)
97
  }
98
  
99
  NAvalue(r_pred) <- NA_flag_val
100
  #r_pred <- setMinMax(r_pred)
101

  
102
  #Step 3: remove scaling factor
103
  raster_name_in <- filename(r_pred)
104
  extension_str <- extension(raster_name_in)
105
  raster_name_tmp <- gsub(extension_str,"",basename(filename(r_pred)))
106
  raster_name_out <- file.path(out_dir,paste(raster_name_tmp,"_rescaled.tif",sep = ""))
107
  #r_pred <- overlay(r_pred, fun=function(x){x*1/scaling},filename=raster_name,overwrite=T)
108

  
109
  #raster_name_in <- "comp_r_m_use_edge_weights_weighted_mean_gam_CAI_dailyTmax_19990102_reg4_1999_m_gam_CAI_dailyTmax_19990102_reg4_1999_m__meeting_NASA_reg4_04292016_masked.tif"
110
  python_cmd <- file.path(python_bin,"gdal_calc.py")
111
  cmd_str3 <- paste(python_cmd, 
112
                     paste("-A ", raster_name_in,sep=""),
113
                     paste("--outfile=",raster_name_out,sep=""),
114
                     #paste("--type=","Int32",sep=""),
115
                     "--co='COMPRESS=LZW'",
116
                     paste("--NoDataValue=",NA_flag_val,sep=""),
117
                     paste("--calc='(A)*",scaling,"'",sep=""),
118
                     "--overwrite",sep=" ") #division by zero is problematic...
119
  #system(cmd_str3)
120
  system(cmd_str3)
121
  #NAvalue(r_pred) <- NA_flag_val
122
  #r_pred <- 
123
  r_pred <- setMinMax(raster(raster_name_out))
124
  
125
  return(raster_name_out)
126
}
127

  
128
plot_raster_mosaic <- function(i,list_param){
129
  #Function to plot mosaic for poster
130
  #
131
  l_dates <- list_param$l_dates
132
  r_mosaiced_scaled <- list_param$r_mosaiced_scaled
133
  NA_flag_val <- list_param$NA_flag_val
134
  out_dir <- list_param$out_dir
135
  out_suffix <- list_param$out_suffix
136
  region_name <- list_param$region_name
137
  variable_name <- list_param$variable_name
138

  
139
#for (i in 1:length(nlayers(r_mosaic_scaled))){
140
  
141
  date_proc <- l_dates[i]
142
  r_pred <- subset(r_mosaic_scaled,i)
143
  NAvalue(r_pred)<- NA_flag_val 
144
 
145
  date_proc <- l_dates[i]
146
  date_val <- as.Date(strptime(date_proc,"%Y%m%d"))
147
  #month_name <- month.name(date_val)
148
  month_str <- format(date_val, "%b") ## Month, char, abbreviated
149
  year_str <- format(date_val, "%Y") ## Year with century
150
  day_str <- as.numeric(format(date_val, "%d")) ## numeric month
151
  date_str <- paste(month_str," ",day_str,", ",year_str,sep="")
152
  
153
  res_pix <- 1200
154
  #res_pix <- 480
155
  col_mfrow <- 1
156
  row_mfrow <- 1
157
  
158
  png_filename <-  file.path(out_dir,paste("Figure4_clim_mosaics_day_","_",date_proc,"_",region_name,"_",out_suffix,".png",sep =""))
159
  title_str <-  paste("Predicted ",variable_name, " on ",date_str , " ", sep = "")
160
  
161
  png(filename=png_filename,width = col_mfrow * res_pix,height = row_mfrow * res_pix)
162
  plot(r_pred,main =title_str,cex.main =1.5,col=matlab.like(255),zlim=c(-50,50),
163
       legend.shrink=0.8,legend.width=0.8)
164
       #axis.args = list(cex.axis = 1.6), #control size of legend z
165
       #legend.args=list(text='dNBR', side=4, line=2.5, cex=2.2))
166
       #legend.args=list(text='dNBR', side=4, line=2.49, cex=1.6))
167
  dev.off()
168

  
169
  return(png_filename)
170
}
171

  
172
extract_date <- function(i,x,item_no=NULL){
173
  y <- unlist(strsplit(x[[i]],"_"))
174
  if(is.null(item_no)){
175
    date_str <- y[length(y)-2] #count from end
176
  }else{
177
    date_str <- y[item_no]
178
  }
179
  return(date_str)
180
}
181

  
182
############################ END OF SCRIPT ##################################

Also available in: Unified diff