Revision d4e27fb9
Added by Benoit Parmentier over 8 years ago
climate/research/oregon/interpolation/global_product_assessment_part1_functions.R | ||
---|---|---|
787 | 787 |
return(station_summary_obj) |
788 | 788 |
} |
789 | 789 |
|
790 |
|
|
791 |
plot_observation_predictions_time_series <- function(df_pix_time_series,var_name1,var_name2,station_id,scaling=NULL,out_dir=".",out_suffix=""){ |
|
792 |
#This function plots time series for observed and predicted points. |
|
793 |
#This assumes that time series with residuals were extracted from raster stacks. |
|
794 |
# |
|
795 |
#Inputs: |
|
796 |
#1) df_pix_time_series |
|
797 |
#2) var_name1: name of variables use |
|
798 |
#3) var_name2: |
|
799 |
#4) station_id |
|
800 |
#5) scaling: if null no scaling |
|
801 |
#6) out_dir |
|
802 |
#7) out_suffix |
|
803 |
# |
|
804 |
|
|
805 |
########## Start script ######### |
|
806 |
|
|
807 |
## Screen of NaN and make sure we have NA |
|
808 |
df_pix_ts[is.na(df_pix_ts)] <- NA |
|
809 |
|
|
810 |
#Scale if necessary |
|
811 |
if(!is.null(scaling)){ |
|
812 |
|
|
813 |
df_pix_ts[[var_pred_mosaic]] <- df_pix_ts[[var_pred_mosaic]]*scaling |
|
814 |
} |
|
815 |
|
|
816 |
#### var_name 1 |
|
817 |
d_z_obs <- zoo(as.numeric(df_pix_ts[[y_var_name]]),as.Date(df_pix_ts$date)) |
|
818 |
plot(d_z_obs) |
|
819 |
|
|
820 |
#### var_name 2 |
|
821 |
d_z_var <- zoo(as.numeric(df_pix_ts[[var_pred_mosaic]]),as.Date(df_pix_ts$date)) #make sure date is a date object !!! |
|
822 |
#names(d_z_var) <- var_pred_mosaic |
|
823 |
plot(d_z_var) |
|
824 |
|
|
825 |
d_z_diff <- d_z_var - d_z_obs |
|
826 |
#d_z_res <- d_z_var - d_z_obs |
|
827 |
|
|
828 |
#d_z_res <- zoo(as.numeric(df_pix_ts[[paste0("res_",var_pred_mosaic)]]),as.Date(df_pix_ts$date)) |
|
829 |
plot(d_z_res) |
|
830 |
|
|
831 |
d_z_all <- merge(d_z_var,d_z_obs,d_z_res) |
|
832 |
names(d_z_all) <- c("pred","obs","res") |
|
833 |
d_z <- merge(d_z_var,d_z_obs) |
|
834 |
names(d_z) <- c("pred","obs") |
|
835 |
|
|
836 |
range(d_z_res,na.rm=T) |
|
837 |
mean(d_z_res,na.rm=T) |
|
838 |
quantile(d_z_res,na.rm=T) |
|
839 |
|
|
840 |
range_dates <- range(as.Date(df_pix_time_series$date)) |
|
841 |
#day_start <- "1984-01-01" #PARAM 12 arg 12 |
|
842 |
#day_end <- "2014-12-31" #PARAM 13 arg 13 |
|
843 |
#start_date <- as.Date(day_start) |
|
844 |
#end_date <- as.Date(day_end) |
|
845 |
start_year <- year(range_dates[1]) |
|
846 |
end_year <- year(range_dates[2]) |
|
847 |
#range_year <- range(df_pix_ts$year) |
|
848 |
#start_year <- range_year[1] |
|
849 |
#end_year <- range_year[2] |
|
850 |
var="tmax" |
|
851 |
|
|
852 |
res_pix <- 1000 |
|
853 |
#res_pix <- 480 |
|
854 |
col_mfrow <- 2 |
|
855 |
row_mfrow <- 1 |
|
856 |
|
|
857 |
png_filename <- file.path(out_dir,paste("Figure_5a_time_series_profile_",region_name,"_",id_name,y_var_name,out_suffix,".png",sep ="")) |
|
858 |
title_str <- paste("Daily", var_name1,"and", var_name2,"for", station_id," for the ", start_year,"-",end_year," time period",sep=" ") |
|
859 |
|
|
860 |
png(filename=png_filename,width = col_mfrow * res_pix,height = row_mfrow * res_pix) |
|
861 |
#this is the whole time series |
|
862 |
#plot(d_z_var,ylab="tmax in deg C",xlab="Daily time steps", |
|
863 |
# main=title_str,cex=3,font=2, |
|
864 |
# cex.main=1.5,cex.lab=1.5,font.lab=2, |
|
865 |
# lty=3) |
|
866 |
#range(df_pix_ts[[var_pred_mosaic]],na.rm=T) |
|
867 |
|
|
868 |
#plot(d_z,plot.type="single",col=c("blue","red")) |
|
869 |
col_str <- c("blue","red") |
|
870 |
plot(d_z,plot.type="single",col=col_str, |
|
871 |
ylab="tmax in deg C",xlab="Daily time steps", |
|
872 |
main=title_str,cex=1,font=2,type="l", |
|
873 |
cex.main=1.5,cex.lab=1.5,font.lab=2) |
|
874 |
|
|
875 |
#plot(df_pix_ts[[var_pred_mosaic]] ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps", |
|
876 |
# main=title_str,cex=1,font=2,type="l", |
|
877 |
# cex.main=1.5,cex.lab=1.5,font.lab=2, |
|
878 |
# lty=3) |
|
879 |
#lines(as.numeric(df_pix_ts[[y_var_name]]) ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps", |
|
880 |
# main=title_str,cex=1,font=2,col="red",type="l", |
|
881 |
# cex.main=1.5,cex.lab=1.5,font.lab=2, |
|
882 |
# lty=3) |
|
883 |
|
|
884 |
dev.off() |
|
885 |
|
|
886 |
#for list_windows go in a loop |
|
887 |
if(!is.null(list_windows)){ |
|
888 |
|
|
889 |
for(i in 1:length(list_windows)){ |
|
890 |
|
|
891 |
|
|
892 |
### get smaller window |
|
893 |
|
|
894 |
window_range <- list_windows[i] |
|
895 |
#day_start <- "1994-01-01" #PARAM 12 arg 12 |
|
896 |
#day_end <- "1999-12-31" #PARAM 13 arg 13 |
|
897 |
day_start <- window_range[1] |
|
898 |
day_end <- windwow_range[2] |
|
899 |
|
|
900 |
start_date <- as.Date(day_start) |
|
901 |
end_date <- as.Date(day_end) |
|
902 |
start_year <- year(start_date) |
|
903 |
end_year <- year(end_date) |
|
904 |
|
|
905 |
### now select from the original time series |
|
906 |
# |
|
907 |
d_z_w <- window(d_z_tmp,start=start_date,end=end_date) |
|
908 |
names(d_z) <- var_pred_mosaic |
|
909 |
df_var <- as.data.frame(d_z) |
|
910 |
|
|
911 |
d_z_tmp <- d_z_obs |
|
912 |
d_z_tmp <- d_z |
|
913 |
d_z_tmp <- window(d_z_tmp,start=start_date,end=end_date) |
|
914 |
plot(d_z_tmp,col=c("blue","red"),plot.type="single") |
|
915 |
df_z <- as.data.frame(d_z) |
|
916 |
|
|
917 |
names(d_z) <- y_var_name |
|
918 |
df_obs <- as.data.frame(d_z) |
|
919 |
names(d_z) <- y_var_name |
|
920 |
|
|
921 |
res_pix <- 1000 |
|
922 |
#res_pix <- 480 |
|
923 |
col_mfrow <- 2 |
|
924 |
row_mfrow <- 1 |
|
925 |
|
|
926 |
png_filename <- file.path(out_dir,paste("Figure5b_time_series_profile_",region_name,"_",out_suffix,".png",sep ="")) |
|
927 |
title_str <- paste("Predicted daily ", station_id," ",var," for the ", start_year,"-",end_year," time period",sep="") |
|
928 |
|
|
929 |
png(filename=png_filename,width = col_mfrow * res_pix,height = row_mfrow * res_pix) |
|
930 |
|
|
931 |
plot(df_pix_ts[[var_pred_mosaic]] ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps", |
|
932 |
main=title_str,cex=1,font=2,type="l", |
|
933 |
cex.main=1.5,cex.lab=1.5,font.lab=2, |
|
934 |
lty=3) |
|
935 |
lines(as.numeric(df_pix_ts[[y_var_name]]) ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps", |
|
936 |
main=title_str,cex=1,font=2,col="red",type="l", |
|
937 |
cex.main=1.5,cex.lab=1.5,font.lab=2, |
|
938 |
lty=3) |
|
939 |
|
|
940 |
dev.off() |
|
941 |
|
|
942 |
} |
|
943 |
|
|
944 |
} |
|
945 |
|
|
946 |
#return() |
|
947 |
} |
|
948 |
|
|
949 |
|
|
790 | 950 |
############################ END OF SCRIPT ################################## |
Also available in: Unified diff
adding ploting time series function in the assessment product part 1 function script