Project

General

Profile

« Previous | Next » 

Revision f8e133e2

Added by Benoit Parmentier over 8 years ago

debugging ploting time series function and moving it to the function script

View differences:

climate/research/oregon/interpolation/global_product_assessment_part1.R
593 593
i<-1
594 594

  
595 595
#Product assessment
596
#function_product_assessment_part1_functions <- "global_product_assessment_part1_functions_09192016c.R"
597
#source(file.path(script_path,function_product_assessment_part1_functions)) #source all functions used in this script 
598
#undebug(combine_measurements_and_predictions_df)
599 596
out_suffix_str <- paste0(region_name,"_",out_suffix)
600 597
#this can be run with mclapply, very fast right now:
601 598
station_summary_obj <- combine_measurements_and_predictions_df(i=i,
......
628 625
id_name <- list_selected_ID[i]
629 626
station_id <- id_name
630 627
#> myDF[ is.na(myDF) ] <- NA 
628
#var_name1 <- "mod1_mosaic"
629
var_name1 <- y_var_name
630
var_name2 <- "mod1_mosaic"
631
out_suffix_str <- paste(region_name,out_suffix,sep="_")
632
function_product_assessment_part1_functions <- "global_product_assessment_part1_functions_09192016d.R"
633
source(file.path(script_path,function_product_assessment_part1_functions)) #source all functions used in this script 
631 634

  
632
plot_observation_predictions_time_series <- function(df_pix_time_series,var_name,df_pix_time_series,station_id,scaling=NULL,out_dir=".",out_suffix=""){
633
  #This function plots time series for observed and predicted points.
634
  #This assumes that time series with residuals were extracted from raster stacks.
635
  #
636
  #Inputs:
637
  #1) df_pix_time_series
638
  #2) var_name1: name of variables use
639
  #3) var_name2:
640
  #4) var_name3: residuals time series (var_name2 -var_name 1)
641
  #5) station_id
642
  #6) scaling: if null no scaling
643
  #7) out_dir
644
  #8) out_suffix
645
  #
646
  
647
  ########## Start script #########
648
  
649
  ## Screen of NaN and make sure we have NA
650
  df_pix_ts[is.na(df_pix_ts)] <- NA
651
  
652
  #Scale if necessary
653
  if(!is.null(scaling)){
654
    
655
    df_pix_ts[[var_pred_mosaic]] <-  df_pix_ts[[var_pred_mosaic]]*scaling 
656
  }
657

  
658
  #### var_name 1
659
  d_z_obs <- zoo(as.numeric(df_pix_ts[[y_var_name]]),as.Date(df_pix_ts$date))
660
  plot(d_z_obs)  
661
  
662
  #### var_name 2
663
  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 !!!
664
  #names(d_z_var) <- var_pred_mosaic
665
  plot(d_z_var)  
666

  
667
  d_z_diff <- d_z_var - d_z_obs 
668
  #d_z_res <- d_z_var - d_z_obs 
669
  
670
  #d_z_res <- zoo(as.numeric(df_pix_ts[[paste0("res_",var_pred_mosaic)]]),as.Date(df_pix_ts$date))
671
  plot(d_z_res)  
672

  
673
  d_z_all <- merge(d_z_var,d_z_obs,d_z_res)
674
  names(d_z_all) <- c("pred","obs","res")
675
  d_z <-  merge(d_z_var,d_z_obs)
676
  names(d_z) <- c("pred","obs")
677
  
678
  range(d_z_res,na.rm=T)
679
  mean(d_z_res,na.rm=T)
680
  quantile(d_z_res,na.rm=T)
681

  
682
  range_dates <- range(as.Date(df_pix_time_series$date))
683
  #day_start <- "1984-01-01" #PARAM 12 arg 12
684
  #day_end <- "2014-12-31" #PARAM 13 arg 13
685
  #start_date <- as.Date(day_start)
686
  #end_date <- as.Date(day_end)
687
  start_year <- year(range_dates[1])
688
  end_year <- year(range_dates[2])
689
  #range_year <- range(df_pix_ts$year)
690
  #start_year <- range_year[1]
691
  #end_year <- range_year[2]
692
  var="tmax"
693

  
694
  res_pix <- 1000
695
  #res_pix <- 480
696
  col_mfrow <- 2
697
  row_mfrow <- 1
698
  
699
  png_filename <-  file.path(out_dir,paste("Figure_5a_time_series_profile_",region_name,"_",id_name,y_var_name,out_suffix,".png",sep =""))
700
  title_str <- paste("Daily", var_name1,"and", var_name2,"for", station_id," for the ", start_year,"-",end_year," time period",sep=" ")
701
  
702
  png(filename=png_filename,width = col_mfrow * res_pix,height = row_mfrow * res_pix)
703
  #this is the whole time series
704
  #plot(d_z_var,ylab="tmax in deg C",xlab="Daily time steps",
705
  #     main=title_str,cex=3,font=2,
706
  #     cex.main=1.5,cex.lab=1.5,font.lab=2,
707
  #     lty=3)
708
  #range(df_pix_ts[[var_pred_mosaic]],na.rm=T)
709
   
710
  #plot(d_z,plot.type="single",col=c("blue","red"))
711
  col_str <- c("blue","red")
712
  plot(d_z,plot.type="single",col=col_str,
713
       ylab="tmax in deg C",xlab="Daily time steps",
714
       main=title_str,cex=1,font=2,type="l",
715
       cex.main=1.5,cex.lab=1.5,font.lab=2)
716
  
717
  #plot(df_pix_ts[[var_pred_mosaic]] ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps",
718
  #   main=title_str,cex=1,font=2,type="l",
719
  #   cex.main=1.5,cex.lab=1.5,font.lab=2,
720
  #   lty=3)
721
  #lines(as.numeric(df_pix_ts[[y_var_name]]) ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps",
722
  #   main=title_str,cex=1,font=2,col="red",type="l",
723
  #   cex.main=1.5,cex.lab=1.5,font.lab=2,
724
  #   lty=3)
725

  
726
  dev.off()
727

  
728
  #for list_windows go in a loop
729
  if(!is.null(list_windows)){
730
    
731
    for(i in 1:length(list_windows)){
732
      
733
      
734
      ### get smaller window
735

  
736
      window_range <- list_windows[i]
737
      #day_start <- "1994-01-01" #PARAM 12 arg 12
738
      #day_end <- "1999-12-31" #PARAM 13 arg 13
739
      day_start <- window_range[1]
740
      day_end <- windwow_range[2]
741
      
742
      start_date <- as.Date(day_start)
743
      end_date <- as.Date(day_end)
744
      start_year <- year(start_date)
745
      end_year <- year(end_date)
746
      
747
      ### now select from the original time series
748
      #
749
      d_z_w <- window(d_z_tmp,start=start_date,end=end_date)
750
      names(d_z) <- var_pred_mosaic
751
      df_var <- as.data.frame(d_z)
752
 
753
      d_z_tmp <- d_z_obs
754
      d_z_tmp <- d_z
755
      d_z_tmp <- window(d_z_tmp,start=start_date,end=end_date)
756
      plot(d_z_tmp,col=c("blue","red"),plot.type="single")
757
      df_z <- as.data.frame(d_z)
758

  
759
      names(d_z) <- y_var_name
760
      df_obs <- as.data.frame(d_z)
761
      names(d_z) <- y_var_name
762

  
763
      res_pix <- 1000
764
      #res_pix <- 480
765
      col_mfrow <- 2
766
      row_mfrow <- 1
767
  
768
      png_filename <-  file.path(out_dir,paste("Figure5b_time_series_profile_",region_name,"_",out_suffix,".png",sep =""))
769
      title_str <- paste("Predicted daily ", station_id," ",var," for the ", start_year,"-",end_year," time period",sep="")
770
  
771
      png(filename=png_filename,width = col_mfrow * res_pix,height = row_mfrow * res_pix)
772

  
773
      plot(df_pix_ts[[var_pred_mosaic]] ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps",
774
      main=title_str,cex=1,font=2,type="l",
775
      cex.main=1.5,cex.lab=1.5,font.lab=2,
776
      lty=3)
777
      lines(as.numeric(df_pix_ts[[y_var_name]]) ~ as.Date(df_pix_ts$date),ylab="tmax in deg C",xlab="Daily time steps",
778
      main=title_str,cex=1,font=2,col="red",type="l",
779
      cex.main=1.5,cex.lab=1.5,font.lab=2,
780
      lty=3)
781

  
782
      dev.off()
635
debug(plot_observation_predictions_time_series)
636
test_plot <- plot_observation_predictions_time_series(df_pix_time_series=df_pix_ts,
637
                                                      var_name1=var_name1,
638
                                                      var_name2=var_name2,
639
                                                      station_id=id_name,
640
                                                      scaling=scaling,
641
                                                      out_dir=".",
642
                                                      out_suffix="")
783 643

  
784
    }
785
    
786
    
787
  }
788
  
789
}
790 644

  
791 645
############### PART5: Make raster stack and display maps #############
792 646
#### Extract corresponding raster for given dates and plot stations used

Also available in: Unified diff